The R Project SVN
R-packages
(root)/trunk/lattice/R/legend.R – Rev 5315
Rev 5310 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
### Copyright (C) 2001-2006 Deepayan Sarkar <Deepayan.Sarkar@R-project.org>###### This file is part of the lattice package 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., 51 Franklin Street, Fifth Floor, Boston,### MA 02110-1301, USAconstruct.legend <-function(legend = NULL, key = NULL, fun = "draw.key"){if (is.null(legend) && is.null(key)) return(NULL)if (is.null(legend)) legend <- list()if (!is.null(key)){space <- key$spacex <- y <- corner <- NULLif (is.null(space)){if (any(c("x", "y", "corner") %in% names(key))){stopifnot(is.null(x) || (length(x) == 1 && x >= 0 && x <= 1))stopifnot(is.null(y) || (length(y) == 1 && y >= 0 && y <= 1))stopifnot(is.null(corner) ||(length(corner) == 2 &&all(corner %in% c(0, 1))))space <- "inside"x <- key$xy <- key$ycorner <- key$corner## check for valid values}elsespace <- "top"}if (space != "inside" && space %in% names(legend))stop(gettextf("component '%s' duplicated in key and legend", space))key.legend <- list(fun = fun, args = list(key = key, draw = FALSE))key.legend$x <- xkey.legend$y <- ykey.legend$corner <- cornerlegend <- c(list(key.legend), legend)names(legend)[1] <- space}legend}# convenience function for auto.keydrawSimpleKey <- function(...)draw.key(simpleKey(...), draw = FALSE)# convenience function for the most common type of keysimpleKey <-function(text, points = TRUE,rectangles = FALSE,lines = FALSE,col = add.text$col,cex = add.text$cex,alpha = add.text$alpha,font = add.text$font,fontface = add.text$fontface,fontfamily = add.text$fontfamily,lineheight = add.text$lineheight,...){add.text <- trellis.par.get("add.text")foo <- seq_along(text)ans <-list(text = list(lab = text),col = col, cex = cex, alpha = alpha,font = font,fontface = fontface,fontfamily = fontfamily,...)if (points) ans$points <-Rows(trellis.par.get("superpose.symbol"), foo)if (rectangles) ans$rectangles <-Rows(trellis.par.get("superpose.polygon"), foo)if (lines) ans$lines <-updateList(Rows(trellis.par.get("superpose.symbol"), foo), ## for pchRows(trellis.par.get("superpose.line"), foo))ans}draw.key <- function(key, draw = FALSE, vp = NULL, ...){if (!is.list(key)) stop("key must be a list")max.length <- 0## maximum of the `row-lengths' of the above## components. There is some scope for confusion## here, e.g., if col is specified in key as a## length 6 vector, and then lines=list(lty=1:3),## what should be the length of that lines column ?## If 3, what happens if lines=list() ?## (Strangely enough, S+ accepts lines=list()## if col (etc) is NOT specified outside, but not## if it is)process.key <-function(align = TRUE,title = NULL,rep = TRUE,background = trellis.par.get("background")$col,alpha.background = 1,border = FALSE,transparent = FALSE,divide = 3,col = "black",alpha = 1,lty = 1,lwd = 1,font = 1,pch = 8,fill = "transparent",adj = 0,type = "l",size = 5,angle = 0,density = -1,...,reverse.rows = FALSE, ## invert rows (e.g. for barchart, stack = FALSE)between = 2,between.columns = 3,columns = 1,cex = 1,cex.title = 1.5 * max(cex),lines.title = 2,padding.text = 1,lineheight = 1,fontface = NULL,fontfamily = NULL){list(reverse.rows = reverse.rows,between = between,align = align,title = title,rep = rep,background = background,alpha.background = alpha.background,border = border,transparent = transparent,columns = columns,divide = divide,between.columns = between.columns,cex = cex,cex.title = cex.title,lines.title = lines.title,padding.text = padding.text,col = col,alpha = alpha,lty = lty,lwd = lwd,lineheight = lineheight,font = font,fontface = fontface,fontfamily = fontfamily,pch = pch,adj = adj,type = type,size = size,angle = angle,density = density,...)}fontsize.points <- trellis.par.get("fontsize")$pointskey <- do.call("process.key", key)key.length <- length(key)key.names <- names(key) # Need to updateif (is.logical(key$border))key$border <-if (key$border) "black"else "transparent"components <- list()for(i in 1:key.length){curname <- pmatch(key.names[i], c("text", "rectangles", "lines", "points"))if (is.na(curname)){;## do nothing}else if (curname == 1) # "text"{if (!(is.characterOrExpression(key[[i]][[1]])))stop("first component of text has to be vector of labels")pars <-list(labels = key[[i]][[1]],col = key$col,alpha = key$alpha,adj = key$adj,cex = key$cex,lineheight = key$lineheight,font = key$font,fontface = key$fontface,fontfamily = key$fontfamily)key[[i]][[1]] <- NULLpars[names(key[[i]])] <- key[[i]]tmplen <- length(pars$labels)for (j in 1:length(pars))if (is.character(pars))pars[[j]] <- rep(pars[[j]], length.out = tmplen)max.length <- max(max.length, tmplen)components[[length(components)+1]] <-list(type = "text", pars = pars, length = tmplen)}else if (curname == 2) # "rectangles"{pars <-list(col = key$col,border = "black",alpha = key$alpha,size = key$size,angle = key$angle,density = key$density)pars[names(key[[i]])] <- key[[i]]tmplen <- max(unlist(lapply(pars,length)))max.length <- max(max.length, tmplen)components[[length(components)+1]] <-list(type = "rectangles", pars = pars, length = tmplen)}else if (curname == 3) # "lines"{pars <-list(col = key$col,alpha = key$alpha,size = key$size,lty = key$lty,cex = key$cex,pch = key$pch,fill = key$fill,lwd = key$lwd,type = key$type)pars[names(key[[i]])] <- key[[i]]tmplen <- max(unlist(lapply(pars,length)))max.length <- max(max.length, tmplen)components[[length(components)+1]] <-list(type = "lines", pars = pars, length = tmplen)}else if (curname == 4) # "points"{pars <- list(col = key$col,alpha = key$alpha,cex = key$cex,pch = key$pch,fill = key$fill,font = key$font,fontface = key$fontface,fontfamily = key$fontfamily)pars[names(key[[i]])] <- key[[i]]tmplen <- max(unlist(lapply(pars,length)))max.length <- max(max.length, tmplen)components[[length(components)+1]] <-list(type = "points", pars = pars, length = tmplen)}}number.of.components <- length(components)## number of components named one of "text",## "lines", "rectangles" or "points"if (number.of.components == 0)stop("Invalid key, need at least one component named lines, text, rect or points")## The next part makes sure all components have same length,## except text, which should be as long as the number of labels## Update (9/11/2003): but that doesn't always make sense --- Re:## r-help message from Alexander.Herr@csiro.au (though it seems## that's S+ behaviour on Linux at least). Each component should## be allowed to have its own length (that's what the lattice docs## suggest too, don't know why). Anyway, I'm adding a rep = TRUE## argument to the key list, which controls whether each column## will be repeated as necessary to have the same length.for (i in seq_len(number.of.components)){if (key$rep && (components[[i]]$type != "text"))components[[i]]$length <- max.lengthcomponents[[i]]$pars <-lapply(components[[i]]$pars, rep, length.out = components[[i]]$length)if (key$reverse.rows)components[[i]]$pars <-lapply(components[[i]]$pars, rev)## {## if (key$rep) components[[i]]$length <- max.length## components[[i]]$pars <-## lapply(components[[i]]$pars, rep, components[[i]]$length)## }## else## {## components[[i]]$pars <-## c(components[[i]]$pars[1],## lapply(components[[i]]$pars[-1], rep,## length.out = components[[i]]$length))## }}column.blocks <- key$columnsrows.per.block <- ceiling(max.length/column.blocks)if (column.blocks > max.length) warning("not enough rows for columns")key$between <- rep(key$between, length.out = number.of.components)if (key$align){## Setting up the layout## The problem of allocating space for text (character strings## or expressions) is dealt with as follows:## Each row and column will take exactly as much space as## necessary. As steps in the construction, a matrix## textMatrix (of same dimensions as the layout) will contain## either 0, meaning that entry is not text, or n > 0, meaning## that entry has the text given by textList[[n]], where## textList is a list consisting of character strings or## expressions.n.row <- rows.per.block + 1n.col <- column.blocks * (1 + 3 * number.of.components) - 1textMatrix <- matrix(0, n.row, n.col)textList <- list()textCex <- numeric(0)heights.x <- rep(1, n.row)heights.units <- rep("lines", n.row)heights.data <- vector(mode = "list", length = n.row)if (length(key$title) > 0){stopifnot(length(key$title) == 1,is.characterOrExpression(key$title))heights.x[1] <- key$lines.title * key$cex.titleheights.units[1] <- "strheight"heights.data[[1]] <- key$title}else heights.x[1] <- 0widths.x <- rep(key$between.column, n.col)widths.units <- rep("strwidth", n.col)widths.data <- as.list(rep("o", n.col))for (i in 1:column.blocks){widths.x[(1:number.of.components-1)*3+1 +(i-1)*3*number.of.components + i-1] <-key$between/2widths.x[(1:number.of.components-1)*3+1 +(i-1)*3*number.of.components + i+1] <-key$between/2}index <- 1for (i in 1:number.of.components){cur <- components[[i]]id <- (1:column.blocks - 1) *(number.of.components * 3 + 1) + i * 3 - 1if (cur$type == "text"){for (j in 1:cur$length){colblck <- ceiling(j / rows.per.block)xx <- (colblck - 1) *(number.of.components * 3 + 1) + i * 3 - 1yy <- j %% rows.per.block + 1if (yy == 1) yy <- rows.per.block + 1textMatrix[yy, xx] <- indextextList <- c(textList, list(cur$pars$labels[j]) )textCex <- c(textCex, cur$pars$cex[j])index <- index + 1}} ## FIXME: do the same as above for those belowelse if (cur$type == "rectangles"){widths.x[id] <- max(cur$pars$size)}else if (cur$type == "lines"){widths.x[id] <- max(cur$pars$size)}else if (cur$type == "points"){widths.x[id] <- max(cur$pars$cex)}}## Need to adjust the heights and widths## adjusting heightsheights.insertlist.position <- 0heights.insertlist.unit <- unit(1, "null")for (i in seq_len(n.row)){textLocations <- textMatrix[i,]if (any(textLocations > 0)){textLocations <- textLocations[textLocations>0]strbar <- textList[textLocations]heights.insertlist.position <- c(heights.insertlist.position, i)heights.insertlist.unit <-unit.c(heights.insertlist.unit,unit(.2 * key$padding.text, "lines") +max(unit(textCex[textLocations], "strheight", strbar)))}}layout.heights <- unit(heights.x, heights.units, data=heights.data)if (length(heights.insertlist.position)>1)for (indx in 2:length(heights.insertlist.position))layout.heights <-rearrangeUnit(layout.heights, heights.insertlist.position[indx],heights.insertlist.unit[indx])## adjusting widthswidths.insertlist.position <- 0widths.insertlist.unit <- unit(1, "null")for (i in 1:n.col){textLocations <- textMatrix[,i]if (any(textLocations > 0)){textLocations <- textLocations[textLocations>0]strbar <- textList[textLocations]widths.insertlist.position <- c(widths.insertlist.position, i)widths.insertlist.unit <-unit.c(widths.insertlist.unit,max(unit(textCex[textLocations], "strwidth", strbar)))}}layout.widths <- unit(widths.x, widths.units, data=widths.data)if (length(widths.insertlist.position)>1)for (indx in 2:length(widths.insertlist.position))layout.widths <-rearrangeUnit(layout.widths, widths.insertlist.position[indx],widths.insertlist.unit[indx])key.layout <-grid.layout(nrow = n.row, ncol = n.col,widths = layout.widths,heights = layout.heights,respect = FALSE)## OK, layout set up, now to draw the key - nokey.gf <- frameGrob(layout = key.layout, vp = vp)if (!key$transparent)key.gf <-placeGrob(key.gf,rectGrob(gp =gpar(fill = key$background,alpha = key$alpha.background,col = key$border)),row = NULL, col = NULL)elsekey.gf <-placeGrob(key.gf,rectGrob(gp=gpar(col=key$border)),row = NULL, col = NULL)## Title (FIXME: allow color, font, alpha-transparency here?if (!is.null(key$title))key.gf <-placeGrob(key.gf,textGrob(label = key$title,gp = gpar(cex = key$cex.title, lineheight = key$lineheight)),row = 1, col = NULL)for (i in 1:number.of.components){cur <- components[[i]]for (j in 1:cur$length){colblck <- ceiling(j / rows.per.block)xx <- (colblck - 1) *(number.of.components*3 + 1) + i*3 - 1yy <- j %% rows.per.block + 1if (yy == 1) yy <- rows.per.block + 1if (cur$type == "text"){key.gf <-placeGrob(key.gf,textGrob(x = cur$pars$adj[j],hjust = cur$pars$adj[j],## just = c(## if (cur$pars$adj[j] == 1) "right"## else if (cur$pars$adj[j] == 0) "left"## else "center",## "center"),label = cur$pars$labels[j],gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],lineheight = cur$pars$lineheight[j],fontfamily = cur$pars$fontfamily[j],fontface = chooseFace(cur$pars$fontface[j], cur$pars$font[j]),cex = cur$pars$cex[j])),row = yy, col = xx)}else if (cur$type == "rectangles"){key.gf <-placeGrob(key.gf,rectGrob(width = cur$pars$size[j] / max(cur$pars$size),## centred, unlike S-PLUS, due to aesthetic reasons !gp = gpar(alpha = cur$pars$alpha[j],fill = cur$pars$col[j],col = cur$pars$border[j])),row = yy, col = xx)## FIXME: Need to make changes to support angle/density}else if (cur$type == "lines"){if (cur$pars$type[j] == "l"){key.gf <-placeGrob(key.gf,linesGrob(x = c(0,1) * cur$pars$size[j]/max(cur$pars$size),## ^^ FIXME: this## should be centered## as well, but since## the chances that## someone would## actually use this## feature are## astronomical, I'm## leaving that for## later.y = c(.5, .5),gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],lty = cur$pars$lty[j],lwd = cur$pars$lwd[j])),row = yy, col = xx)}else if (cur$pars$type[j] == "p"){key.gf <-placeGrob(key.gf,pointsGrob(x=.5, y=.5,gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],cex = cur$pars$cex[j],fill = cur$pars$fill[j],fontfamily = cur$pars$fontfamily[j],fontface = chooseFace(cur$pars$fontface[j], cur$pars$font[j]),fontsize = fontsize.points),pch = cur$pars$pch[j]),row = yy, col = xx)}else # if (cur$pars$type[j] == "b" or "o") -- not differentiating{key.gf <-placeGrob(key.gf,linesGrob(x = c(0,1) * cur$pars$size[j]/max(cur$pars$size),## ^^ this should be## centered as well,## but since the## chances that## someone would## actually use this## feature are## astronomical, I'm## leaving that for## later.y = c(.5, .5),gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],lty = cur$pars$lty[j],lwd = cur$pars$lwd[j])),row = yy, col = xx)if (key$divide > 1){key.gf <-placeGrob(key.gf,pointsGrob(x = (1:key$divide-1)/(key$divide-1),y = rep(.5, key$divide),gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],cex = cur$pars$cex[j],fill = cur$pars$fill[j],fontfamily = cur$pars$fontfamily[j],fontface = chooseFace(cur$pars$fontface[j], cur$pars$font[j]),fontsize = fontsize.points),pch = cur$pars$pch[j]),row = yy, col = xx)}else if (key$divide == 1){key.gf <-placeGrob(key.gf,pointsGrob(x = 0.5,y = 0.5,gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],cex = cur$pars$cex[j],fill = cur$pars$fill[j],fontfamily = cur$pars$fontfamily[j],fontface = chooseFace(cur$pars$fontface[j], cur$pars$font[j]),fontsize = fontsize.points),pch = cur$pars$pch[j]),row = yy, col = xx)}}}else if (cur$type == "points"){key.gf <-placeGrob(key.gf,pointsGrob(x=.5, y=.5,gp =gpar(col = cur$pars$col[j],alpha = cur$pars$alpha[j],cex = cur$pars$cex[j],fill = cur$pars$fill[j],fontfamily = cur$pars$fontfamily[j],fontface = chooseFace(cur$pars$fontface[j], cur$pars$font[j]),fontsize = fontsize.points),pch = cur$pars$pch[j]),row = yy, col = xx)}}}}else stop("sorry, align=F not supported (yet ?)")if (draw) grid.draw(key.gf)key.gf}draw.colorkey <- function(key, draw = FALSE, vp = NULL){if (!is.list(key)) stop("key must be a list")process.key <-function(col = regions$col,alpha = regions$alpha,at,tick.number = 7,width = 2,height = 1,space = "right",...){regions <- trellis.par.get("regions")list(col = col,alpha = alpha,at = at,tick.number = tick.number,width = width,height = height,space = space,...)}axis.line <- trellis.par.get("axis.line")axis.text <- trellis.par.get("axis.text")key <- do.call("process.key", key)## FIXME: delete later#str(key)## made FALSE later if labels explicitly specifiedcheck.overlap <- TRUE## Note: there are two 'at'-s here, one is key$at, which specifies## the breakpoints of the rectangles, and the other is key$lab$at## (optional) which is the positions of the ticks. We will use the## 'at' variable for the latter, 'atrange' for the range of the## former, and keyat explicitly when needed## Getting the locations/dimensions/centers of the rectangleskey$at <- sort(key$at) ## should check if orderednumcol <- length(key$at)-1## numcol.r <- length(key$col)## key$col <-## if (is.function(key$col)) key$col(numcol)## else if (numcol.r <= numcol) rep(key$col, length.out = numcol)## else key$col[floor(1+(1:numcol-1)*(numcol.r-1)/(numcol-1))]key$col <-level.colors(x = seq_len(numcol) - 0.5,at = seq_len(numcol + 1) - 1,col.regions = key$col,colors = TRUE)## FIXME: need to handle DateTime classes properlyatrange <- range(key$at, finite = TRUE)scat <- as.numeric(key$at) ## problems otherwise with DateTime objects (?)## recnum <- length(scat)-1reccentre <- (scat[-1] + scat[-length(scat)]) / 2recdim <- diff(scat)cex <- axis.text$cexcol <- axis.text$colfont <- axis.text$fontfontfamily <- axis.text$fontfamilyfontface <- axis.text$fontfacerot <- 0if (is.null(key$lab)){at <- lpretty(atrange, key$tick.number)at <- at[at >= atrange[1] & at <= atrange[2]]labels <- format(at, trim = TRUE)}else if (is.characterOrExpression(key$lab) && length(key$lab)==length(key$at)){check.overlap <- FALSEat <- key$atlabels <- key$lab}else if (is.list(key$lab)){at <- if (!is.null(key$lab$at)) key$lab$at else lpretty(atrange, key$tick.number)at <- at[at >= atrange[1] & at <= atrange[2]]labels <- if (!is.null(key$lab$lab)) {check.overlap <- FALSEkey$lab$lab} else format(at, trim = TRUE)if (!is.null(key$lab$cex)) cex <- key$lab$cexif (!is.null(key$lab$col)) col <- key$lab$colif (!is.null(key$lab$font)) font <- key$lab$fontif (!is.null(key$lab$fontface)) fontface <- key$lab$fontfaceif (!is.null(key$lab$fontfamily)) fontfamily <- key$lab$fontfamilyif (!is.null(key$lab$rot)) rot <- key$lab$rot}else stop("malformed colorkey")labscat <- atif (key$space == "right") {labelsGrob <-textGrob(label = labels,x = rep(0, length(labscat)),y = labscat,vp = viewport(yscale = atrange),default.units = "native",check.overlap = check.overlap,just = if (rot == -90) c("center", "bottom") else c("left", "center"),rot = rot,gp =gpar(col = col,cex = cex,fontfamily = fontfamily,fontface = chooseFace(fontface, font)))heights.x <- c((1 - key$height) / 2, key$height, (1 - key$height) / 2)heights.units <- rep("null", 3)widths.x <- c(.6 * key$width, .6, 1)widths.units <- c("lines", "lines", "grobwidth")widths.data <- list(NULL, NULL, labelsGrob)key.layout <-grid.layout(nrow = 3, ncol = 3,heights = unit(heights.x, heights.units),widths = unit(widths.x, widths.units, data = widths.data),respect = TRUE)key.gf <- frameGrob(layout = key.layout, vp = vp)key.gf <- placeGrob(key.gf,rectGrob(x = rep(.5, length(reccentre)),y = reccentre,default.units = "native",vp = viewport(yscale = atrange),height = recdim,gp =gpar(fill = key$col,col = "transparent",alpha = key$alpha)),row = 2, col = 1)key.gf <- placeGrob(frame = key.gf,rectGrob(gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd,alpha = axis.line$alpha,fill = "transparent")),row = 2, col = 1)key.gf <- placeGrob(frame = key.gf,segmentsGrob(x0 = rep(0, length(labscat)),y0 = labscat,x1 = rep(.4, length(labscat)),y1 = labscat,vp = viewport(yscale = atrange),default.units = "native",gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd)),row = 2, col = 2)key.gf <- placeGrob(key.gf,labelsGrob,row = 2, col = 3)# key.gf <- placeGrob(key.gf,# rectGrob(),# row = 2, col = 3)}else if (key$space == "left") {labelsGrob <-textGrob(label = labels,x = rep(1, length(labscat)),y = labscat,vp = viewport(yscale = atrange),default.units = "native",check.overlap = check.overlap,just = if (rot == 90) c("center", "bottom") else c("right", "center"),rot = rot,gp =gpar(col = col,cex = cex,fontfamily = fontfamily,fontface = chooseFace(fontface, font)))heights.x <- c((1 - key$height) / 2, key$height, (1 - key$height) / 2)heights.units <- rep("null", 3)widths.x <- c(1, .6, .6 * key$width)widths.units <- c("grobwidth", "lines", "lines")widths.data <- list(labelsGrob, NULL, NULL)key.layout <-grid.layout(nrow = 3, ncol = 3,heights = unit(heights.x, heights.units),widths = unit(widths.x, widths.units, data = widths.data),respect = TRUE)key.gf <- frameGrob(layout = key.layout, vp = vp)key.gf <- placeGrob(key.gf,rectGrob(x = rep(.5, length(reccentre)),y = reccentre,default.units = "native",vp = viewport(yscale = atrange),height = recdim,gp =gpar(fill = key$col,col = "transparent",alpha = key$alpha)),row = 2, col = 3)key.gf <- placeGrob(frame = key.gf,rectGrob(gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd,alpha = axis.line$alpha,fill = "transparent")),row = 2, col = 3)key.gf <- placeGrob(frame = key.gf,segmentsGrob(x0 = rep(1, length(labscat)),y0 = labscat,x1 = rep(.6, length(labscat)),y1 = labscat,vp = viewport(yscale = atrange),default.units = "native",gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd)),row = 2, col = 2)key.gf <- placeGrob(key.gf,labelsGrob,row = 2, col = 1)}else if (key$space == "top") {labelsGrob <-textGrob(label = labels,y = rep(0, length(labscat)),x = labscat,vp = viewport(xscale = atrange),default.units = "native",check.overlap = check.overlap,just = if (rot == 0) c("center","bottom") else c("left", "center"),rot = rot,gp =gpar(col = col,cex = cex,fontfamily = fontfamily,fontface = chooseFace(fontface, font)))widths.x <- c((1 - key$height) / 2, key$height, (1 - key$height) / 2)widths.units <- rep("null", 3)heights.x <- c(1, .6, .6 * key$width)heights.units <- c("grobheight", "lines", "lines")heights.data <- list(labelsGrob, NULL, NULL)key.layout <-grid.layout(nrow = 3, ncol = 3,heights = unit(heights.x, heights.units, data = heights.data),widths = unit(widths.x, widths.units),respect = TRUE)key.gf <- frameGrob(layout = key.layout, vp = vp)key.gf <- placeGrob(key.gf,rectGrob(y = rep(.5, length(reccentre)),x = reccentre,default.units = "native",vp = viewport(xscale = atrange),width = recdim,gp =gpar(fill = key$col,col = "transparent",alpha = key$alpha)),row = 3, col = 2)key.gf <- placeGrob(frame = key.gf,rectGrob(gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd,alpha = axis.line$alpha,fill = "transparent")),row = 3, col = 2)key.gf <- placeGrob(frame = key.gf,segmentsGrob(y0 = rep(0, length(labscat)),x0 = labscat,y1 = rep(.4, length(labscat)),x1 = labscat,vp = viewport(xscale = atrange),default.units = "native",gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd)),row = 2, col = 2)key.gf <- placeGrob(key.gf,labelsGrob,row = 1, col = 2)}else if (key$space == "bottom") {labelsGrob <-textGrob(label = labels,y = rep(1, length(labscat)),x = labscat,vp = viewport(xscale = atrange),default.units = "native",check.overlap = check.overlap,just = if (rot == 0) c("center", "top") else c("right", "center"),rot = rot,gp =gpar(col = col,cex = cex,fontfamily = fontfamily,fontface = chooseFace(fontface, font)))widths.x <- c((1 - key$height) / 2, key$height, (1 - key$height) / 2)widths.units <- rep("null", 3)heights.x <- c(.6 * key$width, .6, 1)heights.units <- c("lines", "lines", "grobheight")heights.data <- list(NULL, NULL, labelsGrob)key.layout <-grid.layout(nrow = 3, ncol = 3,heights = unit(heights.x, heights.units, data = heights.data),widths = unit(widths.x, widths.units),respect = TRUE)key.gf <- frameGrob(layout = key.layout, vp = vp)key.gf <- placeGrob(key.gf,rectGrob(y = rep(.5, length(reccentre)),x = reccentre,default.units = "native",vp = viewport(xscale = atrange),width = recdim,gp =gpar(fill = key$col,col = "transparent",alpha = key$alpha)),row = 1, col = 2)key.gf <- placeGrob(frame = key.gf,rectGrob(gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd,alpha = axis.line$alpha,fill = "transparent")),row = 1, col = 2)key.gf <- placeGrob(frame = key.gf,segmentsGrob(y0 = rep(1, length(labscat)),x0 = labscat,y1 = rep(.6, length(labscat)),x1 = labscat,vp = viewport(xscale = atrange),default.units = "native",gp =gpar(col = axis.line$col,lty = axis.line$lty,lwd = axis.line$lwd)),row = 2, col = 2)key.gf <- placeGrob(key.gf,labelsGrob,row = 3, col = 2)}if (draw)grid.draw(key.gf)key.gf}