R Under development (unstable) (2023-10-21 r85382 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2023 The R Foundation for Statistical Computing
Platform: x86_64-w64-mingw32/x64

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> 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 
   1.96    0.10    2.06