The R Project SVN
R-packages
(root)/trunk/lattice/R/settings.R – Rev 1663
Rev 1357 | Rev 1800 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
### Copyright (C) 2001-2005 Deepayan Sarkar <Deepayan.Sarkar@R-project.org>###### This file is part of the lattice library for R.### It is made available under the terms of the GNU General Public### License, version 2, or at your option, any later version,### incorporated herein by reference.###### This program is distributed in the hope that it will be### useful, but WITHOUT ANY WARRANTY; without even the implied### warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR### PURPOSE. See the GNU General Public License for more### details.###### You should have received a copy of the GNU General Public### License along with this program; if not, write to the Free### Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,### MA 02111-1307, USAcol.whitebg <- function()list(background = list(col="transparent"),bar.fill = list(col="#c8ffc8"),box.rectangle = list(col="darkgreen"),box.umbrella = list(col="darkgreen"),dot.line = list(col="#e8e8e8"),dot.symbol = list(col="darkgreen"),plot.line = list(col="darkgreen"),plot.symbol = list(col="darkgreen"),##regions=list(col=rev(hsv(h=250:349/1000, v=30:129/150,s=.5,##gamma = .6)))regions = list(col = heat.colors(100)),strip.shingle = list(col = c("#ff7f00", "#00ff00", "#00ffff","#0080ff", "#ff00ff", "#ff0000", "#ffff00")),strip.background = list(col = c("#ffe5cc", "#ccffcc", "#ccffff","#cce6ff", "#ffccff", "#ffcccc", "#ffffcc")),reference.line = list(col="#e8e8e8"),superpose.line = list(col = c("darkgreen","red","royalblue","brown","orange","turquoise", "orchid"),lty = 1:7),superpose.symbol = list(pch = c(1,3,6,0,5,16,17), cex = rep(.7, 7),col = c("darkgreen","red","royalblue","brown","orange","turquoise", "orchid")))canonical.theme <- function(name = "null device", color = TRUE){## For the purpose of this function, the only differences in the## settings/themes arise from the difference in the default## colors. So, I will first set up the appropriate colors## according to 'name', and then use those to create the## theme. The first 16 colors correspond to trellis.settings## colors, the 17th is the background color.if (color){## color colorscan.col <-if (name == "windows" || name == "X11")c("#000000", "#00ffff", "#ff00ff", "#00ff00","#ff7f00", "#007eff", "#ffff00", "#ff0000","#c6ffff", "#ffc3ff", "#c8ffc8", "#ffd18f","#a9e2ff", "#ffffc3", "#ff8c8a", "#aaaaaa","#909090")else if (name %in% c("postscript", "pdf", "xfig"))c("#000000", "#00ffff", "#ff00ff", "#00ff00","#ff7f00", "#0080ff", "#ffff00", "#ff0000","#ccffff", "#ffccff", "#ccffcc", "#ffe5cc","#cce6ff", "#ffffcc", "#ffcccc", "#e6e6e6","transparent")else ## default, same as X11 for nowc("#000000", "#00FFFF", "#FF00FF", "#00FF00","#FF7F00", "#007EFF", "#FFFF00", "#FF0000","#C6FFFF", "#FFC3FF", "#C8FFC8", "#FFD18F","#A9E2FF", "#FFFFC3", "#FF8C8A", "#AAAAAA","#909090")}else ## b&w colors, same for all devices (8:16 actually unnecessary)can.col <-c("#000000", "#999999", "#4C4C4C", "#E6E6E6", "#F2F2F2","#B2B2B2", "#000000", "#030303", "#050505", "#080808","#0A0A0A", "#0D0D0D", "#0F0F0F", "#121212", "#151515","#171717", "transparent")## The following definition is the basis for what elements are## valid in any setting. Adding something here should be necessary## and sufficient.## color settings, modified later if postscript or color = FALSEans <-list(fontsize = list(text = 12, points = 8),background = list(alpha = 1, col = can.col[17]),clip = list(panel = "on", strip = "on"),add.line = list(alpha = 1, col = can.col[1], lty = 1, lwd = 1),add.text = list(alpha = 1, cex = 1, col = can.col[1], font = 1),bar.fill = list(alpha = 1, col = can.col[2], border = "black", lty = 1, lwd = 1),box.dot = list(alpha = 1, col = can.col[1], cex = 1, font = 1, pch = 16),box.rectangle = list(alpha = 1, col = can.col[2], fill = "transparent", lty = 1, lwd = 1),box.umbrella = list(alpha = 1, col = can.col[2], lty = 2, lwd = 1),dot.line = list(alpha = 1, col = can.col[16], lty = 1, lwd = 1),dot.symbol = list(alpha = 1, cex = 0.8, col = can.col[2], font = 1, pch = 16),plot.line = list(alpha = 1, col = can.col[2], lty = 1, lwd = 1),plot.symbol = list(alpha = 1, cex = 0.8, col = can.col[2], font = 1, pch = 1),reference.line = list(alpha = 1, col = can.col[16], lty = 1, lwd = 1),strip.background = list(alpha = 1, col = can.col[c(12, 11, 9, 13, 10, 15, 14)]),strip.shingle = list(alpha = 1, col = can.col[c(5, 4, 2, 6, 3, 8, 7)]),strip.border = list(alpha = 1, col = rep(can.col[1], 7), lty = rep(1, 7), lwd = rep(1, 7)),superpose.line = list(alpha = 1, col = can.col[2:8], lty = rep(1, 7), lwd = rep(1, 7)),superpose.symbol = list(alpha = rep(1, 7), cex = rep(0.8, 7), col = can.col[2:8],font = rep(1, 7), pch = rep(1, 7)),superpose.fill = list(alpha = rep(1, 7), col = can.col[2:8],border = rep("black", 7), lty = rep(1, 7), lwd = rep(1, 7)),regions = list(alpha = 1, col = rev(cm.colors(100))),shade.colors = list(alpha = 1, palette = function(irr, ref, height, saturation = .9) {hsv(h = height, s = 1 - saturation * (1 - (1-ref)^0.5), v = irr)}),axis.line = list(alpha = 1, col = can.col[1], lty = 1, lwd = 1),axis.text = list(alpha = 1, cex = .8, col = can.col[1], font = 1),## NEW: controls widths of tick marks and padding of labelsaxis.components = list(left = list(tck = 1, pad1 = 1, pad2 = 1),top = list(tck = 1, pad1 = 1, pad2 = 1),right = list(tck = 1, pad1 = 1, pad2 = 1),bottom = list(tck = 1, pad1 = 1, pad2 = 1)),## NEW: controls widths of basic layout's componentslayout.heights = list(top.padding = 1,main = 1,main.key.padding = 1,key.top = 1,key.axis.padding = 1,axis.top = 1,strip = 1,panel = 1, ## shouldn't be changedaxis.panel = 1, ## can be usefulbetween = 1,axis.bottom = 1,axis.xlab.padding = 1,xlab = 1,xlab.key.padding = 1,key.bottom = 1,key.sub.padding = 1,sub = 1,bottom.padding = 1),layout.widths = list(left.padding = 1,key.left = 1,key.ylab.padding = 1,ylab = 1,ylab.axis.padding = 1,axis.left = 1,axis.panel = 1, ## can be usefulpanel = 1, ## shouldn't be changedbetween = 1,axis.right = 1,axis.key.padding = 1,key.right = 1,right.padding = 1),box.3d = list(alpha = 1, col = can.col[1], lty = 1, lwd = 1),par.xlab.text = list(alpha = 1, cex = 1, col = can.col[1], font = 1),par.ylab.text = list(alpha = 1, cex = 1, col = can.col[1], font = 1),par.zlab.text = list(alpha = 1, cex = 1, col = can.col[1], font = 1),par.main.text = list(alpha = 1, cex = 1.2, col = can.col[1], font = 2),par.sub.text = list(alpha = 1, cex = 1, col = can.col[1], font = 2))if (color){if (name == "postscript" || name == "pdf"){ans$plot.symbol$col <- can.col[6]ans$plot.line$col <- can.col[6]ans$dot.symbol$col <- can.col[6]ans$box.rectangle$col <- can.col[6]ans$box.umbrella$col <- can.col[6]ans$superpose.symbol$col <- c(can.col[c(6, 3, 4, 8)],"orange", "darkgreen", "brown")ans$superpose.line$col <- c(can.col[c(6, 3, 4, 8)],"orange", "darkgreen", "brown")}}else {## black and white settingsans$bar.fill$col <- can.col[5]ans$box.dot$col <- can.col[1]ans$box.rectangle$col <- can.col[1]ans$box.umbrella$col <- can.col[1]ans$box.umbrella$lty <- 2ans$dot.line$col <- can.col[4]ans$dot.symbol$col <- can.col[1]ans$dot.symbol$cex <- 0.85ans$plot.line$col <- can.col[1]ans$plot.symbol$col <- can.col[1]## changing this to be like barplot## ans$regions$col <- gray(29:128/128)ans$regions$col <- grey(seq(0.3^2.2, 0.9^2.2, length = 100)^(1/2.2))ans$shade.colors$palette <-function(irr, ref, height, w = .5)grey(w * irr + (1 - w) * (1 - (1-ref)^.4))ans$reference.line$col <- can.col[4]ans$strip.background$col <- can.col[rep(5, 7)]ans$strip.shingle$col <- can.col[rep(6, 7)]ans$superpose.line$col <- can.col[rep(1, 7)]ans$superpose.line$lty <- 1:7ans$superpose.symbol$col <- can.col[rep(1, 7)]ans$superpose.symbol$cex <- rep(0.7, 7)ans$superpose.symbol$pch <- c(1,3,6,0,5,16,17)ans$superpose.fill$col <- grey( (c(6, 12, 7, 11, 8, 10, 9)/15)^.8 )##ans$superpose.symbol$pch <- c("o","+",">","s","w","#","{")}ans}trellis.par.get <-function(name = NULL){## the default device is opened if none already openif (is.null(dev.list())) trellis.device()lattice.theme <- get("lattice.theme", envir = .LatticeEnv)## just in case settings for the current device haven't been## created yet, which may happen if the device is opened by x11(),## say, (i.e., not by trellis.device()) and no trellis object has## been printed on this device yet.if (is.null(lattice.theme[[.Device]])) {trellis.device(device = .Device, new = FALSE)lattice.theme <- get("lattice.theme", envir = .LatticeEnv)}if (is.null(name))lattice.theme[[.Device]]else if (name %in% names(lattice.theme[[.Device]]))lattice.theme[[.Device]][[name]]else NULL}trellis.par.set <-function(name, value, ..., theme, warn = TRUE){## the default device is opened if none already openif (is.null(dev.list())){trellis.device()if (warn)warning("Note: The default device has been opened to honour attempt to modify trellis settings")}## if (name %in% names(lattice.theme[[.Device]])) NEEDED as a safeguard ?## if (!is.list(value)) stop("value must be a list")lattice.theme <- get("lattice.theme", envir = .LatticeEnv)## make sure a list for this device is presentif (is.null(lattice.theme[[.Device]])){trellis.device(device = .Device, new = FALSE)lattice.theme <- get("lattice.theme", envir = .LatticeEnv)}## WAS: lattice.theme[[.Device]][[name]] <- valueif (missing(theme))if (!missing(value)){theme <- list(value)names(theme) <- name}else if (!missing(name) && is.list(name)){theme <- name}else theme <- list(...)lattice.theme[[.Device]] <- updateList(lattice.theme[[.Device]], theme)assign("lattice.theme", lattice.theme, envir=.LatticeEnv)invisible()}trellis.device <-function(device = getOption("device"),color = !(dev.name == "postscript"),theme = lattice.getOption("default.theme"),## bg = NULL,new = TRUE,retain = FALSE,...){## Get device functionif (is.character(device)){if (new || is.null(dev.list())){ # to make sure this works even if package grDevices is not loadeddevice.call <- try(get(device), silent = TRUE)if (inherits(device.call, "try-error"))device.call <-try(utils::getFromNamespace(device, "grDevices"),silent = TRUE)if (inherits(device.call, "try-error"))stop(paste("Could not find device function", device))}dev.name <- device}else{device.call <- devicedev.name <- deparse(substitute(device))}## Start the new device if necessary.## new = FALSE ignored if no devices open.## FIXME: remove this warning in some future versionif ("bg" %in% names(list(...)))warning("trellis.device has changed, 'bg' may not be doing what you think it is")if (new || is.null(dev.list())){device.call(...)lattice.setStatus(print.more = FALSE)}## Make sure there's an entry for this device in the theme listlattice.theme <- get("lattice.theme", envir = .LatticeEnv)if (!(.Device %in% names(lattice.theme))){lattice.theme[[.Device]] <- canonical.theme(name = .Device, color = color)assign("lattice.theme", lattice.theme, envir = .LatticeEnv)}## If retain = FALSE, overwrite with default settings for deviceif (!retain) trellis.par.set(canonical.theme(name=.Device, color=color))## get theme as listif (!is.null(theme) && !is.list(theme)){if (is.character(theme)) theme <- get(theme)if (is.function(theme)) theme <- theme()if (!is.list(theme)){warning("Invalid theme specified")theme <- NULL}}## apply themeif (!is.null(theme)) trellis.par.set(theme)## if (!is.null(bg)) trellis.par.set(list(background = list(col = bg)))return(invisible())}lset <- function(theme = col.whitebg()){.Deprecated("trellis.par.set")trellis.par.set(theme = theme)# for (item in names(theme))# {# foo <- trellis.par.get(item)# bar <- theme[[item]]# foo[names(bar)] <- bar# trellis.par.set(item, foo)# }}show.settings <- function(x = NULL){old.settings <- trellis.par.get()on.exit(trellis.par.set(old.settings))if (!is.null(x)) trellis.par.set(x)theme <- trellis.par.get()n.row <- 13n.col <- 9heights.x <- rep(1, n.row)heights.units <- rep("lines", n.row)heights.units[c(2, 5, 8, 11)] <- "null"widths.x <- rep(1, n.row)widths.units <- rep("lines", n.row)widths.units[c(2, 4, 6, 8)] <- "null"page.layout <-grid.layout(nrow = n.row, ncol = n.col,widths = unit(widths.x, widths.units),heights = unit(heights.x, heights.units))if (!lattice.getStatus("print.more")) grid.newpage()lattice.setStatus(print.more = FALSE)grid.rect(gp = gpar(fill = theme$background$col,col = "transparent"))pushViewport(viewport(layout = page.layout,gp = gpar(fontsize = theme$fontsize$text)))## superpose.symbolsuperpose.symbol <- theme$superpose.symbollen <- max(2, sapply(superpose.symbol, length))pushViewport(viewport(layout.pos.row = 2,layout.pos.col = 2,yscale = c(0,len+1),xscale = c(0,len+1)))panel.superpose(x = rep(1:len, len),y = rep(1:len, each = len),groups = gl(len, len),subscripts = 1:(len*len))popViewport()grid.text(lab = "superpose.symbol",vp = viewport(layout.pos.row = 3, layout.pos.col = 2))## superpose.linesuperpose.line <- theme$superpose.linelen <- max(2, sapply(superpose.line, length))pushViewport(viewport(layout.pos.row = 2,layout.pos.col = 4,yscale = c(0,len+1),xscale = c(0, 1)))panel.superpose(x = rep(c(0,1), len),y = rep(1:len, each = 2),groups = gl(len, 2),subscripts = 1:(2*len),type = "l")popViewport()grid.text(lab = "superpose.line",vp = viewport(layout.pos.row = 3, layout.pos.col = 4))## strip.background## FIXME: strip.border <- theme$strip.border should be usedstrip.background <- theme$strip.backgroundlen <- length(strip.background$col)pushViewport(viewport(layout.pos.row = 2,layout.pos.col = 6,yscale = c(0,len+1),xscale = c(0,1)))for (i in 1:len) {grid.rect(y = unit(i, "native"), height = unit(.5, "native"),gp = gpar(fill = strip.background$col[i]))}popViewport()grid.text(lab = "strip.background",vp = viewport(layout.pos.row = 3, layout.pos.col = 6))## strip.shinglestrip.shingle <- theme$strip.shinglelen <- length(strip.shingle$col)pushViewport(viewport(layout.pos.row = 2,layout.pos.col = 8,yscale = c(0,len+1),xscale = c(0,1)))for (i in 1:len) {grid.rect(y = unit(i, "native"), height = unit(.5, "native"),gp = gpar(fill = strip.shingle$col[i]))}popViewport()grid.text(lab = "strip.shingle",vp = viewport(layout.pos.row = 3, layout.pos.col = 8))## dot.[symbol, line]pushViewport(viewport(layout.pos.row = 5,layout.pos.col = 2,yscale = extend.limits(c(0,6)),xscale = c(0,6)))panel.dotplot(x = 1:5, y = 1:5)grid.rect() ## FIXME: gpar's for these?popViewport()grid.text(lab = "dot.[symbol, line]",vp = viewport(layout.pos.row = 6, layout.pos.col = 2))## box.[dot, rectangle, umbrella]pushViewport(viewport(layout.pos.row = 5,layout.pos.col = 4,yscale = c(-2, 2),xscale = c(0,6)))panel.bwplot(x = 1:5, y = rep(0, 5))grid.rect()popViewport()grid.text(lab = "box.[dot, rectangle, umbrella]",vp = viewport(layout.pos.row = 6, layout.pos.col = 4))## add.[line, text]add.text <- theme$add.textadd.line <- theme$add.linepushViewport(viewport(layout.pos.row = 5,layout.pos.col = 6,yscale = c(-1,1),xscale = c(0,1)))x <- seq(.1, .9, length = 50)y <- .9 * sin(.1+11*x)llines(x = x, y = y, type = "l", col = add.line$col,lty = add.line$lty, lwd = add.line$lwd)ltext(lab = c("Hello", "World"),x = c(.25, .75), y = c(-.5, .5))grid.rect()popViewport()grid.text(lab = "add.[line, text]",vp = viewport(layout.pos.row = 6, layout.pos.col = 6))## reference.linepushViewport(viewport(layout.pos.row = 5,layout.pos.col = 8,yscale = c(0,4),xscale = c(0,4)))panel.grid()grid.rect()popViewport()grid.text(lab = "reference.line",vp = viewport(layout.pos.row = 6, layout.pos.col = 8))## plot.[symbol, line]plot.symbol <- theme$plot.symbolplot.line <- theme$plot.linepushViewport(viewport(layout.pos.row = 8,layout.pos.col = 2,yscale = c(-1.1,1.1),xscale = c(-.1,1.1)))x <- seq(.1, .9, length = 20)y <- .9 * sin(.1+11*x)panel.xyplot(x = x+.05, y = y+.1, type = "l")panel.xyplot(x = x-.05, y = y-.1)grid.rect()popViewport()grid.text(lab = "plot.[symbol, line]",vp = viewport(layout.pos.row = 9, layout.pos.col = 2))## plot.shingle[bar.fill]bar.fill <- theme$bar.fillpushViewport(viewport(layout.pos.row = 8,layout.pos.col = 4,yscale = extend.limits(c(0,6)),xscale = extend.limits(c(1,10))))grid.rect(x = c(3.5, 4.5, 5.5, 6.5, 7.5), w = rep(5,5),y = c(1,2,3,4,5), height = rep(.5, ,5),default.units = "native",gp =gpar(fill = bar.fill$col,col = bar.fill$border,alpha = bar.fill$alpha,lty = bar.fill$lty,lwd = bar.fill$lwd))grid.rect()popViewport()grid.text(lab = "plot.shingle[bar.fill]",vp = viewport(layout.pos.row = 9, layout.pos.col = 4))## histogram[bar.fill]pushViewport(viewport(layout.pos.row = 8,layout.pos.col = 6,yscale = extend.limits(c(0,7)),xscale = extend.limits(c(0.5,7.5))))panel.histogram(x = rep(1:7, 1:7), breaks = 0:7 + 0.5, type = "count")grid.rect()popViewport()grid.text(lab = "histogram[bar.fill]",vp = viewport(layout.pos.row = 9, layout.pos.col = 6))## barchart[bar.fill]pushViewport(viewport(layout.pos.row = 8,layout.pos.col = 8,yscale = extend.limits(c(0.5,6.5)),xscale = c(-1,7)))panel.barchart(x = 6:1, y = 1:6)grid.rect()popViewport()grid.text(lab = "barchart[bar.fill]",vp = viewport(layout.pos.row = 9, layout.pos.col = 8))## superpose.fillsuperpose.fill <- trellis.par.get("superpose.fill")len <- max(2, sapply(superpose.fill, length))pushViewport(viewport(layout.pos.row = 11,layout.pos.col = 2,yscale = extend.limits(c(-.45, .45)),xscale = c(-1, len+1)))panel.barchart(x = len:1, y = rep(0, len),groups = gl(len, 1),subscripts = 1:len,stack = FALSE)grid.rect()popViewport()grid.text(lab = "superpose.fill",vp = viewport(layout.pos.row = 12, layout.pos.col = 2))## regionsregions <- theme$regionslen <- length(regions$col)pushViewport(viewport(layout.pos.row = 11,layout.pos.col = 4,xscale = c(0,len+1)))for (i in 1:len)grid.rect(x = i, w = 1, default.units = "native",gp = gpar(col = NULL, fill = regions$col[i]))grid.rect()popViewport()grid.text(lab = "regions",vp = viewport(layout.pos.row = 12, layout.pos.col = 4))invisible()}## non-graphical options and layout defaults (in terms of grid units)lattice.getOption <- function(name){get("lattice.options", envir = .LatticeEnv)[[name]]}## FIXME: lattice.options(foo == 1) doesn't work?lattice.options <- function(...){## this would have been really simple if only form allowed were## lattice.options("foo", "bar") and## lattice.options(foo=1, bar=2). But it could also be## lattice.options(foo=1, "bar"), which makes some juggling necessarynew <- list(...)if (is.null(names(new)) && length(new) == 1 && is.list(new[[1]])) new <- new[[1]]old <- .LatticeEnv$lattice.options## any reason to prefer get("lattice.options", envir = .LatticeEnv)?## if no args supplied, returns full options listif (length(new) == 0) return(old)nm <- names(new)if (is.null(nm)) return(old[unlist(new)]) ## typically getting opions, not settingisNamed <- nm != "" ## typically all named when setting, but could have mixif (any(!isNamed)) nm[!isNamed] <- unlist(new[!isNamed])## so now everything has non-"" names, but only the isNamed ones should be set## everything should be returned, howeverretVal <- old[nm]names(retVal) <- nmnm <- nm[isNamed]## this used to be## modified <- updateList(retVal[nm], new[nm])## .LatticeEnv$lattice.options[names(modified)] <- modified## but then calling lattice.options(foo = NULL) had no effect## because foo would be missing from modified. So, we now do:.LatticeEnv$lattice.options <- updateList(old, new[nm])## return changed entries invisiblyinvisible(retVal)}.defaultLatticeOptions <- function()list(save.object = TRUE,drop.unused.levels = list(cond = TRUE, data = TRUE),default.theme = getOption("lattice.theme"), ## for back compatibility, usually NULLbanking = banking,default.args =list(as.table = FALSE,aspect = "fill",between = list(x=0, y=0),##page = NULL,##main = NULL,##sub = NULL,##par.strip.text = NULL,##layout = NULL,skip = FALSE,strip = strip.default),axis.padding = list(numeric = 0.07, factor = 0.6),## extends limits by this amount, to provide padding for## numeric and factor scales respectively. Note that the## value for numeric is multiplicative, while factor is## additiveskip.boundary.labels = 0.02,## ticks too close to the limits will not be drawn unless## explicitly requested. Limits will be imploded by this## proportion, and anything outside will be skipped.axis.units =list(outer =list(left =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")),top =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")),right =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")),bottom =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm"))),inner =list(left =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")),top =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")),right =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")),bottom =list(tick = list(x = 2, units = "mm"),pad1 = list(x = 2, units = "mm"),pad2 = list(x = 2, units = "mm")))),## axis.units =## list(outer =## list(left =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")),## top =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")),## right =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")),## bottom =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc"))),## inner =## list(left =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")),## top =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")),## right =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")),## bottom =## list(tick = list(x = 0.01, units = "snpc"),## pad1 = list(x = 0.01, units = "snpc"),## pad2 = list(x = 0.01, units = "snpc")))),layout.heights =## list(top.padding = list(x = 2, units = "mm", data = NULL),## main = list(x = 0, units = "grobheight", data = textGrob(lab="")),## main.key.padding = list(x = 2, units = "mm", data = NULL),## key.top = list(x = 0, units = "grobheight", data = textGrob(lab="")),## key.axis.padding = list(x = 2, units = "mm", data = NULL),## axis.top = list(x = 0, units = "mm", data = NULL),## strip = list(x = 1, units = "lines", data = NULL),## panel = list(x = 1, units = "null", data = NULL),## axis.panel = list(x = 0, units = "mm", data = NULL),## between = list(x = 5, units = "mm", data = NULL),## axis.bottom = list(x = 0, units = "mm", data = NULL),## axis.xlab.padding = list(x = 2, units = "mm", data = NULL),## xlab = list(x = 0, units = "grobheight", data = textGrob(lab="")),## xlab.key.padding = list(x = 2, units = "mm", data = NULL),## key.bottom = list(x = 0, units = "grobheight", data = textGrob(lab="")),## key.sub.padding = list(x = 2, units = "mm", data = NULL),## sub = list(x = 0, units = "grobheight", data = textGrob(lab="")),## bottom.padding = list(x = 2, units = "mm", data = NULL)),## layout.widths =## list(left.padding = list(x = 2, units = "mm", data = NULL),## key.left = list(x = 0, units = "grobwidth", data = textGrob(lab="")),## key.ylab.padding = list(x = 2, units = "mm", data = NULL),## ## changed in 2.1.0## ylab = list(x = 0, units = "grobwidth", data = textGrob(lab="")),## ylab.axis.padding = list(x = 2, units = "mm", data = NULL),## axis.left = list(x = 0, units = "mm", data = NULL),## axis.panel = list(x = 0, units = "mm", data = NULL),## panel = list(x = 1, units = "null", data = NULL),## between = list(x = 5, units = "mm", data = NULL),## axis.right = list(x = 0, units = "mm", data = NULL),## axis.key.padding = list(x = 2, units = "mm", data = NULL),## key.right = list(x = 0, units = "grobwidth", data = textGrob(lab="")),## right.padding = list(x = 2, units = "mm", data = NULL)),list(top.padding = list(x = 0.01, units = "snpc", data = NULL),main = list(x = 0, units = "grobheight", data = textGrob(lab="")),main.key.padding = list(x = 0.01, units = "snpc", data = NULL),key.top = list(x = 0, units = "grobheight", data = textGrob(lab="")),key.axis.padding = list(x = 0.01, units = "snpc", data = NULL),axis.top = list(x = 0, units = "mm", data = NULL),strip = list(x = 1, units = "lines", data = NULL),panel = list(x = 1, units = "null", data = NULL),axis.panel = list(x = 0, units = "mm", data = NULL),between = list(x = 5, units = "mm", data = NULL),axis.bottom = list(x = 0, units = "mm", data = NULL),axis.xlab.padding = list(x = 0.01, units = "snpc", data = NULL),xlab = list(x = 0, units = "grobheight", data = textGrob(lab="")),xlab.key.padding = list(x = 0.01, units = "snpc", data = NULL),key.bottom = list(x = 0, units = "grobheight", data = textGrob(lab="")),key.sub.padding = list(x = 0.01, units = "snpc", data = NULL),sub = list(x = 0, units = "grobheight", data = textGrob(lab="")),bottom.padding = list(x = 0.01, units = "snpc", data = NULL)),layout.widths =list(left.padding = list(x = 0.01, units = "snpc", data = NULL),key.left = list(x = 0, units = "grobwidth", data = textGrob(lab="")),key.ylab.padding = list(x = 0.01, units = "snpc", data = NULL),ylab = list(x = 0, units = "grobwidth", data = textGrob(lab="")),ylab.axis.padding = list(x = 0.01, units = "snpc", data = NULL),axis.left = list(x = 0, units = "mm", data = NULL),axis.panel = list(x = 0, units = "mm", data = NULL),panel = list(x = 1, units = "null", data = NULL),between = list(x = 5, units = "mm", data = NULL),axis.right = list(x = 0, units = "mm", data = NULL),axis.key.padding = list(x = 0.01, units = "snpc", data = NULL),key.right = list(x = 0, units = "grobwidth", data = textGrob(lab="")),right.padding = list(x = 0.01, units = "snpc", data = NULL)),highlight.gpar = list(col = "red", lwd = 2))lattice.getStatus <- function(name)get("lattice.status", envir = .LatticeEnv)[[name]]lattice.setStatus <- function (...){dots <- list(...)if (is.null(names(dots)) && length(dots) == 1 && is.list(dots[[1]]))dots <- dots[[1]]if (length(dots) == 0)return()lattice.status <- get("lattice.status", envir = .LatticeEnv)lattice.status[names(dots)] <- dotsassign("lattice.status", lattice.status, env = .LatticeEnv)}.defaultLatticeStatus <- function()list(print.more = FALSE,current.plot.saved = FALSE,current.plot.multipage = FALSE,current.focus.row = 0,current.focus.column = 0,vp.highlighted = FALSE,plot.index = 1) ## keeps track of multiple plots in a page