Snews,
Some weeks ago, I posted a request for help in changing the spacing
between the text and the lines in a 'key.' In truth, most of the answers
were of the 'me too' form. It seems that the 'between' and 'between
lines' parameters do not work as advertised. Is this a bug or just poor
documentation? not sure.
However, I think that two people suggested (Karen_Johnson, Eric M.
Ossiander) and one of them provided, a patch to the apparent bug in
'key.' With Eric's permission, please find his patched function below.
I also received a reply from Mathsoft indicating that I should use the
'between' option with fractional or negative numbers. However, although
this does indeed change the spacing between the text and lines, it also
changes the alignment, sometimes resulting in text outside of the
boundary box. Not satisfactory.
Gabriel Baud-Bovy suggested using cex in both inside and outside of the
text part of the key statement. This does work, but requires much
twiddling to get it right.
Thank you again for all of the help in trying to solve this problem. I
just hope that Mathsoft makes the 'key' function more robust in the near
future.
regards,
jcd
#################################
## newkey: Eric Ossiander 12/98
newkey <- function(x = 0, y = 0, ..., title = "", align = T, background
= 0, border = 0, between = 2, corner = c(0, 1), divide = 3, transparent
= F, cex = par("cex"), col = par("col"), lty = par("lty"), lwd =
par("lwd"), font= par("font"), pch = par("pch"), adj = 0, type = "l",
size = 5, columns
= 1, between.columns = 3, angle = 0, density = -1, plot = T, space =
NULL, correction = 0.3)
{
oldxpd <- par("xpd")
on.exit(par(xpd = oldxpd))
if(plot) {
par(xpd = T)
.Fortran("spomoz",
as.integer(1)) # turn on outer margin
}
rest <- list(...)
colnames <- names(rest)
actions <- c("points", "lines", "rectangles", "text")
colnames <- check.types("key components", colnames, actions)
# full name
nrows <- max(sapply(unlist(rest, recursive = F), length))
ncols <- length(colnames)
cx <- par("cxy")[1]
cy <- par("cxy")[2]
replen <- function(a, b, n)
rep(if(is.null(a)) b else a, length = n)
for(j in seq(ncols)) {
this <- rest[[j]]
this$cex <- replen(this$cex, cex, nrows)
this$size <- replen(this$size, size, nrows)
this$type <- replen(this$type, type, nrows)
this$density <- replen(this$density, density, nrows)
this$angle <- replen(this$angle, angle, nrows)
this$col <- replen(this$col, col, nrows)
this$lty <- replen(this$lty, lty, nrows)
this$lwd <- replen(this$lwd, lwd, nrows)
this$adj <- replen(this$adj, adj, nrows)
this$font <- replen(this$font, font, nrows)
this$pch <- replen(this$pch, pch, nrows)
rest[[j]] <- this
}
text.adj <- width <- height <- matrix(0, nrows, ncols)
between <- rep(between, length = ncols)
for(j in seq(ncols)) {
this <- rest[[j]]
for(i in seq(nrows)) {
switch(colnames[j],
points = {
sx <- sy <- this$cex[i]
}
,
lines = {
sx <- this$size[i]
sy <- this$cex[i]
}
,
rectangles = {
sx <- this$size[i]
sy <- this$cex[i]
}
,
text = {
sx <- nchar(this[[1]][i]) *
this$cex[i] * correction # E.O.'s
change
sy <- this$cex[i]
text.adj[i, j] <- this$adj[i]
}
)
width[i, j] <- (sx + between[j]) * cx
height[i, j] <- sy * cy
}
}
if(columns != 1) {
slice <- function(x, p)
{
m <- nrow(x)
n <- ncol(x)
if(m %% p != 0)
x <- rbind(x, matrix(0, p - m %% p, n))
q <- nrow(x)/p
dim(x) <- c(q, p, n)
x <- aperm(x, c(1, 3, 2))
dim(x) <- c(q, n * p)
x
}
width[, ncols] <- width[, ncols] + cx * between.columns
width <- slice(width, columns)
nc <- ncol(width)
width[, nc] <- width[, nc] - cx * between.columns
height <- slice(height, columns)
text.adj <- slice(text.adj, columns)
}
nc <- ncol(width)
nr <- nrow(width)
if(align)
for(j in seq(nc))
width[, j] <- max(width[, j])
xpos <- ypos <- matrix(0, nr, nc)
for(j in seq(length = nc - 1))
xpos[, j + 1] <- xpos[, j] + width[, j]
xpos <- xpos + x + cx * between[1] * 0.5
i <- text.adj != 0 # fix up text adjustments
# this should be fixed -- not between[1]
if(any(i))
xpos[i] <- xpos[i] + text.adj[i] * (width[i]/cx -
between[1]) * cx
for(i in seq(nr))
height[i, ] <- max(height[i, ])
for(i in seq(length = nr - 1))
ypos[i + 1, ] <- ypos[i, ] - height[i, ]
ypos <- ypos + y - 0.5 * cy
if(nchar(title))
ypos <- ypos - cy * 1.5
xmax <- max(xpos + width)
ymin <- min(ypos - height) + 0.5 * cy
if(!plot)
return(c(xmax - x, y - ymin) * par("uin"))
x.offset <- (x - xmax) * corner[1]
xpos <- xpos + x.offset
y.offset <- (y - ymin) * (1 - corner[2])
ypos <- ypos + y.offset
if(!transparent)
polygon(c(x, xmax, xmax, x) + x.offset, c(y, y, ymin,
ymin) + y.offset,
col = background, border =
border)
if(nchar(title))
text((x + xmax)/2 + x.offset, y + y.offset - 0.75 * cy,
title, adj =
0.5, cex = 1.5)
if(columns != 1) {
restack <- function(x, p)
{
n <- ncol(x)/p
q <- nrow(x)
dim(x) <- c(q, n, p)
x <- aperm(x, c(1, 3, 2))
dim(x) <- c(p * q, n)
x
}
xpos <- restack(xpos, columns)[1:nrows, , drop = F]
ypos <- restack(ypos, columns)[1:nrows, , drop = F]
}
for(j in seq(ncols)) {
this <- rest[[j]]
for(i in seq(nrows)) {
switch(colnames[j],
points = {
points(xpos[i, j], ypos[i, j], cex =
this$cex[i], col =
this$col[i], font = this$
font[i], pch = this$pch[i])
}
,
lines = {
if(this$type[i] != "p")
lines(xpos[i, j] + seq(0, 1, length
= divide) * cx *
this$size[i], rep(ypos[i,
j], divide), cex = this$cex[i],
lwd = this$lwd[i], type =
this$type[i], lty
= this$lty[i], pch = this$pch[i],
font = this$font[i], col =
this$col[i])
else points(xpos[i, j] + 0.5 * cx *
this$size[i], ypos[i, j], cex =
this$cex[i],
lwd = this$lwd[i], type =
this$type[i], lty = this$lty[i], pch
= this$pch[i],
font = this$font[i], col =
this$col[i])
}
,
rectangles = {
polygon(xpos[i, j] + c(0,
rep(this$size[i] * cx, 2), 0), ypos[i, j]
+ cy * c(-0.5,
-0.5, 0.5, 0.5), col = this$col[i],
angle = this$angle[i],
density = this$
density[i], border = F)
}
,
text = {
text(xpos[i, j], ypos[i, j],
this[[1]][i], adj = this$adj[i], cex =
this$cex[i],
col = this$col[i], font =
this$font[i])
}
)
}
}
.Fortran("spomoz",
as.integer(0)) # turn off outer margin
invisible()
}
--
Joseph C. Davis, Ph.D. PDF Solutions, Inc.
101 W. Renner Rd, Ste 100 Software and Consulting for
Richardson, TX 75081 Semiconductor Manufacturing
(972) 889-3025 fax: (972) 889-2486
-----------------------------------------------------------------------
This message was distributed by s-news@wubios.wustl.edu. To unsubscribe
send e-mail to s-news-request@wubios.wustl.edu with the BODY of the
message: unsubscribe s-news
|