The R Project SVN
R
(root)/trunk/tests/Examples/graphics-Ex.Rout.save – Rev 87785
Rev 87423 | Rev 88571 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
R Under development (unstable) (2025-02-17 r87727) -- "Unsuffered Consequences"Copyright (C) 2025 The R Foundation for Statistical ComputingPlatform: x86_64-pc-linux-gnuR 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))> xEyeHair Brown Blue Hazel GreenBlack 68 20 15 5Brown 119 84 54 29Red 26 17 14 14Blond 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+051000 1e+06 2 ; 500 1000 5000 10000 50000 1e+05 5e+05 1e+061000 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[1] 1e-02 1e+00 1e+02 1e+04 1e+06 1e+08 1e+10> 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, {+ opar <- par(mfrow = c(3,1))+ time <- strptime(paste(1990, day, time %/% 100, time %% 100),+ "%Y %j %H %M")+ plot(time, temp, type = "l") # axis at 6-hour intervals+ # request more ticks+ olab <- par(lab = c(10, 10, 7))+ plot(time, temp, type = "l")+ par(olab)+ # 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")+ par(opar) # reset changed par settings+ })>> 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)>> ## axis.Date() with various data types:> x <- seq(as.Date("2022-01-20"), as.Date("2023-03-21"), by = "days")> plot(data.frame(x, y = 1), xaxt = "n")> legend("topleft", title = "input",+ legend = c("character", "Date", "POSIXct", "POSIXlt", "numeric"),+ fill = c("violet", "red", "orange", "coral1", "darkgreen"))> axis.Date(1)> axis.Date(3, at = "2022-04-01", col.axis = "violet")> axis.Date(3, at = as.Date("2022-07-01"), col.axis = "red")> axis.Date(3, at = as.POSIXct(as.Date("2022-10-01")), col.axis = "orange")> axis.Date(3, at = as.POSIXlt(as.Date("2023-01-01")), col.axis = "coral1")> axis.Date(3, at = as.integer(as.Date("2023-04-01")), col.axis = "darkgreen")> ## automatically extends the format:> axis.Date(1, at = "2022-02-15", col.axis = "violet",+ col = "violet", tck = -0.05, mgp = c(3,2,0))>> ## axis.POSIXct() with various data types (2 minutes):> x <- as.POSIXct("2022-10-01") + c(0, 60, 120)> attributes(x) # no timezone$class[1] "POSIXct" "POSIXt"> plot(data.frame(x, y = 1), xaxt = "n")> legend("topleft", title = "input",+ legend = c("character", "Date", "POSIXct", "POSIXlt", "numeric"),+ fill = c("violet", "red", "orange", "coral1", "darkgreen"))> axis.POSIXct(1)> axis.POSIXct(3, at = "2022-10-01 00:01", col.axis = "violet")> axis.POSIXct(3, at = as.Date("2022-10-01"), col.axis = "red")> axis.POSIXct(3, at = as.POSIXct("2022-10-01 00:01:30"), col.axis = "orange")> axis.POSIXct(3, at = as.POSIXlt("2022-10-01 00:02"), col.axis = "coral1")> axis.POSIXct(3, at = as.numeric(as.POSIXct("2022-10-01 00:00:30")),+ col.axis = "darkgreen")> ## automatically extends format (here: subseconds):> axis.POSIXct(3, at = as.numeric(as.POSIXct("2022-10-01 00:00:30")) + 0.25,+ col.axis = "forestgreen", col = "darkgreen", mgp = c(3,2,0))>> ## axis.POSIXct: 2 time zones> HST <- as.POSIXct("2022-10-01", tz = "HST") + c(0, 60, 60*60)> CET <- HST> attr(CET, "tzone") <- "CET"> plot(data.frame(HST, y = 1), xaxt = "n", xlab = "Hawaii Standard Time (HST)")> axis.POSIXct(1, HST)> axis.POSIXct(1, HST, at = "2022-10-01 00:10", col.axis = "violet")> axis.POSIXct(3, CET)> mtext(3, text = "Central European Time (CET)", line = 3)> axis.POSIXct(3, CET, at="2022-10-01 12:10", col.axis = "violet")>>>> graphics::par(get("par.postscript", pos = 'CheckExEnv'))> 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 Freq1st :8 Male :16 Child:16 No :16 Min. : 0.002nd :8 Female:16 Adult:16 Yes:16 1st Qu.: 0.753rd :8 Median : 13.50Crew:8 Mean : 68.783rd Qu.: 77.00Max. :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 = MaleClassSurvived 1st 2nd 3rd CrewNo 118 154 387 670Yes 57 14 75 192, , Sex = FemaleClassSurvived 1st 2nd 3rd CrewNo 4 13 89 3Yes 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))failtemperature 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, `+`))> ## "minimal"> filled.contour(cos(r^2)*exp(-r/(2*pi)), axes = FALSE, key.border=NA)> ## rather, the key *should* be labeled (but axes still not):> 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 FSex Admit?Male Yes 512 353 120 138 53 22No 313 207 205 279 138 351Female Yes 89 17 202 131 94 24No 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)>> plot(1:64)> gr <- grid() # now *invisibly* returns the grid "at" locations> str(gr)List of 2$ atx: num [1:7] 0 10 20 30 40 50 60$ aty: num [1:7] 0 10 20 30 40 50 60> stopifnot(length(gr) == 2, identical(gr[[1]], gr[[2]]),+ gr[["atx"]] == 10*(0:6))>> ## In log-scale plots :> plot(8:270, log="xy") ; grid() # at (1, 10, 100); if preferring "all" grid lines:> plot(8:270, log="xy") ; grid(equilogs = FALSE) -> grll> stopifnot(identical(grll, list(atx = c(1, 2, 5, 10, 20, 50, 100, 200),+ aty = c( 10, 20, 50, 100, 200))))>> x <- 2^(-9:70)> plot(log(x) ~ x, log="xy")Warning in xy.coords(x, y, xlabel, ylabel, log) :10 y values <= 0 omitted from logarithmic plot> grll <- grid(equilogs = FALSE, col = adjustcolor("green", 1/3))> gr20 <- grid(nintLog = 20)> gr25 <- grid(nintLog = 25, col="thistle")> str(gr25)List of 2$ atx: num [1:26] 1e-03 1e-02 1e-01 1e+00 1e+01 1e+02 1e+03 1e+04 1e+05 1e+06 ...$ aty: num [1:2] 1 10> stopifnot(exprs = {+ grll$aty == c(1, 2, 5, 10, 20, 50)+ length(gr20$atx) >= 20 # 24 effectively+ all.equal(10^(-3:22), gr25$atx, tol = 1e-15) # even tol = 0+ })>>>> 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 density48.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) breaksList 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 warningWarning 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)>> # Visualize as matrix. Need to transpose matrix and then flip it horizontally:> tf <- function(m) t(m)[, nrow(m):1]> imageM <- function(m, grid = max(dim(m)) <= 25, asp = (nrow(m)-1)/(ncol(m)-1), ...) {+ image(tf(m), asp=asp, axes = FALSE, ...)+ mAxis <- function(side, at, ...) # using 'j'+ axis(side, at=at, labels=as.character(j+1L), col="gray", col.axis=1, ...)+ n <- ncol(m); n1 <- n-1L; j <- 0L:n1; mAxis(1, at= j/n1)+ if(grid) abline(v = (0:n - .5)/n1, col="gray77", lty="dotted")+ n <- nrow(m); n1 <- n-1L; j <- 0L:n1; mAxis(2, at=1-j/n1, las=1)+ if(grid) abline(h = (0:n - .5)/n1, col="gray77", lty="dotted")+ }> (m <- outer(1:5, 1:14))[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14][1,] 1 2 3 4 5 6 7 8 9 10 11 12 13 14[2,] 2 4 6 8 10 12 14 16 18 20 22 24 26 28[3,] 3 6 9 12 15 18 21 24 27 30 33 36 39 42[4,] 4 8 12 16 20 24 28 32 36 40 44 48 52 56[5,] 5 10 15 20 25 30 35 40 45 50 55 60 65 70> imageM(m, main = "image(<5 x 14 matrix>) with rows and columns")> imageM(volcano)>> # 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 & coordsxchar= 0.1723,0.1969,0.2215,0.2461 ; (yextra, ychar)= 0,0,0,0, 0.2355,0.2355,0.2355,0.2355rect2(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.1256rect2(-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.1256rect2(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.07535rect2(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' factorsetosa versicolor virginica50 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))>> matplot(iris3[, "Petal L.",], iris3[, "Petal W.",], pch = "SCV",+ col = rainbow(3, start = 0.8, end = 0.1),+ sub = paste(c("S", "C", "V"), dimnames(iris3)[[3]],+ sep = "=", collapse= ", "),+ main = "Fisher's Iris Data")> par(op)>> ## 'x' a "Date" vector :> nd <- length(dv <- seq(as.Date("1959-02-21"), by = "weeks", length.out = 100))> mSC <- cbind(I=1, sin=sin(pi*(1:nd)/8), cos=cos(pi*(1:nd)/8))> matplot(dv, mSC, type = "b", main = "matplot(<Date>, y)")>> ## 'x' a "POSIXct" date-time vector :> ct <- seq(c(ISOdate(2000,3,20)), by = "15 mins", length.out = 100)> matplot(ct, mSC, type = "b", main = "matplot(<POSIXct>, y)")> ## or the same with even more axis flexibility:> matplot(ct, mSC, type = "b", main = "matplot(<POSIXct>, y)", xaxt="n")> Axis(ct, side=1, at = ct[1+4*(0:24)])>> iS <- 1:3 # indices of subset> matplot(gait[, iS, 1], gait[, iS, 2], pch = "123", type = "b",+ col = rainbow(3, start = 0.8, end = 0.1),+ sub = paste(iS, dimnames(gait)[[2]][iS],+ sep = "=", collapse= ", "),+ xlab = "Hip angle", ylab = "Knee angle",+ main = "Hip and knee angle while walking")>> ## 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)>> ##--- illustrating padj behavior :> plot(0, axes=FALSE, ann=FALSE, frame.plot=TRUE)> for(si in 1:4) mtext(c("padj=0", "-----------", "padj=1"),+ side = si, padj = c(0, 0.5, 1))>>>> 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 mechanics16 11 10 9 9 6policemen managers engineers teachers housewives students6 6 5 4 3 3armed.forces1> 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)> 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 )", cex.axis = 0.8+ ) -> 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], z = 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(state.region)>> ## called from the formula method> plot(~ group, data = PlantGrowth)> plot(weight ~ group, data = PlantGrowth) # numeric ~ 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)))N1 2 3 4 5 6 7 8 9 10 114 14 25 38 40 33 21 16 4 2 3> plot(Poiss.tab, main = "plot(table(rpois(200, lambda = 5)))")>> plot(table(state.division))>> ## 4-D :> plot(Titanic, main ="plot(Titanic, main= *)")>>>>> cleanEx()> nameEx("plot.window")> ### * plot.window>> flush(stderr()); flush(stdout())>> ### Name: plot.window> ### Title: Set up World Coordinates for Graphics Window> ### Aliases: plot.window xlim ylim asp> ### Keywords: aplot>> ### ** Examples>> ##--- An example for the use of 'asp' :> require(stats) # normally loaded> loc <- cmdscale(eurodist)> rx <- range(x <- loc[,1])> ry <- range(y <- -loc[,2])> plot(x, y, type = "n", asp = 1, xlab = "", ylab = "")> abline(h = pretty(rx, 10), v = pretty(ry, 10), col = "lightgray")> text(x, y, labels(eurodist), cex = 0.8)>>>> cleanEx()> nameEx("plot.xy")> ### * plot.xy>> flush(stderr()); flush(stdout())>> ### Name: plot.xy> ### Title: Basic Internal Plot Function> ### Aliases: plot.xy> ### Keywords: aplot>> ### ** Examples>> points.default # to see how it calls "plot.xy(xy.coords(x, y), ...)"function (x, y = NULL, type = "p", ...)plot.xy(xy.coords(x, y), type = type, ...)<bytecode: 0x148a28c60><environment: namespace:graphics>>>>> cleanEx()> nameEx("plothistogram")> ### * plothistogram>> flush(stderr()); flush(stdout())>> ### Name: plot.histogram> ### Title: Plot Histograms> ### Aliases: plot.histogram lines.histogram> ### Keywords: hplot iplot>> ### ** Examples>> (wwt <- hist(women$weight, nclass = 7, plot = FALSE))$breaks[1] 115 120 125 130 135 140 145 150 155 160 165$counts[1] 3 1 2 2 1 1 2 1 1 1$density[1] 0.04000000 0.01333333 0.02666667 0.02666667 0.01333333 0.01333333[7] 0.02666667 0.01333333 0.01333333 0.01333333$mids[1] 117.5 122.5 127.5 132.5 137.5 142.5 147.5 152.5 157.5 162.5$xname[1] "women$weight"$equidist[1] TRUEattr(,"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)>> ## Illustration of pch = 0:25 (as in the figure shown above in PDF/HTML help)> ## Not run: png("pch.png", height = 0.7, width = 7, res = 100, units = "in")> par(mar = rep(0,4))> plot(c(-1, 26), 0:1, type = "n", axes = FALSE)> text(0:25, 0.6, 0:25, cex = 0.5)> points(0:25, rep(0.3, 26), pch = 0:25, bg = "grey")>>> ##-------- 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))improvedtreatment none some markedplacebo 29 7 7treated 13 7 21>> ## applications and admissions by department at UC Berkeley> ## (two-way tables)> (spineplot(marginSums(UCBAdmissions, c(3, 2)),+ main = "Applications at UCB"))GenderDept Male FemaleA 825 108B 560 25C 325 593D 417 375E 191 393F 373 341> (spineplot(marginSums(UCBAdmissions, c(3, 1)),+ main = "Admissions at UCB"))AdmitDept Admitted RejectedA 601 332B 370 215C 322 596D 269 523E 147 437F 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))failtemperature 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))failtemperature no yes[50,60] 0 3(60,70] 8 3(70,80] 7 1(80,90] 1 0> (spineplot(fail ~ temperature, breaks = quantile(temperature)))failtemperature 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 | 000000000000000000000000000001111112223382 | 074 | 56 | 88 | 410 | 512 |14 |16 | 0> stem(log10(islands))The decimal point is at the |1 | 11111122222334441 | 55555566666678999992 | 33442 | 593 |3 | 56784 | 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 ...shL8.61652> mean(shL)/par("cin")[2] # around 0.6[1] 43.08>> (swL <- strwidth(all.lett, units = "inches") * 72) # 'big points'[1] 6.672 6.672 6.000 6.672 6.672 3.336 6.672 6.672 2.664 2.664[11] 6.000 2.664 9.996 6.672 6.672 6.672 6.672 3.996 6.000 3.336[21] 6.672 6.000 8.664 6.000 6.000 6.000 8.004 8.004 8.664 8.664[31] 8.004 7.332 9.336 8.664 3.336 6.000 8.004 6.672 9.996 8.664[41] 9.336 8.004 9.336 8.664 8.004 7.332 8.664 8.004 11.328 8.004[51] 8.004 7.332> split(all.lett, factor(round(swL, 2)))$`2.66`[1] "i" "j" "l"$`3.34`[1] "f" "t" "I"$`4`[1] "r"$`6`[1] "c" "k" "s" "v" "x" "y" "z" "J"$`6.67`[1] "a" "b" "d" "e" "g" "h" "n" "o" "p" "q" "u" "L"$`7.33`[1] "F" "T" "Z"$`8`[1] "A" "B" "E" "K" "P" "S" "V" "X" "Y"$`8.66`[1] "w" "C" "D" "H" "N" "R" "U"$`9.34`[1] "G" "O" "Q"$`10`[1] "m" "M"$`11.33`[1] "W">> sumex <- expression(sum(x[i], i=1,n), e^{i * pi} == -1)> strwidth(sumex)[1] 5.795241 11.484959> strheight(sumex)[1] 8.057449 3.420738>> par(op) #- reset to previous setting>>>> graphics::par(get("par.postscript", pos = 'CheckExEnv'))> cleanEx()> nameEx("sunflowerplot")> ### * sunflowerplot>> flush(stderr()); flush(stdout())>> ### Name: sunflowerplot> ### Title: Produce a Sunflower Scatter Plot> ### Aliases: sunflowerplot sunflowerplot.default sunflowerplot.formula> ### Keywords: hplot smooth nonparametric>> ### ** Examples>> require(stats) # for rnorm> require(grDevices)>> ## 'number' is computed automatically:> sunflowerplot(iris[, 3:4])> ## Imitating Chambers et al, p.109, closely:> sunflowerplot(iris[, 3:4], cex = .2, cex.fact = 1, size = .035, seg.lwd = .8)> ## or> sunflowerplot(Petal.Width ~ Petal.Length, data = iris,+ cex = .2, cex.fact = 1, size = .035, seg.lwd = .8)>>> sunflowerplot(x = sort(2*round(rnorm(100))), y = round(rnorm(100), 0),+ main = "Sunflower Plot of Rounded N(0,1)")> ## Similarly using a "xyTable" argument:> xyT <- xyTable(x = sort(2*round(rnorm(100))), y = round(rnorm(100), 0),+ digits = 3)> utils::str(xyT, vec.len = 20)List of 3$ x : num [1:25] -6 -4 -4 -4 -4 -2 -2 -2 -2 -2 0 0 0 0 0 0 2 2 2 2 2 4 4 4 4$ y : num [1:25] 0 -2 0 1 2 -2 -1 0 1 2 -3 -2 -1 0 1 2 -2 -1 0 1 3 -1 0 1 2$ number: int [1:25] 1 1 1 1 3 1 4 8 4 1 1 3 5 17 12 2 1 8 12 6 1 1 3 2 1> sunflowerplot(xyT, main = "2nd Sunflower Plot of Rounded N(0,1)")>> ## A 'marked point process' {explicit 'number' argument}:> sunflowerplot(rnorm(100), rnorm(100), number = rpois(n = 100, lambda = 2),+ main = "Sunflower plot (marked point process)",+ rotate = TRUE, col = "blue4")>>>> cleanEx()> nameEx("symbols")> ### * symbols>> flush(stderr()); flush(stdout())>> ### Name: symbols> ### Title: Draw Symbols (Circles, Squares, Stars, Thermometers, Boxplots)> ### Aliases: symbols> ### Keywords: aplot hplot multivariate>> ### ** Examples>> require(stats); require(grDevices)> x <- 1:10> y <- sort(10*runif(10))> z <- runif(10)> z3 <- cbind(z, 2*runif(10), runif(10))> symbols(x, y, thermometers = cbind(.5, 1, z), inches = .5, fg = 1:10)> symbols(x, y, thermometers = z3, inches = FALSE)> text(x, y, apply(format(round(z3, digits = 2)), 1, paste, collapse = ","),+ adj = c(-.2,0), cex = .75, col = "purple", xpd = NA)>> ## Note that example(trees) shows more sensible plots!> N <- nrow(trees)> with(trees, {+ ## Girth is diameter in inches+ symbols(Height, Volume, circles = Girth/24, inches = FALSE,+ main = "Trees' Girth") # xlab and ylab automatically+ ## Colours too:+ op <- palette(rainbow(N, end = 0.9))+ symbols(Height, Volume, circles = Girth/16, inches = FALSE, bg = 1:N,+ fg = "gray30", main = "symbols(*, circles = Girth/16, bg = 1:N)")+ palette(op)+ })>>>> cleanEx()> nameEx("title")> ### * title>> flush(stderr()); flush(stdout())>> ### Name: title> ### Title: Plot Annotation> ### Aliases: title> ### Keywords: aplot>> ### ** Examples>> plot(cars, main = "") # here, could use main directly> title(main = "Stopping Distance versus Speed")>> plot(cars, main = "")> title(main = list("Stopping Distance versus Speed", cex = 1.5,+ col = "red", font = 3))>> ## Specifying "..." :> plot(1, col.axis = "sky blue", col.lab = "thistle")> title("Main Title", sub = "subtitle",+ cex.main = 2, font.main= 4, col.main= "blue",+ cex.sub = 0.75, font.sub = 3, col.sub = "red")>>> x <- seq(-4, 4, length.out = 101)> y <- cbind(sin(x), cos(x))> matplot(x, y, type = "l", xaxt = "n",+ main = expression(paste(plain(sin) * phi, " and ",+ plain(cos) * phi)),+ ylab = expression("sin" * phi, "cos" * phi), # only 1st is taken+ xlab = expression(paste("Phase Angle ", phi)),+ col.main = "blue")> axis(1, at = c(-pi, -pi/2, 0, pi/2, pi),+ labels = expression(-pi, -pi/2, 0, pi/2, pi))> abline(h = 0, v = pi/2 * c(-1,1), lty = 2, lwd = .1, col = "gray70")>>>> cleanEx()> nameEx("units")> ### * units>> flush(stderr()); flush(stdout())>> ### Name: units> ### Title: Graphical Units> ### Aliases: xinch yinch xyinch> ### Keywords: dplot>> ### ** Examples>> all(c(xinch(), yinch()) == xyinch()) # TRUE[1] TRUE> xyinch()[1] 1.5000000 0.4185559> xyinch #- to see that is really delta{"usr"} / "pin"function (xy = 1, warn.log = TRUE){if (warn.log && (par("xlog") || par("ylog")))warning("log scale: xyinch() is nonsense")u <- par("usr")xy * c(u[2L] - u[1L], u[4L] - u[3L])/par("pin")}<bytecode: 0x1484fa978><environment: namespace:graphics>>> ## plot labels offset 0.12 inches to the right> ## of plotted symbols in a plot> with(mtcars, {+ plot(mpg, disp, pch = 19, main = "Motor Trend Cars")+ text(mpg + xinch(0.12), disp, row.names(mtcars),+ adj = 0, cex = .7, col = "blue")+ })>>>> cleanEx()> nameEx("xspline")> ### * xspline>> flush(stderr()); flush(stdout())>> ### Name: xspline> ### Title: Draw an X-spline> ### Aliases: xspline> ### Keywords: aplot>> ### ** Examples>> ## based on examples in ?grid.xspline>> xsplineTest <- function(s, open = TRUE,+ x = c(1,1,3,3)/4,+ y = c(1,3,3,1)/4, ...) {+ plot(c(0,1), c(0,1), type = "n", axes = FALSE, xlab = "", ylab = "")+ points(x, y, pch = 19)+ xspline(x, y, s, open, ...)+ text(x+0.05*c(-1,-1,1,1), y+0.05*c(-1,1,1,-1), s)+ }> op <- par(mfrow = c(3,3), mar = rep(0,4), oma = c(0,0,2,0))> xsplineTest(c(0, -1, -1, 0))> xsplineTest(c(0, -1, 0, 0))> xsplineTest(c(0, -1, 1, 0))> xsplineTest(c(0, 0, -1, 0))> xsplineTest(c(0, 0, 0, 0))> xsplineTest(c(0, 0, 1, 0))> xsplineTest(c(0, 1, -1, 0))> xsplineTest(c(0, 1, 0, 0))> xsplineTest(c(0, 1, 1, 0))> title("Open X-splines", outer = TRUE)>> par(mfrow = c(3,3), mar = rep(0,4), oma = c(0,0,2,0))> xsplineTest(c(0, -1, -1, 0), FALSE, col = "grey80")> xsplineTest(c(0, -1, 0, 0), FALSE, col = "grey80")> xsplineTest(c(0, -1, 1, 0), FALSE, col = "grey80")> xsplineTest(c(0, 0, -1, 0), FALSE, col = "grey80")> xsplineTest(c(0, 0, 0, 0), FALSE, col = "grey80")> xsplineTest(c(0, 0, 1, 0), FALSE, col = "grey80")> xsplineTest(c(0, 1, -1, 0), FALSE, col = "grey80")> xsplineTest(c(0, 1, 0, 0), FALSE, col = "grey80")> xsplineTest(c(0, 1, 1, 0), FALSE, col = "grey80")> title("Closed X-splines", outer = TRUE)>> par(op)>> x <- sort(stats::rnorm(5))> y <- sort(stats::rnorm(5))> plot(x, y, pch = 19)> res <- xspline(x, y, 1, draw = FALSE)> lines(res)> ## the end points may be very close together,> ## so use last few for direction> nr <- length(res$x)> arrows(res$x[1], res$y[1], res$x[4], res$y[4], code = 1, length = 0.1)> arrows(res$x[nr-3], res$y[nr-3], res$x[nr], res$y[nr], code = 2, length = 0.1)>>>> graphics::par(get("par.postscript", pos = 'CheckExEnv'))> ### * <FOOTER>> ###> cleanEx()> options(digits = 7L)> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")Time elapsed: 1.594 0.099 1.697 0 0> grDevices::dev.off()null device1> ###> ### Local variables: ***> ### mode: outline-minor ***> ### outline-regexp: "\\(> \\)?### [*]+" ***> ### End: ***> quit('no')