R Under development (unstable) (2024-03-19 r86153 ucrt) -- "Unsuffered Consequences"
Copyright (C) 2024 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.

> 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 
   4.29    0.17    4.48