R version 2.12.0 Under development (unstable) (2010-09-16 r52918)
Copyright (C) 2010 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: x86_64-apple-darwin9.8.0/x86_64 (64-bit)
R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.
Natural language support but running in an English locale
R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.
Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.
> pkgname <- "stats"
> source(file.path(R.home("share"), "R", "examples-header.R"))
> options(warn = 1)
> library('stats')
>
> assign(".oldSearch", search(), pos = 'CheckExEnv')
> cleanEx()
> nameEx("AIC")
> ### * AIC
>
> flush(stderr()); flush(stdout())
>
> ### Name: AIC
> ### Title: Akaike's An Information Criterion
> ### Aliases: AIC
> ### Keywords: models
>
> ### ** Examples
>
> lm1 <- lm(Fertility ~ . , data = swiss)
> AIC(lm1)
[1] 326.0716
> stopifnot(all.equal(AIC(lm1),
+ AIC(logLik(lm1))))
> ## a version of BIC or Schwarz's BC :
> AIC(lm1, k = log(nrow(swiss)))
[1] 339.0226
>
>
>
> cleanEx()
> nameEx("ARMAacf")
> ### * ARMAacf
>
> flush(stderr()); flush(stdout())
>
> ### Name: ARMAacf
> ### Title: Compute Theoretical ACF for an ARMA Process
> ### Aliases: ARMAacf
> ### Keywords: ts
>
> ### ** Examples
>
> ARMAacf(c(1.0, -0.25), 1.0, lag.max = 10)
0 1 2 3 4 5
1.000000000 0.875000000 0.625000000 0.406250000 0.250000000 0.148437500
6 7 8 9 10
0.085937500 0.048828125 0.027343750 0.015136719 0.008300781
>
> ## Example from Brockwell & Davis (1991, pp.92-4)
> ## answer 2^(-n) * (32/3 + 8 * n) /(32/3)
> n <- 1:10; 2^(-n) * (32/3 + 8 * n) /(32/3)
[1] 0.875000000 0.625000000 0.406250000 0.250000000 0.148437500 0.085937500
[7] 0.048828125 0.027343750 0.015136719 0.008300781
> ARMAacf(c(1.0, -0.25), 1.0, lag.max = 10, pacf = TRUE)
[1] 0.8750000 -0.6000000 0.3750000 -0.2727273 0.2142857 -0.1764706
[7] 0.1500000 -0.1304348 0.1153846 -0.1034483
> zapsmall(ARMAacf(c(1.0, -0.25), lag.max = 10, pacf = TRUE))
[1] 0.80 -0.25 0.00 0.00 0.00 0.00 0.00 0.00 0.00 0.00
>
> ## Cov-Matrix of length-7 sub-sample of AR(1) example:
> toeplitz(ARMAacf(0.8, lag.max = 7))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,] 1.0000000 0.800000 0.64000 0.5120 0.4096 0.32768 0.262144 0.2097152
[2,] 0.8000000 1.000000 0.80000 0.6400 0.5120 0.40960 0.327680 0.2621440
[3,] 0.6400000 0.800000 1.00000 0.8000 0.6400 0.51200 0.409600 0.3276800
[4,] 0.5120000 0.640000 0.80000 1.0000 0.8000 0.64000 0.512000 0.4096000
[5,] 0.4096000 0.512000 0.64000 0.8000 1.0000 0.80000 0.640000 0.5120000
[6,] 0.3276800 0.409600 0.51200 0.6400 0.8000 1.00000 0.800000 0.6400000
[7,] 0.2621440 0.327680 0.40960 0.5120 0.6400 0.80000 1.000000 0.8000000
[8,] 0.2097152 0.262144 0.32768 0.4096 0.5120 0.64000 0.800000 1.0000000
>
>
>
> cleanEx()
> nameEx("ARMAtoMA")
> ### * ARMAtoMA
>
> flush(stderr()); flush(stdout())
>
> ### Name: ARMAtoMA
> ### Title: Convert ARMA Process to Infinite MA Process
> ### Aliases: ARMAtoMA
> ### Keywords: ts
>
> ### ** Examples
>
> ARMAtoMA(c(1.0, -0.25), 1.0, 10)
[1] 2.00000000 1.75000000 1.25000000 0.81250000 0.50000000 0.29687500
[7] 0.17187500 0.09765625 0.05468750 0.03027344
> ## Example from Brockwell & Davis (1991, p.92)
> ## answer (1 + 3*n)*2^(-n)
> n <- 1:10; (1 + 3*n)*2^(-n)
[1] 2.00000000 1.75000000 1.25000000 0.81250000 0.50000000 0.29687500
[7] 0.17187500 0.09765625 0.05468750 0.03027344
>
>
>
> cleanEx()
> nameEx("Beta")
> ### * Beta
>
> flush(stderr()); flush(stdout())
>
> ### Name: Beta
> ### Title: The Beta Distribution
> ### Aliases: Beta dbeta pbeta qbeta rbeta
> ### Keywords: distribution
>
> ### ** Examples
>
> x <- seq(0, 1, length=21)
> dbeta(x, 1, 1)
[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
> pbeta(x, 1, 1)
[1] 0.00 0.05 0.10 0.15 0.20 0.25 0.30 0.35 0.40 0.45 0.50 0.55 0.60 0.65 0.70
[16] 0.75 0.80 0.85 0.90 0.95 1.00
>
>
>
> cleanEx()
> nameEx("Binomial")
> ### * Binomial
>
> flush(stderr()); flush(stdout())
>
> ### Name: Binomial
> ### Title: The Binomial Distribution
> ### Aliases: Binomial dbinom pbinom qbinom rbinom
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
> # Compute P(45 < X < 55) for X Binomial(100,0.5)
> sum(dbinom(46:54, 100, 0.5))
[1] 0.6317984
>
> ## Using "log = TRUE" for an extended range :
> n <- 2000
> k <- seq(0, n, by = 20)
> plot (k, dbinom(k, n, pi/10, log=TRUE), type='l', ylab="log density",
+ main = "dbinom(*, log=TRUE) is better than log(dbinom(*))")
> lines(k, log(dbinom(k, n, pi/10)), col='red', lwd=2)
> ## extreme points are omitted since dbinom gives 0.
> mtext("dbinom(k, log=TRUE)", adj=0)
> mtext("extended range", adj=0, line = -1, font=4)
> mtext("log(dbinom(k))", col="red", adj=1)
>
>
>
> cleanEx()
> nameEx("Cauchy")
> ### * Cauchy
>
> flush(stderr()); flush(stdout())
>
> ### Name: Cauchy
> ### Title: The Cauchy Distribution
> ### Aliases: Cauchy dcauchy pcauchy qcauchy rcauchy
> ### Keywords: distribution
>
> ### ** Examples
>
> dcauchy(-1:4)
[1] 0.15915494 0.31830989 0.15915494 0.06366198 0.03183099 0.01872411
>
>
>
> cleanEx()
> nameEx("Chisquare")
> ### * Chisquare
>
> flush(stderr()); flush(stdout())
>
> ### Name: Chisquare
> ### Title: The (non-central) Chi-Squared Distribution
> ### Aliases: Chisquare dchisq pchisq qchisq rchisq
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> dchisq(1, df=1:3)
[1] 0.2419707 0.3032653 0.2419707
> pchisq(1, df= 3)
[1] 0.1987480
> pchisq(1, df= 3, ncp = 0:4)# includes the above
[1] 0.19874804 0.13229855 0.08787311 0.05824691 0.03853592
>
> x <- 1:10
> ## Chi-squared(df = 2) is a special exponential distribution
> all.equal(dchisq(x, df=2), dexp(x, 1/2))
[1] TRUE
> all.equal(pchisq(x, df=2), pexp(x, 1/2))
[1] TRUE
>
> ## non-central RNG -- df=0 with ncp > 0: Z0 has point mass at 0!
> Z0 <- rchisq(100, df = 0, ncp = 2.)
> graphics::stem(Z0)
The decimal point is at the |
0 | 0000000000000000000000000000000000000013356778899
1 | 0001333456678888899
2 | 0011444467
3 | 00233345888
4 | 111246
5 |
6 |
7 | 178
8 | 23
>
> ## Not run:
> ##D ## visual testing
> ##D ## do P-P plots for 1000 points at various degrees of freedom
> ##D L <- 1.2; n <- 1000; pp <- ppoints(n)
> ##D op <- par(mfrow = c(3,3), mar= c(3,3,1,1)+.1, mgp= c(1.5,.6,0),
> ##D oma = c(0,0,3,0))
> ##D for(df in 2^(4*rnorm(9))) {
> ##D plot(pp, sort(pchisq(rr <- rchisq(n,df=df, ncp=L), df=df, ncp=L)),
> ##D ylab="pchisq(rchisq(.),.)", pch=".")
> ##D mtext(paste("df = ",formatC(df, digits = 4)), line= -2, adj=0.05)
> ##D abline(0,1,col=2)
> ##D }
> ##D mtext(expression("P-P plots : Noncentral "*
> ##D chi^2 *"(n=1000, df=X, ncp= 1.2)"),
> ##D cex = 1.5, font = 2, outer=TRUE)
> ##D par(op)
> ## End(Not run)
>
> ## "analytical" test
> lam <- seq(0,100, by=.25)
> p00 <- pchisq(0, df=0, ncp=lam)
> p.0 <- pchisq(1e-300, df=0, ncp=lam)
> stopifnot(all.equal(p00, exp(-lam/2)),
+ all.equal(p.0, exp(-lam/2)))
>
>
>
> cleanEx()
> nameEx("Exponential")
> ### * Exponential
>
> flush(stderr()); flush(stdout())
>
> ### Name: Exponential
> ### Title: The Exponential Distribution
> ### Aliases: Exponential dexp pexp qexp rexp
> ### Keywords: distribution
>
> ### ** Examples
>
> dexp(1) - exp(-1) #-> 0
[1] 0
>
>
>
> cleanEx()
> nameEx("Fdist")
> ### * Fdist
>
> flush(stderr()); flush(stdout())
>
> ### Name: FDist
> ### Title: The F Distribution
> ### Aliases: FDist df pf qf rf
> ### Keywords: distribution
>
> ### ** Examples
>
> ## the density of the square of a t_m is 2*dt(x, m)/(2*x)
> # check this is the same as the density of F_{1,m}
> x <- seq(0.001, 5, len=100)
> all.equal(df(x^2, 1, 5), dt(x, 5)/x)
[1] TRUE
>
> ## Identity: qf(2*p - 1, 1, df)) == qt(p, df)^2) for p >= 1/2
> p <- seq(1/2, .99, length=50); df <- 10
> rel.err <- function(x,y) ifelse(x==y,0, abs(x-y)/mean(abs(c(x,y))))
>
>
>
> cleanEx()
> nameEx("GammaDist")
> ### * GammaDist
>
> flush(stderr()); flush(stdout())
>
> ### Name: GammaDist
> ### Title: The Gamma Distribution
> ### Aliases: GammaDist dgamma pgamma qgamma rgamma
> ### Keywords: distribution
>
> ### ** Examples
>
> -log(dgamma(1:4, shape=1))
[1] 1 2 3 4
> p <- (1:9)/10
> pgamma(qgamma(p,shape=2), shape=2)
[1] 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
> 1 - 1/exp(qgamma(p, shape=1))
[1] 0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9
>
> # even for shape = 0.001 about half the mass is on numbers
> # that cannot be represented accurately (and most of those as zero)
> pgamma(.Machine$double.xmin, 0.001)
[1] 0.4927171
> pgamma(5e-324, 0.001) # on most machines 5e-324 is the smallest
[1] 0.4752741
> # representable non-zero number
> table(rgamma(1e4, 0.001) == 0)/1e4
FALSE TRUE
0.5244 0.4756
>
>
>
> cleanEx()
> nameEx("Geometric")
> ### * Geometric
>
> flush(stderr()); flush(stdout())
>
> ### Name: Geometric
> ### Title: The Geometric Distribution
> ### Aliases: Geometric dgeom pgeom qgeom rgeom
> ### Keywords: distribution
>
> ### ** Examples
>
> qgeom((1:9)/10, prob = .2)
[1] 0 0 1 2 3 4 5 7 10
> Ni <- rgeom(20, prob = 1/4); table(factor(Ni, 0:max(Ni)))
0 1 2 3 4 5 6 7 8 9 10 11
5 3 3 1 2 2 0 1 0 1 1 1
>
>
>
> cleanEx()
> nameEx("HoltWinters")
> ### * HoltWinters
>
> flush(stderr()); flush(stdout())
>
> ### Name: HoltWinters
> ### Title: Holt-Winters Filtering
> ### Aliases: HoltWinters print.HoltWinters residuals.HoltWinters
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ## Seasonal Holt-Winters
> (m <- HoltWinters(co2))
Holt-Winters exponential smoothing with trend and additive seasonal component.
Call:
HoltWinters(x = co2)
Smoothing parameters:
alpha: 0.5126484
beta : 0.009497669
gamma: 0.4728868
Coefficients:
[,1]
a 364.7616237
b 0.1247438
s1 0.2215275
s2 0.9552801
s3 1.5984744
s4 2.8758029
s5 3.2820088
s6 2.4406990
s7 0.8969433
s8 -1.3796428
s9 -3.4112376
s10 -3.2570163
s11 -1.9134850
s12 -0.5844250
> plot(m)
> plot(fitted(m))
>
> (m <- HoltWinters(AirPassengers, seasonal = "mult"))
Holt-Winters exponential smoothing with trend and multiplicative seasonal component.
Call:
HoltWinters(x = AirPassengers, seasonal = "mult")
Smoothing parameters:
alpha: 0.2755925
beta : 0.03269295
gamma: 0.8707292
Coefficients:
[,1]
a 469.3232206
b 3.0215391
s1 0.9464611
s2 0.8829239
s3 0.9717369
s4 1.0304825
s5 1.0476884
s6 1.1805272
s7 1.3590778
s8 1.3331706
s9 1.1083381
s10 0.9868813
s11 0.8361333
s12 0.9209877
> plot(m)
>
> ## Non-Seasonal Holt-Winters
> x <- uspop + rnorm(uspop, sd = 5)
> m <- HoltWinters(x, gamma = FALSE)
> plot(m)
>
> ## Exponential Smoothing
> m2 <- HoltWinters(x, gamma = FALSE, beta = FALSE)
> lines(fitted(m2)[,1], col = 3)
>
>
>
> cleanEx()
> nameEx("Hypergeometric")
> ### * Hypergeometric
>
> flush(stderr()); flush(stdout())
>
> ### Name: Hypergeometric
> ### Title: The Hypergeometric Distribution
> ### Aliases: Hypergeometric dhyper phyper qhyper rhyper
> ### Keywords: distribution
>
> ### ** Examples
>
> m <- 10; n <- 7; k <- 8
> x <- 0:(k+1)
> rbind(phyper(x, m, n, k), dhyper(x, m, n, k))
[,1] [,2] [,3] [,4] [,5] [,6] [,7]
[1,] 0 0.0004113534 0.01336898 0.1170300 0.4193747 0.7821884 0.9635952
[2,] 0 0.0004113534 0.01295763 0.1036610 0.3023447 0.3628137 0.1814068
[,8] [,9] [,10]
[1,] 0.99814891 1.00000000 1
[2,] 0.03455368 0.00185109 0
> all(phyper(x, m, n, k) == cumsum(dhyper(x, m, n, k)))# FALSE
[1] FALSE
>
>
> cleanEx()
> nameEx("IQR")
> ### * IQR
>
> flush(stderr()); flush(stdout())
>
> ### Name: IQR
> ### Title: The Interquartile Range
> ### Aliases: IQR
> ### Keywords: univar robust distribution
>
> ### ** Examples
>
> IQR(rivers)
[1] 370
>
>
>
> cleanEx()
> nameEx("Logistic")
> ### * Logistic
>
> flush(stderr()); flush(stdout())
>
> ### Name: Logistic
> ### Title: The Logistic Distribution
> ### Aliases: Logistic dlogis plogis qlogis rlogis
> ### Keywords: distribution
>
> ### ** Examples
>
> var(rlogis(4000, 0, scale = 5))# approximately (+/- 3)
[1] 86.93007
> pi^2/3 * 5^2
[1] 82.2467
>
>
>
> cleanEx()
> nameEx("Lognormal")
> ### * Lognormal
>
> flush(stderr()); flush(stdout())
>
> ### Name: Lognormal
> ### Title: The Log Normal Distribution
> ### Aliases: Lognormal dlnorm plnorm qlnorm rlnorm
> ### Keywords: distribution
>
> ### ** Examples
>
> dlnorm(1) == dnorm(0)
[1] TRUE
>
>
>
> cleanEx()
> nameEx("Multinom")
> ### * Multinom
>
> flush(stderr()); flush(stdout())
>
> ### Name: Multinom
> ### Title: The Multinomial Distribution
> ### Aliases: Multinomial rmultinom dmultinom
> ### Keywords: distribution
>
> ### ** Examples
>
> rmultinom(10, size = 12, prob=c(0.1,0.2,0.8))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 0 1 0 3 1 0 1 2 2 1
[2,] 2 4 4 2 0 1 2 2 5 3
[3,] 10 7 8 7 11 11 9 8 5 8
>
> pr <- c(1,3,6,10) # normalization not necessary for generation
> rmultinom(10, 20, prob = pr)
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
[1,] 3 0 0 0 1 1 1 1 1 1
[2,] 1 2 3 3 2 4 3 4 4 4
[3,] 7 6 9 7 8 3 8 6 2 7
[4,] 9 12 8 10 9 12 8 9 13 8
>
> ## all possible outcomes of Multinom(N = 3, K = 3)
> X <- t(as.matrix(expand.grid(0:3, 0:3))); X <- X[, colSums(X) <= 3]
> X <- rbind(X, 3:3 - colSums(X)); dimnames(X) <- list(letters[1:3], NULL)
> X
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10]
a 0 1 2 3 0 1 2 0 1 0
b 0 0 0 0 1 1 1 2 2 3
c 3 2 1 0 2 1 0 1 0 0
> round(apply(X, 2, function(x) dmultinom(x, prob = c(1,2,5))), 3)
[1] 0.244 0.146 0.029 0.002 0.293 0.117 0.012 0.117 0.023 0.016
>
>
>
> cleanEx()
> nameEx("NLSstAsymptotic")
> ### * NLSstAsymptotic
>
> flush(stderr()); flush(stdout())
>
> ### Name: NLSstAsymptotic
> ### Title: Fit the Asymptotic Regression Model
> ### Aliases: NLSstAsymptotic NLSstAsymptotic.sortedXyData
> ### Keywords: manip
>
> ### ** Examples
>
> Lob.329 <- Loblolly[ Loblolly$Seed == "329", ]
> print(NLSstAsymptotic(sortedXyData(expression(age),
+ expression(height),
+ Lob.329)), digits=3)
b0 b1 lrc
-8.25 102.38 -3.22
>
>
>
> cleanEx()
> nameEx("NLSstClosestX")
> ### * NLSstClosestX
>
> flush(stderr()); flush(stdout())
>
> ### Name: NLSstClosestX
> ### Title: Inverse Interpolation
> ### Aliases: NLSstClosestX NLSstClosestX.sortedXyData
> ### Keywords: manip
>
> ### ** Examples
>
> DNase.2 <- DNase[ DNase$Run == "2", ]
> DN.srt <- sortedXyData(expression(log(conc)), expression(density), DNase.2)
> NLSstClosestX(DN.srt, 1.0)
[1] 0.9795406
>
>
>
> cleanEx()
> nameEx("NLSstLfAsymptote")
> ### * NLSstLfAsymptote
>
> flush(stderr()); flush(stdout())
>
> ### Name: NLSstLfAsymptote
> ### Title: Horizontal Asymptote on the Left Side
> ### Aliases: NLSstLfAsymptote NLSstLfAsymptote.sortedXyData
> ### Keywords: manip
>
> ### ** Examples
>
> DNase.2 <- DNase[ DNase$Run == "2", ]
> DN.srt <- sortedXyData( expression(log(conc)), expression(density), DNase.2 )
> NLSstLfAsymptote( DN.srt )
[1] -0.1869375
>
>
>
> cleanEx()
> nameEx("NLSstRtAsymptote")
> ### * NLSstRtAsymptote
>
> flush(stderr()); flush(stdout())
>
> ### Name: NLSstRtAsymptote
> ### Title: Horizontal Asymptote on the Right Side
> ### Aliases: NLSstRtAsymptote NLSstRtAsymptote.sortedXyData
> ### Keywords: manip
>
> ### ** Examples
>
> DNase.2 <- DNase[ DNase$Run == "2", ]
> DN.srt <- sortedXyData( expression(log(conc)), expression(density), DNase.2 )
> NLSstRtAsymptote( DN.srt )
[1] 2.157437
>
>
>
> cleanEx()
> nameEx("NegBinomial")
> ### * NegBinomial
>
> flush(stderr()); flush(stdout())
>
> ### Name: NegBinomial
> ### Title: The Negative Binomial Distribution
> ### Aliases: NegBinomial dnbinom pnbinom qnbinom rnbinom
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
> x <- 0:11
> dnbinom(x, size = 1, prob = 1/2) * 2^(1 + x) # == 1
[1] 1 1 1 1 1 1 1 1 1 1 1 1
> 126 / dnbinom(0:8, size = 2, prob = 1/2) #- theoretically integer
[1] 504.0 504.0 672.0 1008.0 1612.8 2688.0 4608.0 8064.0 14336.0
>
>
> x <- 0:15
> size <- (1:20)/4
> persp(x,size, dnb <- outer(x, size, function(x,s) dnbinom(x,s, prob= 0.4)),
+ xlab = "x", ylab = "s", zlab="density", theta = 150)
> title(tit <- "negative binomial density(x,s, pr = 0.4) vs. x & s")
>
> image (x,size, log10(dnb), main= paste("log [",tit,"]"))
> contour(x,size, log10(dnb),add=TRUE)
>
> ## Alternative parametrization
> x1 <- rnbinom(500, mu = 4, size = 1)
> x2 <- rnbinom(500, mu = 4, size = 10)
> x3 <- rnbinom(500, mu = 4, size = 100)
> h1 <- hist(x1, breaks = 20, plot = FALSE)
> h2 <- hist(x2, breaks = h1$breaks, plot = FALSE)
> h3 <- hist(x3, breaks = h1$breaks, plot = FALSE)
> barplot(rbind(h1$counts, h2$counts, h3$counts),
+ beside = TRUE, col = c("red","blue","cyan"),
+ names.arg = round(h1$breaks[-length(h1$breaks)]))
>
>
>
> cleanEx()
> nameEx("Normal")
> ### * Normal
>
> flush(stderr()); flush(stdout())
>
> ### Name: Normal
> ### Title: The Normal Distribution
> ### Aliases: Normal dnorm pnorm qnorm rnorm
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> dnorm(0) == 1/ sqrt(2*pi)
[1] TRUE
> dnorm(1) == exp(-1/2)/ sqrt(2*pi)
[1] TRUE
> dnorm(1) == 1/ sqrt(2*pi*exp(1))
[1] TRUE
>
> ## Using "log = TRUE" for an extended range :
> par(mfrow=c(2,1))
> plot(function(x) dnorm(x, log=TRUE), -60, 50,
+ main = "log { Normal density }")
> curve(log(dnorm(x)), add=TRUE, col="red",lwd=2)
> mtext("dnorm(x, log=TRUE)", adj=0)
> mtext("log(dnorm(x))", col="red", adj=1)
>
> plot(function(x) pnorm(x, log.p=TRUE), -50, 10,
+ main = "log { Normal Cumulative }")
> curve(log(pnorm(x)), add=TRUE, col="red",lwd=2)
> mtext("pnorm(x, log=TRUE)", adj=0)
> mtext("log(pnorm(x))", col="red", adj=1)
>
> ## if you want the so-called 'error function'
> erf <- function(x) 2 * pnorm(x * sqrt(2)) - 1
> ## (see Abramowitz and Stegun 29.2.29)
> ## and the so-called 'complementary error function'
> erfc <- function(x) 2 * pnorm(x * sqrt(2), lower = FALSE)
> ## and the inverses
> erfinv <- function (x) qnorm((1 + x)/2)/sqrt(2)
> erfcinv <- function (x) qnorm(x/2, lower = FALSE)/sqrt(2)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("Poisson")
> ### * Poisson
>
> flush(stderr()); flush(stdout())
>
> ### Name: Poisson
> ### Title: The Poisson Distribution
> ### Aliases: Poisson dpois ppois qpois rpois
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> -log(dpois(0:7, lambda=1) * gamma(1+ 0:7)) # == 1
[1] 1 1 1 1 1 1 1 1
> Ni <- rpois(50, lambda = 4); table(factor(Ni, 0:max(Ni)))
0 1 2 3 4 5 6 7 8 9 10
1 2 7 9 8 13 5 4 0 0 1
>
> 1 - ppois(10*(15:25), lambda=100) # becomes 0 (cancellation)
[1] 1.233094e-06 1.261664e-08 7.085799e-11 2.252643e-13 4.440892e-16
[6] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00
[11] 0.000000e+00
> ppois(10*(15:25), lambda=100, lower.tail=FALSE) # no cancellation
[1] 1.233094e-06 1.261664e-08 7.085800e-11 2.253110e-13 4.174239e-16
[6] 4.626179e-19 3.142097e-22 1.337219e-25 3.639328e-29 6.453883e-33
[11] 7.587807e-37
>
> par(mfrow = c(2, 1))
> x <- seq(-0.01, 5, 0.01)
> plot(x, ppois(x, 1), type="s", ylab="F(x)", main="Poisson(1) CDF")
> plot(x, pbinom(x, 100, 0.01),type="s", ylab="F(x)",
+ main="Binomial(100, 0.01) CDF")
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSD")
> ### * SSD
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSD
> ### Title: SSD Matrix and Estimated Variance Matrix in Multivariate Models
> ### Aliases: SSD estVar
> ### Keywords: models multivariate
>
> ### ** Examples
>
> # Lifted from Baron+Li:
> # "Notes on the use of R for psychology experiments and questionnaires"
> # Maxwell and Delaney, p. 497
> reacttime <- matrix(c(
+ 420, 420, 480, 480, 600, 780,
+ 420, 480, 480, 360, 480, 600,
+ 480, 480, 540, 660, 780, 780,
+ 420, 540, 540, 480, 780, 900,
+ 540, 660, 540, 480, 660, 720,
+ 360, 420, 360, 360, 480, 540,
+ 480, 480, 600, 540, 720, 840,
+ 480, 600, 660, 540, 720, 900,
+ 540, 600, 540, 480, 720, 780,
+ 480, 420, 540, 540, 660, 780),
+ ncol = 6, byrow = TRUE,
+ dimnames=list(subj=1:10,
+ cond=c("deg0NA", "deg4NA", "deg8NA",
+ "deg0NP", "deg4NP", "deg8NP")))
>
> mlmfit <- lm(reacttime~1)
> SSD(mlmfit)
$SSD
cond
cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP
deg0NA 29160 30600 26640 23760 32400 25560
deg4NA 30600 66600 32400 7200 36000 30600
deg8NA 26640 32400 56160 41040 57600 69840
deg0NP 23760 7200 41040 70560 72000 63360
deg4NP 32400 36000 57600 72000 108000 100800
deg8NP 25560 30600 69840 63360 100800 122760
$call
lm(formula = reacttime ~ 1)
$df
[1] 9
attr(,"class")
[1] "SSD"
> estVar(mlmfit)
cond
cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP
deg0NA 3240 3400 2960 2640 3600 2840
deg4NA 3400 7400 3600 800 4000 3400
deg8NA 2960 3600 6240 4560 6400 7760
deg0NP 2640 800 4560 7840 8000 7040
deg4NP 3600 4000 6400 8000 12000 11200
deg8NP 2840 3400 7760 7040 11200 13640
>
>
>
> cleanEx()
> nameEx("SSasymp")
> ### * SSasymp
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSasymp
> ### Title: Self-Starting Nls Asymptotic Regression Model
> ### Aliases: SSasymp
> ### Keywords: models
>
> ### ** Examples
>
> ## Don't show:
> options(show.nls.convergence=FALSE)
> ## End Don't show
> Lob.329 <- Loblolly[ Loblolly$Seed == "329", ]
> SSasymp( Lob.329$age, 100, -8.5, -3.2 ) # response only
[1] 3.988924 11.505611 27.822517 41.130854 51.985354 60.838463
> Asym <- 100
> resp0 <- -8.5
> lrc <- -3.2
> SSasymp( Lob.329$age, Asym, resp0, lrc ) # response and gradient
[1] 3.988924 11.505611 27.822517 41.130854 51.985354 60.838463
attr(,"gradient")
Asym resp0 lrc
[1,] 0.1151053 0.8848947 11.74087
[2,] 0.1843835 0.8156165 18.03613
[3,] 0.3347697 0.6652303 29.42113
[4,] 0.4574272 0.5425728 35.99454
[5,] 0.5574687 0.4425313 39.14366
[6,] 0.6390642 0.3609358 39.90776
> getInitial(height ~ SSasymp( age, Asym, resp0, lrc), data = Lob.329)
$Asym
[1] 94.1282
$resp0
[1] -8.250753
$lrc
[1] -3.217578
> ## Initial values are in fact the converged values
> fm1 <- nls(height ~ SSasymp( age, Asym, resp0, lrc), data = Lob.329)
> summary(fm1)
Formula: height ~ SSasymp(age, Asym, resp0, lrc)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 94.1282 8.4030 11.202 0.001525 **
resp0 -8.2508 1.2261 -6.729 0.006700 **
lrc -3.2176 0.1386 -23.218 0.000175 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.7493 on 3 degrees of freedom
> ## Don't show:
> require(graphics)
>
> xx <- seq(0, 5, len = 101)
> yy <- 5 - 4 * exp(-xx/(2*log(2)))
> par(mar = c(0, 0, 4.1, 0))
> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5),
+ xlab = "", ylab = "", lwd = 2,
+ main = "Parameters in the SSasymp model")
> usr <- par("usr")
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> abline(h = 5, lty = 2, lwd = 0)
> arrows(-0.8, 2.1, -0.8, 0, length = 0.1, angle = 25)
> arrows(-0.8, 2.9, -0.8, 5, length = 0.1, angle = 25)
> text(-0.8, 2.5, expression(phi[1]), adj = c(0.5, 0.5))
> segments(-0.4, 1, 0, 1, lty = 2, lwd = 0.75)
> arrows(-0.3, 0.25, -0.3, 0, length = 0.07, angle = 25)
> arrows(-0.3, 0.75, -0.3, 1, length = 0.07, angle = 25)
> text(-0.3, 0.5, expression(phi[2]), adj = c(0.5, 0.5))
> segments(1, 3.025, 1, 4, lty = 2, lwd = 0.75)
> arrows(0.2, 3.5, 0, 3.5, length = 0.08, angle = 25)
> arrows(0.8, 3.5, 1, 3.5, length = 0.08, angle = 25)
> text(0.5, 3.5, expression(t[0.5]), adj = c(0.5, 0.5))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSasympOff")
> ### * SSasympOff
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSasympOff
> ### Title: Self-Starting Nls Asymptotic Regression Model with an Offset
> ### Aliases: SSasympOff
> ### Keywords: models
>
> ### ** Examples
>
> CO2.Qn1 <- CO2[CO2$Plant == "Qn1", ]
> SSasympOff(CO2.Qn1$conc, 32, -4, 43) # response only
[1] 19.65412 29.14785 31.27791 31.88435 31.99259 31.99970 32.00000
> Asym <- 32; lrc <- -4; c0 <- 43
> SSasympOff(CO2.Qn1$conc, Asym, lrc, c0) # response and gradient
[1] 19.65412 29.14785 31.27791 31.88435 31.99259 31.99970 32.00000
attr(,"gradient")
Asym lrc c0
[1,] 0.6141911 1.175838e+01 -2.261227e-01
[2,] 0.9108704 6.895531e+00 -5.223887e-02
[3,] 0.9774346 2.737698e+00 -1.322559e-02
[4,] 0.9963859 6.503026e-01 -2.118250e-03
[5,] 0.9997683 6.204920e-02 -1.357751e-04
[6,] 0.9999906 3.479529e-03 -5.505583e-06
[7,] 1.0000000 1.369435e-05 -1.430967e-08
> getInitial(uptake ~ SSasympOff(conc, Asym, lrc, c0), data = CO2.Qn1)
$Asym
[1] 38.13978
$lrc
[1] -4.380647
$c0
[1] 51.22324
> ## Initial values are in fact the converged values
> fm1 <- nls(uptake ~ SSasympOff(conc, Asym, lrc, c0), data = CO2.Qn1)
> summary(fm1)
Formula: uptake ~ SSasympOff(conc, Asym, lrc, c0)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 38.1398 0.9164 41.620 1.99e-06 ***
lrc -4.3806 0.2042 -21.457 2.79e-05 ***
c0 51.2232 11.6698 4.389 0.0118 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 1.663 on 4 degrees of freedom
> ## Don't show:
> require(graphics)
>
> xx <- seq(0.5, 5, len = 101)
> yy <- 5 * (1 - exp(-(xx - 0.5)/(2*log(2))))
> par(mar = c(0, 0, 4.0, 0))
> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5),
+ xlab = "", ylab = "", lwd = 2,
+ main = "Parameters in the SSasympOff model")
> usr <- par("usr")
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> abline(h = 5, lty = 2, lwd = 0)
> arrows(-0.8, 2.1, -0.8, 0, length = 0.1, angle = 25)
> arrows(-0.8, 2.9, -0.8, 5, length = 0.1, angle = 25)
> text(-0.8, 2.5, expression(phi[1]), adj = c(0.5, 0.5))
> segments(0.5, 0, 0.5, 3, lty = 2, lwd = 0.75)
> text(0.5, 3.1, expression(phi[3]), adj = c(0.5, 0))
> segments(1.5, 2.525, 1.5, 3, lty = 2, lwd = 0.75)
> arrows(0.7, 2.65, 0.5, 2.65, length = 0.08, angle = 25)
> arrows(1.3, 2.65, 1.5, 2.65, length = 0.08, angle = 25)
> text(1.0, 2.65, expression(t[0.5]), adj = c(0.5, 0.5))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSasympOrig")
> ### * SSasympOrig
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSasympOrig
> ### Title: Self-Starting Nls Asymptotic Regression Model through the Origin
> ### Aliases: SSasympOrig
> ### Keywords: models
>
> ### ** Examples
>
> Lob.329 <- Loblolly[ Loblolly$Seed == "329", ]
> SSasympOrig(Lob.329$age, 100, -3.2) # response only
[1] 11.51053 18.43835 33.47697 45.74272 55.74687 63.90642
> Asym <- 100; lrc <- -3.2
> SSasympOrig(Lob.329$age, Asym, lrc) # response and gradient
[1] 11.51053 18.43835 33.47697 45.74272 55.74687 63.90642
attr(,"gradient")
Asym lrc
[1,] 0.1151053 10.82108
[2,] 0.1843835 16.62316
[3,] 0.3347697 27.11625
[4,] 0.4574272 33.17469
[5,] 0.5574687 36.07710
[6,] 0.6390642 36.78135
> print(getInitial(height ~ SSasympOrig(age, Asym, lrc), data = Lob.329),
+ digits = 3)
Asym lrc
315.05 -4.81
> ## Initial values are in fact the converged values
> fm1 <- nls(height ~ SSasympOrig(age, Asym, lrc), data = Lob.329)
> summary(fm1)
Formula: height ~ SSasympOrig(age, Asym, lrc)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 315.046 443.071 0.711 0.5163
lrc -4.814 1.527 -3.153 0.0344 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.822 on 4 degrees of freedom
> ## Don't show:
> require(graphics)
>
> xx <- seq(0, 5, len = 101)
> yy <- 5 * (1- exp(-xx/(2*log(2))))
> par(mar = c(0, 0, 3.5, 0))
> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5),
+ xlab = "", ylab = "", lwd = 2,
+ main = "Parameters in the SSasympOrig model")
> usr <- par("usr")
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> abline(h = 5, lty = 2, lwd = 0)
> arrows(-0.8, 2.1, -0.8, 0, length = 0.1, angle = 25)
> arrows(-0.8, 2.9, -0.8, 5, length = 0.1, angle = 25)
> text(-0.8, 2.5, expression(phi[1]), adj = c(0.5, 0.5))
> segments(1, 2.525, 1, 3.5, lty = 2, lwd = 0.75)
> arrows(0.2, 3.0, 0, 3.0, length = 0.08, angle = 25)
> arrows(0.8, 3.0, 1, 3.0, length = 0.08, angle = 25)
> text(0.5, 3.0, expression(t[0.5]), adj = c(0.5, 0.5))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSbiexp")
> ### * SSbiexp
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSbiexp
> ### Title: Self-Starting Nls Biexponential model
> ### Aliases: SSbiexp
> ### Keywords: models
>
> ### ** Examples
>
> Indo.1 <- Indometh[Indometh$Subject == 1, ]
> SSbiexp( Indo.1$time, 3, 1, 0.6, -1.3 ) # response only
[1] 2.08098572 1.29421044 0.87967145 0.65483364 0.52711347 0.36094621
[7] 0.26575722 0.20176113 0.15359129 0.11694936 0.06780767
> A1 <- 3; lrc1 <- 1; A2 <- 0.6; lrc2 <- -1.3
> SSbiexp( Indo.1$time, A1, lrc1, A2, lrc2 ) # response and gradient
[1] 2.08098572 1.29421044 0.87967145 0.65483364 0.52711347 0.36094621
[7] 0.26575722 0.20176113 0.15359129 0.11694936 0.06780767
attr(,"gradient")
A1 lrc1 A2 lrc2
[1,] 5.068347e-01 -1.033290e+00 0.9341363 -0.03818728
[2,] 2.568814e-01 -1.047414e+00 0.8726106 -0.07134424
[3,] 1.301964e-01 -7.962985e-01 0.8151372 -0.09996786
[4,] 6.598804e-02 -5.381222e-01 0.7614492 -0.12451147
[5,] 3.344502e-02 -3.409237e-01 0.7112973 -0.14538835
[6,] 4.354421e-03 -7.101926e-02 0.5798049 -0.18961833
[7,] 2.873397e-04 -7.029632e-03 0.4414920 -0.21657709
[8,] 1.896098e-05 -6.184955e-04 0.3361737 -0.21988328
[9,] 1.251198e-06 -5.101663e-05 0.2559792 -0.20928744
[10,] 8.256409e-08 -4.039784e-06 0.1949152 -0.19123411
[11,] 3.595188e-10 -2.345456e-08 0.1130128 -0.14783797
> print(getInitial(conc ~ SSbiexp(time, A1, lrc1, A2, lrc2), data = Indo.1),
+ digits = 5)
A1 lrc1 A2 lrc2
2.02928 0.57939 0.19155 -1.78778
> ## Initial values are in fact the converged values
> fm1 <- nls(conc ~ SSbiexp(time, A1, lrc1, A2, lrc2), data = Indo.1)
> summary(fm1)
Formula: conc ~ SSbiexp(time, A1, lrc1, A2, lrc2)
Parameters:
Estimate Std. Error t value Pr(>|t|)
A1 2.0293 0.1099 18.464 3.39e-07 ***
lrc1 0.5794 0.1247 4.648 0.00235 **
A2 0.1915 0.1106 1.731 0.12698
lrc2 -1.7878 0.7871 -2.271 0.05737 .
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.04103 on 7 degrees of freedom
> ## Don't show:
> require(graphics)
>
> xx <- seq(0, 5, len = 101)
> y1 <- 3.5 * exp(-4*xx)
> y2 <- 1.5 * exp(-xx)
> yy <- y1 + y2
> par(mar = c(0, 0, 3.5, 0))
> plot(xx, yy, type = "n", axes = FALSE, ylim = c(-0.2,6), xlim = c(0, 5),
+ xlab = "", ylab = "", main = "Components of the SSbiexp model")
> usr <- par("usr")
> lines(xx, y1, lty = 2, lwd = 0.75)
> lines(xx, y2, lty = 3, lwd = 0.75)
> lines(xx, yy, lwd = 2)
> segments(1:5, 0, 1:5, -0.15)
> segments(0, 1:5, -0.06, 1:5)
> text(-0.1, 1:5, 1:5, adj = c(1, 0.25), cex = 0.7)
> text(1:5, -0.15, 1:5, adj = c(0.5, 1), cex = 0.7)
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSfol")
> ### * SSfol
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSfol
> ### Title: Self-Starting Nls First-order Compartment Model
> ### Aliases: SSfol
> ### Keywords: models
>
> ### ** Examples
>
> Theoph.1 <- Theoph[ Theoph$Subject == 1, ]
> SSfol(Theoph.1$Dose, Theoph.1$Time, -2.5, 0.5, -3) # response only
[1] 0.000000 2.214486 3.930988 5.261945 5.659813 5.084852 4.587699 3.916808
[9] 3.318395 2.579204 0.943593
> lKe <- -2.5; lKa <- 0.5; lCl <- -3
> SSfol(Theoph.1$Dose, Theoph.1$Time, lKe, lKa, lCl) # response and gradient
[1] 0.000000 2.214486 3.930988 5.261945 5.659813 5.084852 4.587699 3.916808
[9] 3.318395 2.579204 0.943593
attr(,"gradient")
lKe lKa lCl
[1,] 0.0000000 0.00000000 0.000000
[2,] 2.1902842 1.78781716 -2.214486
[3,] 3.8255178 2.35519507 -3.930988
[4,] 4.9527133 1.75648252 -5.261945
[5,] 4.9765205 0.53458070 -5.659813
[6,] 3.7528222 -0.18560297 -5.084852
[7,] 2.9068593 -0.22729852 -4.587699
[8,] 1.8617711 -0.20447579 -3.916808
[9,] 1.0271293 -0.17383515 -3.318395
[10,] 0.1483700 -0.13513891 -2.579204
[11,] -0.8945410 -0.04944021 -0.943593
> getInitial(conc ~ SSfol(Dose, Time, lKe, lKa, lCl), data = Theoph.1)
$lKe
[1] -2.994845
$lKa
[1] 0.609169
$lCl
[1] -3.971003
> ## Initial values are in fact the converged values
> fm1 <- nls(conc ~ SSfol(Dose, Time, lKe, lKa, lCl), data = Theoph.1)
> summary(fm1)
Formula: conc ~ SSfol(Dose, Time, lKe, lKa, lCl)
Parameters:
Estimate Std. Error t value Pr(>|t|)
lKe -2.9196 0.1709 -17.085 1.40e-07 ***
lKa 0.5752 0.1728 3.328 0.0104 *
lCl -3.9159 0.1273 -30.768 1.35e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.732 on 8 degrees of freedom
>
>
>
> cleanEx()
> nameEx("SSfpl")
> ### * SSfpl
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSfpl
> ### Title: Self-Starting Nls Four-Parameter Logistic Model
> ### Aliases: SSfpl
> ### Keywords: models
>
> ### ** Examples
>
> Chick.1 <- ChickWeight[ChickWeight$Chick == 1, ]
> SSfpl(Chick.1$Time, 13, 368, 14, 6) # response only
[1] 44.38189 55.31704 69.39853 87.05603 108.47420 133.43149 161.18758
[8] 190.50000 219.81242 247.56851 272.52580 283.70240
> A <- 13; B <- 368; xmid <- 14; scal <- 6
> SSfpl(Chick.1$Time, A, B, xmid, scal) # response and gradient
[1] 44.38189 55.31704 69.39853 87.05603 108.47420 133.43149 161.18758
[8] 190.50000 219.81242 247.56851 272.52580 283.70240
attr(,"gradient")
A B xmid scal
[1,] 0.9116003 0.08839968 -4.767956 11.125231
[2,] 0.8807971 0.11920292 -6.212120 12.424241
[3,] 0.8411309 0.15886910 -7.906425 13.177374
[4,] 0.7913915 0.20860853 -9.767885 13.023846
[5,] 0.7310586 0.26894142 -11.632873 11.632873
[6,] 0.6607564 0.33924363 -13.262646 8.841764
[7,] 0.5825702 0.41742979 -14.388278 4.796093
[8,] 0.5000000 0.50000000 -14.791667 0.000000
[9,] 0.4174298 0.58257021 -14.388278 -4.796093
[10,] 0.3392436 0.66075637 -13.262646 -8.841764
[11,] 0.2689414 0.73105858 -11.632873 -11.632873
[12,] 0.2374580 0.76254197 -10.713410 -12.498978
> print(getInitial(weight ~ SSfpl(Time, A, B, xmid, scal), data = Chick.1),
+ digits = 5)
A B xmid scal
27.4532 348.9712 19.3905 6.6726
> ## Initial values are in fact the converged values
> fm1 <- nls(weight ~ SSfpl(Time, A, B, xmid, scal), data = Chick.1)
> summary(fm1)
Formula: weight ~ SSfpl(Time, A, B, xmid, scal)
Parameters:
Estimate Std. Error t value Pr(>|t|)
A 27.453 6.601 4.159 0.003169 **
B 348.971 57.899 6.027 0.000314 ***
xmid 19.391 2.194 8.836 2.12e-05 ***
scal 6.673 1.002 6.662 0.000159 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.351 on 8 degrees of freedom
> ## Don't show:
> require(graphics)
>
> xx <- seq(-0.5, 5, len = 101)
> yy <- 1 + 4 / ( 1 + exp((2-xx)))
> par(mar = c(0, 0, 3.5, 0))
> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5),
+ xlab = "", ylab = "", lwd = 2,
+ main = "Parameters in the SSfpl model")
> usr <- par("usr")
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> abline(h = 5, lty = 2, lwd = 0)
> arrows(-0.8, 2.1, -0.8, 0, length = 0.1, angle = 25)
> arrows(-0.8, 2.9, -0.8, 5, length = 0.1, angle = 25)
> text(-0.8, 2.5, expression(phi[1]), adj = c(0.5, 0.5))
> abline(h = 1, lty = 2, lwd = 0)
> arrows(-0.3, 0.25, -0.3, 0, length = 0.07, angle = 25)
> arrows(-0.3, 0.75, -0.3, 1, length = 0.07, angle = 25)
> text(-0.3, 0.5, expression(phi[2]), adj = c(0.5, 0.5))
> segments(2, 0, 2, 3.3, lty = 2, lwd = 0.75)
> text(2, 3.3, expression(phi[3]), adj = c(0.5, 0))
> segments(3, 1+4/(1+exp(-1)) - 0.025, 3, 2.5, lty = 2, lwd = 0.75)
> arrows(2.3, 2.7, 2.0, 2.7, length = 0.08, angle = 25)
> arrows(2.7, 2.7, 3.0, 2.7, length = 0.08, angle = 25)
> text(2.5, 2.7, expression(phi[4]), adj = c(0.5, 0.5))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSgompertz")
> ### * SSgompertz
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSgompertz
> ### Title: Self-Starting Nls Gompertz Growth Model
> ### Aliases: SSgompertz
> ### Keywords: models
>
> ### ** Examples
>
> DNase.1 <- subset(DNase, Run == 1)
> SSlogis(log(DNase.1$conc), 4.5, 2.3, 0.7) # response only
[1] 0.002252677 0.002252677 0.016271550 0.016271550 0.043533453 0.043533453
[7] 0.115296351 0.115296351 0.297460928 0.297460928 0.720167577 0.720167577
[13] 1.525513075 1.525513075 2.609666856 2.609666856
> Asym <- 4.5; b2 <- 2.3; b3 <- 0.7
> SSgompertz(log(DNase.1$conc), Asym, b2, b3) # response and gradient
[1] 0.00525729 0.00525729 0.07323255 0.07323255 0.18049064 0.18049064
[7] 0.36508763 0.36508763 0.63288772 0.63288772 0.97257180 0.97257180
[13] 1.36033340 1.36033340 1.76786902 1.76786902
attr(,"gradient")
Asym b2 b3
[1,] 0.001168287 -0.01543407 0.1531221
[2,] 0.001168287 -0.01543407 0.1531221
[3,] 0.016273900 -0.13112424 0.7036230
[4,] 0.016273900 -0.13112424 0.7036230
[5,] 0.040109031 -0.25238507 0.7795153
[6,] 0.040109031 -0.25238507 0.7795153
[7,] 0.081130585 -0.39869082 0.3233828
[8,] 0.081130585 -0.39869082 0.3233828
[9,] 0.140641716 -0.53975407 -0.7914802
[10,] 0.140641716 -0.53975407 -0.7914802
[11,] 0.216127067 -0.64777036 -2.4251586
[12,] 0.216127067 -0.64777036 -2.4251586
[13,] 0.302296311 -0.70757894 -4.2605728
[14,] 0.302296311 -0.70757894 -4.2605728
[15,] 0.392859783 -0.71814108 -5.9597255
[16,] 0.392859783 -0.71814108 -5.9597255
> print(getInitial(density ~ SSgompertz(log(conc), Asym, b2, b3),
+ data = DNase.1), digits = 5)
Asym b2 b3
4.60333 2.27134 0.71647
> ## Initial values are in fact the converged values
> fm1 <- nls(density ~ SSgompertz(log(conc), Asym, b2, b3),
+ data = DNase.1)
> summary(fm1)
Formula: density ~ SSgompertz(log(conc), Asym, b2, b3)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 4.60333 0.65321 7.047 8.71e-06 ***
b2 2.27134 0.14373 15.803 7.24e-10 ***
b3 0.71647 0.02206 32.475 7.85e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.02684 on 13 degrees of freedom
>
>
>
> cleanEx()
> nameEx("SSlogis")
> ### * SSlogis
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSlogis
> ### Title: Self-Starting Nls Logistic Model
> ### Aliases: SSlogis
> ### Keywords: models
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits=5)
> ## End Don't show
> Chick.1 <- ChickWeight[ChickWeight$Chick == 1, ]
> SSlogis(Chick.1$Time, 368, 14, 6) # response only
[1] 32.531 43.867 58.464 76.768 98.970 124.842 153.614 184.000 214.386
[10] 243.158 269.030 280.615
> Asym <- 368; xmid <- 14; scal <- 6
> SSlogis(Chick.1$Time, Asym, xmid, scal) # response and gradient
[1] 32.531 43.867 58.464 76.768 98.970 124.842 153.614 184.000 214.386
[10] 243.158 269.030 280.615
attr(,"gradient")
Asym xmid scal
[1,] 0.08840 -4.9426 11.5326
[2,] 0.11920 -6.4396 12.8792
[3,] 0.15887 -8.1960 13.6599
[4,] 0.20861 -10.1256 13.5008
[5,] 0.26894 -12.0589 12.0589
[6,] 0.33924 -13.7483 9.1655
[7,] 0.41743 -14.9152 4.9717
[8,] 0.50000 -15.3333 0.0000
[9,] 0.58257 -14.9152 -4.9717
[10,] 0.66076 -13.7483 -9.1655
[11,] 0.73106 -12.0589 -12.0589
[12,] 0.76254 -11.1057 -12.9567
> getInitial(weight ~ SSlogis(Time, Asym, xmid, scal), data = Chick.1)
Asym xmid scal
937.021 35.223 11.405
> ## Initial values are in fact the converged values
> fm1 <- nls(weight ~ SSlogis(Time, Asym, xmid, scal), data = Chick.1)
> summary(fm1)
Formula: weight ~ SSlogis(Time, Asym, xmid, scal)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 937.021 465.858 2.01 0.0752 .
xmid 35.223 8.312 4.24 0.0022 **
scal 11.405 0.905 12.60 5.1e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.92 on 9 degrees of freedom
> ## Don't show:
> options(od)
> ## End Don't show
> ## Don't show:
> require(graphics)
>
> xx <- seq(-0.5, 5, len = 101)
> yy <- 5 / ( 1 + exp((2-xx)))
> par(mar = c(0, 0, 3.5, 0))
> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5),
+ xlab = "", ylab = "", lwd = 2,
+ main = "Parameters in the SSlogis model")
> usr <- par("usr")
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> abline(h = 5, lty = 2, lwd = 0)
> arrows(-0.8, 2.1, -0.8, 0, length = 0.1, angle = 25)
> arrows(-0.8, 2.9, -0.8, 5, length = 0.1, angle = 25)
> text(-0.8, 2.5, expression(phi[1]), adj = c(0.5, 0.5))
> segments(2, 0, 2, 4.0, lty = 2, lwd = 0.75)
> text(2, 4.0, expression(phi[2]), adj = c(0.5, 0))
> segments(3, 5/(1+exp(-1)) + 0.025, 3, 4.0, lty = 2, lwd = 0.75)
> arrows(2.3, 3.8, 2.0, 3.8, length = 0.08, angle = 25)
> arrows(2.7, 3.8, 3.0, 3.8, length = 0.08, angle = 25)
> text(2.5, 3.8, expression(phi[3]), adj = c(0.5, 0.5))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSmicmen")
> ### * SSmicmen
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSmicmen
> ### Title: Self-Starting Nls Michaelis-Menten Model
> ### Aliases: SSmicmen
> ### Keywords: models
>
> ### ** Examples
>
> PurTrt <- Puromycin[ Puromycin$state == "treated", ]
> SSmicmen(PurTrt$conc, 200, 0.05) # response only
[1] 57.14286 57.14286 109.09091 109.09091 137.50000 137.50000 162.96296
[8] 162.96296 183.60656 183.60656 191.30435 191.30435
> Vm <- 200; K <- 0.05
> SSmicmen(PurTrt$conc, Vm, K) # response and gradient
[1] 57.14286 57.14286 109.09091 109.09091 137.50000 137.50000 162.96296
[8] 162.96296 183.60656 183.60656 191.30435 191.30435
attr(,"gradient")
Vm K
[1,] 0.2857143 -816.3265
[2,] 0.2857143 -816.3265
[3,] 0.5454545 -991.7355
[4,] 0.5454545 -991.7355
[5,] 0.6875000 -859.3750
[6,] 0.6875000 -859.3750
[7,] 0.8148148 -603.5665
[8,] 0.8148148 -603.5665
[9,] 0.9180328 -300.9944
[10,] 0.9180328 -300.9944
[11,] 0.9565217 -166.3516
[12,] 0.9565217 -166.3516
> print(getInitial(rate ~ SSmicmen(conc, Vm, K), data = PurTrt), digits=3)
Vm K
212.6837 0.0641
> ## Initial values are in fact the converged values
> fm1 <- nls(rate ~ SSmicmen(conc, Vm, K), data = PurTrt)
> summary(fm1)
Formula: rate ~ SSmicmen(conc, Vm, K)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Vm 2.127e+02 6.947e+00 30.615 3.24e-11 ***
K 6.412e-02 8.281e-03 7.743 1.57e-05 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 10.93 on 10 degrees of freedom
> ## Alternative call using the subset argument
> fm2 <- nls(rate ~ SSmicmen(conc, Vm, K), data = Puromycin,
+ subset = state == "treated")
> summary(fm2)
Formula: rate ~ SSmicmen(conc, Vm, K)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Vm 2.127e+02 6.947e+00 30.615 3.24e-11 ***
K 6.412e-02 8.281e-03 7.743 1.57e-05 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 10.93 on 10 degrees of freedom
> ## Don't show:
> require(graphics)
>
> xx <- seq(0, 5, len = 101)
> yy <- 5 * xx/(1+xx)
> par(mar = c(0, 0, 3.5, 0))
> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,6), xlim = c(-1, 5),
+ xlab = "", ylab = "", lwd = 2,
+ main = "Parameters in the SSmicmen model")
> usr <- par("usr")
> arrows(usr[1], 0, usr[2], 0, length = 0.1, angle = 25)
> arrows(0, usr[3], 0, usr[4], length = 0.1, angle = 25)
> text(usr[2] - 0.2, 0.1, "x", adj = c(1, 0))
> text(-0.1, usr[4], "y", adj = c(1, 1))
> abline(h = 5, lty = 2, lwd = 0)
> arrows(-0.8, 2.1, -0.8, 0, length = 0.1, angle = 25)
> arrows(-0.8, 2.9, -0.8, 5, length = 0.1, angle = 25)
> text(-0.8, 2.5, expression(phi[1]), adj = c(0.5, 0.5))
> segments(1, 0, 1, 2.7, lty = 2, lwd = 0.75)
> text(1, 2.7, expression(phi[2]), adj = c(0.5, 0))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("SSweibull")
> ### * SSweibull
>
> flush(stderr()); flush(stdout())
>
> ### Name: SSweibull
> ### Title: Self-Starting Nls Weibull Growth Curve Model
> ### Aliases: SSweibull
> ### Keywords: models
>
> ### ** Examples
>
> Chick.6 <- subset(ChickWeight, (Chick == 6) & (Time > 0))
> SSweibull(Chick.6$Time, 160, 115, -5.5, 2.5) # response only
[1] 47.62811 59.09743 79.79756 105.12008 128.41818 145.02585 154.25783
[8] 158.24919 159.58222 159.92314 159.97023
> Asym <- 160; Drop <- 115; lrc <- -5.5; pwr <- 2.5
> SSweibull(Chick.6$Time, Asym, Drop, lrc, pwr) # response and gradient
[1] 47.62811 59.09743 79.79756 105.12008 128.41818 145.02585 154.25783
[8] 158.24919 159.58222 159.92314 159.97023
attr(,"gradient")
Asym Drop lrc pwr
[1,] 1 -0.9771469094 2.5978438 1.8006881
[2,] 1 -0.8774136912 13.1957043 18.2931305
[3,] 1 -0.6974125358 28.9032091 51.7875987
[4,] 1 -0.4772166721 40.5993205 84.4239136
[5,] 1 -0.2746244909 40.8147795 93.9795029
[6,] 1 -0.1302099955 30.5264027 75.8552610
[7,] 1 -0.0499319343 17.2098335 45.4177374
[8,] 1 -0.0152244293 7.3268815 20.3144290
[9,] 1 -0.0036328431 2.3469622 6.7835933
[10,] 1 -0.0006683898 0.5619310 1.6833949
[11,] 1 -0.0002589123 0.2459116 0.7486834
> getInitial(weight ~ SSweibull(Time, Asym, Drop, lrc, pwr), data = Chick.6)
Asym Drop lrc pwr
158.501204 110.997081 -5.993421 2.646141
> ## Initial values are in fact the converged values
> fm1 <- nls(weight ~ SSweibull(Time, Asym, Drop, lrc, pwr), data = Chick.6)
> summary(fm1)
Formula: weight ~ SSweibull(Time, Asym, Drop, lrc, pwr)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 158.5012 1.1769 134.67 3.28e-13 ***
Drop 110.9971 2.6330 42.16 1.10e-09 ***
lrc -5.9934 0.3733 -16.05 8.83e-07 ***
pwr 2.6461 0.1613 16.41 7.62e-07 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.061 on 7 degrees of freedom
>
>
>
> cleanEx()
> nameEx("SignRank")
> ### * SignRank
>
> flush(stderr()); flush(stdout())
>
> ### Name: SignRank
> ### Title: Distribution of the Wilcoxon Signed Rank Statistic
> ### Aliases: SignRank dsignrank psignrank qsignrank rsignrank
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> par(mfrow=c(2,2))
> for(n in c(4:5,10,40)) {
+ x <- seq(0, n*(n+1)/2, length=501)
+ plot(x, dsignrank(x,n=n), type='l', main=paste("dsignrank(x,n=",n,")"))
+ }
> ## Don't show:
> p <- c(1, 1, 1, 2, 2:6, 8, 10, 11, 13, 15, 17, 20, 22, 24,
+ 27, 29, 31, 33, 35, 36, 38, 39, 39, 40)
> stopifnot(round(dsignrank(0:56, n=10)* 2^10) == c(p, rev(p), 0),
+ qsignrank((1:16)/ 16, n=4) == c(0:2, rep(3:7, each=2), 8:10))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("StructTS")
> ### * StructTS
>
> flush(stderr()); flush(stdout())
>
> ### Name: StructTS
> ### Title: Fit Structural Time Series
> ### Aliases: StructTS print.StructTS predict.StructTS
> ### Keywords: ts
>
> ### ** Examples
>
> ## see also JohnsonJohnson, Nile and AirPassengers
> require(graphics)
>
> trees <- window(treering, start=0)
> (fit <- StructTS(trees, type = "level"))
Call:
StructTS(x = trees, type = "level")
Variances:
level epsilon
0.0003700 0.0719877
> plot(trees)
> lines(fitted(fit), col = "green")
> tsdiag(fit)
>
> (fit <- StructTS(log10(UKgas), type = "BSM"))
Call:
StructTS(x = log10(UKgas), type = "BSM")
Variances:
level slope seas epsilon
0.000e+00 1.733e-05 7.137e-04 3.678e-04
> par(mfrow = c(4, 1))
> plot(log10(UKgas))
> plot(cbind(fitted(fit), resids=resid(fit)), main = "UK gas consumption")
>
> ## keep some parameters fixed; trace optimizer:
> StructTS(log10(UKgas), type = "BSM", fixed = c(0.1,0.001,NA,NA),
+ optim.control = list(trace=TRUE))
iter 0 value -0.914421
iter 10 value -0.936176
final value -0.936176
converged
Call:
StructTS(x = log10(UKgas), type = "BSM", fixed = c(0.1, 0.001, NA, NA), optim.control = list(trace = TRUE))
Variances:
level slope seas epsilon
0.1000000 0.0010000 0.0003012 0.0000000
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("TDist")
> ### * TDist
>
> flush(stderr()); flush(stdout())
>
> ### Name: TDist
> ### Title: The Student t Distribution
> ### Aliases: TDist dt pt qt rt
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> 1 - pt(1:5, df = 1)
[1] 0.25000000 0.14758362 0.10241638 0.07797913 0.06283296
> qt(.975, df = c(1:10,20,50,100,1000))
[1] 12.706205 4.302653 3.182446 2.776445 2.570582 2.446912 2.364624
[8] 2.306004 2.262157 2.228139 2.085963 2.008559 1.983972 1.962339
>
> tt <- seq(0,10, len=21)
> ncp <- seq(0,6, len=31)
> ptn <- outer(tt,ncp, function(t,d) pt(t, df = 3, ncp=d))
> t.tit <- "Non-central t - Probabilities"
> image(tt,ncp,ptn, zlim=c(0,1), main = t.tit)
> persp(tt,ncp,ptn, zlim=0:1, r=2, phi=20, theta=200, main=t.tit,
+ xlab = "t", ylab = "non-centrality parameter",
+ zlab = "Pr(T <= t)")
>
> plot(function(x) dt(x, df = 3, ncp = 2), -3, 11, ylim = c(0, 0.32),
+ main="Non-central t - Density", yaxs="i")
>
>
>
> cleanEx()
> nameEx("Tukey")
> ### * Tukey
>
> flush(stderr()); flush(stdout())
>
> ### Name: Tukey
> ### Title: The Studentized Range Distribution
> ### Aliases: Tukey ptukey qtukey
> ### Keywords: distribution
>
> ### ** Examples
>
> if(interactive())
+ curve(ptukey(x, nm=6, df=5), from=-1, to=8, n=101)
> (ptt <- ptukey(0:10, 2, df= 5))
[1] 0.0000000 0.4889159 0.7835628 0.9126407 0.9632574 0.9833586 0.9918510
[8] 0.9957141 0.9976011 0.9985838 0.9991249
> (qtt <- qtukey(.95, 2, df= 2:11))
[1] 6.079637 4.500659 3.926503 3.635351 3.460456 3.344084 3.261182 3.199173
[9] 3.151064 3.112663
> ## The precision may be not much more than about 8 digits:
>
>
>
> cleanEx()
> nameEx("TukeyHSD")
> ### * TukeyHSD
>
> flush(stderr()); flush(stdout())
>
> ### Name: TukeyHSD
> ### Title: Compute Tukey Honest Significant Differences
> ### Aliases: TukeyHSD TukeyHSD.aov print.TukeyHSD plot.TukeyHSD
> ### Keywords: models design
>
> ### ** Examples
>
> require(graphics)
>
> summary(fm1 <- aov(breaks ~ wool + tension, data = warpbreaks))
Df Sum Sq Mean Sq F value Pr(>F)
wool 1 450.7 450.67 3.3393 0.073614 .
tension 2 2034.3 1017.13 7.5367 0.001378 **
Residuals 50 6747.9 134.96
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> TukeyHSD(fm1, "tension", ordered = TRUE)
Tukey multiple comparisons of means
95% family-wise confidence level
factor levels have been ordered
Fit: aov(formula = breaks ~ wool + tension, data = warpbreaks)
$tension
diff lwr upr p adj
M-H 4.722222 -4.6311985 14.07564 0.4474210
L-H 14.722222 5.3688015 24.07564 0.0011218
L-M 10.000000 0.6465793 19.35342 0.0336262
> plot(TukeyHSD(fm1, "tension"))
>
>
>
> cleanEx()
> nameEx("Uniform")
> ### * Uniform
>
> flush(stderr()); flush(stdout())
>
> ### Name: Uniform
> ### Title: The Uniform Distribution
> ### Aliases: Uniform dunif punif qunif runif
> ### Keywords: distribution
>
> ### ** Examples
>
> u <- runif(20)
>
> ## The following relations always hold :
> punif(u) == u
[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[16] TRUE TRUE TRUE TRUE TRUE
> dunif(u) == 1
[1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
[16] TRUE TRUE TRUE TRUE TRUE
>
> var(runif(10000))#- ~ = 1/12 = .08333
[1] 0.08475621
>
>
>
> cleanEx()
> nameEx("Weibull")
> ### * Weibull
>
> flush(stderr()); flush(stdout())
>
> ### Name: Weibull
> ### Title: The Weibull Distribution
> ### Aliases: Weibull dweibull pweibull qweibull rweibull
> ### Keywords: distribution
>
> ### ** Examples
>
> x <- c(0,rlnorm(50))
> all.equal(dweibull(x, shape = 1), dexp(x))
[1] TRUE
> all.equal(pweibull(x, shape = 1, scale = pi), pexp(x, rate = 1/pi))
[1] TRUE
> ## Cumulative hazard H():
> all.equal(pweibull(x, 2.5, pi, lower.tail=FALSE, log.p=TRUE), -(x/pi)^2.5,
+ tol = 1e-15)
[1] TRUE
> all.equal(qweibull(x/11, shape = 1, scale = pi), qexp(x/11, rate = 1/pi))
[1] TRUE
>
>
>
> cleanEx()
> nameEx("Wilcoxon")
> ### * Wilcoxon
>
> flush(stderr()); flush(stdout())
>
> ### Name: Wilcoxon
> ### Title: Distribution of the Wilcoxon Rank Sum Statistic
> ### Aliases: Wilcoxon dwilcox pwilcox qwilcox rwilcox
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> x <- -1:(4*6 + 1)
> fx <- dwilcox(x, 4, 6)
> Fx <- pwilcox(x, 4, 6)
>
> layout(rbind(1,2), widths=1, heights=c(3,2))
> plot(x, fx,type='h', col="violet",
+ main= "Probabilities (density) of Wilcoxon-Statist.(n=6,m=4)")
> plot(x, Fx,type="s", col="blue",
+ main= "Distribution of Wilcoxon-Statist.(n=6,m=4)")
> abline(h=0:1, col="gray20",lty=2)
> layout(1)# set back
>
> N <- 200
> hist(U <- rwilcox(N, m=4,n=6), breaks=0:25 - 1/2,
+ border="red", col="pink", sub = paste("N =",N))
> mtext("N * f(x), f() = true \"density\"", side=3, col="blue")
> lines(x, N*fx, type='h', col='blue', lwd=2)
> points(x, N*fx, cex=2)
>
> ## Better is a Quantile-Quantile Plot
> qqplot(U, qw <- qwilcox((1:N - 1/2)/N, m=4,n=6),
+ main = paste("Q-Q-Plot of empirical and theoretical quantiles",
+ "Wilcoxon Statistic, (m=4, n=6)",sep="\n"))
> n <- as.numeric(names(print(tU <- table(U))))
U
0 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23
1 1 4 6 7 10 8 12 14 22 13 16 13 23 16 11 7 4 4 3 3 1 1
> text(n+.2, n+.5, labels=tU, col="red")
>
>
>
> cleanEx()
> nameEx("acf")
> ### * acf
>
> flush(stderr()); flush(stdout())
>
> ### Name: acf
> ### Title: Auto- and Cross- Covariance and -Correlation Function Estimation
> ### Aliases: acf ccf pacf pacf.default [.acf
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ## Examples from Venables & Ripley
> acf(lh)
> acf(lh, type = "covariance")
> pacf(lh)
>
> acf(ldeaths)
> acf(ldeaths, ci.type = "ma")
> acf(ts.union(mdeaths, fdeaths))
> ccf(mdeaths, fdeaths, ylab = "cross-correlation")
> # (just the cross-correlations)
>
> presidents # contains missing values
Qtr1 Qtr2 Qtr3 Qtr4
1945 NA 87 82 75
1946 63 50 43 32
1947 35 60 54 55
1948 36 39 NA NA
1949 69 57 57 51
1950 45 37 46 39
1951 36 24 32 23
1952 25 32 NA 32
1953 59 74 75 60
1954 71 61 71 57
1955 71 68 79 73
1956 76 71 67 75
1957 79 62 63 57
1958 60 49 48 52
1959 57 62 61 66
1960 71 62 61 57
1961 72 83 71 78
1962 79 71 62 74
1963 76 64 62 57
1964 80 73 69 69
1965 71 64 69 62
1966 63 46 56 44
1967 44 52 38 46
1968 36 49 35 44
1969 59 65 65 56
1970 66 53 61 52
1971 51 48 54 49
1972 49 61 NA NA
1973 68 44 40 27
1974 28 25 24 24
> acf(presidents, na.action = na.pass)
> pacf(presidents, na.action = na.pass)
>
>
>
> cleanEx()
> nameEx("acf2AR")
> ### * acf2AR
>
> flush(stderr()); flush(stdout())
>
> ### Name: acf2AR
> ### Title: Compute an AR Process Exactly Fitting an ACF
> ### Aliases: acf2AR
> ### Keywords: ts
>
> ### ** Examples
>
> (Acf <- ARMAacf(c(0.6, 0.3, -0.2)))
0 1 2 3
1.0000000 0.6923077 0.5769231 0.3538462
> acf2AR(Acf)
1 2 3
ar(1) 0.6923077 0.0000 0.0
ar(2) 0.5625000 0.1875 0.0
ar(3) 0.6000000 0.3000 -0.2
>
>
>
> cleanEx()
> nameEx("add1")
> ### * add1
>
> flush(stderr()); flush(stdout())
>
> ### Name: add1
> ### Title: Add or Drop All Possible Single Terms to a Model
> ### Aliases: add1 add1.default add1.lm add1.glm drop1 drop1.default
> ### drop1.lm drop1.glm
> ### Keywords: models
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits=5)
> ## End Don't show
> require(graphics); require(utils)
> example(step)#-> swiss
step> utils::example(lm)
lm> require(graphics)
lm> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models".
lm> ## Page 9: Plant Weight Data.
lm> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
lm> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
lm> group <- gl(2,10,20, labels=c("Ctl","Trt"))
lm> weight <- c(ctl, trt)
lm> anova(lm.D9 <- lm(weight ~ group))
Analysis of Variance Table
Response: weight
Df Sum Sq Mean Sq F value Pr(>F)
group 1 0.69 0.688 1.42 0.25
Residuals 18 8.73 0.485
lm> summary(lm.D90 <- lm(weight ~ group - 1))# omitting intercept
Call:
lm(formula = weight ~ group - 1)
Residuals:
Min 1Q Median 3Q Max
-1.0710 -0.4937 0.0685 0.2462 1.3690
Coefficients:
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.03 0.22 22.9 9.5e-15 ***
groupTrt 4.66 0.22 21.2 3.6e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.696 on 18 degrees of freedom
Multiple R-squared: 0.982, Adjusted R-squared: 0.98
F-statistic: 485 on 2 and 18 DF, p-value: <2e-16
lm> opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
lm> plot(lm.D9, las = 1) # Residuals, Fitted, ...
lm> par(opar)
lm> ## model frame :
lm> stopifnot(identical(lm(weight ~ group, method = "model.frame"),
lm+ model.frame(lm.D9)))
lm> ### less simple examples in "See Also" above
lm>
lm>
lm>
step> step(lm.D9)
Start: AIC=-12.58
weight ~ group
Df Sum of Sq RSS AIC
- group 1 0.688 9.42 -13.1
<none> 8.73 -12.6
Step: AIC=-13.06
weight ~ 1
Call:
lm(formula = weight ~ 1)
Coefficients:
(Intercept)
4.85
step> summary(lm1 <- lm(Fertility ~ ., data = swiss))
Call:
lm(formula = Fertility ~ ., data = swiss)
Residuals:
Min 1Q Median 3Q Max
-15.274 -5.262 0.503 4.120 15.321
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 66.9152 10.7060 6.25 1.9e-07 ***
Agriculture -0.1721 0.0703 -2.45 0.0187 *
Examination -0.2580 0.2539 -1.02 0.3155
Education -0.8709 0.1830 -4.76 2.4e-05 ***
Catholic 0.1041 0.0353 2.95 0.0052 **
Infant.Mortality 1.0770 0.3817 2.82 0.0073 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 7.17 on 41 degrees of freedom
Multiple R-squared: 0.707, Adjusted R-squared: 0.671
F-statistic: 19.8 on 5 and 41 DF, p-value: 5.59e-10
step> slm1 <- step(lm1)
Start: AIC=190.69
Fertility ~ Agriculture + Examination + Education + Catholic +
Infant.Mortality
Df Sum of Sq RSS AIC
- Examination 1 53 2158 190
<none> 2105 191
- Agriculture 1 308 2413 195
- Infant.Mortality 1 409 2514 197
- Catholic 1 448 2553 198
- Education 1 1163 3268 209
Step: AIC=189.86
Fertility ~ Agriculture + Education + Catholic + Infant.Mortality
Df Sum of Sq RSS AIC
<none> 2158 190
- Agriculture 1 264 2422 193
- Infant.Mortality 1 410 2568 196
- Catholic 1 957 3115 205
- Education 1 2250 4408 221
step> summary(slm1)
Call:
lm(formula = Fertility ~ Agriculture + Education + Catholic +
Infant.Mortality, data = swiss)
Residuals:
Min 1Q Median 3Q Max
-14.676 -6.052 0.751 3.166 16.142
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 62.1013 9.6049 6.47 8.5e-08 ***
Agriculture -0.1546 0.0682 -2.27 0.0286 *
Education -0.9803 0.1481 -6.62 5.1e-08 ***
Catholic 0.1247 0.0289 4.31 9.5e-05 ***
Infant.Mortality 1.0784 0.3819 2.82 0.0072 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 7.17 on 42 degrees of freedom
Multiple R-squared: 0.699, Adjusted R-squared: 0.671
F-statistic: 24.4 on 4 and 42 DF, p-value: 1.72e-10
step> slm1$anova
Step Df Deviance Resid. Df Resid. Dev AIC
1 NA NA 41 2105.0 190.69
2 - Examination 1 53.027 42 2158.1 189.86
> add1(lm1, ~ I(Education^2) + .^2)
Single term additions
Model:
Fertility ~ Agriculture + Examination + Education + Catholic +
Infant.Mortality
Df Sum of Sq RSS AIC
<none> 2105 191
I(Education^2) 1 11.8 2093 192
Agriculture:Examination 1 10.7 2094 192
Agriculture:Education 1 1.8 2103 193
Agriculture:Catholic 1 75.0 2030 191
Agriculture:Infant.Mortality 1 4.4 2101 193
Examination:Education 1 48.7 2056 192
Examination:Catholic 1 40.8 2064 192
Examination:Infant.Mortality 1 65.9 2039 191
Education:Catholic 1 278.2 1827 186
Education:Infant.Mortality 1 93.0 2012 191
Catholic:Infant.Mortality 1 2.4 2103 193
> drop1(lm1, test="F") # So called 'type II' anova
Single term deletions
Model:
Fertility ~ Agriculture + Examination + Education + Catholic +
Infant.Mortality
Df Sum of Sq RSS AIC F value Pr(F)
<none> 2105 191
Agriculture 1 308 2413 195 5.99 0.0187 *
Examination 1 53 2158 190 1.03 0.3155
Education 1 1163 3268 209 22.64 2.4e-05 ***
Catholic 1 448 2553 198 8.72 0.0052 **
Infant.Mortality 1 409 2514 197 7.96 0.0073 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
> example(glm)
glm> ## Dobson (1990) Page 93: Randomized Controlled Trial :
glm> counts <- c(18,17,15,20,10,20,25,13,12)
glm> outcome <- gl(3,1,9)
glm> treatment <- gl(3,3)
glm> print(d.AD <- data.frame(treatment, outcome, counts))
treatment outcome counts
1 1 1 18
2 1 2 17
3 1 3 15
4 2 1 20
5 2 2 10
6 2 3 20
7 3 1 25
8 3 2 13
9 3 3 12
glm> glm.D93 <- glm(counts ~ outcome + treatment, family=poisson())
glm> anova(glm.D93)
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev
NULL 8 10.58
outcome 2 5.45 6 5.13
treatment 2 0.00 4 5.13
glm> summary(glm.D93)
Call:
glm(formula = counts ~ outcome + treatment, family = poisson())
Deviance Residuals:
1 2 3 4 5 6 7 8
-0.6712 0.9627 -0.1696 -0.2200 -0.9555 1.0494 0.8472 -0.0917
9
-0.9666
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.04e+00 1.71e-01 17.81 <2e-16 ***
outcome2 -4.54e-01 2.02e-01 -2.25 0.025 *
outcome3 -2.93e-01 1.93e-01 -1.52 0.128
treatment2 1.34e-15 2.00e-01 0.00 1.000
treatment3 1.42e-15 2.00e-01 0.00 1.000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for poisson family taken to be 1)
Null deviance: 10.5814 on 8 degrees of freedom
Residual deviance: 5.1291 on 4 degrees of freedom
AIC: 56.76
Number of Fisher Scoring iterations: 4
glm> ## an example with offsets from Venables & Ripley (2002, p.189)
glm> utils::data(anorexia, package="MASS")
glm> anorex.1 <- glm(Postwt ~ Prewt + Treat + offset(Prewt),
glm+ family = gaussian, data = anorexia)
glm> summary(anorex.1)
Call:
glm(formula = Postwt ~ Prewt + Treat + offset(Prewt), family = gaussian,
data = anorexia)
Deviance Residuals:
Min 1Q Median 3Q Max
-14.108 -4.277 -0.548 5.484 15.292
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 49.771 13.391 3.72 0.00041 ***
Prewt -0.566 0.161 -3.51 0.00080 ***
TreatCont -4.097 1.893 -2.16 0.03400 *
TreatFT 4.563 2.133 2.14 0.03604 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for gaussian family taken to be 48.695)
Null deviance: 4525.4 on 71 degrees of freedom
Residual deviance: 3311.3 on 68 degrees of freedom
AIC: 490
Number of Fisher Scoring iterations: 2
glm> # A Gamma example, from McCullagh & Nelder (1989, pp. 300-2)
glm> clotting <- data.frame(
glm+ u = c(5,10,15,20,30,40,60,80,100),
glm+ lot1 = c(118,58,42,35,27,25,21,19,18),
glm+ lot2 = c(69,35,26,21,18,16,13,12,12))
glm> summary(glm(lot1 ~ log(u), data=clotting, family=Gamma))
Call:
glm(formula = lot1 ~ log(u), family = Gamma, data = clotting)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.0401 -0.0376 -0.0264 0.0290 0.0864
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.016554 0.000928 -17.9 4.3e-07 ***
log(u) 0.015343 0.000415 37.0 2.8e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for Gamma family taken to be 0.0024461)
Null deviance: 3.512826 on 8 degrees of freedom
Residual deviance: 0.016730 on 7 degrees of freedom
AIC: 37.99
Number of Fisher Scoring iterations: 3
glm> summary(glm(lot2 ~ log(u), data=clotting, family=Gamma))
Call:
glm(formula = lot2 ~ log(u), family = Gamma, data = clotting)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.0557 -0.0293 0.0103 0.0171 0.0637
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.023908 0.001326 -18.0 4.0e-07 ***
log(u) 0.023599 0.000577 40.9 1.4e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for Gamma family taken to be 0.0018134)
Null deviance: 3.118557 on 8 degrees of freedom
Residual deviance: 0.012672 on 7 degrees of freedom
AIC: 27.03
Number of Fisher Scoring iterations: 3
glm> ## Not run:
glm> ##D ## for an example of the use of a terms object as a formula
glm> ##D demo(glm.vr)
glm> ## End(Not run)
glm>
glm>
> drop1(glm.D93, test="Chisq")
Single term deletions
Model:
counts ~ outcome + treatment
Df Deviance AIC LRT Pr(Chi)
<none> 5.13 56.8
outcome 2 10.58 58.2 5.45 0.065 .
treatment 2 5.13 52.8 0.00 1.000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> drop1(glm.D93, test="F")
Warning in drop1.glm(glm.D93, test = "F") :
F test assumes 'quasipoisson' family
Single term deletions
Model:
counts ~ outcome + treatment
Df Deviance AIC F value Pr(F)
<none> 5.13 56.8
outcome 2 10.58 58.2 2.13 0.23
treatment 2 5.13 52.8 0.00 1.00
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("addmargins")
> ### * addmargins
>
> flush(stderr()); flush(stdout())
>
> ### Name: addmargins
> ### Title: Puts Arbitrary Margins on Multidimensional Tables or Arrays
> ### Aliases: addmargins
> ### Keywords: manip array
>
> ### ** Examples
>
> Aye <- sample(c("Yes", "Si", "Oui"), 177, replace = TRUE)
> Bee <- sample(c("Hum", "Buzz"), 177, replace = TRUE)
> Sea <- sample(c("White", "Black", "Red", "Dead"), 177, replace = TRUE)
> (A <- table(Aye, Bee, Sea))
, , Sea = Black
Bee
Aye Buzz Hum
Oui 2 11
Si 8 13
Yes 7 6
, , Sea = Dead
Bee
Aye Buzz Hum
Oui 5 10
Si 10 10
Yes 7 6
, , Sea = Red
Bee
Aye Buzz Hum
Oui 5 6
Si 11 5
Yes 7 7
, , Sea = White
Bee
Aye Buzz Hum
Oui 7 9
Si 4 12
Yes 3 6
> addmargins(A)
, , Sea = Black
Bee
Aye Buzz Hum Sum
Oui 2 11 13
Si 8 13 21
Yes 7 6 13
Sum 17 30 47
, , Sea = Dead
Bee
Aye Buzz Hum Sum
Oui 5 10 15
Si 10 10 20
Yes 7 6 13
Sum 22 26 48
, , Sea = Red
Bee
Aye Buzz Hum Sum
Oui 5 6 11
Si 11 5 16
Yes 7 7 14
Sum 23 18 41
, , Sea = White
Bee
Aye Buzz Hum Sum
Oui 7 9 16
Si 4 12 16
Yes 3 6 9
Sum 14 27 41
, , Sea = Sum
Bee
Aye Buzz Hum Sum
Oui 19 36 55
Si 33 40 73
Yes 24 25 49
Sum 76 101 177
> ## Don't show:
> stopifnot(is.table(addmargins(A)))
> ## End Don't show
> ftable(A)
Sea Black Dead Red White
Aye Bee
Oui Buzz 2 5 5 7
Hum 11 10 6 9
Si Buzz 8 10 11 4
Hum 13 10 5 12
Yes Buzz 7 7 7 3
Hum 6 6 7 6
> ftable(addmargins(A))
Sea Black Dead Red White Sum
Aye Bee
Oui Buzz 2 5 5 7 19
Hum 11 10 6 9 36
Sum 13 15 11 16 55
Si Buzz 8 10 11 4 33
Hum 13 10 5 12 40
Sum 21 20 16 16 73
Yes Buzz 7 7 7 3 24
Hum 6 6 7 6 25
Sum 13 13 14 9 49
Sum Buzz 17 22 23 14 76
Hum 30 26 18 27 101
Sum 47 48 41 41 177
>
> # Non-commutative functions - note differences between resulting tables:
> ftable(addmargins(A, c(1,3),
+ FUN = list(Sum = sum, list(Min = min, Max = max))))
Margins computed over dimensions
in the following order:
1: Aye
2: Sea
Sea Black Dead Red White Min Max
Aye Bee
Oui Buzz 2 5 5 7 2 7
Hum 11 10 6 9 6 11
Si Buzz 8 10 11 4 4 11
Hum 13 10 5 12 5 13
Yes Buzz 7 7 7 3 3 7
Hum 6 6 7 6 6 7
Sum Buzz 17 22 23 14 14 23
Hum 30 26 18 27 18 30
> ftable(addmargins(A, c(3,1),
+ FUN = list(list(Min = min, Max = max), Sum = sum)))
Margins computed over dimensions
in the following order:
1: Sea
2: Aye
Sea Black Dead Red White Min Max
Aye Bee
Oui Buzz 2 5 5 7 2 7
Hum 11 10 6 9 6 11
Si Buzz 8 10 11 4 4 11
Hum 13 10 5 12 5 13
Yes Buzz 7 7 7 3 3 7
Hum 6 6 7 6 6 7
Sum Buzz 17 22 23 14 9 25
Hum 30 26 18 27 17 31
>
> # Weird function needed to return the N when computing percentages
> sqsm <- function(x) sum(x)^2/100
> B <- table(Sea, Bee)
> round(sweep(addmargins(B, 1, list(list(All = sum, N = sqsm))), 2,
+ apply(B, 2, sum)/100, "/"), 1)
Bee
Sea Buzz Hum
Black 22.4 29.7
Dead 28.9 25.7
Red 30.3 17.8
White 18.4 26.7
All 100.0 100.0
N 76.0 101.0
> round(sweep(addmargins(B, 2, list(list(All = sum, N = sqsm))), 1,
+ apply(B, 1, sum)/100, "/"), 1)
Bee
Sea Buzz Hum All N
Black 36.2 63.8 100.0 47.0
Dead 45.8 54.2 100.0 48.0
Red 56.1 43.9 100.0 41.0
White 34.1 65.9 100.0 41.0
>
> # A total over Bee requires formation of the Bee-margin first:
> mB <- addmargins(B, 2, FUN = list(list(Total = sum)))
> round(ftable(sweep(addmargins(mB, 1, list(list(All = sum, N = sqsm))), 2,
+ apply(mB,2,sum)/100, "/")), 1)
Bee Buzz Hum Total
Sea
Black 22.4 29.7 26.6
Dead 28.9 25.7 27.1
Red 30.3 17.8 23.2
White 18.4 26.7 23.2
All 100.0 100.0 100.0
N 76.0 101.0 177.0
>
> ## Zero.Printing table+margins:
> set.seed(1)
> x <- sample( 1:7, 20, replace=TRUE)
> y <- sample( 1:7, 20, replace=TRUE)
> tx <- addmargins( table(x, y) )
> print(tx, zero.print = ".")
y
x 1 2 3 4 5 6 7 Sum
1 . . 1 . . . . 1
2 . 1 . 1 1 . 1 4
3 . 2 . . . 1 . 3
4 . . . . 1 . . 1
5 . . 1 1 1 . 1 4
6 . . 1 . . 2 . 3
7 3 . 1 . . . . 4
Sum 3 3 4 2 3 3 2 20
>
>
>
> cleanEx()
> nameEx("aggregate")
> ### * aggregate
>
> flush(stderr()); flush(stdout())
>
> ### Name: aggregate
> ### Title: Compute Summary Statistics of Data Subsets
> ### Aliases: aggregate aggregate.default aggregate.data.frame
> ### aggregate.formula aggregate.ts
> ### Keywords: category array
>
> ### ** Examples
>
> ## Compute the averages for the variables in 'state.x77', grouped
> ## according to the region (Northeast, South, North Central, West) that
> ## each state belongs to.
> aggregate(state.x77, list(Region = state.region), mean)
Region Population Income Illiteracy Life Exp Murder HS Grad
1 Northeast 5495.111 4570.222 1.000000 71.26444 4.722222 53.96667
2 South 4208.125 4011.938 1.737500 69.70625 10.581250 44.34375
3 North Central 4803.000 4611.083 0.700000 71.76667 5.275000 54.51667
4 West 2915.308 4702.615 1.023077 71.23462 7.215385 62.00000
Frost Area
1 132.7778 18141.00
2 64.6250 54605.12
3 138.8333 62652.00
4 102.1538 134463.00
>
> ## Compute the averages according to region and the occurrence of more
> ## than 130 days of frost.
> aggregate(state.x77,
+ list(Region = state.region,
+ Cold = state.x77[,"Frost"] > 130),
+ mean)
Region Cold Population Income Illiteracy Life Exp Murder
1 Northeast FALSE 8802.8000 4780.400 1.1800000 71.12800 5.580000
2 South FALSE 4208.1250 4011.938 1.7375000 69.70625 10.581250
3 North Central FALSE 7233.8333 4633.333 0.7833333 70.95667 8.283333
4 West FALSE 4582.5714 4550.143 1.2571429 71.70000 6.828571
5 Northeast TRUE 1360.5000 4307.500 0.7750000 71.43500 3.650000
6 North Central TRUE 2372.1667 4588.833 0.6166667 72.57667 2.266667
7 West TRUE 970.1667 4880.500 0.7500000 70.69167 7.666667
HS Grad Frost Area
1 52.06000 110.6000 21838.60
2 44.34375 64.6250 54605.12
3 53.36667 120.0000 56736.50
4 60.11429 51.0000 91863.71
5 56.35000 160.5000 13519.00
6 55.66667 157.6667 68567.50
7 64.20000 161.8333 184162.17
> ## (Note that no state in 'South' is THAT cold.)
>
>
> ## example with character variables and NAs
> testDF <- data.frame(v1 = c(1,3,5,7,8,3,5,NA,4,5,7,9),
+ v2 = c(11,33,55,77,88,33,55,NA,44,55,77,99) )
> by1 <- c("red","blue",1,2,NA,"big",1,2,"red",1,NA,12)
> by2 <- c("wet","dry",99,95,NA,"damp",95,99,"red",99,NA,NA)
> aggregate(x = testDF, by = list(by1, by2), FUN = "mean")
Group.1 Group.2 v1 v2
1 1 95 5 55
2 2 95 7 77
3 1 99 5 55
4 2 99 NA NA
5 big damp 3 33
6 blue dry 3 33
7 red red 4 44
8 red wet 1 11
>
> # and if you want to treat NAs as a group
> fby1 <- factor(by1, exclude = "")
> fby2 <- factor(by2, exclude = "")
> aggregate(x = testDF, by = list(fby1, fby2), FUN = "mean")
Group.1 Group.2 v1 v2
1 1 95 5.0 55.0
2 2 95 7.0 77.0
3 1 99 5.0 55.0
4 2 99 NA NA
5 big damp 3.0 33.0
6 blue dry 3.0 33.0
7 red red 4.0 44.0
8 red wet 1.0 11.0
9 12 <NA> 9.0 99.0
10 <NA> <NA> 7.5 82.5
>
>
> ## Formulas, one ~ one, one ~ many, many ~ one, and many ~ many:
> aggregate(weight ~ feed, data = chickwts, mean)
feed weight
1 casein 323.5833
2 horsebean 160.2000
3 linseed 218.7500
4 meatmeal 276.9091
5 soybean 246.4286
6 sunflower 328.9167
> aggregate(breaks ~ wool + tension, data = warpbreaks, mean)
wool tension breaks
1 A L 44.55556
2 B L 28.22222
3 A M 24.00000
4 B M 28.77778
5 A H 24.55556
6 B H 18.77778
> aggregate(cbind(Ozone, Temp) ~ Month, data = airquality, mean)
Month Ozone Temp
1 5 23.61538 66.73077
2 6 29.44444 78.22222
3 7 59.11538 83.88462
4 8 59.96154 83.96154
5 9 31.44828 76.89655
> aggregate(cbind(ncases, ncontrols) ~ alcgp + tobgp, data = esoph, sum)
alcgp tobgp ncases ncontrols
1 0-39g/day 0-9g/day 9 261
2 40-79 0-9g/day 34 179
3 80-119 0-9g/day 19 61
4 120+ 0-9g/day 16 24
5 0-39g/day 10-19 10 84
6 40-79 10-19 17 85
7 80-119 10-19 19 49
8 120+ 10-19 12 18
9 0-39g/day 20-29 5 42
10 40-79 20-29 15 62
11 80-119 20-29 6 16
12 120+ 20-29 7 12
13 0-39g/day 30+ 5 28
14 40-79 30+ 9 29
15 80-119 30+ 7 12
16 120+ 30+ 10 13
>
> ## Dot notation:
> aggregate(. ~ Species, data = iris, mean)
Species Sepal.Length Sepal.Width Petal.Length Petal.Width
1 setosa 5.006 3.428 1.462 0.246
2 versicolor 5.936 2.770 4.260 1.326
3 virginica 6.588 2.974 5.552 2.026
> aggregate(len ~ ., data = ToothGrowth, mean)
supp dose len
1 OJ 0.5 13.23
2 VC 0.5 7.98
3 OJ 1.0 22.70
4 VC 1.0 16.77
5 OJ 2.0 26.06
6 VC 2.0 26.14
>
> ## Often followed by xtabs():
> ag <- aggregate(len ~ ., data = ToothGrowth, mean)
> xtabs(len ~ ., data = ag)
dose
supp 0.5 1 2
OJ 13.23 22.70 26.06
VC 7.98 16.77 26.14
>
>
> ## Compute the average annual approval ratings for American presidents.
> aggregate(presidents, nfrequency = 1, FUN = mean)
Time Series:
Start = 1945
End = 1974
Frequency = 1
[1] NA 47.00 51.00 NA 58.50 41.75 28.75 NA 67.00 65.00 72.75 72.25
[13] 65.25 52.25 61.50 62.75 76.00 71.50 64.75 72.75 66.50 52.25 45.00 41.00
[25] 61.25 58.00 50.50 NA 44.75 25.25
> ## Give the summer less weight.
> aggregate(presidents, nfrequency = 1,
+ FUN = weighted.mean, w = c(1, 1, 0.5, 1))
Time Series:
Start = 1945
End = 1974
Frequency = 1
[1] NA 47.57143 50.57143 NA 58.71429 41.14286 28.28571 NA
[9] 65.85714 64.14286 71.85714 73.00000 65.57143 52.85714 61.57143 63.00000
[17] 76.71429 72.85714 65.14286 73.28571 66.14286 51.71429 46.00000 41.85714
[25] 60.71429 57.57143 50.00000 NA 45.42857 25.42857
>
>
>
> cleanEx()
> nameEx("alias")
> ### * alias
>
> flush(stderr()); flush(stdout())
>
> ### Name: alias
> ### Title: Find Aliases (Dependencies) in a Model
> ### Aliases: alias alias.formula alias.lm
> ### Keywords: models
>
> ### ** Examples
>
> ## From Venables and Ripley (2002) p.165.
> utils::data(npk, package="MASS")
>
> op <- options(contrasts=c("contr.helmert", "contr.poly"))
> npk.aov <- aov(yield ~ block + N*P*K, npk)
> alias(npk.aov)
Model :
yield ~ block + N * P * K
Complete :
(Intercept) block1 block2 block3 block4 block5 N1 P1 K1 N1:P1
N1:P1:K1 0 1 1/3 1/6 -3/10 -1/5 0 0 0 0
N1:K1 P1:K1
N1:P1:K1 0 0
> options(op)# reset
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("anova.glm")
> ### * anova.glm
>
> flush(stderr()); flush(stdout())
>
> ### Name: anova.glm
> ### Title: Analysis of Deviance for Generalized Linear Model Fits
> ### Aliases: anova.glm anova.glmlist
> ### Keywords: models regression
>
> ### ** Examples
>
> ## --- Continuing the Example from '?glm':
> ## Don't show:
> require(utils)
> example("glm", echo = FALSE)
treatment outcome counts
1 1 1 18
2 1 2 17
3 1 3 15
4 2 1 20
5 2 2 10
6 2 3 20
7 3 1 25
8 3 2 13
9 3 3 12
> ## End Don't show
> anova(glm.D93)
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev
NULL 8 10.5814
outcome 2 5.4523 6 5.1291
treatment 2 0.0000 4 5.1291
> anova(glm.D93, test = "Cp")
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev Cp
NULL 8 10.5814 12.581
outcome 2 5.4523 6 5.1291 11.129
treatment 2 0.0000 4 5.1291 15.129
> anova(glm.D93, test = "Chisq")
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev P(>|Chi|)
NULL 8 10.5814
outcome 2 5.4523 6 5.1291 0.06547 .
treatment 2 0.0000 4 5.1291 1.00000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>
>
> cleanEx()
> nameEx("anova.lm")
> ### * anova.lm
>
> flush(stderr()); flush(stdout())
>
> ### Name: anova.lm
> ### Title: ANOVA for Linear Model Fits
> ### Aliases: anova.lm anova.lmlist
> ### Keywords: regression models
>
> ### ** Examples
>
> ## sequential table
> fit <- lm(sr ~ ., data = LifeCycleSavings)
> anova(fit)
Analysis of Variance Table
Response: sr
Df Sum Sq Mean Sq F value Pr(>F)
pop15 1 204.12 204.118 14.1157 0.0004922 ***
pop75 1 53.34 53.343 3.6889 0.0611255 .
dpi 1 12.40 12.401 0.8576 0.3593551
ddpi 1 63.05 63.054 4.3605 0.0424711 *
Residuals 45 650.71 14.460
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
> ## same effect via separate models
> fit0 <- lm(sr ~ 1, data = LifeCycleSavings)
> fit1 <- update(fit0, . ~ . + pop15)
> fit2 <- update(fit1, . ~ . + pop75)
> fit3 <- update(fit2, . ~ . + dpi)
> fit4 <- update(fit3, . ~ . + ddpi)
> anova(fit0, fit1, fit2, fit3, fit4, test="F")
Analysis of Variance Table
Model 1: sr ~ 1
Model 2: sr ~ pop15
Model 3: sr ~ pop15 + pop75
Model 4: sr ~ pop15 + pop75 + dpi
Model 5: sr ~ pop15 + pop75 + dpi + ddpi
Res.Df RSS Df Sum of Sq F Pr(>F)
1 49 983.63
2 48 779.51 1 204.118 14.1157 0.0004922 ***
3 47 726.17 1 53.343 3.6889 0.0611255 .
4 46 713.77 1 12.401 0.8576 0.3593551
5 45 650.71 1 63.054 4.3605 0.0424711 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
> anova(fit4, fit2, fit0, test="F") # unconventional order
Analysis of Variance Table
Model 1: sr ~ pop15 + pop75 + dpi + ddpi
Model 2: sr ~ pop15 + pop75
Model 3: sr ~ 1
Res.Df RSS Df Sum of Sq F Pr(>F)
1 45 650.71
2 47 726.17 -2 -75.455 2.6090 0.0847088 .
3 49 983.63 -2 -257.460 8.9023 0.0005527 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>
>
> cleanEx()
> nameEx("anova.mlm")
> ### * anova.mlm
>
> flush(stderr()); flush(stdout())
>
> ### Name: anova.mlm
> ### Title: Comparisons between Multivariate Linear Models
> ### Aliases: anova.mlm anova.mlmlist
> ### Keywords: regression models multivariate
>
> ### ** Examples
>
> require(graphics)
> utils::example(SSD) # Brings in the mlmfit and reacttime objects
SSD> # Lifted from Baron+Li:
SSD> # "Notes on the use of R for psychology experiments and questionnaires"
SSD> # Maxwell and Delaney, p. 497
SSD> reacttime <- matrix(c(
SSD+ 420, 420, 480, 480, 600, 780,
SSD+ 420, 480, 480, 360, 480, 600,
SSD+ 480, 480, 540, 660, 780, 780,
SSD+ 420, 540, 540, 480, 780, 900,
SSD+ 540, 660, 540, 480, 660, 720,
SSD+ 360, 420, 360, 360, 480, 540,
SSD+ 480, 480, 600, 540, 720, 840,
SSD+ 480, 600, 660, 540, 720, 900,
SSD+ 540, 600, 540, 480, 720, 780,
SSD+ 480, 420, 540, 540, 660, 780),
SSD+ ncol = 6, byrow = TRUE,
SSD+ dimnames=list(subj=1:10,
SSD+ cond=c("deg0NA", "deg4NA", "deg8NA",
SSD+ "deg0NP", "deg4NP", "deg8NP")))
SSD> mlmfit <- lm(reacttime~1)
SSD> SSD(mlmfit)
$SSD
cond
cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP
deg0NA 29160 30600 26640 23760 32400 25560
deg4NA 30600 66600 32400 7200 36000 30600
deg8NA 26640 32400 56160 41040 57600 69840
deg0NP 23760 7200 41040 70560 72000 63360
deg4NP 32400 36000 57600 72000 108000 100800
deg8NP 25560 30600 69840 63360 100800 122760
$call
lm(formula = reacttime ~ 1)
$df
[1] 9
attr(,"class")
[1] "SSD"
SSD> estVar(mlmfit)
cond
cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP
deg0NA 3240 3400 2960 2640 3600 2840
deg4NA 3400 7400 3600 800 4000 3400
deg8NA 2960 3600 6240 4560 6400 7760
deg0NP 2640 800 4560 7840 8000 7040
deg4NP 3600 4000 6400 8000 12000 11200
deg8NP 2840 3400 7760 7040 11200 13640
>
> mlmfit0 <- update(mlmfit, ~0)
>
> ### Traditional tests of intrasubj. contrasts
> ## Using MANOVA techniques on contrasts:
> anova(mlmfit, mlmfit0, X=~1)
Analysis of Variance Table
Model 1: reacttime ~ 1
Model 2: reacttime ~ 1 - 1
Contrasts orthogonal to
~1
Res.Df Df Gen.var. Pillai approx F num Df den Df Pr(>F)
1 9 1249.6
2 10 1 2013.2 0.9456 17.381 5 5 0.003534 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
> ## Assuming sphericity
> anova(mlmfit, mlmfit0, X=~1, test="Spherical")
Analysis of Variance Table
Model 1: reacttime ~ 1
Model 2: reacttime ~ 1 - 1
Contrasts orthogonal to
~1
Greenhouse-Geisser epsilon: 0.4855
Huynh-Feldt epsilon: 0.6778
Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr
1 9 1249.6
2 10 1 2013.2 38.028 5 45 4.4711e-15 2.532e-08 7.393e-11
>
>
> ### tests using intra-subject 3x2 design
> idata <- data.frame(deg=gl(3,1,6,labels=c(0,4,8)),
+ noise=gl(2,3,6,labels=c("A","P")))
>
> anova(mlmfit, mlmfit0, X = ~ deg + noise,
+ idata = idata, test = "Spherical")
Analysis of Variance Table
Model 1: reacttime ~ 1
Model 2: reacttime ~ 1 - 1
Contrasts orthogonal to
~deg + noise
Greenhouse-Geisser epsilon: 0.904
Huynh-Feldt epsilon: 1.118
Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr
1 9 316.58
2 10 1 996.34 45.31 2 18 9.4241e-08 3.4539e-07 9.4241e-08
> anova(mlmfit, mlmfit0, M = ~ deg + noise, X = ~ noise,
+ idata = idata, test="Spherical" )
Analysis of Variance Table
Model 1: reacttime ~ 1
Model 2: reacttime ~ 1 - 1
Contrasts orthogonal to
~noise
Contrasts spanned by
~deg + noise
Greenhouse-Geisser epsilon: 0.9616
Huynh-Feldt epsilon: 1.2176
Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr
1 9 1007.0
2 10 1 2703.2 40.719 2 18 2.0868e-07 3.4017e-07 2.0868e-07
> anova(mlmfit, mlmfit0, M = ~ deg + noise, X = ~ deg,
+ idata = idata, test="Spherical" )
Analysis of Variance Table
Model 1: reacttime ~ 1
Model 2: reacttime ~ 1 - 1
Contrasts orthogonal to
~deg
Contrasts spanned by
~deg + noise
Greenhouse-Geisser epsilon: 1
Huynh-Feldt epsilon: 1
Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr
1 9 1410
2 10 1 6030 33.766 1 9 0.00025597 0.00025597 0.00025597
>
> f <- factor(rep(1:2,5)) # bogus, just for illustration
> mlmfit2 <- update(mlmfit, ~f)
> anova(mlmfit2, mlmfit, mlmfit0, X = ~1, test = "Spherical")
Analysis of Variance Table
Model 1: reacttime ~ f
Model 2: reacttime ~ 1
Model 3: reacttime ~ 1 - 1
Contrasts orthogonal to
~1
Greenhouse-Geisser epsilon: 0.4691
Huynh-Feldt epsilon: 0.6758
Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr
1 8 1337.3
2 9 1 1249.6 0.2743 5 40 0.92452 0.79608 0.86456
3 10 1 2013.2 34.9615 5 40 0.00000 0.00000 0.00000
> anova(mlmfit2, X = ~1, test = "Spherical")
Analysis of Variance Table
Contrasts orthogonal to
~1
Greenhouse-Geisser epsilon: 0.4691
Huynh-Feldt epsilon: 0.6758
Df F num Df den Df Pr(>F) G-G Pr H-F Pr
(Intercept) 1 34.9615 5 40 0.00000 0.00000 0.00000
f 1 0.2743 5 40 0.92452 0.79608 0.86456
Residuals 8
> # one-model form, eqiv. to previous
>
> ### There seems to be a strong interaction in these data
> plot(colMeans(reacttime))
>
>
>
> cleanEx()
> nameEx("ansari.test")
> ### * ansari.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: ansari.test
> ### Title: Ansari-Bradley Test
> ### Aliases: ansari.test ansari.test.default ansari.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> ## Hollander & Wolfe (1973, p. 86f):
> ## Serum iron determination using Hyland control sera
> ramsay <- c(111, 107, 100, 99, 102, 106, 109, 108, 104, 99,
+ 101, 96, 97, 102, 107, 113, 116, 113, 110, 98)
> jung.parekh <- c(107, 108, 106, 98, 105, 103, 110, 105, 104,
+ 100, 96, 108, 103, 104, 114, 114, 113, 108, 106, 99)
> ansari.test(ramsay, jung.parekh)
Warning in ansari.test.default(ramsay, jung.parekh) :
cannot compute exact p-value with ties
Ansari-Bradley test
data: ramsay and jung.parekh
AB = 185.5, p-value = 0.1815
alternative hypothesis: true ratio of scales is not equal to 1
>
> ansari.test(rnorm(10), rnorm(10, 0, 2), conf.int = TRUE)
Ansari-Bradley test
data: rnorm(10) and rnorm(10, 0, 2)
AB = 69, p-value = 0.03831
alternative hypothesis: true ratio of scales is not equal to 1
95 percent confidence interval:
0.1852324 0.9712857
sample estimates:
ratio of scales
0.4007458
>
> ## try more points - failed in 2.4.1
> ansari.test(rnorm(100), rnorm(100, 0, 2), conf.int = TRUE)
Ansari-Bradley test
data: rnorm(100) and rnorm(100, 0, 2)
AB = 6180, p-value = 3.347e-08
alternative hypothesis: true ratio of scales is not equal to 1
95 percent confidence interval:
0.3330596 0.5693532
sample estimates:
ratio of scales
0.4346784
>
>
>
> cleanEx()
> nameEx("aov")
> ### * aov
>
> flush(stderr()); flush(stdout())
>
> ### Name: aov
> ### Title: Fit an Analysis of Variance Model
> ### Aliases: aov print.aov print.aovlist Error
> ### Keywords: models regression
>
> ### ** Examples
>
> ## From Venables and Ripley (2002) p.165.
> utils::data(npk, package="MASS")
>
> ## Set orthogonal contrasts.
> op <- options(contrasts=c("contr.helmert", "contr.poly"))
> ( npk.aov <- aov(yield ~ block + N*P*K, npk) )
Call:
aov(formula = yield ~ block + N * P * K, data = npk)
Terms:
block N P K N:P N:K P:K
Sum of Squares 343.2950 189.2817 8.4017 95.2017 21.2817 33.1350 0.4817
Deg. of Freedom 5 1 1 1 1 1 1
Residuals
Sum of Squares 185.2867
Deg. of Freedom 12
Residual standard error: 3.929447
1 out of 13 effects not estimable
Estimated effects are balanced
> summary(npk.aov)
Df Sum Sq Mean Sq F value Pr(>F)
block 5 343.29 68.659 4.4467 0.015939 *
N 1 189.28 189.282 12.2587 0.004372 **
P 1 8.40 8.402 0.5441 0.474904
K 1 95.20 95.202 6.1657 0.028795 *
N:P 1 21.28 21.282 1.3783 0.263165
N:K 1 33.14 33.135 2.1460 0.168648
P:K 1 0.48 0.482 0.0312 0.862752
Residuals 12 185.29 15.441
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> coefficients(npk.aov)
(Intercept) block1 block2 block3 block4 block5
54.8750000 1.7125000 1.6791667 -1.8229167 -1.0137500 0.2950000
N1 P1 K1 N1:P1 N1:K1 P1:K1
2.8083333 -0.5916667 -1.9916667 -0.9416667 -1.1750000 0.1416667
>
> ## to show the effects of re-ordering terms contrast the two fits
> aov(yield ~ block + N * P + K, npk)
Call:
aov(formula = yield ~ block + N * P + K, data = npk)
Terms:
block N P K N:P Residuals
Sum of Squares 343.2950 189.2817 8.4017 95.2017 21.2817 218.9033
Deg. of Freedom 5 1 1 1 1 14
Residual standard error: 3.954232
Estimated effects are balanced
> aov(terms(yield ~ block + N * P + K, keep.order=TRUE), npk)
Call:
aov(formula = terms(yield ~ block + N * P + K, keep.order = TRUE),
data = npk)
Terms:
block N P N:P K Residuals
Sum of Squares 343.2950 189.2817 8.4017 21.2817 95.2017 218.9033
Deg. of Freedom 5 1 1 1 1 14
Residual standard error: 3.954232
Estimated effects are balanced
>
>
> ## as a test, not particularly sensible statistically
> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)
> npk.aovE
Call:
aov(formula = yield ~ N * P * K + Error(block), data = npk)
Grand Mean: 54.875
Stratum 1: block
Terms:
N:P:K Residuals
Sum of Squares 37.00167 306.29333
Deg. of Freedom 1 4
Residual standard error: 8.750619
Estimated effects are balanced
Stratum 2: Within
Terms:
N P K N:P N:K P:K
Sum of Squares 189.28167 8.40167 95.20167 21.28167 33.13500 0.48167
Deg. of Freedom 1 1 1 1 1 1
Residuals
Sum of Squares 185.28667
Deg. of Freedom 12
Residual standard error: 3.929447
Estimated effects are balanced
> summary(npk.aovE)
Error: block
Df Sum Sq Mean Sq F value Pr(>F)
N:P:K 1 37.002 37.002 0.4832 0.5252
Residuals 4 306.293 76.573
Error: Within
Df Sum Sq Mean Sq F value Pr(>F)
N 1 189.282 189.282 12.2587 0.004372 **
P 1 8.402 8.402 0.5441 0.474904
K 1 95.202 95.202 6.1657 0.028795 *
N:P 1 21.282 21.282 1.3783 0.263165
N:K 1 33.135 33.135 2.1460 0.168648
P:K 1 0.482 0.482 0.0312 0.862752
Residuals 12 185.287 15.441
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> options(op)# reset to previous
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("approxfun")
> ### * approxfun
>
> flush(stderr()); flush(stdout())
>
> ### Name: approxfun
> ### Title: Interpolation Functions
> ### Aliases: approx approxfun
> ### Keywords: arith dplot
>
> ### ** Examples
>
> require(graphics)
>
> x <- 1:10
> y <- rnorm(10)
> par(mfrow = c(2,1))
> plot(x, y, main = "approx(.) and approxfun(.)")
> points(approx(x, y), col = 2, pch = "*")
> points(approx(x, y, method = "constant"), col = 4, pch = "*")
>
> f <- approxfun(x, y)
> curve(f(x), 0, 11, col = "green2")
> points(x, y)
> is.function(fc <- approxfun(x, y, method = "const")) # TRUE
[1] TRUE
> curve(fc(x), 0, 10, col = "darkblue", add = TRUE)
> ## different extrapolation on left and right side :
> plot(approxfun(x, y, rule = 2:1), 0, 11,
+ col = "tomato", add = TRUE, lty = 3, lwd = 2)
>
> ## Show treatment of 'ties' :
>
> x <- c(2,2:4,4,4,5,5,7,7,7)
> y <- c(1:6, 5:4, 3:1)
> approx(x,y, xout=x)$y # warning
[1] 1.5 1.5 3.0 5.0 5.0 5.0 4.5 4.5 2.0 2.0 2.0
> (ay <- approx(x,y, xout=x, ties = "ordered")$y)
[1] 2 2 3 6 6 6 4 4 1 1 1
> stopifnot(ay == c(2,2,3,6,6,6,4,4,1,1,1))
> approx(x,y, xout=x, ties = min)$y
[1] 1 1 3 4 4 4 4 4 1 1 1
> approx(x,y, xout=x, ties = max)$y
[1] 2 2 3 6 6 6 5 5 3 3 3
>
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("ar")
> ### * ar
>
> flush(stderr()); flush(stdout())
>
> ### Name: ar
> ### Title: Fit Autoregressive Models to Time Series
> ### Aliases: ar ar.burg ar.burg.default ar.burg.mts ar.yw ar.yw.default
> ### ar.yw.mts ar.mle print.ar predict.ar
> ### Keywords: ts
>
> ### ** Examples
>
> ar(lh)
Call:
ar(x = lh)
Coefficients:
1 2 3
0.6534 -0.0636 -0.2269
Order selected 3 sigma^2 estimated as 0.1959
> ar(lh, method="burg")
Call:
ar(x = lh, method = "burg")
Coefficients:
1 2 3
0.6588 -0.0608 -0.2234
Order selected 3 sigma^2 estimated as 0.1786
> ar(lh, method="ols")
Call:
ar(x = lh, method = "ols")
Coefficients:
1
0.586
Intercept: 0.006234 (0.06551)
Order selected 1 sigma^2 estimated as 0.2016
> ar(lh, FALSE, 4) # fit ar(4)
Call:
ar(x = lh, aic = FALSE, order.max = 4)
Coefficients:
1 2 3 4
0.6767 -0.0571 -0.2941 0.1028
Order selected 4 sigma^2 estimated as 0.1983
>
> (sunspot.ar <- ar(sunspot.year))
Call:
ar(x = sunspot.year)
Coefficients:
1 2 3 4 5 6 7 8
1.1305 -0.3524 -0.1745 0.1403 -0.1358 0.0963 -0.0556 0.0076
9
0.1941
Order selected 9 sigma^2 estimated as 267.5
> predict(sunspot.ar, n.ahead=25)
$pred
Time Series:
Start = 1989
End = 2013
Frequency = 1
[1] 135.25933 148.09051 133.98476 106.61344 71.21921 40.84057 18.70100
[8] 11.52416 27.24208 56.99888 87.86705 107.62926 111.05437 98.05484
[15] 74.84085 48.80128 27.65441 18.15075 23.15355 40.04723 61.95906
[22] 80.79092 90.11420 87.44131 74.42284
$se
Time Series:
Start = 1989
End = 2013
Frequency = 1
[1] 16.35519 24.68467 28.95653 29.97401 30.07714 30.15629 30.35971 30.58793
[9] 30.71100 30.74276 31.42565 32.96467 34.48910 35.33601 35.51890 35.52034
[17] 35.65505 35.90628 36.07084 36.08139 36.16818 36.56324 37.16527 37.64820
[25] 37.83954
> ## try the other methods too
>
> ar(ts.union(BJsales, BJsales.lead))
Call:
ar(x = ts.union(BJsales, BJsales.lead))
$ar
, , 1
BJsales BJsales.lead
BJsales 0.9499 0.8222
BJsales.lead 0.0276 0.4970
, , 2
BJsales BJsales.lead
BJsales 0.02041 -1.1335
BJsales.lead -0.02193 0.2940
, , 3
BJsales BJsales.lead
BJsales -0.186490 3.9415
BJsales.lead -0.002946 0.1264
$var.pred
BJsales BJsales.lead
BJsales 13.9431 0.7733
BJsales.lead 0.7733 0.1231
> ## Burg is quite different here, as is OLS (see ar.ols)
> ar(ts.union(BJsales, BJsales.lead), method="burg")
Call:
ar(x = ts.union(BJsales, BJsales.lead), method = "burg")
$ar
, , 1
BJsales BJsales.lead
BJsales 1.21197 0.07312
BJsales.lead 0.07411 0.45684
, , 2
BJsales BJsales.lead
BJsales -0.26022 -0.1120
BJsales.lead -0.06904 0.3111
, , 3
BJsales BJsales.lead
BJsales -0.01754 3.93591
BJsales.lead 0.01792 0.09632
, , 4
BJsales BJsales.lead
BJsales -0.07746 -1.33836
BJsales.lead -0.01158 -0.09118
$var.pred
BJsales BJsales.lead
BJsales 0.38426 0.01315
BJsales.lead 0.01315 0.07657
>
>
>
> cleanEx()
> nameEx("ar.ols")
> ### * ar.ols
>
> flush(stderr()); flush(stdout())
>
> ### Name: ar.ols
> ### Title: Fit Autoregressive Models to Time Series by OLS
> ### Aliases: ar.ols
> ### Keywords: ts
>
> ### ** Examples
>
> ar(lh, method="burg")
Call:
ar(x = lh, method = "burg")
Coefficients:
1 2 3
0.6588 -0.0608 -0.2234
Order selected 3 sigma^2 estimated as 0.1786
> ar.ols(lh)
Call:
ar.ols(x = lh)
Coefficients:
1
0.586
Intercept: 0.006234 (0.06551)
Order selected 1 sigma^2 estimated as 0.2016
> ar.ols(lh, FALSE, 4) # fit ar(4)
Call:
ar.ols(x = lh, aic = FALSE, order.max = 4)
Coefficients:
1 2 3 4
0.6761 -0.0571 -0.3001 0.0967
Intercept: 0.0004346 (0.06642)
Order selected 4 sigma^2 estimated as 0.1924
>
> ar.ols(ts.union(BJsales, BJsales.lead))
Call:
ar.ols(x = ts.union(BJsales, BJsales.lead))
$ar
, , 1
BJsales BJsales.lead
BJsales 0.40408 -0.05144
BJsales.lead 0.07348 0.54524
, , 2
BJsales BJsales.lead
BJsales 0.2367 0.05899
BJsales.lead -0.1224 0.28690
, , 3
BJsales BJsales.lead
BJsales 0.09673 4.7413
BJsales.lead 0.10469 0.0701
, , 4
BJsales BJsales.lead
BJsales 0.048758 1.5671
BJsales.lead 0.003482 -0.1838
, , 5
BJsales BJsales.lead
BJsales 0.23307 -0.1574
BJsales.lead -0.02707 0.2623
, , 6
BJsales BJsales.lead
BJsales 0.07494 -0.4313
BJsales.lead -0.08729 -0.2166
, , 7
BJsales BJsales.lead
BJsales -0.09946 -0.6233
BJsales.lead 0.27123 -0.2584
, , 8
BJsales BJsales.lead
BJsales 0.06725 -1.36469
BJsales.lead -0.21501 0.06115
, , 9
BJsales BJsales.lead
BJsales -0.11531 -1.4640
BJsales.lead 0.03536 0.2700
, , 10
BJsales BJsales.lead
BJsales -0.002037 -0.6472
BJsales.lead 0.001284 -1.0667
, , 11
BJsales BJsales.lead
BJsales 0.004065 -0.7009
BJsales.lead 0.002098 0.4890
$x.intercept
BJsales BJsales.lead
0.19630 -0.07022
$var.pred
BJsales BJsales.lead
BJsales 0.040100 -0.000931
BJsales.lead -0.000931 0.068214
>
> x <- diff(log(EuStockMarkets))
> ar.ols(x, order.max=6, demean=FALSE, intercept=TRUE)
Call:
ar.ols(x = x, order.max = 6, demean = FALSE, intercept = TRUE)
$ar
, , 1
DAX SMI CAC FTSE
DAX 0.004560 -0.095781 0.039975 0.04856
SMI -0.009204 -0.007142 0.037758 0.06826
CAC -0.026624 -0.113688 0.063807 0.09154
FTSE -0.010299 -0.089246 -0.003195 0.16409
$x.intercept
DAX SMI CAC FTSE
0.0006941 0.0007813 0.0004866 0.0004388
$var.pred
DAX SMI CAC FTSE
DAX 1.056e-04 6.683e-05 8.274e-05 5.192e-05
SMI 6.683e-05 8.496e-05 6.252e-05 4.254e-05
CAC 8.274e-05 6.252e-05 1.207e-04 5.615e-05
FTSE 5.192e-05 4.254e-05 5.615e-05 6.224e-05
>
>
>
> cleanEx()
> nameEx("arima")
> ### * arima
>
> flush(stderr()); flush(stdout())
>
> ### Name: arima
> ### Title: ARIMA Modelling of Time Series
> ### Aliases: arima
> ### Keywords: ts
>
> ### ** Examples
>
> arima(lh, order = c(1,0,0))
Call:
arima(x = lh, order = c(1, 0, 0))
Coefficients:
ar1 intercept
0.5739 2.4133
s.e. 0.1161 0.1466
sigma^2 estimated as 0.1975: log likelihood = -29.38, aic = 64.76
> arima(lh, order = c(3,0,0))
Call:
arima(x = lh, order = c(3, 0, 0))
Coefficients:
ar1 ar2 ar3 intercept
0.6448 -0.0634 -0.2198 2.3931
s.e. 0.1394 0.1668 0.1421 0.0963
sigma^2 estimated as 0.1787: log likelihood = -27.09, aic = 64.18
> arima(lh, order = c(1,0,1))
Call:
arima(x = lh, order = c(1, 0, 1))
Coefficients:
ar1 ma1 intercept
0.4522 0.1982 2.4101
s.e. 0.1769 0.1705 0.1358
sigma^2 estimated as 0.1923: log likelihood = -28.76, aic = 65.52
>
> arima(lh, order = c(3,0,0), method = "CSS")
Call:
arima(x = lh, order = c(3, 0, 0), method = "CSS")
Coefficients:
ar1 ar2 ar3 intercept
0.6578 -0.0658 -0.2348 2.3918
s.e. 0.1414 0.1702 0.1473 0.0983
sigma^2 estimated as 0.1905: part log likelihood = -28.31
>
> arima(USAccDeaths, order = c(0,1,1), seasonal = list(order=c(0,1,1)))
Call:
arima(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1)))
Coefficients:
ma1 sma1
-0.4303 -0.5528
s.e. 0.1228 0.1784
sigma^2 estimated as 99347: log likelihood = -425.44, aic = 856.88
> arima(USAccDeaths, order = c(0,1,1), seasonal = list(order=c(0,1,1)),
+ method = "CSS") # drops first 13 observations.
Call:
arima(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1)),
method = "CSS")
Coefficients:
ma1 sma1
-0.3732 -0.4549
s.e. 0.1366 0.1436
sigma^2 estimated as 110330: part log likelihood = -426.25
> # for a model with as few years as this, we want full ML
>
> arima(LakeHuron, order = c(2,0,0), xreg = time(LakeHuron)-1920)
Call:
arima(x = LakeHuron, order = c(2, 0, 0), xreg = time(LakeHuron) - 1920)
Coefficients:
ar1 ar2 intercept time(LakeHuron) - 1920
1.0048 -0.2913 579.0993 -0.0216
s.e. 0.0976 0.1004 0.2370 0.0081
sigma^2 estimated as 0.4566: log likelihood = -101.2, aic = 212.4
>
> ## presidents contains NAs
> ## graphs in example(acf) suggest order 1 or 3
> require(graphics)
> (fit1 <- arima(presidents, c(1, 0, 0)))
Call:
arima(x = presidents, order = c(1, 0, 0))
Coefficients:
ar1 intercept
0.8242 56.1505
s.e. 0.0555 4.6434
sigma^2 estimated as 85.47: log likelihood = -416.89, aic = 839.78
> tsdiag(fit1)
> (fit3 <- arima(presidents, c(3, 0, 0))) # smaller AIC
Call:
arima(x = presidents, order = c(3, 0, 0))
Coefficients:
ar1 ar2 ar3 intercept
0.7496 0.2523 -0.1890 56.2223
s.e. 0.0936 0.1140 0.0946 4.2845
sigma^2 estimated as 81.12: log likelihood = -414.08, aic = 838.16
> tsdiag(fit3)
>
>
>
> cleanEx()
> nameEx("arima.sim")
> ### * arima.sim
>
> flush(stderr()); flush(stdout())
>
> ### Name: arima.sim
> ### Title: Simulate from an ARIMA Model
> ### Aliases: arima.sim
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> arima.sim(n = 63, list(ar = c(0.8897, -0.4858), ma = c(-0.2279, 0.2488)),
+ sd = sqrt(0.1796))
Time Series:
Start = 1
End = 63
Frequency = 1
[1] 0.55581369 0.24784310 -0.81731397 -0.38489074 -0.23879363 -0.02072454
[7] -0.51659746 -0.52656352 -0.14929470 0.60799345 0.48274167 0.45161036
[13] 0.09619957 -0.67131840 -0.69255089 -0.56224855 -0.19460329 0.53033906
[19] 0.77731208 0.40648891 -0.02697881 0.08101538 0.22706667 -0.10950179
[25] -0.38234788 -0.13676247 0.27995532 0.23211867 0.53580487 0.43571145
[31] -0.07756004 -0.03502284 -0.56957456 0.26261214 1.09213953 0.64829971
[37] -0.15198589 -0.14659775 -0.27894630 0.91394089 0.68582187 0.71550492
[43] 0.24452551 -0.37501019 -0.29768875 -0.94420587 0.11988146 0.29844068
[49] 1.26774646 0.99077203 0.14790214 0.02779843 -0.57682386 -0.90337297
[55] -0.37740926 -0.24511724 0.03927715 0.13868087 -0.15259447 -0.37935616
[61] -0.32790595 0.34491331 -0.30754547
> # mildly long-tailed
> arima.sim(n = 63, list(ar=c(0.8897, -0.4858), ma=c(-0.2279, 0.2488)),
+ rand.gen = function(n, ...) sqrt(0.1796) * rt(n, df = 5))
Time Series:
Start = 1
End = 63
Frequency = 1
[1] -0.08082626 -0.37591270 -1.05660766 -0.99223818 -0.15203570 -0.06140229
[7] -0.55850504 -0.54699388 -0.72097968 -0.98045782 -0.80880880 -0.61218117
[13] -0.66268962 -0.29302831 -0.83022588 -0.08803565 -0.37932453 0.10532583
[19] 0.08033262 -0.29269089 -0.69193389 0.81677316 -0.25402283 -0.08812259
[25] -0.34117757 0.29026867 -0.54848673 -0.44974248 -0.34110520 -0.17826306
[31] -0.35396760 0.98465366 0.21136827 0.05042017 -0.02400316 -0.42642295
[37] -0.61906692 1.92955621 -0.36050863 -0.68488280 0.10141464 0.64328982
[43] 0.31906603 0.17275054 -0.13570368 -0.13451166 -0.11717037 0.02330814
[49] 0.29918521 0.05938999 -0.20355761 -0.02439309 -1.14548572 -0.94045141
[55] 0.44845239 1.76898773 1.78579981 1.16734413 0.33858833 -0.41153063
[61] -0.31037109 -0.31929663 0.17496536
>
> # An ARIMA simulation
> ts.sim <- arima.sim(list(order = c(1,1,0), ar = 0.7), n = 200)
> ts.plot(ts.sim)
>
>
>
> cleanEx()
> nameEx("arima0")
> ### * arima0
>
> flush(stderr()); flush(stdout())
>
> ### Name: arima0
> ### Title: ARIMA Modelling of Time Series - Preliminary Version
> ### Aliases: arima0 print.arima0 predict.arima0
> ### Keywords: ts
>
> ### ** Examples
>
> ## Not run: arima0(lh, order = c(1,0,0))
> arima0(lh, order = c(3,0,0))
Call:
arima0(x = lh, order = c(3, 0, 0))
Coefficients:
ar1 ar2 ar3 intercept
0.6448 -0.0634 -0.2198 2.3931
s.e. 0.1394 0.1668 0.1421 0.0963
sigma^2 estimated as 0.1787: log likelihood = -27.09, aic = 64.18
> arima0(lh, order = c(1,0,1))
Call:
arima0(x = lh, order = c(1, 0, 1))
Coefficients:
ar1 ma1 intercept
0.4521 0.1983 2.4101
s.e. 0.1357 0.1777 0.1357
sigma^2 estimated as 0.1923: log likelihood = -28.76, aic = 65.52
> predict(arima0(lh, order = c(3,0,0)), n.ahead = 12)
$pred
Time Series:
Start = 49
End = 60
Frequency = 1
[1] 2.460173 2.270829 2.198597 2.260696 2.346933 2.414479 2.438918 2.431440
[9] 2.410223 2.391645 2.382653 2.382697
$se
Time Series:
Start = 49
End = 60
Frequency = 1
[1] 0.4226823 0.5029332 0.5245256 0.5247161 0.5305499 0.5369159 0.5388045
[8] 0.5388448 0.5391043 0.5395174 0.5396991 0.5397140
>
> arima0(lh, order = c(3,0,0), method = "CSS")
Call:
arima0(x = lh, order = c(3, 0, 0), method = "CSS")
Coefficients:
ar1 ar2 ar3 intercept
0.6580 -0.0660 -0.2339 2.3999
s.e. 0.1414 0.1702 0.1469 0.0981
sigma^2 estimated as 0.1905: part log likelihood = -28.31
>
> # for a model with as few years as this, we want full ML
> (fit <- arima0(USAccDeaths, order = c(0,1,1),
+ seasonal = list(order=c(0,1,1)), delta = -1))
Call:
arima0(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1,
1)), delta = -1)
Coefficients:
ma1 sma1
-0.4304 -0.5526
s.e. 0.1228 0.1785
sigma^2 estimated as 99355: log likelihood = -425.44, aic = 856.88
> predict(fit, n.ahead = 6)
$pred
Jan Feb Mar Apr May Jun
1979 8336.028 7531.760 8314.593 8616.864 9488.916 9859.727
$se
Jan Feb Mar Apr May Jun
1979 315.4607 362.9949 404.9878 443.0180 478.0322 510.6511
>
> arima0(LakeHuron, order = c(2,0,0), xreg = time(LakeHuron)-1920)
Call:
arima0(x = LakeHuron, order = c(2, 0, 0), xreg = time(LakeHuron) - 1920)
Coefficients:
ar1 ar2 intercept xreg
1.0048 -0.2913 579.0985 -0.0216
s.e. 0.0976 0.1004 0.2370 0.0081
sigma^2 estimated as 0.4566: log likelihood = -101.2, aic = 212.4
> ## Not run:
> ##D ## presidents contains NAs
> ##D ## graphs in example(acf) suggest order 1 or 3
> ##D (fit1 <- arima0(presidents, c(1, 0, 0), delta = -1)) # avoid warning
> ##D tsdiag(fit1)
> ##D (fit3 <- arima0(presidents, c(3, 0, 0), delta = -1)) # smaller AIC
> ##D tsdiag(fit3)
> ## End(Not run)
>
>
>
> cleanEx()
> nameEx("as.hclust")
> ### * as.hclust
>
> flush(stderr()); flush(stdout())
>
> ### Name: as.hclust
> ### Title: Convert Objects to Class hclust
> ### Aliases: as.hclust as.hclust.default as.hclust.twins
> ### Keywords: multivariate cluster
>
> ### ** Examples
>
> x <- matrix(rnorm(30), ncol=3)
> hc <- hclust(dist(x), method="complete")
>
> if(require(cluster, quietly=TRUE)) {# is a recommended package
+ ag <- agnes(x, method="complete")
+ hcag <- as.hclust(ag)
+ ## The dendrograms order slightly differently:
+ op <- par(mfrow=c(1,2))
+ plot(hc) ; mtext("hclust", side=1)
+ plot(hcag); mtext("agnes", side=1)
+ }
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
detaching ‘package:cluster’
> nameEx("asOneSidedFormula")
> ### * asOneSidedFormula
>
> flush(stderr()); flush(stdout())
>
> ### Name: asOneSidedFormula
> ### Title: Convert to One-Sided Formula
> ### Aliases: asOneSidedFormula
> ### Keywords: models
>
> ### ** Examples
>
> asOneSidedFormula("age")
~age
<environment: 0x2e9b760>
> asOneSidedFormula(~ age)
~age
>
>
>
> cleanEx()
> nameEx("ave")
> ### * ave
>
> flush(stderr()); flush(stdout())
>
> ### Name: ave
> ### Title: Group Averages Over Level Combinations of Factors
> ### Aliases: ave
> ### Keywords: univar
>
> ### ** Examples
>
> require(graphics)
>
> ave(1:3)# no grouping -> grand mean
[1] 2 2 2
>
> attach(warpbreaks)
> ave(breaks, wool)
[1] 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704
[9] 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704
[17] 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704 31.03704
[25] 31.03704 31.03704 31.03704 25.25926 25.25926 25.25926 25.25926 25.25926
[33] 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926
[41] 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926
[49] 25.25926 25.25926 25.25926 25.25926 25.25926 25.25926
> ave(breaks, tension)
[1] 36.38889 36.38889 36.38889 36.38889 36.38889 36.38889 36.38889 36.38889
[9] 36.38889 26.38889 26.38889 26.38889 26.38889 26.38889 26.38889 26.38889
[17] 26.38889 26.38889 21.66667 21.66667 21.66667 21.66667 21.66667 21.66667
[25] 21.66667 21.66667 21.66667 36.38889 36.38889 36.38889 36.38889 36.38889
[33] 36.38889 36.38889 36.38889 36.38889 26.38889 26.38889 26.38889 26.38889
[41] 26.38889 26.38889 26.38889 26.38889 26.38889 21.66667 21.66667 21.66667
[49] 21.66667 21.66667 21.66667 21.66667 21.66667 21.66667
> ave(breaks, tension, FUN = function(x)mean(x, trim=.1))
[1] 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875
[10] 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125
[19] 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625
[28] 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875 35.6875
[37] 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125 26.3125
[46] 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625 21.0625
> plot(breaks, main =
+ "ave( Warpbreaks ) for wool x tension combinations")
> lines(ave(breaks, wool, tension ), type='s', col = "blue")
> lines(ave(breaks, wool, tension, FUN=median), type='s', col = "green")
> legend(40,70, c("mean","median"), lty=1,col=c("blue","green"), bg="gray90")
> detach()
>
>
>
> cleanEx()
> nameEx("bandwidth")
> ### * bandwidth
>
> flush(stderr()); flush(stdout())
>
> ### Name: bandwidth
> ### Title: Bandwidth Selectors for Kernel Density Estimation
> ### Aliases: bw.nrd0 bw.nrd bw.ucv bw.bcv bw.SJ
> ### Keywords: distribution smooth
>
> ### ** Examples
>
> require(graphics)
>
> plot(density(precip, n = 1000))
> rug(precip)
> lines(density(precip, bw="nrd"), col = 2)
> lines(density(precip, bw="ucv"), col = 3)
> lines(density(precip, bw="bcv"), col = 4)
Warning in bw.bcv(x) : minimum occurred at one end of the range
> lines(density(precip, bw="SJ-ste"), col = 5)
> lines(density(precip, bw="SJ-dpi"), col = 6)
> legend(55, 0.035,
+ legend = c("nrd0", "nrd", "ucv", "bcv", "SJ-ste", "SJ-dpi"),
+ col = 1:6, lty = 1)
>
>
>
> cleanEx()
> nameEx("bartlett.test")
> ### * bartlett.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: bartlett.test
> ### Title: Bartlett Test of Homogeneity of Variances
> ### Aliases: bartlett.test bartlett.test.default bartlett.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> require(graphics)
>
> plot(count ~ spray, data = InsectSprays)
> bartlett.test(InsectSprays$count, InsectSprays$spray)
Bartlett test of homogeneity of variances
data: InsectSprays$count and InsectSprays$spray
Bartlett's K-squared = 25.9598, df = 5, p-value = 9.085e-05
> bartlett.test(count ~ spray, data = InsectSprays)
Bartlett test of homogeneity of variances
data: count by spray
Bartlett's K-squared = 25.9598, df = 5, p-value = 9.085e-05
>
>
>
> cleanEx()
> nameEx("binom.test")
> ### * binom.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: binom.test
> ### Title: Exact Binomial Test
> ### Aliases: binom.test
> ### Keywords: htest
>
> ### ** Examples
>
> ## Conover (1971), p. 97f.
> ## Under (the assumption of) simple Mendelian inheritance, a cross
> ## between plants of two particular genotypes produces progeny 1/4 of
> ## which are "dwarf" and 3/4 of which are "giant", respectively.
> ## In an experiment to determine if this assumption is reasonable, a
> ## cross results in progeny having 243 dwarf and 682 giant plants.
> ## If "giant" is taken as success, the null hypothesis is that p =
> ## 3/4 and the alternative that p != 3/4.
> binom.test(c(682, 243), p = 3/4)
Exact binomial test
data: c(682, 243)
number of successes = 682, number of trials = 925, p-value = 0.3825
alternative hypothesis: true probability of success is not equal to 0.75
95 percent confidence interval:
0.7076683 0.7654066
sample estimates:
probability of success
0.7372973
> binom.test(682, 682 + 243, p = 3/4) # The same.
Exact binomial test
data: 682 and 682 + 243
number of successes = 682, number of trials = 925, p-value = 0.3825
alternative hypothesis: true probability of success is not equal to 0.75
95 percent confidence interval:
0.7076683 0.7654066
sample estimates:
probability of success
0.7372973
> ## => Data are in agreement with the null hypothesis.
>
>
>
> cleanEx()
> nameEx("biplot.princomp")
> ### * biplot.princomp
>
> flush(stderr()); flush(stdout())
>
> ### Name: biplot.princomp
> ### Title: Biplot for Principal Components
> ### Aliases: biplot.princomp biplot.prcomp
> ### Keywords: multivariate hplot
>
> ### ** Examples
>
> require(graphics)
> biplot(princomp(USArrests))
>
>
>
> cleanEx()
> nameEx("birthday")
> ### * birthday
>
> flush(stderr()); flush(stdout())
>
> ### Name: birthday
> ### Title: Probability of coincidences
> ### Aliases: qbirthday pbirthday
> ### Keywords: distribution
>
> ### ** Examples
>
> require(graphics)
>
> ## the standard version
> qbirthday()
[1] 22
> ## same 4-digit PIN number
> qbirthday(classes=10^4)
[1] 118
> ## 0.9 probability of three coincident birthdays
> qbirthday(coincident=3, prob=0.9)
[1] 123
> ## Chance of 4 coincident birthdays in 150 people
> pbirthday(150,coincident=4)
[1] 0.351437
> ## 100 coincident birthdays in 1000 people: *very* rare:
> pbirthday(1000, coincident=100)
[1] 2.395639e-112
>
> ## Accuracy compared to exact calculation
> x1<- sapply(10:100, pbirthday)
> x2<- 1-sapply(10:100, function(n)prod((365:(365-n+1))/rep(365,n)))
> par(mfrow=c(2,2))
> plot(x1, x2, xlab="approximate", ylab="exact")
> abline(0,1)
> plot(x1, x1-x2, xlab="approximate", ylab="error")
> abline(h=0)
> plot(x1, x2, log="xy", xlab="approximate", ylab="exact")
> abline(0,1)
> plot(1-x1, 1-x2, log="xy", xlab="approximate", ylab="exact")
> abline(0,1)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("box.test")
> ### * box.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: Box.test
> ### Title: Box-Pierce and Ljung-Box Tests
> ### Aliases: Box.test
> ### Keywords: ts
>
> ### ** Examples
>
> x <- rnorm (100)
> Box.test (x, lag = 1)
Box-Pierce test
data: x
X-squared = 0.0013, df = 1, p-value = 0.9709
> Box.test (x, lag = 1, type="Ljung")
Box-Ljung test
data: x
X-squared = 0.0014, df = 1, p-value = 0.9704
>
>
>
> cleanEx()
> nameEx("cancor")
> ### * cancor
>
> flush(stderr()); flush(stdout())
>
> ### Name: cancor
> ### Title: Canonical Correlations
> ### Aliases: cancor
> ### Keywords: multivariate
>
> ### ** Examples
>
> pop <- LifeCycleSavings[, 2:3]
> oec <- LifeCycleSavings[, -(2:3)]
> cancor(pop, oec)
$cor
[1] 0.8247966 0.3652762
$xcoef
[,1] [,2]
pop15 -0.009110856 -0.03622206
pop75 0.048647514 -0.26031158
$ycoef
[,1] [,2] [,3]
sr 0.0084710221 3.337936e-02 -5.157130e-03
dpi 0.0001307398 -7.588232e-05 4.543705e-06
ddpi 0.0041706000 -1.226790e-02 5.188324e-02
$xcenter
pop15 pop75
35.0896 2.2930
$ycenter
sr dpi ddpi
9.6710 1106.7584 3.7576
>
> x <- matrix(rnorm(150), 50, 3)
> y <- matrix(rnorm(250), 50, 5)
> (cxy <- cancor(x, y))
$cor
[1] 0.53321740 0.30144642 0.08007852
$xcoef
[,1] [,2] [,3]
[1,] -0.14296261 -0.03120270 0.09043770
[2,] -0.03267124 -0.11856663 -0.08155261
[3,] 0.08664746 -0.09026474 0.09783821
$ycoef
[,1] [,2] [,3] [,4] [,5]
[1,] 0.12013347 -0.03407745 0.0074025558 0.029420699 0.07196163
[2,] 0.02860290 -0.04412619 0.0928961072 -0.078303079 -0.02326130
[3,] 0.05802770 -0.04186854 0.0001008608 0.100341655 -0.09037243
[4,] -0.07631922 -0.01011231 0.0700839527 0.105665448 0.03633470
[5,] 0.05199046 0.12587293 0.0423486329 -0.004856735 -0.01739531
$xcenter
[1] 0.1004483 0.1173265 -0.1524854
$ycenter
[1] 0.076869287 -0.031311697 0.090658767 0.109468516 -0.006264799
> all(abs(cor(x %*% cxy$xcoef,
+ y %*% cxy$ycoef)[,1:3] - diag(cxy $ cor)) < 1e-15)
[1] TRUE
> all(abs(cor(x %*% cxy$xcoef) - diag(3)) < 1e-15)
[1] TRUE
> all(abs(cor(y %*% cxy$ycoef) - diag(5)) < 1e-15)
[1] TRUE
>
>
>
> cleanEx()
> nameEx("case.names")
> ### * case.names
>
> flush(stderr()); flush(stdout())
>
> ### Name: case/variable.names
> ### Title: Case and Variable Names of Fitted Models
> ### Aliases: case.names case.names.lm variable.names variable.names.lm
> ### Keywords: regression models
>
> ### ** Examples
>
> x <- 1:20
> y <- x + (x/4 - 2)^3 + rnorm(20, sd=3)
> names(y) <- paste("O",x,sep=".")
> ww <- rep(1,20); ww[13] <- 0
> summary(lmxy <- lm(y ~ x + I(x^2)+I(x^3) + I((x-10)^2),
+ weights = ww), cor = TRUE)
Call:
lm(formula = y ~ x + I(x^2) + I(x^3) + I((x - 10)^2), weights = ww)
Residuals:
Min 1Q Median 3Q Max
-6.7160 -0.7047 0.0728 1.0174 3.9947
Coefficients: (1 not defined because of singularities)
Estimate Std. Error t value Pr(>|t|)
(Intercept) -10.967768 3.104498 -3.533 0.003013 **
x 5.524412 1.255354 4.401 0.000516 ***
I(x^2) -0.542292 0.138460 -3.917 0.001374 **
I(x^3) 0.020905 0.004372 4.782 0.000242 ***
I((x - 10)^2) NA NA NA NA
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 2.838 on 15 degrees of freedom
Multiple R-squared: 0.9702, Adjusted R-squared: 0.9643
F-statistic: 163 on 3 and 15 DF, p-value: 1.14e-11
Correlation of Coefficients:
(Intercept) x I(x^2)
x -0.90
I(x^2) 0.80 -0.97
I(x^3) -0.73 0.93 -0.99
> variable.names(lmxy)
[1] "(Intercept)" "x" "I(x^2)" "I(x^3)"
> variable.names(lmxy, full= TRUE)# includes the last
[1] "(Intercept)" "x" "I(x^2)" "I(x^3)"
[5] "I((x - 10)^2)"
> case.names(lmxy)
[1] "O.1" "O.2" "O.3" "O.4" "O.5" "O.6" "O.7" "O.8" "O.9" "O.10"
[11] "O.11" "O.12" "O.14" "O.15" "O.16" "O.17" "O.18" "O.19" "O.20"
> case.names(lmxy, full = TRUE)# includes the 0-weight case
[1] "O.1" "O.2" "O.3" "O.4" "O.5" "O.6" "O.7" "O.8" "O.9" "O.10"
[11] "O.11" "O.12" "O.13" "O.14" "O.15" "O.16" "O.17" "O.18" "O.19" "O.20"
>
>
>
> cleanEx()
> nameEx("chisq.test")
> ### * chisq.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: chisq.test
> ### Title: Pearson's Chi-squared Test for Count Data
> ### Aliases: chisq.test
> ### Keywords: htest distribution
>
> ### ** Examples
>
> ## Not really a good example
> chisq.test(InsectSprays$count > 7, InsectSprays$spray)
Pearson's Chi-squared test
data: InsectSprays$count > 7 and InsectSprays$spray
X-squared = 60.9915, df = 5, p-value = 7.582e-12
> # Prints test summary
> chisq.test(InsectSprays$count > 7, InsectSprays$spray)$observed
InsectSprays$spray
InsectSprays$count > 7 A B C D E F
FALSE 1 1 12 11 12 0
TRUE 11 11 0 1 0 12
> # Counts observed
> chisq.test(InsectSprays$count > 7, InsectSprays$spray)$expected
InsectSprays$spray
InsectSprays$count > 7 A B C D E F
FALSE 6.166667 6.166667 6.166667 6.166667 6.166667 6.166667
TRUE 5.833333 5.833333 5.833333 5.833333 5.833333 5.833333
> # Counts expected under the null
>
> ## Effect of simulating p-values
> x <- matrix(c(12, 5, 7, 7), ncol = 2)
> chisq.test(x)$p.value # 0.4233
[1] 0.4233054
> chisq.test(x, simulate.p.value = TRUE, B = 10000)$p.value
[1] 0.2935706
> # around 0.29!
>
> ## Testing for population probabilities
> ## Case A. Tabulated data
> x <- c(A = 20, B = 15, C = 25)
> chisq.test(x)
Chi-squared test for given probabilities
data: x
X-squared = 2.5, df = 2, p-value = 0.2865
> chisq.test(as.table(x)) # the same
Chi-squared test for given probabilities
data: as.table(x)
X-squared = 2.5, df = 2, p-value = 0.2865
> x <- c(89,37,30,28,2)
> p <- c(40,20,20,15,5)
> try(
+ chisq.test(x, p = p) # gives an error
+ )
Error in chisq.test(x, p = p) : probabilities must sum to 1.
> chisq.test(x, p = p, rescale.p = TRUE)
Chi-squared test for given probabilities
data: x
X-squared = 9.9901, df = 4, p-value = 0.04059
> # works
> p <- c(0.40,0.20,0.20,0.19,0.01)
> # Expected count in category 5
> # is 1.86 < 5 ==> chi square approx.
> chisq.test(x, p = p) # maybe doubtful, but is ok!
Warning in chisq.test(x, p = p) :
Chi-squared approximation may be incorrect
Chi-squared test for given probabilities
data: x
X-squared = 5.7947, df = 4, p-value = 0.215
> chisq.test(x, p = p, simulate.p.value = TRUE)
Chi-squared test for given probabilities with simulated p-value (based
on 2000 replicates)
data: x
X-squared = 5.7947, df = NA, p-value = 0.2029
>
> ## Case B. Raw data
> x <- trunc(5 * runif(100))
> chisq.test(table(x)) # NOT 'chisq.test(x)'!
Chi-squared test for given probabilities
data: table(x)
X-squared = 4.3, df = 4, p-value = 0.3669
>
>
>
> cleanEx()
> nameEx("cmdscale")
> ### * cmdscale
>
> flush(stderr()); flush(stdout())
>
> ### Name: cmdscale
> ### Title: Classical (Metric) Multidimensional Scaling
> ### Aliases: cmdscale
> ### Keywords: multivariate
>
> ### ** Examples
>
> require(graphics)
>
> loc <- cmdscale(eurodist)
> x <- loc[,1]
> y <- -loc[,2]
> plot(x, y, type="n", xlab="", ylab="", main="cmdscale(eurodist)")
> text(x, y, rownames(loc), cex=0.8)
>
> cmdsE <- cmdscale(eurodist, k=20, add = TRUE, eig = TRUE, x.ret = TRUE)
>
>
>
> cleanEx()
> nameEx("coef")
> ### * coef
>
> flush(stderr()); flush(stdout())
>
> ### Name: coef
> ### Title: Extract Model Coefficients
> ### Aliases: coef coefficients
> ### Keywords: regression models
>
> ### ** Examples
>
> x <- 1:5; coef(lm(c(1:3,7,6) ~ x))
(Intercept) x
-0.7 1.5
>
>
>
> cleanEx()
> nameEx("complete.cases")
> ### * complete.cases
>
> flush(stderr()); flush(stdout())
>
> ### Name: complete.cases
> ### Title: Find Complete Cases
> ### Aliases: complete.cases
> ### Keywords: NA logic
>
> ### ** Examples
>
> x <- airquality[, -1] # x is a regression design matrix
> y <- airquality[, 1] # y is the corresponding response
>
> stopifnot(complete.cases(y) != is.na(y))
> ok <- complete.cases(x,y)
> sum(!ok) # how many are not "ok" ?
[1] 42
> x <- x[ok,]
> y <- y[ok]
>
>
>
> cleanEx()
> nameEx("confint")
> ### * confint
>
> flush(stderr()); flush(stdout())
>
> ### Name: confint
> ### Title: Confidence Intervals for Model Parameters
> ### Aliases: confint confint.default
> ### Keywords: models
>
> ### ** Examples
>
> fit <- lm(100/mpg ~ disp + hp + wt + am, data=mtcars)
> confint(fit)
2.5 % 97.5 %
(Intercept) -0.774822875 2.256118188
disp -0.002867999 0.008273849
hp -0.001400580 0.011949674
wt 0.380088737 1.622517536
am -0.614677730 0.926307310
> confint(fit, "wt")
2.5 % 97.5 %
wt 0.3800887 1.622518
>
> ## from example(glm) (needs MASS to be present on the system)
> counts <- c(18,17,15,20,10,20,25,13,12)
> outcome <- gl(3,1,9); treatment <- gl(3,3)
> glm.D93 <- glm(counts ~ outcome + treatment, family=poisson())
> confint(glm.D93)
Waiting for profiling to be done...
2.5 % 97.5 %
(Intercept) 2.6958215 3.3665558
outcome2 -0.8577018 -0.0625584
outcome3 -0.6753696 0.0824409
treatment2 -0.3932548 0.3932548
treatment3 -0.3932548 0.3932548
> confint.default(glm.D93) # based on asymptotic normality
2.5 % 97.5 %
(Intercept) 2.7095672 3.37947764
outcome2 -0.8505027 -0.05800787
outcome3 -0.6707552 0.08478093
treatment2 -0.3919928 0.39199279
treatment3 -0.3919928 0.39199279
>
>
>
> cleanEx()
> nameEx("constrOptim")
> ### * constrOptim
>
> flush(stderr()); flush(stdout())
>
> ### Name: constrOptim
> ### Title: Linearly Constrained Optimization
> ### Aliases: constrOptim
> ### Keywords: optimize
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits=5)
> ## End Don't show
> ## from optim
> fr <- function(x) { ## Rosenbrock Banana function
+ x1 <- x[1]
+ x2 <- x[2]
+ 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
+ }
> grr <- function(x) { ## Gradient of 'fr'
+ x1 <- x[1]
+ x2 <- x[2]
+ c(-400 * x1 * (x2 - x1 * x1) - 2 * (1 - x1),
+ 200 * (x2 - x1 * x1))
+ }
>
> optim(c(-1.2,1), fr, grr)
$par
[1] 1.0003 1.0005
$value
[1] 8.8252e-08
$counts
function gradient
195 NA
$convergence
[1] 0
$message
NULL
> #Box-constraint, optimum on the boundary
> constrOptim(c(-1.2,0.9), fr, grr, ui=rbind(c(-1,0),c(0,-1)), ci=c(-1,-1))
$par
[1] 0.99998 0.99995
$value
[1] 5.7341e-10
$counts
function gradient
297 94
$convergence
[1] 0
$message
NULL
$outer.iterations
[1] 12
$barrier.value
[1] -0.00019992
> # x<=0.9, y-x>0.1
> constrOptim(c(.5,0), fr, grr, ui=rbind(c(-1,0),c(1,-1)), ci=c(-0.9,0.1))
$par
[1] 0.88913 0.78913
$value
[1] 0.012494
$counts
function gradient
254 48
$convergence
[1] 0
$message
NULL
$outer.iterations
[1] 4
$barrier.value
[1] -7.4e-05
>
>
> ## Solves linear and quadratic programming problems
> ## but needs a feasible starting value
> #
> # from example(solve.QP) in 'quadprog'
> # no derivative
> fQP <- function(b) {-sum(c(0,5,0)*b)+0.5*sum(b*b)}
> Amat <- matrix(c(-4,-3,0,2,1,0,0,-2,1),3,3)
> bvec <- c(-8,2,0)
> constrOptim(c(2,-1,-1), fQP, NULL, ui=t(Amat),ci=bvec)
$par
[1] 0.47614 1.04773 2.09545
$value
[1] -2.3810
$counts
function gradient
510 NA
$convergence
[1] 0
$message
NULL
$outer.iterations
[1] 3
$barrier.value
[1] -0.00062438
> # derivative
> gQP <- function(b) {-c(0,5,0)+b}
> constrOptim(c(2,-1,-1), fQP, gQP, ui=t(Amat), ci=bvec)
$par
[1] 0.47619 1.04762 2.09524
$value
[1] -2.3810
$counts
function gradient
406 81
$convergence
[1] 0
$message
NULL
$outer.iterations
[1] 3
$barrier.value
[1] -0.00062439
>
> ## Now with maximisation instead of minimisation
> hQP <- function(b) {sum(c(0,5,0)*b)-0.5*sum(b*b)}
> constrOptim(c(2,-1,-1), hQP, NULL, ui=t(Amat), ci=bvec,
+ control=list(fnscale=-1))
$par
[1] 0.47614 1.04773 2.09545
$value
[1] 2.3810
$counts
function gradient
510 NA
$convergence
[1] 0
$message
NULL
$outer.iterations
[1] 3
$barrier.value
[1] 0.00062438
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("contrast")
> ### * contrast
>
> flush(stderr()); flush(stdout())
>
> ### Name: contrast
> ### Title: (Possibly Sparse) Contrast Matrices
> ### Aliases: contr.helmert contr.poly contr.sum contr.treatment contr.SAS
> ### Keywords: design regression array
>
> ### ** Examples
>
> (cH <- contr.helmert(4))
[,1] [,2] [,3]
1 -1 -1 -1
2 1 -1 -1
3 0 2 -1
4 0 0 3
> apply(cH, 2,sum) # column sums are 0
[1] 0 0 0
> crossprod(cH) # diagonal -- columns are orthogonal
[,1] [,2] [,3]
[1,] 2 0 0
[2,] 0 6 0
[3,] 0 0 12
> contr.helmert(4, contrasts = FALSE) # just the 4 x 4 identity matrix
1 2 3 4
1 1 0 0 0
2 0 1 0 0
3 0 0 1 0
4 0 0 0 1
>
> (cT <- contr.treatment(5))
2 3 4 5
1 0 0 0 0
2 1 0 0 0
3 0 1 0 0
4 0 0 1 0
5 0 0 0 1
> all(crossprod(cT) == diag(4)) # TRUE: even orthonormal
[1] TRUE
>
> (cT. <- contr.SAS(5))
1 2 3 4
1 1 0 0 0
2 0 1 0 0
3 0 0 1 0
4 0 0 0 1
5 0 0 0 0
> all(crossprod(cT.) == diag(4)) # TRUE
[1] TRUE
>
> zapsmall(cP <- contr.poly(3)) # Linear and Quadratic
.L .Q
[1,] -0.7071068 0.4082483
[2,] 0.0000000 -0.8164966
[3,] 0.7071068 0.4082483
> zapsmall(crossprod(cP), digits=15) # orthonormal up to fuzz
.L .Q
.L 1 0
.Q 0 1
>
>
>
> cleanEx()
> nameEx("contrasts")
> ### * contrasts
>
> flush(stderr()); flush(stdout())
>
> ### Name: contrasts
> ### Title: Get and Set Contrast Matrices
> ### Aliases: contrasts contrasts<-
> ### Keywords: design regression
>
> ### ** Examples
>
> utils::example(factor)
factor> (ff <- factor(substring("statistics", 1:10, 1:10), levels=letters))
[1] s t a t i s t i c s
Levels: a b c d e f g h i j k l m n o p q r s t u v w x y z
factor> as.integer(ff) # the internal codes
[1] 19 20 1 20 9 19 20 9 3 19
factor> factor(ff) # drops the levels that do not occur
[1] s t a t i s t i c s
Levels: a c i s t
factor> ff[, drop=TRUE] # the same, more transparently
[1] s t a t i s t i c s
Levels: a c i s t
factor> factor(letters[1:20], labels="letter")
[1] letter1 letter2 letter3 letter4 letter5 letter6 letter7 letter8
[9] letter9 letter10 letter11 letter12 letter13 letter14 letter15 letter16
[17] letter17 letter18 letter19 letter20
20 Levels: letter1 letter2 letter3 letter4 letter5 letter6 letter7 ... letter20
factor> class(ordered(4:1)) # "ordered", inheriting from "factor"
[1] "ordered" "factor"
factor> ## suppose you want "NA" as a level, and to allow missing values.
factor> (x <- factor(c(1, 2, NA), exclude = NULL))
[1] 1 2 <NA>
Levels: 1 2 <NA>
factor> is.na(x)[2] <- TRUE
factor> x # [1] 1 <NA> <NA>
[1] 1 <NA> <NA>
Levels: 1 2 <NA>
factor> is.na(x)
[1] FALSE TRUE FALSE
factor> # [1] FALSE TRUE FALSE
factor>
factor> ## Using addNA()
factor> Month <- airquality$Month
factor> table(addNA(Month))
5 6 7 8 9 <NA>
31 30 31 31 30 0
factor> table(addNA(Month, ifany=TRUE))
5 6 7 8 9
31 30 31 31 30
> fff <- ff[, drop=TRUE] # reduce to 5 levels.
> contrasts(fff) # treatment contrasts by default
c i s t
a 0 0 0 0
c 1 0 0 0
i 0 1 0 0
s 0 0 1 0
t 0 0 0 1
> contrasts(C(fff, sum))
[,1] [,2] [,3] [,4]
a 1 0 0 0
c 0 1 0 0
i 0 0 1 0
s 0 0 0 1
t -1 -1 -1 -1
> contrasts(fff, contrasts = FALSE) # the 5x5 identity matrix
a c i s t
a 1 0 0 0 0
c 0 1 0 0 0
i 0 0 1 0 0
s 0 0 0 1 0
t 0 0 0 0 1
>
> contrasts(fff) <- contr.sum(5); contrasts(fff) # set sum contrasts
[,1] [,2] [,3] [,4]
a 1 0 0 0
c 0 1 0 0
i 0 0 1 0
s 0 0 0 1
t -1 -1 -1 -1
> contrasts(fff, 2) <- contr.sum(5); contrasts(fff) # set 2 contrasts
[,1] [,2]
a 1 0
c 0 1
i 0 0
s 0 0
t -1 -1
> # supply 2 contrasts, compute 2 more to make full set of 4.
> contrasts(fff) <- contr.sum(5)[,1:2]; contrasts(fff)
[,1] [,2] [,3] [,4]
a 1 0 -0.2471257 0.2688164
c 0 1 -0.2471257 0.2688164
i 0 0 -0.1498721 -0.8817814
s 0 0 0.8912491 0.0753323
t -1 -1 -0.2471257 0.2688164
>
> ## using sparse contrasts: % useful, once model.matrix() works with these :
> ffs <- fff
> contrasts(ffs) <- contr.sum(5, sparse=TRUE)[,1:2]; contrasts(ffs)
[,1] [,2] [,3] [,4]
a 1 0 -0.2471257 0.2688164
c 0 1 -0.2471257 0.2688164
i 0 0 -0.1498721 -0.8817814
s 0 0 0.8912491 0.0753323
t -1 -1 -0.2471257 0.2688164
> stopifnot(all.equal(ffs, fff))
> contrasts(ffs) <- contr.sum(5, sparse=TRUE); contrasts(ffs)
5 x 4 sparse Matrix of class "dgCMatrix"
a 1 . . .
c . 1 . .
i . . 1 .
s . . . 1
t -1 -1 -1 -1
>
>
>
> cleanEx()
> nameEx("convolve")
> ### * convolve
>
> flush(stderr()); flush(stdout())
>
> ### Name: convolve
> ### Title: Convolution of Sequences via FFT
> ### Aliases: convolve
> ### Keywords: math dplot
>
> ### ** Examples
>
> require(graphics)
>
> x <- c(0,0,0,100,0,0,0)
> y <- c(0,0,1, 2 ,1,0,0)/4
> zapsmall(convolve(x,y)) # *NOT* what you first thought.
[1] 50 25 0 0 0 0 25
> zapsmall(convolve(x, y[3:5], type="f")) # rather
[1] 0 25 50 25 0
> x <- rnorm(50)
> y <- rnorm(50)
> # Circular convolution *has* this symmetry:
> all.equal(convolve(x,y, conj = FALSE), rev(convolve(rev(y),x)))
[1] TRUE
>
> n <- length(x <- -20:24)
> y <- (x-10)^2/1000 + rnorm(x)/8
>
> Han <- function(y) # Hanning
+ convolve(y, c(1,2,1)/4, type = "filter")
>
> plot(x,y, main="Using convolve(.) for Hanning filters")
> lines(x[-c(1 , n) ], Han(y), col="red")
> lines(x[-c(1:2, (n-1):n)], Han(Han(y)), lwd=2, col="dark blue")
>
>
>
> cleanEx()
> nameEx("cophenetic")
> ### * cophenetic
>
> flush(stderr()); flush(stdout())
>
> ### Name: cophenetic
> ### Title: Cophenetic Distances for a Hierarchical Clustering
> ### Aliases: cophenetic cophenetic.default cophenetic.dendrogram
> ### Keywords: cluster multivariate
>
> ### ** Examples
>
> require(graphics)
>
> d1 <- dist(USArrests)
> hc <- hclust(d1, "ave")
> d2 <- cophenetic(hc)
> cor(d1,d2) # 0.7659
[1] 0.7658983
>
> ## Example from Sneath & Sokal, Fig. 5-29, p.279
> d0 <- c(1,3.8,4.4,5.1, 4,4.2,5, 2.6,5.3, 5.4)
> attributes(d0) <- list(Size = 5, diag=TRUE)
> class(d0) <- "dist"
> names(d0) <- letters[1:5]
> d0
1 2 3 4
2 1.0
3 3.8 4.0
4 4.4 4.2 2.6
5 5.1 5.0 5.3 5.4
> utils::str(upgma <- hclust(d0, method = "average"))
List of 7
$ merge : int [1:4, 1:2] -1 -3 1 -5 -2 -4 2 3
$ height : num [1:4] 1 2.6 4.1 5.2
$ order : int [1:5] 5 1 2 3 4
$ labels : NULL
$ method : chr "average"
$ call : language hclust(d = d0, method = "average")
$ dist.method: NULL
- attr(*, "class")= chr "hclust"
> plot(upgma, hang = -1)
> #
> (d.coph <- cophenetic(upgma))
1 2 3 4
2 1.0
3 4.1 4.1
4 4.1 4.1 2.6
5 5.2 5.2 5.2 5.2
> cor(d0, d.coph) # 0.9911
[1] 0.9911351
>
>
>
> cleanEx()
> nameEx("cor")
> ### * cor
>
> flush(stderr()); flush(stdout())
>
> ### Name: cor
> ### Title: Correlation, Variance and Covariance (Matrices)
> ### Aliases: var cov cor cov2cor
> ### Keywords: univar multivariate array
>
> ### ** Examples
>
> var(1:10)# 9.166667
[1] 9.166667
>
> var(1:5,1:5)# 2.5
[1] 2.5
>
> ## Two simple vectors
> cor(1:10,2:11)# == 1
[1] 1
>
> ## Correlation Matrix of Multivariate sample:
> (Cl <- cor(longley))
GNP.deflator GNP Unemployed Armed.Forces Population
GNP.deflator 1.0000000 0.9915892 0.6206334 0.4647442 0.9791634
GNP 0.9915892 1.0000000 0.6042609 0.4464368 0.9910901
Unemployed 0.6206334 0.6042609 1.0000000 -0.1774206 0.6865515
Armed.Forces 0.4647442 0.4464368 -0.1774206 1.0000000 0.3644163
Population 0.9791634 0.9910901 0.6865515 0.3644163 1.0000000
Year 0.9911492 0.9952735 0.6682566 0.4172451 0.9939528
Employed 0.9708985 0.9835516 0.5024981 0.4573074 0.9603906
Year Employed
GNP.deflator 0.9911492 0.9708985
GNP 0.9952735 0.9835516
Unemployed 0.6682566 0.5024981
Armed.Forces 0.4172451 0.4573074
Population 0.9939528 0.9603906
Year 1.0000000 0.9713295
Employed 0.9713295 1.0000000
> ## Graphical Correlation Matrix:
> symnum(Cl) # highly correlated
GNP. GNP U A P Y E
GNP.deflator 1
GNP B 1
Unemployed , , 1
Armed.Forces . . 1
Population B B , . 1
Year B B , . B 1
Employed B B . . B B 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
>
> ## Spearman's rho and Kendall's tau
> symnum(clS <- cor(longley, method = "spearman"))
GNP. GNP U A P Y E
GNP.deflator 1
GNP B 1
Unemployed , , 1
Armed.Forces . 1
Population B B , 1
Year B B , 1 1
Employed B B . B B 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(clK <- cor(longley, method = "kendall"))
GNP. GNP U A P Y E
GNP.deflator 1
GNP B 1
Unemployed . . 1
Armed.Forces 1
Population B B . 1
Year B B . 1 1
Employed * * . + + 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> ## How much do they differ?
> i <- lower.tri(Cl)
> cor(cbind(P = Cl[i], S = clS[i], K = clK[i]))
P S K
P 1.0000000 0.980239 0.9572562
S 0.9802390 1.000000 0.9742171
K 0.9572562 0.974217 1.0000000
>
>
> ## cov2cor() scales a covariance matrix by its diagonal
> ## to become the correlation matrix.
> cov2cor # see the function definition {and learn ..}
function (V)
{
p <- (d <- dim(V))[1L]
if (!is.numeric(V) || length(d) != 2L || p != d[2L])
stop("'V' is not a square numeric matrix")
Is <- sqrt(1/diag(V))
if (any(!is.finite(Is)))
warning("diag(.) had 0 or NA entries; non-finite result is doubtful")
r <- V
r[] <- Is * V * rep(Is, each = p)
r[cbind(1L:p, 1L:p)] <- 1
r
}
<environment: namespace:stats>
> stopifnot(all.equal(Cl, cov2cor(cov(longley))),
+ all.equal(cor(longley, method="kendall"),
+ cov2cor(cov(longley, method="kendall"))))
>
> ##--- Missing value treatment:
> C1 <- cov(swiss)
> range(eigen(C1, only.values=TRUE)$values) # 6.19 1921
[1] 6.191249 1921.562488
> swM <- swiss
> swM[1,2] <- swM[7,3] <- swM[25,5] <- NA # create 3 "missing"
> try(cov(swM)) # Error: missing obs...
Fertility Agriculture Examination Education Catholic
Fertility 156.04250 NA NA -79.729510 NA
Agriculture NA NA NA NA NA
Examination NA NA NA NA NA
Education -79.72951 NA NA 92.456059 NA
Catholic NA NA NA NA NA
Infant.Mortality 15.15619 NA NA -2.781684 NA
Infant.Mortality
Fertility 15.156193
Agriculture NA
Examination NA
Education -2.781684
Catholic NA
Infant.Mortality 8.483802
> C2 <- cov(swM, use = "complete")
> range(eigen(C2, only.values=TRUE)$values) # 6.46 1930
[1] 6.462385 1930.505982
> C3 <- cov(swM, use = "pairwise")
> range(eigen(C3, only.values=TRUE)$values) # 6.19 1938
[1] 6.194469 1938.033663
>
> symnum(cor(swM, method = "kendall", use = "complete"))
F A Ex Ed C I
Fertility 1
Agriculture 1
Examination . . 1
Education . . . 1
Catholic . 1
Infant.Mortality 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> ## Kendall's tau doesn't change much:
> symnum(cor(swiss, method = "kendall"))
F A Ex Ed C I
Fertility 1
Agriculture 1
Examination . . 1
Education . . . 1
Catholic . 1
Infant.Mortality . 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
>
>
>
> cleanEx()
> nameEx("cor.test")
> ### * cor.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: cor.test
> ### Title: Test for Association/Correlation Between Paired Samples
> ### Aliases: cor.test cor.test.default cor.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> ## Hollander & Wolfe (1973), p. 187f.
> ## Assessment of tuna quality. We compare the Hunter L measure of
> ## lightness to the averages of consumer panel scores (recoded as
> ## integer values from 1 to 6 and averaged over 80 such values) in
> ## 9 lots of canned tuna.
>
> x <- c(44.4, 45.9, 41.9, 53.3, 44.7, 44.1, 50.7, 45.2, 60.1)
> y <- c( 2.6, 3.1, 2.5, 5.0, 3.6, 4.0, 5.2, 2.8, 3.8)
>
> ## The alternative hypothesis of interest is that the
> ## Hunter L value is positively associated with the panel score.
>
> cor.test(x, y, method = "kendall", alternative = "greater")
Kendall's rank correlation tau
data: x and y
T = 26, p-value = 0.05972
alternative hypothesis: true tau is greater than 0
sample estimates:
tau
0.4444444
> ## => p=0.05972
>
> cor.test(x, y, method = "kendall", alternative = "greater",
+ exact = FALSE) # using large sample approximation
Kendall's rank correlation tau
data: x and y
z = 1.6681, p-value = 0.04765
alternative hypothesis: true tau is greater than 0
sample estimates:
tau
0.4444444
> ## => p=0.04765
>
> ## Compare this to
> cor.test(x, y, method = "spearm", alternative = "g")
Spearman's rank correlation rho
data: x and y
S = 48, p-value = 0.0484
alternative hypothesis: true rho is greater than 0
sample estimates:
rho
0.6
> cor.test(x, y, alternative = "g")
Pearson's product-moment correlation
data: x and y
t = 1.8411, df = 7, p-value = 0.05409
alternative hypothesis: true correlation is greater than 0
95 percent confidence interval:
-0.02223023 1.00000000
sample estimates:
cor
0.5711816
>
> ## Formula interface.
> require(graphics)
> pairs(USJudgeRatings)
> cor.test(~ CONT + INTG, data = USJudgeRatings)
Pearson's product-moment correlation
data: CONT and INTG
t = -0.8605, df = 41, p-value = 0.3945
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
-0.4168591 0.1741182
sample estimates:
cor
-0.1331909
>
>
>
> cleanEx()
> nameEx("cov.wt")
> ### * cov.wt
>
> flush(stderr()); flush(stdout())
>
> ### Name: cov.wt
> ### Title: Weighted Covariance Matrices
> ### Aliases: cov.wt
> ### Keywords: multivariate
>
> ### ** Examples
>
> (xy <- cbind(x = 1:10, y = c(1:3, 8:5, 8:10)))
x y
[1,] 1 1
[2,] 2 2
[3,] 3 3
[4,] 4 8
[5,] 5 7
[6,] 6 6
[7,] 7 5
[8,] 8 8
[9,] 9 9
[10,] 10 10
> w1 <- c(0,0,0,1,1,1,1,1,0,0)
> cov.wt(xy, wt = w1) # i.e. method = "unbiased"
$cov
x y
x 2.5 -0.5
y -0.5 1.7
$center
x y
6.0 6.8
$n.obs
[1] 10
$wt
[1] 0.0 0.0 0.0 0.2 0.2 0.2 0.2 0.2 0.0 0.0
> cov.wt(xy, wt = w1, method = "ML", cor = TRUE)
$cov
x y
x 2.0 -0.40
y -0.4 1.36
$center
x y
6.0 6.8
$n.obs
[1] 10
$wt
[1] 0.0 0.0 0.0 0.2 0.2 0.2 0.2 0.2 0.0 0.0
$cor
x y
x 1.0000000 -0.2425356
y -0.2425356 1.0000000
>
>
>
> cleanEx()
> nameEx("cpgram")
> ### * cpgram
>
> flush(stderr()); flush(stdout())
>
> ### Name: cpgram
> ### Title: Plot Cumulative Periodogram
> ### Aliases: cpgram
> ### Keywords: ts hplot
>
> ### ** Examples
>
> require(graphics)
>
> par(pty = "s", mfrow = c(1,2))
> cpgram(lh)
> lh.ar <- ar(lh, order.max = 9)
> cpgram(lh.ar$resid, main = "AR(3) fit to lh")
>
> cpgram(ldeaths)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("cutree")
> ### * cutree
>
> flush(stderr()); flush(stdout())
>
> ### Name: cutree
> ### Title: Cut a Tree into Groups of Data
> ### Aliases: cutree
> ### Keywords: multivariate cluster
>
> ### ** Examples
>
> hc <- hclust(dist(USArrests))
>
> cutree(hc, k=1:5) #k = 1 is trivial
1 2 3 4 5
Alabama 1 1 1 1 1
Alaska 1 1 1 1 1
Arizona 1 1 1 1 1
Arkansas 1 2 2 2 2
California 1 1 1 1 1
Colorado 1 2 2 2 2
Connecticut 1 2 3 3 3
Delaware 1 1 1 1 1
Florida 1 1 1 4 4
Georgia 1 2 2 2 2
Hawaii 1 2 3 3 5
Idaho 1 2 3 3 3
Illinois 1 1 1 1 1
Indiana 1 2 3 3 3
Iowa 1 2 3 3 5
Kansas 1 2 3 3 3
Kentucky 1 2 3 3 3
Louisiana 1 1 1 1 1
Maine 1 2 3 3 5
Maryland 1 1 1 1 1
Massachusetts 1 2 2 2 2
Michigan 1 1 1 1 1
Minnesota 1 2 3 3 5
Mississippi 1 1 1 1 1
Missouri 1 2 2 2 2
Montana 1 2 3 3 3
Nebraska 1 2 3 3 3
Nevada 1 1 1 1 1
New Hampshire 1 2 3 3 5
New Jersey 1 2 2 2 2
New Mexico 1 1 1 1 1
New York 1 1 1 1 1
North Carolina 1 1 1 4 4
North Dakota 1 2 3 3 5
Ohio 1 2 3 3 3
Oklahoma 1 2 2 2 2
Oregon 1 2 2 2 2
Pennsylvania 1 2 3 3 3
Rhode Island 1 2 2 2 2
South Carolina 1 1 1 1 1
South Dakota 1 2 3 3 5
Tennessee 1 2 2 2 2
Texas 1 2 2 2 2
Utah 1 2 3 3 3
Vermont 1 2 3 3 5
Virginia 1 2 2 2 2
Washington 1 2 2 2 2
West Virginia 1 2 3 3 5
Wisconsin 1 2 3 3 5
Wyoming 1 2 2 2 2
> cutree(hc, h=250)
Alabama Alaska Arizona Arkansas California
1 1 1 2 1
Colorado Connecticut Delaware Florida Georgia
2 2 1 1 2
Hawaii Idaho Illinois Indiana Iowa
2 2 1 2 2
Kansas Kentucky Louisiana Maine Maryland
2 2 1 2 1
Massachusetts Michigan Minnesota Mississippi Missouri
2 1 2 1 2
Montana Nebraska Nevada New Hampshire New Jersey
2 2 1 2 2
New Mexico New York North Carolina North Dakota Ohio
1 1 1 2 2
Oklahoma Oregon Pennsylvania Rhode Island South Carolina
2 2 2 2 1
South Dakota Tennessee Texas Utah Vermont
2 2 2 2 2
Virginia Washington West Virginia Wisconsin Wyoming
2 2 2 2 2
>
> ## Compare the 2 and 4 grouping:
> g24 <- cutree(hc, k = c(2,4))
> table(grp2=g24[,"2"], grp4=g24[,"4"])
grp4
grp2 1 2 3 4
1 14 0 0 2
2 0 14 20 0
>
>
>
> cleanEx()
> nameEx("decompose")
> ### * decompose
>
> flush(stderr()); flush(stdout())
>
> ### Name: decompose
> ### Title: Classical Seasonal Decomposition by Moving Averages
> ### Aliases: decompose plot.decomposed.ts
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> m <- decompose(co2)
> m$figure
[1] -0.05359649 0.61055921 1.37564693 2.51682018 3.00028509 2.32921053
[7] 0.81293860 -1.25052632 -3.05458333 -3.25194079 -2.06969298 -0.96512061
> plot(m)
>
> ## example taken from Kendall/Stuart
> x <- c(-50, 175, 149, 214, 247, 237, 225, 329, 729, 809,
+ 530, 489, 540, 457, 195, 176, 337, 239, 128, 102, 232, 429, 3,
+ 98, 43, -141, -77, -13, 125, 361, -45, 184)
> x <- ts(x, start = c(1951, 1), end = c(1958, 4), frequency = 4)
> m <- decompose(x)
> ## seasonal figure: 6.25, 8.62, -8.84, -6.03
> round(decompose(x)$figure / 10, 2)
[1] 6.25 8.62 -8.84 -6.03
>
>
>
> cleanEx()
> nameEx("delete.response")
> ### * delete.response
>
> flush(stderr()); flush(stdout())
>
> ### Name: delete.response
> ### Title: Modify Terms Objects
> ### Aliases: reformulate drop.terms delete.response [.terms
> ### Keywords: programming
>
> ### ** Examples
>
> ff <- y ~ z + x + w
> tt <- terms(ff)
> tt
y ~ z + x + w
attr(,"variables")
list(y, z, x, w)
attr(,"factors")
z x w
y 0 0 0
z 1 0 0
x 0 1 0
w 0 0 1
attr(,"term.labels")
[1] "z" "x" "w"
attr(,"order")
[1] 1 1 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> delete.response(tt)
~z + x + w
attr(,"variables")
list(z, x, w)
attr(,"factors")
z x w
z 1 0 0
x 0 1 0
w 0 0 1
attr(,"term.labels")
[1] "z" "x" "w"
attr(,"order")
[1] 1 1 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 0
attr(,".Environment")
<environment: R_GlobalEnv>
> drop.terms(tt, 2:3, keep.response = TRUE)
y ~ z
attr(,"variables")
list(y, z)
attr(,"factors")
z
y 0
z 1
attr(,"term.labels")
[1] "z"
attr(,"order")
[1] 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> tt[-1]
y ~ x + w
attr(,"variables")
list(y, x, w)
attr(,"factors")
x w
y 0 0
x 1 0
w 0 1
attr(,"term.labels")
[1] "x" "w"
attr(,"order")
[1] 1 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> tt[2:3]
y ~ x + w
attr(,"variables")
list(y, x, w)
attr(,"factors")
x w
y 0 0
x 1 0
w 0 1
attr(,"term.labels")
[1] "x" "w"
attr(,"order")
[1] 1 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> reformulate(attr(tt, "term.labels"))
~z + x + w
>
> ## keep LHS :
> reformulate("x*w", ff[[2]])
y ~ x * w
> fS <- surv(ft, case) ~ a + b
> reformulate(c("a", "b*f"), fS[[2]])
surv(ft, case) ~ a + b * f
>
> stopifnot(identical( ~ var, reformulate("var")),
+ identical(~ a + b + c, reformulate(letters[1:3])),
+ identical( y ~ a + b, reformulate(letters[1:2], "y"))
+ )
>
>
>
> cleanEx()
> nameEx("dendrapply")
> ### * dendrapply
>
> flush(stderr()); flush(stdout())
>
> ### Name: dendrapply
> ### Title: Apply a Function to All Nodes of a Dendrogram
> ### Aliases: dendrapply
> ### Keywords: iteration
>
> ### ** Examples
>
> require(graphics)
>
> ## a smallish simple dendrogram
> dhc <- as.dendrogram(hc <- hclust(dist(USArrests), "ave"))
> (dhc21 <- dhc[[2]][[1]])
'dendrogram' with 2 branches and 14 members total, at height 44.83793
>
> ## too simple:
> dendrapply(dhc21, function(n) utils::str(attributes(n)))
List of 4
$ members : int 14
$ midpoint: num 6.8
$ height : num 44.8
$ class : chr "dendrogram"
List of 4
$ members : int 8
$ midpoint: num 3.34
$ height : num 26.7
$ class : chr "dendrogram"
List of 4
$ members : int 5
$ midpoint: num 0.938
$ height : num 16.4
$ class : chr "dendrogram"
List of 5
$ members: int 1
$ height : num 0
$ label : chr "Washington"
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 4
$ midpoint: num 0.875
$ height : num 12.9
$ class : chr "dendrogram"
List of 5
$ members: int 1
$ height : num 0
$ label : chr "Oregon"
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 3
$ midpoint: num 0.75
$ height : num 10.7
$ class : chr "dendrogram"
List of 5
$ members: int 1
$ height : num 0
$ label : chr "Wyoming"
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 2
$ midpoint: num 0.5
$ height : num 7.36
$ class : chr "dendrogram"
List of 5
$ label : chr "Oklahoma"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 5
$ label : chr "Virginia"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 3
$ midpoint: num 0.75
$ height : num 22.6
$ class : chr "dendrogram"
List of 5
$ members: int 1
$ height : num 0
$ label : chr "Rhode Island"
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 2
$ midpoint: num 0.5
$ height : num 11.5
$ class : chr "dendrogram"
List of 5
$ label : chr "Massachusetts"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 5
$ label : chr "New Jersey"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 6
$ midpoint: num 2.25
$ height : num 29.1
$ class : chr "dendrogram"
List of 4
$ members : int 3
$ midpoint: num 0.75
$ height : num 20.2
$ class : chr "dendrogram"
List of 5
$ members: int 1
$ height : num 0
$ label : chr "Missouri"
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 2
$ midpoint: num 0.5
$ height : num 12.6
$ class : chr "dendrogram"
List of 5
$ label : chr "Arkansas"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 5
$ label : chr "Tennessee"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 3
$ midpoint: num 0.75
$ height : num 24
$ class : chr "dendrogram"
List of 5
$ members: int 1
$ height : num 0
$ label : chr "Georgia"
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 4
$ members : int 2
$ midpoint: num 0.5
$ height : num 14.5
$ class : chr "dendrogram"
List of 5
$ label : chr "Colorado"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
List of 5
$ label : chr "Texas"
$ members: int 1
$ height : num 0
$ leaf : logi TRUE
$ class : chr "dendrogram"
[[1]]
[[1]][[1]]
[[1]][[1]][[1]]
NULL
[[1]][[1]][[2]]
[[1]][[1]][[2]][[1]]
NULL
[[1]][[1]][[2]][[2]]
[[1]][[1]][[2]][[2]][[1]]
NULL
[[1]][[1]][[2]][[2]][[2]]
list()
[[1]][[2]]
[[1]][[2]][[1]]
NULL
[[1]][[2]][[2]]
list()
[[2]]
[[2]][[1]]
[[2]][[1]][[1]]
NULL
[[2]][[1]][[2]]
list()
[[2]][[2]]
[[2]][[2]][[1]]
NULL
[[2]][[2]][[2]]
list()
>
> ## toy example to set colored leaf labels :
> local({
+ colLab <<- function(n) {
+ if(is.leaf(n)) {
+ a <- attributes(n)
+ i <<- i+1
+ attr(n, "nodePar") <-
+ c(a$nodePar, list(lab.col = mycols[i], lab.font= i%%3))
+ }
+ n
+ }
+ mycols <- grDevices::rainbow(attr(dhc21,"members"))
+ i <- 0
+ })
> dL <- dendrapply(dhc21, colLab)
> op <- par(mfrow=2:1)
> plot(dhc21)
> plot(dL) ## --> colored labels!
> par(op)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("dendrogram")
> ### * dendrogram
>
> flush(stderr()); flush(stdout())
>
> ### Name: dendrogram
> ### Title: General Tree Structures
> ### Aliases: dendrogram as.dendrogram as.dendrogram.dendrogram
> ### as.dendrogram.hclust cut.dendrogram [[.dendrogram print.dendrogram
> ### rev.dendrogram str.dendrogram plot.dendrogram is.leaf
> ### Keywords: multivariate tree hplot
>
> ### ** Examples
>
> require(graphics); require(utils)
>
> hc <- hclust(dist(USArrests), "ave")
> (dend1 <- as.dendrogram(hc)) # "print()" method
'dendrogram' with 2 branches and 50 members total, at height 152.314
> str(dend1) # "str()" method
--[dendrogram w/ 2 branches and 50 members at h = 152]
|--[dendrogram w/ 2 branches and 16 members at h = 77.6]
| |--[dendrogram w/ 2 branches and 2 members at h = 38.5]
| | |--leaf "Florida"
| | `--leaf "North Carolina"
| `--[dendrogram w/ 2 branches and 14 members at h = 44.3]
| |--[dendrogram w/ 2 branches and 4 members at h = 28]
| | |--leaf "California"
| | `--[dendrogram w/ 2 branches and 3 members at h = 15.5]
| | |--leaf "Maryland"
| | `--[dendrogram w/ 2 branches and 2 members at h = 13.9]
| | |--leaf "Arizona"
| | `--leaf "New Mexico"
| `--[dendrogram w/ 2 branches and 10 members at h = 39.4]
| |--[dendrogram w/ 2 branches and 7 members at h = 26.4]
| | |--[dendrogram w/ 2 branches and 3 members at h = 16.9]
| | | |--leaf "Delaware"
| | | `--[dendrogram w/ 2 branches and 2 members at h = 15.5]
| | | |--leaf "Alabama"
| | | `--leaf "Louisiana"
| | `--[dendrogram w/ 2 branches and 4 members at h = 18.4]
| | |--[dendrogram w/ 2 branches and 2 members at h = 6.24]
| | | |--leaf "Illinois"
| | | `--leaf "New York"
| | `--[dendrogram w/ 2 branches and 2 members at h = 13.3]
| | |--leaf "Michigan"
| | `--leaf "Nevada"
| `--[dendrogram w/ 2 branches and 3 members at h = 28.1]
| |--leaf "Alaska"
| `--[dendrogram w/ 2 branches and 2 members at h = 21.2]
| |--leaf "Mississippi"
| `--leaf "South Carolina"
`--[dendrogram w/ 2 branches and 34 members at h = 89.2]
|--[dendrogram w/ 2 branches and 14 members at h = 44.8]
| |--[dendrogram w/ 2 branches and 8 members at h = 26.7]
| | |--[dendrogram w/ 2 branches and 5 members at h = 16.4]
| | | |--leaf "Washington"
| | | `--[dendrogram w/ 2 branches and 4 members at h = 12.9]
| | | |--leaf "Oregon"
| | | `--[dendrogram w/ 2 branches and 3 members at h = 10.7]
| | | |--leaf "Wyoming"
| | | `--[dendrogram w/ 2 branches and 2 members at h = 7.36]
| | | |--leaf "Oklahoma"
| | | `--leaf "Virginia"
| | `--[dendrogram w/ 2 branches and 3 members at h = 22.6]
| | |--leaf "Rhode Island"
| | `--[dendrogram w/ 2 branches and 2 members at h = 11.5]
| | |--leaf "Massachusetts"
| | `--leaf "New Jersey"
| `--[dendrogram w/ 2 branches and 6 members at h = 29.1]
| |--[dendrogram w/ 2 branches and 3 members at h = 20.2]
| | |--leaf "Missouri"
| | `--[dendrogram w/ 2 branches and 2 members at h = 12.6]
| | |--leaf "Arkansas"
| | `--leaf "Tennessee"
| `--[dendrogram w/ 2 branches and 3 members at h = 24.0]
| |--leaf "Georgia"
| `--[dendrogram w/ 2 branches and 2 members at h = 14.5]
| |--leaf "Colorado"
| `--leaf "Texas"
`--[dendrogram w/ 2 branches and 20 members at h = 54.7]
|--[dendrogram w/ 2 branches and 10 members at h = 20.6]
| |--[dendrogram w/ 2 branches and 4 members at h = 15.0]
| | |--leaf "Idaho"
| | `--[dendrogram w/ 2 branches and 3 members at h = 12.4]
| | |--leaf "Nebraska"
| | `--[dendrogram w/ 2 branches and 2 members at h = 3.83]
| | |--leaf "Kentucky"
| | `--leaf "Montana"
| `--[dendrogram w/ 2 branches and 6 members at h = 15.1]
| |--[dendrogram w/ 2 branches and 2 members at h = 6.64]
| | |--leaf "Ohio"
| | `--leaf "Utah"
| `--[dendrogram w/ 2 branches and 4 members at h = 13.4]
| |--[dendrogram w/ 2 branches and 2 members at h = 3.93]
| | |--leaf "Indiana"
| | `--leaf "Kansas"
| `--[dendrogram w/ 2 branches and 2 members at h = 8.03]
| |--leaf "Connecticut"
| `--leaf "Pennsylvania"
`--[dendrogram w/ 2 branches and 10 members at h = 41.1]
|--leaf "Hawaii"
`--[dendrogram w/ 2 branches and 9 members at h = 33.1]
|--[dendrogram w/ 2 branches and 3 members at h = 10.8]
| |--leaf "West Virginia"
| `--[dendrogram w/ 2 branches and 2 members at h = 8.54]
| |--leaf "Maine"
| `--leaf "South Dakota"
`--[dendrogram w/ 2 branches and 6 members at h = 27.8]
|--[dendrogram w/ 2 branches and 2 members at h = 13.0]
| |--leaf "North Dakota"
| `--leaf "Vermont"
`--[dendrogram w/ 2 branches and 4 members at h = 19]
|--leaf "Minnesota"
`--[dendrogram w/ 2 branches and 3 members at h = 10.2]
|--leaf "Wisconsin"
`--[dendrogram w/ 2 branches and 2 members at h = 2.29]
|--leaf "Iowa"
`--leaf "New Hampshire"
> str(dend1, max = 2) # only the first two sub-levels
--[dendrogram w/ 2 branches and 50 members at h = 152]
|--[dendrogram w/ 2 branches and 16 members at h = 77.6]
| |--[dendrogram w/ 2 branches and 2 members at h = 38.5] ..
| `--[dendrogram w/ 2 branches and 14 members at h = 44.3] ..
`--[dendrogram w/ 2 branches and 34 members at h = 89.2]
|--[dendrogram w/ 2 branches and 14 members at h = 44.8] ..
`--[dendrogram w/ 2 branches and 20 members at h = 54.7] ..
>
> op <- par(mfrow= c(2,2), mar = c(5,2,1,4))
> plot(dend1)
> ## "triangle" type and show inner nodes:
> plot(dend1, nodePar=list(pch = c(1,NA), cex=0.8, lab.cex = 0.8),
+ type = "t", center=TRUE)
> plot(dend1, edgePar=list(col = 1:2, lty = 2:3),
+ dLeaf=1, edge.root = TRUE)
> plot(dend1, nodePar=list(pch = 2:1,cex=.4*2:1, col = 2:3),
+ horiz=TRUE)
>
> dend2 <- cut(dend1, h=70)
> plot(dend2$upper)
> ## leaves are wrong horizontally:
> plot(dend2$upper, nodePar=list(pch = c(1,7), col = 2:1))
> ## dend2$lower is *NOT* a dendrogram, but a list of .. :
> plot(dend2$lower[[3]], nodePar=list(col=4), horiz = TRUE, type = "tr")
> ## "inner" and "leaf" edges in different type & color :
> plot(dend2$lower[[2]], nodePar=list(col=1),# non empty list
+ edgePar = list(lty=1:2, col=2:1), edge.root=TRUE)
> par(op)
> str(d3 <- dend2$lower[[2]][[2]][[1]])
--[dendrogram w/ 2 branches and 7 members at h = 26.4]
|--[dendrogram w/ 2 branches and 3 members at h = 16.9]
| |--leaf "Delaware"
| `--[dendrogram w/ 2 branches and 2 members at h = 15.5]
| |--leaf "Alabama"
| `--leaf "Louisiana"
`--[dendrogram w/ 2 branches and 4 members at h = 18.4]
|--[dendrogram w/ 2 branches and 2 members at h = 6.24]
| |--leaf "Illinois"
| `--leaf "New York"
`--[dendrogram w/ 2 branches and 2 members at h = 13.3]
|--leaf "Michigan"
`--leaf "Nevada"
>
> ## "Zoom" in to the first dendrogram :
> plot(dend1, xlim = c(1,20), ylim = c(1,50))
>
> nP <- list(col=3:2, cex=c(2.0, 0.75), pch= 21:22,
+ bg= c("light blue", "pink"),
+ lab.cex = 0.75, lab.col = "tomato")
> plot(d3, nodePar= nP, edgePar = list(col="gray", lwd=2), horiz = TRUE)
> addE <- function(n) {
+ if(!is.leaf(n)) {
+ attr(n, "edgePar") <- list(p.col="plum")
+ attr(n, "edgetext") <- paste(attr(n,"members"),"members")
+ }
+ n
+ }
> d3e <- dendrapply(d3, addE)
> plot(d3e, nodePar= nP)
> plot(d3e, nodePar= nP, leaflab = "textlike")
>
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("density")
> ### * density
>
> flush(stderr()); flush(stdout())
>
> ### Name: density
> ### Title: Kernel Density Estimation
> ### Aliases: density density.default print.density
> ### Keywords: distribution smooth
>
> ### ** Examples
>
> require(graphics)
>
> plot(density(c(-20,rep(0,98),20)), xlim = c(-4,4))# IQR = 0
>
> # The Old Faithful geyser data
> d <- density(faithful$eruptions, bw = "sj")
> d
Call:
density.default(x = faithful$eruptions, bw = "sj")
Data: faithful$eruptions (272 obs.); Bandwidth 'bw' = 0.14
x y
Min. :1.180 Min. :0.0001834
1st Qu.:2.265 1st Qu.:0.0422638
Median :3.350 Median :0.1709243
Mean :3.350 Mean :0.2301726
3rd Qu.:4.435 3rd Qu.:0.4134348
Max. :5.520 Max. :0.5945634
> plot(d)
>
> plot(d, type = "n")
> polygon(d, col = "wheat")
>
> ## Missing values:
> x <- xx <- faithful$eruptions
> x[i.out <- sample(length(x), 10)] <- NA
> doR <- density(x, bw = 0.15, na.rm = TRUE)
> lines(doR, col = "blue")
> points(xx[i.out], rep(0.01, 10))
>
> ## Weighted observations:
> fe <- sort(faithful$eruptions) # has quite a few non-unique values
> ## use 'counts / n' as weights:
> dw <- density(unique(fe), weights = table(fe)/length(fe), bw = d$bw)
> utils::str(dw) ## smaller n: only 126, but identical estimate:
List of 7
$ x : num [1:512] 1.18 1.19 1.2 1.21 1.21 ...
$ y : num [1:512] 0.000183 0.000223 0.00027 0.000328 0.000397 ...
$ bw : num 0.14
$ n : int 126
$ call : language density.default(x = unique(fe), bw = d$bw, weights = table(fe)/length(fe))
$ data.name: chr "unique(fe)"
$ has.na : logi FALSE
- attr(*, "class")= chr "density"
> stopifnot(all.equal(d[1:3], dw[1:3]))
>
> ## simulation from a density() fit:
> # a kernel density fit is an equally-weighted mixture.
> fit <- density(xx)
> N <- 1e6
> x.new <- rnorm(N, sample(xx, size = N, replace = TRUE), fit$bw)
> plot(fit)
> lines(density(x.new), col="blue")
>
>
> (kernels <- eval(formals(density.default)$kernel))
[1] "gaussian" "epanechnikov" "rectangular" "triangular" "biweight"
[6] "cosine" "optcosine"
>
> ## show the kernels in the R parametrization
> plot (density(0, bw = 1), xlab = "",
+ main="R's density() kernels with bw = 1")
> for(i in 2:length(kernels))
+ lines(density(0, bw = 1, kernel = kernels[i]), col = i)
> legend(1.5,.4, legend = kernels, col = seq(kernels),
+ lty = 1, cex = .8, y.intersp = 1)
>
> ## show the kernels in the S parametrization
> plot(density(0, from=-1.2, to=1.2, width=2, kernel="gaussian"), type="l",
+ ylim = c(0, 1), xlab="", main="R's density() kernels with width = 1")
> for(i in 2:length(kernels))
+ lines(density(0, width = 2, kernel = kernels[i]), col = i)
> legend(0.6, 1.0, legend = kernels, col = seq(kernels), lty = 1)
>
> ##-------- Semi-advanced theoretic from here on -------------
>
> (RKs <- cbind(sapply(kernels,
+ function(k) density(kernel = k, give.Rkern = TRUE))))
[,1]
gaussian 0.2820948
epanechnikov 0.2683282
rectangular 0.2886751
triangular 0.2721655
biweight 0.2699746
cosine 0.2711340
optcosine 0.2684756
> 100*round(RKs["epanechnikov",]/RKs, 4) ## Efficiencies
[,1]
gaussian 95.12
epanechnikov 100.00
rectangular 92.95
triangular 98.59
biweight 99.39
cosine 98.97
optcosine 99.95
>
> bw <- bw.SJ(precip) ## sensible automatic choice
> plot(density(precip, bw = bw),
+ main = "same sd bandwidths, 7 different kernels")
> for(i in 2:length(kernels))
+ lines(density(precip, bw = bw, kernel = kernels[i]), col = i)
>
> ## Bandwidth Adjustment for "Exactly Equivalent Kernels"
> h.f <- sapply(kernels, function(k)density(kernel = k, give.Rkern = TRUE))
> (h.f <- (h.f["gaussian"] / h.f)^ .2)
gaussian epanechnikov rectangular triangular biweight cosine
1.0000000 1.0100567 0.9953989 1.0071923 1.0088217 1.0079575
optcosine
1.0099458
> ## -> 1, 1.01, .995, 1.007,... close to 1 => adjustment barely visible..
>
> plot(density(precip, bw = bw),
+ main = "equivalent bandwidths, 7 different kernels")
> for(i in 2:length(kernels))
+ lines(density(precip, bw = bw, adjust = h.f[i], kernel = kernels[i]),
+ col = i)
> legend(55, 0.035, legend = kernels, col = seq(kernels), lty = 1)
>
>
>
> cleanEx()
> nameEx("deriv")
> ### * deriv
>
> flush(stderr()); flush(stdout())
>
> ### Name: deriv
> ### Title: Symbolic and Algorithmic Derivatives of Simple Expressions
> ### Aliases: D deriv deriv.default deriv.formula deriv3 deriv3.default
> ### deriv3.formula
> ### Keywords: math nonlinear
>
> ### ** Examples
>
> ## formula argument :
> dx2x <- deriv(~ x^2, "x") ; dx2x
expression({
.value <- x^2
.grad <- array(0, c(length(.value), 1L), list(NULL, c("x")))
.grad[, "x"] <- 2 * x
attr(.value, "gradient") <- .grad
.value
})
> ## Not run:
> ##D expression({
> ##D .value <- x^2
> ##D .grad <- array(0, c(length(.value), 1), list(NULL, c("x")))
> ##D .grad[, "x"] <- 2 * x
> ##D attr(.value, "gradient") <- .grad
> ##D .value
> ##D })
> ## End(Not run)
> mode(dx2x)
[1] "expression"
> x <- -1:2
> eval(dx2x)
[1] 1 0 1 4
attr(,"gradient")
x
[1,] -2
[2,] 0
[3,] 2
[4,] 4
>
> ## Something 'tougher':
> trig.exp <- expression(sin(cos(x + y^2)))
> ( D.sc <- D(trig.exp, "x") )
-(cos(cos(x + y^2)) * sin(x + y^2))
> all.equal(D(trig.exp[[1]], "x"), D.sc)
[1] TRUE
>
> ( dxy <- deriv(trig.exp, c("x", "y")) )
expression({
.expr2 <- x + y^2
.expr3 <- cos(.expr2)
.expr5 <- cos(.expr3)
.expr6 <- sin(.expr2)
.value <- sin(.expr3)
.grad <- array(0, c(length(.value), 2L), list(NULL, c("x",
"y")))
.grad[, "x"] <- -(.expr5 * .expr6)
.grad[, "y"] <- -(.expr5 * (.expr6 * (2 * y)))
attr(.value, "gradient") <- .grad
.value
})
> y <- 1
> eval(dxy)
[1] 0.8414710 0.5143953 -0.4042392 -0.8360219
attr(,"gradient")
x y
[1,] 0.0000000 0.000000
[2,] -0.7216061 -1.443212
[3,] -0.8316919 -1.663384
[4,] -0.0774320 -0.154864
> eval(D.sc)
[1] 0.0000000 -0.7216061 -0.8316919 -0.0774320
>
> ## function returned:
> deriv((y ~ sin(cos(x) * y)), c("x","y"), func = TRUE)
function (x, y)
{
.expr1 <- cos(x)
.expr2 <- .expr1 * y
.expr4 <- cos(.expr2)
.value <- sin(.expr2)
.grad <- array(0, c(length(.value), 2L), list(NULL, c("x",
"y")))
.grad[, "x"] <- -(.expr4 * (sin(x) * y))
.grad[, "y"] <- .expr4 * .expr1
attr(.value, "gradient") <- .grad
.value
}
>
> ## function with defaulted arguments:
> (fx <- deriv(y ~ b0 + b1 * 2^(-x/th), c("b0", "b1", "th"),
+ function(b0, b1, th, x = 1:7){} ) )
function (b0, b1, th, x = 1:7)
{
.expr3 <- 2^(-x/th)
.value <- b0 + b1 * .expr3
.grad <- array(0, c(length(.value), 3L), list(NULL, c("b0",
"b1", "th")))
.grad[, "b0"] <- 1
.grad[, "b1"] <- .expr3
.grad[, "th"] <- b1 * (.expr3 * (log(2) * (x/th^2)))
attr(.value, "gradient") <- .grad
.value
}
> fx(2,3,4)
[1] 4.522689 4.121320 3.783811 3.500000 3.261345 3.060660 2.891905
attr(,"gradient")
b0 b1 th
[1,] 1 0.8408964 0.1092872
[2,] 1 0.7071068 0.1837984
[3,] 1 0.5946036 0.2318331
[4,] 1 0.5000000 0.2599302
[5,] 1 0.4204482 0.2732180
[6,] 1 0.3535534 0.2756976
[7,] 1 0.2973018 0.2704720
>
> ## Higher derivatives
> deriv3(y ~ b0 + b1 * 2^(-x/th), c("b0", "b1", "th"),
+ c("b0", "b1", "th", "x") )
function (b0, b1, th, x)
{
.expr3 <- 2^(-x/th)
.expr6 <- log(2)
.expr7 <- th^2
.expr9 <- .expr6 * (x/.expr7)
.expr10 <- .expr3 * .expr9
.value <- b0 + b1 * .expr3
.grad <- array(0, c(length(.value), 3L), list(NULL, c("b0",
"b1", "th")))
.hessian <- array(0, c(length(.value), 3L, 3L), list(NULL,
c("b0", "b1", "th"), c("b0", "b1", "th")))
.grad[, "b0"] <- 1
.grad[, "b1"] <- .expr3
.hessian[, "b1", "b1"] <- 0
.hessian[, "b1", "th"] <- .hessian[, "th", "b1"] <- .expr10
.grad[, "th"] <- b1 * .expr10
.hessian[, "th", "th"] <- b1 * (.expr10 * .expr9 - .expr3 *
(.expr6 * (x * (2 * th)/.expr7^2)))
attr(.value, "gradient") <- .grad
attr(.value, "hessian") <- .hessian
.value
}
>
> ## Higher derivatives:
> DD <- function(expr,name, order = 1) {
+ if(order < 1) stop("'order' must be >= 1")
+ if(order == 1) D(expr,name)
+ else DD(D(expr, name), name, order - 1)
+ }
> DD(expression(sin(x^2)), "x", 3)
-(sin(x^2) * (2 * x) * 2 + ((cos(x^2) * (2 * x) * (2 * x) + sin(x^2) *
2) * (2 * x) + sin(x^2) * (2 * x) * 2))
> ## showing the limits of the internal "simplify()" :
> ## Not run:
> ##D -sin(x^2) * (2 * x) * 2 + ((cos(x^2) * (2 * x) * (2 * x) + sin(x^2) *
> ##D 2) * (2 * x) + sin(x^2) * (2 * x) * 2)
> ## End(Not run)
>
>
>
> cleanEx()
> nameEx("diffinv")
> ### * diffinv
>
> flush(stderr()); flush(stdout())
>
> ### Name: diffinv
> ### Title: Discrete Integration: Inverse of Differencing
> ### Aliases: diffinv diffinv.default diffinv.ts
> ### Keywords: ts
>
> ### ** Examples
>
> s <- 1:10
> d <- diff(s)
> diffinv(d, xi = 1)
[1] 1 2 3 4 5 6 7 8 9 10
>
>
>
> cleanEx()
> nameEx("dist")
> ### * dist
>
> flush(stderr()); flush(stdout())
>
> ### Name: dist
> ### Title: Distance Matrix Computation
> ### Aliases: dist print.dist format.dist labels.dist as.matrix.dist as.dist
> ### as.dist.default
> ### Keywords: multivariate cluster
>
> ### ** Examples
>
> require(graphics)
>
> x <- matrix(rnorm(100), nrow=5)
> dist(x)
1 2 3 4
2 5.701817
3 6.013119 5.032069
4 7.276905 5.325473 5.811861
5 6.619295 5.306750 4.945987 6.612081
> dist(x, diag = TRUE)
1 2 3 4 5
1 0.000000
2 5.701817 0.000000
3 6.013119 5.032069 0.000000
4 7.276905 5.325473 5.811861 0.000000
5 6.619295 5.306750 4.945987 6.612081 0.000000
> dist(x, upper = TRUE)
1 2 3 4 5
1 5.701817 6.013119 7.276905 6.619295
2 5.701817 5.032069 5.325473 5.306750
3 6.013119 5.032069 5.811861 4.945987
4 7.276905 5.325473 5.811861 6.612081
5 6.619295 5.306750 4.945987 6.612081
> m <- as.matrix(dist(x))
> d <- as.dist(m)
> stopifnot(d == dist(x))
>
> ## Use correlations between variables "as distance"
> dd <- as.dist((1 - cor(USJudgeRatings))/2)
> round(1000 * dd) # (prints more nicely)
CONT INTG DMNR DILG CFMG DECI PREP FAMI ORAL WRIT PHYS
INTG 567
DMNR 577 18
DILG 494 64 82
CFMG 432 93 93 21
DECI 457 99 98 22 9
PREP 494 61 72 11 21 21
FAMI 513 66 79 21 32 29 5
ORAL 506 44 47 23 25 26 8 9
WRIT 522 46 53 20 29 27 7 5 3
PHYS 473 129 106 94 60 64 76 78 54 72
RTEN 517 31 28 35 36 38 25 29 9 16 47
> plot(hclust(dd)) # to see a dendrogram of clustered variables
>
> ## example of binary and canberra distances.
> x <- c(0, 0, 1, 1, 1, 1)
> y <- c(1, 0, 1, 1, 0, 1)
> dist(rbind(x,y), method= "binary")
x
y 0.4
> ## answer 0.4 = 2/5
> dist(rbind(x,y), method= "canberra")
x
y 2.4
> ## answer 2 * (6/5)
>
> ## To find the names
> labels(eurodist)
[1] "Athens" "Barcelona" "Brussels" "Calais"
[5] "Cherbourg" "Cologne" "Copenhagen" "Geneva"
[9] "Gibraltar" "Hamburg" "Hook of Holland" "Lisbon"
[13] "Lyons" "Madrid" "Marseilles" "Milan"
[17] "Munich" "Paris" "Rome" "Stockholm"
[21] "Vienna"
>
> ## Examples involving "Inf" :
> ## 1)
> x[6] <- Inf
> (m2 <- rbind(x,y))
[,1] [,2] [,3] [,4] [,5] [,6]
x 0 0 1 1 1 Inf
y 1 0 1 1 0 1
> dist(m2, method="binary")# warning, answer 0.5 = 2/4
Warning in dist(m2, method = "binary") :
treating non-finite values as NA
x
y 0.5
> ## These all give "Inf":
> stopifnot(Inf == dist(m2, method= "euclidean"),
+ Inf == dist(m2, method= "maximum"),
+ Inf == dist(m2, method= "manhattan"))
> ## "Inf" is same as very large number:
> x1 <- x; x1[6] <- 1e100
> stopifnot(dist(cbind(x ,y), method="canberra") ==
+ print(dist(cbind(x1,y), method="canberra")))
1 2 3 4 5
2 2
3 1 2
4 1 2 0
5 2 2 1 1
6 1 2 1 1 2
>
> ## 2)
> y[6] <- Inf #-> 6-th pair is excluded
> dist(rbind(x,y), method="binary") # warning; 0.5
Warning in dist(rbind(x, y), method = "binary") :
treating non-finite values as NA
x
y 0.5
> dist(rbind(x,y), method="canberra") # 3
x
y 3
> dist(rbind(x,y), method="maximum") # 1
x
y 1
> dist(rbind(x,y), method="manhattan")# 2.4
x
y 2.4
>
>
>
> cleanEx()
> nameEx("dummy.coef")
> ### * dummy.coef
>
> flush(stderr()); flush(stdout())
>
> ### Name: dummy.coef
> ### Title: Extract Coefficients in Original Coding
> ### Aliases: dummy.coef dummy.coef.lm dummy.coef.aovlist
> ### Keywords: models
>
> ### ** Examples
>
> options(contrasts=c("contr.helmert", "contr.poly"))
> ## From Venables and Ripley (2002) p.165.
> utils::data(npk, package="MASS")
> npk.aov <- aov(yield ~ block + N*P*K, npk)
> dummy.coef(npk.aov)
Full coefficients are
(Intercept): 54.875
block: 1 2 3 4 5 6
-0.850 2.575 5.900 -4.750 -4.350 1.475
N: 0 1
-2.808333 2.808333
P: 0 1
0.5916667 -0.5916667
K: 0 1
1.991667 -1.991667
N:P: 0:0 1:0 0:1 1:1
-0.9416667 0.9416667 0.9416667 -0.9416667
N:K: 0:0 1:0 0:1 1:1
-1.175 1.175 1.175 -1.175
P:K: 0:0 1:0 0:1 1:1
0.1416667 -0.1416667 -0.1416667 0.1416667
N:P:K: 0:0:0 1:0:0 0:1:0 1:1:0 0:0:1 1:0:1 0:1:1
0 0 0 0 0 0 0
(Intercept):
block:
N:
P:
K:
N:P:
N:K:
P:K:
N:P:K: 1:1:1
0
>
> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)
> dummy.coef(npk.aovE)
Error: (Intercept)
(Intercept): 54.875
Error: block
N:P:K: 0:0:0 1:0:0 0:1:0 1:1:0 0:0:1 1:0:1 0:1:1
-1.241667 1.241667 1.241667 -1.241667 1.241667 -1.241667 -1.241667
N:P:K: 1:1:1
1.241667
Error: Within
N: 0 1
-2.808333 2.808333
P: 0 1
0.5916667 -0.5916667
K: 0 1
1.991667 -1.991667
N:P: 0:0 1:0 0:1 1:1
-0.9416667 0.9416667 0.9416667 -0.9416667
N:K: 0:0 1:0 0:1 1:1
-1.175 1.175 1.175 -1.175
P:K: 0:0 1:0 0:1 1:1
0.1416667 -0.1416667 -0.1416667 0.1416667
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("ecdf")
> ### * ecdf
>
> flush(stderr()); flush(stdout())
>
> ### Name: ecdf
> ### Title: Empirical Cumulative Distribution Function
> ### Aliases: ecdf plot.ecdf print.ecdf summary.ecdf quantile.ecdf
> ### Keywords: dplot hplot
>
> ### ** Examples
>
> ##-- Simple didactical ecdf example :
> x <- rnorm(12)
> Fn <- ecdf(x)
> Fn # a *function*
Empirical CDF
Call: ecdf(x)
x[1:12] = -0.83563, -0.82047, -0.62645, ..., 1.5118, 1.5953
> Fn(x) # returns the percentiles for x
[1] 0.25000000 0.41666667 0.08333333 1.00000000 0.50000000 0.16666667
[7] 0.66666667 0.83333333 0.75000000 0.33333333 0.91666667 0.58333333
> tt <- seq(-2,2, by = 0.1)
> 12 * Fn(tt) # Fn is a 'simple' function {with values k/12}
[1] 0 0 0 0 0 0 0 0 0 0 0 0 2 2 3 3 3 4 4 4 4 4 5 5 7
[26] 8 9 9 10 10 10 10 10 10 10 10 12 12 12 12 12
> summary(Fn)
Empirical CDF: 12 unique values with summary
Min. 1st Qu. Median Mean 3rd Qu. Max.
-0.8356 -0.3857 0.3597 0.2686 0.6164 1.5950
> ##--> see below for graphics
> knots(Fn)# the unique data values {12 of them if there were no ties}
[1] -0.8356286 -0.8204684 -0.6264538 -0.3053884 0.1836433 0.3295078
[7] 0.3898432 0.4874291 0.5757814 0.7383247 1.5117812 1.5952808
>
> y <- round(rnorm(12),1); y[3] <- y[1]
> Fn12 <- ecdf(y)
> Fn12
Empirical CDF
Call: ecdf(y)
x[1:8] = -2.2, -2, -0.6, ..., 0.8, 0.9
> knots(Fn12)# unique values (always less than 12!)
[1] -2.2 -2.0 -0.6 0.0 0.1 0.6 0.8 0.9
> summary(Fn12)
Empirical CDF: 8 unique values with summary
Min. 1st Qu. Median Mean 3rd Qu. Max.
-2.20 -0.95 0.05 -0.30 0.65 0.90
> summary.stepfun(Fn12)
Step function with continuity 'f'= 0 , 8 knots with summary
Min. 1st Qu. Median Mean 3rd Qu. Max.
-2.20 -0.95 0.05 -0.30 0.65 0.90
and 9 plateau levels (y) with summary
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000 0.1667 0.5000 0.4630 0.6667 1.0000
>
> ## Advanced: What's inside the function closure?
> print(ls.Fn12 <- ls(environment(Fn12)))
[1] "f" "method" "n" "nobs" "x" "y" "yleft" "yright"
> ##[1] "f" "method" "n" "x" "y" "yleft" "yright"
> utils::ls.str(environment(Fn12))
f : num 0
method : int 2
n : int 8
nobs : int 12
x : num [1:8] -2.2 -2 -0.6 0 0.1 0.6 0.8 0.9
y : num [1:8] 0.0833 0.1667 0.3333 0.5 0.5833 ...
yleft : num 0
yright : num 1
>
>
> ###----------------- Plotting --------------------------
> require(graphics)
>
> op <- par(mfrow=c(3,1), mgp=c(1.5, 0.8,0), mar= .1+c(3,3,2,1))
>
> F10 <- ecdf(rnorm(10))
> summary(F10)
Empirical CDF: 10 unique values with summary
Min. 1st Qu. Median Mean 3rd Qu. Max.
-1.47100 -0.14250 -0.05497 0.04667 0.41040 1.35900
>
> plot(F10)
> plot(F10, verticals= TRUE, do.points = FALSE)
>
> plot(Fn12 , lwd = 2) ; mtext("lwd = 2", adj=1)
> xx <- unique(sort(c(seq(-3, 2, length=201), knots(Fn12))))
> lines(xx, Fn12(xx), col='blue')
> abline(v=knots(Fn12),lty=2,col='gray70')
>
> plot(xx, Fn12(xx), type='o', cex=.1)#- plot.default {ugly}
> plot(Fn12, col.hor='red', add= TRUE) #- plot method
> abline(v=knots(Fn12),lty=2,col='gray70')
> ## luxury plot
> plot(Fn12, verticals=TRUE, col.points='blue',
+ col.hor='red', col.vert='bisque')
>
> ##-- this works too (automatic call to ecdf(.)):
> plot.ecdf(rnorm(24))
> title("via simple plot.ecdf(x)", adj=1)
>
> par(op)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("eff.aovlist")
> ### * eff.aovlist
>
> flush(stderr()); flush(stdout())
>
> ### Name: eff.aovlist
> ### Title: Compute Efficiencies of Multistratum Analysis of Variance
> ### Aliases: eff.aovlist
> ### Keywords: models
>
> ### ** Examples
>
> ## An example from Yates (1932),
> ## a 2^3 design in 2 blocks replicated 4 times
>
> Block <- gl(8, 4)
> A <- factor(c(0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,
+ 0,1,0,1,0,1,0,1,0,1,0,1))
> B <- factor(c(0,0,1,1,0,0,1,1,0,1,0,1,1,0,1,0,0,0,1,1,
+ 0,0,1,1,0,0,1,1,0,0,1,1))
> C <- factor(c(0,1,1,0,1,0,0,1,0,0,1,1,0,0,1,1,0,1,0,1,
+ 1,0,1,0,0,0,1,1,1,1,0,0))
> Yield <- c(101, 373, 398, 291, 312, 106, 265, 450, 106, 306, 324, 449,
+ 272, 89, 407, 338, 87, 324, 279, 471, 323, 128, 423, 334,
+ 131, 103, 445, 437, 324, 361, 302, 272)
> aovdat <- data.frame(Block, A, B, C, Yield)
>
> old <- getOption("contrasts")
> options(contrasts=c("contr.helmert", "contr.poly"))
> (fit <- aov(Yield ~ A*B*C + Error(Block), data = aovdat))
Call:
aov(formula = Yield ~ A * B * C + Error(Block), data = aovdat)
Grand Mean: 291.5938
Stratum 1: Block
Terms:
A:B A:C B:C A:B:C Residuals
Sum of Squares 780.1250 276.1250 2556.1250 112.5000 774.0938
Deg. of Freedom 1 1 1 1 3
Residual standard error: 16.06335
Estimated effects are balanced
Stratum 2: Within
Terms:
A B C A:B A:C B:C
Sum of Squares 3465.28 161170.03 278817.78 28.17 1802.67 11528.17
Deg. of Freedom 1 1 1 1 1 1
A:B:C Residuals
Sum of Squares 45.37 5423.28
Deg. of Freedom 1 17
Residual standard error: 17.86103
Estimated effects are balanced
> eff.aovlist(fit)
A B C A:B A:C B:C A:B:C
Block 0 0 0 0.25 0.25 0.25 0.25
Within 1 1 1 0.75 0.75 0.75 0.75
> options(contrasts = old)
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("effects")
> ### * effects
>
> flush(stderr()); flush(stdout())
>
> ### Name: effects
> ### Title: Effects from Fitted Model
> ### Aliases: effects effects.lm effects.glm
> ### Keywords: models regression
>
> ### ** Examples
>
> y <- c(1:3,7,5)
> x <- c(1:3,6:7)
> ( ee <- effects(lm(y ~ x)) )
(Intercept) x
-8.0498447 4.3655709 0.1483334 1.6144112 -1.2302295
attr(,"assign")
[1] 0 1
attr(,"class")
[1] "coef"
> c( round(ee - effects(lm(y+10 ~ I(x-3.8))), 3) )
(Intercept) x
22.361 0.000 0.000 0.000 0.000
> # just the first is different
>
>
>
> cleanEx()
> nameEx("embed")
> ### * embed
>
> flush(stderr()); flush(stdout())
>
> ### Name: embed
> ### Title: Embedding a Time Series
> ### Aliases: embed
> ### Keywords: ts
>
> ### ** Examples
>
> x <- 1:10
> embed (x, 3)
[,1] [,2] [,3]
[1,] 3 2 1
[2,] 4 3 2
[3,] 5 4 3
[4,] 6 5 4
[5,] 7 6 5
[6,] 8 7 6
[7,] 9 8 7
[8,] 10 9 8
>
>
>
> cleanEx()
> nameEx("expand.model.frame")
> ### * expand.model.frame
>
> flush(stderr()); flush(stdout())
>
> ### Name: expand.model.frame
> ### Title: Add new variables to a model frame
> ### Aliases: expand.model.frame
> ### Keywords: manip regression
>
> ### ** Examples
>
> model <- lm(log(Volume) ~ log(Girth) + log(Height), data=trees)
> expand.model.frame(model, ~ Girth) # prints data.frame like
log(Volume) log(Girth) log(Height) Girth
1 2.332144 2.116256 4.248495 8.3
2 2.332144 2.151762 4.174387 8.6
3 2.322388 2.174752 4.143135 8.8
4 2.797281 2.351375 4.276666 10.5
5 2.933857 2.370244 4.394449 10.7
6 2.980619 2.379546 4.418841 10.8
7 2.747271 2.397895 4.189655 11.0
8 2.901422 2.397895 4.317488 11.0
9 3.117950 2.406945 4.382027 11.1
10 2.990720 2.415914 4.317488 11.2
11 3.186353 2.424803 4.369448 11.3
12 3.044522 2.433613 4.330733 11.4
13 3.063391 2.433613 4.330733 11.4
14 3.058707 2.459589 4.234107 11.7
15 2.949688 2.484907 4.317488 12.0
16 3.100092 2.557227 4.304065 12.9
17 3.520461 2.557227 4.442651 12.9
18 3.310543 2.587764 4.454347 13.3
19 3.246491 2.617396 4.262680 13.7
20 3.214868 2.624669 4.158883 13.8
21 3.540959 2.639057 4.356709 14.0
22 3.456317 2.653242 4.382027 14.2
23 3.591818 2.674149 4.304065 14.5
24 3.645450 2.772589 4.276666 16.0
25 3.751854 2.791165 4.343805 16.3
26 4.014580 2.850707 4.394449 17.3
27 4.019980 2.862201 4.406719 17.5
28 4.065602 2.884801 4.382027 17.9
29 3.941582 2.890372 4.382027 18.0
30 3.931826 2.890372 4.382027 18.0
31 4.343805 3.025291 4.465908 20.6
>
> dd <- data.frame(x=1:5, y=rnorm(5), z=c(1,2,NA,4,5))
> model <- glm(y ~ x, data=dd, subset=1:4, na.action=na.omit)
> expand.model.frame(model, "z", na.expand=FALSE) # = default
y x z
1 -0.6264538 1 1
2 0.1836433 2 2
4 1.5952808 4 4
> expand.model.frame(model, "z", na.expand=TRUE)
y x z
1 -0.6264538 1 1
2 0.1836433 2 2
3 -0.8356286 3 NA
4 1.5952808 4 4
>
>
>
> cleanEx()
> nameEx("extractAIC")
> ### * extractAIC
>
> flush(stderr()); flush(stdout())
>
> ### Name: extractAIC
> ### Title: Extract AIC from a Fitted Model
> ### Aliases: extractAIC
> ### Keywords: models
>
> ### ** Examples
>
> utils::example(glm)
glm> ## Dobson (1990) Page 93: Randomized Controlled Trial :
glm> counts <- c(18,17,15,20,10,20,25,13,12)
glm> outcome <- gl(3,1,9)
glm> treatment <- gl(3,3)
glm> print(d.AD <- data.frame(treatment, outcome, counts))
treatment outcome counts
1 1 1 18
2 1 2 17
3 1 3 15
4 2 1 20
5 2 2 10
6 2 3 20
7 3 1 25
8 3 2 13
9 3 3 12
glm> glm.D93 <- glm(counts ~ outcome + treatment, family=poisson())
glm> anova(glm.D93)
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev
NULL 8 10.5814
outcome 2 5.4523 6 5.1291
treatment 2 0.0000 4 5.1291
glm> summary(glm.D93)
Call:
glm(formula = counts ~ outcome + treatment, family = poisson())
Deviance Residuals:
1 2 3 4 5 6 7 8
-0.67125 0.96272 -0.16965 -0.21999 -0.95552 1.04939 0.84715 -0.09167
9
-0.96656
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.045e+00 1.709e-01 17.815 <2e-16 ***
outcome2 -4.543e-01 2.022e-01 -2.247 0.0246 *
outcome3 -2.930e-01 1.927e-01 -1.520 0.1285
treatment2 1.338e-15 2.000e-01 0.000 1.0000
treatment3 1.421e-15 2.000e-01 0.000 1.0000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for poisson family taken to be 1)
Null deviance: 10.5814 on 8 degrees of freedom
Residual deviance: 5.1291 on 4 degrees of freedom
AIC: 56.761
Number of Fisher Scoring iterations: 4
glm> ## an example with offsets from Venables & Ripley (2002, p.189)
glm> utils::data(anorexia, package="MASS")
glm> anorex.1 <- glm(Postwt ~ Prewt + Treat + offset(Prewt),
glm+ family = gaussian, data = anorexia)
glm> summary(anorex.1)
Call:
glm(formula = Postwt ~ Prewt + Treat + offset(Prewt), family = gaussian,
data = anorexia)
Deviance Residuals:
Min 1Q Median 3Q Max
-14.1083 -4.2773 -0.5484 5.4838 15.2922
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 49.7711 13.3910 3.717 0.000410 ***
Prewt -0.5655 0.1612 -3.509 0.000803 ***
TreatCont -4.0971 1.8935 -2.164 0.033999 *
TreatFT 4.5631 2.1333 2.139 0.036035 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for gaussian family taken to be 48.69504)
Null deviance: 4525.4 on 71 degrees of freedom
Residual deviance: 3311.3 on 68 degrees of freedom
AIC: 489.97
Number of Fisher Scoring iterations: 2
glm> # A Gamma example, from McCullagh & Nelder (1989, pp. 300-2)
glm> clotting <- data.frame(
glm+ u = c(5,10,15,20,30,40,60,80,100),
glm+ lot1 = c(118,58,42,35,27,25,21,19,18),
glm+ lot2 = c(69,35,26,21,18,16,13,12,12))
glm> summary(glm(lot1 ~ log(u), data=clotting, family=Gamma))
Call:
glm(formula = lot1 ~ log(u), family = Gamma, data = clotting)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.04008 -0.03756 -0.02637 0.02905 0.08641
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.0165544 0.0009275 -17.85 4.28e-07 ***
log(u) 0.0153431 0.0004150 36.98 2.75e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for Gamma family taken to be 0.002446059)
Null deviance: 3.512826 on 8 degrees of freedom
Residual deviance: 0.016730 on 7 degrees of freedom
AIC: 37.99
Number of Fisher Scoring iterations: 3
glm> summary(glm(lot2 ~ log(u), data=clotting, family=Gamma))
Call:
glm(formula = lot2 ~ log(u), family = Gamma, data = clotting)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.05574 -0.02925 0.01030 0.01714 0.06371
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.0239085 0.0013265 -18.02 4.00e-07 ***
log(u) 0.0235992 0.0005768 40.91 1.36e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for Gamma family taken to be 0.001813354)
Null deviance: 3.118557 on 8 degrees of freedom
Residual deviance: 0.012672 on 7 degrees of freedom
AIC: 27.032
Number of Fisher Scoring iterations: 3
glm> ## Not run:
glm> ##D ## for an example of the use of a terms object as a formula
glm> ##D demo(glm.vr)
glm> ## End(Not run)
glm>
glm>
> extractAIC(glm.D93) #>> 5 15.129
[1] 5.00000 56.76132
>
>
>
> cleanEx()
> nameEx("factanal")
> ### * factanal
>
> flush(stderr()); flush(stdout())
>
> ### Name: factanal
> ### Title: Factor Analysis
> ### Aliases: factanal
> ### Keywords: multivariate
>
> ### ** Examples
>
> # A little demonstration, v2 is just v1 with noise,
> # and same for v4 vs. v3 and v6 vs. v5
> # Last four cases are there to add noise
> # and introduce a positive manifold (g factor)
> v1 <- c(1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,4,5,6)
> v2 <- c(1,2,1,1,1,1,2,1,2,1,3,4,3,3,3,4,6,5)
> v3 <- c(3,3,3,3,3,1,1,1,1,1,1,1,1,1,1,5,4,6)
> v4 <- c(3,3,4,3,3,1,1,2,1,1,1,1,2,1,1,5,6,4)
> v5 <- c(1,1,1,1,1,3,3,3,3,3,1,1,1,1,1,6,4,5)
> v6 <- c(1,1,1,2,1,3,3,3,4,3,1,1,1,2,1,6,5,4)
> m1 <- cbind(v1,v2,v3,v4,v5,v6)
> cor(m1)
v1 v2 v3 v4 v5 v6
v1 1.0000000 0.9393083 0.5128866 0.4320310 0.4664948 0.4086076
v2 0.9393083 1.0000000 0.4124441 0.4084281 0.4363925 0.4326113
v3 0.5128866 0.4124441 1.0000000 0.8770750 0.5128866 0.4320310
v4 0.4320310 0.4084281 0.8770750 1.0000000 0.4320310 0.4323259
v5 0.4664948 0.4363925 0.5128866 0.4320310 1.0000000 0.9473451
v6 0.4086076 0.4326113 0.4320310 0.4323259 0.9473451 1.0000000
> factanal(m1, factors=3) # varimax is the default
Call:
factanal(x = m1, factors = 3)
Uniquenesses:
v1 v2 v3 v4 v5 v6
0.005 0.101 0.005 0.224 0.084 0.005
Loadings:
Factor1 Factor2 Factor3
v1 0.944 0.182 0.267
v2 0.905 0.235 0.159
v3 0.236 0.210 0.946
v4 0.180 0.242 0.828
v5 0.242 0.881 0.286
v6 0.193 0.959 0.196
Factor1 Factor2 Factor3
SS loadings 1.893 1.886 1.797
Proportion Var 0.316 0.314 0.300
Cumulative Var 0.316 0.630 0.929
The degrees of freedom for the model is 0 and the fit was 0.4755
> factanal(m1, factors=3, rotation="promax")
Call:
factanal(x = m1, factors = 3, rotation = "promax")
Uniquenesses:
v1 v2 v3 v4 v5 v6
0.005 0.101 0.005 0.224 0.084 0.005
Loadings:
Factor1 Factor2 Factor3
v1 0.985
v2 0.951
v3 1.003
v4 0.867
v5 0.910
v6 1.033
Factor1 Factor2 Factor3
SS loadings 1.903 1.876 1.772
Proportion Var 0.317 0.313 0.295
Cumulative Var 0.317 0.630 0.925
The degrees of freedom for the model is 0 and the fit was 0.4755
> # The following shows the g factor as PC1
> prcomp(m1)
Standard deviations:
[1] 3.0368683 1.6313757 1.5818857 0.6344131 0.3190765 0.2649086
Rotation:
PC1 PC2 PC3 PC4 PC5 PC6
v1 0.4168038 -0.52292304 0.2354298 -0.2686501 0.5157193 -0.39907358
v2 0.3885610 -0.50887673 0.2985906 0.3060519 -0.5061522 0.38865228
v3 0.4182779 0.01521834 -0.5555132 -0.5686880 -0.4308467 -0.08474731
v4 0.3943646 0.02184360 -0.5986150 0.5922259 0.3558110 0.09124977
v5 0.4254013 0.47017231 0.2923345 -0.2789775 0.3060409 0.58397162
v6 0.4047824 0.49580764 0.3209708 0.2866938 -0.2682391 -0.57719858
>
> ## formula interface
> factanal(~v1+v2+v3+v4+v5+v6, factors = 3,
+ scores = "Bartlett")$scores
Factor1 Factor2 Factor3
1 -0.9039949 -0.9308984 0.9475392
2 -0.8685952 -0.9328721 0.9352330
3 -0.9082818 -0.9320093 0.9616422
4 -1.0021975 -0.2529689 0.8178552
5 -0.9039949 -0.9308984 0.9475392
6 -0.7452711 0.7273960 -0.7884733
7 -0.7098714 0.7254223 -0.8007795
8 -0.7495580 0.7262851 -0.7743704
9 -0.8080740 1.4033517 -0.9304636
10 -0.7452711 0.7273960 -0.7884733
11 0.9272282 -0.9307506 -0.8371538
12 0.9626279 -0.9327243 -0.8494600
13 0.9229413 -0.9318615 -0.8230509
14 0.8290256 -0.2528211 -0.9668378
15 0.9272282 -0.9307506 -0.8371538
16 0.4224366 2.0453079 1.2864761
17 1.4713902 1.2947716 0.5451562
18 1.8822320 0.3086244 1.9547752
>
> ## a realistic example from Bartholomew (1987, pp. 61-65)
> utils::example(ability.cov)
ablty.> require(stats)
ablty.> (ability.FA <- factanal(factors = 1, covmat=ability.cov))
Call:
factanal(factors = 1, covmat = ability.cov)
Uniquenesses:
general picture blocks maze reading vocab
0.535 0.853 0.748 0.910 0.232 0.280
Loadings:
Factor1
general 0.682
picture 0.384
blocks 0.502
maze 0.300
reading 0.877
vocab 0.849
Factor1
SS loadings 2.443
Proportion Var 0.407
Test of the hypothesis that 1 factor is sufficient.
The chi square statistic is 75.18 on 9 degrees of freedom.
The p-value is 1.46e-12
ablty.> update(ability.FA, factors=2)
Call:
factanal(factors = 2, covmat = ability.cov)
Uniquenesses:
general picture blocks maze reading vocab
0.455 0.589 0.218 0.769 0.052 0.334
Loadings:
Factor1 Factor2
general 0.499 0.543
picture 0.156 0.622
blocks 0.206 0.860
maze 0.109 0.468
reading 0.956 0.182
vocab 0.785 0.225
Factor1 Factor2
SS loadings 1.858 1.724
Proportion Var 0.310 0.287
Cumulative Var 0.310 0.597
Test of the hypothesis that 2 factors are sufficient.
The chi square statistic is 6.11 on 4 degrees of freedom.
The p-value is 0.191
ablty.> update(ability.FA, factors=2, rotation="promax")
Call:
factanal(factors = 2, covmat = ability.cov, rotation = "promax")
Uniquenesses:
general picture blocks maze reading vocab
0.455 0.589 0.218 0.769 0.052 0.334
Loadings:
Factor1 Factor2
general 0.364 0.470
picture 0.671
blocks 0.932
maze 0.508
reading 1.023
vocab 0.811
Factor1 Factor2
SS loadings 1.853 1.807
Proportion Var 0.309 0.301
Cumulative Var 0.309 0.610
Test of the hypothesis that 2 factors are sufficient.
The chi square statistic is 6.11 on 4 degrees of freedom.
The p-value is 0.191
>
>
>
> cleanEx()
> nameEx("factor.scope")
> ### * factor.scope
>
> flush(stderr()); flush(stdout())
>
> ### Name: factor.scope
> ### Title: Compute Allowed Changes in Adding to or Dropping from a Formula
> ### Aliases: add.scope drop.scope factor.scope
> ### Keywords: models
>
> ### ** Examples
>
> add.scope( ~ a + b + c + a:b, ~ (a + b + c)^3)
[1] "a:c" "b:c"
> # [1] "a:c" "b:c"
> drop.scope( ~ a + b + c + a:b)
[1] "c" "a:b"
> # [1] "c" "a:b"
>
>
>
> cleanEx()
> nameEx("family")
> ### * family
>
> flush(stderr()); flush(stdout())
>
> ### Name: family
> ### Title: Family Objects for Models
> ### Aliases: family binomial gaussian Gamma inverse.gaussian poisson quasi
> ### quasibinomial quasipoisson print.family
> ### Keywords: models
>
> ### ** Examples
>
> require(utils) # for str
>
> nf <- gaussian()# Normal family
> nf
Family: gaussian
Link function: identity
> str(nf)# internal STRucture
List of 11
$ family : chr "gaussian"
$ link : chr "identity"
$ linkfun :function (mu)
$ linkinv :function (eta)
$ variance :function (mu)
$ dev.resids:function (y, mu, wt)
$ aic :function (y, n, mu, wt, dev)
$ mu.eta :function (eta)
$ initialize: expression({ n <- rep.int(1, nobs) if (is.null(etastart) && is.null(start) && is.null(mustart) && ((family$link == "inverse" && any(y == 0)) || (family$link == "log" && any(y <= 0)))) stop("cannot find valid starting values: please specify some") mustart <- y })
$ validmu :function (mu)
$ valideta :function (eta)
- attr(*, "class")= chr "family"
>
> gf <- Gamma()
> gf
Family: Gamma
Link function: inverse
> str(gf)
List of 12
$ family : chr "Gamma"
$ link : chr "inverse"
$ linkfun :function (mu)
$ linkinv :function (eta)
$ variance :function (mu)
$ dev.resids:function (y, mu, wt)
$ aic :function (y, n, mu, wt, dev)
$ mu.eta :function (eta)
$ initialize: expression({ if (any(y <= 0)) stop("non-positive values not allowed for the gamma family") n <- rep.int(1, nobs) mustart <- y })
$ validmu :function (mu)
$ valideta :function (eta)
$ simulate :function (object, nsim)
- attr(*, "class")= chr "family"
> gf$linkinv
function (eta)
1/eta
<environment: 0x9f00a80>
> gf$variance(-3:4) #- == (.)^2
[1] 9 4 1 0 1 4 9 16
>
>
> ## quasipoisson. compare with example(glm)
> counts <- c(18,17,15,20,10,20,25,13,12)
> outcome <- gl(3,1,9)
> treatment <- gl(3,3)
> d.AD <- data.frame(treatment, outcome, counts)
> glm.qD93 <- glm(counts ~ outcome + treatment, family=quasipoisson())
> glm.qD93
Call: glm(formula = counts ~ outcome + treatment, family = quasipoisson())
Coefficients:
(Intercept) outcome2 outcome3 treatment2 treatment3
3.045e+00 -4.543e-01 -2.930e-01 1.338e-15 1.421e-15
Degrees of Freedom: 8 Total (i.e. Null); 4 Residual
Null Deviance: 10.58
Residual Deviance: 5.129 AIC: NA
> anova(glm.qD93, test="F")
Analysis of Deviance Table
Model: quasipoisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev F Pr(>F)
NULL 8 10.5814
outcome 2 5.4523 6 5.1291 2.1079 0.2370
treatment 2 0.0000 4 5.1291 0.0000 1.0000
> summary(glm.qD93)
Call:
glm(formula = counts ~ outcome + treatment, family = quasipoisson())
Deviance Residuals:
1 2 3 4 5 6 7 8
-0.67125 0.96272 -0.16965 -0.21999 -0.95552 1.04939 0.84715 -0.09167
9
-0.96656
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 3.045e+00 1.944e-01 15.665 9.7e-05 ***
outcome2 -4.543e-01 2.299e-01 -1.976 0.119
outcome3 -2.930e-01 2.192e-01 -1.337 0.252
treatment2 1.338e-15 2.274e-01 0.000 1.000
treatment3 1.421e-15 2.274e-01 0.000 1.000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for quasipoisson family taken to be 1.293300)
Null deviance: 10.5814 on 8 degrees of freedom
Residual deviance: 5.1291 on 4 degrees of freedom
AIC: NA
Number of Fisher Scoring iterations: 4
> ## for Poisson results use
> anova(glm.qD93, dispersion = 1, test="Chisq")
Analysis of Deviance Table
Model: quasipoisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev P(>|Chi|)
NULL 8 10.5814
outcome 2 5.4523 6 5.1291 0.06547 .
treatment 2 0.0000 4 5.1291 1.00000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> summary(glm.qD93, dispersion = 1)
Call:
glm(formula = counts ~ outcome + treatment, family = quasipoisson())
Deviance Residuals:
1 2 3 4 5 6 7 8
-0.67125 0.96272 -0.16965 -0.21999 -0.95552 1.04939 0.84715 -0.09167
9
-0.96656
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.045e+00 1.709e-01 17.815 <2e-16 ***
outcome2 -4.543e-01 2.022e-01 -2.247 0.0246 *
outcome3 -2.930e-01 1.927e-01 -1.520 0.1285
treatment2 1.338e-15 2.000e-01 0.000 1.0000
treatment3 1.421e-15 2.000e-01 0.000 1.0000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for quasipoisson family taken to be 1)
Null deviance: 10.5814 on 8 degrees of freedom
Residual deviance: 5.1291 on 4 degrees of freedom
AIC: NA
Number of Fisher Scoring iterations: 4
>
>
> ## Example of user-specified link, a logit model for p^days
> ## See Shaffer, T. 2004. Auk 121(2): 526-540.
> logexp <- function(days = 1)
+ {
+ linkfun <- function(mu) qlogis(mu^(1/days))
+ linkinv <- function(eta) plogis(eta)^days
+ mu.eta <- function(eta) days * plogis(eta)^(days-1) *
+ .Call("logit_mu_eta", eta, PACKAGE = "stats")
+ valideta <- function(eta) TRUE
+ link <- paste("logexp(", days, ")", sep="")
+ structure(list(linkfun = linkfun, linkinv = linkinv,
+ mu.eta = mu.eta, valideta = valideta, name = link),
+ class = "link-glm")
+ }
> binomial(logexp(3))
Family: binomial
Link function: logexp(3)
> ## in practice this would be used with a vector of 'days', in
> ## which case use an offset of 0 in the corresponding formula
> ## to get the null deviance right.
>
> ## Binomial with identity link: often not a good idea.
> ## Not run: binomial(link=make.link("identity"))
>
> ## tests of quasi
> x <- rnorm(100)
> y <- rpois(100, exp(1+x))
> glm(y ~x, family=quasi(variance="mu", link="log"))
Call: glm(formula = y ~ x, family = quasi(variance = "mu", link = "log"))
Coefficients:
(Intercept) x
0.8596 1.0875
Degrees of Freedom: 99 Total (i.e. Null); 98 Residual
Null Deviance: 481.9
Residual Deviance: 101.7 AIC: NA
> # which is the same as
> glm(y ~x, family=poisson)
Call: glm(formula = y ~ x, family = poisson)
Coefficients:
(Intercept) x
0.8596 1.0875
Degrees of Freedom: 99 Total (i.e. Null); 98 Residual
Null Deviance: 481.9
Residual Deviance: 101.7 AIC: 364
> glm(y ~x, family=quasi(variance="mu^2", link="log"))
Call: glm(formula = y ~ x, family = quasi(variance = "mu^2", link = "log"))
Coefficients:
(Intercept) x
0.6902 1.4546
Degrees of Freedom: 99 Total (i.e. Null); 98 Residual
Null Deviance: 83.85
Residual Deviance: 32.45 AIC: NA
> ## Not run: glm(y ~x, family=quasi(variance="mu^3", link="log")) # fails
> y <- rbinom(100, 1, plogis(x))
> # needs to set a starting value for the next fit
> glm(y ~x, family=quasi(variance="mu(1-mu)", link="logit"), start=c(0,1))
Call: glm(formula = y ~ x, family = quasi(variance = "mu(1-mu)", link = "logit"),
start = c(0, 1))
Coefficients:
(Intercept) x
-0.08334 0.38518
Degrees of Freedom: 99 Total (i.e. Null); 98 Residual
Null Deviance: 138.6
Residual Deviance: 135.8 AIC: NA
>
>
>
> cleanEx()
> nameEx("fft")
> ### * fft
>
> flush(stderr()); flush(stdout())
>
> ### Name: fft
> ### Title: Fast Discrete Fourier Transform
> ### Aliases: fft mvfft
> ### Keywords: math dplot
>
> ### ** Examples
>
> x <- 1:4
> fft(x)
[1] 10+0i -2+2i -2+0i -2-2i
> fft(fft(x), inverse = TRUE)/length(x)
[1] 1+0i 2+0i 3+0i 4+0i
>
>
>
> cleanEx()
> nameEx("filter")
> ### * filter
>
> flush(stderr()); flush(stdout())
>
> ### Name: filter
> ### Title: Linear Filtering on a Time Series
> ### Aliases: filter
> ### Keywords: ts
>
> ### ** Examples
>
> x <- 1:100
> filter(x, rep(1, 3))
Time Series:
Start = 1
End = 100
Frequency = 1
[1] NA 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51 54
[19] 57 60 63 66 69 72 75 78 81 84 87 90 93 96 99 102 105 108
[37] 111 114 117 120 123 126 129 132 135 138 141 144 147 150 153 156 159 162
[55] 165 168 171 174 177 180 183 186 189 192 195 198 201 204 207 210 213 216
[73] 219 222 225 228 231 234 237 240 243 246 249 252 255 258 261 264 267 270
[91] 273 276 279 282 285 288 291 294 297 NA
> filter(x, rep(1, 3), sides = 1)
Time Series:
Start = 1
End = 100
Frequency = 1
[1] NA NA 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51
[19] 54 57 60 63 66 69 72 75 78 81 84 87 90 93 96 99 102 105
[37] 108 111 114 117 120 123 126 129 132 135 138 141 144 147 150 153 156 159
[55] 162 165 168 171 174 177 180 183 186 189 192 195 198 201 204 207 210 213
[73] 216 219 222 225 228 231 234 237 240 243 246 249 252 255 258 261 264 267
[91] 270 273 276 279 282 285 288 291 294 297
> filter(x, rep(1, 3), sides = 1, circular = TRUE)
Time Series:
Start = 1
End = 100
Frequency = 1
[1] 200 103 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51
[19] 54 57 60 63 66 69 72 75 78 81 84 87 90 93 96 99 102 105
[37] 108 111 114 117 120 123 126 129 132 135 138 141 144 147 150 153 156 159
[55] 162 165 168 171 174 177 180 183 186 189 192 195 198 201 204 207 210 213
[73] 216 219 222 225 228 231 234 237 240 243 246 249 252 255 258 261 264 267
[91] 270 273 276 279 282 285 288 291 294 297
>
> filter(presidents, rep(1,3))
Qtr1 Qtr2 Qtr3 Qtr4
1945 NA NA 244 220
1946 188 156 125 110
1947 127 149 169 145
1948 130 NA NA NA
1949 NA 183 165 153
1950 133 128 122 121
1951 99 92 79 80
1952 80 NA NA NA
1953 165 208 209 206
1954 192 203 189 199
1955 196 218 220 228
1956 220 214 213 221
1957 216 204 182 180
1958 166 157 149 157
1959 171 180 189 198
1960 199 194 180 190
1961 212 226 232 228
1962 228 212 207 212
1963 214 202 183 199
1964 210 222 211 209
1965 204 204 195 194
1966 171 165 146 144
1967 140 134 136 120
1968 131 120 128 138
1969 168 189 186 187
1970 175 180 166 164
1971 151 153 151 152
1972 159 NA NA NA
1973 NA 152 111 95
1974 80 77 73 NA
>
>
>
> cleanEx()
> nameEx("fisher.test")
> ### * fisher.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: fisher.test
> ### Title: Fisher's Exact Test for Count Data
> ### Aliases: fisher.test
> ### Keywords: htest
>
> ### ** Examples
>
> ## Agresti (1990, p. 61f; 2002, p. 91) Fisher's Tea Drinker
> ## A British woman claimed to be able to distinguish whether milk or
> ## tea was added to the cup first. To test, she was given 8 cups of
> ## tea, in four of which milk was added first. The null hypothesis
> ## is that there is no association between the true order of pouring
> ## and the woman's guess, the alternative that there is a positive
> ## association (that the odds ratio is greater than 1).
> TeaTasting <-
+ matrix(c(3, 1, 1, 3),
+ nrow = 2,
+ dimnames = list(Guess = c("Milk", "Tea"),
+ Truth = c("Milk", "Tea")))
> fisher.test(TeaTasting, alternative = "greater")
Fisher's Exact Test for Count Data
data: TeaTasting
p-value = 0.2429
alternative hypothesis: true odds ratio is greater than 1
95 percent confidence interval:
0.3135693 Inf
sample estimates:
odds ratio
6.408309
> ## => p=0.2429, association could not be established
>
> ## Fisher (1962, 1970), Criminal convictions of like-sex twins
> Convictions <-
+ matrix(c(2, 10, 15, 3),
+ nrow = 2,
+ dimnames =
+ list(c("Dizygotic", "Monozygotic"),
+ c("Convicted", "Not convicted")))
> Convictions
Convicted Not convicted
Dizygotic 2 15
Monozygotic 10 3
> fisher.test(Convictions, alternative = "less")
Fisher's Exact Test for Count Data
data: Convictions
p-value = 0.0004652
alternative hypothesis: true odds ratio is less than 1
95 percent confidence interval:
0.0000000 0.2849601
sample estimates:
odds ratio
0.04693661
> fisher.test(Convictions, conf.int = FALSE)
Fisher's Exact Test for Count Data
data: Convictions
p-value = 0.0005367
alternative hypothesis: true odds ratio is not equal to 1
sample estimates:
odds ratio
0.04693661
> fisher.test(Convictions, conf.level = 0.95)$conf.int
[1] 0.003325764 0.363182271
attr(,"conf.level")
[1] 0.95
> fisher.test(Convictions, conf.level = 0.99)$conf.int
[1] 0.001386333 0.578851645
attr(,"conf.level")
[1] 0.99
>
> ## A r x c table Agresti (2002, p. 57) Job Satisfaction
> Job <- matrix(c(1,2,1,0, 3,3,6,1, 10,10,14,9, 6,7,12,11), 4, 4,
+ dimnames = list(income=c("< 15k", "15-25k", "25-40k", "> 40k"),
+ satisfaction=c("VeryD", "LittleD", "ModerateS", "VeryS")))
> fisher.test(Job)
Fisher's Exact Test for Count Data
data: Job
p-value = 0.7827
alternative hypothesis: two.sided
> fisher.test(Job, simulate.p.value=TRUE, B=1e5)
Fisher's Exact Test for Count Data with simulated p-value (based on
1e+05 replicates)
data: Job
p-value = 0.7842
alternative hypothesis: two.sided
>
>
>
> cleanEx()
> nameEx("fivenum")
> ### * fivenum
>
> flush(stderr()); flush(stdout())
>
> ### Name: fivenum
> ### Title: Tukey Five-Number Summaries
> ### Aliases: fivenum
> ### Keywords: univar robust distribution
>
> ### ** Examples
>
> fivenum(c(rnorm(100),-1:1/0))
[1] -Inf -0.5425200 0.1139092 0.6969634 Inf
>
>
>
> cleanEx()
> nameEx("fligner.test")
> ### * fligner.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: fligner.test
> ### Title: Fligner-Killeen Test of Homogeneity of Variances
> ### Aliases: fligner.test fligner.test.default fligner.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> require(graphics)
>
> plot(count ~ spray, data = InsectSprays)
> fligner.test(InsectSprays$count, InsectSprays$spray)
Fligner-Killeen test of homogeneity of variances
data: InsectSprays$count and InsectSprays$spray
Fligner-Killeen:med chi-squared = 14.4828, df = 5, p-value = 0.01282
> fligner.test(count ~ spray, data = InsectSprays)
Fligner-Killeen test of homogeneity of variances
data: count by spray
Fligner-Killeen:med chi-squared = 14.4828, df = 5, p-value = 0.01282
> ## Compare this to bartlett.test()
>
>
>
> cleanEx()
> nameEx("formula")
> ### * formula
>
> flush(stderr()); flush(stdout())
>
> ### Name: formula
> ### Title: Model Formulae
> ### Aliases: formula formula.default formula.formula formula.terms
> ### formula.data.frame as.formula print.formula [.formula
> ### Keywords: models
>
> ### ** Examples
>
> class(fo <- y ~ x1*x2) # "formula"
[1] "formula"
> fo
y ~ x1 * x2
> typeof(fo)# R internal : "language"
[1] "language"
> terms(fo)
y ~ x1 * x2
attr(,"variables")
list(y, x1, x2)
attr(,"factors")
x1 x2 x1:x2
y 0 0 0
x1 1 0 1
x2 0 1 1
attr(,"term.labels")
[1] "x1" "x2" "x1:x2"
attr(,"order")
[1] 1 1 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
>
> environment(fo)
<environment: R_GlobalEnv>
> environment(as.formula("y ~ x"))
<environment: R_GlobalEnv>
> environment(as.formula("y ~ x", env=new.env()))
<environment: 0x5ccf058>
>
>
> ## Create a formula for a model with a large number of variables:
> xnam <- paste("x", 1:25, sep="")
> (fmla <- as.formula(paste("y ~ ", paste(xnam, collapse= "+"))))
y ~ x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 + x10 + x11 +
x12 + x13 + x14 + x15 + x16 + x17 + x18 + x19 + x20 + x21 +
x22 + x23 + x24 + x25
>
>
>
> cleanEx()
> nameEx("formula.nls")
> ### * formula.nls
>
> flush(stderr()); flush(stdout())
>
> ### Name: formula.nls
> ### Title: Extract Model Formula from nls Object
> ### Aliases: formula.nls
> ### Keywords: models
>
> ### ** Examples
>
> fm1 <- nls(circumference ~ A/(1+exp((B-age)/C)), Orange,
+ start = list(A=160, B=700, C = 350))
> formula(fm1)
circumference ~ A/(1 + exp((B - age)/C))
>
>
>
> cleanEx()
> nameEx("friedman.test")
> ### * friedman.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: friedman.test
> ### Title: Friedman Rank Sum Test
> ### Aliases: friedman.test friedman.test.default friedman.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> ## Hollander & Wolfe (1973), p. 140ff.
> ## Comparison of three methods ("round out", "narrow angle", and
> ## "wide angle") for rounding first base. For each of 18 players
> ## and the three method, the average time of two runs from a point on
> ## the first base line 35ft from home plate to a point 15ft short of
> ## second base is recorded.
> RoundingTimes <-
+ matrix(c(5.40, 5.50, 5.55,
+ 5.85, 5.70, 5.75,
+ 5.20, 5.60, 5.50,
+ 5.55, 5.50, 5.40,
+ 5.90, 5.85, 5.70,
+ 5.45, 5.55, 5.60,
+ 5.40, 5.40, 5.35,
+ 5.45, 5.50, 5.35,
+ 5.25, 5.15, 5.00,
+ 5.85, 5.80, 5.70,
+ 5.25, 5.20, 5.10,
+ 5.65, 5.55, 5.45,
+ 5.60, 5.35, 5.45,
+ 5.05, 5.00, 4.95,
+ 5.50, 5.50, 5.40,
+ 5.45, 5.55, 5.50,
+ 5.55, 5.55, 5.35,
+ 5.45, 5.50, 5.55,
+ 5.50, 5.45, 5.25,
+ 5.65, 5.60, 5.40,
+ 5.70, 5.65, 5.55,
+ 6.30, 6.30, 6.25),
+ nrow = 22,
+ byrow = TRUE,
+ dimnames = list(1 : 22,
+ c("Round Out", "Narrow Angle", "Wide Angle")))
> friedman.test(RoundingTimes)
Friedman rank sum test
data: RoundingTimes
Friedman chi-squared = 11.1429, df = 2, p-value = 0.003805
> ## => strong evidence against the null that the methods are equivalent
> ## with respect to speed
>
> wb <- aggregate(warpbreaks$breaks,
+ by = list(w = warpbreaks$wool,
+ t = warpbreaks$tension),
+ FUN = mean)
> wb
w t x
1 A L 44.55556
2 B L 28.22222
3 A M 24.00000
4 B M 28.77778
5 A H 24.55556
6 B H 18.77778
> friedman.test(wb$x, wb$w, wb$t)
Friedman rank sum test
data: wb$x, wb$w and wb$t
Friedman chi-squared = 0.3333, df = 1, p-value = 0.5637
> friedman.test(x ~ w | t, data = wb)
Friedman rank sum test
data: x and w and t
Friedman chi-squared = 0.3333, df = 1, p-value = 0.5637
>
>
>
> cleanEx()
> nameEx("ftable")
> ### * ftable
>
> flush(stderr()); flush(stdout())
>
> ### Name: ftable
> ### Title: Flat Contingency Tables
> ### Aliases: ftable ftable.default print.ftable
> ### Keywords: category
>
> ### ** Examples
>
> ## Start with a contingency table.
> ftable(Titanic, row.vars = 1:3)
Survived No Yes
Class Sex Age
1st Male Child 0 5
Adult 118 57
Female Child 0 1
Adult 4 140
2nd Male Child 0 11
Adult 154 14
Female Child 0 13
Adult 13 80
3rd Male Child 35 13
Adult 387 75
Female Child 17 14
Adult 89 76
Crew Male Child 0 0
Adult 670 192
Female Child 0 0
Adult 3 20
> ftable(Titanic, row.vars = 1:2, col.vars = "Survived")
Survived No Yes
Class Sex
1st Male 118 62
Female 4 141
2nd Male 154 25
Female 13 93
3rd Male 422 88
Female 106 90
Crew Male 670 192
Female 3 20
> ftable(Titanic, row.vars = 2:1, col.vars = "Survived")
Survived No Yes
Sex Class
Male 1st 118 62
2nd 154 25
3rd 422 88
Crew 670 192
Female 1st 4 141
2nd 13 93
3rd 106 90
Crew 3 20
>
> ## Start with a data frame.
> x <- ftable(mtcars[c("cyl", "vs", "am", "gear")])
> x
gear 3 4 5
cyl vs am
4 0 0 0 0 0
1 0 0 1
1 0 1 2 0
1 0 6 1
6 0 0 0 0 0
1 0 2 1
1 0 2 2 0
1 0 0 0
8 0 0 12 0 0
1 0 0 2
1 0 0 0 0
1 0 0 0
> ftable(x, row.vars = c(2, 4))
cyl 4 6 8
am 0 1 0 1 0 1
vs gear
0 3 0 0 0 0 12 0
4 0 0 0 2 0 0
5 0 1 0 1 0 2
1 3 1 0 2 0 0 0
4 2 6 2 0 0 0
5 0 1 0 0 0 0
>
> ## Start with expressions, use table()'s "dnn" to change labels
> ftable(mtcars$cyl, mtcars$vs, mtcars$am, mtcars$gear, row.vars = c(2, 4),
+ dnn = c("Cylinders", "V/S", "Transmission", "Gears"))
Cylinders 4 6 8
Transmission 0 1 0 1 0 1
V/S Gears
0 3 0 0 0 0 12 0
4 0 0 0 2 0 0
5 0 1 0 1 0 2
1 3 1 0 2 0 0 0
4 2 6 2 0 0 0
5 0 1 0 0 0 0
>
>
>
> cleanEx()
> nameEx("ftable.formula")
> ### * ftable.formula
>
> flush(stderr()); flush(stdout())
>
> ### Name: ftable.formula
> ### Title: Formula Notation for Flat Contingency Tables
> ### Aliases: ftable.formula
> ### Keywords: category
>
> ### ** Examples
>
> Titanic
, , Age = Child, Survived = No
Sex
Class Male Female
1st 0 0
2nd 0 0
3rd 35 17
Crew 0 0
, , Age = Adult, Survived = No
Sex
Class Male Female
1st 118 4
2nd 154 13
3rd 387 89
Crew 670 3
, , Age = Child, Survived = Yes
Sex
Class Male Female
1st 5 1
2nd 11 13
3rd 13 14
Crew 0 0
, , Age = Adult, Survived = Yes
Sex
Class Male Female
1st 57 140
2nd 14 80
3rd 75 76
Crew 192 20
> x <- ftable(Survived ~ ., data = Titanic)
> x
Survived No Yes
Class Sex Age
1st Male Child 0 5
Adult 118 57
Female Child 0 1
Adult 4 140
2nd Male Child 0 11
Adult 154 14
Female Child 0 13
Adult 13 80
3rd Male Child 35 13
Adult 387 75
Female Child 17 14
Adult 89 76
Crew Male Child 0 0
Adult 670 192
Female Child 0 0
Adult 3 20
> ftable(Sex ~ Class + Age, data = x)
Sex Male Female
Class Age
1st Child 5 1
Adult 175 144
2nd Child 11 13
Adult 168 93
3rd Child 48 31
Adult 462 165
Crew Child 0 0
Adult 862 23
>
>
>
> cleanEx()
> nameEx("getInitial")
> ### * getInitial
>
> flush(stderr()); flush(stdout())
>
> ### Name: getInitial
> ### Title: Get Initial Parameter Estimates
> ### Aliases: getInitial getInitial.default getInitial.formula
> ### getInitial.selfStart
> ### Keywords: models nonlinear manip
>
> ### ** Examples
>
> PurTrt <- Puromycin[ Puromycin$state == "treated", ]
> print(getInitial( rate ~ SSmicmen( conc, Vm, K ), PurTrt ), digits = 3)
Vm K
212.6837 0.0641
>
>
>
> cleanEx()
> nameEx("glm")
> ### * glm
>
> flush(stderr()); flush(stdout())
>
> ### Name: glm
> ### Title: Fitting Generalized Linear Models
> ### Aliases: glm glm.fit weights.glm print.glm
> ### Keywords: models regression
>
> ### ** Examples
>
> ## Dobson (1990) Page 93: Randomized Controlled Trial :
> counts <- c(18,17,15,20,10,20,25,13,12)
> outcome <- gl(3,1,9)
> treatment <- gl(3,3)
> print(d.AD <- data.frame(treatment, outcome, counts))
treatment outcome counts
1 1 1 18
2 1 2 17
3 1 3 15
4 2 1 20
5 2 2 10
6 2 3 20
7 3 1 25
8 3 2 13
9 3 3 12
> glm.D93 <- glm(counts ~ outcome + treatment, family=poisson())
> anova(glm.D93)
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev
NULL 8 10.5814
outcome 2 5.4523 6 5.1291
treatment 2 0.0000 4 5.1291
> summary(glm.D93)
Call:
glm(formula = counts ~ outcome + treatment, family = poisson())
Deviance Residuals:
1 2 3 4 5 6 7 8
-0.67125 0.96272 -0.16965 -0.21999 -0.95552 1.04939 0.84715 -0.09167
9
-0.96656
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 3.045e+00 1.709e-01 17.815 <2e-16 ***
outcome2 -4.543e-01 2.022e-01 -2.247 0.0246 *
outcome3 -2.930e-01 1.927e-01 -1.520 0.1285
treatment2 1.338e-15 2.000e-01 0.000 1.0000
treatment3 1.421e-15 2.000e-01 0.000 1.0000
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for poisson family taken to be 1)
Null deviance: 10.5814 on 8 degrees of freedom
Residual deviance: 5.1291 on 4 degrees of freedom
AIC: 56.761
Number of Fisher Scoring iterations: 4
>
> ## an example with offsets from Venables & Ripley (2002, p.189)
> utils::data(anorexia, package="MASS")
>
> anorex.1 <- glm(Postwt ~ Prewt + Treat + offset(Prewt),
+ family = gaussian, data = anorexia)
> summary(anorex.1)
Call:
glm(formula = Postwt ~ Prewt + Treat + offset(Prewt), family = gaussian,
data = anorexia)
Deviance Residuals:
Min 1Q Median 3Q Max
-14.1083 -4.2773 -0.5484 5.4838 15.2922
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 49.7711 13.3910 3.717 0.000410 ***
Prewt -0.5655 0.1612 -3.509 0.000803 ***
TreatCont -4.0971 1.8935 -2.164 0.033999 *
TreatFT 4.5631 2.1333 2.139 0.036035 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for gaussian family taken to be 48.69504)
Null deviance: 4525.4 on 71 degrees of freedom
Residual deviance: 3311.3 on 68 degrees of freedom
AIC: 489.97
Number of Fisher Scoring iterations: 2
>
> # A Gamma example, from McCullagh & Nelder (1989, pp. 300-2)
> clotting <- data.frame(
+ u = c(5,10,15,20,30,40,60,80,100),
+ lot1 = c(118,58,42,35,27,25,21,19,18),
+ lot2 = c(69,35,26,21,18,16,13,12,12))
> summary(glm(lot1 ~ log(u), data=clotting, family=Gamma))
Call:
glm(formula = lot1 ~ log(u), family = Gamma, data = clotting)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.04008 -0.03756 -0.02637 0.02905 0.08641
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.0165544 0.0009275 -17.85 4.28e-07 ***
log(u) 0.0153431 0.0004150 36.98 2.75e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for Gamma family taken to be 0.002446059)
Null deviance: 3.512826 on 8 degrees of freedom
Residual deviance: 0.016730 on 7 degrees of freedom
AIC: 37.99
Number of Fisher Scoring iterations: 3
> summary(glm(lot2 ~ log(u), data=clotting, family=Gamma))
Call:
glm(formula = lot2 ~ log(u), family = Gamma, data = clotting)
Deviance Residuals:
Min 1Q Median 3Q Max
-0.05574 -0.02925 0.01030 0.01714 0.06371
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.0239085 0.0013265 -18.02 4.00e-07 ***
log(u) 0.0235992 0.0005768 40.91 1.36e-09 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for Gamma family taken to be 0.001813354)
Null deviance: 3.118557 on 8 degrees of freedom
Residual deviance: 0.012672 on 7 degrees of freedom
AIC: 27.032
Number of Fisher Scoring iterations: 3
>
> ## Not run:
> ##D ## for an example of the use of a terms object as a formula
> ##D demo(glm.vr)
> ## End(Not run)
>
>
> cleanEx()
> nameEx("glm.control")
> ### * glm.control
>
> flush(stderr()); flush(stdout())
>
> ### Name: glm.control
> ### Title: Auxiliary for Controlling GLM Fitting
> ### Aliases: glm.control
> ### Keywords: optimize models
>
> ### ** Examples
>
> ### A variation on example(glm) :
>
> ## Annette Dobson's example ...
> counts <- c(18,17,15,20,10,20,25,13,12)
> outcome <- gl(3,1,9)
> treatment <- gl(3,3)
> oo <- options(digits = 12) # to see more when tracing :
> glm.D93X <- glm(counts ~ outcome + treatment, family=poisson(),
+ trace = TRUE, epsilon = 1e-14)
Deviance = 5.17971906292 Iterations - 1
Deviance = 5.12914710976 Iterations - 2
Deviance = 5.129141077 Iterations - 3
Deviance = 5.129141077 Iterations - 4
Deviance = 5.129141077 Iterations - 5
> options(oo)
> coef(glm.D93X) # the last two are closer to 0 than in ?glm's glm.D93
(Intercept) outcome2 outcome3 treatment2 treatment3
3.044522e+00 -4.542553e-01 -2.929871e-01 7.019758e-16 7.549517e-16
>
>
>
> cleanEx()
> nameEx("hclust")
> ### * hclust
>
> flush(stderr()); flush(stdout())
>
> ### Name: hclust
> ### Title: Hierarchical Clustering
> ### Aliases: hclust plot.hclust plclust print.hclust
> ### Keywords: multivariate cluster
>
> ### ** Examples
>
> require(graphics)
>
> hc <- hclust(dist(USArrests), "ave")
> plot(hc)
> plot(hc, hang = -1)
>
> ## Do the same with centroid clustering and squared Euclidean distance,
> ## cut the tree into ten clusters and reconstruct the upper part of the
> ## tree from the cluster centers.
> hc <- hclust(dist(USArrests)^2, "cen")
> memb <- cutree(hc, k = 10)
> cent <- NULL
> for(k in 1:10){
+ cent <- rbind(cent, colMeans(USArrests[memb == k, , drop = FALSE]))
+ }
> hc1 <- hclust(dist(cent)^2, method = "cen", members = table(memb))
> opar <- par(mfrow = c(1, 2))
> plot(hc, labels = FALSE, hang = -1, main = "Original Tree")
> plot(hc1, labels = FALSE, hang = -1, main = "Re-start from 10 clusters")
> par(opar)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("heatmap")
> ### * heatmap
>
> flush(stderr()); flush(stdout())
>
> ### Name: heatmap
> ### Title: Draw a Heat Map
> ### Aliases: heatmap
> ### Keywords: hplot
>
> ### ** Examples
>
> require(graphics); require(grDevices)
> x <- as.matrix(mtcars)
> rc <- rainbow(nrow(x), start=0, end=.3)
> cc <- rainbow(ncol(x), start=0, end=.3)
> hv <- heatmap(x, col = cm.colors(256), scale="column",
+ RowSideColors = rc, ColSideColors = cc, margins=c(5,10),
+ xlab = "specification variables", ylab= "Car Models",
+ main = "heatmap(<Mtcars data>, ..., scale = \"column\")")
> utils::str(hv) # the two re-ordering index vectors
List of 4
$ rowInd: int [1:32] 31 17 16 15 5 25 29 24 7 6 ...
$ colInd: int [1:11] 2 9 8 11 6 5 10 7 1 4 ...
$ Rowv : NULL
$ Colv : NULL
>
> ## no column dendrogram (nor reordering) at all:
> heatmap(x, Colv = NA, col = cm.colors(256), scale="column",
+ RowSideColors = rc, margins=c(5,10),
+ xlab = "specification variables", ylab= "Car Models",
+ main = "heatmap(<Mtcars data>, ..., scale = \"column\")")
> ## Don't show:
> ## no row dendrogram (nor reordering) at all:
> heatmap(x, Rowv = NA, col = cm.colors(256), scale="column",
+ ColSideColors = cc, margins=c(5,10),
+ xlab = "xlab", ylab= "ylab")# no main
> ## End Don't show
> ## "no nothing"
> heatmap(x, Rowv = NA, Colv = NA, scale="column",
+ main = "heatmap(*, NA, NA) ~= image(t(x))")
>
> round(Ca <- cor(attitude), 2)
rating complaints privileges learning raises critical advance
rating 1.00 0.83 0.43 0.62 0.59 0.16 0.16
complaints 0.83 1.00 0.56 0.60 0.67 0.19 0.22
privileges 0.43 0.56 1.00 0.49 0.45 0.15 0.34
learning 0.62 0.60 0.49 1.00 0.64 0.12 0.53
raises 0.59 0.67 0.45 0.64 1.00 0.38 0.57
critical 0.16 0.19 0.15 0.12 0.38 1.00 0.28
advance 0.16 0.22 0.34 0.53 0.57 0.28 1.00
> symnum(Ca) # simple graphic
rt cm p l rs cr a
rating 1
complaints + 1
privileges . . 1
learning , . . 1
raises . , . , 1
critical . 1
advance . . . 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> heatmap(Ca, symm = TRUE, margins=c(6,6))# with reorder()
> heatmap(Ca, Rowv=FALSE, symm = TRUE, margins=c(6,6))# _NO_ reorder()
>
> ## For variable clustering, rather use distance based on cor():
> symnum( cU <- cor(USJudgeRatings) )
CO I DM DI CF DE PR F O W PH R
CONT 1
INTG 1
DMNR B 1
DILG + + 1
CFMG + + B 1
DECI + + B B 1
PREP + + B B B 1
FAMI + + B * * B 1
ORAL * * B B * B B 1
WRIT * + B * * B B B 1
PHYS , , + + + + + + + 1
RTEN * * * * * B * B B * 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
>
> hU <- heatmap(cU, Rowv = FALSE, symm = TRUE, col = topo.colors(16),
+ distfun = function(c) as.dist(1 - c), keep.dendro = TRUE)
> ## The Correlation matrix with same reordering:
> round(100 * cU[hU[[1]], hU[[2]]])
CONT INTG DMNR PHYS DILG CFMG DECI RTEN ORAL WRIT PREP FAMI
CONT 100 -13 -15 5 1 14 9 -3 -1 -4 1 -3
INTG -13 100 96 74 87 81 80 94 91 91 88 87
DMNR -15 96 100 79 84 81 80 94 91 89 86 84
PHYS 5 74 79 100 81 88 87 91 89 86 85 84
DILG 1 87 84 81 100 96 96 93 95 96 98 96
CFMG 14 81 81 88 96 100 98 93 95 94 96 94
DECI 9 80 80 87 96 98 100 92 95 95 96 94
RTEN -3 94 94 91 93 93 92 100 98 97 95 94
ORAL -1 91 91 89 95 95 95 98 100 99 98 98
WRIT -4 91 89 86 96 94 95 97 99 100 99 99
PREP 1 88 86 85 98 96 96 95 98 99 100 99
FAMI -3 87 84 84 96 94 94 94 98 99 99 100
> ## The column dendrogram:
> utils::str(hU$Colv)
--[dendrogram w/ 2 branches and 12 members at h = 1.15]
|--leaf "CONT"
`--[dendrogram w/ 2 branches and 11 members at h = 0.258]
|--[dendrogram w/ 2 branches and 2 members at h = 0.0354]
| |--leaf "INTG"
| `--leaf "DMNR"
`--[dendrogram w/ 2 branches and 9 members at h = 0.187]
|--leaf "PHYS"
`--[dendrogram w/ 2 branches and 8 members at h = 0.075]
|--[dendrogram w/ 2 branches and 3 members at h = 0.0438]
| |--leaf "DILG"
| `--[dendrogram w/ 2 branches and 2 members at h = 0.0189]
| |--leaf "CFMG"
| `--leaf "DECI"
`--[dendrogram w/ 2 branches and 5 members at h = 0.0584]
|--leaf "RTEN"
`--[dendrogram w/ 2 branches and 4 members at h = 0.0187]
|--[dendrogram w/ 2 branches and 2 members at h = 0.00657]
| |--leaf "ORAL"
| `--leaf "WRIT"
`--[dendrogram w/ 2 branches and 2 members at h = 0.0101]
|--leaf "PREP"
`--leaf "FAMI"
>
>
>
> cleanEx()
> nameEx("identify.hclust")
> ### * identify.hclust
>
> flush(stderr()); flush(stdout())
>
> ### Name: identify.hclust
> ### Title: Identify Clusters in a Dendrogram
> ### Aliases: identify.hclust
> ### Keywords: cluster iplot
>
> ### ** Examples
> ## Not run:
> ##D require(graphics)
> ##D
> ##D hca <- hclust(dist(USArrests))
> ##D plot(hca)
> ##D (x <- identify(hca)) ## Terminate with 2nd mouse button !!
> ##D
> ##D hci <- hclust(dist(iris[,1:4]))
> ##D plot(hci)
> ##D identify(hci, function(k) print(table(iris[k,5])))
> ##D
> ##D # open a new device (one for dendrogram, one for bars):
> ##D get(getOption("device"))() # << make that narrow (& small)
> ##D # and *beside* 1st one
> ##D nD <- dev.cur() # to be for the barplot
> ##D dev.set(dev.prev())# old one for dendrogram
> ##D plot(hci)
> ##D ## select subtrees in dendrogram and "see" the species distribution:
> ##D identify(hci, function(k) barplot(table(iris[k,5]),col=2:4), DEV.FUN = nD)
> ## End(Not run)
>
>
> cleanEx()
> nameEx("influence.measures")
> ### * influence.measures
>
> flush(stderr()); flush(stdout())
>
> ### Name: influence.measures
> ### Title: Regression Deletion Diagnostics
> ### Aliases: influence.measures print.infl summary.infl hat hatvalues
> ### hatvalues.lm rstandard rstandard.lm rstandard.glm rstudent
> ### rstudent.lm rstudent.glm dfbeta dfbeta.lm dfbetas dfbetas.lm dffits
> ### covratio cooks.distance cooks.distance.lm cooks.distance.glm
> ### Keywords: regression
>
> ### ** Examples
>
> require(graphics)
>
> ## Analysis of the life-cycle savings data
> ## given in Belsley, Kuh and Welsch.
> lm.SR <- lm(sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings)
>
> inflm.SR <- influence.measures(lm.SR)
> which(apply(inflm.SR$is.inf, 1, any))
Chile United States Zambia Libya
7 44 46 49
> # which observations 'are' influential
> summary(inflm.SR) # only these
Potentially influential observations of
lm(formula = sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings) :
dfb.1_ dfb.pp15 dfb.pp75 dfb.dpi dfb.ddpi dffit cov.r cook.d
Chile -0.20 0.13 0.22 -0.02 0.12 -0.46 0.65_* 0.04
United States 0.07 -0.07 0.04 -0.23 -0.03 -0.25 1.66_* 0.01
Zambia 0.16 -0.08 -0.34 0.09 0.23 0.75 0.51_* 0.10
Libya 0.55 -0.48 -0.38 -0.02 -1.02_* -1.16_* 2.09_* 0.27
hat
Chile 0.04
United States 0.33_*
Zambia 0.06
Libya 0.53_*
> inflm.SR # all
Influence measures of
lm(formula = sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings) :
dfb.1_ dfb.pp15 dfb.pp75 dfb.dpi dfb.ddpi dffit cov.r
Australia 0.01232 -0.010436 -0.02653 0.04534 -0.000159 0.0627 1.193
Austria -0.01005 0.005944 0.04084 -0.03672 -0.008182 0.0632 1.268
Belgium -0.06416 0.051496 0.12070 -0.03472 -0.007265 0.1878 1.176
Bolivia 0.00578 -0.012703 -0.02253 0.03185 0.040642 -0.0597 1.224
Brazil 0.08973 -0.061626 -0.17907 0.11997 0.068457 0.2646 1.082
Canada 0.00541 -0.006750 0.01021 -0.03531 -0.002649 -0.0390 1.328
Chile -0.19941 0.132652 0.21979 -0.01998 0.120007 -0.4554 0.655
China 0.02112 -0.005726 -0.08311 0.05180 0.110627 0.2008 1.150
Colombia 0.03910 -0.052261 -0.02464 0.00168 0.009084 -0.0960 1.167
Costa Rica -0.23367 0.284279 0.14243 0.05638 -0.032824 0.4049 0.968
Denmark -0.04051 0.020927 0.04653 0.15220 0.048854 0.3845 0.934
Ecuador 0.07176 -0.095239 -0.06067 0.01950 0.047786 -0.1695 1.139
Finland -0.11350 0.111328 0.11695 -0.04364 -0.017132 -0.1464 1.203
France -0.16600 0.147054 0.21900 -0.02942 0.023952 0.2765 1.226
Germany -0.00802 0.008224 0.00835 -0.00697 -0.000293 -0.0152 1.226
Greece -0.14820 0.163938 0.02861 0.15713 -0.059599 -0.2811 1.140
Guatamala 0.01552 -0.054853 0.00614 0.00585 0.097217 -0.2305 1.085
Honduras -0.00226 0.009845 -0.01020 0.00812 -0.001887 0.0482 1.186
Iceland 0.24789 -0.273549 -0.23265 -0.12555 0.184698 -0.4768 0.866
India 0.02105 -0.015769 -0.01439 -0.01374 -0.018958 0.0381 1.202
Ireland -0.31001 0.296238 0.48156 -0.25733 -0.093317 0.5216 1.268
Italy 0.06619 -0.070974 0.00307 -0.06999 -0.028648 0.1388 1.162
Japan 0.63987 -0.656139 -0.67390 0.14610 0.388603 0.8597 1.085
Korea -0.16897 0.135087 0.21895 0.00511 -0.169492 -0.4303 0.870
Luxembourg -0.06827 0.068883 0.04380 -0.02797 0.049134 -0.1401 1.196
Malta 0.03652 -0.048756 0.00791 -0.08659 0.153014 0.2386 1.128
Norway 0.00222 -0.000350 -0.00611 -0.01594 -0.001462 -0.0522 1.168
Netherlands 0.01395 -0.016738 -0.01186 0.00433 0.022591 0.0366 1.229
New Zealand -0.06002 0.065105 0.09412 -0.02638 -0.064740 0.1469 1.134
Nicaragua -0.01209 0.017904 0.00972 -0.00474 -0.010467 0.0397 1.174
Panama 0.02828 -0.053342 0.01446 -0.03467 -0.007889 -0.1775 1.067
Paraguay -0.23227 0.164160 0.15826 0.14361 0.270478 -0.4655 0.873
Peru -0.07182 0.146695 0.09148 -0.08585 -0.287184 0.4811 0.831
Philippines -0.15707 0.226807 0.15743 -0.11140 -0.170674 0.4884 0.818
Portugal -0.02140 0.025514 -0.00380 0.03991 -0.028011 -0.0690 1.233
South Africa 0.02218 -0.020296 -0.00672 -0.02049 -0.016326 0.0343 1.195
South Rhodesia 0.14390 -0.134719 -0.09245 -0.06956 -0.057920 0.1607 1.313
Spain -0.03035 0.031311 0.00394 0.03512 0.005340 -0.0526 1.208
Sweden 0.10098 -0.081623 -0.06166 -0.25528 -0.013316 -0.4526 1.086
Switzerland 0.04323 -0.046492 -0.04364 0.09093 -0.018828 0.1903 1.147
Turkey -0.01092 -0.011985 0.02645 0.00161 0.025138 -0.1445 1.100
Tunisia 0.07377 -0.104998 -0.07727 0.04439 0.103058 -0.2177 1.131
United Kingdom 0.04671 -0.035840 -0.17129 0.12554 0.100314 -0.2722 1.189
United States 0.06910 -0.072886 0.03745 -0.23312 -0.032729 -0.2510 1.655
Venezuela -0.05083 0.100805 -0.03366 0.11366 -0.124486 0.3071 1.095
Zambia 0.16361 -0.079172 -0.33899 0.09406 0.228232 0.7482 0.512
Jamaica 0.10958 -0.100223 -0.05722 -0.00703 -0.295461 -0.3456 1.200
Uruguay -0.13403 0.128805 0.02953 0.13132 0.099591 -0.2051 1.187
Libya 0.55074 -0.483244 -0.37974 -0.01937 -1.024477 -1.1601 2.091
Malaysia 0.03684 -0.061126 0.03235 -0.04956 -0.072294 -0.2126 1.113
cook.d hat inf
Australia 8.04e-04 0.0677
Austria 8.18e-04 0.1204
Belgium 7.15e-03 0.0875
Bolivia 7.28e-04 0.0895
Brazil 1.40e-02 0.0696
Canada 3.11e-04 0.1584
Chile 3.78e-02 0.0373 *
China 8.16e-03 0.0780
Colombia 1.88e-03 0.0573
Costa Rica 3.21e-02 0.0755
Denmark 2.88e-02 0.0627
Ecuador 5.82e-03 0.0637
Finland 4.36e-03 0.0920
France 1.55e-02 0.1362
Germany 4.74e-05 0.0874
Greece 1.59e-02 0.0966
Guatamala 1.07e-02 0.0605
Honduras 4.74e-04 0.0601
Iceland 4.35e-02 0.0705
India 2.97e-04 0.0715
Ireland 5.44e-02 0.2122
Italy 3.92e-03 0.0665
Japan 1.43e-01 0.2233
Korea 3.56e-02 0.0608
Luxembourg 3.99e-03 0.0863
Malta 1.15e-02 0.0794
Norway 5.56e-04 0.0479
Netherlands 2.74e-04 0.0906
New Zealand 4.38e-03 0.0542
Nicaragua 3.23e-04 0.0504
Panama 6.33e-03 0.0390
Paraguay 4.16e-02 0.0694
Peru 4.40e-02 0.0650
Philippines 4.52e-02 0.0643
Portugal 9.73e-04 0.0971
South Africa 2.41e-04 0.0651
South Rhodesia 5.27e-03 0.1608
Spain 5.66e-04 0.0773
Sweden 4.06e-02 0.1240
Switzerland 7.33e-03 0.0736
Turkey 4.22e-03 0.0396
Tunisia 9.56e-03 0.0746
United Kingdom 1.50e-02 0.1165
United States 1.28e-02 0.3337 *
Venezuela 1.89e-02 0.0863
Zambia 9.66e-02 0.0643 *
Jamaica 2.40e-02 0.1408
Uruguay 8.53e-03 0.0979
Libya 2.68e-01 0.5315 *
Malaysia 9.11e-03 0.0652
> plot(rstudent(lm.SR) ~ hatvalues(lm.SR)) # recommended by some
>
> ## The 'infl' argument is not needed, but avoids recomputation:
> rs <- rstandard(lm.SR)
> iflSR <- influence(lm.SR)
> identical(rs, rstandard(lm.SR, infl = iflSR))
[1] TRUE
> ## to "see" the larger values:
> 1000 * round(dfbetas(lm.SR, infl = iflSR), 3)
(Intercept) pop15 pop75 dpi ddpi
Australia 12 -10 -27 45 0
Austria -10 6 41 -37 -8
Belgium -64 51 121 -35 -7
Bolivia 6 -13 -23 32 41
Brazil 90 -62 -179 120 68
Canada 5 -7 10 -35 -3
Chile -199 133 220 -20 120
China 21 -6 -83 52 111
Colombia 39 -52 -25 2 9
Costa Rica -234 284 142 56 -33
Denmark -41 21 47 152 49
Ecuador 72 -95 -61 20 48
Finland -113 111 117 -44 -17
France -166 147 219 -29 24
Germany -8 8 8 -7 0
Greece -148 164 29 157 -60
Guatamala 16 -55 6 6 97
Honduras -2 10 -10 8 -2
Iceland 248 -274 -233 -126 185
India 21 -16 -14 -14 -19
Ireland -310 296 482 -257 -93
Italy 66 -71 3 -70 -29
Japan 640 -656 -674 146 389
Korea -169 135 219 5 -169
Luxembourg -68 69 44 -28 49
Malta 37 -49 8 -87 153
Norway 2 0 -6 -16 -1
Netherlands 14 -17 -12 4 23
New Zealand -60 65 94 -26 -65
Nicaragua -12 18 10 -5 -10
Panama 28 -53 14 -35 -8
Paraguay -232 164 158 144 270
Peru -72 147 91 -86 -287
Philippines -157 227 157 -111 -171
Portugal -21 26 -4 40 -28
South Africa 22 -20 -7 -20 -16
South Rhodesia 144 -135 -92 -70 -58
Spain -30 31 4 35 5
Sweden 101 -82 -62 -255 -13
Switzerland 43 -46 -44 91 -19
Turkey -11 -12 26 2 25
Tunisia 74 -105 -77 44 103
United Kingdom 47 -36 -171 126 100
United States 69 -73 37 -233 -33
Venezuela -51 101 -34 114 -124
Zambia 164 -79 -339 94 228
Jamaica 110 -100 -57 -7 -295
Uruguay -134 129 30 131 100
Libya 551 -483 -380 -19 -1024
Malaysia 37 -61 32 -50 -72
>
> ## Huber's data [Atkinson 1985]
> xh <- c(-4:0, 10)
> yh <- c(2.48, .73, -.04, -1.44, -1.32, 0)
> summary(lmH <- lm(yh ~ xh))
Call:
lm(formula = yh ~ xh)
Residuals:
1 2 3 4 5 6
2.0858 0.4173 -0.2713 -1.5898 -1.3883 0.7463
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 0.06833 0.63279 0.108 0.919
xh -0.08146 0.13595 -0.599 0.581
Residual standard error: 1.55 on 4 degrees of freedom
Multiple R-squared: 0.08237, Adjusted R-squared: -0.147
F-statistic: 0.3591 on 1 and 4 DF, p-value: 0.5813
> (im <- influence.measures(lmH))
Influence measures of
lm(formula = yh ~ xh) :
dfb.1_ dfb.xh dffit cov.r cook.d hat inf
1 1.1124 -9.56e-01 1.4667 0.329 0.52004 0.290 *
2 0.1261 -8.13e-02 0.1500 2.218 0.01464 0.236
3 -0.0775 3.33e-02 -0.0843 2.173 0.00469 0.197
4 -0.5320 1.14e-01 -0.5442 1.000 0.13454 0.174
5 -0.4361 1.78e-17 -0.4361 1.230 0.09627 0.167
6 8.5733 1.84e+01 20.3160 0.255 26.39859 0.936 *
> plot(xh,yh, main = "Huber's data: L.S. line and influential obs.")
> abline(lmH); points(xh[im$is.inf], yh[im$is.inf], pch=20, col=2)
>
> ## Irwin's data [Williams 1987]
> xi <- 1:5
> yi <- c(0,2,14,19,30) # number of mice responding to does xi
> mi <- rep(40, 5) # number of mice exposed
> summary(lmI <- glm(cbind(yi, mi -yi) ~ xi, family = binomial))
Call:
glm(formula = cbind(yi, mi - yi) ~ xi, family = binomial)
Deviance Residuals:
1 2 3 4 5
-1.4507 -0.8039 1.6653 -0.4025 -0.3948
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -4.8420 0.6731 -7.194 6.28e-13 ***
xi 1.2173 0.1761 6.913 4.74e-12 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 84.2169 on 4 degrees of freedom
Residual deviance: 5.8421 on 3 degrees of freedom
AIC: 24.486
Number of Fisher Scoring iterations: 4
> signif(cooks.distance(lmI), 3)# ~= Ci in Table 3, p.184
1 2 3 4 5
0.2520 0.2610 1.2900 0.0845 0.3640
> (imI <- influence.measures(lmI))
Influence measures of
glm(formula = cbind(yi, mi - yi) ~ xi, family = binomial) :
dfb.1_ dfb.xi dffit cov.r cook.d hat inf
1 -0.81080 0.7561 -0.815 0.801 0.2522 0.259
2 -0.47926 0.4205 -0.500 2.427 0.2611 0.370
3 1.29804 -0.9219 1.739 0.246 1.2899 0.354 *
4 0.00388 -0.0727 -0.246 3.357 0.0845 0.389 *
5 0.29253 -0.3982 -0.511 5.213 0.3636 0.628 *
> stopifnot(all.equal(imI$infmat[,"cook.d"],
+ cooks.distance(lmI)))
>
>
>
> cleanEx()
> nameEx("integrate")
> ### * integrate
>
> flush(stderr()); flush(stdout())
>
> ### Name: integrate
> ### Title: Integration of One-Dimensional Functions
> ### Aliases: integrate print.integrate
> ### Keywords: math utilities
>
> ### ** Examples
>
> integrate(dnorm, -1.96, 1.96)
0.9500042 with absolute error < 1.0e-11
> integrate(dnorm, -Inf, Inf)
1 with absolute error < 9.4e-05
>
> ## a slowly-convergent integral
> integrand <- function(x) {1/((x+1)*sqrt(x))}
> integrate(integrand, lower = 0, upper = Inf)
3.141593 with absolute error < 2.7e-05
>
> ## don't do this if you really want the integral from 0 to Inf
> integrate(integrand, lower = 0, upper = 10)
2.529038 with absolute error < 3e-04
> integrate(integrand, lower = 0, upper = 100000)
3.135268 with absolute error < 4.2e-07
> integrate(integrand, lower = 0, upper = 1000000, stop.on.error = FALSE)
failed with message ‘the integral is probably divergent’
>
> ## some functions do not handle vector input properly
> f <- function(x) 2.0
> try(integrate(f, 0, 1))
Error in integrate(f, 0, 1) :
evaluation of function gave a result of wrong length
> integrate(Vectorize(f), 0, 1) ## correct
2 with absolute error < 2.2e-14
> integrate(function(x) rep(2.0, length(x)), 0, 1) ## correct
2 with absolute error < 2.2e-14
>
> ## integrate can fail if misused
> integrate(dnorm,0,2)
0.4772499 with absolute error < 5.3e-15
> integrate(dnorm,0,20)
0.5 with absolute error < 3.7e-05
> integrate(dnorm,0,200)
0.5 with absolute error < 1.6e-07
> integrate(dnorm,0,2000)
0.5 with absolute error < 4.4e-06
> integrate(dnorm,0,20000) ## fails on many systems
0 with absolute error < 0
> integrate(dnorm,0,Inf) ## works
0.5 with absolute error < 4.7e-05
>
>
>
> cleanEx()
> nameEx("interaction.plot")
> ### * interaction.plot
>
> flush(stderr()); flush(stdout())
>
> ### Name: interaction.plot
> ### Title: Two-way Interaction Plot
> ### Aliases: interaction.plot
> ### Keywords: hplot
>
> ### ** Examples
>
> require(graphics)
>
> with(ToothGrowth, {
+ interaction.plot(dose, supp, len, fixed=TRUE)
+ dose <- ordered(dose)
+ interaction.plot(dose, supp, len, fixed=TRUE, col = 2:3, leg.bty = "o")
+ interaction.plot(dose, supp, len, fixed=TRUE, col = 2:3, type = "p")
+ })
>
> with(OrchardSprays, {
+ interaction.plot(treatment, rowpos, decrease)
+ interaction.plot(rowpos, treatment, decrease, cex.axis=0.8)
+ ## order the rows by their mean effect
+ rowpos <- factor(rowpos,
+ levels = sort.list(tapply(decrease, rowpos, mean)))
+ interaction.plot(rowpos, treatment, decrease, col = 2:9, lty = 1)
+ })
>
> with(esoph, {
+ interaction.plot(agegp, alcgp, ncases/ncontrols, main = "'esoph' Data")
+ interaction.plot(agegp, tobgp, ncases/ncontrols, trace.label="tobacco",
+ fixed=TRUE, xaxt = "n")
+ })
> ## deal with NAs:
> esoph[66,] # second to last age group: 65-74
agegp alcgp tobgp ncases ncontrols
66 65-74 0-39g/day 30+ 0 2
> esophNA <- esoph; esophNA$ncases[66] <- NA
> with(esophNA, {
+ interaction.plot(agegp, alcgp, ncases/ncontrols, col= 2:5)
+ # doesn't show *last* group either
+ interaction.plot(agegp, alcgp, ncases/ncontrols, col= 2:5, type = "b")
+ ## alternative take non-NA's {"cheating"}
+ interaction.plot(agegp, alcgp, ncases/ncontrols, col= 2:5,
+ fun = function(x) mean(x, na.rm=TRUE),
+ sub = "function(x) mean(x, na.rm=TRUE)")
+ })
> rm(esophNA) # to clear up
>
>
>
> cleanEx()
> nameEx("is.empty")
> ### * is.empty
>
> flush(stderr()); flush(stdout())
>
> ### Name: is.empty.model
> ### Title: Test if a Model's Formula is Empty
> ### Aliases: is.empty.model
> ### Keywords: models
>
> ### ** Examples
>
> y <- rnorm(20)
> is.empty.model(y ~ 0)
[1] TRUE
> is.empty.model(y ~ -1)
[1] TRUE
> is.empty.model(lm(y ~ 0))
[1] TRUE
>
>
>
> cleanEx()
> nameEx("isoreg")
> ### * isoreg
>
> flush(stderr()); flush(stdout())
>
> ### Name: isoreg
> ### Title: Isotonic / Monotone Regression
> ### Aliases: isoreg
> ### Keywords: regression smooth
>
> ### ** Examples
>
> require(graphics)
>
> (ir <- isoreg(c(1,0,4,3,3,5,4,2,0)))
Isotonic regression from isoreg(x = c(1, 0, 4, 3, 3, 5, 4, 2, 0)),
with 2 knots / breaks at obs.nr. 2 9 ;
initially ordered 'x'
and further components List of 4
$ x : num [1:9] 1 2 3 4 5 6 7 8 9
$ y : num [1:9] 1 0 4 3 3 5 4 2 0
$ yf: num [1:9] 0.5 0.5 3 3 3 3 3 3 3
$ yc: num [1:10] 0 1 1 5 8 11 16 20 22 22
> plot(ir, plot.type = "row")
>
> (ir3 <- isoreg(y3 <- c(1,0,4,3,3,5,4,2, 3)))# last "3", not "0"
Isotonic regression from isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3)),
with 3 knots / breaks at obs.nr. 2 5 9 ;
initially ordered 'x'
and further components List of 4
$ x : num [1:9] 1 2 3 4 5 6 7 8 9
$ y : num [1:9] 1 0 4 3 3 5 4 2 3
$ yf: num [1:9] 0.5 0.5 3.33 3.33 3.33 ...
$ yc: num [1:10] 0 1 1 5 8 11 16 20 22 25
> (fi3 <- as.stepfun(ir3))
Step function
Call: isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3))
x[1:3] = 2, 5, 9
4 plateau levels = 0.5, 0.5, 3.3333, 3.5
> (ir4 <- isoreg(1:10, y4 <- c(5, 9, 1:2, 5:8, 3, 8)))
Isotonic regression from isoreg(x = 1:10, y = y4 <- c(5, 9, 1:2, 5:8, 3, 8)),
with 5 knots / breaks at obs.nr. 4 5 6 9 10 ;
initially ordered 'x'
and further components List of 4
$ x : num [1:10] 1 2 3 4 5 6 7 8 9 10
$ y : num [1:10] 5 9 1 2 5 6 7 8 3 8
$ yf: num [1:10] 4.25 4.25 4.25 4.25 5 6 6 6 6 8
$ yc: num [1:11] 0 5 14 15 17 22 28 35 43 46 ...
> cat(sprintf("R^2 = %.2f\n",
+ 1 - sum(residuals(ir4)^2) / ((10-1)*var(y4))))
R^2 = 0.21
>
> ## If you are interested in the knots alone :
> with(ir4, cbind(iKnots, yf[iKnots]))
iKnots
[1,] 4 4.25
[2,] 5 5.00
[3,] 6 6.00
[4,] 9 6.00
[5,] 10 8.00
>
> ## Example of unordered x[] with ties:
> x <- sample((0:30)/8)
> y <- exp(x)
> x. <- round(x) # ties!
> plot(m <- isoreg(x., y))
> stopifnot(all.equal(with(m, yf[iKnots]),
+ as.vector(tapply(y, x., mean))))
>
>
>
> cleanEx()
> nameEx("kernapply")
> ### * kernapply
>
> flush(stderr()); flush(stdout())
>
> ### Name: kernapply
> ### Title: Apply Smoothing Kernel
> ### Aliases: kernapply kernapply.default kernapply.ts kernapply.tskernel
> ### kernapply.vector
> ### Keywords: ts
>
> ### ** Examples
>
> ## see 'kernel' for examples
>
>
>
> cleanEx()
> nameEx("kernel")
> ### * kernel
>
> flush(stderr()); flush(stdout())
>
> ### Name: kernel
> ### Title: Smoothing Kernel Objects
> ### Aliases: kernel bandwidth.kernel df.kernel is.tskernel plot.tskernel
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ## Demonstrate a simple trading strategy for the
> ## financial time series German stock index DAX.
> x <- EuStockMarkets[,1]
> k1 <- kernel("daniell", 50) # a long moving average
> k2 <- kernel("daniell", 10) # and a short one
> plot(k1)
> plot(k2)
> x1 <- kernapply(x, k1)
> x2 <- kernapply(x, k2)
> plot(x)
> lines(x1, col = "red") # go long if the short crosses the long upwards
> lines(x2, col = "green") # and go short otherwise
>
> ## More interesting kernels
> kd <- kernel("daniell", c(3,3))
> kd # note the unusual indexing
Daniell(3,3)
coef[-6] = 0.02041
coef[-5] = 0.04082
coef[-4] = 0.06122
coef[-3] = 0.08163
coef[-2] = 0.10204
coef[-1] = 0.12245
coef[ 0] = 0.14286
coef[ 1] = 0.12245
coef[ 2] = 0.10204
coef[ 3] = 0.08163
coef[ 4] = 0.06122
coef[ 5] = 0.04082
coef[ 6] = 0.02041
> kd[-2:2]
[1] 0.1020408 0.1224490 0.1428571 0.1224490 0.1020408
> plot(kernel("fejer", 100, r=6))
> plot(kernel("modified.daniell", c(7,5,3)))
>
> # Reproduce example 10.4.3 from Brockwell and Davis (1991)
> spectrum(sunspot.year, kernel=kernel("daniell", c(11,7,3)), log="no")
>
>
>
> cleanEx()
> nameEx("kmeans")
> ### * kmeans
>
> flush(stderr()); flush(stdout())
>
> ### Name: kmeans
> ### Title: K-Means Clustering
> ### Aliases: kmeans print.kmeans
> ### Keywords: multivariate cluster
>
> ### ** Examples
>
> require(graphics)
>
> # a 2-dimensional example
> x <- rbind(matrix(rnorm(100, sd = 0.3), ncol = 2),
+ matrix(rnorm(100, mean = 1, sd = 0.3), ncol = 2))
> colnames(x) <- c("x", "y")
> (cl <- kmeans(x, 2))
K-means clustering with 2 clusters of sizes 51, 49
Cluster means:
x y
1 0.94443633 1.01712793
2 0.02149367 0.02121248
Clustering vector:
[1] 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
[38] 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[75] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
Within cluster sum of squares by cluster:
[1] 8.392416 6.525480
(between_SS / total_SS = 75.5 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size"
> plot(x, col = cl$cluster)
> points(cl$centers, col = 1:2, pch = 8, cex=2)
>
> kmeans(x,1)$withinss # if you are interested in that
[1] 60.99123
>
> ## random starts do help here with too many clusters
> (cl <- kmeans(x, 5, nstart = 25))
K-means clustering with 5 clusters of sizes 24, 15, 24, 25, 12
Cluster means:
x y
1 0.1581362 -0.1761590
2 0.8609139 1.3145869
3 0.8043520 0.7805033
4 -0.1096832 0.2106891
5 1.3290081 1.1185534
Clustering vector:
[1] 4 1 4 1 4 4 1 1 4 4 3 1 4 4 1 4 1 4 1 4 1 1 4 4 1 4 1 4 4 1 1 1 4 1 4 4 4
[38] 1 1 1 1 4 4 4 4 4 1 1 1 1 2 3 3 3 3 5 5 5 3 5 2 3 5 2 3 2 3 3 5 2 2 5 2 3
[75] 3 5 2 2 2 2 3 2 5 3 5 3 2 3 3 3 3 5 3 2 3 3 5 3 2 3
Within cluster sum of squares by cluster:
[1] 1.2816507 0.7104553 1.5056575 2.5330710 1.0314888
(between_SS / total_SS = 88.4 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size"
> plot(x, col = cl$cluster)
> points(cl$centers, col = 1:5, pch = 8)
>
>
>
> cleanEx()
> nameEx("kruskal.test")
> ### * kruskal.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: kruskal.test
> ### Title: Kruskal-Wallis Rank Sum Test
> ### Aliases: kruskal.test kruskal.test.default kruskal.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> ## Hollander & Wolfe (1973), 116.
> ## Mucociliary efficiency from the rate of removal of dust in normal
> ## subjects, subjects with obstructive airway disease, and subjects
> ## with asbestosis.
> x <- c(2.9, 3.0, 2.5, 2.6, 3.2) # normal subjects
> y <- c(3.8, 2.7, 4.0, 2.4) # with obstructive airway disease
> z <- c(2.8, 3.4, 3.7, 2.2, 2.0) # with asbestosis
> kruskal.test(list(x, y, z))
Kruskal-Wallis rank sum test
data: list(x, y, z)
Kruskal-Wallis chi-squared = 0.7714, df = 2, p-value = 0.68
> ## Equivalently,
> x <- c(x, y, z)
> g <- factor(rep(1:3, c(5, 4, 5)),
+ labels = c("Normal subjects",
+ "Subjects with obstructive airway disease",
+ "Subjects with asbestosis"))
> kruskal.test(x, g)
Kruskal-Wallis rank sum test
data: x and g
Kruskal-Wallis chi-squared = 0.7714, df = 2, p-value = 0.68
>
> ## Formula interface.
> require(graphics)
> boxplot(Ozone ~ Month, data = airquality)
> kruskal.test(Ozone ~ Month, data = airquality)
Kruskal-Wallis rank sum test
data: Ozone by Month
Kruskal-Wallis chi-squared = 29.2666, df = 4, p-value = 6.901e-06
>
>
>
> cleanEx()
> nameEx("ks.test")
> ### * ks.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: ks.test
> ### Title: Kolmogorov-Smirnov Tests
> ### Aliases: ks.test
> ### Keywords: htest
>
> ### ** Examples
>
> require(graphics)
>
> x <- rnorm(50)
> y <- runif(30)
> # Do x and y come from the same distribution?
> ks.test(x, y)
Two-sample Kolmogorov-Smirnov test
data: x and y
D = 0.48, p-value = 0.0002033
alternative hypothesis: two-sided
> # Does x come from a shifted gamma distribution with shape 3 and rate 2?
> ks.test(x+2, "pgamma", 3, 2) # two-sided, exact
One-sample Kolmogorov-Smirnov test
data: x + 2
D = 0.4096, p-value = 4.227e-08
alternative hypothesis: two-sided
> ks.test(x+2, "pgamma", 3, 2, exact = FALSE)
One-sample Kolmogorov-Smirnov test
data: x + 2
D = 0.4096, p-value = 1.033e-07
alternative hypothesis: two-sided
> ks.test(x+2, "pgamma", 3, 2, alternative = "gr")
One-sample Kolmogorov-Smirnov test
data: x + 2
D^+ = 0.04, p-value = 0.8302
alternative hypothesis: the CDF of x lies above the null hypothesis
>
> # test if x is stochastically larger than x2
> x2 <- rnorm(50, -1)
> plot(ecdf(x), xlim=range(c(x, x2)))
> plot(ecdf(x2), add=TRUE, lty="dashed")
> t.test(x, x2, alternative="g")
Welch Two Sample t-test
data: x and x2
t = 5.6742, df = 96.85, p-value = 7.242e-08
alternative hypothesis: true difference in means is greater than 0
95 percent confidence interval:
0.706975 Inf
sample estimates:
mean of x mean of y
0.1004483 -0.8990693
> wilcox.test(x, x2, alternative="g")
Wilcoxon rank sum test with continuity correction
data: x and x2
W = 1983, p-value = 2.212e-07
alternative hypothesis: true location shift is greater than 0
> ks.test(x, x2, alternative="l")
Two-sample Kolmogorov-Smirnov test
data: x and x2
D^- = 0.5, p-value = 3.727e-06
alternative hypothesis: the CDF of x lies below that of y
>
>
>
> cleanEx()
> nameEx("ksmooth")
> ### * ksmooth
>
> flush(stderr()); flush(stdout())
>
> ### Name: ksmooth
> ### Title: Kernel Regression Smoother
> ### Aliases: ksmooth
> ### Keywords: smooth
>
> ### ** Examples
>
> require(graphics)
>
> with(cars, {
+ plot(speed, dist)
+ lines(ksmooth(speed, dist, "normal", bandwidth=2), col=2)
+ lines(ksmooth(speed, dist, "normal", bandwidth=5), col=3)
+ })
>
>
>
> cleanEx()
> nameEx("lag")
> ### * lag
>
> flush(stderr()); flush(stdout())
>
> ### Name: lag
> ### Title: Lag a Time Series
> ### Aliases: lag lag.default
> ### Keywords: ts
>
> ### ** Examples
>
> lag(ldeaths, 12) # starts one year earlier
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
1973 3035 2552 2704 2554 2014 1655 1721 1524 1596 2074 2199 2512
1974 2933 2889 2938 2497 1870 1726 1607 1545 1396 1787 2076 2837
1975 2787 3891 3179 2011 1636 1580 1489 1300 1356 1653 2013 2823
1976 3102 2294 2385 2444 1748 1554 1498 1361 1346 1564 1640 2293
1977 2815 3137 2679 1969 1870 1633 1529 1366 1357 1570 1535 2491
1978 3084 2605 2573 2143 1693 1504 1461 1354 1333 1492 1781 1915
>
>
>
> cleanEx()
> nameEx("lag.plot")
> ### * lag.plot
>
> flush(stderr()); flush(stdout())
>
> ### Name: lag.plot
> ### Title: Time Series Lag Plots
> ### Aliases: lag.plot
> ### Keywords: hplot ts
>
> ### ** Examples
>
> require(graphics)
>
> lag.plot(nhtemp, 8, diag.col = "forest green")
> lag.plot(nhtemp, 5, main="Average Temperatures in New Haven")
> ## ask defaults to TRUE when we have more than one page:
> lag.plot(nhtemp, 6, layout = c(2,1), asp = NA,
+ main = "New Haven Temperatures", col.main = "blue")
>
> ## Multivariate (but non-stationary! ...)
> lag.plot(freeny.x, lags = 3)
> ## Not run:
> ##D no lines for long series :
> ##D lag.plot(sqrt(sunspots), set = c(1:4, 9:12), pch = ".", col = "gold")
> ## End(Not run)
>
>
>
> cleanEx()
> nameEx("line")
> ### * line
>
> flush(stderr()); flush(stdout())
>
> ### Name: line
> ### Title: Robust Line Fitting
> ### Aliases: line residuals.tukeyline
> ### Keywords: robust regression
>
> ### ** Examples
>
> require(graphics)
>
> plot(cars)
> (z <- line(cars))
Call:
line(cars)
Coefficients:
[1] -26.053 4.421
> abline(coef(z))
> ## Tukey-Anscombe Plot :
> plot(residuals(z) ~ fitted(z), main = deparse(z$call))
>
>
>
> cleanEx()
> nameEx("lm")
> ### * lm
>
> flush(stderr()); flush(stdout())
>
> ### Name: lm
> ### Title: Fitting Linear Models
> ### Aliases: lm print.lm
> ### Keywords: regression
>
> ### ** Examples
>
> require(graphics)
>
> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models".
> ## Page 9: Plant Weight Data.
> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
> group <- gl(2,10,20, labels=c("Ctl","Trt"))
> weight <- c(ctl, trt)
> anova(lm.D9 <- lm(weight ~ group))
Analysis of Variance Table
Response: weight
Df Sum Sq Mean Sq F value Pr(>F)
group 1 0.6882 0.68820 1.4191 0.249
Residuals 18 8.7292 0.48496
> summary(lm.D90 <- lm(weight ~ group - 1))# omitting intercept
Call:
lm(formula = weight ~ group - 1)
Residuals:
Min 1Q Median 3Q Max
-1.0710 -0.4938 0.0685 0.2462 1.3690
Coefficients:
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.0320 0.2202 22.85 9.55e-15 ***
groupTrt 4.6610 0.2202 21.16 3.62e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.6964 on 18 degrees of freedom
Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798
F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16
>
> opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
> plot(lm.D9, las = 1) # Residuals, Fitted, ...
> par(opar)
>
> ## model frame :
> stopifnot(identical(lm(weight ~ group, method = "model.frame"),
+ model.frame(lm.D9)))
>
> ### less simple examples in "See Also" above
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("lm.influence")
> ### * lm.influence
>
> flush(stderr()); flush(stdout())
>
> ### Name: lm.influence
> ### Title: Regression Diagnostics
> ### Aliases: lm.influence influence influence.lm influence.glm
> ### Keywords: regression
>
> ### ** Examples
>
> ## Analysis of the life-cycle savings data
> ## given in Belsley, Kuh and Welsch.
> summary(lm.SR <- lm(sr ~ pop15 + pop75 + dpi + ddpi,
+ data = LifeCycleSavings),
+ corr = TRUE)
Call:
lm(formula = sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings)
Residuals:
Min 1Q Median 3Q Max
-8.2422 -2.6857 -0.2488 2.4280 9.7509
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 28.5660865 7.3545161 3.884 0.000334 ***
pop15 -0.4611931 0.1446422 -3.189 0.002603 **
pop75 -1.6914977 1.0835989 -1.561 0.125530
dpi -0.0003369 0.0009311 -0.362 0.719173
ddpi 0.4096949 0.1961971 2.088 0.042471 *
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 3.803 on 45 degrees of freedom
Multiple R-squared: 0.3385, Adjusted R-squared: 0.2797
F-statistic: 5.756 on 4 and 45 DF, p-value: 0.0007904
Correlation of Coefficients:
(Intercept) pop15 pop75 dpi
pop15 -0.98
pop75 -0.81 0.77
dpi -0.17 0.18 -0.37
ddpi -0.19 0.10 -0.05 0.26
> utils::str(lmI <- lm.influence(lm.SR))
List of 4
$ hat : Named num [1:50] 0.0677 0.1204 0.0875 0.0895 0.0696 ...
..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
$ coefficients: num [1:50, 1:5] 0.0916 -0.0747 -0.4752 0.0429 0.6604 ...
..- attr(*, "dimnames")=List of 2
.. ..$ : chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
.. ..$ : chr [1:5] "(Intercept)" "pop15" "pop75" "dpi" ...
$ sigma : Named num [1:50] 3.84 3.84 3.83 3.84 3.81 ...
..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
$ wt.res : Named num [1:50] 0.864 0.616 2.219 -0.698 3.553 ...
..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
>
> ## For more "user level" examples, use example(influence.measures)
>
>
>
> cleanEx()
> nameEx("lm.summaries")
> ### * lm.summaries
>
> flush(stderr()); flush(stdout())
>
> ### Name: lm.summaries
> ### Title: Accessing Linear Model Fits
> ### Aliases: family.lm formula.lm residuals.lm labels.lm weights
> ### weights.default
> ### Keywords: regression models
>
> ### ** Examples
>
> ## Don't show:
> utils::example("lm", echo = FALSE)
> ## End Don't show
> ##-- Continuing the lm(.) example:
> coef(lm.D90)# the bare coefficients
groupCtl groupTrt
5.032 4.661
>
> ## The 2 basic regression diagnostic plots [plot.lm(.) is preferred]
> plot(resid(lm.D90), fitted(lm.D90))# Tukey-Anscombe's
> abline(h=0, lty=2, col = 'gray')
>
> qqnorm(residuals(lm.D90))
>
>
>
> cleanEx()
> nameEx("lmfit")
> ### * lmfit
>
> flush(stderr()); flush(stdout())
>
> ### Name: lm.fit
> ### Title: Fitter Functions for Linear Models
> ### Aliases: lm.fit lm.wfit
> ### Keywords: regression array
>
> ### ** Examples
>
> require(utils)
> set.seed(129)
> n <- 7 ; p <- 2
> X <- matrix(rnorm(n * p), n,p) # no intercept!
> y <- rnorm(n)
> w <- rnorm(n)^2
>
> str(lmw <- lm.wfit(x=X, y=y, w=w))
List of 9
$ coefficients : Named num [1:2] -0.0432 -0.5612
..- attr(*, "names")= chr [1:2] "x1" "x2"
$ residuals : num [1:7] -0.132 -1.308 -0.256 1.468 0.439 ...
$ fitted.values: num [1:7] 0.05 -0.5232 0.6151 -0.5766 0.0512 ...
$ effects : Named num [1:7] 0.804 1.722 -0.072 2.047 0.392 ...
..- attr(*, "names")= chr [1:7] "x1" "x2" "" "" ...
$ weights : num [1:7] 0.3195 0.0123 0.0569 1.8154 0.8359 ...
$ rank : int 2
$ assign : NULL
$ qr :List of 5
..$ qr : num [1:7, 1:2] 3.0953 0.0355 0.106 0.5901 -0.5898 ...
..$ qraux: num [1:2] 1.2 1.02
..$ pivot: int [1:2] 1 2
..$ tol : num 1e-07
..$ rank : int 2
..- attr(*, "class")= chr "qr"
$ df.residual : int 5
>
> str(lm. <- lm.fit (x=X, y=y))
List of 8
$ coefficients : Named num [1:2] 0.132 -0.553
..- attr(*, "names")= chr [1:2] "x1" "x2"
$ residuals : num [1:7] 0.06433 -1.14333 -0.00708 1.69606 0.09095 ...
$ effects : Named num [1:7] 0.791 1.476 -0.415 1.983 0.133 ...
..- attr(*, "names")= chr [1:7] "x1" "x2" "" "" ...
$ rank : int 2
$ fitted.values: num [1:7] -0.146 -0.688 0.366 -0.804 0.399 ...
$ assign : NULL
$ qr :List of 5
..$ qr : num [1:7, 1:2] 3.321 0.298 0.414 0.408 -0.601 ...
..$ qraux: num [1:2] 1.34 1.32
..$ pivot: int [1:2] 1 2
..$ tol : num 1e-07
..$ rank : int 2
..- attr(*, "class")= chr "qr"
$ df.residual : int 5
>
>
>
>
> cleanEx()
> nameEx("loess")
> ### * loess
>
> flush(stderr()); flush(stdout())
>
> ### Name: loess
> ### Title: Local Polynomial Regression Fitting
> ### Aliases: loess
> ### Keywords: smooth loess
>
> ### ** Examples
>
> cars.lo <- loess(dist ~ speed, cars)
> predict(cars.lo, data.frame(speed = seq(5, 30, 1)), se = TRUE)
$fit
1 2 3 4 5 6 7 8
7.797353 10.002308 12.499786 15.281082 18.446568 21.865315 25.517015 29.350386
9 10 11 12 13 14 15 16
33.230660 37.167935 41.205226 45.055736 48.355889 49.824812 51.986702 56.461318
17 18 19 20 21 22 23 24
61.959729 68.569313 76.316068 85.212121 95.324047 NA NA NA
25 26
NA NA
$se.fit
1 2 3 4 5 6 7 8
7.568120 5.945831 4.990827 4.545284 4.308639 4.115049 3.789542 3.716231
9 10 11 12 13 14 15 16
3.776947 4.091747 4.709568 4.245427 4.035929 3.753410 4.004705 4.043190
17 18 19 20 21 22 23 24
4.026105 4.074664 4.570818 5.954217 8.302014 NA NA NA
25 26
NA NA
$residual.scale
[1] 15.29496
$df
[1] 44.6179
> # to allow extrapolation
> cars.lo2 <- loess(dist ~ speed, cars,
+ control = loess.control(surface = "direct"))
> predict(cars.lo2, data.frame(speed = seq(5, 30, 1)), se = TRUE)
$fit
1 2 3 4 5 6 7
7.741006 9.926596 12.442424 15.281082 18.425712 21.865315 25.713413
8 9 10 11 12 13 14
29.350386 33.230660 37.167935 41.205226 45.781544 48.355889 50.067148
15 16 17 18 19 20 21
51.986702 56.445263 62.025404 68.569313 76.193111 85.053364 95.300523
22 23 24 25 26
106.974661 120.092581 134.665851 150.698545 168.190283
$se.fit
1 2 3 4 5 6 7 8
7.565991 5.959097 5.012013 4.550013 4.321596 4.119331 3.939804 3.720098
9 10 11 12 13 14 15 16
3.780877 4.096004 4.714469 4.398936 4.040129 4.184257 4.008873 4.061865
17 18 19 20 21 22 23 24
4.033998 4.078904 4.584606 5.952480 8.306901 11.601911 15.792480 20.864660
25 26
26.823827 33.683999
$residual.scale
[1] 15.31087
$df
[1] 44.55085
>
>
>
> cleanEx()
> nameEx("logLik")
> ### * logLik
>
> flush(stderr()); flush(stdout())
>
> ### Name: logLik
> ### Title: Extract Log-Likelihood
> ### Aliases: logLik print.logLik str.logLik logLik.lm
> ### Keywords: models
>
> ### ** Examples
>
> x <- 1:5
> lmx <- lm(x ~ 1)
> logLik(lmx) # using print.logLik() method
'log Lik.' -8.82756 (df=2)
> utils::str(logLik(lmx))
Class 'logLik' : -8.828 (df=2)
>
> ## lm method
> (fm1 <- lm(rating ~ ., data = attitude))
Call:
lm(formula = rating ~ ., data = attitude)
Coefficients:
(Intercept) complaints privileges learning raises critical
10.78708 0.61319 -0.07305 0.32033 0.08173 0.03838
advance
-0.21706
> logLik(fm1)
'log Lik.' -97.2499 (df=8)
> logLik(fm1, REML = TRUE)
'log Lik.' -102.6851 (df=8)
>
> utils::data(Orthodont, package="nlme")
> fm1 <- lm(distance ~ Sex * age, Orthodont)
> logLik(fm1)
'log Lik.' -239.1209 (df=5)
> logLik(fm1, REML = TRUE)
'log Lik.' -241.7796 (df=5)
>
>
>
> cleanEx()
> nameEx("loglin")
> ### * loglin
>
> flush(stderr()); flush(stdout())
>
> ### Name: loglin
> ### Title: Fitting Log-Linear Models
> ### Aliases: loglin
> ### Keywords: category models
>
> ### ** Examples
>
> ## Model of joint independence of sex from hair and eye color.
> fm <- loglin(HairEyeColor, list(c(1, 2), c(1, 3), c(2, 3)))
5 iterations: deviation 0.04093795
> fm
$lrt
[1] 6.761258
$pearson
[1] 6.868292
$df
[1] 9
$margin
$margin[[1]]
[1] "Hair" "Eye"
$margin[[2]]
[1] "Hair" "Sex"
$margin[[3]]
[1] "Eye" "Sex"
> 1 - pchisq(fm$lrt, fm$df)
[1] 0.66196
> ## Model with no three-factor interactions fits well.
>
>
>
> cleanEx()
> nameEx("lowess")
> ### * lowess
>
> flush(stderr()); flush(stdout())
>
> ### Name: lowess
> ### Title: Scatter Plot Smoothing
> ### Aliases: lowess
> ### Keywords: smooth
>
> ### ** Examples
>
> require(graphics)
>
> plot(cars, main = "lowess(cars)")
> lines(lowess(cars), col = 2)
> lines(lowess(cars, f=.2), col = 3)
> legend(5, 120, c(paste("f = ", c("2/3", ".2"))), lty = 1, col = 2:3)
>
>
>
> cleanEx()
> nameEx("ls.diag")
> ### * ls.diag
>
> flush(stderr()); flush(stdout())
>
> ### Name: ls.diag
> ### Title: Compute Diagnostics for 'lsfit' Regression Results
> ### Aliases: ls.diag
> ### Keywords: regression
>
> ### ** Examples
>
> ## Don't show:
> utils::example("lm", echo = FALSE)
> ## End Don't show
> ##-- Using the same data as the lm(.) example:
> lsD9 <- lsfit(x = as.numeric(gl(2, 10, 20)), y = weight)
> dlsD9 <- ls.diag(lsD9)
> utils::str(dlsD9, give.attr=FALSE)
List of 10
$ std.dev : num 0.696
$ hat : num [1:20] 0.1 0.1 0.1 0.1 0.1 ...
$ std.res : num [1:20] -1.305 0.829 0.224 1.632 -0.805 ...
$ stud.res : num [1:20] -1.333 0.822 0.218 1.718 -0.797 ...
$ cooks : num [1:20] 0.09458 0.03822 0.00279 0.14792 0.03602 ...
$ dfits : num [1:20] -0.4442 0.274 0.0727 0.5726 -0.2657 ...
$ correlation : num [1:2, 1:2] 1 -0.949 -0.949 1
$ std.err : num [1:2, 1] 0.492 0.311
$ cov.scaled : num [1:2, 1:2] 0.242 -0.145 -0.145 0.097
$ cov.unscaled: num [1:2, 1:2] 0.5 -0.3 -0.3 0.2
> abs(1 - sum(dlsD9$hat) / 2) < 10*.Machine$double.eps # sum(h.ii) = p
[1] TRUE
> plot(dlsD9$hat, dlsD9$stud.res, xlim=c(0,0.11))
> abline(h = 0, lty = 2, col = "lightgray")
>
>
>
> cleanEx()
> nameEx("lsfit")
> ### * lsfit
>
> flush(stderr()); flush(stdout())
>
> ### Name: lsfit
> ### Title: Find the Least Squares Fit
> ### Aliases: lsfit
> ### Keywords: regression
>
> ### ** Examples
>
> ## Don't show:
> utils::example("lm", echo = FALSE)
> ## End Don't show
> ##-- Using the same data as the lm(.) example:
> lsD9 <- lsfit(x = unclass(gl(2,10)), y = weight)
> ls.print(lsD9)
Residual Standard Error=0.6964
R-Square=0.0731
F-statistic (df=1, 18)=1.4191
p-value=0.249
Estimate Std.Err t-value Pr(>|t|)
Intercept 5.403 0.4924 10.9723 0.000
X -0.371 0.3114 -1.1913 0.249
>
>
>
> cleanEx()
> nameEx("mad")
> ### * mad
>
> flush(stderr()); flush(stdout())
>
> ### Name: mad
> ### Title: Median Absolute Deviation
> ### Aliases: mad
> ### Keywords: univar robust
>
> ### ** Examples
>
> mad(c(1:9))
[1] 2.9652
> print(mad(c(1:9), constant=1)) ==
+ mad(c(1:8,100), constant=1) # = 2 ; TRUE
[1] 2
[1] TRUE
> x <- c(1,2,3, 5,7,8)
> sort(abs(x - median(x)))
[1] 1 1 2 3 3 4
> c(mad(x, constant=1),
+ mad(x, constant=1, low = TRUE),
+ mad(x, constant=1, high = TRUE))
[1] 2.5 2.0 3.0
>
>
>
> cleanEx()
> nameEx("mahalanobis")
> ### * mahalanobis
>
> flush(stderr()); flush(stdout())
>
> ### Name: mahalanobis
> ### Title: Mahalanobis Distance
> ### Aliases: mahalanobis
> ### Keywords: multivariate
>
> ### ** Examples
>
> require(graphics)
>
> ma <- cbind(1:6, 1:3)
> (S <- var(ma))
[,1] [,2]
[1,] 3.5 0.8
[2,] 0.8 0.8
> mahalanobis(c(0,0), 1:2, S)
[1] 5.37037
>
> x <- matrix(rnorm(100*3), ncol = 3)
> stopifnot(mahalanobis(x, 0, diag(ncol(x))) == rowSums(x*x))
> ##- Here, D^2 = usual squared Euclidean distances
>
> Sx <- cov(x)
> D2 <- mahalanobis(x, colMeans(x), Sx)
> plot(density(D2, bw=.5),
+ main="Squared Mahalanobis distances, n=100, p=3") ; rug(D2)
> qqplot(qchisq(ppoints(100), df=3), D2,
+ main = expression("Q-Q plot of Mahalanobis" * ~D^2 *
+ " vs. quantiles of" * ~ chi[3]^2))
> abline(0, 1, col = 'gray')
>
>
>
> cleanEx()
> nameEx("make.link")
> ### * make.link
>
> flush(stderr()); flush(stdout())
>
> ### Name: make.link
> ### Title: Create a Link for GLM Families
> ### Aliases: make.link
> ### Keywords: models
>
> ### ** Examples
>
> utils::str(make.link("logit"))
List of 5
$ linkfun :function (mu)
$ linkinv :function (eta)
$ mu.eta :function (eta)
$ valideta:function (eta)
$ name : chr "logit"
- attr(*, "class")= chr "link-glm"
>
>
>
> cleanEx()
> nameEx("makepredictcall")
> ### * makepredictcall
>
> flush(stderr()); flush(stdout())
>
> ### Name: makepredictcall
> ### Title: Utility Function for Safe Prediction
> ### Aliases: makepredictcall makepredictcall.default SafePrediction
> ### Keywords: models
>
> ### ** Examples
>
> require(graphics)
>
> ## using poly: this did not work in R < 1.5.0
> fm <- lm(weight ~ poly(height, 2), data = women)
> plot(women, xlab = "Height (in)", ylab = "Weight (lb)")
> ht <- seq(57, 73, len = 200)
> lines(ht, predict(fm, data.frame(height=ht)))
>
> ## see also example(cars)
>
> ## see bs and ns for spline examples.
>
>
>
> cleanEx()
> nameEx("mantelhaen.test")
> ### * mantelhaen.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: mantelhaen.test
> ### Title: Cochran-Mantel-Haenszel Chi-Squared Test for Count Data
> ### Aliases: mantelhaen.test
> ### Keywords: htest
>
> ### ** Examples
>
> ## Agresti (1990), pages 231--237, Penicillin and Rabbits
> ## Investigation of the effectiveness of immediately injected or 1.5
> ## hours delayed penicillin in protecting rabbits against a lethal
> ## injection with beta-hemolytic streptococci.
> Rabbits <-
+ array(c(0, 0, 6, 5,
+ 3, 0, 3, 6,
+ 6, 2, 0, 4,
+ 5, 6, 1, 0,
+ 2, 5, 0, 0),
+ dim = c(2, 2, 5),
+ dimnames = list(
+ Delay = c("None", "1.5h"),
+ Response = c("Cured", "Died"),
+ Penicillin.Level = c("1/8", "1/4", "1/2", "1", "4")))
> Rabbits
, , Penicillin.Level = 1/8
Response
Delay Cured Died
None 0 6
1.5h 0 5
, , Penicillin.Level = 1/4
Response
Delay Cured Died
None 3 3
1.5h 0 6
, , Penicillin.Level = 1/2
Response
Delay Cured Died
None 6 0
1.5h 2 4
, , Penicillin.Level = 1
Response
Delay Cured Died
None 5 1
1.5h 6 0
, , Penicillin.Level = 4
Response
Delay Cured Died
None 2 0
1.5h 5 0
> ## Classical Mantel-Haenszel test
> mantelhaen.test(Rabbits)
Mantel-Haenszel chi-squared test with continuity correction
data: Rabbits
Mantel-Haenszel X-squared = 3.9286, df = 1, p-value = 0.04747
alternative hypothesis: true common odds ratio is not equal to 1
95 percent confidence interval:
1.026713 47.725133
sample estimates:
common odds ratio
7
> ## => p = 0.047, some evidence for higher cure rate of immediate
> ## injection
> ## Exact conditional test
> mantelhaen.test(Rabbits, exact = TRUE)
Exact conditional test of independence in 2 x 2 x k tables
data: Rabbits
S = 16, p-value = 0.03994
alternative hypothesis: true common odds ratio is not equal to 1
95 percent confidence interval:
1.077401 529.837399
sample estimates:
common odds ratio
10.36102
> ## => p - 0.040
> ## Exact conditional test for one-sided alternative of a higher
> ## cure rate for immediate injection
> mantelhaen.test(Rabbits, exact = TRUE, alternative = "greater")
Exact conditional test of independence in 2 x 2 x k tables
data: Rabbits
S = 16, p-value = 0.01997
alternative hypothesis: true common odds ratio is greater than 1
95 percent confidence interval:
1.384239 Inf
sample estimates:
common odds ratio
10.36102
> ## => p = 0.020
>
> ## UC Berkeley Student Admissions
> mantelhaen.test(UCBAdmissions)
Mantel-Haenszel chi-squared test with continuity correction
data: UCBAdmissions
Mantel-Haenszel X-squared = 1.4269, df = 1, p-value = 0.2323
alternative hypothesis: true common odds ratio is not equal to 1
95 percent confidence interval:
0.7719074 1.0603298
sample estimates:
common odds ratio
0.9046968
> ## No evidence for association between admission and gender
> ## when adjusted for department. However,
> apply(UCBAdmissions, 3, function(x) (x[1,1]*x[2,2])/(x[1,2]*x[2,1]))
A B C D E F
0.3492120 0.8025007 1.1330596 0.9212838 1.2216312 0.8278727
> ## This suggests that the assumption of homogeneous (conditional)
> ## odds ratios may be violated. The traditional approach would be
> ## using the Woolf test for interaction:
> woolf <- function(x) {
+ x <- x + 1 / 2
+ k <- dim(x)[3]
+ or <- apply(x, 3, function(x) (x[1,1]*x[2,2])/(x[1,2]*x[2,1]))
+ w <- apply(x, 3, function(x) 1 / sum(1 / x))
+ 1 - pchisq(sum(w * (log(or) - weighted.mean(log(or), w)) ^ 2), k - 1)
+ }
> woolf(UCBAdmissions)
[1] 0.003427200
> ## => p = 0.003, indicating that there is significant heterogeneity.
> ## (And hence the Mantel-Haenszel test cannot be used.)
>
> ## Agresti (2002), p. 287f and p. 297.
> ## Job Satisfaction example.
> Satisfaction <-
+ as.table(array(c(1, 2, 0, 0, 3, 3, 1, 2,
+ 11, 17, 8, 4, 2, 3, 5, 2,
+ 1, 0, 0, 0, 1, 3, 0, 1,
+ 2, 5, 7, 9, 1, 1, 3, 6),
+ dim = c(4, 4, 2),
+ dimnames =
+ list(Income =
+ c("<5000", "5000-15000",
+ "15000-25000", ">25000"),
+ "Job Satisfaction" =
+ c("V_D", "L_S", "M_S", "V_S"),
+ Gender = c("Female", "Male"))))
> ## (Satisfaction categories abbreviated for convenience.)
> ftable(. ~ Gender + Income, Satisfaction)
Job Satisfaction V_D L_S M_S V_S
Gender Income
Female <5000 1 3 11 2
5000-15000 2 3 17 3
15000-25000 0 1 8 5
>25000 0 2 4 2
Male <5000 1 1 2 1
5000-15000 0 3 5 1
15000-25000 0 0 7 3
>25000 0 1 9 6
> ## Table 7.8 in Agresti (2002), p. 288.
> mantelhaen.test(Satisfaction)
Cochran-Mantel-Haenszel test
data: Satisfaction
Cochran-Mantel-Haenszel M^2 = 10.2001, df = 9, p-value = 0.3345
> ## See Table 7.12 in Agresti (2002), p. 297.
>
>
>
> cleanEx()
> nameEx("mauchly.test")
> ### * mauchly.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: mauchly.test
> ### Title: Mauchly's Test of Sphericity
> ### Aliases: mauchly.test mauchly.test.SSD mauchly.test.mlm
> ### Keywords: htest models multivariate
>
> ### ** Examples
>
> utils::example(SSD) # Brings in the mlmfit and reacttime objects
SSD> # Lifted from Baron+Li:
SSD> # "Notes on the use of R for psychology experiments and questionnaires"
SSD> # Maxwell and Delaney, p. 497
SSD> reacttime <- matrix(c(
SSD+ 420, 420, 480, 480, 600, 780,
SSD+ 420, 480, 480, 360, 480, 600,
SSD+ 480, 480, 540, 660, 780, 780,
SSD+ 420, 540, 540, 480, 780, 900,
SSD+ 540, 660, 540, 480, 660, 720,
SSD+ 360, 420, 360, 360, 480, 540,
SSD+ 480, 480, 600, 540, 720, 840,
SSD+ 480, 600, 660, 540, 720, 900,
SSD+ 540, 600, 540, 480, 720, 780,
SSD+ 480, 420, 540, 540, 660, 780),
SSD+ ncol = 6, byrow = TRUE,
SSD+ dimnames=list(subj=1:10,
SSD+ cond=c("deg0NA", "deg4NA", "deg8NA",
SSD+ "deg0NP", "deg4NP", "deg8NP")))
SSD> mlmfit <- lm(reacttime~1)
SSD> SSD(mlmfit)
$SSD
cond
cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP
deg0NA 29160 30600 26640 23760 32400 25560
deg4NA 30600 66600 32400 7200 36000 30600
deg8NA 26640 32400 56160 41040 57600 69840
deg0NP 23760 7200 41040 70560 72000 63360
deg4NP 32400 36000 57600 72000 108000 100800
deg8NP 25560 30600 69840 63360 100800 122760
$call
lm(formula = reacttime ~ 1)
$df
[1] 9
attr(,"class")
[1] "SSD"
SSD> estVar(mlmfit)
cond
cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP
deg0NA 3240 3400 2960 2640 3600 2840
deg4NA 3400 7400 3600 800 4000 3400
deg8NA 2960 3600 6240 4560 6400 7760
deg0NP 2640 800 4560 7840 8000 7040
deg4NP 3600 4000 6400 8000 12000 11200
deg8NP 2840 3400 7760 7040 11200 13640
>
> ### traditional test of intrasubj. contrasts
> mauchly.test(mlmfit, X=~1)
Mauchly's test of sphericity
Contrasts orthogonal to
~1
data: SSD matrix from lm(formula = reacttime ~ 1)
W = 0.0311, p-value = 0.04765
>
> ### tests using intra-subject 3x2 design
> idata <- data.frame(deg=gl(3,1,6, labels=c(0,4,8)),
+ noise=gl(2,3,6, labels=c("A","P")))
> mauchly.test(mlmfit, X = ~ deg + noise, idata = idata)
Mauchly's test of sphericity
Contrasts orthogonal to
~deg + noise
data: SSD matrix from lm(formula = reacttime ~ 1)
W = 0.8938, p-value = 0.6381
> mauchly.test(mlmfit, M = ~ deg + noise, X = ~ noise, idata=idata)
Mauchly's test of sphericity
Contrasts orthogonal to
~noise
Contrasts spanned by
~deg + noise
data: SSD matrix from lm(formula = reacttime ~ 1)
W = 0.9601, p-value = 0.8497
>
>
>
> cleanEx()
> nameEx("mcnemar.test")
> ### * mcnemar.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: mcnemar.test
> ### Title: McNemar's Chi-squared Test for Count Data
> ### Aliases: mcnemar.test
> ### Keywords: htest
>
> ### ** Examples
>
> ## Agresti (1990), p. 350.
> ## Presidential Approval Ratings.
> ## Approval of the President's performance in office in two surveys,
> ## one month apart, for a random sample of 1600 voting-age Americans.
> Performance <-
+ matrix(c(794, 86, 150, 570),
+ nrow = 2,
+ dimnames = list("1st Survey" = c("Approve", "Disapprove"),
+ "2nd Survey" = c("Approve", "Disapprove")))
> Performance
2nd Survey
1st Survey Approve Disapprove
Approve 794 150
Disapprove 86 570
> mcnemar.test(Performance)
McNemar's Chi-squared test with continuity correction
data: Performance
McNemar's chi-squared = 16.8178, df = 1, p-value = 4.115e-05
> ## => significant change (in fact, drop) in approval ratings
>
>
>
> cleanEx()
> nameEx("median")
> ### * median
>
> flush(stderr()); flush(stdout())
>
> ### Name: median
> ### Title: Median Value
> ### Aliases: median median.default
> ### Keywords: univar robust
>
> ### ** Examples
>
> median(1:4)# = 2.5 [even number]
[1] 2.5
> median(c(1:3,100,1000))# = 3 [odd, robust]
[1] 3
>
>
>
> cleanEx()
> nameEx("medpolish")
> ### * medpolish
>
> flush(stderr()); flush(stdout())
>
> ### Name: medpolish
> ### Title: Median Polish of a Matrix
> ### Aliases: medpolish
> ### Keywords: robust
>
> ### ** Examples
>
> require(graphics)
>
> ## Deaths from sport parachuting; from ABC of EDA, p.224:
> deaths <-
+ rbind(c(14,15,14),
+ c( 7, 4, 7),
+ c( 8, 2,10),
+ c(15, 9,10),
+ c( 0, 2, 0))
> dimnames(deaths) <- list(c("1-24", "25-74", "75-199", "200++", "NA"),
+ paste(1973:1975))
> deaths
1973 1974 1975
1-24 14 15 14
25-74 7 4 7
75-199 8 2 10
200++ 15 9 10
NA 0 2 0
> (med.d <- medpolish(deaths))
1 : 19
Final: 19
Median Polish Results (Dataset: "deaths")
Overall: 8
Row Effects:
1-24 25-74 75-199 200++ NA
6 -1 0 2 -8
Column Effects:
1973 1974 1975
0 -1 0
Residuals:
1973 1974 1975
1-24 0 2 0
25-74 0 -2 0
75-199 0 -5 2
200++ 5 0 0
NA 0 3 0
> plot(med.d)
> ## Check decomposition:
> all(deaths ==
+ med.d$overall + outer(med.d$row,med.d$col, "+") + med.d$residuals)
[1] TRUE
>
>
>
> cleanEx()
> nameEx("model.extract")
> ### * model.extract
>
> flush(stderr()); flush(stdout())
>
> ### Name: model.extract
> ### Title: Extract Components from a Model Frame
> ### Aliases: model.extract model.offset model.response model.weights
> ### Keywords: manip programming models
>
> ### ** Examples
>
> a <- model.frame(cbind(ncases,ncontrols) ~ agegp+tobgp+alcgp, data=esoph)
> model.extract(a, "response")
ncases ncontrols
1 0 40
2 0 10
3 0 6
4 0 5
5 0 27
6 0 7
7 0 4
8 0 7
9 0 2
10 0 1
11 0 2
12 0 1
13 1 1
14 0 1
15 0 2
16 0 60
17 1 14
18 0 7
19 0 8
20 0 35
21 3 23
22 1 14
23 0 8
24 0 11
25 0 6
26 0 2
27 0 1
28 2 3
29 0 3
30 2 4
31 1 46
32 0 18
33 0 10
34 0 4
35 6 38
36 4 21
37 5 15
38 5 7
39 3 16
40 6 14
41 1 5
42 2 4
43 4 4
44 3 4
45 2 3
46 4 4
47 2 49
48 3 22
49 3 12
50 4 6
51 9 40
52 6 21
53 4 17
54 3 6
55 9 18
56 8 15
57 3 6
58 4 4
59 5 10
60 6 7
61 2 3
62 5 6
63 5 48
64 4 14
65 2 7
66 0 2
67 17 34
68 3 10
69 5 9
70 6 13
71 4 12
72 2 3
73 1 1
74 3 4
75 1 2
76 1 1
77 1 1
78 1 18
79 2 6
80 1 3
81 2 5
82 1 3
83 0 3
84 1 1
85 1 1
86 1 1
87 2 2
88 1 1
> stopifnot(model.extract(a, "response") == model.response(a))
>
> a <- model.frame(ncases/(ncases+ncontrols) ~ agegp+tobgp+alcgp,
+ data = esoph, weights = ncases+ncontrols)
> model.response(a)
1 2 3 4 5 6 7
0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
8 9 10 11 12 13 14
0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.50000000 0.00000000
15 16 17 18 19 20 21
0.00000000 0.00000000 0.06666667 0.00000000 0.00000000 0.00000000 0.11538462
22 23 24 25 26 27 28
0.06666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.40000000
29 30 31 32 33 34 35
0.00000000 0.33333333 0.02127660 0.00000000 0.00000000 0.00000000 0.13636364
36 37 38 39 40 41 42
0.16000000 0.25000000 0.41666667 0.15789474 0.30000000 0.16666667 0.33333333
43 44 45 46 47 48 49
0.50000000 0.42857143 0.40000000 0.50000000 0.03921569 0.12000000 0.20000000
50 51 52 53 54 55 56
0.40000000 0.18367347 0.22222222 0.19047619 0.33333333 0.33333333 0.34782609
57 58 59 60 61 62 63
0.33333333 0.50000000 0.33333333 0.46153846 0.40000000 0.45454545 0.09433962
64 65 66 67 68 69 70
0.22222222 0.22222222 0.00000000 0.33333333 0.23076923 0.35714286 0.31578947
71 72 73 74 75 76 77
0.25000000 0.40000000 0.50000000 0.42857143 0.33333333 0.50000000 0.50000000
78 79 80 81 82 83 84
0.05263158 0.25000000 0.25000000 0.28571429 0.25000000 0.00000000 0.50000000
85 86 87 88
0.50000000 0.50000000 0.50000000 0.50000000
> model.extract(a, "weights")
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26
40 10 6 5 27 7 4 7 2 1 2 1 2 1 2 60 15 7 8 35 26 15 8 11 6 2
27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52
1 5 3 6 47 18 10 4 44 25 20 12 19 20 6 6 8 7 5 8 51 25 15 10 49 27
53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78
21 9 27 23 9 8 15 13 5 11 53 18 9 2 51 13 14 19 16 5 2 7 3 2 2 19
79 80 81 82 83 84 85 86 87 88
8 4 7 4 3 2 2 2 4 2
>
> a <- model.frame(cbind(ncases,ncontrols) ~ agegp,
+ something = tobgp, data = esoph)
> names(a)
[1] "cbind(ncases, ncontrols)" "agegp"
[3] "(something)"
> stopifnot(model.extract(a, "something") == esoph$tobgp)
>
>
>
> cleanEx()
> nameEx("model.frame")
> ### * model.frame
>
> flush(stderr()); flush(stdout())
>
> ### Name: model.frame
> ### Title: Extracting the "Environment" of a Model Formula
> ### Aliases: model.frame model.frame.default model.frame.lm model.frame.glm
> ### model.frame.aovlist get_all_vars
> ### Keywords: models
>
> ### ** Examples
>
> data.class(model.frame(dist ~ speed, data = cars))
[1] "data.frame"
>
>
>
> cleanEx()
> nameEx("model.matrix")
> ### * model.matrix
>
> flush(stderr()); flush(stdout())
>
> ### Name: model.matrix
> ### Title: Construct Design Matrices
> ### Aliases: model.matrix model.matrix.default model.matrix.lm
> ### Keywords: models
>
> ### ** Examples
>
> ff <- log(Volume) ~ log(Height) + log(Girth)
> utils::str(m <- model.frame(ff, trees))
'data.frame': 31 obs. of 3 variables:
$ log(Volume): num 2.33 2.33 2.32 2.8 2.93 ...
$ log(Height): num 4.25 4.17 4.14 4.28 4.39 ...
$ log(Girth) : num 2.12 2.15 2.17 2.35 2.37 ...
- attr(*, "terms")=Classes 'terms', 'formula' length 3 log(Volume) ~ log(Height) + log(Girth)
.. ..- attr(*, "variables")= language list(log(Volume), log(Height), log(Girth))
.. ..- attr(*, "factors")= int [1:3, 1:2] 0 1 0 0 0 1
.. .. ..- attr(*, "dimnames")=List of 2
.. .. .. ..$ : chr [1:3] "log(Volume)" "log(Height)" "log(Girth)"
.. .. .. ..$ : chr [1:2] "log(Height)" "log(Girth)"
.. ..- attr(*, "term.labels")= chr [1:2] "log(Height)" "log(Girth)"
.. ..- attr(*, "order")= int [1:2] 1 1
.. ..- attr(*, "intercept")= int 1
.. ..- attr(*, "response")= int 1
.. ..- attr(*, ".Environment")=<environment: R_GlobalEnv>
.. ..- attr(*, "predvars")= language list(log(Volume), log(Height), log(Girth))
.. ..- attr(*, "dataClasses")= Named chr [1:3] "numeric" "numeric" "numeric"
.. .. ..- attr(*, "names")= chr [1:3] "log(Volume)" "log(Height)" "log(Girth)"
> mat <- model.matrix(ff, m)
>
> dd <- data.frame(a = gl(3,4), b = gl(4,1,12)) # balanced 2-way
> options("contrasts")
$contrasts
unordered ordered
"contr.treatment" "contr.poly"
> model.matrix(~ a + b, dd)
(Intercept) a2 a3 b2 b3 b4
1 1 0 0 0 0 0
2 1 0 0 1 0 0
3 1 0 0 0 1 0
4 1 0 0 0 0 1
5 1 1 0 0 0 0
6 1 1 0 1 0 0
7 1 1 0 0 1 0
8 1 1 0 0 0 1
9 1 0 1 0 0 0
10 1 0 1 1 0 0
11 1 0 1 0 1 0
12 1 0 1 0 0 1
attr(,"assign")
[1] 0 1 1 2 2 2
attr(,"contrasts")
attr(,"contrasts")$a
[1] "contr.treatment"
attr(,"contrasts")$b
[1] "contr.treatment"
> model.matrix(~ a + b, dd, contrasts = list(a="contr.sum"))
(Intercept) a1 a2 b2 b3 b4
1 1 1 0 0 0 0
2 1 1 0 1 0 0
3 1 1 0 0 1 0
4 1 1 0 0 0 1
5 1 0 1 0 0 0
6 1 0 1 1 0 0
7 1 0 1 0 1 0
8 1 0 1 0 0 1
9 1 -1 -1 0 0 0
10 1 -1 -1 1 0 0
11 1 -1 -1 0 1 0
12 1 -1 -1 0 0 1
attr(,"assign")
[1] 0 1 1 2 2 2
attr(,"contrasts")
attr(,"contrasts")$a
[1] "contr.sum"
attr(,"contrasts")$b
[1] "contr.treatment"
> model.matrix(~ a + b, dd, contrasts = list(a="contr.sum", b="contr.poly"))
(Intercept) a1 a2 b.L b.Q b.C
1 1 1 0 -0.6708204 0.5 -0.2236068
2 1 1 0 -0.2236068 -0.5 0.6708204
3 1 1 0 0.2236068 -0.5 -0.6708204
4 1 1 0 0.6708204 0.5 0.2236068
5 1 0 1 -0.6708204 0.5 -0.2236068
6 1 0 1 -0.2236068 -0.5 0.6708204
7 1 0 1 0.2236068 -0.5 -0.6708204
8 1 0 1 0.6708204 0.5 0.2236068
9 1 -1 -1 -0.6708204 0.5 -0.2236068
10 1 -1 -1 -0.2236068 -0.5 0.6708204
11 1 -1 -1 0.2236068 -0.5 -0.6708204
12 1 -1 -1 0.6708204 0.5 0.2236068
attr(,"assign")
[1] 0 1 1 2 2 2
attr(,"contrasts")
attr(,"contrasts")$a
[1] "contr.sum"
attr(,"contrasts")$b
[1] "contr.poly"
> m.orth <- model.matrix(~a+b, dd, contrasts = list(a="contr.helmert"))
> crossprod(m.orth) # m.orth is ALMOST orthogonal
(Intercept) a1 a2 b2 b3 b4
(Intercept) 12 0 0 3 3 3
a1 0 8 0 0 0 0
a2 0 0 24 0 0 0
b2 3 0 0 3 0 0
b3 3 0 0 0 3 0
b4 3 0 0 0 0 3
>
>
>
> cleanEx()
> nameEx("model.tables")
> ### * model.tables
>
> flush(stderr()); flush(stdout())
>
> ### Name: model.tables
> ### Title: Compute Tables of Results from an Aov Model Fit
> ### Aliases: model.tables model.tables.aov model.tables.aovlist
> ### Keywords: models
>
> ### ** Examples
>
> ## From Venables and Ripley (2002) p.165.
> utils::data(npk, package="MASS")
>
> options(contrasts=c("contr.helmert", "contr.treatment"))
> npk.aov <- aov(yield ~ block + N*P*K, npk)
> model.tables(npk.aov, "means", se = TRUE)
Tables of means
Grand mean
54.875
block
block
1 2 3 4 5 6
54.02 57.45 60.77 50.12 50.52 56.35
N
N
0 1
52.07 57.68
P
P
0 1
55.47 54.28
K
K
0 1
56.87 52.88
N:P
P
N 0 1
0 51.72 52.42
1 59.22 56.15
N:K
K
N 0 1
0 52.88 51.25
1 60.85 54.52
P:K
K
P 0 1
0 57.60 53.33
1 56.13 52.43
Standard errors for differences of means
block N P K N:P N:K P:K
2.779 1.604 1.604 1.604 2.269 2.269 2.269
replic. 4 12 12 12 6 6 6
>
> ## as a test, not particularly sensible statistically
> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)
> model.tables(npk.aovE, se=TRUE)
Tables of effects
N
N
0 1
-2.8083 2.8083
P
P
0 1
0.5917 -0.5917
K
K
0 1
1.9917 -1.9917
N:P
P
N 0 1
0 -0.9417 0.9417
1 0.9417 -0.9417
N:K
K
N 0 1
0 -1.175 1.175
1 1.175 -1.175
P:K
K
P 0 1
0 0.14167 -0.14167
1 -0.14167 0.14167
N:P:K
, , K = 0
P
N 0 1
0 -1.2417 1.2417
1 1.2417 -1.2417
, , K = 1
P
N 0 1
0 1.2417 -1.2417
1 -1.2417 1.2417
Standard errors of effects
N P K N:P N:K P:K N:P:K
1.134 1.134 1.134 1.604 1.604 1.604 5.052
replic. 12 12 12 6 6 6 3
> model.tables(npk.aovE, "means")
Tables of means
Grand mean
54.875
N
N
0 1
52.07 57.68
P
P
0 1
55.47 54.28
K
K
0 1
56.87 52.88
N:P
P
N 0 1
0 51.72 52.42
1 59.22 56.15
N:K
K
N 0 1
0 52.88 51.25
1 60.85 54.52
P:K
K
P 0 1
0 57.60 53.33
1 56.13 52.43
N:P:K
, , K = 0
P
N 0 1
0 51.43 54.33
1 63.77 57.93
, , K = 1
P
N 0 1
0 52.00 50.50
1 54.67 54.37
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("monthplot")
> ### * monthplot
>
> flush(stderr()); flush(stdout())
>
> ### Name: monthplot
> ### Title: Plot a Seasonal or other Subseries from a Time Series
> ### Aliases: monthplot monthplot.default monthplot.ts monthplot.stl
> ### monthplot.StructTS
> ### Keywords: hplot ts
>
> ### ** Examples
>
> require(graphics)
>
> ## The CO2 data
> fit <- stl(log(co2), s.window = 20, t.window = 20)
> plot(fit)
> op <- par(mfrow = c(2,2))
> monthplot(co2, ylab = "data", cex.axis = 0.8)
> monthplot(fit, choice = "seasonal", cex.axis = 0.8)
> monthplot(fit, choice = "trend", cex.axis = 0.8)
> monthplot(fit, choice = "remainder", type = "h", cex.axis = 0.8)
> par(op)
>
> ## The CO2 data, grouped quarterly
> quarter <- (cycle(co2) - 1) %/% 3
> monthplot(co2, phase = quarter)
>
> ## see also JohnsonJohnson
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("mood.test")
> ### * mood.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: mood.test
> ### Title: Mood Two-Sample Test of Scale
> ### Aliases: mood.test mood.test.default mood.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> ## Same data as for the Ansari-Bradley test:
> ## Serum iron determination using Hyland control sera
> ramsay <- c(111, 107, 100, 99, 102, 106, 109, 108, 104, 99,
+ 101, 96, 97, 102, 107, 113, 116, 113, 110, 98)
> jung.parekh <- c(107, 108, 106, 98, 105, 103, 110, 105, 104,
+ 100, 96, 108, 103, 104, 114, 114, 113, 108, 106, 99)
> mood.test(ramsay, jung.parekh)
Mood two-sample test of scale
data: ramsay and jung.parekh
Z = 1.0371, p-value = 0.2997
alternative hypothesis: two.sided
> ## Compare this to ansari.test(ramsay, jung.parekh)
>
>
>
> cleanEx()
> nameEx("na.action")
> ### * na.action
>
> flush(stderr()); flush(stdout())
>
> ### Name: na.action
> ### Title: NA Action
> ### Aliases: na.action na.action.default
> ### Keywords: NA methods
>
> ### ** Examples
>
> na.action(na.omit(c(1, NA)))
[1] 2
attr(,"class")
[1] "omit"
>
>
>
> cleanEx()
> nameEx("na.contiguous")
> ### * na.contiguous
>
> flush(stderr()); flush(stdout())
>
> ### Name: na.contiguous
> ### Title: Find Longest Contiguous Stretch of non-NAs
> ### Aliases: na.contiguous na.contiguous.default
> ### Keywords: ts
>
> ### ** Examples
>
> na.contiguous(presidents)
Qtr1 Qtr2 Qtr3 Qtr4
1952 32
1953 59 74 75 60
1954 71 61 71 57
1955 71 68 79 73
1956 76 71 67 75
1957 79 62 63 57
1958 60 49 48 52
1959 57 62 61 66
1960 71 62 61 57
1961 72 83 71 78
1962 79 71 62 74
1963 76 64 62 57
1964 80 73 69 69
1965 71 64 69 62
1966 63 46 56 44
1967 44 52 38 46
1968 36 49 35 44
1969 59 65 65 56
1970 66 53 61 52
1971 51 48 54 49
1972 49 61
>
>
>
> cleanEx()
> nameEx("na.fail")
> ### * na.fail
>
> flush(stderr()); flush(stdout())
>
> ### Name: na.fail
> ### Title: Handle Missing Values in Objects
> ### Aliases: na.fail na.fail.default na.omit na.omit.data.frame
> ### na.omit.default na.exclude na.exclude.data.frame na.exclude.default
> ### na.pass
> ### Keywords: NA
>
> ### ** Examples
>
> DF <- data.frame(x = c(1, 2, 3), y = c(0, 10, NA))
> na.omit(DF)
x y
1 1 0
2 2 10
> m <- as.matrix(DF)
> na.omit(m)
x y
[1,] 1 0
[2,] 2 10
attr(,"na.action")
[1] 3
attr(,"class")
[1] "omit"
> stopifnot(all(na.omit(1:3) == 1:3)) # does not affect objects with no NA's
> try(na.fail(DF))#> Error: missing values in ...
Error in na.fail.default(DF) : missing values in object
>
> options("na.action")
$na.action
[1] "na.omit"
>
>
>
> cleanEx()
> nameEx("nextn")
> ### * nextn
>
> flush(stderr()); flush(stdout())
>
> ### Name: nextn
> ### Title: Highly Composite Numbers
> ### Aliases: nextn
> ### Keywords: math
>
> ### ** Examples
>
> nextn(1001) # 1024
[1] 1024
> table(sapply(599:630, nextn))
600 625 640
2 25 5
>
>
>
> cleanEx()
> nameEx("nlm")
> ### * nlm
>
> flush(stderr()); flush(stdout())
>
> ### Name: nlm
> ### Title: Non-Linear Minimization
> ### Aliases: nlm
> ### Keywords: nonlinear optimize
>
> ### ** Examples
>
> f <- function(x) sum((x-1:length(x))^2)
> nlm(f, c(10,10))
$minimum
[1] 4.303458e-26
$estimate
[1] 1 2
$gradient
[1] 2.757794e-13 -3.099743e-13
$code
[1] 1
$iterations
[1] 2
> nlm(f, c(10,10), print.level = 2)
iteration = 0
Step:
[1] 0 0
Parameter:
[1] 10 10
Function Value
[1] 145
Gradient:
[1] 18.00001 16.00001
iteration = 1
Step:
[1] -9 -8
Parameter:
[1] 1.000000 2.000000
Function Value
[1] 1.721748e-13
Gradient:
[1] 1.551336e-06 1.379735e-06
iteration = 2
Parameter:
[1] 1 2
Function Value
[1] 4.303458e-26
Gradient:
[1] 2.757794e-13 -3.099743e-13
Relative gradient close to zero.
Current iterate is probably solution.
$minimum
[1] 4.303458e-26
$estimate
[1] 1 2
$gradient
[1] 2.757794e-13 -3.099743e-13
$code
[1] 1
$iterations
[1] 2
> utils::str(nlm(f, c(5), hessian = TRUE))
List of 6
$ minimum : num 2.44e-24
$ estimate : num 1
$ gradient : num 1e-06
$ hessian : num [1, 1] 2
$ code : int 1
$ iterations: int 1
>
> f <- function(x, a) sum((x-a)^2)
> nlm(f, c(10,10), a=c(3,5))
$minimum
[1] 3.371781e-25
$estimate
[1] 3 5
$gradient
[1] 6.750156e-13 -9.450218e-13
$code
[1] 1
$iterations
[1] 2
> f <- function(x, a)
+ {
+ res <- sum((x-a)^2)
+ attr(res, "gradient") <- 2*(x-a)
+ res
+ }
> nlm(f, c(10,10), a=c(3,5))
$minimum
[1] 0
$estimate
[1] 3 5
$gradient
[1] 0 0
$code
[1] 1
$iterations
[1] 1
>
> ## more examples, including the use of derivatives.
> ## Not run: demo(nlm)
>
>
>
> cleanEx()
> nameEx("nlminb")
> ### * nlminb
>
> flush(stderr()); flush(stdout())
>
> ### Name: nlminb
> ### Title: Optimization using PORT routines
> ### Aliases: nlminb
> ### Keywords: optimize
>
> ### ** Examples
>
>
> cleanEx()
> nameEx("nls")
> ### * nls
>
> flush(stderr()); flush(stdout())
>
> ### Name: nls
> ### Title: Nonlinear Least Squares
> ### Aliases: nls
> ### Keywords: nonlinear regression models
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits=5)
> ## End Don't show
> require(graphics)
>
> DNase1 <- subset(DNase, Run == 1)
>
> ## using a selfStart model
> fm1DNase1 <- nls(density ~ SSlogis(log(conc), Asym, xmid, scal), DNase1)
> summary(fm1DNase1)
Formula: density ~ SSlogis(log(conc), Asym, xmid, scal)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 2.3452 0.0782 30.0 2.2e-13 ***
xmid 1.4831 0.0814 18.2 1.2e-10 ***
scal 1.0415 0.0323 32.3 8.5e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.0192 on 13 degrees of freedom
> ## the coefficients only:
> coef(fm1DNase1)
Asym xmid scal
2.3452 1.4831 1.0415
> ## including their SE, etc:
> coef(summary(fm1DNase1))
Estimate Std. Error t value Pr(>|t|)
Asym 2.3452 0.078154 30.007 2.1655e-13
xmid 1.4831 0.081353 18.230 1.2185e-10
scal 1.0415 0.032271 32.272 8.5069e-14
>
> ## using conditional linearity
> fm2DNase1 <- nls(density ~ 1/(1 + exp((xmid - log(conc))/scal)),
+ data = DNase1,
+ start = list(xmid = 0, scal = 1),
+ algorithm = "plinear")
> summary(fm2DNase1)
Formula: density ~ 1/(1 + exp((xmid - log(conc))/scal))
Parameters:
Estimate Std. Error t value Pr(>|t|)
xmid 1.4831 0.0814 18.2 1.2e-10 ***
scal 1.0415 0.0323 32.3 8.5e-14 ***
.lin 2.3452 0.0782 30.0 2.2e-13 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.0192 on 13 degrees of freedom
>
> ## without conditional linearity
> fm3DNase1 <- nls(density ~ Asym/(1 + exp((xmid - log(conc))/scal)),
+ data = DNase1,
+ start = list(Asym = 3, xmid = 0, scal = 1))
> summary(fm3DNase1)
Formula: density ~ Asym/(1 + exp((xmid - log(conc))/scal))
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 2.3452 0.0782 30.0 2.2e-13 ***
xmid 1.4831 0.0814 18.2 1.2e-10 ***
scal 1.0415 0.0323 32.3 8.5e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.0192 on 13 degrees of freedom
>
> ## using Port's nl2sol algorithm
> fm4DNase1 <- nls(density ~ Asym/(1 + exp((xmid - log(conc))/scal)),
+ data = DNase1,
+ start = list(Asym = 3, xmid = 0, scal = 1),
+ algorithm = "port")
> summary(fm4DNase1)
Formula: density ~ Asym/(1 + exp((xmid - log(conc))/scal))
Parameters:
Estimate Std. Error t value Pr(>|t|)
Asym 2.3452 0.0782 30.0 2.2e-13 ***
xmid 1.4831 0.0814 18.2 1.2e-10 ***
scal 1.0415 0.0323 32.3 8.5e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.0192 on 13 degrees of freedom
Algorithm "port", convergence message: relative convergence (4)
>
> ## weighted nonlinear regression
> Treated <- Puromycin[Puromycin$state == "treated", ]
> weighted.MM <- function(resp, conc, Vm, K)
+ {
+ ## Purpose: exactly as white book p. 451 -- RHS for nls()
+ ## Weighted version of Michaelis-Menten model
+ ## ----------------------------------------------------------
+ ## Arguments: 'y', 'x' and the two parameters (see book)
+ ## ----------------------------------------------------------
+ ## Author: Martin Maechler, Date: 23 Mar 2001
+
+ pred <- (Vm * conc)/(K + conc)
+ (resp - pred) / sqrt(pred)
+ }
>
> Pur.wt <- nls( ~ weighted.MM(rate, conc, Vm, K), data = Treated,
+ start = list(Vm = 200, K = 0.1))
> summary(Pur.wt)
Formula: 0 ~ weighted.MM(rate, conc, Vm, K)
Parameters:
Estimate Std. Error t value Pr(>|t|)
Vm 2.07e+02 9.22e+00 22.42 7.0e-10 ***
K 5.46e-02 7.98e-03 6.84 4.5e-05 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 1.21 on 10 degrees of freedom
>
> ## Passing arguments using a list that can not be coerced to a data.frame
> lisTreat <- with(Treated,
+ list(conc1 = conc[1], conc.1 = conc[-1], rate = rate))
>
> weighted.MM1 <- function(resp, conc1, conc.1, Vm, K)
+ {
+ conc <- c(conc1, conc.1)
+ pred <- (Vm * conc)/(K + conc)
+ (resp - pred) / sqrt(pred)
+ }
> Pur.wt1 <- nls( ~ weighted.MM1(rate, conc1, conc.1, Vm, K),
+ data = lisTreat, start = list(Vm = 200, K = 0.1))
> stopifnot(all.equal(coef(Pur.wt), coef(Pur.wt1)))
>
> ## Chambers and Hastie (1992) Statistical Models in S (p. 537):
> ## If the value of the right side [of formula] has an attribute called
> ## 'gradient' this should be a matrix with the number of rows equal
> ## to the length of the response and one column for each parameter.
>
> weighted.MM.grad <- function(resp, conc1, conc.1, Vm, K)
+ {
+ conc <- c(conc1, conc.1)
+
+ K.conc <- K+conc
+ dy.dV <- conc/K.conc
+ dy.dK <- -Vm*dy.dV/K.conc
+ pred <- Vm*dy.dV
+ pred.5 <- sqrt(pred)
+ dev <- (resp - pred) / pred.5
+ Ddev <- -0.5*(resp+pred)/(pred.5*pred)
+ attr(dev, "gradient") <- Ddev * cbind(Vm = dy.dV, K = dy.dK)
+ dev
+ }
>
> Pur.wt.grad <- nls( ~ weighted.MM.grad(rate, conc1, conc.1, Vm, K),
+ data = lisTreat, start = list(Vm = 200, K = 0.1))
>
> rbind(coef(Pur.wt), coef(Pur.wt1), coef(Pur.wt.grad))
Vm K
[1,] 206.83 0.054611
[2,] 206.83 0.054611
[3,] 206.83 0.054611
>
> ## In this example, there seems no advantage to providing the gradient.
> ## In other cases, there might be.
>
>
> ## The two examples below show that you can fit a model to
> ## artificial data with noise but not to artificial data
> ## without noise.
> x <- 1:10
> y <- 2*x + 3 # perfect fit
> yeps <- y + rnorm(length(y), sd = 0.01) # added noise
> nls(yeps ~ a + b*x, start = list(a = 0.12345, b = 0.54321))
Nonlinear regression model
model: yeps ~ a + b * x
data: parent.frame()
a b
3 2
residual sum-of-squares: 0.000524
> ## Not run:
> ##D ## terminates in an error, because convergence cannot be confirmed:
> ##D nls(y ~ a + b*x, start = list(a = 0.12345, b = 0.54321))
> ## End(Not run)
>
> ## the nls() internal cheap guess for starting values can be sufficient:
>
> x <- -(1:100)/10
> y <- 100 + 10 * exp(x / 2) + rnorm(x)/10
> nlmod <- nls(y ~ Const + A * exp(B * x))
Warning in nls(y ~ Const + A * exp(B * x)) :
No starting values specified for some parameters.
Intializing ‘Const’, ‘A’, ‘B’ to '1.'.
Consider specifying 'start' or using a selfStart model
>
> plot(x,y, main = "nls(*), data, true function and fit, n=100")
> curve(100 + 10 * exp(x / 2), col=4, add = TRUE)
> lines(x, predict(nlmod), col=2)
>
>
> ## The muscle dataset in MASS is from an experiment on muscle
> ## contraction on 21 animals. The observed variables are Strip
> ## (identifier of muscle), Conc (Cacl concentration) and Length
> ## (resulting length of muscle section).
> utils::data(muscle, package = "MASS")
>
> ## The non linear model considered is
> ## Length = alpha + beta*exp(-Conc/theta) + error
> ## where theta is constant but alpha and beta may vary with Strip.
>
> with(muscle, table(Strip)) # 2,3 or 4 obs per strip
Strip
S01 S02 S03 S04 S05 S06 S07 S08 S09 S10 S11 S12 S13 S14 S15 S16 S17 S18 S19 S20
4 4 4 3 3 3 2 2 2 2 3 2 2 2 2 4 4 3 3 3
S21
3
>
> ## We first use the plinear algorithm to fit an overall model,
> ## ignoring that alpha and beta might vary with Strip.
>
> musc.1 <- nls(Length ~ cbind(1, exp(-Conc/th)), muscle,
+ start = list(th=1), algorithm="plinear")
> summary(musc.1)
Formula: Length ~ cbind(1, exp(-Conc/th))
Parameters:
Estimate Std. Error t value Pr(>|t|)
th 0.608 0.115 5.31 1.9e-06 ***
.lin1 28.963 1.230 23.55 < 2e-16 ***
.lin2 -34.227 3.793 -9.02 1.4e-12 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 4.67 on 57 degrees of freedom
>
> ## Then we use nls' indexing feature for parameters in non-linear
> ## models to use the conventional algorithm to fit a model in which
> ## alpha and beta vary with Strip. The starting values are provided
> ## by the previously fitted model.
> ## Note that with indexed parameters, the starting values must be
> ## given in a list (with names):
> b <- coef(musc.1)
> musc.2 <- nls(Length ~ a[Strip] + b[Strip]*exp(-Conc/th),
+ muscle,
+ start = list(a=rep(b[2],21), b=rep(b[3],21), th=b[1]))
> summary(musc.2)
Formula: Length ~ a[Strip] + b[Strip] * exp(-Conc/th)
Parameters:
Estimate Std. Error t value Pr(>|t|)
a1 23.454 0.796 29.46 5.0e-16 ***
a2 28.302 0.793 35.70 < 2e-16 ***
a3 30.801 1.716 17.95 1.7e-12 ***
a4 25.921 3.016 8.60 1.4e-07 ***
a5 23.201 2.891 8.02 3.5e-07 ***
a6 20.120 2.435 8.26 2.3e-07 ***
a7 33.595 1.682 19.98 3.0e-13 ***
a8 39.053 3.753 10.41 8.6e-09 ***
a9 32.137 3.318 9.69 2.5e-08 ***
a10 40.005 3.336 11.99 1.0e-09 ***
a11 36.190 3.109 11.64 1.6e-09 ***
a12 36.911 1.839 20.07 2.8e-13 ***
a13 30.635 1.700 18.02 1.6e-12 ***
a14 34.312 3.495 9.82 2.0e-08 ***
a15 38.395 3.375 11.38 2.3e-09 ***
a16 31.226 0.886 35.26 < 2e-16 ***
a17 31.230 0.821 38.02 < 2e-16 ***
a18 19.998 1.011 19.78 3.6e-13 ***
a19 37.095 1.071 34.65 < 2e-16 ***
a20 32.594 1.121 29.07 6.2e-16 ***
a21 30.376 1.057 28.74 7.5e-16 ***
b1 -27.300 6.873 -3.97 0.00099 ***
b2 -26.270 6.754 -3.89 0.00118 **
b3 -30.901 2.270 -13.61 1.4e-10 ***
b4 -32.238 3.810 -8.46 1.7e-07 ***
b5 -29.941 3.773 -7.94 4.1e-07 ***
b6 -20.622 3.647 -5.65 2.9e-05 ***
b7 -19.625 8.085 -2.43 0.02661 *
b8 -45.780 4.113 -11.13 3.2e-09 ***
b9 -31.345 6.352 -4.93 0.00013 ***
b10 -38.599 3.955 -9.76 2.2e-08 ***
b11 -33.921 3.839 -8.84 9.2e-08 ***
b12 -38.268 8.992 -4.26 0.00053 ***
b13 -22.568 8.194 -2.75 0.01355 *
b14 -36.167 6.358 -5.69 2.7e-05 ***
b15 -32.952 6.354 -5.19 7.4e-05 ***
b16 -47.207 9.540 -4.95 0.00012 ***
b17 -33.875 7.688 -4.41 0.00039 ***
b18 -15.896 6.222 -2.55 0.02051 *
b19 -28.969 7.235 -4.00 0.00092 ***
b20 -36.917 8.033 -4.60 0.00026 ***
b21 -26.508 7.012 -3.78 0.00149 **
th 0.797 0.127 6.30 8.0e-06 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 1.11 on 17 degrees of freedom
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("nls.control")
> ### * nls.control
>
> flush(stderr()); flush(stdout())
>
> ### Name: nls.control
> ### Title: Control the Iterations in nls
> ### Aliases: nls.control
> ### Keywords: nonlinear regression models
>
> ### ** Examples
>
> nls.control(minFactor = 1/2048)
$maxiter
[1] 50
$tol
[1] 1e-05
$minFactor
[1] 0.0004882812
$printEval
[1] FALSE
$warnOnly
[1] FALSE
>
>
>
> cleanEx()
> nameEx("numericDeriv")
> ### * numericDeriv
>
> flush(stderr()); flush(stdout())
>
> ### Name: numericDeriv
> ### Title: Evaluate Derivatives Numerically
> ### Aliases: numericDeriv
> ### Keywords: models
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits=4)
> ## End Don't show
> myenv <- new.env()
> assign("mean", 0., envir = myenv)
> assign("sd", 1., envir = myenv)
> assign("x", seq(-3., 3., len = 31), envir = myenv)
> numericDeriv(quote(pnorm(x, mean, sd)), c("mean", "sd"), myenv)
[1] 0.001350 0.002555 0.004661 0.008198 0.013903 0.022750 0.035930 0.054799
[9] 0.080757 0.115070 0.158655 0.211855 0.274253 0.344578 0.420740 0.500000
[17] 0.579260 0.655422 0.725747 0.788145 0.841345 0.884930 0.919243 0.945201
[25] 0.964070 0.977250 0.986097 0.991802 0.995339 0.997445 0.998650
attr(,"gradient")
[,1] [,2]
[1,] -0.004432 0.01330
[2,] -0.007915 0.02216
[3,] -0.013583 0.03532
[4,] -0.022395 0.05375
[5,] -0.035475 0.07804
[6,] -0.053991 0.10798
[7,] -0.078950 0.14211
[8,] -0.110921 0.17747
[9,] -0.149727 0.20962
[10,] -0.194186 0.23302
[11,] -0.241971 0.24197
[12,] -0.289692 0.23175
[13,] -0.333225 0.19993
[14,] -0.368270 0.14731
[15,] -0.391043 0.07821
[16,] -0.398942 0.00000
[17,] -0.391043 -0.07821
[18,] -0.368270 -0.14731
[19,] -0.333225 -0.19993
[20,] -0.289692 -0.23175
[21,] -0.241971 -0.24197
[22,] -0.194186 -0.23302
[23,] -0.149727 -0.20962
[24,] -0.110921 -0.17747
[25,] -0.078950 -0.14211
[26,] -0.053991 -0.10798
[27,] -0.035475 -0.07804
[28,] -0.022395 -0.05375
[29,] -0.013583 -0.03532
[30,] -0.007915 -0.02216
[31,] -0.004432 -0.01330
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("oneway.test")
> ### * oneway.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: oneway.test
> ### Title: Test for Equal Means in a One-Way Layout
> ### Aliases: oneway.test
> ### Keywords: htest
>
> ### ** Examples
>
> ## Not assuming equal variances
> oneway.test(extra ~ group, data = sleep)
One-way analysis of means (not assuming equal variances)
data: extra and group
F = 3.4626, num df = 1.000, denom df = 17.776, p-value = 0.0794
> ## Assuming equal variances
> oneway.test(extra ~ group, data = sleep, var.equal = TRUE)
One-way analysis of means
data: extra and group
F = 3.4626, num df = 1, denom df = 18, p-value = 0.07919
> ## which gives the same result as
> anova(lm(extra ~ group, data = sleep))
Analysis of Variance Table
Response: extra
Df Sum Sq Mean Sq F value Pr(>F)
group 1 12.482 12.4820 3.4626 0.07919 .
Residuals 18 64.886 3.6048
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>
>
> cleanEx()
> nameEx("optim")
> ### * optim
>
> flush(stderr()); flush(stdout())
>
> ### Name: optim
> ### Title: General-purpose Optimization
> ### Aliases: optim
> ### Keywords: nonlinear optimize
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits = 5)
> ## End Don't show
> require(graphics)
>
> fr <- function(x) { ## Rosenbrock Banana function
+ x1 <- x[1]
+ x2 <- x[2]
+ 100 * (x2 - x1 * x1)^2 + (1 - x1)^2
+ }
> grr <- function(x) { ## Gradient of 'fr'
+ x1 <- x[1]
+ x2 <- x[2]
+ c(-400 * x1 * (x2 - x1 * x1) - 2 * (1 - x1),
+ 200 * (x2 - x1 * x1))
+ }
> optim(c(-1.2,1), fr)
$par
[1] 1.0003 1.0005
$value
[1] 8.8252e-08
$counts
function gradient
195 NA
$convergence
[1] 0
$message
NULL
> optim(c(-1.2,1), fr, grr, method = "BFGS")
$par
[1] 1 1
$value
[1] 9.595e-18
$counts
function gradient
110 43
$convergence
[1] 0
$message
NULL
> optim(c(-1.2,1), fr, NULL, method = "BFGS", hessian = TRUE)
$par
[1] 0.9998 0.9996
$value
[1] 3.8274e-08
$counts
function gradient
118 38
$convergence
[1] 0
$message
NULL
$hessian
[,1] [,2]
[1,] 801.69 -399.92
[2,] -399.92 200.00
> optim(c(-1.2,1), fr, grr, method = "L-BFGS-B")
$par
[1] 1 1
$value
[1] 2.2676e-13
$counts
function gradient
47 47
$convergence
[1] 0
$message
[1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
>
> flb <- function(x)
+ { p <- length(x); sum(c(1, rep(4, p-1)) * (x - c(1, x[-p])^2)^2) }
> ## 25-dimensional box constrained
> optim(rep(3, 25), flb, NULL, method = "L-BFGS-B",
+ lower=rep(2, 25), upper=rep(4, 25)) # par[24] is *not* at boundary
$par
[1] 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000
[11] 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000 2.0000
[21] 2.0000 2.0000 2.0000 2.1091 4.0000
$value
[1] 368.11
$counts
function gradient
6 6
$convergence
[1] 0
$message
[1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"
>
> ## "wild" function , global minimum at about -15.81515
> fw <- function (x)
+ 10*sin(0.3*x)*sin(1.3*x^2) + 0.00001*x^4 + 0.2*x+80
> plot(fw, -50, 50, n=1000, main = "optim() minimising 'wild function'")
>
> res <- optim(50, fw, method="SANN",
+ control=list(maxit=20000, temp=20, parscale=20))
> res
$par
[1] -15.815
$value
[1] 67.468
$counts
function gradient
20000 NA
$convergence
[1] 0
$message
NULL
> ## Now improve locally {typically only by a small bit}:
> (r2 <- optim(res$par, fw, method="BFGS"))
$par
[1] -15.815
$value
[1] 67.468
$counts
function gradient
19 2
$convergence
[1] 0
$message
NULL
> points(r2$par, r2$value, pch = 8, col = "red", cex = 2)
>
> ## Combinatorial optimization: Traveling salesman problem
> library(stats) # normally loaded
>
> eurodistmat <- as.matrix(eurodist)
>
> distance <- function(sq) { # Target function
+ sq2 <- embed(sq, 2)
+ return(sum(eurodistmat[cbind(sq2[,2],sq2[,1])]))
+ }
>
> genseq <- function(sq) { # Generate new candidate sequence
+ idx <- seq(2, NROW(eurodistmat)-1, by=1)
+ changepoints <- sample(idx, size=2, replace=FALSE)
+ tmp <- sq[changepoints[1]]
+ sq[changepoints[1]] <- sq[changepoints[2]]
+ sq[changepoints[2]] <- tmp
+ return(sq)
+ }
>
> sq <- c(1,2:NROW(eurodistmat),1) # Initial sequence
> distance(sq)
[1] 29625
>
> set.seed(123) # chosen to get a good soln relatively quickly
> res <- optim(sq, distance, genseq, method="SANN",
+ control = list(maxit=30000, temp=2000, trace=TRUE, REPORT=500))
sann objective function values
initial value 29625.000000
iter 5000 value 13585.000000
iter 10000 value 13092.000000
iter 15000 value 13063.000000
iter 20000 value 12919.000000
iter 25000 value 12907.000000
iter 29999 value 12842.000000
final value 12842.000000
sann stopped after 29999 iterations
> res # Near optimum distance around 12842
$par
[1] 1 19 16 8 15 2 14 9 12 13 18 5 4 3 11 7 20 10 6 17 21 1
$value
[1] 12842
$counts
function gradient
30000 NA
$convergence
[1] 0
$message
NULL
>
> loc <- cmdscale(eurodist)
> rx <- range(x <- loc[,1])
> ry <- range(y <- -loc[,2])
> tspinit <- loc[sq,]
> tspres <- loc[res$par,]
> s <- seq(NROW(tspres)-1)
>
> plot(x, y, type="n", asp=1, xlab="", ylab="",
+ main="initial solution of traveling salesman problem")
> arrows(tspinit[s,1], -tspinit[s,2], tspinit[s+1,1], -tspinit[s+1,2],
+ angle=10, col="green")
> text(x, y, labels(eurodist), cex=0.8)
>
> plot(x, y, type="n", asp=1, xlab="", ylab="",
+ main="optim() 'solving' traveling salesman problem")
> arrows(tspres[s,1], -tspres[s,2], tspres[s+1,1], -tspres[s+1,2],
+ angle=10, col="red")
> text(x, y, labels(eurodist), cex=0.8)
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("optimize")
> ### * optimize
>
> flush(stderr()); flush(stdout())
>
> ### Name: optimize
> ### Title: One Dimensional Optimization
> ### Aliases: optimize optimise
> ### Keywords: optimize
>
> ### ** Examples
>
> require(graphics)
>
> f <- function (x,a) (x-a)^2
> xmin <- optimize(f, c(0, 1), tol = 0.0001, a = 1/3)
> xmin
$minimum
[1] 0.3333333
$objective
[1] 0
>
> ## See where the function is evaluated:
> optimize(function(x) x^2*(print(x)-1), lower=0, upper=10)
[1] 3.81966
[1] 6.18034
[1] 2.36068
[1] 2.077939
[1] 1.505823
[1] 0.9306496
[1] 0.9196752
[1] 0.772905
[1] 0.4776816
[1] 0.6491436
[1] 0.656315
[1] 0.6653777
[1] 0.6667786
[1] 0.6666728
[1] 0.666632
[1] 0.6667135
[1] 0.6666728
$minimum
[1] 0.6666728
$objective
[1] -0.1481481
>
> ## "wrong" solution with unlucky interval and piecewise constant f():
> f <- function(x) ifelse(x > -1, ifelse(x < 4, exp(-1/abs(x - 1)), 10), 10)
> fp <- function(x) { print(x); f(x) }
>
> plot(f, -2,5, ylim = 0:1, col = 2)
> optimize(fp, c(-4, 20))# doesn't see the minimum
[1] 5.167184
[1] 10.83282
[1] 14.33437
[1] 16.49845
[1] 17.83592
[1] 18.66253
[1] 19.17340
[1] 19.48913
[1] 19.68427
[1] 19.80487
[1] 19.8794
[1] 19.92547
[1] 19.95393
[1] 19.97153
[1] 19.98240
[1] 19.98913
[1] 19.99328
[1] 19.99585
[1] 19.99743
[1] 19.99841
[1] 19.99902
[1] 19.99939
[1] 19.99963
[1] 19.99977
[1] 19.99986
[1] 19.99991
[1] 19.99995
[1] 19.99995
$minimum
[1] 19.99995
$objective
[1] 10
> optimize(fp, c(-7, 20))# ok
[1] 3.313082
[1] 9.686918
[1] -0.6261646
[1] 1.244956
[1] 1.250965
[1] 0.771827
[1] 0.2378417
[1] 1.000451
[1] 0.9906964
[1] 0.9955736
[1] 0.9980122
[1] 0.9992315
[1] 0.9998411
[1] 0.9996083
[1] 0.9994644
[1] 0.9993754
[1] 0.9993204
[1] 0.9992797
[1] 0.9992797
$minimum
[1] 0.9992797
$objective
[1] 0
>
>
>
> cleanEx()
> nameEx("order.dendrogram")
> ### * order.dendrogram
>
> flush(stderr()); flush(stdout())
>
> ### Name: order.dendrogram
> ### Title: Ordering or Labels of the Leaves in a Dendrogram
> ### Aliases: order.dendrogram labels.dendrogram
> ### Keywords: manip
>
> ### ** Examples
>
> set.seed(123)
> x <- rnorm(10)
> hc <- hclust(dist(x))
> hc$order
[1] 3 6 7 2 4 5 8 9 1 10
> dd <- as.dendrogram(hc)
> order.dendrogram(dd) ## the same :
[1] 3 6 7 2 4 5 8 9 1 10
> stopifnot(hc$order == order.dendrogram(dd))
>
> d2 <- as.dendrogram(hclust(dist(USArrests)))
> labels(d2) ## in this case the same as
[1] "Florida" "North Carolina" "Delaware" "Alabama"
[5] "Louisiana" "Alaska" "Mississippi" "South Carolina"
[9] "Maryland" "Arizona" "New Mexico" "California"
[13] "Illinois" "New York" "Michigan" "Nevada"
[17] "Missouri" "Arkansas" "Tennessee" "Georgia"
[21] "Colorado" "Texas" "Rhode Island" "Wyoming"
[25] "Oregon" "Oklahoma" "Virginia" "Washington"
[29] "Massachusetts" "New Jersey" "Ohio" "Utah"
[33] "Connecticut" "Pennsylvania" "Nebraska" "Kentucky"
[37] "Montana" "Idaho" "Indiana" "Kansas"
[41] "Hawaii" "Minnesota" "Wisconsin" "Iowa"
[45] "New Hampshire" "West Virginia" "Maine" "South Dakota"
[49] "North Dakota" "Vermont"
> stopifnot(labels(d2) == rownames(USArrests)[order.dendrogram(d2)])
>
>
>
> cleanEx()
> nameEx("p.adjust")
> ### * p.adjust
>
> flush(stderr()); flush(stdout())
>
> ### Name: p.adjust
> ### Title: Adjust P-values for Multiple Comparisons
> ### Aliases: p.adjust p.adjust.methods
> ### Keywords: htest
>
> ### ** Examples
>
> require(graphics)
>
> set.seed(123)
> x <- rnorm(50, mean=c(rep(0,25),rep(3,25)))
> p <- 2*pnorm( sort(-abs(x)))
>
> round(p, 3)
[1] 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.000 0.001 0.002
[13] 0.003 0.004 0.005 0.007 0.007 0.009 0.009 0.011 0.021 0.049 0.061 0.063
[25] 0.074 0.083 0.086 0.119 0.189 0.206 0.221 0.286 0.305 0.466 0.483 0.492
[37] 0.532 0.575 0.578 0.619 0.636 0.645 0.656 0.689 0.719 0.818 0.827 0.897
[49] 0.912 0.944
> round(p.adjust(p), 3)
[1] 0.000 0.001 0.001 0.005 0.005 0.006 0.006 0.007 0.009 0.016 0.024 0.063
[13] 0.125 0.131 0.189 0.239 0.240 0.291 0.301 0.350 0.635 1.000 1.000 1.000
[25] 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
[37] 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
[49] 1.000 1.000
> round(p.adjust(p,"BH"), 3)
[1] 0.000 0.000 0.000 0.001 0.001 0.001 0.001 0.001 0.001 0.002 0.003 0.007
[13] 0.013 0.013 0.017 0.021 0.021 0.024 0.025 0.028 0.050 0.112 0.130 0.130
[25] 0.148 0.159 0.160 0.213 0.326 0.343 0.356 0.446 0.462 0.684 0.684 0.684
[37] 0.719 0.741 0.741 0.763 0.763 0.763 0.763 0.782 0.799 0.880 0.880 0.930
[49] 0.930 0.944
>
> ## or all of them at once (dropping the "fdr" alias):
> p.adjust.M <- p.adjust.methods[p.adjust.methods != "fdr"]
> p.adj <- sapply(p.adjust.M, function(meth) p.adjust(p, meth))
> p.adj.60 <- sapply(p.adjust.M, function(meth) p.adjust(p, meth, n = 60))
> stopifnot(identical(p.adj[,"none"], p), p.adj <= p.adj.60)
> round(p.adj, 3)
holm hochberg hommel bonferroni BH BY none
[1,] 0.000 0.000 0.000 0.000 0.000 0.000 0.000
[2,] 0.001 0.001 0.001 0.001 0.000 0.002 0.000
[3,] 0.001 0.001 0.001 0.001 0.000 0.002 0.000
[4,] 0.005 0.005 0.004 0.005 0.001 0.004 0.000
[5,] 0.005 0.005 0.005 0.005 0.001 0.004 0.000
[6,] 0.006 0.006 0.005 0.006 0.001 0.004 0.000
[7,] 0.006 0.006 0.006 0.007 0.001 0.004 0.000
[8,] 0.007 0.007 0.007 0.008 0.001 0.004 0.000
[9,] 0.009 0.009 0.009 0.011 0.001 0.006 0.000
[10,] 0.016 0.016 0.015 0.019 0.002 0.009 0.000
[11,] 0.024 0.024 0.024 0.031 0.003 0.013 0.001
[12,] 0.063 0.063 0.058 0.081 0.007 0.030 0.002
[13,] 0.125 0.125 0.109 0.165 0.013 0.057 0.003
[14,] 0.131 0.131 0.117 0.177 0.013 0.057 0.004
[15,] 0.189 0.189 0.168 0.262 0.017 0.079 0.005
[16,] 0.239 0.239 0.212 0.342 0.021 0.093 0.007
[17,] 0.240 0.240 0.219 0.353 0.021 0.093 0.007
[18,] 0.291 0.291 0.273 0.440 0.024 0.110 0.009
[19,] 0.301 0.301 0.291 0.470 0.025 0.111 0.009
[20,] 0.350 0.350 0.339 0.565 0.028 0.127 0.011
[21,] 0.635 0.635 0.571 1.000 0.050 0.227 0.021
[22,] 1.000 0.944 0.944 1.000 0.112 0.503 0.049
[23,] 1.000 0.944 0.944 1.000 0.130 0.587 0.061
[24,] 1.000 0.944 0.944 1.000 0.130 0.587 0.063
[25,] 1.000 0.944 0.944 1.000 0.148 0.665 0.074
[26,] 1.000 0.944 0.944 1.000 0.159 0.717 0.083
[27,] 1.000 0.944 0.944 1.000 0.160 0.719 0.086
[28,] 1.000 0.944 0.944 1.000 0.213 0.957 0.119
[29,] 1.000 0.944 0.944 1.000 0.326 1.000 0.189
[30,] 1.000 0.944 0.944 1.000 0.343 1.000 0.206
[31,] 1.000 0.944 0.944 1.000 0.356 1.000 0.221
[32,] 1.000 0.944 0.944 1.000 0.446 1.000 0.286
[33,] 1.000 0.944 0.944 1.000 0.462 1.000 0.305
[34,] 1.000 0.944 0.944 1.000 0.684 1.000 0.466
[35,] 1.000 0.944 0.944 1.000 0.684 1.000 0.483
[36,] 1.000 0.944 0.944 1.000 0.684 1.000 0.492
[37,] 1.000 0.944 0.944 1.000 0.719 1.000 0.532
[38,] 1.000 0.944 0.944 1.000 0.741 1.000 0.575
[39,] 1.000 0.944 0.944 1.000 0.741 1.000 0.578
[40,] 1.000 0.944 0.944 1.000 0.763 1.000 0.619
[41,] 1.000 0.944 0.944 1.000 0.763 1.000 0.636
[42,] 1.000 0.944 0.944 1.000 0.763 1.000 0.645
[43,] 1.000 0.944 0.944 1.000 0.763 1.000 0.656
[44,] 1.000 0.944 0.944 1.000 0.782 1.000 0.689
[45,] 1.000 0.944 0.944 1.000 0.799 1.000 0.719
[46,] 1.000 0.944 0.944 1.000 0.880 1.000 0.818
[47,] 1.000 0.944 0.944 1.000 0.880 1.000 0.827
[48,] 1.000 0.944 0.944 1.000 0.930 1.000 0.897
[49,] 1.000 0.944 0.944 1.000 0.930 1.000 0.912
[50,] 1.000 0.944 0.944 1.000 0.944 1.000 0.944
> ## or a bit nicer:
> noquote(apply(p.adj, 2, format.pval, digits = 3))
holm hochberg hommel bonferroni BH BY none
[1,] 1.18e-05 1.18e-05 1.18e-05 1.18e-05 1.18e-05 5.3e-05 2.35e-07
[2,] 0.00103 0.00103 0.00101 0.00105 0.000429 0.00193 2.10e-05
[3,] 0.00124 0.00124 0.00124 0.00129 0.000429 0.00193 2.58e-05
[4,] 0.00461 0.00461 0.00422 0.00491 0.000947 0.00426 9.81e-05
[5,] 0.00484 0.00484 0.00453 0.00526 0.000947 0.00426 0.000105
[6,] 0.00559 0.00559 0.00521 0.00621 0.000947 0.00426 0.000124
[7,] 0.00583 0.00583 0.00557 0.00663 0.000947 0.00426 0.000133
[8,] 0.00674 0.00674 0.00659 0.00784 0.000980 0.00441 0.000157
[9,] 0.00947 0.00947 0.00924 0.01127 0.001253 0.00564 0.000225
[10,] 0.01556 0.01556 0.01518 0.01898 0.001898 0.00854 0.000380
[11,] 0.02446 0.02446 0.02446 0.03057 0.002780 0.01251 0.000611
[12,] 0.06294 0.06294 0.05810 0.08070 0.006725 0.03026 0.001614
[13,] 0.12549 0.12549 0.10898 0.16512 0.012637 0.05686 0.003302
[14,] 0.13092 0.13092 0.11677 0.17692 0.012637 0.05686 0.003538
[15,] 0.18853 0.18853 0.16758 0.26185 0.017457 0.07854 0.005237
[16,] 0.23912 0.23912 0.21179 0.34160 0.020762 0.09341 0.006832
[17,] 0.24001 0.24001 0.21884 0.35296 0.020762 0.09341 0.007059
[18,] 0.29057 0.29057 0.27296 0.44026 0.024459 0.11004 0.008805
[19,] 0.30083 0.30083 0.29143 0.47005 0.024740 0.11131 0.009401
[20,] 0.35024 0.35024 0.33894 0.56490 0.028245 0.12708 0.011298
[21,] 0.63451 0.63451 0.57105 1.00000 0.050358 0.22657 0.021150
[22,] 1.00000 0.94379 0.94379 1.00000 0.111880 0.50337 0.049227
[23,] 1.00000 0.94379 0.94379 1.00000 0.130463 0.58698 0.060533
[24,] 1.00000 0.94379 0.94379 1.00000 0.130463 0.58698 0.062622
[25,] 1.00000 0.94379 0.94379 1.00000 0.147903 0.66545 0.073952
[26,] 1.00000 0.94379 0.94379 1.00000 0.159252 0.71651 0.082811
[27,] 1.00000 0.94379 0.94379 1.00000 0.159877 0.71932 0.086333
[28,] 1.00000 0.94379 0.94379 1.00000 0.212617 0.95661 0.119065
[29,] 1.00000 0.94379 0.94379 1.00000 0.325999 1.00000 0.189080
[30,] 1.00000 0.94379 0.94379 1.00000 0.343082 1.00000 0.205849
[31,] 1.00000 0.94379 0.94379 1.00000 0.356325 1.00000 0.220921
[32,] 1.00000 0.94379 0.94379 1.00000 0.446250 1.00000 0.285600
[33,] 1.00000 0.94379 0.94379 1.00000 0.461954 1.00000 0.304889
[34,] 1.00000 0.94379 0.94379 1.00000 0.683577 1.00000 0.466068
[35,] 1.00000 0.94379 0.94379 1.00000 0.683577 1.00000 0.483081
[36,] 1.00000 0.94379 0.94379 1.00000 0.683577 1.00000 0.492175
[37,] 1.00000 0.94379 0.94379 1.00000 0.718845 1.00000 0.531945
[38,] 1.00000 0.94379 0.94379 1.00000 0.741435 1.00000 0.575155
[39,] 1.00000 0.94379 0.94379 1.00000 0.741435 1.00000 0.578319
[40,] 1.00000 0.94379 0.94379 1.00000 0.762606 1.00000 0.618589
[41,] 1.00000 0.94379 0.94379 1.00000 0.762606 1.00000 0.636362
[42,] 1.00000 0.94379 0.94379 1.00000 0.762606 1.00000 0.644859
[43,] 1.00000 0.94379 0.94379 1.00000 0.762606 1.00000 0.655841
[44,] 1.00000 0.94379 0.94379 1.00000 0.782487 1.00000 0.688588
[45,] 1.00000 0.94379 0.94379 1.00000 0.798874 1.00000 0.718986
[46,] 1.00000 0.94379 0.94379 1.00000 0.880265 1.00000 0.817954
[47,] 1.00000 0.94379 0.94379 1.00000 0.880265 1.00000 0.827449
[48,] 1.00000 0.94379 0.94379 1.00000 0.930478 1.00000 0.897130
[49,] 1.00000 0.94379 0.94379 1.00000 0.930478 1.00000 0.911868
[50,] 1.00000 0.94379 0.94379 1.00000 0.943789 1.00000 0.943789
>
>
> ## and a graphic:
> matplot(p, p.adj, ylab="p.adjust(p, meth)", type = "l", asp=1, lty=1:6,
+ main = "P-value adjustments")
> legend(.7,.6, p.adjust.M, col=1:6, lty=1:6)
>
> ## Can work with NA's:
> pN <- p; iN <- c(46,47); pN[iN] <- NA
> pN.a <- sapply(p.adjust.M, function(meth) p.adjust(pN, meth))
> ## The smallest 20 P-values all affected by the NA's :
> round((pN.a / p.adj)[1:20, ] , 4)
holm hochberg hommel bonferroni BH BY none
[1,] 0.9600 0.9600 0.9600 0.96 0.96 0.9514 1
[2,] 0.9592 0.9592 0.9583 0.96 0.96 0.9514 1
[3,] 0.9583 0.9583 0.9583 0.96 0.96 0.9514 1
[4,] 0.9574 0.9574 0.9535 0.96 0.96 0.9514 1
[5,] 0.9565 0.9565 0.9535 0.96 0.96 0.9514 1
[6,] 0.9556 0.9556 0.9524 0.96 0.96 0.9514 1
[7,] 0.9545 0.9545 0.9524 0.96 0.96 0.9514 1
[8,] 0.9535 0.9535 0.9524 0.96 0.96 0.9514 1
[9,] 0.9524 0.9524 0.9512 0.96 0.96 0.9514 1
[10,] 0.9512 0.9512 0.9500 0.96 0.96 0.9514 1
[11,] 0.9500 0.9500 0.9500 0.96 0.96 0.9514 1
[12,] 0.9487 0.9487 0.9444 0.96 0.96 0.9514 1
[13,] 0.9474 0.9474 0.9394 0.96 0.96 0.9514 1
[14,] 0.9459 0.9459 0.9394 0.96 0.96 0.9514 1
[15,] 0.9444 0.9444 0.9375 0.96 0.96 0.9514 1
[16,] 0.9429 0.9429 0.9355 0.96 0.96 0.9514 1
[17,] 0.9412 0.9412 0.9355 0.96 0.96 0.9514 1
[18,] 0.9394 0.9394 0.9355 0.96 0.96 0.9514 1
[19,] 0.9375 0.9375 0.9355 0.96 0.96 0.9514 1
[20,] 0.9355 0.9355 0.9333 0.96 0.96 0.9514 1
>
>
>
> cleanEx()
> nameEx("pairwise.prop.test")
> ### * pairwise.prop.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: pairwise.prop.test
> ### Title: Pairwise comparisons for proportions
> ### Aliases: pairwise.prop.test
> ### Keywords: htest
>
> ### ** Examples
>
> smokers <- c( 83, 90, 129, 70 )
> patients <- c( 86, 93, 136, 82 )
> pairwise.prop.test(smokers, patients)
Warning in prop.test(x[c(i, j)], n[c(i, j)], ...) :
Chi-squared approximation may be incorrect
Warning in prop.test(x[c(i, j)], n[c(i, j)], ...) :
Chi-squared approximation may be incorrect
Warning in prop.test(x[c(i, j)], n[c(i, j)], ...) :
Chi-squared approximation may be incorrect
Pairwise comparisons using Pairwise comparison of proportions
data: smokers out of patients
1 2 3
2 1.000 - -
3 1.000 1.000 -
4 0.119 0.093 0.124
P value adjustment method: holm
>
>
>
> cleanEx()
> nameEx("pairwise.t.test")
> ### * pairwise.t.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: pairwise.t.test
> ### Title: Pairwise t tests
> ### Aliases: pairwise.t.test
> ### Keywords: htest
>
> ### ** Examples
>
> attach(airquality)
> Month <- factor(Month, labels = month.abb[5:9])
> pairwise.t.test(Ozone, Month)
Pairwise comparisons using t tests with pooled SD
data: Ozone and Month
May Jun Jul Aug
Jun 1.00000 - - -
Jul 0.00026 0.05113 - -
Aug 0.00019 0.04987 1.00000 -
Sep 1.00000 1.00000 0.00488 0.00388
P value adjustment method: holm
> pairwise.t.test(Ozone, Month, p.adj = "bonf")
Pairwise comparisons using t tests with pooled SD
data: Ozone and Month
May Jun Jul Aug
Jun 1.00000 - - -
Jul 0.00029 0.10225 - -
Aug 0.00019 0.08312 1.00000 -
Sep 1.00000 1.00000 0.00697 0.00485
P value adjustment method: bonferroni
> pairwise.t.test(Ozone, Month, pool.sd = FALSE)
Pairwise comparisons using t tests with non-pooled SD
data: Ozone and Month
May Jun Jul Aug
Jun 1.00000 - - -
Jul 0.00026 0.01527 - -
Aug 0.00195 0.02135 1.00000 -
Sep 0.86321 1.00000 0.00589 0.01721
P value adjustment method: holm
> detach()
>
>
>
> cleanEx()
> nameEx("pairwise.wilcox.test")
> ### * pairwise.wilcox.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: pairwise.wilcox.test
> ### Title: Pairwise Wilcoxon Rank Sum Tests
> ### Aliases: pairwise.wilcox.test
> ### Keywords: htest
>
> ### ** Examples
>
> attach(airquality)
> Month <- factor(Month, labels = month.abb[5:9])
> ## These give warnings because of ties :
> pairwise.wilcox.test(Ozone, Month)
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Pairwise comparisons using Wilcoxon rank sum test
data: Ozone and Month
May Jun Jul Aug
Jun 0.5775 - - -
Jul 0.0003 0.0848 - -
Aug 0.0011 0.1295 1.0000 -
Sep 0.4744 1.0000 0.0060 0.0227
P value adjustment method: holm
> pairwise.wilcox.test(Ozone, Month, p.adj = "bonf")
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Warning in wilcox.test.default(xi, xj, paired = paired, ...) :
cannot compute exact p-value with ties
Pairwise comparisons using Wilcoxon rank sum test
data: Ozone and Month
May Jun Jul Aug
Jun 1.0000 - - -
Jul 0.0003 0.1414 - -
Aug 0.0012 0.2591 1.0000 -
Sep 1.0000 1.0000 0.0074 0.0325
P value adjustment method: bonferroni
> detach()
>
>
>
> cleanEx()
> nameEx("plot.acf")
> ### * plot.acf
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.acf
> ### Title: Plot Autocovariance and Autocorrelation Functions
> ### Aliases: plot.acf
> ### Keywords: hplot ts
>
> ### ** Examples
>
> require(graphics)
>
> z4 <- ts(matrix(rnorm(400), 100, 4), start=c(1961, 1), frequency=12)
> z7 <- ts(matrix(rnorm(700), 100, 7), start=c(1961, 1), frequency=12)
> acf(z4)
> acf(z7, max.mfrow = 7)# squeeze on 1 page
> acf(z7) # multi-page
>
>
>
> cleanEx()
> nameEx("plot.isoreg")
> ### * plot.isoreg
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.isoreg
> ### Title: Plot Method for isoreg Objects
> ### Aliases: plot.isoreg lines.isoreg
> ### Keywords: hplot print
>
> ### ** Examples
>
> require(graphics)
>
> utils::example(isoreg) # for the examples there
isoreg> require(graphics)
isoreg> (ir <- isoreg(c(1,0,4,3,3,5,4,2,0)))
Isotonic regression from isoreg(x = c(1, 0, 4, 3, 3, 5, 4, 2, 0)),
with 2 knots / breaks at obs.nr. 2 9 ;
initially ordered 'x'
and further components List of 4
$ x : num [1:9] 1 2 3 4 5 6 7 8 9
$ y : num [1:9] 1 0 4 3 3 5 4 2 0
$ yf: num [1:9] 0.5 0.5 3 3 3 3 3 3 3
$ yc: num [1:10] 0 1 1 5 8 11 16 20 22 22
isoreg> plot(ir, plot.type = "row")
isoreg> (ir3 <- isoreg(y3 <- c(1,0,4,3,3,5,4,2, 3)))# last "3", not "0"
Isotonic regression from isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3)),
with 3 knots / breaks at obs.nr. 2 5 9 ;
initially ordered 'x'
and further components List of 4
$ x : num [1:9] 1 2 3 4 5 6 7 8 9
$ y : num [1:9] 1 0 4 3 3 5 4 2 3
$ yf: num [1:9] 0.5 0.5 3.33 3.33 3.33 ...
$ yc: num [1:10] 0 1 1 5 8 11 16 20 22 25
isoreg> (fi3 <- as.stepfun(ir3))
Step function
Call: isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3))
x[1:3] = 2, 5, 9
4 plateau levels = 0.5, 0.5, 3.3333, 3.5
isoreg> (ir4 <- isoreg(1:10, y4 <- c(5, 9, 1:2, 5:8, 3, 8)))
Isotonic regression from isoreg(x = 1:10, y = y4 <- c(5, 9, 1:2, 5:8, 3, 8)),
with 5 knots / breaks at obs.nr. 4 5 6 9 10 ;
initially ordered 'x'
and further components List of 4
$ x : num [1:10] 1 2 3 4 5 6 7 8 9 10
$ y : num [1:10] 5 9 1 2 5 6 7 8 3 8
$ yf: num [1:10] 4.25 4.25 4.25 4.25 5 6 6 6 6 8
$ yc: num [1:11] 0 5 14 15 17 22 28 35 43 46 ...
isoreg> cat(sprintf("R^2 = %.2f\n",
isoreg+ 1 - sum(residuals(ir4)^2) / ((10-1)*var(y4))))
R^2 = 0.21
isoreg> ## If you are interested in the knots alone :
isoreg> with(ir4, cbind(iKnots, yf[iKnots]))
iKnots
[1,] 4 4.25
[2,] 5 5.00
[3,] 6 6.00
[4,] 9 6.00
[5,] 10 8.00
isoreg> ## Example of unordered x[] with ties:
isoreg> x <- sample((0:30)/8)
isoreg> y <- exp(x)
isoreg> x. <- round(x) # ties!
isoreg> plot(m <- isoreg(x., y))
isoreg> stopifnot(all.equal(with(m, yf[iKnots]),
isoreg+ as.vector(tapply(y, x., mean))))
>
> plot(y3, main = "simple plot(.) + lines(<isoreg>)")
> lines(ir3)
>
> ## 'same' plot as above, "proving" that only ranks of 'x' are important
> plot(isoreg(2^(1:9), c(1,0,4,3,3,5,4,2,0)), plot.type = "row", log = "x")
Warning in xy.coords(x, y, xlabel, ylabel, log) :
1 x value <= 0 omitted from logarithmic plot
Warning in xy.coords(x, y, xlabel, ylabel, log) :
1 x value <= 0 omitted from logarithmic plot
>
> plot(ir3, plot.type = "row", ylab = "y3")
> plot(isoreg(y3 - 4), plot.t="r", ylab = "y3 - 4")
> plot(ir4, plot.type = "ro", ylab = "y4", xlab = "x = 1:n")
>
> ## experiment a bit with these (C-c C-j):
> plot(isoreg(sample(9), y3), plot.type="row")
> plot(isoreg(sample(9), y3), plot.type="col.wise")
>
> plot(ir <- isoreg(sample(10), sample(10, replace = TRUE)),
+ plot.type = "r")
>
>
>
> cleanEx()
> nameEx("plot.lm")
> ### * plot.lm
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.lm
> ### Title: Plot Diagnostics for an lm Object
> ### Aliases: plot.lm plot.mlm
> ### Keywords: hplot regression
>
> ### ** Examples
>
> require(graphics)
>
> ## Analysis of the life-cycle savings data
> ## given in Belsley, Kuh and Welsch.
> plot(lm.SR <- lm(sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings))
>
> ## 4 plots on 1 page;
> ## allow room for printing model formula in outer margin:
> par(mfrow = c(2, 2), oma = c(0, 0, 2, 0))
> plot(lm.SR)
> plot(lm.SR, id.n = NULL) # no id's
> plot(lm.SR, id.n = 5, labels.id = NULL)# 5 id numbers
>
> ## Was default in R <= 2.1.x:
> ## Cook's distances instead of Residual-Leverage plot
> plot(lm.SR, which = 1:4)
>
> ## Fit a smooth curve, where applicable:
> plot(lm.SR, panel = panel.smooth)
> ## Gives a smoother curve
> plot(lm.SR, panel = function(x,y) panel.smooth(x, y, span = 1))
>
> par(mfrow=c(2,1))# same oma as above
> plot(lm.SR, which = 1:2, sub.caption = "Saving Rates, n=50, p=5")
>
> ## Don't show:
> ## An example with *long* formula that needs abbreviation:
> for(i in 1:5) assign(paste("long.var.name",i,sep="."), runif(10))
> plot(lm(long.var.name.1 ~
+ long.var.name.2 + long.var.name.3 + long.var.name.4 + long.var.name.5))
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.ppr")
> ### * plot.ppr
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.ppr
> ### Title: Plot Ridge Functions for Projection Pursuit Regression Fit
> ### Aliases: plot.ppr
> ### Keywords: hplot
>
> ### ** Examples
>
> require(graphics)
>
> with(rock, {
+ area1 <- area/10000; peri1 <- peri/10000
+ par(mfrow=c(3,2))# maybe: , pty="s")
+ rock.ppr <- ppr(log(perm) ~ area1 + peri1 + shape,
+ data = rock, nterms = 2, max.terms = 5)
+ plot(rock.ppr, main="ppr(log(perm)~ ., nterms=2, max.terms=5)")
+ plot(update(rock.ppr, bass=5), main = "update(..., bass = 5)")
+ plot(update(rock.ppr, sm.method="gcv", gcvpen=2),
+ main = "update(..., sm.method=\"gcv\", gcvpen=2)")
+ })
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.profile.nls")
> ### * plot.profile.nls
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.profile.nls
> ### Title: Plot a profile.nls Object
> ### Aliases: plot.profile.nls
> ### Keywords: nonlinear regression models
>
> ### ** Examples
>
> require(graphics)
>
> # obtain the fitted object
> fm1 <- nls(demand ~ SSasympOrig(Time, A, lrc), data = BOD)
> # get the profile for the fitted model
> pr1 <- profile(fm1, alpha = 0.05)
> opar <- par(mfrow = c(2,2), oma = c(1.1, 0, 1.1, 0), las = 1)
> plot(pr1, conf = c(95, 90, 80, 50)/100)
> plot(pr1, conf = c(95, 90, 80, 50)/100, absVal = FALSE)
> mtext("Confidence intervals based on the profile sum of squares",
+ side = 3, outer = TRUE)
> mtext("BOD data - confidence levels of 50%, 80%, 90% and 95%",
+ side = 1, outer = TRUE)
> par(opar)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.stepfun")
> ### * plot.stepfun
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.stepfun
> ### Title: Plot Step Functions
> ### Aliases: plot.stepfun lines.stepfun
> ### Keywords: hplot
>
> ### ** Examples
>
> require(graphics)
>
> y0 <- c(1,2,4,3)
> sfun0 <- stepfun(1:3, y0, f = 0)
> sfun.2 <- stepfun(1:3, y0, f = .2)
> sfun1 <- stepfun(1:3, y0, right = TRUE)
>
> tt <- seq(0,3, by=0.1)
> op <- par(mfrow=c(2,2))
> plot(sfun0); plot(sfun0, xval=tt, add=TRUE, col.hor="bisque")
> plot(sfun.2);plot(sfun.2,xval=tt, add=TRUE, col = "orange")# all colors
> plot(sfun1);lines(sfun1, xval=tt, col.hor="coral")
> ##-- This is revealing :
> plot(sfun0, verticals= FALSE,
+ main = "stepfun(x, y0, f=f) for f = 0, .2, 1")
> for(i in 1:3)
+ lines(list(sfun0,sfun.2,stepfun(1:3,y0,f = 1))[[i]], col=i)
> legend(2.5, 1.9, paste("f =", c(0,0.2,1)), col=1:3, lty=1, y.intersp=1)
> par(op)
>
> # Extend and/or restrict 'viewport':
> plot(sfun0, xlim = c(0,5), ylim = c(0, 3.5),
+ main = "plot(stepfun(*), xlim= . , ylim = .)")
>
> ##-- this works too (automatic call to ecdf(.)):
> plot.stepfun(rt(50, df=3), col.vert = "gray20")
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("plot.ts")
> ### * plot.ts
>
> flush(stderr()); flush(stdout())
>
> ### Name: plot.ts
> ### Title: Plotting Time-Series Objects
> ### Aliases: plot.ts lines.ts
> ### Keywords: hplot ts
>
> ### ** Examples
>
> require(graphics)
>
> ## Multivariate
> z <- ts(matrix(rt(200 * 8, df = 3), 200, 8),
+ start = c(1961, 1), frequency = 12)
> plot(z, yax.flip = TRUE)
> plot(z, axes = FALSE, ann = FALSE, frame.plot = TRUE,
+ mar.multi = c(0,0,0,0), oma.multi = c(1,1,5,1))
> title("plot(ts(..), axes=FALSE, ann=FALSE, frame.plot=TRUE, mar..., oma...)")
>
> z <- window(z[,1:3], end = c(1969,12))
> plot(z, type = "b") # multiple
> plot(z, plot.type="single", lty=1:3, col=4:2)
>
> ## A phase plot:
> plot(nhtemp, c(nhtemp[-1], NA), cex = .8, col="blue",
+ main = "Lag plot of New Haven temperatures")
> ## a clearer way to do this would be
> ## Not run:
> ##D plot(nhtemp, lag(nhtemp, 1), cex = .8, col="blue",
> ##D main = "Lag plot of New Haven temperatures")
> ## End(Not run)
>
> ## xy.lines and xy.labels are FALSE for large series:
> plot(lag(sunspots, 1), sunspots, pch = ".")
>
> SMI <- EuStockMarkets[, "SMI"]
> plot(lag(SMI, 1), SMI, pch = ".")
> plot(lag(SMI, 20), SMI, pch = ".", log = "xy",
+ main = "4 weeks lagged SMI stocks -- log scale", xy.lines= TRUE)
>
>
>
> cleanEx()
> nameEx("poisson.test")
> ### * poisson.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: poisson.test
> ### Title: Exact Poisson tests
> ### Aliases: poisson.test
> ### Keywords: htest
>
> ### ** Examples
>
> ### These are paraphrased from data sets in the ISwR package
>
> ## SMR, Welsh Nickel workers
> poisson.test(137, 24.19893)
Exact Poisson test
data: 137 time base: 24.19893
number of events = 137, time base = 24.199, p-value < 2.2e-16
alternative hypothesis: true event rate is not equal to 1
95 percent confidence interval:
4.753125 6.692709
sample estimates:
event rate
5.661407
>
> ## eba1977, compare Fredericia to other three cities for ages 55-59
> poisson.test(c(11,6+8+7),c(800, 1083+1050+878))
Comparison of Poisson rates
data: c(11, 6 + 8 + 7) time base: c(800, 1083 + 1050 + 878)
count1 = 11, expected count1 = 6.717, p-value = 0.07967
alternative hypothesis: true rate ratio is not equal to 1
95 percent confidence interval:
0.8584264 4.2772659
sample estimates:
rate ratio
1.971488
>
>
>
> cleanEx()
> nameEx("poly")
> ### * poly
>
> flush(stderr()); flush(stdout())
>
> ### Name: poly
> ### Title: Compute Orthogonal Polynomials
> ### Aliases: poly polym predict.poly makepredictcall.poly
> ### Keywords: math
>
> ### ** Examples
>
> od <- options(digits=3) # avoid too much visual clutter
> (z <- poly(1:10, 3))
1 2 3
[1,] -0.495 0.522 -0.453
[2,] -0.385 0.174 0.151
[3,] -0.275 -0.087 0.378
[4,] -0.165 -0.261 0.335
[5,] -0.055 -0.348 0.130
[6,] 0.055 -0.348 -0.130
[7,] 0.165 -0.261 -0.335
[8,] 0.275 -0.087 -0.378
[9,] 0.385 0.174 -0.151
[10,] 0.495 0.522 0.453
attr(,"degree")
[1] 1 2 3
attr(,"coefs")
attr(,"coefs")$alpha
[1] 5.5 5.5 5.5
attr(,"coefs")$norm2
[1] 1.0 10.0 82.5 528.0 3088.8
attr(,"class")
[1] "poly" "matrix"
> predict(z, seq(2, 4, 0.5))
1 2 3
[1,] -0.385 0.1741 0.151
[2,] -0.330 0.0326 0.305
[3,] -0.275 -0.0870 0.378
[4,] -0.220 -0.1850 0.383
[5,] -0.165 -0.2611 0.335
attr(,"degree")
[1] 1 2 3
attr(,"coefs")
attr(,"coefs")$alpha
[1] 5.5 5.5 5.5
attr(,"coefs")$norm2
[1] 1.0 10.0 82.5 528.0 3088.8
attr(,"class")
[1] "poly" "matrix"
> zapsmall(poly(seq(4, 6, 0.5), 3, coefs = attr(z, "coefs")))
1 2 3
[1,] -0.165 -0.261 0.335
[2,] -0.110 -0.316 0.246
[3,] -0.055 -0.348 0.130
[4,] 0.000 -0.359 0.000
[5,] 0.055 -0.348 -0.130
attr(,"degree")
[1] 1 2 3
attr(,"coefs")
attr(,"coefs")$alpha
[1] 5.5 5.5 5.5
attr(,"coefs")$norm2
[1] 1.0 10.0 82.5 528.0 3088.8
attr(,"class")
[1] "poly" "matrix"
>
> zapsmall(polym(1:4, c(1, 4:6), degree=3)) # or just poly()
1.0 2.0 3.0 0.1 1.1 2.1 0.2 1.2 0.3
[1,] -0.671 0.5 -0.224 -0.802 0.538 -0.401 0.323 -0.217 -0.053
[2,] -0.224 -0.5 0.671 0.000 0.000 0.000 -0.688 0.154 0.526
[3,] 0.224 -0.5 -0.671 0.267 0.060 -0.134 -0.239 -0.053 -0.788
[4,] 0.671 0.5 0.224 0.535 0.359 0.267 0.604 0.405 0.315
attr(,"degree")
[1] 1 2 3 1 2 3 2 3 3
> zapsmall(poly(cbind(1:4, c(1, 4:6)), degree=3))
1.0 2.0 3.0 0.1 1.1 2.1 0.2 1.2 0.3
[1,] -0.671 0.5 -0.224 -0.802 0.538 -0.401 0.323 -0.217 -0.053
[2,] -0.224 -0.5 0.671 0.000 0.000 0.000 -0.688 0.154 0.526
[3,] 0.224 -0.5 -0.671 0.267 0.060 -0.134 -0.239 -0.053 -0.788
[4,] 0.671 0.5 0.224 0.535 0.359 0.267 0.604 0.405 0.315
attr(,"degree")
[1] 1 2 3 1 2 3 2 3 3
> options(od)
>
>
>
> cleanEx()
> nameEx("power")
> ### * power
>
> flush(stderr()); flush(stdout())
>
> ### Name: power
> ### Title: Create a Power Link Object
> ### Aliases: power
> ### Keywords: models
>
> ### ** Examples
>
> power()
$linkfun
function (mu)
mu
<environment: 0x517d8f8>
$linkinv
function (eta)
eta
<environment: 0x517d8f8>
$mu.eta
function (eta)
rep.int(1, length(eta))
<environment: 0x517d8f8>
$valideta
function (eta)
TRUE
<environment: 0x517d8f8>
$name
[1] "identity"
attr(,"class")
[1] "link-glm"
> quasi(link=power(1/3))[c("linkfun", "linkinv")]
$linkfun
function (mu)
mu^lambda
<environment: 0x5161f88>
$linkinv
function (eta)
pmax(eta^(1/lambda), .Machine$double.eps)
<environment: 0x5161f88>
>
>
>
> cleanEx()
> nameEx("power.anova.test")
> ### * power.anova.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: power.anova.test
> ### Title: Power Calculations for Balanced One-Way Analysis of Variance
> ### Tests
> ### Aliases: power.anova.test
> ### Keywords: htest
>
> ### ** Examples
>
> power.anova.test(groups=4, n=5, between.var=1, within.var=3)
Balanced one-way analysis of variance power calculation
groups = 4
n = 5
between.var = 1
within.var = 3
sig.level = 0.05
power = 0.3535594
NOTE: n is number in each group
> # Power = 0.3535594
>
> power.anova.test(groups=4, between.var=1, within.var=3,
+ power=.80)
Balanced one-way analysis of variance power calculation
groups = 4
n = 11.92613
between.var = 1
within.var = 3
sig.level = 0.05
power = 0.8
NOTE: n is number in each group
> # n = 11.92613
>
> ## Assume we have prior knowledge of the group means:
> groupmeans <- c(120, 130, 140, 150)
> power.anova.test(groups = length(groupmeans),
+ between.var=var(groupmeans),
+ within.var=500, power=.90) # n = 15.18834
Balanced one-way analysis of variance power calculation
groups = 4
n = 15.18834
between.var = 166.6667
within.var = 500
sig.level = 0.05
power = 0.9
NOTE: n is number in each group
>
>
>
>
> cleanEx()
> nameEx("power.prop.test")
> ### * power.prop.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: power.prop.test
> ### Title: Power Calculations for Two-Sample Test for Proportions
> ### Aliases: power.prop.test
> ### Keywords: htest
>
> ### ** Examples
>
> power.prop.test(n = 50, p1 = .50, p2 = .75)
Two-sample comparison of proportions power calculation
n = 50
p1 = 0.5
p2 = 0.75
sig.level = 0.05
power = 0.7401659
alternative = two.sided
NOTE: n is number in *each* group
> power.prop.test(p1 = .50, p2 = .75, power = .90)
Two-sample comparison of proportions power calculation
n = 76.70693
p1 = 0.5
p2 = 0.75
sig.level = 0.05
power = 0.9
alternative = two.sided
NOTE: n is number in *each* group
> power.prop.test(n = 50, p1 = .5, power = .90)
Two-sample comparison of proportions power calculation
n = 50
p1 = 0.5
p2 = 0.8026141
sig.level = 0.05
power = 0.9
alternative = two.sided
NOTE: n is number in *each* group
>
>
>
> cleanEx()
> nameEx("power.t.test")
> ### * power.t.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: power.t.test
> ### Title: Power calculations for one and two sample t tests
> ### Aliases: power.t.test
> ### Keywords: htest
>
> ### ** Examples
>
> power.t.test(n = 20, delta = 1)
Two-sample t test power calculation
n = 20
delta = 1
sd = 1
sig.level = 0.05
power = 0.8689528
alternative = two.sided
NOTE: n is number in *each* group
> power.t.test(power = .90, delta = 1)
Two-sample t test power calculation
n = 22.02110
delta = 1
sd = 1
sig.level = 0.05
power = 0.9
alternative = two.sided
NOTE: n is number in *each* group
> power.t.test(power = .90, delta = 1, alternative = "one.sided")
Two-sample t test power calculation
n = 17.84713
delta = 1
sd = 1
sig.level = 0.05
power = 0.9
alternative = one.sided
NOTE: n is number in *each* group
>
>
>
> cleanEx()
> nameEx("pp.test")
> ### * pp.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: PP.test
> ### Title: Phillips-Perron Test for Unit Roots
> ### Aliases: PP.test
> ### Keywords: ts
>
> ### ** Examples
>
> x <- rnorm(1000)
> PP.test(x)
Phillips-Perron Unit Root Test
data: x
Dickey-Fuller = -33.0567, Truncation lag parameter = 7, p-value = 0.01
> y <- cumsum(x) # has unit root
> PP.test(y)
Phillips-Perron Unit Root Test
data: y
Dickey-Fuller = -2.6899, Truncation lag parameter = 7, p-value = 0.2863
>
>
>
> cleanEx()
> nameEx("ppoints")
> ### * ppoints
>
> flush(stderr()); flush(stdout())
>
> ### Name: ppoints
> ### Title: Ordinates for Probability Plotting
> ### Aliases: ppoints
> ### Keywords: dplot arith distribution
>
> ### ** Examples
>
> ppoints(4) # the same as ppoints(1:4)
[1] 0.1470588 0.3823529 0.6176471 0.8529412
> ppoints(10)
[1] 0.06097561 0.15853659 0.25609756 0.35365854 0.45121951 0.54878049
[7] 0.64634146 0.74390244 0.84146341 0.93902439
> ppoints(10, a=1/2)
[1] 0.05 0.15 0.25 0.35 0.45 0.55 0.65 0.75 0.85 0.95
>
>
>
> cleanEx()
> nameEx("ppr")
> ### * ppr
>
> flush(stderr()); flush(stdout())
>
> ### Name: ppr
> ### Title: Projection Pursuit Regression
> ### Aliases: ppr ppr.default ppr.formula
> ### Keywords: regression
>
> ### ** Examples
>
> require(graphics)
>
> # Note: your numerical values may differ
> attach(rock)
> area1 <- area/10000; peri1 <- peri/10000
> rock.ppr <- ppr(log(perm) ~ area1 + peri1 + shape,
+ data = rock, nterms = 2, max.terms = 5)
> rock.ppr
Call:
ppr(formula = log(perm) ~ area1 + peri1 + shape, data = rock,
nterms = 2, max.terms = 5)
Goodness of fit:
2 terms 3 terms 4 terms 5 terms
8.737806 5.289517 4.745799 4.490378
> # Call:
> # ppr.formula(formula = log(perm) ~ area1 + peri1 + shape, data = rock,
> # nterms = 2, max.terms = 5)
> #
> # Goodness of fit:
> # 2 terms 3 terms 4 terms 5 terms
> # 8.737806 5.289517 4.745799 4.490378
>
> summary(rock.ppr)
Call:
ppr(formula = log(perm) ~ area1 + peri1 + shape, data = rock,
nterms = 2, max.terms = 5)
Goodness of fit:
2 terms 3 terms 4 terms 5 terms
8.737806 5.289517 4.745799 4.490378
Projection direction vectors:
term 1 term 2
area1 0.34357179 0.37071027
peri1 -0.93781471 -0.61923542
shape 0.04961846 0.69218595
Coefficients of ridge terms:
term 1 term 2
1.6079271 0.5460971
> # ..... (same as above)
> # .....
> #
> # Projection direction vectors:
> # term 1 term 2
> # area1 0.34357179 0.37071027
> # peri1 -0.93781471 -0.61923542
> # shape 0.04961846 0.69218595
> #
> # Coefficients of ridge terms:
> # term 1 term 2
> # 1.6079271 0.5460971
>
> par(mfrow=c(3,2))# maybe: , pty="s")
> plot(rock.ppr, main="ppr(log(perm)~ ., nterms=2, max.terms=5)")
> plot(update(rock.ppr, bass=5), main = "update(..., bass = 5)")
> plot(update(rock.ppr, sm.method="gcv", gcvpen=2),
+ main = "update(..., sm.method=\"gcv\", gcvpen=2)")
> cbind(perm=rock$perm, prediction=round(exp(predict(rock.ppr)), 1))
perm prediction
1 6.3 5.9
2 6.3 6.5
3 6.3 12.1
4 6.3 7.4
5 17.1 16.3
6 17.1 13.2
7 17.1 41.2
8 17.1 10.6
9 119.0 101.9
10 119.0 73.0
11 119.0 46.8
12 119.0 121.7
13 82.4 107.8
14 82.4 79.7
15 82.4 98.3
16 82.4 128.8
17 58.6 66.8
18 58.6 33.2
19 58.6 58.7
20 58.6 111.6
21 142.0 118.9
22 142.0 128.4
23 142.0 91.9
24 142.0 188.5
25 740.0 341.7
26 740.0 577.9
27 740.0 895.7
28 740.0 1041.0
29 890.0 560.8
30 890.0 721.8
31 890.0 937.9
32 890.0 848.5
33 950.0 806.4
34 950.0 1085.4
35 950.0 945.6
36 950.0 848.5
37 100.0 154.1
38 100.0 178.0
39 100.0 321.5
40 100.0 232.7
41 1300.0 1067.0
42 1300.0 697.8
43 1300.0 1236.6
44 1300.0 1301.8
45 580.0 485.1
46 580.0 285.1
47 580.0 644.3
48 580.0 571.5
> detach()
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("prcomp")
> ### * prcomp
>
> flush(stderr()); flush(stdout())
>
> ### Name: prcomp
> ### Title: Principal Components Analysis
> ### Aliases: prcomp prcomp.formula prcomp.default plot.prcomp
> ### predict.prcomp print.prcomp summary.prcomp print.summary.prcomp
> ### Keywords: multivariate
>
> ### ** Examples
>
> require(graphics)
>
> ## the variances of the variables in the
> ## USArrests data vary by orders of magnitude, so scaling is appropriate
> prcomp(USArrests) # inappropriate
Standard deviations:
[1] 83.732400 14.212402 6.489426 2.482790
Rotation:
PC1 PC2 PC3 PC4
Murder 0.04170432 -0.04482166 0.07989066 -0.99492173
Assault 0.99522128 -0.05876003 -0.06756974 0.03893830
UrbanPop 0.04633575 0.97685748 -0.20054629 -0.05816914
Rape 0.07515550 0.20071807 0.97408059 0.07232502
> prcomp(USArrests, scale = TRUE)
Standard deviations:
[1] 1.5748783 0.9948694 0.5971291 0.4164494
Rotation:
PC1 PC2 PC3 PC4
Murder -0.5358995 0.4181809 -0.3412327 0.64922780
Assault -0.5831836 0.1879856 -0.2681484 -0.74340748
UrbanPop -0.2781909 -0.8728062 -0.3780158 0.13387773
Rape -0.5434321 -0.1673186 0.8177779 0.08902432
> prcomp(~ Murder + Assault + Rape, data = USArrests, scale = TRUE)
Standard deviations:
[1] 1.5357670 0.6767949 0.4282154
Rotation:
PC1 PC2 PC3
Murder -0.5826006 0.5339532 -0.6127565
Assault -0.6079818 0.2140236 0.7645600
Rape -0.5393836 -0.8179779 -0.1999436
> plot(prcomp(USArrests))
> summary(prcomp(USArrests, scale = TRUE))
Importance of components:
PC1 PC2 PC3 PC4
Standard deviation 1.575 0.9949 0.59713 0.41645
Proportion of Variance 0.620 0.2474 0.08914 0.04336
Cumulative Proportion 0.620 0.8675 0.95664 1.00000
> biplot(prcomp(USArrests, scale = TRUE))
>
>
>
> cleanEx()
> nameEx("predict.HoltWinters")
> ### * predict.HoltWinters
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.HoltWinters
> ### Title: Prediction Function for Fitted Holt-Winters Models
> ### Aliases: predict.HoltWinters
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> m <- HoltWinters(co2)
> p <- predict(m, 50, prediction.interval = TRUE)
> plot(m, p)
>
>
>
> cleanEx()
> nameEx("predict")
> ### * predict
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict
> ### Title: Model Predictions
> ### Aliases: predict
> ### Keywords: methods
>
> ### ** Examples
>
> ## Don't show:
> old <- Sys.setlocale("LC_COLLATE", "C")
> ## End Don't show
> require(utils)
>
> ## All the "predict" methods found
> ## NB most of the methods in the standard packages are hidden.
> for(fn in methods("predict"))
+ try({
+ f <- eval(substitute(getAnywhere(fn)$objs[[1]], list(fn = fn)))
+ cat(fn, ":\n\t", deparse(args(f)), "\n")
+ }, silent = TRUE)
predict.Arima :
function (object, n.ahead = 1, newxreg = NULL, se.fit = TRUE, ...) NULL
predict.HoltWinters :
function (object, n.ahead = 1, prediction.interval = FALSE, level = 0.95, ...) NULL
predict.StructTS :
function (object, n.ahead = 1, se.fit = TRUE, ...) NULL
predict.ar :
function (object, newdata, n.ahead = 1, se.fit = TRUE, ...) NULL
predict.arima0 :
function (object, n.ahead = 1, newxreg = NULL, se.fit = TRUE, ...) NULL
predict.bSpline :
function (object, x, nseg = 50, deriv = 0, ...) NULL
predict.bs :
function (object, newx, ...) NULL
predict.glm :
function (object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.pass, ...) NULL
predict.glmmPQL :
function (object, newdata = NULL, type = c("link", "response"), level = Q, na.action = na.pass, ...) NULL
predict.lda :
function (object, newdata, prior = object$prior, dimen, method = c("plug-in", "predictive", "debiased"), ...) NULL
predict.lm :
function (object, newdata, se.fit = FALSE, scale = NULL, df = Inf, interval = c("none", "confidence", "prediction"), level = 0.95, type = c("response", "terms"), terms = NULL, na.action = na.pass, pred.var = res.var/weights, weights = 1, ...) NULL
predict.loess :
function (object, newdata = NULL, se = FALSE, na.action = na.pass, ...) NULL
predict.lqs :
function (object, newdata, na.action = na.pass, ...) NULL
predict.mca :
function (object, newdata, type = c("row", "factor"), ...) NULL
predict.mlm :
function (object, newdata, se.fit = FALSE, na.action = na.pass, ...) NULL
predict.nbSpline :
function (object, x, nseg = 50, deriv = 0, ...) NULL
predict.nls :
function (object, newdata, se.fit = FALSE, scale = NULL, df = Inf, interval = c("none", "confidence", "prediction"), level = 0.95, ...) NULL
predict.npolySpline :
function (object, x, nseg = 50, deriv = 0, ...) NULL
predict.ns :
function (object, newx, ...) NULL
predict.pbSpline :
function (object, x, nseg = 50, deriv = 0, ...) NULL
predict.polr :
function (object, newdata, type = c("class", "probs"), ...) NULL
predict.poly :
function (object, newdata, ...) NULL
predict.polySpline :
function (object, x, nseg = 50, deriv = 0, ...) NULL
predict.ppolySpline :
function (object, x, nseg = 50, deriv = 0, ...) NULL
predict.ppr :
function (object, newdata, ...) NULL
predict.prcomp :
function (object, newdata, ...) NULL
predict.princomp :
function (object, newdata, ...) NULL
predict.qda :
function (object, newdata, prior = object$prior, method = c("plug-in", "predictive", "debiased", "looCV"), ...) NULL
predict.rlm :
function (object, newdata = NULL, scale = NULL, ...) NULL
predict.smooth.spline :
function (object, x, deriv = 0, ...) NULL
predict.smooth.spline.fit :
function (object, x, deriv = 0, ...) NULL
> ## Don't show:
> old <- Sys.setlocale("LC_COLLATE", old)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("predict.arima")
> ### * predict.arima
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.Arima
> ### Title: Forecast from ARIMA fits
> ### Aliases: predict.Arima
> ### Keywords: ts
>
> ### ** Examples
>
> od <- options(digits=5) # avoid too much spurious accuracy
> predict(arima(lh, order = c(3,0,0)), n.ahead = 12)
$pred
Time Series:
Start = 49
End = 60
Frequency = 1
[1] 2.4602 2.2708 2.1986 2.2607 2.3470 2.4145 2.4389 2.4315 2.4102 2.3917
[11] 2.3827 2.3827
$se
Time Series:
Start = 49
End = 60
Frequency = 1
[1] 0.42268 0.50293 0.52452 0.52472 0.53055 0.53692 0.53880 0.53884 0.53910
[10] 0.53952 0.53970 0.53971
>
> (fit <- arima(USAccDeaths, order = c(0,1,1),
+ seasonal = list(order=c(0,1,1))))
Call:
arima(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1)))
Coefficients:
ma1 sma1
-0.430 -0.553
s.e. 0.123 0.178
sigma^2 estimated as 99347: log likelihood = -425.44, aic = 856.88
> predict(fit, n.ahead = 6)
$pred
Jan Feb Mar Apr May Jun
1979 8336.1 7531.8 8314.6 8616.9 9488.9 9859.8
$se
Jan Feb Mar Apr May Jun
1979 315.45 363.01 405.02 443.06 478.09 510.72
> options(od)
>
>
>
> cleanEx()
> nameEx("predict.glm")
> ### * predict.glm
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.glm
> ### Title: Predict Method for GLM Fits
> ### Aliases: predict.glm
> ### Keywords: models regression
>
> ### ** Examples
>
> require(graphics)
>
> ## example from Venables and Ripley (2002, pp. 190-2.)
> ldose <- rep(0:5, 2)
> numdead <- c(1, 4, 9, 13, 18, 20, 0, 2, 6, 10, 12, 16)
> sex <- factor(rep(c("M", "F"), c(6, 6)))
> SF <- cbind(numdead, numalive=20-numdead)
> budworm.lg <- glm(SF ~ sex*ldose, family=binomial)
> summary(budworm.lg)
Call:
glm(formula = SF ~ sex * ldose, family = binomial)
Deviance Residuals:
Min 1Q Median 3Q Max
-1.39849 -0.32094 -0.07592 0.38220 1.10375
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -2.9935 0.5527 -5.416 6.09e-08 ***
sexM 0.1750 0.7783 0.225 0.822
ldose 0.9060 0.1671 5.422 5.89e-08 ***
sexM:ldose 0.3529 0.2700 1.307 0.191
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 124.8756 on 11 degrees of freedom
Residual deviance: 4.9937 on 8 degrees of freedom
AIC: 43.104
Number of Fisher Scoring iterations: 4
>
> plot(c(1,32), c(0,1), type = "n", xlab = "dose",
+ ylab = "prob", log = "x")
> text(2^ldose, numdead/20, as.character(sex))
> ld <- seq(0, 5, 0.1)
> lines(2^ld, predict(budworm.lg, data.frame(ldose=ld,
+ sex=factor(rep("M", length(ld)), levels=levels(sex))),
+ type = "response"))
> lines(2^ld, predict(budworm.lg, data.frame(ldose=ld,
+ sex=factor(rep("F", length(ld)), levels=levels(sex))),
+ type = "response"))
>
>
>
> cleanEx()
> nameEx("predict.lm")
> ### * predict.lm
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.lm
> ### Title: Predict method for Linear Model Fits
> ### Aliases: predict.lm predict.mlm
> ### Keywords: regression
>
> ### ** Examples
>
> require(graphics)
>
> ## Predictions
> x <- rnorm(15)
> y <- x + rnorm(15)
> predict(lm(y ~ x))
1 2 3 4 5 6 7
-0.6270917 0.2550840 -0.8548779 1.7923222 0.4139268 -0.8383687 0.5858991
8 9 10 11 12 13 14
0.8591183 0.6821126 -0.2774594 1.7013932 0.4796306 -0.6214146 -2.3566523
15
1.2801229
> new <- data.frame(x = seq(-3, 3, 0.5))
> predict(lm(y ~ x), new, se.fit = TRUE)
$fit
1 2 3 4 5 6
-3.21182462 -2.66733702 -2.12284942 -1.57836182 -1.03387422 -0.48938662
7 8 9 10 11 12
0.05510098 0.59958858 1.14407618 1.68856379 2.23305139 2.77753899
13
3.32202659
$se.fit
1 2 3 4 5 6 7 8
0.7545246 0.6449274 0.5380108 0.4357521 0.3423511 0.2672616 0.2292452 0.2461261
9 10 11 12 13
0.3090353 0.3966456 0.4960370 0.6013965 0.7100725
$df
[1] 13
$residual.scale
[1] 0.8832292
> pred.w.plim <- predict(lm(y ~ x), new, interval="prediction")
> pred.w.clim <- predict(lm(y ~ x), new, interval="confidence")
> matplot(new$x,cbind(pred.w.clim, pred.w.plim[,-1]),
+ lty=c(1,2,2,3,3), type="l", ylab="predicted y")
>
> ## Prediction intervals, special cases
> ## The first three of these throw warnings
> w <- 1 + x^2
> fit <- lm(y ~ x)
> wfit <- lm(y ~ x, weights = w)
> predict(fit, interval = "prediction")
Warning in predict.lm(fit, interval = "prediction") :
Predictions on current data refer to _future_ responses
fit lwr upr
1 -0.6270917 -2.6311852 1.37700188
2 0.2550840 -1.7160306 2.22619860
3 -0.8548779 -2.8806560 1.17090027
4 1.7923222 -0.3158417 3.90048609
5 0.4139268 -1.5600794 2.38793297
6 -0.8383687 -2.8624006 1.18566313
7 0.5858991 -1.3942769 2.56607519
8 0.8591183 -1.1372816 2.85551813
9 0.6821126 -1.3028836 2.66710884
10 -0.2774594 -2.2586227 1.70370390
11 1.7013932 -0.3922734 3.79505973
12 0.4796306 -1.4963611 2.45562227
13 -0.6214146 -2.6250348 1.38220556
14 -2.3566523 -4.6435457 -0.06975883
15 1.2801229 -0.7562734 3.31651909
> predict(wfit, interval = "prediction")
Warning in predict.lm(wfit, interval = "prediction") :
Predictions on current data refer to _future_ responses
Warning in predict.lm(wfit, interval = "prediction") :
Assuming prediction variance inversely proportional to weights used for fitting
fit lwr upr
1 -0.6795401 -2.7152943 1.3562142
2 0.2726114 -2.0676598 2.6128825
3 -0.9253947 -2.7873163 0.9365269
4 1.9317861 0.5179227 3.3456495
5 0.4440538 -1.8206181 2.7087257
6 -0.9075760 -2.7817747 0.9666227
7 0.6296673 -1.5219043 2.7812390
8 0.9245587 -1.0206112 2.8697287
9 0.7335126 -1.3468740 2.8138992
10 -0.3021743 -2.5805044 1.9761557
11 1.8336444 0.3867018 3.2805870
12 0.5149694 -1.7094216 2.7393604
13 -0.6734127 -2.7135353 1.3667099
14 -2.5462925 -3.8073357 -1.2852494
15 1.3789581 -0.2749888 3.0329051
> predict(wfit, new, interval = "prediction")
Warning in predict.lm(wfit, new, interval = "prediction") :
Assuming constant prediction variance even though model fit is weighted
fit lwr upr
1 -3.46929871 -6.02669183 -0.9119056
2 -2.88162137 -5.38456191 -0.3786808
3 -2.29394403 -4.75159401 0.1637059
4 -1.70626669 -4.12830217 0.7157688
5 -1.11858935 -3.51511782 1.2779391
6 -0.53091201 -2.91236575 1.8505417
7 0.05676532 -2.32024444 2.4337751
8 0.64444266 -1.73881338 3.0276987
9 1.23212000 -1.16798909 3.6322291
10 1.81979734 -0.60755066 4.2471453
11 2.40747468 -0.05715376 4.8721031
12 2.99515202 0.48364874 5.5066553
13 3.58282936 1.01538228 6.1502764
> predict(wfit, new, interval = "prediction", weights = (new$x)^2)
fit lwr upr
1 -3.46929871 -4.7661745 -2.17242292
2 -2.88162137 -4.1752786 -1.58796414
3 -2.29394403 -3.6870669 -0.90082115
4 -1.70626669 -3.3884596 -0.02407382
5 -1.11858935 -3.5151178 1.27793911
6 -0.53091201 -5.2286061 4.16678211
7 0.05676532 -Inf Inf
8 0.64444266 -4.0541654 5.34305071
9 1.23212000 -1.1679891 3.63222909
10 1.81979734 0.1299644 3.50963027
11 2.40747468 1.0020775 3.81287188
12 2.99515202 1.6850045 4.30529950
13 3.58282936 2.2662384 4.89942029
> predict(wfit, new, interval = "prediction", weights = ~x^2)
fit lwr upr
1 -3.46929871 -4.7661745 -2.17242292
2 -2.88162137 -4.1752786 -1.58796414
3 -2.29394403 -3.6870669 -0.90082115
4 -1.70626669 -3.3884596 -0.02407382
5 -1.11858935 -3.5151178 1.27793911
6 -0.53091201 -5.2286061 4.16678211
7 0.05676532 -Inf Inf
8 0.64444266 -4.0541654 5.34305071
9 1.23212000 -1.1679891 3.63222909
10 1.81979734 0.1299644 3.50963027
11 2.40747468 1.0020775 3.81287188
12 2.99515202 1.6850045 4.30529950
13 3.58282936 2.2662384 4.89942029
>
>
>
> cleanEx()
> nameEx("predict.loess")
> ### * predict.loess
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.loess
> ### Title: Predict Loess Curve or Surface
> ### Aliases: predict.loess
> ### Keywords: smooth
>
> ### ** Examples
>
> cars.lo <- loess(dist ~ speed, cars)
> predict(cars.lo, data.frame(speed=seq(5, 30, 1)), se=TRUE)
$fit
1 2 3 4 5 6 7 8
7.797353 10.002308 12.499786 15.281082 18.446568 21.865315 25.517015 29.350386
9 10 11 12 13 14 15 16
33.230660 37.167935 41.205226 45.055736 48.355889 49.824812 51.986702 56.461318
17 18 19 20 21 22 23 24
61.959729 68.569313 76.316068 85.212121 95.324047 NA NA NA
25 26
NA NA
$se.fit
1 2 3 4 5 6 7 8
7.568120 5.945831 4.990827 4.545284 4.308639 4.115049 3.789542 3.716231
9 10 11 12 13 14 15 16
3.776947 4.091747 4.709568 4.245427 4.035929 3.753410 4.004705 4.043190
17 18 19 20 21 22 23 24
4.026105 4.074664 4.570818 5.954217 8.302014 NA NA NA
25 26
NA NA
$residual.scale
[1] 15.29496
$df
[1] 44.6179
> # to get extrapolation
> cars.lo2 <- loess(dist ~ speed, cars,
+ control=loess.control(surface="direct"))
> predict(cars.lo2, data.frame(speed=seq(5, 30, 1)), se=TRUE)
$fit
1 2 3 4 5 6 7
7.741006 9.926596 12.442424 15.281082 18.425712 21.865315 25.713413
8 9 10 11 12 13 14
29.350386 33.230660 37.167935 41.205226 45.781544 48.355889 50.067148
15 16 17 18 19 20 21
51.986702 56.445263 62.025404 68.569313 76.193111 85.053364 95.300523
22 23 24 25 26
106.974661 120.092581 134.665851 150.698545 168.190283
$se.fit
1 2 3 4 5 6 7 8
7.565991 5.959097 5.012013 4.550013 4.321596 4.119331 3.939804 3.720098
9 10 11 12 13 14 15 16
3.780877 4.096004 4.714469 4.398936 4.040129 4.184257 4.008873 4.061865
17 18 19 20 21 22 23 24
4.033998 4.078904 4.584606 5.952480 8.306901 11.601911 15.792480 20.864660
25 26
26.823827 33.683999
$residual.scale
[1] 15.31087
$df
[1] 44.55085
>
>
>
> cleanEx()
> nameEx("predict.nls")
> ### * predict.nls
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.nls
> ### Title: Predicting from Nonlinear Least Squares Fits
> ### Aliases: predict.nls
> ### Keywords: nonlinear regression models
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits=5)
> ## End Don't show
> require(graphics)
>
> fm <- nls(demand ~ SSasympOrig(Time, A, lrc), data = BOD)
> predict(fm) # fitted values at observed times
[1] 7.8874 12.5250 15.2517 16.8549 17.7975 18.6776
> ## Form data plot and smooth line for the predictions
> opar <- par(las = 1)
> plot(demand ~ Time, data = BOD, col = 4,
+ main = "BOD data and fitted first-order curve",
+ xlim = c(0,7), ylim = c(0, 20) )
> tt <- seq(0, 8, length = 101)
> lines(tt, predict(fm, list(Time = tt)))
> par(opar)
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("predict.smooth.spline")
> ### * predict.smooth.spline
>
> flush(stderr()); flush(stdout())
>
> ### Name: predict.smooth.spline
> ### Title: Predict from Smoothing Spline Fit
> ### Aliases: predict.smooth.spline
> ### Keywords: smooth
>
> ### ** Examples
>
> require(graphics)
>
> attach(cars)
> cars.spl <- smooth.spline(speed, dist, df=6.4)
> ## Don't show:
> print.default(cars.spl)
$x
[1] 4 7 8 9 10 11 12 13 14 15 16 17 18 19 20 22 23 24 25
$y
[1] 5.833836 12.575603 15.037250 17.795007 20.935898 24.228479 28.488199
[8] 33.969567 38.578804 40.986090 43.494687 47.156344 50.862366 52.692043
[15] 54.754531 66.036824 75.010419 85.290273 95.014670
$w
[1] 2 2 1 1 3 2 4 4 4 3 2 3 4 3 5 1 1 4 1
$yin
[1] 6.00000 13.00000 16.00000 10.00000 26.00000 22.50000 21.50000 35.00000
[9] 50.50000 33.33333 36.00000 40.66667 64.50000 50.00000 50.40000 66.00000
[17] 54.00000 93.75000 85.00000
$data
$data$x
[1] 4 4 7 7 8 9 10 10 10 11 11 12 12 12 12 13 13 13 13 14 14 14 14 15 15
[26] 15 16 16 17 17 17 18 18 18 18 19 19 19 20 20 20 20 20 22 23 24 24 24 24 25
$data$y
[1] 2 10 4 22 16 10 18 26 34 17 28 14 20 24 28 26 34 34 46
[20] 26 36 60 80 20 26 54 32 40 32 40 50 42 56 76 84 36 46 68
[39] 32 48 52 56 64 66 54 70 92 93 120 85
$data$w
[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[39] 1 1 1 1 1 1 1 1 1 1 1 1
$lev
[1] 0.8934338 0.4379689 0.1842314 0.1529048 0.3641292 0.2022506 0.3399561
[8] 0.3123173 0.3248036 0.2745481 0.1965797 0.2777060 0.3368286 0.2546068
[15] 0.5210306 0.1743541 0.1531692 0.6249904 0.3750748
$cv.crit
[1] 257.2678
$pen.crit
[1] 3015.936
$crit
[1] 3
$df
[1] 6.400884
$spar
[1] 0.4873957
$lambda
[1] 0.0008526606
$iparms
icrit ispar iter
3 0 13
$fit
$knot
[1] 0.0000000 0.0000000 0.0000000 0.0000000 0.1428571 0.1904762 0.2380952
[8] 0.2857143 0.3333333 0.3809524 0.4285714 0.4761905 0.5238095 0.5714286
[15] 0.6190476 0.6666667 0.7142857 0.7619048 0.8571429 0.9047619 0.9523810
[22] 1.0000000 1.0000000 1.0000000 1.0000000
$nk
[1] 21
$min
[1] 4
$range
[1] 21
$coef
[1] 5.833836 8.018090 10.929996 14.991332 17.703639 20.964154 24.055137
[8] 28.186176 34.129352 39.113818 40.888197 43.249931 47.080201 51.367328
[15] 52.624683 54.840036 62.675393 74.718525 85.502238 91.843521 95.014670
attr(,"class")
[1] "smooth.spline.fit"
$call
smooth.spline(x = speed, y = dist, df = 6.4)
attr(,"class")
[1] "smooth.spline"
> ## End Don't show
>
> ## "Proof" that the derivatives are okay, by comparing with approximation
> diff.quot <- function(x,y) {
+ ## Difference quotient (central differences where available)
+ n <- length(x); i1 <- 1:2; i2 <- (n-1):n
+ c(diff(y[i1]) / diff(x[i1]), (y[-i1] - y[-i2]) / (x[-i1] - x[-i2]),
+ diff(y[i2]) / diff(x[i2]))
+ }
>
> xx <- unique(sort(c(seq(0,30, by = .2), kn <- unique(speed))))
> i.kn <- match(kn, xx)# indices of knots within xx
> op <- par(mfrow = c(2,2))
> plot(speed, dist, xlim = range(xx), main = "Smooth.spline & derivatives")
> lines(pp <- predict(cars.spl, xx), col = "red")
> points(kn, pp$y[i.kn], pch = 3, col="dark red")
> mtext("s(x)", col = "red")
> for(d in 1:3){
+ n <- length(pp$x)
+ plot(pp$x, diff.quot(pp$x,pp$y), type = 'l', xlab="x", ylab="",
+ col = "blue", col.main = "red",
+ main= paste("s",paste(rep("'",d), collapse=""),"(x)", sep=""))
+ mtext("Difference quotient approx.(last)", col = "blue")
+ lines(pp <- predict(cars.spl, xx, deriv = d), col = "red")
+ ## Don't show:
+ print(pp)
+ ## End Don't show
+ points(kn, pp$y[i.kn], pch = 3, col="dark red")
+ abline(h=0, lty = 3, col = "gray")
+ }
$x
[1] 0.0 0.2 0.4 0.6 0.8 1.0 1.2 1.4 1.6 1.8 2.0 2.2 2.4 2.6 2.8
[16] 3.0 3.2 3.4 3.6 3.8 4.0 4.2 4.4 4.6 4.8 5.0 5.2 5.4 5.6 5.8
[31] 6.0 6.2 6.4 6.6 6.8 7.0 7.2 7.4 7.6 7.8 8.0 8.2 8.4 8.6 8.8
[46] 9.0 9.2 9.4 9.6 9.8 10.0 10.2 10.4 10.6 10.8 11.0 11.2 11.4 11.6 11.8
[61] 12.0 12.2 12.4 12.6 12.8 13.0 13.2 13.4 13.6 13.8 14.0 14.2 14.4 14.6 14.8
[76] 15.0 15.2 15.4 15.6 15.8 16.0 16.2 16.4 16.6 16.8 17.0 17.2 17.4 17.6 17.8
[91] 18.0 18.2 18.4 18.6 18.8 19.0 19.2 19.4 19.6 19.8 20.0 20.2 20.4 20.6 20.8
[106] 21.0 21.2 21.4 21.6 21.8 22.0 22.2 22.4 22.6 22.8 23.0 23.2 23.4 23.6 23.8
[121] 24.0 24.2 24.4 24.6 24.8 25.0 25.2 25.4 25.6 25.8 26.0 26.2 26.4 26.6 26.8
[136] 27.0 27.2 27.4 27.6 27.8 28.0 28.2 28.4 28.6 28.8 29.0 29.2 29.4 29.6 29.8
[151] 30.0
$y
[1] 2.184254 2.184254 2.184254 2.184254 2.184254 2.184254 2.184254
[8] 2.184254 2.184254 2.184254 2.184254 2.184254 2.184254 2.184254
[15] 2.184254 2.184254 2.184254 2.184254 2.184254 2.184254 2.184254
[22] 2.185055 2.187545 2.191723 2.197591 2.205146 2.214391 2.225324
[29] 2.237946 2.252257 2.268256 2.285944 2.305321 2.326387 2.349141
[36] 2.373584 2.401852 2.436084 2.476278 2.522435 2.574554 2.635109
[43] 2.706573 2.788944 2.882223 2.986411 3.081697 3.148275 3.186142
[50] 3.195300 3.175749 3.166034 3.204703 3.291756 3.427192 3.611011
[57] 3.834464 4.088800 4.374019 4.690122 5.037108 5.344118 5.540295
[64] 5.625638 5.600147 5.463821 5.227052 4.900227 4.483347 3.976412
[71] 3.379422 2.813354 2.399183 2.136910 2.026534 2.068056 2.203151
[78] 2.373493 2.579082 2.819918 3.096002 3.369475 3.602482 3.795021
[85] 3.947094 4.058699 4.080338 3.962512 3.705220 3.308463 2.772241
[92] 2.234965 1.835047 1.572485 1.447281 1.459435 1.588383 1.813566
[99] 2.134982 2.552632 3.066516 3.621455 4.162272 4.688967 5.201539
[106] 5.699989 6.184317 6.654523 7.110606 7.552567 7.980405 8.394132
[113] 8.793758 9.179284 9.550708 9.908031 10.197841 10.366724 10.414682
[120] 10.341713 10.147818 9.918957 9.741090 9.614215 9.538335 9.513448
[127] 9.513448 9.513448 9.513448 9.513448 9.513448 9.513448 9.513448
[134] 9.513448 9.513448 9.513448 9.513448 9.513448 9.513448 9.513448
[141] 9.513448 9.513448 9.513448 9.513448 9.513448 9.513448 9.513448
[148] 9.513448 9.513448 9.513448 9.513448
$x
[1] 0.0 0.2 0.4 0.6 0.8 1.0 1.2 1.4 1.6 1.8 2.0 2.2 2.4 2.6 2.8
[16] 3.0 3.2 3.4 3.6 3.8 4.0 4.2 4.4 4.6 4.8 5.0 5.2 5.4 5.6 5.8
[31] 6.0 6.2 6.4 6.6 6.8 7.0 7.2 7.4 7.6 7.8 8.0 8.2 8.4 8.6 8.8
[46] 9.0 9.2 9.4 9.6 9.8 10.0 10.2 10.4 10.6 10.8 11.0 11.2 11.4 11.6 11.8
[61] 12.0 12.2 12.4 12.6 12.8 13.0 13.2 13.4 13.6 13.8 14.0 14.2 14.4 14.6 14.8
[76] 15.0 15.2 15.4 15.6 15.8 16.0 16.2 16.4 16.6 16.8 17.0 17.2 17.4 17.6 17.8
[91] 18.0 18.2 18.4 18.6 18.8 19.0 19.2 19.4 19.6 19.8 20.0 20.2 20.4 20.6 20.8
[106] 21.0 21.2 21.4 21.6 21.8 22.0 22.2 22.4 22.6 22.8 23.0 23.2 23.4 23.6 23.8
[121] 24.0 24.2 24.4 24.6 24.8 25.0 25.2 25.4 25.6 25.8 26.0 26.2 26.4 26.6 26.8
[136] 27.0 27.2 27.4 27.6 27.8 28.0 28.2 28.4 28.6 28.8 29.0 29.2 29.4 29.6 29.8
[151] 30.0
$y
[1] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[6] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[11] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[16] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[21] -0.0002165147 0.0082269950 0.0166705047 0.0251140144 0.0335575241
[26] 0.0420010338 0.0504445435 0.0588880532 0.0673315629 0.0757750726
[31] 0.0842185822 0.0926620919 0.1011056016 0.1095491113 0.1179926210
[36] 0.1264361307 0.1562499762 0.1860638217 0.2158776671 0.2456915126
[41] 0.2755053581 0.3300457726 0.3845861870 0.4391266015 0.4936670160
[46] 0.5482074305 0.4046596591 0.2611118877 0.1175641163 -0.0259836551
[51] -0.1695314264 0.0723860374 0.3143035013 0.5562209652 0.7981384291
[56] 1.0400558930 1.1944722898 1.3488886866 1.5033050835 1.6577214803
[61] 1.8121378771 1.2579681380 0.7037983989 0.1496286598 -0.4045410793
[66] -0.9587108185 -1.4089861032 -1.8592613879 -2.3095366727 -2.7598119574
[71] -3.2100872422 -2.4505987906 -1.6911103389 -0.9316218873 -0.1721334357
[76] 0.5873550159 0.7635912416 0.9398274674 1.1160636931 1.2922999189
[81] 1.4685361447 1.2662005031 1.0638648615 0.8615292198 0.6591935782
[86] 0.4568579366 -0.2404682740 -0.9377944846 -1.6351206952 -2.3324469058
[91] -3.0297731165 -2.3429865119 -1.6561999074 -0.9694133029 -0.2826266984
[96] 0.4041599061 0.8853283585 1.3664968109 1.8476652633 2.3288337157
[101] 2.8100021681 2.7393907024 2.6687792367 2.5981677710 2.5275563053
[106] 2.4569448396 2.3863333739 2.3157219082 2.2451104425 2.1744989768
[111] 2.1038875112 2.0333827893 1.9628780674 1.8923733455 1.8218686237
[116] 1.7513639018 1.1467332516 0.5421026014 -0.0625280487 -0.6671586989
[121] -1.2717893491 -1.0168219086 -0.7618544680 -0.5068870274 -0.2519195869
[126] 0.0030478537 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[131] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[136] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[141] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[146] 0.0000000000 0.0000000000 0.0000000000 0.0000000000 0.0000000000
[151] 0.0000000000
$x
[1] 0.0 0.2 0.4 0.6 0.8 1.0 1.2 1.4 1.6 1.8 2.0 2.2 2.4 2.6 2.8
[16] 3.0 3.2 3.4 3.6 3.8 4.0 4.2 4.4 4.6 4.8 5.0 5.2 5.4 5.6 5.8
[31] 6.0 6.2 6.4 6.6 6.8 7.0 7.2 7.4 7.6 7.8 8.0 8.2 8.4 8.6 8.8
[46] 9.0 9.2 9.4 9.6 9.8 10.0 10.2 10.4 10.6 10.8 11.0 11.2 11.4 11.6 11.8
[61] 12.0 12.2 12.4 12.6 12.8 13.0 13.2 13.4 13.6 13.8 14.0 14.2 14.4 14.6 14.8
[76] 15.0 15.2 15.4 15.6 15.8 16.0 16.2 16.4 16.6 16.8 17.0 17.2 17.4 17.6 17.8
[91] 18.0 18.2 18.4 18.6 18.8 19.0 19.2 19.4 19.6 19.8 20.0 20.2 20.4 20.6 20.8
[106] 21.0 21.2 21.4 21.6 21.8 22.0 22.2 22.4 22.6 22.8 23.0 23.2 23.4 23.6 23.8
[121] 24.0 24.2 24.4 24.6 24.8 25.0 25.2 25.4 25.6 25.8 26.0 26.2 26.4 26.6 26.8
[136] 27.0 27.2 27.4 27.6 27.8 28.0 28.2 28.4 28.6 28.8 29.0 29.2 29.4 29.6 29.8
[151] 30.0
$y
[1] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[7] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[13] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[19] 0.00000000 0.00000000 0.04221755 0.04221755 0.04221755 0.04221755
[25] 0.04221755 0.04221755 0.04221755 0.04221755 0.04221755 0.04221755
[31] 0.04221755 0.04221755 0.04221755 0.04221755 0.04221755 0.14906923
[37] 0.14906923 0.14906923 0.14906923 0.14906923 0.27270207 0.27270207
[43] 0.27270207 0.27270207 0.27270207 -0.71773886 -0.71773886 -0.71773886
[49] -0.71773886 -0.71773886 1.20958732 1.20958732 1.20958732 1.20958732
[55] 1.20958732 0.77208198 0.77208198 0.77208198 0.77208198 0.77208198
[61] -2.77084870 -2.77084870 -2.77084870 -2.77084870 -2.77084870 -2.25137642
[67] -2.25137642 -2.25137642 -2.25137642 -2.25137642 3.79744226 3.79744226
[73] 3.79744226 3.79744226 3.79744226 0.88118113 0.88118113 0.88118113
[79] 0.88118113 0.88118113 -1.01167821 -1.01167821 -1.01167821 -1.01167821
[85] -1.01167821 -3.48663105 -3.48663105 -3.48663105 -3.48663105 -3.48663105
[91] 3.43393302 3.43393302 3.43393302 3.43393302 3.43393302 2.40584226
[97] 2.40584226 2.40584226 2.40584226 2.40584226 -0.35305733 -0.35305733
[103] -0.35305733 -0.35305733 -0.35305733 -0.35305733 -0.35305733 -0.35305733
[109] -0.35305733 -0.35305733 -0.35252361 -0.35252361 -0.35252361 -0.35252361
[115] -0.35252361 -3.02315325 -3.02315325 -3.02315325 -3.02315325 -3.02315325
[121] 1.27483720 1.27483720 1.27483720 1.27483720 1.27483720 1.27483720
[127] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[133] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[139] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[145] 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000
[151] 0.00000000
> detach(); par(op)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("princomp")
> ### * princomp
>
> flush(stderr()); flush(stdout())
>
> ### Name: princomp
> ### Title: Principal Components Analysis
> ### Aliases: princomp princomp.formula princomp.default plot.princomp
> ### print.princomp predict.princomp
> ### Keywords: multivariate
>
> ### ** Examples
>
> require(graphics)
>
> ## The variances of the variables in the
> ## USArrests data vary by orders of magnitude, so scaling is appropriate
> (pc.cr <- princomp(USArrests)) # inappropriate
Call:
princomp(x = USArrests)
Standard deviations:
Comp.1 Comp.2 Comp.3 Comp.4
82.890847 14.069560 6.424204 2.457837
4 variables and 50 observations.
> princomp(USArrests, cor = TRUE) # =^= prcomp(USArrests, scale=TRUE)
Call:
princomp(x = USArrests, cor = TRUE)
Standard deviations:
Comp.1 Comp.2 Comp.3 Comp.4
1.5748783 0.9948694 0.5971291 0.4164494
4 variables and 50 observations.
> ## Similar, but different:
> ## The standard deviations differ by a factor of sqrt(49/50)
>
> summary(pc.cr <- princomp(USArrests, cor = TRUE))
Importance of components:
Comp.1 Comp.2 Comp.3 Comp.4
Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938
Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752
Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000
> loadings(pc.cr) ## note that blank entries are small but not zero
Loadings:
Comp.1 Comp.2 Comp.3 Comp.4
Murder -0.536 0.418 -0.341 0.649
Assault -0.583 0.188 -0.268 -0.743
UrbanPop -0.278 -0.873 -0.378 0.134
Rape -0.543 -0.167 0.818
Comp.1 Comp.2 Comp.3 Comp.4
SS loadings 1.00 1.00 1.00 1.00
Proportion Var 0.25 0.25 0.25 0.25
Cumulative Var 0.25 0.50 0.75 1.00
> plot(pc.cr) # shows a screeplot.
> biplot(pc.cr)
>
> ## Formula interface
> princomp(~ ., data = USArrests, cor = TRUE)
Call:
princomp(formula = ~., data = USArrests, cor = TRUE)
Standard deviations:
Comp.1 Comp.2 Comp.3 Comp.4
1.5748783 0.9948694 0.5971291 0.4164494
4 variables and 50 observations.
>
> ## NA-handling
> USArrests[1, 2] <- NA
> pc.cr <- princomp(~ Murder + Assault + UrbanPop,
+ data = USArrests, na.action=na.exclude, cor = TRUE)
>
>
>
> cleanEx()
> nameEx("print.ts")
> ### * print.ts
>
> flush(stderr()); flush(stdout())
>
> ### Name: print.ts
> ### Title: Printing Time-Series Objects
> ### Aliases: print.ts
> ### Keywords: ts
>
> ### ** Examples
>
> print(ts(1:10, frequency = 7, start = c(12, 2)), calendar = TRUE)
p1 p2 p3 p4 p5 p6 p7
12 1 2 3 4 5 6
13 7 8 9 10
>
>
>
> cleanEx()
> nameEx("printCoefmat")
> ### * printCoefmat
>
> flush(stderr()); flush(stdout())
>
> ### Name: printCoefmat
> ### Title: Print Coefficient Matrices
> ### Aliases: printCoefmat
> ### Keywords: print
>
> ### ** Examples
>
> cmat <- cbind(rnorm(3, 10), sqrt(rchisq(3, 12)))
> cmat <- cbind(cmat, cmat[,1]/cmat[,2])
> cmat <- cbind(cmat, 2*pnorm(-cmat[,3]))
> colnames(cmat) <- c("Estimate", "Std.Err", "Z value", "Pr(>z)")
> printCoefmat(cmat[,1:3])
Estimate Std.Err Z value
[1,] 9.3735 4.4447 2.1089
[2,] 10.1836 3.5496 2.8689
[3,] 9.1644 2.7365 3.3490
> printCoefmat(cmat)
Estimate Std.Err Z value Pr(>z)
[1,] 9.3735 4.4447 2.1089 0.0349492 *
[2,] 10.1836 3.5496 2.8689 0.0041185 **
[3,] 9.1644 2.7365 3.3490 0.0008111 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> options(show.coef.Pvalues = FALSE)
> printCoefmat(cmat, digits=2)
Estimate Std.Err Z value
[1,] 9.4 4.4 2.1
[2,] 10.2 3.5 2.9
[3,] 9.2 2.7 3.3
> printCoefmat(cmat, digits=2, P.values = TRUE)
Estimate Std.Err Z value Pr(>z)
[1,] 9.4 4.4 2.1 0.035 *
[2,] 10.2 3.5 2.9 0.004 **
[3,] 9.2 2.7 3.3 8e-04 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> options(show.coef.Pvalues = TRUE)# revert
>
>
>
> cleanEx()
> nameEx("profile.nls")
> ### * profile.nls
>
> flush(stderr()); flush(stdout())
>
> ### Name: profile.nls
> ### Title: Method for Profiling nls Objects
> ### Aliases: profile.nls
> ### Keywords: nonlinear regression models
>
> ### ** Examples
>
> ## Don't show:
> od <- options(digits = 4)
> ## End Don't show
> # obtain the fitted object
> fm1 <- nls(demand ~ SSasympOrig(Time, A, lrc), data = BOD)
> # get the profile for the fitted model: default level is too extreme
> pr1 <- profile(fm1, alpha = 0.05)
> # profiled values for the two parameters
> pr1$A
tau par.vals.A par.vals.lrc
1 -3.0873 13.59751 0.14033
2 -2.4957 14.46884 0.01607
3 -1.8906 15.41836 -0.11787
4 -1.2634 16.49088 -0.26877
5 -0.6080 17.75662 -0.44553
6 0.0000 19.14258 -0.63282
7 0.4998 20.52853 -0.80750
8 0.9465 22.06851 -0.98233
9 1.3780 23.98253 -1.17103
10 1.7908 26.44552 -1.37431
11 2.1841 29.75928 -1.59599
12 2.5559 34.43804 -1.84209
13 2.9028 41.42542 -2.12176
> pr1$lrc
tau par.vals.A par.vals.lrc
1 -2.9550 42.395076 -2.184153
2 -2.5201 33.446683 -1.836926
3 -2.0570 28.124205 -1.547326
4 -1.5710 24.656989 -1.293871
5 -1.0653 22.245847 -1.063030
6 -0.5412 20.482887 -0.845157
7 0.0000 19.142578 -0.632822
8 0.5539 18.095015 -0.420487
9 1.1022 17.273414 -0.207623
10 1.6298 16.621533 0.007939
11 2.1335 16.086803 0.234850
12 2.6052 15.638807 0.485009
13 3.0276 15.265409 0.779458
> # see also example(plot.profile.nls)
> ## Don't show:
> options(od)
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("proj")
> ### * proj
>
> flush(stderr()); flush(stdout())
>
> ### Name: proj
> ### Title: Projections of Models
> ### Aliases: proj proj.default proj.lm proj.aov proj.aovlist
> ### Keywords: models
>
> ### ** Examples
>
> N <- c(0,1,0,1,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,1,1,0,0)
> P <- c(1,1,0,0,0,1,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,1,1,0)
> K <- c(1,0,0,1,0,1,1,0,0,1,0,1,0,1,1,0,0,0,1,1,1,0,1,0)
> yield <- c(49.5,62.8,46.8,57.0,59.8,58.5,55.5,56.0,62.8,55.8,69.5,
+ 55.0, 62.0,48.8,45.5,44.2,52.0,51.5,49.8,48.8,57.2,59.0,53.2,56.0)
>
> npk <- data.frame(block=gl(6,4), N=factor(N), P=factor(P),
+ K=factor(K), yield=yield)
> npk.aov <- aov(yield ~ block + N*P*K, npk)
> proj(npk.aov)
(Intercept) block N P K N:P N:K
1 54.875 -0.850 -2.808333 -0.5916667 -1.991667 0.9416667 1.175
2 54.875 -0.850 2.808333 -0.5916667 1.991667 -0.9416667 1.175
3 54.875 -0.850 -2.808333 0.5916667 1.991667 -0.9416667 -1.175
4 54.875 -0.850 2.808333 0.5916667 -1.991667 0.9416667 -1.175
5 54.875 2.575 2.808333 0.5916667 1.991667 0.9416667 1.175
6 54.875 2.575 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175
7 54.875 2.575 -2.808333 0.5916667 -1.991667 -0.9416667 1.175
8 54.875 2.575 -2.808333 -0.5916667 1.991667 0.9416667 -1.175
9 54.875 5.900 -2.808333 -0.5916667 1.991667 0.9416667 -1.175
10 54.875 5.900 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175
11 54.875 5.900 2.808333 0.5916667 1.991667 0.9416667 1.175
12 54.875 5.900 -2.808333 0.5916667 -1.991667 -0.9416667 1.175
13 54.875 -4.750 2.808333 0.5916667 1.991667 0.9416667 1.175
14 54.875 -4.750 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175
15 54.875 -4.750 -2.808333 0.5916667 -1.991667 -0.9416667 1.175
16 54.875 -4.750 -2.808333 -0.5916667 1.991667 0.9416667 -1.175
17 54.875 -4.350 2.808333 -0.5916667 1.991667 -0.9416667 1.175
18 54.875 -4.350 -2.808333 0.5916667 1.991667 -0.9416667 -1.175
19 54.875 -4.350 2.808333 0.5916667 -1.991667 0.9416667 -1.175
20 54.875 -4.350 -2.808333 -0.5916667 -1.991667 0.9416667 1.175
21 54.875 1.475 2.808333 0.5916667 -1.991667 0.9416667 -1.175
22 54.875 1.475 2.808333 -0.5916667 1.991667 -0.9416667 1.175
23 54.875 1.475 -2.808333 -0.5916667 -1.991667 0.9416667 1.175
24 54.875 1.475 -2.808333 0.5916667 1.991667 -0.9416667 -1.175
P:K Residuals
1 0.1416667 -1.39166667
2 -0.1416667 4.47500000
3 0.1416667 -5.02500000
4 -0.1416667 1.94166667
5 0.1416667 -5.30000000
6 0.1416667 2.80000000
7 -0.1416667 2.16666667
8 -0.1416667 0.33333333
9 -0.1416667 3.80833333
10 0.1416667 -3.22500000
11 0.1416667 1.07500000
12 -0.1416667 -1.65833333
13 0.1416667 4.22500000
14 0.1416667 0.42500000
15 -0.1416667 -0.50833333
16 -0.1416667 -4.14166667
17 -0.1416667 -2.82500000
18 0.1416667 3.17500000
19 -0.1416667 -1.75833333
20 0.1416667 1.40833333
21 -0.1416667 -0.18333333
22 -0.1416667 -1.65000000
23 0.1416667 -0.01666667
24 0.1416667 1.85000000
attr(,"df")
(Intercept) block N P K N:P
1 5 1 1 1 1
N:K P:K Residuals
1 1 12
attr(,"formula")
yield ~ block + N * P * K
attr(,"onedf")
[1] FALSE
attr(,"factors")
attr(,"factors")$`(Intercept)`
[1] "(Intercept)"
attr(,"factors")$block
[1] "block"
attr(,"factors")$N
[1] "N"
attr(,"factors")$P
[1] "P"
attr(,"factors")$K
[1] "K"
attr(,"factors")$`N:P`
[1] "N" "P"
attr(,"factors")$`N:K`
[1] "N" "K"
attr(,"factors")$`P:K`
[1] "P" "K"
attr(,"factors")$Residuals
[1] "block" "N" "P" "K" "Within"
attr(,"call")
aov(formula = yield ~ block + N * P * K, data = npk)
attr(,"t.factor")
block N P K N:P N:K P:K N:P:K
yield 0 0 0 0 0 0 0 0
block 1 0 0 0 0 0 0 0
N 0 1 0 0 1 1 0 1
P 0 0 1 0 1 0 1 1
K 0 0 0 1 0 1 1 1
attr(,"class")
[1] "aovproj"
>
> ## as a test, not particularly sensible
> options(contrasts=c("contr.helmert", "contr.treatment"))
> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)
> proj(npk.aovE)
(Intercept) :
(Intercept)
1 54.875
2 54.875
3 54.875
4 54.875
5 54.875
6 54.875
7 54.875
8 54.875
9 54.875
10 54.875
11 54.875
12 54.875
13 54.875
14 54.875
15 54.875
16 54.875
17 54.875
18 54.875
19 54.875
20 54.875
21 54.875
22 54.875
23 54.875
24 54.875
attr(,"df")
attr(,"df")$df
(Intercept)
1
attr(,"onedf")
attr(,"onedf")$onedf
[1] FALSE
attr(,"factors")
attr(,"factors")$`(Intercept)`
[1] "(Intercept)"
block :
N:P:K Residuals
1 -1.241667 0.3916667
2 -1.241667 0.3916667
3 -1.241667 0.3916667
4 -1.241667 0.3916667
5 1.241667 1.3333333
6 1.241667 1.3333333
7 1.241667 1.3333333
8 1.241667 1.3333333
9 1.241667 4.6583333
10 1.241667 4.6583333
11 1.241667 4.6583333
12 1.241667 4.6583333
13 1.241667 -5.9916667
14 1.241667 -5.9916667
15 1.241667 -5.9916667
16 1.241667 -5.9916667
17 -1.241667 -3.1083333
18 -1.241667 -3.1083333
19 -1.241667 -3.1083333
20 -1.241667 -3.1083333
21 -1.241667 2.7166667
22 -1.241667 2.7166667
23 -1.241667 2.7166667
24 -1.241667 2.7166667
attr(,"df")
attr(,"df")$df
N:P:K Residuals
1 4
attr(,"onedf")
attr(,"onedf")$onedf
[1] FALSE
attr(,"factors")
attr(,"factors")$`N:P:K`
[1] "N" "P" "K"
attr(,"factors")$Residuals
[1] "block"
Within :
N P K N:P N:K P:K Residuals
1 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 -1.39166667
2 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 4.47500000
3 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 -5.02500000
4 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 1.94166667
5 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 -5.30000000
6 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 2.80000000
7 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 2.16666667
8 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 0.33333333
9 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 3.80833333
10 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 -3.22500000
11 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 1.07500000
12 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 -1.65833333
13 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 4.22500000
14 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 0.42500000
15 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 -0.50833333
16 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 -4.14166667
17 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 -2.82500000
18 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 3.17500000
19 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 -1.75833333
20 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 1.40833333
21 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 -0.18333333
22 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 -1.65000000
23 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 -0.01666667
24 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 1.85000000
attr(,"df")
attr(,"df")$df
N P K N:P N:K P:K Residuals
1 1 1 1 1 1 12
attr(,"onedf")
attr(,"onedf")$onedf
[1] FALSE
attr(,"factors")
attr(,"factors")$N
[1] "N"
attr(,"factors")$P
[1] "P"
attr(,"factors")$K
[1] "K"
attr(,"factors")$`N:P`
[1] "N" "P"
attr(,"factors")$`N:K`
[1] "N" "K"
attr(,"factors")$`P:K`
[1] "P" "K"
attr(,"factors")$Residuals
[1] "block" "Within"
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("prop.test")
> ### * prop.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: prop.test
> ### Title: Test of Equal or Given Proportions
> ### Aliases: prop.test
> ### Keywords: htest
>
> ### ** Examples
>
> heads <- rbinom(1, size=100, prob = .5)
> prop.test(heads, 100) # continuity correction TRUE by default
1-sample proportions test with continuity correction
data: heads out of 100, null probability 0.5
X-squared = 0.09, df = 1, p-value = 0.7642
alternative hypothesis: true p is not equal to 0.5
95 percent confidence interval:
0.4183183 0.6201278
sample estimates:
p
0.52
> prop.test(heads, 100, correct = FALSE)
1-sample proportions test without continuity correction
data: heads out of 100, null probability 0.5
X-squared = 0.16, df = 1, p-value = 0.6892
alternative hypothesis: true p is not equal to 0.5
95 percent confidence interval:
0.4231658 0.6153545
sample estimates:
p
0.52
>
> ## Data from Fleiss (1981), p. 139.
> ## H0: The null hypothesis is that the four populations from which
> ## the patients were drawn have the same true proportion of smokers.
> ## A: The alternative is that this proportion is different in at
> ## least one of the populations.
>
> smokers <- c( 83, 90, 129, 70 )
> patients <- c( 86, 93, 136, 82 )
> prop.test(smokers, patients)
4-sample test for equality of proportions without continuity
correction
data: smokers out of patients
X-squared = 12.6004, df = 3, p-value = 0.005585
alternative hypothesis: two.sided
sample estimates:
prop 1 prop 2 prop 3 prop 4
0.9651163 0.9677419 0.9485294 0.8536585
>
>
>
> cleanEx()
> nameEx("prop.trend.test")
> ### * prop.trend.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: prop.trend.test
> ### Title: Test for trend in proportions
> ### Aliases: prop.trend.test
> ### Keywords: htest
>
> ### ** Examples
>
> smokers <- c( 83, 90, 129, 70 )
> patients <- c( 86, 93, 136, 82 )
> prop.test(smokers, patients)
4-sample test for equality of proportions without continuity
correction
data: smokers out of patients
X-squared = 12.6004, df = 3, p-value = 0.005585
alternative hypothesis: two.sided
sample estimates:
prop 1 prop 2 prop 3 prop 4
0.9651163 0.9677419 0.9485294 0.8536585
> prop.trend.test(smokers, patients)
Chi-squared Test for Trend in Proportions
data: smokers out of patients ,
using scores: 1 2 3 4
X-squared = 8.2249, df = 1, p-value = 0.004132
> prop.trend.test(smokers, patients,c(0,0,0,1))
Chi-squared Test for Trend in Proportions
data: smokers out of patients ,
using scores: 0 0 0 1
X-squared = 12.1731, df = 1, p-value = 0.0004848
>
>
>
> cleanEx()
> nameEx("qqnorm")
> ### * qqnorm
>
> flush(stderr()); flush(stdout())
>
> ### Name: qqnorm
> ### Title: Quantile-Quantile Plots
> ### Aliases: qqnorm qqnorm.default qqplot qqline
> ### Keywords: hplot distribution
>
> ### ** Examples
>
> require(graphics)
>
> y <- rt(200, df = 5)
> qqnorm(y); qqline(y, col = 2)
> qqplot(y, rt(300, df = 5))
>
> qqnorm(precip, ylab = "Precipitation [in/yr] for 70 US cities")
>
>
>
> cleanEx()
> nameEx("quade.test")
> ### * quade.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: quade.test
> ### Title: Quade Test
> ### Aliases: quade.test quade.test.default quade.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> ## Conover (1999, p. 375f):
> ## Numbers of five brands of a new hand lotion sold in seven stores
> ## during one week.
> y <- matrix(c( 5, 4, 7, 10, 12,
+ 1, 3, 1, 0, 2,
+ 16, 12, 22, 22, 35,
+ 5, 4, 3, 5, 4,
+ 10, 9, 7, 13, 10,
+ 19, 18, 28, 37, 58,
+ 10, 7, 6, 8, 7),
+ nrow = 7, byrow = TRUE,
+ dimnames =
+ list(Store = as.character(1:7),
+ Brand = LETTERS[1:5]))
> y
Brand
Store A B C D E
1 5 4 7 10 12
2 1 3 1 0 2
3 16 12 22 22 35
4 5 4 3 5 4
5 10 9 7 13 10
6 19 18 28 37 58
7 10 7 6 8 7
> quade.test(y)
Quade test
data: y
Quade F = 3.8293, num df = 4, denom df = 24, p-value = 0.01519
>
>
>
> cleanEx()
> nameEx("quantile")
> ### * quantile
>
> flush(stderr()); flush(stdout())
>
> ### Name: quantile
> ### Title: Sample Quantiles
> ### Aliases: quantile quantile.default
> ### Keywords: univar
>
> ### ** Examples
>
> quantile(x <- rnorm(1001)) # Extremes & Quartiles by default
0% 25% 50% 75% 100%
-3.00804860 -0.69731820 -0.03472603 0.68924373 3.81027668
> quantile(x, probs = c(0.1, 0.5, 1, 2, 5, 10, 50, NA)/100)
0.1% 0.5% 1% 2% 5% 10%
-2.99694930 -2.59232767 -2.42431731 -2.24515257 -1.72663060 -1.33880074
50%
-0.03472603 NA
>
> ### Compare different types
> p <- c(0.1, 0.5, 1, 2, 5, 10, 50)/100
> res <- matrix(as.numeric(NA), 9, 7)
> for(type in 1:9) res[type, ] <- y <- quantile(x, p, type = type)
> dimnames(res) <- list(1:9, names(y))
> round(res, 3)
0.1% 0.5% 1% 2% 5% 10% 50%
1 -2.997 -2.592 -2.424 -2.245 -1.727 -1.339 -0.035
2 -2.997 -2.592 -2.424 -2.245 -1.727 -1.339 -0.035
3 -3.008 -2.596 -2.433 -2.265 -1.733 -1.344 -0.036
4 -3.008 -2.596 -2.433 -2.264 -1.733 -1.344 -0.035
5 -3.002 -2.594 -2.428 -2.255 -1.730 -1.341 -0.035
6 -3.008 -2.596 -2.432 -2.264 -1.733 -1.343 -0.035
7 -2.997 -2.592 -2.424 -2.245 -1.727 -1.339 -0.035
8 -3.004 -2.595 -2.430 -2.258 -1.731 -1.342 -0.035
9 -3.004 -2.595 -2.429 -2.257 -1.730 -1.341 -0.035
>
>
>
> cleanEx()
> nameEx("r2dtable")
> ### * r2dtable
>
> flush(stderr()); flush(stdout())
>
> ### Name: r2dtable
> ### Title: Random 2-way Tables with Given Marginals
> ### Aliases: r2dtable
> ### Keywords: distribution
>
> ### ** Examples
>
> ## Fisher's Tea Drinker data.
> TeaTasting <-
+ matrix(c(3, 1, 1, 3),
+ nrow = 2,
+ dimnames = list(Guess = c("Milk", "Tea"),
+ Truth = c("Milk", "Tea")))
> ## Simulate permutation test for independence based on the maximum
> ## Pearson residuals (rather than their sum).
> rowTotals <- rowSums(TeaTasting)
> colTotals <- colSums(TeaTasting)
> nOfCases <- sum(rowTotals)
> expected <- outer(rowTotals, colTotals, "*") / nOfCases
> maxSqResid <- function(x) max((x - expected) ^ 2 / expected)
> simMaxSqResid <-
+ sapply(r2dtable(1000, rowTotals, colTotals), maxSqResid)
> sum(simMaxSqResid >= maxSqResid(TeaTasting)) / 1000
[1] 0.465
> ## Fisher's exact test gives p = 0.4857 ...
>
>
>
> cleanEx()
> nameEx("read.ftable")
> ### * read.ftable
>
> flush(stderr()); flush(stdout())
>
> ### Name: read.ftable
> ### Title: Manipulate Flat Contingency Tables
> ### Aliases: read.ftable write.ftable format.ftable
> ### Keywords: category
>
> ### ** Examples
>
> ## Agresti (1990), page 157, Table 5.8.
> ## Not in ftable standard format, but o.k.
> file <- tempfile()
> cat(" Intercourse\n",
+ "Race Gender Yes No\n",
+ "White Male 43 134\n",
+ " Female 26 149\n",
+ "Black Male 29 23\n",
+ " Female 22 36\n",
+ file = file)
> ft <- read.ftable(file)
> ft
Intercourse Yes No
Race Gender
White Male 43 134
Female 26 149
Black Male 29 23
Female 22 36
> unlink(file)
>
> ## Agresti (1990), page 297, Table 8.16.
> ## Almost o.k., but misses the name of the row variable.
> file <- tempfile()
> cat(" \"Tonsil Size\"\n",
+ " \"Not Enl.\" \"Enl.\" \"Greatly Enl.\"\n",
+ "Noncarriers 497 560 269\n",
+ "Carriers 19 29 24\n",
+ file = file)
> ft <- read.ftable(file, skip = 2,
+ row.var.names = "Status",
+ col.vars = list("Tonsil Size" =
+ c("Not Enl.", "Enl.", "Greatly Enl.")))
> ft
Tonsil Size Not Enl. Enl. Greatly Enl.
Status
Noncarriers 497 560 269
Carriers 19 29 24
> unlink(file)
>
> ft22 <- ftable(Titanic, row.vars = 2:1, col.vars = 4:3)
> write.ftable(ft22, quote = FALSE)
Survived No Yes
Age Child Adult Child Adult
Sex Class
Male 1st 0 118 5 57
2nd 0 154 11 14
3rd 35 387 13 75
Crew 0 670 0 192
Female 1st 0 4 1 140
2nd 0 13 13 80
3rd 17 89 14 76
Crew 0 3 0 20
> ## Don't show:
> stopifnot(dim(format(ft)) == 4:5,
+ dim(format(ftable(UCBAdmissions))) == c(6,9),
+ dim(format(ft22)) == c(11,7))
> ## End Don't show
>
>
>
> cleanEx()
> nameEx("rect.hclust")
> ### * rect.hclust
>
> flush(stderr()); flush(stdout())
>
> ### Name: rect.hclust
> ### Title: Draw Rectangles Around Hierarchical Clusters
> ### Aliases: rect.hclust
> ### Keywords: aplot cluster
>
> ### ** Examples
>
> require(graphics)
>
> hca <- hclust(dist(USArrests))
> plot(hca)
> rect.hclust(hca, k=3, border="red")
> x <- rect.hclust(hca, h=50, which=c(2,7), border=3:4)
> x
[[1]]
Alabama Alaska Delaware Louisiana Mississippi
1 2 8 18 24
South Carolina
40
[[2]]
Connecticut Idaho Indiana Kansas Kentucky Montana
7 12 14 16 17 26
Nebraska Ohio Pennsylvania Utah
27 35 38 44
>
>
>
> cleanEx()
> nameEx("relevel")
> ### * relevel
>
> flush(stderr()); flush(stdout())
>
> ### Name: relevel
> ### Title: Reorder Levels of Factor
> ### Aliases: relevel relevel.default relevel.factor relevel.ordered
> ### Keywords: utilities models
>
> ### ** Examples
>
> warpbreaks$tension <- relevel(warpbreaks$tension, ref="M")
> summary(lm(breaks ~ wool + tension, data=warpbreaks))
Call:
lm(formula = breaks ~ wool + tension, data = warpbreaks)
Residuals:
Min 1Q Median 3Q Max
-19.500 -8.083 -2.139 6.472 30.722
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 29.278 3.162 9.260 2e-12 ***
woolB -5.778 3.162 -1.827 0.0736 .
tensionL 10.000 3.872 2.582 0.0128 *
tensionH -4.722 3.872 -1.219 0.2284
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 11.62 on 50 degrees of freedom
Multiple R-squared: 0.2691, Adjusted R-squared: 0.2253
F-statistic: 6.138 on 3 and 50 DF, p-value: 0.001230
>
>
>
> cleanEx()
> nameEx("reorder.dendrogram")
> ### * reorder.dendrogram
>
> flush(stderr()); flush(stdout())
>
> ### Name: reorder.dendrogram
> ### Title: Reorder a Dendrogram
> ### Aliases: reorder.dendrogram
> ### Keywords: manip
>
> ### ** Examples
>
> require(graphics)
>
> set.seed(123)
> x <- rnorm(10)
> hc <- hclust(dist(x))
> dd <- as.dendrogram(hc)
> dd.reorder <- reorder(dd, 10:1)
> plot(dd, main = "random dendrogram 'dd'")
>
> op <- par(mfcol = 1:2)
> plot(dd.reorder, main = "reorder(dd, 10:1)")
> plot(reorder(dd,10:1, agglo.FUN= mean),
+ main = "reorder(dd, 10:1, mean)")
> par(op)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("reorder.factor")
> ### * reorder.factor
>
> flush(stderr()); flush(stdout())
>
> ### Name: reorder.default
> ### Title: Reorder Levels of a Factor
> ### Aliases: reorder reorder.default
> ### Keywords: utilities
>
> ### ** Examples
>
> require(graphics)
>
> bymedian <- with(InsectSprays, reorder(spray, count, median))
> boxplot(count ~ bymedian, data = InsectSprays,
+ xlab = "Type of spray", ylab = "Insect count",
+ main = "InsectSprays data", varwidth = TRUE,
+ col = "lightgray")
>
>
>
> cleanEx()
> nameEx("replications")
> ### * replications
>
> flush(stderr()); flush(stdout())
>
> ### Name: replications
> ### Title: Number of Replications of Terms
> ### Aliases: replications
> ### Keywords: models
>
> ### ** Examples
>
> ## From Venables and Ripley (2002) p.165.
> N <- c(0,1,0,1,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,1,1,0,0)
> P <- c(1,1,0,0,0,1,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,1,1,0)
> K <- c(1,0,0,1,0,1,1,0,0,1,0,1,0,1,1,0,0,0,1,1,1,0,1,0)
> yield <- c(49.5,62.8,46.8,57.0,59.8,58.5,55.5,56.0,62.8,55.8,69.5,
+ 55.0, 62.0,48.8,45.5,44.2,52.0,51.5,49.8,48.8,57.2,59.0,53.2,56.0)
>
> npk <- data.frame(block=gl(6,4), N=factor(N), P=factor(P),
+ K=factor(K), yield=yield)
> replications(~ . - yield, npk)
block N P K
4 12 12 12
>
>
>
> cleanEx()
> nameEx("reshape")
> ### * reshape
>
> flush(stderr()); flush(stdout())
>
> ### Name: reshape
> ### Title: Reshape Grouped Data
> ### Aliases: reshape
> ### Keywords: manip
>
> ### ** Examples
>
> summary(Indometh)
Subject time conc
1:11 Min. :0.250 Min. :0.0500
4:11 1st Qu.:0.750 1st Qu.:0.1100
2:11 Median :2.000 Median :0.3400
5:11 Mean :2.886 Mean :0.5918
6:11 3rd Qu.:5.000 3rd Qu.:0.8325
3:11 Max. :8.000 Max. :2.7200
> wide <- reshape(Indometh, v.names="conc", idvar="Subject",
+ timevar="time", direction="wide")
> wide
Subject conc.0.25 conc.0.5 conc.0.75 conc.1 conc.1.25 conc.2 conc.3 conc.4
1 1 1.50 0.94 0.78 0.48 0.37 0.19 0.12 0.11
12 2 2.03 1.63 0.71 0.70 0.64 0.36 0.32 0.20
23 3 2.72 1.49 1.16 0.80 0.80 0.39 0.22 0.12
34 4 1.85 1.39 1.02 0.89 0.59 0.40 0.16 0.11
45 5 2.05 1.04 0.81 0.39 0.30 0.23 0.13 0.11
56 6 2.31 1.44 1.03 0.84 0.64 0.42 0.24 0.17
conc.5 conc.6 conc.8
1 0.08 0.07 0.05
12 0.25 0.12 0.08
23 0.11 0.08 0.08
34 0.10 0.07 0.07
45 0.08 0.10 0.06
56 0.13 0.10 0.09
>
> reshape(wide, direction="long")
Subject time conc
1.0.25 1 0.25 1.50
2.0.25 2 0.25 2.03
3.0.25 3 0.25 2.72
4.0.25 4 0.25 1.85
5.0.25 5 0.25 2.05
6.0.25 6 0.25 2.31
1.0.5 1 0.50 0.94
2.0.5 2 0.50 1.63
3.0.5 3 0.50 1.49
4.0.5 4 0.50 1.39
5.0.5 5 0.50 1.04
6.0.5 6 0.50 1.44
1.0.75 1 0.75 0.78
2.0.75 2 0.75 0.71
3.0.75 3 0.75 1.16
4.0.75 4 0.75 1.02
5.0.75 5 0.75 0.81
6.0.75 6 0.75 1.03
1.1 1 1.00 0.48
2.1 2 1.00 0.70
3.1 3 1.00 0.80
4.1 4 1.00 0.89
5.1 5 1.00 0.39
6.1 6 1.00 0.84
1.1.25 1 1.25 0.37
2.1.25 2 1.25 0.64
3.1.25 3 1.25 0.80
4.1.25 4 1.25 0.59
5.1.25 5 1.25 0.30
6.1.25 6 1.25 0.64
1.2 1 2.00 0.19
2.2 2 2.00 0.36
3.2 3 2.00 0.39
4.2 4 2.00 0.40
5.2 5 2.00 0.23
6.2 6 2.00 0.42
1.3 1 3.00 0.12
2.3 2 3.00 0.32
3.3 3 3.00 0.22
4.3 4 3.00 0.16
5.3 5 3.00 0.13
6.3 6 3.00 0.24
1.4 1 4.00 0.11
2.4 2 4.00 0.20
3.4 3 4.00 0.12
4.4 4 4.00 0.11
5.4 5 4.00 0.11
6.4 6 4.00 0.17
1.5 1 5.00 0.08
2.5 2 5.00 0.25
3.5 3 5.00 0.11
4.5 4 5.00 0.10
5.5 5 5.00 0.08
6.5 6 5.00 0.13
1.6 1 6.00 0.07
2.6 2 6.00 0.12
3.6 3 6.00 0.08
4.6 4 6.00 0.07
5.6 5 6.00 0.10
6.6 6 6.00 0.10
1.8 1 8.00 0.05
2.8 2 8.00 0.08
3.8 3 8.00 0.08
4.8 4 8.00 0.07
5.8 5 8.00 0.06
6.8 6 8.00 0.09
> reshape(wide, idvar="Subject", varying=list(2:12),
+ v.names="conc", direction="long")
Subject time conc
1.1 1 1 1.50
2.1 2 1 2.03
3.1 3 1 2.72
4.1 4 1 1.85
5.1 5 1 2.05
6.1 6 1 2.31
1.2 1 2 0.94
2.2 2 2 1.63
3.2 3 2 1.49
4.2 4 2 1.39
5.2 5 2 1.04
6.2 6 2 1.44
1.3 1 3 0.78
2.3 2 3 0.71
3.3 3 3 1.16
4.3 4 3 1.02
5.3 5 3 0.81
6.3 6 3 1.03
1.4 1 4 0.48
2.4 2 4 0.70
3.4 3 4 0.80
4.4 4 4 0.89
5.4 5 4 0.39
6.4 6 4 0.84
1.5 1 5 0.37
2.5 2 5 0.64
3.5 3 5 0.80
4.5 4 5 0.59
5.5 5 5 0.30
6.5 6 5 0.64
1.6 1 6 0.19
2.6 2 6 0.36
3.6 3 6 0.39
4.6 4 6 0.40
5.6 5 6 0.23
6.6 6 6 0.42
1.7 1 7 0.12
2.7 2 7 0.32
3.7 3 7 0.22
4.7 4 7 0.16
5.7 5 7 0.13
6.7 6 7 0.24
1.8 1 8 0.11
2.8 2 8 0.20
3.8 3 8 0.12
4.8 4 8 0.11
5.8 5 8 0.11
6.8 6 8 0.17
1.9 1 9 0.08
2.9 2 9 0.25
3.9 3 9 0.11
4.9 4 9 0.10
5.9 5 9 0.08
6.9 6 9 0.13
1.10 1 10 0.07
2.10 2 10 0.12
3.10 3 10 0.08
4.10 4 10 0.07
5.10 5 10 0.10
6.10 6 10 0.10
1.11 1 11 0.05
2.11 2 11 0.08
3.11 3 11 0.08
4.11 4 11 0.07
5.11 5 11 0.06
6.11 6 11 0.09
>
> ## times need not be numeric
> df <- data.frame(id=rep(1:4,rep(2,4)),
+ visit=I(rep(c("Before","After"),4)),
+ x=rnorm(4), y=runif(4))
> df
id visit x y
1 1 Before -0.6264538 0.62911404
2 1 After 0.1836433 0.06178627
3 2 Before -0.8356286 0.20597457
4 2 After 1.5952808 0.17655675
5 3 Before -0.6264538 0.62911404
6 3 After 0.1836433 0.06178627
7 4 Before -0.8356286 0.20597457
8 4 After 1.5952808 0.17655675
> reshape(df, timevar="visit", idvar="id", direction="wide")
id x.Before y.Before x.After y.After
1 1 -0.6264538 0.6291140 0.1836433 0.06178627
3 2 -0.8356286 0.2059746 1.5952808 0.17655675
5 3 -0.6264538 0.6291140 0.1836433 0.06178627
7 4 -0.8356286 0.2059746 1.5952808 0.17655675
> ## warns that y is really varying
> reshape(df, timevar="visit", idvar="id", direction="wide", v.names="x")
Warning in reshapeWide(data, idvar = idvar, timevar = timevar, varying = varying, :
some constant variables (y) are really varying
id y x.Before x.After
1 1 0.6291140 -0.6264538 0.1836433
3 2 0.2059746 -0.8356286 1.5952808
5 3 0.6291140 -0.6264538 0.1836433
7 4 0.2059746 -0.8356286 1.5952808
>
>
> ## unbalanced 'long' data leads to NA fill in 'wide' form
> df2 <- df[1:7,]
> df2
id visit x y
1 1 Before -0.6264538 0.62911404
2 1 After 0.1836433 0.06178627
3 2 Before -0.8356286 0.20597457
4 2 After 1.5952808 0.17655675
5 3 Before -0.6264538 0.62911404
6 3 After 0.1836433 0.06178627
7 4 Before -0.8356286 0.20597457
> reshape(df2, timevar="visit", idvar="id", direction="wide")
id x.Before y.Before x.After y.After
1 1 -0.6264538 0.6291140 0.1836433 0.06178627
3 2 -0.8356286 0.2059746 1.5952808 0.17655675
5 3 -0.6264538 0.6291140 0.1836433 0.06178627
7 4 -0.8356286 0.2059746 NA NA
>
> ## Alternative regular expressions for guessing names
> df3 <- data.frame(id=1:4, age=c(40,50,60,50), dose1=c(1,2,1,2),
+ dose2=c(2,1,2,1), dose4=c(3,3,3,3))
> reshape(df3, direction="long", varying=3:5, sep="")
id age time dose
1.1 1 40 1 1
2.1 2 50 1 2
3.1 3 60 1 1
4.1 4 50 1 2
1.2 1 40 2 2
2.2 2 50 2 1
3.2 3 60 2 2
4.2 4 50 2 1
1.4 1 40 4 3
2.4 2 50 4 3
3.4 3 60 4 3
4.4 4 50 4 3
>
>
> ## an example that isn't longitudinal data
> state.x77 <- as.data.frame(state.x77)
> long <- reshape(state.x77, idvar="state", ids=row.names(state.x77),
+ times=names(state.x77), timevar="Characteristic",
+ varying=list(names(state.x77)), direction="long")
>
> reshape(long, direction="wide")
state Population Income Illiteracy Life Exp
Alabama.Population Alabama 3615 3624 2.1 69.05
Alaska.Population Alaska 365 6315 1.5 69.31
Arizona.Population Arizona 2212 4530 1.8 70.55
Arkansas.Population Arkansas 2110 3378 1.9 70.66
California.Population California 21198 5114 1.1 71.71
Colorado.Population Colorado 2541 4884 0.7 72.06
Connecticut.Population Connecticut 3100 5348 1.1 72.48
Delaware.Population Delaware 579 4809 0.9 70.06
Florida.Population Florida 8277 4815 1.3 70.66
Georgia.Population Georgia 4931 4091 2.0 68.54
Hawaii.Population Hawaii 868 4963 1.9 73.60
Idaho.Population Idaho 813 4119 0.6 71.87
Illinois.Population Illinois 11197 5107 0.9 70.14
Indiana.Population Indiana 5313 4458 0.7 70.88
Iowa.Population Iowa 2861 4628 0.5 72.56
Kansas.Population Kansas 2280 4669 0.6 72.58
Kentucky.Population Kentucky 3387 3712 1.6 70.10
Louisiana.Population Louisiana 3806 3545 2.8 68.76
Maine.Population Maine 1058 3694 0.7 70.39
Maryland.Population Maryland 4122 5299 0.9 70.22
Massachusetts.Population Massachusetts 5814 4755 1.1 71.83
Michigan.Population Michigan 9111 4751 0.9 70.63
Minnesota.Population Minnesota 3921 4675 0.6 72.96
Mississippi.Population Mississippi 2341 3098 2.4 68.09
Missouri.Population Missouri 4767 4254 0.8 70.69
Montana.Population Montana 746 4347 0.6 70.56
Nebraska.Population Nebraska 1544 4508 0.6 72.60
Nevada.Population Nevada 590 5149 0.5 69.03
New Hampshire.Population New Hampshire 812 4281 0.7 71.23
New Jersey.Population New Jersey 7333 5237 1.1 70.93
New Mexico.Population New Mexico 1144 3601 2.2 70.32
New York.Population New York 18076 4903 1.4 70.55
North Carolina.Population North Carolina 5441 3875 1.8 69.21
North Dakota.Population North Dakota 637 5087 0.8 72.78
Ohio.Population Ohio 10735 4561 0.8 70.82
Oklahoma.Population Oklahoma 2715 3983 1.1 71.42
Oregon.Population Oregon 2284 4660 0.6 72.13
Pennsylvania.Population Pennsylvania 11860 4449 1.0 70.43
Rhode Island.Population Rhode Island 931 4558 1.3 71.90
South Carolina.Population South Carolina 2816 3635 2.3 67.96
South Dakota.Population South Dakota 681 4167 0.5 72.08
Tennessee.Population Tennessee 4173 3821 1.7 70.11
Texas.Population Texas 12237 4188 2.2 70.90
Utah.Population Utah 1203 4022 0.6 72.90
Vermont.Population Vermont 472 3907 0.6 71.64
Virginia.Population Virginia 4981 4701 1.4 70.08
Washington.Population Washington 3559 4864 0.6 71.72
West Virginia.Population West Virginia 1799 3617 1.4 69.48
Wisconsin.Population Wisconsin 4589 4468 0.7 72.48
Wyoming.Population Wyoming 376 4566 0.6 70.29
Murder HS Grad Frost Area
Alabama.Population 15.1 41.3 20 50708
Alaska.Population 11.3 66.7 152 566432
Arizona.Population 7.8 58.1 15 113417
Arkansas.Population 10.1 39.9 65 51945
California.Population 10.3 62.6 20 156361
Colorado.Population 6.8 63.9 166 103766
Connecticut.Population 3.1 56.0 139 4862
Delaware.Population 6.2 54.6 103 1982
Florida.Population 10.7 52.6 11 54090
Georgia.Population 13.9 40.6 60 58073
Hawaii.Population 6.2 61.9 0 6425
Idaho.Population 5.3 59.5 126 82677
Illinois.Population 10.3 52.6 127 55748
Indiana.Population 7.1 52.9 122 36097
Iowa.Population 2.3 59.0 140 55941
Kansas.Population 4.5 59.9 114 81787
Kentucky.Population 10.6 38.5 95 39650
Louisiana.Population 13.2 42.2 12 44930
Maine.Population 2.7 54.7 161 30920
Maryland.Population 8.5 52.3 101 9891
Massachusetts.Population 3.3 58.5 103 7826
Michigan.Population 11.1 52.8 125 56817
Minnesota.Population 2.3 57.6 160 79289
Mississippi.Population 12.5 41.0 50 47296
Missouri.Population 9.3 48.8 108 68995
Montana.Population 5.0 59.2 155 145587
Nebraska.Population 2.9 59.3 139 76483
Nevada.Population 11.5 65.2 188 109889
New Hampshire.Population 3.3 57.6 174 9027
New Jersey.Population 5.2 52.5 115 7521
New Mexico.Population 9.7 55.2 120 121412
New York.Population 10.9 52.7 82 47831
North Carolina.Population 11.1 38.5 80 48798
North Dakota.Population 1.4 50.3 186 69273
Ohio.Population 7.4 53.2 124 40975
Oklahoma.Population 6.4 51.6 82 68782
Oregon.Population 4.2 60.0 44 96184
Pennsylvania.Population 6.1 50.2 126 44966
Rhode Island.Population 2.4 46.4 127 1049
South Carolina.Population 11.6 37.8 65 30225
South Dakota.Population 1.7 53.3 172 75955
Tennessee.Population 11.0 41.8 70 41328
Texas.Population 12.2 47.4 35 262134
Utah.Population 4.5 67.3 137 82096
Vermont.Population 5.5 57.1 168 9267
Virginia.Population 9.5 47.8 85 39780
Washington.Population 4.3 63.5 32 66570
West Virginia.Population 6.7 41.6 100 24070
Wisconsin.Population 3.0 54.5 149 54464
Wyoming.Population 6.9 62.9 173 97203
>
> reshape(long, direction="wide", new.row.names=unique(long$state))
state Population Income Illiteracy Life Exp Murder
Alabama Alabama 3615 3624 2.1 69.05 15.1
Alaska Alaska 365 6315 1.5 69.31 11.3
Arizona Arizona 2212 4530 1.8 70.55 7.8
Arkansas Arkansas 2110 3378 1.9 70.66 10.1
California California 21198 5114 1.1 71.71 10.3
Colorado Colorado 2541 4884 0.7 72.06 6.8
Connecticut Connecticut 3100 5348 1.1 72.48 3.1
Delaware Delaware 579 4809 0.9 70.06 6.2
Florida Florida 8277 4815 1.3 70.66 10.7
Georgia Georgia 4931 4091 2.0 68.54 13.9
Hawaii Hawaii 868 4963 1.9 73.60 6.2
Idaho Idaho 813 4119 0.6 71.87 5.3
Illinois Illinois 11197 5107 0.9 70.14 10.3
Indiana Indiana 5313 4458 0.7 70.88 7.1
Iowa Iowa 2861 4628 0.5 72.56 2.3
Kansas Kansas 2280 4669 0.6 72.58 4.5
Kentucky Kentucky 3387 3712 1.6 70.10 10.6
Louisiana Louisiana 3806 3545 2.8 68.76 13.2
Maine Maine 1058 3694 0.7 70.39 2.7
Maryland Maryland 4122 5299 0.9 70.22 8.5
Massachusetts Massachusetts 5814 4755 1.1 71.83 3.3
Michigan Michigan 9111 4751 0.9 70.63 11.1
Minnesota Minnesota 3921 4675 0.6 72.96 2.3
Mississippi Mississippi 2341 3098 2.4 68.09 12.5
Missouri Missouri 4767 4254 0.8 70.69 9.3
Montana Montana 746 4347 0.6 70.56 5.0
Nebraska Nebraska 1544 4508 0.6 72.60 2.9
Nevada Nevada 590 5149 0.5 69.03 11.5
New Hampshire New Hampshire 812 4281 0.7 71.23 3.3
New Jersey New Jersey 7333 5237 1.1 70.93 5.2
New Mexico New Mexico 1144 3601 2.2 70.32 9.7
New York New York 18076 4903 1.4 70.55 10.9
North Carolina North Carolina 5441 3875 1.8 69.21 11.1
North Dakota North Dakota 637 5087 0.8 72.78 1.4
Ohio Ohio 10735 4561 0.8 70.82 7.4
Oklahoma Oklahoma 2715 3983 1.1 71.42 6.4
Oregon Oregon 2284 4660 0.6 72.13 4.2
Pennsylvania Pennsylvania 11860 4449 1.0 70.43 6.1
Rhode Island Rhode Island 931 4558 1.3 71.90 2.4
South Carolina South Carolina 2816 3635 2.3 67.96 11.6
South Dakota South Dakota 681 4167 0.5 72.08 1.7
Tennessee Tennessee 4173 3821 1.7 70.11 11.0
Texas Texas 12237 4188 2.2 70.90 12.2
Utah Utah 1203 4022 0.6 72.90 4.5
Vermont Vermont 472 3907 0.6 71.64 5.5
Virginia Virginia 4981 4701 1.4 70.08 9.5
Washington Washington 3559 4864 0.6 71.72 4.3
West Virginia West Virginia 1799 3617 1.4 69.48 6.7
Wisconsin Wisconsin 4589 4468 0.7 72.48 3.0
Wyoming Wyoming 376 4566 0.6 70.29 6.9
HS Grad Frost Area
Alabama 41.3 20 50708
Alaska 66.7 152 566432
Arizona 58.1 15 113417
Arkansas 39.9 65 51945
California 62.6 20 156361
Colorado 63.9 166 103766
Connecticut 56.0 139 4862
Delaware 54.6 103 1982
Florida 52.6 11 54090
Georgia 40.6 60 58073
Hawaii 61.9 0 6425
Idaho 59.5 126 82677
Illinois 52.6 127 55748
Indiana 52.9 122 36097
Iowa 59.0 140 55941
Kansas 59.9 114 81787
Kentucky 38.5 95 39650
Louisiana 42.2 12 44930
Maine 54.7 161 30920
Maryland 52.3 101 9891
Massachusetts 58.5 103 7826
Michigan 52.8 125 56817
Minnesota 57.6 160 79289
Mississippi 41.0 50 47296
Missouri 48.8 108 68995
Montana 59.2 155 145587
Nebraska 59.3 139 76483
Nevada 65.2 188 109889
New Hampshire 57.6 174 9027
New Jersey 52.5 115 7521
New Mexico 55.2 120 121412
New York 52.7 82 47831
North Carolina 38.5 80 48798
North Dakota 50.3 186 69273
Ohio 53.2 124 40975
Oklahoma 51.6 82 68782
Oregon 60.0 44 96184
Pennsylvania 50.2 126 44966
Rhode Island 46.4 127 1049
South Carolina 37.8 65 30225
South Dakota 53.3 172 75955
Tennessee 41.8 70 41328
Texas 47.4 35 262134
Utah 67.3 137 82096
Vermont 57.1 168 9267
Virginia 47.8 85 39780
Washington 63.5 32 66570
West Virginia 41.6 100 24070
Wisconsin 54.5 149 54464
Wyoming 62.9 173 97203
>
> ## multiple id variables
> df3 <- data.frame(school=rep(1:3,each=4), class=rep(9:10,6),
+ time=rep(c(1,1,2,2),3),
+ score=rnorm(12))
> wide <- reshape(df3, idvar=c("school","class"), direction="wide")
> wide
school class score.1 score.2
1 1 9 0.48742905 0.57578135
2 1 10 0.73832471 -0.30538839
5 2 9 1.51178117 -0.62124058
6 2 10 0.38984324 -2.21469989
9 3 9 1.12493092 -0.01619026
10 3 10 -0.04493361 0.94383621
> ## transform back
> reshape(wide)
school class time score.1
1.9.1 1 9 1 0.48742905
1.10.1 1 10 1 0.73832471
2.9.1 2 9 1 1.51178117
2.10.1 2 10 1 0.38984324
3.9.1 3 9 1 1.12493092
3.10.1 3 10 1 -0.04493361
1.9.2 1 9 2 0.57578135
1.10.2 1 10 2 -0.30538839
2.9.2 2 9 2 -0.62124058
2.10.2 2 10 2 -2.21469989
3.9.2 3 9 2 -0.01619026
3.10.2 3 10 2 0.94383621
>
>
>
>
> cleanEx()
> nameEx("runmed")
> ### * runmed
>
> flush(stderr()); flush(stdout())
>
> ### Name: runmed
> ### Title: Running Medians - Robust Scatter Plot Smoothing
> ### Aliases: runmed
> ### Keywords: smooth robust
>
> ### ** Examples
>
> require(graphics)
>
> utils::example(nhtemp)
nhtemp> require(stats); require(graphics)
nhtemp> plot(nhtemp, main = "nhtemp data",
nhtemp+ ylab = "Mean annual temperature in New Haven, CT (deg. F)")
> myNHT <- as.vector(nhtemp)
> myNHT[20] <- 2 * nhtemp[20]
> plot(myNHT, type="b", ylim = c(48,60), main = "Running Medians Example")
> lines(runmed(myNHT, 7), col = "red")
>
> ## special: multiple y values for one x
> plot(cars, main = "'cars' data and runmed(dist, 3)")
> lines(cars, col = "light gray", type = "c")
> with(cars, lines(speed, runmed(dist, k = 3), col = 2))
>
> ## nice quadratic with a few outliers
> y <- ys <- (-20:20)^2
> y [c(1,10,21,41)] <- c(150, 30, 400, 450)
> all(y == runmed(y, 1)) # 1-neighbourhood <==> interpolation
[1] TRUE
> plot(y) ## lines(y, lwd=.1, col="light gray")
> lines(lowess(seq(y),y, f = .3), col = "brown")
> lines(runmed(y, 7), lwd=2, col = "blue")
> lines(runmed(y,11), lwd=2, col = "red")
>
> ## Lowess is not robust
> y <- ys ; y[21] <- 6666 ; x <- seq(y)
> col <- c("black", "brown","blue")
> plot(y, col=col[1])
> lines(lowess(x,y, f = .3), col = col[2])
> lines(runmed(y, 7), lwd=2, col = col[3])
> legend(length(y),max(y), c("data", "lowess(y, f = 0.3)", "runmed(y, 7)"),
+ xjust = 1, col = col, lty = c(0, 1,1), pch = c(1,NA,NA))
>
>
>
> cleanEx()
> nameEx("scatter.smooth")
> ### * scatter.smooth
>
> flush(stderr()); flush(stdout())
>
> ### Name: scatter.smooth
> ### Title: Scatter Plot with Smooth Curve Fitted by Loess
> ### Aliases: scatter.smooth loess.smooth
> ### Keywords: smooth
>
> ### ** Examples
>
> require(graphics)
>
> with(cars, scatter.smooth(speed, dist))
>
>
>
> cleanEx()
> nameEx("screeplot")
> ### * screeplot
>
> flush(stderr()); flush(stdout())
>
> ### Name: screeplot
> ### Title: Screeplots
> ### Aliases: screeplot screeplot.default
> ### Keywords: multivariate
>
> ### ** Examples
>
> require(graphics)
>
> ## The variances of the variables in the
> ## USArrests data vary by orders of magnitude, so scaling is appropriate
> (pc.cr <- princomp(USArrests, cor = TRUE)) # inappropriate
Call:
princomp(x = USArrests, cor = TRUE)
Standard deviations:
Comp.1 Comp.2 Comp.3 Comp.4
1.5748783 0.9948694 0.5971291 0.4164494
4 variables and 50 observations.
> screeplot(pc.cr)
>
> fit <- princomp(covmat=Harman74.cor)
> screeplot(fit)
> screeplot(fit, npcs=24, type="lines")
>
>
>
> cleanEx()
> nameEx("sd")
> ### * sd
>
> flush(stderr()); flush(stdout())
>
> ### Name: sd
> ### Title: Standard Deviation
> ### Aliases: sd
> ### Keywords: univar
>
> ### ** Examples
>
> sd(1:2) ^ 2
[1] 0.5
>
>
>
> cleanEx()
> nameEx("se.contrast")
> ### * se.contrast
>
> flush(stderr()); flush(stdout())
>
> ### Name: se.contrast
> ### Title: Standard Errors for Contrasts in Model Terms
> ### Aliases: se.contrast se.contrast.aov se.contrast.aovlist
> ### Keywords: models
>
> ### ** Examples
>
> ## From Venables and Ripley (2002) p.165.
> N <- c(0,1,0,1,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,1,1,0,0)
> P <- c(1,1,0,0,0,1,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,1,1,0)
> K <- c(1,0,0,1,0,1,1,0,0,1,0,1,0,1,1,0,0,0,1,1,1,0,1,0)
> yield <- c(49.5,62.8,46.8,57.0,59.8,58.5,55.5,56.0,62.8,55.8,69.5,
+ 55.0, 62.0,48.8,45.5,44.2,52.0,51.5,49.8,48.8,57.2,59.0,53.2,56.0)
>
> npk <- data.frame(block = gl(6,4), N = factor(N), P = factor(P),
+ K = factor(K), yield = yield)
> ## Set suitable contrasts.
> options(contrasts=c("contr.helmert", "contr.poly"))
> npk.aov1 <- aov(yield ~ block + N + K, data=npk)
> se.contrast(npk.aov1, list(N == "0", N == "1"), data=npk)
[1] 1.609175
> # or via a matrix
> cont <- matrix(c(-1,1), 2, 1, dimnames=list(NULL, "N"))
> se.contrast(npk.aov1, cont[N, , drop=FALSE]/12, data=npk)
N
1.609175
>
> ## test a multi-stratum model
> npk.aov2 <- aov(yield ~ N + K + Error(block/(N + K)), data=npk)
> se.contrast(npk.aov2, list(N == "0", N == "1"))
[1] 1.812166
>
>
> ## an example looking at an interaction contrast
> ## Dataset from R.E. Kirk (1995)
> ## 'Experimental Design: procedures for the behavioral sciences'
> score <- c(12, 8,10, 6, 8, 4,10,12, 8, 6,10,14, 9, 7, 9, 5,11,12,
+ 7,13, 9, 9, 5,11, 8, 7, 3, 8,12,10,13,14,19, 9,16,14)
> A <- gl(2, 18, labels=c("a1", "a2"))
> B <- rep(gl(3, 6, labels=c("b1", "b2", "b3")), 2)
> fit <- aov(score ~ A*B)
> cont <- c(1, -1)[A] * c(1, -1, 0)[B]
> sum(cont) # 0
[1] 0
> sum(cont*score) # value of the contrast
[1] -18
> se.contrast(fit, as.matrix(cont))
Contrast 1
14.24547
> (t.stat <- sum(cont*score)/se.contrast(fit, as.matrix(cont)))
Contrast 1
-1.263560
> summary(fit, split=list(B=1:2), expand.split = TRUE)
Df Sum Sq Mean Sq F value Pr(>F)
A 1 18.778 18.778 2.2208 0.146606
B 2 62.000 31.000 3.6662 0.037629 *
B: C1 1 1.500 1.500 0.1774 0.676621
B: C2 1 60.500 60.500 7.1551 0.011986 *
A:B 2 81.556 40.778 4.8226 0.015274 *
A:B: C1 1 13.500 13.500 1.5966 0.216119
A:B: C2 1 68.056 68.056 8.0486 0.008085 **
Residuals 30 253.667 8.456
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> ## t.stat^2 is the F value on the A:B: C1 line (with Helmert contrasts)
> ## Now look at all three interaction contrasts
> cont <- c(1, -1)[A] * cbind(c(1, -1, 0), c(1, 0, -1), c(0, 1, -1))[B,]
> se.contrast(fit, cont) # same, due to balance.
Contrast 1 Contrast 2 Contrast 3
14.24547 14.24547 14.24547
> rm(A,B,score)
>
>
> ## multi-stratum example where efficiencies play a role
> utils::example(eff.aovlist)
eff.vl> ## An example from Yates (1932),
eff.vl> ## a 2^3 design in 2 blocks replicated 4 times
eff.vl>
eff.vl> Block <- gl(8, 4)
eff.vl> A <- factor(c(0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,
eff.vl+ 0,1,0,1,0,1,0,1,0,1,0,1))
eff.vl> B <- factor(c(0,0,1,1,0,0,1,1,0,1,0,1,1,0,1,0,0,0,1,1,
eff.vl+ 0,0,1,1,0,0,1,1,0,0,1,1))
eff.vl> C <- factor(c(0,1,1,0,1,0,0,1,0,0,1,1,0,0,1,1,0,1,0,1,
eff.vl+ 1,0,1,0,0,0,1,1,1,1,0,0))
eff.vl> Yield <- c(101, 373, 398, 291, 312, 106, 265, 450, 106, 306, 324, 449,
eff.vl+ 272, 89, 407, 338, 87, 324, 279, 471, 323, 128, 423, 334,
eff.vl+ 131, 103, 445, 437, 324, 361, 302, 272)
eff.vl> aovdat <- data.frame(Block, A, B, C, Yield)
eff.vl> old <- getOption("contrasts")
eff.vl> options(contrasts=c("contr.helmert", "contr.poly"))
eff.vl> (fit <- aov(Yield ~ A*B*C + Error(Block), data = aovdat))
Call:
aov(formula = Yield ~ A * B * C + Error(Block), data = aovdat)
Grand Mean: 291.5938
Stratum 1: Block
Terms:
A:B A:C B:C A:B:C Residuals
Sum of Squares 780.1250 276.1250 2556.1250 112.5000 774.0938
Deg. of Freedom 1 1 1 1 3
Residual standard error: 16.06335
Estimated effects are balanced
Stratum 2: Within
Terms:
A B C A:B A:C B:C
Sum of Squares 3465.28 161170.03 278817.78 28.17 1802.67 11528.17
Deg. of Freedom 1 1 1 1 1 1
A:B:C Residuals
Sum of Squares 45.37 5423.28
Deg. of Freedom 1 17
Residual standard error: 17.86103
Estimated effects are balanced
eff.vl> eff.aovlist(fit)
A B C A:B A:C B:C A:B:C
Block 0 0 0 0.25 0.25 0.25 0.25
Within 1 1 1 0.75 0.75 0.75 0.75
eff.vl> options(contrasts = old)
> fit <- aov(Yield ~ A + B * C + Error(Block), data = aovdat)
> cont1 <- c(-1, 1)[A]/32 # Helmert contrasts
> cont2 <- c(-1, 1)[B] * c(-1, 1)[C]/32
> cont <- cbind(A=cont1, BC=cont2)
> colSums(cont*Yield) # values of the contrasts
A BC
10.40625 -20.90625
> se.contrast(fit, as.matrix(cont))
A BC
3.377196 3.899650
> ## Not run:
> ##D # comparison with lme
> ##D library(nlme)
> ##D fit2 <- lme(Yield ~ A + B*C, random = ~1 | Block, data = aovdat)
> ##D summary(fit2)$tTable # same estimates, similar (but smaller) se's.
> ## End(Not run)
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("selfStart")
> ### * selfStart
>
> flush(stderr()); flush(stdout())
>
> ### Name: selfStart
> ### Title: Construct Self-starting Nonlinear Models
> ### Aliases: selfStart selfStart.default selfStart.formula
> ### Keywords: models
>
> ### ** Examples
>
> ## self-starting logistic model
>
> SSlogis <- selfStart(~ Asym/(1 + exp((xmid - x)/scal)),
+ function(mCall, data, LHS)
+ {
+ xy <- sortedXyData(mCall[["x"]], LHS, data)
+ if(nrow(xy) < 4) {
+ stop("Too few distinct x values to fit a logistic")
+ }
+ z <- xy[["y"]]
+ if (min(z) <= 0) { z <- z + 0.05 * max(z) } # avoid zeroes
+ z <- z/(1.05 * max(z)) # scale to within unit height
+ xy[["z"]] <- log(z/(1 - z)) # logit transformation
+ aux <- coef(lm(x ~ z, xy))
+ parameters(xy) <- list(xmid = aux[1], scal = aux[2])
+ pars <- as.vector(coef(nls(y ~ 1/(1 + exp((xmid - x)/scal)),
+ data = xy, algorithm = "plinear")))
+ value <- c(pars[3], pars[1], pars[2])
+ names(value) <- mCall[c("Asym", "xmid", "scal")]
+ value
+ }, c("Asym", "xmid", "scal"))
>
> # 'first.order.log.model' is a function object defining a first order
> # compartment model
> # 'first.order.log.initial' is a function object which calculates initial
> # values for the parameters in 'first.order.log.model'
>
> # self-starting first order compartment model
> ## Not run:
> ##D SSfol <- selfStart(first.order.log.model, first.order.log.initial)
> ## End(Not run)
>
>
>
> cleanEx()
> nameEx("setNames")
> ### * setNames
>
> flush(stderr()); flush(stdout())
>
> ### Name: setNames
> ### Title: Set the Names in an Object
> ### Aliases: setNames
> ### Keywords: list
>
> ### ** Examples
>
> setNames( 1:3, c("foo", "bar", "baz") )
foo bar baz
1 2 3
> # this is just a short form of
> tmp <- 1:3
> names(tmp) <- c("foo", "bar", "baz")
> tmp
foo bar baz
1 2 3
>
>
>
> cleanEx()
> nameEx("shapiro.test")
> ### * shapiro.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: shapiro.test
> ### Title: Shapiro-Wilk Normality Test
> ### Aliases: shapiro.test
> ### Keywords: htest
>
> ### ** Examples
>
> shapiro.test(rnorm(100, mean = 5, sd = 3))
Shapiro-Wilk normality test
data: rnorm(100, mean = 5, sd = 3)
W = 0.9956, p-value = 0.9876
> shapiro.test(runif(100, min = 2, max = 4))
Shapiro-Wilk normality test
data: runif(100, min = 2, max = 4)
W = 0.9309, p-value = 5.616e-05
>
>
>
> cleanEx()
> nameEx("simulate")
> ### * simulate
>
> flush(stderr()); flush(stdout())
>
> ### Name: simulate
> ### Title: Simulate Responses
> ### Aliases: simulate
> ### Keywords: models datagen
>
> ### ** Examples
>
> x <- 1:5
> mod1 <- lm(c(1:3,7,6) ~ x)
> S1 <- simulate(mod1, nsim = 4)
> ## repeat the simulation:
> .Random.seed <- attr(S1, "seed")
> identical(S1, simulate(mod1, nsim = 4))
[1] TRUE
>
> S2 <- simulate(mod1, nsim = 200, seed = 101)
> rowMeans(S2) # should be about
1 2 3 4 5
0.6885691 2.2329771 3.7790352 5.2775859 6.8131451
> fitted(mod1)
1 2 3 4 5
0.8 2.3 3.8 5.3 6.8
>
> ## repeat identically:
> (sseed <- attr(S2, "seed")) # seed; RNGkind as attribute
[1] 101
attr(,"kind")
attr(,"kind")[[1]]
[1] "Mersenne-Twister"
attr(,"kind")[[2]]
[1] "Inversion"
> stopifnot(identical(S2, simulate(mod1, nsim = 200, seed = sseed)))
>
> ## To be sure about the proper RNGkind, e.g., after
> RNGversion("2.7.0")
> ## first set the RNG kind, then simulate
> do.call(RNGkind, attr(sseed, "kind"))
> identical(S2, simulate(mod1, nsim = 200, seed = sseed))
[1] TRUE
>
> ## Binomial GLM examples
> yb1 <- matrix(c(4,4,5,7,8,6,6,5,3,2), ncol = 2)
> modb1 <- glm(yb1 ~ x, family = binomial)
> S3 <- simulate(modb1, nsim = 4)
> # each column of S3 is a two-column matrix.
>
> x2 <- sort(runif(100))
> yb2 <- rbinom(100, prob = plogis(2*(x2-1)), size = 1)
> yb2 <- factor(1 + yb2, labels = c("failure", "success"))
> modb2 <- glm(yb2 ~ x2, family = binomial)
> S4 <- simulate(modb2, nsim = 4)
> # each column of S4 is a factor
>
>
>
> cleanEx()
> nameEx("smooth")
> ### * smooth
>
> flush(stderr()); flush(stdout())
>
> ### Name: smooth
> ### Title: Tukey's (Running Median) Smoothing
> ### Aliases: smooth
> ### Keywords: robust smooth
>
> ### ** Examples
>
> require(graphics)
>
> ## see also demo(smooth) !
>
> x1 <- c(4, 1, 3, 6, 6, 4, 1, 6, 2, 4, 2) # very artificial
> (x3R <- smooth(x1, "3R")) # 2 iterations of "3"
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(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
>
> sm.3RS <- function(x, ...)
+ smooth(smooth(x, "3R", ...), "S", ...)
>
> y <- c(1,1, 19:1)
> plot(y, main = "misbehaviour of \"3RSR\"", col.main = 3)
> lines(sm.3RS(y))
> lines(smooth(y))
> lines(smooth(y, "3RSR"), col = 3, lwd = 2)# the horror
>
> x <- c(8:10,10, 0,0, 9,9)
> plot(x, main = "breakdown of 3R and S and hence 3RSS")
> matlines(cbind(smooth(x,"3R"),smooth(x,"S"), smooth(x,"3RSS"),smooth(x)))
>
> presidents[is.na(presidents)] <- 0 # silly
> 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
> 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
> 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
>
> all.equal(c(sm2),c(smooth(smooth(sm3, "S"), "S"))) # 3RSS === 3R S S
[1] TRUE
> all.equal(c(sm), c(smooth(smooth(sm3, "S"), "3R")))# 3RS3R === 3R S 3R
[1] TRUE
>
> plot(presidents, main = "smooth(presidents0, *) : 3R and default 3RS3R")
> lines(sm3,col = 3, lwd = 1.5)
> lines(sm, col = 2, lwd = 1.25)
>
>
>
> cleanEx()
> nameEx("smooth.spline")
> ### * smooth.spline
>
> flush(stderr()); flush(stdout())
>
> ### Name: smooth.spline
> ### Title: Fit a Smoothing Spline
> ### Aliases: smooth.spline
> ### Keywords: smooth
>
> ### ** Examples
>
> require(graphics)
>
> attach(cars)
> plot(speed, dist, main = "data(cars) & smoothing splines")
> cars.spl <- smooth.spline(speed, dist)
> (cars.spl)
Call:
smooth.spline(x = speed, y = dist)
Smoothing Parameter spar= 0.7801305 lambda= 0.1112206 (11 iterations)
Equivalent Degrees of Freedom (Df): 2.635278
Penalized Criterion: 4187.776
GCV: 244.1044
> ## This example has duplicate points, so avoid cv=TRUE
> ## Don't show:
> stopifnot(cars.spl $ w == table(speed)) # weights = multiplicities
> utils::str(cars.spl, digits=5, vec.len=6)
List of 15
$ x : num [1:19] 4 7 8 9 10 11 12 13 14 15 16 17 18 19 20 ...
$ y : num [1:19] 1.6578 11.6829 15.0644 18.4823 21.9471 25.4656 29.0505 32.7076 ...
$ w : num [1:19] 2 2 1 1 3 2 4 4 4 3 2 3 4 3 5 ...
$ yin : num [1:19] 6 13 16 10 26 22.5 21.5 35 ...
$ data :List of 3
..$ x: num [1:50] 4 4 7 7 8 9 10 10 10 11 11 12 12 12 12 ...
..$ y: num [1:50] 2 10 4 22 16 10 18 26 34 17 28 14 20 24 28 ...
..$ w: num [1:50] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 ...
$ lev : num [1:19] 0.399342 0.179105 0.069771 0.055561 0.136721 0.077539 0.137252 0.126354 ...
$ cv.crit : num 244.1
$ pen.crit: num 4187.8
$ crit : num 244.1
$ df : num 2.6353
$ spar : num 0.78013
$ lambda : num 0.11122
$ iparms : Named int [1:3] 1 0 11
..- attr(*, "names")= chr [1:3] "icrit" "ispar" "iter"
$ fit :List of 5
..$ knot : num [1:25] 0 0 0 0 0.14286 0.19048 0.2381 0.28571 ...
..$ nk : int 21
..$ min : num 4
..$ range: num 21
..$ coef : num [1:21] 1.6578 4.9869 9.4256 15.0584 18.4743 21.9384 25.4544 29.0377 ...
..- attr(*, "class")= chr "smooth.spline.fit"
$ call : language smooth.spline(x = speed, y = dist)
- attr(*, "class")= chr "smooth.spline"
> cars.spl$fit
$knot
[1] 0.0000000 0.0000000 0.0000000 0.0000000 0.1428571 0.1904762 0.2380952
[8] 0.2857143 0.3333333 0.3809524 0.4285714 0.4761905 0.5238095 0.5714286
[15] 0.6190476 0.6666667 0.7142857 0.7619048 0.8571429 0.9047619 0.9523810
[22] 1.0000000 1.0000000 1.0000000 1.0000000
$nk
[1] 21
$min
[1] 4
$range
[1] 21
$coef
[1] 1.657809 4.986889 9.425578 15.058364 18.474307 21.938439 25.454405
[8] 29.037679 32.697985 36.415692 40.180057 44.035086 48.004725 52.097325
[15] 56.299736 62.096055 68.215320 74.524063 79.313459 82.506943 84.103688
attr(,"class")
[1] "smooth.spline.fit"
> ## End Don't show
> lines(cars.spl, col = "blue")
> lines(smooth.spline(speed, dist, df=10), lty=2, col = "red")
> legend(5,120,c(paste("default [C.V.] => df =",round(cars.spl$df,1)),
+ "s( * , df = 10)"), col = c("blue","red"), lty = 1:2,
+ bg='bisque')
> detach()
>
>
> ## Residual (Tukey Anscombe) plot:
> plot(residuals(cars.spl) ~ fitted(cars.spl))
> abline(h = 0, col="gray")
>
> ## consistency check:
> stopifnot(all.equal(cars$dist,
+ fitted(cars.spl) + residuals(cars.spl)))
>
> ##-- artificial example
> y18 <- c(1:3,5,4,7:3,2*(2:5),rep(10,4))
> xx <- seq(1,length(y18), len=201)
> (s2 <- smooth.spline(y18)) # GCV
Call:
smooth.spline(x = y18)
Smoothing Parameter spar= 0.3928105 lambda= 9.672776e-05 (13 iterations)
Equivalent Degrees of Freedom (Df): 8.494168
Penalized Criterion: 3.59204
GCV: 0.7155391
> (s02 <- smooth.spline(y18, spar = 0.2))
Call:
smooth.spline(x = y18, spar = 0.2)
Smoothing Parameter spar= 0.2 lambda= 3.911187e-06
Equivalent Degrees of Freedom (Df): 15.25900
Penalized Criterion: 0.4973656
GCV: 1.191602
> plot(y18, main=deparse(s2$call), col.main=2)
> lines(s2, col = "gray"); lines(predict(s2, xx), col = 2)
> lines(predict(s02, xx), col = 3); mtext(deparse(s02$call), col = 3)
>
>
>
> cleanEx()
> nameEx("smoothEnds")
> ### * smoothEnds
>
> flush(stderr()); flush(stdout())
>
> ### Name: smoothEnds
> ### Title: End Points Smoothing (for Running Medians)
> ### Aliases: smoothEnds
> ### Keywords: smooth robust
>
> ### ** Examples
>
> require(graphics)
>
> y <- ys <- (-20:20)^2
> y [c(1,10,21,41)] <- c(100, 30, 400, 470)
> s7k <- runmed(y,7, endrule = "keep")
> s7. <- runmed(y,7, endrule = "const")
> s7m <- runmed(y,7)
> col3 <- c("midnightblue","blue","steelblue")
> plot(y, main = "Running Medians -- runmed(*, k=7, end.rule = X)")
> lines(ys, col = "light gray")
> matlines(cbind(s7k,s7.,s7m), lwd= 1.5, lty = 1, col = col3)
> legend(1,470, paste("endrule",c("keep","constant","median"),sep=" = "),
+ col = col3, lwd = 1.5, lty = 1)
>
> stopifnot(identical(s7m, smoothEnds(s7k, 7)))
>
>
>
> cleanEx()
> nameEx("sortedXyData")
> ### * sortedXyData
>
> flush(stderr()); flush(stdout())
>
> ### Name: sortedXyData
> ### Title: Create a 'sortedXyData' Object
> ### Aliases: sortedXyData sortedXyData.default
> ### Keywords: manip
>
> ### ** Examples
>
> DNase.2 <- DNase[ DNase$Run == "2", ]
> sortedXyData( expression(log(conc)), expression(density), DNase.2 )
x y
1 -3.0194489 0.0475
2 -1.6331544 0.1300
3 -0.9400073 0.2160
4 -0.2468601 0.3920
5 0.4462871 0.6765
6 1.1394343 1.0970
7 1.8325815 1.5400
8 2.5257286 1.9230
>
>
>
> cleanEx()
> nameEx("spec.ar")
> ### * spec.ar
>
> flush(stderr()); flush(stdout())
>
> ### Name: spec.ar
> ### Title: Estimate Spectral Density of a Time Series from AR Fit
> ### Aliases: spec.ar
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> spec.ar(lh)
>
> spec.ar(ldeaths)
> spec.ar(ldeaths, method="burg")
>
>
>
> cleanEx()
> nameEx("spec.pgram")
> ### * spec.pgram
>
> flush(stderr()); flush(stdout())
>
> ### Name: spec.pgram
> ### Title: Estimate Spectral Density of a Time Series by a Smoothed
> ### Periodogram
> ### Aliases: spec.pgram
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ## Examples from Venables & Ripley
> spectrum(ldeaths)
> spectrum(ldeaths, spans = c(3,5))
> spectrum(ldeaths, spans = c(5,7))
> spectrum(mdeaths, spans = c(3,3))
> spectrum(fdeaths, spans = c(3,3))
>
> ## bivariate example
> mfdeaths.spc <- spec.pgram(ts.union(mdeaths, fdeaths), spans = c(3,3))
> # plots marginal spectra: now plot coherency and phase
> plot(mfdeaths.spc, plot.type = "coherency")
> plot(mfdeaths.spc, plot.type = "phase")
>
> ## now impose a lack of alignment
> mfdeaths.spc <- spec.pgram(ts.intersect(mdeaths, lag(fdeaths, 4)),
+ spans = c(3,3), plot = FALSE)
> plot(mfdeaths.spc, plot.type = "coherency")
> plot(mfdeaths.spc, plot.type = "phase")
>
> stocks.spc <- spectrum(EuStockMarkets, kernel("daniell", c(30,50)),
+ plot = FALSE)
> plot(stocks.spc, plot.type = "marginal") # the default type
> plot(stocks.spc, plot.type = "coherency")
> plot(stocks.spc, plot.type = "phase")
>
> sales.spc <- spectrum(ts.union(BJsales, BJsales.lead),
+ kernel("modified.daniell", c(5,7)))
> plot(sales.spc, plot.type = "coherency")
> plot(sales.spc, plot.type = "phase")
>
>
>
> cleanEx()
> nameEx("spectrum")
> ### * spectrum
>
> flush(stderr()); flush(stdout())
>
> ### Name: spectrum
> ### Title: Spectral Density Estimation
> ### Aliases: spectrum spec
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ## Examples from Venables & Ripley
> ## spec.pgram
> par(mfrow=c(2,2))
> spectrum(lh)
> spectrum(lh, spans=3)
> spectrum(lh, spans=c(3,3))
> spectrum(lh, spans=c(3,5))
>
> spectrum(ldeaths)
> spectrum(ldeaths, spans=c(3,3))
> spectrum(ldeaths, spans=c(3,5))
> spectrum(ldeaths, spans=c(5,7))
> spectrum(ldeaths, spans=c(5,7), log="dB", ci=0.8)
>
> # for multivariate examples see the help for spec.pgram
>
> ## spec.ar
> spectrum(lh, method="ar")
> spectrum(ldeaths, method="ar")
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("splinefun")
> ### * splinefun
>
> flush(stderr()); flush(stdout())
>
> ### Name: splinefun
> ### Title: Interpolating Splines
> ### Aliases: spline splinefun splinefunH
> ### Keywords: math dplot
>
> ### ** Examples
>
> require(graphics)
>
> op <- par(mfrow = c(2,1), mgp = c(2,.8,0), mar = .1+c(3,3,3,1))
> n <- 9
> x <- 1:n
> y <- rnorm(n)
> plot(x, y, main = paste("spline[fun](.) through", n, "points"))
> lines(spline(x, y))
> lines(spline(x, y, n = 201), col = 2)
>
> y <- (x-6)^2
> plot(x, y, main = "spline(.) -- 3 methods")
> lines(spline(x, y, n = 201), col = 2)
> lines(spline(x, y, n = 201, method = "natural"), col = 3)
> lines(spline(x, y, n = 201, method = "periodic"), col = 4)
Warning in spline(x, y, n = 201, method = "periodic") :
spline: first and last y values differ - using y[1] for both
> legend(6,25, c("fmm","natural","periodic"), col=2:4, lty=1)
>
> y <- sin((x-0.5)*pi)
> f <- splinefun(x, y)
> ls(envir = environment(f))
[1] "z"
> splinecoef <- get("z", envir = environment(f))
> curve(f(x), 1, 10, col = "green", lwd = 1.5)
> points(splinecoef, col = "purple", cex = 2)
> curve(f(x, deriv=1), 1, 10, col = 2, lwd = 1.5)
> curve(f(x, deriv=2), 1, 10, col = 2, lwd = 1.5, n = 401)
> curve(f(x, deriv=3), 1, 10, col = 2, lwd = 1.5, n = 401)
> par(op)
>
> ## Manual spline evaluation --- demo the coefficients :
> .x <- splinecoef$x
> u <- seq(3,6, by = 0.25)
> (ii <- findInterval(u, .x))
[1] 3 3 3 3 4 4 4 4 5 5 5 5 6
> dx <- u - .x[ii]
> f.u <- with(splinecoef,
+ y[ii] + dx*(b[ii] + dx*(c[ii] + dx* d[ii])))
> stopifnot(all.equal(f(u), f.u))
>
> ## An example with ties (non-unique x values):
> set.seed(1); x <- round(rnorm(30), 1); y <- sin(pi * x) + rnorm(30)/10
> plot(x,y, main="spline(x,y) when x has ties")
> lines(spline(x,y, n= 201), col = 2)
> ## visualizes the non-unique ones:
> tx <- table(x); mx <- as.numeric(names(tx[tx > 1]))
> ry <- matrix(unlist(tapply(y, match(x,mx), range, simplify=FALSE)),
+ ncol=2, byrow=TRUE)
> segments(mx, ry[,1], mx, ry[,2], col = "blue", lwd = 2)
>
> ## An example of monotone interpolation
> n <- 20
> set.seed(11)
> x. <- sort(runif(n)) ; y. <- cumsum(abs(rnorm(n)))
> plot(x.,y.)
> curve(splinefun(x.,y.)(x), add=TRUE, col=2, n=1001)
> curve(splinefun(x.,y., method="mono")(x), add=TRUE, col=3, n=1001)
> legend("topleft", paste("splinefun( \"", c("fmm", "monoH.CS"), "\" )", sep=''),
+ col=2:3, lty=1)
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("stat.anova")
> ### * stat.anova
>
> flush(stderr()); flush(stdout())
>
> ### Name: stat.anova
> ### Title: GLM Anova Statistics
> ### Aliases: stat.anova
> ### Keywords: regression models
>
> ### ** Examples
>
> ##-- Continued from '?glm':
> ## Don't show:
> utils::example("glm", echo = FALSE)
treatment outcome counts
1 1 1 18
2 1 2 17
3 1 3 15
4 2 1 20
5 2 2 10
6 2 3 20
7 3 1 25
8 3 2 13
9 3 3 12
> ## End Don't show
> print(ag <- anova(glm.D93))
Analysis of Deviance Table
Model: poisson, link: log
Response: counts
Terms added sequentially (first to last)
Df Deviance Resid. Df Resid. Dev
NULL 8 10.5814
outcome 2 5.4523 6 5.1291
treatment 2 0.0000 4 5.1291
> stat.anova(ag$table, test = "Cp",
+ scale = sum(resid(glm.D93, "pearson")^2)/4,
+ df.scale = 4, n = 9)
table Cp
>
>
>
> cleanEx()
> nameEx("step")
> ### * step
>
> flush(stderr()); flush(stdout())
>
> ### Name: step
> ### Title: Choose a model by AIC in a Stepwise Algorithm
> ### Aliases: step
> ### Keywords: models
>
> ### ** Examples
>
> utils::example(lm)
lm> require(graphics)
lm> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models".
lm> ## Page 9: Plant Weight Data.
lm> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
lm> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
lm> group <- gl(2,10,20, labels=c("Ctl","Trt"))
lm> weight <- c(ctl, trt)
lm> anova(lm.D9 <- lm(weight ~ group))
Analysis of Variance Table
Response: weight
Df Sum Sq Mean Sq F value Pr(>F)
group 1 0.6882 0.68820 1.4191 0.249
Residuals 18 8.7292 0.48496
lm> summary(lm.D90 <- lm(weight ~ group - 1))# omitting intercept
Call:
lm(formula = weight ~ group - 1)
Residuals:
Min 1Q Median 3Q Max
-1.0710 -0.4938 0.0685 0.2462 1.3690
Coefficients:
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.0320 0.2202 22.85 9.55e-15 ***
groupTrt 4.6610 0.2202 21.16 3.62e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.6964 on 18 degrees of freedom
Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798
F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16
lm> opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
lm> plot(lm.D9, las = 1) # Residuals, Fitted, ...
lm> par(opar)
lm> ## model frame :
lm> stopifnot(identical(lm(weight ~ group, method = "model.frame"),
lm+ model.frame(lm.D9)))
lm> ### less simple examples in "See Also" above
lm>
lm>
lm>
> step(lm.D9)
Start: AIC=-12.58
weight ~ group
Df Sum of Sq RSS AIC
- group 1 0.6882 9.4175 -13.063
<none> 8.7292 -12.581
Step: AIC=-13.06
weight ~ 1
Call:
lm(formula = weight ~ 1)
Coefficients:
(Intercept)
4.847
>
> summary(lm1 <- lm(Fertility ~ ., data = swiss))
Call:
lm(formula = Fertility ~ ., data = swiss)
Residuals:
Min 1Q Median 3Q Max
-15.2743 -5.2617 0.5032 4.1198 15.3213
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 66.91518 10.70604 6.250 1.91e-07 ***
Agriculture -0.17211 0.07030 -2.448 0.01873 *
Examination -0.25801 0.25388 -1.016 0.31546
Education -0.87094 0.18303 -4.758 2.43e-05 ***
Catholic 0.10412 0.03526 2.953 0.00519 **
Infant.Mortality 1.07705 0.38172 2.822 0.00734 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 7.165 on 41 degrees of freedom
Multiple R-squared: 0.7067, Adjusted R-squared: 0.671
F-statistic: 19.76 on 5 and 41 DF, p-value: 5.594e-10
> slm1 <- step(lm1)
Start: AIC=190.69
Fertility ~ Agriculture + Examination + Education + Catholic +
Infant.Mortality
Df Sum of Sq RSS AIC
- Examination 1 53.03 2158.1 189.86
<none> 2105.0 190.69
- Agriculture 1 307.72 2412.8 195.10
- Infant.Mortality 1 408.75 2513.8 197.03
- Catholic 1 447.71 2552.8 197.75
- Education 1 1162.56 3267.6 209.36
Step: AIC=189.86
Fertility ~ Agriculture + Education + Catholic + Infant.Mortality
Df Sum of Sq RSS AIC
<none> 2158.1 189.86
- Agriculture 1 264.18 2422.2 193.29
- Infant.Mortality 1 409.81 2567.9 196.03
- Catholic 1 956.57 3114.6 205.10
- Education 1 2249.97 4408.0 221.43
> summary(slm1)
Call:
lm(formula = Fertility ~ Agriculture + Education + Catholic +
Infant.Mortality, data = swiss)
Residuals:
Min 1Q Median 3Q Max
-14.6765 -6.0522 0.7514 3.1664 16.1422
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 62.10131 9.60489 6.466 8.49e-08 ***
Agriculture -0.15462 0.06819 -2.267 0.02857 *
Education -0.98026 0.14814 -6.617 5.14e-08 ***
Catholic 0.12467 0.02889 4.315 9.50e-05 ***
Infant.Mortality 1.07844 0.38187 2.824 0.00722 **
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 7.168 on 42 degrees of freedom
Multiple R-squared: 0.6993, Adjusted R-squared: 0.6707
F-statistic: 24.42 on 4 and 42 DF, p-value: 1.717e-10
> slm1$anova
Step Df Deviance Resid. Df Resid. Dev AIC
1 NA NA 41 2105.043 190.6913
2 - Examination 1 53.02656 42 2158.069 189.8606
>
>
>
> cleanEx()
> nameEx("stepfun")
> ### * stepfun
>
> flush(stderr()); flush(stdout())
>
> ### Name: stepfun
> ### Title: Step Function Class
> ### Aliases: stepfun is.stepfun as.stepfun print.stepfun summary.stepfun
> ### knots
> ### Keywords: dplot
>
> ### ** Examples
>
> y0 <- c(1.,2.,4.,3.)
> sfun0 <- stepfun(1:3, y0, f = 0)
> sfun.2 <- stepfun(1:3, y0, f = .2)
> sfun1 <- stepfun(1:3, y0, f = 1)
> sfun1c <- stepfun(1:3, y0, right=TRUE)# hence f=1
> sfun0
Step function
Call: stepfun(1:3, y0, f = 0)
x[1:3] = 1, 2, 3
4 plateau levels = 1, 2, 4, 3
> summary(sfun0)
Step function with continuity 'f'= 0 , 3 knots at
[1] 1 2 3
and 4 plateau levels (y) at
[1] 1 2 4 3
> summary(sfun.2)
Step function with continuity 'f'= 0.2 , 3 knots at
[1] 1 2 3
and 4 plateau levels (y) at
[1] 1 2 4 3
>
> ## look at the internal structure:
> unclass(sfun0)
function (v)
.C("R_approxfun", as.double(x), as.double(y), as.integer(n),
xout = as.double(v), as.integer(length(v)), as.integer(method),
as.double(yleft), as.double(yright), as.double(f), NAOK = TRUE,
PACKAGE = "stats")$xout
<environment: 0x51e66e8>
attr(,"call")
stepfun(1:3, y0, f = 0)
> ls(envir = environment(sfun0))
[1] "f" "method" "n" "x" "y" "yleft" "yright"
>
> x0 <- seq(0.5,3.5, by = 0.25)
> rbind(x=x0, f.f0 = sfun0(x0), f.f02= sfun.2(x0),
+ f.f1 = sfun1(x0), f.f1c = sfun1c(x0))
[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
x 0.5 0.75 1 1.25 1.5 1.75 2 2.25 2.5 2.75 3 3.25 3.5
f.f0 1.0 1.00 2 2.00 2.0 2.00 4 4.00 4.0 4.00 3 3.00 3.0
f.f02 1.0 1.00 2 2.40 2.4 2.40 4 3.80 3.8 3.80 3 3.00 3.0
f.f1 1.0 1.00 2 4.00 4.0 4.00 4 3.00 3.0 3.00 3 3.00 3.0
f.f1c 1.0 1.00 1 2.00 2.0 2.00 2 4.00 4.0 4.00 4 3.00 3.0
> ## Identities :
> stopifnot(identical(y0[-1], sfun0 (1:3)),# right = FALSE
+ identical(y0[-4], sfun1c(1:3)))# right = TRUE
>
>
>
> cleanEx()
> nameEx("stl")
> ### * stl
>
> flush(stderr()); flush(stdout())
>
> ### Name: stl
> ### Title: Seasonal Decomposition of Time Series by Loess
> ### Aliases: stl
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> plot(stl(nottem, "per"))
> plot(stl(nottem, s.window = 4, t.window = 50, t.jump = 1))
>
> plot(stllc <- stl(log(co2), s.window=21))
> summary(stllc)
Call:
stl(x = log(co2), s.window = 21)
Time.series components:
seasonal trend remainder
Min. :-9.939103e-03 Min. :5.753541 Min. :-2.255405e-03
1st Qu.:-4.536535e-03 1st Qu.:5.778556 1st Qu.:-4.586796e-04
Median : 8.777611e-04 Median :5.815125 Median :-8.867395e-06
Mean :-1.304469e-06 Mean :5.819267 Mean :-1.965549e-06
3rd Qu.: 4.997747e-03 3rd Qu.:5.859806 3rd Qu.: 4.023465e-04
Max. : 9.114691e-03 Max. :5.898750 Max. : 1.939626e-03
IQR:
STL.seasonal STL.trend STL.remainder data
0.009534 0.081250 0.000861 0.079370
% 12.0 102.4 1.1 100.0
Weights: all == 1
Other components: List of 5
$ win : Named num [1:3] 21 21 13
$ deg : Named int [1:3] 0 1 1
$ jump : Named num [1:3] 3 3 2
$ inner: int 2
$ outer: int 0
> ## linear trend, strict period.
> plot(stl(log(co2), s.window="per", t.window=1000))
>
> ## Two STL plotted side by side :
> stmd <- stl(mdeaths, s.window = "per") # non-robust
> summary(stmR <- stl(mdeaths, s.window = "per", robust = TRUE))
Call:
stl(x = mdeaths, s.window = "per", robust = TRUE)
Time.series components:
seasonal trend remainder
Min. :-4.468302e+02 Min. :1318.650 Min. :-314.583544
1st Qu.:-3.015726e+02 1st Qu.:1432.208 1st Qu.: -32.539250
Median :-7.905613e+01 Median :1448.891 Median : 5.794267
Mean :-2.497770e-06 Mean :1472.880 Mean : 23.064626
3rd Qu.: 3.045673e+02 3rd Qu.:1548.974 3rd Qu.: 47.513361
Max. : 5.447904e+02 Max. :1615.535 Max. : 872.199161
IQR:
STL.seasonal STL.trend STL.remainder data
606.14 116.77 80.05 707.75
% 85.6 16.5 11.3 100.0
Weights:
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0000000 0.5594126 0.9451991 0.7312186 0.9853375 1.0000000
Other components: List of 5
$ win : Named num [1:3] 721 19 13
$ deg : Named int [1:3] 0 1 1
$ jump : Named num [1:3] 73 2 2
$ inner: int 1
$ outer: int 15
> op <- par(mar = c(0, 4, 0, 3), oma = c(5, 0, 4, 0), mfcol = c(4, 2))
> plot(stmd, set.pars=NULL, labels = NULL,
+ main = "stl(mdeaths, s.w = \"per\", robust = FALSE / TRUE )")
> plot(stmR, set.pars=NULL)
> # mark the 'outliers' :
> (iO <- which(stmR $ weights < 1e-8)) # 10 were considered outliers
[1] 24 26 27 28 36 37 50 52 59 61
> sts <- stmR$time.series
> points(time(sts)[iO], 0.8* sts[,"remainder"][iO], pch = 4, col = "red")
> par(op)# reset
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("summary.aov")
> ### * summary.aov
>
> flush(stderr()); flush(stdout())
>
> ### Name: summary.aov
> ### Title: Summarize an Analysis of Variance Model
> ### Aliases: summary.aov summary.aovlist print.summary.aov
> ### print.summary.aovlist
> ### Keywords: models regression
>
> ### ** Examples
>
> ## For a simple example see example(aov)
>
> # Cochran and Cox (1957, p.164)
> # 3x3 factorial with ordered factors, each is average of 12.
> CC <- data.frame(
+ y = c(449, 413, 326, 409, 358, 291, 341, 278, 312)/12,
+ P = ordered(gl(3, 3)), N = ordered(gl(3, 1, 9))
+ )
> CC.aov <- aov(y ~ N * P, data = CC , weights = rep(12, 9))
> summary(CC.aov)
Df Sum Sq Mean Sq
N 2 1016.67 508.33
P 2 917.39 458.69
N:P 4 399.28 99.82
>
> # Split both main effects into linear and quadratic parts.
> summary(CC.aov, split = list(N = list(L = 1, Q = 2),
+ P = list(L = 1, Q = 2)))
Df Sum Sq Mean Sq
N 2 1016.67 508.33
N: L 1 1012.50 1012.50
N: Q 1 4.17 4.17
P 2 917.39 458.69
P: L 1 917.35 917.35
P: Q 1 0.04 0.04
N:P 4 399.28 99.82
N:P: L.L 1 184.08 184.08
N:P: Q.L 1 152.11 152.11
N:P: L.Q 1 49.00 49.00
N:P: Q.Q 1 14.08 14.08
>
> # Split only the interaction
> summary(CC.aov, split = list("N:P" = list(L.L = 1, Q = 2:4)))
Df Sum Sq Mean Sq
N 2 1016.67 508.33
P 2 917.39 458.69
N:P 4 399.28 99.82
N:P: L.L 1 184.08 184.08
N:P: Q 3 215.19 71.73
>
> # split on just one var
> summary(CC.aov, split = list(P = list(lin = 1, quad = 2)))
Df Sum Sq Mean Sq
N 2 1016.67 508.33
P 2 917.39 458.69
P: lin 1 917.35 917.35
P: quad 1 0.04 0.04
N:P 4 399.28 99.82
N:P: lin 2 336.19 168.10
N:P: quad 2 63.08 31.54
> summary(CC.aov, split = list(P = list(lin = 1, quad = 2)),
+ expand.split=FALSE)
Df Sum Sq Mean Sq
N 2 1016.67 508.33
P 2 917.39 458.69
P: lin 1 917.35 917.35
P: quad 1 0.04 0.04
N:P 4 399.28 99.82
>
>
> cleanEx()
> nameEx("summary.glm")
> ### * summary.glm
>
> flush(stderr()); flush(stdout())
>
> ### Name: summary.glm
> ### Title: Summarizing Generalized Linear Model Fits
> ### Aliases: summary.glm print.summary.glm
> ### Keywords: models regression
>
> ### ** Examples
>
> ## For examples see example(glm)
>
>
>
> cleanEx()
> nameEx("summary.lm")
> ### * summary.lm
>
> flush(stderr()); flush(stdout())
>
> ### Name: summary.lm
> ### Title: Summarizing Linear Model Fits
> ### Aliases: summary.lm summary.mlm print.summary.lm
> ### Keywords: regression models
>
> ### ** Examples
>
> ## Don't show:
> utils::example("lm", echo = FALSE)
> ## End Don't show
> ##-- Continuing the lm(.) example:
> coef(lm.D90)# the bare coefficients
groupCtl groupTrt
5.032 4.661
> sld90 <- summary(lm.D90 <- lm(weight ~ group -1))# omitting intercept
> sld90
Call:
lm(formula = weight ~ group - 1)
Residuals:
Min 1Q Median 3Q Max
-1.0710 -0.4938 0.0685 0.2462 1.3690
Coefficients:
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.0320 0.2202 22.85 9.55e-15 ***
groupTrt 4.6610 0.2202 21.16 3.62e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.6964 on 18 degrees of freedom
Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798
F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16
> coef(sld90)# much more
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.032 0.2202177 22.85012 9.547128e-15
groupTrt 4.661 0.2202177 21.16542 3.615345e-14
>
>
>
> cleanEx()
> nameEx("summary.manova")
> ### * summary.manova
>
> flush(stderr()); flush(stdout())
>
> ### Name: summary.manova
> ### Title: Summary Method for Multivariate Analysis of Variance
> ### Aliases: summary.manova print.summary.manova
> ### Keywords: models
>
> ### ** Examples
>
> ## Example on producing plastic film from Krzanowski (1998, p. 381)
> tear <- c(6.5, 6.2, 5.8, 6.5, 6.5, 6.9, 7.2, 6.9, 6.1, 6.3,
+ 6.7, 6.6, 7.2, 7.1, 6.8, 7.1, 7.0, 7.2, 7.5, 7.6)
> gloss <- c(9.5, 9.9, 9.6, 9.6, 9.2, 9.1, 10.0, 9.9, 9.5, 9.4,
+ 9.1, 9.3, 8.3, 8.4, 8.5, 9.2, 8.8, 9.7, 10.1, 9.2)
> opacity <- c(4.4, 6.4, 3.0, 4.1, 0.8, 5.7, 2.0, 3.9, 1.9, 5.7,
+ 2.8, 4.1, 3.8, 1.6, 3.4, 8.4, 5.2, 6.9, 2.7, 1.9)
> Y <- cbind(tear, gloss, opacity)
> rate <- factor(gl(2,10), labels=c("Low", "High"))
> additive <- factor(gl(2, 5, length=20), labels=c("Low", "High"))
>
> fit <- manova(Y ~ rate * additive)
> summary.aov(fit) # univariate ANOVA tables
Response tear :
Df Sum Sq Mean Sq F value Pr(>F)
rate 1 1.7405 1.74050 15.7868 0.001092 **
additive 1 0.7605 0.76050 6.8980 0.018330 *
rate:additive 1 0.0005 0.00050 0.0045 0.947143
Residuals 16 1.7640 0.11025
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Response gloss :
Df Sum Sq Mean Sq F value Pr(>F)
rate 1 1.3005 1.30050 7.9178 0.01248 *
additive 1 0.6125 0.61250 3.7291 0.07139 .
rate:additive 1 0.5445 0.54450 3.3151 0.08740 .
Residuals 16 2.6280 0.16425
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Response opacity :
Df Sum Sq Mean Sq F value Pr(>F)
rate 1 0.421 0.4205 0.1036 0.7517
additive 1 4.901 4.9005 1.2077 0.2881
rate:additive 1 3.960 3.9605 0.9760 0.3379
Residuals 16 64.924 4.0578
> summary(fit, test="Wilks") # ANOVA table of Wilks' lambda
Df Wilks approx F num Df den Df Pr(>F)
rate 1 0.38186 7.5543 3 14 0.003034 **
additive 1 0.52303 4.2556 3 14 0.024745 *
rate:additive 1 0.77711 1.3385 3 14 0.301782
Residuals 16
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> summary(fit) # same F statistics as single-df terms
Df Pillai approx F num Df den Df Pr(>F)
rate 1 0.61814 7.5543 3 14 0.003034 **
additive 1 0.47697 4.2556 3 14 0.024745 *
rate:additive 1 0.22289 1.3385 3 14 0.301782
Residuals 16
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>
>
>
> cleanEx()
> nameEx("summary.princomp")
> ### * summary.princomp
>
> flush(stderr()); flush(stdout())
>
> ### Name: summary.princomp
> ### Title: Summary method for Principal Components Analysis
> ### Aliases: summary.princomp print.summary.princomp
> ### Keywords: multivariate
>
> ### ** Examples
>
> summary(pc.cr <- princomp(USArrests, cor=TRUE))
Importance of components:
Comp.1 Comp.2 Comp.3 Comp.4
Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938
Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752
Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000
> print(summary(princomp(USArrests, cor=TRUE),
+ loadings = TRUE, cutoff = 0.2), digits = 2)
Importance of components:
Comp.1 Comp.2 Comp.3 Comp.4
Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938
Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752
Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000
Loadings:
Comp.1 Comp.2 Comp.3 Comp.4
Murder -0.54 0.42 -0.34 0.65
Assault -0.58 -0.27 -0.74
UrbanPop -0.28 -0.87 -0.38
Rape -0.54 0.82
>
>
>
> cleanEx()
> nameEx("supsmu")
> ### * supsmu
>
> flush(stderr()); flush(stdout())
>
> ### Name: supsmu
> ### Title: Friedman's SuperSmoother
> ### Aliases: supsmu
> ### Keywords: smooth
>
> ### ** Examples
>
> require(graphics)
>
> with(cars, {
+ plot(speed, dist)
+ lines(supsmu(speed, dist))
+ lines(supsmu(speed, dist, bass = 7), lty = 2)
+ })
>
>
>
> cleanEx()
> nameEx("symnum")
> ### * symnum
>
> flush(stderr()); flush(stdout())
>
> ### Name: symnum
> ### Title: Symbolic Number Coding
> ### Aliases: symnum
> ### Keywords: utilities character
>
> ### ** Examples
>
> ii <- 0:8; names(ii) <- ii
> symnum(ii, cut= 2*(0:4), sym = c(".", "-", "+", "$"))
0 1 2 3 4 5 6 7 8
. . . - - + + $ $
attr(,"legend")
[1] 0 ‘.’ 2 ‘-’ 4 ‘+’ 6 ‘$’ 8
> symnum(ii, cut= 2*(0:4), sym = c(".", "-", "+", "$"), show.max=TRUE)
0 1 2 3 4 5 6 7 8
. . . - - + + $ 8
attr(,"legend")
[1] 0 ‘.’ 2 ‘-’ 4 ‘+’ 6 ‘$’ 8
>
> symnum(1:12 %% 3 == 0)# --> "|" = TRUE, "." = FALSE for logical
[1] . . | . . | . . | . . |
>
> ## Pascal's Triangle modulo 2 -- odd and even numbers:
> N <- 38
> pascal <- t(sapply(0:N, function(n) round(choose(n, 0:N - (N-n)%/%2))))
> rownames(pascal) <- rep("", 1+N) # <-- to improve "graphic"
> symnum(pascal %% 2, symbols = c(" ", "A"), numeric = FALSE)
A
A A
A A
A A A A
A A
A A A A
A A A A
A A A A A A A A
A A
A A A A
A A A A
A A A A A A A A
A A A A
A A A A A A A A
A A A A A A A A
A A A A A A A A A A A A A A A A
A A
A A A A
A A A A
A A A A A A A A
A A A A
A A A A A A A A
A A A A A A A A
A A A A A A A A A A A A A A A A
A A A A
A A A A A A A A
A A A A A A A A
A A A A A A A A A A A A A A A A
A A A A A A A A
A A A A A A A A A A A A A A A A
A A A A A A A A A A A A A A A A
A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A
A A
A A A A
A A A A
A A A A A A A A
A A A A
A A A A A A A A
A A A A A A A A
>
> ##-- Symbolic correlation matrices:
> symnum(cor(attitude), diag = FALSE)
rt cm p l rs cr a
rating
complaints +
privileges . .
learning , . .
raises . , . ,
critical .
advance . . .
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cor(attitude), abbr.= NULL)
rating 1
complaints + 1
privileges . . 1
learning , . . 1
raises . , . , 1
critical . 1
advance . . . 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cor(attitude), abbr.= FALSE)
rating complaints privileges learning raises critical advance
rating 1
complaints + 1
privileges . . 1
learning , . . 1
raises . , . , 1
critical . 1
advance . . . 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cor(attitude), abbr.= 2)
rt cm pr lr rs cr ad
rating 1
complaints + 1
privileges . . 1
learning , . . 1
raises . , . , 1
critical . 1
advance . . . 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
>
> symnum(cor(rbind(1, rnorm(25), rnorm(25)^2)))
[1,] 1
[2,] + 1
[3,] . 1
[4,] . B 1
[5,] + B 1
[6,] . B B 1
[7,] , * . . * 1
[8,] . + . , + . B 1
[9,] . + . , * . B B 1
[10,] . B B B . . . 1
[11,] B B . * . , , B 1
[12,] , B . B B + * . 1
[13,] 1 + . . + . , . . . , 1
[14,] , . * + B * + , 1
[15,] . * B . + , + , * B . , 1
[16,] * B B + , , * * . 1
[17,] * B B + , , * * . B 1
[18,] , , + , , * B * , + , . * . . 1
[19,] . + , , + . B B B , + + . . + , , B 1
[20,] + B B B + * . B + . B B , + 1
[21,] , , + , , * B B , + + . * . . B B , 1
[22,] . , , , + . B B B , + + . . + , , B B + B 1
[23,] B , , . , , . . , . , B + + + , 1
[24,] * , , . , , . , . . * * . , , . B 1
[25,] B + . . + . , . . . , B , * * . + . B B 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cor(matrix(rexp(30, 1), 5, 18))) # <<-- PATTERN ! --
[1,] 1
[2,] . 1
[3,] 1
[4,] . . 1
[5,] , . 1
[6,] , , 1
[7,] 1 . . 1
[8,] . 1 . , , . 1
[9,] 1 . 1
[10,] . . 1 . . 1
[11,] , . 1 , , . 1
[12,] , , 1 , , 1
[13,] 1 . . 1 . . 1
[14,] . 1 . , , . 1 . , , . 1
[15,] 1 . 1 . 1
[16,] . . 1 . . 1 . . 1
[17,] , . 1 , , . 1 , , . 1
[18,] , , 1 , , 1 , , 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cm1 <- cor(matrix(rnorm(90) , 5, 18))) # < White Noise SMALL n
[1,] 1
[2,] . 1
[3,] . . 1
[4,] , , 1
[5,] . , 1
[6,] . * * 1
[7,] , . . . 1
[8,] , . . 1
[9,] . . . . . . 1
[10,] , . . . B . 1
[11,] , + . + + , . 1
[12,] , + + * . . , 1
[13,] . + + , + . 1
[14,] . . . + , , 1
[15,] . . . . . . + 1
[16,] . , . . . . . . 1
[17,] , + , + . . * . . 1
[18,] . . * , . . . , , . . 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cm1, diag=FALSE)
[1,]
[2,] .
[3,] . .
[4,] , ,
[5,] . ,
[6,] . * *
[7,] , . . .
[8,] , . .
[9,] . . . . . .
[10,] , . . . B .
[11,] , + . + + , .
[12,] , + + * . . ,
[13,] . + + , + .
[14,] . . . + , ,
[15,] . . . . . . +
[16,] . , . . . . . .
[17,] , + , + . . * . .
[18,] . . * , . . . , , . .
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cm2 <- cor(matrix(rnorm(900), 50, 18))) # < White Noise "BIG" n
[1,] 1
[2,] 1
[3,] 1
[4,] 1
[5,] 1
[6,] 1
[7,] 1
[8,] 1
[9,] 1
[10,] 1
[11,] 1
[12,] 1
[13,] . . 1
[14,] 1
[15,] 1
[16,] 1
[17,] 1
[18,] 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
> symnum(cm2, lower=FALSE)
[1,] 1
[2,] 1
[3,] 1
[4,] 1
[5,] 1
[6,] 1
[7,] 1
[8,] 1 .
[9,] 1
[10,] 1
[11,] 1 .
[12,] 1
[13,] . . 1
[14,] 1
[15,] 1
[16,] 1
[17,] 1
[18,] 1
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1
>
> ## NA's:
> Cm <- cor(matrix(rnorm(60), 10, 6)); Cm[c(3,6), 2] <- NA
> symnum(Cm, show.max=NULL)
[1,]
[2,]
[3,] . ?
[4,] . ,
[5,] .
[6,] , ?
attr(,"legend")
[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 \t ## NA: ‘?’
>
> ## Graphical P-values (aka "significance stars"):
> pval <- rev(sort(c(outer(1:6, 10^-(1:3)))))
> symp <- symnum(pval, corr=FALSE,
+ cutpoints = c(0, .001,.01,.05, .1, 1),
+ symbols = c("***","**","*","."," "))
> noquote(cbind(P.val = format(pval), Signif= symp))
P.val Signif
[1,] 0.600
[2,] 0.500
[3,] 0.400
[4,] 0.300
[5,] 0.200
[6,] 0.100 .
[7,] 0.060 .
[8,] 0.050 *
[9,] 0.040 *
[10,] 0.030 *
[11,] 0.020 *
[12,] 0.010 **
[13,] 0.006 **
[14,] 0.005 **
[15,] 0.004 **
[16,] 0.003 **
[17,] 0.002 **
[18,] 0.001 ***
>
>
>
> cleanEx()
> nameEx("t.test")
> ### * t.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: t.test
> ### Title: Student's t-Test
> ### Aliases: t.test t.test.default t.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> require(graphics)
>
> t.test(1:10,y=c(7:20)) # P = .00001855
Welch Two Sample t-test
data: 1:10 and c(7:20)
t = -5.4349, df = 21.982, p-value = 1.855e-05
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-11.052802 -4.947198
sample estimates:
mean of x mean of y
5.5 13.5
> t.test(1:10,y=c(7:20, 200)) # P = .1245 -- NOT significant anymore
Welch Two Sample t-test
data: 1:10 and c(7:20, 200)
t = -1.6329, df = 14.165, p-value = 0.1245
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-47.242900 6.376233
sample estimates:
mean of x mean of y
5.50000 25.93333
>
> ## Classical example: Student's sleep data
> plot(extra ~ group, data = sleep)
> ## Traditional interface
> with(sleep, t.test(extra[group == 1], extra[group == 2]))
Welch Two Sample t-test
data: extra[group == 1] and extra[group == 2]
t = -1.8608, df = 17.776, p-value = 0.0794
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-3.3654832 0.2054832
sample estimates:
mean of x mean of y
0.75 2.33
> ## Formula interface
> t.test(extra ~ group, data = sleep)
Welch Two Sample t-test
data: extra by group
t = -1.8608, df = 17.776, p-value = 0.0794
alternative hypothesis: true difference in means is not equal to 0
95 percent confidence interval:
-3.3654832 0.2054832
sample estimates:
mean in group 1 mean in group 2
0.75 2.33
>
>
>
> cleanEx()
> nameEx("termplot")
> ### * termplot
>
> flush(stderr()); flush(stdout())
>
> ### Name: termplot
> ### Title: Plot Regression Terms
> ### Aliases: termplot
> ### Keywords: hplot regression
>
> ### ** Examples
>
> require(graphics)
>
> had.splines <- "package:splines" %in% search()
> if(!had.splines) rs <- require(splines)
Loading required package: splines
> x <- 1:100
> z <- factor(rep(LETTERS[1:4],25))
> y <- rnorm(100, sin(x/10)+as.numeric(z))
> model <- glm(y ~ ns(x,6) + z)
>
> par(mfrow=c(2,2)) ## 2 x 2 plots for same model :
> termplot(model, main = paste("termplot( ", deparse(model$call)," ...)"))
> termplot(model, rug=TRUE)
> termplot(model, partial.resid=TRUE, se = TRUE, main = TRUE)
> termplot(model, partial.resid=TRUE, smooth=panel.smooth, span.smth=1/4)
> if(!had.splines && rs) detach("package:splines")
>
>
>
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("terms.object")
> ### * terms.object
>
> flush(stderr()); flush(stdout())
>
> ### Name: terms.object
> ### Title: Description of Terms Objects
> ### Aliases: terms.object
> ### Keywords: models
>
> ### ** Examples
>
> ## use of specials (as used for gam() in packages mgcv and gam)
> (tf <- terms(y ~ x + x:z + s(x), specials = "s"))
y ~ x + x:z + s(x)
attr(,"variables")
list(y, x, z, s(x))
attr(,"factors")
x s(x) x:z
y 0 0 0
x 1 0 2
z 0 0 1
s(x) 0 1 0
attr(,"term.labels")
[1] "x" "s(x)" "x:z"
attr(,"specials")
attr(,"specials")$s
[1] 4
attr(,"order")
[1] 1 1 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> ## Note that the "factors" attribute has variables as row names
> ## and term labels as column names, both as character vectors.
> attr(tf, "specials") # index 's' variable(s)
$s
[1] 4
> rownames(attr(tf, "factors"))[attr(tf, "specials")$s]
[1] "s(x)"
>
> ## we can keep the order by
> terms(y ~ x + x:z + s(x), specials = "s", keep.order = TRUE)
y ~ x + x:z + s(x)
attr(,"variables")
list(y, x, z, s(x))
attr(,"factors")
x x:z s(x)
y 0 0 0
x 1 2 0
z 0 1 0
s(x) 0 0 1
attr(,"term.labels")
[1] "x" "x:z" "s(x)"
attr(,"specials")
attr(,"specials")$s
[1] 4
attr(,"order")
[1] 1 2 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
>
>
>
> cleanEx()
> nameEx("time")
> ### * time
>
> flush(stderr()); flush(stdout())
>
> ### Name: time
> ### Title: Sampling Times of Time Series
> ### Aliases: time cycle frequency deltat time.default
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> cycle(presidents)
Qtr1 Qtr2 Qtr3 Qtr4
1945 1 2 3 4
1946 1 2 3 4
1947 1 2 3 4
1948 1 2 3 4
1949 1 2 3 4
1950 1 2 3 4
1951 1 2 3 4
1952 1 2 3 4
1953 1 2 3 4
1954 1 2 3 4
1955 1 2 3 4
1956 1 2 3 4
1957 1 2 3 4
1958 1 2 3 4
1959 1 2 3 4
1960 1 2 3 4
1961 1 2 3 4
1962 1 2 3 4
1963 1 2 3 4
1964 1 2 3 4
1965 1 2 3 4
1966 1 2 3 4
1967 1 2 3 4
1968 1 2 3 4
1969 1 2 3 4
1970 1 2 3 4
1971 1 2 3 4
1972 1 2 3 4
1973 1 2 3 4
1974 1 2 3 4
> # a simple series plot
> plot(as.vector(time(presidents)), as.vector(presidents), type="l")
>
>
>
> cleanEx()
> nameEx("toeplitz")
> ### * toeplitz
>
> flush(stderr()); flush(stdout())
>
> ### Name: toeplitz
> ### Title: Form Symmetric Toeplitz Matrix
> ### Aliases: toeplitz
> ### Keywords: ts
>
> ### ** Examples
>
> x <- 1:5
> toeplitz (x)
[,1] [,2] [,3] [,4] [,5]
[1,] 1 2 3 4 5
[2,] 2 1 2 3 4
[3,] 3 2 1 2 3
[4,] 4 3 2 1 2
[5,] 5 4 3 2 1
>
>
>
> cleanEx()
> nameEx("ts")
> ### * ts
>
> flush(stderr()); flush(stdout())
>
> ### Name: ts
> ### Title: Time-Series Objects
> ### Aliases: ts as.ts as.ts.default is.ts Ops.ts cbind.ts is.mts [.ts t.ts
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ts(1:10, frequency = 4, start = c(1959, 2)) # 2nd Quarter of 1959
Qtr1 Qtr2 Qtr3 Qtr4
1959 1 2 3
1960 4 5 6 7
1961 8 9 10
> print( ts(1:10, frequency = 7, start = c(12, 2)), calendar = TRUE)
p1 p2 p3 p4 p5 p6 p7
12 1 2 3 4 5 6
13 7 8 9 10
> # print.ts(.)
> ## Using July 1954 as start date:
> gnp <- ts(cumsum(1 + round(rnorm(100), 2)),
+ start = c(1954, 7), frequency = 12)
> plot(gnp) # using 'plot.ts' for time-series plot
>
> ## Multivariate
> z <- ts(matrix(rnorm(300), 100, 3), start=c(1961, 1), frequency=12)
> class(z)
[1] "mts" "ts"
> plot(z)
> plot(z, plot.type="single", lty=1:3)
>
> ## A phase plot:
> plot(nhtemp, c(nhtemp[-1], NA), cex = .8, col="blue",
+ main = "Lag plot of New Haven temperatures")
> ## a clearer way to do this would be
> ## Not run:
> ##D plot(nhtemp, lag(nhtemp, 1), cex = .8, col="blue",
> ##D main = "Lag plot of New Haven temperatures")
> ## End(Not run)
>
>
> cleanEx()
> nameEx("ts.plot")
> ### * ts.plot
>
> flush(stderr()); flush(stdout())
>
> ### Name: ts.plot
> ### Title: Plot Multiple Time Series
> ### Aliases: ts.plot
> ### Keywords: ts
>
> ### ** Examples
>
> require(graphics)
>
> ts.plot(ldeaths, mdeaths, fdeaths,
+ gpars=list(xlab="year", ylab="deaths", lty=c(1:3)))
>
>
>
> cleanEx()
> nameEx("ts.union")
> ### * ts.union
>
> flush(stderr()); flush(stdout())
>
> ### Name: ts.union
> ### Title: Bind Two or More Time Series
> ### Aliases: ts.union ts.intersect
> ### Keywords: ts
>
> ### ** Examples
>
> ts.union(mdeaths, fdeaths)
mdeaths fdeaths
Jan 1974 2134 901
Feb 1974 1863 689
Mar 1974 1877 827
Apr 1974 1877 677
May 1974 1492 522
Jun 1974 1249 406
Jul 1974 1280 441
Aug 1974 1131 393
Sep 1974 1209 387
Oct 1974 1492 582
Nov 1974 1621 578
Dec 1974 1846 666
Jan 1975 2103 830
Feb 1975 2137 752
Mar 1975 2153 785
Apr 1975 1833 664
May 1975 1403 467
Jun 1975 1288 438
Jul 1975 1186 421
Aug 1975 1133 412
Sep 1975 1053 343
Oct 1975 1347 440
Nov 1975 1545 531
Dec 1975 2066 771
Jan 1976 2020 767
Feb 1976 2750 1141
Mar 1976 2283 896
Apr 1976 1479 532
May 1976 1189 447
Jun 1976 1160 420
Jul 1976 1113 376
Aug 1976 970 330
Sep 1976 999 357
Oct 1976 1208 445
Nov 1976 1467 546
Dec 1976 2059 764
Jan 1977 2240 862
Feb 1977 1634 660
Mar 1977 1722 663
Apr 1977 1801 643
May 1977 1246 502
Jun 1977 1162 392
Jul 1977 1087 411
Aug 1977 1013 348
Sep 1977 959 387
Oct 1977 1179 385
Nov 1977 1229 411
Dec 1977 1655 638
Jan 1978 2019 796
Feb 1978 2284 853
Mar 1978 1942 737
Apr 1978 1423 546
May 1978 1340 530
Jun 1978 1187 446
Jul 1978 1098 431
Aug 1978 1004 362
Sep 1978 970 387
Oct 1978 1140 430
Nov 1978 1110 425
Dec 1978 1812 679
Jan 1979 2263 821
Feb 1979 1820 785
Mar 1979 1846 727
Apr 1979 1531 612
May 1979 1215 478
Jun 1979 1075 429
Jul 1979 1056 405
Aug 1979 975 379
Sep 1979 940 393
Oct 1979 1081 411
Nov 1979 1294 487
Dec 1979 1341 574
> cbind(mdeaths, fdeaths) # same as the previous line
mdeaths fdeaths
Jan 1974 2134 901
Feb 1974 1863 689
Mar 1974 1877 827
Apr 1974 1877 677
May 1974 1492 522
Jun 1974 1249 406
Jul 1974 1280 441
Aug 1974 1131 393
Sep 1974 1209 387
Oct 1974 1492 582
Nov 1974 1621 578
Dec 1974 1846 666
Jan 1975 2103 830
Feb 1975 2137 752
Mar 1975 2153 785
Apr 1975 1833 664
May 1975 1403 467
Jun 1975 1288 438
Jul 1975 1186 421
Aug 1975 1133 412
Sep 1975 1053 343
Oct 1975 1347 440
Nov 1975 1545 531
Dec 1975 2066 771
Jan 1976 2020 767
Feb 1976 2750 1141
Mar 1976 2283 896
Apr 1976 1479 532
May 1976 1189 447
Jun 1976 1160 420
Jul 1976 1113 376
Aug 1976 970 330
Sep 1976 999 357
Oct 1976 1208 445
Nov 1976 1467 546
Dec 1976 2059 764
Jan 1977 2240 862
Feb 1977 1634 660
Mar 1977 1722 663
Apr 1977 1801 643
May 1977 1246 502
Jun 1977 1162 392
Jul 1977 1087 411
Aug 1977 1013 348
Sep 1977 959 387
Oct 1977 1179 385
Nov 1977 1229 411
Dec 1977 1655 638
Jan 1978 2019 796
Feb 1978 2284 853
Mar 1978 1942 737
Apr 1978 1423 546
May 1978 1340 530
Jun 1978 1187 446
Jul 1978 1098 431
Aug 1978 1004 362
Sep 1978 970 387
Oct 1978 1140 430
Nov 1978 1110 425
Dec 1978 1812 679
Jan 1979 2263 821
Feb 1979 1820 785
Mar 1979 1846 727
Apr 1979 1531 612
May 1979 1215 478
Jun 1979 1075 429
Jul 1979 1056 405
Aug 1979 975 379
Sep 1979 940 393
Oct 1979 1081 411
Nov 1979 1294 487
Dec 1979 1341 574
> ts.intersect(window(mdeaths, 1976), window(fdeaths, 1974, 1978))
window(mdeaths, 1976) window(fdeaths, 1974, 1978)
Jan 1976 2020 767
Feb 1976 2750 1141
Mar 1976 2283 896
Apr 1976 1479 532
May 1976 1189 447
Jun 1976 1160 420
Jul 1976 1113 376
Aug 1976 970 330
Sep 1976 999 357
Oct 1976 1208 445
Nov 1976 1467 546
Dec 1976 2059 764
Jan 1977 2240 862
Feb 1977 1634 660
Mar 1977 1722 663
Apr 1977 1801 643
May 1977 1246 502
Jun 1977 1162 392
Jul 1977 1087 411
Aug 1977 1013 348
Sep 1977 959 387
Oct 1977 1179 385
Nov 1977 1229 411
Dec 1977 1655 638
Jan 1978 2019 796
>
> sales1 <- ts.union(BJsales, lead = BJsales.lead)
> ts.intersect(sales1, lead3 = lag(BJsales.lead, -3))
Time Series:
Start = 4
End = 150
Frequency = 1
sales1.BJsales sales1.lead lead3
4 198.9 9.75 10.01
5 199.0 10.33 10.07
6 200.2 10.13 10.32
7 198.6 10.36 9.75
8 200.0 10.32 10.33
9 200.3 10.13 10.13
10 201.2 10.16 10.36
11 201.6 10.58 10.32
12 201.5 10.62 10.13
13 201.5 10.86 10.16
14 203.5 11.20 10.58
15 204.9 10.74 10.62
16 207.1 10.56 10.86
17 210.5 10.48 11.20
18 210.5 10.77 10.74
19 209.8 11.33 10.56
20 208.8 10.96 10.48
21 209.5 11.16 10.77
22 213.2 11.70 11.33
23 213.7 11.39 10.96
24 215.1 11.42 11.16
25 218.7 11.94 11.70
26 219.8 11.24 11.39
27 220.5 11.59 11.42
28 223.8 10.96 11.94
29 222.8 11.40 11.24
30 223.8 11.02 11.59
31 221.7 11.01 10.96
32 222.3 11.23 11.40
33 220.8 11.33 11.02
34 219.4 10.83 11.01
35 220.1 10.84 11.23
36 220.6 11.14 11.33
37 218.9 10.38 10.83
38 217.8 10.90 10.84
39 217.7 11.05 11.14
40 215.0 11.11 10.38
41 215.3 11.01 10.90
42 215.9 11.22 11.05
43 216.7 11.21 11.11
44 216.7 11.91 11.01
45 217.7 11.69 11.22
46 218.7 10.93 11.21
47 222.9 10.99 11.91
48 224.9 11.01 11.69
49 222.2 10.84 10.93
50 220.7 10.76 10.99
51 220.0 10.77 11.01
52 218.7 10.88 10.84
53 217.0 10.49 10.76
54 215.9 10.50 10.77
55 215.8 11.00 10.88
56 214.1 10.98 10.49
57 212.3 10.61 10.50
58 213.9 10.48 11.00
59 214.6 10.53 10.98
60 213.6 11.07 10.61
61 212.1 10.61 10.48
62 211.4 10.86 10.53
63 213.1 10.34 11.07
64 212.9 10.78 10.61
65 213.3 10.80 10.86
66 211.5 10.33 10.34
67 212.3 10.44 10.78
68 213.0 10.50 10.80
69 211.0 10.75 10.33
70 210.7 10.40 10.44
71 210.1 10.40 10.50
72 211.4 10.34 10.75
73 210.0 10.55 10.40
74 209.7 10.46 10.40
75 208.8 10.82 10.34
76 208.8 10.91 10.55
77 208.8 10.87 10.46
78 210.6 10.67 10.82
79 211.9 11.11 10.91
80 212.8 10.88 10.87
81 212.5 11.28 10.67
82 214.8 11.27 11.11
83 215.3 11.44 10.88
84 217.5 11.52 11.28
85 218.8 12.10 11.27
86 220.7 11.83 11.44
87 222.2 12.62 11.52
88 226.7 12.41 12.10
89 228.4 12.43 11.83
90 233.2 12.73 12.62
91 235.7 13.01 12.41
92 237.1 12.74 12.43
93 240.6 12.73 12.73
94 243.8 12.76 13.01
95 245.3 12.92 12.74
96 246.0 12.64 12.73
97 246.3 12.79 12.76
98 247.7 13.05 12.92
99 247.6 12.69 12.64
100 247.8 13.01 12.79
101 249.4 12.90 13.05
102 249.0 13.12 12.69
103 249.9 12.47 13.01
104 250.5 12.47 12.90
105 251.5 12.94 13.12
106 249.0 13.10 12.47
107 247.6 12.91 12.47
108 248.8 13.39 12.94
109 250.4 13.13 13.10
110 250.7 13.34 12.91
111 253.0 13.34 13.39
112 253.7 13.14 13.13
113 255.0 13.49 13.34
114 256.2 13.87 13.34
115 256.0 13.39 13.14
116 257.4 13.59 13.49
117 260.4 13.27 13.87
118 260.0 13.70 13.39
119 261.3 13.20 13.59
120 260.4 13.32 13.27
121 261.6 13.15 13.70
122 260.8 13.30 13.20
123 259.8 12.94 13.32
124 259.0 13.29 13.15
125 258.9 13.26 13.30
126 257.4 13.08 12.94
127 257.7 13.24 13.29
128 257.9 13.31 13.26
129 257.4 13.52 13.08
130 257.3 13.02 13.24
131 257.6 13.25 13.31
132 258.9 13.12 13.52
133 257.8 13.26 13.02
134 257.7 13.11 13.25
135 257.2 13.30 13.12
136 257.5 13.06 13.26
137 256.8 13.32 13.11
138 257.5 13.10 13.30
139 257.0 13.27 13.06
140 257.6 13.64 13.32
141 257.3 13.58 13.10
142 257.5 13.87 13.27
143 259.6 13.53 13.64
144 261.1 13.41 13.58
145 262.9 13.25 13.87
146 263.3 13.50 13.53
147 262.8 13.58 13.41
148 261.8 13.51 13.25
149 262.2 13.77 13.50
150 262.7 13.40 13.58
>
>
>
> cleanEx()
> nameEx("tsdiag")
> ### * tsdiag
>
> flush(stderr()); flush(stdout())
>
> ### Name: tsdiag
> ### Title: Diagnostic Plots for Time-Series Fits
> ### Aliases: tsdiag tsdiag.arima0 tsdiag.Arima tsdiag.StructTS
> ### Keywords: ts
>
> ### ** Examples
>
> ## Not run:
> ##D require(graphics)
> ##D
> ##D fit <- arima(lh, c(1,0,0))
> ##D tsdiag(fit)
> ##D
> ##D ## see also examples(arima)
> ##D
> ##D (fit <- StructTS(log10(JohnsonJohnson), type="BSM"))
> ##D tsdiag(fit)
> ## End(Not run)
>
>
> cleanEx()
> nameEx("uniroot")
> ### * uniroot
>
> flush(stderr()); flush(stdout())
>
> ### Name: uniroot
> ### Title: One Dimensional Root (Zero) Finding
> ### Aliases: uniroot
> ### Keywords: optimize
>
> ### ** Examples
>
> require(utils) # for str
>
> ## some platforms hit zero exactly on the first step:
> ## if so the estimated precision is 2/3.
> f <- function (x,a) x - a
> str(xmin <- uniroot(f, c(0, 1), tol = 0.0001, a = 1/3))
List of 4
$ root : num 0.333
$ f.root : num 0
$ iter : int 1
$ estim.prec: num 0.667
>
> str(uniroot(function(x) x*(x^2-1) + .5, lower = -2, upper = 2,
+ tol = 0.0001), dig = 10)
List of 4
$ root : num -1.191487962
$ f.root : num -2.549728179e-07
$ iter : int 7
$ estim.prec: num 5e-05
> str(uniroot(function(x) x*(x^2-1) + .5, lower = -2, upper = 2,
+ tol = 1e-10 ), dig = 10)
List of 4
$ root : num -1.191487884
$ f.root : num 5.66574565e-11
$ iter : int 8
$ estim.prec: num 5.000044823e-11
>
>
>
> cleanEx()
> nameEx("update")
> ### * update
>
> flush(stderr()); flush(stdout())
>
> ### Name: update
> ### Title: Update and Re-fit a Model Call
> ### Aliases: update update.default
> ### Keywords: models
>
> ### ** Examples
>
> oldcon <- options(contrasts = c("contr.treatment", "contr.poly"))
> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models".
> ## Page 9: Plant Weight Data.
> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
> group <- gl(2, 10, 20, labels = c("Ctl", "Trt"))
> weight <- c(ctl, trt)
> lm.D9 <- lm(weight ~ group)
> lm.D9
Call:
lm(formula = weight ~ group)
Coefficients:
(Intercept) groupTrt
5.032 -0.371
> summary(lm.D90 <- update(lm.D9, . ~ . - 1))
Call:
lm(formula = weight ~ group - 1)
Residuals:
Min 1Q Median 3Q Max
-1.0710 -0.4938 0.0685 0.2462 1.3690
Coefficients:
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.0320 0.2202 22.85 9.55e-15 ***
groupTrt 4.6610 0.2202 21.16 3.62e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.6964 on 18 degrees of freedom
Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798
F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16
> options(contrasts = c("contr.helmert", "contr.poly"))
> update(lm.D9)
Call:
lm(formula = weight ~ group)
Coefficients:
(Intercept) group1
4.8465 -0.1855
> options(oldcon)
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> cleanEx()
> nameEx("update.formula")
> ### * update.formula
>
> flush(stderr()); flush(stdout())
>
> ### Name: update.formula
> ### Title: Model Updating
> ### Aliases: update.formula
> ### Keywords: models
>
> ### ** Examples
>
> update(y ~ x, ~ . + x2) #> y ~ x + x2
y ~ x + x2
> update(y ~ x, log(.) ~ . ) #> log(y) ~ x
log(y) ~ x
>
>
>
> cleanEx()
> nameEx("var.test")
> ### * var.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: var.test
> ### Title: F Test to Compare Two Variances
> ### Aliases: var.test var.test.default var.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> x <- rnorm(50, mean = 0, sd = 2)
> y <- rnorm(30, mean = 1, sd = 1)
> var.test(x, y) # Do x and y have the same variance?
F test to compare two variances
data: x and y
F = 2.6522, num df = 49, denom df = 29, p-value = 0.006232
alternative hypothesis: true ratio of variances is not equal to 1
95 percent confidence interval:
1.332510 4.989832
sample estimates:
ratio of variances
2.652168
> var.test(lm(x ~ 1), lm(y ~ 1)) # The same.
F test to compare two variances
data: lm(x ~ 1) and lm(y ~ 1)
F = 2.6522, num df = 49, denom df = 29, p-value = 0.006232
alternative hypothesis: true ratio of variances is not equal to 1
95 percent confidence interval:
1.332510 4.989832
sample estimates:
ratio of variances
2.652168
>
>
>
> cleanEx()
> nameEx("varimax")
> ### * varimax
>
> flush(stderr()); flush(stdout())
>
> ### Name: varimax
> ### Title: Rotation Methods for Factor Analysis
> ### Aliases: promax varimax
> ### Keywords: multivariate
>
> ### ** Examples
>
> ## varimax with normalize = TRUE is the default
> fa <- factanal( ~., 2, data = swiss)
> varimax(loadings(fa), normalize = FALSE)
$loadings
Loadings:
Factor1 Factor2
Fertility -0.650 0.398
Agriculture -0.628 0.337
Examination 0.681 -0.515
Education 0.997
Catholic -0.117 0.962
Infant.Mortality 0.176
Factor1 Factor2
SS loadings 2.297 1.496
Proportion Var 0.383 0.249
Cumulative Var 0.383 0.632
$rotmat
[,1] [,2]
[1,] 0.999973881 -0.007227595
[2,] 0.007227595 0.999973881
> promax(loadings(fa))
$loadings
Loadings:
Factor1 Factor2
Fertility -0.595 0.227
Agriculture -0.599 0.160
Examination 0.577 -0.360
Education 1.192 0.363
Catholic 0.326 1.147
Infant.Mortality 0.180
Factor1 Factor2
SS loadings 2.574 1.686
Proportion Var 0.429 0.281
Cumulative Var 0.429 0.710
$rotmat
[,1] [,2]
[1,] 1.2114045 0.4029296
[2,] 0.4956199 1.2453063
>
>
>
> cleanEx()
> nameEx("weighted.mean")
> ### * weighted.mean
>
> flush(stderr()); flush(stdout())
>
> ### Name: weighted.mean
> ### Title: Weighted Arithmetic Mean
> ### Aliases: weighted.mean weighted.mean.default
> ### Keywords: univar
>
> ### ** Examples
>
> ## GPA from Siegel 1994
> wt <- c(5, 5, 4, 1)/15
> x <- c(3.7,3.3,3.5,2.8)
> xm <- weighted.mean(x, wt)
>
>
>
> cleanEx()
> nameEx("weighted.residuals")
> ### * weighted.residuals
>
> flush(stderr()); flush(stdout())
>
> ### Name: weighted.residuals
> ### Title: Compute Weighted Residuals
> ### Aliases: weighted.residuals
> ### Keywords: regression
>
> ### ** Examples
>
> utils::example("lm")
lm> require(graphics)
lm> ## Annette Dobson (1990) "An Introduction to Generalized Linear Models".
lm> ## Page 9: Plant Weight Data.
lm> ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
lm> trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
lm> group <- gl(2,10,20, labels=c("Ctl","Trt"))
lm> weight <- c(ctl, trt)
lm> anova(lm.D9 <- lm(weight ~ group))
Analysis of Variance Table
Response: weight
Df Sum Sq Mean Sq F value Pr(>F)
group 1 0.6882 0.68820 1.4191 0.249
Residuals 18 8.7292 0.48496
lm> summary(lm.D90 <- lm(weight ~ group - 1))# omitting intercept
Call:
lm(formula = weight ~ group - 1)
Residuals:
Min 1Q Median 3Q Max
-1.0710 -0.4938 0.0685 0.2462 1.3690
Coefficients:
Estimate Std. Error t value Pr(>|t|)
groupCtl 5.0320 0.2202 22.85 9.55e-15 ***
groupTrt 4.6610 0.2202 21.16 3.62e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.6964 on 18 degrees of freedom
Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798
F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16
lm> opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))
lm> plot(lm.D9, las = 1) # Residuals, Fitted, ...
lm> par(opar)
lm> ## model frame :
lm> stopifnot(identical(lm(weight ~ group, method = "model.frame"),
lm+ model.frame(lm.D9)))
lm> ### less simple examples in "See Also" above
lm>
lm>
lm>
> all.equal(weighted.residuals(lm.D9),
+ residuals(lm.D9))
[1] TRUE
> x <- 1:10
> w <- 0:9
> y <- rnorm(x)
> weighted.residuals(lmxy <- lm(y ~ x, weights = w))
2 3 4 5 6 7
-0.15744267 -1.63534445 2.24282864 0.09895229 -2.41528559 0.60771924
8 9 10
1.37406419 1.06675699 -1.45098819
> weighted.residuals(lmxy, drop0 = FALSE)
1 2 3 4 5 6
0.00000000 -0.15744267 -1.63534445 2.24282864 0.09895229 -2.41528559
7 8 9 10
0.60771924 1.37406419 1.06675699 -1.45098819
>
>
>
> cleanEx()
> nameEx("wilcox.test")
> ### * wilcox.test
>
> flush(stderr()); flush(stdout())
>
> ### Name: wilcox.test
> ### Title: Wilcoxon Rank Sum and Signed Rank Tests
> ### Aliases: wilcox.test wilcox.test.default wilcox.test.formula
> ### Keywords: htest
>
> ### ** Examples
>
> require(graphics)
> ## One-sample test.
> ## Hollander & Wolfe (1973), 29f.
> ## Hamilton depression scale factor measurements in 9 patients with
> ## mixed anxiety and depression, taken at the first (x) and second
> ## (y) visit after initiation of a therapy (administration of a
> ## tranquilizer).
> x <- c(1.83, 0.50, 1.62, 2.48, 1.68, 1.88, 1.55, 3.06, 1.30)
> y <- c(0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29)
> wilcox.test(x, y, paired = TRUE, alternative = "greater")
Wilcoxon signed rank test
data: x and y
V = 40, p-value = 0.01953
alternative hypothesis: true location shift is greater than 0
> wilcox.test(y - x, alternative = "less") # The same.
Wilcoxon signed rank test
data: y - x
V = 5, p-value = 0.01953
alternative hypothesis: true location is less than 0
> wilcox.test(y - x, alternative = "less",
+ exact = FALSE, correct = FALSE) # H&W large sample
Wilcoxon signed rank test
data: y - x
V = 5, p-value = 0.01908
alternative hypothesis: true location is less than 0
> # approximation
>
> ## Two-sample test.
> ## Hollander & Wolfe (1973), 69f.
> ## Permeability constants of the human chorioamnion (a placental
> ## membrane) at term (x) and between 12 to 26 weeks gestational
> ## age (y). The alternative of interest is greater permeability
> ## of the human chorioamnion for the term pregnancy.
> x <- c(0.80, 0.83, 1.89, 1.04, 1.45, 1.38, 1.91, 1.64, 0.73, 1.46)
> y <- c(1.15, 0.88, 0.90, 0.74, 1.21)
> wilcox.test(x, y, alternative = "g") # greater
Wilcoxon rank sum test
data: x and y
W = 35, p-value = 0.1272
alternative hypothesis: true location shift is greater than 0
> wilcox.test(x, y, alternative = "greater",
+ exact = FALSE, correct = FALSE) # H&W large sample
Wilcoxon rank sum test
data: x and y
W = 35, p-value = 0.1103
alternative hypothesis: true location shift is greater than 0
> # approximation
>
> wilcox.test(rnorm(10), rnorm(10, 2), conf.int = TRUE)
Wilcoxon rank sum test
data: rnorm(10) and rnorm(10, 2)
W = 7, p-value = 0.0004871
alternative hypothesis: true location shift is not equal to 0
95 percent confidence interval:
-3.024352 -1.348555
sample estimates:
difference in location
-2.262424
>
> ## Formula interface.
> boxplot(Ozone ~ Month, data = airquality)
> wilcox.test(Ozone ~ Month, data = airquality,
+ subset = Month %in% c(5, 8))
Warning in wilcox.test.default(x = c(41L, 36L, 12L, 18L, 28L, 23L, 19L, :
cannot compute exact p-value with ties
Wilcoxon rank sum test with continuity correction
data: Ozone by Month
W = 127.5, p-value = 0.0001208
alternative hypothesis: true location shift is not equal to 0
>
>
>
> cleanEx()
> nameEx("window")
> ### * window
>
> flush(stderr()); flush(stdout())
>
> ### Name: window
> ### Title: Time Windows
> ### Aliases: window window.default window.ts window<- window<-.ts
> ### Keywords: ts
>
> ### ** Examples
>
> window(presidents, 1960, c(1969,4)) # values in the 1960's
Qtr1 Qtr2 Qtr3 Qtr4
1960 71 62 61 57
1961 72 83 71 78
1962 79 71 62 74
1963 76 64 62 57
1964 80 73 69 69
1965 71 64 69 62
1966 63 46 56 44
1967 44 52 38 46
1968 36 49 35 44
1969 59 65 65 56
> window(presidents, deltat=1) # All Qtr1s
Time Series:
Start = 1945
End = 1974
Frequency = 1
[1] NA 63 35 36 69 45 36 25 59 71 71 76 79 60 57 71 72 79 76 80 71 63 44 36 59
[26] 66 51 49 68 28
> window(presidents, start=c(1945,3), deltat=1) # All Qtr3s
Time Series:
Start = 1945.5
End = 1974.5
Frequency = 1
[1] 82 43 54 NA 57 46 32 NA 75 71 79 67 63 48 61 61 71 62 62 69 69 56 38 35 65
[26] 61 54 NA 40 24
> window(presidents, 1944, c(1979,2), extend=TRUE)
Qtr1 Qtr2 Qtr3 Qtr4
1944 NA NA NA NA
1945 NA 87 82 75
1946 63 50 43 32
1947 35 60 54 55
1948 36 39 NA NA
1949 69 57 57 51
1950 45 37 46 39
1951 36 24 32 23
1952 25 32 NA 32
1953 59 74 75 60
1954 71 61 71 57
1955 71 68 79 73
1956 76 71 67 75
1957 79 62 63 57
1958 60 49 48 52
1959 57 62 61 66
1960 71 62 61 57
1961 72 83 71 78
1962 79 71 62 74
1963 76 64 62 57
1964 80 73 69 69
1965 71 64 69 62
1966 63 46 56 44
1967 44 52 38 46
1968 36 49 35 44
1969 59 65 65 56
1970 66 53 61 52
1971 51 48 54 49
1972 49 61 NA NA
1973 68 44 40 27
1974 28 25 24 24
1975 NA NA NA NA
1976 NA NA NA NA
1977 NA NA NA NA
1978 NA NA NA NA
1979 NA NA
>
> pres <- window(presidents, 1945, c(1949,4)) # values in the 1940's
> window(pres, 1945.25, 1945.50) <- c(60, 70)
> window(pres, 1944, 1944.75) <- 0 # will generate a warning
Warning: extending time series when replacing values
> window(pres, c(1945,4), c(1949,4), frequency=1) <- 85:89
> pres
Qtr1 Qtr2 Qtr3 Qtr4
1944 0 0 0 0
1945 NA 60 70 85
1946 63 50 43 86
1947 35 60 54 87
1948 36 39 NA 88
1949 69 57 57 89
>
>
>
> cleanEx()
> nameEx("xtabs")
> ### * xtabs
>
> flush(stderr()); flush(stdout())
>
> ### Name: xtabs
> ### Title: Cross Tabulation
> ### Aliases: xtabs print.xtabs
> ### Keywords: category
>
> ### ** Examples
>
> ## 'esoph' has the frequencies of cases and controls for all levels of
> ## the variables 'agegp', 'alcgp', and 'tobgp'.
> xtabs(cbind(ncases, ncontrols) ~ ., data = esoph)
, , tobgp = 0-9g/day, = ncases
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 0 0 0 0
35-44 0 0 0 2
45-54 1 6 3 4
55-64 2 9 9 5
65-74 5 17 6 3
75+ 1 2 1 2
, , tobgp = 10-19, = ncases
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 0 0 0 1
35-44 1 3 0 0
45-54 0 4 6 3
55-64 3 6 8 6
65-74 4 3 4 1
75+ 2 1 1 1
, , tobgp = 20-29, = ncases
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 0 0 0 0
35-44 0 1 0 2
45-54 0 5 1 2
55-64 3 4 3 2
65-74 2 5 2 1
75+ 0 0 0 0
, , tobgp = 30+, = ncases
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 0 0 0 0
35-44 0 0 0 0
45-54 0 5 2 4
55-64 4 3 4 5
65-74 0 0 1 1
75+ 1 1 0 0
, , tobgp = 0-9g/day, = ncontrols
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 40 27 2 1
35-44 60 35 11 3
45-54 46 38 16 4
55-64 49 40 18 10
65-74 48 34 13 4
75+ 18 5 1 2
, , tobgp = 10-19, = ncontrols
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 10 7 1 1
35-44 14 23 6 3
45-54 18 21 14 4
55-64 22 21 15 7
65-74 14 10 12 2
75+ 6 3 1 1
, , tobgp = 20-29, = ncontrols
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 6 4 0 1
35-44 7 14 2 4
45-54 10 15 5 3
55-64 12 17 6 3
65-74 7 9 3 1
75+ 0 3 0 0
, , tobgp = 30+, = ncontrols
alcgp
agegp 0-39g/day 40-79 80-119 120+
25-34 5 7 2 2
35-44 8 8 1 0
45-54 4 7 4 4
55-64 6 6 4 6
65-74 2 0 1 1
75+ 3 1 0 0
> ## Output is not really helpful ... flat tables are better:
> ftable(xtabs(cbind(ncases, ncontrols) ~ ., data = esoph))
ncases ncontrols
agegp alcgp tobgp
25-34 0-39g/day 0-9g/day 0 40
10-19 0 10
20-29 0 6
30+ 0 5
40-79 0-9g/day 0 27
10-19 0 7
20-29 0 4
30+ 0 7
80-119 0-9g/day 0 2
10-19 0 1
20-29 0 0
30+ 0 2
120+ 0-9g/day 0 1
10-19 1 1
20-29 0 1
30+ 0 2
35-44 0-39g/day 0-9g/day 0 60
10-19 1 14
20-29 0 7
30+ 0 8
40-79 0-9g/day 0 35
10-19 3 23
20-29 1 14
30+ 0 8
80-119 0-9g/day 0 11
10-19 0 6
20-29 0 2
30+ 0 1
120+ 0-9g/day 2 3
10-19 0 3
20-29 2 4
30+ 0 0
45-54 0-39g/day 0-9g/day 1 46
10-19 0 18
20-29 0 10
30+ 0 4
40-79 0-9g/day 6 38
10-19 4 21
20-29 5 15
30+ 5 7
80-119 0-9g/day 3 16
10-19 6 14
20-29 1 5
30+ 2 4
120+ 0-9g/day 4 4
10-19 3 4
20-29 2 3
30+ 4 4
55-64 0-39g/day 0-9g/day 2 49
10-19 3 22
20-29 3 12
30+ 4 6
40-79 0-9g/day 9 40
10-19 6 21
20-29 4 17
30+ 3 6
80-119 0-9g/day 9 18
10-19 8 15
20-29 3 6
30+ 4 4
120+ 0-9g/day 5 10
10-19 6 7
20-29 2 3
30+ 5 6
65-74 0-39g/day 0-9g/day 5 48
10-19 4 14
20-29 2 7
30+ 0 2
40-79 0-9g/day 17 34
10-19 3 10
20-29 5 9
30+ 0 0
80-119 0-9g/day 6 13
10-19 4 12
20-29 2 3
30+ 1 1
120+ 0-9g/day 3 4
10-19 1 2
20-29 1 1
30+ 1 1
75+ 0-39g/day 0-9g/day 1 18
10-19 2 6
20-29 0 0
30+ 1 3
40-79 0-9g/day 2 5
10-19 1 3
20-29 0 3
30+ 1 1
80-119 0-9g/day 1 1
10-19 1 1
20-29 0 0
30+ 0 0
120+ 0-9g/day 2 2
10-19 1 1
20-29 0 0
30+ 0 0
> ## In particular if we have fewer factors ...
> ftable(xtabs(cbind(ncases, ncontrols) ~ agegp, data = esoph))
ncases ncontrols
agegp
25-34 1 116
35-44 9 199
45-54 46 213
55-64 76 242
65-74 55 161
75+ 13 44
>
> ## This is already a contingency table in array form.
> DF <- as.data.frame(UCBAdmissions)
> ## Now 'DF' is a data frame with a grid of the factors and the counts
> ## in variable 'Freq'.
> DF
Admit Gender Dept Freq
1 Admitted Male A 512
2 Rejected Male A 313
3 Admitted Female A 89
4 Rejected Female A 19
5 Admitted Male B 353
6 Rejected Male B 207
7 Admitted Female B 17
8 Rejected Female B 8
9 Admitted Male C 120
10 Rejected Male C 205
11 Admitted Female C 202
12 Rejected Female C 391
13 Admitted Male D 138
14 Rejected Male D 279
15 Admitted Female D 131
16 Rejected Female D 244
17 Admitted Male E 53
18 Rejected Male E 138
19 Admitted Female E 94
20 Rejected Female E 299
21 Admitted Male F 22
22 Rejected Male F 351
23 Admitted Female F 24
24 Rejected Female F 317
> ## Nice for taking margins ...
> xtabs(Freq ~ Gender + Admit, DF)
Admit
Gender Admitted Rejected
Male 1198 1493
Female 557 1278
> ## And for testing independence ...
> summary(xtabs(Freq ~ ., DF))
Call: xtabs(formula = Freq ~ ., data = DF)
Number of cases in table: 4526
Number of factors: 3
Test for independence of all factors:
Chisq = 2000.3, df = 16, p-value = 0
>
> ## Create a nice display for the warp break data.
> warpbreaks$replicate <- rep(1:9, len = 54)
> ftable(xtabs(breaks ~ wool + tension + replicate, data = warpbreaks))
replicate 1 2 3 4 5 6 7 8 9
wool tension
A L 26 30 54 25 70 52 51 26 67
M 18 21 29 17 12 18 35 30 36
H 36 21 24 18 10 43 28 15 26
B L 27 14 29 19 29 31 41 20 44
M 42 26 19 16 39 28 21 39 29
H 20 21 24 17 13 15 15 16 28
>
> ### ---- Sparse Examples ----
>
> if(require("Matrix")) {
+ ## similar to "nlme"s 'ergoStool' :
+ d.ergo <- data.frame(Type = paste("T", rep(1:4, 9*4), sep=""),
+ Subj = gl(9,4, 36*4))
+ print(xtabs(~ Type + Subj, data=d.ergo)) # 4 replicates each
+ set.seed(15) # a subset of cases:
+ print(xtabs(~ Type + Subj, data=d.ergo[sample(36, 10),], sparse=TRUE))
+
+ ## Hypothetical two level setup:
+ inner <- factor(sample(letters[1:25], 100, replace = TRUE))
+ inout <- factor(sample(LETTERS[1:5], 25, replace = TRUE))
+ fr <- data.frame(inner = inner, outer = inout[as.integer(inner)])
+ print(xtabs(~ inner + outer, fr, sparse = TRUE))
+ }
Loading required package: Matrix
Loading required package: lattice
Attaching package: 'Matrix'
The following object(s) are masked from 'package:base':
det
Subj
Type 1 2 3 4 5 6 7 8 9
T1 4 4 4 4 4 4 4 4 4
T2 4 4 4 4 4 4 4 4 4
T3 4 4 4 4 4 4 4 4 4
T4 4 4 4 4 4 4 4 4 4
4 x 9 sparse Matrix of class "dgCMatrix"
1 2 3 4 5 6 7 8 9
T1 . 1 . 1 . 1 . 1 .
T2 1 . . . . . 1 . 1
T3 . . . . 1 . . . .
T4 1 . . . . . 1 . .
25 x 5 sparse Matrix of class "dgCMatrix"
A B C D E
a 2 . . . .
b . . 1 . .
c . 6 . . .
d . . . 5 .
e . . . 3 .
f 1 . . . .
g . 9 . . .
h . . 3 . .
i . . . . 5
j . . . 1 .
k 3 . . . .
l . 2 . . .
m 6 . . . .
n . . 1 . .
o 2 . . . .
p . . 2 . .
q . 5 . . .
r . . . . 6
s . . 4 . .
t . . . 7 .
u . 4 . . .
v . . . 7 .
w . . . 7 .
x . . . . 6
y . . . . 2
>
>
>
> cleanEx()
detaching ‘package:Matrix’, ‘package:lattice’
> nameEx("zC")
> ### * zC
>
> flush(stderr()); flush(stdout())
>
> ### Name: C
> ### Title: Sets Contrasts for a Factor
> ### Aliases: C
> ### Keywords: models
>
> ### ** Examples
>
> ## reset contrasts to defaults
> options(contrasts=c("contr.treatment", "contr.poly"))
> tens <- with(warpbreaks, C(tension, poly, 1))
> ## tension SHOULD be an ordered factor, but as it is not we can use
> aov(breaks ~ wool + tens + tension, data=warpbreaks)
Call:
aov(formula = breaks ~ wool + tens + tension, data = warpbreaks)
Terms:
wool tens tension Residuals
Sum of Squares 450.667 1950.694 83.565 6747.889
Deg. of Freedom 1 1 1 50
Residual standard error: 11.61713
1 out of 5 effects not estimable
Estimated effects may be unbalanced
>
> ## show the use of ... The default contrast is contr.treatment here
> summary(lm(breaks ~ wool + C(tension, base=2), data=warpbreaks))
Call:
lm(formula = breaks ~ wool + C(tension, base = 2), data = warpbreaks)
Residuals:
Min 1Q Median 3Q Max
-19.500 -8.083 -2.139 6.472 30.722
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 29.278 3.162 9.260 2e-12 ***
woolB -5.778 3.162 -1.827 0.0736 .
C(tension, base = 2)1 10.000 3.872 2.582 0.0128 *
C(tension, base = 2)3 -4.722 3.872 -1.219 0.2284
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 11.62 on 50 degrees of freedom
Multiple R-squared: 0.2691, Adjusted R-squared: 0.2253
F-statistic: 6.138 on 3 and 50 DF, p-value: 0.001230
>
>
> # following on from help(esoph)
> model3 <- glm(cbind(ncases, ncontrols) ~ agegp + C(tobgp, , 1) +
+ C(alcgp, , 1), data = esoph, family = binomial())
> summary(model3)
Call:
glm(formula = cbind(ncases, ncontrols) ~ agegp + C(tobgp, , 1) +
C(alcgp, , 1), family = binomial(), data = esoph)
Deviance Residuals:
Min 1Q Median 3Q Max
-1.7628 -0.6426 -0.2709 0.3043 2.0421
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.72420 0.19582 -8.805 < 2e-16 ***
agegp.L 2.96113 0.65092 4.549 5.39e-06 ***
agegp.Q -1.33735 0.58918 -2.270 0.02322 *
agegp.C 0.15292 0.44792 0.341 0.73281
agegp^4 0.06668 0.30776 0.217 0.82848
agegp^5 -0.20288 0.19523 -1.039 0.29872
C(tobgp, , 1).L 0.58501 0.18331 3.191 0.00142 **
C(alcgp, , 1).L 1.46034 0.18899 7.727 1.10e-14 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 227.241 on 87 degrees of freedom
Residual deviance: 59.277 on 80 degrees of freedom
AIC: 222.76
Number of Fisher Scoring iterations: 6
>
>
>
> options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", pos = 'CheckExEnv'),"\n")
Time elapsed: 18.66 0.376 19.064 0.002 0.023
> grDevices::dev.off()
null device
1
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')