Running 'MASSch04.R' [151s]
  Running 'auto-key.R' [2s]
  Running 'barchart-width.R' [161s]
  Running 'call.R' [3s]
  Running 'colorkey-title.R' [1s]
  Running 'dataframe-methods.R' [4s]
  Running 'dates.R' [172s]
  Running 'dotplotscoping.R' [0s]
  Running 'fontsize.R' [161s]
  Running 'levelplot.R' [4s]
  Running 'scales.R' [3s]
  Running 'shade-wireframe.R' [5s]
  Running 'summary.R' [0s]
  Running 'temp.R' [3s]
  Running 'test.R' [4s]
  Running 'wireframe.R' [166s]
Running the tests in 'tests/MASSch04.R' failed.
Complete output:
  > #-*- R -*-
  > 
  > ## Script from Fourth Edition of `Modern Applied Statistics with S'
  > 
  > # Chapter 4   Graphical Output
  > 
  > library(MASS)
  > library(lattice)
  > trellis.device(postscript, file="MASS-ch04.ps", width=8, height=6,
  +                pointsize=9)
  > options(echo=T, width=65, digits=5)
  > 
  > 
  > # 4.2  Basic plotting functions
  > 
  > topo.loess <- loess(z ~ x * y, topo, degree = 2, span = 0.25)
  > topo.mar <- list(x = seq(0, 6.5, 0.2), y=seq(0, 6.5, 0.2))
  > topo.lo <- predict(topo.loess, expand.grid(topo.mar))
  > topo.lo1 <- cbind(expand.grid(x=topo.mar$x, y=topo.mar$y),
  +                   z=as.vector(topo.lo))
  > contourplot(z ~ x * y, topo.lo1, aspect = 1,
  +   at = seq(700, 1000, 25), xlab = "", ylab = "",
  +   panel = function(x, y, subscripts, ...) {
  +      panel.levelplot(x, y, subscripts, ...)
  +      panel.xyplot(topo$x, topo$y, cex = 0.5)
  +   }
  + )
  > 
  > 
  > 
  > 
  > 
  > 
  > 
  > # 4.5  Trellis graphics
  > 
  > 
  > xyplot(time ~ dist, data = hills,
  +   panel = function(x, y, ...) {
  +      panel.xyplot(x, y, ...)
  +      panel.lmline(x, y, type = "l")
  +      panel.abline(lqs(y ~ x), lty = 3)
  + #     identify(x, y, row.names(hills))
  +   }
  + )
  > 
  > bwplot(Expt ~ Speed, data = michelson, ylab = "Experiment No.",
  +        main = "Speed of Light Data")
  > 
  > 
  > data(swiss)
  > splom(~ swiss, aspect = "fill",
  +   panel = function(x, y, ...) {
  +      panel.xyplot(x, y, ...); panel.loess(x, y, ...)
  +   }
  + )
  > 
  > sps <- trellis.par.get("superpose.symbol")
  > sps$pch <- 1:7
  > trellis.par.set("superpose.symbol", sps)
  > xyplot(Time ~ Viscosity, data = stormer, groups = Wt,
  +    panel = panel.superpose, type = "b",
  +    key = list(columns = 3,
  +        text = list(paste(c("Weight:   ", "", ""),
  +                          unique(stormer$Wt), "gms")),
  +        points = Rows(sps, 1:3)
  +        )
  + )
  > rm(sps)
  > 
  > topo.plt <- expand.grid(topo.mar)
  > topo.plt$pred <- as.vector(predict(topo.loess, topo.plt))
  > levelplot(pred ~ x * y, topo.plt, aspect = 1,
  +   at = seq(690, 960, 10), xlab = "", ylab = "",
  +   panel = function(x, y, subscripts, ...) {
  +      panel.levelplot(x, y, subscripts, ...)
  +      panel.xyplot(topo$x,topo$y, cex = 0.5, col = 1)
  +   }
  + )
  > 
  > ## if (F) {
  > wireframe(pred ~ x * y, topo.plt, aspect = c(1, 0.5),
  +   drape = T, screen = list(z = -150, x = -60),
  +   colorkey = list(space="right", height=0.6))
  > ## }
  > 
  > lcrabs.pc <- predict(princomp(log(crabs[,4:8])))
  > crabs.grp <- c("B", "b", "O", "o")[rep(1:4, each = 50)]
  > splom(~ lcrabs.pc[, 1:3], groups = crabs.grp,
  +    panel = panel.superpose,
  +    key = list(text = list(c("Blue male", "Blue female",
  +                             "Orange Male", "Orange female")),
  +        points = Rows(trellis.par.get("superpose.symbol"), 1:4),
  +        columns = 4)
  +   )
  > 
  > sex <- crabs$sex
  > levels(sex) <- c("Female", "Male")
  > sp <- crabs$sp
  > levels(sp) <- c("Blue", "Orange")
  > splom(~ lcrabs.pc[, 1:3] | sp*sex, cex = 0.5, pscales = 0)
  > 
  > Quine <- quine
  > levels(Quine$Eth) <- c("Aboriginal", "Non-aboriginal")
  > levels(Quine$Sex) <- c("Female", "Male")
  > levels(Quine$Age) <- c("primary", "first form",
  +                       "second form", "third form")
  > levels(Quine$Lrn) <- c("Average learner", "Slow learner")
  > bwplot(Age ~ Days | Sex*Lrn*Eth, data = Quine)
  > 
  > bwplot(Age ~ Days | Sex*Lrn*Eth, data = Quine, layout = c(4, 2),
  +       strip = function(...) strip.default(..., style = 1))
  > 
  > stripplot(Age ~ Days | Sex*Lrn*Eth, data = Quine,
  +          jitter = TRUE, layout = c(4, 2))
  > 
  > stripplot(Age ~ Days | Eth*Sex, data = Quine,
  +    groups = Lrn, jitter = TRUE,
  +    panel = function(x, y, subscripts, jitter.data = F, ...) {
  +        if(jitter.data)  y <- jitter(as.numeric(y))
  +        panel.superpose(x, y, subscripts, ...)
  +    },
  +    xlab = "Days of absence",
  +    between = list(y = 1), par.strip.text = list(cex = 0.7),
  +    key = list(columns = 2, text = list(levels(Quine$Lrn)),
  +        points = Rows(trellis.par.get("superpose.symbol"), 1:2)
  +        ),
  +    strip = function(...)
  +         strip.default(..., strip.names = c(TRUE, TRUE), style = 1)
  + )
  > 
  > fgl0 <- fgl[ ,-10] # omit type.
  > fgl.df <- data.frame(type = rep(fgl$type, 9),
  +   y = as.vector(as.matrix(fgl0)),
  +   meas = factor(rep(1:9, each = 214), labels = names(fgl0)))
  > stripplot(type ~ y | meas, data = fgl.df,
  +   scales = list(x = "free"), xlab = "", cex = 0.5,
  +   strip = function(...) strip.default(style = 1, ...))
  > 
  > if(F) { # no data supplied
  + xyplot(ratio ~ scant | subject, data = A5,
  +       xlab = "scan interval (years)",
  +       ylab = "ventricle/brain volume normalized to 1 at start",
  +       subscripts = TRUE, ID = A5$ID,
  +       strip = function(factor, ...)
  +          strip.default(..., factor.levels = labs, style = 1),
  +       layout = c(8, 5, 1),
  +       skip = c(rep(FALSE, 37), rep(TRUE, 1), rep(FALSE, 1)),
  +       panel = function(x, y, subscripts, ID) {
  +           panel.xyplot(x, y, type = "b", cex = 0.5)
  +           which <- unique(ID[subscripts])
  +           panel.xyplot(c(0, 1.5), pr3[names(pr3) == which],
  +                        type = "l", lty = 3)
  +           if(which == 303 || which == 341) points(1.4, 1.3)
  +       })
  + }
  > 
  > Cath <- equal.count(swiss$Catholic, number = 6, overlap = 0.25)
  > xyplot(Fertility ~ Education | Cath, data = swiss,
  +   span = 1, layout = c(6, 1), aspect = 1,
  +   panel = function(x, y, span) {
  +      panel.xyplot(x, y); panel.loess(x, y, span)
  +   }
  + )
  > 
  > Cath2 <- equal.count(swiss$Catholic, number = 2, overlap = 0)
  > Agr <- equal.count(swiss$Agric, number = 3, overlap = 0.25)
  > xyplot(Fertility ~ Education | Agr * Cath2, data = swiss,
  +   span = 1, aspect = "xy",
  +   panel = function(x, y, span) {
  +      panel.xyplot(x, y); panel.loess(x, y, span)
  +   }
  + )
  > 
  > Cath
  
  Data:
   [1]   9.96  84.84  93.40  33.77   5.16  90.57  92.85  97.16
   [9]  97.67  91.38  98.61   8.52   2.27   4.43   2.82  24.20
  [17]   3.30  12.11   2.15   2.84   5.23   4.52  15.14   4.20
  [25]   2.40   5.23   2.56   7.72  18.46   6.10  99.71  99.68
  [33] 100.00  98.96  98.22  99.06  99.46  96.83   5.62  13.79
  [41]  11.22  16.92   4.97   8.65  42.34  50.43  58.33
  
  Intervals:
      min    max count
  1  2.14   4.53    10
  2  4.19   7.73    10
  3  6.09  16.93    10
  4 13.78  84.85    10
  5 58.32  98.23    10
  6 97.15 100.01    10
  
  Overlap between adjacent intervals:
  [1] 3 2 3 2 3
  > levels(Cath)
        [,1]   [,2]
  [1,]  2.14   4.53
  [2,]  4.19   7.73
  [3,]  6.09  16.93
  [4,] 13.78  84.85
  [5,] 58.32  98.23
  [6,] 97.15 100.01
  > plot(Cath, aspect = 0.3)
  > 
  > # End of ch04
  > 
  > proc.time()
     user  system elapsed 
     1.96    0.15    2.17 
