R : Copyright 2001, The R Development Core Team
Version 1.4.0 Under development (unstable) (2001-11-28)
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")
> piechart(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")
> piechart(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(long ~ lat | 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: 1476
Number of builtin functions: 1442
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)
return(FALSE)
exists(paste(sp[1:(np - 1)], collapse = "."), mode = "function") ||
(np >= 3 && exists(paste(sp[1:(np - 2) .... [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(r, ...) {
if (is.list(r)) {
nm <- format(names(r))
rr <- lapply(r, symnum, na = "NA")
for (i in seq(along = r)) cat(nm[i], ":", rr[[i]], "\n",
...)
}
else NextMethod("print", . .... [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: 8.13 0.18 8.75 0 0
>