Running 'MASSch04.R' [3s]
  Running 'auto-key.R' [2s]
  Running 'barchart-width.R' [1s]
  Running 'call.R' [176s]
  Running 'colorkey-title.R' [156s]
  Running 'dataframe-methods.R' [4s]
  Running 'dates.R' [1s]
  Running 'dotplotscoping.R' [166s]
  Running 'fontsize.R' [117s]
  Running 'levelplot.R' [80s]
  Running 'scales.R' [2s]
  Running 'shade-wireframe.R' [96s]
  Running 'summary.R' [0s]
  Running 'temp.R' [2s]
  Running 'test.R' [70s]
  Running 'wireframe.R' [104s]
Running the tests in 'tests/call.R' failed.
Complete output:
  > library(lattice)
  > 
  > ## Background: https://stat.ethz.ch/pipermail/r-devel/2017-May/074245.html
  > 
  > ## For a long time, lattice has used the following construct to add a
  > ## $call component to the final "trellis" object produced:
  > 
  > ## obj$call <- sys.call(sys.parent()); obj$call[[1]] <- quote(xyplot)
  > 
  > ## But this doesn't work in all contexts, especially when using
  > ## with(). From lattice_0.21, this has been changed to use sys.call(),
  > ## but it is important to have this done in EVERY method.
  > 
  > ## The following code tests this by checking the call component in
  > ## every high-level method defined in lattice.
  > 
  > g <- data.frame(x = runif(10), y = runif(10), g10 = gl(10, 1), g2 = gl(2, 5))
  > 
  > test.objects <-
  +     with(g,
  +          list(barchart.formula = barchart(g10 ~ x | g2, subset = g10 != "1"),
  +               barchart.array = barchart(unclass(Titanic)),
  +               barchart.default = barchart(g2),
  +               barchart.matrix = barchart(VADeaths),
  +               barchart.numeric = barchart(x),
  +               barchart.table = barchart(UCBAdmissions),
  +               bwplot.formula = bwplot(g2 ~ x + y, outer = TRUE),
  +               bwplot.numeric = bwplot(y, notch = TRUE),
  +               densityplot.formula = densityplot(~ x, groups = g2),
  +               densityplot.numeric = densityplot(y, plot.points = "jitter"),
  +               dotplot.formula = dotplot(g10 ~ x | g2),
  +               dotplot.array = dotplot(unclass(Titanic)),
  +               dotplot.default = dotplot(g2),
  +               dotplot.matrix = dotplot(VADeaths),
  +               dotplot.numeric = dotplot(x),
  +               dotplot.table = dotplot(UCBAdmissions),
  +               histogram.formula = histogram(~ c(x, y)),
  +               histogram.factor = histogram(g2),
  +               histogram.numeric = histogram(c(x, y)),
  +               qqmath.formula = qqmath(~ x + y),
  +               qqmath.numeric = qqmath(x),
  +               stripplot.formula = stripplot(g2 ~ x + y, outer = TRUE),
  +               stripplot.numeric = stripplot(y, jitter = TRUE),
  +               qq.formula = qq(g2 ~ x),
  +               xyplot.formula = xyplot(y ~ x),
  +               xyplot.ts = xyplot(ts(x)),
  +               levelplot.formula = levelplot(y ~ g2 + g10),
  +               levelplot.table = levelplot(UCBAdmissions),
  +               levelplot.array = levelplot(unclass(Titanic)),
  +               levelplot.matrix = levelplot(VADeaths),
  +               contourplot.formula = contourplot(y ~ g2 + g10),
  +               contourplot.table = contourplot(UCBAdmissions),
  +               contourplot.array = contourplot(unclass(Titanic)),
  +               contourplot.matrix = contourplot(VADeaths),
  +               cloud.formula = cloud(g10 ~ x + y),
  +               cloud.matrix = cloud(VADeaths),
  +               cloud.table = cloud(UCBAdmissions),
  +               wireframe.formula = wireframe(y ~ g2 + g10),
  +               wireframe.matrix = wireframe(VADeaths),
  +               splom.formula = splom(~cbind(x = x, y = y, g = as.numeric(g2))),
  +               splom.matrix = splom(cbind(x = x, y = y, g = as.numeric(g2))),
  +               splom.data.frame = splom(data.frame(x, y, g2)),
  +               parallelplot.formula = parallelplot(~iris),
  +               parallelplot.matrix = parallelplot(data.matrix(iris[1:4])),
  +               parallelplot.data.frame = parallelplot(iris),
  +               rfs = rfs(oneway(y ~ g2)),
  +               tmd.formula = tmd(sort(y) ~ sort(x)),
  +               tmd.trellis = tmd(xyplot(sort(y) ~ sort(x))),
  +               update.trellis = update(xyplot(y ~ x), pch = 16, cex = 1.5)))
  >               
  > ## sanity check (some examples without with())
  > 
  > test.objects$xyplot <- xyplot(y ~ x | g2, data = g, cex = c(1, 2))
  > test.objects$densityplot <- densityplot(g$x, plot.points = FALSE)
  > test.objects$shingle <- plot(equal.count(rnorm(1000)))
  > 
  > 
  > for (m in names(test.objects))
  +     cat(sprintf("%25s : %s\n", m, paste(deparse(test.objects[[m]]$call), collapse = "")))
           barchart.formula : barchart(g10 ~ x | g2, subset = g10 != "1")
             barchart.array : barchart(unclass(Titanic))
           barchart.default : barchart(g2)
            barchart.matrix : barchart(VADeaths)
           barchart.numeric : barchart(x)
             barchart.table : barchart(UCBAdmissions)
             bwplot.formula : bwplot(g2 ~ x + y, outer = TRUE)
             bwplot.numeric : bwplot(y, notch = TRUE)
        densityplot.formula : densityplot(~x, groups = g2)
        densityplot.numeric : densityplot(y, plot.points = "jitter")
            dotplot.formula : dotplot(g10 ~ x | g2)
              dotplot.array : dotplot(unclass(Titanic))
            dotplot.default : dotplot(g2)
             dotplot.matrix : dotplot(VADeaths)
            dotplot.numeric : dotplot(x)
              dotplot.table : dotplot(UCBAdmissions)
          histogram.formula : histogram(~c(x, y))
           histogram.factor : histogram(g2)
          histogram.numeric : histogram(c(x, y))
             qqmath.formula : qqmath(~x + y)
             qqmath.numeric : qqmath(x)
          stripplot.formula : stripplot(g2 ~ x + y, outer = TRUE)
          stripplot.numeric : stripplot(y, jitter = TRUE)
                 qq.formula : qq(g2 ~ x)
             xyplot.formula : xyplot(y ~ x)
                  xyplot.ts : xyplot(ts(x))
          levelplot.formula : levelplot(y ~ g2 + g10)
            levelplot.table : levelplot(UCBAdmissions)
            levelplot.array : levelplot(as.table(x), ...)
           levelplot.matrix : levelplot(VADeaths)
        contourplot.formula : contourplot(y ~ g2 + g10)
          contourplot.table : contourplot(UCBAdmissions)
          contourplot.array : contourplot(unclass(Titanic))
         contourplot.matrix : contourplot(VADeaths)
              cloud.formula : cloud(g10 ~ x + y)
               cloud.matrix : cloud(VADeaths)
                cloud.table : cloud(UCBAdmissions)
          wireframe.formula : wireframe(y ~ g2 + g10)
           wireframe.matrix : wireframe(VADeaths)
              splom.formula : splom(~cbind(x = x, y = y, g = as.numeric(g2)))
               splom.matrix : splom(cbind(x = x, y = y, g = as.numeric(g2)))
           splom.data.frame : splom(data.frame(x, y, g2))
       parallelplot.formula : parallelplot(~iris)
        parallelplot.matrix : parallelplot(data.matrix(iris[1:4]))
    parallelplot.data.frame : parallelplot(iris)
                        rfs : rfs(oneway(y ~ g2))
                tmd.formula : tmd(sort(y) ~ sort(x))
                tmd.trellis : tmd(xyplot(sort(y) ~ sort(x)))
             update.trellis : xyplot(y ~ x, pch = 16, cex = 1.5)
                     xyplot : xyplot(y ~ x | g2, data = g, cex = c(1, 2))
                densityplot : densityplot(g$x, plot.points = FALSE)
                    shingle : plot(equal.count(rnorm(1000)))
  > 
  > 
  > pdf("test-call.pdf")
  > for (m in names(test.objects))
  + {
  +     lab <- paste(deparse(test.objects[[m]]$call), collapse = "")
  +     print(update(test.objects[[m]],
  +                  page = function(n) panel.text(0.5, 1, labels = lab, pos = 1)))
  + }
  > dev.off()
  pdf 
    2 
  > 
  > 
  > proc.time()
     user  system elapsed 
     2.81    0.14    2.93 
