R Under development (unstable) (2021-11-30 r81267) -- "Unsuffered Consequences"
Copyright (C) 2021 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

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.

> pkgname <- "graphics"
> source(file.path(R.home("share"), "R", "examples-header.R"))
> options(warn = 1)
> library('graphics')
> 
> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')
> base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')
> cleanEx()
> nameEx("abline")
> ### * abline
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: abline
> ### Title: Add Straight Lines to a Plot
> ### Aliases: abline
> ### Keywords: aplot
> 
> ### ** Examples
> 
> ## Setup up coordinate system (with x == y aspect ratio):
> plot(c(-2,3), c(-1,5), type = "n", xlab = "x", ylab = "y", asp = 1)
> ## the x- and y-axis, and an integer grid
> abline(h = 0, v = 0, col = "gray60")
> text(1,0, "abline( h = 0 )", col = "gray60", adj = c(0, -.1))
> abline(h = -1:5, v = -2:3, col = "lightgray", lty = 3)
> abline(a = 1, b = 2, col = 2)
> text(1,3, "abline( 1, 2 )", col = 2, adj = c(-.1, -.1))
> 
> ## Simple Regression Lines:
> require(stats)
> sale5 <- c(6, 4, 9, 7, 6, 12, 8, 10, 9, 13)
> plot(sale5)
> abline(lsfit(1:10, sale5))
> abline(lsfit(1:10, sale5, intercept = FALSE), col = 4) # less fitting
> 
> z <- lm(dist ~ speed, data = cars)
> plot(cars)
> abline(z) # equivalent to abline(reg = z) or
> abline(coef = coef(z))
> 
> ## trivial intercept model
> abline(mC <- lm(dist ~ 1, data = cars)) ## the same as
> abline(a = coef(mC), b = 0, col = "blue")
> 
> 
> 
> cleanEx()
> nameEx("arrows")
> ### * arrows
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: arrows
> ### Title: Add Arrows to a Plot
> ### Aliases: arrows
> ### Keywords: aplot
> 
> ### ** Examples
> 
> x <- stats::runif(12); y <- stats::rnorm(12)
> i <- order(x, y); x <- x[i]; y <- y[i]
> plot(x,y, main = "arrows(.) and segments(.)")
> ## draw arrows from point to point :
> s <- seq(length(x)-1)  # one shorter than data
> arrows(x[s], y[s], x[s+1], y[s+1], col = 1:3)
> s <- s[-length(s)]
> segments(x[s], y[s], x[s+2], y[s+2], col = "pink")
> 
> 
> 
> cleanEx()
> nameEx("assocplot")
> ### * assocplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: assocplot
> ### Title: Association Plots
> ### Aliases: assocplot
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ## Aggregate over sex:
> x <- marginSums(HairEyeColor, c(1, 2))
> x
       Eye
Hair    Brown Blue Hazel Green
  Black    68   20    15     5
  Brown   119   84    54    29
  Red      26   17    14    14
  Blond     7   94    10    16
> assocplot(x, main = "Relation between hair and eye color")
> 
> 
> 
> cleanEx()
> nameEx("axTicks")
> ### * axTicks
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: axTicks
> ### Title: Compute Axis Tickmark Locations
> ### Aliases: axTicks
> ### Keywords: dplot
> 
> ### ** Examples
> 
>  plot(1:7, 10*21:27)
>  axTicks(1)
[1] 1 2 3 4 5 6 7
>  axTicks(2)
[1] 210 220 230 240 250 260 270
>  stopifnot(identical(axTicks(1), axTicks(3)),
+            identical(axTicks(2), axTicks(4)))
> 
> ## Show how axTicks() and axis() correspond :
> op <- par(mfrow = c(3, 1))
> for(x in 9999 * c(1, 2, 8)) {
+     plot(x, 9, log = "x")
+     cat(formatC(par("xaxp"), width = 5),";", T <- axTicks(1),"\n")
+     rug(T, col =  adjustcolor("red", 0.5), lwd = 4)
+ }
 1000 1e+05     3 ; 200 500 1000 2000 5000 10000 20000 50000 1e+05 2e+05 5e+05 
 1000 1e+06     2 ; 500 1000 5000 10000 50000 1e+05 5e+05 1e+06 
 1000 1e+07     1 ; 1000 10000 1e+05 1e+06 1e+07 
> par(op)
> 
> x <- 9.9*10^(-3:10)
> plot(x, 1:14, log = "x")
> axTicks(1) # now length 7, in R <= 2.13.x gave 'nintLog = Inf' res; then
[1] 1e-02 1e+00 1e+02 1e+04 1e+06 1e+08 1e+10
> ## 1e-01 1e+01 1e+03 1e+05 1e+07 1e+09 1e+11 ; since R 4.2.0: 1e-2 1e0 1e2 .. 1e10
> axTicks(1, nintLog = Inf) # rather too many
 [1] 1e-02 1e-01 1e+00 1e+01 1e+02 1e+03 1e+04 1e+05 1e+06 1e+07 1e+08 1e+09
[13] 1e+10 1e+11
> 
> ## An example using axTicks() without reference to an existing plot
> ## (copying R's internal procedures for setting axis ranges etc.),
> ## You do need to supply _all_ of axp, usr, log, nintLog
> ## standard logarithmic y axis labels
> ylims <- c(0.2, 88)
> get_axp <- function(x) 10^c(ceiling(x[1]), floor(x[2]))
> ## mimic par("yaxs") == "i"
> usr.i <- log10(ylims)
> (aT.i <- axTicks(side = 2, usr = usr.i,
+                  axp = c(get_axp(usr.i), n = 3), log = TRUE, nintLog = 5))
[1]  0.2  0.5  1.0  2.0  5.0 10.0 20.0 50.0
> ## mimic (default) par("yaxs") == "r"
> usr.r <- extendrange(r = log10(ylims), f = 0.04)
> (aT.r <- axTicks(side = 2, usr = usr.r,
+                  axp = c(get_axp(usr.r), 3), log = TRUE, nintLog = 5))
[1]   0.2   0.5   1.0   2.0   5.0  10.0  20.0  50.0 100.0
> 
> ## Prove that we got it right :
> plot(0:1, ylims, log = "y", yaxs = "i")
> stopifnot(all.equal(aT.i, axTicks(side = 2)))
> 
> plot(0:1, ylims, log = "y", yaxs = "r")
> stopifnot(all.equal(aT.r, axTicks(side = 2)))
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("axis.POSIXct")
> ### * axis.POSIXct
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: axis.POSIXct
> ### Title: Date and Date-time Plotting Functions
> ### Aliases: axis.POSIXct axis.Date
> ### Keywords: utilities chron
> 
> ### ** Examples
> 
> with(beaver1, {
+ time <- strptime(paste(1990, day, time %/% 100, time %% 100),
+                  "%Y %j %H %M")
+ plot(time, temp, type = "l") # axis at 4-hour intervals.
+ # now label every hour on the time axis
+ plot(time, temp, type = "l", xaxt = "n")
+ r <- as.POSIXct(round(range(time), "hours"))
+ axis.POSIXct(1, at = seq(r[1], r[2], by = "hour"), format = "%H")
+ })
> 
> plot(.leap.seconds, seq_along(.leap.seconds), type = "n", yaxt = "n",
+      xlab = "leap seconds", ylab = "", bty = "n")
> rug(.leap.seconds)
> ## or as dates
> lps <- as.Date(.leap.seconds)
> plot(lps, seq_along(.leap.seconds),
+      type = "n", yaxt = "n", xlab = "leap seconds",
+      ylab = "", bty = "n")
> rug(lps)
> 
> ## 100 random dates in a 10-week period
> random.dates <- as.Date("2001/1/1") + 70*sort(stats::runif(100))
> plot(random.dates, 1:100)
> # or for a better axis labelling
> plot(random.dates, 1:100, xaxt = "n")
> axis.Date(1, at = seq(as.Date("2001/1/1"), max(random.dates)+6, "weeks"))
> axis.Date(1, at = seq(as.Date("2001/1/1"), max(random.dates)+6, "days"),
+      labels = FALSE, tcl = -0.2)
> 
> 
> 
> cleanEx()
> nameEx("axis")
> ### * axis
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: axis
> ### Title: Add an Axis to a Plot
> ### Aliases: axis
> ### Keywords: aplot
> 
> ### ** Examples
> 
> require(stats) # for rnorm
> plot(1:4, rnorm(4), axes = FALSE)
> axis(1, 1:4, LETTERS[1:4])
> axis(2)
> box() #- to make it look "as usual"
> 
> plot(1:7, rnorm(7), main = "axis() examples",
+      type = "s", xaxt = "n", frame.plot = FALSE, col = "red")
> axis(1, 1:7, LETTERS[1:7], col.axis = "blue")
> # unusual options:
> axis(4, col = "violet", col.axis = "dark violet", lwd = 2)
> axis(3, col = "gold", lty = 2, lwd = 0.5)
> 
> # one way to have a custom x axis
> plot(1:10, xaxt = "n")
> axis(1, xaxp = c(2, 9, 7))
> 
> ## Changing default gap between labels:
> plot(0:100, type="n", axes=FALSE, ann=FALSE)
> title(quote("axis(1, .., gap.axis = f)," ~~ f >= 0))
> axis(2, at = 5*(0:20), las = 1, gap.axis = 1/4)
> gaps <- c(4, 2, 1, 1/2, 1/4, 0.1, 0)
> chG <- paste0(ifelse(gaps == 1, "default:  ", ""),
+               "gap.axis=", formatC(gaps))
> jj <- seq_along(gaps)
> linG <- -2.5*(jj-1)
> for(j in jj) {
+     isD <- gaps[j] == 1 # is default
+     axis (1, at=5*(0:20), gap.axis = gaps[j], padj=-1, line = linG[j],
+           col.axis = if(isD) "forest green" else 1, font.axis= 1+isD)
+ }
> mtext(chG, side=1, padj=-1, line = linG -1/2, cex=3/4,
+       col = ifelse(gaps == 1, "forest green", "blue3"))
> ## now shrink the window (in x- and y-direction) and observe the axis labels drawn
> 
> 
> 
> cleanEx()
> nameEx("barplot")
> ### * barplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: barplot
> ### Title: Bar Plots
> ### Aliases: barplot barplot.default barplot.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> # Formula method
> barplot(GNP ~ Year, data = longley)
> barplot(cbind(Employed, Unemployed) ~ Year, data = longley)
> 
> ## 3rd form of formula - 2 categories :
> op <- par(mfrow = 2:1, mgp = c(3,1,0)/2, mar = .1+c(3,3:1))
> summary(d.Titanic <- as.data.frame(Titanic))
  Class       Sex        Age     Survived      Freq       
 1st :8   Male  :16   Child:16   No :16   Min.   :  0.00  
 2nd :8   Female:16   Adult:16   Yes:16   1st Qu.:  0.75  
 3rd :8                                   Median : 13.50  
 Crew:8                                   Mean   : 68.78  
                                          3rd Qu.: 77.00  
                                          Max.   :670.00  
> barplot(Freq ~ Class + Survived, data = d.Titanic,
+         subset = Age == "Adult" & Sex == "Male",
+         main = "barplot(Freq ~ Class + Survived, *)", ylab = "# {passengers}", legend.text = TRUE)
> # Corresponding table :
> (xt <- xtabs(Freq ~ Survived + Class + Sex, d.Titanic, subset = Age=="Adult"))
, , Sex = Male

        Class
Survived 1st 2nd 3rd Crew
     No  118 154 387  670
     Yes  57  14  75  192

, , Sex = Female

        Class
Survived 1st 2nd 3rd Crew
     No    4  13  89    3
     Yes 140  80  76   20

> # Alternatively, a mosaic plot :
> mosaicplot(xt[,,"Male"], main = "mosaicplot(Freq ~ Class + Survived, *)", color=TRUE)
> par(op)
> 
> 
> # Default method
> require(grDevices) # for colours
> tN <- table(Ni <- stats::rpois(100, lambda = 5))
> r <- barplot(tN, col = rainbow(20))
> #- type = "h" plotting *is* 'bar'plot
> lines(r, tN, type = "h", col = "red", lwd = 2)
> 
> barplot(tN, space = 1.5, axisnames = FALSE,
+         sub = "barplot(..., space= 1.5, axisnames = FALSE)")
> 
> barplot(VADeaths, plot = FALSE)
[1] 0.7 1.9 3.1 4.3
> barplot(VADeaths, plot = FALSE, beside = TRUE)
     [,1] [,2] [,3] [,4]
