[EMAIL PROTECTED] wrote:
I'm presumably missing something very obvious, but how does one use the
key.opts argument in labcurve (via Ecdf)?
In this example, I want the key to be big and have a blue background, but
it isn't and doesn't.
ch <- rnorm(1000, 200, 40)
sex <- factor(sample(c('female','male'), 1000, TRUE))
Ecdf(~ch, group=sex, label.curves=list(keys=c("f", "m"),
key.opts=list(cex=3, background="blue")))
Regards,
Richie.
Mathematical Sciences Unit
HSL
------------------------------------------------------------------------
ATTENTION:
This message contains privileged and confidential inform...{{dropped:20}}
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
Sorry about the error. Until the next release of Hmisc please source in
the following function override. -Frank
putKey <- function(z, labels, type=NULL,
pch=NULL, lty=NULL, lwd=NULL,
cex=par('cex'), col=rep(par('col'),nc),
transparent=TRUE, plot=TRUE, key.opts=NULL,
grid=FALSE)
{
if(grid)
{
require('grid')
require('lattice') # use draw.key in lattice
}
if(!.R. && !existsFunction('key'))
stop('must do library(trellis) to access key() function')
nc <- length(labels)
if(!length(pch)) pch <- rep(NA, nc)
if(!length(lty)) lty <- rep(NA, nc)
if(!length(lwd)) lwd <- rep(NA, nc)
pp <- !is.na(pch)
lp <- !is.na(lty) | !is.na(lwd)
lwd <- ifelse(is.na(lwd), par('lwd'), lwd)
if(!length(type)) type <- ifelse(!(pp | lp), 'n',
ifelse(pp & lp, 'b',
ifelse(pp, 'p', 'l')))
pch <- ifelse(is.na(pch) & type!='p' & type!='b',
if(.R.) NA else 0,
pch)
lty <- ifelse(is.na(lty) & type=='p',
if(.R.) NA else 1,
lty)
lwd <- ifelse(is.na(lwd) & type=='p', 1, lwd)
cex <- ifelse(is.na(cex) & type!='p' & type!='b', 1, cex)
if(!.R. && any(is.na(pch)))
stop("pch can not be NA for type='p' or 'b'")
if(!.R. && any(is.na(lty)))
stop("lty can not be NA for type='l' or 'b'")
if(any(is.na(lwd)))
stop("lwd can not be NA for type='l' or 'b'")
if(any(is.na(cex)))
stop("cex can not be NA for type='p' or 'b'")
m <- list()
m[[1]] <- as.name(if(grid) 'draw.key'
else if(.R.) 'rlegend' else 'key')
if(!grid)
{
m$x <- z[[1]]; m$y <- z[[2]]
}
if(.R.)
{
if(grid)
{
w <- list(text=list(labels, col=col))
if(!(all(is.na(lty)) & all(is.na(lwd))))
{
lns <- list()
if(!all(is.na(lty)))
lns$lty <- lty
if(!all(is.na(lwd)))
lns$lwd <- lwd
lns$col <- col
w$lines <- lns
}
if(!all(is.na(pch)))
w$points <- list(pch=pch, col=col)
m$key <- c(w, key.opts)
m$draw <- plot
if(plot)
m$vp <- viewport(x=unit(z[[1]], 'native'),
y=unit(z[[2]], 'native'))
z <- eval(as.call(m))
size <-
if(plot) c(NA,NA)
else
c(convertUnit(grobWidth(z), 'native', 'x', 'location', 'x',
'dimension', valueOnly=TRUE)[1],
convertUnit(grobHeight(z), 'native', 'y', 'location', 'y',
'dimension', valueOnly=TRUE)[1])
return(invisible(size))
}
else
{
m$legend <- labels
m$xjust <- m$yjust <- .5
m$plot <- plot
m$col <- col
m$cex <- cex
if(!all(is.na(lty))) m$lty <- lty
if(!all(is.na(lwd))) m$lwd <- lwd
if(!all(is.na(pch))) m$pch <- pch
if(length(key.opts)) m[names(key.opts)] <- key.opts
w <- eval(as.call(m))$rect
return(invisible(c(w$w[1], w$h[1])))
}
}
m$transparent <- transparent
m$corner <- c(.5,.5)
m$plot <- plot
m$type <- type
if(!plot) labels <- substring(labels, 1, 10)
## key gets length wrong for long labels
m$text <- list(labels, col=col)
if(all(type=='p'))
m$points <- list(pch=pch, cex=cex, col=col)
else
m$lines <-
if(any(type!='l'))
list(lty=lty, col=col, lwd=lwd, pch=pch, cex=cex)
else
list(lty=lty, col=col, lwd=lwd)
if(length(key.opts))
m[names(key.opts)] <- key.opts
invisible(eval(as.call(m))) ## execute key(....)
}
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
