R : Copyright 2002, The R Development Core Team Version 1.5.0 Under development (unstable) (2002-03-09) R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type `license()' or `licence()' for distribution details. R is a collaborative project with many contributors. Type `contributors()' for more information. Type `demo()' for some demos, `help()' for on-line help, or `help.start()' for a HTML browser interface to help. Type `q()' to quit R. > #### Run all demos that do not depend on tcl and other specials. > .ptime <- proc.time() > .Random.seed <- c(0,rep(7654, 3)) > > ## Currently only do `base', but others make sense, not tcltk though : > > ## Drop these for strict testing {and add them to \testonly{.} examples > ## in ../src/library/base/man/demo.Rd }: > dont <- list(base = c("nlm", "lm.glm") + ) > for(pkg in c("base", "eda")) { + + demos <- list.files(file.path(system.file(package = pkg), "demo"), + pattern = "\\.R$") + demos <- demos[is.na(match(demos, paste(dont[[pkg]], "R",sep=".")))] + + if(length(demos)) { + if(need <- pkg != "base" && + !any((fpkg <- paste("package", pkg, sep=":")) == search())) + library(pkg, character.only = TRUE) + + for(nam in sub("\\.R$", "", demos)) + demo(nam, character.only = TRUE) + + if(need) detach(pos = which(fpkg == search())) + } + } demo(glm.vr) ---- ~~~~~~ > Fr <- c(68, 42, 42, 30, 37, 52, 24, 43, 66, 50, 33, 23, 47, 55, 23, 47, 63, 53, 29, 27, 57, 49, 19, 29) > Temp <- gl(2, 2, 24, labels = c("Low", "High")) > Soft <- gl(3, 8, 24, labels = c("Hard", "Medium", "Soft")) > M.user <- gl(2, 4, 24, labels = c("N", "Y")) > Brand <- gl(2, 1, 24, labels = c("X", "M")) > detg <- data.frame(Fr, Temp, Soft, M.user, Brand) > detg.m0 <- glm(Fr ~ M.user * Temp * Soft + Brand, family = poisson, data = detg) > summary(detg.m0) Call: glm(formula = Fr ~ M.user * Temp * Soft + Brand, family = poisson, data = detg) Deviance Residuals: Min 1Q Median 3Q Max -2.208775 -0.991898 -0.001264 0.935415 1.975997 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 4.01524 0.10032 40.025 < 2e-16 *** M.userY -0.21184 0.14256 -1.486 0.13727 TempHigh -0.42381 0.15158 -2.796 0.00517 ** SoftMedium 0.05311 0.13307 0.399 0.68982 SoftSoft 0.05311 0.13307 0.399 0.68982 BrandM -0.01587 0.06299 -0.252 0.80103 M.userY:TempHigh 0.13987 0.22163 0.631 0.52798 M.userY:SoftMedium 0.08323 0.19684 0.423 0.67243 M.userY:SoftSoft 0.12169 0.19590 0.621 0.53447 TempHigh:SoftMedium -0.30442 0.22238 -1.369 0.17101 TempHigh:SoftSoft -0.30442 0.22238 -1.369 0.17102 M.userY:TempHigh:SoftMedium 0.21189 0.31569 0.671 0.50209 M.userY:TempHigh:SoftSoft -0.20387 0.32536 -0.627 0.53092 --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 118.627 on 23 degrees of freedom Residual deviance: 32.826 on 11 degrees of freedom AIC: 191.24 Number of Fisher Scoring iterations: 3 > detg.mod <- glm(terms(Fr ~ M.user * Temp * Soft + Brand * M.user * Temp, keep.order = TRUE), family = poisson, data = detg) > summary(detg.mod, correlation = FALSE) Call: glm(formula = terms(Fr ~ M.user * Temp * Soft + Brand * M.user * Temp, keep.order = TRUE), family = poisson, data = detg) Deviance Residuals: Min 1Q Median 3Q Max -0.913649 -0.355846 0.002531 0.330274 0.921460 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 4.14887 0.10603 39.128 <2e-16 *** M.userY -0.40521 0.16188 -2.503 0.0123 * TempHigh -0.44275 0.17121 -2.586 0.0097 ** M.userY:TempHigh -0.12692 0.26257 -0.483 0.6288 SoftMedium 0.05311 0.13308 0.399 0.6898 SoftSoft 0.05311 0.13308 0.399 0.6898 M.userY:SoftMedium 0.08323 0.19685 0.423 0.6725 M.userY:SoftSoft 0.12169 0.19591 0.621 0.5345 TempHigh:SoftMedium -0.30442 0.22239 -1.369 0.1710 TempHigh:SoftSoft -0.30442 0.22239 -1.369 0.1710 M.userY:TempHigh:SoftMedium 0.21189 0.31577 0.671 0.5022 M.userY:TempHigh:SoftSoft -0.20387 0.32540 -0.627 0.5310 BrandM -0.30647 0.10942 -2.801 0.0051 ** M.userY:BrandM 0.40757 0.15961 2.554 0.0107 * TempHigh:BrandM 0.04411 0.18463 0.239 0.8112 M.userY:TempHigh:BrandM 0.44427 0.26673 1.666 0.0958 . --- Signif. codes: 0 `***' 0.001 `**' 0.01 `*' 0.05 `.' 0.1 ` ' 1 (Dispersion parameter for poisson family taken to be 1) Null deviance: 118.627 on 23 degrees of freedom Residual deviance: 5.656 on 8 degrees of freedom AIC: 170.07 Number of Fisher Scoring iterations: 3 > symnum(summary(detg.mod, correlation = TRUE)$corr) ( M.sY TmH M.sY:TH SM SS M.Y:SM M.Y:SS TH:SM TH:SS (Intercept) 1 M.userY , 1 TempHigh , . 1 M.userY:TempHigh . , , 1 SoftMedium , . . 1 SoftSoft , . . . 1 M.userY:SoftMedium . , . , . 1 M.userY:SoftSoft . , . . , . 1 TempHigh:SoftMedium . , . . . . 1 TempHigh:SoftSoft . , . . . . . 1 M.userY:TempHigh:SoftMedium . . . . , . , . M.userY:TempHigh:SoftSoft . . . . . , . , BrandM . M.userY:BrandM . TempHigh:BrandM . . M.userY:TempHigh:BrandM . . M.Y:TH:SM M.Y:TH:SS B M.Y:B TH:B M.Y:TH:B (Intercept) M.userY TempHigh M.userY:TempHigh SoftMedium SoftSoft M.userY:SoftMedium M.userY:SoftSoft TempHigh:SoftMedium TempHigh:SoftSoft M.userY:TempHigh:SoftMedium 1 M.userY:TempHigh:SoftSoft . 1 BrandM 1 M.userY:BrandM , 1 TempHigh:BrandM . . 1 M.userY:TempHigh:BrandM . . , 1 attr(,"legend") [1] 0 ` ' 0.3 `.' 0.6 `,' 0.8 `+' 0.9 `*' 0.95 `B' 1 > anova(detg.m0, detg.mod) Analysis of Deviance Table Model 1: Fr ~ M.user * Temp * Soft + Brand Model 2: Fr ~ M.user + Temp + M.user:Temp + Soft + M.user:Soft + Temp:Soft + M.user:Temp:Soft + Brand + M.user:Brand + Temp:Brand + M.user:Temp:Brand Resid. Df Resid. Dev Df Deviance 1 11 32.826 2 8 5.656 3 27.170 demo(graphics) ---- ~~~~~~~~ > if (dev.cur() <= 1) get(getOption("device"))() > opar <- par(ask = interactive() && (.Device %in% c("X11", "GTK", "gnome", "windows", "Macintosh"))) > x <- rnorm(50) > opar <- c(opar, par(bg = "white")) > plot(x, ann = FALSE, type = "n") > abline(h = 0, col = gray(0.9)) > lines(x, col = "green4", lty = "dotted") > points(x, bg = "limegreen", pch = 21) > title(main = "Simple Use of Color In a Plot", xlab = "Just a Whisper of a Label", col.main = "blue", col.lab = gray(0.8), cex.main = 1.2, cex.lab = 1, font.main = 4, font.lab = 3) > par(bg = "gray") > pie(rep(1, 24), col = rainbow(24), radius = 0.9) > title(main = "A Sample Color Wheel", cex.main = 1.4, font.main = 3) > title(xlab = "(Use this as a test of monitor linearity)", cex.lab = 0.8, font.lab = 3) > 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, col = c("purple", "violetred1", "green3", "cornsilk", "cyan", "white")) > title(main = "January Pie Sales", cex.main = 1.8, font.main = 1) > title(xlab = "(Don't try this at home kids)", cex.lab = 0.8, font.lab = 3) > par(bg = "cornsilk") > n <- 10 > g <- gl(n, 100, n * 100) > x <- rnorm(n * 100) + sqrt(codes(g)) > boxplot(split(x, g), col = "lavender", notch = TRUE) > title(main = "Notched Boxplots", xlab = "Group", font.main = 4, font.lab = 1) > par(bg = "white") > n <- 100 > x <- c(0, cumsum(rnorm(n))) > y <- c(0, cumsum(rnorm(n))) > xx <- c(0:n, n:0) > yy <- c(x, rev(y)) > plot(xx, yy, type = "n", xlab = "Time", ylab = "Distance") > polygon(xx, yy, col = "gray") > title("Distance Between Brownian Motions") > x <- c(0, 0.4, 0.86, 0.85, 0.69, 0.48, 0.54, 1.09, 1.11, 1.73, 2.05, 2.02) > par(bg = "lightgray") > plot(x, type = "n", axes = FALSE, ann = FALSE) > usr <- par("usr") > rect(usr[1], usr[3], usr[2], usr[4], col = "cornsilk", border = "black") > lines(x, col = "blue") > points(x, pch = 21, bg = "lightcyan", cex = 1.25) > axis(2, col.axis = "blue", las = 1) > axis(1, at = 1:12, lab = month.abb, col.axis = "blue") > box() > title(main = "The Level of Interest in R", font.main = 4, col.main = "red") > title(xlab = "1996", col.lab = "red") > par(bg = "cornsilk") > x <- rnorm(1000) > hist(x, xlim = range(-4, 4, x), col = "lavender", main = "") > title(main = "1000 Normal Random Variates", font.main = 3) > data("iris") > pairs(iris[1:4], main = "Edgar Anderson's Iris Data", font.main = 4, pch = 19) > pairs(iris[1:4], main = "Edgar Anderson's Iris Data", pch = 21, bg = c("red", "green3", "blue")[codes(iris$Species)]) > data("volcano") > x <- 10 * 1:nrow(volcano) > y <- 10 * 1:ncol(volcano) > l <- pretty(range(volcano), 10) > par(bg = "lightcyan") > pin <- par("pin") > xdelta <- diff(range(x)) > ydelta <- diff(range(y)) > xscale <- pin[1]/xdelta > yscale <- pin[2]/ydelta > scale <- if (xscale < yscale) xscale else yscale > xadd <- 0.5 * (pin[1]/scale - xdelta) > yadd <- 0.5 * (pin[2]/scale - ydelta) > plot(numeric(0), numeric(0), xlim = range(x) + c(-1, 1) * xadd, ylim = range(y) + c(-1, 1) * yadd, type = "n", ann = FALSE) > usr <- par("usr") > rect(usr[1], usr[3], usr[2], usr[4], col = "green3") > contour(x, y, volcano, levels = l, col = "yellow", lty = "solid", add = TRUE) > box() > title("A Topographic Map of Maunga Whau", font = 4) > title(xlab = "Meters North", ylab = "Meters West", font = 3) > mtext("10 Meter Contour Spacing", side = 3, line = 0.35, outer = FALSE, at = mean(par("usr")[1:2]), cex = 0.7, font = 3) > par(bg = "cornsilk") > data(quakes) > coplot(lat ~ long | depth, data = quakes, pch = 21, bg = "green3") > example(plotmath) pltmth> x <- seq(-4, 4, len = 101) pltmth> y <- cbind(sin(x), cos(x)) pltmth> matplot(x, y, type = "l", xaxt = "n", main = expression(paste(plain(sin) * phi, " and ", plain(cos) * phi)), ylab = expression("sin" * phi, "cos" * phi), xlab = expression(paste("Phase Angle ", phi)), col.main = "blue") pltmth> axis(1, at = c(-pi, -pi/2, 0, pi/2, pi), lab = expression(-pi, -pi/2, 0, pi/2, pi)) pltmth> plot(1:10, type = "n", xlab = "", ylab = "", main = "plot math & numbers") pltmth> tt <- 1.23 pltmth> mtext(substitute(hat(theta) == that, list(that = tt))) pltmth> for (i in 2:9) text(i, i + 1, substitute(list(xi, eta) == group("(", list(x, y), ")"), list(x = i, y = i + 1))) pltmth> plot(1:10, 1:10) pltmth> text(4, 9, expression(hat(beta) == (X^t * X)^{ -1 } * X^t * y)) pltmth> text(4, 8.4, "expression(hat(beta) == (X^t * X)^{-1} * X^t * y)", cex = 0.8) pltmth> text(4, 7, expression(bar(x) == sum(frac(x[i], n), i == 1, n))) pltmth> text(4, 6.4, "expression(bar(x) == sum(frac(x[i], n), i==1, n))", cex = 0.8) pltmth> text(8, 5, expression(paste(frac(1, sigma * sqrt(2 * pi)), " ", plain(e)^{ frac(-(x - mu)^2, 2 * sigma^2) })), cex = 1.2) pltmth> make.table <- function(nr, nc) { savepar <- par(mar = rep(0, 4), pty = "s") plot(c(0, nc * 2 + 1), c(0, -(nr + 1)), type = "n", xlab = "", ylab = "", axes = FALSE) savepar } pltmth> get.r <- function(i, nr) { i%%nr + 1 } pltmth> get.c <- function(i, nr) { i%/%nr + 1 } pltmth> draw.title.cell <- function(title, i, nr) { r <- get.r(i, nr) c <- get.c(i, nr) text(2 * c - 0.5, -r, title) rect((2 * (c - 1) + 0.5), -(r - 0.5), (2 * c + 0.5), -(r + 0.5)) } pltmth> draw.plotmath.cell <- function(expr, i, nr, string = NULL) { r <- get.r(i, nr) c <- get.c(i, nr) if (is.null(string)) { string <- deparse(expr) string <- substr(string, 12, nchar(string) - 1) } text((2 * (c - 1) + .... [TRUNCATED] pltmth> nr <- 20 pltmth> nc <- 2 pltmth> oldpar <- make.table(nr, nc) pltmth> i <- 0 pltmth> draw.title.cell("Arithmetic Operators", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x + y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x - y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x * y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x/y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %+-% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x%/%y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %*% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(-x), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(+x), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Sub/Superscripts", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x[i]), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x^2), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Juxtaposition", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x * y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(paste(x, y, z)), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Lists", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(list(x, y, z)), i, nr) pltmth> i <- i + 1 pltmth> i <- 20 pltmth> draw.title.cell("Radicals", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(sqrt(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(sqrt(x, y)), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Relations", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x == y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x != y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x < y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x <= y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x > y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x >= y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %~~% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %=~% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %==% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %prop% y), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Typeface", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(plain(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(italic(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(bold(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(bolditalic(x)), i, nr) pltmth> i <- i + 1 pltmth> nr <- 20 pltmth> nc <- 2 pltmth> make.table(nr, nc) $mar [1] 0 0 0 0 $pty [1] "s" pltmth> i <- 0 pltmth> draw.title.cell("Ellipsis", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(list(x[1], ..., x[n])), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x[1] + ... + x[n]), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(list(x[1], cdots, x[n])), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x[1] + ldots + x[n]), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Set Relations", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %subset% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %subseteq% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %supset% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %supseteq% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %notsubset% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %in% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %notin% y), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Accents", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(hat(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(tilde(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(ring(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(bar(xy)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(widehat(xy)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(widetilde(xy)), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Arrows", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %<->% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %->% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %<-% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %up% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %down% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %<=>% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %=>% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %<=% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %dblup% y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x %dbldown% y), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Symbolic Names", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(Alpha - Omega), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(alpha - omega), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(infinity), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(32 * degree), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(60 * minute), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(30 * second), i, nr) pltmth> i <- i + 1 pltmth> nr <- 20 pltmth> nc <- 1 pltmth> make.table(nr, nc) $mar [1] 0 0 0 0 $pty [1] "s" pltmth> i <- 0 pltmth> draw.title.cell("Style", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(displaystyle(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(textstyle(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(scriptstyle(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(scriptscriptstyle(x)), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Spacing", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x ~ ~y), i, nr) pltmth> i <- i + 1 pltmth> par(new = TRUE) pltmth> nr <- 10 pltmth> nc <- 1 pltmth> make.table(nr, nc) $mar [1] 0 0 0 0 $pty [1] "s" pltmth> i <- 4 pltmth> draw.plotmath.cell(expression(x + phantom(0) + y), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x + over(1, phantom(0))), i, nr) pltmth> i <- i + 1 pltmth> draw.title.cell("Fractions", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(frac(x, y)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(over(x, y)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(atop(x, y)), i, nr) pltmth> i <- i + 1 pltmth> nr <- 10 pltmth> nc <- 1 pltmth> make.table(nr, nc) $mar [1] 0 0 0 0 $pty [1] "s" pltmth> i <- 0 pltmth> draw.title.cell("Big Operators", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(sum(x[i], i = 1, n)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(prod(plain(P)(X == x), x)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(integral(f(x) * dx, a, b)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(union(A[i], i == 1, n)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(intersect(A[i], i == 1, n)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(lim(f(x), x %->% 0)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(min(g(x), x >= 0)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(inf(S)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(sup(S)), i, nr) pltmth> i <- i + 1 pltmth> make.table(nr, nc) $mar [1] 0 0 0 0 $pty [1] "s" pltmth> i <- 0 pltmth> draw.title.cell("Grouping", i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression((x + y) * z), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x^y + z), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x^(y + z)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(x^{ y + z }), i, nr, string = "x^{y + z}") pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(group("(", list(a, b), "]")), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(bgroup("(", atop(x, y), ")")), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(group(lceil, x, rceil)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(group(lfloor, x, rfloor)), i, nr) pltmth> i <- i + 1 pltmth> draw.plotmath.cell(expression(group("|", x, "|")), i, nr) pltmth> i <- i + 1 pltmth> par(oldpar) > par(opar) demo(image) ---- ~~~~~ > if (dev.cur() <= 1) get(getOption("device"))() > opar <- par(ask = interactive() && (.Device %in% c("X11", "GTK", "windows", "Macintosh"))) > data(volcano) > x <- 10 * (1:nrow(volcano)) > x.at <- seq(100, 800, by = 100) > y <- 10 * (1:ncol(volcano)) > y.at <- seq(100, 600, by = 100) > image(x, y, volcano, col = terrain.colors(100), axes = FALSE) > contour(x, y, volcano, levels = seq(90, 200, by = 5), add = TRUE, col = "brown") > axis(1, at = x.at) > axis(2, at = y.at) > box() > title(main = "Maunga Whau Volcano", sub = "col=terrain.colors(100)", font.main = 4) > image(x, y, volcano, col = heat.colors(100), axes = FALSE) > contour(x, y, volcano, levels = seq(90, 200, by = 5), add = TRUE, col = "brown") > axis(1, at = x.at) > axis(2, at = y.at) > box() > title(main = "Maunga Whau Volcano", sub = "col=heat.colors(100)", font.main = 4) > image(x, y, volcano, col = gray(100:200/200), axes = FALSE) > contour(x, y, volcano, levels = seq(90, 200, by = 5), add = TRUE, col = "black") > axis(1, at = x.at) > axis(2, at = y.at) > box() > title(main = "Maunga Whau Volcano \n col=gray(100:200/200)", font.main = 4) > example(filled.contour) flld.c> data(volcano) flld.c> filled.contour(volcano, color = terrain.colors, asp = 1) flld.c> x <- 10 * 1:nrow(volcano) flld.c> y <- 10 * 1:ncol(volcano) flld.c> filled.contour(x, y, volcano, color = terrain.colors, 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(10 .... [TRUNCATED] flld.c> mtext(paste("filled.contour(.) from", R.version.string), side = 1, line = 4, adj = 1, cex = 0.66) flld.c> a <- expand.grid(1:20, 1:20) flld.c> b <- matrix(a[, 1] + a[, 2], 20) flld.c> filled.contour(x = 1:20, y = 1:20, z = b, plot.axes = { axis(1) axis(2) points(10, 10) }) > par(opar) demo(is.things) ---- ~~~~~~~~~ > ls.base <- ls("package:base") > base.is.f <- sapply(ls.base, function(x) is.function(get(x))) > bi <- ls.base[base.is.f] > cat("\nNumber of base objects:\t\t", length(ls.base), "\nNumber of builtin functions:\t", sum(base.is.f), "\n\t starting with 'is.' :\t ", length(is.bi <- bi[substring(bi, 1, 3) == "is."]), "\n") Number of base objects: 1516 Number of builtin functions: 1483 starting with 'is.' : 45 > is.primitive <- function(obj) is.function(obj) && is.null(args(obj)) > is.method <- function(fname) { np <- length(sp <- strsplit(fname, split = "\\.")[[1]]) if (np <= 1 || (np == 2 && sp[1] %in% c("is", "as"))) return(FALSE) exists(paste(sp[1:(np - 1)], collapse = "."), mode = "function") || .... [TRUNCATED] > is.ALL <- function(obj, func.names = ls(pos = length(search())), not.using = c("is.single", "is.loaded", "is.empty.model", "is.R", "is.element"), true.only = FALSE, debug = FALSE) { is.fn <- func.names[substring(func.names, 1, 3) == .... [TRUNCATED] > print.isList <- function(x, ..., verbose = getOption("verbose")) { if (is.list(x)) { if (verbose) cat("print.isList(): list case (length=", length(x), ")\n") nm <- format(names(x)) rr <- lappl .... [TRUNCATED] > is.ALL(NULL) is.array : . is.atomic : | is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : NA is.function : . is.infinite : () is.integer : . is.language : . is.list : . is.logical : . is.matrix : . is.mts : . is.na : NA is.name : . is.nan : () is.null : | is.numeric : . is.object : . is.ordered : . is.pairlist : | is.qr : . is.real : . is.recursive : . is.symbol : . is.table : . is.ts : . is.unsorted : . is.vector : . > is.ALL(NULL, true.only = TRUE) [1] "is.atomic" "is.null" "is.pairlist" > all.equal(NULL, pairlist()) [1] TRUE > is.ALL(list(), true.only = TRUE) [1] "is.list" "is.recursive" "is.vector" > (pl <- is.ALL(pairlist(1, list(3, "A")), true.only = TRUE)) [1] "is.list" "is.pairlist" "is.recursive" > (ll <- is.ALL(list(1, pairlist(3, "A")), true.only = TRUE)) [1] "is.list" "is.recursive" "is.vector" > all.equal(pl[pl != "is.pairlist"], ll[ll != "is.vector"]) [1] TRUE > is.ALL(1:5) is.array : . is.atomic : | is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : | | | | | is.function : . is.infinite : . . . . . is.integer : | is.language : . is.list : . is.logical : . is.matrix : . is.mts : . is.na : . . . . . is.name : . is.nan : . . . . . is.null : . is.numeric : | is.object : . is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : . is.symbol : . is.table : . is.ts : . is.unsorted : . is.vector : | > is.ALL(array(1:24, 2:4)) is.array : | is.atomic : | is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : | | | | | | | | | | | | | | | | | | | | | | | | is.function : . is.infinite : . . . . . . . . . . . . . . . . . . . . . . . . is.integer : | is.language : . is.list : . is.logical : . is.matrix : . is.mts : . is.na : . . . . . . . . . . . . . . . . . . . . . . . . is.name : . is.nan : . . . . . . . . . . . . . . . . . . . . . . . . is.null : . is.numeric : | is.object : . is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : . is.symbol : . is.table : . is.ts : . is.unsorted : . is.vector : . > is.ALL(1 + 3) is.array : . is.atomic : | is.call : . is.character : . is.complex : . is.data.frame : . is.double : | is.environment : . is.expression : . is.factor : . is.finite : | is.function : . is.infinite : . is.integer : . is.language : . is.list : . is.logical : . is.matrix : . is.mts : . is.na : . is.name : . is.nan : . is.null : . is.numeric : | is.object : . is.ordered : . is.pairlist : . is.qr : . is.real : | is.recursive : . is.symbol : . is.table : . is.ts : . is.unsorted : . is.vector : | > e13 <- expression(1 + 3) > is.ALL(e13) is.array : . is.atomic : . is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : | is.factor : . is.finite : . is.function : . is.infinite : . is.integer : . is.language : | is.list : . is.logical : . is.matrix : . is.mts : . is.na : . is.name : . is.nan : . is.null : . is.numeric : . is.object : . is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : | is.symbol : . is.table : . is.ts : . is.unsorted : NA is.vector : | > is.ALL(substitute(expression(a + 3), list(a = 1)), true.only = TRUE) [1] "is.call" "is.language" "is.recursive" > is.ALL(y ~ x) is.array : . is.atomic : . is.call : | is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : NA is.function : . is.infinite : . . . is.integer : . is.language : | is.list : . is.logical : . is.matrix : . is.mts : . is.na : NA is.name : . is.nan : . . . is.null : . is.numeric : . is.object : | is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : | is.symbol : . is.table : . is.ts : . is.unsorted : NA is.vector : . > is0 <- is.ALL(numeric(0)) > is0.ok <- 1 == (lis0 <- sapply(is0, length)) > is0[!is0.ok] $is.finite logical(0) $is.infinite logical(0) $is.na logical(0) $is.nan logical(0) > is0 <- unlist(is0) > is0 is.array is.atomic is.call is.character is.complex FALSE TRUE FALSE FALSE FALSE is.data.frame is.double is.environment is.expression is.factor FALSE TRUE FALSE FALSE FALSE is.function is.integer is.language is.list is.logical FALSE FALSE FALSE FALSE FALSE is.matrix is.mts is.name is.null is.numeric FALSE FALSE FALSE FALSE TRUE is.object is.ordered is.pairlist is.qr is.real FALSE FALSE FALSE FALSE TRUE is.recursive is.symbol is.table is.ts is.unsorted FALSE FALSE FALSE FALSE FALSE is.vector TRUE > ispi <- unlist(is.ALL(pi)) > all(ispi[is0.ok] == is0) [1] TRUE > is.ALL(numeric(0), true = TRUE) [1] "is.atomic" "is.double" "is.numeric" "is.real" "is.vector" > is.ALL(array(1, 1:3), true = TRUE) [1] "is.array" "is.atomic" "is.double" "is.numeric" "is.real" > is.ALL(cbind(1:3), true = TRUE) [1] "is.array" "is.atomic" "is.integer" "is.matrix" "is.numeric" > is.ALL(structure(1:7, names = paste("a", 1:7, sep = ""))) is.array : . is.atomic : | is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : | | | | | | | is.function : . is.infinite : . . . . . . . is.integer : | is.language : . is.list : . is.logical : . is.matrix : . is.mts : . is.na : . . . . . . . is.name : . is.nan : . . . . . . . is.null : . is.numeric : | is.object : . is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : . is.symbol : . is.table : . is.ts : . is.unsorted : . is.vector : | > is.ALL(structure(1:7, names = paste("a", 1:7, sep = "")), true.only = TRUE) [1] "is.atomic" "is.integer" "is.numeric" "is.vector" > x <- 1:20 > y <- 5 + 6 * x + rnorm(20) > lm.xy <- lm(y ~ x) > is.ALL(lm.xy) is.array : . is.atomic : . is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : . . . . . . . . . . . . is.function : . is.infinite : . . . . . . . . . . . . is.integer : . is.language : . is.list : | is.logical : . is.matrix : . is.mts : . is.na : . . . . . . . . . . . . is.name : . is.nan : . . . . . . . . . . . . is.null : . is.numeric : . is.object : | is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : | is.symbol : . is.table : . is.ts : . is.unsorted : NA is.vector : . > is.ALL(structure(1:7, names = paste("a", 1:7, sep = ""))) is.array : . is.atomic : | is.call : . is.character : . is.complex : . is.data.frame : . is.double : . is.environment : . is.expression : . is.factor : . is.finite : | | | | | | | is.function : . is.infinite : . . . . . . . is.integer : | is.language : . is.list : . is.logical : . is.matrix : . is.mts : . is.na : . . . . . . . is.name : . is.nan : . . . . . . . is.null : . is.numeric : | is.object : . is.ordered : . is.pairlist : . is.qr : . is.real : . is.recursive : . is.symbol : . is.table : . is.ts : . is.unsorted : . is.vector : | > is.ALL(structure(1:7, names = paste("a", 1:7, sep = "")), true.only = TRUE) [1] "is.atomic" "is.integer" "is.numeric" "is.vector" demo(recursion) ---- ~~~~~~~~~ > area <- function(f, a, b, ..., fa = f(a, ...), fb = f(b, ...), limit = 10, eps = 1e-05) { h <- b - a d <- (a + b)/2 fd <- f(d, ...) a1 <- ((fa + fb) * h)/2 a2 <- ((fa + 4 * fd + fb) * h)/6 if (abs(a1 - a2) < eps) .... [TRUNCATED] > fbeta <- function(x, alpha, beta) { x^(alpha - 1) * (1 - x)^(beta - 1) } > b0 <- area(fbeta, 0, 1, alpha = 3.5, beta = 1.5) > b1 <- exp(lgamma(3.5) + lgamma(1.5) - lgamma(5)) > c(b0, b1, b0 - b1) [1] 1.227170e-01 1.227185e-01 -1.443996e-06 > fbeta.tmp <- function(x, alpha, beta) { val <<- c(val, x) x^(alpha - 1) * (1 - x)^(beta - 1) } > val <- NULL > b0 <- area(fbeta.tmp, 0, 1, alpha = 3.5, beta = 1.5) > plot(val, fbeta(val, 3.5, 1.5), pch = 0) > area <- function(f, a, b, ..., limit = 10, eps = 1e-05) { area2 <- function(f, a, b, ..., fa = f(a, ...), fb = f(b, ...), limit = limit, eps = eps) { h <- b - a d <- (a + b)/2 fd <- f(d, ...) a1 <- ((fa + .... [TRUNCATED] demo(scoping) ---- ~~~~~~~ > open.account <- function(total) { list(deposit = function(amount) { if (amount <= 0) stop("Deposits must be positive!\n") total <<- total + amount cat(amount, "deposited. Your balance is", total, "\n\n") }, withdraw = .... [TRUNCATED] > ross <- open.account(100) > robert <- open.account(200) > ross$withdraw(30) 30 withdrawn. Your balance is 70 > ross$balance() Your balance is 70 > robert$balance() Your balance is 200 > ross$deposit(50) 50 deposited. Your balance is 120 > ross$balance() Your balance is 120 > try(ross$withdraw(500)) Error in ross$withdraw(500) : You don't have that much money! In addition: Warning messages: 1: is.nan() applied to non-(list or vector) in: fn(obj) 2: is.nan() applied to non-(list or vector) in: fn(obj) 3: is.na() applied to non-(list or vector) in: fn(obj) 4: is.nan() applied to non-(list or vector) in: fn(obj) 5: is.nan() applied to non-(list or vector) in: fn(obj) 6: is.nan() applied to non-(list or vector) in: fn(obj) demo(smooth) ---- ~~~~~~ > op <- par(ask = interactive(), mfrow = c(1, 1)) > example(smooth) smooth> x1 <- c(4, 1, 3, 6, 6, 4, 1, 6, 2, 4, 2) smooth> (x3R <- smooth(x1, "3R")) 3R Tukey smoother resulting from smooth(x = x1, kind = "3R") used 2 iterations [1] 3 3 3 6 6 4 4 4 2 2 2 smooth> smooth(x3R, kind = "S") S Tukey smoother resulting from smooth(x = x3R, kind = "S") changed [1] 3 3 3 3 4 4 4 4 2 2 2 smooth> sm.3RS <- function(x, ...) smooth(smooth(x, "3R", ...), "S", ...) smooth> y <- c(1, 1, 19:1) smooth> plot(y, main = "misbehaviour of \"3RSR\"", col.main = 3) smooth> lines(sm.3RS(y)) smooth> lines(smooth(y)) smooth> lines(smooth(y, "3RSR"), col = 3, lwd = 2) smooth> x <- c(8:10, 10, 0, 0, 9, 9) smooth> plot(x, main = "breakdown of 3R and S and hence 3RSS") smooth> matlines(cbind(smooth(x, "3R"), smooth(x, "S"), smooth(x, "3RSS"), smooth(x))) smooth> data(presidents) smooth> presidents[is.na(presidents)] <- 0 smooth> summary(sm3 <- smooth(presidents, "3R")) 3R Tukey smoother resulting from smooth(x = presidents, kind = "3R") ; n = 120 used 4 iterations Min. 1st Qu. Median Mean 3rd Qu. Max. 0.0 44.0 57.0 54.2 71.0 82.0 smooth> summary(sm2 <- smooth(presidents, "3RSS")) 3RSS Tukey smoother resulting from smooth(x = presidents, kind = "3RSS") ; n = 120 used 5 iterations Min. 1st Qu. Median Mean 3rd Qu. Max. 0.00 44.00 57.00 55.45 69.00 82.00 smooth> summary(sm <- smooth(presidents)) 3RS3R Tukey smoother resulting from smooth(x = presidents) ; n = 120 used 7 iterations Min. 1st Qu. Median Mean 3rd Qu. Max. 24.00 44.00 57.00 55.88 69.00 82.00 smooth> all.equal(c(sm2), c(smooth(smooth(sm3, "S"), "S"))) [1] TRUE smooth> all.equal(c(sm), c(smooth(smooth(sm3, "S"), "3R"))) [1] TRUE smooth> plot(presidents, main = "smooth(presidents0, *) : 3R and default 3RS3R") smooth> lines(sm3, col = 3, lwd = 1.5) smooth> lines(sm, col = 2, lwd = 1.25) > showSmooth <- function(x, leg.x = 1, leg.y = max(x)) { ss <- cbind(x, "3c" = smooth(x, "3", end = "copy"), "3" = smooth(x, "3"), "3Rc" = smooth(x, "3R", end = "copy"), "3R" = smooth(x, "3R"), sm = smooth(x)) k <- ncol(ss) - .... [TRUNCATED] > for (x in list(c(4, 6, 2, 2, 6, 3, 6, 6, 5, 2), c(3, 2, 1, 4, 5, 1, 3, 2, 4, 5, 2), c(2, 4, 2, 6, 1, 1, 2, 6, 3, 1, 6), x1, )) print(t(showSmooth(x))) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] x 4 6 2 2 6 3 6 6 5 2 3c 4 4 2 2 3 6 6 6 5 2 3 4 4 2 2 3 6 6 6 5 3 3Rc 4 4 2 2 3 6 6 6 5 2 3R 4 4 2 2 3 6 6 6 5 3 sm 4 4 4 3 3 6 6 6 5 3 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] x 3 2 1 4 5 1 3 2 4 5 2 3c 3 2 2 4 4 3 2 3 4 4 2 3 2 2 2 4 4 3 2 3 4 4 4 3Rc 3 2 2 4 4 3 3 3 4 4 2 3R 2 2 2 4 4 3 3 3 4 4 4 sm 2 2 2 2 3 3 3 3 4 4 4 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] x 2 4 2 6 1 1 2 6 3 1 6 3c 2 2 4 2 1 1 2 3 3 3 6 3 2 2 4 2 1 1 2 3 3 3 3 3Rc 2 2 2 2 1 1 2 3 3 3 6 3R 2 2 2 2 1 1 2 3 3 3 3 sm 2 2 2 2 2 2 2 3 3 3 3 [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] x 4 1 3 6 6 4 1 6 2 4 2 3c 4 3 3 6 6 4 4 2 4 2 2 3 3 3 3 6 6 4 4 2 4 2 2 3Rc 4 3 3 6 6 4 4 4 2 2 2 3R 3 3 3 6 6 4 4 4 2 2 2 sm 3 3 3 3 4 4 4 4 2 2 2 > par(op) > > cat("Time elapsed: ", proc.time() - .ptime, "\n") Time elapsed: 26.52 2.25 29.37 0 0 >