The R Project SVN
R
(root)/branches/R-4-0-branch/tests/Examples/stats-Ex.Rout.save – Rev 79937
Rev 79826 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
R version 4.0.3 Patched (2021-02-03 r79936) -- "Bunny-Wunnies Freak Out"Copyright (C) 2021 The R Foundation for Statistical ComputingPlatform: x86_64-pc-linux-gnu (64-bit)R is free software and comes with ABSOLUTELY NO WARRANTY.You are welcome to redistribute it under certain conditions.Type 'license()' or 'licence()' for distribution details.Natural language support but running in an English localeR 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')>> base::assign(".oldSearch", base::search(), pos = 'CheckExEnv')> base::assign(".old_wd", base::getwd(), pos = 'CheckExEnv')> cleanEx()> nameEx("AIC")> ### * AIC>> flush(stderr()); flush(stdout())>> ### Name: AIC> ### Title: Akaike's An Information Criterion> ### Aliases: AIC BIC> ### Keywords: models>> ### ** Examples>> lm1 <- lm(Fertility ~ . , data = swiss)> AIC(lm1)[1] 326.0716> stopifnot(all.equal(AIC(lm1),+ AIC(logLik(lm1))))> BIC(lm1)[1] 339.0226>> lm2 <- update(lm1, . ~ . -Examination)> AIC(lm1, lm2)df AIClm1 7 326.0716lm2 6 325.2408> BIC(lm1, lm2)df BIClm1 7 339.0226lm2 6 336.3417>>>> 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 51.000000000 0.875000000 0.625000000 0.406250000 0.250000000 0.1484375006 7 8 9 100.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> a.n <- 2^(-n) * (32/3 + 8 * n) /(32/3)> (A.n <- ARMAacf(c(1.0, -0.25), 1.0, lag.max = 10))0 1 2 3 4 51.000000000 0.875000000 0.625000000 0.406250000 0.250000000 0.1484375006 7 8 9 100.085937500 0.048828125 0.027343750 0.015136719 0.008300781> stopifnot(all.equal(unname(A.n), c(1, a.n)))>> 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>> ## Visualization, including limit cases:> pl.beta <- function(a,b, asp = if(isLim) 1, ylim = if(isLim) c(0,1.1)) {+ if(isLim <- a == 0 || b == 0 || a == Inf || b == Inf) {+ eps <- 1e-10+ x <- c(0, eps, (1:7)/16, 1/2+c(-eps,0,eps), (9:15)/16, 1-eps, 1)+ } else {+ x <- seq(0, 1, length = 1025)+ }+ fx <- cbind(dbeta(x, a,b), pbeta(x, a,b), qbeta(x, a,b))+ f <- fx; f[fx == Inf] <- 1e100+ matplot(x, f, ylab="", type="l", ylim=ylim, asp=asp,+ main = sprintf("[dpq]beta(x, a=%g, b=%g)", a,b))+ abline(0,1, col="gray", lty=3)+ abline(h = 0:1, col="gray", lty=3)+ legend("top", paste0(c("d","p","q"), "beta(x, a,b)"),+ col=1:3, lty=1:3, bty = "n")+ invisible(cbind(x, fx))+ }> pl.beta(3,1)>> pl.beta(2, 4)> pl.beta(3, 7)> pl.beta(3, 7, asp=1)>> pl.beta(0, 0) ## point masses at {0, 1}>> pl.beta(0, 2) ## point mass at 0 ; the same as> pl.beta(1, Inf)>> pl.beta(Inf, 2) ## point mass at 1 ; the same as> pl.beta(3, 0)>> pl.beta(Inf, Inf)# point mass at 1/2>>>> 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.198748> 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 | 00000000000000000000000000000000000000133567788991 | 00013334566788888992 | 00114444673 | 002333458884 | 1112465 |6 |7 | 1788 | 23>>> ## "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>> ## a fast way to generate *sorted* U[0,1] random numbers:> rsunif <- function(n) { n1 <- n+1+ cE <- cumsum(rexp(n1)); cE[seq_len(n)]/cE[n1] }> plot(rsunif(1000), ylim=0:1, pch=".")> abline(0,1/(1000+1), col=adjustcolor(1, 0.5))>>>> cleanEx()> nameEx("Fdist")> ### * Fdist>> flush(stderr()); flush(stdout())>> ### Name: FDist> ### Title: The F Distribution> ### Aliases: FDist df pf qf rf> ### Keywords: distribution>> ### ** Examples>> ## Equivalence of pt(.,nu) with pf(.^2, 1,nu):> x <- seq(0.001, 5, len = 100)> nu <- 4> stopifnot(all.equal(2*pt(x,nu) - 1, pf(x^2, 1,nu)),+ ## upper tails:+ all.equal(2*pt(x, nu, lower=FALSE),+ pf(x^2, 1,nu, lower=FALSE)))>> ## 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}> 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>>>> 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 115 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>> ## Don't show:> od <- options(digits = 5)> ## End(Don't show)> 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.51265beta : 0.0094977gamma: 0.47289Coefficients:[,1]a 364.76162b 0.12474s1 0.22153s2 0.95528s3 1.59847s4 2.87580s5 3.28201s6 2.44070s7 0.89694s8 -1.37964s9 -3.41124s10 -3.25702s11 -1.91349s12 -0.58442> 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.27559beta : 0.032693gamma: 0.87073Coefficients:[,1]a 469.32322b 3.02154s1 0.94646s2 0.88292s3 0.97174s4 1.03048s5 1.04769s6 1.18053s7 1.35908s8 1.33317s9 1.10834s10 0.98688s11 0.83613s12 0.92099> 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)> ## Don't show:> options(od)> ## End(Don't show)>>>> 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.117030 0.4193747 0.7821884 0.9635952[2,] 0 0.0004113534 0.01295763 0.103661 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("KalmanLike")> ### * KalmanLike>> flush(stderr()); flush(stdout())>> ### Name: KalmanLike> ### Title: Kalman Filtering> ### Aliases: KalmanLike KalmanRun KalmanSmooth KalmanForecast makeARIMA> ### Keywords: ts>> ### ** Examples>> ## an ARIMA fit> fit3 <- arima(presidents, c(3, 0, 0))> predict(fit3, 12)$predQtr1 Qtr2 Qtr3 Qtr41975 29.84194 34.41014 39.30815 43.027791976 46.18808 48.56947 50.44866 51.860641977 52.94295 53.75521 54.37019 54.83150$seQtr1 Qtr2 Qtr3 Qtr41975 9.00655 11.25606 13.43389 14.515161976 15.25538 15.65611 15.90158 16.037921977 16.11764 16.16229 16.18785 16.20220> ## reconstruct this> pr <- KalmanForecast(12, fit3$model)> pr$pred + fit3$coef[4][1] 29.84194 34.41014 39.30815 43.02779 46.18808 48.56947 50.44866 51.86064[9] 52.94295 53.75521 54.37019 54.83150> sqrt(pr$var * fit3$sigma2)[1] 9.00655 11.25606 13.43389 14.51516 15.25538 15.65611 15.90158 16.03792[9] 16.11764 16.16229 16.18785 16.20220> ## and now do it year by year> mod <- fit3$model> for(y in 1:3) {+ pr <- KalmanForecast(4, mod, TRUE)+ print(list(pred = pr$pred + fit3$coef["intercept"],+ se = sqrt(pr$var * fit3$sigma2)))+ mod <- attr(pr, "mod")+ }$pred[1] 29.84194 34.41014 39.30815 43.02779$se[1] 9.00655 11.25606 13.43389 14.51516$pred[1] 46.18808 48.56947 50.44866 51.86064$se[1] 15.25538 15.65611 15.90158 16.03792$pred[1] 52.94295 53.75521 54.37019 54.83150$se[1] 16.11764 16.16229 16.18785 16.20220>>>> 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 0b 0 0 0 0 1 1 1 2 2 3c 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 101 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")>> ## The (limit) case lambda = 0 :> stopifnot(identical(dpois(0,0), 1),+ identical(ppois(0,0), 1),+ identical(qpois(1,0), 0))>>>> 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)$SSDcondcond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NPdeg0NA 29160 30600 26640 23760 32400 25560deg4NA 30600 66600 32400 7200 36000 30600deg8NA 26640 32400 56160 41040 57600 69840deg0NP 23760 7200 41040 70560 72000 63360deg4NP 32400 36000 57600 72000 108000 100800deg8NP 25560 30600 69840 63360 100800 122760$calllm(formula = reacttime ~ 1)$df[1] 9attr(,"class")[1] "SSD"> estVar(mlmfit)condcond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NPdeg0NA 3240 3400 2960 2640 3600 2840deg4NA 3400 7400 3600 800 4000 3400deg8NA 2960 3600 6240 4560 6400 7760deg0NP 2640 800 4560 7840 8000 7040deg4NP 3600 4000 6400 8000 12000 11200deg8NP 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> local({+ 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.838463attr(,"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 resp0 lrc94.128204 -8.250753 -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 ‘ ’ 1Residual standard error: 0.7493 on 3 degrees of freedom>> ## Visualize the SSasymp() model parametrization :>> xx <- seq(-.3, 5, len = 101)> ## Asym + (R0-Asym) * exp(-exp(lrc)* x) :> yy <- 5 - 4 * exp(-xx / exp(3/4))> stopifnot( all.equal(yy, SSasymp(xx, Asym = 5, R0 = 1, lrc = -3/4)) )> require(graphics)> op <- par(mar = c(0, .2, 4.1, 0))> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,5.2), xlim = c(-.3, 5),+ xlab = "", ylab = "", lwd = 2,+ main = quote("Parameters in the SSasymp model " ~+ {f[phi](x) == phi[1] + (phi[2]-phi[1])*~e^{-e^{phi[3]}*~x}}))> mtext(quote(list(phi[1] == "Asym", phi[2] == "R0", phi[3] == "lrc")))> 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 = 3)> arrows(c(0.35, 0.65), 1,+ c(0 , 1 ), 1, length = 0.08, angle = 25); text(0.5, 1, quote(1))> y0 <- 1 + 4*exp(-3/4) ; t.5 <- log(2) / exp(-3/4) ; AR2 <- 3 # (Asym + R0)/2> segments(c(1, 1), c( 1, y0),+ c(1, 0), c(y0, 1), lty = 2, lwd = 0.75)> text(1.1, 1/2+y0/2, quote((phi[1]-phi[2])*e^phi[3]), adj = c(0,.5))> axis(2, at = c(1,AR2,5), labels= expression(phi[2], frac(phi[1]+phi[2],2), phi[1]),+ pos=0, las=1)> arrows(c(.6,t.5-.6), AR2,+ c(0, t.5 ), AR2, length = 0.08, angle = 25)> text( t.5/2, AR2, quote(t[0.5]))> text( t.5 +.4, AR2,+ quote({f(t[0.5]) == frac(phi[1]+phi[2],2)}~{} %=>% {}~~+ {t[0.5] == frac(log(2), e^{phi[3]})}), adj = c(0, 0.5))> par(op)>>>> 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> local({ 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.00000attr(,"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 lrc c038.139782 -4.380647 51.223238> ## 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 ‘ ’ 1Residual standard error: 1.663 on 4 degrees of freedom>> ## Visualize the SSasympOff() model parametrization :>> xx <- seq(0.25, 8, by=1/16)> yy <- 5 * (1 - exp(-(xx - 3/4)*0.4))> stopifnot( all.equal(yy, SSasympOff(xx, Asym = 5, lrc = log(0.4), c0 = 3/4)) )> require(graphics)> op <- par(mar = c(0, 0, 4.0, 0))> plot(xx, yy, type = "l", axes = FALSE, ylim = c(-.5,6), xlim = c(-1, 8),+ xlab = "", ylab = "", lwd = 2,+ main = "Parameters in the SSasympOff model")> mtext(quote(list(phi[1] == "Asym", phi[2] == "lrc", phi[3] == "c0")))> 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 = 3)> arrows(-0.8, c(2.1, 2.9),+ -0.8, c(0 , 5 ), length = 0.1, angle = 25)> text (-0.8, 2.5, quote(phi[1]))> segments(3/4, -.2, 3/4, 1.6, lty = 2)> text (3/4, c(-.3, 1.7), quote(phi[3]))> arrows(c(1.1, 1.4), -.15,+ c(3/4, 7/4), -.15, length = 0.07, angle = 25)> text (3/4 + 1/2, -.15, quote(1))> segments(c(3/4, 7/4, 7/4), c(0, 0, 2), # 5 * exp(log(0.4)) = 2+ c(7/4, 7/4, 3/4), c(0, 2, 0), lty = 2, lwd = 2)> text( 7/4 +.1, 2./2, quote(phi[1]*e^phi[2]), adj = c(0, .5))> par(op)>>>> 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>> ## Visualize the SSasympOrig() model parametrization :>> xx <- seq(0, 5, len = 101)> yy <- 5 * (1- exp(-xx * log(2)))> stopifnot( all.equal(yy, SSasympOrig(xx, Asym = 5, lrc = log(log(2)))) )>> require(graphics)> op <- par(mar = c(0, 0, 3.5, 0))> plot(xx, yy, type = "l", axes = FALSE, ylim = c(0,5), xlim = c(-1/4, 5),+ xlab = "", ylab = "", lwd = 2,+ main = quote("Parameters in the SSasympOrig model"~~ f[phi](x)))> mtext(quote(list(phi[1] == "Asym", phi[2] == "lrc")))> 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 = 3)> axis(2, at = 5*c(1/2,1), labels= expression(frac(phi[1],2), phi[1]), pos=0, las=1)> arrows(c(.3,.7), 5/2,+ c(0, 1 ), 5/2, length = 0.08, angle = 25)> text( 0.5, 5/2, quote(t[0.5]))> text( 1 +.4, 5/2,+ quote({f(t[0.5]) == frac(phi[1],2)}~{} %=>% {}~~{t[0.5] == frac(log(2), e^{phi[2]})}),+ adj = c(0, 0.5))> par(op)>>>> 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.06780767attr(,"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 lrc22.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.12698lrc2 -1.7878 0.7871 -2.271 0.05737 .---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1Residual standard error: 0.04103 on 7 degrees of freedom>> ## Show the model components visually> require(graphics)>> xx <- seq(0, 5, len = 101)> y1 <- 3.5 * exp(-4*xx)> y2 <- 1.5 * exp(-xx)> plot(xx, y1 + y2, type = "l", lwd=2, ylim = c(-0.2,6), xlim = c(0, 5),+ main = "Components of the SSbiexp model")> lines(xx, y1, lty = 2, col="tomato"); abline(v=0, h=0, col="gray40")> lines(xx, y2, lty = 3, col="blue2" )> legend("topright", c("y1+y2", "y1 = 3.5 * exp(-4*x)", "y2 = 1.5 * exp(-x)"),+ lty=1:3, col=c("black","tomato","blue2"), bty="n")> axis(2, pos=0, at = c(3.5, 1.5), labels = c("A1","A2"), las=2)>> ## and how you could have got their sum via SSbiexp():> ySS <- SSbiexp(xx, 3.5, log(4), 1.5, log(1))> ## --- ---> stopifnot(all.equal(y1+y2, ySS, tolerance = 1e-15))>>>> 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, ]> with(Theoph.1, SSfol(Dose, 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> with(Theoph.1, local({ lKe <- -2.5; lKa <- 0.5; lCl <- -3+ SSfol(Dose, 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.943593attr(,"gradient")lKe lKa lCl[1,] 0.000000 0.00000000 0.000000[2,] 2.190284 1.78781716 -2.214486[3,] 3.825518 2.35519507 -3.930988[4,] 4.952713 1.75648252 -5.261945[5,] 4.976520 0.53458070 -5.659813[6,] 3.752822 -0.18560297 -5.084852[7,] 2.906859 -0.22729852 -4.587699[8,] 1.861771 -0.20447579 -3.916808[9,] 1.027129 -0.17383515 -3.318395[10,] 0.148370 -0.13513891 -2.579204[11,] -0.894541 -0.04944021 -0.943593> getInitial(conc ~ SSfol(Dose, Time, lKe, lKa, lCl), data = Theoph.1)lKe lKa lCl-2.994845 0.609169 -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 ‘ ’ 1Residual 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> local({+ 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.70240attr(,"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 scal27.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 ‘ ’ 1Residual standard error: 2.351 on 8 degrees of freedom>> ## Visualizing the SSfpl() parametrization> xx <- seq(-0.5, 5, len = 101)> yy <- 1 + 4 / (1 + exp((2-xx))) # == SSfpl(xx, *) :> stopifnot( all.equal(yy, SSfpl(xx, A = 1, B = 5, xmid = 2, scal = 1)) )> require(graphics)> op <- 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")> mtext(quote(list(phi[1] == "A", phi[2] == "B", phi[3] == "xmid", phi[4] == "scal")))> 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 = c(1, 5), lty = 3)> arrows(-0.8, c(2.1, 2.9),+ -0.8, c(0, 5 ), length = 0.1, angle = 25)> text (-0.8, 2.5, quote(phi[1]))> arrows(-0.3, c(1/4, 3/4),+ -0.3, c(0, 1 ), length = 0.07, angle = 25)> text (-0.3, 0.5, quote(phi[2]))> text(2, -.1, quote(phi[3]))> segments(c(2,3,3), c(0,3,4), # SSfpl(x = xmid = 2) = 3+ c(2,3,2), c(3,4,3), lty = 2, lwd = 0.75)> arrows(c(2.3, 2.7), 3,+ c(2.0, 3 ), 3, length = 0.08, angle = 25)> text( 2.5, 3, quote(phi[4])); text(3.1, 3.5, "1")> par(op)>>>> 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)> SSgompertz(log(DNase.1$conc), 4.5, 2.3, 0.7) # response only[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> local({ 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.76786902attr(,"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 b34.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 ‘ ’ 1Residual standard error: 0.02684 on 13 degrees of freedom> plot(density ~ log(conc), DNase.1, # xlim = c(0, 21),+ main = "SSgompertz() fit to DNase.1")> ux <- par("usr")[1:2]; x <- seq(ux[1], ux[2], length.out=250)> lines(x, do.call(SSgompertz, c(list(x=x), coef(fm1))), col = "red", lwd=2)> As <- coef(fm1)[["Asym"]]; abline(v = 0, h = 0, lty = 3)> axis(2, at= exp(-coef(fm1)[["b2"]]), quote(e^{-b[2]}), las=1, pos=0)>>>> graphics::par(get("par.postscript", pos = 'CheckExEnv'))> cleanEx()> nameEx("SSlogis")> ### * SSlogis>> flush(stderr()); flush(stdout())>> ### Name: SSlogis> ### Title: Self-Starting Nls Logistic Model> ### Aliases: SSlogis> ### Keywords: models>> ### ** Examples>> dwlg1 <- data.frame(Prop = c(rep(0,5), 2, 5, rep(9, 9)), end = 1:16)> iPar <- getInitial(Prop ~ SSlogis(end, Asym, xmid, scal), data = dwlg1)> ## failed in R <= 3.4.2 (because of the '0's in 'Prop')> stopifnot(all.equal(tol = 1e-6,+ iPar, c(Asym = 9.0678, xmid = 6.79331, scal = 0.499934)))>> ## Visualize the SSlogis() model parametrization :> xx <- seq(-0.75, 5, by=1/32)> yy <- 5 / (1 + exp((2-xx)/0.6)) # == SSlogis(xx, *):> stopifnot( all.equal(yy, SSlogis(xx, Asym = 5, xmid = 2, scal = 0.6)) )> require(graphics)> op <- par(mar = c(0.5, 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")> mtext(quote(list(phi[1] == "Asym", phi[2] == "xmid", phi[3] == "scal")))> 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 = 3)> arrows(-0.8, c(2.1, 2.9),+ -0.8, c(0, 5 ), length = 0.1, angle = 25)> text (-0.8, 2.5, quote(phi[1]))> segments(c(2,2.6,2.6), c(0, 2.5,3.5), # NB. SSlogis(x = xmid = 2) = 2.5+ c(2,2.6,2 ), c(2.5,3.5,2.5), lty = 2, lwd = 0.75)> text(2, -.1, quote(phi[2]))> arrows(c(2.2, 2.4), 2.5,+ c(2.0, 2.6), 2.5, length = 0.08, angle = 25)> text( 2.3, 2.5, quote(phi[3])); text(2.7, 3, "1")> par(op)>>>> 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> local({ 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.30435attr(,"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 K212.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 ‘ ’ 1Residual 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) # The same indeed: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 ‘ ’ 1Residual standard error: 10.93 on 10 degrees of freedom> stopifnot(all.equal(coef(summary(fm1)), coef(summary(fm2))))>> ## Visualize the SSmicmen() Michaelis-Menton model parametrization :>> xx <- seq(0, 5, len = 101)> yy <- 5 * xx/(1+xx)> stopifnot(all.equal(yy, SSmicmen(xx, Vm = 5, K = 1)))> require(graphics)> op <- par(mar = c(0, 0, 3.5, 0))> plot(xx, yy, type = "l", lwd = 2, ylim = c(-1/4,6), xlim = c(-1, 5),+ ann = FALSE, axes = FALSE, main = "Parameters in the SSmicmen model")> mtext(quote(list(phi[1] == "Vm", phi[2] == "K")))> 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 = 3)> arrows(-0.8, c(2.1, 2.9),+ -0.8, c(0, 5 ), length = 0.1, angle = 25)> text( -0.8, 2.5, quote(phi[1]))> segments(1, 0, 1, 2.7, lty = 2, lwd = 0.75)> text(1, 2.7, quote(phi[2]))> par(op)>>>> 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> local({ 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.97023attr(,"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> ## IGNORE_RDIFF_BEGIN> getInitial(weight ~ SSweibull(Time, Asym, Drop, lrc, pwr), data = Chick.6)Asym Drop lrc pwr158.501204 110.997081 -5.993421 2.646141> ## IGNORE_RDIFF_END> ## 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 ‘ ’ 1Residual standard error: 2.061 on 7 degrees of freedom> ## Data and Fit:> plot(weight ~ Time, Chick.6, xlim = c(0, 21), main = "SSweibull() fit to Chick.6")> ux <- par("usr")[1:2]; x <- seq(ux[1], ux[2], length.out=250)> lines(x, do.call(SSweibull, c(list(x=x), coef(fm1))), col = "red", lwd=2)> As <- coef(fm1)[["Asym"]]; abline(v = 0, h = c(As, As - coef(fm1)[["Drop"]]), lty = 3)>>>> graphics::par(get("par.postscript", pos = 'CheckExEnv'))> 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 = paste0("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 epsilon0.00037 0.07199> 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 epsilon0.000e+00 1.733e-05 7.137e-04 3.678e-04> par(mfrow = c(4, 1)) # to give appropriate aspect ratio for next plot.> 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 10 value -0.936176final value -0.936176convergedCall:StructTS(x = log10(UKgas), type = "BSM", fixed = c(0.1, 0.001, NA, NA), optim.control = list(trace = TRUE))Variances:level slope seas epsilon0.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> ### 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 451 450.7 3.339 0.07361 .tension 2 2034 1017.1 7.537 0.00138 **Residuals 50 6748 135.0---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1> TukeyHSD(fm1, "tension", ordered = TRUE)Tukey multiple comparisons of means95% family-wise confidence levelfactor levels have been orderedFit: aov(formula = breaks ~ wool + tension, data = warpbreaks)$tensiondiff lwr upr p adjM-H 4.722222 -4.6311985 14.07564 0.4474210L-H 14.722222 5.3688015 24.07564 0.0011218L-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, tolerance = 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))))U0 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 231 2 4 5 5 5 7 12 13 14 12 23 16 9 13 16 13 11 14 1 1 2 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 valuesQtr1 Qtr2 Qtr3 Qtr41945 NA 87 82 751946 63 50 43 321947 35 60 54 551948 36 39 NA NA1949 69 57 57 511950 45 37 46 391951 36 24 32 231952 25 32 NA 321953 59 74 75 601954 71 61 71 571955 71 68 79 731956 76 71 67 751957 79 62 63 571958 60 49 48 521959 57 62 61 661960 71 62 61 571961 72 83 71 781962 79 71 62 741963 76 64 62 571964 80 73 69 691965 71 64 69 621966 63 46 56 441967 44 52 38 461968 36 49 35 441969 59 65 65 561970 66 53 61 521971 51 48 54 491972 49 61 NA NA1973 68 44 40 271974 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 31.0000000 0.6923077 0.5769231 0.3538462> acf2AR(Acf)1 2 3ar(1) 0.6923077 0.0000 0.0ar(2) 0.5625000 0.1875 0.0ar(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)> ## following example(swiss)> lm1 <- lm(Fertility ~ ., data = swiss)> add1(lm1, ~ I(Education^2) + .^2)Single term additionsModel:Fertility ~ Agriculture + Examination + Education + Catholic +Infant.MortalityDf Sum of Sq RSS AIC<none> 2105 191I(Education^2) 1 11.8 2093 192Agriculture:Examination 1 10.7 2094 192Agriculture:Education 1 1.8 2103 193Agriculture:Catholic 1 75.0 2030 191Agriculture:Infant.Mortality 1 4.4 2101 193Examination:Education 1 48.7 2056 192Examination:Catholic 1 40.8 2064 192Examination:Infant.Mortality 1 65.9 2039 191Education:Catholic 1 278.2 1827 186Education:Infant.Mortality 1 93.0 2012 191Catholic:Infant.Mortality 1 2.4 2103 193> drop1(lm1, test = "F") # So called 'type II' anovaSingle term deletionsModel:Fertility ~ Agriculture + Examination + Education + Catholic +Infant.MortalityDf Sum of Sq RSS AIC F value Pr(>F)<none> 2105 191Agriculture 1 308 2413 195 5.99 0.0187 *Examination 1 53 2158 190 1.03 0.3155Education 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>> ## following example(glm)> ## Don't show:> example(glm, echo = FALSE)> ## End(Don't show)> drop1(glm.D93, test = "Chisq")Single term deletionsModel:counts ~ outcome + treatmentDf Deviance AIC LRT Pr(>Chi)<none> 5.13 56.8outcome 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' familySingle term deletionsModel:counts ~ outcome + treatmentDf Deviance AIC F value Pr(>F)<none> 5.13 56.8outcome 2 10.58 58.2 2.13 0.23treatment 2 5.13 52.8 0.00 1.00> add1(glm.D93, scope = ~outcome*treatment, test = "Rao") ## Pearson Chi-squareSingle term additionsModel:counts ~ outcome + treatmentDf Deviance AIC Rao score Pr(>Chi)<none> 5.13 56.8outcome:treatment 4 0.00 59.6 5.17 0.27> ## 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 = BlackBeeAye Buzz HumOui 7 4Si 5 7Yes 7 7, , Sea = DeadBeeAye Buzz HumOui 8 7Si 10 7Yes 10 3, , Sea = RedBeeAye Buzz HumOui 2 12Si 4 7Yes 8 7, , Sea = WhiteBeeAye Buzz HumOui 7 12Si 13 10Yes 6 7> (aA <- addmargins(A)), , Sea = BlackBeeAye Buzz Hum SumOui 7 4 11Si 5 7 12Yes 7 7 14Sum 19 18 37, , Sea = DeadBeeAye Buzz Hum SumOui 8 7 15Si 10 7 17Yes 10 3 13Sum 28 17 45, , Sea = RedBeeAye Buzz Hum SumOui 2 12 14Si 4 7 11Yes 8 7 15Sum 14 26 40, , Sea = WhiteBeeAye Buzz Hum SumOui 7 12 19Si 13 10 23Yes 6 7 13Sum 26 29 55, , Sea = SumBeeAye Buzz Hum SumOui 24 35 59Si 32 31 63Yes 31 24 55Sum 87 90 177> ## Don't show:> stopifnot(is.table(aA))> ## End(Don't show)> ftable(A)Sea Black Dead Red WhiteAye BeeOui Buzz 7 8 2 7Hum 4 7 12 12Si Buzz 5 10 4 13Hum 7 7 7 10Yes Buzz 7 10 8 6Hum 7 3 7 7> ftable(aA)Sea Black Dead Red White SumAye BeeOui Buzz 7 8 2 7 24Hum 4 7 12 12 35Sum 11 15 14 19 59Si Buzz 5 10 4 13 32Hum 7 7 7 10 31Sum 12 17 11 23 63Yes Buzz 7 10 8 6 31Hum 7 3 7 7 24Sum 14 13 15 13 55Sum Buzz 19 28 14 26 87Hum 18 17 26 29 90Sum 37 45 40 55 177>> # Non-commutative functions - note differences between resulting tables:> ftable( addmargins(A, c(3, 1),+ FUN = list(list(Min = min, Max = max),+ Sum = sum)))Margins computed over dimensionsin the following order:1: Sea2: AyeSea Black Dead Red White Min MaxAye BeeOui Buzz 7 8 2 7 2 8Hum 4 7 12 12 4 12Si Buzz 5 10 4 13 4 13Hum 7 7 7 10 7 10Yes Buzz 7 10 8 6 6 10Hum 7 3 7 7 3 7Sum Buzz 19 28 14 26 12 31Hum 18 17 26 29 14 29> ftable( addmargins(A, c(1, 3),+ FUN = list(Sum = sum,+ list(Min = min, Max = max))))Margins computed over dimensionsin the following order:1: Aye2: SeaSea Black Dead Red White Min MaxAye BeeOui Buzz 7 8 2 7 2 8Hum 4 7 12 12 4 12Si Buzz 5 10 4 13 4 13Hum 7 7 7 10 7 10Yes Buzz 7 10 8 6 6 10Hum 7 3 7 7 3 7Sum Buzz 19 28 14 26 14 28Hum 18 17 26 29 17 29>> # 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)BeeSea Buzz HumBlack 21.8 20.0Dead 32.2 18.9Red 16.1 28.9White 29.9 32.2All 100.0 100.0N 87.0 90.0> round(sweep(addmargins(B, 2, list(list(All = sum, N = sqsm))), 1,+ apply(B, 1, sum)/100, "/"), 1)BeeSea Buzz Hum All NBlack 51.4 48.6 100.0 37.0Dead 62.2 37.8 100.0 45.0Red 35.0 65.0 100.0 40.0White 47.3 52.7 100.0 55.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 TotalSeaBlack 21.8 20.0 20.9Dead 32.2 18.9 25.4Red 16.1 28.9 22.6White 29.9 32.2 31.1All 100.0 100.0 100.0N 87.0 90.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 = ".")yx 1 2 3 4 5 6 7 Sum1 2 . . . 1 . . 32 2 1 . . . 1 . 43 . 1 . . 1 1 . 34 . . . . . . 1 15 1 . . 1 . . 1 36 . . 1 1 1 . . 37 . 1 . . 1 1 . 3Sum 5 3 1 2 4 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 Grad1 Northeast 5495.111 4570.222 1.000000 71.26444 4.722222 53.966672 South 4208.125 4011.938 1.737500 69.70625 10.581250 44.343753 North Central 4803.000 4611.083 0.700000 71.76667 5.275000 54.516674 West 2915.308 4702.615 1.023077 71.23462 7.215385 62.00000Frost Area1 132.7778 18141.002 64.6250 54605.123 138.8333 62652.004 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 Murder1 Northeast FALSE 8802.8000 4780.400 1.1800000 71.12800 5.5800002 South FALSE 4208.1250 4011.938 1.7375000 69.70625 10.5812503 North Central FALSE 7233.8333 4633.333 0.7833333 70.95667 8.2833334 West FALSE 4582.5714 4550.143 1.2571429 71.70000 6.8285715 Northeast TRUE 1360.5000 4307.500 0.7750000 71.43500 3.6500006 North Central TRUE 2372.1667 4588.833 0.6166667 72.57667 2.2666677 West TRUE 970.1667 4880.500 0.7500000 70.69167 7.666667HS Grad Frost Area1 52.06000 110.6000 21838.602 44.34375 64.6250 54605.123 53.36667 120.0000 56736.504 60.11429 51.0000 91863.715 56.35000 160.5000 13519.006 55.66667 157.6667 68567.507 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 v21 1 95 5 552 2 95 7 773 1 99 5 554 2 99 NA NA5 big damp 3 336 blue dry 3 337 red red 4 448 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 v21 1 95 5.0 55.02 2 95 7.0 77.03 1 99 5.0 55.04 2 99 NA NA5 big damp 3.0 33.06 blue dry 3.0 33.07 red red 4.0 44.08 red wet 1.0 11.09 12 <NA> 9.0 99.010 <NA> <NA> 7.5 82.5>>> ## Formulas, one ~ one, one ~ many, many ~ one, and many ~ many:> aggregate(weight ~ feed, data = chickwts, mean)feed weight1 casein 323.58332 horsebean 160.20003 linseed 218.75004 meatmeal 276.90915 soybean 246.42866 sunflower 328.9167> aggregate(breaks ~ wool + tension, data = warpbreaks, mean)wool tension breaks1 A L 44.555562 B L 28.222223 A M 24.000004 B M 28.777785 A H 24.555566 B H 18.77778> aggregate(cbind(Ozone, Temp) ~ Month, data = airquality, mean)Month Ozone Temp1 5 23.61538 66.730772 6 29.44444 78.222223 7 59.11538 83.884624 8 59.96154 83.961545 9 31.44828 76.89655> aggregate(cbind(ncases, ncontrols) ~ alcgp + tobgp, data = esoph, sum)alcgp tobgp ncases ncontrols1 0-39g/day 0-9g/day 9 2612 40-79 0-9g/day 34 1793 80-119 0-9g/day 19 614 120+ 0-9g/day 16 245 0-39g/day 10-19 10 846 40-79 10-19 17 857 80-119 10-19 19 498 120+ 10-19 12 189 0-39g/day 20-29 5 4210 40-79 20-29 15 6211 80-119 20-29 6 1612 120+ 20-29 7 1213 0-39g/day 30+ 5 2814 40-79 30+ 9 2915 80-119 30+ 7 1216 120+ 30+ 10 13>> ## Dot notation:> aggregate(. ~ Species, data = iris, mean)Species Sepal.Length Sepal.Width Petal.Length Petal.Width1 setosa 5.006 3.428 1.462 0.2462 versicolor 5.936 2.770 4.260 1.3263 virginica 6.588 2.974 5.552 2.026> aggregate(len ~ ., data = ToothGrowth, mean)supp dose len1 OJ 0.5 13.232 VC 0.5 7.983 OJ 1.0 22.704 VC 1.0 16.775 OJ 2.0 26.066 VC 2.0 26.14>> ## Often followed by xtabs():> ag <- aggregate(len ~ ., data = ToothGrowth, mean)> xtabs(len ~ ., data = ag)dosesupp 0.5 1 2OJ 13.23 22.70 26.06VC 7.98 16.77 26.14>>> ## Compute the average annual approval ratings for American presidents.> aggregate(presidents, nfrequency = 1, FUN = mean)Time Series:Start = 1945End = 1974Frequency = 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 = 1945End = 1974Frequency = 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>>> 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> ### Keywords: models regression>> ### ** Examples>> ## --- Continuing the Example from '?glm':> ## Don't show:> require(utils)> example("glm", echo = FALSE)> ## End(Don't show)> anova(glm.D93)Analysis of Deviance TableModel: poisson, link: logResponse: countsTerms added sequentially (first to last)Df Deviance Resid. Df Resid. DevNULL 8 10.5814outcome 2 5.4523 6 5.1291treatment 2 0.0000 4 5.1291> anova(glm.D93, test = "Cp")Analysis of Deviance TableModel: poisson, link: logResponse: countsTerms added sequentially (first to last)Df Deviance Resid. Df Resid. Dev CpNULL 8 10.5814 12.581outcome 2 5.4523 6 5.1291 11.129treatment 2 0.0000 4 5.1291 15.129> anova(glm.D93, test = "Chisq")Analysis of Deviance TableModel: poisson, link: logResponse: countsTerms added sequentially (first to last)Df Deviance Resid. Df Resid. Dev Pr(>Chi)NULL 8 10.5814outcome 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> glm.D93a <-+ update(glm.D93, ~treatment*outcome) # equivalent to Pearson Chi-square> anova(glm.D93, glm.D93a, test = "Rao")Analysis of Deviance TableModel 1: counts ~ outcome + treatmentModel 2: counts ~ treatment + outcome + treatment:outcomeResid. Df Resid. Dev Df Deviance Rao Pr(>Chi)1 4 5.12912 0 0.0000 4 5.1291 5.1732 0.27>>>> 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 TableResponse: srDf 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.3593551ddpi 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 TableModel 1: sr ~ 1Model 2: sr ~ pop15Model 3: sr ~ pop15 + pop75Model 4: sr ~ pop15 + pop75 + dpiModel 5: sr ~ pop15 + pop75 + dpi + ddpiRes.Df RSS Df Sum of Sq F Pr(>F)1 49 983.632 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.35935515 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 orderAnalysis of Variance TableModel 1: sr ~ pop15 + pop75 + dpi + ddpiModel 2: sr ~ pop15 + pop75Model 3: sr ~ 1Res.Df RSS Df Sum of Sq F Pr(>F)1 45 650.712 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> ### Keywords: regression models multivariate>> ### ** Examples>> require(graphics)> utils::example(SSD) # Brings in the mlmfit and reacttime objectsSSD> # Lifted from Baron+Li:SSD> # "Notes on the use of R for psychology experiments and questionnaires"SSD> # Maxwell and Delaney, p. 497SSD> 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)$SSDcondcond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NPdeg0NA 29160 30600 26640 23760 32400 25560deg4NA 30600 66600 32400 7200 36000 30600deg8NA 26640 32400 56160 41040 57600 69840deg0NP 23760 7200 41040 70560 72000 63360deg4NP 32400 36000 57600 72000 108000 100800deg8NP 25560 30600 69840 63360 100800 122760$calllm(formula = reacttime ~ 1)$df[1] 9attr(,"class")[1] "SSD"SSD> estVar(mlmfit)condcond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NPdeg0NA 3240 3400 2960 2640 3600 2840deg4NA 3400 7400 3600 800 4000 3400deg8NA 2960 3600 6240 4560 6400 7760deg0NP 2640 800 4560 7840 8000 7040deg4NP 3600 4000 6400 8000 12000 11200deg8NP 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 TableModel 1: reacttime ~ 1Model 2: reacttime ~ 1 - 1Contrasts orthogonal to~1Res.Df Df Gen.var. Pillai approx F num Df den Df Pr(>F)1 9 1249.62 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 TableModel 1: reacttime ~ 1Model 2: reacttime ~ 1 - 1Contrasts orthogonal to~1Greenhouse-Geisser epsilon: 0.4855Huynh-Feldt epsilon: 0.6778Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr1 9 1249.62 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 TableModel 1: reacttime ~ 1Model 2: reacttime ~ 1 - 1Contrasts orthogonal to~deg + noiseGreenhouse-Geisser epsilon: 0.904Huynh-Feldt epsilon: 1.118Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr1 9 316.582 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 TableModel 1: reacttime ~ 1Model 2: reacttime ~ 1 - 1Contrasts orthogonal to~noiseContrasts spanned by~deg + noiseGreenhouse-Geisser epsilon: 0.9616Huynh-Feldt epsilon: 1.2176Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr1 9 1007.02 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 TableModel 1: reacttime ~ 1Model 2: reacttime ~ 1 - 1Contrasts orthogonal to~degContrasts spanned by~deg + noiseGreenhouse-Geisser epsilon: 1Huynh-Feldt epsilon: 1Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr1 9 14102 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 TableModel 1: reacttime ~ fModel 2: reacttime ~ 1Model 3: reacttime ~ 1 - 1Contrasts orthogonal to~1Greenhouse-Geisser epsilon: 0.4691Huynh-Feldt epsilon: 0.6758Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr1 8 1337.32 9 1 1249.6 0.2743 5 40 0.92452 0.79608 0.864563 10 1 2013.2 34.9615 5 40 0.00000 0.00000 0.00000> anova(mlmfit2, X = ~1, test = "Spherical")Analysis of Variance TableContrasts orthogonal to~1Greenhouse-Geisser epsilon: 0.4691Huynh-Feldt epsilon: 0.6758Df F num Df den Df Pr(>F) G-G Pr H-F Pr(Intercept) 1 34.9615 5 40 0.00000 0.00000 0.00000f 1 0.2743 5 40 0.92452 0.79608 0.86456Residuals 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 tiesAnsari-Bradley testdata: ramsay and jung.parekhAB = 185.5, p-value = 0.1815alternative hypothesis: true ratio of scales is not equal to 1>> ansari.test(rnorm(10), rnorm(10, 0, 2), conf.int = TRUE)Ansari-Bradley testdata: rnorm(10) and rnorm(10, 0, 2)AB = 69, p-value = 0.03831alternative hypothesis: true ratio of scales is not equal to 195 percent confidence interval:0.1852324 0.9712857sample estimates:ratio of scales0.4007458>> ## try more points - failed in 2.4.1> ansari.test(rnorm(100), rnorm(100, 0, 2), conf.int = TRUE)Ansari-Bradley testdata: rnorm(100) and rnorm(100, 0, 2)AB = 6180, p-value = 3.347e-08alternative hypothesis: true ratio of scales is not equal to 195 percent confidence interval:0.3330596 0.5693532sample estimates:ratio of scales0.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.>> ## 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:KSum of Squares 343.2950 189.2817 8.4017 95.2017 21.2817 33.1350 0.4817Deg. of Freedom 5 1 1 1 1 1 1ResidualsSum of Squares 185.2867Deg. of Freedom 12Residual standard error: 3.9294471 out of 13 effects not estimableEstimated effects are balanced> coefficients(npk.aov)(Intercept) block1 block2 block3 block4 block554.8750000 1.7125000 1.6791667 -1.8229167 -1.0137500 0.2950000N1 P1 K1 N1:P1 N1:K1 P1:K12.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 ResidualsSum of Squares 343.2950 189.2817 8.4017 95.2017 21.2817 218.9033Deg. of Freedom 5 1 1 1 1 14Residual standard error: 3.954232Estimated 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 ResidualsSum of Squares 343.2950 189.2817 8.4017 21.2817 95.2017 218.9033Deg. of Freedom 5 1 1 1 1 14Residual standard error: 3.954232Estimated effects are balanced>>> ## as a test, not particularly sensible statistically> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)> npk.aovECall:aov(formula = yield ~ N * P * K + Error(block), data = npk)Grand Mean: 54.875Stratum 1: blockTerms:N:P:K ResidualsSum of Squares 37.00167 306.29333Deg. of Freedom 1 4Residual standard error: 8.750619Estimated effects are balancedStratum 2: WithinTerms:N P K N:P N:K P:KSum of Squares 189.28167 8.40167 95.20167 21.28167 33.13500 0.48167Deg. of Freedom 1 1 1 1 1 1ResidualsSum of Squares 185.28667Deg. of Freedom 12Residual standard error: 3.929447Estimated effects are balanced> ## IGNORE_RDIFF_BEGIN> summary(npk.aovE)Error: blockDf Sum Sq Mean Sq F value Pr(>F)N:P:K 1 37.0 37.00 0.483 0.525Residuals 4 306.3 76.57Error: WithinDf Sum Sq Mean Sq F value Pr(>F)N 1 189.28 189.28 12.259 0.00437 **P 1 8.40 8.40 0.544 0.47490K 1 95.20 95.20 6.166 0.02880 *N:P 1 21.28 21.28 1.378 0.26317N:K 1 33.14 33.14 2.146 0.16865P:K 1 0.48 0.48 0.031 0.86275Residuals 12 185.29 15.44---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1> ## IGNORE_RDIFF_END> options(op) # reset to previous>>>> base::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)>> ### Treatment of 'NA's -- are kept if na.rm=FALSE :>> xn <- 1:4> yn <- c(1,NA,3:4)> xout <- (1:9)/2> ## Default behavior (na.rm = TRUE): NA's omitted; extrapolation gives NA> data.frame(approx(xn,yn, xout))x y1 0.5 NA2 1.0 1.03 1.5 1.54 2.0 2.05 2.5 2.56 3.0 3.07 3.5 3.58 4.0 4.09 4.5 NA> data.frame(approx(xn,yn, xout, rule = 2))# -> *constant* extrapolationx y1 0.5 1.02 1.0 1.03 1.5 1.54 2.0 2.05 2.5 2.56 3.0 3.07 3.5 3.58 4.0 4.09 4.5 4.0> ## New (2019-2020) na.rm = FALSE: NA's are "kept"> data.frame(approx(xn,yn, xout, na.rm=FALSE, rule = 2))x y1 0.5 1.02 1.0 1.03 1.5 NA4 2.0 NA5 2.5 NA6 3.0 3.07 3.5 3.58 4.0 4.09 4.5 4.0> data.frame(approx(xn,yn, xout, na.rm=FALSE, rule = 2, method="constant"))x y1 0.5 12 1.0 13 1.5 14 2.0 NA5 2.5 NA6 3.0 37 3.5 38 4.0 49 4.5 4>> ## NA's in x[] are not allowed:> stopifnot(inherits( try( approx(yn,yn, na.rm=FALSE) ), "try-error"))Error in approx(yn, yn, na.rm = FALSE) :approx(x,y, .., na.rm=FALSE): NA values in x are not allowed>> ## Give a nice overview of all possibilities rule * method * na.rm :> ## ----------------------------- ==== ====== =====> ## extrapolations "N":= NA; "C":= Constant :> rules <- list(N=1, C=2, NC=1:2, CN=2:1)> methods <- c("constant","linear")> ry <- sapply(rules, function(R) {+ sapply(methods, function(M)+ sapply(setNames(,c(TRUE,FALSE)), function(na.)+ approx(xn, yn, xout=xout, method=M, rule=R, na.rm=na.)$y),+ simplify="array")+ }, simplify="array")> names(dimnames(ry)) <- c("x = ", "na.rm", "method", "rule")> dimnames(ry)[[1]] <- format(xout)> ftable(aperm(ry, 4:1)) # --> (4 * 2 * 2) x length(xout) = 16 x 9 matrixx = 0.5 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5rule method na.rmN constant TRUE NA 1.0 1.0 1.0 1.0 3.0 3.0 4.0 NAFALSE NA 1.0 1.0 NA NA 3.0 3.0 4.0 NAlinear TRUE NA 1.0 1.5 2.0 2.5 3.0 3.5 4.0 NAFALSE NA 1.0 NA NA NA 3.0 3.5 4.0 NAC constant TRUE 1.0 1.0 1.0 1.0 1.0 3.0 3.0 4.0 4.0FALSE 1.0 1.0 1.0 NA NA 3.0 3.0 4.0 4.0linear TRUE 1.0 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.0FALSE 1.0 1.0 NA NA NA 3.0 3.5 4.0 4.0NC constant TRUE NA 1.0 1.0 1.0 1.0 3.0 3.0 4.0 4.0FALSE NA 1.0 1.0 NA NA 3.0 3.0 4.0 4.0linear TRUE NA 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.0FALSE NA 1.0 NA NA NA 3.0 3.5 4.0 4.0CN constant TRUE 1.0 1.0 1.0 1.0 1.0 3.0 3.0 4.0 NAFALSE 1.0 1.0 1.0 NA NA 3.0 3.0 4.0 NAlinear TRUE 1.0 1.0 1.5 2.0 2.5 3.0 3.5 4.0 NAFALSE 1.0 1.0 NA NA NA 3.0 3.5 4.0 NA> ## Don't show:> stopifnot(exprs = {+ identical(unname(ry),+ array(c(NA, 1, 1, 1, 1, 3, 3, 4, NA, NA, 1, 1, NA, NA, 3, 3, 4, NA,+ NA, 1, 1.5, 2, 2.5, 3, 3.5, 4, NA, NA, 1, NA, NA, NA, 3, 3.5, 4, NA,+ 1, 1, 1, 1, 1, 3, 3, 4, 4, 1, 1, 1, NA, NA, 3, 3, 4, 4,+ 1, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4, 1, 1, NA, NA, NA, 3, 3.5, 4, 4,+ NA, 1, 1, 1, 1, 3, 3, 4, 4, NA, 1, 1, NA, NA, 3, 3, 4, 4,+ NA, 1, 1.5, 2, 2.5, 3, 3.5, 4, 4, NA, 1, NA, NA, NA, 3, 3.5, 4, 4,+ 1, 1, 1, 1, 1, 3, 3, 4, NA, 1, 1, 1, NA, NA, 3, 3, 4, NA,+ 1, 1, 1.5, 2, 2.5, 3, 3.5, 4, NA, 1, 1, NA, NA, NA, 3, 3.5, 4, NA),+ dim = c(9L, 2L, 2L, 4L)))+ identical(approxfun(xn,yn, method="constant", rule=2, na.rm=FALSE)(xout),+ as.vector(ry[,"FALSE", "constant","C"]))+ identical(approxfun(xn,yn, method="linear", rule=2:1, na.rm=FALSE)(xout),+ as.vector(ry[,"FALSE", "linear", "CN"]))+ })> ## End(Don't show)>> ## Show treatment of 'ties' :>> x <- c(2,2:4,4,4,5,5,7,7,7)> y <- c(1:6, 5:4, 3:1)> (amy <- approx(x, y, xout = x)$y) # warning, can be avoided by specifying 'ties=':Warning in regularize.values(x, y, ties, missing(ties), na.rm = na.rm) :collapsing to unique 'x' values[1] 1.5 1.5 3.0 5.0 5.0 5.0 4.5 4.5 2.0 2.0 2.0> op <- options(warn=2) # warnings would be error> stopifnot(identical(amy, approx(x, y, xout = x, ties=mean)$y))> (ay <- approx(x, y, xout = x, ties = "ordered")$y)[1] 2 2 3 6 6 6 4 4 1 1 1> stopifnot(amy == c(1.5,1.5, 3, 5,5,5, 4.5,4.5, 2,2,2),+ 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> options(op) # revert 'warn'ing level>>>> 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 30.6534 -0.0636 -0.2269Order selected 3 sigma^2 estimated as 0.1959> ar(lh, method = "burg")Call:ar(x = lh, method = "burg")Coefficients:1 2 30.6588 -0.0608 -0.2234Order selected 3 sigma^2 estimated as 0.1786> ar(lh, method = "ols")Call:ar(x = lh, method = "ols")Coefficients:10.586Intercept: 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 40.6767 -0.0571 -0.2941 0.1028Order 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 81.1305 -0.3524 -0.1745 0.1403 -0.1358 0.0963 -0.0556 0.007690.1941Order selected 9 sigma^2 estimated as 267.5> predict(sunspot.ar, n.ahead = 25)$predTime Series:Start = 1989End = 2013Frequency = 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$seTime Series:Start = 1989End = 2013Frequency = 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, , 1BJsales BJsales.leadBJsales 0.9499 0.8222BJsales.lead 0.0276 0.4970, , 2BJsales BJsales.leadBJsales 0.02041 -1.133BJsales.lead -0.02193 0.294, , 3BJsales BJsales.leadBJsales -0.186490 3.9415BJsales.lead -0.002946 0.1264$var.predBJsales BJsales.leadBJsales 13.9431 0.7733BJsales.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, , 1BJsales BJsales.leadBJsales 1.21197 0.07312BJsales.lead 0.07411 0.45684, , 2BJsales BJsales.leadBJsales -0.26022 -0.1120BJsales.lead -0.06904 0.3111, , 3BJsales BJsales.leadBJsales -0.01754 3.93591BJsales.lead 0.01792 0.09632, , 4BJsales BJsales.leadBJsales -0.07746 -1.33836BJsales.lead -0.01158 -0.09118$var.predBJsales BJsales.leadBJsales 0.38426 0.01315BJsales.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 30.6588 -0.0608 -0.2234Order selected 3 sigma^2 estimated as 0.1786> ar.ols(lh)Call:ar.ols(x = lh)Coefficients:10.586Intercept: 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 40.6761 -0.0571 -0.3001 0.0967Intercept: 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, , 1BJsales BJsales.leadBJsales 0.40408 -0.05144BJsales.lead 0.07348 0.54524, , 2BJsales BJsales.leadBJsales 0.2367 0.05899BJsales.lead -0.1224 0.28690, , 3BJsales BJsales.leadBJsales 0.09673 4.7413BJsales.lead 0.10469 0.0701, , 4BJsales BJsales.leadBJsales 0.048758 1.5671BJsales.lead 0.003482 -0.1838, , 5BJsales BJsales.leadBJsales 0.23307 -0.1574BJsales.lead -0.02707 0.2623, , 6BJsales BJsales.leadBJsales 0.07494 -0.4313BJsales.lead -0.08729 -0.2166, , 7BJsales BJsales.leadBJsales -0.09946 -0.6233BJsales.lead 0.27123 -0.2584, , 8BJsales BJsales.leadBJsales 0.06725 -1.36469BJsales.lead -0.21501 0.06115, , 9BJsales BJsales.leadBJsales -0.11531 -1.464BJsales.lead 0.03536 0.270, , 10BJsales BJsales.leadBJsales -0.002037 -0.6472BJsales.lead 0.001284 -1.0667, , 11BJsales BJsales.leadBJsales 0.004065 -0.7009BJsales.lead 0.002098 0.4890$x.interceptBJsales BJsales.lead0.19630 -0.07022$var.predBJsales BJsales.leadBJsales 0.0400996 -0.0009311BJsales.lead -0.0009311 0.0682137>> 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, , 1DAX SMI CAC FTSEDAX 0.004560 -0.095781 0.039975 0.04856SMI -0.009204 -0.007142 0.037758 0.06826CAC -0.026624 -0.113688 0.063807 0.09154FTSE -0.010299 -0.089246 -0.003195 0.16409$x.interceptDAX SMI CAC FTSE0.0006941 0.0007813 0.0004866 0.0004388$var.predDAX SMI CAC FTSEDAX 1.056e-04 6.683e-05 8.274e-05 5.192e-05SMI 6.683e-05 8.496e-05 6.252e-05 4.254e-05CAC 8.274e-05 6.252e-05 1.207e-04 5.615e-05FTSE 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 intercept0.5739 2.4133s.e. 0.1161 0.1466sigma^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 intercept0.6448 -0.0634 -0.2198 2.3931s.e. 0.1394 0.1668 0.1421 0.0963sigma^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 intercept0.4522 0.1982 2.4101s.e. 0.1769 0.1705 0.1358sigma^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 intercept0.6578 -0.0658 -0.2348 2.3918s.e. 0.1414 0.1702 0.1473 0.0983sigma^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.5528s.e. 0.1228 0.1784sigma^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.4549s.e. 0.1366 0.1436sigma^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) - 19201.0048 -0.2913 579.0993 -0.0216s.e. 0.0976 0.1004 0.2370 0.0081sigma^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 intercept0.8242 56.1505s.e. 0.0555 4.6434sigma^2 estimated as 85.47: log likelihood = -416.89, aic = 839.78> nobs(fit1)[1] 114> tsdiag(fit1)> (fit3 <- arima(presidents, c(3, 0, 0))) # smaller AICCall:arima(x = presidents, order = c(3, 0, 0))Coefficients:ar1 ar2 ar3 intercept0.7496 0.2523 -0.1890 56.2223s.e. 0.0936 0.1140 0.0946 4.2845sigma^2 estimated as 81.12: log likelihood = -414.08, aic = 838.16> tsdiag(fit3)> BIC(fit1, fit3)df BICfit1 3 847.9931fit3 5 851.8449> ## compare a whole set of models; BIC() would choose the smallest> AIC(fit1, arima(presidents, c(2,0,0)),+ arima(presidents, c(2,0,1)), # <- chosen (barely) by AIC+ fit3, arima(presidents, c(3,0,1)))df AICfit1 3 839.7845arima(presidents, c(2, 0, 0)) 4 840.0458arima(presidents, c(2, 0, 1)) 5 838.1272fit3 5 838.1639arima(presidents, c(3, 0, 1)) 6 838.8124>> ## An example of using the 'fixed' argument:> ## Note that the period of the seasonal component is taken to be> ## frequency(presidents), i.e. 4.> (fitSfx <- arima(presidents, order=c(2,0,1), seasonal=c(1,0,0),+ fixed=c(NA, NA, 0.5, -0.1, 50), transform.pars=FALSE))Call:arima(x = presidents, order = c(2, 0, 1), seasonal = c(1, 0, 0), transform.pars = FALSE,fixed = c(NA, NA, 0.5, -0.1, 50))Coefficients:ar1 ar2 ma1 sar1 intercept0.2047 0.6269 0.5 -0.1 50s.e. 0.0734 0.0747 0.0 0.0 0sigma^2 estimated as 84.01: log likelihood = -416.07, aic = 838.14> ## The partly-fixed & smaller model seems better (as we "knew too much"):> AIC(fitSfx, arima(presidents, order=c(2,0,1), seasonal=c(1,0,0)))df AICfitSfx 3 838.1406arima(presidents, order = c(2, 0, 1), seasonal = c(1, 0, 0)) 6 839.7095>> ## An example of ARIMA forecasting:> predict(fit3, 3)$predQtr1 Qtr2 Qtr31975 29.84194 34.41014 39.30815$seQtr1 Qtr2 Qtr31975 9.00655 11.25606 13.43389>>>> 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 = 1End = 63Frequency = 1[1] 0.55638574 0.24800500 -0.81744783 -0.38508849 -0.23890454 -0.02072714[7] -0.51654590 -0.52651638 -0.14927781 0.60798558 0.48272646 0.45160066[13] 0.09619832 -0.67131480 -0.69254708 -0.56224691 -0.19460368 0.53033791[19] 0.77731125 0.40648873 -0.02697856 0.08101569 0.22706682 -0.10950180[25] -0.38234797 -0.13676254 0.27995530 0.23211869 0.53580489 0.43571147[31] -0.07756004 -0.03502285 -0.56957457 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 = 1End = 63Frequency = 1[1] -0.08101433 -0.37596592 -1.05656365 -0.99217317 -0.15199924 -0.06140144[7] -0.55852200 -0.54700937 -0.72098523 -0.98045523 -0.80880380 -0.61217798[13] -0.66268921 -0.29302949 -0.83022714 -0.08803618 -0.37932440 0.10532621[19] 0.08033289 -0.29269083 -0.69193397 0.81677306 -0.25402288 -0.08812258[25] -0.34117754 0.29026870 -0.54848673 -0.44974248 -0.34110521 -0.17826307[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 intercept0.6448 -0.0634 -0.2198 2.3931s.e. 0.1394 0.1668 0.1421 0.0963sigma^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 intercept0.4521 0.1983 2.4101s.e. 0.1357 0.1777 0.1357sigma^2 estimated as 0.1923: log likelihood = -28.76, aic = 65.52> predict(arima0(lh, order = c(3,0,0)), n.ahead = 12)$predTime Series:Start = 49End = 60Frequency = 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$seTime Series:Start = 49End = 60Frequency = 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 intercept0.6580 -0.0660 -0.2339 2.3999s.e. 0.1414 0.1702 0.1469 0.0981sigma^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.5526s.e. 0.1228 0.1785sigma^2 estimated as 99355: log likelihood = -425.44, aic = 856.88> predict(fit, n.ahead = 6)$predJan Feb Mar Apr May Jun1979 8336.028 7531.760 8314.593 8616.864 9488.916 9859.727$seJan Feb Mar Apr May Jun1979 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 xreg1.0048 -0.2913 579.0985 -0.0216s.e. 0.0976 0.1004 0.2370 0.0081sigma^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")>>>>> cleanEx()> nameEx("asOneSidedFormula")> ### * asOneSidedFormula>> flush(stderr()); flush(stdout())>> ### Name: asOneSidedFormula> ### Title: Convert to One-Sided Formula> ### Aliases: asOneSidedFormula> ### Keywords: models>> ### ** Examples>> asOneSidedFormula("age")~age<environment: 0x544b0b0>> 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 = 0.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 variancesdata: InsectSprays$count and InsectSprays$sprayBartlett's K-squared = 25.96, df = 5, p-value = 9.085e-05> bartlett.test(count ~ spray, data = InsectSprays)Bartlett test of homogeneity of variancesdata: count by sprayBartlett's K-squared = 25.96, 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 testdata: c(682, 243)number of successes = 682, number of trials = 925, p-value = 0.3825alternative hypothesis: true probability of success is not equal to 0.7595 percent confidence interval:0.7076683 0.7654066sample estimates:probability of success0.7372973> binom.test(682, 682 + 243, p = 3/4) # The same.Exact binomial testdata: 682 and 682 + 243number of successes = 682, number of trials = 925, p-value = 0.3825alternative hypothesis: true probability of success is not equal to 0.7595 percent confidence interval:0.7076683 0.7654066sample estimates:probability of success0.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() # 23[1] 23> ## probability of > 2 people with the same birthday> pbirthday(23, coincident = 3)[1] 0.01441541>> ## examples from Diaconis & Mosteller p. 858.> ## 'coincidence' is that husband, wife, daughter all born on the 16th> qbirthday(classes = 30, coincident = 3) # approximately 18[1] 18> qbirthday(coincident = 4) # exact value 187[1] 187> qbirthday(coincident = 10) # exact value 1181[1] 1179>> ## same 4-digit PIN number> qbirthday(classes = 10^4)[1] 119>> ## 0.9 probability of three or more coincident birthdays> qbirthday(coincident = 3, prob = 0.9)[1] 135>> ## Chance of 4 or more coincident birthdays in 150 people> pbirthday(150, coincident = 4)[1] 0.2690146>> ## 100 or more coincident birthdays in 1000 people: very rare> pbirthday(1000, coincident = 100)[1] 1.531434e-113>>>> 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 testdata: xX-squared = 0.0013332, df = 1, p-value = 0.9709> Box.test (x, lag = 1, type = "Ljung")Box-Ljung testdata: xX-squared = 0.0013736, df = 1, p-value = 0.9704>>>> cleanEx()> nameEx("cancor")> ### * cancor>> flush(stderr()); flush(stdout())>> ### Name: cancor> ### Title: Canonical Correlations> ### Aliases: cancor> ### Keywords: multivariate>> ### ** Examples>>> 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 <- setNames(x + (x/4 - 2)^3 + rnorm(20, sd = 3),+ 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)Weighted Residuals:Min 1Q Median 3Q Max-6.7160 -0.7047 0.0728 1.0174 3.9947Coefficients: (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 ‘ ’ 1Residual standard error: 2.838 on 15 degrees of freedomMultiple R-squared: 0.9702, Adjusted R-squared: 0.9643F-statistic: 163 on 3 and 15 DF, p-value: 1.14e-11Correlation of Coefficients:(Intercept) x I(x^2)x -0.90I(x^2) 0.80 -0.97I(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("checkMFClasses")> ### * checkMFClasses>> flush(stderr()); flush(stdout())>> ### Name: .checkMFClasses> ### Title: Functions to Check the Type of Variables passed to Model Frames> ### Aliases: .checkMFClasses .MFclass .getXlevels> ### Keywords: utilities>> ### ** Examples>> sapply(warpbreaks, .MFclass) # "numeric" plus 2 x "factor"breaks wool tension"numeric" "factor" "factor"> sapply(iris, .MFclass) # 4 x "numeric" plus "factor"Sepal.Length Sepal.Width Petal.Length Petal.Width Species"numeric" "numeric" "numeric" "numeric" "factor">> mf <- model.frame(Sepal.Width ~ Species, iris)> mc <- model.frame(Sepal.Width ~ Sepal.Length, iris)>> .checkMFClasses("numeric", mc) # nothing else> .checkMFClasses(c("numeric", "factor"), mf)>> ## simple .getXlevels() cases :> (xl <- .getXlevels(terms(mf), mf)) # a list with one entry " $ Species" with 3 levels:$Species[1] "setosa" "versicolor" "virginica"> stopifnot(exprs = {+ identical(xl$Species, levels(iris$Species))+ identical(.getXlevels(terms(mc), mc), xl[0]) # a empty named list, as no factors+ is.null(.getXlevels(terms(x~x), list(x=1)))+ })>>>> 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>>> ## From Agresti(2007) p.39> M <- as.table(rbind(c(762, 327, 468), c(484, 239, 477)))> dimnames(M) <- list(gender = c("F", "M"),+ party = c("Democrat","Independent", "Republican"))> (Xsq <- chisq.test(M)) # Prints test summaryPearson's Chi-squared testdata: MX-squared = 30.07, df = 2, p-value = 2.954e-07> Xsq$observed # observed counts (same as M)partygender Democrat Independent RepublicanF 762 327 468M 484 239 477> Xsq$expected # expected counts under the nullpartygender Democrat Independent RepublicanF 703.6714 319.6453 533.6834M 542.3286 246.3547 411.3166> Xsq$residuals # Pearson residualspartygender Democrat Independent RepublicanF 2.1988558 0.4113702 -2.8432397M -2.5046695 -0.4685829 3.2386734> Xsq$stdres # standardized residualspartygender Democrat Independent RepublicanF 4.5020535 0.6994517 -5.3159455M -4.5020535 -0.6994517 5.3159455>>> ## 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 probabilitiesdata: xX-squared = 2.5, df = 2, p-value = 0.2865> chisq.test(as.table(x)) # the sameChi-squared test for given probabilitiesdata: 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 probabilitiesdata: xX-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 incorrectChi-squared test for given probabilitiesdata: xX-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 (basedon 2000 replicates)data: xX-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 probabilitiesdata: 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] # reflect so North is at the top> ## note asp = 1, to ensure Euclidean distances are represented correctly> plot(x, y, type = "n", xlab = "", ylab = "", asp = 1, axes = FALSE,+ main = "cmdscale(eurodist)")> text(x, y, rownames(loc), cex = 0.6)>>>> cleanEx()> nameEx("coef")> ### * coef>> flush(stderr()); flush(stdout())>> ### Name: coef> ### Title: Extract Model Coefficients> ### Aliases: coef coefficients coef.default coef.aov> ### 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 confint.lm> ### Keywords: models>> ### ** Examples>> fit <- lm(100/mpg ~ disp + hp + wt + am, data = mtcars)> confint(fit)2.5 % 97.5 %(Intercept) -0.774822875 2.256118188disp -0.002867999 0.008273849hp -0.001400580 0.011949674wt 0.380088737 1.622517536am -0.614677730 0.926307310> confint(fit, "wt")2.5 % 97.5 %wt 0.3800887 1.622518>>>>> cleanEx()> nameEx("constrOptim")> ### * constrOptim>> flush(stderr()); flush(stdout())>> ### Name: constrOptim> ### Title: Linearly Constrained Optimization> ### Aliases: constrOptim> ### Keywords: optimize>> ### ** Examples>>> 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 -12 1 -1 -13 0 2 -14 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 matrix1 2 3 41 1 0 0 02 0 1 0 03 0 0 1 04 0 0 0 1>> (cT <- contr.treatment(5))2 3 4 51 0 0 0 02 1 0 0 03 0 1 0 04 0 0 1 05 0 0 0 1> all(crossprod(cT) == diag(4)) # TRUE: even orthonormal[1] TRUE>> (cT. <- contr.SAS(5))1 2 3 41 1 0 0 02 0 1 0 03 0 0 1 04 0 0 0 15 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 sLevels: 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 zfactor> as.integer(ff) # the internal codes[1] 19 20 1 20 9 19 20 9 3 19factor> (f. <- factor(ff)) # drops the levels that do not occur[1] s t a t i s t i c sLevels: a c i s tfactor> ff[, drop = TRUE] # the same, more transparently[1] s t a t i s t i c sLevels: a c i s tfactor> 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 letter2020 Levels: letter1 letter2 letter3 letter4 letter5 letter6 letter7 ... letter20factor> class(ordered(4:1)) # "ordered", inheriting from "factor"[1] "ordered" "factor"factor> z <- factor(LETTERS[3:1], ordered = TRUE)factor> ## and "relational" methods work:factor> stopifnot(sort(z)[c(1,3)] == range(z), min(z) < max(z))factor> ## Don't show:factor> of <- ordered(ff)factor> stopifnot(identical(range(of, rev(of)), of[3:2]),factor+ identical(max(of), of[2]))factor> ## End(Don't show)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] <- TRUEfactor> x # [1] 1 <NA> <NA>[1] 1 <NA> <NA>Levels: 1 2 <NA>factor> is.na(x)[1] FALSE TRUE FALSEfactor> # [1] FALSE TRUE FALSEfactor>factor> ## More rational, since R 3.4.0 :factor> factor(c(1:2, NA), exclude = "" ) # keeps <NA> , as[1] 1 2 <NA>Levels: 1 2 <NA>factor> factor(c(1:2, NA), exclude = NULL) # always did[1] 1 2 <NA>Levels: 1 2 <NA>factor> ## exclude = <character>factor> z # ordered levels 'A < B < C'[1] C B ALevels: A < B < Cfactor> factor(z, exclude = "C") # does exclude[1] <NA> B ALevels: A < Bfactor> factor(z, exclude = "B") # ditto[1] C <NA> ALevels: A < Cfactor> ## Now, labels maybe duplicated:factor> ## factor() with duplicated labels allowing to "merge levels"factor> x <- c("Man", "Male", "Man", "Lady", "Female")factor> ## Map from 4 different values to only two levels:factor> (xf <- factor(x, levels = c("Male", "Man" , "Lady", "Female"),factor+ labels = c("Male", "Male", "Female", "Female")))[1] Male Male Male Female FemaleLevels: Male Femalefactor> #> [1] Male Male Male Female Femalefactor> #> Levels: Male Femalefactor>factor> ## Using addNA()factor> Month <- airquality$Monthfactor> table(addNA(Month))5 6 7 8 9 <NA>31 30 31 31 30 0factor> table(addNA(Month, ifany = TRUE))5 6 7 8 931 30 31 31 30> fff <- ff[, drop = TRUE] # reduce to 5 levels.> contrasts(fff) # treatment contrasts by defaultc i s ta 0 0 0 0c 1 0 0 0i 0 1 0 0s 0 0 1 0t 0 0 0 1> contrasts(C(fff, sum))[,1] [,2] [,3] [,4]a 1 0 0 0c 0 1 0 0i 0 0 1 0s 0 0 0 1t -1 -1 -1 -1> contrasts(fff, contrasts = FALSE) # the 5x5 identity matrixa c i s ta 1 0 0 0 0c 0 1 0 0 0i 0 0 1 0 0s 0 0 0 1 0t 0 0 0 0 1>> contrasts(fff) <- contr.sum(5); contrasts(fff) # set sum contrasts[,1] [,2] [,3] [,4]a 1 0 0 0c 0 1 0 0i 0 0 1 0s 0 0 0 1t -1 -1 -1 -1> contrasts(fff, 2) <- contr.sum(5); contrasts(fff) # set 2 contrasts[,1] [,2]a 1 0c 0 1i 0 0s 0 0t -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.2688164c 0 1 -0.2471257 0.2688164i 0 0 -0.1498721 -0.8817814s 0 0 0.8912491 0.0753323t -1 -1 -0.2471257 0.2688164>>>> 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]> d01 2 3 42 1.03 3.8 4.04 4.4 4.2 2.65 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 42 1.03 4.1 4.14 4.1 4.1 2.65 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 PopulationGNP.deflator 1.0000000 0.9915892 0.6206334 0.4647442 0.9791634GNP 0.9915892 1.0000000 0.6042609 0.4464368 0.9910901Unemployed 0.6206334 0.6042609 1.0000000 -0.1774206 0.6865515Armed.Forces 0.4647442 0.4464368 -0.1774206 1.0000000 0.3644163Population 0.9791634 0.9910901 0.6865515 0.3644163 1.0000000Year 0.9911492 0.9952735 0.6682566 0.4172451 0.9939528Employed 0.9708985 0.9835516 0.5024981 0.4573074 0.9603906Year EmployedGNP.deflator 0.9911492 0.9708985GNP 0.9952735 0.9835516Unemployed 0.6682566 0.5024981Armed.Forces 0.4172451 0.4573074Population 0.9939528 0.9603906Year 1.0000000 0.9713295Employed 0.9713295 1.0000000> ## Graphical Correlation Matrix:> symnum(Cl) # highly correlatedGNP. GNP U A P Y EGNP.deflator 1GNP B 1Unemployed , , 1Armed.Forces . . 1Population B B , . 1Year B B , . B 1Employed B B . . B B 1attr(,"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 EGNP.deflator 1GNP B 1Unemployed , , 1Armed.Forces . 1Population B B , 1Year B B , 1 1Employed B B . B B 1attr(,"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 EGNP.deflator 1GNP B 1Unemployed . . 1Armed.Forces 1Population B B . 1Year B B . 1 1Employed * * . + + 1attr(,"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 KP 1.0000000 0.9802390 0.9572562S 0.9802390 1.0000000 0.9742171K 0.9572562 0.9742171 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 <- Vr[] <- Is * V * rep(Is, each = p)r[cbind(1L:p, 1L:p)] <- 1r}<bytecode: 0x61e74d8><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" with 3 "missing"s :> swM <- swiss> colnames(swM) <- abbreviate(colnames(swiss), min=6)> swM[1,2] <- swM[7,3] <- swM[25,5] <- NA # create 3 "missing">> ## Consider all 5 "use" cases :> (C. <- cov(swM)) # use="everything" quite a few NA's in cov.matrixFrtlty Agrclt Exmntn Eductn Cathlc Infn.MFrtlty 156.04250 NA NA -79.729510 NA 15.156193Agrclt NA NA NA NA NA NAExmntn NA NA NA NA NA NAEductn -79.72951 NA NA 92.456059 NA -2.781684Cathlc NA NA NA NA NA NAInfn.M 15.15619 NA NA -2.781684 NA 8.483802> try(cov(swM, use = "all")) # Error: missing obs...Error in cov(swM, use = "all") : missing observations in cov/cor> C2 <- cov(swM, use = "complete")> stopifnot(identical(C2, cov(swM, use = "na.or.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>> ## Kendall's tau doesn't change much:> symnum(Rc <- cor(swM, method = "kendall", use = "complete"))F A Ex Ed C IFrtlty 1Agrclt 1Exmntn . . 1Eductn . . . 1Cathlc . 1Infn.M 1attr(,"legend")[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1> symnum(Rp <- cor(swM, method = "kendall", use = "pairwise"))F A Ex Ed C IFrtlty 1Agrclt 1Exmntn . . 1Eductn . . . 1Cathlc . 1Infn.M . 1attr(,"legend")[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1> symnum(R. <- cor(swiss, method = "kendall"))F A Ex Ed C IFertility 1Agriculture 1Examination . . 1Education . . . 1Catholic . 1Infant.Mortality . 1attr(,"legend")[1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1>> ## "pairwise" is closer componentwise,> summary(abs(c(1 - Rp/R.)))Min. 1st Qu. Median Mean 3rd Qu. Max.0.00000 0.00000 0.04481 0.09573 0.15214 0.53941> summary(abs(c(1 - Rc/R.)))Min. 1st Qu. Median Mean 3rd Qu. Max.0.00000 0.02021 0.08482 0.50675 0.16192 7.08509>> ## but "complete" is closer in Eigen space:> EV <- function(m) eigen(m, only.values=TRUE)$values> summary(abs(1 - EV(Rp)/EV(R.)) / abs(1 - EV(Rc)/EV(R.)))Min. 1st Qu. Median Mean 3rd Qu. Max.0.8942 1.1464 1.2452 1.3732 1.3722 2.3265>>>> 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 taudata: x and yT = 26, p-value = 0.05972alternative hypothesis: true tau is greater than 0sample estimates:tau0.4444444> ## => p=0.05972>> cor.test(x, y, method = "kendall", alternative = "greater",+ exact = FALSE) # using large sample approximationKendall's rank correlation taudata: x and yz = 1.6681, p-value = 0.04765alternative hypothesis: true tau is greater than 0sample estimates:tau0.4444444> ## => p=0.04765>> ## Compare this to> cor.test(x, y, method = "spearm", alternative = "g")Spearman's rank correlation rhodata: x and yS = 48, p-value = 0.0484alternative hypothesis: true rho is greater than 0sample estimates:rho0.6> cor.test(x, y, alternative = "g")Pearson's product-moment correlationdata: x and yt = 1.8411, df = 7, p-value = 0.05409alternative hypothesis: true correlation is greater than 095 percent confidence interval:-0.02223023 1.00000000sample estimates:cor0.5711816>> ## Formula interface.> require(graphics)> pairs(USJudgeRatings)> cor.test(~ CONT + INTG, data = USJudgeRatings)Pearson's product-moment correlationdata: CONT and INTGt = -0.8605, df = 41, p-value = 0.3945alternative hypothesis: true correlation is not equal to 095 percent confidence interval:-0.4168591 0.1741182sample 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"$covx yx 2.5 -0.5y -0.5 1.7$centerx y6.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)$covx yx 2.0 -0.40y -0.4 1.36$centerx y6.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$corx yx 1.0000000 -0.2425356y -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 trivial1 2 3 4 5Alabama 1 1 1 1 1Alaska 1 1 1 1 1Arizona 1 1 1 1 1Arkansas 1 2 2 2 2California 1 1 1 1 1Colorado 1 2 2 2 2Connecticut 1 2 3 3 3Delaware 1 1 1 1 1Florida 1 1 1 4 4Georgia 1 2 2 2 2Hawaii 1 2 3 3 5Idaho 1 2 3 3 3Illinois 1 1 1 1 1Indiana 1 2 3 3 3Iowa 1 2 3 3 5Kansas 1 2 3 3 3Kentucky 1 2 3 3 3Louisiana 1 1 1 1 1Maine 1 2 3 3 5Maryland 1 1 1 1 1Massachusetts 1 2 2 2 2Michigan 1 1 1 1 1Minnesota 1 2 3 3 5Mississippi 1 1 1 1 1Missouri 1 2 2 2 2Montana 1 2 3 3 3Nebraska 1 2 3 3 3Nevada 1 1 1 1 1New Hampshire 1 2 3 3 5New Jersey 1 2 2 2 2New Mexico 1 1 1 1 1New York 1 1 1 1 1North Carolina 1 1 1 4 4North Dakota 1 2 3 3 5Ohio 1 2 3 3 3Oklahoma 1 2 2 2 2Oregon 1 2 2 2 2Pennsylvania 1 2 3 3 3Rhode Island 1 2 2 2 2South Carolina 1 1 1 1 1South Dakota 1 2 3 3 5Tennessee 1 2 2 2 2Texas 1 2 2 2 2Utah 1 2 3 3 3Vermont 1 2 3 3 5Virginia 1 2 2 2 2Washington 1 2 2 2 2West Virginia 1 2 3 3 5Wisconsin 1 2 3 3 5Wyoming 1 2 2 2 2> cutree(hc, h = 250)Alabama Alaska Arizona Arkansas California1 1 1 2 1Colorado Connecticut Delaware Florida Georgia2 2 1 1 2Hawaii Idaho Illinois Indiana Iowa2 2 1 2 2Kansas Kentucky Louisiana Maine Maryland2 2 1 2 1Massachusetts Michigan Minnesota Mississippi Missouri2 1 2 1 2Montana Nebraska Nevada New Hampshire New Jersey2 2 1 2 2New Mexico New York North Carolina North Dakota Ohio1 1 1 2 2Oklahoma Oregon Pennsylvania Rhode Island South Carolina2 2 2 2 1South Dakota Tennessee Texas Utah Vermont2 2 2 2 2Virginia Washington West Virginia Wisconsin Wyoming2 2 2 2 2>> ## Compare the 2 and 4 grouping:> g24 <- cutree(hc, k = c(2,4))> table(grp2 = g24[,"2"], grp4 = g24[,"4"])grp4grp2 1 2 3 41 14 0 0 22 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)> tty ~ z + x + wattr(,"variables")list(y, z, x, w)attr(,"factors")z x wy 0 0 0z 1 0 0x 0 1 0w 0 0 1attr(,"term.labels")[1] "z" "x" "w"attr(,"order")[1] 1 1 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> delete.response(tt)~z + x + wattr(,"variables")list(z, x, w)attr(,"factors")z x wz 1 0 0x 0 1 0w 0 0 1attr(,"term.labels")[1] "z" "x" "w"attr(,"order")[1] 1 1 1attr(,"intercept")[1] 1attr(,"response")[1] 0attr(,".Environment")<environment: R_GlobalEnv>> drop.terms(tt, 2:3, keep.response = TRUE)y ~ zattr(,"variables")list(y, z)attr(,"factors")zy 0z 1attr(,"term.labels")[1] "z"attr(,"order")[1] 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> tt[-1]y ~ x + wattr(,"variables")list(y, x, w)attr(,"factors")x wy 0 0x 1 0w 0 1attr(,"term.labels")[1] "x" "w"attr(,"order")[1] 1 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> tt[2:3]y ~ x + wattr(,"variables")list(y, x, w)attr(,"factors")x wy 0 0x 1 0w 0 1attr(,"term.labels")[1] "x" "w"attr(,"order")[1] 1 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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>> ## using non-syntactic names:> reformulate(c("`P/E`", "`% Growth`"), response = as.name("+-"))`+-` ~ `P/E` + `% Growth`>> x <- c("a name", "another name")> try( reformulate(x) ) # -> Error ..... unexpected symbolError in str2lang(termtext) : <text>:1:3: unexpected symbol1: a name^> ## rather backquote the strings in x :> reformulate(sprintf("`%s`", x))~`a name` + `another name`>> 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]][[1]][[1]][[2]][[2]][[2]][[1]]NULL[[1]][[1]][[2]][[2]][[2]][[2]]NULL[[1]][[2]][[1]][[2]][[1]]NULL[[1]][[2]][[2]][[1]][[2]][[2]][[1]]NULL[[1]][[2]][[2]][[2]]NULL[[2]][[2]][[1]][[2]][[1]][[1]]NULL[[2]][[1]][[2]][[2]][[1]][[2]][[1]]NULL[[2]][[1]][[2]][[2]]NULL[[2]][[2]][[2]][[2]][[1]]NULL[[2]][[2]][[2]][[2]][[2]][[2]][[1]]NULL[[2]][[2]][[2]][[2]]NULL>> ## 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 as.hclust.dendrogram cut.dendrogram> ### [[.dendrogram merge.dendrogram nobs.dendrogram plot.dendrogram> ### print.dendrogram rev.dendrogram str.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]| |--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]| | |--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]| |--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, last.str = "'") # 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] ..> oo <- options(str.dendrogram.last = "\\") # yet another possibility> 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] ..> options(oo) # .. resetting them>> 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)>> ## simple test for as.hclust() as the inverse of as.dendrogram():> stopifnot(identical(as.hclust(dend1)[1:4], hc[1:4]))>> 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)> d3 <- dend2$lower[[2]][[2]][[1]]> stopifnot(identical(d3, dend2$lower[[2]][[c(2,1)]]))> str(d3, last.str = "'")--[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">> ## to peek at the inner structure "if you must", use '[..]' indexing :> str(d3[2][[1]]) ## or the fullList of 2$ :List of 2..$ : int 13.. ..- attr(*, "label")= chr "Illinois".. ..- attr(*, "members")= int 1.. ..- attr(*, "height")= num 0.. ..- attr(*, "leaf")= logi TRUE..$ : int 32.. ..- attr(*, "label")= chr "New York".. ..- attr(*, "members")= int 1.. ..- attr(*, "height")= num 0.. ..- attr(*, "leaf")= logi TRUE..- attr(*, "members")= int 2..- attr(*, "midpoint")= num 0.5..- attr(*, "height")= num 6.24$ :List of 2..$ : int 22.. ..- attr(*, "label")= chr "Michigan".. ..- attr(*, "members")= int 1.. ..- attr(*, "height")= num 0.. ..- attr(*, "leaf")= logi TRUE..$ : int 28.. ..- attr(*, "label")= chr "Nevada".. ..- attr(*, "members")= int 1.. ..- attr(*, "height")= num 0.. ..- attr(*, "leaf")= logi TRUE..- attr(*, "members")= int 2..- attr(*, "midpoint")= num 0.5..- attr(*, "height")= num 13.3- attr(*, "members")= int 4- attr(*, "midpoint")= num 1.5- attr(*, "height")= num 18.4> str(d3[])List of 2$ :List of 2..$ : int 8.. ..- attr(*, "members")= int 1.. ..- attr(*, "height")= num 0.. ..- attr(*, "label")= chr "Delaware".. ..- attr(*, "leaf")= logi TRUE..$ :List of 2.. ..$ : int 1.. .. ..- attr(*, "label")= chr "Alabama".. .. ..- attr(*, "members")= int 1.. .. ..- attr(*, "height")= num 0.. .. ..- attr(*, "leaf")= logi TRUE.. ..$ : int 18.. .. ..- attr(*, "label")= chr "Louisiana".. .. ..- attr(*, "members")= int 1.. .. ..- attr(*, "height")= num 0.. .. ..- attr(*, "leaf")= logi TRUE.. ..- attr(*, "members")= int 2.. ..- attr(*, "midpoint")= num 0.5.. ..- attr(*, "height")= num 15.5..- attr(*, "members")= int 3..- attr(*, "midpoint")= num 0.75..- attr(*, "height")= num 16.9$ :List of 2..$ :List of 2.. ..$ : int 13.. .. ..- attr(*, "label")= chr "Illinois".. .. ..- attr(*, "members")= int 1.. .. ..- attr(*, "height")= num 0.. .. ..- attr(*, "leaf")= logi TRUE.. ..$ : int 32.. .. ..- attr(*, "label")= chr "New York".. .. ..- attr(*, "members")= int 1.. .. ..- attr(*, "height")= num 0.. .. ..- attr(*, "leaf")= logi TRUE.. ..- attr(*, "members")= int 2.. ..- attr(*, "midpoint")= num 0.5.. ..- attr(*, "height")= num 6.24..$ :List of 2.. ..$ : int 22.. .. ..- attr(*, "label")= chr "Michigan".. .. ..- attr(*, "members")= int 1.. .. ..- attr(*, "height")= num 0.. .. ..- attr(*, "leaf")= logi TRUE.. ..$ : int 28.. .. ..- attr(*, "label")= chr "Nevada".. .. ..- attr(*, "members")= int 1.. .. ..- attr(*, "height")= num 0.. .. ..- attr(*, "leaf")= logi TRUE.. ..- attr(*, "members")= int 2.. ..- attr(*, "midpoint")= num 0.5.. ..- attr(*, "height")= num 13.3..- attr(*, "members")= int 4..- attr(*, "midpoint")= num 1.5..- attr(*, "height")= num 18.4- attr(*, "members")= int 7- attr(*, "midpoint")= num 2.62- attr(*, "height")= num 26.4>> ## merge() to join dendrograms:> (d13 <- merge(dend2$lower[[1]], dend2$lower[[3]]))'dendrogram' with 2 branches and 16 members total, at height 49.32173> ## merge() all parts back (using default 'height' instead of original one):> den.1 <- Reduce(merge, dend2$lower)> ## or merge() all four parts at same height --> 4 branches (!)> d. <- merge(dend2$lower[[1]], dend2$lower[[2]], dend2$lower[[3]],+ dend2$lower[[4]])> ## (with a warning) or the same using do.call :> stopifnot(identical(d., do.call(merge, dend2$lower)))> plot(d., main = "merge(d1, d2, d3, d4) |-> dendrogram with a 4-split")>> ## "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> ### 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")> dCall:density.default(x = faithful$eruptions, bw = "sj")Data: faithful$eruptions (272 obs.); Bandwidth 'bw' = 0.14x yMin. :1.180 Min. :0.00018341st Qu.:2.265 1st Qu.:0.0422638Median :3.350 Median :0.1709243Mean :3.350 Mean :0.23017263rd Qu.:4.435 3rd Qu.:0.4134348Max. :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.2820948epanechnikov 0.2683282rectangular 0.2886751triangular 0.2721655biweight 0.2699746cosine 0.2711340optcosine 0.2684756> 100*round(RKs["epanechnikov",]/RKs, 4) ## Efficiencies[,1]gaussian 95.12epanechnikov 100.00rectangular 92.95triangular 98.59biweight 99.39cosine 98.97optcosine 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 cosine1.0000000 1.0100567 0.9953989 1.0071923 1.0088217 1.0079575optcosine1.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") ; dx2xexpression({.value <- x^2.grad <- array(0, c(length(.value), 1L), list(NULL, c("x"))).grad[, "x"] <- 2 * xattr(.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 4attr(,"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.8360219attr(,"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 * .expr1attr(.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.891905attr(,"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>> ## First derivative>> D(expression(x^2), "x")2 * x> stopifnot(D(as.name("x"), "x") == 1)>> ## 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") <- .gradattr(.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)>> ## New (R 3.4.0, 2017):> D(quote(log1p(x^2)), "x") ## log1p(x) = log(1 + x)2 * x/(1 + x^2)> stopifnot(identical(+ D(quote(log1p(x^2)), "x"),+ D(quote(log(1+x^2)), "x")))> D(quote(expm1(x^2)), "x") ## expm1(x) = exp(x) - 1exp(x^2) * (2 * x)> stopifnot(identical(+ D(quote(expm1(x^2)), "x") -> Dex1,+ D(quote(exp(x^2)-1), "x")),+ identical(Dex1, quote(exp(x^2) * (2 * x))))>> D(quote(sinpi(x^2)), "x") ## sinpi(x) = sin(pi*x)cospi(x^2) * (pi * (2 * x))> D(quote(cospi(x^2)), "x") ## cospi(x) = cos(pi*x)-(sinpi(x^2) * (pi * (2 * x)))> D(quote(tanpi(x^2)), "x") ## tanpi(x) = tan(pi*x)pi * (2 * x)/cospi(x^2)^2>> stopifnot(identical(D(quote(log2 (x^2)), "x"),+ quote(2 * x/(x^2 * log(2)))),+ identical(D(quote(log10(x^2)), "x"),+ quote(2 * x/(x^2 * log(10)))))>>>>> 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 42 5.7018173 6.013119 5.0320694 7.276905 5.325473 5.8118615 6.619295 5.306750 4.945987 6.612081> dist(x, diag = TRUE)1 2 3 4 51 0.0000002 5.701817 0.0000003 6.013119 5.032069 0.0000004 7.276905 5.325473 5.811861 0.0000005 6.619295 5.306750 4.945987 6.612081 0.000000> dist(x, upper = TRUE)1 2 3 4 51 5.701817 6.013119 7.276905 6.6192952 5.701817 5.032069 5.325473 5.3067503 6.013119 5.032069 5.811861 4.9459874 7.276905 5.325473 5.811861 6.6120815 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 PHYSINTG 567DMNR 577 18DILG 494 64 82CFMG 432 93 93 21DECI 457 99 98 22 9PREP 494 61 72 11 21 21FAMI 513 66 79 21 32 29 5ORAL 506 44 47 23 25 26 8 9WRIT 522 46 53 20 29 27 7 5 3PHYS 473 129 106 94 60 64 76 78 54 72RTEN 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")xy 0.4> ## answer 0.4 = 2/5> dist(rbind(x, y), method = "canberra")xy 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 Infy 1 0 1 1 0 1> dist(m2, method = "binary") # warning, answer 0.5 = 2/4Warning in dist(m2, method = "binary") :treating non-finite values as NAxy 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 52 23 1 24 1 2 05 2 2 1 16 1 2 1 1 2>> ## 2)> y[6] <- Inf #-> 6-th pair is excluded> dist(rbind(x, y), method = "binary" ) # warning; 0.5Warning in dist(rbind(x, y), method = "binary") :treating non-finite values as NAxy 0.5> dist(rbind(x, y), method = "canberra" ) # 3xy 3> dist(rbind(x, y), method = "maximum") # 1xy 1> dist(rbind(x, y), method = "manhattan") # 2.4xy 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.> npk.aov <- aov(yield ~ block + N*P*K, npk)> dummy.coef(npk.aov)Full coefficients are(Intercept): 54.875block: 1 2 3 4 5 6-0.850 2.575 5.900 -4.750 -4.350 1.475N: 0 1-2.808333 2.808333P: 0 10.5916667 -0.5916667K: 0 11.991667 -1.991667N:P: 0:0 1:0 0:1 1:1-0.9416667 0.9416667 0.9416667 -0.9416667N:K: 0:0 1:0 0:1 1:1-1.175 1.175 1.175 -1.175P:K: 0:0 1:0 0:1 1:10.1416667 -0.1416667 -0.1416667 0.1416667N:P:K: 0:0:0 1:0:0 0:1:0 1:1:0 0:0:1 1:0:1 0:1:10 0 0 0 0 0 0(Intercept):block:N:P:K:N:P:N:K:P:K:N:P:K: 1:1:10>> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)> dummy.coef(npk.aovE)Error: (Intercept)(Intercept): 54.875Error: blockN: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.241667N:P:K: 1:1:11.241667Error: WithinN: 0 1-2.808333 2.808333P: 0 10.5916667 -0.5916667K: 0 11.991667 -1.991667N:P: 0:0 1:0 0:1 1:1-0.9416667 0.9416667 0.9416667 -0.9416667N:K: 0:0 1:0 0:1 1:1-1.175 1.175 1.175 -1.175P:K: 0:0 1:0 0:1 1:10.1416667 -0.1416667 -0.1416667 0.1416667>>>> base::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 CDFCall: 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 summaryMin. 1st Qu. Median Mean 3rd Qu. Max.-0.8356 -0.3857 0.3597 0.2686 0.6164 1.5953> ##--> 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)> Fn12Empirical CDFCall: 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 summaryMin. 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 summaryMin. 1st Qu. Median Mean 3rd Qu. Max.-2.20 -0.95 0.05 -0.30 0.65 0.90and 9 plateau levels (y) with summaryMin. 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?> ls(environment(Fn12))[1] "f" "method" "na.rm" "nobs" "x" "y" "yleft" "yright"> ## "f" "method" "na.rm" "nobs" "x" "y" "yleft" "yright"> utils::ls.str(environment(Fn12))f : num 0method : int 2na.rm : logi TRUEnobs : int 12x : num [1:8] -2.2 -2 -0.6 0 0.1 0.6 0.8 0.9y : num [1:8] 0.0833 0.1667 0.3333 0.5 0.5833 ...yleft : num 0yright : num 1> stopifnot(all.equal(quantile(Fn12), quantile(y)))>> ###----------------- 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 summaryMin. 1st Qu. Median Mean 3rd Qu. Max.-1.47075 -0.14254 -0.05497 0.04667 0.41037 1.35868>> 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"))> ## IGNORE_RDIFF_BEGIN> (fit <- aov(Yield ~ A*B*C + Error(Block), data = aovdat))Call:aov(formula = Yield ~ A * B * C + Error(Block), data = aovdat)Grand Mean: 291.5938Stratum 1: BlockTerms:A:B A:C B:C A:B:C ResidualsSum of Squares 780.1250 276.1250 2556.1250 112.5000 774.0938Deg. of Freedom 1 1 1 1 3Residual standard error: 16.06335Estimated effects are balancedStratum 2: WithinTerms:A B C A:B A:C B:CSum of Squares 3465.28 161170.03 278817.78 28.17 1802.67 11528.17Deg. of Freedom 1 1 1 1 1 1A:B:C ResidualsSum of Squares 45.37 5423.28Deg. of Freedom 1 17Residual standard error: 17.86103Estimated effects are balanced> ## IGNORE_RDIFF_END> eff.aovlist(fit)A B C A:B A:C B:C A:B:CBlock 0 0 0 0.25 0.25 0.25 0.25Within 1 1 1 0.75 0.75 0.75 0.75> options(contrasts = old)>>>> base::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.2302295attr(,"assign")[1] 0 1attr(,"class")[1] "coef"> c( round(ee - effects(lm(y+10 ~ I(x-3.8))), 3) )(Intercept) x22.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 likelog(Volume) log(Girth) log(Height) Girth1 2.332144 2.116256 4.248495 8.32 2.332144 2.151762 4.174387 8.63 2.322388 2.174752 4.143135 8.84 2.797281 2.351375 4.276666 10.55 2.933857 2.370244 4.394449 10.76 2.980619 2.379546 4.418841 10.87 2.747271 2.397895 4.189655 11.08 2.901422 2.397895 4.317488 11.09 3.117950 2.406945 4.382027 11.110 2.990720 2.415914 4.317488 11.211 3.186353 2.424803 4.369448 11.312 3.044522 2.433613 4.330733 11.413 3.063391 2.433613 4.330733 11.414 3.058707 2.459589 4.234107 11.715 2.949688 2.484907 4.317488 12.016 3.100092 2.557227 4.304065 12.917 3.520461 2.557227 4.442651 12.918 3.310543 2.587764 4.454347 13.319 3.246491 2.617396 4.262680 13.720 3.214868 2.624669 4.158883 13.821 3.540959 2.639057 4.356709 14.022 3.456317 2.653242 4.382027 14.223 3.591818 2.674149 4.304065 14.524 3.645450 2.772589 4.276666 16.025 3.751854 2.791165 4.343805 16.326 4.014580 2.850707 4.394449 17.327 4.019980 2.862201 4.406719 17.528 4.065602 2.884801 4.382027 17.929 3.941582 2.890372 4.382027 18.030 3.931826 2.890372 4.382027 18.031 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) # = defaulty x z1 -0.6264538 1 12 0.1836433 2 24 1.5952808 4 4> expand.model.frame(model, "z", na.expand = TRUE)y x z1 -0.6264538 1 12 0.1836433 2 23 -0.8356286 3 NA4 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>>> 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 v6v1 1.0000000 0.9393083 0.5128866 0.4320310 0.4664948 0.4086076v2 0.9393083 1.0000000 0.4124441 0.4084281 0.4363925 0.4326113v3 0.5128866 0.4124441 1.0000000 0.8770750 0.5128866 0.4320310v4 0.4320310 0.4084281 0.8770750 1.0000000 0.4320310 0.4323259v5 0.4664948 0.4363925 0.5128866 0.4320310 1.0000000 0.9473451v6 0.4086076 0.4326113 0.4320310 0.4323259 0.9473451 1.0000000> factanal(m1, factors = 3) # varimax is the defaultCall:factanal(x = m1, factors = 3)Uniquenesses:v1 v2 v3 v4 v5 v60.005 0.101 0.005 0.224 0.084 0.005Loadings:Factor1 Factor2 Factor3v1 0.944 0.182 0.267v2 0.905 0.235 0.159v3 0.236 0.210 0.946v4 0.180 0.242 0.828v5 0.242 0.881 0.286v6 0.193 0.959 0.196Factor1 Factor2 Factor3SS loadings 1.893 1.886 1.797Proportion Var 0.316 0.314 0.300Cumulative Var 0.316 0.630 0.929The degrees of freedom for the model is 0 and the fit was 0.4755> # The following shows the g factor as PC1>> ## formula interface> factanal(~v1+v2+v3+v4+v5+v6, factors = 3,+ scores = "Bartlett")$scoresFactor1 Factor2 Factor31 -0.9039949 -0.9308984 0.94753922 -0.8685952 -0.9328721 0.93523303 -0.9082818 -0.9320093 0.96164224 -1.0021975 -0.2529689 0.81785525 -0.9039949 -0.9308984 0.94753926 -0.7452711 0.7273960 -0.78847337 -0.7098714 0.7254223 -0.80077958 -0.7495580 0.7262851 -0.77437049 -0.8080740 1.4033517 -0.930463610 -0.7452711 0.7273960 -0.788473311 0.9272282 -0.9307506 -0.837153812 0.9626279 -0.9327243 -0.849460013 0.9229413 -0.9318615 -0.823050914 0.8290256 -0.2528211 -0.966837815 0.9272282 -0.9307506 -0.837153816 0.4224366 2.0453079 1.286476117 1.4713902 1.2947716 0.545156218 1.8822320 0.3086244 1.9547752>>>> 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> ### Keywords: models>> ### ** Examples>> require(utils) # for str>> nf <- gaussian() # Normal family> nfFamily: gaussianLink function: identity> str(nf)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| __truncated__$ validmu :function (mu)$ valideta :function (eta)- attr(*, "class")= chr "family">> gf <- Gamma()> gfFamily: GammaLink 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, n| __truncated__$ validmu :function (mu)$ valideta :function (eta)$ simulate :function (object, nsim)- attr(*, "class")= chr "family"> gf$linkinvfunction (eta)1/eta<environment: namespace:stats>> gf$variance(-3:4) #- == (.)^2[1] 9 4 1 0 1 4 9 16>> ## Binomial with default 'logit' link: Check some properties visually:> bi <- binomial()> et <- seq(-10,10, by=1/8)> plot(et, bi$mu.eta(et), type="l")> ## show that mu.eta() is derivative of linkinv() :> lines((et[-1]+et[-length(et)])/2, col=adjustcolor("red", 1/4),+ diff(bi$linkinv(et))/diff(et), type="l", lwd=4)> ## which here is the logistic density:> lines(et, dlogis(et), lwd=3, col=adjustcolor("blue", 1/4))> stopifnot(exprs = {+ all.equal(bi$ mu.eta(et), dlogis(et))+ all.equal(bi$linkinv(et), plogis(et) -> m)+ all.equal(bi$linkfun(m ), qlogis(m)) # logit(.) == qlogis(.) !+ })>> ## Data from example(glm) :> d.AD <- data.frame(treatment = gl(3,3),+ outcome = gl(3,1,9),+ counts = c(18,17,15, 20,10,20, 25,13,12))> glm.D93 <- glm(counts ~ outcome + treatment, d.AD, family = poisson())> ## Quasipoisson: compare with above / example(glm) :> glm.qD93 <- glm(counts ~ outcome + treatment, d.AD, family = quasipoisson())>>> ## 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) *+ binomial()$mu.eta(eta)+ valideta <- function(eta) TRUE+ link <- paste0("logexp(", days, ")")+ structure(list(linkfun = linkfun, linkinv = linkinv,+ mu.eta = mu.eta, valideta = valideta, name = link),+ class = "link-glm")+ }> (bil3 <- binomial(logexp(3)))Family: binomialLink function: logexp(3)> ## Don't show:> stopifnot(length(bil3$mu.eta(as.double(0:5))) == 6)> ## End(Don't show)> ## 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, as both> ## computationally and conceptually difficult:> binomial(link = "identity") ## is exactly the same asFamily: binomialLink function: identity> binomial(link = make.link("identity"))Family: binomialLink function: 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) x0.8596 1.0875Degrees of Freedom: 99 Total (i.e. Null); 98 ResidualNull Deviance: 481.9Residual Deviance: 101.7 AIC: NA> # which is the same as> glm(y ~ x, family = poisson)Call: glm(formula = y ~ x, family = poisson)Coefficients:(Intercept) x0.8596 1.0875Degrees of Freedom: 99 Total (i.e. Null); 98 ResidualNull Deviance: 481.9Residual 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) x0.6902 1.4546Degrees of Freedom: 99 Total (i.e. Null); 98 ResidualNull Deviance: 83.85Residual Deviance: 32.45 AIC: NA> ## Not run: glm(y ~ x, family = quasi(variance = "mu^3", link = "log")) # fails> y <- rbinom(100, 1, plogis(x))> # need 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.38518Degrees of Freedom: 99 Total (i.e. Null); 98 ResidualNull Deviance: 138.6Residual Deviance: 135.8 AIC: NA>>>> cleanEx()> nameEx("fft")> ### * fft>> flush(stderr()); flush(stdout())>> ### Name: fft> ### Title: Fast Discrete Fourier Transform (FFT)> ### 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>> ## Slow Discrete Fourier Transform (DFT) - e.g., for checking the formula> fft0 <- function(z, inverse=FALSE) {+ n <- length(z)+ if(n == 0) return(z)+ k <- 0:(n-1)+ ff <- (if(inverse) 1 else -1) * 2*pi * 1i * k/n+ vapply(1:n, function(h) sum(z * exp(ff*(h-1))), complex(1))+ }>> relD <- function(x,y) 2* abs(x - y) / abs(x + y)> n <- 2^8> z <- complex(n, rnorm(n), rnorm(n))>>> 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 = 1End = 100Frequency = 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 = 1End = 100Frequency = 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 = 1End = 100Frequency = 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 Qtr41945 NA NA 244 2201946 188 156 125 1101947 127 149 169 1451948 130 NA NA NA1949 NA 183 165 1531950 133 128 122 1211951 99 92 79 801952 80 NA NA NA1953 165 208 209 2061954 192 203 189 1991955 196 218 220 2281956 220 214 213 2211957 216 204 182 1801958 166 157 149 1571959 171 180 189 1981960 199 194 180 1901961 212 226 232 2281962 228 212 207 2121963 214 202 183 1991964 210 222 211 2091965 204 204 195 1941966 171 165 146 1441967 140 134 136 1201968 131 120 128 1381969 168 189 186 1871970 175 180 166 1641971 151 153 151 1521972 159 NA NA NA1973 NA 152 111 951974 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 Datadata: TeaTastingp-value = 0.2429alternative hypothesis: true odds ratio is greater than 195 percent confidence interval:0.3135693 Infsample estimates:odds ratio6.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")))> ConvictionsConvicted Not convictedDizygotic 2 15Monozygotic 10 3> fisher.test(Convictions, alternative = "less")Fisher's Exact Test for Count Datadata: Convictionsp-value = 0.0004652alternative hypothesis: true odds ratio is less than 195 percent confidence interval:0.0000000 0.2849601sample estimates:odds ratio0.04693661> fisher.test(Convictions, conf.int = FALSE)Fisher's Exact Test for Count Datadata: Convictionsp-value = 0.0005367alternative hypothesis: true odds ratio is not equal to 1sample estimates:odds ratio0.04693661> fisher.test(Convictions, conf.level = 0.95)$conf.int[1] 0.003325764 0.363182271attr(,"conf.level")[1] 0.95> fisher.test(Convictions, conf.level = 0.99)$conf.int[1] 0.001386333 0.578851645attr(,"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) # 0.7827Fisher's Exact Test for Count Datadata: Jobp-value = 0.7827alternative hypothesis: two.sided> fisher.test(Job, simulate.p.value = TRUE, B = 1e5) # also close to 0.78Fisher's Exact Test for Count Data with simulated p-value (based on1e+05 replicates)data: Jobp-value = 0.7842alternative hypothesis: two.sided>> ## 6th example in Mehta & Patel's JASA paper> MP6 <- rbind(+ c(1,2,2,1,1,0,1),+ c(2,0,0,2,3,0,0),+ c(0,1,1,1,2,7,3),+ c(1,1,2,0,0,0,1),+ c(0,1,1,1,1,0,0))> fisher.test(MP6)Fisher's Exact Test for Count Datadata: MP6p-value = 0.03929alternative hypothesis: two.sided> # Exactly the same p-value, as Cochran's conditions are never met:> fisher.test(MP6, hybrid=TRUE)Fisher's Exact Test for Count Data hybrid using asym.chisq. iff(exp=5, perc=80, Emin=1)data: MP6p-value = 0.03929alternative 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 variancesdata: InsectSprays$count and InsectSprays$sprayFligner-Killeen:med chi-squared = 14.483, df = 5, p-value = 0.01282> fligner.test(count ~ spray, data = InsectSprays)Fligner-Killeen test of homogeneity of variancesdata: count by sprayFligner-Killeen:med chi-squared = 14.483, 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 DF2formula as.formula print.formula [.formula> ### Keywords: models>> ### ** Examples>> class(fo <- y ~ x1*x2) # "formula"[1] "formula"> foy ~ x1 * x2> typeof(fo) # R internal : "language"[1] "language"> terms(fo)y ~ x1 * x2attr(,"variables")list(y, x1, x2)attr(,"factors")x1 x2 x1:x2y 0 0 0x1 1 0 1x2 0 1 1attr(,"term.labels")[1] "x1" "x2" "x1:x2"attr(,"order")[1] 1 1 2attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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: 0x5f97170>>>> ## Create a formula for a model with a large number of variables:> xnam <- paste0("x", 1:25)> (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 testdata: RoundingTimesFriedman chi-squared = 11.143, 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)> wbw t x1 A L 44.555562 B L 28.222223 A M 24.000004 B M 28.777785 A H 24.555566 B H 18.77778> friedman.test(wb$x, wb$w, wb$t)Friedman rank sum testdata: wb$x, wb$w and wb$tFriedman chi-squared = 0.33333, df = 1, p-value = 0.5637> friedman.test(x ~ w | t, data = wb)Friedman rank sum testdata: x and w and tFriedman chi-squared = 0.33333, df = 1, p-value = 0.5637>>>> cleanEx()> nameEx("ftable")> ### * ftable>> flush(stderr()); flush(stdout())>> ### Name: ftable> ### Title: Flat Contingency Tables> ### Aliases: ftable ftable.default> ### Keywords: category>> ### ** Examples>> ## Start with a contingency table.> ftable(Titanic, row.vars = 1:3)Survived No YesClass Sex Age1st Male Child 0 5Adult 118 57Female Child 0 1Adult 4 1402nd Male Child 0 11Adult 154 14Female Child 0 13Adult 13 803rd Male Child 35 13Adult 387 75Female Child 17 14Adult 89 76Crew Male Child 0 0Adult 670 192Female Child 0 0Adult 3 20> ftable(Titanic, row.vars = 1:2, col.vars = "Survived")Survived No YesClass Sex1st Male 118 62Female 4 1412nd Male 154 25Female 13 933rd Male 422 88Female 106 90Crew Male 670 192Female 3 20> ftable(Titanic, row.vars = 2:1, col.vars = "Survived")Survived No YesSex ClassMale 1st 118 622nd 154 253rd 422 88Crew 670 192Female 1st 4 1412nd 13 933rd 106 90Crew 3 20> ## Don't show:> . <- integer()> (f04 <- ftable(Titanic, col.vars= .))Class Sex Age Survived1st Male Child No 0Yes 5Adult No 118Yes 57Female Child No 0Yes 1Adult No 4Yes 1402nd Male Child No 0Yes 11Adult No 154Yes 14Female Child No 0Yes 13Adult No 13Yes 803rd Male Child No 35Yes 13Adult No 387Yes 75Female Child No 17Yes 14Adult No 89Yes 76Crew Male Child No 0Yes 0Adult No 670Yes 192Female Child No 0Yes 0Adult No 3Yes 20> (f10 <- ftable(Titanic, col.vars= 1, row.vars= .))Class 1st 2nd 3rd Crew325 285 706 885> (f01 <- ftable(Titanic, col.vars= ., row.vars= 1))Class1st 3252nd 2853rd 706Crew 885> (f00 <- ftable(Titanic, col.vars= ., row.vars= .))2201> stopifnot(+ dim(f04) == c(32,1),+ dim(f10) == c(1,4),+ dim(f01) == c(4,1),+ dim(f00) == c(1,1))> ## End(Don't show)> ## Start with a data frame.> x <- ftable(mtcars[c("cyl", "vs", "am", "gear")])> xgear 3 4 5cyl vs am4 0 0 0 0 01 0 0 11 0 1 2 01 0 6 16 0 0 0 0 01 0 2 11 0 2 2 01 0 0 08 0 0 12 0 01 0 0 21 0 0 0 01 0 0 0> ftable(x, row.vars = c(2, 4))cyl 4 6 8am 0 1 0 1 0 1vs gear0 3 0 0 0 0 12 04 0 0 0 2 0 05 0 1 0 1 0 21 3 1 0 2 0 0 04 2 6 2 0 0 05 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 8Transmission 0 1 0 1 0 1V/S Gears0 3 0 0 0 0 12 04 0 0 0 2 0 05 0 1 0 1 0 21 3 1 0 2 0 0 04 2 6 2 0 0 05 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 = NoSexClass Male Female1st 0 02nd 0 03rd 35 17Crew 0 0, , Age = Adult, Survived = NoSexClass Male Female1st 118 42nd 154 133rd 387 89Crew 670 3, , Age = Child, Survived = YesSexClass Male Female1st 5 12nd 11 133rd 13 14Crew 0 0, , Age = Adult, Survived = YesSexClass Male Female1st 57 1402nd 14 803rd 75 76Crew 192 20> x <- ftable(Survived ~ ., data = Titanic)> xSurvived No YesClass Sex Age1st Male Child 0 5Adult 118 57Female Child 0 1Adult 4 1402nd Male Child 0 11Adult 154 14Female Child 0 13Adult 13 803rd Male Child 35 13Adult 387 75Female Child 17 14Adult 89 76Crew Male Child 0 0Adult 670 192Female Child 0 0Adult 3 20> ftable(Sex ~ Class + Age, data = x)Sex Male FemaleClass Age1st Child 5 1Adult 175 1442nd Child 11 13Adult 168 933rd Child 48 31Adult 462 165Crew Child 0 0Adult 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 K212.6837 0.0641>>>> cleanEx()> nameEx("glm")> ### * glm>> flush(stderr()); flush(stdout())>> ### Name: glm> ### Title: Fitting Generalized Linear Models> ### Aliases: glm glm.fit weights.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)> data.frame(treatment, outcome, counts) # showing datatreatment outcome counts1 1 1 182 1 2 173 1 3 154 2 1 205 2 2 106 2 3 207 3 1 258 3 2 139 3 3 12> glm.D93 <- glm(counts ~ outcome + treatment, family = poisson())> anova(glm.D93)Analysis of Deviance TableModel: poisson, link: logResponse: countsTerms added sequentially (first to last)Df Deviance Resid. Df Resid. DevNULL 8 10.5814outcome 2 5.4523 6 5.1291treatment 2 0.0000 4 5.1291> ## Computing AIC [in many ways]:> (A0 <- AIC(glm.D93))[1] 56.76132> (ll <- logLik(glm.D93))'log Lik.' -23.38066 (df=5)> A1 <- -2*c(ll) + 2*attr(ll, "df")> A2 <- glm.D93$family$aic(counts, mu=fitted(glm.D93), wt=1) ++ 2 * length(coef(glm.D93))> stopifnot(exprs = {+ all.equal(A0, A1)+ all.equal(A1, A2)+ all.equal(A1, glm.D93$aic)+ })>>>> # 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.08641Coefficients: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.51283 on 8 degrees of freedomResidual deviance: 0.01673 on 7 degrees of freedomAIC: 37.99Number 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.06371Coefficients: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 freedomResidual deviance: 0.012672 on 7 degrees of freedomAIC: 27.032Number of Fisher Scoring iterations: 3> ## Aliased ("S"ingular) -> 1 NA coefficient> (fS <- glm(lot2 ~ log(u) + log(u^2), data = clotting, family = Gamma))Call: glm(formula = lot2 ~ log(u) + log(u^2), family = Gamma, data = clotting)Coefficients:(Intercept) log(u) log(u^2)-0.02391 0.02360 NADegrees of Freedom: 8 Total (i.e. Null); 7 ResidualNull Deviance: 3.119Residual Deviance: 0.01267 AIC: 27.03> tools::assertError(update(fS, singular.ok=FALSE), verbose=interactive())> ## -> .. "singular fit encountered">> ## 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>>> cleanEx()> nameEx("hclust")> ### * hclust>> flush(stderr()); flush(stdout())>> ### Name: hclust> ### Title: Hierarchical Clustering> ### Aliases: hclust plot.hclust print.hclust> ### Keywords: multivariate cluster>> ### ** Examples>> require(graphics)>> ### Example 1: Violent crime rates by US state>> 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)>> ### Example 2: Straight-line distances among 10 US cities> ## Compare the results of algorithms "ward.D" and "ward.D2">> mds2 <- -cmdscale(UScitiesD)> plot(mds2, type="n", axes=FALSE, ann=FALSE)> text(mds2, labels=rownames(mds2), xpd = NA)>> hcity.D <- hclust(UScitiesD, "ward.D") # "wrong"> hcity.D2 <- hclust(UScitiesD, "ward.D2")> opar <- par(mfrow = c(1, 2))> plot(hcity.D, hang=-1)> plot(hcity.D2, hang=-1)> 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 vectorsList 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 advancerating 1.00 0.83 0.43 0.62 0.59 0.16 0.16complaints 0.83 1.00 0.56 0.60 0.67 0.19 0.22privileges 0.43 0.56 1.00 0.49 0.45 0.15 0.34learning 0.62 0.60 0.49 1.00 0.64 0.12 0.53raises 0.59 0.67 0.45 0.64 1.00 0.38 0.57critical 0.16 0.19 0.15 0.12 0.38 1.00 0.28advance 0.16 0.22 0.34 0.53 0.57 0.28 1.00> symnum(Ca) # simple graphicrt cm p l rs cr arating 1complaints + 1privileges . . 1learning , . . 1raises . , . , 1critical . 1advance . . . 1attr(,"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()> ## slightly artificial with color bar, without and with ordering:> cc <- rainbow(nrow(Ca))> heatmap(Ca, Rowv = FALSE, symm = TRUE, RowSideColors = cc, ColSideColors = cc,+ margins = c(6,6))> heatmap(Ca, symm = TRUE, RowSideColors = cc, ColSideColors = cc,+ margins = c(6,6))>> ## For variable clustering, rather use distance based on cor():> symnum( cU <- cor(USJudgeRatings) )CO I DM DI CF DE PR F O W PH RCONT 1INTG 1DMNR B 1DILG + + 1CFMG + + B 1DECI + + B B 1PREP + + B B B 1FAMI + + B * * B 1ORAL * * B B * B B 1WRIT * + B * * B B B 1PHYS , , + + + + + + + 1RTEN * * * * * B * B B * 1attr(,"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 FAMICONT 100 -13 -15 5 1 14 9 -3 -1 -4 1 -3INTG -13 100 96 74 87 81 80 94 91 91 88 87DMNR -15 96 100 79 84 81 80 94 91 89 86 84PHYS 5 74 79 100 81 88 87 91 89 86 85 84DILG 1 87 84 81 100 96 96 93 95 96 98 96CFMG 14 81 81 88 96 100 98 93 95 94 96 94DECI 9 80 80 87 96 98 100 92 95 95 96 94RTEN -3 94 94 91 93 93 92 100 98 97 95 94ORAL -1 91 91 89 95 95 95 98 100 99 98 98WRIT -4 91 89 86 96 94 95 97 99 100 99 99PREP 1 88 86 85 98 96 96 95 98 99 100 99FAMI -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 dev.new() # << 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 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 Libya7 44 46 49> # which observations 'are' influential> summary(inflm.SR) # only thesePotentially influential observations oflm(formula = sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings) :dfb.1_ dfb.pp15 dfb.pp75 dfb.dpi dfb.ddpi dffit cov.r cook.dChile -0.20 0.13 0.22 -0.02 0.12 -0.46 0.65_* 0.04United States 0.07 -0.07 0.04 -0.23 -0.03 -0.25 1.66_* 0.01Zambia 0.16 -0.08 -0.34 0.09 0.23 0.75 0.51_* 0.10Libya 0.55 -0.48 -0.38 -0.02 -1.02_* -1.16_* 2.09_* 0.27hatChile 0.04United States 0.33_*Zambia 0.06Libya 0.53_*> plot(rstudent(lm.SR) ~ hatvalues(lm.SR)) # recommended by some> plot(lm.SR, which = 5) # an enhanced version of that via plot(<lm>)>> ## The 'infl' argument is not needed, but avoids recomputation:> rs <- rstandard(lm.SR)> iflSR <- influence(lm.SR)> all.equal(rs, rstandard(lm.SR, infl = iflSR), tol = 1e-10)[1] TRUE> ## to "see" the larger values:> 1000 * round(dfbetas(lm.SR, infl = iflSR), 3)(Intercept) pop15 pop75 dpi ddpiAustralia 12 -10 -27 45 0Austria -10 6 41 -37 -8Belgium -64 51 121 -35 -7Bolivia 6 -13 -23 32 41Brazil 90 -62 -179 120 68Canada 5 -7 10 -35 -3Chile -199 133 220 -20 120China 21 -6 -83 52 111Colombia 39 -52 -25 2 9Costa Rica -234 284 142 56 -33Denmark -41 21 47 152 49Ecuador 72 -95 -61 20 48Finland -113 111 117 -44 -17France -166 147 219 -29 24Germany -8 8 8 -7 0Greece -148 164 29 157 -60Guatamala 16 -55 6 6 97Honduras -2 10 -10 8 -2Iceland 248 -274 -233 -126 185India 21 -16 -14 -14 -19Ireland -310 296 482 -257 -93Italy 66 -71 3 -70 -29Japan 640 -656 -674 146 389Korea -169 135 219 5 -169Luxembourg -68 69 44 -28 49Malta 37 -49 8 -87 153Norway 2 0 -6 -16 -1Netherlands 14 -17 -12 4 23New Zealand -60 65 94 -26 -65Nicaragua -12 18 10 -5 -10Panama 28 -53 14 -35 -8Paraguay -232 164 158 144 270Peru -72 147 91 -86 -287Philippines -157 227 157 -111 -171Portugal -21 26 -4 40 -28South Africa 22 -20 -7 -20 -16South Rhodesia 144 -135 -92 -70 -58Spain -30 31 4 35 5Sweden 101 -82 -62 -255 -13Switzerland 43 -46 -44 91 -19Turkey -11 -12 26 2 25Tunisia 74 -105 -77 44 103United Kingdom 47 -36 -171 126 100United States 69 -73 37 -233 -33Venezuela -51 101 -34 114 -124Zambia 164 -79 -339 94 228Jamaica 110 -100 -57 -7 -295Uruguay -134 129 30 131 100Libya 551 -483 -380 -19 -1024Malaysia 37 -61 32 -50 -72> cat("PRESS :"); (PRESS <- sum( rstandard(lm.SR, type = "predictive")^2 ))PRESS :[1] 798.939> stopifnot(all.equal(PRESS, sum( (residuals(lm.SR) / (1 - iflSR$hat))^2)))>> ## Show that "PRE-residuals" == L.O.O. Crossvalidation (CV) errors:> X <- model.matrix(lm.SR)> y <- model.response(model.frame(lm.SR))> ## Leave-one-out CV least-squares prediction errors (relatively fast)> rCV <- vapply(seq_len(nrow(X)), function(i)+ y[i] - X[i,] %*% .lm.fit(X[-i,], y[-i])$coef,+ numeric(1))> ## are the same as the *faster* rstandard(*, "pred") :> stopifnot(all.equal(rCV, unname(rstandard(lm.SR, type = "predictive"))))>>> ## Huber's data [Atkinson 1985]> xh <- c(-4:0, 10)> yh <- c(2.48, .73, -.04, -1.44, -1.32, 0)> lmH <- lm(yh ~ xh)> im <- influence.measures(lmH)> 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 dose xi> mi <- rep(40, 5) # number of mice exposed> glmI <- glm(cbind(yi, mi -yi) ~ xi, family = binomial)> signif(cooks.distance(glmI), 3) # ~= Ci in Table 3, p.1841 2 3 4 50.2520 0.2610 1.2900 0.0845 0.3640> imI <- influence.measures(glmI)> stopifnot(all.equal(imI$infmat[,"cook.d"],+ cooks.distance(glmI)))>>>> 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 < 1e-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) ## correct2 with absolute error < 2.2e-14> integrate(function(x) rep(2.0, length(x)), 0, 1) ## correct2 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 systems0 with absolute error < 0> integrate(dnorm, 0, Inf) ## works0.5 with absolute error < 4.7e-05> ## Don't show:> tools::assertError(+ ## End(Don't show)+ integrate(dnorm, 0:1, 20) #-> error!+ ## "silently" gave integrate(dnorm, 0, 20) in earlier versions of R+ ## Don't show:+ , verbose=TRUE)Asserted error: length(lower) == 1 is not TRUE> ## End(Don't show)>>>> 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-74agegp alcgp tobgp ncases ncontrols66 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 functionCall: isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3))x[1:3] = 2, 5, 94 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 indexingDaniell(3,3)coef[-6] = 0.02041coef[-5] = 0.04082coef[-4] = 0.06122coef[-3] = 0.08163coef[-2] = 0.10204coef[-1] = 0.12245coef[ 0] = 0.14286coef[ 1] = 0.12245coef[ 2] = 0.10204coef[ 3] = 0.08163coef[ 4] = 0.06122coef[ 5] = 0.04082coef[ 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 fitted.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 49, 51Cluster means:x y1 0.02149367 0.021212482 0.94443633 1.01712793Clustering vector:[1] 1 1 1 1 1 1 1 1 1 1 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 1 1[38] 1 1 1 1 1 1 1 1 1 1 1 1 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[75] 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 2Within cluster sum of squares by cluster:[1] 6.525480 8.392416(between_SS / total_SS = 75.5 %)Available components:[1] "cluster" "centers" "totss" "withinss" "tot.withinss"[6] "betweenss" "size" "iter" "ifault"> plot(x, col = cl$cluster)> points(cl$centers, col = 1:2, pch = 8, cex = 2)>> # sum of squares> ss <- function(x) sum(scale(x, scale = FALSE)^2)>> ## cluster centers "fitted" to each obs.:> fitted.x <- fitted(cl); head(fitted.x)x y1 0.02149367 0.021212481 0.02149367 0.021212481 0.02149367 0.021212481 0.02149367 0.021212481 0.02149367 0.021212481 0.02149367 0.02121248> resid.x <- x - fitted(cl)>> ## Equalities : ----------------------------------> cbind(cl[c("betweenss", "tot.withinss", "totss")], # the same two columns+ c(ss(fitted.x), ss(resid.x), ss(x)))[,1] [,2]betweenss 46.07333 46.07333tot.withinss 14.9179 14.9179totss 60.99123 60.99123> stopifnot(all.equal(cl$ totss, ss(x)),+ all.equal(cl$ tot.withinss, ss(resid.x)),+ ## these three are the same:+ all.equal(cl$ betweenss, ss(fitted.x)),+ all.equal(cl$ betweenss, cl$totss - cl$tot.withinss),+ ## and hence also+ all.equal(ss(x), ss(fitted.x) + ss(resid.x))+ )>> kmeans(x,1)$withinss # trivial one-cluster, (its W.SS == ss(x))[1] 60.99123>> ## random starts do help here with too many clusters> ## (and are often recommended anyway!):> (cl <- kmeans(x, 5, nstart = 25))K-means clustering with 5 clusters of sizes 12, 24, 24, 15, 25Cluster means:x y1 1.3290081 1.11855342 0.1581362 -0.17615903 0.8043520 0.78050334 0.8609139 1.31458695 -0.1096832 0.2106891Clustering vector:[1] 5 2 5 2 5 5 2 2 5 5 3 2 5 5 2 5 2 5 2 5 2 2 5 5 2 5 2 5 5 2 2 2 5 2 5 5 5[38] 2 2 2 2 5 5 5 5 5 2 2 2 2 4 3 3 3 3 1 1 1 3 1 4 3 1 4 3 4 3 3 1 4 4 1 4 3[75] 3 1 4 4 4 4 3 4 1 3 1 3 4 3 3 3 3 1 3 4 3 3 1 3 4 3Within cluster sum of squares by cluster:[1] 1.0314888 1.2816507 1.5056575 0.7104553 2.5330710(between_SS / total_SS = 88.4 %)Available components:[1] "cluster" "centers" "totss" "withinss" "tot.withinss"[6] "betweenss" "size" "iter" "ifault"> 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 testdata: list(x, y, z)Kruskal-Wallis chi-squared = 0.77143, 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 testdata: x and gKruskal-Wallis chi-squared = 0.77143, 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 testdata: Ozone by MonthKruskal-Wallis chi-squared = 29.267, 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 testdata: x and yD = 0.48, p-value = 0.0002033alternative 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, exactOne-sample Kolmogorov-Smirnov testdata: x + 2D = 0.40962, p-value = 4.227e-08alternative hypothesis: two-sided> ks.test(x+2, "pgamma", 3, 2, exact = FALSE)One-sample Kolmogorov-Smirnov testdata: x + 2D = 0.40962, p-value = 1.033e-07alternative hypothesis: two-sided> ks.test(x+2, "pgamma", 3, 2, alternative = "gr")One-sample Kolmogorov-Smirnov testdata: x + 2D^+ = 0.039998, p-value = 0.8302alternative 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-testdata: x and x2t = 5.6742, df = 96.85, p-value = 7.242e-08alternative hypothesis: true difference in means is greater than 095 percent confidence interval:0.7069751 Infsample estimates:mean of x mean of y0.1004483 -0.8990693> wilcox.test(x, x2, alternative = "g")Wilcoxon rank sum test with continuity correctiondata: x and x2W = 1983, p-value = 2.212e-07alternative hypothesis: true location shift is greater than 0> ks.test(x, x2, alternative = "l")Two-sample Kolmogorov-Smirnov testdata: x and x2D^- = 0.5, p-value = 3.727e-06alternative 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 earlierJan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec1973 3035 2552 2704 2554 2014 1655 1721 1524 1596 2074 2199 25121974 2933 2889 2938 2497 1870 1726 1607 1545 1396 1787 2076 28371975 2787 3891 3179 2011 1636 1580 1489 1300 1356 1653 2013 28231976 3102 2294 2385 2444 1748 1554 1498 1361 1346 1564 1640 22931977 2815 3137 2679 1969 1870 1633 1529 1366 1357 1570 1535 24911978 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)>> ## no lines for long series :> lag.plot(sqrt(sunspots), set = c(1:4, 9:12), pch = ".", col = "gold")>>>> 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] -29.333 4.667> abline(coef(z))> ## Tukey-Anscombe Plot :> plot(residuals(z) ~ fitted(z), main = deparse(z$call))>> ## Andrew Siegel's pathological 9-point data, y-values multiplied by 3:> d.AS <- data.frame(x = c(-4:3, 12), y = 3*c(rep(0,6), -5, 5, 1))> cAS <- with(d.AS, t(sapply(1:10,+ function(it) line(x,y, iter=it)$coefficients)))> dimnames(cAS) <- list(paste("it =", format(1:10)), c("intercept", "slope"))> cASintercept slopeit = 1 0.500000 0.500000it = 2 -0.250000 -0.250000it = 3 0.875000 0.875000it = 4 -0.812500 -0.812500it = 5 1.718750 1.718750it = 6 -2.078125 -2.078125it = 7 2.500000 2.500000it = 8 -2.083333 -2.083333it = 9 2.500000 2.500000it = 10 -2.083333 -2.083333> ## iterations started to oscillate, repeating iteration 7,8 indefinitely>>>> cleanEx()> nameEx("lm")> ### * lm>> flush(stderr()); flush(stdout())>> ### Name: lm> ### Title: Fitting Linear Models> ### Aliases: 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)> lm.D9 <- lm(weight ~ group)> lm.D90 <- lm(weight ~ group - 1) # omitting intercept> opar <- par(mfrow = c(2,2), oma = c(0, 0, 1.1, 0))> plot(lm.D9, las = 1) # Residuals, Fitted, ...> par(opar)> ## Don't show:> ## model frame :> stopifnot(identical(lm(weight ~ group, method = "model.frame"),+ model.frame(lm.D9)))> ## End(Don't show)> ### 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.7509Coefficients: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.125530dpi -0.0003369 0.0009311 -0.362 0.719173ddpi 0.4096949 0.1961971 2.088 0.042471 *---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1Residual standard error: 3.803 on 45 degrees of freedomMultiple R-squared: 0.3385, Adjusted R-squared: 0.2797F-statistic: 5.756 on 4 and 45 DF, p-value: 0.0007904Correlation of Coefficients:(Intercept) pop15 pop75 dpipop15 -0.98pop75 -0.81 0.77dpi -0.17 0.18 -0.37ddpi -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> ### 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 coefficientsgroupCtl groupTrt5.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 .lm.fit> ### 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> ## Don't show:> ## These are the same calculations at C level, but a parallel BLAS> ## might not do them the same way twice, and if seems serial MKL does not.> lm.. <- .lm.fit(X,y)> lm.w <- .lm.fit(X*sqrt(w), y*sqrt(w))> id <- function(x, y) all.equal(x, y, tolerance = 1e-15, scale = 1)> stopifnot(id(unname(lm.$coef), lm..$coef),+ id(unname(lmw$coef), lm.w$coef))> ## End(Don't show)>>>> 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)$fit1 2 3 4 5 6 7 87.797353 10.002308 12.499786 15.281082 18.446568 21.865315 25.517015 29.3503869 10 11 12 13 14 15 1633.230660 37.167935 41.205226 45.055736 48.355889 49.824812 51.986702 56.46131817 18 19 20 21 22 23 2461.959729 68.569313 76.316068 85.212121 95.324047 NA NA NA25 26NA NA$se.fit1 2 3 4 5 6 7 87.568120 5.945831 4.990827 4.545284 4.308639 4.115049 3.789542 3.7162319 10 11 12 13 14 15 163.776947 4.091747 4.709568 4.245427 4.035929 3.753410 4.004705 4.04319017 18 19 20 21 22 23 244.026105 4.074664 4.570818 5.954217 8.302014 NA NA NA25 26NA 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)$fit1 2 3 4 5 6 77.741006 9.926596 12.442424 15.281082 18.425712 21.865315 25.7134138 9 10 11 12 13 1429.350386 33.230660 37.167935 41.205226 45.781544 48.355889 50.06714815 16 17 18 19 20 2151.986702 56.445263 62.025404 68.569313 76.193111 85.053364 95.30052322 23 24 25 26106.974661 120.092581 134.665851 150.698545 168.190283$se.fit1 2 3 4 5 6 7 87.565991 5.959097 5.012013 4.550013 4.321596 4.119331 3.939804 3.7200989 10 11 12 13 14 15 163.780877 4.096004 4.714469 4.398936 4.040129 4.184257 4.008873 4.06186517 18 19 20 21 22 23 244.033998 4.078904 4.584606 5.952480 8.306901 11.601911 15.792480 20.86466025 2626.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 logLik.lm> ### Keywords: models>> ### ** Examples>> x <- 1:5> lmx <- lm(x ~ 1)> logLik(lmx) # using print.logLik() method'log Lik.' -8.827561 (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 critical10.78708 0.61319 -0.07305 0.32033 0.08173 0.03838advance-0.21706> logLik(fm1)'log Lik.' -97.24991 (df=8)> logLik(fm1, REML = TRUE)'log Lik.' -102.6851 (df=8)>>>> 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)> 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.6964R-Square=0.0731F-statistic (df=1, 18)=1.4191p-value=0.249Estimate Std.Err t-value Pr(>|t|)Intercept 5.403 0.4924 10.9723 0.000X -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 = 0.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)> nD <- data.frame(height = ht)> pfm <- predict(fm, nD)> lines(ht, pfm)> pf2 <- predict(update(fm, ~ stats::poly(height, 2)), nD)> stopifnot(all.equal(pfm, pf2)) ## was off (rel.diff. 0.0766) in R <= 3.5.0>> ## see also example(cars)>> ## see bs and ns for spline examples.>>>> cleanEx()> nameEx("manova")> ### * manova>> flush(stderr()); flush(stdout())>> ### Name: manova> ### Title: Multivariate Analysis of Variance> ### Aliases: manova> ### Keywords: models>> ### ** Examples>> ## Set orthogonal contrasts.> op <- options(contrasts = c("contr.helmert", "contr.poly"))>> ## Fake a 2nd response variable> npk2 <- within(npk, foo <- rnorm(24))> ( npk2.aov <- manova(cbind(yield, foo) ~ block + N*P*K, npk2) )Call:manova(cbind(yield, foo) ~ block + N * P * K, npk2)Terms:block N P K N:P N:K P:Kyield 343.2950 189.2817 8.4017 95.2017 21.2817 33.1350 0.4817foo 2.9548 0.0223 1.3807 0.0097 2.7585 0.9724 5.5258Deg. of Freedom 5 1 1 1 1 1 1Residualsyield 185.2867foo 7.8286Deg. of Freedom 12Residual standard errors: 3.929447 0.80770391 out of 13 effects not estimableEstimated effects are balanced> summary(npk2.aov)Df Pillai approx F num Df den Df Pr(>F)block 5 0.89478 1.9430 10 24 0.08861 .N 1 0.50586 5.6304 2 11 0.02071 *P 1 0.17088 1.1336 2 11 0.35677K 1 0.34430 2.8879 2 11 0.09815 .N:P 1 0.30158 2.3750 2 11 0.13888N:K 1 0.21654 1.5201 2 11 0.26127P:K 1 0.41992 3.9814 2 11 0.05003 .Residuals 12---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>> ( npk2.aovE <- manova(cbind(yield, foo) ~ N*P*K + Error(block), npk2) )Call:manova(cbind(yield, foo) ~ N * P * K + Error(block), npk2)Grand Means:yield foo54.8750000 0.1498669Stratum 1: blockTerms:N:P:K Residualsyield 37.00167 306.29333foo 0.06988 2.88496Deg. of Freedom 1 4Residual standard errors: 8.750619 0.8492579Estimated effects are balancedStratum 2: WithinTerms:N P K N:P N:K P:Kyield 189.28167 8.40167 95.20167 21.28167 33.13500 0.48167foo 0.02235 1.38066 0.00966 2.75852 0.97240 5.52584Deg. of Freedom 1 1 1 1 1 1Residualsyield 185.28667foo 7.82863Deg. of Freedom 12Residual standard errors: 3.929447 0.8077039Estimated effects are balanced> summary(npk2.aovE)Error: blockDf Pillai approx F num Df den Df Pr(>F)N:P:K 1 0.20004 0.3751 2 3 0.7155Residuals 4Error: WithinDf Pillai approx F num Df den Df Pr(>F)N 1 0.50586 5.6304 2 11 0.02071 *P 1 0.17088 1.1336 2 11 0.35677K 1 0.34430 2.8879 2 11 0.09815 .N:P 1 0.30158 2.3750 2 11 0.13888N:K 1 0.21654 1.5201 2 11 0.26127P:K 1 0.41992 3.9814 2 11 0.05003 .Residuals 12---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1>>>> base::options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))> 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/8ResponseDelay Cured DiedNone 0 61.5h 0 5, , Penicillin.Level = 1/4ResponseDelay Cured DiedNone 3 31.5h 0 6, , Penicillin.Level = 1/2ResponseDelay Cured DiedNone 6 01.5h 2 4, , Penicillin.Level = 1ResponseDelay Cured DiedNone 5 11.5h 6 0, , Penicillin.Level = 4ResponseDelay Cured DiedNone 2 01.5h 5 0> ## Classical Mantel-Haenszel test> mantelhaen.test(Rabbits)Mantel-Haenszel chi-squared test with continuity correctiondata: RabbitsMantel-Haenszel X-squared = 3.9286, df = 1, p-value = 0.04747alternative hypothesis: true common odds ratio is not equal to 195 percent confidence interval:1.026713 47.725133sample estimates:common odds ratio7> ## => 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 tablesdata: RabbitsS = 16, p-value = 0.03994alternative hypothesis: true common odds ratio is not equal to 195 percent confidence interval:1.077401 529.837399sample estimates:common odds ratio10.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 tablesdata: RabbitsS = 16, p-value = 0.01997alternative hypothesis: true common odds ratio is greater than 195 percent confidence interval:1.384239 Infsample estimates:common odds ratio10.36102> ## => p = 0.020>> ## UC Berkeley Student Admissions> mantelhaen.test(UCBAdmissions)Mantel-Haenszel chi-squared test with continuity correctiondata: UCBAdmissionsMantel-Haenszel X-squared = 1.4269, df = 1, p-value = 0.2323alternative hypothesis: true common odds ratio is not equal to 195 percent confidence interval:0.7719074 1.0603298sample estimates:common odds ratio0.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 F0.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.0034272> ## => 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_SGender IncomeFemale <5000 1 3 11 25000-15000 2 3 17 315000-25000 0 1 8 5>25000 0 2 4 2Male <5000 1 1 2 15000-15000 0 3 5 115000-25000 0 0 7 3>25000 0 1 9 6> ## Table 7.8 in Agresti (2002), p. 288.> mantelhaen.test(Satisfaction)Cochran-Mantel-Haenszel testdata: SatisfactionCochran-Mantel-Haenszel M^2 = 10.2, 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 objectsSSD> # Lifted from Baron+Li:SSD> # "Notes on the use of R for psychology experiments and questionnaires"SSD> # Maxwell and Delaney, p. 497SSD> 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)$SSDcondcond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NPdeg0NA 29160 30600 26640 23760 32400 25560deg4NA 30600 66600 32400 7200 36000 30600deg8NA 26640 32400 56160 41040 57600 69840deg0NP 23760 7200 41040 70560 72000 63360deg4NP 32400 36000 57600 72000 108000 100800deg8NP 25560 30600 69840 63360 100800 122760$calllm(formula = reacttime ~ 1)$df[1] 9attr(,"class")[1] "SSD"SSD> estVar(mlmfit)condcond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NPdeg0NA 3240 3400 2960 2640 3600 2840deg4NA 3400 7400 3600 800 4000 3400deg8NA 2960 3600 6240 4560 6400 7760deg0NP 2640 800 4560 7840 8000 7040deg4NP 3600 4000 6400 8000 12000 11200deg8NP 2840 3400 7760 7040 11200 13640>> ### traditional test of intrasubj. contrasts> mauchly.test(mlmfit, X = ~1)Mauchly's test of sphericityContrasts orthogonal to~1data: SSD matrix from lm(formula = reacttime ~ 1)W = 0.031084, 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 sphericityContrasts orthogonal to~deg + noisedata: SSD matrix from lm(formula = reacttime ~ 1)W = 0.89378, p-value = 0.6381> mauchly.test(mlmfit, M = ~ deg + noise, X = ~ noise, idata = idata)Mauchly's test of sphericityContrasts orthogonal to~noiseContrasts spanned by~deg + noisedata: SSD matrix from lm(formula = reacttime ~ 1)W = 0.96011, 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")))> Performance2nd Survey1st Survey Approve DisapproveApprove 794 150Disapprove 86 570> mcnemar.test(Performance)McNemar's Chi-squared test with continuity correctiondata: PerformanceMcNemar's chi-squared = 16.818, 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 (Robust Twoway Decomposition) 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))> deaths1973 1974 19751-24 14 15 1425-74 7 4 775-199 8 2 10200++ 15 9 10NA 0 2 0> (med.d <- medpolish(deaths))1: 19Final: 19Median Polish Results (Dataset: "deaths")Overall: 8Row Effects:1-24 25-74 75-199 200++ NA6 -1 0 2 -8Column Effects:1973 1974 19750 -1 0Residuals:1973 1974 19751-24 0 2 025-74 0 -2 075-199 0 -5 2200++ 5 0 0NA 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 ncontrols1 0 402 0 103 0 64 0 55 0 276 0 77 0 48 0 79 0 210 0 111 0 212 0 113 1 114 0 115 0 216 0 6017 1 1418 0 719 0 820 0 3521 3 2322 1 1423 0 824 0 1125 0 626 0 227 0 128 2 329 0 330 2 431 1 4632 0 1833 0 1034 0 435 6 3836 4 2137 5 1538 5 739 3 1640 6 1441 1 542 2 443 4 444 3 445 2 346 4 447 2 4948 3 2249 3 1250 4 651 9 4052 6 2153 4 1754 3 655 9 1856 8 1557 3 658 4 459 5 1060 6 761 2 362 5 663 5 4864 4 1465 2 766 0 267 17 3468 3 1069 5 970 6 1371 4 1272 2 373 1 174 3 475 1 276 1 177 1 178 1 1879 2 680 1 381 2 582 1 383 0 384 1 185 1 186 1 187 2 288 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 70.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.000000008 9 10 11 12 13 140.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.50000000 0.0000000015 16 17 18 19 20 210.00000000 0.00000000 0.06666667 0.00000000 0.00000000 0.00000000 0.1153846222 23 24 25 26 27 280.06666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.4000000029 30 31 32 33 34 350.00000000 0.33333333 0.02127660 0.00000000 0.00000000 0.00000000 0.1363636436 37 38 39 40 41 420.16000000 0.25000000 0.41666667 0.15789474 0.30000000 0.16666667 0.3333333343 44 45 46 47 48 490.50000000 0.42857143 0.40000000 0.50000000 0.03921569 0.12000000 0.2000000050 51 52 53 54 55 560.40000000 0.18367347 0.22222222 0.19047619 0.33333333 0.33333333 0.3478260957 58 59 60 61 62 630.33333333 0.50000000 0.33333333 0.46153846 0.40000000 0.45454545 0.0943396264 65 66 67 68 69 700.22222222 0.22222222 0.00000000 0.33333333 0.23076923 0.35714286 0.3157894771 72 73 74 75 76 770.25000000 0.40000000 0.50000000 0.42857143 0.33333333 0.50000000 0.5000000078 79 80 81 82 83 840.05263158 0.25000000 0.25000000 0.28571429 0.25000000 0.00000000 0.5000000085 86 87 880.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 2640 10 6 5 27 7 4 7 2 1 2 1 2 1 2 60 15 7 8 35 26 15 8 11 6 227 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 521 5 3 6 47 18 10 4 44 25 20 12 19 20 6 6 8 7 5 8 51 25 15 10 49 2753 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 7821 9 27 23 9 8 15 13 5 11 53 18 9 2 51 13 14 19 16 5 2 7 3 2 2 1979 80 81 82 83 84 85 86 87 888 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 Model Frame from a Formula or Fit> ### 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">> ## get_all_vars(): new var.s are recycled (iff length matches: 50 = 2*25)> ncars <- get_all_vars(sqrt(dist) ~ I(speed/2), data = cars, newVar = 2:3)> stopifnot(is.data.frame(ncars),+ identical(cars, ncars[,names(cars)]),+ ncol(ncars) == ncol(cars) + 1)>>>> 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' language 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") # typically 'treatment' (for unordered factors)$contrastsunordered ordered"contr.treatment" "contr.poly"> model.matrix(~ a + b, dd)(Intercept) a2 a3 b2 b3 b41 1 0 0 0 0 02 1 0 0 1 0 03 1 0 0 0 1 04 1 0 0 0 0 15 1 1 0 0 0 06 1 1 0 1 0 07 1 1 0 0 1 08 1 1 0 0 0 19 1 0 1 0 0 010 1 0 1 1 0 011 1 0 1 0 1 012 1 0 1 0 0 1attr(,"assign")[1] 0 1 1 2 2 2attr(,"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 b41 1 1 0 0 0 02 1 1 0 1 0 03 1 1 0 0 1 04 1 1 0 0 0 15 1 0 1 0 0 06 1 0 1 1 0 07 1 0 1 0 1 08 1 0 1 0 0 19 1 -1 -1 0 0 010 1 -1 -1 1 0 011 1 -1 -1 0 1 012 1 -1 -1 0 0 1attr(,"assign")[1] 0 1 1 2 2 2attr(,"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.C1 1 1 0 -0.6708204 0.5 -0.22360682 1 1 0 -0.2236068 -0.5 0.67082043 1 1 0 0.2236068 -0.5 -0.67082044 1 1 0 0.6708204 0.5 0.22360685 1 0 1 -0.6708204 0.5 -0.22360686 1 0 1 -0.2236068 -0.5 0.67082047 1 0 1 0.2236068 -0.5 -0.67082048 1 0 1 0.6708204 0.5 0.22360689 1 -1 -1 -0.6708204 0.5 -0.223606810 1 -1 -1 -0.2236068 -0.5 0.670820411 1 -1 -1 0.2236068 -0.5 -0.670820412 1 -1 -1 0.6708204 0.5 0.2236068attr(,"assign")[1] 0 1 1 2 2 2attr(,"contrasts")attr(,"contrasts")$a[1] "contr.sum"attr(,"contrasts")$b.L .Q .C1 -0.6708204 0.5 -0.22360682 -0.2236068 -0.5 0.67082043 0.2236068 -0.5 -0.67082044 0.6708204 0.5 0.2236068> 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 3a1 0 8 0 0 0 0a2 0 0 24 0 0 0b2 3 0 0 3 0 0b3 3 0 0 0 3 0b4 3 0 0 0 0 3> # invalid contrasts.. ignored with a warning:> stopifnot(identical(+ model.matrix(~ a + b, dd),+ model.matrix(~ a + b, dd, contrasts.arg = "contr.FOO")))Warning in model.matrix.default(~a + b, dd, contrasts.arg = "contr.FOO") :non-list contrasts argument ignored>>>> 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>>> 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 scaledata: ramsay and jung.parekhZ = 1.0371, p-value = 0.2997alternative 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] 2attr(,"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 Qtr41952 321953 59 74 75 601954 71 61 71 571955 71 68 79 731956 76 71 67 751957 79 62 63 571958 60 49 48 521959 57 62 61 661960 71 62 61 571961 72 83 71 781962 79 71 62 741963 76 64 62 571964 80 73 69 691965 71 64 69 621966 63 46 56 441967 44 52 38 461968 36 49 35 441969 59 65 65 561970 66 53 61 521971 51 48 54 491972 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 y1 1 02 2 10> m <- as.matrix(DF)> na.omit(m)x y[1,] 1 0[2,] 2 10attr(,"na.action")[1] 3attr(,"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: Find Highly Composite Numbers> ### Aliases: nextn> ### Keywords: math>> ### ** Examples>> nextn(1001) # 1024[1] 1024> table(nextn(599:630))600 625 6402 25 5> n <- 1:100 ; plot(n, nextn(n) - n, type = "o", lwd=2, cex=1/2)>>>> 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 = 0Step:[1] 0 0Parameter:[1] 10 10Function Value[1] 145Gradient:[1] 18.00001 16.00001iteration = 1Step:[1] -9 -8Parameter:[1] 1 2Function Value[1] 1.721748e-13Gradient:[1] 1.551336e-06 1.379735e-06iteration = 2Parameter:[1] 1 2Function Value[1] 4.303458e-26Gradient:[1] 2.757794e-13 -3.099743e-13Relative 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 ‘ ’ 1Residual standard error: 0.0192 on 13 degrees of freedom> ## the coefficients only:> coef(fm1DNase1)Asym xmid scal2.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-13xmid 1.4831 0.081353 18.230 1.2185e-10scal 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 ‘ ’ 1Residual 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 ‘ ’ 1Residual 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 ‘ ’ 1Residual standard error: 0.0192 on 13 degrees of freedomAlgorithm "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 ‘ ’ 1Residual 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 modelmodel: yeps ~ a + b * xdata: parent.frame()a b3 2residual sum-of-squares: 0.000524> ## terminates in an error, because convergence cannot be confirmed:> try(nls(y ~ a + b*x, start = list(a = 0.12345, b = 0.54321)))Error in nls(y ~ a + b * x, start = list(a = 0.12345, b = 0.54321)) :number of iterations exceeded maximum of 50>> ## 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.Initializing ‘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)>>> ## 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.998650attr(,"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 groupF = 3.4626, num df = 1.000, denom df = 17.776, p-value = 0.07939> ## Assuming equal variances> oneway.test(extra ~ group, data = sleep, var.equal = TRUE)One-way analysis of meansdata: extra and groupF = 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 TableResponse: extraDf 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 optimHess> ### Keywords: nonlinear optimize>> ### ** Examples>>> 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.6666321[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.1734[1] 19.48913[1] 19.68427[1] 19.80487[1] 19.8794[1] 19.92547[1] 19.95393[1] 19.97153[1] 19.9824[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(identical(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(0.7, 0.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 incorrectWarning in prop.test(x[c(i, j)], n[c(i, j)], ...) :Chi-squared approximation may be incorrectWarning in prop.test(x[c(i, j)], n[c(i, j)], ...) :Chi-squared approximation may be incorrectPairwise comparisons using Pairwise comparison of proportionsdata: smokers out of patients1 2 32 1.000 - -3 1.000 1.000 -4 0.119 0.093 0.124P 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 SDdata: Ozone and MonthMay Jun Jul AugJun 1.00000 - - -Jul 0.00026 0.05113 - -Aug 0.00019 0.04987 1.00000 -Sep 1.00000 1.00000 0.00488 0.00388P value adjustment method: holm> pairwise.t.test(Ozone, Month, p.adj = "bonf")Pairwise comparisons using t tests with pooled SDdata: Ozone and MonthMay Jun Jul AugJun 1.00000 - - -Jul 0.00029 0.10225 - -Aug 0.00019 0.08312 1.00000 -Sep 1.00000 1.00000 0.00697 0.00485P value adjustment method: bonferroni> pairwise.t.test(Ozone, Month, pool.sd = FALSE)Pairwise comparisons using t tests with non-pooled SDdata: Ozone and MonthMay Jun Jul AugJun 1.00000 - - -Jul 0.00026 0.01527 - -Aug 0.00195 0.02135 1.00000 -Sep 0.86321 1.00000 0.00589 0.01721P 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 tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesPairwise comparisons using Wilcoxon rank sum test with continuity correctiondata: Ozone and MonthMay Jun Jul AugJun 0.5775 - - -Jul 0.0003 0.0848 - -Aug 0.0011 0.1295 1.0000 -Sep 0.4744 1.0000 0.0060 0.0227P 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 tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesWarning in wilcox.test.default(xi, xj, paired = paired, ...) :cannot compute exact p-value with tiesPairwise comparisons using Wilcoxon rank sum test with continuity correctiondata: Ozone and MonthMay Jun Jul AugJun 1.0000 - - -Jul 0.0003 0.1414 - -Aug 0.0012 0.2591 1.0000 -Sep 1.0000 1.0000 0.0074 0.0325P 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 onto 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 thereisoreg> 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 22isoreg> 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 25isoreg> (fi3 <- as.stepfun(ir3))Step functionCall: isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3))x[1:3] = 2, 5, 94 plateau levels = 0.5, 0.5, 3.3333, 3.5isoreg> (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.21isoreg> ## 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.00isoreg> ## 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 plotWarning 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> ### Keywords: hplot 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)> plot(lm.SR)>> ## 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)>> rock1 <- within(rock, { area1 <- area/10000; peri1 <- peri/10000 })> par(mfrow = c(3,2)) # maybe: , pty = "s"> rock.ppr <- ppr(log(perm) ~ area1 + peri1 + shape,+ data = rock1, 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, lag(nhtemp, 1), cex = .8, col = "blue",+ main = "Lag plot of New Haven temperatures")>> ## 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 testdata: 137 time base: 24.19893number of events = 137, time base = 24.199, p-value < 2.2e-16alternative hypothesis: true event rate is not equal to 195 percent confidence interval:4.753125 6.692709sample estimates:event rate5.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 ratesdata: c(11, 6 + 8 + 7) time base: c(800, 1083 + 1050 + 878)count1 = 11, expected count1 = 6.7174, p-value = 0.07967alternative hypothesis: true rate ratio is not equal to 195 percent confidence interval:0.8584264 4.2772659sample estimates:rate ratio1.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.453attr(,"coefs")attr(,"coefs")$alpha[1] 5.5 5.5 5.5attr(,"coefs")$norm2[1] 1.0 10.0 82.5 528.0 3088.8attr(,"degree")[1] 1 2 3attr(,"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> 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.130attr(,"coefs")attr(,"coefs")$alpha[1] 5.5 5.5 5.5attr(,"coefs")$norm2[1] 1.0 10.0 82.5 528.0 3088.8attr(,"degree")[1] 1 2 3attr(,"class")[1] "poly" "matrix">> zm <- zapsmall(polym ( 1:4, c(1, 4:6), degree = 3)) # or just poly():> (z1 <- 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.315attr(,"degree")[1] 1 2 3 1 2 3 2 3 3attr(,"coefs")attr(,"coefs")[[1]]attr(,"coefs")[[1]]$alpha[1] 2.5 2.5 2.5attr(,"coefs")[[1]]$norm2[1] 1.0 4.0 5.0 4.0 1.8attr(,"coefs")[[2]]attr(,"coefs")[[2]]$alpha[1] 4.00 2.71 4.47attr(,"coefs")[[2]]$norm2[1] 1.00 4.00 14.00 25.86 9.94attr(,"class")[1] "poly" "matrix"> ## they are the same :> stopifnot(all.equal(zm, z1, tol = 1e-15))>> ## poly(<matrix>, df) --- used to fail till July 14 (vive la France!), 2017:> m2 <- cbind(1:4, c(1, 4:6))> pm2 <- zapsmall(poly(m2, 3)) # "unnamed degree = 3"> stopifnot(all.equal(pm2, zm, tol = 1e-15))>> options(od)>>>> cleanEx()> nameEx("power")> ### * power>> flush(stderr()); flush(stdout())>> ### Name: power> ### Title: Create a Power Link Object> ### Aliases: power> ### Keywords: models>> ### ** Examples>> power()$linkfunfunction (mu)mu<environment: namespace:stats>$linkinvfunction (eta)eta<environment: namespace:stats>$mu.etafunction (eta)rep.int(1, length(eta))<environment: namespace:stats>$validetafunction (eta)TRUE<environment: namespace:stats>$name[1] "identity"attr(,"class")[1] "link-glm"> quasi(link = power(1/3))[c("linkfun", "linkinv")]$linkfunfunction (mu)mu^lambda<bytecode: 0x5580280><environment: 0x5588948>$linkinvfunction (eta)pmax(eta^(1/lambda), .Machine$double.eps)<bytecode: 0x5580130><environment: 0x5588948>>>>> 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 calculationgroups = 4n = 5between.var = 1within.var = 3sig.level = 0.05power = 0.3535594NOTE: 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 calculationgroups = 4n = 11.92613between.var = 1within.var = 3sig.level = 0.05power = 0.8NOTE: 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.18834Balanced one-way analysis of variance power calculationgroups = 4n = 15.18834between.var = 166.6667within.var = 500sig.level = 0.05power = 0.9NOTE: 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) ## => power = 0.740Two-sample comparison of proportions power calculationn = 50p1 = 0.5p2 = 0.75sig.level = 0.05power = 0.7401659alternative = two.sidedNOTE: n is number in *each* group> power.prop.test(p1 = .50, p2 = .75, power = .90) ## => n = 76.7Two-sample comparison of proportions power calculationn = 76.70693p1 = 0.5p2 = 0.75sig.level = 0.05power = 0.9alternative = two.sidedNOTE: n is number in *each* group> power.prop.test(n = 50, p1 = .5, power = .90) ## => p2 = 0.8026Two-sample comparison of proportions power calculationn = 50p1 = 0.5p2 = 0.8026141sig.level = 0.05power = 0.9alternative = two.sidedNOTE: n is number in *each* group> power.prop.test(n = 50, p1 = .5, p2 = 0.9, power = .90, sig.level=NULL)Two-sample comparison of proportions power calculationn = 50p1 = 0.5p2 = 0.9sig.level = 0.001318068power = 0.9alternative = two.sidedNOTE: n is number in *each* group> ## => sig.l = 0.00131> power.prop.test(p1 = .5, p2 = 0.501, sig.level=.001, power=0.90)Two-sample comparison of proportions power calculationn = 10451937p1 = 0.5p2 = 0.501sig.level = 0.001power = 0.9alternative = two.sidedNOTE: n is number in *each* group> ## => n = 10451937> try(+ power.prop.test(n=30, p1=0.90, p2=NULL, power=0.8)+ ) # a warning (which may become an error)Warning in power.prop.test(n = 30, p1 = 0.9, p2 = NULL, power = 0.8) :No p2 in [p1, 1] can be found to achieve the desired powerTwo-sample comparison of proportions power calculationn = 30p1 = 0.9p2 = 1.030182sig.level = 0.05power = 0.8alternative = two.sidedNOTE: n is number in *each* group> ## Reason:> power.prop.test( p1=0.90, p2= 1.0, power=0.8) ##-> n = 73.37Two-sample comparison of proportions power calculationn = 73.37427p1 = 0.9p2 = 1sig.level = 0.05power = 0.8alternative = two.sidedNOTE: 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 calculationn = 20delta = 1sd = 1sig.level = 0.05power = 0.8689528alternative = two.sidedNOTE: n is number in *each* group> power.t.test(power = .90, delta = 1)Two-sample t test power calculationn = 22.0211delta = 1sd = 1sig.level = 0.05power = 0.9alternative = two.sidedNOTE: n is number in *each* group> power.t.test(power = .90, delta = 1, alternative = "one.sided")Two-sample t test power calculationn = 17.84713delta = 1sd = 1sig.level = 0.05power = 0.9alternative = one.sidedNOTE: 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 Testdata: xDickey-Fuller = -33.057, Truncation lag parameter = 7, p-value = 0.01> y <- cumsum(x) # has unit root> PP.test(y)Phillips-Perron Unit Root Testdata: yDickey-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>> ## Visualize including the fractions :> require(graphics)## Don't show:> lNs <- loadedNamespaces()> ## End(Don't show)> p.ppoints <- function(n, ..., add = FALSE, col = par("col")) {+ pn <- ppoints(n, ...)+ if(add)+ points(pn, pn, col = col)+ else {+ tit <- match.call(); tit[[1]] <- quote(ppoints)+ plot(pn,pn, main = deparse(tit), col=col,+ xlim = 0:1, ylim = 0:1, xaxs = "i", yaxs = "i")+ abline(0, 1, col = adjustcolor(1, 1/4), lty = 3)+ }+ if(!add && requireNamespace("MASS", quietly = TRUE))+ text(pn, pn, as.character(MASS::fractions(pn)),+ adj = c(0,0)-1/4, cex = 3/4, xpd = NA, col=col)+ abline(h = pn, v = pn, col = adjustcolor(col, 1/2), lty = 2, lwd = 1/2)+ }>> p.ppoints(4)> p.ppoints(10)> p.ppoints(10, a = 1/2)> p.ppoints(21)> p.ppoints(8) ; p.ppoints(8, a = 1/2, add=TRUE, col="tomato")> ## Don't show:> if(!any("MASS" == lNs)) unloadNamespace("MASS")> ## End(Don't show)>>>> graphics::par(get("par.postscript", pos = 'CheckExEnv'))> 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.pprCall:ppr(formula = log(perm) ~ area1 + peri1 + shape, data = rock,nterms = 2, max.terms = 5)Goodness of fit:2 terms 3 terms 4 terms 5 terms8.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 terms8.737806 5.289517 4.745799 4.490378Projection direction vectors ('alpha'):term 1 term 2area1 0.34357179 0.37071027peri1 -0.93781471 -0.61923542shape 0.04961846 0.69218595Coefficients of ridge terms ('beta'):term 1 term 21.6079271 0.5460971> # ..... (same as above)> # .....> #> # Projection direction vectors ('alpha'):> # 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 prediction1 6.3 5.92 6.3 6.53 6.3 12.14 6.3 7.45 17.1 16.36 17.1 13.27 17.1 41.28 17.1 10.69 119.0 101.910 119.0 73.011 119.0 46.812 119.0 121.713 82.4 107.814 82.4 79.715 82.4 98.316 82.4 128.817 58.6 66.818 58.6 33.219 58.6 58.720 58.6 111.621 142.0 118.922 142.0 128.423 142.0 91.924 142.0 188.525 740.0 341.726 740.0 577.927 740.0 895.728 740.0 1041.029 890.0 560.830 890.0 721.831 890.0 937.932 890.0 848.533 950.0 806.434 950.0 1085.435 950.0 945.636 950.0 848.537 100.0 154.138 100.0 178.039 100.0 321.540 100.0 232.741 1300.0 1067.042 1300.0 697.843 1300.0 1236.644 1300.0 1301.845 580.0 485.146 580.0 285.147 580.0 644.348 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>> C <- chol(S <- toeplitz(.9 ^ (0:31))) # Cov.matrix and its root> all.equal(S, crossprod(C))[1] TRUE> set.seed(17)> X <- matrix(rnorm(32000), 1000, 32)> Z <- X %*% C ## ==> cov(Z) ~= C'C = S> all.equal(cov(Z), S, tol = 0.08)[1] TRUE> pZ <- prcomp(Z, tol = 0.1)> summary(pZ) # only ~14 PCs (out of 32)Importance of first k=14 (out of 32) components:PC1 PC2 PC3 PC4 PC5 PC6 PC7Standard deviation 3.6415 2.7178 1.8447 1.39430 1.10207 0.90922 0.76951Proportion of Variance 0.4173 0.2324 0.1071 0.06118 0.03822 0.02602 0.01864Cumulative Proportion 0.4173 0.6498 0.7569 0.81806 0.85628 0.88230 0.90094PC8 PC9 PC10 PC11 PC12 PC13 PC14Standard deviation 0.67490 0.60833 0.51638 0.49048 0.44452 0.40326 0.3904Proportion of Variance 0.01433 0.01165 0.00839 0.00757 0.00622 0.00512 0.0048Cumulative Proportion 0.91527 0.92692 0.93531 0.94288 0.94910 0.95422 0.9590> ## or choose only 3 PCs more directly:> pz3 <- prcomp(Z, rank. = 3)> summary(pz3) # same numbers as the first 3 aboveImportance of first k=3 (out of 32) components:PC1 PC2 PC3Standard deviation 3.6415 2.7178 1.8447Proportion of Variance 0.4173 0.2324 0.1071Cumulative Proportion 0.4173 0.6498 0.7569> stopifnot(ncol(pZ$rotation) == 14, ncol(pz3$rotation) == 3,+ all.equal(pz3$sdev, pZ$sdev, tol = 1e-15)) # exactly equal typically>>>>> 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.getlocale("LC_COLLATE")> invisible(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.> ## Output will depend on what namespaces are (or have been) loaded.> ## IGNORE_RDIFF_BEGIN> 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 = 1L, newxreg = NULL, se.fit = TRUE, ...) NULLpredict.HoltWinters :function (object, n.ahead = 1L, prediction.interval = FALSE, level = 0.95, ...) NULLpredict.StructTS :function (object, n.ahead = 1L, se.fit = TRUE, ...) NULLpredict.ar :function (object, newdata, n.ahead = 1L, se.fit = TRUE, ...) NULLpredict.arima0 :function (object, n.ahead = 1L, newxreg = NULL, se.fit = TRUE, ...) NULLpredict.bSpline :function (object, x, nseg = 50, deriv = 0, ...) NULLpredict.bs :function (object, newx, ...) NULLpredict.glm :function (object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.pass, ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.glmmPQL :function (object, newdata = NULL, type = c("link", "response"), level = Q, na.action = na.pass, ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.lda :function (object, newdata, prior = object$prior, dimen, method = c("plug-in", "predictive", "debiased"), ...) NULLpredict.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, ...) NULLpredict.loess :function (object, newdata = NULL, se = FALSE, na.action = na.pass, ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.lqs :function (object, newdata, na.action = na.pass, ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.mca :function (object, newdata, type = c("row", "factor"), ...) NULLpredict.mlm :function (object, newdata, se.fit = FALSE, na.action = na.pass, ...) NULLpredict.nbSpline :function (object, x, nseg = 50, deriv = 0, ...) NULLpredict.nls :function (object, newdata, se.fit = FALSE, scale = NULL, df = Inf, interval = c("none", "confidence", "prediction"), level = 0.95, ...) NULLpredict.npolySpline :function (object, x, nseg = 50, deriv = 0, ...) NULLpredict.ns :function (object, newx, ...) NULLpredict.pbSpline :function (object, x, nseg = 50, deriv = 0, ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.polr :function (object, newdata, type = c("class", "probs"), ...) NULLpredict.poly :function (object, newdata, ...) NULLpredict.polySpline :function (object, x, nseg = 50, deriv = 0, ...) NULLpredict.ppolySpline :function (object, x, nseg = 50, deriv = 0, ...) NULLpredict.ppr :function (object, newdata, ...) NULLpredict.prcomp :function (object, newdata, ...) NULLpredict.princomp :function (object, newdata, ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.qda :function (object, newdata, prior = object$prior, method = c("plug-in", "predictive", "debiased", "looCV"), ...) NULLWarning: namespace ‘MASS’ is not available and has been replacedby .GlobalEnv when processing object ‘<unknown>’predict.rlm :function (object, newdata = NULL, scale = NULL, ...) NULLpredict.smooth.spline :function (object, x, deriv = 0, ...) NULLpredict.smooth.spline.fit :function (object, x, deriv = 0, ...) NULL> ## IGNORE_RDIFF_END> ## Don't show:> invisible(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)$predTime Series:Start = 49End = 60Frequency = 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$seTime Series:Start = 49End = 60Frequency = 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.553s.e. 0.123 0.178sigma^2 estimated as 99347: log likelihood = -425.44, aic = 856.88> predict(fit, n.ahead = 6)$predJan Feb Mar Apr May Jun1979 8336.1 7531.8 8314.6 8616.9 9488.9 9859.8$seJan Feb Mar Apr May Jun1979 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.10375Coefficients: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.822ldose 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 freedomResidual deviance: 4.9937 on 8 degrees of freedomAIC: 43.104Number 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> ### 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.58589918 9 10 11 12 13 140.8591183 0.6821126 -0.2774594 1.7013932 0.4796306 -0.6214146 -2.3566523151.2801229> new <- data.frame(x = seq(-3, 3, 0.5))> predict(lm(y ~ x), new, se.fit = TRUE)$fit1 2 3 4 5 6-3.21182462 -2.66733702 -2.12284942 -1.57836182 -1.03387422 -0.489386627 8 9 10 11 120.05510098 0.59958858 1.14407618 1.68856379 2.23305139 2.77753899133.32202659$se.fit1 2 3 4 5 6 7 80.7545246 0.6449274 0.5380108 0.4357521 0.3423511 0.2672616 0.2292452 0.24612619 10 11 12 130.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_ responsesfit lwr upr1 -0.6270917 -2.6311852 1.377001882 0.2550840 -1.7160306 2.226198603 -0.8548779 -2.8806560 1.170900274 1.7923222 -0.3158417 3.900486095 0.4139268 -1.5600794 2.387932976 -0.8383687 -2.8624006 1.185663137 0.5858991 -1.3942769 2.566075198 0.8591183 -1.1372816 2.855518139 0.6821126 -1.3028836 2.6671088410 -0.2774594 -2.2586227 1.7037039011 1.7013932 -0.3922734 3.7950597312 0.4796306 -1.4963611 2.4556222713 -0.6214146 -2.6250348 1.3822055614 -2.3566523 -4.6435457 -0.0697588315 1.2801229 -0.7562734 3.31651909> predict(wfit, interval = "prediction")Warning in predict.lm(wfit, interval = "prediction") :predictions on current data refer to _future_ responsesWarning in predict.lm(wfit, interval = "prediction") :assuming prediction variance inversely proportional to weights used for fittingfit lwr upr1 -0.6795401 -2.7152943 1.35621422 0.2726114 -2.0676598 2.61288253 -0.9253947 -2.7873163 0.93652694 1.9317861 0.5179227 3.34564955 0.4440538 -1.8206181 2.70872576 -0.9075760 -2.7817747 0.96662277 0.6296673 -1.5219043 2.78123908 0.9245587 -1.0206112 2.86972879 0.7335126 -1.3468740 2.813899210 -0.3021743 -2.5805044 1.976155711 1.8336444 0.3867018 3.280587012 0.5149694 -1.7094216 2.739360413 -0.6734127 -2.7135353 1.366709914 -2.5462925 -3.8073357 -1.285249415 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 weightedfit lwr upr1 -3.46929871 -6.02669183 -0.91190562 -2.88162137 -5.38456191 -0.37868083 -2.29394403 -4.75159401 0.16370594 -1.70626669 -4.12830217 0.71576885 -1.11858935 -3.51511782 1.27793916 -0.53091201 -2.91236575 1.85054177 0.05676532 -2.32024444 2.43377518 0.64444266 -1.73881338 3.02769879 1.23212000 -1.16798909 3.632229110 1.81979734 -0.60755066 4.247145311 2.40747468 -0.05715376 4.872103112 2.99515202 0.48364874 5.506655313 3.58282936 1.01538228 6.1502764> predict(wfit, new, interval = "prediction", weights = (new$x)^2)fit lwr upr1 -3.46929871 -4.7661745 -2.172422922 -2.88162137 -4.1752786 -1.587964143 -2.29394403 -3.6870669 -0.900821154 -1.70626669 -3.3884596 -0.024073825 -1.11858935 -3.5151178 1.277939116 -0.53091201 -5.2286061 4.166782117 0.05676532 -Inf Inf8 0.64444266 -4.0541654 5.343050719 1.23212000 -1.1679891 3.6322290910 1.81979734 0.1299644 3.5096302711 2.40747468 1.0020775 3.8128718812 2.99515202 1.6850045 4.3052995013 3.58282936 2.2662384 4.89942029> predict(wfit, new, interval = "prediction", weights = ~x^2)fit lwr upr1 -3.46929871 -4.7661745 -2.172422922 -2.88162137 -4.1752786 -1.587964143 -2.29394403 -3.6870669 -0.900821154 -1.70626669 -3.3884596 -0.024073825 -1.11858935 -3.5151178 1.277939116 -0.53091201 -5.2286061 4.166782117 0.05676532 -Inf Inf8 0.64444266 -4.0541654 5.343050719 1.23212000 -1.1679891 3.6322290910 1.81979734 0.1299644 3.5096302711 2.40747468 1.0020775 3.8128718812 2.99515202 1.6850045 4.3052995013 3.58282936 2.2662384 4.89942029>> ##-- From aov(.) example ---- predict(.. terms)> npk.aov <- aov(yield ~ block + N*P*K, npk)> (termL <- attr(terms(npk.aov), "term.labels"))[1] "block" "N" "P" "K" "N:P" "N:K" "P:K" "N:P:K"> (pt <- predict(npk.aov, type = "terms"))block N P K N:P N:K P:K N:P:K1 -0.850 -4.925 0.2083333 -0.9583333 0.9416667 1.175 0.4250000 02 -0.850 4.925 0.2083333 0.9583333 -2.8250000 1.175 -0.1416667 03 -0.850 -4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 04 -0.850 4.925 -0.2083333 -0.9583333 0.9416667 -3.525 -0.1416667 05 2.575 4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 06 2.575 4.925 0.2083333 -0.9583333 -2.8250000 -3.525 0.4250000 07 2.575 -4.925 -0.2083333 -0.9583333 0.9416667 1.175 -0.1416667 08 2.575 -4.925 0.2083333 0.9583333 0.9416667 1.175 -0.1416667 09 5.900 -4.925 0.2083333 0.9583333 0.9416667 1.175 -0.1416667 010 5.900 4.925 0.2083333 -0.9583333 -2.8250000 -3.525 0.4250000 011 5.900 4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 012 5.900 -4.925 -0.2083333 -0.9583333 0.9416667 1.175 -0.1416667 013 -4.750 4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 014 -4.750 4.925 0.2083333 -0.9583333 -2.8250000 -3.525 0.4250000 015 -4.750 -4.925 -0.2083333 -0.9583333 0.9416667 1.175 -0.1416667 016 -4.750 -4.925 0.2083333 0.9583333 0.9416667 1.175 -0.1416667 017 -4.350 4.925 0.2083333 0.9583333 -2.8250000 1.175 -0.1416667 018 -4.350 -4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 019 -4.350 4.925 -0.2083333 -0.9583333 0.9416667 -3.525 -0.1416667 020 -4.350 -4.925 0.2083333 -0.9583333 0.9416667 1.175 0.4250000 021 1.475 4.925 -0.2083333 -0.9583333 0.9416667 -3.525 -0.1416667 022 1.475 4.925 0.2083333 0.9583333 -2.8250000 1.175 -0.1416667 023 1.475 -4.925 0.2083333 -0.9583333 0.9416667 1.175 0.4250000 024 1.475 -4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0attr(,"constant")[1] 54.875> pt. <- predict(npk.aov, type = "terms", terms = termL[1:4])> stopifnot(all.equal(pt[,1:4], pt.,+ tolerance = 1e-12, check.attributes = FALSE))>>>> 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)$fit1 2 3 4 5 6 7 87.797353 10.002308 12.499786 15.281082 18.446568 21.865315 25.517015 29.3503869 10 11 12 13 14 15 1633.230660 37.167935 41.205226 45.055736 48.355889 49.824812 51.986702 56.46131817 18 19 20 21 22 23 2461.959729 68.569313 76.316068 85.212121 95.324047 NA NA NA25 26NA NA$se.fit1 2 3 4 5 6 7 87.568120 5.945831 4.990827 4.545284 4.308639 4.115049 3.789542 3.7162319 10 11 12 13 14 15 163.776947 4.091747 4.709568 4.245427 4.035929 3.753410 4.004705 4.04319017 18 19 20 21 22 23 244.026105 4.074664 4.570818 5.954217 8.302014 NA NA NA25 26NA 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)$fit1 2 3 4 5 6 77.741006 9.926596 12.442424 15.281082 18.425712 21.865315 25.7134138 9 10 11 12 13 1429.350386 33.230660 37.167935 41.205226 45.781544 48.355889 50.06714815 16 17 18 19 20 2151.986702 56.445263 62.025404 68.569313 76.193111 85.053364 95.30052322 23 24 25 26106.974661 120.092581 134.665851 150.698545 168.190283$se.fit1 2 3 4 5 6 7 87.565991 5.959097 5.012013 4.550013 4.321596 4.119331 3.939804 3.7200989 10 11 12 13 14 15 163.780877 4.096004 4.714469 4.398936 4.040129 4.184257 4.008873 4.06186517 18 19 20 21 22 23 244.033998 4.078904 4.584606 5.952480 8.306901 11.601911 15.792480 20.86466025 2626.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$tol[1] 7e-06$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$no.weights[1] TRUE$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$ratio[1] 6.575971e-05$lambda[1] 0.0008526606$iparmsicrit ispar iter errorI3 0 13 0 NA$auxMNULL$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.014670attr(,"class")[1] "smooth.spline.fit"$callsmooth.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 = paste0("s" ,paste(rep("'", d), collapse = ""), "(x)"))+ 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)) # inappropriateCall:princomp(x = USArrests)Standard deviations:Comp.1 Comp.2 Comp.3 Comp.482.890847 14.069560 6.424204 2.4578374 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.41.5748783 0.9948694 0.5971291 0.41644944 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.4Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000> loadings(pc.cr) # note that blank entries are small but not zeroLoadings:Comp.1 Comp.2 Comp.3 Comp.4Murder 0.536 0.418 0.341 0.649Assault 0.583 0.188 0.268 -0.743UrbanPop 0.278 -0.873 0.378 0.134Rape 0.543 -0.167 -0.818Comp.1 Comp.2 Comp.3 Comp.4SS loadings 1.00 1.00 1.00 1.00Proportion Var 0.25 0.25 0.25 0.25Cumulative Var 0.25 0.50 0.75 1.00> ## The signs of the columns of the loadings are arbitrary> 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.41.5748783 0.9948694 0.5971291 0.41644944 variables and 50 observations.>> ## NA-handling> USArrests[1, 2] <- NA> pc.cr <- princomp(~ Murder + Assault + UrbanPop,+ data = USArrests, na.action = na.exclude, cor = TRUE)>> ## (Simple) Robust PCA:> ## Classical:> (pc.cl <- princomp(stackloss))Call:princomp(x = stackloss)Standard deviations:Comp.1 Comp.2 Comp.3 Comp.413.596589 4.676077 2.617533 1.3663204 variables and 21 observations.>>> cleanEx()> nameEx("print.power.htest")> ### * print.power.htest>> flush(stderr()); flush(stdout())>> ### Name: print.power.htest> ### Title: Print Methods for Hypothesis Tests and Power Calculation Objects> ### Aliases: print.htest print.power.htest> ### Keywords: htest>> ### ** Examples>> (ptt <- power.t.test(n = 20, delta = 1))Two-sample t test power calculationn = 20delta = 1sd = 1sig.level = 0.05power = 0.8689528alternative = two.sidedNOTE: n is number in *each* group> print(ptt, digits = 4) # using less digits than defaultTwo-sample t test power calculationn = 20delta = 1sd = 1sig.level = 0.05power = 0.869alternative = two.sidedNOTE: n is number in *each* group> print(ptt, digits = 12) # using more " " "Two-sample t test power calculationn = 20delta = 1sd = 1sig.level = 0.05power = 0.868952801692alternative = two.sidedNOTE: n is number in *each* group>>>> cleanEx()> nameEx("print.ts")> ### * print.ts>> flush(stderr()); flush(stdout())>> ### Name: print.ts> ### Title: Printing and Formatting of Time-Series Objects> ### Aliases: .preformat.ts print.ts> ### Keywords: ts>> ### ** Examples>> print(ts(1:10, frequency = 7, start = c(12, 2)), calendar = TRUE)p1 p2 p3 p4 p5 p6 p712 1 2 3 4 5 613 7 8 9 10>> print(sunsp.1 <- window(sunspot.month, end=c(1756, 12)))Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec1749 58.0 62.6 70.0 55.7 85.0 83.5 94.8 66.3 75.9 75.5 158.6 85.21750 73.3 75.9 89.2 88.3 90.0 100.0 85.4 103.0 91.2 65.7 63.3 75.41751 70.0 43.5 45.3 56.4 60.7 50.7 66.3 59.8 23.5 23.2 28.5 44.01752 35.0 50.0 71.0 59.3 59.7 39.6 78.4 29.3 27.1 46.6 37.6 40.01753 44.0 32.0 45.7 38.0 36.0 31.7 22.0 39.0 28.0 25.0 20.0 6.71754 0.0 3.0 1.7 13.7 20.7 26.7 18.8 12.3 8.2 24.1 13.2 4.21755 10.2 11.2 6.8 6.5 0.0 0.0 8.6 3.2 17.8 23.7 6.8 20.01756 12.5 7.1 5.4 9.4 12.5 12.9 3.6 6.4 11.8 14.3 17.0 9.4> m <- .preformat.ts(sunsp.1) # a character matrix>>>> 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> op <- 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(op) # restore>>>> 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> ## IGNORE_RDIFF_BEGIN> pr1$Atau par.vals.A par.vals.lrc1 -3.0873 13.59751 0.140332 -2.4957 14.46884 0.016073 -1.8906 15.41836 -0.117874 -1.2634 16.49088 -0.268775 -0.6080 17.75662 -0.445536 0.0000 19.14258 -0.632827 0.4998 20.52853 -0.807508 0.9465 22.06851 -0.982339 1.3780 23.98253 -1.1710310 1.7908 26.44552 -1.3743111 2.1841 29.75928 -1.5959912 2.5559 34.43804 -1.8420913 2.9028 41.42542 -2.12176> pr1$lrctau par.vals.A par.vals.lrc1 -2.9550 42.395076 -2.1841532 -2.5201 33.446683 -1.8369263 -2.0570 28.124205 -1.5473264 -1.5710 24.656989 -1.2938715 -1.0653 22.245847 -1.0630306 -0.5412 20.482887 -0.8451577 0.0000 19.142578 -0.6328228 0.5539 18.095015 -0.4204879 1.1022 17.273414 -0.20762310 1.6298 16.621533 0.00793911 2.1335 16.086803 0.23485012 2.6052 15.638807 0.48500913 3.0276 15.265409 0.779458> ## IGNORE_RDIFF_END> # 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:K1 54.875 -0.850 -2.808333 -0.5916667 -1.991667 0.9416667 1.1752 54.875 -0.850 2.808333 -0.5916667 1.991667 -0.9416667 1.1753 54.875 -0.850 -2.808333 0.5916667 1.991667 -0.9416667 -1.1754 54.875 -0.850 2.808333 0.5916667 -1.991667 0.9416667 -1.1755 54.875 2.575 2.808333 0.5916667 1.991667 0.9416667 1.1756 54.875 2.575 2.808333 -0.5916667 -1.991667 -0.9416667 -1.1757 54.875 2.575 -2.808333 0.5916667 -1.991667 -0.9416667 1.1758 54.875 2.575 -2.808333 -0.5916667 1.991667 0.9416667 -1.1759 54.875 5.900 -2.808333 -0.5916667 1.991667 0.9416667 -1.17510 54.875 5.900 2.808333 -0.5916667 -1.991667 -0.9416667 -1.17511 54.875 5.900 2.808333 0.5916667 1.991667 0.9416667 1.17512 54.875 5.900 -2.808333 0.5916667 -1.991667 -0.9416667 1.17513 54.875 -4.750 2.808333 0.5916667 1.991667 0.9416667 1.17514 54.875 -4.750 2.808333 -0.5916667 -1.991667 -0.9416667 -1.17515 54.875 -4.750 -2.808333 0.5916667 -1.991667 -0.9416667 1.17516 54.875 -4.750 -2.808333 -0.5916667 1.991667 0.9416667 -1.17517 54.875 -4.350 2.808333 -0.5916667 1.991667 -0.9416667 1.17518 54.875 -4.350 -2.808333 0.5916667 1.991667 -0.9416667 -1.17519 54.875 -4.350 2.808333 0.5916667 -1.991667 0.9416667 -1.17520 54.875 -4.350 -2.808333 -0.5916667 -1.991667 0.9416667 1.17521 54.875 1.475 2.808333 0.5916667 -1.991667 0.9416667 -1.17522 54.875 1.475 2.808333 -0.5916667 1.991667 -0.9416667 1.17523 54.875 1.475 -2.808333 -0.5916667 -1.991667 0.9416667 1.17524 54.875 1.475 -2.808333 0.5916667 1.991667 -0.9416667 -1.175P:K Residuals1 0.1416667 -1.391666672 -0.1416667 4.475000003 0.1416667 -5.025000004 -0.1416667 1.941666675 0.1416667 -5.300000006 0.1416667 2.800000007 -0.1416667 2.166666678 -0.1416667 0.333333339 -0.1416667 3.8083333310 0.1416667 -3.2250000011 0.1416667 1.0750000012 -0.1416667 -1.6583333313 0.1416667 4.2250000014 0.1416667 0.4250000015 -0.1416667 -0.5083333316 -0.1416667 -4.1416666717 -0.1416667 -2.8250000018 0.1416667 3.1750000019 -0.1416667 -1.7583333320 0.1416667 1.4083333321 -0.1416667 -0.1833333322 -0.1416667 -1.6500000023 0.1416667 -0.0166666724 0.1416667 1.85000000attr(,"df")(Intercept) block N P K N:P1 5 1 1 1 1N:K P:K Residuals1 1 12attr(,"formula")yield ~ block + N * P * Kattr(,"onedf")[1] FALSEattr(,"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:Kyield 0 0 0 0 0 0 0 0block 1 0 0 0 0 0 0 0N 0 1 0 0 1 1 0 1P 0 0 1 0 1 0 1 1K 0 0 0 1 0 1 1 1attr(,"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.8752 54.8753 54.8754 54.8755 54.8756 54.8757 54.8758 54.8759 54.87510 54.87511 54.87512 54.87513 54.87514 54.87515 54.87516 54.87517 54.87518 54.87519 54.87520 54.87521 54.87522 54.87523 54.87524 54.875attr(,"df")attr(,"df")$df(Intercept)1attr(,"onedf")attr(,"onedf")$onedf[1] FALSEattr(,"factors")attr(,"factors")$`(Intercept)`[1] "(Intercept)"block :N:P:K Residuals1 -1.241667 0.39166672 -1.241667 0.39166673 -1.241667 0.39166674 -1.241667 0.39166675 1.241667 1.33333336 1.241667 1.33333337 1.241667 1.33333338 1.241667 1.33333339 1.241667 4.658333310 1.241667 4.658333311 1.241667 4.658333312 1.241667 4.658333313 1.241667 -5.991666714 1.241667 -5.991666715 1.241667 -5.991666716 1.241667 -5.991666717 -1.241667 -3.108333318 -1.241667 -3.108333319 -1.241667 -3.108333320 -1.241667 -3.108333321 -1.241667 2.716666722 -1.241667 2.716666723 -1.241667 2.716666724 -1.241667 2.7166667attr(,"df")attr(,"df")$dfN:P:K Residuals1 4attr(,"onedf")attr(,"onedf")$onedf[1] FALSEattr(,"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 Residuals1 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 -1.391666672 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 4.475000003 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 -5.025000004 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 1.941666675 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 -5.300000006 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 2.800000007 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 2.166666678 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 0.333333339 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 3.8083333310 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 -3.2250000011 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 1.0750000012 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 -1.6583333313 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 4.2250000014 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 0.4250000015 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 -0.5083333316 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 -4.1416666717 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 -2.8250000018 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 3.1750000019 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 -1.7583333320 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 1.4083333321 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 -0.1833333322 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 -1.6500000023 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 -0.0166666724 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 1.85000000attr(,"df")attr(,"df")$dfN P K N:P N:K P:K Residuals1 1 1 1 1 1 12attr(,"onedf")attr(,"onedf")$onedf[1] FALSEattr(,"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">>>> base::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 default1-sample proportions test with continuity correctiondata: heads out of 100, null probability 0.5X-squared = 0.09, df = 1, p-value = 0.7642alternative hypothesis: true p is not equal to 0.595 percent confidence interval:0.4183183 0.6201278sample estimates:p0.52> prop.test(heads, 100, correct = FALSE)1-sample proportions test without continuity correctiondata: heads out of 100, null probability 0.5X-squared = 0.16, df = 1, p-value = 0.6892alternative hypothesis: true p is not equal to 0.595 percent confidence interval:0.4231658 0.6153545sample estimates:p0.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 continuitycorrectiondata: smokers out of patientsX-squared = 12.6, df = 3, p-value = 0.005585alternative hypothesis: two.sidedsample estimates:prop 1 prop 2 prop 3 prop 40.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 continuitycorrectiondata: smokers out of patientsX-squared = 12.6, df = 3, p-value = 0.005585alternative hypothesis: two.sidedsample estimates:prop 1 prop 2 prop 3 prop 40.9651163 0.9677419 0.9485294 0.8536585> prop.trend.test(smokers, patients)Chi-squared Test for Trend in Proportionsdata: smokers out of patients ,using scores: 1 2 3 4X-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 Proportionsdata: smokers out of patients ,using scores: 0 0 0 1X-squared = 12.173, 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")>> ## "QQ-Chisquare" : --------------------------> y <- rchisq(500, df = 3)> ## Q-Q plot for Chi^2 data against true theoretical distribution:> qqplot(qchisq(ppoints(500), df = 3), y,+ main = expression("Q-Q plot for" ~~ {chi^2}[nu == 3]))> qqline(y, distribution = function(p) qchisq(p, df = 3),+ probs = c(0.1, 0.6), col = 2)> mtext("qqline(*, dist = qchisq(., df=3), prob = c(0.1, 0.6))")> ## (Note that the above uses ppoints() with a = 1/2, giving the> ## probability points for quantile type 5: so theoretically, using> ## qqline(qtype = 5) might be preferable.)>>>> 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]))> yBrandStore A B C D E1 5 4 7 10 122 1 3 1 0 23 16 12 22 22 354 5 4 3 5 45 10 9 7 13 106 19 18 28 37 587 10 7 6 8 7> (qTst <- quade.test(y))Quade testdata: yQuade F = 3.8293, num df = 4, denom df = 24, p-value = 0.01519>> ## Show equivalence of different versions of test :> utils::str(dy <- as.data.frame(as.table(y)))'data.frame': 35 obs. of 3 variables:$ Store: Factor w/ 7 levels "1","2","3","4",..: 1 2 3 4 5 6 7 1 2 3 ...$ Brand: Factor w/ 5 levels "A","B","C","D",..: 1 1 1 1 1 1 1 2 2 2 ...$ Freq : num 5 1 16 5 10 19 10 4 3 12 ...> qT. <- quade.test(Freq ~ Brand|Store, data = dy)> qT.$data.name <- qTst$data.name> stopifnot(all.equal(qTst, qT., tolerance = 1e-15))> dys <- dy[order(dy[,"Freq"]),]> qTs <- quade.test(Freq ~ Brand|Store, data = dys)> qTs$data.name <- qTst$data.name> stopifnot(all.equal(qTst, qTs, tolerance = 1e-15))>>>> 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 default0% 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.3388007450%-0.03472603 NA>> ### Compare different types> quantAll <- function(x, prob, ...)+ t(vapply(1:9, function(typ) quantile(x, prob=prob, type = typ, ...),+ quantile(x, prob, type=1, ...)))> p <- c(0.1, 0.5, 1, 2, 5, 10, 50)/100> signif(quantAll(x, p), 4)0.1% 0.5% 1% 2% 5% 10% 50%[1,] -2.997 -2.592 -2.424 -2.245 -1.727 -1.339 -0.03473[2,] -2.997 -2.592 -2.424 -2.245 -1.727 -1.339 -0.03473[3,] -3.008 -2.596 -2.433 -2.265 -1.733 -1.344 -0.03592[4,] -3.008 -2.596 -2.433 -2.264 -1.733 -1.344 -0.03532[5,] -3.002 -2.594 -2.428 -2.255 -1.730 -1.341 -0.03473[6,] -3.008 -2.596 -2.432 -2.264 -1.733 -1.343 -0.03473[7,] -2.997 -2.592 -2.424 -2.245 -1.727 -1.339 -0.03473[8,] -3.004 -2.595 -2.430 -2.258 -1.731 -1.342 -0.03473[9,] -3.004 -2.595 -2.429 -2.257 -1.730 -1.341 -0.03473>> ## 0% and 100% are equal to min(), max() for all types:> stopifnot(t(quantAll(x, prob=0:1)) == range(x))>> ## for complex numbers:> z <- complex(re=x, im = -10*x)> signif(quantAll(z, p), 4)0.1% 0.5% 1% 2% 5%[1,] -3.00+29.97i -2.59+25.92i -2.42+24.24i -2.25+22.45i -1.73+17.27i[2,] -3.00+29.97i -2.59+25.92i -2.42+24.24i -2.25+22.45i -1.73+17.27i[3,] -3.01+30.08i -2.60+25.96i -2.43+24.33i -2.26+22.65i -1.73+17.33i[4,] -3.01+30.08i -2.60+25.96i -2.43+24.33i -2.26+22.64i -1.73+17.33i[5,] -3.00+30.02i -2.59+25.94i -2.43+24.28i -2.25+22.55i -1.73+17.30i[6,] -3.01+30.08i -2.60+25.96i -2.43+24.32i -2.26+22.64i -1.73+17.33i[7,] -3.00+29.97i -2.59+25.92i -2.42+24.24i -2.25+22.45i -1.73+17.27i[8,] -3.00+30.04i -2.59+25.95i -2.43+24.30i -2.26+22.58i -1.73+17.31i[9,] -3.00+30.04i -2.59+25.95i -2.43+24.29i -2.26+22.57i -1.73+17.30i10% 50%[1,] -1.34+13.39i -0.0347+0.3473i[2,] -1.34+13.39i -0.0347+0.3473i[3,] -1.34+13.44i -0.0359+0.3592i[4,] -1.34+13.44i -0.0353+0.3532i[5,] -1.34+13.41i -0.0347+0.3473i[6,] -1.34+13.43i -0.0347+0.3473i[7,] -1.34+13.39i -0.0347+0.3473i[8,] -1.34+13.42i -0.0347+0.3473i[9,] -1.34+13.41i -0.0347+0.3473i>>>> 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("rWishart")> ### * rWishart>> flush(stderr()); flush(stdout())>> ### Name: rWishart> ### Title: Random Wishart Distributed Matrices> ### Aliases: rWishart> ### Keywords: multivariate>> ### ** Examples>> ## Artificial> S <- toeplitz((10:1)/10)> set.seed(11)> R <- rWishart(1000, 20, S)> dim(R) # 10 10 1000[1] 10 10 1000> mR <- apply(R, 1:2, mean) # ~= E[ Wish(S, 20) ] = 20 * S> stopifnot(all.equal(mR, 20*S, tolerance = .009))>> ## See Details, the variance is> Va <- 20*(S^2 + tcrossprod(diag(S)))> vR <- apply(R, 1:2, var)> stopifnot(all.equal(vR, Va, tolerance = 1/16))>>>> 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 print.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)> ft1 <- read.ftable(file)> ft1Intercourse Yes NoRace GenderWhite Male 43 134Female 26 149Black Male 29 23Female 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.")))> ftTonsil Size Not Enl. Enl. Greatly Enl.StatusNoncarriers 497 560 269Carriers 19 29 24> unlink(file)>> ft22 <- ftable(Titanic, row.vars = 2:1, col.vars = 4:3)> write.ftable(ft22, quote = FALSE)Survived No YesAge Child Adult Child AdultSex ClassMale 1st 0 118 5 572nd 0 154 11 143rd 35 387 13 75Crew 0 670 0 192Female 1st 0 4 1 1402nd 0 13 13 803rd 17 89 14 76Crew 0 3 0 20> write.ftable(ft22, quote = FALSE, method="row.compact")Survived No YesSex Class Age Child Adult Child AdultMale 1st 0 118 5 572nd 0 154 11 143rd 35 387 13 75Crew 0 670 0 192Female 1st 0 4 1 1402nd 0 13 13 803rd 17 89 14 76Crew 0 3 0 20> write.ftable(ft22, quote = FALSE, method="col.compact")Survived No YesAge Child Adult Child AdultSex ClassMale 1st 0 118 5 572nd 0 154 11 143rd 35 387 13 75Crew 0 670 0 192Female 1st 0 4 1 1402nd 0 13 13 803rd 17 89 14 76Crew 0 3 0 20> write.ftable(ft22, quote = FALSE, method="compact")Survived No YesSex Class | Age Child Adult Child AdultMale 1st 0 118 5 572nd 0 154 11 143rd 35 387 13 75Crew 0 670 0 192Female 1st 0 4 1 1402nd 0 13 13 803rd 17 89 14 76Crew 0 3 0 20> ## Don't show:> op <- options(warn = 2) # no warnings allowed> stopifnot(dim(format(ft)) == 4:5,+ dim(format(ftable(UCBAdmissions))) == c(6,9))> meths <- c("non.compact", "row.compact", "col.compact", "compact")> dimform <-+ function(ft) sapply(meths, function(M) dim(format(ft, method = M)))> m.eq <- function(M,m) all.equal(unname(M), m, tolerance = 0)> ## All format(..) w/o warnings:> stopifnot(m.eq(print(dimform(ft22)),+ rbind(11:10, rep(7:6, each = 2))),+ m.eq(print(dimform(ftable(Titanic, row.vars = integer()))),+ rbind(rep(6:5,2), 33)))non.compact row.compact col.compact compact[1,] 11 10 11 10[2,] 7 7 6 6non.compact row.compact col.compact compact[1,] 6 5 6 5[2,] 33 33 33 33> options(op)> ## 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 Mississippi1 2 8 18 24South Carolina40[[2]]Connecticut Idaho Indiana Kansas Kentucky Montana7 12 14 16 17 26Nebraska Ohio Pennsylvania Utah27 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.722Coefficients: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 ‘ ’ 1Residual standard error: 11.62 on 50 degrees of freedomMultiple R-squared: 0.2691, Adjusted R-squared: 0.2253F-statistic: 6.138 on 3 and 50 DF, p-value: 0.00123>>>> 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 K4 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 conc1:11 Min. :0.250 Min. :0.05004:11 1st Qu.:0.750 1st Qu.:0.11002:11 Median :2.000 Median :0.34005:11 Mean :2.886 Mean :0.59186:11 3rd Qu.:5.000 3rd Qu.:0.83253:11 Max. :8.000 Max. :2.7200> wide <- reshape(Indometh, v.names = "conc", idvar = "Subject",+ timevar = "time", direction = "wide")> wideSubject conc.0.25 conc.0.5 conc.0.75 conc.1 conc.1.25 conc.2 conc.3 conc.41 1 1.50 0.94 0.78 0.48 0.37 0.19 0.12 0.1112 2 2.03 1.63 0.71 0.70 0.64 0.36 0.32 0.2023 3 2.72 1.49 1.16 0.80 0.80 0.39 0.22 0.1234 4 1.85 1.39 1.02 0.89 0.59 0.40 0.16 0.1145 5 2.05 1.04 0.81 0.39 0.30 0.23 0.13 0.1156 6 2.31 1.44 1.03 0.84 0.64 0.42 0.24 0.17conc.5 conc.6 conc.81 0.08 0.07 0.0512 0.25 0.12 0.0823 0.11 0.08 0.0834 0.10 0.07 0.0745 0.08 0.10 0.0656 0.13 0.10 0.09>> reshape(wide, direction = "long")Subject time conc1.0.25 1 0.25 1.502.0.25 2 0.25 2.033.0.25 3 0.25 2.724.0.25 4 0.25 1.855.0.25 5 0.25 2.056.0.25 6 0.25 2.311.0.5 1 0.50 0.942.0.5 2 0.50 1.633.0.5 3 0.50 1.494.0.5 4 0.50 1.395.0.5 5 0.50 1.046.0.5 6 0.50 1.441.0.75 1 0.75 0.782.0.75 2 0.75 0.713.0.75 3 0.75 1.164.0.75 4 0.75 1.025.0.75 5 0.75 0.816.0.75 6 0.75 1.031.1 1 1.00 0.482.1 2 1.00 0.703.1 3 1.00 0.804.1 4 1.00 0.895.1 5 1.00 0.396.1 6 1.00 0.841.1.25 1 1.25 0.372.1.25 2 1.25 0.643.1.25 3 1.25 0.804.1.25 4 1.25 0.595.1.25 5 1.25 0.306.1.25 6 1.25 0.641.2 1 2.00 0.192.2 2 2.00 0.363.2 3 2.00 0.394.2 4 2.00 0.405.2 5 2.00 0.236.2 6 2.00 0.421.3 1 3.00 0.122.3 2 3.00 0.323.3 3 3.00 0.224.3 4 3.00 0.165.3 5 3.00 0.136.3 6 3.00 0.241.4 1 4.00 0.112.4 2 4.00 0.203.4 3 4.00 0.124.4 4 4.00 0.115.4 5 4.00 0.116.4 6 4.00 0.171.5 1 5.00 0.082.5 2 5.00 0.253.5 3 5.00 0.114.5 4 5.00 0.105.5 5 5.00 0.086.5 6 5.00 0.131.6 1 6.00 0.072.6 2 6.00 0.123.6 3 6.00 0.084.6 4 6.00 0.075.6 5 6.00 0.106.6 6 6.00 0.101.8 1 8.00 0.052.8 2 8.00 0.083.8 3 8.00 0.084.8 4 8.00 0.075.8 5 8.00 0.066.8 6 8.00 0.09> reshape(wide, idvar = "Subject", varying = list(2:12),+ v.names = "conc", direction = "long")Subject time conc1.1 1 1 1.502.1 2 1 2.033.1 3 1 2.724.1 4 1 1.855.1 5 1 2.056.1 6 1 2.311.2 1 2 0.942.2 2 2 1.633.2 3 2 1.494.2 4 2 1.395.2 5 2 1.046.2 6 2 1.441.3 1 3 0.782.3 2 3 0.713.3 3 3 1.164.3 4 3 1.025.3 5 3 0.816.3 6 3 1.031.4 1 4 0.482.4 2 4 0.703.4 3 4 0.804.4 4 4 0.895.4 5 4 0.396.4 6 4 0.841.5 1 5 0.372.5 2 5 0.643.5 3 5 0.804.5 4 5 0.595.5 5 5 0.306.5 6 5 0.641.6 1 6 0.192.6 2 6 0.363.6 3 6 0.394.6 4 6 0.405.6 5 6 0.236.6 6 6 0.421.7 1 7 0.122.7 2 7 0.323.7 3 7 0.224.7 4 7 0.165.7 5 7 0.136.7 6 7 0.241.8 1 8 0.112.8 2 8 0.203.8 3 8 0.124.8 4 8 0.115.8 5 8 0.116.8 6 8 0.171.9 1 9 0.082.9 2 9 0.253.9 3 9 0.114.9 4 9 0.105.9 5 9 0.086.9 6 9 0.131.10 1 10 0.072.10 2 10 0.123.10 3 10 0.084.10 4 10 0.075.10 5 10 0.106.10 6 10 0.101.11 1 11 0.052.11 2 11 0.083.11 3 11 0.084.11 4 11 0.075.11 5 11 0.066.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))> dfid visit x y1 1 Before -0.6264538 0.629114042 1 After 0.1836433 0.061786273 2 Before -0.8356286 0.205974574 2 After 1.5952808 0.176556755 3 Before -0.6264538 0.629114046 3 After 0.1836433 0.061786277 4 Before -0.8356286 0.205974578 4 After 1.5952808 0.17655675> reshape(df, timevar = "visit", idvar = "id", direction = "wide")id x.Before y.Before x.After y.After1 1 -0.6264538 0.6291140 0.1836433 0.061786273 2 -0.8356286 0.2059746 1.5952808 0.176556755 3 -0.6264538 0.6291140 0.1836433 0.061786277 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 varyingid y x.Before x.After1 1 0.6291140 -0.6264538 0.18364333 2 0.2059746 -0.8356286 1.59528085 3 0.6291140 -0.6264538 0.18364337 4 0.2059746 -0.8356286 1.5952808>>> ## unbalanced 'long' data leads to NA fill in 'wide' form> df2 <- df[1:7, ]> df2id visit x y1 1 Before -0.6264538 0.629114042 1 After 0.1836433 0.061786273 2 Before -0.8356286 0.205974574 2 After 1.5952808 0.176556755 3 Before -0.6264538 0.629114046 3 After 0.1836433 0.061786277 4 Before -0.8356286 0.20597457> reshape(df2, timevar = "visit", idvar = "id", direction = "wide")id x.Before y.Before x.After y.After1 1 -0.6264538 0.6291140 0.1836433 0.061786273 2 -0.8356286 0.2059746 1.5952808 0.176556755 3 -0.6264538 0.6291140 0.1836433 0.061786277 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 dose1.1 1 40 1 12.1 2 50 1 23.1 3 60 1 14.1 4 50 1 21.2 1 40 2 22.2 2 50 2 13.2 3 60 2 24.2 4 50 2 11.4 1 40 4 32.4 2 50 4 33.4 3 60 4 34.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 ExpAlabama.Population Alabama 3615 3624 2.1 69.05Alaska.Population Alaska 365 6315 1.5 69.31Arizona.Population Arizona 2212 4530 1.8 70.55Arkansas.Population Arkansas 2110 3378 1.9 70.66California.Population California 21198 5114 1.1 71.71Colorado.Population Colorado 2541 4884 0.7 72.06Connecticut.Population Connecticut 3100 5348 1.1 72.48Delaware.Population Delaware 579 4809 0.9 70.06Florida.Population Florida 8277 4815 1.3 70.66Georgia.Population Georgia 4931 4091 2.0 68.54Hawaii.Population Hawaii 868 4963 1.9 73.60Idaho.Population Idaho 813 4119 0.6 71.87Illinois.Population Illinois 11197 5107 0.9 70.14Indiana.Population Indiana 5313 4458 0.7 70.88Iowa.Population Iowa 2861 4628 0.5 72.56Kansas.Population Kansas 2280 4669 0.6 72.58Kentucky.Population Kentucky 3387 3712 1.6 70.10Louisiana.Population Louisiana 3806 3545 2.8 68.76Maine.Population Maine 1058 3694 0.7 70.39Maryland.Population Maryland 4122 5299 0.9 70.22Massachusetts.Population Massachusetts 5814 4755 1.1 71.83Michigan.Population Michigan 9111 4751 0.9 70.63Minnesota.Population Minnesota 3921 4675 0.6 72.96Mississippi.Population Mississippi 2341 3098 2.4 68.09Missouri.Population Missouri 4767 4254 0.8 70.69Montana.Population Montana 746 4347 0.6 70.56Nebraska.Population Nebraska 1544 4508 0.6 72.60Nevada.Population Nevada 590 5149 0.5 69.03New Hampshire.Population New Hampshire 812 4281 0.7 71.23New Jersey.Population New Jersey 7333 5237 1.1 70.93New Mexico.Population New Mexico 1144 3601 2.2 70.32New York.Population New York 18076 4903 1.4 70.55North Carolina.Population North Carolina 5441 3875 1.8 69.21North Dakota.Population North Dakota 637 5087 0.8 72.78Ohio.Population Ohio 10735 4561 0.8 70.82Oklahoma.Population Oklahoma 2715 3983 1.1 71.42Oregon.Population Oregon 2284 4660 0.6 72.13Pennsylvania.Population Pennsylvania 11860 4449 1.0 70.43Rhode Island.Population Rhode Island 931 4558 1.3 71.90South Carolina.Population South Carolina 2816 3635 2.3 67.96South Dakota.Population South Dakota 681 4167 0.5 72.08Tennessee.Population Tennessee 4173 3821 1.7 70.11Texas.Population Texas 12237 4188 2.2 70.90Utah.Population Utah 1203 4022 0.6 72.90Vermont.Population Vermont 472 3907 0.6 71.64Virginia.Population Virginia 4981 4701 1.4 70.08Washington.Population Washington 3559 4864 0.6 71.72West Virginia.Population West Virginia 1799 3617 1.4 69.48Wisconsin.Population Wisconsin 4589 4468 0.7 72.48Wyoming.Population Wyoming 376 4566 0.6 70.29Murder HS Grad Frost AreaAlabama.Population 15.1 41.3 20 50708Alaska.Population 11.3 66.7 152 566432Arizona.Population 7.8 58.1 15 113417Arkansas.Population 10.1 39.9 65 51945California.Population 10.3 62.6 20 156361Colorado.Population 6.8 63.9 166 103766Connecticut.Population 3.1 56.0 139 4862Delaware.Population 6.2 54.6 103 1982Florida.Population 10.7 52.6 11 54090Georgia.Population 13.9 40.6 60 58073Hawaii.Population 6.2 61.9 0 6425Idaho.Population 5.3 59.5 126 82677Illinois.Population 10.3 52.6 127 55748Indiana.Population 7.1 52.9 122 36097Iowa.Population 2.3 59.0 140 55941Kansas.Population 4.5 59.9 114 81787Kentucky.Population 10.6 38.5 95 39650Louisiana.Population 13.2 42.2 12 44930Maine.Population 2.7 54.7 161 30920Maryland.Population 8.5 52.3 101 9891Massachusetts.Population 3.3 58.5 103 7826Michigan.Population 11.1 52.8 125 56817Minnesota.Population 2.3 57.6 160 79289Mississippi.Population 12.5 41.0 50 47296Missouri.Population 9.3 48.8 108 68995Montana.Population 5.0 59.2 155 145587Nebraska.Population 2.9 59.3 139 76483Nevada.Population 11.5 65.2 188 109889New Hampshire.Population 3.3 57.6 174 9027New Jersey.Population 5.2 52.5 115 7521New Mexico.Population 9.7 55.2 120 121412New York.Population 10.9 52.7 82 47831North Carolina.Population 11.1 38.5 80 48798North Dakota.Population 1.4 50.3 186 69273Ohio.Population 7.4 53.2 124 40975Oklahoma.Population 6.4 51.6 82 68782Oregon.Population 4.2 60.0 44 96184Pennsylvania.Population 6.1 50.2 126 44966Rhode Island.Population 2.4 46.4 127 1049South Carolina.Population 11.6 37.8 65 30225South Dakota.Population 1.7 53.3 172 75955Tennessee.Population 11.0 41.8 70 41328Texas.Population 12.2 47.4 35 262134Utah.Population 4.5 67.3 137 82096Vermont.Population 5.5 57.1 168 9267Virginia.Population 9.5 47.8 85 39780Washington.Population 4.3 63.5 32 66570West Virginia.Population 6.7 41.6 100 24070Wisconsin.Population 3.0 54.5 149 54464Wyoming.Population 6.9 62.9 173 97203>> reshape(long, direction = "wide", new.row.names = unique(long$state))state Population Income Illiteracy Life Exp MurderAlabama Alabama 3615 3624 2.1 69.05 15.1Alaska Alaska 365 6315 1.5 69.31 11.3Arizona Arizona 2212 4530 1.8 70.55 7.8Arkansas Arkansas 2110 3378 1.9 70.66 10.1California California 21198 5114 1.1 71.71 10.3Colorado Colorado 2541 4884 0.7 72.06 6.8Connecticut Connecticut 3100 5348 1.1 72.48 3.1Delaware Delaware 579 4809 0.9 70.06 6.2Florida Florida 8277 4815 1.3 70.66 10.7Georgia Georgia 4931 4091 2.0 68.54 13.9Hawaii Hawaii 868 4963 1.9 73.60 6.2Idaho Idaho 813 4119 0.6 71.87 5.3Illinois Illinois 11197 5107 0.9 70.14 10.3Indiana Indiana 5313 4458 0.7 70.88 7.1Iowa Iowa 2861 4628 0.5 72.56 2.3Kansas Kansas 2280 4669 0.6 72.58 4.5Kentucky Kentucky 3387 3712 1.6 70.10 10.6Louisiana Louisiana 3806 3545 2.8 68.76 13.2Maine Maine 1058 3694 0.7 70.39 2.7Maryland Maryland 4122 5299 0.9 70.22 8.5Massachusetts Massachusetts 5814 4755 1.1 71.83 3.3Michigan Michigan 9111 4751 0.9 70.63 11.1Minnesota Minnesota 3921 4675 0.6 72.96 2.3Mississippi Mississippi 2341 3098 2.4 68.09 12.5Missouri Missouri 4767 4254 0.8 70.69 9.3Montana Montana 746 4347 0.6 70.56 5.0Nebraska Nebraska 1544 4508 0.6 72.60 2.9Nevada Nevada 590 5149 0.5 69.03 11.5New Hampshire New Hampshire 812 4281 0.7 71.23 3.3New Jersey New Jersey 7333 5237 1.1 70.93 5.2New Mexico New Mexico 1144 3601 2.2 70.32 9.7New York New York 18076 4903 1.4 70.55 10.9North Carolina North Carolina 5441 3875 1.8 69.21 11.1North Dakota North Dakota 637 5087 0.8 72.78 1.4Ohio Ohio 10735 4561 0.8 70.82 7.4Oklahoma Oklahoma 2715 3983 1.1 71.42 6.4Oregon Oregon 2284 4660 0.6 72.13 4.2Pennsylvania Pennsylvania 11860 4449 1.0 70.43 6.1Rhode Island Rhode Island 931 4558 1.3 71.90 2.4South Carolina South Carolina 2816 3635 2.3 67.96 11.6South Dakota South Dakota 681 4167 0.5 72.08 1.7Tennessee Tennessee 4173 3821 1.7 70.11 11.0Texas Texas 12237 4188 2.2 70.90 12.2Utah Utah 1203 4022 0.6 72.90 4.5Vermont Vermont 472 3907 0.6 71.64 5.5Virginia Virginia 4981 4701 1.4 70.08 9.5Washington Washington 3559 4864 0.6 71.72 4.3West Virginia West Virginia 1799 3617 1.4 69.48 6.7Wisconsin Wisconsin 4589 4468 0.7 72.48 3.0Wyoming Wyoming 376 4566 0.6 70.29 6.9HS Grad Frost AreaAlabama 41.3 20 50708Alaska 66.7 152 566432Arizona 58.1 15 113417Arkansas 39.9 65 51945California 62.6 20 156361Colorado 63.9 166 103766Connecticut 56.0 139 4862Delaware 54.6 103 1982Florida 52.6 11 54090Georgia 40.6 60 58073Hawaii 61.9 0 6425Idaho 59.5 126 82677Illinois 52.6 127 55748Indiana 52.9 122 36097Iowa 59.0 140 55941Kansas 59.9 114 81787Kentucky 38.5 95 39650Louisiana 42.2 12 44930Maine 54.7 161 30920Maryland 52.3 101 9891Massachusetts 58.5 103 7826Michigan 52.8 125 56817Minnesota 57.6 160 79289Mississippi 41.0 50 47296Missouri 48.8 108 68995Montana 59.2 155 145587Nebraska 59.3 139 76483Nevada 65.2 188 109889New Hampshire 57.6 174 9027New Jersey 52.5 115 7521New Mexico 55.2 120 121412New York 52.7 82 47831North Carolina 38.5 80 48798North Dakota 50.3 186 69273Ohio 53.2 124 40975Oklahoma 51.6 82 68782Oregon 60.0 44 96184Pennsylvania 50.2 126 44966Rhode Island 46.4 127 1049South Carolina 37.8 65 30225South Dakota 53.3 172 75955Tennessee 41.8 70 41328Texas 47.4 35 262134Utah 67.3 137 82096Vermont 57.1 168 9267Virginia 47.8 85 39780Washington 63.5 32 66570West Virginia 41.6 100 24070Wisconsin 54.5 149 54464Wyoming 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")> wideschool class score.1 score.21 1 9 0.48742905 0.575781352 1 10 0.73832471 -0.305388395 2 9 1.51178117 -0.621240586 2 10 0.38984324 -2.214699899 3 9 1.12493092 -0.0161902610 3 10 -0.04493361 0.94383621> ## transform back> reshape(wide)school class time score.11.9.1 1 9 1 0.487429051.10.1 1 10 1 0.738324712.9.1 2 9 1 1.511781172.10.1 2 10 1 0.389843243.9.1 3 9 1 1.124930923.10.1 3 10 1 -0.044933611.9.2 1 9 2 0.575781351.10.2 1 10 2 -0.305388392.9.2 2 9 2 -0.621240582.10.2 2 10 2 -2.214699893.9.2 3 9 2 -0.016190263.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 = 0.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 = 0.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))>> ## An example with initial NA's - used to fail badly (notably for "Turlach"):> x15 <- c(rep(NA, 4), c(9, 9, 4, 22, 6, 1, 7, 5, 2, 8, 3))> rS15 <- cbind(Sk.3 = runmed(x15, k = 3, algorithm="S"),+ Sk.7 = runmed(x15, k = 7, algorithm="S"),+ Sk.11= runmed(x15, k =11, algorithm="S"))> rT15 <- cbind(Tk.3 = runmed(x15, k = 3, algorithm="T", print.level=1),+ Tk.7 = runmed(x15, k = 7, algorithm="T", print.level=1),+ Tk.9 = runmed(x15, k = 9, algorithm="T", print.level=1),+ Tk.11= runmed(x15, k =11, algorithm="T", print.level=1))runmed(x, k=3, endrule='median' ( => iend=0), algorithm='Turlach',na.*='+Big_alternate' ( => iNAct=1))firstNA = 1.R_heapsort(1, 3,..): l=2:j: 0 1 2 3 4 5 6window []: -2B -2B -BIG +BIG +BIG +2B +2Bnrlist[]: -12345 2 1 2 0-12345-12345outlist[]: 4 2 3 2runmed(x, k=7, endrule='median' ( => iend=0), algorithm='Turlach',na.*='+Big_alternate' ( => iNAct=1))firstNA = 1.R_heapsort(1, 7,..): l=4:j: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14window []: -2B -2B -2B -2B -BIG -BIG 4 9 9 +BIG +BIG +2B +2B +2B +2Bnrlist[]: -12345 4 2 7 3 1 6 5 4 2 0-12345-12345-12345-12345outlist[]: 10 5 9 4 8 7 6 3runmed(x, k=9, endrule='median' ( => iend=0), algorithm='Turlach',na.*='+Big_alternate' ( => iNAct=1))firstNA = 1.R_heapsort(1, 9,..): l=5:j: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18window []: -2B -2B -2B -2B -2B -BIG -BIG 4 6 9 9 22 +BIG +BIG +2B +2B +2B +2B +2Bnrlist[]: -12345 4 2 7 9 3 1 6 8 5 4 7 2 0-12345-12345-12345-12345-12345outlist[]: 13 6 12 5 10 9 7 11 8 4runmed(x, k=11, endrule='median' ( => iend=0), algorithm='Turlach',na.*='+Big_alternate' ( => iNAct=1))firstNA = 1.R_heapsort(1, 11,..): l=6:j: 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22window []: -2B -2B -2B -2B -2B -2B -BIG -BIG 1 4 6 7 9 9 22 +BIG +BIG +2B +2B +2B +2B +2B +2Bnrlist[]: -12345 2 4 10 7 9 1 3 9 6 8 10 5 4 7 2 0-12345-12345-12345-12345-12345-12345outlist[]: 16 6 15 7 13 12 9 14 10 8 11 6> cbind(x15, rS15, rT15) # result for k=11 maybe a bit surprising ..x15 Sk.3 Sk.7 Sk.11 Tk.3 Tk.7 Tk.9 Tk.11[1,] NA NaN NaN NaN NaN NaN NaN NaN[2,] NA NA NaN NaN NA NaN NaN NaN[3,] NA NA 9 9 NA 9 9 9[4,] NA 9 9 7 9 9 7 7[5,] 9 9 9 6 9 9 9 6[6,] 9 9 9 7 9 9 6 7[7,] 4 9 6 6 9 6 7 6[8,] 22 6 7 6 6 7 6 6[9,] 6 6 6 6 6 6 6 6[10,] 1 6 5 6 6 5 6 6[11,] 7 5 6 6 5 6 5 6[12,] 5 5 5 6 5 5 5 6[13,] 2 5 5 5 5 5 5 5[14,] 8 3 3 3 3 3 3 3[15,] 3 3 3 3 3 3 3 3> Tv <- rT15[-(1:3),]> stopifnot(3 <= Tv, Tv <= 9, 5 <= Tv[1:10,])> matplot(y = cbind(x15, rT15), type = "b", ylim = c(1,9), pch=1:5, xlab = NA,+ main = "runmed(x15, k, algo = \"Turlach\")")> mtext(paste("x15 <-", deparse(x15)))> points(x15, cex=2)> legend("bottomleft", legend=c("data", paste("k = ", c(3,7,9,11))),+ bty="n", col=1:5, lty=1:5, pch=1:5)>>>> 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))> ## or with dotted thick smoothed line results :> with(cars, scatter.smooth(speed, dist, lpars =+ list(col = "red", lwd = 3, lty = 3)))>>>> 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)) # inappropriateCall:princomp(x = USArrests, cor = TRUE)Standard deviations:Comp.1 Comp.2 Comp.3 Comp.41.5748783 0.9948694 0.5971291 0.41644944 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)N1.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 114.24547> (t.stat <- sum(cont*score)/se.contrast(fit, as.matrix(cont)))Contrast 1-1.26356> summary(fit, split = list(B = 1:2), expand.split = TRUE)Df Sum Sq Mean Sq F value Pr(>F)A 1 18.78 18.78 2.221 0.14661B 2 62.00 31.00 3.666 0.03763 *B: C1 1 1.50 1.50 0.177 0.67662B: C2 1 60.50 60.50 7.155 0.01199 *A:B 2 81.56 40.78 4.823 0.01527 *A:B: C1 1 13.50 13.50 1.597 0.21612A:B: C2 1 68.06 68.06 8.049 0.00809 **Residuals 30 253.67 8.46---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 314.24547 14.24547 14.24547> rm(A, B, score)>>> ## multi-stratum example where efficiencies play a role> ## 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)> 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 contrastsA BC10.40625 -20.90625> se.contrast(fit, as.matrix(cont))A BC3.377196 3.899650>>> base::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>> ## The "initializer" (finds initial values for parameters from data):> initLogis <- function(mCall, data, LHS) {+ xy <- data.frame(sortedXyData(mCall[["input"]], LHS, data))+ if(nrow(xy) < 4)+ stop("too few distinct input values to fit a logistic model")+ z <- xy[["y"]]+ ## transform to proportion, i.e. in (0,1) :+ rng <- range(z); dz <- diff(rng)+ z <- (z - rng[1L] + 0.05 * dz)/(1.1 * dz)+ xy[["z"]] <- log(z/(1 - z)) # logit transformation+ aux <- coef(lm(x ~ z, xy))+ pars <- coef(nls(y ~ 1/(1 + exp((xmid - x)/scal)),+ data = xy,+ start = list(xmid = aux[[1L]], scal = aux[[2L]]),+ algorithm = "plinear"))+ setNames(pars[c(".lin", "xmid", "scal")], nm = mCall[c("Asym", "xmid", "scal")])+ }>> SSlogis <- selfStart(~ Asym/(1 + exp((xmid - x)/scal)),+ initial = initLogis,+ parameters = 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)>> ## Explore the self-starting models already available in R's "stats":> pos.st <- which("package:stats" == search())> mSS <- apropos("^SS..", where = TRUE, ignore.case = FALSE)> (mSS <- unname(mSS[names(mSS) == pos.st]))[1] "SSasymp" "SSasympOff" "SSasympOrig" "SSbiexp" "SSfol"[6] "SSfpl" "SSgompertz" "SSlogis" "SSmicmen" "SSweibull"> fSS <- sapply(mSS, get, pos = pos.st, mode = "function")> all(sapply(fSS, inherits, "selfStart")) # -> TRUE[1] TRUE>> ## Show the argument list of each self-starting function:> str(fSS, give.attr = FALSE)List of 10$ SSasymp :function (input, Asym, R0, lrc)$ SSasympOff :function (input, Asym, lrc, c0)$ SSasympOrig:function (input, Asym, lrc)$ SSbiexp :function (input, A1, lrc1, A2, lrc2)$ SSfol :function (Dose, input, lKe, lKa, lCl)$ SSfpl :function (input, A, B, xmid, scal)$ SSgompertz :function (x, Asym, b2, b3)$ SSlogis :function (input, Asym, xmid, scal)$ SSmicmen :function (input, Vm, K)$ SSweibull :function (x, Asym, Drop, lrc, pwr)>>>> 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 baz1 2 3> # this is just a short form of> tmp <- 1:3> names(tmp) <- c("foo", "bar", "baz")> tmpfoo bar baz1 2 3>> ## special case of character vector, using default> setNames(nm = c("First", "2nd"))First 2nd"First" "2nd">>>> 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 testdata: rnorm(100, mean = 5, sd = 3)W = 0.9956, p-value = 0.9876> shapiro.test(runif(100, min = 2, max = 4))Shapiro-Wilk normality testdata: runif(100, min = 2, max = 4)W = 0.93092, p-value = 5.616e-05>>>> cleanEx()> nameEx("sigma")> ### * sigma>> flush(stderr()); flush(stdout())>> ### Name: sigma> ### Title: Extract Residual Standard Deviation 'Sigma'> ### Aliases: sigma sigma.default sigma.mlm> ### Keywords: models>> ### ** Examples>> ## -- lm() ------------------------------> lm1 <- lm(Fertility ~ . , data = swiss)> sigma(lm1) # ~= 7.165 = "Residual standard error" printed from summary(lm1)[1] 7.165369> stopifnot(all.equal(sigma(lm1), summary(lm1)$sigma, tol=1e-15))>> ## -- nls() -----------------------------> DNase1 <- subset(DNase, Run == 1)> fm.DN1 <- nls(density ~ SSlogis(log(conc), Asym, xmid, scal), DNase1)> sigma(fm.DN1) # ~= 0.01919 as from summary(..)[1] 0.01919449> stopifnot(all.equal(sigma(fm.DN1), summary(fm.DN1)$sigma, tol=1e-15))>> ## -- glm() -----------------------------> ## -- a) Binomial -- Example from MASS> 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)> sigma(budworm.lg <- glm(SF ~ sex*ldose, family = binomial))[1] 0.7900734>> ## -- b) Poisson -- from ?glm :> ## 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)> sigma(glm.D93 <- glm(counts ~ outcome + treatment, family = poisson()))[1] 1.13238> ## (currently) *differs* from> summary(glm.D93)$dispersion # == 1[1] 1> ## and the *Quasi*poisson's dispersion> sigma(glm.qD93 <- update(glm.D93, family = quasipoisson()))[1] 1.13238> sigma (glm.qD93)^2 # 1.282285 is close, but not the same[1] 1.282285> summary(glm.qD93)$dispersion # == 1.2933[1] 1.2933>> ## -- Multivariate lm() "mlm" -----------> utils::example("SSD", echo=FALSE)> sigma(mlmfit) # is the same as {but more efficient than}deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP56.92100 86.02325 78.99367 88.54377 109.54451 116.79041> sqrt(diag(estVar(mlmfit)))deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP56.92100 86.02325 78.99367 88.54377 109.54451 116.79041> ## Don't show:> stopifnot(all.equal(sigma(mlmfit), sqrt(diag(estVar(mlmfit)))))> ## End(Don't show)>>>> 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 the same as1 2 3 4 50.6885691 2.2329771 3.7790352 5.2775859 6.8131451> fitted(mod1)1 2 3 4 50.8 2.3 3.8 5.3 6.8>> ## repeat identically:> (sseed <- attr(S2, "seed")) # seed; RNGkind as attribute[1] 101attr(,"kind")attr(,"kind")[[1]][1] "Mersenne-Twister"attr(,"kind")[[2]][1] "Inversion"attr(,"kind")[[3]][1] "Rejection"> stopifnot(identical(S2, simulate(mod1, nsim = 200, seed = sseed)))>> ## To be sure about the proper RNGkind, e.g., after> RNGversion("2.7.0")Warning in RNGkind("Mersenne-Twister", "Inversion", "Rounding") :non-uniform 'Rounding' sampler used> ## 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 fromsmooth(x = presidents, kind = "3R") ; n = 120used 4 iterationsMin. 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 fromsmooth(x = presidents, kind = "3RSS") ; n = 120used 5 iterationsMin. 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 fromsmooth(x = presidents) ; n = 120used 7 iterationsMin. 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 .nknots.smspl> ### Keywords: smooth>> ### ** Examples>> require(graphics)> plot(dist ~ speed, data = cars, main = "data(cars) & smoothing splines")> cars.spl <- with(cars, smooth.spline(speed, dist))> cars.splCall:smooth.spline(x = speed, y = dist)Smoothing Parameter spar= 0.7801305 lambda= 0.1112206 (11 iterations)Equivalent Degrees of Freedom (Df): 2.635278Penalized Criterion (RSS): 4187.776GCV: 244.1044> ## This example has duplicate points, so avoid cv = TRUE> ## Don't show:> stopifnot(cars.spl $ w == table(cars$speed)) # weights = multiplicities> utils::str(cars.spl, digits = 5, vec.len = 6)List of 19$ 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 ...$ tol : num 7e-06$ 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$ no.weights: logi TRUE$ 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$ ratio : num 6.576e-05$ lambda : num 0.11122$ iparms : Named int [1:5] 1 0 11 0 NA..- attr(*, "names")= chr [1:5] "icrit" "ispar" "iter" "" "errorI"$ auxM : NULL$ 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.103688attr(,"class")[1] "smooth.spline.fit"> ## End(Don't show)> lines(cars.spl, col = "blue")> ss10 <- smooth.spline(cars[,"speed"], cars[,"dist"], df = 10)> lines(ss10, 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')>>> ## 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)))> ## The chosen inner knots in original x-scale :> with(cars.spl$fit, min + range * knot[-c(1:3, nk+1 +1:3)]) # == unique(cars$speed)[1] 4 7 8 9 10 11 12 13 14 15 16 17 18 19 20 22 23 24 25>> ## Visualize the behavior of .nknots.smspl()> nKnots <- Vectorize(.nknots.smspl) ; c.. <- adjustcolor("gray20",.5)> curve(nKnots, 1, 250, n=250)> abline(0,1, lty=2, col=c..); text(90,90,"y = x", col=c.., adj=-.25)> abline(h=100,lty=2); abline(v=200, lty=2)>> n <- c(1:799, seq(800, 3490, by=10), seq(3500, 10000, by = 50))> plot(n, nKnots(n), type="l", main = "Vectorize(.nknots.smspl) (n)")> abline(0,1, lty=2, col=c..); text(180,180,"y = x", col=c..)> n0 <- c(50, 200, 800, 3200); c0 <- adjustcolor("blue3", .5)> lines(n0, nKnots(n0), type="h", col=c0)> axis(1, at=n0, line=-2, col.ticks=c0, col=NA, col.axis=c0)> axis(4, at=.nknots.smspl(10000), line=-.5, col=c..,col.axis=c.., las=1)>> ##-- 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)) # GCVCall:smooth.spline(x = y18)Smoothing Parameter spar= 0.3928105 lambda= 9.672776e-05 (13 iterations)Equivalent Degrees of Freedom (Df): 8.494168Penalized Criterion (RSS): 3.59204GCV: 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-06Equivalent Degrees of Freedom (Df): 15.259Penalized Criterion (RSS): 0.4973656GCV: 1.191602> (s02. <- smooth.spline(y18, spar = 0.2, cv = NA))Call:smooth.spline(x = y18, spar = 0.2, cv = NA)Smoothing Parameter spar= 0.2 lambda= 3.911187e-06Equivalent Degrees of Freedom (Df): NAPenalized Criterion (RSS): 0.4973656> 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)>> ## Specifying 'lambda' instead of usual spar :> (s2. <- smooth.spline(y18, lambda = s2$lambda, tol = s2$tol))Call:smooth.spline(x = y18, lambda = s2$lambda, tol = s2$tol)Smoothing Parameter spar= NA lambda= 9.672776e-05Equivalent Degrees of Freedom (Df): 8.494168Penalized Criterion (RSS): 3.59204GCV: 0.7155391>> ## Don't show:> stopifnot(identical(+ with(s2$fit, min + range * knot[-c(1:3, nk+1+1:3)]),+ as.numeric(1:18)),+ with(cars.spl$fit, min + range * knot[-c(1:3, nk+1+1:3)]) == unique(cars$speed))>> nD <- c("spar", "ratio", "iparms", "call"); nn <- setdiff(names(s2), nD)> stopifnot(all.equal(s2[nn], s2.[nn], tol = 7e-7), # seen 6.86e-8+ all.equal(predict(s02 , xx),+ predict(s02., xx), tol = 1e-15))> ## End(Don't show)>>> 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, endrule = X)")> lines(ys, col = "light gray")> matlines(cbind(s7k, s7.,s7m), lwd = 1.5, lty = 1, col = col3)> eRules <- c("keep","constant","median")> legend("topleft", paste("endrule", eRules, sep = " = "),+ col = col3, lwd = 1.5, lty = 1, bty = "n")>> stopifnot(identical(s7m, smoothEnds(s7k, 7)))>> ## With missing values (for R >= 3.6.1):> yN <- y; yN[c(2,40)] <- NA> rN <- sapply(eRules, function(R) runmed(yN, 7, endrule=R))> matlines(rN, type = "b", pch = 4, lwd = 3, lty=2,+ col = adjustcolor(c("red", "orange4", "orange1"), 0.5))> yN[c(1, 20:21)] <- NA # additionally> rN. <- sapply(eRules, function(R) runmed(yN, 7, endrule=R))> head(rN., 4); tail(rN.) # more NA's too, still not *so* many:keep constant median[1,] NA 256 392[2,] NA 256 324[3,] 324 256 256[4,] 256 256 256keep constant median[36,] 225 225 225[37,] 256 256 256[38,] 289 289 289[39,] 324 289 289[40,] NA 289 397[41,] 470 289 470> stopifnot(exprs = {+ !anyNA(rN[,2:3])+ identical(which(is.na(rN[,"keep"])), c(2L, 40L))+ identical(which(is.na(rN.), arr.ind=TRUE, useNames=FALSE),+ cbind(c(1:2,40L), 1L))+ identical(rN.[38:41, "median"], c(289,289, 397, 470))+ })>>>> 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 y1 -3.0194489 0.04752 -1.6331544 0.13003 -0.9400073 0.21604 -0.2468601 0.39205 0.4462871 0.67656 1.1394343 1.09707 1.8325815 1.54008 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")>> spec.ar(log(lynx))> spec.ar(log(lynx), method = "burg", add = TRUE, col = "purple")> spec.ar(log(lynx), method = "mle", add = TRUE, col = "forest green")> spec.ar(log(lynx), method = "ols", add = TRUE, col = "blue")>>>> 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 = 0.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)Warning in regularize.values(x, y, ties, missing(ties)) :collapsing to unique 'x' values> ## 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)>> ## Another example with sorted x, but ties:> set.seed(8); x <- sort(round(rnorm(30), 1)); y <- round(sin(pi * x) + rnorm(30)/10, 3)> summary(diff(x) == 0) # -> 7 duplicated x-valuesMode FALSE TRUElogical 22 7> str(spline(x, y, n = 201, ties="ordered")) # all '$y' entries are NaNList of 2$ x: num [1:201] -3 -2.98 -2.95 -2.92 -2.9 ...$ y: num [1:201] NaN NaN NaN NaN NaN NaN NaN NaN NaN NaN ...> ## The default (ties=mean) is ok, but most efficient to use instead is> sxyo <- spline(x, y, n = 201, ties= list("ordered", mean))> sapply(sxyo, summary)# all fine nowx yMin. -3.00 -1.078000001st Qu. -1.75 -0.57050000Median -0.50 -0.13613265Mean -0.50 -0.082083113rd Qu. 0.75 0.50611122Max. 2.00 1.03072752> plot(x, y, main = "spline(x,y, ties=list(\"ordered\", mean)) for when x has ties")> lines(sxyo, col="blue")>> ## 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 = "monoH.FC")(x), add = TRUE, col = 3, n = 1001)> curve(splinefun(x., y., method = "hyman") (x), add = TRUE, col = 4, n = 1001)> legend("topleft",+ paste0("splinefun( \"", c("fmm", "monoH.FC", "hyman"), "\" )"),+ col = 2:4, lty = 1, bty = "n")>> ## and one from Fritsch and Carlson (1980), Dougherty et al (1989)> x. <- c(7.09, 8.09, 8.19, 8.7, 9.2, 10, 12, 15, 20)> f <- c(0, 2.76429e-5, 4.37498e-2, 0.169183, 0.469428, 0.943740,+ 0.998636, 0.999919, 0.999994)> s0 <- splinefun(x., f)> s1 <- splinefun(x., f, method = "monoH.FC")> s2 <- splinefun(x., f, method = "hyman")> plot(x., f, ylim = c(-0.2, 1.2))> curve(s0(x), add = TRUE, col = 2, n = 1001) -> m0> curve(s1(x), add = TRUE, col = 3, n = 1001)> curve(s2(x), add = TRUE, col = 4, n = 1001)> legend("right",+ paste0("splinefun( \"", c("fmm", "monoH.FC", "hyman"), "\" )"),+ col = 2:4, lty = 1, bty = "n")>> ## they seem identical, but are not quite:> xx <- m0$x> plot(xx, s1(xx) - s2(xx), type = "l", col = 2, lwd = 2,+ main = "Difference monoH.FC - hyman"); abline(h = 0, lty = 3)>> x <- xx[xx < 10.2] ## full range: x <- xx .. does not show enough> ccol <- adjustcolor(2:4, 0.8)> matplot(x, cbind(s0(x, deriv = 2), s1(x, deriv = 2), s2(x, deriv = 2))^2,+ lwd = 2, col = ccol, type = "l", ylab = quote({{f*second}(x)}^2),+ main = expression({{f*second}(x)}^2 ~" for the three 'splines'"))> legend("topright",+ paste0("splinefun( \"", c("fmm", "monoH.FC", "hyman"), "\" )"),+ lwd = 2, col = ccol, lty = 1:3, bty = "n")> ## --> "hyman" has slightly smaller Integral f''(x)^2 dx than "FC",> ## here, and both are 'much worse' than the regular fmm spline.>>>> 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)> ## End(Don't show)> print(ag <- anova(glm.D93))Analysis of Deviance TableModel: poisson, link: logResponse: countsTerms added sequentially (first to last)Df Deviance Resid. Df Resid. DevNULL 8 10.5814outcome 2 5.4523 6 5.1291treatment 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>>> cleanEx()> nameEx("stepfun")> ### * stepfun>> flush(stderr()); flush(stdout())>> ### Name: stepfun> ### Title: Step Functions - Creation and 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 = 0.2)> sfun1 <- stepfun(1:3, y0, f = 1)> sfun1c <- stepfun(1:3, y0, right = TRUE) # hence f=1> sfun0Step functionCall: stepfun(1:3, y0, f = 0)x[1:3] = 1, 2, 34 plateau levels = 1, 2, 4, 3> summary(sfun0)Step function with continuity 'f'= 0 , 3 knots at[1] 1 2 3and 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 3and 4 plateau levels (y) at[1] 1 2 4 3>> ## look at the internal structure:> unclass(sfun0)function (v).approxfun(x, y, v, method, yleft, yright, f, na.rm)<bytecode: 0x49bde58><environment: 0x461a858>attr(,"call")stepfun(1:3, y0, f = 0)> ls(envir = environment(sfun0))[1] "f" "method" "na.rm" "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.5f.f0 1.0 1.00 2 2.00 2.0 2.00 4 4.00 4.0 4.00 3 3.00 3.0f.f02 1.0 1.00 2 2.40 2.4 2.40 4 3.80 3.8 3.80 3 3.00 3.0f.f1 1.0 1.00 2 4.00 4.0 4.00 4 3.00 3.0 3.00 3 3.00 3.0f.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 = 7, 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 remainderMin. :-0.009939103 Min. :5.753541 Min. :-0.00225540511st Qu.:-0.004536535 1st Qu.:5.778556 1st Qu.:-0.0004586796Median : 0.000877761 Median :5.815125 Median :-0.0000088674Mean :-0.000001304 Mean :5.819267 Mean :-0.00000196553rd Qu.: 0.004997747 3rd Qu.:5.859806 3rd Qu.: 0.0004023465Max. : 0.009114691 Max. :5.898750 Max. : 0.0019396260IQR:STL.seasonal STL.trend STL.remainder data0.009534 0.081250 0.000861 0.079370% 12.0 102.4 1.1 100.0Weights: all == 1Other 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 remainderMin. :-446.8302 Min. :1318.650 Min. :-314.58351st Qu.:-301.5726 1st Qu.:1432.208 1st Qu.: -32.5392Median : -79.0561 Median :1448.891 Median : 5.7943Mean : 0.0000 Mean :1472.880 Mean : 23.06463rd Qu.: 304.5673 3rd Qu.:1548.974 3rd Qu.: 47.5134Max. : 544.7904 Max. :1615.535 Max. : 872.1992IQR:STL.seasonal STL.trend STL.remainder data606.14 116.77 80.05 707.75% 85.6 16.5 11.3 100.0Weights:Min. 1st Qu. Median Mean 3rd Qu. Max.0.0000 0.5594 0.9452 0.7312 0.9853 1.0000Other 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 SqN 2 1016.7 508.3P 2 917.4 458.7N:P 4 399.3 99.8>> # 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 SqN 2 1016.7 508.3N: L 1 1012.5 1012.5N: Q 1 4.2 4.2P 2 917.4 458.7P: L 1 917.3 917.3P: Q 1 0.0 0.0N:P 4 399.3 99.8N:P: L.L 1 184.1 184.1N:P: Q.L 1 152.1 152.1N:P: L.Q 1 49.0 49.0N:P: Q.Q 1 14.1 14.1>> # Split only the interaction> summary(CC.aov, split = list("N:P" = list(L.L = 1, Q = 2:4)))Df Sum Sq Mean SqN 2 1016.7 508.3P 2 917.4 458.7N:P 4 399.3 99.8N:P: L.L 1 184.1 184.1N:P: Q 3 215.2 71.7>> # split on just one var> summary(CC.aov, split = list(P = list(lin = 1, quad = 2)))Df Sum Sq Mean SqN 2 1016.7 508.3P 2 917.4 458.7P: lin 1 917.3 917.3P: quad 1 0.0 0.0N:P 4 399.3 99.8N:P: lin 2 336.2 168.1N:P: quad 2 63.1 31.5> summary(CC.aov, split = list(P = list(lin = 1, quad = 2)),+ expand.split = FALSE)Df Sum Sq Mean SqN 2 1016.7 508.3P 2 917.4 458.7P: lin 1 917.3 917.3P: quad 1 0.0 0.0N:P 4 399.3 99.8>>> 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 coefficientsgroupCtl groupTrt5.032 4.661> sld90 <- summary(lm.D90 <- lm(weight ~ group -1)) # omitting intercept> sld90Call:lm(formula = weight ~ group - 1)Residuals:Min 1Q Median 3Q Max-1.0710 -0.4938 0.0685 0.2462 1.3690Coefficients: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 ‘ ’ 1Residual standard error: 0.6964 on 18 degrees of freedomMultiple R-squared: 0.9818, Adjusted R-squared: 0.9798F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16> coef(sld90) # much moreEstimate Std. Error t value Pr(>|t|)groupCtl 5.032 0.2202177 22.85012 9.547128e-15groupTrt 4.661 0.2202177 21.16542 3.615345e-14>> ## model with *aliased* coefficient:> lm.D9. <- lm(weight ~ group + I(group != "Ctl"))> Sm.D9. <- summary(lm.D9.)> Sm.D9. # shows the NA NA NA NA lineCall:lm(formula = weight ~ group + I(group != "Ctl"))Residuals:Min 1Q Median 3Q Max-1.0710 -0.4938 0.0685 0.2462 1.3690Coefficients: (1 not defined because of singularities)Estimate Std. Error t value Pr(>|t|)(Intercept) 5.0320 0.2202 22.850 9.55e-15 ***groupTrt -0.3710 0.3114 -1.191 0.249I(group != "Ctl")TRUE NA NA NA NA---Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1Residual standard error: 0.6964 on 18 degrees of freedomMultiple R-squared: 0.07308, Adjusted R-squared: 0.02158F-statistic: 1.419 on 1 and 18 DF, p-value: 0.249> stopifnot(length(cc <- coef(lm.D9.)) == 3, is.na(cc[3]),+ dim(coef(Sm.D9.)) == c(2,4), Sm.D9.$df == c(2, 18, 3))>>>> 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>>> 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.4Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000> ## The signs of the loading columns are arbitrary> print(summary(princomp(USArrests, cor = TRUE),+ loadings = TRUE, cutoff = 0.2), digits = 2)Importance of components:Comp.1 Comp.2 Comp.3 Comp.4Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000Loadings:Comp.1 Comp.2 Comp.3 Comp.4Murder 0.54 0.42 0.34 0.65Assault 0.58 0.27 -0.74UrbanPop 0.28 -0.87 0.38Rape 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 <- setNames(0:8, 0:8)> 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. . . - - + + $ 8attr(,"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)AA AA AA A A AA AA A A AA A A AA A A A A A A AA AA A A AA A A AA A A A A A A AA A A AA A A A A A A AA A A A A A A AA A A A A A A A A A A A A A A AA AA A A AA A A AA A A A A A A AA A A AA A A A A A A AA A A A A A A AA A A A A A A A A A A A A A A AA A A AA A A A A A A AA A A A A A A AA A A A A A A A A A A A A A A AA A A A A A A AA A A A A A A A A A A A A A A AA A A A A A A A A A A A A A A AA A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A AA AA A A AA A A AA A A A A A A AA A A AA A A A A A A AA A A A A A A A>> ##-- Symbolic correlation matrices:> symnum(cor(attitude), diag = FALSE)rt cm p l rs cr aratingcomplaints +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 1complaints + 1privileges . . 1learning , . . 1raises . , . , 1critical . 1advance . . . 1attr(,"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 advancerating 1complaints + 1privileges . . 1learning , . . 1raises . , . , 1critical . 1advance . . . 1attr(,"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 adrating 1complaints + 1privileges . . 1learning , . . 1raises . , . , 1critical . 1advance . . . 1attr(,"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 1attr(,"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 , , 1attr(,"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,] . . * , . . . , , . . 1attr(,"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,] 1attr(,"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,] 1attr(,"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 = .00001855Welch Two Sample t-testdata: 1:10 and c(7:20)t = -5.4349, df = 21.982, p-value = 1.855e-05alternative hypothesis: true difference in means is not equal to 095 percent confidence interval:-11.052802 -4.947198sample estimates:mean of x mean of y5.5 13.5> t.test(1:10, y = c(7:20, 200)) # P = .1245 -- NOT significant anymoreWelch Two Sample t-testdata: 1:10 and c(7:20, 200)t = -1.6329, df = 14.165, p-value = 0.1245alternative hypothesis: true difference in means is not equal to 095 percent confidence interval:-47.242900 6.376233sample estimates:mean of x mean of y5.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-testdata: extra[group == 1] and extra[group == 2]t = -1.8608, df = 17.776, p-value = 0.07939alternative hypothesis: true difference in means is not equal to 095 percent confidence interval:-3.3654832 0.2054832sample estimates:mean of x mean of y0.75 2.33>> ## Formula interface> t.test(extra ~ group, data = sleep)Welch Two Sample t-testdata: extra by groupt = -1.8608, df = 17.776, p-value = 0.07939alternative hypothesis: true difference in means is not equal to 095 percent confidence interval:-3.3654832 0.2054832sample estimates:mean in group 1 mean in group 20.75 2.33>> ## Formula interface to one-sample test> t.test(extra ~ 1, data = sleep)One Sample t-testdata: extrat = 3.413, df = 19, p-value = 0.002918alternative hypothesis: true mean is not equal to 095 percent confidence interval:0.5955845 2.4844155sample estimates:mean of x1.54>> ## Formula interface to paired test> ## The sleep data are actually paired, so could have been in wide format:> sleep2 <- reshape(sleep, direction = "wide",+ idvar = "ID", timevar = "group")> t.test(Pair(extra.1, extra.2) ~ 1, data = sleep2)Paired t-testdata: Pair(extra.1, extra.2)t = -4.0621, df = 9, p-value = 0.002833alternative hypothesis: true difference in means is not equal to 095 percent confidence interval:-2.4598858 -0.7001142sample estimates:mean of the differences-1.58>>>> 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:zy 0 0 0x 1 0 2z 0 0 1s(x) 0 1 0attr(,"term.labels")[1] "x" "s(x)" "x:z"attr(,"specials")attr(,"specials")$s[1] 4attr(,"order")[1] 1 1 2attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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 0x 1 2 0z 0 1 0s(x) 0 0 1attr(,"term.labels")[1] "x" "x:z" "s(x)"attr(,"specials")attr(,"specials")$s[1] 4attr(,"order")[1] 1 2 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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 Qtr41945 1 2 3 41946 1 2 3 41947 1 2 3 41948 1 2 3 41949 1 2 3 41950 1 2 3 41951 1 2 3 41952 1 2 3 41953 1 2 3 41954 1 2 3 41955 1 2 3 41956 1 2 3 41957 1 2 3 41958 1 2 3 41959 1 2 3 41960 1 2 3 41961 1 2 3 41962 1 2 3 41963 1 2 3 41964 1 2 3 41965 1 2 3 41966 1 2 3 41967 1 2 3 41968 1 2 3 41969 1 2 3 41970 1 2 3 41971 1 2 3 41972 1 2 3 41973 1 2 3 41974 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 1959Qtr1 Qtr2 Qtr3 Qtr41959 1 2 31960 4 5 6 71961 8 9 10> print( ts(1:10, frequency = 7, start = c(12, 2)), calendar = TRUE)p1 p2 p3 p4 p5 p6 p712 1 2 3 4 5 613 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" "matrix"> head(z) # as "matrix"Series 1 Series 2 Series 3[1,] -0.62036668 0.4094018 0.8936737[2,] 0.04211587 1.6888733 -1.0472981[3,] -0.91092165 1.5865884 1.9713374[4,] 0.15802877 -0.3309078 -0.3836321[5,] -0.65458464 -2.2852355 1.6541453[6,] 1.76728727 2.4976616 1.5122127> plot(z)> plot(z, plot.type = "single", lty = 1:3)>> ## A phase plot:> plot(nhtemp, lag(nhtemp, 1), cex = .8, col = "blue",+ main = "Lag plot of New Haven temperatures")>>>> 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 fdeathsJan 1974 2134 901Feb 1974 1863 689Mar 1974 1877 827Apr 1974 1877 677May 1974 1492 522Jun 1974 1249 406Jul 1974 1280 441Aug 1974 1131 393Sep 1974 1209 387Oct 1974 1492 582Nov 1974 1621 578Dec 1974 1846 666Jan 1975 2103 830Feb 1975 2137 752Mar 1975 2153 785Apr 1975 1833 664May 1975 1403 467Jun 1975 1288 438Jul 1975 1186 421Aug 1975 1133 412Sep 1975 1053 343Oct 1975 1347 440Nov 1975 1545 531Dec 1975 2066 771Jan 1976 2020 767Feb 1976 2750 1141Mar 1976 2283 896Apr 1976 1479 532May 1976 1189 447Jun 1976 1160 420Jul 1976 1113 376Aug 1976 970 330Sep 1976 999 357Oct 1976 1208 445Nov 1976 1467 546Dec 1976 2059 764Jan 1977 2240 862Feb 1977 1634 660Mar 1977 1722 663Apr 1977 1801 643May 1977 1246 502Jun 1977 1162 392Jul 1977 1087 411Aug 1977 1013 348Sep 1977 959 387Oct 1977 1179 385Nov 1977 1229 411Dec 1977 1655 638Jan 1978 2019 796Feb 1978 2284 853Mar 1978 1942 737Apr 1978 1423 546May 1978 1340 530Jun 1978 1187 446Jul 1978 1098 431Aug 1978 1004 362Sep 1978 970 387Oct 1978 1140 430Nov 1978 1110 425Dec 1978 1812 679Jan 1979 2263 821Feb 1979 1820 785Mar 1979 1846 727Apr 1979 1531 612May 1979 1215 478Jun 1979 1075 429Jul 1979 1056 405Aug 1979 975 379Sep 1979 940 393Oct 1979 1081 411Nov 1979 1294 487Dec 1979 1341 574> cbind(mdeaths, fdeaths) # same as the previous linemdeaths fdeathsJan 1974 2134 901Feb 1974 1863 689Mar 1974 1877 827Apr 1974 1877 677May 1974 1492 522Jun 1974 1249 406Jul 1974 1280 441Aug 1974 1131 393Sep 1974 1209 387Oct 1974 1492 582Nov 1974 1621 578Dec 1974 1846 666Jan 1975 2103 830Feb 1975 2137 752Mar 1975 2153 785Apr 1975 1833 664May 1975 1403 467Jun 1975 1288 438Jul 1975 1186 421Aug 1975 1133 412Sep 1975 1053 343Oct 1975 1347 440Nov 1975 1545 531Dec 1975 2066 771Jan 1976 2020 767Feb 1976 2750 1141Mar 1976 2283 896Apr 1976 1479 532May 1976 1189 447Jun 1976 1160 420Jul 1976 1113 376Aug 1976 970 330Sep 1976 999 357Oct 1976 1208 445Nov 1976 1467 546Dec 1976 2059 764Jan 1977 2240 862Feb 1977 1634 660Mar 1977 1722 663Apr 1977 1801 643May 1977 1246 502Jun 1977 1162 392Jul 1977 1087 411Aug 1977 1013 348Sep 1977 959 387Oct 1977 1179 385Nov 1977 1229 411Dec 1977 1655 638Jan 1978 2019 796Feb 1978 2284 853Mar 1978 1942 737Apr 1978 1423 546May 1978 1340 530Jun 1978 1187 446Jul 1978 1098 431Aug 1978 1004 362Sep 1978 970 387Oct 1978 1140 430Nov 1978 1110 425Dec 1978 1812 679Jan 1979 2263 821Feb 1979 1820 785Mar 1979 1846 727Apr 1979 1531 612May 1979 1215 478Jun 1979 1075 429Jul 1979 1056 405Aug 1979 975 379Sep 1979 940 393Oct 1979 1081 411Nov 1979 1294 487Dec 1979 1341 574> ts.intersect(window(mdeaths, 1976), window(fdeaths, 1974, 1978))window(mdeaths, 1976) window(fdeaths, 1974, 1978)Jan 1976 2020 767Feb 1976 2750 1141Mar 1976 2283 896Apr 1976 1479 532May 1976 1189 447Jun 1976 1160 420Jul 1976 1113 376Aug 1976 970 330Sep 1976 999 357Oct 1976 1208 445Nov 1976 1467 546Dec 1976 2059 764Jan 1977 2240 862Feb 1977 1634 660Mar 1977 1722 663Apr 1977 1801 643May 1977 1246 502Jun 1977 1162 392Jul 1977 1087 411Aug 1977 1013 348Sep 1977 959 387Oct 1977 1179 385Nov 1977 1229 411Dec 1977 1655 638Jan 1978 2019 796>> sales1 <- ts.union(BJsales, lead = BJsales.lead)> ts.intersect(sales1, lead3 = lag(BJsales.lead, -3))Time Series:Start = 4End = 150Frequency = 1sales1.BJsales sales1.lead lead34 198.9 9.75 10.015 199.0 10.33 10.076 200.2 10.13 10.327 198.6 10.36 9.758 200.0 10.32 10.339 200.3 10.13 10.1310 201.2 10.16 10.3611 201.6 10.58 10.3212 201.5 10.62 10.1313 201.5 10.86 10.1614 203.5 11.20 10.5815 204.9 10.74 10.6216 207.1 10.56 10.8617 210.5 10.48 11.2018 210.5 10.77 10.7419 209.8 11.33 10.5620 208.8 10.96 10.4821 209.5 11.16 10.7722 213.2 11.70 11.3323 213.7 11.39 10.9624 215.1 11.42 11.1625 218.7 11.94 11.7026 219.8 11.24 11.3927 220.5 11.59 11.4228 223.8 10.96 11.9429 222.8 11.40 11.2430 223.8 11.02 11.5931 221.7 11.01 10.9632 222.3 11.23 11.4033 220.8 11.33 11.0234 219.4 10.83 11.0135 220.1 10.84 11.2336 220.6 11.14 11.3337 218.9 10.38 10.8338 217.8 10.90 10.8439 217.7 11.05 11.1440 215.0 11.11 10.3841 215.3 11.01 10.9042 215.9 11.22 11.0543 216.7 11.21 11.1144 216.7 11.91 11.0145 217.7 11.69 11.2246 218.7 10.93 11.2147 222.9 10.99 11.9148 224.9 11.01 11.6949 222.2 10.84 10.9350 220.7 10.76 10.9951 220.0 10.77 11.0152 218.7 10.88 10.8453 217.0 10.49 10.7654 215.9 10.50 10.7755 215.8 11.00 10.8856 214.1 10.98 10.4957 212.3 10.61 10.5058 213.9 10.48 11.0059 214.6 10.53 10.9860 213.6 11.07 10.6161 212.1 10.61 10.4862 211.4 10.86 10.5363 213.1 10.34 11.0764 212.9 10.78 10.6165 213.3 10.80 10.8666 211.5 10.33 10.3467 212.3 10.44 10.7868 213.0 10.50 10.8069 211.0 10.75 10.3370 210.7 10.40 10.4471 210.1 10.40 10.5072 211.4 10.34 10.7573 210.0 10.55 10.4074 209.7 10.46 10.4075 208.8 10.82 10.3476 208.8 10.91 10.5577 208.8 10.87 10.4678 210.6 10.67 10.8279 211.9 11.11 10.9180 212.8 10.88 10.8781 212.5 11.28 10.6782 214.8 11.27 11.1183 215.3 11.44 10.8884 217.5 11.52 11.2885 218.8 12.10 11.2786 220.7 11.83 11.4487 222.2 12.62 11.5288 226.7 12.41 12.1089 228.4 12.43 11.8390 233.2 12.73 12.6291 235.7 13.01 12.4192 237.1 12.74 12.4393 240.6 12.73 12.7394 243.8 12.76 13.0195 245.3 12.92 12.7496 246.0 12.64 12.7397 246.3 12.79 12.7698 247.7 13.05 12.9299 247.6 12.69 12.64100 247.8 13.01 12.79101 249.4 12.90 13.05102 249.0 13.12 12.69103 249.9 12.47 13.01104 250.5 12.47 12.90105 251.5 12.94 13.12106 249.0 13.10 12.47107 247.6 12.91 12.47108 248.8 13.39 12.94109 250.4 13.13 13.10110 250.7 13.34 12.91111 253.0 13.34 13.39112 253.7 13.14 13.13113 255.0 13.49 13.34114 256.2 13.87 13.34115 256.0 13.39 13.14116 257.4 13.59 13.49117 260.4 13.27 13.87118 260.0 13.70 13.39119 261.3 13.20 13.59120 260.4 13.32 13.27121 261.6 13.15 13.70122 260.8 13.30 13.20123 259.8 12.94 13.32124 259.0 13.29 13.15125 258.9 13.26 13.30126 257.4 13.08 12.94127 257.7 13.24 13.29128 257.9 13.31 13.26129 257.4 13.52 13.08130 257.3 13.02 13.24131 257.6 13.25 13.31132 258.9 13.12 13.52133 257.8 13.26 13.02134 257.7 13.11 13.25135 257.2 13.30 13.12136 257.5 13.06 13.26137 256.8 13.32 13.11138 257.5 13.10 13.30139 257.0 13.27 13.06140 257.6 13.64 13.32141 257.3 13.58 13.10142 257.5 13.87 13.27143 259.6 13.53 13.64144 261.1 13.41 13.58145 262.9 13.25 13.87146 263.3 13.50 13.53147 262.8 13.58 13.41148 261.8 13.51 13.25149 262.2 13.77 13.50150 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>>>> cleanEx()> nameEx("uniroot")> ### * uniroot>> flush(stderr()); flush(stdout())>> ### Name: uniroot> ### Title: One Dimensional Root (Zero) Finding> ### Aliases: uniroot> ### Keywords: optimize>> ### ** Examples>> ##--- uniroot() with new interval extension + checking features: -------------->> f1 <- function(x) (121 - x^2)/(x^2+1)> f2 <- function(x) exp(-x)*(x - 12)>> try(uniroot(f1, c(0,10)))Error in uniroot(f1, c(0, 10)) :f() values at end points not of opposite sign> try(uniroot(f2, c(0, 2)))Error in uniroot(f2, c(0, 2)) :f() values at end points not of opposite sign> ##--> error: f() .. end points not of opposite sign>> ## where as 'extendInt="yes"' simply first enlarges the search interval:> u1 <- uniroot(f1, c(0,10),extendInt="yes", trace=1)search in [0,10] ... extended to [-1.5e-05, 11.5] in 4 steps> u2 <- uniroot(f2, c(0,2), extendInt="yes", trace=2)search in [0,2].. modified lower,upper: ( -1e-06, 2.02).. modified lower,upper: ( -3e-06, 2.06).. modified lower,upper: ( -7e-06, 2.14).. modified lower,upper: ( -1.5e-05, 2.3).. modified lower,upper: ( -3.1e-05, 2.62).. modified lower,upper: ( -6.3e-05, 3.26).. modified lower,upper: ( -0.000127, 4.54).. modified lower,upper: ( -0.000255, 7.1).. modified lower,upper: ( -0.000511, 12.22)> stopifnot(all.equal(u1$root, 11, tolerance = 1e-5),+ all.equal(u2$root, 12, tolerance = 6e-6))>> ## The *danger* of interval extension:> ## No way to find a zero of a positive function, but> ## numerically, f(-|M|) becomes zero :> u3 <- uniroot(exp, c(0,2), extendInt="yes", trace=TRUE)search in [0,2] ... extended to [-1073.74, 2.14748e+07] in 30 steps>> ## Nonsense example (must give an error):> tools::assertCondition( uniroot(function(x) 1, 0:1, extendInt="yes"),+ "error", verbose=TRUE)assertCondition: caught “error”>> ## Convergence checking :> sinc <- function(x) ifelse(x == 0, 1, sin(x)/x)> curve(sinc, -6,18); abline(h=0,v=0, lty=3, col=adjustcolor("gray", 0.8))> ## Don't show:> tools::assertWarning(+ ## End(Don't show)+ uniroot(sinc, c(0,5), extendInt="yes", maxiter=4) #-> "just" a warning+ ## Don't show:+ , verbose=TRUE)Asserted warning: _NOT_ converged in 4 iterations> ## End(Don't show)>> ## now with check.conv=TRUE, must signal a convergence error :> ## Don't show:> tools::assertError(+ ## End(Don't show)+ uniroot(sinc, c(0,5), extendInt="yes", maxiter=4, check.conv=TRUE)+ ## Don't show:+ , verbose=TRUE)Asserted error: _NOT_ converged in 4 iterations> ## End(Don't show)>> ### Weibull cumulative hazard (example origin, Ravi Varadhan):> cumhaz <- function(t, a, b) b * (t/b)^a> froot <- function(x, u, a, b) cumhaz(x, a, b) - u>> n <- 1000> u <- -log(runif(n))> a <- 1/2> b <- 1> ## Find failure times> ru <- sapply(u, function(x)+ uniroot(froot, u=x, a=a, b=b, interval= c(1.e-14, 1e04),+ extendInt="yes")$root)> ru2 <- sapply(u, function(x)+ uniroot(froot, u=x, a=a, b=b, interval= c(0.01, 10),+ extendInt="yes")$root)> stopifnot(all.equal(ru, ru2, tolerance = 6e-6))>> r1 <- uniroot(froot, u= 0.99, a=a, b=b, interval= c(0.01, 10),+ extendInt="up")> stopifnot(all.equal(0.99, cumhaz(r1$root, a=a, b=b)))>> ## An error if 'extendInt' assumes "wrong zero-crossing direction":> ## Don't show:> tools::assertError(+ ## End(Don't show)+ uniroot(froot, u= 0.99, a=a, b=b, interval= c(0.1, 10), extendInt="down")+ ## Don't show:+ , verbose=TRUE)Asserted error: no sign change found in 1000 iterations> ## End(Don't show)>>>> cleanEx()> nameEx("update")> ### * update>> flush(stderr()); flush(stdout())>> ### Name: update> ### Title: Update and Re-fit a Model Call> ### Aliases: update update.default getCall getCall.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.D9Call:lm(formula = weight ~ group)Coefficients:(Intercept) groupTrt5.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.3690Coefficients: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 ‘ ’ 1Residual standard error: 0.6964 on 18 degrees of freedomMultiple R-squared: 0.9818, Adjusted R-squared: 0.9798F-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) group14.8465 -0.1855> getCall(lm.D90) # "through the origin"lm(formula = weight ~ group - 1)>> options(oldcon)>>>> base::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 + x2y ~ x + x2> update(y ~ x, log(.) ~ . ) #> log(y) ~ xlog(y) ~ x> update(. ~ u+v, res ~ . ) #> res ~ u + vres ~ u + v>>>> 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 variancesdata: x and yF = 2.6522, num df = 49, denom df = 29, p-value = 0.006232alternative hypothesis: true ratio of variances is not equal to 195 percent confidence interval:1.332510 4.989832sample estimates:ratio of variances2.652168> var.test(lm(x ~ 1), lm(y ~ 1)) # The same.F test to compare two variancesdata: lm(x ~ 1) and lm(y ~ 1)F = 2.6522, num df = 49, denom df = 29, p-value = 0.006232alternative hypothesis: true ratio of variances is not equal to 195 percent confidence interval:1.332510 4.989832sample estimates:ratio of variances2.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)$loadingsLoadings:Factor1 Factor2Fertility -0.650 0.398Agriculture -0.628 0.337Examination 0.681 -0.515Education 0.997Catholic -0.117 0.962Infant.Mortality 0.176Factor1 Factor2SS loadings 2.297 1.496Proportion Var 0.383 0.249Cumulative Var 0.383 0.632$rotmat[,1] [,2][1,] 0.999973881 -0.007227595[2,] 0.007227595 0.999973881> promax(loadings(fa))$loadingsLoadings:Factor1 Factor2Fertility -0.595 0.227Agriculture -0.599 0.160Examination 0.577 -0.360Education 1.192 0.363Catholic 0.326 1.147Infant.Mortality 0.180Factor1 Factor2SS loadings 2.574 1.686Proportion Var 0.429 0.281Cumulative 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>> ## following on from example(lm)> ## Don't show:> utils::example("lm", echo = FALSE)> ## End(Don't show)> 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.607719248 9 101.37406419 1.06675699 -1.45098819> weighted.residuals(lmxy, drop0 = FALSE)1 2 3 4 5 60.00000000 -0.15744267 -1.63534445 2.24282864 0.09895229 -2.415285597 8 9 100.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 exact testdata: x and yV = 40, p-value = 0.01953alternative hypothesis: true location shift is greater than 0> wilcox.test(y - x, alternative = "less") # The same.Wilcoxon signed rank exact testdata: y - xV = 5, p-value = 0.01953alternative hypothesis: true location is less than 0> wilcox.test(y - x, alternative = "less",+ exact = FALSE, correct = FALSE) # H&W large sampleWilcoxon signed rank testdata: y - xV = 5, p-value = 0.01908alternative hypothesis: true location is less than 0> # approximation>> ## Formula interface to one-sample and paired tests>> depression <- data.frame(first = x, second = y, change = y - x)> wilcox.test(change ~ 1, data = depression)Wilcoxon signed rank exact testdata: changeV = 5, p-value = 0.03906alternative hypothesis: true location is not equal to 0> wilcox.test(Pair(first, second) ~ 1, data = depression)Wilcoxon signed rank exact testdata: Pair(first, second)V = 40, p-value = 0.03906alternative hypothesis: true location shift is not equal to 0>> ## 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") # greaterWilcoxon rank sum exact testdata: x and yW = 35, p-value = 0.1272alternative hypothesis: true location shift is greater than 0> wilcox.test(x, y, alternative = "greater",+ exact = FALSE, correct = FALSE) # H&W large sampleWilcoxon rank sum testdata: x and yW = 35, p-value = 0.1103alternative hypothesis: true location shift is greater than 0> # approximation>> wilcox.test(rnorm(10), rnorm(10, 2), conf.int = TRUE)Wilcoxon rank sum exact testdata: rnorm(10) and rnorm(10, 2)W = 7, p-value = 0.0004871alternative hypothesis: true location shift is not equal to 095 percent confidence interval:-3.024352 -1.348555sample 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 tiesWilcoxon rank sum test with continuity correctiondata: Ozone by MonthW = 127.5, p-value = 0.0001208alternative hypothesis: true location shift is not equal to 0>> ## accuracy in ties determination via 'digits.rank':> wilcox.test( 4:2, 3:1, paired=TRUE) # Warning: cannot compute exact p-value with tiesWarning in wilcox.test.default(4:2, 3:1, paired = TRUE) :cannot compute exact p-value with tiesWilcoxon signed rank test with continuity correctiondata: 4:2 and 3:1V = 6, p-value = 0.1489alternative hypothesis: true location shift is not equal to 0> wilcox.test((4:2)/10, (3:1)/10, paired=TRUE) # no ties => *no* warningWilcoxon signed rank exact testdata: (4:2)/10 and (3:1)/10V = 6, p-value = 0.25alternative hypothesis: true location shift is not equal to 0> wilcox.test((4:2)/10, (3:1)/10, paired=TRUE, digits.rank = 9) # same ties as (4:2, 3:1)Warning in wilcox.test.default((4:2)/10, (3:1)/10, paired = TRUE, digits.rank = 9) :cannot compute exact p-value with tiesWilcoxon signed rank test with continuity correctiondata: (4:2)/10 and (3:1)/10V = 6, p-value = 0.1489alternative hypothesis: true location shift is not equal to 0>>>> cleanEx()> nameEx("window")> ### * window>> flush(stderr()); flush(stdout())>> ### Name: window> ### Title: Time (Series) Windows> ### Aliases: window window.default window.ts window<- window<-.ts> ### Keywords: ts>> ### ** Examples>> window(presidents, 1960, c(1969,4)) # values in the 1960'sQtr1 Qtr2 Qtr3 Qtr41960 71 62 61 571961 72 83 71 781962 79 71 62 741963 76 64 62 571964 80 73 69 691965 71 64 69 621966 63 46 56 441967 44 52 38 461968 36 49 35 441969 59 65 65 56> window(presidents, deltat = 1) # All Qtr1sTime Series:Start = 1945End = 1974Frequency = 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 Qtr3sTime Series:Start = 1945.5End = 1974.5Frequency = 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 Qtr41944 NA NA NA NA1945 NA 87 82 751946 63 50 43 321947 35 60 54 551948 36 39 NA NA1949 69 57 57 511950 45 37 46 391951 36 24 32 231952 25 32 NA 321953 59 74 75 601954 71 61 71 571955 71 68 79 731956 76 71 67 751957 79 62 63 571958 60 49 48 521959 57 62 61 661960 71 62 61 571961 72 83 71 781962 79 71 62 741963 76 64 62 571964 80 73 69 691965 71 64 69 621966 63 46 56 441967 44 52 38 461968 36 49 35 441969 59 65 65 561970 66 53 61 521971 51 48 54 491972 49 61 NA NA1973 68 44 40 271974 28 25 24 241975 NA NA NA NA1976 NA NA NA NA1977 NA NA NA NA1978 NA NA NA NA1979 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 warningWarning: extending time series when replacing values> window(pres, c(1945,4), c(1949,4), frequency = 1) <- 85:89> presQtr1 Qtr2 Qtr3 Qtr41944 0 0 0 01945 NA 60 70 851946 63 50 43 861947 35 60 54 871948 36 39 NA 881949 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, = ncasesalcgpagegp 0-39g/day 40-79 80-119 120+25-34 0 0 0 035-44 0 0 0 245-54 1 6 3 455-64 2 9 9 565-74 5 17 6 375+ 1 2 1 2, , tobgp = 10-19, = ncasesalcgpagegp 0-39g/day 40-79 80-119 120+25-34 0 0 0 135-44 1 3 0 045-54 0 4 6 355-64 3 6 8 665-74 4 3 4 175+ 2 1 1 1, , tobgp = 20-29, = ncasesalcgpagegp 0-39g/day 40-79 80-119 120+25-34 0 0 0 035-44 0 1 0 245-54 0 5 1 255-64 3 4 3 265-74 2 5 2 175+ 0 0 0 0, , tobgp = 30+, = ncasesalcgpagegp 0-39g/day 40-79 80-119 120+25-34 0 0 0 035-44 0 0 0 045-54 0 5 2 455-64 4 3 4 565-74 0 0 1 175+ 1 1 0 0, , tobgp = 0-9g/day, = ncontrolsalcgpagegp 0-39g/day 40-79 80-119 120+25-34 40 27 2 135-44 60 35 11 345-54 46 38 16 455-64 49 40 18 1065-74 48 34 13 475+ 18 5 1 2, , tobgp = 10-19, = ncontrolsalcgpagegp 0-39g/day 40-79 80-119 120+25-34 10 7 1 135-44 14 23 6 345-54 18 21 14 455-64 22 21 15 765-74 14 10 12 275+ 6 3 1 1, , tobgp = 20-29, = ncontrolsalcgpagegp 0-39g/day 40-79 80-119 120+25-34 6 4 0 135-44 7 14 2 445-54 10 15 5 355-64 12 17 6 365-74 7 9 3 175+ 0 3 0 0, , tobgp = 30+, = ncontrolsalcgpagegp 0-39g/day 40-79 80-119 120+25-34 5 7 2 235-44 8 8 1 045-54 4 7 4 455-64 6 6 4 665-74 2 0 1 175+ 3 1 0 0> ## Output is not really helpful ... flat tables are better:> ftable(xtabs(cbind(ncases, ncontrols) ~ ., data = esoph))ncases ncontrolsagegp alcgp tobgp25-34 0-39g/day 0-9g/day 0 4010-19 0 1020-29 0 630+ 0 540-79 0-9g/day 0 2710-19 0 720-29 0 430+ 0 780-119 0-9g/day 0 210-19 0 120-29 0 030+ 0 2120+ 0-9g/day 0 110-19 1 120-29 0 130+ 0 235-44 0-39g/day 0-9g/day 0 6010-19 1 1420-29 0 730+ 0 840-79 0-9g/day 0 3510-19 3 2320-29 1 1430+ 0 880-119 0-9g/day 0 1110-19 0 620-29 0 230+ 0 1120+ 0-9g/day 2 310-19 0 320-29 2 430+ 0 045-54 0-39g/day 0-9g/day 1 4610-19 0 1820-29 0 1030+ 0 440-79 0-9g/day 6 3810-19 4 2120-29 5 1530+ 5 780-119 0-9g/day 3 1610-19 6 1420-29 1 530+ 2 4120+ 0-9g/day 4 410-19 3 420-29 2 330+ 4 455-64 0-39g/day 0-9g/day 2 4910-19 3 2220-29 3 1230+ 4 640-79 0-9g/day 9 4010-19 6 2120-29 4 1730+ 3 680-119 0-9g/day 9 1810-19 8 1520-29 3 630+ 4 4120+ 0-9g/day 5 1010-19 6 720-29 2 330+ 5 665-74 0-39g/day 0-9g/day 5 4810-19 4 1420-29 2 730+ 0 240-79 0-9g/day 17 3410-19 3 1020-29 5 930+ 0 080-119 0-9g/day 6 1310-19 4 1220-29 2 330+ 1 1120+ 0-9g/day 3 410-19 1 220-29 1 130+ 1 175+ 0-39g/day 0-9g/day 1 1810-19 2 620-29 0 030+ 1 340-79 0-9g/day 2 510-19 1 320-29 0 330+ 1 180-119 0-9g/day 1 110-19 1 120-29 0 030+ 0 0120+ 0-9g/day 2 210-19 1 120-29 0 030+ 0 0> ## In particular if we have fewer factors ...> ftable(xtabs(cbind(ncases, ncontrols) ~ agegp, data = esoph))ncases ncontrolsagegp25-34 1 11635-44 9 19945-54 46 21355-64 76 24265-74 55 16175+ 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'.> DFAdmit Gender Dept Freq1 Admitted Male A 5122 Rejected Male A 3133 Admitted Female A 894 Rejected Female A 195 Admitted Male B 3536 Rejected Male B 2077 Admitted Female B 178 Rejected Female B 89 Admitted Male C 12010 Rejected Male C 20511 Admitted Female C 20212 Rejected Female C 39113 Admitted Male D 13814 Rejected Male D 27915 Admitted Female D 13116 Rejected Female D 24417 Admitted Male E 5318 Rejected Male E 13819 Admitted Female E 9420 Rejected Female E 29921 Admitted Male F 2222 Rejected Male F 35123 Admitted Female F 2424 Rejected Female F 317> ## Nice for taking margins ...> xtabs(Freq ~ Gender + Admit, DF)AdmitGender Admitted RejectedMale 1198 1493Female 557 1278> ## And for testing independence ...> summary(xtabs(Freq ~ ., DF))Call: xtabs(formula = Freq ~ ., data = DF)Number of cases in table: 4526Number of factors: 3Test for independence of all factors:Chisq = 2000.3, df = 16, p-value = 0>> ## with NA's> DN <- DF; DN[cbind(6:9, c(1:2,4,1))] <- NA; DNAdmit Gender Dept Freq1 Admitted Male A 5122 Rejected Male A 3133 Admitted Female A 894 Rejected Female A 195 Admitted Male B 3536 <NA> Male B 2077 Admitted <NA> B 178 Rejected Female B NA9 <NA> Male C 12010 Rejected Male C 20511 Admitted Female C 20212 Rejected Female C 39113 Admitted Male D 13814 Rejected Male D 27915 Admitted Female D 13116 Rejected Female D 24417 Admitted Male E 5318 Rejected Male E 13819 Admitted Female E 9420 Rejected Female E 29921 Admitted Male F 2222 Rejected Male F 35123 Admitted Female F 2424 Rejected Female F 317> tools::assertError(# 'na.fail' should fail :+ xtabs(Freq ~ Gender + Admit, DN, na.action=na.fail))> xtabs(Freq ~ Gender + Admit, DN)AdmitGender Admitted RejectedMale 1078 1286Female 540 1270> xtabs(Freq ~ Gender + Admit, DN, na.action = na.pass)AdmitGender Admitted RejectedMale 1078 1286Female 540> ## The Female:Rejected combination has NA 'Freq' (and NA prints 'invisibly' as "")> xtabs(Freq ~ Gender + Admit, DN, addNA = TRUE) # ==> count NAsAdmitGender Admitted Rejected <NA>Male 1078 1286 327Female 540 0<NA> 17 0 0>> ## Create a nice display for the warp break data.> warpbreaks$replicate <- rep_len(1:9, 54)> ftable(xtabs(breaks ~ wool + tension + replicate, data = warpbreaks))replicate 1 2 3 4 5 6 7 8 9wool tensionA L 26 30 54 25 70 52 51 26 67M 18 21 29 17 12 18 35 30 36H 36 21 24 18 10 43 28 15 26B L 27 14 29 19 29 31 41 20 44M 42 26 19 16 39 28 21 39 29H 20 21 24 17 13 15 15 16 28>> ### ---- Sparse Examples ---->>>>> cleanEx()> 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 ResidualsSum of Squares 450.667 1950.694 83.565 6747.889Deg. of Freedom 1 1 1 50Residual standard error: 11.617131 out of 5 effects not estimableEstimated 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.722Coefficients: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 ‘ ’ 1Residual standard error: 11.62 on 50 degrees of freedomMultiple R-squared: 0.2691, Adjusted R-squared: 0.2253F-statistic: 6.138 on 3 and 50 DF, p-value: 0.00123>>> # 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.0421Coefficients: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.73281agegp^4 0.06668 0.30776 0.217 0.82848agegp^5 -0.20288 0.19523 -1.039 0.29872C(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 freedomResidual deviance: 59.277 on 80 degrees of freedomAIC: 222.76Number of Fisher Scoring iterations: 6>>>> base::options(contrasts = c(unordered = "contr.treatment",ordered = "contr.poly"))> ### * <FOOTER>> ###> cleanEx()> options(digits = 7L)> base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")Time elapsed: 13.858 0.43 14.881 0 0> grDevices::dev.off()null device1> ###> ### Local variables: ***> ### mode: outline-minor ***> ### outline-regexp: "\\(> \\)?### [*]+" ***> ### End: ***> quit('no')