Running the tests in 'tests/barchart-width.R' failed.
Complete output:
  > 
  > ## Allow custom widths for barcharts? Currently allowed (without NSE),
  > ## but could be improved.
  > 
  > pdf("barchart-width.pdf")
  > 
  > library(lattice)
  > x <- 1:10
  > names(x) <- sample(LETTERS, 10)
  > barchart(x, origin = 0)
  > 
  > barchart(x, origin = 0, box.width = runif(5))
  > barchart(x, origin = 0, box.width = runif(5), horizontal = FALSE)
  > 
  > d <- within(expand.grid(a = gl(4, 1), b = gl(10, 1)),
  + {
  +     x <- rexp(40)
  +     w <- 0.8 * runif(40)
  + })
  > 
  > barchart(b ~ x | a, data = d, origin = 0, box.width = d$w)
  > barchart(b ~ x | a, data = d, origin = 0, box.width = d$w[1:10])
  > 
  > barchart(b ~ x, data = d, groups = a, box.width = d$w)
  > 
  > barchart(b ~ x, data = d, groups = a, stack = TRUE, box.width = d$w)
  > barchart(x ~ b, data = d, groups = a, stack = TRUE, box.width = d$w)
  > 
  > dev.off()
  null device 
            1 
  > 
  > proc.time()
     user  system elapsed 
     0.65    0.09    0.73 
Running the tests in 'tests/dates.R' failed.
Complete output:
  > 
  > postscript("date.ps")
  > library(lattice)
  > 
  > ## POSIXt handling
  > 
  > y <- Sys.time() + 10000 * 1:100
  > x <- rnorm(100)
  > b <- gl(3,1,100)
  > 
  > xyplot(y ~ x | b)
  > xyplot(y ~ x | b, scales = list(relation = "free", rot = 0))
  > xyplot(y ~ x | b, scales = "sliced")
  > 
  > ## Date handling
  > 
  > dat <-
  +     data.frame(a = 1:10,
  +                b = seq(as.Date("2003/1/1"), as.Date("2003/1/10"), by="day"))
  > xyplot(a~b, dat)
  > xyplot(a~b, dat, scales=list(x=list(at=dat$b)))
  > 
  > 
  > dev.off()
  null device 
            1 
  > 
  > 
  > proc.time()
     user  system elapsed 
     0.62    0.07    0.64 
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.93    0.14    1.07 
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 
     3.68    0.04    3.70