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

  Natural language support but running in an English locale

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("right", leg.txt, pch = "sSvV", col = c(1, 3),
+        cex = 1+(-1:2)/8, trace = TRUE)# trace: show computed lengths & coords
  xchar= 0.1723,0.1969,0.2215,0.2461 ; (yextra, ychar)= 0,0,0,0, 0.2355,0.2355,0.2355,0.2355 
  rect2(5.559,2.839, w=2.721, h=1.177, ...)
  points2( 5.732 5.756 5.781 5.805 , 2.603 2.368 2.132 1.897 , pch= s S v V , ...) 
> 
> ## 'merge = TRUE' for merging lines & points:
> x <- seq(-pi, pi, length.out = 65)
> for(reverse in c(FALSE, TRUE)) {  ## normal *and* reverse axes:
+   F <- if(reverse) rev else identity
+   plot(x, sin(x), type = "l", col = 3, lty = 2,
+        xlim = F(range(x)), ylim = F(c(-1.2, 1.8)))
+   points(x, cos(x), pch = 3, col = 4)
+   lines(x, tan(x), type = "b", lty = 1, pch = 4, col = 6)
+   title("legend('top', lty = c(2, -1, 1), pch = c(NA, 3, 4), merge = TRUE)",
+         cex.main = 1.1)
+   legend("top", 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", trace=TRUE)
+   ## Don't show: 
+  if(!reverse && interactive()) {
+     cat("waiting .."); Sys.sleep(2); cat(" done\n") }
+   
+ ## End(Don't show)
+ } # for(..)
  xchar= 0.1767,0.1767,0.1767 ; (yextra, ychar)= 0,0,0, 0.1256,0.1256,0.1256 
  rect2(-0.4885,1.92, w=0.977, h=0.5023, ...)
  segments2( -0.4355 -0.4355 , 1.794 1.543 , dx= 0.3534 0.3534 , dy=0, ...) 
  points2( -0.2588 -0.2588 , 1.669 1.543 , pch= 3 4 , ...) 
  xchar= -0.1767,-0.1767,-0.1767 ; (yextra, ychar)= -0,-0,-0, -0.1256,-0.1256,-0.1256 
  rect2(0.4885,-1.32, w=-0.977, h=-0.5023, ...)
  segments2( 0.4355 0.4355 , -1.194 -0.9433 , dx= -0.3534 -0.3534 , dy=0, ...) 
  points2( 0.2588 0.2588 , -1.069 -0.9433 , pch= 3 4 , ...) 
> 
> ## 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, inset = 1/10,
+                title = "Line Types", title.cex = 0.5, trace=TRUE)
  xchar= 0.1125,0.1125 ; (yextra, ychar)= 0,0, 0.07535,0.07535 
  rect2(3.666,1.878, w=1.062, h=0.2637, ...)
  segments2( 3.778 3.778 , 1.765 1.689 , dx= 0.225 0.225 , dy=0, ...) 
> 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)  #, trace = TRUE)
+ } #      ^^^^^^^ to force lines -> automatic merge=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 -- see also example(barplot) which may call legend(*, fill=)
> barplot(VADeaths)
> legend("topright", rownames(VADeaths), fill = gray.colors(nrow(VADeaths)))
> 
> ## Using 'ncol'
> x <- 0:64/64
> for(R in c(identity, rev)) { # normal *and* reverse x-axis works fine:
+   xl <- R(range(x)); x1 <- xl[1]
+ matplot(x, outer(x, 1:7, function(x, k) sin(k * pi * x)), xlim=xl,
+         type = "o", col = 1:7, ylim = c(-1, 1.5), pch = "*")
+ op <- par(bg = "antiquewhite1")
+ legend(x1, 1.5, paste("sin(", 1:7, "pi * x)"), col = 1:7, lty = 1:7,
+        pch = "*", ncol = 4, cex = 0.8)
+ legend("bottomright", paste("sin(", 1:7, "pi * x)"), col = 1:7, lty = 1:7,
+        pch = "*", cex = 0.8)
+ legend(x1, -.1, paste("sin(", 1:4, "pi * x)"), col = 1:4, lty = 1:4,
+        ncol = 2, cex = 0.8)
+ legend(x1, -.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)
+   ## Don't show: 
+  if(interactive() && identical(R, identity)) {
+      cat("waiting .."); Sys.sleep(2); cat(" done\n") }
+ ## End(Don't show)
+ } # for(..)
> 
> ## 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)
> 
> # using text.width for several columns
> plot(1, type="n")
> legend("topleft", c("This legend", "has", "equally sized", "columns."),
+        pch = 1:4, ncol = 4)
> legend("bottomleft", c("This legend", "has", "optimally sized", "columns."),
+        pch = 1:4, ncol = 4, text.width = NA)
> legend("right", letters[1:4], pch = 1:4, ncol = 4,
+        text.width = 1:4 / 50)
> 
> 
> 
> 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: 0x2931ea0>
<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: 0x44b1200>
<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:  7.891 0.169 8.114 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')