R Under development (unstable) (2022-01-05 r81451) -- "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. 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(, 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(, y)") > ## or the same with even more axis flexibility: > matplot(ct, mSC, type = "b", main = "matplot(, 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, ...) > > > > 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") } > > ## 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')) > ### *