Running the tests in 'tests/colorkey-title.R' failed.
Complete output:
  > postscript("colorkey-title.ps")
  > 
  > library(lattice)
  > 
  > levelplot(volcano) # no title
  > 
  > levelplot(volcano, colorkey = list(title = "Height", space = "bottom"))
  > levelplot(volcano, colorkey = list(title = "Height", space = "top")) # ??
  > levelplot(volcano, colorkey = list(title = "Height", space = "left")) # ??
  > levelplot(volcano, colorkey = list(title = "Height", space = "right"))
  > 
  > levelplot(volcano,
  +           colorkey = list(space = "bottom",
  +                           title = list(label = "Height", rot = 0, y = 1, vjust = 0),
  +                           title.control = list(side = "left", padding = 0.5)))
  > 
  > levelplot(volcano,
  +           colorkey = list(space = "right",
  +                           title = list(label = "Height", cex = 1, x = 0, hjust = 0),
  +                           title.control = list(side = "top")))
  > 
  > 
  > require(grid)
  Loading required package: grid
  > f <- frameGrob(layout = grid.layout(heights = unit(0, "mm")))
  > f <- placeGrob(f, textGrob("Height", x = 0, y = 1, hjust = 0, vjust = -0.5))
  > 
  > levelplot(volcano,
  +           colorkey = list(space = "right", title = f,
  +                           title.control = list(side = "top", padding = 0)))
  > 
  > dev.off()
  null device 
            1 
  > 
  > proc.time()
     user  system elapsed 
     1.01    0.12    1.12 
