From rmh at surfer.sbm.temple.edu  Sun Apr 27 17:44:09 2003
From: rmh at surfer.sbm.temple.edu (rmh@surfer.sbm.temple.edu)
Date: Sun Apr 27 16:44:33 2003
Subject: [Rd] bug and proposed fix in print.trellis 1.7.0 (PR#2859)
Message-ID: <200304271444.h3REi9pD003350@pubhealth.ku.dk>

sent again without attachments at Peter Dalgaard's request

description:
# Your mailer is set to "none" (default on Windows),
# hence we cannot send the bug report directly from R.
# Please copy the bug report (after finishing it) to
# your favorite email program and send it to
#
#       r-bugs@r-project.org
#
######################################################


The new feature described in rw1070/library/lattice/Changes is very
useful and is needed for several of the examples I showed at DSC-2003.

> scales
> ------
> In anticipation of future use (in nlme, for example), the at and
> labels components of scales can now be a list. Each element
> corresponds to a panel. This is thoroughly untested and not guaranteed
> to work.

It currently rejects correctly formed user labels.  I attach an
example of the problem and a proposed fix.

Rich

--please do not edit the information below--

Version:
 platform = i386-pc-mingw32
 arch = i386
 os = mingw32
 system = i386, mingw32
 status = 
 major = 1
 minor = 7.0
 year = 2003
 month = 04
 day = 16
 language = R

Windows XP Home Edition (build 2600) Service Pack 1.0

Search Path:
 .GlobalEnv, file:c:/HOME/rmh/hh/splus.library/.RData, package:grid, package:lattice, package:methods, package:ctest, package:mva, package:modreg, package:nls, package:ts, Autoloads, package:base


example:
## print.trellis bug in R 1.7.0

tmp <- data.frame(a=factor(c("a","b","c")),
                  b=factor(c("d","e","f")),
                  d=factor(c(1,1,2)))

xyplot(a ~ b | d, data=tmp,  ## works
        scales=list(alternating=F))

xyplot(a ~ b | d, data=tmp,  ## Invalid value for labels
       scales=list(x=list(labels=list(c("d","e",""),c("","","f")),
                     alternating=F)))

source("print.trellis.r")    ## rmh proposed fix

xyplot(a ~ b | d, data=tmp,  ## now it works
       scales=list(x=list(labels=list(c("d","e",""),c("","","f")),
                     alternating=F)))




proposed fix:
print.trellis <-
function (x, position, split, more = FALSE, newpage = TRUE, panel.height = list(1, 
    "null"), panel.width = list(1, "null"), ...) 
{
    if (is.null(dev.list())) 
        trellis.device()
    else if (is.null(trellis.par.get())) 
        trellis.device(device = .Device, new = FALSE)
    bg = trellis.par.get("background")$col
    new <- TRUE
    if (.lattice.print.more || !newpage) 
        new <- FALSE
    .lattice.print.more <<- more
    usual <- (missing(position) & missing(split))
    fontsize.default <- trellis.par.get("fontsize")$default
    if (!missing(position)) {
        if (length(position) != 4) 
            stop("Incorrect value of position")
        if (new) {
            grid.newpage()
            grid.rect(gp = gpar(fill = bg, col = "transparent"))
        }
        push.viewport(viewport(x = position[1], y = position[2], 
            width = position[3] - position[1], height = position[4] - 
                position[2], just = c("left", "bottom")))
        if (!missing(split)) {
            if (length(split) != 4) 
                stop("Incorrect value of split")
            push.viewport(viewport(layout = grid.layout(nrow = split[4], 
                ncol = split[3])))
            push.viewport(viewport(layout.pos.row = split[2], 
                layout.pos.col = split[1]))
        }
    }
    else if (!missing(split)) {
        if (length(split) != 4) 
            stop("Incorrect value of split")
        if (new) {
            grid.newpage()
            grid.rect(gp = gpar(fill = bg, col = "transparent"))
        }
        push.viewport(viewport(layout = grid.layout(nrow = split[4], 
            ncol = split[3])))
        push.viewport(viewport(layout.pos.row = split[2], layout.pos.col = split[1]))
    }
    panel <- if (is.function(x$panel)) 
        x$panel
    else if (is.character(x$panel)) 
        get(x$panel)
    else eval(x$panel)
    x$strip <- if (is.function(x$strip)) 
        x$strip
    else if (is.character(x$strip)) 
        get(x$strip)
    else eval(x$strip)
    axis.line <- trellis.par.get("axis.line")
    number.of.cond <- length(x$condlevels)
    layout.respect <- !x$aspect.fill
    if (layout.respect) 
        panel.height[[1]] <- x$aspect.ratio * panel.width[[1]]
    if (!is.null(x$key)) {
        key.gf <- draw.key(x$key)
        key.space <- if ("space" %in% names(x$key)) 
            x$key$space
        else if ("x" %in% names(x$key) || "corner" %in% names(x$key)) 
            "inside"
        else "top"
    }
    else if (!is.null(x$colorkey)) {
        key.gf <- draw.colorkey(x$colorkey)
        key.space <- if ("space" %in% names(x$colorkey)) 
            x$colorkey$space
        else "right"
    }
    xaxis.col <- if (is.logical(x$x.scales$col)) 
        axis.line$col
    else x$x.scales$col
    xaxis.font <- if (is.logical(x$x.scales$font)) 
        1
    else x$x.scales$font
    xaxis.cex <- x$x.scales$cex
    xaxis.rot <- if (is.logical(x$x.scales$rot)) 
        c(0, 0)
    else x$x.scales$rot
    yaxis.col <- if (is.logical(x$y.scales$col)) 
        axis.line$col
    else x$y.scales$col
    yaxis.font <- if (is.logical(x$y.scales$font)) 
        1
    else x$y.scales$font
    yaxis.cex <- x$y.scales$cex
    yaxis.rot <- if (!is.logical(x$y.scales$rot)) 
        x$y.scales$rot
    else if (x$y.scales$relation != "same" && is.logical(x$y.scales$labels)) 
        c(90, 90)
    else c(0, 0)
    strip.col.default.bg <- rep(trellis.par.get("strip.background")$col, 
        length = number.of.cond)
    strip.col.default.fg <- rep(trellis.par.get("strip.shingle")$col, 
        length = number.of.cond)
    cond.max.level <- integer(number.of.cond)
    for (i in 1:number.of.cond) {
        cond.max.level[i] <- length(x$condlevels[[i]])
    }
    if (x$layout[1] == 0) {
        ddim <- par("din")
        device.aspect <- ddim[2]/ddim[1]
        panel.aspect <- panel.height[[1]]/panel.width[[1]]
        plots.per.page <- x$layout[2]
        m <- max(1, round(sqrt(x$layout[2] * device.aspect/panel.aspect)))
        n <- ceiling(plots.per.page/m)
        m <- ceiling(plots.per.page/n)
        x$layout[1] <- n
        x$layout[2] <- m
    }
    else plots.per.page <- x$layout[1] * x$layout[2]
    cols.per.page <- x$layout[1]
    rows.per.page <- x$layout[2]
    number.of.pages <- x$layout[3]
    if (cols.per.page > 1) 
        x.between <- rep(x$x.between, length = cols.per.page - 
            1)
    if (rows.per.page > 1) 
        y.between <- rep(x$y.between, length = rows.per.page - 
            1)
    x.alternating <- rep(x$x.scales$alternating, length = cols.per.page)
    y.alternating <- rep(x$y.scales$alternating, length = rows.per.page)
    x.relation.same <- x$x.scales$relation == "same"
    y.relation.same <- x$y.scales$relation == "same"
    xlog <- x$x.scales$log
    ylog <- x$y.scales$log
    if (is.logical(xlog) && xlog) 
        xlog <- 10
    if (is.logical(ylog) && ylog) 
        ylog <- 10
    have.xlog <- !is.logical(xlog) || xlog
    have.ylog <- !is.logical(ylog) || ylog
    xlogbase <- if (is.numeric(xlog)) 
        xlog
    else exp(1)
    ylogbase <- if (is.numeric(ylog)) 
        ylog
    else exp(1)
    xlogpaste <- if (have.xlog) 
        paste(as.character(xlog), "^", sep = "")
    else ""
    ylogpaste <- if (have.ylog) 
        paste(as.character(ylog), "^", sep = "")
    else ""
    have.main <- !(is.null(x$main$label) || (is.character(x$main$label) && 
        x$main$label == ""))
    have.sub <- !(is.null(x$sub$label) || (is.character(x$sub$label) && 
        x$sub$label == ""))
    have.xlab <- !(is.null(x$xlab$label) || (is.character(x$xlab$label) && 
        x$xlab$label == ""))
    have.ylab <- !(is.null(x$ylab$label) || (is.character(x$ylab$label) && 
        x$ylab$label == ""))
    n.row <- rows.per.page * (number.of.cond + 3) + (rows.per.page - 
        1) + 11
    n.col <- 3 * cols.per.page + (cols.per.page - 1) + 9
    if (layout.respect) {
        layout.respect <- matrix(0, n.row, n.col)
        layout.respect[number.of.cond + 6 + (1:rows.per.page - 
            1) * (number.of.cond + 4), (1:cols.per.page - 1) * 
            4 + 8] <- 1
    }
    heights.x <- rep(1, n.row)
    heights.units <- rep("lines", n.row)
    heights.data <- as.list(1:n.row)
    widths.x <- rep(1, n.col)
    widths.units <- rep("lines", n.col)
    widths.data <- as.list(1:n.col)
    heights.x[number.of.cond + 6 + (1:rows.per.page - 1) * (number.of.cond + 
        4)] <- panel.height[[1]]
    heights.units[number.of.cond + 6 + (1:rows.per.page - 1) * 
        (number.of.cond + 4)] <- panel.height[[2]]
    heights.x[number.of.cond + 7 + (1:rows.per.page - 1) * (number.of.cond + 
        4)] <- 0
    heights.x[number.of.cond + 8 + (1:rows.per.page - 1) * (number.of.cond + 
        4)] <- 0
    heights.x[4] <- 0
    heights.x[5] <- 0
    heights.x[n.row - 4] <- 0
    heights.x[n.row - 5] <- 0
    if (rows.per.page > 1) 
        heights.x[number.of.cond + 9 + ((if (x$as.table) 
            1:(rows.per.page - 1)
        else (rows.per.page - 1):1) - 1) * (number.of.cond + 
            4)] <- y.between
    heights.x[1] <- 0.5
    heights.x[2] <- if (have.main) 
        2 * x$main$cex
    else 0
    if (have.main) {
        heights.units[2] <- "strheight"
        heights.data[[2]] <- x$main$lab
    }
    heights.x[n.row] <- 0.5
    heights.x[n.row - 1] <- if (have.sub) 
        2 * x$sub$cex
    else 0
    if (have.sub) {
        heights.units[n.row - 1] <- "strheight"
        heights.data[[n.row - 1]] <- x$sub$lab
    }
    heights.x[3] <- 0
    heights.x[n.row - 2] <- 0
    heights.insertlist.position <- 0
    heights.insertlist.unit <- unit(1, "null")
    if (x$x.scales$draw) {
        if (x.relation.same) {
            lab <- calculateAxisComponents(x = x$x.limits, at = x$x.scales$at, 
                labels = x$x.scales$lab, have.log = have.xlog, 
                logbase = xlogbase, logpaste = xlogpaste, abbreviate = x$x.scales$abbr, 
                minlength = x$x.scales$minl, n = x$x.scales$tick.number)$lab
##          if (is.character(lab)) 
            if (all(sapply(lab, is.character)))  ## rmh
                strbar <- as.list(lab)
            else if (is.expression(lab)) {
                strbar <- list()
                for (ss in seq(along = lab)) strbar <- c(strbar, 
                  list(lab[ss]))
            }
            else stop("Invalid value for labels")
            heights.x[5] <- 0.5 + max(0.001, x$x.scales$tck[2]) * 
                0.3
            heights.x[n.row - 5] <- 0.5 + max(0.001, x$x.scales$tck[1]) * 
                0.3
            if (any(x.alternating == 2 | x.alternating == 3)) {
                if (xaxis.rot[2] %in% c(0, 180)) {
                  heights.insertlist.position <- c(heights.insertlist.position, 
                    4)
                  heights.insertlist.unit <- unit.c(heights.insertlist.unit, 
                    max(unit(rep(1 * xaxis.cex[2], length(strbar)), 
                      "strheight", strbar)))
                }
                else {
                  heights.insertlist.position <- c(heights.insertlist.position, 
                    4)
                  heights.insertlist.unit <- unit.c(heights.insertlist.unit, 
                    max(unit(rep(1 * xaxis.cex[2] * abs(sin(xaxis.rot[2] * 
                      base::pi/180)), length(strbar)), "strwidth", 
                      strbar)))
                }
            }
            if (any(x.alternating == 1 | x.alternating == 3)) {
                if (xaxis.rot[1] %in% c(0, 180)) {
                  heights.insertlist.position <- c(heights.insertlist.position, 
                    n.row - 4)
                  heights.insertlist.unit <- unit.c(heights.insertlist.unit, 
                    max(unit(rep(1 * xaxis.cex[1], length(strbar)), 
                      "strheight", strbar)))
                }
                else {
                  heights.insertlist.position <- c(heights.insertlist.position, 
                    n.row - 4)
                  heights.insertlist.unit <- unit.c(heights.insertlist.unit, 
                    max(unit(rep(1 * xaxis.cex[1] * abs(sin(xaxis.rot[1] * 
                      base::pi/180)), length(strbar)), "strwidth", 
                      strbar)))
                }
            }
        }
        else {
            labelChars <- character(0)
            labelExprs <- expression(0)
            for (i in seq(along = x$x.limits)) {
                lab <- calculateAxisComponents(x = x$x.limits[[i]], 
                  at = if (is.list(x$x.scales$at)) 
                    x$x.scales$at[[i]]
                  else x$x.scales$at, labels = if (is.list(x$x.scales$lab)) 
                    x$x.scales$lab[[i]]
                  else x$x.scales$lab, have.log = have.xlog, 
                  logbase = xlogbase, logpaste = xlogpaste, abbreviate = x$x.scales$abbr, 
                  minlength = x$x.scales$minl, n = x$x.scales$tick.number)$lab
                if (is.character(lab)) 
                  labelChars <- c(labelChars, lab)
                else if (is.expression(lab)) 
                  labelExprs <- c(labelExprs, lab)
            }
            labelChars <- unique(labelChars)
            strbar <- list()
            for (ss in labelChars) strbar <- c(strbar, list(ss))
            for (ss in seq(along = labelExprs)) strbar <- c(strbar, 
                list(labelExprs[ss]))
            if (xaxis.rot[1] %in% c(0, 180)) {
                heights.x[number.of.cond + 7 + (1:rows.per.page - 
                  1) * (number.of.cond + 4)] <- max(0.001, x$x.scales$tck[1]) * 
                  0.3
                heights.insertlist.position <- c(heights.insertlist.position, 
                  number.of.cond + 8 + (1:rows.per.page - 1) * 
                    (number.of.cond + 4))
                for (i in 1:rows.per.page) heights.insertlist.unit <- unit.c(heights.insertlist.unit, 
                  max(unit(rep(1.5 * xaxis.cex[1], length(strbar)), 
                    "strheight", strbar)))
            }
            else {
                heights.x[number.of.cond + 7 + (1:rows.per.page - 
                  1) * (number.of.cond + 4)] <- max(0.001, x$x.scales$tck[1]) * 
                  0.3
                heights.insertlist.position <- c(heights.insertlist.position, 
                  number.of.cond + 8 + (1:rows.per.page - 1) * 
                    (number.of.cond + 4))
                for (i in 1:rows.per.page) heights.insertlist.unit <- unit.c(heights.insertlist.unit, 
                  max(unit(rep(1.5 * xaxis.cex[1] * abs(sin(xaxis.rot[1] * 
                    base::pi/180)), length(strbar)), "strwidth", 
                    strbar)))
            }
        }
    }
    heights.x[n.row - 3] <- if (have.xlab) 
        2 * x$xlab$cex
    else 0
    if (have.xlab) {
        heights.units[n.row - 3] <- "strheight"
        heights.data[[n.row - 3]] <- x$xlab$lab
    }
    for (crr in 1:number.of.cond) heights.x[number.of.cond + 
        6 + (1:rows.per.page - 1) * (number.of.cond + 4) - crr] <- if (is.logical(x$strip)) 
        0
    else 1.1 * x$par.strip.text$cex * x$par.strip.text$lines
    widths.x[3] <- if (have.ylab) 
        2 * x$ylab$cex
    else 0
    if (have.ylab) {
        widths.units[3] <- "strheight"
        widths.data[[3]] <- x$ylab$lab
    }
    widths.x[(1:cols.per.page - 1) * 4 + 8] <- panel.width[[1]]
    widths.units[(1:cols.per.page - 1) * 4 + 8] <- panel.width[[2]]
    widths.x[(1:cols.per.page - 1) * 4 + 7] <- 0
    widths.x[(1:cols.per.page - 1) * 4 + 6] <- 0
    widths.x[4] <- 0
    widths.x[5] <- 0
    widths.x[n.col - 2] <- 0
    widths.x[n.col - 3] <- 0
    if (cols.per.page > 1) 
        widths.x[(1:(cols.per.page - 1) - 1) * 4 + 9] <- x.between
    widths.x[1] <- 0.5
    widths.x[n.col] <- 0.5
    widths.x[2] <- 0
    widths.x[n.col - 1] <- 0
    widths.insertlist.position <- 0
    widths.insertlist.unit <- unit(1, "null")
    if (x$y.scales$draw) {
        if (y.relation.same) {
            lab <- calculateAxisComponents(x = x$y.limits, at = x$y.scales$at, 
                labels = x$y.scales$lab, have.log = have.ylog, 
                logbase = ylogbase, logpaste = ylogpaste, abbreviate = x$y.scales$abbr, 
                minlength = x$y.scales$minl, n = x$y.scales$tick.number)$lab
##          if (is.character(lab)) 
            if (all(sapply(lab, is.character)))  ## rmh
                strbar <- as.list(lab)
            else if (is.expression(lab)) {
                strbar <- list()
                for (ss in seq(along = lab)) strbar <- c(strbar, 
                  list(lab[ss]))
            }
            else stop("Invalid value for labels")
            widths.x[5] <- 0.5 + max(0.001, x$y.scales$tck[1]) * 
                0.3
            widths.x[n.col - 3] <- max(1, x$y.scales$tck[2]) * 
                0.5
            if (any(y.alternating == 1 | y.alternating == 3)) {
                if (abs(yaxis.rot[1]) == 90) {
                  widths.insertlist.position <- c(widths.insertlist.position, 
                    4)
                  widths.insertlist.unit <- unit.c(widths.insertlist.unit, 
                    max(unit(1 * rep(yaxis.cex[1], length(strbar)), 
                      "strheight", data = strbar)))
                }
                else {
                  widths.insertlist.position <- c(widths.insertlist.position, 
                    4)
                  widths.insertlist.unit <- unit.c(widths.insertlist.unit, 
                    max(unit(rep(1 * yaxis.cex[1] * abs(cos(yaxis.rot[1] * 
                      base::pi/180)), length(strbar)), "strwidth", 
                      strbar)))
                }
            }
            if (any(y.alternating == 2 | y.alternating == 3)) {
                if (abs(yaxis.rot[2]) == 90) {
                  widths.insertlist.position <- c(widths.insertlist.position, 
                    n.col - 2)
                  widths.insertlist.unit <- unit.c(widths.insertlist.unit, 
                    max(unit(rep(1 * yaxis.cex[2], length(strbar)), 
                      "strheight", strbar)))
                }
                else {
                  widths.insertlist.position <- c(widths.insertlist.position, 
                    n.col - 2)
                  widths.insertlist.unit <- unit.c(widths.insertlist.unit, 
                    max(unit(rep(1 * yaxis.cex[2] * abs(cos(yaxis.rot[2] * 
                      base::pi/180)), length(strbar)), "strwidth", 
                      strbar)))
                }
            }
        }
        else {
            labelChars <- character(0)
            labelExprs <- expression(0)
            for (i in seq(along = x$y.limits)) {
                lab <- calculateAxisComponents(x = x$y.limits[[i]], 
                  at = if (is.list(x$y.scales$at)) 
                    x$y.scales$at[[i]]
                  else x$y.scales$at, labels = if (is.list(x$y.scales$lab)) 
                    x$y.scales$lab[[i]]
                  else x$y.scales$lab, have.log = have.ylog, 
                  logbase = ylogbase, logpaste = ylogpaste, abbreviate = x$y.scales$abbr, 
                  minlength = x$y.scales$minl, n = x$y.scales$tick.number)$lab
                if (is.character(lab)) 
                  labelChars <- c(labelChars, lab)
                else if (is.expression(lab)) 
                  labelExprs <- c(labelExprs, lab)
            }
            labelChars <- unique(labelChars)
            strbar <- list()
            for (ss in labelChars) strbar <- c(strbar, list(ss))
            for (ss in seq(along = labelExprs)) strbar <- c(strbar, 
                list(labelExprs[ss]))
            if (abs(yaxis.rot[1]) == 90) {
                widths.x[(1:cols.per.page - 1) * 4 + 7] <- max(0.001, 
                  x$y.scales$tck[1]) * 0.3
                widths.insertlist.position <- c(widths.insertlist.position, 
                  (1:cols.per.page - 1) * 4 + 6)
                for (i in 1:cols.per.page) widths.insertlist.unit <- unit.c(widths.insertlist.unit, 
                  max(unit(rep(1.5 * yaxis.cex[1], length(strbar)), 
                    "strheight", strbar)))
            }
            else {
                widths.x[(1:cols.per.page - 1) * 4 + 7] <- max(0.001, 
                  x$y.scales$tck[1]) * 0.3
                widths.insertlist.position <- c(widths.insertlist.position, 
                  (1:cols.per.page - 1) * 4 + 6)
                for (i in 1:cols.per.page) widths.insertlist.unit <- unit.c(widths.insertlist.unit, 
                  max(unit(rep(1.2 * yaxis.cex[1] * abs(cos(yaxis.rot[1] * 
                    base::pi/180)), length(strbar)), "strwidth", 
                    strbar)))
            }
        }
    }
    if (!is.null(x$key) || !is.null(x$colorkey)) {
        if (key.space == "left") {
            widths.x[2] <- 1.2
            widths.units[2] <- "grobwidth"
            widths.data[[2]] <- key.gf
        }
        else if (key.space == "right") {
            widths.x[n.col - 1] <- 1.2
            widths.units[n.col - 1] <- "grobwidth"
            widths.data[[n.col - 1]] <- key.gf
        }
        else if (key.space == "top") {
            heights.x[3] <- 1.2
            heights.units[3] <- "grobheight"
            heights.data[[3]] <- key.gf
        }
        else if (key.space == "bottom") {
            heights.x[n.row - 2] <- 1.2
            heights.units[n.row - 2] <- "grobheight"
            heights.data[[n.row - 2]] <- key.gf
        }
    }
    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])
    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])
    page.layout <- grid.layout(nrow = n.row, ncol = n.col, widths = layout.widths, 
        heights = layout.heights, respect = layout.respect)
    cond.current.level <- rep(1, number.of.cond)
    panel.number <- 1
    for (page.number in 1:number.of.pages) if (!any(cond.max.level - 
        cond.current.level < 0)) {
        if (usual) {
            if (new) 
                grid.newpage()
            grid.rect(gp = gpar(fill = bg, col = "transparent"))
            new <- TRUE
        }
        push.viewport(viewport(layout = page.layout, gp = gpar(fontsize = fontsize.default, 
            col = axis.line$col, lty = axis.line$lty, lwd = axis.line$lwd)))
        if (have.main) 
            grid.text(label = x$main$label, gp = gpar(col = x$main$col, 
                font = x$main$font, fontsize = fontsize.default * 
                  x$main$cex), vp = viewport(layout.pos.row = 2))
        if (have.sub) 
            grid.text(label = x$sub$label, gp = gpar(col = x$sub$col, 
                font = x$sub$font, fontsize = fontsize.default * 
                  x$sub$cex), vp = viewport(layout.pos.row = n.row - 
                1))
        if (have.xlab) 
            grid.text(label = x$xlab$label, gp = gpar(col = x$xlab$col, 
                font = x$xlab$font, fontsize = fontsize.default * 
                  x$xlab$cex), vp = viewport(layout.pos.row = n.row - 
                3, layout.pos.col = c(6, n.col - 4)))
        if (have.ylab) 
            grid.text(label = x$ylab$label, rot = 90, gp = gpar(col = x$ylab$col, 
                font = x$ylab$font, fontsize = fontsize.default * 
                  x$ylab$cex), vp = viewport(layout.pos.col = 3, 
                layout.pos.row = c(6, n.row - 6)))
        for (row in 1:rows.per.page) for (column in 1:cols.per.page) if (!any(cond.max.level - 
            cond.current.level < 0) && (row - 1) * cols.per.page + 
            column <= plots.per.page) {
            if (!is.list(x$panel.args[[panel.number]])) 
                panel.number <- panel.number + 1
            else {
                actual.row <- if (x$as.table) 
                  (rows.per.page - row + 1)
                else row
                pos.row <- 6 + number.of.cond + (rows.per.page - 
                  actual.row) * (number.of.cond + 4)
                pos.col <- (column - 1) * 4 + 8
                xlabelinfo <- calculateAxisComponents(x = if (x.relation.same) 
                  x$x.limits
                else x$x.limits[[panel.number]], at = if (is.list(x$x.scales$at)) 
                  x$x.scales$at[[panel.number]]
                else x$x.scales$at, labels = if (is.list(x$x.scales$lab)) 
                  x$x.scales$lab[[panel.number]]
                else x$x.scales$lab, have.log = have.xlog, logbase = xlogbase, 
                  logpaste = xlogpaste, abbreviate = x$x.scales$abbr, 
                  minlength = x$x.scales$minl, n = x$x.scales$tick.number)
                ylabelinfo <- calculateAxisComponents(x = if (y.relation.same) 
                  x$y.limits
                else x$y.limits[[panel.number]], at = if (is.list(x$y.scales$at)) 
                  x$y.scales$at[[panel.number]]
                else x$y.scales$at, labels = if (is.list(x$y.scales$lab)) 
                  x$y.scales$lab[[panel.number]]
                else x$y.scales$lab, have.log = have.ylog, logbase = ylogbase, 
                  logpaste = ylogpaste, abbreviate = x$y.scales$abbr, 
                  minlength = x$y.scales$minl, n = x$y.scales$tick.number)
                xscale <- xlabelinfo$num.limit
                yscale <- ylabelinfo$num.limit
                push.viewport(viewport(layout.pos.row = pos.row, 
                  layout.pos.col = pos.col, xscale = xscale, 
                  yscale = yscale, clip = TRUE, gp = gpar(fontsize = fontsize.default)))
                pargs <- c(x$panel.args[[panel.number]], x$panel.args.common, 
                  list(panel.number = panel.number))
                if (!("..." %in% names(formals(panel)))) 
                  pargs <- pargs[names(formals(panel))]
                do.call("panel", pargs)
                grid.rect()
                pop.viewport()
                if (!x.relation.same && x$x.scales$draw) {
                  axs <- x$x.scales
                  ok <- (xlabelinfo$at >= xscale[1] & xlabelinfo$at <= 
                    xscale[2])
                  push.viewport(viewport(layout.pos.row = pos.row + 
                    1, layout.pos.col = pos.col, xscale = xscale))
                  if (axs$tck[1] != 0 && any(ok)) 
                    grid.segments(y0 = unit(rep(1, sum(ok)), 
                      "npc"), y1 = unit(rep(1, sum(ok)), "npc") - 
                      unit(rep(0.3 * axs$tck[1], sum(ok)), "lines"), 
                      x0 = unit(xlabelinfo$at[ok], "native"), 
                      x1 = unit(xlabelinfo$at[ok], "native"), 
                      gp = gpar(col = xaxis.col))
                  pop.viewport()
                  if (any(ok)) 
                    grid.text(label = xlabelinfo$label[ok], x = unit(xlabelinfo$at[ok], 
                      "native"), y = unit(if (xaxis.rot[1] %in% 
                      c(0, 180)) 
                      0.5
                    else 0.95, "npc"), just = if (xaxis.rot[1] == 
                      0) 
                      c("centre", "centre")
                    else if (xaxis.rot[1] == 180) 
                      c("centre", "centre")
                    else if (xaxis.rot[1] > 0) 
                      c("right", "centre")
                    else c("left", "centre"), rot = xaxis.rot[1], 
                      check.overlap = xlabelinfo$check.overlap, 
                      gp = gpar(col = xaxis.col, font = xaxis.font, 
                        fontsize = axs$cex[1] * fontsize.default), 
                      vp = viewport(layout.pos.row = pos.row + 
                        2, layout.pos.col = pos.col, xscale = xscale))
                }
                if (!y.relation.same && x$y.scales$draw) {
                  axs <- x$y.scales
                  ok <- (ylabelinfo$at >= yscale[1] & ylabelinfo$at <= 
                    yscale[2])
                  push.viewport(viewport(layout.pos.row = pos.row, 
                    layout.pos.col = pos.col - 1, yscale = yscale))
                  if (axs$tck[1] != 0 && any(ok)) 
                    grid.segments(x0 = unit(rep(1, sum(ok)), 
                      "npc"), x1 = unit(rep(1, sum(ok)), "npc") - 
                      unit(rep(0.3 * axs$tck[1], sum(ok)), "lines"), 
                      y0 = unit(ylabelinfo$at[ok], "native"), 
                      y1 = unit(ylabelinfo$at[ok], "native"), 
                      gp = gpar(col = yaxis.col))
                  pop.viewport()
                  if (any(ok)) 
                    grid.text(label = ylabelinfo$label[ok], y = unit(ylabelinfo$at[ok], 
                      "native"), x = unit(if (abs(yaxis.rot[1]) == 
                      90) 
                      0.5
                    else 0.95, "npc"), just = if (yaxis.rot[1] == 
                      90) 
                      c("centre", "centre")
                    else if (yaxis.rot[1] == -90) 
                      c("centre", "centre")
                    else if (yaxis.rot[1] > -90 && yaxis.rot[1] < 
                      90) 
                      c("right", "centre")
                    else c("left", "centre"), rot = yaxis.rot[1], 
                      check.overlap = ylabelinfo$check.overlap, 
                      gp = gpar(col = yaxis.col, font = xaxis.font, 
                        fontsize = axs$cex[1] * fontsize.default), 
                      vp = viewport(layout.pos.row = pos.row, 
                        layout.pos.col = pos.col - 2, yscale = yscale))
                }
                if (y.relation.same && x$y.scales$draw) {
                  if (column == 1) {
                    axs <- x$y.scales
                    ok <- (ylabelinfo$at >= yscale[1] & ylabelinfo$at <= 
                      yscale[2])
                    push.viewport(viewport(layout.pos.row = pos.row, 
                      layout.pos.col = pos.col - 3, yscale = yscale))
                    if (axs$tck[1] != 0 && any(ok)) 
                      grid.segments(x0 = unit(rep(1, sum(ok)), 
                        "npc"), x1 = unit(rep(1, sum(ok)), "npc") - 
                        unit(rep(0.3 * axs$tck[1], sum(ok)), 
                          "lines"), y0 = unit(ylabelinfo$at[ok], 
                        "native"), y1 = unit(ylabelinfo$at[ok], 
                        "native"), gp = gpar(col = yaxis.col))
                    pop.viewport()
                    if (y.alternating[actual.row] == 1 || y.alternating[actual.row] == 
                      3) 
                      if (any(ok)) 
                        grid.text(label = ylabelinfo$lab[ok], 
                          y = unit(ylabelinfo$at[ok], "native"), 
                          x = unit(if (abs(yaxis.rot[1]) == 90) 
                            0.5
                          else 1, "npc"), just = if (yaxis.rot[1] == 
                            -90) 
                            c("centre", "centre")
                          else if (yaxis.rot[1] == 90) 
                            c("centre", "centre")
                          else if (yaxis.rot[1] > -90 && yaxis.rot[1] < 
                            90) 
                            c("right", "centre")
                          else c("left", "centre"), rot = yaxis.rot[1], 
                          check.overlap = ylabelinfo$check.overlap, 
                          gp = gpar(col = yaxis.col, font = yaxis.font, 
                            fontsize = axs$cex[1] * fontsize.default), 
                          vp = viewport(layout.pos.row = pos.row, 
                            layout.pos.col = pos.col - 4, yscale = yscale))
                  }
                  if (column == cols.per.page) {
                    axs <- x$y.scales
                    ok <- (ylabelinfo$at >= yscale[1] & ylabelinfo$at <= 
                      yscale[2])
                    push.viewport(viewport(layout.pos.row = pos.row, 
                      layout.pos.col = pos.col + 1, yscale = yscale))
                    if (axs$tck[2] != 0 && any(ok)) 
                      grid.segments(x0 = unit(rep(0, sum(ok)), 
                        "npc"), x1 = unit(rep(0.3 * axs$tck[2], 
                        sum(ok)), "lines"), y0 = unit(ylabelinfo$at[ok], 
                        "native"), y1 = unit(ylabelinfo$at[ok], 
                        "native"), gp = gpar(col = yaxis.col))
                    pop.viewport()
                    if (y.alternating[actual.row] == 2 || y.alternating[actual.row] == 
                      3) 
                      if (any(ok)) 
                        grid.text(label = ylabelinfo$label[ok], 
                          y = unit(ylabelinfo$at[ok], "native"), 
                          x = unit(if (abs(yaxis.rot[2]) == 90) 
                            0.5
                          else 0, "npc"), just = if (yaxis.rot[2] == 
                            -90) 
                            c("centre", "centre")
                          else if (yaxis.rot[2] == 90) 
                            c("centre", "centre")
                          else if (yaxis.rot[2] > -90 && yaxis.rot[2] < 
                            90) 
                            c("left", "centre")
                          else c("right", "centre"), rot = yaxis.rot[2], 
                          check.overlap = ylabelinfo$check.overlap, 
                          gp = gpar(col = yaxis.col, font = yaxis.font, 
                            fontsize = axs$cex[2] * fontsize.default), 
                          vp = viewport(layout.pos.row = pos.row, 
                            layout.pos.col = pos.col + 2, yscale = yscale))
                  }
                }
                if (x.relation.same && x$x.scales$draw) {
                  if (actual.row == 1) {
                    axs <- x$x.scales
                    ok <- (xlabelinfo$at >= xscale[1] & xlabelinfo$at <= 
                      xscale[2])
                    push.viewport(viewport(layout.pos.row = pos.row + 
                      3, layout.pos.col = pos.col, xscale = xscale))
                    if (axs$tck[1] != 0 && any(ok)) 
                      grid.segments(y0 = unit(rep(1, sum(ok)), 
                        "npc"), y1 = unit(rep(1, sum(ok)), "npc") - 
                        unit(rep(0.3 * axs$tck[1], sum(ok)), 
                          "lines"), x0 = unit(xlabelinfo$at[ok], 
                        "native"), x1 = unit(xlabelinfo$at[ok], 
                        "native"), gp = gpar(col = xaxis.col))
                    pop.viewport()
                    if (x.alternating[column] == 1 || x.alternating[column] == 
                      3) 
                      if (any(ok)) {
                        grid.text(label = xlabelinfo$lab[ok], 
                          x = unit(xlabelinfo$at[ok], "native"), 
                          y = unit(if (xaxis.rot[1] %in% c(0, 
                            180)) 
                            0.5
                          else 1, "npc"), just = if (xaxis.rot[1] == 
                            0) 
                            c("centre", "centre")
                          else if (xaxis.rot[1] == 180) 
                            c("centre", "centre")
                          else if (xaxis.rot[1] > 0) 
                            c("right", "centre")
                          else c("left", "centre"), rot = xaxis.rot[1], 
                          check.overlap = xlabelinfo$check.overlap, 
                          gp = gpar(col = xaxis.col, font = xaxis.font, 
                            fontsize = axs$cex[1] * fontsize.default), 
                          vp = viewport(layout.pos.row = pos.row + 
                            4, layout.pos.col = pos.col, xscale = xscale))
                      }
                  }
                }
                if (!is.logical(x$strip)) 
                  for (i in 1:number.of.cond) {
                    push.viewport(viewport(layout.pos.row = pos.row - 
                      i, layout.pos.col = pos.col, clip = TRUE, 
                      gp = gpar(fontsize = fontsize.default)))
                    grid.rect()
                    x$strip(which.given = i, which.panel = cond.current.level, 
                      var.name = names(x$cond), factor.levels = if (!is.list(x$cond[[i]])) 
                        x$cond[[i]]
                      else NULL, shingle.intervals = if (is.list(x$cond[[i]])) 
                        do.call("rbind", x$cond[[i]])
                      else NULL, bg = strip.col.default.bg[i], 
                      fg = strip.col.default.fg[i], par.strip.text = x$par.strip.text)
                    pop.viewport()
                  }
                if (x.relation.same && x$x.scales$draw) 
                  if (actual.row == rows.per.page) {
                    axs <- x$x.scales
                    ok <- (xlabelinfo$at >= xscale[1] & xlabelinfo$at <= 
                      xscale[2])
                    push.viewport(viewport(layout.pos.row = pos.row - 
                      1 - number.of.cond, layout.pos.col = pos.col, 
                      xscale = xscale))
                    if (axs$tck[2] != 0 && any(ok)) 
                      grid.segments(y0 = unit(rep(0, sum(ok)), 
                        "npc"), y1 = unit(rep(0.3 * axs$tck[2], 
                        sum(ok)), "lines"), x0 = unit(xlabelinfo$at[ok], 
                        "native"), x1 = unit(xlabelinfo$at[ok], 
                        "native"), gp = gpar(col = xaxis.col))
                    pop.viewport()
                    if (x.alternating[column] == 2 || x.alternating[column] == 
                      3) 
                      if (any(ok)) 
                        grid.text(label = xlabelinfo$label[ok], 
                          x = unit(xlabelinfo$at[ok], "native"), 
                          y = unit(if (xaxis.rot[2] %in% c(0, 
                            180)) 
                            0.5
                          else 0, "npc"), just = if (xaxis.rot[2] == 
                            0) 
                            c("centre", "centre")
                          else if (xaxis.rot[2] == 180) 
                            c("centre", "centre")
                          else if (xaxis.rot[2] > 0) 
                            c("left", "centre")
                          else c("right", "centre"), rot = xaxis.rot[2], 
                          check.overlap = xlabelinfo$check.overlap, 
                          gp = gpar(col = xaxis.col, font = xaxis.font, 
                            fontsize = axs$cex[2] * fontsize.default), 
                          vp = viewport(layout.pos.row = pos.row - 
                            2 - number.of.cond, layout.pos.col = pos.col, 
                            xscale = xscale))
                  }
                cond.current.level <- cupdate(cond.current.level, 
                  cond.max.level)
                panel.number <- panel.number + 1
            }
        }
        if (!is.null(x$key) || !is.null(x$colorkey)) {
            if (key.space == "left") {
                push.viewport(viewport(layout.pos.col = 2, layout.pos.row = c(6, 
                  n.row - 6)))
                grid.draw(key.gf)
                pop.viewport()
            }
            else if (key.space == "right") {
                push.viewport(viewport(layout.pos.col = n.col - 
                  1, layout.pos.row = c(6, n.row - 6)))
                grid.draw(key.gf)
                pop.viewport()
            }
            else if (key.space == "top") {
                push.viewport(viewport(layout.pos.row = 3, layout.pos.col = c(6, 
                  n.col - 4)))
                grid.draw(key.gf)
                pop.viewport()
            }
            else if (key.space == "bottom") {
                push.viewport(viewport(layout.pos.row = n.row - 
                  2, layout.pos.col = c(6, n.col - 4)))
                grid.draw(key.gf)
                pop.viewport()
            }
            else if (key.space == "inside") {
                push.viewport(viewport(layout.pos.row = c(1, 
                  n.row), layout.pos.col = c(1, n.col)))
                if (is.null(x$key$corner)) 
                  x$key$corner <- c(0, 1)
                if (is.null(x$key$x)) 
                  x$key$x <- x$key$corner[1]
                if (is.null(x$key$y)) 
                  x$key$y <- x$key$corner[2]
                if (all(x$key$corner == c(0, 1))) {
                  push.viewport(viewport(layout = grid.layout(nrow = 3, 
                    ncol = 3, widths = unit(c(x$key$x, 1, 1), 
                      c("npc", "grobwidth", "null"), list(1, 
                        key.gf, 1)), heights = unit(c(1 - x$key$y, 
                      1, 1), c("npc", "grobheight", "null"), 
                      list(1, key.gf, 1)))))
                  push.viewport(viewport(layout.pos.row = 2, 
                    layout.pos.col = 2))
                  grid.draw(key.gf)
                  pop.viewport()
                  pop.viewport()
                }
                if (all(x$key$corner == c(1, 1))) {
                  push.viewport(viewport(layout = grid.layout(nrow = 3, 
                    ncol = 3, heights = unit(c(1 - x$key$y, 1, 
                      1), c("npc", "grobheight", "null"), list(1, 
                      key.gf, 1)), widths = unit(c(1, 1, 1 - 
                      x$key$x), c("null", "grobwidth", "npc"), 
                      list(1, key.gf, 1)))))
                  push.viewport(viewport(layout.pos.row = 2, 
                    layout.pos.col = 2))
                  grid.draw(key.gf)
                  pop.viewport()
                  pop.viewport()
                }
                if (all(x$key$corner == c(0, 0))) {
                  push.viewport(viewport(layout = grid.layout(nrow = 3, 
                    ncol = 3, widths = unit(c(x$key$x, 1, 1), 
                      c("npc", "grobwidth", "null"), list(1, 
                        key.gf, 1)), heights = unit(c(1, 1, x$key$y), 
                      c("null", "grobheight", "npc"), list(1, 
                        key.gf, 1)))))
                  push.viewport(viewport(layout.pos.row = 2, 
                    layout.pos.col = 2))
                  grid.draw(key.gf)
                  pop.viewport()
                  pop.viewport()
                }
                if (all(x$key$corner == c(1, 0))) {
                  push.viewport(viewport(layout = grid.layout(nrow = 3, 
                    ncol = 3, widths = unit(c(1, 1, 1 - x$key$x), 
                      c("null", "grobwidth", "npc"), list(1, 
                        key.gf, 1)), heights = unit(c(1, 1, x$key$y), 
                      c("null", "grobheight", "npc"), list(1, 
                        key.gf, 1)))))
                  push.viewport(viewport(layout.pos.row = 2, 
                    layout.pos.col = 2))
                  grid.draw(key.gf)
                  pop.viewport()
                  pop.viewport()
                }
                pop.viewport()
            }
        }
        push.viewport(viewport(layout.pos.row = c(1, n.row), 
            layout.pos.col = c(1, n.col)))
        if (!is.null(x$page)) 
            x$page(page.number)
        pop.viewport()
        pop.viewport()
    }
    if (!missing(position)) {
        if (!missing(split)) {
            pop.viewport()
            pop.viewport()
        }
        pop.viewport()
    }
    else if (!missing(split)) {
        pop.viewport()
        pop.viewport()
    }
    invisible(page.layout)
}


[Rd] bug and proposed fix in print.trellis 1.7.0 (PR#2859)
rmh@surfer.sbm.temple.edu