[1,]  1.5  7.5 13.5 19.5
[2,]  2.5  8.5 14.5 20.5
[3,]  3.5  9.5 15.5 21.5
[4,]  4.5 10.5 16.5 22.5
[5,]  5.5 11.5 17.5 23.5
> 
> mp <- barplot(VADeaths) # default
> tot <- colMeans(VADeaths)
> text(mp, tot + 3, format(tot), xpd = TRUE, col = "blue")
> barplot(VADeaths, beside = TRUE,
+         col = c("lightblue", "mistyrose", "lightcyan",
+                 "lavender", "cornsilk"),
+         legend.text = rownames(VADeaths), ylim = c(0, 100))
> title(main = "Death Rates in Virginia", font.main = 4)
> 
> hh <- t(VADeaths)[, 5:1]
> mybarcol <- "gray20"
> mp <- barplot(hh, beside = TRUE,
+         col = c("lightblue", "mistyrose",
+                 "lightcyan", "lavender"),
+         legend.text = colnames(VADeaths), ylim = c(0,100),
+         main = "Death Rates in Virginia", font.main = 4,
+         sub = "Faked upper 2*sigma error bars", col.sub = mybarcol,
+         cex.names = 1.5)
> segments(mp, hh, mp, hh + 2*sqrt(1000*hh/100), col = mybarcol, lwd = 1.5)
> stopifnot(dim(mp) == dim(hh))  # corresponding matrices
> mtext(side = 1, at = colMeans(mp), line = -2,
+       text = paste("Mean", formatC(colMeans(hh))), col = "red")
> 
> # Bar shading example
> barplot(VADeaths, angle = 15+10*1:5, density = 20, col = "black",
+         legend.text = rownames(VADeaths))
> title(main = list("Death Rates in Virginia", font = 4))
> 
> # Border color
> barplot(VADeaths, border = "dark blue") 
> 
> # Log scales (not much sense here)
> barplot(tN, col = heat.colors(12), log = "y")
> barplot(tN, col = gray.colors(20), log = "xy")
> 
> # Legend location
> barplot(height = cbind(x = c(465, 91) / 465 * 100,
+                        y = c(840, 200) / 840 * 100,
+                        z = c(37, 17) / 37 * 100),
+         beside = FALSE,
+         width = c(465, 840, 37),
+         col = c(1, 2),
+         legend.text = c("A", "B"),
+         args.legend = list(x = "topleft"))
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("box")
> ### * box
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: box
> ### Title: Draw a Box around a Plot
> ### Aliases: box
> ### Keywords: aplot
> 
> ### ** Examples
> 
> plot(1:7, abs(stats::rnorm(7)), type = "h", axes = FALSE)
> axis(1, at = 1:7, labels = letters[1:7])
> box(lty = '1373', col = 'red')
> 
> 
> 
> cleanEx()
> nameEx("boxplot")
> ### * boxplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: boxplot
> ### Title: Box Plots
> ### Aliases: boxplot boxplot.default boxplot.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ## boxplot on a formula:
> boxplot(count ~ spray, data = InsectSprays, col = "lightgray")
> # *add* notches (somewhat funny here <--> warning "notches .. outside hinges"):
> boxplot(count ~ spray, data = InsectSprays,
+         notch = TRUE, add = TRUE, col = "blue")
Warning in (function (z, notch = FALSE, width = NULL, varwidth = FALSE,  :
  some notches went outside hinges ('box'): maybe set notch=FALSE
> 
> boxplot(decrease ~ treatment, data = OrchardSprays, col = "bisque",
+         log = "y")
> ## horizontal=TRUE, switching  y <--> x :
> boxplot(decrease ~ treatment, data = OrchardSprays, col = "bisque",
+         log = "x", horizontal=TRUE)
> 
> rb <- boxplot(decrease ~ treatment, data = OrchardSprays, col = "bisque")
> title("Comparing boxplot()s and non-robust mean +/- SD")
> mn.t <- tapply(OrchardSprays$decrease, OrchardSprays$treatment, mean)
> sd.t <- tapply(OrchardSprays$decrease, OrchardSprays$treatment, sd)
> xi <- 0.3 + seq(rb$n)
> points(xi, mn.t, col = "orange", pch = 18)
> arrows(xi, mn.t - sd.t, xi, mn.t + sd.t,
+        code = 3, col = "pink", angle = 75, length = .1)
> 
> ## boxplot on a matrix:
> mat <- cbind(Uni05 = (1:100)/21, Norm = rnorm(100),
+              `5T` = rt(100, df = 5), Gam2 = rgamma(100, shape = 2))
> boxplot(mat) # directly, calling boxplot.matrix()
> 
> ## boxplot on a data frame:
> df. <- as.data.frame(mat)
> par(las = 1) # all axis labels horizontal
> boxplot(df., main = "boxplot(*, horizontal = TRUE)", horizontal = TRUE)
> 
> ## Using 'at = ' and adding boxplots -- example idea by Roger Bivand :
> boxplot(len ~ dose, data = ToothGrowth,
+         boxwex = 0.25, at = 1:3 - 0.2,
+         subset = supp == "VC", col = "yellow",
+         main = "Guinea Pigs' Tooth Growth",
+         xlab = "Vitamin C dose mg",
+         ylab = "tooth length",
+         xlim = c(0.5, 3.5), ylim = c(0, 35), yaxs = "i")
> boxplot(len ~ dose, data = ToothGrowth, add = TRUE,
+         boxwex = 0.25, at = 1:3 + 0.2,
+         subset = supp == "OJ", col = "orange")
> legend(2, 9, c("Ascorbic acid", "Orange juice"),
+        fill = c("yellow", "orange"))
> 
> ## With less effort (slightly different) using factor *interaction*:
> boxplot(len ~ dose:supp, data = ToothGrowth,
+         boxwex = 0.5, col = c("orange", "yellow"),
+         main = "Guinea Pigs' Tooth Growth",
+         xlab = "Vitamin C dose mg", ylab = "tooth length",
+         sep = ":", lex.order = TRUE, ylim = c(0, 35), yaxs = "i")
> 
> ## more examples in  help(bxp)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("boxplot.matrix")
> ### * boxplot.matrix
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: boxplot.matrix
> ### Title: Draw a Boxplot for each Column (Row) of a Matrix
> ### Aliases: boxplot.matrix
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ## Very similar to the example in ?boxplot
> mat <- cbind(Uni05 = (1:100)/21, Norm = rnorm(100),
+              T5 = rt(100, df = 5), Gam2 = rgamma(100, shape = 2))
> boxplot(mat, main = "boxplot.matrix(...., main = ...)",
+         notch = TRUE, col = 1:4)
> 
> 
> 
> cleanEx()
> nameEx("bxp")
> ### * bxp
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: bxp
> ### Title: Draw Box Plots from Summaries
> ### Aliases: bxp
> ### Keywords: aplot
> 
> ### ** Examples
> 
> require(stats)
> set.seed(753)
> (bx.p <- boxplot(split(rt(100, 4), gl(5, 20))))
$stats
            [,1]        [,2]        [,3]        [,4]        [,5]
[1,] -1.66391873 -2.02625162 -2.12785004 -2.76510496 -1.70034047
[2,] -0.55308292 -0.65897584 -0.86705616 -1.63431484 -0.81848966
[3,] -0.06763313  0.04887846  0.09674026 -0.06712275 -0.01150075
[4,]  0.68813940  0.91705734  1.05562526  0.56746581  0.49017934
[5,]  1.14222667  3.16270157  2.07574986  2.09523462  1.87734641

$n
[1] 20 20 20 20 20

$conf
           [,1]       [,2]       [,3]       [,4]       [,5]
[1,] -0.5061554 -0.5079321 -0.5825407 -0.8450091 -0.4738519
[2,]  0.3708891  0.6056890  0.7760212  0.7107636  0.4508504

$out
[1]  4.115274  3.224584  3.920438  4.168341 -4.357819  2.498006

$group
[1] 1 1 1 4 5 5

$names
[1] "1" "2" "3" "4" "5"

> op <- par(mfrow =  c(2, 2))
> bxp(bx.p, xaxt = "n")
> bxp(bx.p, notch = TRUE, axes = FALSE, pch = 4, boxfill = 1:5)
Warning in bxp(bx.p, notch = TRUE, axes = FALSE, pch = 4, boxfill = 1:5) :
  some notches went outside hinges ('box'): maybe set notch=FALSE
> bxp(bx.p, notch = TRUE, boxfill = "lightblue", frame.plot = FALSE,
+     outline = FALSE, main = "bxp(*, frame.plot= FALSE, outline= FALSE)")
Warning in bxp(bx.p, notch = TRUE, boxfill = "lightblue", frame.plot = FALSE,  :
  some notches went outside hinges ('box'): maybe set notch=FALSE
> bxp(bx.p, notch = TRUE, boxfill = "lightblue", border = 2:6,
+     ylim = c(-4,4), pch = 22, bg = "green", log = "x",
+     main = "... log = 'x', ylim = *")
Warning in bxp(bx.p, notch = TRUE, boxfill = "lightblue", border = 2:6,  :
  some notches went outside hinges ('box'): maybe set notch=FALSE
> par(op)
> op <- par(mfrow = c(1, 2))
> 
> ## single group -- no label
> boxplot (weight ~ group, data = PlantGrowth, subset = group == "ctrl")
> ## with label
> bx <- boxplot(weight ~ group, data = PlantGrowth,
+               subset = group == "ctrl", plot = FALSE)
> bxp(bx, show.names=TRUE)
> par(op)
> 
> ## passing gap.axis=* to axis(), PR#18109:
> boxplot(matrix(100*rnorm(1e3), 50, 20),
+         cex.axis = 1.5, gap.axis = -1)# showing *all* labels
> 
> z <- split(rnorm(1000), rpois(1000, 2.2))
> boxplot(z, whisklty = 3, main = "boxplot(z, whisklty = 3)")
> 
> ## Colour support similar to plot.default:
> op <- par(mfrow = 1:2, bg = "light gray", fg = "midnight blue")
> boxplot(z,   col.axis = "skyblue3", main = "boxplot(*, col.axis=..,main=..)")
> plot(z[[1]], col.axis = "skyblue3", main =    "plot(*, col.axis=..,main=..)")
> mtext("par(bg=\"light gray\", fg=\"midnight blue\")",
+       outer = TRUE, line = -1.2)
> par(op)
> 
> ## Mimic S-Plus:
> splus <- list(boxwex = 0.4, staplewex = 1, outwex = 1, boxfill = "grey40",
+               medlwd = 3, medcol = "white", whisklty = 3, outlty = 1, outpch = NA)
> boxplot(z, pars = splus)
> ## Recycled and "sweeping" parameters
> op <- par(mfrow = c(1,2))
>  boxplot(z, border = 1:5, lty = 3, medlty = 1, medlwd = 2.5)
>  boxplot(z, boxfill = 1:3, pch = 1:5, lwd = 1.5, medcol = "white")
> par(op)
> ## too many possibilities
> boxplot(z, boxfill = "light gray", outpch = 21:25, outlty = 2,
+         bg = "pink", lwd = 2,
+         medcol = "dark blue", medcex = 2, medpch = 20)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("cdplot")
> ### * cdplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: cdplot
> ### Title: Conditional Density Plots
> ### Aliases: cdplot cdplot.default cdplot.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ## NASA space shuttle o-ring failures
> fail <- factor(c(2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1,
+                  1, 2, 1, 1, 1, 1, 1),
+                levels = 1:2, labels = c("no", "yes"))
> temperature <- c(53, 57, 58, 63, 66, 67, 67, 67, 68, 69, 70, 70,
+                  70, 70, 72, 73, 75, 75, 76, 76, 78, 79, 81)
> 
> ## CD plot
> cdplot(fail ~ temperature)
> cdplot(fail ~ temperature, bw = 2)
> cdplot(fail ~ temperature, bw = "SJ")
> 
> ## compare with spinogram
> (spineplot(fail ~ temperature, breaks = 3))
           fail
temperature no yes
    [50,60]  0   3
    (60,70]  8   3
    (70,80]  7   1
    (80,90]  1   0
> 
> ## highlighting for failures
> cdplot(fail ~ temperature, ylevels = 2:1)
> 
> ## scatter plot with conditional density
> cdens <- cdplot(fail ~ temperature, plot = FALSE)
> plot(I(as.numeric(fail) - 1) ~ jitter(temperature, factor = 2),
+      xlab = "Temperature", ylab = "Conditional failure probability")
> lines(53:81, 1 - cdens[[1]](53:81), col = 2)
> 
> 
> 
> cleanEx()
> nameEx("clip")
> ### * clip
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: clip
> ### Title: Set Clipping Region
> ### Aliases: clip
> ### Keywords: dplot
> 
> ### ** Examples
> 
> x <- rnorm(1000)
> hist(x, xlim = c(-4,4))
> usr <- par("usr")
> clip(usr[1], -2, usr[3], usr[4])
> hist(x, col = 'red', add = TRUE)
> clip(2, usr[2], usr[3], usr[4])
> hist(x, col = 'blue', add = TRUE)
> do.call("clip", as.list(usr))  # reset to plot region
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("contour")
> ### * contour
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: contour
> ### Title: Display Contours
> ### Aliases: contour contour.default
> ### Keywords: hplot aplot
> 
> ### ** Examples
> 
> require(grDevices) # for colours
> x <- -6:16
> op <- par(mfrow = c(2, 2))
> contour(outer(x, x), method = "edge", vfont = c("sans serif", "plain"))
> z <- outer(x, sqrt(abs(x)), FUN = `/`)
> image(x, x, z)
> contour(x, x, z, col = "pink", add = TRUE, method = "edge",
+         vfont = c("sans serif", "plain"))
> contour(x, x, z, ylim = c(1, 6), method = "simple", labcex = 1,
+         xlab = quote(x[1]), ylab = quote(x[2]))
> contour(x, x, z, ylim = c(-6, 6), nlevels = 20, lty = 2, method = "simple",
+         main = "20 levels; \"simple\" labelling method")
> par(op)
> 
> ## Passing multiple colours / lty / lwd :
> op <- par(mfrow = c(1, 2))
> z <- outer(-9:25, -9:25)
> ## Using default levels <- pretty(range(z, finite = TRUE), 10),
> ##  the first and last of which typically are *not* drawn:
> (levs <- pretty(z, n=10)) # -300 -200 ... 600 700
 [1] -300 -200 -100    0  100  200  300  400  500  600  700
> contour(z, col = 1:4)
> ## Set levels explicitly; show that 'lwd' and 'lty' are recycled as well:
> contour(z, levels=levs[-c(1,length(levs))], col = 1:5, lwd = 1:3 *1.5, lty = 1:3)
> par(op)
> 
> ## Persian Rug Art:
> x <- y <- seq(-4*pi, 4*pi, length.out = 27)
> r <- sqrt(outer(x^2, y^2, `+`))
> opar <- par(mfrow = c(2, 2), mar = rep(0, 4))
> for(f in pi^(0:3))
+   contour(cos(r^2)*exp(-r/f),
+           drawlabels = FALSE, axes = FALSE, frame.plot = TRUE)
> 
> rx <- range(x <- 10*1:nrow(volcano))
> ry <- range(y <- 10*1:ncol(volcano))
> ry <- ry + c(-1, 1) * (diff(rx) - diff(ry))/2
> tcol <- terrain.colors(12)
> par(opar); opar <- par(pty = "s", bg = "lightcyan")
> plot(x = 0, y = 0, type = "n", xlim = rx, ylim = ry, xlab = "", ylab = "")
> u <- par("usr")
> rect(u[1], u[3], u[2], u[4], col = tcol[8], border = "red")
> contour(x, y, volcano, col = tcol[2], lty = "solid", add = TRUE,
+         vfont = c("sans serif", "plain"))
> title("A Topographic Map of Maunga Whau", font = 4)
> abline(h = 200*0:4, v = 200*0:4, col = "lightgray", lty = 2, lwd = 0.1)
> 
> ## contourLines produces the same contour lines as contour
> plot(x = 0, y = 0, type = "n", xlim = rx, ylim = ry, xlab = "", ylab = "")
> u <- par("usr")
> rect(u[1], u[3], u[2], u[4], col = tcol[8], border = "red")
> contour(x, y, volcano, col = tcol[1], lty = "solid", add = TRUE,
+         vfont = c("sans serif", "plain"))
> line.list <- contourLines(x, y, volcano)
> invisible(lapply(line.list, lines, lwd=3, col=adjustcolor(2, .3)))
> par(opar)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("convertXY")
> ### * convertXY
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: convertXY
> ### Title: Convert between Graphics Coordinate Systems
> ### Aliases: grconvertX grconvertY
> ### Keywords: dplot
> 
> ### ** Examples
> 
> op <- par(omd=c(0.1, 0.9, 0.1, 0.9), mfrow = c(1, 2))
> plot(1:4)
> for(tp in c("in", "dev", "ndc", "nfc", "npc", "nic", "lines", "chars"))
+     print(grconvertX(c(1.0, 4.0), "user", tp))
[1] 1.577778 3.022222
[1] 113.6 217.6
[1] 0.2253968 0.4317460
[1] 0.3134921 0.8293651
[1] 0.03703704 0.96296296
[1] 0.1567460 0.4146825
[1]  7.888889 15.111111
[1]  7.888889 15.111111
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("coplot")
> ### * coplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: coplot
> ### Title: Conditioning Plots
> ### Aliases: coplot co.intervals
> ### Keywords: hplot aplot
> 
> ### ** Examples
> 
> ## Tonga Trench Earthquakes
> coplot(lat ~ long | depth, data = quakes)
> given.depth <- co.intervals(quakes$depth, number = 4, overlap = .1)
> coplot(lat ~ long | depth, data = quakes, given.values = given.depth, rows = 1)
> 
> ## Conditioning on 2 variables:
> ll.dm <- lat ~ long | depth * mag
> coplot(ll.dm, data = quakes)
> coplot(ll.dm, data = quakes, number = c(4, 7), show.given = c(TRUE, FALSE))
> coplot(ll.dm, data = quakes, number = c(3, 7),
+        overlap = c(-.5, .1)) # negative overlap DROPS values
> 
> ## given two factors
> Index <- seq_len(nrow(warpbreaks)) # to get nicer default labels
> coplot(breaks ~ Index | wool * tension, data = warpbreaks,
+        show.given = 0:1)
> coplot(breaks ~ Index | wool * tension, data = warpbreaks,
+        col = "red", bg = "pink", pch = 21,
+        bar.bg = c(fac = "light blue"))
> 
> ## Example with empty panels:
> with(data.frame(state.x77), {
+ coplot(Life.Exp ~ Income | Illiteracy * state.region, number = 3,
+        panel = function(x, y, ...) panel.smooth(x, y, span = .8, ...))
+ ## y ~ factor -- not really sensible, but 'show off':
+ coplot(Life.Exp ~ state.region | Income * state.division,
+        panel = panel.smooth)
+ })
> 
> 
> 
> cleanEx()
> nameEx("curve")
> ### * curve
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: curve
> ### Title: Draw Function Plots
> ### Aliases: curve plot.function
> ### Keywords: hplot
> 
> ### ** Examples
> 
> plot(qnorm) # default range c(0, 1) is appropriate here,
>             # but end values are -/+Inf and so are omitted.
> plot(qlogis, main = "The Inverse Logit : qlogis()")
> abline(h = 0, v = 0:2/2, lty = 3, col = "gray")
> 
> curve(sin, -2*pi, 2*pi, xname = "t")
> curve(tan, xname = "t", add = NA,
+       main = "curve(tan)  --> same x-scale as previous plot")
> 
> op <- par(mfrow = c(2, 2))
> curve(x^3 - 3*x, -2, 2)
> curve(x^2 - 2, add = TRUE, col = "violet")
> 
> ## simple and advanced versions, quite similar:
> plot(cos, -pi,  3*pi)
> curve(cos, xlim = c(-pi, 3*pi), n = 1001, col = "blue", add = TRUE)
> 
> chippy <- function(x) sin(cos(x)*exp(-x/2))
> curve(chippy, -8, 7, n = 2001)
> plot (chippy, -8, -5)
> 
> for(ll in c("", "x", "y", "xy"))
+    curve(log(1+x), 1, 100, log = ll, sub = paste0("log = '", ll, "'"))
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("dotchart")
> ### * dotchart
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: dotchart
> ### Title: Cleveland's Dot Plots
> ### Aliases: dotchart
> ### Keywords: hplot
> 
> ### ** Examples
> 
> dotchart(VADeaths, main = "Death Rates in Virginia - 1940")
> 
> op <- par(xaxs = "i")  # 0 -- 100%
> dotchart(t(VADeaths), xlim = c(0,100), bg = "skyblue",
+          main = "Death Rates in Virginia - 1940", xlab = "rate [ % ]",
+          ylab = "Grouping:  Age  x   Urbanity . Gender")
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("filled.contour")
> ### * filled.contour
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: filled.contour
> ### Title: Level (Contour) Plots
> ### Aliases: filled.contour .filled.contour
> ### Keywords: hplot aplot
> 
> ### ** Examples
> 
> require("grDevices") # for colours
> filled.contour(volcano, asp = 1) # simple
> 
> x <- 10*1:nrow(volcano)
> y <- 10*1:ncol(volcano)
> filled.contour(x, y, volcano,
+     color.palette = function(n) hcl.colors(n, "terrain"),
+     plot.title = title(main = "The Topography of Maunga Whau",
+     xlab = "Meters North", ylab = "Meters West"),
+     plot.axes = { axis(1, seq(100, 800, by = 100))
+                   axis(2, seq(100, 600, by = 100)) },
+     key.title = title(main = "Height\n(meters)"),
+     key.axes = axis(4, seq(90, 190, by = 10)))  # maybe also asp = 1
> mtext(paste("filled.contour(.) from", R.version.string),
+       side = 1, line = 4, adj = 1, cex = .66)
> 
> # Annotating a filled contour plot
> a <- expand.grid(1:20, 1:20)
> b <- matrix(a[,1] + a[,2], 20)
> filled.contour(x = 1:20, y = 1:20, z = b,
+                plot.axes = { axis(1); axis(2); points(10, 10) })
> 
> ## Persian Rug Art:
> x <- y <- seq(-4*pi, 4*pi, length.out = 27)
> r <- sqrt(outer(x^2, y^2, `+`))
> filled.contour(cos(r^2)*exp(-r/(2*pi)), axes = FALSE)
> ## rather, the key *should* be labeled:
> filled.contour(cos(r^2)*exp(-r/(2*pi)), frame.plot = FALSE,
+                plot.axes = {})
> 
> 
> 
> cleanEx()
> nameEx("fourfoldplot")
> ### * fourfoldplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: fourfoldplot
> ### Title: Fourfold Plots
> ### Aliases: fourfoldplot
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ## Use the Berkeley admission data as in Friendly (1995).
> x <- aperm(UCBAdmissions, c(2, 1, 3))
> dimnames(x)[[2]] <- c("Yes", "No")
> names(dimnames(x)) <- c("Sex", "Admit?", "Department")
> stats::ftable(x)
              Department   A   B   C   D   E   F
Sex    Admit?                                   
Male   Yes               512 353 120 138  53  22
       No                313 207 205 279 138 351
Female Yes                89  17 202 131  94  24
       No                 19   8 391 244 299 317
> 
> ## Fourfold display of data aggregated over departments, with
> ## frequencies standardized to equate the margins for admission
> ## and sex.
> ## Figure 1 in Friendly (1994).
> fourfoldplot(marginSums(x, c(1, 2)))
> 
> ## Fourfold display of x, with frequencies in each table
> ## standardized to equate the margins for admission and sex.
> ## Figure 2 in Friendly (1994).
> fourfoldplot(x)
> 
> ## Fourfold display of x, with frequencies in each table
> ## standardized to equate the margins for admission. but not
> ## for sex.
> ## Figure 3 in Friendly (1994).
> fourfoldplot(x, margin = 2)
> 
> 
> 
> cleanEx()
> nameEx("grid")
> ### * grid
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: grid
> ### Title: Add Grid to a Plot
> ### Aliases: grid
> ### Keywords: aplot
> 
> ### ** Examples
> 
> plot(1:3)
> grid(NA, 5, lwd = 2) # grid only in y-direction
> 
> ## maybe change the desired number of tick marks:  par(lab = c(mx, my, 7))
> op <- par(mfcol = 1:2)
> with(iris,
+      {
+      plot(Sepal.Length, Sepal.Width, col = as.integer(Species),
+           xlim = c(4, 8), ylim = c(2, 4.5), panel.first = grid(),
+           main = "with(iris,  plot(...., panel.first = grid(), ..) )")
+      plot(Sepal.Length, Sepal.Width, col = as.integer(Species),
+           panel.first = grid(3, lty = 1, lwd = 2),
+           main = "... panel.first = grid(3, lty = 1, lwd = 2), ..")
+      }
+     )
> par(op)
> 
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("hist.POSIXt")
> ### * hist.POSIXt
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: hist.POSIXt
> ### Title: Histogram of a Date or Date-Time Object
> ### Aliases: hist.POSIXt hist.Date
> ### Keywords: chron dplot hplot
> 
> ### ** Examples
> 
> hist(.leap.seconds, "years", freq = TRUE)
> brks <- seq(ISOdate(1970, 1, 1), ISOdate(2030, 1, 1), "5 years")
> hist(.leap.seconds, brks)
> rug(.leap.seconds, lwd=2)
> ## show that  'include.lowest' "works"
> stopifnot(identical(c(2L, rep(1L,11)),
+    hist(brks, brks, plot=FALSE, include.lowest=TRUE )$counts))
> tools::assertError(verbose=TRUE, ##--> 'breaks' do not span range of 'x'
+    hist(brks, brks, plot=FALSE, include.lowest=FALSE))
Asserted error: some 'x' not counted; maybe 'breaks' do not span range of 'x'
> ## The default fuzz in hist.default()  "kills" this, with a "wrong" message:
> try ( hist(brks[-13] + 1, brks, include.lowest = FALSE) )
Error in hist.default(unclass(x), unclass(breaks), plot = FALSE, warn.unused = FALSE,  : 
  some 'x' not counted; maybe 'breaks' do not span range of 'x'
> ## and decreasing 'fuzz' solves the issue:
> hb <- hist(brks[-13] + 1, brks, include.lowest = FALSE, fuzz = 1e-10)
> stopifnot(hb$counts == 1)
> 
> ## 100 random dates in a 10-week period
> random.dates <- as.Date("2001/1/1") + 70*stats::runif(100)
> hist(random.dates, "weeks", format = "%d %b")
> 
> 
> 
> cleanEx()
> nameEx("hist")
> ### * hist
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: hist
> ### Title: Histograms
> ### Aliases: hist hist.default
> ### Keywords: dplot hplot distribution
> 
> ### ** Examples
> 
> op <- par(mfrow = c(2, 2))
> hist(islands)
> utils::str(hist(islands, col = "gray", labels = TRUE))
List of 6
 $ breaks  : num [1:10] 0 2000 4000 6000 8000 10000 12000 14000 16000 18000
 $ counts  : int [1:9] 41 2 1 1 1 1 0 0 1
 $ density : num [1:9] 4.27e-04 2.08e-05 1.04e-05 1.04e-05 1.04e-05 ...
 $ mids    : num [1:9] 1000 3000 5000 7000 9000 11000 13000 15000 17000
 $ xname   : chr "islands"
 $ equidist: logi TRUE
 - attr(*, "class")= chr "histogram"
> 
> hist(sqrt(islands), breaks = 12, col = "lightblue", border = "pink")
> ##-- For non-equidistant breaks, counts should NOT be graphed unscaled:
> r <- hist(sqrt(islands), breaks = c(4*0:5, 10*3:5, 70, 100, 140),
+           col = "blue1")
> text(r$mids, r$density, r$counts, adj = c(.5, -.5), col = "blue3")
> sapply(r[2:3], sum)
   counts   density 
48.000000  0.215625 
> sum(r$density * diff(r$breaks)) # == 1
[1] 1
> lines(r, lty = 3, border = "purple") # -> lines.histogram(*)
> par(op)
> 
> require(utils) # for str
> str(hist(islands, breaks = 12, plot =  FALSE)) #-> 10 (~= 12) breaks
List of 6
 $ breaks  : num [1:10] 0 2000 4000 6000 8000 10000 12000 14000 16000 18000
 $ counts  : int [1:9] 41 2 1 1 1 1 0 0 1
 $ density : num [1:9] 4.27e-04 2.08e-05 1.04e-05 1.04e-05 1.04e-05 ...
 $ mids    : num [1:9] 1000 3000 5000 7000 9000 11000 13000 15000 17000
 $ xname   : chr "islands"
 $ equidist: logi TRUE
 - attr(*, "class")= chr "histogram"
> str(hist(islands, breaks = c(12,20,36,80,200,1000,17000), plot = FALSE))
List of 6
 $ breaks  : num [1:7] 12 20 36 80 200 1000 17000
 $ counts  : int [1:6] 12 11 8 6 4 7
 $ density : num [1:6] 0.03125 0.014323 0.003788 0.001042 0.000104 ...
 $ mids    : num [1:6] 16 28 58 140 600 9000
 $ xname   : chr "islands"
 $ equidist: logi FALSE
 - attr(*, "class")= chr "histogram"
> 
> hist(islands, breaks = c(12,20,36,80,200,1000,17000), freq = TRUE,
+      main = "WRONG histogram") # and warning
Warning in plot.histogram(r, freq = freq1, col = col, border = border, angle = angle,  :
  the AREAS in the plot are wrong -- rather use 'freq = FALSE'
> ## R >= 4.2.0: no "*.5" labels on y-axis:
> hist(c(2,3,3,5,5,6,6,6,7))
> 
> require(stats)
> set.seed(14)
> x <- rchisq(100, df = 4)
> 
> ## Histogram with custom x-axis:
> hist(x, xaxt = "n")
> axis(1, at = 0:17)
> 
> ## Don't show: 
> op <- par(mfrow = 2:1, mgp = c(1.5, 0.6, 0), mar = .1 + c(3,3:1))
> ## End(Don't show)
> ## Comparing data with a model distribution should be done with qqplot()!
> qqplot(x, qchisq(ppoints(x), df = 4)); abline(0, 1, col = 2, lty = 2)
> 
> ## if you really insist on using hist() ... :
> hist(x, freq = FALSE, ylim = c(0, 0.2))
> curve(dchisq(x, df = 4), col = 2, lty = 2, lwd = 2, add = TRUE)
> ## Don't show: 
> par(op)
> ## End(Don't show)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("identify")
> ### * identify
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: identify
> ### Title: Identify Points in a Scatter Plot
> ### Aliases: identify identify.default
> ### Keywords: iplot
> 
> ### ** Examples
> 
> ## A function to use identify to select points, and overplot the
> ## points with another symbol as they are selected
> identifyPch <- function(x, y = NULL, n = length(x), plot = FALSE, pch = 19, ...)
+ {
+     xy <- xy.coords(x, y); x <- xy$x; y <- xy$y
+     sel <- rep(FALSE, length(x))
+     while(sum(sel) < n) {
+         ans <- identify(x[!sel], y[!sel], labels = which(!sel), n = 1, plot = plot, ...)
+         if(!length(ans)) break
+         ans <- which(!sel)[ans]
+         points(x[ans], y[ans], pch = pch)
+         sel[ans] <- TRUE
+     }
+     ## return indices of selected points
+     which(sel)
+ }
> 
> if(dev.interactive()) { ## use it
+   x <- rnorm(50); y <- rnorm(50)
+   plot(x,y); identifyPch(x,y) # how fast to get all?
+ }
> 
> 
> 
> 
> cleanEx()
> nameEx("image")
> ### * image
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: image
> ### Title: Display a Color Image
> ### Aliases: image image.default
> ### Keywords: hplot aplot
> 
> ### ** Examples
> 
> require("grDevices") # for colours
> x <- y <- seq(-4*pi, 4*pi, length.out = 27)
> r <- sqrt(outer(x^2, y^2, `+`))
> image(z = z <- cos(r^2)*exp(-r/6), col = gray.colors(33))
> image(z, axes = FALSE, main = "Math can be beautiful ...",
+       xlab = expression(cos(r^2) * e^{-r/6}))
> contour(z, add = TRUE, drawlabels = FALSE)
> 
> # Volcano data visualized as matrix. Need to transpose and flip
> # matrix horizontally.
> image(t(volcano)[ncol(volcano):1,])
> 
> # A prettier display of the volcano
> x <- 10*(1:nrow(volcano))
> y <- 10*(1:ncol(volcano))
> image(x, y, volcano, col = hcl.colors(100, "terrain"), axes = FALSE)
> contour(x, y, volcano, levels = seq(90, 200, by = 5),
+         add = TRUE, col = "brown")
> axis(1, at = seq(100, 800, by = 100))
> axis(2, at = seq(100, 600, by = 100))
> box()
> title(main = "Maunga Whau Volcano", font.main = 4)
> 
> 
> 
> cleanEx()
> nameEx("layout")
> ### * layout
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: layout
> ### Title: Specifying Complex Plot Arrangements
> ### Aliases: layout layout.show lcm
> ### Keywords: iplot dplot environment
> 
> ### ** Examples
> 
> def.par <- par(no.readonly = TRUE) # save default, for resetting...
> 
> ## divide the device into two rows and two columns
> ## allocate figure 1 all of row 1
> ## allocate figure 2 the intersection of column 2 and row 2
> layout(matrix(c(1,1,0,2), 2, 2, byrow = TRUE))
> ## show the regions that have been allocated to each plot
> layout.show(2)
> 
> ## divide device into two rows and two columns
> ## allocate figure 1 and figure 2 as above
> ## respect relations between widths and heights
> nf <- layout(matrix(c(1,1,0,2), 2, 2, byrow = TRUE), respect = TRUE)
> layout.show(nf)
> 
> ## create single figure which is 5cm square
> nf <- layout(matrix(1), widths = lcm(5), heights = lcm(5))
> layout.show(nf)
> 
> 
> ##-- Create a scatterplot with marginal histograms -----
> 
> x <- pmin(3, pmax(-3, stats::rnorm(50)))
> y <- pmin(3, pmax(-3, stats::rnorm(50)))
> xhist <- hist(x, breaks = seq(-3,3,0.5), plot = FALSE)
> yhist <- hist(y, breaks = seq(-3,3,0.5), plot = FALSE)
> top <- max(c(xhist$counts, yhist$counts))
> xrange <- c(-3, 3)
> yrange <- c(-3, 3)
> nf <- layout(matrix(c(2,0,1,3),2,2,byrow = TRUE), c(3,1), c(1,3), TRUE)
> layout.show(nf)
> 
> par(mar = c(3,3,1,1))
> plot(x, y, xlim = xrange, ylim = yrange, xlab = "", ylab = "")
> par(mar = c(0,3,1,1))
> barplot(xhist$counts, axes = FALSE, ylim = c(0, top), space = 0)
> par(mar = c(3,0,1,1))
> barplot(yhist$counts, axes = FALSE, xlim = c(0, top), space = 0, horiz = TRUE)
> 
> par(def.par)  #- reset to default
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("legend")
> ### * legend
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: legend
> ### Title: Add Legends to Plots
> ### Aliases: legend
> ### Keywords: aplot
> 
> ### ** Examples
> 
> ## Run the example in '?matplot' or the following:
> leg.txt <- c("Setosa     Petals", "Setosa     Sepals",
+              "Versicolor Petals", "Versicolor Sepals")
> y.leg <- c(4.5, 3, 2.1, 1.4, .7)
> cexv  <- c(1.2, 1, 4/5, 2/3, 1/2)
> matplot(c(1, 8), c(0, 4.5), type = "n", xlab = "Length", ylab = "Width",
+         main = "Petal and Sepal Dimensions in Iris Blossoms")
> for (i in seq(cexv)) {
+   text  (1, y.leg[i] - 0.1, paste("cex=", formatC(cexv[i])), cex = 0.8, adj = 0)
+   legend(3, y.leg[i], leg.txt, pch = "sSvV", col = c(1, 3), cex = cexv[i])
+ }
> ## cex *vector* [in R <= 3.5.1 has 'if(xc < 0)' w/ length(xc) == 2]
> legend(6,1, leg.txt, pch = "sSvV", col = c(1, 3), cex = 1+(-1:2)/8)
> 
> ## 'merge = TRUE' for merging lines & points:
> x <- seq(-pi, pi, length.out = 65)
> plot(x, sin(x), type = "l", ylim = c(-1.2, 1.8), col = 3, lty = 2)
> points(x, cos(x), pch = 3, col = 4)
> lines(x, tan(x), type = "b", lty = 1, pch = 4, col = 6)
> title("legend(..., lty = c(2, -1, 1), pch = c(NA, 3, 4), merge = TRUE)",
+       cex.main = 1.1)
> legend(-1, 1.9, c("sin", "cos", "tan"), col = c(3, 4, 6),
+        text.col = "green4", lty = c(2, -1, 1), pch = c(NA, 3, 4),
+        merge = TRUE, bg = "gray90")
> 
> ## right-justifying a set of labels: thanks to Uwe Ligges
> x <- 1:5; y1 <- 1/x; y2 <- 2/x
> plot(rep(x, 2), c(y1, y2), type = "n", xlab = "x", ylab = "y")
> lines(x, y1); lines(x, y2, lty = 2)
> temp <- legend("topright", legend = c(" ", " "),
+                text.width = strwidth("1,000,000"),
+                lty = 1:2, xjust = 1, yjust = 1,
+                title = "Line Types")
> text(temp$rect$left + temp$rect$w, temp$text$y,
+      c("1,000", "1,000,000"), pos = 2)
> 
> 
> ##--- log scaled Examples ------------------------------
> leg.txt <- c("a one", "a two")
> 
> par(mfrow = c(2, 2))
> for(ll in c("","x","y","xy")) {
+   plot(2:10, log = ll, main = paste0("log = '", ll, "'"))
+   abline(1, 1)
+   lines(2:3, 3:4, col = 2)
+   points(2, 2, col = 3)
+   rect(2, 3, 3, 2, col = 4)
+   text(c(3,3), 2:3, c("rect(2,3,3,2, col=4)",
+                       "text(c(3,3),2:3,\"c(rect(...)\")"), adj = c(0, 0.3))
+   legend(list(x = 2,y = 8), legend = leg.txt, col = 2:3, pch = 1:2,
+          lty = 1, merge = TRUE)   #, trace = TRUE)
+ }
> par(mfrow = c(1,1))
> 
> ##-- Math expressions:  ------------------------------
> x <- seq(-pi, pi, length.out = 65)
> plot(x, sin(x), type = "l", col = 2, xlab = expression(phi),
+      ylab = expression(f(phi)))
> abline(h = -1:1, v = pi/2*(-6:6), col = "gray90")
> lines(x, cos(x), col = 3, lty = 2)
> ex.cs1 <- expression(plain(sin) * phi,  paste("cos", phi))  # 2 ways
> utils::str(legend(-3, .9, ex.cs1, lty = 1:2, plot = FALSE,
+            adj = c(0, 0.6)))  # adj y !
List of 2
 $ rect:List of 4
  ..$ w   : num 1.2
  ..$ h   : num 0.251
  ..$ left: num -3
  ..$ top : num 0.9
 $ text:List of 2
  ..$ x: num [1:2] -2.29 -2.29
  ..$ y: num [1:2] 0.816 0.733
> legend(-3, 0.9, ex.cs1, lty = 1:2, col = 2:3,  adj = c(0, 0.6))
> 
> require(stats)
> x <- rexp(100, rate = .5)
> hist(x, main = "Mean and Median of a Skewed Distribution")
> abline(v = mean(x),   col = 2, lty = 2, lwd = 2)
> abline(v = median(x), col = 3, lty = 3, lwd = 2)
> ex12 <- expression(bar(x) == sum(over(x[i], n), i == 1, n),
+                    hat(x) == median(x[i], i == 1, n))
> utils::str(legend(4.1, 30, ex12, col = 2:3, lty = 2:3, lwd = 2))
List of 2
 $ rect:List of 4
  ..$ w   : num 4.27
  ..$ h   : num 6.78
  ..$ left: num 4.1
  ..$ top : num 30
 $ text:List of 2
  ..$ x: num [1:2] 5.22 5.22
  ..$ y: num [1:2] 27.3 24.6
> 
> ## 'Filled' boxes -- for more, see example(plot.factor)
> op <- par(bg = "white") # to get an opaque box for the legend
> plot(cut(weight, 3) ~ group, data = PlantGrowth, col = NULL,
+      density = 16*(1:3))
> par(op)
> 
> ## Using 'ncol' :
> x <- 0:64/64
> matplot(x, outer(x, 1:7, function(x, k) sin(k * pi * x)),
+         type = "o", col = 1:7, ylim = c(-1, 1.5), pch = "*")
> op <- par(bg = "antiquewhite1")
> legend(0, 1.5, paste("sin(", 1:7, "pi * x)"), col = 1:7, lty = 1:7,
+        pch = "*", ncol = 4, cex = 0.8)
> legend(.8,1.2, paste("sin(", 1:7, "pi * x)"), col = 1:7, lty = 1:7,
+        pch = "*", cex = 0.8)
> legend(0, -.1, paste("sin(", 1:4, "pi * x)"), col = 1:4, lty = 1:4,
+        ncol = 2, cex = 0.8)
> legend(0, -.4, paste("sin(", 5:7, "pi * x)"), col = 4:6,  pch = 24,
+        ncol = 2, cex = 1.5, lwd = 2, pt.bg = "pink", pt.cex = 1:3)
> par(op)
> 
> ## point covering line :
> y <- sin(3*pi*x)
> plot(x, y, type = "l", col = "blue",
+     main = "points with bg & legend(*, pt.bg)")
> points(x, y, pch = 21, bg = "white")
> legend(.4,1, "sin(c x)", pch = 21, pt.bg = "white", lty = 1, col = "blue")
> 
> ## legends with titles at different locations
> plot(x, y, type = "n")
> legend("bottomright", "(x,y)", pch=1, title= "bottomright")
> legend("bottom",      "(x,y)", pch=1, title= "bottom")
> legend("bottomleft",  "(x,y)", pch=1, title= "bottomleft")
> legend("left",        "(x,y)", pch=1, title= "left")
> legend("topleft",     "(x,y)", pch=1, title= "topleft, inset = .05", inset = .05)
> legend("top",         "(x,y)", pch=1, title= "top")
> legend("topright",    "(x,y)", pch=1, title= "topright, inset = .02",inset = .02)
> legend("right",       "(x,y)", pch=1, title= "right")
> legend("center",      "(x,y)", pch=1, title= "center")
> 
> # using text.font (and text.col):
> op <- par(mfrow = c(2, 2), mar = rep(2.1, 4))
> c6 <- terrain.colors(10)[1:6]
> for(i in 1:4) {
+    plot(1, type = "n", axes = FALSE, ann = FALSE); title(paste("text.font =",i))
+    legend("top", legend = LETTERS[1:6], col = c6,
+           ncol = 2, cex = 2, lwd = 3, text.font = i, text.col = c6)
+ }
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("lines")
> ### * lines
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: lines
> ### Title: Add Connected Line Segments to a Plot
> ### Aliases: lines lines.default
> ### Keywords: aplot
> 
> ### ** Examples
> 
> # draw a smooth line through a scatter plot
> plot(cars, main = "Stopping Distance versus Speed")
> lines(stats::lowess(cars))
> 
> 
> 
> cleanEx()
> nameEx("matplot")
> ### * matplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: matplot
> ### Title: Plot Columns of Matrices
> ### Aliases: matplot matpoints matlines
> ### Keywords: hplot aplot array
> 
> ### ** Examples
> 
> require(grDevices)
> matplot((-4:5)^2, main = "Quadratic") # almost identical to plot(*)
> sines <- outer(1:20, 1:4, function(x, y) sin(x / 20 * pi * y))
> matplot(sines, pch = 1:4, type = "o", col = rainbow(ncol(sines)))
> matplot(sines, type = "b", pch = 21:23, col = 2:5, bg = 2:5,
+         main = "matplot(...., pch = 21:23, bg = 2:5)")
> 
> x <- 0:50/50
> matplot(x, outer(x, 1:8, function(x, k) sin(k*pi * x)),
+         ylim = c(-2,2), type = "plobcsSh",
+         main= "matplot(,type = \"plobcsSh\" )")
> ## pch & type =  vector of 1-chars :
> matplot(x, outer(x, 1:4, function(x, k) sin(k*pi * x)),
+         pch = letters[1:4], type = c("b","p","o"))
> 
> lends <- c("round","butt","square")
> matplot(matrix(1:12, 4), type="c", lty=1, lwd=10, lend=lends)
> text(cbind(2.5, 2*c(1,3,5)-.4), lends, col= 1:3, cex = 1.5)
> 
> table(iris$Species) # is data.frame with 'Species' factor

    setosa versicolor  virginica 
        50         50         50 
> iS <- iris$Species == "setosa"
> iV <- iris$Species == "versicolor"
> op <- par(bg = "bisque")
> matplot(c(1, 8), c(0, 4.5), type =  "n", xlab = "Length", ylab = "Width",
+         main = "Petal and Sepal Dimensions in Iris Blossoms")
> matpoints(iris[iS,c(1,3)], iris[iS,c(2,4)], pch = "sS", col = c(2,4))
> matpoints(iris[iV,c(1,3)], iris[iV,c(2,4)], pch = "vV", col = c(2,4))
> legend(1, 4, c("    Setosa Petals", "    Setosa Sepals",
+                "Versicolor Petals", "Versicolor Sepals"),
+        pch = "sSvV", col = rep(c(2,4), 2))
> 
> nam.var <- colnames(iris)[-5]
> nam.spec <- as.character(iris[1+50*0:2, "Species"])
> iris.S <- array(NA, dim = c(50,4,3),
+                 dimnames = list(NULL, nam.var, nam.spec))
> for(i in 1:3) iris.S[,,i] <- data.matrix(iris[1:50+50*(i-1), -5])
> 
> matplot(iris.S[, "Petal.Length",], iris.S[, "Petal.Width",], pch = "SCV",
+         col = rainbow(3, start = 0.8, end = 0.1),
+         sub = paste(c("S", "C", "V"), dimnames(iris.S)[[3]],
+                     sep = "=", collapse= ",  "),
+         main = "Fisher's Iris Data")
> par(op)
> 
> ## 'x' a "Date" vector :
> nd <- length(dv <- seq(as.Date("1959-02-21"), by = "weeks", length.out = 100))
> mSC <- cbind(I=1, sin=sin(pi*(1:nd)/8), cos=cos(pi*(1:nd)/8))
> matplot(dv, mSC, type = "b", main = "matplot(<Date>, y)")
> 
> ## 'x' a "POSIXct" date-time vector :
> ct <- seq(c(ISOdate(2000,3,20)), by = "15 mins", length.out = 100)
> matplot(ct, mSC, type = "b", main = "matplot(<POSIXct>, y)")
> ## or the same with even more axis flexibility:
> matplot(ct, mSC, type = "b", main = "matplot(<POSIXct>, y)", xaxt="n")
> Axis(ct, side=1, at = ct[1+4*(0:24)])
> 
> ## Also works for data frame columns:
> matplot(iris[1:50,1:4])
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("mosaicplot")
> ### * mosaicplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: mosaicplot
> ### Title: Mosaic Plots
> ### Aliases: mosaicplot mosaicplot.default mosaicplot.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> require(stats)
> mosaicplot(Titanic, main = "Survival on the Titanic", color = TRUE)
> ## Formula interface for tabulated data:
> mosaicplot(~ Sex + Age + Survived, data = Titanic, color = TRUE)
> 
> mosaicplot(HairEyeColor, shade = TRUE)
> ## Independence model of hair and eye color and sex.  Indicates that
> ## there are more blue eyed blonde females than expected in the case
> ## of independence and too few brown eyed blonde females.
> ## The corresponding model is:
> fm <- loglin(HairEyeColor, list(1, 2, 3))
2 iterations: deviation 5.684342e-14 
> pchisq(fm$pearson, fm$df, lower.tail = FALSE)
[1] 5.320872e-23
> 
> mosaicplot(HairEyeColor, shade = TRUE, margin = list(1:2, 3))
> ## Model of joint independence of sex from hair and eye color.  Males
> ## are underrepresented among people with brown hair and eyes, and are
> ## overrepresented among people with brown hair and blue eyes.
> ## The corresponding model is:
> fm <- loglin(HairEyeColor, list(1:2, 3))
2 iterations: deviation 5.684342e-14 
> pchisq(fm$pearson, fm$df, lower.tail = FALSE)
[1] 0.1891745
> 
> ## Formula interface for raw data: visualize cross-tabulation of numbers
> ## of gears and carburettors in Motor Trend car data.
> mosaicplot(~ gear + carb, data = mtcars, color = TRUE, las = 1)
> # color recycling
> mosaicplot(~ gear + carb, data = mtcars, color = 2:3, las = 1)
> 
> 
> 
> cleanEx()
> nameEx("mtext")
> ### * mtext
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: mtext
> ### Title: Write Text into the Margins of a Plot
> ### Aliases: mtext
> ### Keywords: aplot
> 
> ### ** Examples
> 
> plot(1:10, (-4:5)^2, main = "Parabola Points", xlab = "xlab")
> mtext("10 of them")
> for(s in 1:4)
+     mtext(paste("mtext(..., line= -1, {side, col, font} = ", s,
+           ", cex = ", (1+s)/2, ")"), line = -1,
+           side = s, col = s, font = s, cex = (1+s)/2)
> mtext("mtext(..., line= -2)", line = -2)
> mtext("mtext(..., line= -2, adj = 0)", line = -2, adj = 0)
> ##--- log axis :
> plot(1:10, exp(1:10), log = "y", main = "log =\"y\"", xlab = "xlab")
> for(s in 1:4) mtext(paste("mtext(...,side=", s ,")"), side = s)
> 
> 
> 
> cleanEx()
> nameEx("pairs")
> ### * pairs
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: pairs
> ### Title: Scatterplot Matrices
> ### Aliases: pairs pairs.default pairs.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> pairs(iris[1:4], main = "Anderson's Iris Data -- 3 species",
+       pch = 21, bg = c("red", "green3", "blue")[unclass(iris$Species)])
> 
> ## formula method, "graph" layout (row 1 at bottom):
> pairs(~ Fertility + Education + Catholic, data = swiss, row1attop=FALSE,
+       subset = Education < 20, main = "Swiss data, Education < 20")
> 
> pairs(USJudgeRatings, gap=1/10) # (gap: not wasting plotting area)
> ## show only lower triangle (and suppress labeling for whatever reason):
> pairs(USJudgeRatings, text.panel = NULL, upper.panel = NULL)
> 
> ## put histograms on the diagonal
> panel.hist <- function(x, ...)
+ {
+     usr <- par("usr")
+     par(usr = c(usr[1:2], 0, 1.5) )
+     h <- hist(x, plot = FALSE)
+     breaks <- h$breaks; nB <- length(breaks)
+     y <- h$counts; y <- y/max(y)
+     rect(breaks[-nB], 0, breaks[-1], y, col = "cyan", ...)
+ }
> pairs(USJudgeRatings[1:5], panel = panel.smooth,
+       cex = 1.5, pch = 24, bg = "light blue", horOdd=TRUE,
+       diag.panel = panel.hist, cex.labels = 2, font.labels = 2)
> 
> ## put (absolute) correlations on the upper panels,
> ## with size proportional to the correlations.
> panel.cor <- function(x, y, digits = 2, prefix = "", cex.cor, ...)
+ {
+     par(usr = c(0, 1, 0, 1))
+     r <- abs(cor(x, y))
+     txt <- format(c(r, 0.123456789), digits = digits)[1]
+     txt <- paste0(prefix, txt)
+     if(missing(cex.cor)) cex.cor <- 0.8/strwidth(txt)
+     text(0.5, 0.5, txt, cex = cex.cor * r)
+ }
> pairs(USJudgeRatings, lower.panel = panel.smooth, upper.panel = panel.cor,
+       gap=0, row1attop=FALSE)
> 
> pairs(iris[-5], log = "xy") # plot all variables on log scale
> pairs(iris, log = 1:4, # log the first four
+       main = "Lengths and Widths in [log]", line.main=1.5, oma=c(2,2,3,2))
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("panel.smooth")
> ### * panel.smooth
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: panel.smooth
> ### Title: Simple Panel Plot
> ### Aliases: panel.smooth
> ### Keywords: hplot dplot
> 
> ### ** Examples
> 
> pairs(swiss, panel = panel.smooth, pch = ".")  # emphasize the smooths
> pairs(swiss, panel = panel.smooth, lwd = 2, cex = 1.5, col = 4)  # hmm...
> 
> 
> 
> cleanEx()
> nameEx("par")
> ### * par
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: par
> ### Title: Set or Query Graphical Parameters
> ### Aliases: par .Pars 'graphical parameter' 'graphical parameters'
> ### Keywords: iplot dplot environment
> 
> ### ** Examples
> 
> op <- par(mfrow = c(2, 2), # 2 x 2 pictures on one plot
+           pty = "s")       # square plotting region,
>                            # independent of device size
> 
> ## At end of plotting, reset to previous settings:
> par(op)
> 
> ## Alternatively,
> op <- par(no.readonly = TRUE) # the whole list of settable par's.
> ## do lots of plotting and par(.) calls, then reset:
> par(op)
> ## Note this is not in general good practice
> 
> par("ylog") # FALSE
[1] FALSE
> plot(1 : 12, log = "y")
> par("ylog") # TRUE
[1] TRUE
> 
> plot(1:2, xaxs = "i") # 'inner axis' w/o extra space
> par(c("usr", "xaxp"))
$usr
[1] 1.00 2.00 0.96 2.04

$xaxp
[1] 1 2 5

> 
> ( nr.prof <-
+ c(prof.pilots = 16, lawyers = 11, farmers = 10, salesmen = 9, physicians = 9,
+   mechanics = 6, policemen = 6, managers = 6, engineers = 5, teachers = 4,
+   housewives = 3, students = 3, armed.forces = 1))
 prof.pilots      lawyers      farmers     salesmen   physicians    mechanics 
          16           11           10            9            9            6 
   policemen     managers    engineers     teachers   housewives     students 
           6            6            5            4            3            3 
armed.forces 
           1 
> par(las = 3)
> barplot(rbind(nr.prof)) # R 0.63.2: shows alignment problem
> par(las = 0)  # reset to default
> 
> require(grDevices) # for gray
> ## 'fg' use:
> plot(1:12, type = "b", main = "'fg' : axes, ticks and box in gray",
+      fg = gray(0.7), bty = "7" , sub = R.version.string)
> 
> ex <- function() {
+    old.par <- par(no.readonly = TRUE) # all par settings which
+                                       # could be changed.
+    on.exit(par(old.par))
+    ## ...
+    ## ... do lots of par() settings and plots
+    ## ...
+    invisible() #-- now,  par(old.par)  will be executed
+ }
> ex()
> 
> ## Line types
> showLty <- function(ltys, xoff = 0, ...) {
+    stopifnot((n <- length(ltys)) >= 1)
+    op <- par(mar = rep(.5,4)); on.exit(par(op))
+    plot(0:1, 0:1, type = "n", axes = FALSE, ann = FALSE)
+    y <- (n:1)/(n+1)
+    clty <- as.character(ltys)
+    mytext <- function(x, y, txt)
+       text(x, y, txt, adj = c(0, -.3), cex = 0.8, ...)
+    abline(h = y, lty = ltys, ...); mytext(xoff, y, clty)
+    y <- y - 1/(3*(n+1))
+    abline(h = y, lty = ltys, lwd = 2, ...)
+    mytext(1/8+xoff, y, paste(clty," lwd = 2"))
+ }
> showLty(c("solid", "dashed", "dotted", "dotdash", "longdash", "twodash"))
> par(new = TRUE)  # the same:
> showLty(c("solid", "44", "13", "1343", "73", "2262"), xoff = .2, col = 2)
> showLty(c("11", "22", "33", "44",   "12", "13", "14",   "21", "31"))
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("persp")
> ### * persp
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: persp
> ### Title: Perspective Plots
> ### Aliases: persp persp.default
> ### Keywords: hplot aplot
> 
> ### ** Examples
> 
> require(grDevices) # for trans3d
> ## More examples in  demo(persp) !!
> ##                   -----------
> 
> # (1) The Obligatory Mathematical surface.
> #     Rotated sinc function.
> 
> x <- seq(-10, 10, length.out = 30)
> y <- x
> f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
> z <- outer(x, y, f)
> z[is.na(z)] <- 1
> op <- par(bg = "white")
> persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue")
> persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue",
+       ltheta = 120, shade = 0.75, ticktype = "detailed",
+       xlab = "X", ylab = "Y", zlab = "Sinc( r )"
+ ) -> res
> round(res, 3)
      [,1]   [,2]   [,3]   [,4]
[1,] 0.087 -0.025  0.043 -0.043
[2,] 0.050  0.043 -0.075  0.075
[3,] 0.000  0.074  0.042 -0.042
[4,] 0.000 -0.273 -2.890  3.890
> 
> # (2) Add to existing persp plot - using trans3d() :
> 
> xE <- c(-10,10); xy <- expand.grid(xE, xE)
> points(trans3d(xy[,1], xy[,2], 6, pmat = res), col = 2, pch = 16)
> lines (trans3d(x, y = 10, z = 6 + sin(x), pmat = res), col = 3)
> 
> phi <- seq(0, 2*pi, length.out = 201)
> r1 <- 7.725 # radius of 2nd maximum
> xr <- r1 * cos(phi)
> yr <- r1 * sin(phi)
> lines(trans3d(xr,yr, f(xr,yr), res), col = "pink", lwd = 2)
> ## (no hidden lines)
> 
> # (3) Visualizing a simple DEM model
> 
> z <- 2 * volcano        # Exaggerate the relief
> x <- 10 * (1:nrow(z))   # 10 meter spacing (S to N)
> y <- 10 * (1:ncol(z))   # 10 meter spacing (E to W)
> ## Don't draw the grid lines :  border = NA
> par(bg = "slategray")
> persp(x, y, z, theta = 135, phi = 30, col = "green3", scale = FALSE,
+       ltheta = -120, shade = 0.75, border = NA, box = FALSE)
> 
> # (4) Surface colours corresponding to z-values
> 
> par(bg = "white")
> x <- seq(-1.95, 1.95, length.out = 30)
> y <- seq(-1.95, 1.95, length.out = 35)
> z <- outer(x, y, function(a, b) a*b^2)
> nrz <- nrow(z)
> ncz <- ncol(z)
> # Create a function interpolating colors in the range of specified colors
> jet.colors <- colorRampPalette( c("blue", "green") )
> # Generate the desired number of colors from this palette
> nbcol <- 100
> color <- jet.colors(nbcol)
> # Compute the z-value at the facet centres
> zfacet <- z[-1, -1] + z[-1, -ncz] + z[-nrz, -1] + z[-nrz, -ncz]
> # Recode facet z-values into color indices
> facetcol <- cut(zfacet, nbcol)
> persp(x, y, z, col = color[facetcol], phi = 30, theta = -30)
> 
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("pie")
> ### * pie
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: pie
> ### Title: Pie Charts
> ### Aliases: pie
> ### Keywords: hplot
> 
> ### ** Examples
> 
> require(grDevices)
> pie(rep(1, 24), col = rainbow(24), radius = 0.9)
> 
> pie.sales <- c(0.12, 0.3, 0.26, 0.16, 0.04, 0.12)
> names(pie.sales) <- c("Blueberry", "Cherry",
+     "Apple", "Boston Cream", "Other", "Vanilla Cream")
> pie(pie.sales) # default colours
> pie(pie.sales, col = c("purple", "violetred1", "green3",
+                        "cornsilk", "cyan", "white"))
> pie(pie.sales, col = gray(seq(0.4, 1.0, length.out = 6)))
> pie(pie.sales, density = 10, angle = 15 + 10 * 1:6)
> pie(pie.sales, clockwise = TRUE, main = "pie(*, clockwise = TRUE)")
> segments(0, 0, 0, 1, col = "red", lwd = 2)
> text(0, 1, "init.angle = 90", col = "red")
> 
> n <- 200
> pie(rep(1, n), labels = "", col = rainbow(n), border = NA,
+     main = "pie(*, labels=\"\", col=rainbow(n), border=NA,..")
> 
> ## Another case showing pie() is rather fun than science:
> ## (original by FinalBackwardsGlance on http://imgur.com/gallery/wWrpU4X)
> pie(c(Sky = 78, "Sunny side of pyramid" = 17, "Shady side of pyramid" = 5),
+     init.angle = 315, col = c("deepskyblue", "yellow", "yellow3"), border = FALSE)
> 
> 
> 
> cleanEx()
> nameEx("plot.dataframe")
> ### * plot.dataframe
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.data.frame
> ### Title: Plot Method for Data Frames
> ### Aliases: plot.data.frame
> ### Keywords: hplot methods
> 
> ### ** Examples
> 
> plot(OrchardSprays[1], method = "jitter")
> plot(OrchardSprays[c(4,1)])
> plot(OrchardSprays)
> 
> plot(iris)
> plot(iris[5:4])
> plot(women)
> 
> 
> 
> cleanEx()
> nameEx("plot.default")
> ### * plot.default
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.default
> ### Title: The Default Scatterplot Function
> ### Aliases: plot.default plot
> ### Keywords: hplot
> 
> ### ** Examples
> 
> Speed <- cars$speed
> Distance <- cars$dist
> plot(Speed, Distance, panel.first = grid(8, 8),
+      pch = 0, cex = 1.2, col = "blue")
> plot(Speed, Distance,
+      panel.first = lines(stats::lowess(Speed, Distance), lty = "dashed"),
+      pch = 0, cex = 1.2, col = "blue")
> 
> ## Show the different plot types
> x <- 0:12
> y <- sin(pi/5 * x)
> op <- par(mfrow = c(3,3), mar = .1+ c(2,2,3,1))
> for (tp in c("p","l","b",  "c","o","h",  "s","S","n")) {
+    plot(y ~ x, type = tp, main = paste0("plot(*, type = \"", tp, "\")"))
+    if(tp == "S") {
+       lines(x, y, type = "s", col = "red", lty = 2)
+       mtext("lines(*, type = \"s\", ...)", col = "red", cex = 0.8)
+    }
+ }
> par(op)
> 
> ##--- Log-Log Plot  with  custom axes
> lx <- seq(1, 5, length.out = 41)
> yl <- expression(e^{-frac(1,2) * {log[10](x)}^2})
> y <- exp(-.5*lx^2)
> op <- par(mfrow = c(2,1), mar = par("mar")-c(1,0,2,0), mgp = c(2, .7, 0))
> plot(10^lx, y, log = "xy", type = "l", col = "purple",
+      main = "Log-Log plot", ylab = yl, xlab = "x")
> plot(10^lx, y, log = "xy", type = "o", pch = ".", col = "forestgreen",
+      main = "Log-Log plot with custom axes", ylab = yl, xlab = "x",
+      axes = FALSE, frame.plot = TRUE)
> my.at <- 10^(1:5)
> axis(1, at = my.at, labels = formatC(my.at, format = "fg"))
> e.y <- -5:-1 ; at.y <- 10^e.y
> axis(2, at = at.y, col.axis = "red", las = 1,
+      labels = as.expression(lapply(e.y, function(E) bquote(10^.(E)))))
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.design")
> ### * plot.design
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.design
> ### Title: Plot Univariate Effects of a Design or Model
> ### Aliases: plot.design
> ### Keywords: hplot
> 
> ### ** Examples
> 
> require(stats)
> plot.design(warpbreaks)  # automatic for data frame with one numeric var.
> 
> Form <- breaks ~ wool + tension
> summary(fm1 <- aov(Form, data = warpbreaks))
            Df Sum Sq Mean Sq F value  Pr(>F)   
wool         1    451   450.7   3.339 0.07361 . 
tension      2   2034  1017.1   7.537 0.00138 **
Residuals   50   6748   135.0                   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> plot.design(       Form, data = warpbreaks, col = 2)  # same as above
> 
> ## More than one y :
> utils::str(esoph)
'data.frame':	88 obs. of  5 variables:
 $ agegp    : Ord.factor w/ 6 levels "25-34"<"35-44"<..: 1 1 1 1 1 1 1 1 1 1 ...
 $ alcgp    : Ord.factor w/ 4 levels "0-39g/day"<"40-79"<..: 1 1 1 1 2 2 2 2 3 3 ...
 $ tobgp    : Ord.factor w/ 4 levels "0-9g/day"<"10-19"<..: 1 2 3 4 1 2 3 4 1 2 ...
 $ ncases   : num  0 0 0 0 0 0 0 0 0 0 ...
 $ ncontrols: num  40 10 6 5 27 7 4 7 2 1 ...
> plot.design(esoph) ## two plots; if interactive you are "ask"ed
> 
> ## or rather, compare mean and median:
> op <- par(mfcol = 1:2)
> plot.design(ncases/ncontrols ~ ., data = esoph, ylim = c(0, 0.8))
> plot.design(ncases/ncontrols ~ ., data = esoph, ylim = c(0, 0.8),
+             fun = median)
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.factor")
> ### * plot.factor
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.factor
> ### Title: Plotting Factor Variables
> ### Aliases: plot.factor
> ### Keywords: hplot
> 
> ### ** Examples
> 
> require(grDevices)
> plot(weight ~ group, data = PlantGrowth)           # numeric vector ~ factor
> plot(cut(weight, 2) ~ group, data = PlantGrowth)   # factor ~ factor
> ## passing "..." to spineplot() eventually:
> plot(cut(weight, 3) ~ group, data = PlantGrowth,
+      col = hcl(c(0, 120, 240), 50, 70))
> 
> plot(PlantGrowth$group, axes = FALSE, main = "no axes")  # extremely silly
> 
> 
> 
> cleanEx()
> nameEx("plot.formula")
> ### * plot.formula
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.formula
> ### Title: Formula Notation for Scatterplots
> ### Aliases: plot.formula lines.formula points.formula text.formula
> ### Keywords: hplot aplot
> 
> ### ** Examples
> 
> op <- par(mfrow = c(2,1))
> plot(Ozone ~ Wind, data = airquality, pch = as.character(Month))
> plot(Ozone ~ Wind, data = airquality, pch = as.character(Month),
+      subset = Month != 7)
> par(op)
> 
> ## text.formula() can be very natural:
> wb <- within(warpbreaks, {
+     time <- seq_along(breaks); W.T <- wool:tension })
> plot(breaks ~ time, data = wb, type = "b")
> text(breaks ~ time, data = wb, labels = W.T, col = 1+as.integer(wool))
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.raster")
> ### * plot.raster
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.raster
> ### Title: Plotting Raster Images
> ### Aliases: plot.raster
> ### Keywords: hplot
> 
> ### ** Examples
> 
> require(grDevices)
> r <- as.raster(c(0.5, 1, 0.5))
> plot(r)
> # additional arguments to rasterImage()
> plot(r, interpolate=FALSE)
> # distort
> plot(r, asp=NA)
> # fill page
> op <- par(mar=rep(0, 4))
> plot(r, asp=NA)
> par(op)
> # normal annotations work
> plot(r, asp=NA)
> box()
> title(main="This is my raster")
> # add to existing plot
> plot(1)
> plot(r, add=TRUE)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.table")
> ### * plot.table
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.table
> ### Title: Plot Methods for 'table' Objects
> ### Aliases: plot.table lines.table points.table
> ### Keywords: hplot category
> 
> ### ** Examples
> 
> ## 1-d tables
> (Poiss.tab <- table(N = stats::rpois(200, lambda = 5)))
N
 1  2  3  4  5  6  7  8  9 10 11 
 4 14 25 38 40 33 21 16  4  2  3 
> plot(Poiss.tab, main = "plot(table(rpois(200, lambda = 5)))")
> 
> plot(table(state.division))
> 
> ## 4-D :
> plot(Titanic, main ="plot(Titanic, main= *)")
> 
> 
> 
> 
> cleanEx()
> nameEx("plot.window")
> ### * plot.window
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.window
> ### Title: Set up World Coordinates for Graphics Window
> ### Aliases: plot.window xlim ylim asp
> ### Keywords: aplot
> 
> ### ** Examples
> 
> ##--- An example for the use of 'asp' :
> require(stats)  # normally loaded
> loc <- cmdscale(eurodist)
> rx <- range(x <- loc[,1])
> ry <- range(y <- -loc[,2])
> plot(x, y, type = "n", asp = 1, xlab = "", ylab = "")
> abline(h = pretty(rx, 10), v = pretty(ry, 10), col = "lightgray")
> text(x, y, labels(eurodist), cex = 0.8)
> 
> 
> 
> cleanEx()
> nameEx("plot.xy")
> ### * plot.xy
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.xy
> ### Title: Basic Internal Plot Function
> ### Aliases: plot.xy
> ### Keywords: aplot
> 
> ### ** Examples
> 
> points.default # to see how it calls "plot.xy(xy.coords(x, y), ...)"
function (x, y = NULL, type = "p", ...) 
plot.xy(xy.coords(x, y), type = type, ...)
<bytecode: 0x55daca5416a8>
<environment: namespace:graphics>
> 
> 
> 
> cleanEx()
> nameEx("plothistogram")
> ### * plothistogram
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: plot.histogram
> ### Title: Plot Histograms
> ### Aliases: plot.histogram lines.histogram
> ### Keywords: hplot iplot
> 
> ### ** Examples
> 
> (wwt <- hist(women$weight, nclass = 7, plot = FALSE))
$breaks
 [1] 115 120 125 130 135 140 145 150 155 160 165

$counts
 [1] 3 1 2 2 1 1 2 1 1 1

$density
 [1] 0.04000000 0.01333333 0.02666667 0.02666667 0.01333333 0.01333333
 [7] 0.02666667 0.01333333 0.01333333 0.01333333

$mids
 [1] 117.5 122.5 127.5 132.5 137.5 142.5 147.5 152.5 157.5 162.5

$xname
[1] "women$weight"

$equidist
[1] TRUE

attr(,"class")
[1] "histogram"
> plot(wwt, labels = TRUE) # default main & xlab using wwt$xname
> plot(wwt, border = "dark blue", col = "light blue",
+      main = "Histogram of 15 women's weights", xlab = "weight [pounds]")
> 
> ## Fake "lines" example, using non-default labels:
> w2 <- wwt; w2$counts <- w2$counts - 1
> lines(w2, col = "Midnight Blue", labels = ifelse(w2$counts, "> 1", "1"))
> 
> 
> 
> cleanEx()
> nameEx("points")
> ### * points
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: points
> ### Title: Add Points to a Plot
> ### Aliases: points points.default pch
> ### Keywords: aplot
> 
> ### ** Examples
> 
> require(stats) # for rnorm
> plot(-4:4, -4:4, type = "n")  # setting up coord. system
> points(rnorm(200), rnorm(200), col = "red")
> points(rnorm(100)/2, rnorm(100)/2, col = "blue", cex = 1.5)
> 
> op <- par(bg = "light blue")
> x <- seq(0, 2*pi, length.out = 51)
> ## something "between type='b' and type='o'":
> plot(x, sin(x), type = "o", pch = 21, bg = par("bg"), col = "blue", cex = .6,
+  main = 'plot(..., type="o", pch=21, bg=par("bg"))')
> par(op)
> 
> ## Not run: 
> ##D ## The figure was produced by calls like
> ##D png("pch.png", height = 0.7, width = 7, res = 100, units = "in")
> ##D par(mar = rep(0,4))
> ##D plot(c(-1, 26), 0:1, type = "n", axes = FALSE)
> ##D text(0:25, 0.6, 0:25, cex = 0.5)
> ##D points(0:25, rep(0.3, 26), pch = 0:25, bg = "grey")
> ## End(Not run)
> 
> ##-------- Showing all the extra & some char graphics symbols ---------
> pchShow <-
+   function(extras = c("*",".", "o","O","0","+","-","|","%","#"),
+            cex = 3, ## good for both .Device=="postscript" and "x11"
+            col = "red3", bg = "gold", coltext = "brown", cextext = 1.2,
+            main = paste("plot symbols :  points (...  pch = *, cex =",
+                         cex,")"))
+   {
+     nex <- length(extras)
+     np  <- 26 + nex
+     ipch <- 0:(np-1)
+     k <- floor(sqrt(np))
+     dd <- c(-1,1)/2
+     rx <- dd + range(ix <- ipch %/% k)
+     ry <- dd + range(iy <- 3 + (k-1)- ipch %% k)
+     pch <- as.list(ipch) # list with integers & strings
+     if(nex > 0) pch[26+ 1:nex] <- as.list(extras)
+     plot(rx, ry, type = "n", axes  =  FALSE, xlab = "", ylab = "", main = main)
+     abline(v = ix, h = iy, col = "lightgray", lty = "dotted")
+     for(i in 1:np) {
+       pc <- pch[[i]]
+       ## 'col' symbols with a 'bg'-colored interior (where available) :
+       points(ix[i], iy[i], pch = pc, col = col, bg = bg, cex = cex)
+       if(cextext > 0)
+           text(ix[i] - 0.3, iy[i], pc, col = coltext, cex = cextext)
+     }
+   }
> 
> pchShow()
> pchShow(c("o","O","0"), cex = 2.5)
> pchShow(NULL, cex = 4, cextext = 0, main = NULL)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("polygon")
> ### * polygon
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: polygon
> ### Title: Polygon Drawing
> ### Aliases: polygon
> ### Keywords: aplot
> 
> ### ** Examples
> 
> x <- c(1:9, 8:1)
> y <- c(1, 2*(5:3), 2, -1, 17, 9, 8, 2:9)
> op <- par(mfcol = c(3, 1))
> for(xpd in c(FALSE, TRUE, NA)) {
+   plot(1:10, main = paste("xpd =", xpd))
+   box("figure", col = "pink", lwd = 3)
+   polygon(x, y, xpd = xpd, col = "orange", lty = 2, lwd = 2, border = "red")
+ }
> par(op)
> 
> n <- 100
> xx <- c(0:n, n:0)
> yy <- c(c(0, cumsum(stats::rnorm(n))), rev(c(0, cumsum(stats::rnorm(n)))))
> plot   (xx, yy, type = "n", xlab = "Time", ylab = "Distance")
> polygon(xx, yy, col = "gray", border = "red")
> title("Distance Between Brownian Motions")
> 
> # Multiple polygons from NA values
> # and recycling of col, border, and lty
> op <- par(mfrow = c(2, 1))
> plot(c(1, 9), 1:2, type = "n")
> polygon(1:9, c(2,1,2,1,1,2,1,2,1),
+         col = c("red", "blue"),
+         border = c("green", "yellow"),
+         lwd = 3, lty = c("dashed", "solid"))
> plot(c(1, 9), 1:2, type = "n")
> polygon(1:9, c(2,1,2,1,NA,2,1,2,1),
+         col = c("red", "blue"),
+         border = c("green", "yellow"),
+         lwd = 3, lty = c("dashed", "solid"))
> par(op)
> 
> # Line-shaded polygons
> plot(c(1, 9), 1:2, type = "n")
> polygon(1:9, c(2,1,2,1,NA,2,1,2,1),
+         density = c(10, 20), angle = c(-45, 45))
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("polypath")
> ### * polypath
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: polypath
> ### Title: Path Drawing
> ### Aliases: polypath
> ### Keywords: aplot
> 
> ### ** Examples
> 
> plotPath <- function(x, y, col = "grey", rule = "winding") {
+     plot.new()
+     plot.window(range(x, na.rm = TRUE), range(y, na.rm = TRUE))
+     polypath(x, y, col = col, rule = rule)
+     if (!is.na(col))
+         mtext(paste("Rule:", rule), side = 1, line = 0)
+ }
> 
> plotRules <- function(x, y, title) {
+     plotPath(x, y)
+     plotPath(x, y, rule = "evenodd")
+     mtext(title, side = 3, line = 0)
+     plotPath(x, y, col = NA)
+ }
> 
> op <- par(mfrow = c(5, 3), mar = c(2, 1, 1, 1))
> 
> plotRules(c(.1, .1, .9, .9, NA, .2, .2, .8, .8),
+           c(.1, .9, .9, .1, NA, .2, .8, .8, .2),
+           "Nested rectangles, both clockwise")
> plotRules(c(.1, .1, .9, .9, NA, .2, .8, .8, .2),
+           c(.1, .9, .9, .1, NA, .2, .2, .8, .8),
+           "Nested rectangles, outer clockwise, inner anti-clockwise")
> plotRules(c(.1, .1, .4, .4, NA, .6, .9, .9, .6),
+           c(.1, .4, .4, .1, NA, .6, .6, .9, .9),
+           "Disjoint rectangles")
> plotRules(c(.1, .1, .6, .6, NA, .4, .4, .9, .9),
+           c(.1, .6, .6, .1, NA, .4, .9, .9, .4),
+           "Overlapping rectangles, both clockwise")
> plotRules(c(.1, .1, .6, .6, NA, .4, .9, .9, .4),
+           c(.1, .6, .6, .1, NA, .4, .4, .9, .9),
+           "Overlapping rectangles, one clockwise, other anti-clockwise")
> 
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("rasterImage")
> ### * rasterImage
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: rasterImage
> ### Title: Draw One or More Raster Images
> ### Aliases: rasterImage
> ### Keywords: aplot
> 
> ### ** Examples
> 
> require(grDevices)
> ## set up the plot region:
> op <- par(bg = "thistle")
> plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "")
> image <- as.raster(matrix(0:1, ncol = 5, nrow = 3))
Warning in matrix(0:1, ncol = 5, nrow = 3) :
  data length [2] is not a sub-multiple or multiple of the number of rows [3]
> rasterImage(image, 100, 300, 150, 350, interpolate = FALSE)
> rasterImage(image, 100, 400, 150, 450)
> rasterImage(image, 200, 300, 200 + xinch(.5), 300 + yinch(.3),
+             interpolate = FALSE)
> rasterImage(image, 200, 400, 250, 450, angle = 15, interpolate = FALSE)
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("rect")
> ### * rect
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: rect
> ### Title: Draw One or More Rectangles
> ### Aliases: rect
> ### Keywords: aplot
> 
> ### ** Examples
> 
> require(grDevices)
> ## set up the plot region:
> op <- par(bg = "thistle")
> plot(c(100, 250), c(300, 450), type = "n", xlab = "", ylab = "",
+      main = "2 x 11 rectangles; 'rect(100+i,300+i,  150+i,380+i)'")
> i <- 4*(0:10)
> ## draw rectangles with bottom left (100, 300)+i
> ## and top right (150, 380)+i
> rect(100+i, 300+i, 150+i, 380+i, col = rainbow(11, start = 0.7, end = 0.1))
> rect(240-i, 320+i, 250-i, 410+i, col = heat.colors(11), lwd = i/5)
> ## Background alternating  ( transparent / "bg" ) :
> j <- 10*(0:5)
> rect(125+j, 360+j,   141+j, 405+j/2, col = c(NA,0),
+      border = "gold", lwd = 2)
> rect(125+j, 296+j/2, 141+j, 331+j/5, col = c(NA,"midnightblue"))
> mtext("+  2 x 6 rect(*, col = c(NA,0)) and  col = c(NA,\"m..blue\")")
> 
> ## an example showing colouring and shading
> plot(c(100, 200), c(300, 450), type= "n", xlab = "", ylab = "")
> rect(100, 300, 125, 350) # transparent
> rect(100, 400, 125, 450, col = "green", border = "blue") # coloured
> rect(115, 375, 150, 425, col = par("bg"), border = "transparent")
> rect(150, 300, 175, 350, density = 10, border = "red")
> rect(150, 400, 175, 450, density = 30, col = "blue",
+      angle = -30, border = "transparent")
> 
> legend(180, 450, legend = 1:4, fill = c(NA, "green", par("fg"), "blue"),
+        density = c(NA, NA, 10, 30), angle = c(NA, NA, 30, -30))
> 
> par(op)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("rug")
> ### * rug
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: rug
> ### Title: Add a Rug to a Plot
> ### Aliases: rug
> ### Keywords: aplot
> 
> ### ** Examples
> 
> require(stats)  # both 'density' and its default method
> with(faithful, {
+     plot(density(eruptions, bw = 0.15))
+     rug(eruptions)
+     rug(jitter(eruptions, amount = 0.01), side = 3, col = "light blue")
+ })
> 
> 
> 
> cleanEx()
> nameEx("screen")
> ### * screen
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: screen
> ### Title: Creating and Controlling Multiple Screens on a Single Device
> ### Aliases: screen split.screen erase.screen close.screen
> ### Keywords: aplot dplot device
> 
> ### ** Examples
> 
> if (interactive()) {
+ par(bg = "white")           # default is likely to be transparent
+ split.screen(c(2, 1))       # split display into two screens
+ split.screen(c(1, 3), screen = 2) # now split the bottom half into 3
+ screen(1) # prepare screen 1 for output
+ plot(10:1)
+ screen(4) # prepare screen 4 for output
+ plot(10:1)
+ close.screen(all = TRUE)    # exit split-screen mode
+ 
+ split.screen(c(2, 1))       # split display into two screens
+ split.screen(c(1, 2), 2)    # split bottom half in two
+ plot(1:10)                  # screen 3 is active, draw plot
+ erase.screen()              # forgot label, erase and redraw
+ plot(1:10, ylab = "ylab 3")
+ screen(1)                   # prepare screen 1 for output
+ plot(1:10)
+ screen(4)                   # prepare screen 4 for output
+ plot(1:10, ylab = "ylab 4")
+ screen(1, FALSE)            # return to screen 1, but do not clear
+ plot(10:1, axes = FALSE, lty = 2, ylab = "")  # overlay second plot
+ axis(4)                     # add tic marks to right-hand axis
+ title("Plot 1")
+ close.screen(all = TRUE)    # exit split-screen mode
+ }
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("segments")
> ### * segments
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: segments
> ### Title: Add Line Segments to a Plot
> ### Aliases: segments
> ### Keywords: aplot
> 
> ### ** Examples
> 
> x <- stats::runif(12); y <- stats::rnorm(12)
> i <- order(x, y); x <- x[i]; y <- y[i]
> plot(x, y, main = "arrows(.) and segments(.)")
> ## draw arrows from point to point :
> s <- seq(length(x)-1)  # one shorter than data
> arrows(x[s], y[s], x[s+1], y[s+1], col= 1:3)
> s <- s[-length(s)]
> segments(x[s], y[s], x[s+2], y[s+2], col= 'pink')
> 
> 
> 
> cleanEx()
> nameEx("smoothScatter")
> ### * smoothScatter
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: smoothScatter
> ### Title: Scatterplots with Smoothed Densities Color Representation
> ### Aliases: smoothScatter
> ### Keywords: hplot
> 
> ### ** Examples
> 
> 
> cleanEx()
> nameEx("spineplot")
> ### * spineplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: spineplot
> ### Title: Spine Plots and Spinograms
> ### Aliases: spineplot spineplot.default spineplot.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ## treatment and improvement of patients with rheumatoid arthritis
> treatment <- factor(rep(c(1, 2), c(43, 41)), levels = c(1, 2),
+                     labels = c("placebo", "treated"))
> improved <- factor(rep(c(1, 2, 3, 1, 2, 3), c(29, 7, 7, 13, 7, 21)),
+                    levels = c(1, 2, 3),
+                    labels = c("none", "some", "marked"))
> 
> ## (dependence on a categorical variable)
> (spineplot(improved ~ treatment))
         improved
treatment none some marked
  placebo   29    7      7
  treated   13    7     21
> 
> ## applications and admissions by department at UC Berkeley
> ## (two-way tables)
> (spineplot(marginSums(UCBAdmissions, c(3, 2)),
+            main = "Applications at UCB"))
    Gender
Dept Male Female
   A  825    108
   B  560     25
   C  325    593
   D  417    375
   E  191    393
   F  373    341
> (spineplot(marginSums(UCBAdmissions, c(3, 1)),
+            main = "Admissions at UCB"))
    Admit
Dept Admitted Rejected
   A      601      332
   B      370      215
   C      322      596
   D      269      523
   E      147      437
   F       46      668
> 
> ## NASA space shuttle o-ring failures
> fail <- factor(c(2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 2, 1, 2, 1,
+                  1, 1, 1, 2, 1, 1, 1, 1, 1),
+                levels = c(1, 2), labels = c("no", "yes"))
> temperature <- c(53, 57, 58, 63, 66, 67, 67, 67, 68, 69, 70, 70,
+                  70, 70, 72, 73, 75, 75, 76, 76, 78, 79, 81)
> 
> ## (dependence on a numerical variable)
> (spineplot(fail ~ temperature))
           fail
temperature no yes
    [50,55]  0   1
    (55,60]  0   2
    (60,65]  0   1
    (65,70]  8   2
    (70,75]  3   1
    (75,80]  4   0
    (80,85]  1   0
> (spineplot(fail ~ temperature, breaks = 3))
           fail
temperature no yes
    [50,60]  0   3
    (60,70]  8   3
    (70,80]  7   1
    (80,90]  1   0
> (spineplot(fail ~ temperature, breaks = quantile(temperature)))
           fail
temperature no yes
    [53,67]  4   4
    (67,70]  4   2
    (70,75]  3   1
    (75,81]  5   0
> 
> ## highlighting for failures
> spineplot(fail ~ temperature, ylevels = 2:1)
> 
> 
> 
> cleanEx()
> nameEx("stars")
> ### * stars
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: stars
> ### Title: Star (Spider/Radar) Plots and Segment Diagrams
> ### Aliases: stars
> ### Keywords: hplot multivariate
> 
> ### ** Examples
> 
> require(grDevices)
> stars(mtcars[, 1:7], key.loc = c(14, 2),
+       main = "Motor Trend Cars : stars(*, full = F)", full = FALSE)
> stars(mtcars[, 1:7], key.loc = c(14, 1.5),
+       main = "Motor Trend Cars : full stars()", flip.labels = FALSE)
> 
> ## 'Spider' or 'Radar' plot:
> stars(mtcars[, 1:7], locations = c(0, 0), radius = FALSE,
+       key.loc = c(0, 0), main = "Motor Trend Cars", lty = 2)
> 
> ## Segment Diagrams:
> palette(rainbow(12, s = 0.6, v = 0.75))
> stars(mtcars[, 1:7], len = 0.8, key.loc = c(12, 1.5),
+       main = "Motor Trend Cars", draw.segments = TRUE)
> stars(mtcars[, 1:7], len = 0.6, key.loc = c(1.5, 0),
+       main = "Motor Trend Cars", draw.segments = TRUE,
+       frame.plot = TRUE, nrow = 4, cex = .7)
> 
> ## scale linearly (not affinely) to [0, 1]
> USJudge <- apply(USJudgeRatings, 2, function(x) x/max(x))
> Jnam <- row.names(USJudgeRatings)
> Snam <- abbreviate(substring(Jnam, 1, regexpr("[,.]",Jnam) - 1), 7)
> stars(USJudge, labels = Jnam, scale = FALSE,
+       key.loc = c(13, 1.5), main = "Judge not ...", len = 0.8)
> stars(USJudge, labels = Snam, scale = FALSE,
+       key.loc = c(13, 1.5), radius = FALSE)
> 
> loc <- stars(USJudge, labels = NULL, scale = FALSE,
+              radius = FALSE, frame.plot = TRUE,
+              key.loc = c(13, 1.5), main = "Judge not ...", len = 1.2)
> text(loc, Snam, col = "blue", cex = 0.8, xpd = TRUE)
> 
> ## 'Segments':
> stars(USJudge, draw.segments = TRUE, scale = FALSE, key.loc = c(13,1.5))
> 
> ## 'Spider':
> stars(USJudgeRatings, locations = c(0, 0), scale = FALSE, radius  =  FALSE,
+       col.stars = 1:10, key.loc = c(0, 0), main = "US Judges rated")
> ## Same as above, but with colored lines instead of filled polygons.
> stars(USJudgeRatings, locations = c(0, 0), scale = FALSE, radius  =  FALSE,
+       col.lines = 1:10, key.loc = c(0, 0), main = "US Judges rated")
> ## 'Radar-Segments'
> stars(USJudgeRatings[1:10,], locations = 0:1, scale = FALSE,
+       draw.segments = TRUE, col.segments = 0, col.stars = 1:10, key.loc =  0:1,
+       main = "US Judges 1-10 ")
> palette("default")
> stars(cbind(1:16, 10*(16:1)), draw.segments = TRUE,
+       main = "A Joke -- do *not* use symbols on 2D data!")
> 
> 
> 
> cleanEx()
> nameEx("stem")
> ### * stem
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: stem
> ### Title: Stem-and-Leaf Plots
> ### Aliases: stem
> ### Keywords: univar distribution
> 
> ### ** Examples
> 
> stem(islands)

  The decimal point is 3 digit(s) to the right of the |

   0 | 00000000000000000000000000000111111222338
   2 | 07
   4 | 5
   6 | 8
   8 | 4
  10 | 5
  12 | 
  14 | 
  16 | 0

> stem(log10(islands))

  The decimal point is at the |

  1 | 1111112222233444
  1 | 5555556666667899999
  2 | 3344
  2 | 59
  3 | 
  3 | 5678
  4 | 012

> 
> 
> 
> cleanEx()
> nameEx("stripchart")
> ### * stripchart
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: stripchart
> ### Title: 1-D Scatter Plots
> ### Aliases: stripchart stripchart.default stripchart.formula
> ### Keywords: hplot
> 
> ### ** Examples
> 
> x <- stats::rnorm(50)
> xr <- round(x, 1)
> stripchart(x) ; m <- mean(par("usr")[1:2])
> text(m, 1.04, "stripchart(x, \"overplot\")")
> stripchart(xr, method = "stack", add = TRUE, at = 1.2)
> text(m, 1.35, "stripchart(round(x,1), \"stack\")")
> stripchart(xr, method = "jitter", add = TRUE, at = 0.7)
> text(m, 0.85, "stripchart(round(x,1), \"jitter\")")
> 
> stripchart(decrease ~ treatment,
+     main = "stripchart(OrchardSprays)",
+     vertical = TRUE, log = "y", data = OrchardSprays)
> 
> stripchart(decrease ~ treatment, at = c(1:8)^2,
+     main = "stripchart(OrchardSprays)",
+     vertical = TRUE, log = "y", data = OrchardSprays)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("strwidth")
> ### * strwidth
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: strwidth
> ### Title: Plotting Dimensions of Character Strings and Math Expressions
> ### Aliases: strwidth strheight
> ### Keywords: dplot character
> 
> ### ** Examples
> 
> str.ex <- c("W","w","I",".","WwI.")
> op <- par(pty = "s"); plot(1:100, 1:100, type = "n")
> sw <- strwidth(str.ex); sw
[1] 3.2600930 2.4934186 0.9600698 0.9600698 7.6736512
> all.equal(sum(sw[1:4]), sw[5])
[1] TRUE
> #- since the last string contains the others
> 
> sw.i <- strwidth(str.ex, "inches"); 25.4 * sw.i  # width in [mm]
[1] 3.996267 3.056467 1.176867 1.176867 9.406467
> unique(sw / sw.i)
[1] 20.72093 20.72093
> # constant factor: 1 value
> mean(sw.i / strwidth(str.ex, "fig")) / par('fin')[1]  # = 1: are the same
[1] 1
> 
> ## See how letters fall in classes
> ##  -- depending on graphics device and font!
> all.lett <- c(letters, LETTERS)
> shL <- strheight(all.lett, units = "inches") * 72  # 'big points'
> table(shL)  # all have same heights ...
shL
8.616 
   52 
> mean(shL)/par("cin")[2] # around 0.6
[1] 43.08
> 
> (swL <- strwidth(all.lett, units = "inches") * 72)  # 'big points'
 [1]  6.672  6.672  6.000  6.672  6.672  3.336  6.672  6.672  2.664  2.664
[11]  6.000  2.664  9.996  6.672  6.672  6.672  6.672  3.996  6.000  3.336
[21]  6.672  6.000  8.664  6.000  6.000  6.000  8.004  8.004  8.664  8.664
[31]  8.004  7.332  9.336  8.664  3.336  6.000  8.004  6.672  9.996  8.664
[41]  9.336  8.004  9.336  8.664  8.004  7.332  8.664  8.004 11.328  8.004
[51]  8.004  7.332
> split(all.lett, factor(round(swL, 2)))
$`2.66`
[1] "i" "j" "l"

$`3.34`
[1] "f" "t" "I"

$`4`
[1] "r"

$`6`
[1] "c" "k" "s" "v" "x" "y" "z" "J"

$`6.67`
 [1] "a" "b" "d" "e" "g" "h" "n" "o" "p" "q" "u" "L"

$`7.33`
[1] "F" "T" "Z"

$`8`
[1] "A" "B" "E" "K" "P" "S" "V" "X" "Y"

$`8.66`
[1] "w" "C" "D" "H" "N" "R" "U"

$`9.34`
[1] "G" "O" "Q"

$`10`
[1] "m" "M"

$`11.33`
[1] "W"

> 
> sumex <- expression(sum(x[i], i=1,n), e^{i * pi} == -1)
> strwidth(sumex)
[1]  5.795241 11.484959
> strheight(sumex)
[1] 8.057449 3.420738
> 
> par(op)  #- reset to previous setting
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("sunflowerplot")
> ### * sunflowerplot
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: sunflowerplot
> ### Title: Produce a Sunflower Scatter Plot
> ### Aliases: sunflowerplot sunflowerplot.default sunflowerplot.formula
> ### Keywords: hplot smooth nonparametric
> 
> ### ** Examples
> 
> require(stats) # for rnorm
> require(grDevices)
> 
> ## 'number' is computed automatically:
> sunflowerplot(iris[, 3:4])
> ## Imitating Chambers et al, p.109, closely:
> sunflowerplot(iris[, 3:4], cex = .2, cex.fact = 1, size = .035, seg.lwd = .8)
> ## or
> sunflowerplot(Petal.Width ~ Petal.Length, data = iris,
+               cex = .2, cex.fact = 1, size = .035, seg.lwd = .8)
> 
> 
> sunflowerplot(x = sort(2*round(rnorm(100))), y = round(rnorm(100), 0),
+               main = "Sunflower Plot of Rounded N(0,1)")
> ## Similarly using a "xyTable" argument:
> xyT <- xyTable(x = sort(2*round(rnorm(100))), y = round(rnorm(100), 0),
+                digits = 3)
> utils::str(xyT, vec.len = 20)
List of 3
 $ x     : num [1:25] -6 -4 -4 -4 -4 -2 -2 -2 -2 -2 0 0 0 0 0 0 2 2 2 2 2 4 4 4 4
 $ y     : num [1:25] 0 -2 0 1 2 -2 -1 0 1 2 -3 -2 -1 0 1 2 -2 -1 0 1 3 -1 0 1 2
 $ number: int [1:25] 1 1 1 1 3 1 4 8 4 1 1 3 5 17 12 2 1 8 12 6 1 1 3 2 1
> sunflowerplot(xyT, main = "2nd Sunflower Plot of Rounded N(0,1)")
> 
> ## A 'marked point process' {explicit 'number' argument}:
> sunflowerplot(rnorm(100), rnorm(100), number = rpois(n = 100, lambda = 2),
+               main = "Sunflower plot (marked point process)",
+               rotate = TRUE, col = "blue4")
> 
> 
> 
> cleanEx()
> nameEx("symbols")
> ### * symbols
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: symbols
> ### Title: Draw Symbols (Circles, Squares, Stars, Thermometers, Boxplots)
> ### Aliases: symbols
> ### Keywords: aplot hplot multivariate
> 
> ### ** Examples
> 
> require(stats); require(grDevices)
> x <- 1:10
> y <- sort(10*runif(10))
> z <- runif(10)
> z3 <- cbind(z, 2*runif(10), runif(10))
> symbols(x, y, thermometers = cbind(.5, 1, z), inches = .5, fg = 1:10)
> symbols(x, y, thermometers = z3, inches = FALSE)
> text(x, y, apply(format(round(z3, digits = 2)), 1, paste, collapse = ","),
+      adj = c(-.2,0), cex = .75, col = "purple", xpd = NA)
> 
> ## Note that  example(trees)  shows more sensible plots!
> N <- nrow(trees)
> with(trees, {
+ ## Girth is diameter in inches
+ symbols(Height, Volume, circles = Girth/24, inches = FALSE,
+         main = "Trees' Girth") # xlab and ylab automatically
+ ## Colours too:
+ op <- palette(rainbow(N, end = 0.9))
+ symbols(Height, Volume, circles = Girth/16, inches = FALSE, bg = 1:N,
+         fg = "gray30", main = "symbols(*, circles = Girth/16, bg = 1:N)")
+ palette(op)
+ })
> 
> 
> 
> cleanEx()
> nameEx("title")
> ### * title
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: title
> ### Title: Plot Annotation
> ### Aliases: title
> ### Keywords: aplot
> 
> ### ** Examples
> 
> plot(cars, main = "") # here, could use main directly
> title(main = "Stopping Distance versus Speed")
> 
> plot(cars, main = "")
> title(main = list("Stopping Distance versus Speed", cex = 1.5,
+                   col = "red", font = 3))
> 
> ## Specifying "..." :
> plot(1, col.axis = "sky blue", col.lab = "thistle")
> title("Main Title", sub = "subtitle",
+       cex.main = 2,   font.main= 4, col.main= "blue",
+       cex.sub = 0.75, font.sub = 3, col.sub = "red")
> 
> 
> x <- seq(-4, 4, length.out = 101)
> y <- cbind(sin(x), cos(x))
> matplot(x, y, type = "l", xaxt = "n",
+         main = expression(paste(plain(sin) * phi, "  and  ",
+                                 plain(cos) * phi)),
+         ylab = expression("sin" * phi, "cos" * phi), # only 1st is taken
+         xlab = expression(paste("Phase Angle ", phi)),
+         col.main = "blue")
> axis(1, at = c(-pi, -pi/2, 0, pi/2, pi),
+      labels = expression(-pi, -pi/2, 0, pi/2, pi))
> abline(h = 0, v = pi/2 * c(-1,1), lty = 2, lwd = .1, col = "gray70")
> 
> 
> 
> cleanEx()
> nameEx("units")
> ### * units
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: units
> ### Title: Graphical Units
> ### Aliases: xinch yinch xyinch
> ### Keywords: dplot
> 
> ### ** Examples
> 
> all(c(xinch(), yinch()) == xyinch()) # TRUE
[1] TRUE
> xyinch()
[1] 1.5000000 0.4185559
> xyinch #- to see that is really   delta{"usr"} / "pin"
function (xy = 1, warn.log = TRUE) 
{
    if (warn.log && (par("xlog") || par("ylog"))) 
        warning("log scale:  xyinch() is nonsense")
    u <- par("usr")
    xy * c(u[2L] - u[1L], u[4L] - u[3L])/par("pin")
}
<bytecode: 0x55dacadb84e8>
<environment: namespace:graphics>
> 
> ## plot labels offset 0.12 inches to the right
> ## of plotted symbols in a plot
> with(mtcars, {
+     plot(mpg, disp, pch = 19, main = "Motor Trend Cars")
+     text(mpg + xinch(0.12), disp, row.names(mtcars),
+          adj = 0, cex = .7, col = "blue")
+     })
> 
> 
> 
> cleanEx()
> nameEx("xspline")
> ### * xspline
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xspline
> ### Title: Draw an X-spline
> ### Aliases: xspline
> ### Keywords: aplot
> 
> ### ** Examples
> 
> ## based on examples in ?grid.xspline
> 
> xsplineTest <- function(s, open = TRUE,
+                         x = c(1,1,3,3)/4,
+                         y = c(1,3,3,1)/4, ...) {
+     plot(c(0,1), c(0,1), type = "n", axes = FALSE, xlab = "", ylab = "")
+     points(x, y, pch = 19)
+     xspline(x, y, s, open, ...)
+     text(x+0.05*c(-1,-1,1,1), y+0.05*c(-1,1,1,-1), s)
+ }
> op <- par(mfrow = c(3,3), mar = rep(0,4), oma = c(0,0,2,0))
> xsplineTest(c(0, -1, -1, 0))
> xsplineTest(c(0, -1,  0, 0))
> xsplineTest(c(0, -1,  1, 0))
> xsplineTest(c(0,  0, -1, 0))
> xsplineTest(c(0,  0,  0, 0))
> xsplineTest(c(0,  0,  1, 0))
> xsplineTest(c(0,  1, -1, 0))
> xsplineTest(c(0,  1,  0, 0))
> xsplineTest(c(0,  1,  1, 0))
> title("Open X-splines", outer = TRUE)
> 
> par(mfrow = c(3,3), mar = rep(0,4), oma = c(0,0,2,0))
> xsplineTest(c(0, -1, -1, 0), FALSE, col = "grey80")
> xsplineTest(c(0, -1,  0, 0), FALSE, col = "grey80")
> xsplineTest(c(0, -1,  1, 0), FALSE, col = "grey80")
> xsplineTest(c(0,  0, -1, 0), FALSE, col = "grey80")
> xsplineTest(c(0,  0,  0, 0), FALSE, col = "grey80")
> xsplineTest(c(0,  0,  1, 0), FALSE, col = "grey80")
> xsplineTest(c(0,  1, -1, 0), FALSE, col = "grey80")
> xsplineTest(c(0,  1,  0, 0), FALSE, col = "grey80")
> xsplineTest(c(0,  1,  1, 0), FALSE, col = "grey80")
> title("Closed X-splines", outer = TRUE)
> 
> par(op)
> 
> x <- sort(stats::rnorm(5))
> y <- sort(stats::rnorm(5))
> plot(x, y, pch = 19)
> res <- xspline(x, y, 1, draw = FALSE)
> lines(res)
> ## the end points may be very close together,
> ## so use last few for direction
> nr <- length(res$x)
> arrows(res$x[1], res$y[1], res$x[4], res$y[4], code = 1, length = 0.1)
> arrows(res$x[nr-3], res$y[nr-3], res$x[nr], res$y[nr], code = 2, length = 0.1)
> 
> 
> 
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> ### * <FOOTER>
> ###
> cleanEx()
> options(digits = 7L)
> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
Time elapsed:  2.98 0.04 3.02 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')