Running the tests in 'tests/dotplotscoping.R' failed.
Complete output:
  > postscript("dotplotscoping.ps")
  > library(lattice)
  > 
  > fubar <- function() {
  +     k <- 2
  +     kkk <- 1:10
  +     names(kkk) <- 1:10
  +     data = list(x=kkk)
  +     dotplot(~x^k + rnorm(10), data)
  + }
  > 
  > fubar()
  > dev.off()
  null device 
            1 
  > 
  > proc.time()
     user  system elapsed 
     0.26    0.09    0.34 
Running the tests in 'tests/fontsize.R' failed.
Complete output:
  > library(lattice)
  > 
  > pdf("fontsize.pdf", pointsize = 5)
  > 
  > splom(iris, sub = "pdf:fontsize = 5")
  > 
  > trellis.par.set(grid.pars = list(fontsize = 5))
  > splom(iris, sub = "grid.pars:fontsize = 5")
  > 
  > trellis.par.set(grid.pars = list(fontsize = 10))
  > splom(iris, sub = "grid.pars:fontsize = 10")
  > 
  > trellis.par.set(fontsize = list(text = 15))
  > splom(iris, sub = "grid.pars:fontsize = 15")
  > 
  > dev.off()
  null device 
            1 
  > 
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.89    0.06    0.93 
Running the tests in 'tests/levelplot.R' failed.
Complete output:
  > 
  > pdf("levelplot.pdf")
  > 
  > library(lattice)
  > 
  > data(volcano)
  > 
  > 
  > foo <-
  +     data.frame(z = as.vector(volcano),
  +                x = rep(log1p(1:87), 61),
  +                y = rep(1:61, each = 87))
  > 
  > system.time(print(levelplot(z ~ x * y, foo, contour = TRUE)))
     user  system elapsed 
     0.10    0.00    0.09 
  > 
  > system.time(print(levelplot(z ~ x * y, foo, contour = TRUE,
  +                             panel = panel.levelplot.raster)))
     user  system elapsed 
     0.03    0.02    0.05 
  Warning message:
  In (function (x, y, z, subscripts, at = pretty(z), ..., col.regions = regions$col,  :
    'x' values are not equispaced; output may be wrong
  > 
  > system.time(print(levelplot(z ~ x * y, foo, contour = TRUE,
  +                             region.type = "contour")))
     user  system elapsed 
     0.36    0.17    0.53 
  > 
  > levelplot(z ~ x * y, subset(foo, z > 150), contour = T)
  > 
  > ## region.type = "contour" does not support missing grid points
  > suppressWarnings(plot(levelplot(z ~ x * y, subset(foo, z > 150),
  +                                 contour = T,
  +                                 main = "Expect error",
  +                                 region.type = "contour")))
  > 
  > 
  > levelplot(z ~ x * y, foo, subset = z > 150, contour = T)
  > contourplot(z ~ x * y, foo, subset = z > 150, cuts = 10)
  > 
  > ## manual colorkey labels
  > levelplot(z ~ x * y, foo, subset = z > 150,
  +           colorkey = list(labels = list(at     = c(145, 150),
  +                                         labels = c("below min", 150))))
  > ## lattice <= 0.21-5 put the "below min" label at z=150
  > 
  > ## This should be an error because 'labels' are specified without 'at':
  > 
  > e <- 
  +     try(print(levelplot(z ~ x * y, foo, subset = z > 150,
  +                         colorkey = list(labels = list(labels = c("A", "B"))))),
  +         silent = TRUE)
  > stopifnot(inherits(e, "try-error"))
  > 
  > ## subset group interaction has problems (does it any longer?):
  > 
  > cloud(Sepal.Length ~ Petal.Length * Petal.Width, 
  +       data = iris, cex = 0.8, groups = Species, subpanel = panel.superpose, 
  +       main = "With subset", screen = list(z = 20, x = -70, y = 0), subset = 30:60)
  > 
  > cloud(Sepal.Length ~ Petal.Length * Petal.Width, 
  +       data = iris[30:60, ], cex = 0.8, groups = Species, subpanel = panel.superpose, 
  +       main = "Without subset", screen = list(z = 20, x = -70, y = 0))
  > 
  > 
  > levelplot(Sepal.Length ~ Petal.Length * Petal.Width, 
  +           data = iris, groups = Species, 
  +           subset = 30:60)
  > 
  > cloud(z ~ x * y, foo)
  > cloud(z ~ x * y, foo, subset = z > 150)
  > 
  > ## long format: NA's clipped at the beginning (??)
  > 
  > splom(~iris[,1:4], iris, groups = Species)
  > splom(~iris[,1:4], iris, groups = Species, subset = 70:130, auto.key = T)
  > 
  > parallelplot(~iris[,1:4] | Species, iris, subset = 30:130)
  > 
  > ## NA-s in matrix
  > 
  > volna <- volcano
  > volna[20:40, 20:40] <- NA
  > levelplot(volna)
  > levelplot(volna, region.type = "contour")
  > cloud(volna)
  > wireframe(volna)
  > 
  > dev.off()
  null device 
            1 
  > 
  > 
  > 
  > 
  > # grid.newpage()
  > # pushViewport(viewport())
  > # grid.lines(x = c(1:5, NA, 7:10) / 10,
  > #            y = c(1:5, NA, 7:10) / 10)
  > 
  > # grid.points(x = c(1:5, NA, 7:10) / 10,
  > #             y = c(1:5, 6, 7:10) / 10)
  > 
  > 
  > 
  > 
  > # grid.points(x = .5, y = .1, pch = 16, gp = gpar(cex  = 1))
  > # grid.points(x = .5, y = .2, pch = 16, gp = gpar(cex  = 3))
  > 
  > # grid.points(x = .5, y = .3, pch = '+', gp = gpar(cex  = 1))
  > # grid.points(x = .5, y = .4, pch = '+', gp = gpar(cex  = 3))
  > 
  > 
  > 
  > 
  > # viewport[ROOT] ->
  > 
  > #     (viewport[GRIDVP1182]->
  > 
  > #      (viewport[GRIDVP1185],
  > #       viewport[GRIDVP1187],
  > #       viewport[GRIDVP1189],
  > #       viewport[GRIDVP1190],
  > 
  > #       viewport[panel.1]->
  > 
  > #       (viewport[GRIDVP1184]->
  >        
  > #        (viewport[subpanel.1.1],
  > #         viewport[subpanel.1.2], viewport[subpanel.1.3],
  > #         viewport[subpanel.2.1], viewport[subpanel.2.2],
  > #         viewport[subpanel.2.3], viewport[subpanel.3.1],
  > #         viewport[subpanel.3.2], viewport[subpanel.3.3])),
  > 
  > #       viewport[panel.2]->
  > #       (viewport[GRIDVP1186]->
  > #        (viewport[subpanel.1.1],
  > #         viewport[subpanel.1.2], viewport[subpanel.1.3],
  > #         viewport[subpanel.2.1], viewport[subpanel.2.2],
  > #         viewport[subpanel.2.3], viewport[subpanel.3.1],
  > #         viewport[subpanel.3.2], viewport[subpanel.3.3])),
  > 
  > #       viewport[panel.3]->
  > #       (viewport[GRIDVP1188]->
  > #        (viewport[subpanel.1.1],
  > #         viewport[subpanel.1.2], viewport[subpanel.1.3],
  > #         viewport[subpanel.2.1], viewport[subpanel.2.2],
  > #         viewport[subpanel.2.3], viewport[subpanel.3.1],
  > #         viewport[subpanel.3.2], viewport[subpanel.3.3]))))
  > 
  > 
  > proc.time()
     user  system elapsed 
     2.26    0.56    2.81 
Running the tests in 'tests/shade-wireframe.R' failed.
Complete output:
  > 
  > library(lattice)
  > 
  > pdf("shade-wireframe.pdf")
  > 
  > classicShadePalette <- function(irr, ref, height, saturation = .9)
  + {
  +     hsv(h = height, s = 1 - saturation * (1 - (1-ref)^0.5), v = irr)
  + }
  > trellis.par.set(shade.colors = list(palette = classicShadePalette))
  > wireframe(volcano, shade = TRUE)
  > 
  > ## Using makeShadePalette()
  > 
  > ## matte
  > cm.palette <- makeShadePalette(cm.colors(10), pref = 0.2)
  > trellis.par.set(shade.colors = list(palette = cm.palette))
  > wireframe(volcano, shade = TRUE)
  > 
  > ## glossy
  > cm.palette <- makeShadePalette(cm.colors(10), pref = 1.2)
  > trellis.par.set(shade.colors = list(palette = cm.palette))
  > wireframe(volcano, shade = TRUE)
  > 
  > ygb.palette <- makeShadePalette(rev(hcl.colors(12, "YlGnBu")))
  > trellis.par.set(shade.colors = list(palette = ygb.palette))
  > wireframe(volcano, shade = TRUE)
  > 
  > dev.off()
  null device 
            1 
  > 
  > proc.time()
     user  system elapsed 
     3.14    0.09    3.23 
Running the tests in 'tests/test.R' failed.
Complete output:
  > postscript("test.ps")
  > library(lattice)
  > 
  > lattice.options(default.args =
  +                 list(page = function(n) {
  +                     grid::grid.text(label = paste(deparse(trellis.last.object()$call, width.cutoff = 150L), collapse = "\n"),
  +                                     x = 0.01, y = 0.99, just = c("left", "top"))
  +                 }))
  > 
  > densityplot(~ 5)
  > densityplot(~ 1:5 | letters[1:5])
  > 
  > x <- rnorm(200)
  > y <- rnorm(200)
  > z <- equal.count(rnorm(200))
  > a <- factor(rep(1:3, len = 200))
  > 
  > df.test <- list(xx = x+1-min(x), yy = y, zz = z, aa = a)
  > 
  > xyplot(y ~ x | z * a, strip = function(...) strip.default(..., style = 4),
  +        par.strip.text = list(cex = 2, col = "blue", font = 2),
  +        ##scales = list(x = list(draw = FALSE),  y = "sliced"))
  +        scales = list(x = list(rot = 0), y = list(rot = 0)))
  > 
  > xyplot(a ~ x | z,
  +        main = "xyplot call with modified options",
  +        lattice.options =
  +        list(panel.xyplot = "panel.bwplot",
  +             default.args = list(between = list(x = 1, y = 1))))
  > 
  > 
  > 
  > 
  > bwplot(zz ~ xx | aa, df.test)
  > 
  > bwplot(aa ~ xx | zz, df.test, 
  +        scales =
  +        list(x = list(log = "e", tck = 5, rot = 90,  cex = 2),
  +             y = list(col = "red", tck = 3, alternating = TRUE, cex = 5,  rot = 0),
  +             tick.number = 20),
  +        main = list("main", cex = 5),
  +        sub = list("sub", cex = 5),
  +        xlab = list("xlab", cex = 5),
  +        ylab = list("ylab", cex = 5))
  > 
  > 
  > bwplot(~zz , df.test)
  > bwplot(~xx , df.test)
  > 
  > dotplot(zz ~ xx | aa, df.test)
  > dotplot(aa ~ xx | zz, df.test)
  > 
  > dotplot(~zz , df.test)
  > dotplot(~xx , df.test)
  > 
  > stripplot(zz ~ xx | aa, df.test)
  > stripplot(aa ~ xx | zz, df.test)
  > stripplot(~zz , df.test)
  > stripplot(~xx , df.test)
  > 
  > 
  > 
  > xa <- 1:8
  > xb <- rep( c( NA, 10 ), 4 )
  > 
  > xc <- rep( c( 'C2', 'C1' ), 4 )
  > xyplot( xa ~ xb | xc)
  > xyplot( xa ~ xb | xc, scales = "free")
  > 
  > xc <- rep( c( 'C1', 'C2' ), 4 )
  > xyplot( xa ~ xb | xc)
  > xyplot( xa ~ xb | xc, scales = "free")
  > 
  > x = sample(1:3, 100, replace=TRUE)
  > histogram( ~ x, breaks=c(0,1.5,2.5,3.5), type='count')
  Warning message:
  In histogram.formula(~x, breaks = c(0, 1.5, 2.5, 3.5), type = "count") :
    type='count' can be misleading in this context
  > histogram( ~ x, breaks=c(0,1.5,2.5,3.5), type='density')
  > 
  > 
  > ## splom pscales
  > 
  > data(iris)
  > iris2 <- iris[,1:4]
  > 
  > splom(iris2, groups = iris$Species,
  +       pscales = 10)
  > 
  > splom(iris2, groups = iris$Species,
  +       pscales = list(list(at = 6, lab = "six"), list(at = 3), list(at = 4), list(at = 1)))
  > 
  > splom(iris2, groups = iris$Species,
  +       pscales = list(list(at = 6, lab = "six", limits = c(-10, 10)),
  +       list(at = 3), list(at = 4), list(limits = c(-5, 5))))
  > 
  > 
  > ## factors in formula
  > 
  > data(barley)
  > levelplot(yield ~ year * variety | site, barley,
  +           panel = function(x, y, ...) {
  +               x <- as.numeric(x)
  +               y <- as.numeric(y)
  +               panel.levelplot(x, y, ...)
  +           })
  > 
  > 
  > data(volcano)
  > levelplot(volcano, key = list(x = .5, y = .5, points = list(col = 1:3)),
  +           legend = list(top = list(fun = grid::textGrob("This \nis \na \nstupid \nlegend"))))
  > 
  > 
  > ## demo of seekViewport
  > 
  > library(grid)
  > 
  > splom(~iris[1:3]|Species, data = iris, 
  +       layout=c(2,2), pscales = 0,
  +       varnames = c("Sepal\nLength", "Sepal\nWidth", "Petal\nLength"),
  +       page = function(...) {
  +           ltext(x = seq(.6, .8, len = 4), 
  +                 y = seq(.9, .6, len = 4), 
  +                 lab = c("Three", "Varieties", "of", "Iris"),
  +                 cex = 2)
  +       }, par.settings = list(clip = list(panel = FALSE)))
  > 
  > seekViewport(vpPath(trellis.vpname("panel", 1, 1), "pairs", "subpanel.2.3"))
  > grid.yaxis(main = TRUE)
  > 
  > seekViewport(vpPath(trellis.vpname("panel", 2, 1), "pairs", "subpanel.2.1"))
  > grid.yaxis(main = FALSE)
  > 
  > seekViewport(vpPath(trellis.vpname("panel", 1, 2), "pairs", "subpanel.2.2"))
  > grid.yaxis(main = FALSE)
  > 
  > demo("lattice")
  
  
  	demo(lattice)
  	---- ~~~~~~~
  
  > require(grid)
  
  > old.prompt <- devAskNewPage(TRUE)
  
  > ## store current settings, to be restored later
  > old.settings <- trellis.par.get()
  
  > ## changing settings to new 'theme'
  > trellis.par.set(theme = col.whitebg())
  
  > ## simulated example, histogram and kernel density estimate superposed
  > x <- rnorm(500)
  
  > densityplot(~x)
  
  > histogram(x, type = "density", 
  +           panel = function(x, ...) {
  +               panel.histogram(x, ...) 
  +               panel.densityplot(x, col = "brown", plot.points = FALSE)
  +           })
  
  > ## Using a custom panel function to superpose a fitted normal density
  > ## on a Kernel Density Estimate
  > 
  > densityplot( ~ height | voice.part, data = singer, layout = c(2, 4),  
  +             xlab = "Height (inches)",
  +             ylab = "Kernel Density\n with Normal Fit",
  +             main = list("Estimated Density", cex = 1.4, col = "DarkOliveGreen"),
  +             panel = function(x, ...) {
  +                 panel.densityplot(x, ...)
  +                 panel.mathdensity(dmath = dnorm,
  +                                   args = list(mean=mean(x),sd=sd(x)))
  +             } )
  
  > ## user defined panel functions and fonts
  > 
  > states <- data.frame(state.x77,
  +                      state.name = dimnames(state.x77)[[1]], 
  +                      state.region = factor(state.region)) 
  
  > xyplot(Murder ~ Population | state.region, data = states, 
  +        groups = state.name,
  +        panel = function(x, y, subscripts, groups)  
  +        ltext(x = x, y = y, labels = groups[subscripts],
  +              cex=.9, fontfamily = "HersheySans", fontface = "italic"),
  +        par.strip.text = list(cex = 1.3, font = 4, col = "brown"),
  +        xlab = list("Estimated Population, July 1, 1975", font = 2),
  +        ylab = list("Murder Rate (per 100,000 population), 1976", font = 2),
  +        main = list("Murder Rates in US states", col = "brown", font = 4))
  
  > ##graphical parameters for xlab etc can also be changed permanently
  > trellis.par.set(list(par.xlab.text = list(font = 2),
  +                      par.ylab.text = list(font = 2),
  +                      par.main.text = list(font = 4, col = "brown")))
  
  > ## Same with some multiple line text
  > levels(states$state.region) <-
  +     c("Northeast", "South", "North\n Central",  "West")
  
  > xyplot(Murder  ~ Population | state.region, data = states,
  +        groups = as.character(state.name),
  +        panel = function(x, y, subscripts, groups)
  +        ltext(x = x, y = y, labels = groups[subscripts], srt = -50, col = "blue",
  +              cex=.9, fontfamily = "HersheySans"),
  +        par.strip.text = list(cex = 1.3, font = 4, col = "brown", lines = 2),
  +        xlab = "Estimated Population\nJuly 1, 1975", 
  +        ylab = "Murder Rate \n(per 100,000 population)\n 1976", 
  +        main = "Murder Rates in US states")
  
  > ##setting these back to their defaults
  > trellis.par.set(list(par.xlab.text = list(font = 1),
  +                      par.ylab.text = list(font = 1),
  +                      par.main.text = list(font = 2, col = "black")))
  
  > ##levelplot
  > 
  > levelplot(volcano, colorkey = list(space = "top"),
  +           sub = "Maunga Whau volcano", aspect = "iso")
  
  > ## wireframe
  > wireframe(volcano, shade = TRUE,
  +           aspect = c(61/87, 0.4),
  +           screen = list(z = -120, x = -45),
  +           light.source = c(0,0,10), distance = .2,
  +           shade.colors.palette = function(irr, ref, height, w = .5)
  +           grey(w * irr + (1 - w) * (1 - (1-ref)^.4)))
  
  > ## 3-D surface parametrized on a 2-D grid
  > 
  > n <- 50
  
  > tx <- matrix(seq(-pi, pi, length.out = 2*n), 2*n, n)
  
  > ty <- matrix(seq(-pi, pi, length.out = n) / 2, 2*n, n, byrow = T)
  
  > xx <- cos(tx) * cos(ty)
  
  > yy <- sin(tx) * cos(ty)
  
  > zz <- sin(ty)
  
  > zzz <- zz
  
  > zzz[,1:12 * 4] <- NA
  
  > wireframe(zzz ~ xx * yy, shade = TRUE, light.source = c(3,3,3))
  
  > ## Example with panel.superpose. 
  > 
  > xyplot(Petal.Length~Petal.Width, data = iris, groups=Species, 
  +        panel = panel.superpose,
  +        type = c("p", "smooth"), span=.75,
  +        col.line = trellis.par.get("strip.background")$col,
  +        col.symbol = trellis.par.get("strip.shingle")$col,
  +        key = list(title = "Iris Data", x = .15, y=.85, corner = c(0,1),
  +            border = TRUE, 
  +            points = list(col=trellis.par.get("strip.shingle")$col[1:3],
  +            pch = trellis.par.get("superpose.symbol")$pch[1:3],
  +            cex = trellis.par.get("superpose.symbol")$cex[1:3]
  +            ),
  +            text = list(levels(iris$Species))))
  
  > ## non-trivial strip function
  > 
  > barchart(variety ~ yield | year * site, barley, origin = 0,
  +          layout = c(4, 3),
  +          between = list(x = c(0, 0.5, 0)),
  +          ## par.settings = list(clip = list(strip = "on")),
  +          strip =
  +          function(which.given,
  +                   which.panel,
  +                   factor.levels,
  +                   bg = trellis.par.get("strip.background")$col[which.given],
  +                   ...) {
  +              axis.line <- trellis.par.get("axis.line")
  +              pushViewport(viewport(clip = trellis.par.get("clip")$strip,
  +                                    name = trellis.vpname("strip")))
  +              if (which.given == 1)
  +              {
  +                  grid.rect(x = .26, just = "right",
  +                            name = trellis.grobname("fill", type="strip"),
  +                            gp = gpar(fill = bg, col = "transparent"))
  +                  ltext(factor.levels[which.panel[which.given]],
  +                        x = .24, y = .5, adj = 1,
  +                        name.type = "strip")
  +              }
  +              if (which.given == 2)
  +              {
  +                  grid.rect(x = .26, just = "left",
  +                            name = trellis.grobname("fill", type="strip"),
  +                            gp = gpar(fill = bg, col = "transparent"))
  +                  ltext(factor.levels[which.panel[which.given]],
  +                        x = .28, y = .5, adj = 0,
  +                        name.type = "strip")
  +              }
  +              upViewport()
  +              grid.rect(name = trellis.grobname("border", type="strip"),
  +                        gp =
  +                        gpar(col = axis.line$col,
  +                             lty = axis.line$lty,
  +                             lwd = axis.line$lwd,
  +                             alpha = axis.line$alpha,
  +                             fill = "transparent"))
  +          }, par.strip.text = list(lines = 0.4))
  
  > trellis.par.set(theme = old.settings, strict = 2)
  
  > devAskNewPage(old.prompt)
  > dev.off()
  null device 
            1 
  > 
  > 
  > 
  > proc.time()
     user  system elapsed 
     2.84    0.12    2.95 
Running the tests in 'tests/wireframe.R' failed.
Complete output:
  > 
  > library(lattice)
  > 
  > pdf("wireframe.pdf")
  > 
  > data(volcano)
  > 
  > foo <-
  +     data.frame(z = as.vector(volcano),
  +                x = rep(1:87, 61),
  +                y = rep(1:61, each = 87))
  > 
  > wireframe(z ~ x * y, foo)
  > 
  > ## this used to give an error, but seems fine now (?)
  > wireframe(z ~ x * y, foo, subset = z > 150)
  > 
  > 
  > ## Example 1 (a). valgrind shows warnings, starting with
  > 
  > 
  > ## ==9058== Invalid read of size 8
  > ## ==9058==    at 0xA450AFF: wireframePanelCalculations (threeDplot.c:291)
  > 
  > ## and subsequently in various other places in that function leading to
  > 
  > ## ==9058== Conditional jump or move depends on uninitialised value(s)
  > ## ==9058==    at 0x3FFAA466CF: __printf_fp (in /lib64/libc-2.4.so)
  > ## ==9058==    by 0x3FFAA423AE: vfprintf (in /lib64/libc-2.4.so)
  > ## ==9058==    by 0x3FFAA4A477: fprintf (in /lib64/libc-2.4.so)
  > ## ==9058==    by 0x94975BE: PostScriptRLineTo (devPS.c:2683)
  > 
  > ## A bit more tracing shows it is accessing element 4016 in an array of
  > ## length 2456, and the plot seems nonsense (and random) when viewed on
  > ## screen. (BDR, 2006/09/17)
  > 
  > ## DS's earlier comment: what's this supposed to do ?  weird thing is,
  > ## result is random (probably indicator of memory access errors)
  > 
  > if (FALSE)
  + {
  + 
  +     wireframe(z + I(z + 100) ~ x * y, foo,
  +               subset = z > 150,
  +               scales = list(arrows = FALSE))
  + }
  > 
  > ## this works as expected
  > 
  > wireframe(z + I(z + 100) ~ x * y, foo)
  > 
  > ## Example 1 (b).  Another way of seeing the problem:
  > 
  > ## this is OK:
  > 
  > bar <- foo
  > bar$z[bar$z < 150] <- NA
  > wireframe(z + I(z + 100) ~ x * y, bar,
  +           scales = list(arrows = FALSE))
  > 
  > ## but this is not
  > if (FALSE)
  + {
  +     wireframe(z + I(z + 100) ~ x * y,
  +               subset(bar, !is.na(z)),
  +               scales = list(arrows = FALSE))
  + }
  > 
  > 
  > ## Example 2.  Probably another example of the same "bug": see
  > ## https://stat.ethz.ch/pipermail/r-devel/2005-September/034544.html
  > 
  > 
  > n <- 20
  > psteps <- 50
  > binomtable <- function(n, psteps)
  + {
  +     x <- (0:(10*n))/10
  +     p <- (0:psteps)/psteps
  +     dd <- expand.grid(x=x,p=p)
  +     dd$F <- pbinom(dd$x,n,dd$p)
  +     dd$x0 <-trunc(dd$x)
  +     dd
  + }
  > 
  > bt <- binomtable(n = 5, psteps = 100)
  > bt[bt$x - bt$x0 >= 0.9, ]$F <- NA
  > 
  > if (FALSE)
  + {
  +     ## this is problematic
  +     wireframe(F ~ x * p, bt,
  +               groups = bt$x0, shade = TRUE,
  +               scales = list(arrows = FALSE)) 
  + }
  > 
  > ## this one OK
  > wireframe(F ~ x * p, bt, shade = TRUE,
  +           scales = list(arrows = FALSE))
  > 
  > ## this too
  > wireframe(F ~ x * p | factor(x0), bt,
  +           ## groups = bt$x0,
  +           shade = TRUE,
  +           scales = list(arrows = FALSE)) 
  > 
  > 
  > ## Working hypothesis: the problem crops up when there are groups
  > ## (specified either directly or through the formula interface) AND x
  > ## and y values for each group don't represent the full evaluation
  > ## grid.  The second condition is a bit unclear.  In example 2, each
  > ## group's support is disjoint from that of the others.  In example 1,
  > ## both groups have the same support, they are just not the full grid.
  > 
  > dev.off()
  null device 
            1 
  > 
  > proc.time()
     user  system elapsed 
     2.73    0.06    2.78