| |
| R version 3.6.2 Patched (2020-02-12 r77795) -- "Dark and Stormy Night" |
| Copyright (C) 2020 The R Foundation for Statistical Computing |
| Platform: 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 locale |
| |
| R is a collaborative project with many contributors. |
| Type 'contributors()' for more information and |
| 'citation()' on how to cite R or R packages in publications. |
| |
| Type 'demo()' for some demos, 'help()' for on-line help, or |
| 'help.start()' for an HTML browser interface to help. |
| Type 'q()' to quit R. |
| |
| > pkgname <- "stats" |
| > source(file.path(R.home("share"), "R", "examples-header.R")) |
| > options(warn = 1) |
| > library('stats') |
| > |
| > 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 AIC |
| lm1 7 326.0716 |
| lm2 6 325.2408 |
| > BIC(lm1, lm2) |
| df BIC |
| lm1 7 339.0226 |
| lm2 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 5 |
| 1.000000000 0.875000000 0.625000000 0.406250000 0.250000000 0.148437500 |
| 6 7 8 9 10 |
| 0.085937500 0.048828125 0.027343750 0.015136719 0.008300781 |
| > |
| > ## Example from Brockwell & Davis (1991, pp.92-4) |
| > ## answer: 2^(-n) * (32/3 + 8 * n) /(32/3) |
| > n <- 1:10 |
| > 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 5 |
| 1.000000000 0.875000000 0.625000000 0.406250000 0.250000000 0.148437500 |
| 6 7 8 9 10 |
| 0.085937500 0.048828125 0.027343750 0.015136719 0.008300781 |
| > 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 | 0000000000000000000000000000000000000013356778899 |
| 1 | 0001333456678888899 |
| 2 | 0011444467 |
| 3 | 00233345888 |
| 4 | 111246 |
| 5 | |
| 6 | |
| 7 | 178 |
| 8 | 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 11 |
| 5 3 3 1 2 2 0 1 0 1 1 1 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("HoltWinters") |
| > ### * HoltWinters |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: HoltWinters |
| > ### Title: Holt-Winters Filtering |
| > ### Aliases: HoltWinters print.HoltWinters residuals.HoltWinters |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > ## 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.51265 |
| beta : 0.0094977 |
| gamma: 0.47289 |
| |
| Coefficients: |
| [,1] |
| a 364.76162 |
| b 0.12474 |
| s1 0.22153 |
| s2 0.95528 |
| s3 1.59847 |
| s4 2.87580 |
| s5 3.28201 |
| s6 2.44070 |
| s7 0.89694 |
| s8 -1.37964 |
| s9 -3.41124 |
| s10 -3.25702 |
| s11 -1.91349 |
| s12 -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.27559 |
| beta : 0.032693 |
| gamma: 0.87073 |
| |
| Coefficients: |
| [,1] |
| a 469.32322 |
| b 3.02154 |
| s1 0.94646 |
| s2 0.88292 |
| s3 0.97174 |
| s4 1.03048 |
| s5 1.04769 |
| s6 1.18053 |
| s7 1.35908 |
| s8 1.33317 |
| s9 1.10834 |
| s10 0.98688 |
| s11 0.83613 |
| s12 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) |
| $pred |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1975 29.84194 34.41014 39.30815 43.02779 |
| 1976 46.18808 48.56947 50.44866 51.86064 |
| 1977 52.94295 53.75521 54.37019 54.83150 |
| |
| $se |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1975 9.00655 11.25606 13.43389 14.51516 |
| 1976 15.25538 15.65611 15.90158 16.03792 |
| 1977 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 0 |
| b 0 0 0 0 1 1 1 2 2 3 |
| c 3 2 1 0 2 1 0 1 0 0 |
| > round(apply(X, 2, function(x) dmultinom(x, prob = c(1,2,5))), 3) |
| [1] 0.244 0.146 0.029 0.002 0.293 0.117 0.012 0.117 0.023 0.016 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("NLSstAsymptotic") |
| > ### * NLSstAsymptotic |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: NLSstAsymptotic |
| > ### Title: Fit the Asymptotic Regression Model |
| > ### Aliases: NLSstAsymptotic NLSstAsymptotic.sortedXyData |
| > ### Keywords: manip |
| > |
| > ### ** Examples |
| > |
| > Lob.329 <- Loblolly[ Loblolly$Seed == "329", ] |
| > print(NLSstAsymptotic(sortedXyData(expression(age), |
| + expression(height), |
| + Lob.329)), digits = 3) |
| b0 b1 lrc |
| -8.25 102.38 -3.22 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("NLSstClosestX") |
| > ### * NLSstClosestX |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: NLSstClosestX |
| > ### Title: Inverse Interpolation |
| > ### Aliases: NLSstClosestX NLSstClosestX.sortedXyData |
| > ### Keywords: manip |
| > |
| > ### ** Examples |
| > |
| > DNase.2 <- DNase[ DNase$Run == "2", ] |
| > DN.srt <- sortedXyData(expression(log(conc)), expression(density), DNase.2) |
| > NLSstClosestX(DN.srt, 1.0) |
| [1] 0.9795406 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("NLSstLfAsymptote") |
| > ### * NLSstLfAsymptote |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: NLSstLfAsymptote |
| > ### Title: Horizontal Asymptote on the Left Side |
| > ### Aliases: NLSstLfAsymptote NLSstLfAsymptote.sortedXyData |
| > ### Keywords: manip |
| > |
| > ### ** Examples |
| > |
| > DNase.2 <- DNase[ DNase$Run == "2", ] |
| > DN.srt <- sortedXyData( expression(log(conc)), expression(density), DNase.2 ) |
| > NLSstLfAsymptote( DN.srt ) |
| [1] -0.1869375 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("NLSstRtAsymptote") |
| > ### * NLSstRtAsymptote |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: NLSstRtAsymptote |
| > ### Title: Horizontal Asymptote on the Right Side |
| > ### Aliases: NLSstRtAsymptote NLSstRtAsymptote.sortedXyData |
| > ### Keywords: manip |
| > |
| > ### ** Examples |
| > |
| > DNase.2 <- DNase[ DNase$Run == "2", ] |
| > DN.srt <- sortedXyData( expression(log(conc)), expression(density), DNase.2 ) |
| > NLSstRtAsymptote( DN.srt ) |
| [1] 2.157437 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("NegBinomial") |
| > ### * NegBinomial |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: NegBinomial |
| > ### Title: The Negative Binomial Distribution |
| > ### Aliases: NegBinomial dnbinom pnbinom qnbinom rnbinom |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > x <- 0:11 |
| > dnbinom(x, size = 1, prob = 1/2) * 2^(1 + x) # == 1 |
| [1] 1 1 1 1 1 1 1 1 1 1 1 1 |
| > 126 / dnbinom(0:8, size = 2, prob = 1/2) #- theoretically integer |
| [1] 504.0 504.0 672.0 1008.0 1612.8 2688.0 4608.0 8064.0 14336.0 |
| > |
| > |
| > x <- 0:15 |
| > size <- (1:20)/4 |
| > persp(x, size, dnb <- outer(x, size, function(x,s) dnbinom(x, s, prob = 0.4)), |
| + xlab = "x", ylab = "s", zlab = "density", theta = 150) |
| > title(tit <- "negative binomial density(x,s, pr = 0.4) vs. x & s") |
| > |
| > image (x, size, log10(dnb), main = paste("log [", tit, "]")) |
| > contour(x, size, log10(dnb), add = TRUE) |
| > |
| > ## Alternative parametrization |
| > x1 <- rnbinom(500, mu = 4, size = 1) |
| > x2 <- rnbinom(500, mu = 4, size = 10) |
| > x3 <- rnbinom(500, mu = 4, size = 100) |
| > h1 <- hist(x1, breaks = 20, plot = FALSE) |
| > h2 <- hist(x2, breaks = h1$breaks, plot = FALSE) |
| > h3 <- hist(x3, breaks = h1$breaks, plot = FALSE) |
| > barplot(rbind(h1$counts, h2$counts, h3$counts), |
| + beside = TRUE, col = c("red","blue","cyan"), |
| + names.arg = round(h1$breaks[-length(h1$breaks)])) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("Normal") |
| > ### * Normal |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: Normal |
| > ### Title: The Normal Distribution |
| > ### Aliases: Normal dnorm pnorm qnorm rnorm |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > dnorm(0) == 1/sqrt(2*pi) |
| [1] TRUE |
| > dnorm(1) == exp(-1/2)/sqrt(2*pi) |
| [1] TRUE |
| > dnorm(1) == 1/sqrt(2*pi*exp(1)) |
| [1] TRUE |
| > |
| > ## Using "log = TRUE" for an extended range : |
| > par(mfrow = c(2,1)) |
| > plot(function(x) dnorm(x, log = TRUE), -60, 50, |
| + main = "log { Normal density }") |
| > curve(log(dnorm(x)), add = TRUE, col = "red", lwd = 2) |
| > mtext("dnorm(x, log=TRUE)", adj = 0) |
| > mtext("log(dnorm(x))", col = "red", adj = 1) |
| > |
| > plot(function(x) pnorm(x, log.p = TRUE), -50, 10, |
| + main = "log { Normal Cumulative }") |
| > curve(log(pnorm(x)), add = TRUE, col = "red", lwd = 2) |
| > mtext("pnorm(x, log=TRUE)", adj = 0) |
| > mtext("log(pnorm(x))", col = "red", adj = 1) |
| > |
| > ## if you want the so-called 'error function' |
| > erf <- function(x) 2 * pnorm(x * sqrt(2)) - 1 |
| > ## (see Abramowitz and Stegun 29.2.29) |
| > ## and the so-called 'complementary error function' |
| > erfc <- function(x) 2 * pnorm(x * sqrt(2), lower = FALSE) |
| > ## and the inverses |
| > erfinv <- function (x) qnorm((1 + x)/2)/sqrt(2) |
| > erfcinv <- function (x) qnorm(x/2, lower = FALSE)/sqrt(2) |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("Poisson") |
| > ### * Poisson |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: Poisson |
| > ### Title: The Poisson Distribution |
| > ### Aliases: Poisson dpois ppois qpois rpois |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > -log(dpois(0:7, lambda = 1) * gamma(1+ 0:7)) # == 1 |
| [1] 1 1 1 1 1 1 1 1 |
| > Ni <- rpois(50, lambda = 4); table(factor(Ni, 0:max(Ni))) |
| |
| 0 1 2 3 4 5 6 7 8 9 10 |
| 1 2 7 9 8 13 5 4 0 0 1 |
| > |
| > 1 - ppois(10*(15:25), lambda = 100) # becomes 0 (cancellation) |
| [1] 1.233094e-06 1.261664e-08 7.085799e-11 2.252643e-13 4.440892e-16 |
| [6] 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 |
| [11] 0.000000e+00 |
| > ppois(10*(15:25), lambda = 100, lower.tail = FALSE) # no cancellation |
| [1] 1.233094e-06 1.261664e-08 7.085800e-11 2.253110e-13 4.174239e-16 |
| [6] 4.626179e-19 3.142097e-22 1.337219e-25 3.639328e-29 6.453883e-33 |
| [11] 7.587807e-37 |
| > |
| > par(mfrow = c(2, 1)) |
| > x <- seq(-0.01, 5, 0.01) |
| > plot(x, ppois(x, 1), type = "s", ylab = "F(x)", main = "Poisson(1) CDF") |
| > plot(x, pbinom(x, 100, 0.01), type = "s", ylab = "F(x)", |
| + main = "Binomial(100, 0.01) CDF") |
| > |
| > ## 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) |
| $SSD |
| cond |
| cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| deg0NA 29160 30600 26640 23760 32400 25560 |
| deg4NA 30600 66600 32400 7200 36000 30600 |
| deg8NA 26640 32400 56160 41040 57600 69840 |
| deg0NP 23760 7200 41040 70560 72000 63360 |
| deg4NP 32400 36000 57600 72000 108000 100800 |
| deg8NP 25560 30600 69840 63360 100800 122760 |
| |
| $call |
| lm(formula = reacttime ~ 1) |
| |
| $df |
| [1] 9 |
| |
| attr(,"class") |
| [1] "SSD" |
| > estVar(mlmfit) |
| cond |
| cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| deg0NA 3240 3400 2960 2640 3600 2840 |
| deg4NA 3400 7400 3600 800 4000 3400 |
| deg8NA 2960 3600 6240 4560 6400 7760 |
| deg0NP 2640 800 4560 7840 8000 7040 |
| deg4NP 3600 4000 6400 8000 12000 11200 |
| deg8NP 2840 3400 7760 7040 11200 13640 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("SSasymp") |
| > ### * SSasymp |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: SSasymp |
| > ### Title: Self-Starting Nls Asymptotic Regression Model |
| > ### Aliases: SSasymp |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > ## Don't show: |
| > options(show.nls.convergence=FALSE) |
| > ## End(Don't show) |
| > Lob.329 <- Loblolly[ Loblolly$Seed == "329", ] |
| > SSasymp( Lob.329$age, 100, -8.5, -3.2 ) # response only |
| [1] 3.988924 11.505611 27.822517 41.130854 51.985354 60.838463 |
| > 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.838463 |
| attr(,"gradient") |
| Asym resp0 lrc |
| [1,] 0.1151053 0.8848947 11.74087 |
| [2,] 0.1843835 0.8156165 18.03613 |
| [3,] 0.3347697 0.6652303 29.42113 |
| [4,] 0.4574272 0.5425728 35.99454 |
| [5,] 0.5574687 0.4425313 39.14366 |
| [6,] 0.6390642 0.3609358 39.90776 |
| > getInitial(height ~ SSasymp( age, Asym, resp0, lrc), data = Lob.329) |
| Asym resp0 lrc |
| 94.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 ‘ ’ 1 |
| |
| Residual 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.00000 |
| attr(,"gradient") |
| Asym lrc c0 |
| [1,] 0.6141911 1.175838e+01 -2.261227e-01 |
| [2,] 0.9108704 6.895531e+00 -5.223887e-02 |
| [3,] 0.9774346 2.737698e+00 -1.322559e-02 |
| [4,] 0.9963859 6.503026e-01 -2.118250e-03 |
| [5,] 0.9997683 6.204920e-02 -1.357751e-04 |
| [6,] 0.9999906 3.479529e-03 -5.505583e-06 |
| [7,] 1.0000000 1.369435e-05 -1.430967e-08 |
| > getInitial(uptake ~ SSasympOff(conc, Asym, lrc, c0), data = CO2.Qn1) |
| Asym lrc c0 |
| 38.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 ‘ ’ 1 |
| |
| Residual 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.06780767 |
| attr(,"gradient") |
| A1 lrc1 A2 lrc2 |
| [1,] 5.068347e-01 -1.033290e+00 0.9341363 -0.03818728 |
| [2,] 2.568814e-01 -1.047414e+00 0.8726106 -0.07134424 |
| [3,] 1.301964e-01 -7.962985e-01 0.8151372 -0.09996786 |
| [4,] 6.598804e-02 -5.381222e-01 0.7614492 -0.12451147 |
| [5,] 3.344502e-02 -3.409237e-01 0.7112973 -0.14538835 |
| [6,] 4.354421e-03 -7.101926e-02 0.5798049 -0.18961833 |
| [7,] 2.873397e-04 -7.029632e-03 0.4414920 -0.21657709 |
| [8,] 1.896098e-05 -6.184955e-04 0.3361737 -0.21988328 |
| [9,] 1.251198e-06 -5.101663e-05 0.2559792 -0.20928744 |
| [10,] 8.256409e-08 -4.039784e-06 0.1949152 -0.19123411 |
| [11,] 3.595188e-10 -2.345456e-08 0.1130128 -0.14783797 |
| > print(getInitial(conc ~ SSbiexp(time, A1, lrc1, A2, lrc2), data = Indo.1), |
| + digits = 5) |
| A1 lrc1 A2 lrc2 |
| 2.02928 0.57939 0.19155 -1.78778 |
| > ## Initial values are in fact the converged values |
| > fm1 <- nls(conc ~ SSbiexp(time, A1, lrc1, A2, lrc2), data = Indo.1) |
| > summary(fm1) |
| |
| Formula: conc ~ SSbiexp(time, A1, lrc1, A2, lrc2) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| A1 2.0293 0.1099 18.464 3.39e-07 *** |
| lrc1 0.5794 0.1247 4.648 0.00235 ** |
| A2 0.1915 0.1106 1.731 0.12698 |
| lrc2 -1.7878 0.7871 -2.271 0.05737 . |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.04103 on 7 degrees of freedom |
| |
| > |
| > ## 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.943593 |
| attr(,"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 ‘ ’ 1 |
| |
| Residual standard error: 0.732 on 8 degrees of freedom |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("SSfpl") |
| > ### * SSfpl |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: SSfpl |
| > ### Title: Self-Starting Nls Four-Parameter Logistic Model |
| > ### Aliases: SSfpl |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > Chick.1 <- ChickWeight[ChickWeight$Chick == 1, ] |
| > SSfpl(Chick.1$Time, 13, 368, 14, 6) # response only |
| [1] 44.38189 55.31704 69.39853 87.05603 108.47420 133.43149 161.18758 |
| [8] 190.50000 219.81242 247.56851 272.52580 283.70240 |
| > 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.70240 |
| attr(,"gradient") |
| A B xmid scal |
| [1,] 0.9116003 0.08839968 -4.767956 11.125231 |
| [2,] 0.8807971 0.11920292 -6.212120 12.424241 |
| [3,] 0.8411309 0.15886910 -7.906425 13.177374 |
| [4,] 0.7913915 0.20860853 -9.767885 13.023846 |
| [5,] 0.7310586 0.26894142 -11.632873 11.632873 |
| [6,] 0.6607564 0.33924363 -13.262646 8.841764 |
| [7,] 0.5825702 0.41742979 -14.388278 4.796093 |
| [8,] 0.5000000 0.50000000 -14.791667 0.000000 |
| [9,] 0.4174298 0.58257021 -14.388278 -4.796093 |
| [10,] 0.3392436 0.66075637 -13.262646 -8.841764 |
| [11,] 0.2689414 0.73105858 -11.632873 -11.632873 |
| [12,] 0.2374580 0.76254197 -10.713410 -12.498978 |
| > print(getInitial(weight ~ SSfpl(Time, A, B, xmid, scal), data = Chick.1), |
| + digits = 5) |
| A B xmid scal |
| 27.4532 348.9712 19.3905 6.6726 |
| > ## Initial values are in fact the converged values |
| > fm1 <- nls(weight ~ SSfpl(Time, A, B, xmid, scal), data = Chick.1) |
| > summary(fm1) |
| |
| Formula: weight ~ SSfpl(Time, A, B, xmid, scal) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| A 27.453 6.601 4.159 0.003169 ** |
| B 348.971 57.899 6.027 0.000314 *** |
| xmid 19.391 2.194 8.836 2.12e-05 *** |
| scal 6.673 1.002 6.662 0.000159 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 2.351 on 8 degrees of freedom |
| |
| > |
| > ## 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.76786902 |
| attr(,"gradient") |
| Asym b2 b3 |
| [1,] 0.001168287 -0.01543407 0.1531221 |
| [2,] 0.001168287 -0.01543407 0.1531221 |
| [3,] 0.016273900 -0.13112424 0.7036230 |
| [4,] 0.016273900 -0.13112424 0.7036230 |
| [5,] 0.040109031 -0.25238507 0.7795153 |
| [6,] 0.040109031 -0.25238507 0.7795153 |
| [7,] 0.081130585 -0.39869082 0.3233828 |
| [8,] 0.081130585 -0.39869082 0.3233828 |
| [9,] 0.140641716 -0.53975407 -0.7914802 |
| [10,] 0.140641716 -0.53975407 -0.7914802 |
| [11,] 0.216127067 -0.64777036 -2.4251586 |
| [12,] 0.216127067 -0.64777036 -2.4251586 |
| [13,] 0.302296311 -0.70757894 -4.2605728 |
| [14,] 0.302296311 -0.70757894 -4.2605728 |
| [15,] 0.392859783 -0.71814108 -5.9597255 |
| [16,] 0.392859783 -0.71814108 -5.9597255 |
| > print(getInitial(density ~ SSgompertz(log(conc), Asym, b2, b3), |
| + data = DNase.1), digits = 5) |
| Asym b2 b3 |
| 4.60333 2.27134 0.71647 |
| > ## Initial values are in fact the converged values |
| > fm1 <- nls(density ~ SSgompertz(log(conc), Asym, b2, b3), |
| + data = DNase.1) |
| > summary(fm1) |
| |
| Formula: density ~ SSgompertz(log(conc), Asym, b2, b3) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Asym 4.60333 0.65321 7.047 8.71e-06 *** |
| b2 2.27134 0.14373 15.803 7.24e-10 *** |
| b3 0.71647 0.02206 32.475 7.85e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.02684 on 13 degrees of freedom |
| |
| > 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.30435 |
| attr(,"gradient") |
| Vm K |
| [1,] 0.2857143 -816.3265 |
| [2,] 0.2857143 -816.3265 |
| [3,] 0.5454545 -991.7355 |
| [4,] 0.5454545 -991.7355 |
| [5,] 0.6875000 -859.3750 |
| [6,] 0.6875000 -859.3750 |
| [7,] 0.8148148 -603.5665 |
| [8,] 0.8148148 -603.5665 |
| [9,] 0.9180328 -300.9944 |
| [10,] 0.9180328 -300.9944 |
| [11,] 0.9565217 -166.3516 |
| [12,] 0.9565217 -166.3516 |
| > print(getInitial(rate ~ SSmicmen(conc, Vm, K), data = PurTrt), digits = 3) |
| Vm K |
| 212.6837 0.0641 |
| > ## Initial values are in fact the converged values |
| > fm1 <- nls(rate ~ SSmicmen(conc, Vm, K), data = PurTrt) |
| > summary(fm1) |
| |
| Formula: rate ~ SSmicmen(conc, Vm, K) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Vm 2.127e+02 6.947e+00 30.615 3.24e-11 *** |
| K 6.412e-02 8.281e-03 7.743 1.57e-05 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 10.93 on 10 degrees of freedom |
| |
| > ## Alternative call using the subset argument |
| > fm2 <- nls(rate ~ SSmicmen(conc, Vm, K), data = Puromycin, |
| + subset = state == "treated") |
| > summary(fm2) # 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 ‘ ’ 1 |
| |
| Residual 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.97023 |
| attr(,"gradient") |
| Asym Drop lrc pwr |
| [1,] 1 -0.9771469094 2.5978438 1.8006881 |
| [2,] 1 -0.8774136912 13.1957043 18.2931305 |
| [3,] 1 -0.6974125358 28.9032091 51.7875987 |
| [4,] 1 -0.4772166721 40.5993205 84.4239136 |
| [5,] 1 -0.2746244909 40.8147795 93.9795029 |
| [6,] 1 -0.1302099955 30.5264027 75.8552610 |
| [7,] 1 -0.0499319343 17.2098335 45.4177374 |
| [8,] 1 -0.0152244293 7.3268815 20.3144290 |
| [9,] 1 -0.0036328431 2.3469622 6.7835933 |
| [10,] 1 -0.0006683898 0.5619310 1.6833949 |
| [11,] 1 -0.0002589123 0.2459116 0.7486834 |
| > getInitial(weight ~ SSweibull(Time, Asym, Drop, lrc, pwr), data = Chick.6) |
| Asym Drop lrc pwr |
| 158.501204 110.997081 -5.993421 2.646141 |
| > ## Initial values are in fact the converged values |
| > fm1 <- nls(weight ~ SSweibull(Time, Asym, Drop, lrc, pwr), data = Chick.6) |
| > summary(fm1) |
| |
| Formula: weight ~ SSweibull(Time, Asym, Drop, lrc, pwr) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Asym 158.5012 1.1769 134.67 3.28e-13 *** |
| Drop 110.9971 2.6330 42.16 1.10e-09 *** |
| lrc -5.9934 0.3733 -16.05 8.83e-07 *** |
| pwr 2.6461 0.1613 16.41 7.62e-07 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 2.061 on 7 degrees of freedom |
| |
| > ## 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 epsilon |
| 0.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 epsilon |
| 0.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.936176 |
| final value -0.936176 |
| converged |
| |
| Call: |
| StructTS(x = log10(UKgas), type = "BSM", fixed = c(0.1, 0.001, NA, NA), optim.control = list(trace = TRUE)) |
| |
| Variances: |
| level slope seas epsilon |
| 0.1000000 0.0010000 0.0003012 0.0000000 |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("TDist") |
| > ### * TDist |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: TDist |
| > ### Title: The Student t Distribution |
| > ### Aliases: TDist dt pt qt rt |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > 1 - pt(1:5, df = 1) |
| [1] 0.25000000 0.14758362 0.10241638 0.07797913 0.06283296 |
| > qt(.975, df = c(1:10,20,50,100,1000)) |
| [1] 12.706205 4.302653 3.182446 2.776445 2.570582 2.446912 2.364624 |
| [8] 2.306004 2.262157 2.228139 2.085963 2.008559 1.983972 1.962339 |
| > |
| > tt <- seq(0, 10, len = 21) |
| > ncp <- seq(0, 6, len = 31) |
| > ptn <- outer(tt, ncp, function(t, d) pt(t, df = 3, ncp = d)) |
| > t.tit <- "Non-central t - Probabilities" |
| > image(tt, ncp, ptn, zlim = c(0,1), main = t.tit) |
| > persp(tt, ncp, ptn, zlim = 0:1, r = 2, phi = 20, theta = 200, main = t.tit, |
| + xlab = "t", ylab = "non-centrality parameter", |
| + zlab = "Pr(T <= t)") |
| > |
| > plot(function(x) dt(x, df = 3, ncp = 2), -3, 11, ylim = c(0, 0.32), |
| + main = "Non-central t - Density", yaxs = "i") |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("Tukey") |
| > ### * Tukey |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: Tukey |
| > ### Title: The Studentized Range Distribution |
| > ### Aliases: Tukey ptukey qtukey |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > if(interactive()) |
| + curve(ptukey(x, nm = 6, df = 5), from = -1, to = 8, n = 101) |
| > (ptt <- ptukey(0:10, 2, df = 5)) |
| [1] 0.0000000 0.4889159 0.7835628 0.9126407 0.9632574 0.9833586 0.9918510 |
| [8] 0.9957141 0.9976011 0.9985838 0.9991249 |
| > (qtt <- qtukey(.95, 2, df = 2:11)) |
| [1] 6.079637 4.500659 3.926503 3.635351 3.460456 3.344084 3.261182 3.199173 |
| [9] 3.151064 3.112663 |
| > ## The precision may be not much more than about 8 digits: |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("TukeyHSD") |
| > ### * TukeyHSD |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: TukeyHSD |
| > ### Title: Compute Tukey Honest Significant Differences |
| > ### Aliases: TukeyHSD |
| > ### 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 means |
| 95% family-wise confidence level |
| factor levels have been ordered |
| |
| Fit: aov(formula = breaks ~ wool + tension, data = warpbreaks) |
| |
| $tension |
| diff lwr upr p adj |
| M-H 4.722222 -4.6311985 14.07564 0.4474210 |
| L-H 14.722222 5.3688015 24.07564 0.0011218 |
| L-M 10.000000 0.6465793 19.35342 0.0336262 |
| |
| > plot(TukeyHSD(fm1, "tension")) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("Uniform") |
| > ### * Uniform |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: Uniform |
| > ### Title: The Uniform Distribution |
| > ### Aliases: Uniform dunif punif qunif runif |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > u <- runif(20) |
| > |
| > ## The following relations always hold : |
| > punif(u) == u |
| [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE |
| [16] TRUE TRUE TRUE TRUE TRUE |
| > dunif(u) == 1 |
| [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE |
| [16] TRUE TRUE TRUE TRUE TRUE |
| > |
| > var(runif(10000)) #- ~ = 1/12 = .08333 |
| [1] 0.08475621 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("Weibull") |
| > ### * Weibull |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: Weibull |
| > ### Title: The Weibull Distribution |
| > ### Aliases: Weibull dweibull pweibull qweibull rweibull |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > x <- c(0, rlnorm(50)) |
| > all.equal(dweibull(x, shape = 1), dexp(x)) |
| [1] TRUE |
| > all.equal(pweibull(x, shape = 1, scale = pi), pexp(x, rate = 1/pi)) |
| [1] TRUE |
| > ## Cumulative hazard H(): |
| > all.equal(pweibull(x, 2.5, pi, lower.tail = FALSE, log.p = TRUE), |
| + -(x/pi)^2.5, 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)))) |
| U |
| 0 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 |
| 1 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 values |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1945 NA 87 82 75 |
| 1946 63 50 43 32 |
| 1947 35 60 54 55 |
| 1948 36 39 NA NA |
| 1949 69 57 57 51 |
| 1950 45 37 46 39 |
| 1951 36 24 32 23 |
| 1952 25 32 NA 32 |
| 1953 59 74 75 60 |
| 1954 71 61 71 57 |
| 1955 71 68 79 73 |
| 1956 76 71 67 75 |
| 1957 79 62 63 57 |
| 1958 60 49 48 52 |
| 1959 57 62 61 66 |
| 1960 71 62 61 57 |
| 1961 72 83 71 78 |
| 1962 79 71 62 74 |
| 1963 76 64 62 57 |
| 1964 80 73 69 69 |
| 1965 71 64 69 62 |
| 1966 63 46 56 44 |
| 1967 44 52 38 46 |
| 1968 36 49 35 44 |
| 1969 59 65 65 56 |
| 1970 66 53 61 52 |
| 1971 51 48 54 49 |
| 1972 49 61 NA NA |
| 1973 68 44 40 27 |
| 1974 28 25 24 24 |
| > acf(presidents, na.action = na.pass) |
| > pacf(presidents, na.action = na.pass) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("acf2AR") |
| > ### * acf2AR |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: acf2AR |
| > ### Title: Compute an AR Process Exactly Fitting an ACF |
| > ### Aliases: acf2AR |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > (Acf <- ARMAacf(c(0.6, 0.3, -0.2))) |
| 0 1 2 3 |
| 1.0000000 0.6923077 0.5769231 0.3538462 |
| > acf2AR(Acf) |
| 1 2 3 |
| ar(1) 0.6923077 0.0000 0.0 |
| ar(2) 0.5625000 0.1875 0.0 |
| ar(3) 0.6000000 0.3000 -0.2 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("add1") |
| > ### * add1 |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: add1 |
| > ### Title: Add or Drop All Possible Single Terms to a Model |
| > ### Aliases: add1 add1.default add1.lm add1.glm drop1 drop1.default |
| > ### drop1.lm drop1.glm |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > ## Don't show: |
| > od <- options(digits = 5) |
| > ## End(Don't show) |
| > require(graphics); require(utils) |
| > ## following example(swiss) |
| > lm1 <- lm(Fertility ~ ., data = swiss) |
| > add1(lm1, ~ I(Education^2) + .^2) |
| Single term additions |
| |
| Model: |
| Fertility ~ Agriculture + Examination + Education + Catholic + |
| Infant.Mortality |
| Df Sum of Sq RSS AIC |
| <none> 2105 191 |
| I(Education^2) 1 11.8 2093 192 |
| Agriculture:Examination 1 10.7 2094 192 |
| Agriculture:Education 1 1.8 2103 193 |
| Agriculture:Catholic 1 75.0 2030 191 |
| Agriculture:Infant.Mortality 1 4.4 2101 193 |
| Examination:Education 1 48.7 2056 192 |
| Examination:Catholic 1 40.8 2064 192 |
| Examination:Infant.Mortality 1 65.9 2039 191 |
| Education:Catholic 1 278.2 1827 186 |
| Education:Infant.Mortality 1 93.0 2012 191 |
| Catholic:Infant.Mortality 1 2.4 2103 193 |
| > drop1(lm1, test = "F") # So called 'type II' anova |
| Single term deletions |
| |
| Model: |
| Fertility ~ Agriculture + Examination + Education + Catholic + |
| Infant.Mortality |
| Df Sum of Sq RSS AIC F value Pr(>F) |
| <none> 2105 191 |
| Agriculture 1 308 2413 195 5.99 0.0187 * |
| Examination 1 53 2158 190 1.03 0.3155 |
| Education 1 1163 3268 209 22.64 2.4e-05 *** |
| Catholic 1 448 2553 198 8.72 0.0052 ** |
| Infant.Mortality 1 409 2514 197 7.96 0.0073 ** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > |
| > ## following example(glm) |
| > ## Don't show: |
| > example(glm, echo = FALSE) |
| treatment outcome counts |
| 1 1 1 18 |
| 2 1 2 17 |
| 3 1 3 15 |
| 4 2 1 20 |
| 5 2 2 10 |
| 6 2 3 20 |
| 7 3 1 25 |
| 8 3 2 13 |
| 9 3 3 12 |
| > ## End(Don't show) |
| > drop1(glm.D93, test = "Chisq") |
| Single term deletions |
| |
| Model: |
| counts ~ outcome + treatment |
| Df Deviance AIC LRT Pr(>Chi) |
| <none> 5.13 56.8 |
| outcome 2 10.58 58.2 5.45 0.065 . |
| treatment 2 5.13 52.8 0.00 1.000 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > drop1(glm.D93, test = "F") |
| Warning in drop1.glm(glm.D93, test = "F") : |
| F test assumes 'quasipoisson' family |
| Single term deletions |
| |
| Model: |
| counts ~ outcome + treatment |
| Df Deviance AIC F value Pr(>F) |
| <none> 5.13 56.8 |
| outcome 2 10.58 58.2 2.13 0.23 |
| treatment 2 5.13 52.8 0.00 1.00 |
| > add1(glm.D93, scope = ~outcome*treatment, test = "Rao") ## Pearson Chi-square |
| Single term additions |
| |
| Model: |
| counts ~ outcome + treatment |
| Df Deviance AIC Rao score Pr(>Chi) |
| <none> 5.13 56.8 |
| outcome: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 = Black |
| |
| Bee |
| Aye Buzz Hum |
| Oui 7 4 |
| Si 5 7 |
| Yes 7 7 |
| |
| , , Sea = Dead |
| |
| Bee |
| Aye Buzz Hum |
| Oui 8 7 |
| Si 10 7 |
| Yes 10 3 |
| |
| , , Sea = Red |
| |
| Bee |
| Aye Buzz Hum |
| Oui 2 12 |
| Si 4 7 |
| Yes 8 7 |
| |
| , , Sea = White |
| |
| Bee |
| Aye Buzz Hum |
| Oui 7 12 |
| Si 13 10 |
| Yes 6 7 |
| |
| > addmargins(A) |
| , , Sea = Black |
| |
| Bee |
| Aye Buzz Hum Sum |
| Oui 7 4 11 |
| Si 5 7 12 |
| Yes 7 7 14 |
| Sum 19 18 37 |
| |
| , , Sea = Dead |
| |
| Bee |
| Aye Buzz Hum Sum |
| Oui 8 7 15 |
| Si 10 7 17 |
| Yes 10 3 13 |
| Sum 28 17 45 |
| |
| , , Sea = Red |
| |
| Bee |
| Aye Buzz Hum Sum |
| Oui 2 12 14 |
| Si 4 7 11 |
| Yes 8 7 15 |
| Sum 14 26 40 |
| |
| , , Sea = White |
| |
| Bee |
| Aye Buzz Hum Sum |
| Oui 7 12 19 |
| Si 13 10 23 |
| Yes 6 7 13 |
| Sum 26 29 55 |
| |
| , , Sea = Sum |
| |
| Bee |
| Aye Buzz Hum Sum |
| Oui 24 35 59 |
| Si 32 31 63 |
| Yes 31 24 55 |
| Sum 87 90 177 |
| |
| > ## Don't show: |
| > stopifnot(is.table(addmargins(A))) |
| > ## End(Don't show) |
| > ftable(A) |
| Sea Black Dead Red White |
| Aye Bee |
| Oui Buzz 7 8 2 7 |
| Hum 4 7 12 12 |
| Si Buzz 5 10 4 13 |
| Hum 7 7 7 10 |
| Yes Buzz 7 10 8 6 |
| Hum 7 3 7 7 |
| > ftable(addmargins(A)) |
| Sea Black Dead Red White Sum |
| Aye Bee |
| Oui Buzz 7 8 2 7 24 |
| Hum 4 7 12 12 35 |
| Sum 11 15 14 19 59 |
| Si Buzz 5 10 4 13 32 |
| Hum 7 7 7 10 31 |
| Sum 12 17 11 23 63 |
| Yes Buzz 7 10 8 6 31 |
| Hum 7 3 7 7 24 |
| Sum 14 13 15 13 55 |
| Sum Buzz 19 28 14 26 87 |
| Hum 18 17 26 29 90 |
| Sum 37 45 40 55 177 |
| > |
| > # Non-commutative functions - note differences between resulting tables: |
| > ftable(addmargins(A, c(1, 3), |
| + FUN = list(Sum = sum, list(Min = min, Max = max)))) |
| Margins computed over dimensions |
| in the following order: |
| 1: Aye |
| 2: Sea |
| Sea Black Dead Red White Min Max |
| Aye Bee |
| Oui Buzz 7 8 2 7 2 8 |
| Hum 4 7 12 12 4 12 |
| Si Buzz 5 10 4 13 4 13 |
| Hum 7 7 7 10 7 10 |
| Yes Buzz 7 10 8 6 6 10 |
| Hum 7 3 7 7 3 7 |
| Sum Buzz 19 28 14 26 14 28 |
| Hum 18 17 26 29 17 29 |
| > ftable(addmargins(A, c(3, 1), |
| + FUN = list(list(Min = min, Max = max), Sum = sum))) |
| Margins computed over dimensions |
| in the following order: |
| 1: Sea |
| 2: Aye |
| Sea Black Dead Red White Min Max |
| Aye Bee |
| Oui Buzz 7 8 2 7 2 8 |
| Hum 4 7 12 12 4 12 |
| Si Buzz 5 10 4 13 4 13 |
| Hum 7 7 7 10 7 10 |
| Yes Buzz 7 10 8 6 6 10 |
| Hum 7 3 7 7 3 7 |
| Sum Buzz 19 28 14 26 12 31 |
| Hum 18 17 26 29 14 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) |
| Bee |
| Sea Buzz Hum |
| Black 21.8 20.0 |
| Dead 32.2 18.9 |
| Red 16.1 28.9 |
| White 29.9 32.2 |
| All 100.0 100.0 |
| N 87.0 90.0 |
| > round(sweep(addmargins(B, 2, list(list(All = sum, N = sqsm))), 1, |
| + apply(B, 1, sum)/100, "/"), 1) |
| Bee |
| Sea Buzz Hum All N |
| Black 51.4 48.6 100.0 37.0 |
| Dead 62.2 37.8 100.0 45.0 |
| Red 35.0 65.0 100.0 40.0 |
| White 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 Total |
| Sea |
| Black 21.8 20.0 20.9 |
| Dead 32.2 18.9 25.4 |
| Red 16.1 28.9 22.6 |
| White 29.9 32.2 31.1 |
| All 100.0 100.0 100.0 |
| N 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 = ".") |
| y |
| x 1 2 3 4 5 6 7 Sum |
| 1 2 . . . 1 . . 3 |
| 2 2 1 . . . 1 . 4 |
| 3 . 1 . . 1 1 . 3 |
| 4 . . . . . . 1 1 |
| 5 1 . . 1 . . 1 3 |
| 6 . . 1 1 1 . . 3 |
| 7 . 1 . . 1 1 . 3 |
| Sum 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 Grad |
| 1 Northeast 5495.111 4570.222 1.000000 71.26444 4.722222 53.96667 |
| 2 South 4208.125 4011.938 1.737500 69.70625 10.581250 44.34375 |
| 3 North Central 4803.000 4611.083 0.700000 71.76667 5.275000 54.51667 |
| 4 West 2915.308 4702.615 1.023077 71.23462 7.215385 62.00000 |
| Frost Area |
| 1 132.7778 18141.00 |
| 2 64.6250 54605.12 |
| 3 138.8333 62652.00 |
| 4 102.1538 134463.00 |
| > |
| > ## Compute the averages according to region and the occurrence of more |
| > ## than 130 days of frost. |
| > aggregate(state.x77, |
| + list(Region = state.region, |
| + Cold = state.x77[,"Frost"] > 130), |
| + mean) |
| Region Cold Population Income Illiteracy Life Exp Murder |
| 1 Northeast FALSE 8802.8000 4780.400 1.1800000 71.12800 5.580000 |
| 2 South FALSE 4208.1250 4011.938 1.7375000 69.70625 10.581250 |
| 3 North Central FALSE 7233.8333 4633.333 0.7833333 70.95667 8.283333 |
| 4 West FALSE 4582.5714 4550.143 1.2571429 71.70000 6.828571 |
| 5 Northeast TRUE 1360.5000 4307.500 0.7750000 71.43500 3.650000 |
| 6 North Central TRUE 2372.1667 4588.833 0.6166667 72.57667 2.266667 |
| 7 West TRUE 970.1667 4880.500 0.7500000 70.69167 7.666667 |
| HS Grad Frost Area |
| 1 52.06000 110.6000 21838.60 |
| 2 44.34375 64.6250 54605.12 |
| 3 53.36667 120.0000 56736.50 |
| 4 60.11429 51.0000 91863.71 |
| 5 56.35000 160.5000 13519.00 |
| 6 55.66667 157.6667 68567.50 |
| 7 64.20000 161.8333 184162.17 |
| > ## (Note that no state in 'South' is THAT cold.) |
| > |
| > |
| > ## example with character variables and NAs |
| > testDF <- data.frame(v1 = c(1,3,5,7,8,3,5,NA,4,5,7,9), |
| + v2 = c(11,33,55,77,88,33,55,NA,44,55,77,99) ) |
| > by1 <- c("red", "blue", 1, 2, NA, "big", 1, 2, "red", 1, NA, 12) |
| > by2 <- c("wet", "dry", 99, 95, NA, "damp", 95, 99, "red", 99, NA, NA) |
| > aggregate(x = testDF, by = list(by1, by2), FUN = "mean") |
| Group.1 Group.2 v1 v2 |
| 1 1 95 5 55 |
| 2 2 95 7 77 |
| 3 1 99 5 55 |
| 4 2 99 NA NA |
| 5 big damp 3 33 |
| 6 blue dry 3 33 |
| 7 red red 4 44 |
| 8 red wet 1 11 |
| > |
| > # and if you want to treat NAs as a group |
| > fby1 <- factor(by1, exclude = "") |
| > fby2 <- factor(by2, exclude = "") |
| > aggregate(x = testDF, by = list(fby1, fby2), FUN = "mean") |
| Group.1 Group.2 v1 v2 |
| 1 1 95 5.0 55.0 |
| 2 2 95 7.0 77.0 |
| 3 1 99 5.0 55.0 |
| 4 2 99 NA NA |
| 5 big damp 3.0 33.0 |
| 6 blue dry 3.0 33.0 |
| 7 red red 4.0 44.0 |
| 8 red wet 1.0 11.0 |
| 9 12 <NA> 9.0 99.0 |
| 10 <NA> <NA> 7.5 82.5 |
| > |
| > |
| > ## Formulas, one ~ one, one ~ many, many ~ one, and many ~ many: |
| > aggregate(weight ~ feed, data = chickwts, mean) |
| feed weight |
| 1 casein 323.5833 |
| 2 horsebean 160.2000 |
| 3 linseed 218.7500 |
| 4 meatmeal 276.9091 |
| 5 soybean 246.4286 |
| 6 sunflower 328.9167 |
| > aggregate(breaks ~ wool + tension, data = warpbreaks, mean) |
| wool tension breaks |
| 1 A L 44.55556 |
| 2 B L 28.22222 |
| 3 A M 24.00000 |
| 4 B M 28.77778 |
| 5 A H 24.55556 |
| 6 B H 18.77778 |
| > aggregate(cbind(Ozone, Temp) ~ Month, data = airquality, mean) |
| Month Ozone Temp |
| 1 5 23.61538 66.73077 |
| 2 6 29.44444 78.22222 |
| 3 7 59.11538 83.88462 |
| 4 8 59.96154 83.96154 |
| 5 9 31.44828 76.89655 |
| > aggregate(cbind(ncases, ncontrols) ~ alcgp + tobgp, data = esoph, sum) |
| alcgp tobgp ncases ncontrols |
| 1 0-39g/day 0-9g/day 9 261 |
| 2 40-79 0-9g/day 34 179 |
| 3 80-119 0-9g/day 19 61 |
| 4 120+ 0-9g/day 16 24 |
| 5 0-39g/day 10-19 10 84 |
| 6 40-79 10-19 17 85 |
| 7 80-119 10-19 19 49 |
| 8 120+ 10-19 12 18 |
| 9 0-39g/day 20-29 5 42 |
| 10 40-79 20-29 15 62 |
| 11 80-119 20-29 6 16 |
| 12 120+ 20-29 7 12 |
| 13 0-39g/day 30+ 5 28 |
| 14 40-79 30+ 9 29 |
| 15 80-119 30+ 7 12 |
| 16 120+ 30+ 10 13 |
| > |
| > ## Dot notation: |
| > aggregate(. ~ Species, data = iris, mean) |
| Species Sepal.Length Sepal.Width Petal.Length Petal.Width |
| 1 setosa 5.006 3.428 1.462 0.246 |
| 2 versicolor 5.936 2.770 4.260 1.326 |
| 3 virginica 6.588 2.974 5.552 2.026 |
| > aggregate(len ~ ., data = ToothGrowth, mean) |
| supp dose len |
| 1 OJ 0.5 13.23 |
| 2 VC 0.5 7.98 |
| 3 OJ 1.0 22.70 |
| 4 VC 1.0 16.77 |
| 5 OJ 2.0 26.06 |
| 6 VC 2.0 26.14 |
| > |
| > ## Often followed by xtabs(): |
| > ag <- aggregate(len ~ ., data = ToothGrowth, mean) |
| > xtabs(len ~ ., data = ag) |
| dose |
| supp 0.5 1 2 |
| OJ 13.23 22.70 26.06 |
| VC 7.98 16.77 26.14 |
| > |
| > |
| > ## Compute the average annual approval ratings for American presidents. |
| > aggregate(presidents, nfrequency = 1, FUN = mean) |
| Time Series: |
| Start = 1945 |
| End = 1974 |
| Frequency = 1 |
| [1] NA 47.00 51.00 NA 58.50 41.75 28.75 NA 67.00 65.00 72.75 72.25 |
| [13] 65.25 52.25 61.50 62.75 76.00 71.50 64.75 72.75 66.50 52.25 45.00 41.00 |
| [25] 61.25 58.00 50.50 NA 44.75 25.25 |
| > ## Give the summer less weight. |
| > aggregate(presidents, nfrequency = 1, |
| + FUN = weighted.mean, w = c(1, 1, 0.5, 1)) |
| Time Series: |
| Start = 1945 |
| End = 1974 |
| Frequency = 1 |
| [1] NA 47.57143 50.57143 NA 58.71429 41.14286 28.28571 NA |
| [9] 65.85714 64.14286 71.85714 73.00000 65.57143 52.85714 61.57143 63.00000 |
| [17] 76.71429 72.85714 65.14286 73.28571 66.14286 51.71429 46.00000 41.85714 |
| [25] 60.71429 57.57143 50.00000 NA 45.42857 25.42857 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("alias") |
| > ### * alias |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: alias |
| > ### Title: Find Aliases (Dependencies) in a Model |
| > ### Aliases: alias alias.formula alias.lm |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > |
| > 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) |
| treatment outcome counts |
| 1 1 1 18 |
| 2 1 2 17 |
| 3 1 3 15 |
| 4 2 1 20 |
| 5 2 2 10 |
| 6 2 3 20 |
| 7 3 1 25 |
| 8 3 2 13 |
| 9 3 3 12 |
| > ## End(Don't show) |
| > anova(glm.D93) |
| Analysis of Deviance Table |
| |
| Model: poisson, link: log |
| |
| Response: counts |
| |
| Terms added sequentially (first to last) |
| |
| |
| Df Deviance Resid. Df Resid. Dev |
| NULL 8 10.5814 |
| outcome 2 5.4523 6 5.1291 |
| treatment 2 0.0000 4 5.1291 |
| > anova(glm.D93, test = "Cp") |
| Analysis of Deviance Table |
| |
| Model: poisson, link: log |
| |
| Response: counts |
| |
| Terms added sequentially (first to last) |
| |
| |
| Df Deviance Resid. Df Resid. Dev Cp |
| NULL 8 10.5814 12.581 |
| outcome 2 5.4523 6 5.1291 11.129 |
| treatment 2 0.0000 4 5.1291 15.129 |
| > anova(glm.D93, test = "Chisq") |
| Analysis of Deviance Table |
| |
| Model: poisson, link: log |
| |
| Response: counts |
| |
| Terms added sequentially (first to last) |
| |
| |
| Df Deviance Resid. Df Resid. Dev Pr(>Chi) |
| NULL 8 10.5814 |
| outcome 2 5.4523 6 5.1291 0.06547 . |
| treatment 2 0.0000 4 5.1291 1.00000 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > glm.D93a <- |
| + update(glm.D93, ~treatment*outcome) # equivalent to Pearson Chi-square |
| > anova(glm.D93, glm.D93a, test = "Rao") |
| Analysis of Deviance Table |
| |
| Model 1: counts ~ outcome + treatment |
| Model 2: counts ~ treatment + outcome + treatment:outcome |
| Resid. Df Resid. Dev Df Deviance Rao Pr(>Chi) |
| 1 4 5.1291 |
| 2 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 Table |
| |
| Response: sr |
| Df Sum Sq Mean Sq F value Pr(>F) |
| pop15 1 204.12 204.118 14.1157 0.0004922 *** |
| pop75 1 53.34 53.343 3.6889 0.0611255 . |
| dpi 1 12.40 12.401 0.8576 0.3593551 |
| ddpi 1 63.05 63.054 4.3605 0.0424711 * |
| Residuals 45 650.71 14.460 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > |
| > ## same effect via separate models |
| > fit0 <- lm(sr ~ 1, data = LifeCycleSavings) |
| > fit1 <- update(fit0, . ~ . + pop15) |
| > fit2 <- update(fit1, . ~ . + pop75) |
| > fit3 <- update(fit2, . ~ . + dpi) |
| > fit4 <- update(fit3, . ~ . + ddpi) |
| > anova(fit0, fit1, fit2, fit3, fit4, test = "F") |
| Analysis of Variance Table |
| |
| Model 1: sr ~ 1 |
| Model 2: sr ~ pop15 |
| Model 3: sr ~ pop15 + pop75 |
| Model 4: sr ~ pop15 + pop75 + dpi |
| Model 5: sr ~ pop15 + pop75 + dpi + ddpi |
| Res.Df RSS Df Sum of Sq F Pr(>F) |
| 1 49 983.63 |
| 2 48 779.51 1 204.118 14.1157 0.0004922 *** |
| 3 47 726.17 1 53.343 3.6889 0.0611255 . |
| 4 46 713.77 1 12.401 0.8576 0.3593551 |
| 5 45 650.71 1 63.054 4.3605 0.0424711 * |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > |
| > anova(fit4, fit2, fit0, test = "F") # unconventional order |
| Analysis of Variance Table |
| |
| Model 1: sr ~ pop15 + pop75 + dpi + ddpi |
| Model 2: sr ~ pop15 + pop75 |
| Model 3: sr ~ 1 |
| Res.Df RSS Df Sum of Sq F Pr(>F) |
| 1 45 650.71 |
| 2 47 726.17 -2 -75.455 2.6090 0.0847088 . |
| 3 49 983.63 -2 -257.460 8.9023 0.0005527 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("anova.mlm") |
| > ### * anova.mlm |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: anova.mlm |
| > ### Title: Comparisons between Multivariate Linear Models |
| > ### Aliases: anova.mlm |
| > ### Keywords: regression models multivariate |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > utils::example(SSD) # Brings in the mlmfit and reacttime objects |
| |
| SSD> # Lifted from Baron+Li: |
| SSD> # "Notes on the use of R for psychology experiments and questionnaires" |
| SSD> # Maxwell and Delaney, p. 497 |
| SSD> reacttime <- matrix(c( |
| SSD+ 420, 420, 480, 480, 600, 780, |
| SSD+ 420, 480, 480, 360, 480, 600, |
| SSD+ 480, 480, 540, 660, 780, 780, |
| SSD+ 420, 540, 540, 480, 780, 900, |
| SSD+ 540, 660, 540, 480, 660, 720, |
| SSD+ 360, 420, 360, 360, 480, 540, |
| SSD+ 480, 480, 600, 540, 720, 840, |
| SSD+ 480, 600, 660, 540, 720, 900, |
| SSD+ 540, 600, 540, 480, 720, 780, |
| SSD+ 480, 420, 540, 540, 660, 780), |
| SSD+ ncol = 6, byrow = TRUE, |
| SSD+ dimnames = list(subj = 1:10, |
| SSD+ cond = c("deg0NA", "deg4NA", "deg8NA", |
| SSD+ "deg0NP", "deg4NP", "deg8NP"))) |
| |
| SSD> mlmfit <- lm(reacttime ~ 1) |
| |
| SSD> SSD(mlmfit) |
| $SSD |
| cond |
| cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| deg0NA 29160 30600 26640 23760 32400 25560 |
| deg4NA 30600 66600 32400 7200 36000 30600 |
| deg8NA 26640 32400 56160 41040 57600 69840 |
| deg0NP 23760 7200 41040 70560 72000 63360 |
| deg4NP 32400 36000 57600 72000 108000 100800 |
| deg8NP 25560 30600 69840 63360 100800 122760 |
| |
| $call |
| lm(formula = reacttime ~ 1) |
| |
| $df |
| [1] 9 |
| |
| attr(,"class") |
| [1] "SSD" |
| |
| SSD> estVar(mlmfit) |
| cond |
| cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| deg0NA 3240 3400 2960 2640 3600 2840 |
| deg4NA 3400 7400 3600 800 4000 3400 |
| deg8NA 2960 3600 6240 4560 6400 7760 |
| deg0NP 2640 800 4560 7840 8000 7040 |
| deg4NP 3600 4000 6400 8000 12000 11200 |
| deg8NP 2840 3400 7760 7040 11200 13640 |
| > |
| > mlmfit0 <- update(mlmfit, ~0) |
| > |
| > ### Traditional tests of intrasubj. contrasts |
| > ## Using MANOVA techniques on contrasts: |
| > anova(mlmfit, mlmfit0, X = ~1) |
| Analysis of Variance Table |
| |
| Model 1: reacttime ~ 1 |
| Model 2: reacttime ~ 1 - 1 |
| |
| Contrasts orthogonal to |
| ~1 |
| |
| Res.Df Df Gen.var. Pillai approx F num Df den Df Pr(>F) |
| 1 9 1249.6 |
| 2 10 1 2013.2 0.9456 17.381 5 5 0.003534 ** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > |
| > ## Assuming sphericity |
| > anova(mlmfit, mlmfit0, X = ~1, test = "Spherical") |
| Analysis of Variance Table |
| |
| Model 1: reacttime ~ 1 |
| Model 2: reacttime ~ 1 - 1 |
| |
| Contrasts orthogonal to |
| ~1 |
| |
| Greenhouse-Geisser epsilon: 0.4855 |
| Huynh-Feldt epsilon: 0.6778 |
| |
| Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr |
| 1 9 1249.6 |
| 2 10 1 2013.2 38.028 5 45 4.4711e-15 2.532e-08 7.393e-11 |
| > |
| > |
| > ### tests using intra-subject 3x2 design |
| > idata <- data.frame(deg = gl(3, 1, 6, labels = c(0, 4, 8)), |
| + noise = gl(2, 3, 6, labels = c("A", "P"))) |
| > |
| > anova(mlmfit, mlmfit0, X = ~ deg + noise, |
| + idata = idata, test = "Spherical") |
| Analysis of Variance Table |
| |
| Model 1: reacttime ~ 1 |
| Model 2: reacttime ~ 1 - 1 |
| |
| Contrasts orthogonal to |
| ~deg + noise |
| |
| Greenhouse-Geisser epsilon: 0.904 |
| Huynh-Feldt epsilon: 1.118 |
| |
| Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr |
| 1 9 316.58 |
| 2 10 1 996.34 45.31 2 18 9.4241e-08 3.4539e-07 9.4241e-08 |
| > anova(mlmfit, mlmfit0, M = ~ deg + noise, X = ~ noise, |
| + idata = idata, test = "Spherical" ) |
| Analysis of Variance Table |
| |
| Model 1: reacttime ~ 1 |
| Model 2: reacttime ~ 1 - 1 |
| |
| Contrasts orthogonal to |
| ~noise |
| |
| |
| Contrasts spanned by |
| ~deg + noise |
| |
| Greenhouse-Geisser epsilon: 0.9616 |
| Huynh-Feldt epsilon: 1.2176 |
| |
| Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr |
| 1 9 1007.0 |
| 2 10 1 2703.2 40.719 2 18 2.0868e-07 3.4017e-07 2.0868e-07 |
| > anova(mlmfit, mlmfit0, M = ~ deg + noise, X = ~ deg, |
| + idata = idata, test = "Spherical" ) |
| Analysis of Variance Table |
| |
| Model 1: reacttime ~ 1 |
| Model 2: reacttime ~ 1 - 1 |
| |
| Contrasts orthogonal to |
| ~deg |
| |
| |
| Contrasts spanned by |
| ~deg + noise |
| |
| Greenhouse-Geisser epsilon: 1 |
| Huynh-Feldt epsilon: 1 |
| |
| Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr |
| 1 9 1410 |
| 2 10 1 6030 33.766 1 9 0.00025597 0.00025597 0.00025597 |
| > |
| > f <- factor(rep(1:2, 5)) # bogus, just for illustration |
| > mlmfit2 <- update(mlmfit, ~f) |
| > anova(mlmfit2, mlmfit, mlmfit0, X = ~1, test = "Spherical") |
| Analysis of Variance Table |
| |
| Model 1: reacttime ~ f |
| Model 2: reacttime ~ 1 |
| Model 3: reacttime ~ 1 - 1 |
| |
| Contrasts orthogonal to |
| ~1 |
| |
| Greenhouse-Geisser epsilon: 0.4691 |
| Huynh-Feldt epsilon: 0.6758 |
| |
| Res.Df Df Gen.var. F num Df den Df Pr(>F) G-G Pr H-F Pr |
| 1 8 1337.3 |
| 2 9 1 1249.6 0.2743 5 40 0.92452 0.79608 0.86456 |
| 3 10 1 2013.2 34.9615 5 40 0.00000 0.00000 0.00000 |
| > anova(mlmfit2, X = ~1, test = "Spherical") |
| Analysis of Variance Table |
| |
| |
| Contrasts orthogonal to |
| ~1 |
| |
| Greenhouse-Geisser epsilon: 0.4691 |
| Huynh-Feldt epsilon: 0.6758 |
| |
| Df F num Df den Df Pr(>F) G-G Pr H-F Pr |
| (Intercept) 1 34.9615 5 40 0.00000 0.00000 0.00000 |
| f 1 0.2743 5 40 0.92452 0.79608 0.86456 |
| Residuals 8 |
| > # one-model form, eqiv. to previous |
| > |
| > ### There seems to be a strong interaction in these data |
| > plot(colMeans(reacttime)) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("ansari.test") |
| > ### * ansari.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ansari.test |
| > ### Title: Ansari-Bradley Test |
| > ### Aliases: ansari.test ansari.test.default ansari.test.formula |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > ## Hollander & Wolfe (1973, p. 86f): |
| > ## Serum iron determination using Hyland control sera |
| > ramsay <- c(111, 107, 100, 99, 102, 106, 109, 108, 104, 99, |
| + 101, 96, 97, 102, 107, 113, 116, 113, 110, 98) |
| > jung.parekh <- c(107, 108, 106, 98, 105, 103, 110, 105, 104, |
| + 100, 96, 108, 103, 104, 114, 114, 113, 108, 106, 99) |
| > ansari.test(ramsay, jung.parekh) |
| Warning in ansari.test.default(ramsay, jung.parekh) : |
| cannot compute exact p-value with ties |
| |
| Ansari-Bradley test |
| |
| data: ramsay and jung.parekh |
| AB = 185.5, p-value = 0.1815 |
| alternative hypothesis: true ratio of scales is not equal to 1 |
| |
| > |
| > ansari.test(rnorm(10), rnorm(10, 0, 2), conf.int = TRUE) |
| |
| Ansari-Bradley test |
| |
| data: rnorm(10) and rnorm(10, 0, 2) |
| AB = 69, p-value = 0.03831 |
| alternative hypothesis: true ratio of scales is not equal to 1 |
| 95 percent confidence interval: |
| 0.1852324 0.9712857 |
| sample estimates: |
| ratio of scales |
| 0.4007458 |
| |
| > |
| > ## try more points - failed in 2.4.1 |
| > ansari.test(rnorm(100), rnorm(100, 0, 2), conf.int = TRUE) |
| |
| Ansari-Bradley test |
| |
| data: rnorm(100) and rnorm(100, 0, 2) |
| AB = 6180, p-value = 3.347e-08 |
| alternative hypothesis: true ratio of scales is not equal to 1 |
| 95 percent confidence interval: |
| 0.3330596 0.5693532 |
| sample estimates: |
| ratio of scales |
| 0.4346784 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("aov") |
| > ### * aov |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: aov |
| > ### Title: Fit an Analysis of Variance Model |
| > ### Aliases: aov print.aov print.aovlist Error |
| > ### Keywords: models regression |
| > |
| > ### ** Examples |
| > |
| > ## From Venables and Ripley (2002) p.165. |
| > |
| > ## Set orthogonal contrasts. |
| > op <- options(contrasts = c("contr.helmert", "contr.poly")) |
| > ( npk.aov <- aov(yield ~ block + N*P*K, npk) ) |
| Call: |
| aov(formula = yield ~ block + N * P * K, data = npk) |
| |
| Terms: |
| block N P K N:P N:K P:K |
| Sum of Squares 343.2950 189.2817 8.4017 95.2017 21.2817 33.1350 0.4817 |
| Deg. of Freedom 5 1 1 1 1 1 1 |
| Residuals |
| Sum of Squares 185.2867 |
| Deg. of Freedom 12 |
| |
| Residual standard error: 3.929447 |
| 1 out of 13 effects not estimable |
| Estimated effects are balanced |
| > coefficients(npk.aov) |
| (Intercept) block1 block2 block3 block4 block5 |
| 54.8750000 1.7125000 1.6791667 -1.8229167 -1.0137500 0.2950000 |
| N1 P1 K1 N1:P1 N1:K1 P1:K1 |
| 2.8083333 -0.5916667 -1.9916667 -0.9416667 -1.1750000 0.1416667 |
| > |
| > ## to show the effects of re-ordering terms contrast the two fits |
| > aov(yield ~ block + N * P + K, npk) |
| Call: |
| aov(formula = yield ~ block + N * P + K, data = npk) |
| |
| Terms: |
| block N P K N:P Residuals |
| Sum of Squares 343.2950 189.2817 8.4017 95.2017 21.2817 218.9033 |
| Deg. of Freedom 5 1 1 1 1 14 |
| |
| Residual standard error: 3.954232 |
| Estimated effects are balanced |
| > aov(terms(yield ~ block + N * P + K, keep.order = TRUE), npk) |
| Call: |
| aov(formula = terms(yield ~ block + N * P + K, keep.order = TRUE), |
| data = npk) |
| |
| Terms: |
| block N P N:P K Residuals |
| Sum of Squares 343.2950 189.2817 8.4017 21.2817 95.2017 218.9033 |
| Deg. of Freedom 5 1 1 1 1 14 |
| |
| Residual standard error: 3.954232 |
| Estimated effects are balanced |
| > |
| > |
| > ## as a test, not particularly sensible statistically |
| > npk.aovE <- aov(yield ~ N*P*K + Error(block), npk) |
| > npk.aovE |
| |
| Call: |
| aov(formula = yield ~ N * P * K + Error(block), data = npk) |
| |
| Grand Mean: 54.875 |
| |
| Stratum 1: block |
| |
| Terms: |
| N:P:K Residuals |
| Sum of Squares 37.00167 306.29333 |
| Deg. of Freedom 1 4 |
| |
| Residual standard error: 8.750619 |
| Estimated effects are balanced |
| |
| Stratum 2: Within |
| |
| Terms: |
| N P K N:P N:K P:K |
| Sum of Squares 189.28167 8.40167 95.20167 21.28167 33.13500 0.48167 |
| Deg. of Freedom 1 1 1 1 1 1 |
| Residuals |
| Sum of Squares 185.28667 |
| Deg. of Freedom 12 |
| |
| Residual standard error: 3.929447 |
| Estimated effects are balanced |
| > ## IGNORE_RDIFF_BEGIN |
| > summary(npk.aovE) |
| |
| Error: block |
| Df Sum Sq Mean Sq F value Pr(>F) |
| N:P:K 1 37.0 37.00 0.483 0.525 |
| Residuals 4 306.3 76.57 |
| |
| Error: Within |
| Df 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.47490 |
| K 1 95.20 95.20 6.166 0.02880 * |
| N:P 1 21.28 21.28 1.378 0.26317 |
| N:K 1 33.14 33.14 2.146 0.16865 |
| P:K 1 0.48 0.48 0.031 0.86275 |
| Residuals 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) |
| > |
| > ## 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)) : |
| 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)) |
| > options(op) # revert |
| > (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 |
| > |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("ar") |
| > ### * ar |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ar |
| > ### Title: Fit Autoregressive Models to Time Series |
| > ### Aliases: ar ar.burg ar.burg.default ar.burg.mts ar.yw ar.yw.default |
| > ### ar.yw.mts ar.mle print.ar predict.ar |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > ar(lh) |
| |
| Call: |
| ar(x = lh) |
| |
| Coefficients: |
| 1 2 3 |
| 0.6534 -0.0636 -0.2269 |
| |
| Order selected 3 sigma^2 estimated as 0.1959 |
| > ar(lh, method = "burg") |
| |
| Call: |
| ar(x = lh, method = "burg") |
| |
| Coefficients: |
| 1 2 3 |
| 0.6588 -0.0608 -0.2234 |
| |
| Order selected 3 sigma^2 estimated as 0.1786 |
| > ar(lh, method = "ols") |
| |
| Call: |
| ar(x = lh, method = "ols") |
| |
| Coefficients: |
| 1 |
| 0.586 |
| |
| Intercept: 0.006234 (0.06551) |
| |
| Order selected 1 sigma^2 estimated as 0.2016 |
| > ar(lh, FALSE, 4) # fit ar(4) |
| |
| Call: |
| ar(x = lh, aic = FALSE, order.max = 4) |
| |
| Coefficients: |
| 1 2 3 4 |
| 0.6767 -0.0571 -0.2941 0.1028 |
| |
| Order selected 4 sigma^2 estimated as 0.1983 |
| > |
| > (sunspot.ar <- ar(sunspot.year)) |
| |
| Call: |
| ar(x = sunspot.year) |
| |
| Coefficients: |
| 1 2 3 4 5 6 7 8 |
| 1.1305 -0.3524 -0.1745 0.1403 -0.1358 0.0963 -0.0556 0.0076 |
| 9 |
| 0.1941 |
| |
| Order selected 9 sigma^2 estimated as 267.5 |
| > predict(sunspot.ar, n.ahead = 25) |
| $pred |
| Time Series: |
| Start = 1989 |
| End = 2013 |
| Frequency = 1 |
| [1] 135.25933 148.09051 133.98476 106.61344 71.21921 40.84057 18.70100 |
| [8] 11.52416 27.24208 56.99888 87.86705 107.62926 111.05437 98.05484 |
| [15] 74.84085 48.80128 27.65441 18.15075 23.15355 40.04723 61.95906 |
| [22] 80.79092 90.11420 87.44131 74.42284 |
| |
| $se |
| Time Series: |
| Start = 1989 |
| End = 2013 |
| Frequency = 1 |
| [1] 16.35519 24.68467 28.95653 29.97401 30.07714 30.15629 30.35971 30.58793 |
| [9] 30.71100 30.74276 31.42565 32.96467 34.48910 35.33601 35.51890 35.52034 |
| [17] 35.65505 35.90628 36.07084 36.08139 36.16818 36.56324 37.16527 37.64820 |
| [25] 37.83954 |
| |
| > ## try the other methods too |
| > |
| > ar(ts.union(BJsales, BJsales.lead)) |
| |
| Call: |
| ar(x = ts.union(BJsales, BJsales.lead)) |
| |
| $ar |
| , , 1 |
| |
| BJsales BJsales.lead |
| BJsales 0.9499 0.8222 |
| BJsales.lead 0.0276 0.4970 |
| |
| , , 2 |
| |
| BJsales BJsales.lead |
| BJsales 0.02041 -1.133 |
| BJsales.lead -0.02193 0.294 |
| |
| , , 3 |
| |
| BJsales BJsales.lead |
| BJsales -0.186490 3.9415 |
| BJsales.lead -0.002946 0.1264 |
| |
| |
| $var.pred |
| BJsales BJsales.lead |
| BJsales 13.9431 0.7733 |
| BJsales.lead 0.7733 0.1231 |
| |
| > ## Burg is quite different here, as is OLS (see ar.ols) |
| > ar(ts.union(BJsales, BJsales.lead), method = "burg") |
| |
| Call: |
| ar(x = ts.union(BJsales, BJsales.lead), method = "burg") |
| |
| $ar |
| , , 1 |
| |
| BJsales BJsales.lead |
| BJsales 1.21197 0.07312 |
| BJsales.lead 0.07411 0.45684 |
| |
| , , 2 |
| |
| BJsales BJsales.lead |
| BJsales -0.26022 -0.1120 |
| BJsales.lead -0.06904 0.3111 |
| |
| , , 3 |
| |
| BJsales BJsales.lead |
| BJsales -0.01754 3.93591 |
| BJsales.lead 0.01792 0.09632 |
| |
| , , 4 |
| |
| BJsales BJsales.lead |
| BJsales -0.07746 -1.33836 |
| BJsales.lead -0.01158 -0.09118 |
| |
| |
| $var.pred |
| BJsales BJsales.lead |
| BJsales 0.38426 0.01315 |
| BJsales.lead 0.01315 0.07657 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("ar.ols") |
| > ### * ar.ols |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ar.ols |
| > ### Title: Fit Autoregressive Models to Time Series by OLS |
| > ### Aliases: ar.ols |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > ar(lh, method = "burg") |
| |
| Call: |
| ar(x = lh, method = "burg") |
| |
| Coefficients: |
| 1 2 3 |
| 0.6588 -0.0608 -0.2234 |
| |
| Order selected 3 sigma^2 estimated as 0.1786 |
| > ar.ols(lh) |
| |
| Call: |
| ar.ols(x = lh) |
| |
| Coefficients: |
| 1 |
| 0.586 |
| |
| Intercept: 0.006234 (0.06551) |
| |
| Order selected 1 sigma^2 estimated as 0.2016 |
| > ar.ols(lh, FALSE, 4) # fit ar(4) |
| |
| Call: |
| ar.ols(x = lh, aic = FALSE, order.max = 4) |
| |
| Coefficients: |
| 1 2 3 4 |
| 0.6761 -0.0571 -0.3001 0.0967 |
| |
| Intercept: 0.0004346 (0.06642) |
| |
| Order selected 4 sigma^2 estimated as 0.1924 |
| > |
| > ar.ols(ts.union(BJsales, BJsales.lead)) |
| |
| Call: |
| ar.ols(x = ts.union(BJsales, BJsales.lead)) |
| |
| $ar |
| , , 1 |
| |
| BJsales BJsales.lead |
| BJsales 0.40408 -0.05144 |
| BJsales.lead 0.07348 0.54524 |
| |
| , , 2 |
| |
| BJsales BJsales.lead |
| BJsales 0.2367 0.05899 |
| BJsales.lead -0.1224 0.28690 |
| |
| , , 3 |
| |
| BJsales BJsales.lead |
| BJsales 0.09673 4.7413 |
| BJsales.lead 0.10469 0.0701 |
| |
| , , 4 |
| |
| BJsales BJsales.lead |
| BJsales 0.048758 1.5671 |
| BJsales.lead 0.003482 -0.1838 |
| |
| , , 5 |
| |
| BJsales BJsales.lead |
| BJsales 0.23307 -0.1574 |
| BJsales.lead -0.02707 0.2623 |
| |
| , , 6 |
| |
| BJsales BJsales.lead |
| BJsales 0.07494 -0.4313 |
| BJsales.lead -0.08729 -0.2166 |
| |
| , , 7 |
| |
| BJsales BJsales.lead |
| BJsales -0.09946 -0.6233 |
| BJsales.lead 0.27123 -0.2584 |
| |
| , , 8 |
| |
| BJsales BJsales.lead |
| BJsales 0.06725 -1.36469 |
| BJsales.lead -0.21501 0.06115 |
| |
| , , 9 |
| |
| BJsales BJsales.lead |
| BJsales -0.11531 -1.464 |
| BJsales.lead 0.03536 0.270 |
| |
| , , 10 |
| |
| BJsales BJsales.lead |
| BJsales -0.002037 -0.6472 |
| BJsales.lead 0.001284 -1.0667 |
| |
| , , 11 |
| |
| BJsales BJsales.lead |
| BJsales 0.004065 -0.7009 |
| BJsales.lead 0.002098 0.4890 |
| |
| |
| $x.intercept |
| BJsales BJsales.lead |
| 0.19630 -0.07022 |
| |
| $var.pred |
| BJsales BJsales.lead |
| BJsales 0.0400996 -0.0009311 |
| BJsales.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 |
| , , 1 |
| |
| DAX SMI CAC FTSE |
| DAX 0.004560 -0.095781 0.039975 0.04856 |
| SMI -0.009204 -0.007142 0.037758 0.06826 |
| CAC -0.026624 -0.113688 0.063807 0.09154 |
| FTSE -0.010299 -0.089246 -0.003195 0.16409 |
| |
| |
| $x.intercept |
| DAX SMI CAC FTSE |
| 0.0006941 0.0007813 0.0004866 0.0004388 |
| |
| $var.pred |
| DAX SMI CAC FTSE |
| DAX 1.056e-04 6.683e-05 8.274e-05 5.192e-05 |
| SMI 6.683e-05 8.496e-05 6.252e-05 4.254e-05 |
| CAC 8.274e-05 6.252e-05 1.207e-04 5.615e-05 |
| FTSE 5.192e-05 4.254e-05 5.615e-05 6.224e-05 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("arima") |
| > ### * arima |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: arima |
| > ### Title: ARIMA Modelling of Time Series |
| > ### Aliases: arima |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > arima(lh, order = c(1,0,0)) |
| |
| Call: |
| arima(x = lh, order = c(1, 0, 0)) |
| |
| Coefficients: |
| ar1 intercept |
| 0.5739 2.4133 |
| s.e. 0.1161 0.1466 |
| |
| sigma^2 estimated as 0.1975: log likelihood = -29.38, aic = 64.76 |
| > arima(lh, order = c(3,0,0)) |
| |
| Call: |
| arima(x = lh, order = c(3, 0, 0)) |
| |
| Coefficients: |
| ar1 ar2 ar3 intercept |
| 0.6448 -0.0634 -0.2198 2.3931 |
| s.e. 0.1394 0.1668 0.1421 0.0963 |
| |
| sigma^2 estimated as 0.1787: log likelihood = -27.09, aic = 64.18 |
| > arima(lh, order = c(1,0,1)) |
| |
| Call: |
| arima(x = lh, order = c(1, 0, 1)) |
| |
| Coefficients: |
| ar1 ma1 intercept |
| 0.4522 0.1982 2.4101 |
| s.e. 0.1769 0.1705 0.1358 |
| |
| sigma^2 estimated as 0.1923: log likelihood = -28.76, aic = 65.52 |
| > |
| > arima(lh, order = c(3,0,0), method = "CSS") |
| |
| Call: |
| arima(x = lh, order = c(3, 0, 0), method = "CSS") |
| |
| Coefficients: |
| ar1 ar2 ar3 intercept |
| 0.6578 -0.0658 -0.2348 2.3918 |
| s.e. 0.1414 0.1702 0.1473 0.0983 |
| |
| sigma^2 estimated as 0.1905: part log likelihood = -28.31 |
| > |
| > arima(USAccDeaths, order = c(0,1,1), seasonal = list(order = c(0,1,1))) |
| |
| Call: |
| arima(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1))) |
| |
| Coefficients: |
| ma1 sma1 |
| -0.4303 -0.5528 |
| s.e. 0.1228 0.1784 |
| |
| sigma^2 estimated as 99347: log likelihood = -425.44, aic = 856.88 |
| > arima(USAccDeaths, order = c(0,1,1), seasonal = list(order = c(0,1,1)), |
| + method = "CSS") # drops first 13 observations. |
| |
| Call: |
| arima(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1)), |
| method = "CSS") |
| |
| Coefficients: |
| ma1 sma1 |
| -0.3732 -0.4549 |
| s.e. 0.1366 0.1436 |
| |
| sigma^2 estimated as 110330: part log likelihood = -426.25 |
| > # for a model with as few years as this, we want full ML |
| > |
| > arima(LakeHuron, order = c(2,0,0), xreg = time(LakeHuron) - 1920) |
| |
| Call: |
| arima(x = LakeHuron, order = c(2, 0, 0), xreg = time(LakeHuron) - 1920) |
| |
| Coefficients: |
| ar1 ar2 intercept time(LakeHuron) - 1920 |
| 1.0048 -0.2913 579.0993 -0.0216 |
| s.e. 0.0976 0.1004 0.2370 0.0081 |
| |
| sigma^2 estimated as 0.4566: log likelihood = -101.2, aic = 212.4 |
| > |
| > ## presidents contains NAs |
| > ## graphs in example(acf) suggest order 1 or 3 |
| > require(graphics) |
| > (fit1 <- arima(presidents, c(1, 0, 0))) |
| |
| Call: |
| arima(x = presidents, order = c(1, 0, 0)) |
| |
| Coefficients: |
| ar1 intercept |
| 0.8242 56.1505 |
| s.e. 0.0555 4.6434 |
| |
| sigma^2 estimated as 85.47: log likelihood = -416.89, aic = 839.78 |
| > nobs(fit1) |
| [1] 114 |
| > tsdiag(fit1) |
| > (fit3 <- arima(presidents, c(3, 0, 0))) # smaller AIC |
| |
| Call: |
| arima(x = presidents, order = c(3, 0, 0)) |
| |
| Coefficients: |
| ar1 ar2 ar3 intercept |
| 0.7496 0.2523 -0.1890 56.2223 |
| s.e. 0.0936 0.1140 0.0946 4.2845 |
| |
| sigma^2 estimated as 81.12: log likelihood = -414.08, aic = 838.16 |
| > tsdiag(fit3) |
| > BIC(fit1, fit3) |
| df BIC |
| fit1 3 847.9931 |
| fit3 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 AIC |
| fit1 3 839.7845 |
| arima(presidents, c(2, 0, 0)) 4 840.0458 |
| arima(presidents, c(2, 0, 1)) 5 838.1272 |
| fit3 5 838.1639 |
| arima(presidents, c(3, 0, 1)) 6 838.8124 |
| > |
| > ## An example of ARIMA forecasting: |
| > predict(fit3, 3) |
| $pred |
| Qtr1 Qtr2 Qtr3 |
| 1975 29.84194 34.41014 39.30815 |
| |
| $se |
| Qtr1 Qtr2 Qtr3 |
| 1975 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 = 1 |
| End = 63 |
| Frequency = 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 = 1 |
| End = 63 |
| Frequency = 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 intercept |
| 0.6448 -0.0634 -0.2198 2.3931 |
| s.e. 0.1394 0.1668 0.1421 0.0963 |
| |
| sigma^2 estimated as 0.1787: log likelihood = -27.09, aic = 64.18 |
| > arima0(lh, order = c(1,0,1)) |
| |
| Call: |
| arima0(x = lh, order = c(1, 0, 1)) |
| |
| Coefficients: |
| ar1 ma1 intercept |
| 0.4521 0.1983 2.4101 |
| s.e. 0.1357 0.1777 0.1357 |
| |
| sigma^2 estimated as 0.1923: log likelihood = -28.76, aic = 65.52 |
| > predict(arima0(lh, order = c(3,0,0)), n.ahead = 12) |
| $pred |
| Time Series: |
| Start = 49 |
| End = 60 |
| Frequency = 1 |
| [1] 2.460173 2.270829 2.198597 2.260696 2.346933 2.414479 2.438918 2.431440 |
| [9] 2.410223 2.391645 2.382653 2.382697 |
| |
| $se |
| Time Series: |
| Start = 49 |
| End = 60 |
| Frequency = 1 |
| [1] 0.4226823 0.5029332 0.5245256 0.5247161 0.5305499 0.5369159 0.5388045 |
| [8] 0.5388448 0.5391043 0.5395174 0.5396991 0.5397140 |
| |
| > |
| > arima0(lh, order = c(3,0,0), method = "CSS") |
| |
| Call: |
| arima0(x = lh, order = c(3, 0, 0), method = "CSS") |
| |
| Coefficients: |
| ar1 ar2 ar3 intercept |
| 0.6580 -0.0660 -0.2339 2.3999 |
| s.e. 0.1414 0.1702 0.1469 0.0981 |
| |
| sigma^2 estimated as 0.1905: part log likelihood = -28.31 |
| > |
| > # for a model with as few years as this, we want full ML |
| > (fit <- arima0(USAccDeaths, order = c(0,1,1), |
| + seasonal = list(order=c(0,1,1)), delta = -1)) |
| |
| Call: |
| arima0(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, |
| 1)), delta = -1) |
| |
| Coefficients: |
| ma1 sma1 |
| -0.4304 -0.5526 |
| s.e. 0.1228 0.1785 |
| |
| sigma^2 estimated as 99355: log likelihood = -425.44, aic = 856.88 |
| > predict(fit, n.ahead = 6) |
| $pred |
| Jan Feb Mar Apr May Jun |
| 1979 8336.028 7531.760 8314.593 8616.864 9488.916 9859.727 |
| |
| $se |
| Jan Feb Mar Apr May Jun |
| 1979 315.4607 362.9949 404.9878 443.0180 478.0322 510.6511 |
| |
| > |
| > arima0(LakeHuron, order = c(2,0,0), xreg = time(LakeHuron)-1920) |
| |
| Call: |
| arima0(x = LakeHuron, order = c(2, 0, 0), xreg = time(LakeHuron) - 1920) |
| |
| Coefficients: |
| ar1 ar2 intercept xreg |
| 1.0048 -0.2913 579.0985 -0.0216 |
| s.e. 0.0976 0.1004 0.2370 0.0081 |
| |
| sigma^2 estimated as 0.4566: log likelihood = -101.2, aic = 212.4 |
| > ## Not run: |
| > ##D ## presidents contains NAs |
| > ##D ## graphs in example(acf) suggest order 1 or 3 |
| > ##D (fit1 <- arima0(presidents, c(1, 0, 0), delta = -1)) # avoid warning |
| > ##D tsdiag(fit1) |
| > ##D (fit3 <- arima0(presidents, c(3, 0, 0), delta = -1)) # smaller AIC |
| > ##D tsdiag(fit3) |
| > ## End(Not run) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("as.hclust") |
| > ### * as.hclust |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: as.hclust |
| > ### Title: Convert Objects to Class hclust |
| > ### Aliases: as.hclust as.hclust.default as.hclust.twins |
| > ### Keywords: multivariate cluster |
| > |
| > ### ** Examples |
| > |
| > x <- matrix(rnorm(30), ncol = 3) |
| > hc <- hclust(dist(x), method = "complete") |
| > |
| > |
| > |
| > |
| > 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: 0x5c8d520> |
| > 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 variances |
| |
| data: InsectSprays$count and InsectSprays$spray |
| Bartlett's K-squared = 25.96, df = 5, p-value = 9.085e-05 |
| |
| > bartlett.test(count ~ spray, data = InsectSprays) |
| |
| Bartlett test of homogeneity of variances |
| |
| data: count by spray |
| Bartlett's K-squared = 25.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 test |
| |
| data: c(682, 243) |
| number of successes = 682, number of trials = 925, p-value = 0.3825 |
| alternative hypothesis: true probability of success is not equal to 0.75 |
| 95 percent confidence interval: |
| 0.7076683 0.7654066 |
| sample estimates: |
| probability of success |
| 0.7372973 |
| |
| > binom.test(682, 682 + 243, p = 3/4) # The same. |
| |
| Exact binomial test |
| |
| data: 682 and 682 + 243 |
| number of successes = 682, number of trials = 925, p-value = 0.3825 |
| alternative hypothesis: true probability of success is not equal to 0.75 |
| 95 percent confidence interval: |
| 0.7076683 0.7654066 |
| sample estimates: |
| probability of success |
| 0.7372973 |
| |
| > ## => Data are in agreement with the null hypothesis. |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("biplot.princomp") |
| > ### * biplot.princomp |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: biplot.princomp |
| > ### Title: Biplot for Principal Components |
| > ### Aliases: biplot.princomp biplot.prcomp |
| > ### Keywords: multivariate hplot |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > biplot(princomp(USArrests)) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("birthday") |
| > ### * birthday |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: birthday |
| > ### Title: Probability of coincidences |
| > ### Aliases: qbirthday pbirthday |
| > ### Keywords: distribution |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > ## the standard version |
| > qbirthday() # 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 test |
| |
| data: x |
| X-squared = 0.0013332, df = 1, p-value = 0.9709 |
| |
| > Box.test (x, lag = 1, type = "Ljung") |
| |
| Box-Ljung test |
| |
| data: x |
| X-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.9947 |
| |
| Coefficients: (1 not defined because of singularities) |
| Estimate Std. Error t value Pr(>|t|) |
| (Intercept) -10.967768 3.104498 -3.533 0.003013 ** |
| x 5.524412 1.255354 4.401 0.000516 *** |
| I(x^2) -0.542292 0.138460 -3.917 0.001374 ** |
| I(x^3) 0.020905 0.004372 4.782 0.000242 *** |
| I((x - 10)^2) NA NA NA NA |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 2.838 on 15 degrees of freedom |
| Multiple R-squared: 0.9702, Adjusted R-squared: 0.9643 |
| F-statistic: 163 on 3 and 15 DF, p-value: 1.14e-11 |
| |
| Correlation of Coefficients: |
| (Intercept) x I(x^2) |
| x -0.90 |
| I(x^2) 0.80 -0.97 |
| I(x^3) -0.73 0.93 -0.99 |
| |
| > variable.names(lmxy) |
| [1] "(Intercept)" "x" "I(x^2)" "I(x^3)" |
| > variable.names(lmxy, full = TRUE) # includes the last |
| [1] "(Intercept)" "x" "I(x^2)" "I(x^3)" |
| [5] "I((x - 10)^2)" |
| > case.names(lmxy) |
| [1] "O.1" "O.2" "O.3" "O.4" "O.5" "O.6" "O.7" "O.8" "O.9" "O.10" |
| [11] "O.11" "O.12" "O.14" "O.15" "O.16" "O.17" "O.18" "O.19" "O.20" |
| > case.names(lmxy, full = TRUE) # includes the 0-weight case |
| [1] "O.1" "O.2" "O.3" "O.4" "O.5" "O.6" "O.7" "O.8" "O.9" "O.10" |
| [11] "O.11" "O.12" "O.13" "O.14" "O.15" "O.16" "O.17" "O.18" "O.19" "O.20" |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("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 summary |
| |
| Pearson's Chi-squared test |
| |
| data: M |
| X-squared = 30.07, df = 2, p-value = 2.954e-07 |
| |
| > Xsq$observed # observed counts (same as M) |
| party |
| gender Democrat Independent Republican |
| F 762 327 468 |
| M 484 239 477 |
| > Xsq$expected # expected counts under the null |
| party |
| gender Democrat Independent Republican |
| F 703.6714 319.6453 533.6834 |
| M 542.3286 246.3547 411.3166 |
| > Xsq$residuals # Pearson residuals |
| party |
| gender Democrat Independent Republican |
| F 2.1988558 0.4113702 -2.8432397 |
| M -2.5046695 -0.4685829 3.2386734 |
| > Xsq$stdres # standardized residuals |
| party |
| gender Democrat Independent Republican |
| F 4.5020535 0.6994517 -5.3159455 |
| M -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 probabilities |
| |
| data: x |
| X-squared = 2.5, df = 2, p-value = 0.2865 |
| |
| > chisq.test(as.table(x)) # the same |
| |
| Chi-squared test for given probabilities |
| |
| data: as.table(x) |
| X-squared = 2.5, df = 2, p-value = 0.2865 |
| |
| > x <- c(89,37,30,28,2) |
| > p <- c(40,20,20,15,5) |
| > try( |
| + chisq.test(x, p = p) # gives an error |
| + ) |
| Error in chisq.test(x, p = p) : probabilities must sum to 1. |
| > chisq.test(x, p = p, rescale.p = TRUE) |
| |
| Chi-squared test for given probabilities |
| |
| data: x |
| X-squared = 9.9901, df = 4, p-value = 0.04059 |
| |
| > # works |
| > p <- c(0.40,0.20,0.20,0.19,0.01) |
| > # Expected count in category 5 |
| > # is 1.86 < 5 ==> chi square approx. |
| > chisq.test(x, p = p) # maybe doubtful, but is ok! |
| Warning in chisq.test(x, p = p) : |
| Chi-squared approximation may be incorrect |
| |
| Chi-squared test for given probabilities |
| |
| data: x |
| X-squared = 5.7947, df = 4, p-value = 0.215 |
| |
| > chisq.test(x, p = p, simulate.p.value = TRUE) |
| |
| Chi-squared test for given probabilities with simulated p-value (based |
| on 2000 replicates) |
| |
| data: x |
| X-squared = 5.7947, df = NA, p-value = 0.2029 |
| |
| > |
| > ## Case B. Raw data |
| > x <- trunc(5 * runif(100)) |
| > chisq.test(table(x)) # NOT 'chisq.test(x)'! |
| |
| Chi-squared test for given probabilities |
| |
| data: table(x) |
| X-squared = 4.3, df = 4, p-value = 0.3669 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("cmdscale") |
| > ### * cmdscale |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: cmdscale |
| > ### Title: Classical (Metric) Multidimensional Scaling |
| > ### Aliases: cmdscale |
| > ### Keywords: multivariate |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > loc <- cmdscale(eurodist) |
| > x <- loc[, 1] |
| > y <- -loc[, 2] # 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.256118188 |
| disp -0.002867999 0.008273849 |
| hp -0.001400580 0.011949674 |
| wt 0.380088737 1.622517536 |
| am -0.614677730 0.926307310 |
| > confint(fit, "wt") |
| 2.5 % 97.5 % |
| wt 0.3800887 1.622518 |
| > |
| > |
| > |
| > |
| > 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 -1 |
| 2 1 -1 -1 |
| 3 0 2 -1 |
| 4 0 0 3 |
| > apply(cH, 2, sum) # column sums are 0 |
| [1] 0 0 0 |
| > crossprod(cH) # diagonal -- columns are orthogonal |
| [,1] [,2] [,3] |
| [1,] 2 0 0 |
| [2,] 0 6 0 |
| [3,] 0 0 12 |
| > contr.helmert(4, contrasts = FALSE) # just the 4 x 4 identity matrix |
| 1 2 3 4 |
| 1 1 0 0 0 |
| 2 0 1 0 0 |
| 3 0 0 1 0 |
| 4 0 0 0 1 |
| > |
| > (cT <- contr.treatment(5)) |
| 2 3 4 5 |
| 1 0 0 0 0 |
| 2 1 0 0 0 |
| 3 0 1 0 0 |
| 4 0 0 1 0 |
| 5 0 0 0 1 |
| > all(crossprod(cT) == diag(4)) # TRUE: even orthonormal |
| [1] TRUE |
| > |
| > (cT. <- contr.SAS(5)) |
| 1 2 3 4 |
| 1 1 0 0 0 |
| 2 0 1 0 0 |
| 3 0 0 1 0 |
| 4 0 0 0 1 |
| 5 0 0 0 0 |
| > all(crossprod(cT.) == diag(4)) # TRUE |
| [1] TRUE |
| > |
| > zapsmall(cP <- contr.poly(3)) # Linear and Quadratic |
| .L .Q |
| [1,] -0.7071068 0.4082483 |
| [2,] 0.0000000 -0.8164966 |
| [3,] 0.7071068 0.4082483 |
| > zapsmall(crossprod(cP), digits = 15) # orthonormal up to fuzz |
| .L .Q |
| .L 1 0 |
| .Q 0 1 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("contrasts") |
| > ### * contrasts |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: contrasts |
| > ### Title: Get and Set Contrast Matrices |
| > ### Aliases: contrasts contrasts<- |
| > ### Keywords: design regression |
| > |
| > ### ** Examples |
| > |
| > utils::example(factor) |
| |
| factor> (ff <- factor(substring("statistics", 1:10, 1:10), levels = letters)) |
| [1] s t a t i s t i c s |
| Levels: a b c d e f g h i j k l m n o p q r s t u v w x y z |
| |
| factor> as.integer(ff) # the internal codes |
| [1] 19 20 1 20 9 19 20 9 3 19 |
| |
| factor> (f. <- factor(ff)) # drops the levels that do not occur |
| [1] s t a t i s t i c s |
| Levels: a c i s t |
| |
| factor> ff[, drop = TRUE] # the same, more transparently |
| [1] s t a t i s t i c s |
| Levels: a c i s t |
| |
| factor> factor(letters[1:20], labels = "letter") |
| [1] letter1 letter2 letter3 letter4 letter5 letter6 letter7 letter8 |
| [9] letter9 letter10 letter11 letter12 letter13 letter14 letter15 letter16 |
| [17] letter17 letter18 letter19 letter20 |
| 20 Levels: letter1 letter2 letter3 letter4 letter5 letter6 letter7 ... letter20 |
| |
| factor> class(ordered(4:1)) # "ordered", inheriting from "factor" |
| [1] "ordered" "factor" |
| |
| factor> 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] <- TRUE |
| |
| factor> x # [1] 1 <NA> <NA> |
| [1] 1 <NA> <NA> |
| Levels: 1 2 <NA> |
| |
| factor> is.na(x) |
| [1] FALSE TRUE FALSE |
| |
| factor> # [1] FALSE TRUE FALSE |
| factor> |
| factor> ## 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 A |
| Levels: A < B < C |
| |
| factor> factor(z, exclude = "C") # does exclude |
| [1] <NA> B A |
| Levels: A < B |
| |
| factor> factor(z, exclude = "B") # ditto |
| [1] C <NA> A |
| Levels: A < C |
| |
| factor> ## 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 Female |
| Levels: Male Female |
| |
| factor> #> [1] Male Male Male Female Female |
| factor> #> Levels: Male Female |
| factor> |
| factor> ## Using addNA() |
| factor> Month <- airquality$Month |
| |
| factor> table(addNA(Month)) |
| |
| 5 6 7 8 9 <NA> |
| 31 30 31 31 30 0 |
| |
| factor> table(addNA(Month, ifany = TRUE)) |
| |
| 5 6 7 8 9 |
| 31 30 31 31 30 |
| > fff <- ff[, drop = TRUE] # reduce to 5 levels. |
| > contrasts(fff) # treatment contrasts by default |
| c i s t |
| a 0 0 0 0 |
| c 1 0 0 0 |
| i 0 1 0 0 |
| s 0 0 1 0 |
| t 0 0 0 1 |
| > contrasts(C(fff, sum)) |
| [,1] [,2] [,3] [,4] |
| a 1 0 0 0 |
| c 0 1 0 0 |
| i 0 0 1 0 |
| s 0 0 0 1 |
| t -1 -1 -1 -1 |
| > contrasts(fff, contrasts = FALSE) # the 5x5 identity matrix |
| a c i s t |
| a 1 0 0 0 0 |
| c 0 1 0 0 0 |
| i 0 0 1 0 0 |
| s 0 0 0 1 0 |
| t 0 0 0 0 1 |
| > |
| > contrasts(fff) <- contr.sum(5); contrasts(fff) # set sum contrasts |
| [,1] [,2] [,3] [,4] |
| a 1 0 0 0 |
| c 0 1 0 0 |
| i 0 0 1 0 |
| s 0 0 0 1 |
| t -1 -1 -1 -1 |
| > contrasts(fff, 2) <- contr.sum(5); contrasts(fff) # set 2 contrasts |
| [,1] [,2] |
| a 1 0 |
| c 0 1 |
| i 0 0 |
| s 0 0 |
| t -1 -1 |
| > # supply 2 contrasts, compute 2 more to make full set of 4. |
| > contrasts(fff) <- contr.sum(5)[, 1:2]; contrasts(fff) |
| [,1] [,2] [,3] [,4] |
| a 1 0 -0.2471257 0.2688164 |
| c 0 1 -0.2471257 0.2688164 |
| i 0 0 -0.1498721 -0.8817814 |
| s 0 0 0.8912491 0.0753323 |
| t -1 -1 -0.2471257 0.2688164 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("convolve") |
| > ### * convolve |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: convolve |
| > ### Title: Convolution of Sequences via FFT |
| > ### Aliases: convolve |
| > ### Keywords: math dplot |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > x <- c(0,0,0,100,0,0,0) |
| > y <- c(0,0,1, 2 ,1,0,0)/4 |
| > zapsmall(convolve(x, y)) # *NOT* what you first thought. |
| [1] 50 25 0 0 0 0 25 |
| > zapsmall(convolve(x, y[3:5], type = "f")) # rather |
| [1] 0 25 50 25 0 |
| > x <- rnorm(50) |
| > y <- rnorm(50) |
| > # Circular convolution *has* this symmetry: |
| > all.equal(convolve(x, y, conj = FALSE), rev(convolve(rev(y),x))) |
| [1] TRUE |
| > |
| > n <- length(x <- -20:24) |
| > y <- (x-10)^2/1000 + rnorm(x)/8 |
| > |
| > Han <- function(y) # Hanning |
| + convolve(y, c(1,2,1)/4, type = "filter") |
| > |
| > plot(x, y, main = "Using convolve(.) for Hanning filters") |
| > lines(x[-c(1 , n) ], Han(y), col = "red") |
| > lines(x[-c(1:2, (n-1):n)], Han(Han(y)), lwd = 2, col = "dark blue") |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("cophenetic") |
| > ### * cophenetic |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: cophenetic |
| > ### Title: Cophenetic Distances for a Hierarchical Clustering |
| > ### Aliases: cophenetic cophenetic.default cophenetic.dendrogram |
| > ### Keywords: cluster multivariate |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > d1 <- dist(USArrests) |
| > hc <- hclust(d1, "ave") |
| > d2 <- cophenetic(hc) |
| > cor(d1, d2) # 0.7659 |
| [1] 0.7658983 |
| > |
| > ## Example from Sneath & Sokal, Fig. 5-29, p.279 |
| > d0 <- c(1,3.8,4.4,5.1, 4,4.2,5, 2.6,5.3, 5.4) |
| > attributes(d0) <- list(Size = 5, diag = TRUE) |
| > class(d0) <- "dist" |
| > names(d0) <- letters[1:5] |
| > d0 |
| 1 2 3 4 |
| 2 1.0 |
| 3 3.8 4.0 |
| 4 4.4 4.2 2.6 |
| 5 5.1 5.0 5.3 5.4 |
| > utils::str(upgma <- hclust(d0, method = "average")) |
| List of 7 |
| $ merge : int [1:4, 1:2] -1 -3 1 -5 -2 -4 2 3 |
| $ height : num [1:4] 1 2.6 4.1 5.2 |
| $ order : int [1:5] 5 1 2 3 4 |
| $ labels : NULL |
| $ method : chr "average" |
| $ call : language hclust(d = d0, method = "average") |
| $ dist.method: NULL |
| - attr(*, "class")= chr "hclust" |
| > plot(upgma, hang = -1) |
| > # |
| > (d.coph <- cophenetic(upgma)) |
| 1 2 3 4 |
| 2 1.0 |
| 3 4.1 4.1 |
| 4 4.1 4.1 2.6 |
| 5 5.2 5.2 5.2 5.2 |
| > cor(d0, d.coph) # 0.9911 |
| [1] 0.9911351 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("cor") |
| > ### * cor |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: cor |
| > ### Title: Correlation, Variance and Covariance (Matrices) |
| > ### Aliases: var cov cor cov2cor |
| > ### Keywords: univar multivariate array |
| > |
| > ### ** Examples |
| > |
| > var(1:10) # 9.166667 |
| [1] 9.166667 |
| > |
| > var(1:5, 1:5) # 2.5 |
| [1] 2.5 |
| > |
| > ## Two simple vectors |
| > cor(1:10, 2:11) # == 1 |
| [1] 1 |
| > |
| > ## Correlation Matrix of Multivariate sample: |
| > (Cl <- cor(longley)) |
| GNP.deflator GNP Unemployed Armed.Forces Population |
| GNP.deflator 1.0000000 0.9915892 0.6206334 0.4647442 0.9791634 |
| GNP 0.9915892 1.0000000 0.6042609 0.4464368 0.9910901 |
| Unemployed 0.6206334 0.6042609 1.0000000 -0.1774206 0.6865515 |
| Armed.Forces 0.4647442 0.4464368 -0.1774206 1.0000000 0.3644163 |
| Population 0.9791634 0.9910901 0.6865515 0.3644163 1.0000000 |
| Year 0.9911492 0.9952735 0.6682566 0.4172451 0.9939528 |
| Employed 0.9708985 0.9835516 0.5024981 0.4573074 0.9603906 |
| Year Employed |
| GNP.deflator 0.9911492 0.9708985 |
| GNP 0.9952735 0.9835516 |
| Unemployed 0.6682566 0.5024981 |
| Armed.Forces 0.4172451 0.4573074 |
| Population 0.9939528 0.9603906 |
| Year 1.0000000 0.9713295 |
| Employed 0.9713295 1.0000000 |
| > ## Graphical Correlation Matrix: |
| > symnum(Cl) # highly correlated |
| GNP. GNP U A P Y E |
| GNP.deflator 1 |
| GNP B 1 |
| Unemployed , , 1 |
| Armed.Forces . . 1 |
| Population B B , . 1 |
| Year B B , . B 1 |
| Employed B B . . B B 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > |
| > ## Spearman's rho and Kendall's tau |
| > symnum(clS <- cor(longley, method = "spearman")) |
| GNP. GNP U A P Y E |
| GNP.deflator 1 |
| GNP B 1 |
| Unemployed , , 1 |
| Armed.Forces . 1 |
| Population B B , 1 |
| Year B B , 1 1 |
| Employed B B . B B 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(clK <- cor(longley, method = "kendall")) |
| GNP. GNP U A P Y E |
| GNP.deflator 1 |
| GNP B 1 |
| Unemployed . . 1 |
| Armed.Forces 1 |
| Population B B . 1 |
| Year B B . 1 1 |
| Employed * * . + + 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > ## How much do they differ? |
| > i <- lower.tri(Cl) |
| > cor(cbind(P = Cl[i], S = clS[i], K = clK[i])) |
| P S K |
| P 1.0000000 0.9802390 0.9572562 |
| S 0.9802390 1.0000000 0.9742171 |
| K 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 <- V |
| r[] <- Is * V * rep(Is, each = p) |
| r[cbind(1L:p, 1L:p)] <- 1 |
| r |
| } |
| <bytecode: 0x69b1ae8> |
| <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.matrix |
| Frtlty Agrclt Exmntn Eductn Cathlc Infn.M |
| Frtlty 156.04250 NA NA -79.729510 NA 15.156193 |
| Agrclt NA NA NA NA NA NA |
| Exmntn NA NA NA NA NA NA |
| Eductn -79.72951 NA NA 92.456059 NA -2.781684 |
| Cathlc NA NA NA NA NA NA |
| Infn.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 I |
| Frtlty 1 |
| Agrclt 1 |
| Exmntn . . 1 |
| Eductn . . . 1 |
| Cathlc . 1 |
| Infn.M 1 |
| attr(,"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 I |
| Frtlty 1 |
| Agrclt 1 |
| Exmntn . . 1 |
| Eductn . . . 1 |
| Cathlc . 1 |
| Infn.M . 1 |
| attr(,"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 I |
| Fertility 1 |
| Agriculture 1 |
| Examination . . 1 |
| Education . . . 1 |
| Catholic . 1 |
| Infant.Mortality . 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > |
| > ## "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 tau |
| |
| data: x and y |
| T = 26, p-value = 0.05972 |
| alternative hypothesis: true tau is greater than 0 |
| sample estimates: |
| tau |
| 0.4444444 |
| |
| > ## => p=0.05972 |
| > |
| > cor.test(x, y, method = "kendall", alternative = "greater", |
| + exact = FALSE) # using large sample approximation |
| |
| Kendall's rank correlation tau |
| |
| data: x and y |
| z = 1.6681, p-value = 0.04765 |
| alternative hypothesis: true tau is greater than 0 |
| sample estimates: |
| tau |
| 0.4444444 |
| |
| > ## => p=0.04765 |
| > |
| > ## Compare this to |
| > cor.test(x, y, method = "spearm", alternative = "g") |
| |
| Spearman's rank correlation rho |
| |
| data: x and y |
| S = 48, p-value = 0.0484 |
| alternative hypothesis: true rho is greater than 0 |
| sample estimates: |
| rho |
| 0.6 |
| |
| > cor.test(x, y, alternative = "g") |
| |
| Pearson's product-moment correlation |
| |
| data: x and y |
| t = 1.8411, df = 7, p-value = 0.05409 |
| alternative hypothesis: true correlation is greater than 0 |
| 95 percent confidence interval: |
| -0.02223023 1.00000000 |
| sample estimates: |
| cor |
| 0.5711816 |
| |
| > |
| > ## Formula interface. |
| > require(graphics) |
| > pairs(USJudgeRatings) |
| > cor.test(~ CONT + INTG, data = USJudgeRatings) |
| |
| Pearson's product-moment correlation |
| |
| data: CONT and INTG |
| t = -0.8605, df = 41, p-value = 0.3945 |
| alternative hypothesis: true correlation is not equal to 0 |
| 95 percent confidence interval: |
| -0.4168591 0.1741182 |
| sample estimates: |
| cor |
| -0.1331909 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("cov.wt") |
| > ### * cov.wt |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: cov.wt |
| > ### Title: Weighted Covariance Matrices |
| > ### Aliases: cov.wt |
| > ### Keywords: multivariate |
| > |
| > ### ** Examples |
| > |
| > (xy <- cbind(x = 1:10, y = c(1:3, 8:5, 8:10))) |
| x y |
| [1,] 1 1 |
| [2,] 2 2 |
| [3,] 3 3 |
| [4,] 4 8 |
| [5,] 5 7 |
| [6,] 6 6 |
| [7,] 7 5 |
| [8,] 8 8 |
| [9,] 9 9 |
| [10,] 10 10 |
| > w1 <- c(0,0,0,1,1,1,1,1,0,0) |
| > cov.wt(xy, wt = w1) # i.e. method = "unbiased" |
| $cov |
| x y |
| x 2.5 -0.5 |
| y -0.5 1.7 |
| |
| $center |
| x y |
| 6.0 6.8 |
| |
| $n.obs |
| [1] 10 |
| |
| $wt |
| [1] 0.0 0.0 0.0 0.2 0.2 0.2 0.2 0.2 0.0 0.0 |
| |
| > cov.wt(xy, wt = w1, method = "ML", cor = TRUE) |
| $cov |
| x y |
| x 2.0 -0.40 |
| y -0.4 1.36 |
| |
| $center |
| x y |
| 6.0 6.8 |
| |
| $n.obs |
| [1] 10 |
| |
| $wt |
| [1] 0.0 0.0 0.0 0.2 0.2 0.2 0.2 0.2 0.0 0.0 |
| |
| $cor |
| x y |
| x 1.0000000 -0.2425356 |
| y -0.2425356 1.0000000 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("cpgram") |
| > ### * cpgram |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: cpgram |
| > ### Title: Plot Cumulative Periodogram |
| > ### Aliases: cpgram |
| > ### Keywords: ts hplot |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > par(pty = "s", mfrow = c(1,2)) |
| > cpgram(lh) |
| > lh.ar <- ar(lh, order.max = 9) |
| > cpgram(lh.ar$resid, main = "AR(3) fit to lh") |
| > |
| > cpgram(ldeaths) |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("cutree") |
| > ### * cutree |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: cutree |
| > ### Title: Cut a Tree into Groups of Data |
| > ### Aliases: cutree |
| > ### Keywords: multivariate cluster |
| > |
| > ### ** Examples |
| > |
| > hc <- hclust(dist(USArrests)) |
| > |
| > cutree(hc, k = 1:5) #k = 1 is trivial |
| 1 2 3 4 5 |
| Alabama 1 1 1 1 1 |
| Alaska 1 1 1 1 1 |
| Arizona 1 1 1 1 1 |
| Arkansas 1 2 2 2 2 |
| California 1 1 1 1 1 |
| Colorado 1 2 2 2 2 |
| Connecticut 1 2 3 3 3 |
| Delaware 1 1 1 1 1 |
| Florida 1 1 1 4 4 |
| Georgia 1 2 2 2 2 |
| Hawaii 1 2 3 3 5 |
| Idaho 1 2 3 3 3 |
| Illinois 1 1 1 1 1 |
| Indiana 1 2 3 3 3 |
| Iowa 1 2 3 3 5 |
| Kansas 1 2 3 3 3 |
| Kentucky 1 2 3 3 3 |
| Louisiana 1 1 1 1 1 |
| Maine 1 2 3 3 5 |
| Maryland 1 1 1 1 1 |
| Massachusetts 1 2 2 2 2 |
| Michigan 1 1 1 1 1 |
| Minnesota 1 2 3 3 5 |
| Mississippi 1 1 1 1 1 |
| Missouri 1 2 2 2 2 |
| Montana 1 2 3 3 3 |
| Nebraska 1 2 3 3 3 |
| Nevada 1 1 1 1 1 |
| New Hampshire 1 2 3 3 5 |
| New Jersey 1 2 2 2 2 |
| New Mexico 1 1 1 1 1 |
| New York 1 1 1 1 1 |
| North Carolina 1 1 1 4 4 |
| North Dakota 1 2 3 3 5 |
| Ohio 1 2 3 3 3 |
| Oklahoma 1 2 2 2 2 |
| Oregon 1 2 2 2 2 |
| Pennsylvania 1 2 3 3 3 |
| Rhode Island 1 2 2 2 2 |
| South Carolina 1 1 1 1 1 |
| South Dakota 1 2 3 3 5 |
| Tennessee 1 2 2 2 2 |
| Texas 1 2 2 2 2 |
| Utah 1 2 3 3 3 |
| Vermont 1 2 3 3 5 |
| Virginia 1 2 2 2 2 |
| Washington 1 2 2 2 2 |
| West Virginia 1 2 3 3 5 |
| Wisconsin 1 2 3 3 5 |
| Wyoming 1 2 2 2 2 |
| > cutree(hc, h = 250) |
| Alabama Alaska Arizona Arkansas California |
| 1 1 1 2 1 |
| Colorado Connecticut Delaware Florida Georgia |
| 2 2 1 1 2 |
| Hawaii Idaho Illinois Indiana Iowa |
| 2 2 1 2 2 |
| Kansas Kentucky Louisiana Maine Maryland |
| 2 2 1 2 1 |
| Massachusetts Michigan Minnesota Mississippi Missouri |
| 2 1 2 1 2 |
| Montana Nebraska Nevada New Hampshire New Jersey |
| 2 2 1 2 2 |
| New Mexico New York North Carolina North Dakota Ohio |
| 1 1 1 2 2 |
| Oklahoma Oregon Pennsylvania Rhode Island South Carolina |
| 2 2 2 2 1 |
| South Dakota Tennessee Texas Utah Vermont |
| 2 2 2 2 2 |
| Virginia Washington West Virginia Wisconsin Wyoming |
| 2 2 2 2 2 |
| > |
| > ## Compare the 2 and 4 grouping: |
| > g24 <- cutree(hc, k = c(2,4)) |
| > table(grp2 = g24[,"2"], grp4 = g24[,"4"]) |
| grp4 |
| grp2 1 2 3 4 |
| 1 14 0 0 2 |
| 2 0 14 20 0 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("decompose") |
| > ### * decompose |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: decompose |
| > ### Title: Classical Seasonal Decomposition by Moving Averages |
| > ### Aliases: decompose plot.decomposed.ts |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > m <- decompose(co2) |
| > m$figure |
| [1] -0.05359649 0.61055921 1.37564693 2.51682018 3.00028509 2.32921053 |
| [7] 0.81293860 -1.25052632 -3.05458333 -3.25194079 -2.06969298 -0.96512061 |
| > plot(m) |
| > |
| > ## example taken from Kendall/Stuart |
| > x <- c(-50, 175, 149, 214, 247, 237, 225, 329, 729, 809, |
| + 530, 489, 540, 457, 195, 176, 337, 239, 128, 102, 232, 429, 3, |
| + 98, 43, -141, -77, -13, 125, 361, -45, 184) |
| > x <- ts(x, start = c(1951, 1), end = c(1958, 4), frequency = 4) |
| > m <- decompose(x) |
| > ## seasonal figure: 6.25, 8.62, -8.84, -6.03 |
| > round(decompose(x)$figure / 10, 2) |
| [1] 6.25 8.62 -8.84 -6.03 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("delete.response") |
| > ### * delete.response |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: delete.response |
| > ### Title: Modify Terms Objects |
| > ### Aliases: reformulate drop.terms delete.response [.terms |
| > ### Keywords: programming |
| > |
| > ### ** Examples |
| > |
| > ff <- y ~ z + x + w |
| > tt <- terms(ff) |
| > tt |
| y ~ z + x + w |
| attr(,"variables") |
| list(y, z, x, w) |
| attr(,"factors") |
| z x w |
| y 0 0 0 |
| z 1 0 0 |
| x 0 1 0 |
| w 0 0 1 |
| attr(,"term.labels") |
| [1] "z" "x" "w" |
| attr(,"order") |
| [1] 1 1 1 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > delete.response(tt) |
| ~z + x + w |
| attr(,"variables") |
| list(z, x, w) |
| attr(,"factors") |
| z x w |
| z 1 0 0 |
| x 0 1 0 |
| w 0 0 1 |
| attr(,"term.labels") |
| [1] "z" "x" "w" |
| attr(,"order") |
| [1] 1 1 1 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 0 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > drop.terms(tt, 2:3, keep.response = TRUE) |
| y ~ z |
| attr(,"variables") |
| list(y, z) |
| attr(,"factors") |
| z |
| y 0 |
| z 1 |
| attr(,"term.labels") |
| [1] "z" |
| attr(,"order") |
| [1] 1 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > tt[-1] |
| y ~ x + w |
| attr(,"variables") |
| list(y, x, w) |
| attr(,"factors") |
| x w |
| y 0 0 |
| x 1 0 |
| w 0 1 |
| attr(,"term.labels") |
| [1] "x" "w" |
| attr(,"order") |
| [1] 1 1 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > tt[2:3] |
| y ~ x + w |
| attr(,"variables") |
| list(y, x, w) |
| attr(,"factors") |
| x w |
| y 0 0 |
| x 1 0 |
| w 0 1 |
| attr(,"term.labels") |
| [1] "x" "w" |
| attr(,"order") |
| [1] 1 1 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > reformulate(attr(tt, "term.labels")) |
| ~z + x + w |
| > |
| > ## keep LHS : |
| > reformulate("x*w", ff[[2]]) |
| y ~ x * w |
| > fS <- surv(ft, case) ~ a + b |
| > reformulate(c("a", "b*f"), fS[[2]]) |
| surv(ft, case) ~ a + b * f |
| > |
| > ## 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 symbol |
| Error in parse(text = s, keep.source = FALSE) : |
| <text>:1:3: unexpected symbol |
| 1: 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 full |
| 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 |
| > 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") |
| > d |
| |
| Call: |
| density.default(x = faithful$eruptions, bw = "sj") |
| |
| Data: faithful$eruptions (272 obs.); Bandwidth 'bw' = 0.14 |
| |
| x y |
| Min. :1.180 Min. :0.0001834 |
| 1st Qu.:2.265 1st Qu.:0.0422638 |
| Median :3.350 Median :0.1709243 |
| Mean :3.350 Mean :0.2301726 |
| 3rd Qu.:4.435 3rd Qu.:0.4134348 |
| Max. :5.520 Max. :0.5945634 |
| > plot(d) |
| > |
| > plot(d, type = "n") |
| > polygon(d, col = "wheat") |
| > |
| > ## Missing values: |
| > x <- xx <- faithful$eruptions |
| > x[i.out <- sample(length(x), 10)] <- NA |
| > doR <- density(x, bw = 0.15, na.rm = TRUE) |
| > lines(doR, col = "blue") |
| > points(xx[i.out], rep(0.01, 10)) |
| > |
| > ## Weighted observations: |
| > fe <- sort(faithful$eruptions) # has quite a few non-unique values |
| > ## use 'counts / n' as weights: |
| > dw <- density(unique(fe), weights = table(fe)/length(fe), bw = d$bw) |
| > utils::str(dw) ## smaller n: only 126, but identical estimate: |
| List of 7 |
| $ x : num [1:512] 1.18 1.19 1.2 1.21 1.21 ... |
| $ y : num [1:512] 0.000183 0.000223 0.00027 0.000328 0.000397 ... |
| $ bw : num 0.14 |
| $ n : int 126 |
| $ call : language density.default(x = unique(fe), bw = d$bw, weights = table(fe)/length(fe)) |
| $ data.name: chr "unique(fe)" |
| $ has.na : logi FALSE |
| - attr(*, "class")= chr "density" |
| > stopifnot(all.equal(d[1:3], dw[1:3])) |
| > |
| > ## simulation from a density() fit: |
| > # a kernel density fit is an equally-weighted mixture. |
| > fit <- density(xx) |
| > N <- 1e6 |
| > x.new <- rnorm(N, sample(xx, size = N, replace = TRUE), fit$bw) |
| > plot(fit) |
| > lines(density(x.new), col = "blue") |
| > |
| > |
| > (kernels <- eval(formals(density.default)$kernel)) |
| [1] "gaussian" "epanechnikov" "rectangular" "triangular" "biweight" |
| [6] "cosine" "optcosine" |
| > |
| > ## show the kernels in the R parametrization |
| > plot (density(0, bw = 1), xlab = "", |
| + main = "R's density() kernels with bw = 1") |
| > for(i in 2:length(kernels)) |
| + lines(density(0, bw = 1, kernel = kernels[i]), col = i) |
| > legend(1.5,.4, legend = kernels, col = seq(kernels), |
| + lty = 1, cex = .8, y.intersp = 1) |
| > |
| > ## show the kernels in the S parametrization |
| > plot(density(0, from = -1.2, to = 1.2, width = 2, kernel = "gaussian"), |
| + type = "l", ylim = c(0, 1), xlab = "", |
| + main = "R's density() kernels with width = 1") |
| > for(i in 2:length(kernels)) |
| + lines(density(0, width = 2, kernel = kernels[i]), col = i) |
| > legend(0.6, 1.0, legend = kernels, col = seq(kernels), lty = 1) |
| > |
| > ##-------- Semi-advanced theoretic from here on ------------- |
| > |
| > (RKs <- cbind(sapply(kernels, |
| + function(k) density(kernel = k, give.Rkern = TRUE)))) |
| [,1] |
| gaussian 0.2820948 |
| epanechnikov 0.2683282 |
| rectangular 0.2886751 |
| triangular 0.2721655 |
| biweight 0.2699746 |
| cosine 0.2711340 |
| optcosine 0.2684756 |
| > 100*round(RKs["epanechnikov",]/RKs, 4) ## Efficiencies |
| [,1] |
| gaussian 95.12 |
| epanechnikov 100.00 |
| rectangular 92.95 |
| triangular 98.59 |
| biweight 99.39 |
| cosine 98.97 |
| optcosine 99.95 |
| > |
| > bw <- bw.SJ(precip) ## sensible automatic choice |
| > plot(density(precip, bw = bw), |
| + main = "same sd bandwidths, 7 different kernels") |
| > for(i in 2:length(kernels)) |
| + lines(density(precip, bw = bw, kernel = kernels[i]), col = i) |
| > |
| > ## Bandwidth Adjustment for "Exactly Equivalent Kernels" |
| > h.f <- sapply(kernels, function(k)density(kernel = k, give.Rkern = TRUE)) |
| > (h.f <- (h.f["gaussian"] / h.f)^ .2) |
| gaussian epanechnikov rectangular triangular biweight cosine |
| 1.0000000 1.0100567 0.9953989 1.0071923 1.0088217 1.0079575 |
| optcosine |
| 1.0099458 |
| > ## -> 1, 1.01, .995, 1.007,... close to 1 => adjustment barely visible.. |
| > |
| > plot(density(precip, bw = bw), |
| + main = "equivalent bandwidths, 7 different kernels") |
| > for(i in 2:length(kernels)) |
| + lines(density(precip, bw = bw, adjust = h.f[i], kernel = kernels[i]), |
| + col = i) |
| > legend(55, 0.035, legend = kernels, col = seq(kernels), lty = 1) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("deriv") |
| > ### * deriv |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: deriv |
| > ### Title: Symbolic and Algorithmic Derivatives of Simple Expressions |
| > ### Aliases: D deriv deriv.default deriv.formula deriv3 deriv3.default |
| > ### deriv3.formula |
| > ### Keywords: math nonlinear |
| > |
| > ### ** Examples |
| > |
| > ## formula argument : |
| > dx2x <- deriv(~ x^2, "x") ; dx2x |
| expression({ |
| .value <- x^2 |
| .grad <- array(0, c(length(.value), 1L), list(NULL, c("x"))) |
| .grad[, "x"] <- 2 * x |
| attr(.value, "gradient") <- .grad |
| .value |
| }) |
| > ## Not run: |
| > ##D expression({ |
| > ##D .value <- x^2 |
| > ##D .grad <- array(0, c(length(.value), 1), list(NULL, c("x"))) |
| > ##D .grad[, "x"] <- 2 * x |
| > ##D attr(.value, "gradient") <- .grad |
| > ##D .value |
| > ##D }) |
| > ## End(Not run) |
| > mode(dx2x) |
| [1] "expression" |
| > x <- -1:2 |
| > eval(dx2x) |
| [1] 1 0 1 4 |
| attr(,"gradient") |
| x |
| [1,] -2 |
| [2,] 0 |
| [3,] 2 |
| [4,] 4 |
| > |
| > ## Something 'tougher': |
| > trig.exp <- expression(sin(cos(x + y^2))) |
| > ( D.sc <- D(trig.exp, "x") ) |
| -(cos(cos(x + y^2)) * sin(x + y^2)) |
| > all.equal(D(trig.exp[[1]], "x"), D.sc) |
| [1] TRUE |
| > |
| > ( dxy <- deriv(trig.exp, c("x", "y")) ) |
| expression({ |
| .expr2 <- x + y^2 |
| .expr3 <- cos(.expr2) |
| .expr5 <- cos(.expr3) |
| .expr6 <- sin(.expr2) |
| .value <- sin(.expr3) |
| .grad <- array(0, c(length(.value), 2L), list(NULL, c("x", |
| "y"))) |
| .grad[, "x"] <- -(.expr5 * .expr6) |
| .grad[, "y"] <- -(.expr5 * (.expr6 * (2 * y))) |
| attr(.value, "gradient") <- .grad |
| .value |
| }) |
| > y <- 1 |
| > eval(dxy) |
| [1] 0.8414710 0.5143953 -0.4042392 -0.8360219 |
| attr(,"gradient") |
| x y |
| [1,] 0.0000000 0.000000 |
| [2,] -0.7216061 -1.443212 |
| [3,] -0.8316919 -1.663384 |
| [4,] -0.0774320 -0.154864 |
| > eval(D.sc) |
| [1] 0.0000000 -0.7216061 -0.8316919 -0.0774320 |
| > |
| > ## function returned: |
| > deriv((y ~ sin(cos(x) * y)), c("x","y"), func = TRUE) |
| function (x, y) |
| { |
| .expr1 <- cos(x) |
| .expr2 <- .expr1 * y |
| .expr4 <- cos(.expr2) |
| .value <- sin(.expr2) |
| .grad <- array(0, c(length(.value), 2L), list(NULL, c("x", |
| "y"))) |
| .grad[, "x"] <- -(.expr4 * (sin(x) * y)) |
| .grad[, "y"] <- .expr4 * .expr1 |
| attr(.value, "gradient") <- .grad |
| .value |
| } |
| > |
| > ## function with defaulted arguments: |
| > (fx <- deriv(y ~ b0 + b1 * 2^(-x/th), c("b0", "b1", "th"), |
| + function(b0, b1, th, x = 1:7){} ) ) |
| function (b0, b1, th, x = 1:7) |
| { |
| .expr3 <- 2^(-x/th) |
| .value <- b0 + b1 * .expr3 |
| .grad <- array(0, c(length(.value), 3L), list(NULL, c("b0", |
| "b1", "th"))) |
| .grad[, "b0"] <- 1 |
| .grad[, "b1"] <- .expr3 |
| .grad[, "th"] <- b1 * (.expr3 * (log(2) * (x/th^2))) |
| attr(.value, "gradient") <- .grad |
| .value |
| } |
| > fx(2, 3, 4) |
| [1] 4.522689 4.121320 3.783811 3.500000 3.261345 3.060660 2.891905 |
| attr(,"gradient") |
| b0 b1 th |
| [1,] 1 0.8408964 0.1092872 |
| [2,] 1 0.7071068 0.1837984 |
| [3,] 1 0.5946036 0.2318331 |
| [4,] 1 0.5000000 0.2599302 |
| [5,] 1 0.4204482 0.2732180 |
| [6,] 1 0.3535534 0.2756976 |
| [7,] 1 0.2973018 0.2704720 |
| > |
| > ## 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") <- .grad |
| attr(.value, "hessian") <- .hessian |
| .value |
| } |
| > |
| > ## Higher derivatives: |
| > DD <- function(expr, name, order = 1) { |
| + if(order < 1) stop("'order' must be >= 1") |
| + if(order == 1) D(expr, name) |
| + else DD(D(expr, name), name, order - 1) |
| + } |
| > DD(expression(sin(x^2)), "x", 3) |
| -(sin(x^2) * (2 * x) * 2 + ((cos(x^2) * (2 * x) * (2 * x) + sin(x^2) * |
| 2) * (2 * x) + sin(x^2) * (2 * x) * 2)) |
| > ## showing the limits of the internal "simplify()" : |
| > ## Not run: |
| > ##D -sin(x^2) * (2 * x) * 2 + ((cos(x^2) * (2 * x) * (2 * x) + sin(x^2) * |
| > ##D 2) * (2 * x) + sin(x^2) * (2 * x) * 2) |
| > ## End(Not run) |
| > |
| > ## 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) - 1 |
| exp(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 4 |
| 2 5.701817 |
| 3 6.013119 5.032069 |
| 4 7.276905 5.325473 5.811861 |
| 5 6.619295 5.306750 4.945987 6.612081 |
| > dist(x, diag = TRUE) |
| 1 2 3 4 5 |
| 1 0.000000 |
| 2 5.701817 0.000000 |
| 3 6.013119 5.032069 0.000000 |
| 4 7.276905 5.325473 5.811861 0.000000 |
| 5 6.619295 5.306750 4.945987 6.612081 0.000000 |
| > dist(x, upper = TRUE) |
| 1 2 3 4 5 |
| 1 5.701817 6.013119 7.276905 6.619295 |
| 2 5.701817 5.032069 5.325473 5.306750 |
| 3 6.013119 5.032069 5.811861 4.945987 |
| 4 7.276905 5.325473 5.811861 6.612081 |
| 5 6.619295 5.306750 4.945987 6.612081 |
| > m <- as.matrix(dist(x)) |
| > d <- as.dist(m) |
| > stopifnot(d == dist(x)) |
| > |
| > ## Use correlations between variables "as distance" |
| > dd <- as.dist((1 - cor(USJudgeRatings))/2) |
| > round(1000 * dd) # (prints more nicely) |
| CONT INTG DMNR DILG CFMG DECI PREP FAMI ORAL WRIT PHYS |
| INTG 567 |
| DMNR 577 18 |
| DILG 494 64 82 |
| CFMG 432 93 93 21 |
| DECI 457 99 98 22 9 |
| PREP 494 61 72 11 21 21 |
| FAMI 513 66 79 21 32 29 5 |
| ORAL 506 44 47 23 25 26 8 9 |
| WRIT 522 46 53 20 29 27 7 5 3 |
| PHYS 473 129 106 94 60 64 76 78 54 72 |
| RTEN 517 31 28 35 36 38 25 29 9 16 47 |
| > plot(hclust(dd)) # to see a dendrogram of clustered variables |
| > |
| > ## example of binary and canberra distances. |
| > x <- c(0, 0, 1, 1, 1, 1) |
| > y <- c(1, 0, 1, 1, 0, 1) |
| > dist(rbind(x, y), method = "binary") |
| x |
| y 0.4 |
| > ## answer 0.4 = 2/5 |
| > dist(rbind(x, y), method = "canberra") |
| x |
| y 2.4 |
| > ## answer 2 * (6/5) |
| > |
| > ## To find the names |
| > labels(eurodist) |
| [1] "Athens" "Barcelona" "Brussels" "Calais" |
| [5] "Cherbourg" "Cologne" "Copenhagen" "Geneva" |
| [9] "Gibraltar" "Hamburg" "Hook of Holland" "Lisbon" |
| [13] "Lyons" "Madrid" "Marseilles" "Milan" |
| [17] "Munich" "Paris" "Rome" "Stockholm" |
| [21] "Vienna" |
| > |
| > ## Examples involving "Inf" : |
| > ## 1) |
| > x[6] <- Inf |
| > (m2 <- rbind(x, y)) |
| [,1] [,2] [,3] [,4] [,5] [,6] |
| x 0 0 1 1 1 Inf |
| y 1 0 1 1 0 1 |
| > dist(m2, method = "binary") # warning, answer 0.5 = 2/4 |
| Warning in dist(m2, method = "binary") : |
| treating non-finite values as NA |
| x |
| y 0.5 |
| > ## These all give "Inf": |
| > stopifnot(Inf == dist(m2, method = "euclidean"), |
| + Inf == dist(m2, method = "maximum"), |
| + Inf == dist(m2, method = "manhattan")) |
| > ## "Inf" is same as very large number: |
| > x1 <- x; x1[6] <- 1e100 |
| > stopifnot(dist(cbind(x, y), method = "canberra") == |
| + print(dist(cbind(x1, y), method = "canberra"))) |
| 1 2 3 4 5 |
| 2 2 |
| 3 1 2 |
| 4 1 2 0 |
| 5 2 2 1 1 |
| 6 1 2 1 1 2 |
| > |
| > ## 2) |
| > y[6] <- Inf #-> 6-th pair is excluded |
| > dist(rbind(x, y), method = "binary" ) # warning; 0.5 |
| Warning in dist(rbind(x, y), method = "binary") : |
| treating non-finite values as NA |
| x |
| y 0.5 |
| > dist(rbind(x, y), method = "canberra" ) # 3 |
| x |
| y 3 |
| > dist(rbind(x, y), method = "maximum") # 1 |
| x |
| y 1 |
| > dist(rbind(x, y), method = "manhattan") # 2.4 |
| x |
| y 2.4 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("dummy.coef") |
| > ### * dummy.coef |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: dummy.coef |
| > ### Title: Extract Coefficients in Original Coding |
| > ### Aliases: dummy.coef dummy.coef.lm dummy.coef.aovlist |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > options(contrasts = c("contr.helmert", "contr.poly")) |
| > ## From Venables and Ripley (2002) p.165. |
| > npk.aov <- aov(yield ~ block + N*P*K, npk) |
| > dummy.coef(npk.aov) |
| Full coefficients are |
| |
| (Intercept): 54.875 |
| block: 1 2 3 4 5 6 |
| -0.850 2.575 5.900 -4.750 -4.350 1.475 |
| N: 0 1 |
| -2.808333 2.808333 |
| P: 0 1 |
| 0.5916667 -0.5916667 |
| K: 0 1 |
| 1.991667 -1.991667 |
| N:P: 0:0 1:0 0:1 1:1 |
| -0.9416667 0.9416667 0.9416667 -0.9416667 |
| N:K: 0:0 1:0 0:1 1:1 |
| -1.175 1.175 1.175 -1.175 |
| P:K: 0:0 1:0 0:1 1:1 |
| 0.1416667 -0.1416667 -0.1416667 0.1416667 |
| N:P:K: 0:0:0 1:0:0 0:1:0 1:1:0 0:0:1 1:0:1 0:1:1 |
| 0 0 0 0 0 0 0 |
| |
| (Intercept): |
| block: |
| |
| N: |
| |
| P: |
| |
| K: |
| |
| N:P: |
| |
| N:K: |
| |
| P:K: |
| |
| N:P:K: 1:1:1 |
| 0 |
| > |
| > npk.aovE <- aov(yield ~ N*P*K + Error(block), npk) |
| > dummy.coef(npk.aovE) |
| |
| Error: (Intercept) |
| |
| (Intercept): 54.875 |
| |
| Error: block |
| |
| N:P:K: 0:0:0 1:0:0 0:1:0 1:1:0 0:0:1 1:0:1 0:1:1 |
| -1.241667 1.241667 1.241667 -1.241667 1.241667 -1.241667 -1.241667 |
| |
| N:P:K: 1:1:1 |
| 1.241667 |
| |
| Error: Within |
| |
| N: 0 1 |
| -2.808333 2.808333 |
| P: 0 1 |
| 0.5916667 -0.5916667 |
| K: 0 1 |
| 1.991667 -1.991667 |
| N:P: 0:0 1:0 0:1 1:1 |
| -0.9416667 0.9416667 0.9416667 -0.9416667 |
| N:K: 0:0 1:0 0:1 1:1 |
| -1.175 1.175 1.175 -1.175 |
| P:K: 0:0 1:0 0:1 1:1 |
| 0.1416667 -0.1416667 -0.1416667 0.1416667 |
| > |
| > |
| > |
| > 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 CDF |
| Call: ecdf(x) |
| x[1:12] = -0.83563, -0.82047, -0.62645, ..., 1.5118, 1.5953 |
| > Fn(x) # returns the percentiles for x |
| [1] 0.25000000 0.41666667 0.08333333 1.00000000 0.50000000 0.16666667 |
| [7] 0.66666667 0.83333333 0.75000000 0.33333333 0.91666667 0.58333333 |
| > tt <- seq(-2, 2, by = 0.1) |
| > 12 * Fn(tt) # Fn is a 'simple' function {with values k/12} |
| [1] 0 0 0 0 0 0 0 0 0 0 0 0 2 2 3 3 3 4 4 4 4 4 5 5 7 |
| [26] 8 9 9 10 10 10 10 10 10 10 10 12 12 12 12 12 |
| > summary(Fn) |
| Empirical CDF: 12 unique values with summary |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| -0.8356 -0.3857 0.3597 0.2686 0.6164 1.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) |
| > Fn12 |
| Empirical CDF |
| Call: ecdf(y) |
| x[1:8] = -2.2, -2, -0.6, ..., 0.8, 0.9 |
| > knots(Fn12) # unique values (always less than 12!) |
| [1] -2.2 -2.0 -0.6 0.0 0.1 0.6 0.8 0.9 |
| > summary(Fn12) |
| Empirical CDF: 8 unique values with summary |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| -2.20 -0.95 0.05 -0.30 0.65 0.90 |
| > summary.stepfun(Fn12) |
| Step function with continuity 'f'= 0 , 8 knots with summary |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| -2.20 -0.95 0.05 -0.30 0.65 0.90 |
| |
| and 9 plateau levels (y) with summary |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| 0.0000 0.1667 0.5000 0.4630 0.6667 1.0000 |
| > |
| > ## Advanced: What's inside the function closure? |
| > ls(environment(Fn12)) |
| [1] "f" "method" "nobs" "x" "y" "yleft" "yright" |
| > ##[1] "f" "method" "n" "x" "y" "yleft" "yright" |
| > utils::ls.str(environment(Fn12)) |
| f : num 0 |
| method : int 2 |
| nobs : int 12 |
| x : num [1:8] -2.2 -2 -0.6 0 0.1 0.6 0.8 0.9 |
| y : num [1:8] 0.0833 0.1667 0.3333 0.5 0.5833 ... |
| yleft : num 0 |
| yright : num 1 |
| > 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 summary |
| Min. 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.5938 |
| |
| Stratum 1: Block |
| |
| Terms: |
| A:B A:C B:C A:B:C Residuals |
| Sum of Squares 780.1250 276.1250 2556.1250 112.5000 774.0938 |
| Deg. of Freedom 1 1 1 1 3 |
| |
| Residual standard error: 16.06335 |
| Estimated effects are balanced |
| |
| Stratum 2: Within |
| |
| Terms: |
| A B C A:B A:C B:C |
| Sum of Squares 3465.28 161170.03 278817.78 28.17 1802.67 11528.17 |
| Deg. of Freedom 1 1 1 1 1 1 |
| A:B:C Residuals |
| Sum of Squares 45.37 5423.28 |
| Deg. of Freedom 1 17 |
| |
| Residual standard error: 17.86103 |
| Estimated effects are balanced |
| > ## IGNORE_RDIFF_END |
| > eff.aovlist(fit) |
| A B C A:B A:C B:C A:B:C |
| Block 0 0 0 0.25 0.25 0.25 0.25 |
| Within 1 1 1 0.75 0.75 0.75 0.75 |
| > options(contrasts = old) |
| > |
| > |
| > |
| > 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.2302295 |
| attr(,"assign") |
| [1] 0 1 |
| attr(,"class") |
| [1] "coef" |
| > c( round(ee - effects(lm(y+10 ~ I(x-3.8))), 3) ) |
| (Intercept) x |
| 22.361 0.000 0.000 0.000 0.000 |
| > # just the first is different |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("embed") |
| > ### * embed |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: embed |
| > ### Title: Embedding a Time Series |
| > ### Aliases: embed |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > x <- 1:10 |
| > embed (x, 3) |
| [,1] [,2] [,3] |
| [1,] 3 2 1 |
| [2,] 4 3 2 |
| [3,] 5 4 3 |
| [4,] 6 5 4 |
| [5,] 7 6 5 |
| [6,] 8 7 6 |
| [7,] 9 8 7 |
| [8,] 10 9 8 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("expand.model.frame") |
| > ### * expand.model.frame |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: expand.model.frame |
| > ### Title: Add new variables to a model frame |
| > ### Aliases: expand.model.frame |
| > ### Keywords: manip regression |
| > |
| > ### ** Examples |
| > |
| > model <- lm(log(Volume) ~ log(Girth) + log(Height), data = trees) |
| > expand.model.frame(model, ~ Girth) # prints data.frame like |
| log(Volume) log(Girth) log(Height) Girth |
| 1 2.332144 2.116256 4.248495 8.3 |
| 2 2.332144 2.151762 4.174387 8.6 |
| 3 2.322388 2.174752 4.143135 8.8 |
| 4 2.797281 2.351375 4.276666 10.5 |
| 5 2.933857 2.370244 4.394449 10.7 |
| 6 2.980619 2.379546 4.418841 10.8 |
| 7 2.747271 2.397895 4.189655 11.0 |
| 8 2.901422 2.397895 4.317488 11.0 |
| 9 3.117950 2.406945 4.382027 11.1 |
| 10 2.990720 2.415914 4.317488 11.2 |
| 11 3.186353 2.424803 4.369448 11.3 |
| 12 3.044522 2.433613 4.330733 11.4 |
| 13 3.063391 2.433613 4.330733 11.4 |
| 14 3.058707 2.459589 4.234107 11.7 |
| 15 2.949688 2.484907 4.317488 12.0 |
| 16 3.100092 2.557227 4.304065 12.9 |
| 17 3.520461 2.557227 4.442651 12.9 |
| 18 3.310543 2.587764 4.454347 13.3 |
| 19 3.246491 2.617396 4.262680 13.7 |
| 20 3.214868 2.624669 4.158883 13.8 |
| 21 3.540959 2.639057 4.356709 14.0 |
| 22 3.456317 2.653242 4.382027 14.2 |
| 23 3.591818 2.674149 4.304065 14.5 |
| 24 3.645450 2.772589 4.276666 16.0 |
| 25 3.751854 2.791165 4.343805 16.3 |
| 26 4.014580 2.850707 4.394449 17.3 |
| 27 4.019980 2.862201 4.406719 17.5 |
| 28 4.065602 2.884801 4.382027 17.9 |
| 29 3.941582 2.890372 4.382027 18.0 |
| 30 3.931826 2.890372 4.382027 18.0 |
| 31 4.343805 3.025291 4.465908 20.6 |
| > |
| > dd <- data.frame(x = 1:5, y = rnorm(5), z = c(1,2,NA,4,5)) |
| > model <- glm(y ~ x, data = dd, subset = 1:4, na.action = na.omit) |
| > expand.model.frame(model, "z", na.expand = FALSE) # = default |
| y x z |
| 1 -0.6264538 1 1 |
| 2 0.1836433 2 2 |
| 4 1.5952808 4 4 |
| > expand.model.frame(model, "z", na.expand = TRUE) |
| y x z |
| 1 -0.6264538 1 1 |
| 2 0.1836433 2 2 |
| 3 -0.8356286 3 NA |
| 4 1.5952808 4 4 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("extractAIC") |
| > ### * extractAIC |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: extractAIC |
| > ### Title: Extract AIC from a Fitted Model |
| > ### Aliases: extractAIC |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > |
| > cleanEx() |
| > nameEx("factanal") |
| > ### * factanal |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: factanal |
| > ### Title: Factor Analysis |
| > ### Aliases: factanal |
| > ### Keywords: multivariate |
| > |
| > ### ** Examples |
| > |
| > # A little demonstration, v2 is just v1 with noise, |
| > # and same for v4 vs. v3 and v6 vs. v5 |
| > # Last four cases are there to add noise |
| > # and introduce a positive manifold (g factor) |
| > v1 <- c(1,1,1,1,1,1,1,1,1,1,3,3,3,3,3,4,5,6) |
| > v2 <- c(1,2,1,1,1,1,2,1,2,1,3,4,3,3,3,4,6,5) |
| > v3 <- c(3,3,3,3,3,1,1,1,1,1,1,1,1,1,1,5,4,6) |
| > v4 <- c(3,3,4,3,3,1,1,2,1,1,1,1,2,1,1,5,6,4) |
| > v5 <- c(1,1,1,1,1,3,3,3,3,3,1,1,1,1,1,6,4,5) |
| > v6 <- c(1,1,1,2,1,3,3,3,4,3,1,1,1,2,1,6,5,4) |
| > m1 <- cbind(v1,v2,v3,v4,v5,v6) |
| > cor(m1) |
| v1 v2 v3 v4 v5 v6 |
| v1 1.0000000 0.9393083 0.5128866 0.4320310 0.4664948 0.4086076 |
| v2 0.9393083 1.0000000 0.4124441 0.4084281 0.4363925 0.4326113 |
| v3 0.5128866 0.4124441 1.0000000 0.8770750 0.5128866 0.4320310 |
| v4 0.4320310 0.4084281 0.8770750 1.0000000 0.4320310 0.4323259 |
| v5 0.4664948 0.4363925 0.5128866 0.4320310 1.0000000 0.9473451 |
| v6 0.4086076 0.4326113 0.4320310 0.4323259 0.9473451 1.0000000 |
| > factanal(m1, factors = 3) # varimax is the default |
| |
| Call: |
| factanal(x = m1, factors = 3) |
| |
| Uniquenesses: |
| v1 v2 v3 v4 v5 v6 |
| 0.005 0.101 0.005 0.224 0.084 0.005 |
| |
| Loadings: |
| Factor1 Factor2 Factor3 |
| v1 0.944 0.182 0.267 |
| v2 0.905 0.235 0.159 |
| v3 0.236 0.210 0.946 |
| v4 0.180 0.242 0.828 |
| v5 0.242 0.881 0.286 |
| v6 0.193 0.959 0.196 |
| |
| Factor1 Factor2 Factor3 |
| SS loadings 1.893 1.886 1.797 |
| Proportion Var 0.316 0.314 0.300 |
| Cumulative Var 0.316 0.630 0.929 |
| |
| The degrees of freedom for the model is 0 and the fit was 0.4755 |
| > # The following shows the g factor as PC1 |
| > |
| > ## formula interface |
| > factanal(~v1+v2+v3+v4+v5+v6, factors = 3, |
| + scores = "Bartlett")$scores |
| Factor1 Factor2 Factor3 |
| 1 -0.9039949 -0.9308984 0.9475392 |
| 2 -0.8685952 -0.9328721 0.9352330 |
| 3 -0.9082818 -0.9320093 0.9616422 |
| 4 -1.0021975 -0.2529689 0.8178552 |
| 5 -0.9039949 -0.9308984 0.9475392 |
| 6 -0.7452711 0.7273960 -0.7884733 |
| 7 -0.7098714 0.7254223 -0.8007795 |
| 8 -0.7495580 0.7262851 -0.7743704 |
| 9 -0.8080740 1.4033517 -0.9304636 |
| 10 -0.7452711 0.7273960 -0.7884733 |
| 11 0.9272282 -0.9307506 -0.8371538 |
| 12 0.9626279 -0.9327243 -0.8494600 |
| 13 0.9229413 -0.9318615 -0.8230509 |
| 14 0.8290256 -0.2528211 -0.9668378 |
| 15 0.9272282 -0.9307506 -0.8371538 |
| 16 0.4224366 2.0453079 1.2864761 |
| 17 1.4713902 1.2947716 0.5451562 |
| 18 1.8822320 0.3086244 1.9547752 |
| > |
| > |
| > |
| > 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 |
| > nf |
| |
| Family: gaussian |
| Link 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() |
| > gf |
| |
| Family: Gamma |
| Link function: inverse |
| |
| > str(gf) |
| List of 12 |
| $ family : chr "Gamma" |
| $ link : chr "inverse" |
| $ linkfun :function (mu) |
| $ linkinv :function (eta) |
| $ variance :function (mu) |
| $ dev.resids:function (y, mu, wt) |
| $ aic :function (y, n, mu, wt, dev) |
| $ mu.eta :function (eta) |
| $ initialize: expression({ if (any(y <= 0)) stop("non-positive values not allowed for the 'gamma' family") n <- rep.int(1, n| __truncated__ |
| $ validmu :function (mu) |
| $ valideta :function (eta) |
| $ simulate :function (object, nsim) |
| - attr(*, "class")= chr "family" |
| > gf$linkinv |
| function (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: binomial |
| Link 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 as |
| |
| Family: binomial |
| Link function: identity |
| |
| > binomial(link = make.link("identity")) |
| |
| Family: binomial |
| Link 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) x |
| 0.8596 1.0875 |
| |
| Degrees of Freedom: 99 Total (i.e. Null); 98 Residual |
| Null Deviance: 481.9 |
| Residual Deviance: 101.7 AIC: NA |
| > # which is the same as |
| > glm(y ~ x, family = poisson) |
| |
| Call: glm(formula = y ~ x, family = poisson) |
| |
| Coefficients: |
| (Intercept) x |
| 0.8596 1.0875 |
| |
| Degrees of Freedom: 99 Total (i.e. Null); 98 Residual |
| Null Deviance: 481.9 |
| Residual Deviance: 101.7 AIC: 364 |
| > glm(y ~ x, family = quasi(variance = "mu^2", link = "log")) |
| |
| Call: glm(formula = y ~ x, family = quasi(variance = "mu^2", link = "log")) |
| |
| Coefficients: |
| (Intercept) x |
| 0.6902 1.4546 |
| |
| Degrees of Freedom: 99 Total (i.e. Null); 98 Residual |
| Null Deviance: 83.85 |
| Residual Deviance: 32.45 AIC: NA |
| > ## Not run: glm(y ~ x, family = quasi(variance = "mu^3", link = "log")) # fails |
| > y <- rbinom(100, 1, plogis(x)) |
| > # 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.38518 |
| |
| Degrees of Freedom: 99 Total (i.e. Null); 98 Residual |
| Null Deviance: 138.6 |
| Residual Deviance: 135.8 AIC: NA |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("fft") |
| > ### * fft |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: fft |
| > ### Title: Fast Discrete Fourier Transform (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 = 1 |
| End = 100 |
| Frequency = 1 |
| [1] NA 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51 54 |
| [19] 57 60 63 66 69 72 75 78 81 84 87 90 93 96 99 102 105 108 |
| [37] 111 114 117 120 123 126 129 132 135 138 141 144 147 150 153 156 159 162 |
| [55] 165 168 171 174 177 180 183 186 189 192 195 198 201 204 207 210 213 216 |
| [73] 219 222 225 228 231 234 237 240 243 246 249 252 255 258 261 264 267 270 |
| [91] 273 276 279 282 285 288 291 294 297 NA |
| > filter(x, rep(1, 3), sides = 1) |
| Time Series: |
| Start = 1 |
| End = 100 |
| Frequency = 1 |
| [1] NA NA 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51 |
| [19] 54 57 60 63 66 69 72 75 78 81 84 87 90 93 96 99 102 105 |
| [37] 108 111 114 117 120 123 126 129 132 135 138 141 144 147 150 153 156 159 |
| [55] 162 165 168 171 174 177 180 183 186 189 192 195 198 201 204 207 210 213 |
| [73] 216 219 222 225 228 231 234 237 240 243 246 249 252 255 258 261 264 267 |
| [91] 270 273 276 279 282 285 288 291 294 297 |
| > filter(x, rep(1, 3), sides = 1, circular = TRUE) |
| Time Series: |
| Start = 1 |
| End = 100 |
| Frequency = 1 |
| [1] 200 103 6 9 12 15 18 21 24 27 30 33 36 39 42 45 48 51 |
| [19] 54 57 60 63 66 69 72 75 78 81 84 87 90 93 96 99 102 105 |
| [37] 108 111 114 117 120 123 126 129 132 135 138 141 144 147 150 153 156 159 |
| [55] 162 165 168 171 174 177 180 183 186 189 192 195 198 201 204 207 210 213 |
| [73] 216 219 222 225 228 231 234 237 240 243 246 249 252 255 258 261 264 267 |
| [91] 270 273 276 279 282 285 288 291 294 297 |
| > |
| > filter(presidents, rep(1, 3)) |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1945 NA NA 244 220 |
| 1946 188 156 125 110 |
| 1947 127 149 169 145 |
| 1948 130 NA NA NA |
| 1949 NA 183 165 153 |
| 1950 133 128 122 121 |
| 1951 99 92 79 80 |
| 1952 80 NA NA NA |
| 1953 165 208 209 206 |
| 1954 192 203 189 199 |
| 1955 196 218 220 228 |
| 1956 220 214 213 221 |
| 1957 216 204 182 180 |
| 1958 166 157 149 157 |
| 1959 171 180 189 198 |
| 1960 199 194 180 190 |
| 1961 212 226 232 228 |
| 1962 228 212 207 212 |
| 1963 214 202 183 199 |
| 1964 210 222 211 209 |
| 1965 204 204 195 194 |
| 1966 171 165 146 144 |
| 1967 140 134 136 120 |
| 1968 131 120 128 138 |
| 1969 168 189 186 187 |
| 1970 175 180 166 164 |
| 1971 151 153 151 152 |
| 1972 159 NA NA NA |
| 1973 NA 152 111 95 |
| 1974 80 77 73 NA |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("fisher.test") |
| > ### * fisher.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: fisher.test |
| > ### Title: Fisher's Exact Test for Count Data |
| > ### Aliases: fisher.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > ## Agresti (1990, p. 61f; 2002, p. 91) Fisher's Tea Drinker |
| > ## A British woman claimed to be able to distinguish whether milk or |
| > ## tea was added to the cup first. To test, she was given 8 cups of |
| > ## tea, in four of which milk was added first. The null hypothesis |
| > ## is that there is no association between the true order of pouring |
| > ## and the woman's guess, the alternative that there is a positive |
| > ## association (that the odds ratio is greater than 1). |
| > TeaTasting <- |
| + matrix(c(3, 1, 1, 3), |
| + nrow = 2, |
| + dimnames = list(Guess = c("Milk", "Tea"), |
| + Truth = c("Milk", "Tea"))) |
| > fisher.test(TeaTasting, alternative = "greater") |
| |
| Fisher's Exact Test for Count Data |
| |
| data: TeaTasting |
| p-value = 0.2429 |
| alternative hypothesis: true odds ratio is greater than 1 |
| 95 percent confidence interval: |
| 0.3135693 Inf |
| sample estimates: |
| odds ratio |
| 6.408309 |
| |
| > ## => p = 0.2429, association could not be established |
| > |
| > ## Fisher (1962, 1970), Criminal convictions of like-sex twins |
| > Convictions <- matrix(c(2, 10, 15, 3), nrow = 2, |
| + dimnames = |
| + list(c("Dizygotic", "Monozygotic"), |
| + c("Convicted", "Not convicted"))) |
| > Convictions |
| Convicted Not convicted |
| Dizygotic 2 15 |
| Monozygotic 10 3 |
| > fisher.test(Convictions, alternative = "less") |
| |
| Fisher's Exact Test for Count Data |
| |
| data: Convictions |
| p-value = 0.0004652 |
| alternative hypothesis: true odds ratio is less than 1 |
| 95 percent confidence interval: |
| 0.0000000 0.2849601 |
| sample estimates: |
| odds ratio |
| 0.04693661 |
| |
| > fisher.test(Convictions, conf.int = FALSE) |
| |
| Fisher's Exact Test for Count Data |
| |
| data: Convictions |
| p-value = 0.0005367 |
| alternative hypothesis: true odds ratio is not equal to 1 |
| sample estimates: |
| odds ratio |
| 0.04693661 |
| |
| > fisher.test(Convictions, conf.level = 0.95)$conf.int |
| [1] 0.003325764 0.363182271 |
| attr(,"conf.level") |
| [1] 0.95 |
| > fisher.test(Convictions, conf.level = 0.99)$conf.int |
| [1] 0.001386333 0.578851645 |
| attr(,"conf.level") |
| [1] 0.99 |
| > |
| > ## A r x c table Agresti (2002, p. 57) Job Satisfaction |
| > Job <- matrix(c(1,2,1,0, 3,3,6,1, 10,10,14,9, 6,7,12,11), 4, 4, |
| + dimnames = list(income = c("< 15k", "15-25k", "25-40k", "> 40k"), |
| + satisfaction = c("VeryD", "LittleD", "ModerateS", "VeryS"))) |
| > fisher.test(Job) # 0.7827 |
| |
| Fisher's Exact Test for Count Data |
| |
| data: Job |
| p-value = 0.7827 |
| alternative hypothesis: two.sided |
| |
| > fisher.test(Job, simulate.p.value = TRUE, B = 1e5) # also close to 0.78 |
| |
| Fisher's Exact Test for Count Data with simulated p-value (based on |
| 1e+05 replicates) |
| |
| data: Job |
| p-value = 0.7842 |
| alternative hypothesis: two.sided |
| |
| > |
| > ## 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 Data |
| |
| data: MP6 |
| p-value = 0.03929 |
| alternative 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: MP6 |
| p-value = 0.03929 |
| alternative hypothesis: two.sided |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("fivenum") |
| > ### * fivenum |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: fivenum |
| > ### Title: Tukey Five-Number Summaries |
| > ### Aliases: fivenum |
| > ### Keywords: univar robust distribution |
| > |
| > ### ** Examples |
| > |
| > fivenum(c(rnorm(100), -1:1/0)) |
| [1] -Inf -0.5425200 0.1139092 0.6969634 Inf |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("fligner.test") |
| > ### * fligner.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: fligner.test |
| > ### Title: Fligner-Killeen Test of Homogeneity of Variances |
| > ### Aliases: fligner.test fligner.test.default fligner.test.formula |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > plot(count ~ spray, data = InsectSprays) |
| > fligner.test(InsectSprays$count, InsectSprays$spray) |
| |
| Fligner-Killeen test of homogeneity of variances |
| |
| data: InsectSprays$count and InsectSprays$spray |
| Fligner-Killeen:med chi-squared = 14.483, df = 5, p-value = 0.01282 |
| |
| > fligner.test(count ~ spray, data = InsectSprays) |
| |
| Fligner-Killeen test of homogeneity of variances |
| |
| data: count by spray |
| Fligner-Killeen:med chi-squared = 14.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" |
| > fo |
| y ~ x1 * x2 |
| > typeof(fo) # R internal : "language" |
| [1] "language" |
| > terms(fo) |
| y ~ x1 * x2 |
| attr(,"variables") |
| list(y, x1, x2) |
| attr(,"factors") |
| x1 x2 x1:x2 |
| y 0 0 0 |
| x1 1 0 1 |
| x2 0 1 1 |
| attr(,"term.labels") |
| [1] "x1" "x2" "x1:x2" |
| attr(,"order") |
| [1] 1 1 2 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > |
| > environment(fo) |
| <environment: R_GlobalEnv> |
| > environment(as.formula("y ~ x")) |
| <environment: R_GlobalEnv> |
| > environment(as.formula("y ~ x", env = new.env())) |
| <environment: 0x68cb030> |
| > |
| > |
| > ## 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 test |
| |
| data: RoundingTimes |
| Friedman 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) |
| > wb |
| w t x |
| 1 A L 44.55556 |
| 2 B L 28.22222 |
| 3 A M 24.00000 |
| 4 B M 28.77778 |
| 5 A H 24.55556 |
| 6 B H 18.77778 |
| > friedman.test(wb$x, wb$w, wb$t) |
| |
| Friedman rank sum test |
| |
| data: wb$x, wb$w and wb$t |
| Friedman chi-squared = 0.33333, df = 1, p-value = 0.5637 |
| |
| > friedman.test(x ~ w | t, data = wb) |
| |
| Friedman rank sum test |
| |
| data: x and w and t |
| Friedman chi-squared = 0.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 Yes |
| Class Sex Age |
| 1st Male Child 0 5 |
| Adult 118 57 |
| Female Child 0 1 |
| Adult 4 140 |
| 2nd Male Child 0 11 |
| Adult 154 14 |
| Female Child 0 13 |
| Adult 13 80 |
| 3rd Male Child 35 13 |
| Adult 387 75 |
| Female Child 17 14 |
| Adult 89 76 |
| Crew Male Child 0 0 |
| Adult 670 192 |
| Female Child 0 0 |
| Adult 3 20 |
| > ftable(Titanic, row.vars = 1:2, col.vars = "Survived") |
| Survived No Yes |
| Class Sex |
| 1st Male 118 62 |
| Female 4 141 |
| 2nd Male 154 25 |
| Female 13 93 |
| 3rd Male 422 88 |
| Female 106 90 |
| Crew Male 670 192 |
| Female 3 20 |
| > ftable(Titanic, row.vars = 2:1, col.vars = "Survived") |
| Survived No Yes |
| Sex Class |
| Male 1st 118 62 |
| 2nd 154 25 |
| 3rd 422 88 |
| Crew 670 192 |
| Female 1st 4 141 |
| 2nd 13 93 |
| 3rd 106 90 |
| Crew 3 20 |
| > ## Don't show: |
| > . <- integer() |
| > (f04 <- ftable(Titanic, col.vars= .)) |
| Class Sex Age Survived |
| 1st Male Child No 0 |
| Yes 5 |
| Adult No 118 |
| Yes 57 |
| Female Child No 0 |
| Yes 1 |
| Adult No 4 |
| Yes 140 |
| 2nd Male Child No 0 |
| Yes 11 |
| Adult No 154 |
| Yes 14 |
| Female Child No 0 |
| Yes 13 |
| Adult No 13 |
| Yes 80 |
| 3rd Male Child No 35 |
| Yes 13 |
| Adult No 387 |
| Yes 75 |
| Female Child No 17 |
| Yes 14 |
| Adult No 89 |
| Yes 76 |
| Crew Male Child No 0 |
| Yes 0 |
| Adult No 670 |
| Yes 192 |
| Female Child No 0 |
| Yes 0 |
| Adult No 3 |
| Yes 20 |
| > (f10 <- ftable(Titanic, col.vars= 1, row.vars= .)) |
| Class 1st 2nd 3rd Crew |
| |
| 325 285 706 885 |
| > (f01 <- ftable(Titanic, col.vars= ., row.vars= 1)) |
| Class |
| 1st 325 |
| 2nd 285 |
| 3rd 706 |
| Crew 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")]) |
| > x |
| gear 3 4 5 |
| cyl vs am |
| 4 0 0 0 0 0 |
| 1 0 0 1 |
| 1 0 1 2 0 |
| 1 0 6 1 |
| 6 0 0 0 0 0 |
| 1 0 2 1 |
| 1 0 2 2 0 |
| 1 0 0 0 |
| 8 0 0 12 0 0 |
| 1 0 0 2 |
| 1 0 0 0 0 |
| 1 0 0 0 |
| > ftable(x, row.vars = c(2, 4)) |
| cyl 4 6 8 |
| am 0 1 0 1 0 1 |
| vs gear |
| 0 3 0 0 0 0 12 0 |
| 4 0 0 0 2 0 0 |
| 5 0 1 0 1 0 2 |
| 1 3 1 0 2 0 0 0 |
| 4 2 6 2 0 0 0 |
| 5 0 1 0 0 0 0 |
| > |
| > ## Start with expressions, use table()'s "dnn" to change labels |
| > ftable(mtcars$cyl, mtcars$vs, mtcars$am, mtcars$gear, row.vars = c(2, 4), |
| + dnn = c("Cylinders", "V/S", "Transmission", "Gears")) |
| Cylinders 4 6 8 |
| Transmission 0 1 0 1 0 1 |
| V/S Gears |
| 0 3 0 0 0 0 12 0 |
| 4 0 0 0 2 0 0 |
| 5 0 1 0 1 0 2 |
| 1 3 1 0 2 0 0 0 |
| 4 2 6 2 0 0 0 |
| 5 0 1 0 0 0 0 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("ftable.formula") |
| > ### * ftable.formula |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ftable.formula |
| > ### Title: Formula Notation for Flat Contingency Tables |
| > ### Aliases: ftable.formula |
| > ### Keywords: category |
| > |
| > ### ** Examples |
| > |
| > Titanic |
| , , Age = Child, Survived = No |
| |
| Sex |
| Class Male Female |
| 1st 0 0 |
| 2nd 0 0 |
| 3rd 35 17 |
| Crew 0 0 |
| |
| , , Age = Adult, Survived = No |
| |
| Sex |
| Class Male Female |
| 1st 118 4 |
| 2nd 154 13 |
| 3rd 387 89 |
| Crew 670 3 |
| |
| , , Age = Child, Survived = Yes |
| |
| Sex |
| Class Male Female |
| 1st 5 1 |
| 2nd 11 13 |
| 3rd 13 14 |
| Crew 0 0 |
| |
| , , Age = Adult, Survived = Yes |
| |
| Sex |
| Class Male Female |
| 1st 57 140 |
| 2nd 14 80 |
| 3rd 75 76 |
| Crew 192 20 |
| |
| > x <- ftable(Survived ~ ., data = Titanic) |
| > x |
| Survived No Yes |
| Class Sex Age |
| 1st Male Child 0 5 |
| Adult 118 57 |
| Female Child 0 1 |
| Adult 4 140 |
| 2nd Male Child 0 11 |
| Adult 154 14 |
| Female Child 0 13 |
| Adult 13 80 |
| 3rd Male Child 35 13 |
| Adult 387 75 |
| Female Child 17 14 |
| Adult 89 76 |
| Crew Male Child 0 0 |
| Adult 670 192 |
| Female Child 0 0 |
| Adult 3 20 |
| > ftable(Sex ~ Class + Age, data = x) |
| Sex Male Female |
| Class Age |
| 1st Child 5 1 |
| Adult 175 144 |
| 2nd Child 11 13 |
| Adult 168 93 |
| 3rd Child 48 31 |
| Adult 462 165 |
| Crew Child 0 0 |
| Adult 862 23 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("getInitial") |
| > ### * getInitial |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: getInitial |
| > ### Title: Get Initial Parameter Estimates |
| > ### Aliases: getInitial getInitial.default getInitial.formula |
| > ### getInitial.selfStart |
| > ### Keywords: models nonlinear manip |
| > |
| > ### ** Examples |
| > |
| > PurTrt <- Puromycin[ Puromycin$state == "treated", ] |
| > print(getInitial( rate ~ SSmicmen( conc, Vm, K ), PurTrt ), digits = 3) |
| Vm K |
| 212.6837 0.0641 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("glm") |
| > ### * glm |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: glm |
| > ### Title: Fitting Generalized Linear Models |
| > ### Aliases: glm glm.fit weights.glm |
| > ### Keywords: models regression |
| > |
| > ### ** Examples |
| > |
| > ## Dobson (1990) Page 93: Randomized Controlled Trial : |
| > counts <- c(18,17,15,20,10,20,25,13,12) |
| > outcome <- gl(3,1,9) |
| > treatment <- gl(3,3) |
| > print(d.AD <- data.frame(treatment, outcome, counts)) |
| treatment outcome counts |
| 1 1 1 18 |
| 2 1 2 17 |
| 3 1 3 15 |
| 4 2 1 20 |
| 5 2 2 10 |
| 6 2 3 20 |
| 7 3 1 25 |
| 8 3 2 13 |
| 9 3 3 12 |
| > glm.D93 <- glm(counts ~ outcome + treatment, family = poisson()) |
| > anova(glm.D93) |
| Analysis of Deviance Table |
| |
| Model: poisson, link: log |
| |
| Response: counts |
| |
| Terms added sequentially (first to last) |
| |
| |
| Df Deviance Resid. Df Resid. Dev |
| NULL 8 10.5814 |
| outcome 2 5.4523 6 5.1291 |
| treatment 2 0.0000 4 5.1291 |
| > ## 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.08641 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| (Intercept) -0.0165544 0.0009275 -17.85 4.28e-07 *** |
| log(u) 0.0153431 0.0004150 36.98 2.75e-09 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| (Dispersion parameter for Gamma family taken to be 0.002446059) |
| |
| Null deviance: 3.51283 on 8 degrees of freedom |
| Residual deviance: 0.01673 on 7 degrees of freedom |
| AIC: 37.99 |
| |
| Number of Fisher Scoring iterations: 3 |
| |
| > summary(glm(lot2 ~ log(u), data = clotting, family = Gamma)) |
| |
| Call: |
| glm(formula = lot2 ~ log(u), family = Gamma, data = clotting) |
| |
| Deviance Residuals: |
| Min 1Q Median 3Q Max |
| -0.05574 -0.02925 0.01030 0.01714 0.06371 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| (Intercept) -0.0239085 0.0013265 -18.02 4.00e-07 *** |
| log(u) 0.0235992 0.0005768 40.91 1.36e-09 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| (Dispersion parameter for Gamma family taken to be 0.001813354) |
| |
| Null deviance: 3.118557 on 8 degrees of freedom |
| Residual deviance: 0.012672 on 7 degrees of freedom |
| AIC: 27.032 |
| |
| Number of Fisher Scoring iterations: 3 |
| |
| > ## 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 NA |
| |
| Degrees of Freedom: 8 Total (i.e. Null); 7 Residual |
| Null Deviance: 3.119 |
| Residual 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 vectors |
| List of 4 |
| $ rowInd: int [1:32] 31 17 16 15 5 25 29 24 7 6 ... |
| $ colInd: int [1:11] 2 9 8 11 6 5 10 7 1 4 ... |
| $ Rowv : NULL |
| $ Colv : NULL |
| > |
| > ## no column dendrogram (nor reordering) at all: |
| > heatmap(x, Colv = NA, col = cm.colors(256), scale = "column", |
| + RowSideColors = rc, margins = c(5,10), |
| + xlab = "specification variables", ylab = "Car Models", |
| + main = "heatmap(<Mtcars data>, ..., scale = \"column\")") |
| > ## Don't show: |
| > ## no row dendrogram (nor reordering) at all: |
| > heatmap(x, Rowv = NA, col = cm.colors(256), scale = "column", |
| + ColSideColors = cc, margins = c(5,10), |
| + xlab = "xlab", ylab = "ylab") # no main |
| > ## End(Don't show) |
| > ## "no nothing" |
| > heatmap(x, Rowv = NA, Colv = NA, scale = "column", |
| + main = "heatmap(*, NA, NA) ~= image(t(x))") |
| > |
| > round(Ca <- cor(attitude), 2) |
| rating complaints privileges learning raises critical advance |
| rating 1.00 0.83 0.43 0.62 0.59 0.16 0.16 |
| complaints 0.83 1.00 0.56 0.60 0.67 0.19 0.22 |
| privileges 0.43 0.56 1.00 0.49 0.45 0.15 0.34 |
| learning 0.62 0.60 0.49 1.00 0.64 0.12 0.53 |
| raises 0.59 0.67 0.45 0.64 1.00 0.38 0.57 |
| critical 0.16 0.19 0.15 0.12 0.38 1.00 0.28 |
| advance 0.16 0.22 0.34 0.53 0.57 0.28 1.00 |
| > symnum(Ca) # simple graphic |
| rt cm p l rs cr a |
| rating 1 |
| complaints + 1 |
| privileges . . 1 |
| learning , . . 1 |
| raises . , . , 1 |
| critical . 1 |
| advance . . . 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > heatmap(Ca, symm = TRUE, margins = c(6,6)) # with reorder() |
| > heatmap(Ca, Rowv = FALSE, symm = TRUE, margins = c(6,6)) # _NO_ reorder() |
| > ## 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 R |
| CONT 1 |
| INTG 1 |
| DMNR B 1 |
| DILG + + 1 |
| CFMG + + B 1 |
| DECI + + B B 1 |
| PREP + + B B B 1 |
| FAMI + + B * * B 1 |
| ORAL * * B B * B B 1 |
| WRIT * + B * * B B B 1 |
| PHYS , , + + + + + + + 1 |
| RTEN * * * * * B * B B * 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > |
| > hU <- heatmap(cU, Rowv = FALSE, symm = TRUE, col = topo.colors(16), |
| + distfun = function(c) as.dist(1 - c), keep.dendro = TRUE) |
| > ## The Correlation matrix with same reordering: |
| > round(100 * cU[hU[[1]], hU[[2]]]) |
| CONT INTG DMNR PHYS DILG CFMG DECI RTEN ORAL WRIT PREP FAMI |
| CONT 100 -13 -15 5 1 14 9 -3 -1 -4 1 -3 |
| INTG -13 100 96 74 87 81 80 94 91 91 88 87 |
| DMNR -15 96 100 79 84 81 80 94 91 89 86 84 |
| PHYS 5 74 79 100 81 88 87 91 89 86 85 84 |
| DILG 1 87 84 81 100 96 96 93 95 96 98 96 |
| CFMG 14 81 81 88 96 100 98 93 95 94 96 94 |
| DECI 9 80 80 87 96 98 100 92 95 95 96 94 |
| RTEN -3 94 94 91 93 93 92 100 98 97 95 94 |
| ORAL -1 91 91 89 95 95 95 98 100 99 98 98 |
| WRIT -4 91 89 86 96 94 95 97 99 100 99 99 |
| PREP 1 88 86 85 98 96 96 95 98 99 100 99 |
| FAMI -3 87 84 84 96 94 94 94 98 99 99 100 |
| > ## The column dendrogram: |
| > utils::str(hU$Colv) |
| --[dendrogram w/ 2 branches and 12 members at h = 1.15] |
| |--leaf "CONT" |
| `--[dendrogram w/ 2 branches and 11 members at h = 0.258] |
| |--[dendrogram w/ 2 branches and 2 members at h = 0.0354] |
| | |--leaf "INTG" |
| | `--leaf "DMNR" |
| `--[dendrogram w/ 2 branches and 9 members at h = 0.187] |
| |--leaf "PHYS" |
| `--[dendrogram w/ 2 branches and 8 members at h = 0.075] |
| |--[dendrogram w/ 2 branches and 3 members at h = 0.0438] |
| | |--leaf "DILG" |
| | `--[dendrogram w/ 2 branches and 2 members at h = 0.0189] |
| | |--leaf "CFMG" |
| | `--leaf "DECI" |
| `--[dendrogram w/ 2 branches and 5 members at h = 0.0584] |
| |--leaf "RTEN" |
| `--[dendrogram w/ 2 branches and 4 members at h = 0.0187] |
| |--[dendrogram w/ 2 branches and 2 members at h = 0.00657] |
| | |--leaf "ORAL" |
| | `--leaf "WRIT" |
| `--[dendrogram w/ 2 branches and 2 members at h = 0.0101] |
| |--leaf "PREP" |
| `--leaf "FAMI" |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("identify.hclust") |
| > ### * identify.hclust |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: identify.hclust |
| > ### Title: Identify Clusters in a Dendrogram |
| > ### Aliases: identify.hclust |
| > ### Keywords: cluster iplot |
| > |
| > ### ** Examples |
| > ## Not run: |
| > ##D require(graphics) |
| > ##D |
| > ##D hca <- hclust(dist(USArrests)) |
| > ##D plot(hca) |
| > ##D (x <- identify(hca)) ## Terminate with 2nd mouse button !! |
| > ##D |
| > ##D hci <- hclust(dist(iris[,1:4])) |
| > ##D plot(hci) |
| > ##D identify(hci, function(k) print(table(iris[k,5]))) |
| > ##D |
| > ##D # open a new device (one for dendrogram, one for bars): |
| > ##D 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 Libya |
| 7 44 46 49 |
| > # which observations 'are' influential |
| > summary(inflm.SR) # only these |
| Potentially influential observations of |
| lm(formula = sr ~ pop15 + pop75 + dpi + ddpi, data = LifeCycleSavings) : |
| |
| dfb.1_ dfb.pp15 dfb.pp75 dfb.dpi dfb.ddpi dffit cov.r cook.d |
| Chile -0.20 0.13 0.22 -0.02 0.12 -0.46 0.65_* 0.04 |
| United States 0.07 -0.07 0.04 -0.23 -0.03 -0.25 1.66_* 0.01 |
| Zambia 0.16 -0.08 -0.34 0.09 0.23 0.75 0.51_* 0.10 |
| Libya 0.55 -0.48 -0.38 -0.02 -1.02_* -1.16_* 2.09_* 0.27 |
| hat |
| Chile 0.04 |
| United States 0.33_* |
| Zambia 0.06 |
| Libya 0.53_* |
| > 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) |
| > identical(rs, rstandard(lm.SR, infl = iflSR)) |
| [1] TRUE |
| > ## to "see" the larger values: |
| > 1000 * round(dfbetas(lm.SR, infl = iflSR), 3) |
| (Intercept) pop15 pop75 dpi ddpi |
| Australia 12 -10 -27 45 0 |
| Austria -10 6 41 -37 -8 |
| Belgium -64 51 121 -35 -7 |
| Bolivia 6 -13 -23 32 41 |
| Brazil 90 -62 -179 120 68 |
| Canada 5 -7 10 -35 -3 |
| Chile -199 133 220 -20 120 |
| China 21 -6 -83 52 111 |
| Colombia 39 -52 -25 2 9 |
| Costa Rica -234 284 142 56 -33 |
| Denmark -41 21 47 152 49 |
| Ecuador 72 -95 -61 20 48 |
| Finland -113 111 117 -44 -17 |
| France -166 147 219 -29 24 |
| Germany -8 8 8 -7 0 |
| Greece -148 164 29 157 -60 |
| Guatamala 16 -55 6 6 97 |
| Honduras -2 10 -10 8 -2 |
| Iceland 248 -274 -233 -126 185 |
| India 21 -16 -14 -14 -19 |
| Ireland -310 296 482 -257 -93 |
| Italy 66 -71 3 -70 -29 |
| Japan 640 -656 -674 146 389 |
| Korea -169 135 219 5 -169 |
| Luxembourg -68 69 44 -28 49 |
| Malta 37 -49 8 -87 153 |
| Norway 2 0 -6 -16 -1 |
| Netherlands 14 -17 -12 4 23 |
| New Zealand -60 65 94 -26 -65 |
| Nicaragua -12 18 10 -5 -10 |
| Panama 28 -53 14 -35 -8 |
| Paraguay -232 164 158 144 270 |
| Peru -72 147 91 -86 -287 |
| Philippines -157 227 157 -111 -171 |
| Portugal -21 26 -4 40 -28 |
| South Africa 22 -20 -7 -20 -16 |
| South Rhodesia 144 -135 -92 -70 -58 |
| Spain -30 31 4 35 5 |
| Sweden 101 -82 -62 -255 -13 |
| Switzerland 43 -46 -44 91 -19 |
| Turkey -11 -12 26 2 25 |
| Tunisia 74 -105 -77 44 103 |
| United Kingdom 47 -36 -171 126 100 |
| United States 69 -73 37 -233 -33 |
| Venezuela -51 101 -34 114 -124 |
| Zambia 164 -79 -339 94 228 |
| Jamaica 110 -100 -57 -7 -295 |
| Uruguay -134 129 30 131 100 |
| Libya 551 -483 -380 -19 -1024 |
| Malaysia 37 -61 32 -50 -72 |
| > 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.184 |
| 1 2 3 4 5 |
| 0.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) ## correct |
| 2 with absolute error < 2.2e-14 |
| > integrate(function(x) rep(2.0, length(x)), 0, 1) ## correct |
| 2 with absolute error < 2.2e-14 |
| > |
| > ## integrate can fail if misused |
| > integrate(dnorm, 0, 2) |
| 0.4772499 with absolute error < 5.3e-15 |
| > integrate(dnorm, 0, 20) |
| 0.5 with absolute error < 3.7e-05 |
| > integrate(dnorm, 0, 200) |
| 0.5 with absolute error < 1.6e-07 |
| > integrate(dnorm, 0, 2000) |
| 0.5 with absolute error < 4.4e-06 |
| > integrate(dnorm, 0, 20000) ## fails on many systems |
| 0 with absolute error < 0 |
| > integrate(dnorm, 0, Inf) ## works |
| 0.5 with absolute error < 4.7e-05 |
| > ## 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-74 |
| agegp alcgp tobgp ncases ncontrols |
| 66 65-74 0-39g/day 30+ 0 2 |
| > esophNA <- esoph; esophNA$ncases[66] <- NA |
| > with(esophNA, { |
| + interaction.plot(agegp, alcgp, ncases/ncontrols, col = 2:5) |
| + # doesn't show *last* group either |
| + interaction.plot(agegp, alcgp, ncases/ncontrols, col = 2:5, type = "b") |
| + ## alternative take non-NA's {"cheating"} |
| + interaction.plot(agegp, alcgp, ncases/ncontrols, col = 2:5, |
| + fun = function(x) mean(x, na.rm = TRUE), |
| + sub = "function(x) mean(x, na.rm=TRUE)") |
| + }) |
| > rm(esophNA) # to clear up |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("is.empty") |
| > ### * is.empty |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: is.empty.model |
| > ### Title: Test if a Model's Formula is Empty |
| > ### Aliases: is.empty.model |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > y <- rnorm(20) |
| > is.empty.model(y ~ 0) |
| [1] TRUE |
| > is.empty.model(y ~ -1) |
| [1] TRUE |
| > is.empty.model(lm(y ~ 0)) |
| [1] TRUE |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("isoreg") |
| > ### * isoreg |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: isoreg |
| > ### Title: Isotonic / Monotone Regression |
| > ### Aliases: isoreg |
| > ### Keywords: regression smooth |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > (ir <- isoreg(c(1,0,4,3,3,5,4,2,0))) |
| Isotonic regression from isoreg(x = c(1, 0, 4, 3, 3, 5, 4, 2, 0)), |
| with 2 knots / breaks at obs.nr. 2 9 ; |
| initially ordered 'x' |
| and further components List of 4 |
| $ x : num [1:9] 1 2 3 4 5 6 7 8 9 |
| $ y : num [1:9] 1 0 4 3 3 5 4 2 0 |
| $ yf: num [1:9] 0.5 0.5 3 3 3 3 3 3 3 |
| $ yc: num [1:10] 0 1 1 5 8 11 16 20 22 22 |
| > plot(ir, plot.type = "row") |
| > |
| > (ir3 <- isoreg(y3 <- c(1,0,4,3,3,5,4,2, 3))) # last "3", not "0" |
| Isotonic regression from isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3)), |
| with 3 knots / breaks at obs.nr. 2 5 9 ; |
| initially ordered 'x' |
| and further components List of 4 |
| $ x : num [1:9] 1 2 3 4 5 6 7 8 9 |
| $ y : num [1:9] 1 0 4 3 3 5 4 2 3 |
| $ yf: num [1:9] 0.5 0.5 3.33 3.33 3.33 ... |
| $ yc: num [1:10] 0 1 1 5 8 11 16 20 22 25 |
| > (fi3 <- as.stepfun(ir3)) |
| Step function |
| Call: isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3)) |
| x[1:3] = 2, 5, 9 |
| 4 plateau levels = 0.5, 0.5, 3.3333, 3.5 |
| > (ir4 <- isoreg(1:10, y4 <- c(5, 9, 1:2, 5:8, 3, 8))) |
| Isotonic regression from isoreg(x = 1:10, y = y4 <- c(5, 9, 1:2, 5:8, 3, 8)), |
| with 5 knots / breaks at obs.nr. 4 5 6 9 10 ; |
| initially ordered 'x' |
| and further components List of 4 |
| $ x : num [1:10] 1 2 3 4 5 6 7 8 9 10 |
| $ y : num [1:10] 5 9 1 2 5 6 7 8 3 8 |
| $ yf: num [1:10] 4.25 4.25 4.25 4.25 5 6 6 6 6 8 |
| $ yc: num [1:11] 0 5 14 15 17 22 28 35 43 46 ... |
| > cat(sprintf("R^2 = %.2f\n", |
| + 1 - sum(residuals(ir4)^2) / ((10-1)*var(y4)))) |
| R^2 = 0.21 |
| > |
| > ## If you are interested in the knots alone : |
| > with(ir4, cbind(iKnots, yf[iKnots])) |
| iKnots |
| [1,] 4 4.25 |
| [2,] 5 5.00 |
| [3,] 6 6.00 |
| [4,] 9 6.00 |
| [5,] 10 8.00 |
| > |
| > ## Example of unordered x[] with ties: |
| > x <- sample((0:30)/8) |
| > y <- exp(x) |
| > x. <- round(x) # ties! |
| > plot(m <- isoreg(x., y)) |
| > stopifnot(all.equal(with(m, yf[iKnots]), |
| + as.vector(tapply(y, x., mean)))) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("kernapply") |
| > ### * kernapply |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: kernapply |
| > ### Title: Apply Smoothing Kernel |
| > ### Aliases: kernapply kernapply.default kernapply.ts kernapply.tskernel |
| > ### kernapply.vector |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > ## see 'kernel' for examples |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("kernel") |
| > ### * kernel |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: kernel |
| > ### Title: Smoothing Kernel Objects |
| > ### Aliases: kernel bandwidth.kernel df.kernel is.tskernel plot.tskernel |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > ## Demonstrate a simple trading strategy for the |
| > ## financial time series German stock index DAX. |
| > x <- EuStockMarkets[,1] |
| > k1 <- kernel("daniell", 50) # a long moving average |
| > k2 <- kernel("daniell", 10) # and a short one |
| > plot(k1) |
| > plot(k2) |
| > x1 <- kernapply(x, k1) |
| > x2 <- kernapply(x, k2) |
| > plot(x) |
| > lines(x1, col = "red") # go long if the short crosses the long upwards |
| > lines(x2, col = "green") # and go short otherwise |
| > |
| > ## More interesting kernels |
| > kd <- kernel("daniell", c(3, 3)) |
| > kd # note the unusual indexing |
| Daniell(3,3) |
| coef[-6] = 0.02041 |
| coef[-5] = 0.04082 |
| coef[-4] = 0.06122 |
| coef[-3] = 0.08163 |
| coef[-2] = 0.10204 |
| coef[-1] = 0.12245 |
| coef[ 0] = 0.14286 |
| coef[ 1] = 0.12245 |
| coef[ 2] = 0.10204 |
| coef[ 3] = 0.08163 |
| coef[ 4] = 0.06122 |
| coef[ 5] = 0.04082 |
| coef[ 6] = 0.02041 |
| > kd[-2:2] |
| [1] 0.1020408 0.1224490 0.1428571 0.1224490 0.1020408 |
| > plot(kernel("fejer", 100, r = 6)) |
| > plot(kernel("modified.daniell", c(7,5,3))) |
| > |
| > # Reproduce example 10.4.3 from Brockwell and Davis (1991) |
| > spectrum(sunspot.year, kernel = kernel("daniell", c(11,7,3)), log = "no") |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("kmeans") |
| > ### * kmeans |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: kmeans |
| > ### Title: K-Means Clustering |
| > ### Aliases: kmeans print.kmeans 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, 51 |
| |
| Cluster means: |
| x y |
| 1 0.02149367 0.02121248 |
| 2 0.94443633 1.01712793 |
| |
| Clustering 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 2 |
| |
| Within 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 y |
| 1 0.02149367 0.02121248 |
| 1 0.02149367 0.02121248 |
| 1 0.02149367 0.02121248 |
| 1 0.02149367 0.02121248 |
| 1 0.02149367 0.02121248 |
| 1 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.07333 |
| tot.withinss 14.9179 14.9179 |
| totss 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, 25 |
| |
| Cluster means: |
| x y |
| 1 1.3290081 1.1185534 |
| 2 0.1581362 -0.1761590 |
| 3 0.8043520 0.7805033 |
| 4 0.8609139 1.3145869 |
| 5 -0.1096832 0.2106891 |
| |
| Clustering 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 3 |
| |
| Within 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 test |
| |
| data: 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 test |
| |
| data: x and g |
| Kruskal-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 test |
| |
| data: Ozone by Month |
| Kruskal-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 test |
| |
| data: x and y |
| D = 0.48, p-value = 0.0002033 |
| alternative hypothesis: two-sided |
| |
| > # Does x come from a shifted gamma distribution with shape 3 and rate 2? |
| > ks.test(x+2, "pgamma", 3, 2) # two-sided, exact |
| |
| One-sample Kolmogorov-Smirnov test |
| |
| data: x + 2 |
| D = 0.40962, p-value = 4.227e-08 |
| alternative hypothesis: two-sided |
| |
| > ks.test(x+2, "pgamma", 3, 2, exact = FALSE) |
| |
| One-sample Kolmogorov-Smirnov test |
| |
| data: x + 2 |
| D = 0.40962, p-value = 1.033e-07 |
| alternative hypothesis: two-sided |
| |
| > ks.test(x+2, "pgamma", 3, 2, alternative = "gr") |
| |
| One-sample Kolmogorov-Smirnov test |
| |
| data: x + 2 |
| D^+ = 0.039998, p-value = 0.8302 |
| alternative hypothesis: the CDF of x lies above the null hypothesis |
| |
| > |
| > # test if x is stochastically larger than x2 |
| > x2 <- rnorm(50, -1) |
| > plot(ecdf(x), xlim = range(c(x, x2))) |
| > plot(ecdf(x2), add = TRUE, lty = "dashed") |
| > t.test(x, x2, alternative = "g") |
| |
| Welch Two Sample t-test |
| |
| data: x and x2 |
| t = 5.6742, df = 96.85, p-value = 7.242e-08 |
| alternative hypothesis: true difference in means is greater than 0 |
| 95 percent confidence interval: |
| 0.7069751 Inf |
| sample estimates: |
| mean of x mean of y |
| 0.1004483 -0.8990693 |
| |
| > wilcox.test(x, x2, alternative = "g") |
| |
| Wilcoxon rank sum test with continuity correction |
| |
| data: x and x2 |
| W = 1983, p-value = 2.212e-07 |
| alternative hypothesis: true location shift is greater than 0 |
| |
| > ks.test(x, x2, alternative = "l") |
| |
| Two-sample Kolmogorov-Smirnov test |
| |
| data: x and x2 |
| D^- = 0.5, p-value = 3.727e-06 |
| alternative hypothesis: the CDF of x lies below that of y |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("ksmooth") |
| > ### * ksmooth |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ksmooth |
| > ### Title: Kernel Regression Smoother |
| > ### Aliases: ksmooth |
| > ### Keywords: smooth |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > with(cars, { |
| + plot(speed, dist) |
| + lines(ksmooth(speed, dist, "normal", bandwidth = 2), col = 2) |
| + lines(ksmooth(speed, dist, "normal", bandwidth = 5), col = 3) |
| + }) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("lag") |
| > ### * lag |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: lag |
| > ### Title: Lag a Time Series |
| > ### Aliases: lag lag.default |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > lag(ldeaths, 12) # starts one year earlier |
| Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec |
| 1973 3035 2552 2704 2554 2014 1655 1721 1524 1596 2074 2199 2512 |
| 1974 2933 2889 2938 2497 1870 1726 1607 1545 1396 1787 2076 2837 |
| 1975 2787 3891 3179 2011 1636 1580 1489 1300 1356 1653 2013 2823 |
| 1976 3102 2294 2385 2444 1748 1554 1498 1361 1346 1564 1640 2293 |
| 1977 2815 3137 2679 1969 1870 1633 1529 1366 1357 1570 1535 2491 |
| 1978 3084 2605 2573 2143 1693 1504 1461 1354 1333 1492 1781 1915 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("lag.plot") |
| > ### * lag.plot |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: lag.plot |
| > ### Title: Time Series Lag Plots |
| > ### Aliases: lag.plot |
| > ### Keywords: hplot ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > lag.plot(nhtemp, 8, diag.col = "forest green") |
| > lag.plot(nhtemp, 5, main = "Average Temperatures in New Haven") |
| > ## ask defaults to TRUE when we have more than one page: |
| > lag.plot(nhtemp, 6, layout = c(2,1), asp = NA, |
| + main = "New Haven Temperatures", col.main = "blue") |
| > |
| > ## Multivariate (but non-stationary! ...) |
| > lag.plot(freeny.x, lags = 3) |
| > |
| > ## 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")) |
| > cAS |
| intercept slope |
| it = 1 0.500000 0.500000 |
| it = 2 -0.250000 -0.250000 |
| it = 3 0.875000 0.875000 |
| it = 4 -0.812500 -0.812500 |
| it = 5 1.718750 1.718750 |
| it = 6 -2.078125 -2.078125 |
| it = 7 2.500000 2.500000 |
| it = 8 -2.083333 -2.083333 |
| it = 9 2.500000 2.500000 |
| it = 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.7509 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| (Intercept) 28.5660865 7.3545161 3.884 0.000334 *** |
| pop15 -0.4611931 0.1446422 -3.189 0.002603 ** |
| pop75 -1.6914977 1.0835989 -1.561 0.125530 |
| dpi -0.0003369 0.0009311 -0.362 0.719173 |
| ddpi 0.4096949 0.1961971 2.088 0.042471 * |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 3.803 on 45 degrees of freedom |
| Multiple R-squared: 0.3385, Adjusted R-squared: 0.2797 |
| F-statistic: 5.756 on 4 and 45 DF, p-value: 0.0007904 |
| |
| Correlation of Coefficients: |
| (Intercept) pop15 pop75 dpi |
| pop15 -0.98 |
| pop75 -0.81 0.77 |
| dpi -0.17 0.18 -0.37 |
| ddpi -0.19 0.10 -0.05 0.26 |
| |
| > utils::str(lmI <- lm.influence(lm.SR)) |
| List of 4 |
| $ hat : Named num [1:50] 0.0677 0.1204 0.0875 0.0895 0.0696 ... |
| ..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ... |
| $ coefficients: num [1:50, 1:5] 0.0916 -0.0747 -0.4752 0.0429 0.6604 ... |
| ..- attr(*, "dimnames")=List of 2 |
| .. ..$ : chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ... |
| .. ..$ : chr [1:5] "(Intercept)" "pop15" "pop75" "dpi" ... |
| $ sigma : Named num [1:50] 3.84 3.84 3.83 3.84 3.81 ... |
| ..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ... |
| $ wt.res : Named num [1:50] 0.864 0.616 2.219 -0.698 3.553 ... |
| ..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ... |
| > |
| > ## For more "user level" examples, use example(influence.measures) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("lm.summaries") |
| > ### * lm.summaries |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: lm.summaries |
| > ### Title: Accessing Linear Model Fits |
| > ### Aliases: family.lm formula.lm residuals.lm labels.lm |
| > ### Keywords: regression models |
| > |
| > ### ** Examples |
| > |
| > ## Don't show: |
| > utils::example("lm", echo = FALSE) |
| > ## End(Don't show) |
| > ##-- Continuing the lm(.) example: |
| > coef(lm.D90) # the bare coefficients |
| groupCtl groupTrt |
| 5.032 4.661 |
| > |
| > ## The 2 basic regression diagnostic plots [plot.lm(.) is preferred] |
| > plot(resid(lm.D90), fitted(lm.D90)) # Tukey-Anscombe's |
| > abline(h = 0, lty = 2, col = "gray") |
| > |
| > qqnorm(residuals(lm.D90)) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("lmfit") |
| > ### * lmfit |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: lm.fit |
| > ### Title: Fitter Functions for Linear Models |
| > ### Aliases: lm.fit lm.wfit .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) |
| $fit |
| 1 2 3 4 5 6 7 8 |
| 7.797353 10.002308 12.499786 15.281082 18.446568 21.865315 25.517015 29.350386 |
| 9 10 11 12 13 14 15 16 |
| 33.230660 37.167935 41.205226 45.055736 48.355889 49.824812 51.986702 56.461318 |
| 17 18 19 20 21 22 23 24 |
| 61.959729 68.569313 76.316068 85.212121 95.324047 NA NA NA |
| 25 26 |
| NA NA |
| |
| $se.fit |
| 1 2 3 4 5 6 7 8 |
| 7.568120 5.945831 4.990827 4.545284 4.308639 4.115049 3.789542 3.716231 |
| 9 10 11 12 13 14 15 16 |
| 3.776947 4.091747 4.709568 4.245427 4.035929 3.753410 4.004705 4.043190 |
| 17 18 19 20 21 22 23 24 |
| 4.026105 4.074664 4.570818 5.954217 8.302014 NA NA NA |
| 25 26 |
| NA NA |
| |
| $residual.scale |
| [1] 15.29496 |
| |
| $df |
| [1] 44.6179 |
| |
| > # to allow extrapolation |
| > cars.lo2 <- loess(dist ~ speed, cars, |
| + control = loess.control(surface = "direct")) |
| > predict(cars.lo2, data.frame(speed = seq(5, 30, 1)), se = TRUE) |
| $fit |
| 1 2 3 4 5 6 7 |
| 7.741006 9.926596 12.442424 15.281082 18.425712 21.865315 25.713413 |
| 8 9 10 11 12 13 14 |
| 29.350386 33.230660 37.167935 41.205226 45.781544 48.355889 50.067148 |
| 15 16 17 18 19 20 21 |
| 51.986702 56.445263 62.025404 68.569313 76.193111 85.053364 95.300523 |
| 22 23 24 25 26 |
| 106.974661 120.092581 134.665851 150.698545 168.190283 |
| |
| $se.fit |
| 1 2 3 4 5 6 7 8 |
| 7.565991 5.959097 5.012013 4.550013 4.321596 4.119331 3.939804 3.720098 |
| 9 10 11 12 13 14 15 16 |
| 3.780877 4.096004 4.714469 4.398936 4.040129 4.184257 4.008873 4.061865 |
| 17 18 19 20 21 22 23 24 |
| 4.033998 4.078904 4.584606 5.952480 8.306901 11.601911 15.792480 20.864660 |
| 25 26 |
| 26.823827 33.683999 |
| |
| $residual.scale |
| [1] 15.31087 |
| |
| $df |
| [1] 44.55085 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("logLik") |
| > ### * logLik |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: logLik |
| > ### Title: Extract Log-Likelihood |
| > ### Aliases: logLik 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 critical |
| 10.78708 0.61319 -0.07305 0.32033 0.08173 0.03838 |
| advance |
| -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.6964 |
| R-Square=0.0731 |
| F-statistic (df=1, 18)=1.4191 |
| p-value=0.249 |
| |
| Estimate Std.Err t-value Pr(>|t|) |
| Intercept 5.403 0.4924 10.9723 0.000 |
| X -0.371 0.3114 -1.1913 0.249 |
| |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("mad") |
| > ### * mad |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: mad |
| > ### Title: Median Absolute Deviation |
| > ### Aliases: mad |
| > ### Keywords: univar robust |
| > |
| > ### ** Examples |
| > |
| > mad(c(1:9)) |
| [1] 2.9652 |
| > print(mad(c(1:9), constant = 1)) == |
| + mad(c(1:8, 100), constant = 1) # = 2 ; TRUE |
| [1] 2 |
| [1] TRUE |
| > x <- c(1,2,3,5,7,8) |
| > sort(abs(x - median(x))) |
| [1] 1 1 2 3 3 4 |
| > c(mad(x, constant = 1), |
| + mad(x, constant = 1, low = TRUE), |
| + mad(x, constant = 1, high = TRUE)) |
| [1] 2.5 2.0 3.0 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("mahalanobis") |
| > ### * mahalanobis |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: mahalanobis |
| > ### Title: Mahalanobis Distance |
| > ### Aliases: mahalanobis |
| > ### Keywords: multivariate |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > ma <- cbind(1:6, 1:3) |
| > (S <- var(ma)) |
| [,1] [,2] |
| [1,] 3.5 0.8 |
| [2,] 0.8 0.8 |
| > mahalanobis(c(0, 0), 1:2, S) |
| [1] 5.37037 |
| > |
| > x <- matrix(rnorm(100*3), ncol = 3) |
| > stopifnot(mahalanobis(x, 0, diag(ncol(x))) == rowSums(x*x)) |
| > ##- Here, D^2 = usual squared Euclidean distances |
| > |
| > Sx <- cov(x) |
| > D2 <- mahalanobis(x, colMeans(x), Sx) |
| > plot(density(D2, bw = 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:K |
| yield 343.2950 189.2817 8.4017 95.2017 21.2817 33.1350 0.4817 |
| foo 2.9548 0.0223 1.3807 0.0097 2.7585 0.9724 5.5258 |
| Deg. of Freedom 5 1 1 1 1 1 1 |
| Residuals |
| yield 185.2867 |
| foo 7.8286 |
| Deg. of Freedom 12 |
| |
| Residual standard errors: 3.929447 0.8077039 |
| 1 out of 13 effects not estimable |
| Estimated 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.35677 |
| K 1 0.34430 2.8879 2 11 0.09815 . |
| N:P 1 0.30158 2.3750 2 11 0.13888 |
| N:K 1 0.21654 1.5201 2 11 0.26127 |
| P: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 foo |
| 54.8750000 0.1498669 |
| |
| Stratum 1: block |
| |
| Terms: |
| N:P:K Residuals |
| yield 37.00167 306.29333 |
| foo 0.06988 2.88496 |
| Deg. of Freedom 1 4 |
| |
| Residual standard errors: 8.750619 0.8492579 |
| Estimated effects are balanced |
| |
| Stratum 2: Within |
| |
| Terms: |
| N P K N:P N:K P:K |
| yield 189.28167 8.40167 95.20167 21.28167 33.13500 0.48167 |
| foo 0.02235 1.38066 0.00966 2.75852 0.97240 5.52584 |
| Deg. of Freedom 1 1 1 1 1 1 |
| Residuals |
| yield 185.28667 |
| foo 7.82863 |
| Deg. of Freedom 12 |
| |
| Residual standard errors: 3.929447 0.8077039 |
| Estimated effects are balanced |
| > summary(npk2.aovE) |
| |
| Error: block |
| Df Pillai approx F num Df den Df Pr(>F) |
| N:P:K 1 0.20004 0.3751 2 3 0.7155 |
| Residuals 4 |
| |
| Error: Within |
| Df 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.35677 |
| K 1 0.34430 2.8879 2 11 0.09815 . |
| N:P 1 0.30158 2.3750 2 11 0.13888 |
| N:K 1 0.21654 1.5201 2 11 0.26127 |
| P: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/8 |
| |
| Response |
| Delay Cured Died |
| None 0 6 |
| 1.5h 0 5 |
| |
| , , Penicillin.Level = 1/4 |
| |
| Response |
| Delay Cured Died |
| None 3 3 |
| 1.5h 0 6 |
| |
| , , Penicillin.Level = 1/2 |
| |
| Response |
| Delay Cured Died |
| None 6 0 |
| 1.5h 2 4 |
| |
| , , Penicillin.Level = 1 |
| |
| Response |
| Delay Cured Died |
| None 5 1 |
| 1.5h 6 0 |
| |
| , , Penicillin.Level = 4 |
| |
| Response |
| Delay Cured Died |
| None 2 0 |
| 1.5h 5 0 |
| |
| > ## Classical Mantel-Haenszel test |
| > mantelhaen.test(Rabbits) |
| |
| Mantel-Haenszel chi-squared test with continuity correction |
| |
| data: Rabbits |
| Mantel-Haenszel X-squared = 3.9286, df = 1, p-value = 0.04747 |
| alternative hypothesis: true common odds ratio is not equal to 1 |
| 95 percent confidence interval: |
| 1.026713 47.725133 |
| sample estimates: |
| common odds ratio |
| 7 |
| |
| > ## => p = 0.047, some evidence for higher cure rate of immediate |
| > ## injection |
| > ## Exact conditional test |
| > mantelhaen.test(Rabbits, exact = TRUE) |
| |
| Exact conditional test of independence in 2 x 2 x k tables |
| |
| data: Rabbits |
| S = 16, p-value = 0.03994 |
| alternative hypothesis: true common odds ratio is not equal to 1 |
| 95 percent confidence interval: |
| 1.077401 529.837399 |
| sample estimates: |
| common odds ratio |
| 10.36102 |
| |
| > ## => p - 0.040 |
| > ## Exact conditional test for one-sided alternative of a higher |
| > ## cure rate for immediate injection |
| > mantelhaen.test(Rabbits, exact = TRUE, alternative = "greater") |
| |
| Exact conditional test of independence in 2 x 2 x k tables |
| |
| data: Rabbits |
| S = 16, p-value = 0.01997 |
| alternative hypothesis: true common odds ratio is greater than 1 |
| 95 percent confidence interval: |
| 1.384239 Inf |
| sample estimates: |
| common odds ratio |
| 10.36102 |
| |
| > ## => p = 0.020 |
| > |
| > ## UC Berkeley Student Admissions |
| > mantelhaen.test(UCBAdmissions) |
| |
| Mantel-Haenszel chi-squared test with continuity correction |
| |
| data: UCBAdmissions |
| Mantel-Haenszel X-squared = 1.4269, df = 1, p-value = 0.2323 |
| alternative hypothesis: true common odds ratio is not equal to 1 |
| 95 percent confidence interval: |
| 0.7719074 1.0603298 |
| sample estimates: |
| common odds ratio |
| 0.9046968 |
| |
| > ## No evidence for association between admission and gender |
| > ## when adjusted for department. However, |
| > apply(UCBAdmissions, 3, function(x) (x[1,1]*x[2,2])/(x[1,2]*x[2,1])) |
| A B C D E F |
| 0.3492120 0.8025007 1.1330596 0.9212838 1.2216312 0.8278727 |
| > ## This suggests that the assumption of homogeneous (conditional) |
| > ## odds ratios may be violated. The traditional approach would be |
| > ## using the Woolf test for interaction: |
| > woolf <- function(x) { |
| + x <- x + 1 / 2 |
| + k <- dim(x)[3] |
| + or <- apply(x, 3, function(x) (x[1,1]*x[2,2])/(x[1,2]*x[2,1])) |
| + w <- apply(x, 3, function(x) 1 / sum(1 / x)) |
| + 1 - pchisq(sum(w * (log(or) - weighted.mean(log(or), w)) ^ 2), k - 1) |
| + } |
| > woolf(UCBAdmissions) |
| [1] 0.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_S |
| Gender Income |
| Female <5000 1 3 11 2 |
| 5000-15000 2 3 17 3 |
| 15000-25000 0 1 8 5 |
| >25000 0 2 4 2 |
| Male <5000 1 1 2 1 |
| 5000-15000 0 3 5 1 |
| 15000-25000 0 0 7 3 |
| >25000 0 1 9 6 |
| > ## Table 7.8 in Agresti (2002), p. 288. |
| > mantelhaen.test(Satisfaction) |
| |
| Cochran-Mantel-Haenszel test |
| |
| data: Satisfaction |
| Cochran-Mantel-Haenszel M^2 = 10.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 objects |
| |
| SSD> # Lifted from Baron+Li: |
| SSD> # "Notes on the use of R for psychology experiments and questionnaires" |
| SSD> # Maxwell and Delaney, p. 497 |
| SSD> reacttime <- matrix(c( |
| SSD+ 420, 420, 480, 480, 600, 780, |
| SSD+ 420, 480, 480, 360, 480, 600, |
| SSD+ 480, 480, 540, 660, 780, 780, |
| SSD+ 420, 540, 540, 480, 780, 900, |
| SSD+ 540, 660, 540, 480, 660, 720, |
| SSD+ 360, 420, 360, 360, 480, 540, |
| SSD+ 480, 480, 600, 540, 720, 840, |
| SSD+ 480, 600, 660, 540, 720, 900, |
| SSD+ 540, 600, 540, 480, 720, 780, |
| SSD+ 480, 420, 540, 540, 660, 780), |
| SSD+ ncol = 6, byrow = TRUE, |
| SSD+ dimnames = list(subj = 1:10, |
| SSD+ cond = c("deg0NA", "deg4NA", "deg8NA", |
| SSD+ "deg0NP", "deg4NP", "deg8NP"))) |
| |
| SSD> mlmfit <- lm(reacttime ~ 1) |
| |
| SSD> SSD(mlmfit) |
| $SSD |
| cond |
| cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| deg0NA 29160 30600 26640 23760 32400 25560 |
| deg4NA 30600 66600 32400 7200 36000 30600 |
| deg8NA 26640 32400 56160 41040 57600 69840 |
| deg0NP 23760 7200 41040 70560 72000 63360 |
| deg4NP 32400 36000 57600 72000 108000 100800 |
| deg8NP 25560 30600 69840 63360 100800 122760 |
| |
| $call |
| lm(formula = reacttime ~ 1) |
| |
| $df |
| [1] 9 |
| |
| attr(,"class") |
| [1] "SSD" |
| |
| SSD> estVar(mlmfit) |
| cond |
| cond deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| deg0NA 3240 3400 2960 2640 3600 2840 |
| deg4NA 3400 7400 3600 800 4000 3400 |
| deg8NA 2960 3600 6240 4560 6400 7760 |
| deg0NP 2640 800 4560 7840 8000 7040 |
| deg4NP 3600 4000 6400 8000 12000 11200 |
| deg8NP 2840 3400 7760 7040 11200 13640 |
| > |
| > ### traditional test of intrasubj. contrasts |
| > mauchly.test(mlmfit, X = ~1) |
| |
| Mauchly's test of sphericity |
| Contrasts orthogonal to |
| ~1 |
| |
| |
| data: SSD matrix from lm(formula = reacttime ~ 1) |
| W = 0.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 sphericity |
| Contrasts orthogonal to |
| ~deg + noise |
| |
| |
| data: 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 sphericity |
| Contrasts orthogonal to |
| ~noise |
| |
| Contrasts spanned by |
| ~deg + noise |
| |
| |
| data: 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"))) |
| > Performance |
| 2nd Survey |
| 1st Survey Approve Disapprove |
| Approve 794 150 |
| Disapprove 86 570 |
| > mcnemar.test(Performance) |
| |
| McNemar's Chi-squared test with continuity correction |
| |
| data: Performance |
| McNemar's chi-squared = 16.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)) |
| > deaths |
| 1973 1974 1975 |
| 1-24 14 15 14 |
| 25-74 7 4 7 |
| 75-199 8 2 10 |
| 200++ 15 9 10 |
| NA 0 2 0 |
| > (med.d <- medpolish(deaths)) |
| 1: 19 |
| Final: 19 |
| |
| Median Polish Results (Dataset: "deaths") |
| |
| Overall: 8 |
| |
| Row Effects: |
| 1-24 25-74 75-199 200++ NA |
| 6 -1 0 2 -8 |
| |
| Column Effects: |
| 1973 1974 1975 |
| 0 -1 0 |
| |
| Residuals: |
| 1973 1974 1975 |
| 1-24 0 2 0 |
| 25-74 0 -2 0 |
| 75-199 0 -5 2 |
| 200++ 5 0 0 |
| NA 0 3 0 |
| |
| > plot(med.d) |
| > ## Check decomposition: |
| > all(deaths == |
| + med.d$overall + outer(med.d$row,med.d$col, "+") + med.d$residuals) |
| [1] TRUE |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("model.extract") |
| > ### * model.extract |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: model.extract |
| > ### Title: Extract Components from a Model Frame |
| > ### Aliases: model.extract model.offset model.response model.weights |
| > ### Keywords: manip programming models |
| > |
| > ### ** Examples |
| > |
| > a <- model.frame(cbind(ncases,ncontrols) ~ agegp + tobgp + alcgp, data = esoph) |
| > model.extract(a, "response") |
| ncases ncontrols |
| 1 0 40 |
| 2 0 10 |
| 3 0 6 |
| 4 0 5 |
| 5 0 27 |
| 6 0 7 |
| 7 0 4 |
| 8 0 7 |
| 9 0 2 |
| 10 0 1 |
| 11 0 2 |
| 12 0 1 |
| 13 1 1 |
| 14 0 1 |
| 15 0 2 |
| 16 0 60 |
| 17 1 14 |
| 18 0 7 |
| 19 0 8 |
| 20 0 35 |
| 21 3 23 |
| 22 1 14 |
| 23 0 8 |
| 24 0 11 |
| 25 0 6 |
| 26 0 2 |
| 27 0 1 |
| 28 2 3 |
| 29 0 3 |
| 30 2 4 |
| 31 1 46 |
| 32 0 18 |
| 33 0 10 |
| 34 0 4 |
| 35 6 38 |
| 36 4 21 |
| 37 5 15 |
| 38 5 7 |
| 39 3 16 |
| 40 6 14 |
| 41 1 5 |
| 42 2 4 |
| 43 4 4 |
| 44 3 4 |
| 45 2 3 |
| 46 4 4 |
| 47 2 49 |
| 48 3 22 |
| 49 3 12 |
| 50 4 6 |
| 51 9 40 |
| 52 6 21 |
| 53 4 17 |
| 54 3 6 |
| 55 9 18 |
| 56 8 15 |
| 57 3 6 |
| 58 4 4 |
| 59 5 10 |
| 60 6 7 |
| 61 2 3 |
| 62 5 6 |
| 63 5 48 |
| 64 4 14 |
| 65 2 7 |
| 66 0 2 |
| 67 17 34 |
| 68 3 10 |
| 69 5 9 |
| 70 6 13 |
| 71 4 12 |
| 72 2 3 |
| 73 1 1 |
| 74 3 4 |
| 75 1 2 |
| 76 1 1 |
| 77 1 1 |
| 78 1 18 |
| 79 2 6 |
| 80 1 3 |
| 81 2 5 |
| 82 1 3 |
| 83 0 3 |
| 84 1 1 |
| 85 1 1 |
| 86 1 1 |
| 87 2 2 |
| 88 1 1 |
| > stopifnot(model.extract(a, "response") == model.response(a)) |
| > |
| > a <- model.frame(ncases/(ncases+ncontrols) ~ agegp + tobgp + alcgp, |
| + data = esoph, weights = ncases+ncontrols) |
| > model.response(a) |
| 1 2 3 4 5 6 7 |
| 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 |
| 8 9 10 11 12 13 14 |
| 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.50000000 0.00000000 |
| 15 16 17 18 19 20 21 |
| 0.00000000 0.00000000 0.06666667 0.00000000 0.00000000 0.00000000 0.11538462 |
| 22 23 24 25 26 27 28 |
| 0.06666667 0.00000000 0.00000000 0.00000000 0.00000000 0.00000000 0.40000000 |
| 29 30 31 32 33 34 35 |
| 0.00000000 0.33333333 0.02127660 0.00000000 0.00000000 0.00000000 0.13636364 |
| 36 37 38 39 40 41 42 |
| 0.16000000 0.25000000 0.41666667 0.15789474 0.30000000 0.16666667 0.33333333 |
| 43 44 45 46 47 48 49 |
| 0.50000000 0.42857143 0.40000000 0.50000000 0.03921569 0.12000000 0.20000000 |
| 50 51 52 53 54 55 56 |
| 0.40000000 0.18367347 0.22222222 0.19047619 0.33333333 0.33333333 0.34782609 |
| 57 58 59 60 61 62 63 |
| 0.33333333 0.50000000 0.33333333 0.46153846 0.40000000 0.45454545 0.09433962 |
| 64 65 66 67 68 69 70 |
| 0.22222222 0.22222222 0.00000000 0.33333333 0.23076923 0.35714286 0.31578947 |
| 71 72 73 74 75 76 77 |
| 0.25000000 0.40000000 0.50000000 0.42857143 0.33333333 0.50000000 0.50000000 |
| 78 79 80 81 82 83 84 |
| 0.05263158 0.25000000 0.25000000 0.28571429 0.25000000 0.00000000 0.50000000 |
| 85 86 87 88 |
| 0.50000000 0.50000000 0.50000000 0.50000000 |
| > model.extract(a, "weights") |
| 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 |
| 40 10 6 5 27 7 4 7 2 1 2 1 2 1 2 60 15 7 8 35 26 15 8 11 6 2 |
| 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 |
| 1 5 3 6 47 18 10 4 44 25 20 12 19 20 6 6 8 7 5 8 51 25 15 10 49 27 |
| 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 |
| 21 9 27 23 9 8 15 13 5 11 53 18 9 2 51 13 14 19 16 5 2 7 3 2 2 19 |
| 79 80 81 82 83 84 85 86 87 88 |
| 8 4 7 4 3 2 2 2 4 2 |
| > |
| > a <- model.frame(cbind(ncases,ncontrols) ~ agegp, |
| + something = tobgp, data = esoph) |
| > names(a) |
| [1] "cbind(ncases, ncontrols)" "agegp" |
| [3] "(something)" |
| > stopifnot(model.extract(a, "something") == esoph$tobgp) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("model.frame") |
| > ### * model.frame |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: model.frame |
| > ### Title: Extracting the 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) |
| $contrasts |
| unordered ordered |
| "contr.treatment" "contr.poly" |
| |
| > model.matrix(~ a + b, dd) |
| (Intercept) a2 a3 b2 b3 b4 |
| 1 1 0 0 0 0 0 |
| 2 1 0 0 1 0 0 |
| 3 1 0 0 0 1 0 |
| 4 1 0 0 0 0 1 |
| 5 1 1 0 0 0 0 |
| 6 1 1 0 1 0 0 |
| 7 1 1 0 0 1 0 |
| 8 1 1 0 0 0 1 |
| 9 1 0 1 0 0 0 |
| 10 1 0 1 1 0 0 |
| 11 1 0 1 0 1 0 |
| 12 1 0 1 0 0 1 |
| attr(,"assign") |
| [1] 0 1 1 2 2 2 |
| attr(,"contrasts") |
| attr(,"contrasts")$a |
| [1] "contr.treatment" |
| |
| attr(,"contrasts")$b |
| [1] "contr.treatment" |
| |
| > model.matrix(~ a + b, dd, contrasts = list(a = "contr.sum")) |
| (Intercept) a1 a2 b2 b3 b4 |
| 1 1 1 0 0 0 0 |
| 2 1 1 0 1 0 0 |
| 3 1 1 0 0 1 0 |
| 4 1 1 0 0 0 1 |
| 5 1 0 1 0 0 0 |
| 6 1 0 1 1 0 0 |
| 7 1 0 1 0 1 0 |
| 8 1 0 1 0 0 1 |
| 9 1 -1 -1 0 0 0 |
| 10 1 -1 -1 1 0 0 |
| 11 1 -1 -1 0 1 0 |
| 12 1 -1 -1 0 0 1 |
| attr(,"assign") |
| [1] 0 1 1 2 2 2 |
| attr(,"contrasts") |
| attr(,"contrasts")$a |
| [1] "contr.sum" |
| |
| attr(,"contrasts")$b |
| [1] "contr.treatment" |
| |
| > model.matrix(~ a + b, dd, contrasts = list(a = "contr.sum", b = contr.poly)) |
| (Intercept) a1 a2 b.L b.Q b.C |
| 1 1 1 0 -0.6708204 0.5 -0.2236068 |
| 2 1 1 0 -0.2236068 -0.5 0.6708204 |
| 3 1 1 0 0.2236068 -0.5 -0.6708204 |
| 4 1 1 0 0.6708204 0.5 0.2236068 |
| 5 1 0 1 -0.6708204 0.5 -0.2236068 |
| 6 1 0 1 -0.2236068 -0.5 0.6708204 |
| 7 1 0 1 0.2236068 -0.5 -0.6708204 |
| 8 1 0 1 0.6708204 0.5 0.2236068 |
| 9 1 -1 -1 -0.6708204 0.5 -0.2236068 |
| 10 1 -1 -1 -0.2236068 -0.5 0.6708204 |
| 11 1 -1 -1 0.2236068 -0.5 -0.6708204 |
| 12 1 -1 -1 0.6708204 0.5 0.2236068 |
| attr(,"assign") |
| [1] 0 1 1 2 2 2 |
| attr(,"contrasts") |
| attr(,"contrasts")$a |
| [1] "contr.sum" |
| |
| attr(,"contrasts")$b |
| .L .Q .C |
| 1 -0.6708204 0.5 -0.2236068 |
| 2 -0.2236068 -0.5 0.6708204 |
| 3 0.2236068 -0.5 -0.6708204 |
| 4 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 3 |
| a1 0 8 0 0 0 0 |
| a2 0 0 24 0 0 0 |
| b2 3 0 0 3 0 0 |
| b3 3 0 0 0 3 0 |
| b4 3 0 0 0 0 3 |
| > # 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 scale |
| |
| data: ramsay and jung.parekh |
| Z = 1.0371, p-value = 0.2997 |
| alternative hypothesis: two.sided |
| |
| > ## Compare this to ansari.test(ramsay, jung.parekh) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("na.action") |
| > ### * na.action |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: na.action |
| > ### Title: NA Action |
| > ### Aliases: na.action na.action.default |
| > ### Keywords: NA methods |
| > |
| > ### ** Examples |
| > |
| > na.action(na.omit(c(1, NA))) |
| [1] 2 |
| attr(,"class") |
| [1] "omit" |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("na.contiguous") |
| > ### * na.contiguous |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: na.contiguous |
| > ### Title: Find Longest Contiguous Stretch of non-NAs |
| > ### Aliases: na.contiguous na.contiguous.default |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > na.contiguous(presidents) |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1952 32 |
| 1953 59 74 75 60 |
| 1954 71 61 71 57 |
| 1955 71 68 79 73 |
| 1956 76 71 67 75 |
| 1957 79 62 63 57 |
| 1958 60 49 48 52 |
| 1959 57 62 61 66 |
| 1960 71 62 61 57 |
| 1961 72 83 71 78 |
| 1962 79 71 62 74 |
| 1963 76 64 62 57 |
| 1964 80 73 69 69 |
| 1965 71 64 69 62 |
| 1966 63 46 56 44 |
| 1967 44 52 38 46 |
| 1968 36 49 35 44 |
| 1969 59 65 65 56 |
| 1970 66 53 61 52 |
| 1971 51 48 54 49 |
| 1972 49 61 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("na.fail") |
| > ### * na.fail |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: na.fail |
| > ### Title: Handle Missing Values in Objects |
| > ### Aliases: na.fail na.fail.default na.omit na.omit.data.frame |
| > ### na.omit.default na.exclude na.exclude.data.frame na.exclude.default |
| > ### na.pass |
| > ### Keywords: NA |
| > |
| > ### ** Examples |
| > |
| > DF <- data.frame(x = c(1, 2, 3), y = c(0, 10, NA)) |
| > na.omit(DF) |
| x y |
| 1 1 0 |
| 2 2 10 |
| > m <- as.matrix(DF) |
| > na.omit(m) |
| x y |
| [1,] 1 0 |
| [2,] 2 10 |
| attr(,"na.action") |
| [1] 3 |
| attr(,"class") |
| [1] "omit" |
| > stopifnot(all(na.omit(1:3) == 1:3)) # does not affect objects with no NA's |
| > try(na.fail(DF)) #> Error: missing values in ... |
| Error in na.fail.default(DF) : missing values in object |
| > |
| > options("na.action") |
| $na.action |
| [1] "na.omit" |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("nextn") |
| > ### * nextn |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: nextn |
| > ### Title: Find Highly Composite Numbers |
| > ### Aliases: nextn |
| > ### Keywords: math |
| > |
| > ### ** Examples |
| > |
| > nextn(1001) # 1024 |
| [1] 1024 |
| > table(nextn(599:630)) |
| |
| 600 625 640 |
| 2 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 = 0 |
| Step: |
| [1] 0 0 |
| Parameter: |
| [1] 10 10 |
| Function Value |
| [1] 145 |
| Gradient: |
| [1] 18.00001 16.00001 |
| |
| iteration = 1 |
| Step: |
| [1] -9 -8 |
| Parameter: |
| [1] 1 2 |
| Function Value |
| [1] 1.721748e-13 |
| Gradient: |
| [1] 1.551336e-06 1.379735e-06 |
| |
| iteration = 2 |
| Parameter: |
| [1] 1 2 |
| Function Value |
| [1] 4.303458e-26 |
| Gradient: |
| [1] 2.757794e-13 -3.099743e-13 |
| |
| Relative gradient close to zero. |
| Current iterate is probably solution. |
| |
| $minimum |
| [1] 4.303458e-26 |
| |
| $estimate |
| [1] 1 2 |
| |
| $gradient |
| [1] 2.757794e-13 -3.099743e-13 |
| |
| $code |
| [1] 1 |
| |
| $iterations |
| [1] 2 |
| |
| > utils::str(nlm(f, c(5), hessian = TRUE)) |
| List of 6 |
| $ minimum : num 2.44e-24 |
| $ estimate : num 1 |
| $ gradient : num 1e-06 |
| $ hessian : num [1, 1] 2 |
| $ code : int 1 |
| $ iterations: int 1 |
| > |
| > f <- function(x, a) sum((x-a)^2) |
| > nlm(f, c(10,10), a = c(3,5)) |
| $minimum |
| [1] 3.371781e-25 |
| |
| $estimate |
| [1] 3 5 |
| |
| $gradient |
| [1] 6.750156e-13 -9.450218e-13 |
| |
| $code |
| [1] 1 |
| |
| $iterations |
| [1] 2 |
| |
| > f <- function(x, a) |
| + { |
| + res <- sum((x-a)^2) |
| + attr(res, "gradient") <- 2*(x-a) |
| + res |
| + } |
| > nlm(f, c(10,10), a = c(3,5)) |
| $minimum |
| [1] 0 |
| |
| $estimate |
| [1] 3 5 |
| |
| $gradient |
| [1] 0 0 |
| |
| $code |
| [1] 1 |
| |
| $iterations |
| [1] 1 |
| |
| > |
| > ## more examples, including the use of derivatives. |
| > ## Not run: demo(nlm) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("nlminb") |
| > ### * nlminb |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: nlminb |
| > ### Title: Optimization using PORT routines |
| > ### Aliases: nlminb |
| > ### Keywords: optimize |
| > |
| > ### ** Examples |
| > |
| > |
| > cleanEx() |
| > nameEx("nls") |
| > ### * nls |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: nls |
| > ### Title: Nonlinear Least Squares |
| > ### Aliases: nls |
| > ### Keywords: nonlinear regression models |
| > |
| > ### ** Examples |
| > |
| > ## Don't show: |
| > od <- options(digits=5) |
| > ## End(Don't show) |
| > require(graphics) |
| > |
| > DNase1 <- subset(DNase, Run == 1) |
| > |
| > ## using a selfStart model |
| > fm1DNase1 <- nls(density ~ SSlogis(log(conc), Asym, xmid, scal), DNase1) |
| > summary(fm1DNase1) |
| |
| Formula: density ~ SSlogis(log(conc), Asym, xmid, scal) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Asym 2.3452 0.0782 30.0 2.2e-13 *** |
| xmid 1.4831 0.0814 18.2 1.2e-10 *** |
| scal 1.0415 0.0323 32.3 8.5e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.0192 on 13 degrees of freedom |
| |
| > ## the coefficients only: |
| > coef(fm1DNase1) |
| Asym xmid scal |
| 2.3452 1.4831 1.0415 |
| > ## including their SE, etc: |
| > coef(summary(fm1DNase1)) |
| Estimate Std. Error t value Pr(>|t|) |
| Asym 2.3452 0.078154 30.007 2.1655e-13 |
| xmid 1.4831 0.081353 18.230 1.2185e-10 |
| scal 1.0415 0.032271 32.272 8.5069e-14 |
| > |
| > ## using conditional linearity |
| > fm2DNase1 <- nls(density ~ 1/(1 + exp((xmid - log(conc))/scal)), |
| + data = DNase1, |
| + start = list(xmid = 0, scal = 1), |
| + algorithm = "plinear") |
| > summary(fm2DNase1) |
| |
| Formula: density ~ 1/(1 + exp((xmid - log(conc))/scal)) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| xmid 1.4831 0.0814 18.2 1.2e-10 *** |
| scal 1.0415 0.0323 32.3 8.5e-14 *** |
| .lin 2.3452 0.0782 30.0 2.2e-13 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.0192 on 13 degrees of freedom |
| |
| > |
| > ## without conditional linearity |
| > fm3DNase1 <- nls(density ~ Asym/(1 + exp((xmid - log(conc))/scal)), |
| + data = DNase1, |
| + start = list(Asym = 3, xmid = 0, scal = 1)) |
| > summary(fm3DNase1) |
| |
| Formula: density ~ Asym/(1 + exp((xmid - log(conc))/scal)) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Asym 2.3452 0.0782 30.0 2.2e-13 *** |
| xmid 1.4831 0.0814 18.2 1.2e-10 *** |
| scal 1.0415 0.0323 32.3 8.5e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.0192 on 13 degrees of freedom |
| |
| > |
| > ## using Port's nl2sol algorithm |
| > fm4DNase1 <- nls(density ~ Asym/(1 + exp((xmid - log(conc))/scal)), |
| + data = DNase1, |
| + start = list(Asym = 3, xmid = 0, scal = 1), |
| + algorithm = "port") |
| > summary(fm4DNase1) |
| |
| Formula: density ~ Asym/(1 + exp((xmid - log(conc))/scal)) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Asym 2.3452 0.0782 30.0 2.2e-13 *** |
| xmid 1.4831 0.0814 18.2 1.2e-10 *** |
| scal 1.0415 0.0323 32.3 8.5e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.0192 on 13 degrees of freedom |
| |
| Algorithm "port", convergence message: relative convergence (4) |
| |
| > |
| > ## weighted nonlinear regression |
| > Treated <- Puromycin[Puromycin$state == "treated", ] |
| > weighted.MM <- function(resp, conc, Vm, K) |
| + { |
| + ## Purpose: exactly as white book p. 451 -- RHS for nls() |
| + ## Weighted version of Michaelis-Menten model |
| + ## ---------------------------------------------------------- |
| + ## Arguments: 'y', 'x' and the two parameters (see book) |
| + ## ---------------------------------------------------------- |
| + ## Author: Martin Maechler, Date: 23 Mar 2001 |
| + |
| + pred <- (Vm * conc)/(K + conc) |
| + (resp - pred) / sqrt(pred) |
| + } |
| > |
| > Pur.wt <- nls( ~ weighted.MM(rate, conc, Vm, K), data = Treated, |
| + start = list(Vm = 200, K = 0.1)) |
| > summary(Pur.wt) |
| |
| Formula: 0 ~ weighted.MM(rate, conc, Vm, K) |
| |
| Parameters: |
| Estimate Std. Error t value Pr(>|t|) |
| Vm 2.07e+02 9.22e+00 22.42 7.0e-10 *** |
| K 5.46e-02 7.98e-03 6.84 4.5e-05 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 1.21 on 10 degrees of freedom |
| |
| > |
| > ## Passing arguments using a list that can not be coerced to a data.frame |
| > lisTreat <- with(Treated, |
| + list(conc1 = conc[1], conc.1 = conc[-1], rate = rate)) |
| > |
| > weighted.MM1 <- function(resp, conc1, conc.1, Vm, K) |
| + { |
| + conc <- c(conc1, conc.1) |
| + pred <- (Vm * conc)/(K + conc) |
| + (resp - pred) / sqrt(pred) |
| + } |
| > Pur.wt1 <- nls( ~ weighted.MM1(rate, conc1, conc.1, Vm, K), |
| + data = lisTreat, start = list(Vm = 200, K = 0.1)) |
| > stopifnot(all.equal(coef(Pur.wt), coef(Pur.wt1))) |
| > |
| > ## Chambers and Hastie (1992) Statistical Models in S (p. 537): |
| > ## If the value of the right side [of formula] has an attribute called |
| > ## 'gradient' this should be a matrix with the number of rows equal |
| > ## to the length of the response and one column for each parameter. |
| > |
| > weighted.MM.grad <- function(resp, conc1, conc.1, Vm, K) |
| + { |
| + conc <- c(conc1, conc.1) |
| + |
| + K.conc <- K+conc |
| + dy.dV <- conc/K.conc |
| + dy.dK <- -Vm*dy.dV/K.conc |
| + pred <- Vm*dy.dV |
| + pred.5 <- sqrt(pred) |
| + dev <- (resp - pred) / pred.5 |
| + Ddev <- -0.5*(resp+pred)/(pred.5*pred) |
| + attr(dev, "gradient") <- Ddev * cbind(Vm = dy.dV, K = dy.dK) |
| + dev |
| + } |
| > |
| > Pur.wt.grad <- nls( ~ weighted.MM.grad(rate, conc1, conc.1, Vm, K), |
| + data = lisTreat, start = list(Vm = 200, K = 0.1)) |
| > |
| > rbind(coef(Pur.wt), coef(Pur.wt1), coef(Pur.wt.grad)) |
| Vm K |
| [1,] 206.83 0.054611 |
| [2,] 206.83 0.054611 |
| [3,] 206.83 0.054611 |
| > |
| > ## In this example, there seems no advantage to providing the gradient. |
| > ## In other cases, there might be. |
| > |
| > |
| > ## The two examples below show that you can fit a model to |
| > ## artificial data with noise but not to artificial data |
| > ## without noise. |
| > x <- 1:10 |
| > y <- 2*x + 3 # perfect fit |
| > yeps <- y + rnorm(length(y), sd = 0.01) # added noise |
| > nls(yeps ~ a + b*x, start = list(a = 0.12345, b = 0.54321)) |
| Nonlinear regression model |
| model: yeps ~ a + b * x |
| data: parent.frame() |
| a b |
| 3 2 |
| residual sum-of-squares: 0.000524 |
| > ## 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.998650 |
| attr(,"gradient") |
| [,1] [,2] |
| [1,] -0.004432 0.01330 |
| [2,] -0.007915 0.02216 |
| [3,] -0.013583 0.03532 |
| [4,] -0.022395 0.05375 |
| [5,] -0.035475 0.07804 |
| [6,] -0.053991 0.10798 |
| [7,] -0.078950 0.14211 |
| [8,] -0.110921 0.17747 |
| [9,] -0.149727 0.20962 |
| [10,] -0.194186 0.23302 |
| [11,] -0.241971 0.24197 |
| [12,] -0.289692 0.23175 |
| [13,] -0.333225 0.19993 |
| [14,] -0.368270 0.14731 |
| [15,] -0.391043 0.07821 |
| [16,] -0.398942 0.00000 |
| [17,] -0.391043 -0.07821 |
| [18,] -0.368270 -0.14731 |
| [19,] -0.333225 -0.19993 |
| [20,] -0.289692 -0.23175 |
| [21,] -0.241971 -0.24197 |
| [22,] -0.194186 -0.23302 |
| [23,] -0.149727 -0.20962 |
| [24,] -0.110921 -0.17747 |
| [25,] -0.078950 -0.14211 |
| [26,] -0.053991 -0.10798 |
| [27,] -0.035475 -0.07804 |
| [28,] -0.022395 -0.05375 |
| [29,] -0.013583 -0.03532 |
| [30,] -0.007915 -0.02216 |
| [31,] -0.004432 -0.01330 |
| > ## Don't show: |
| > options(od) |
| > ## End(Don't show) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("oneway.test") |
| > ### * oneway.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: oneway.test |
| > ### Title: Test for Equal Means in a One-Way Layout |
| > ### Aliases: oneway.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > ## Not assuming equal variances |
| > oneway.test(extra ~ group, data = sleep) |
| |
| One-way analysis of means (not assuming equal variances) |
| |
| data: extra and group |
| F = 3.4626, num df = 1.000, denom df = 17.776, p-value = 0.07939 |
| |
| > ## Assuming equal variances |
| > oneway.test(extra ~ group, data = sleep, var.equal = TRUE) |
| |
| One-way analysis of means |
| |
| data: extra and group |
| F = 3.4626, num df = 1, denom df = 18, p-value = 0.07919 |
| |
| > ## which gives the same result as |
| > anova(lm(extra ~ group, data = sleep)) |
| Analysis of Variance Table |
| |
| Response: extra |
| Df Sum Sq Mean Sq F value Pr(>F) |
| group 1 12.482 12.4820 3.4626 0.07919 . |
| Residuals 18 64.886 3.6048 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("optim") |
| > ### * optim |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: optim |
| > ### Title: General-purpose Optimization |
| > ### Aliases: optim 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 incorrect |
| Warning in prop.test(x[c(i, j)], n[c(i, j)], ...) : |
| Chi-squared approximation may be incorrect |
| Warning in prop.test(x[c(i, j)], n[c(i, j)], ...) : |
| Chi-squared approximation may be incorrect |
| |
| Pairwise comparisons using Pairwise comparison of proportions |
| |
| data: smokers out of patients |
| |
| 1 2 3 |
| 2 1.000 - - |
| 3 1.000 1.000 - |
| 4 0.119 0.093 0.124 |
| |
| P value adjustment method: holm |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("pairwise.t.test") |
| > ### * pairwise.t.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: pairwise.t.test |
| > ### Title: Pairwise t tests |
| > ### Aliases: pairwise.t.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > attach(airquality) |
| > Month <- factor(Month, labels = month.abb[5:9]) |
| > pairwise.t.test(Ozone, Month) |
| |
| Pairwise comparisons using t tests with pooled SD |
| |
| data: Ozone and Month |
| |
| May Jun Jul Aug |
| Jun 1.00000 - - - |
| Jul 0.00026 0.05113 - - |
| Aug 0.00019 0.04987 1.00000 - |
| Sep 1.00000 1.00000 0.00488 0.00388 |
| |
| P value adjustment method: holm |
| > pairwise.t.test(Ozone, Month, p.adj = "bonf") |
| |
| Pairwise comparisons using t tests with pooled SD |
| |
| data: Ozone and Month |
| |
| May Jun Jul Aug |
| Jun 1.00000 - - - |
| Jul 0.00029 0.10225 - - |
| Aug 0.00019 0.08312 1.00000 - |
| Sep 1.00000 1.00000 0.00697 0.00485 |
| |
| P value adjustment method: bonferroni |
| > pairwise.t.test(Ozone, Month, pool.sd = FALSE) |
| |
| Pairwise comparisons using t tests with non-pooled SD |
| |
| data: Ozone and Month |
| |
| May Jun Jul Aug |
| Jun 1.00000 - - - |
| Jul 0.00026 0.01527 - - |
| Aug 0.00195 0.02135 1.00000 - |
| Sep 0.86321 1.00000 0.00589 0.01721 |
| |
| P value adjustment method: holm |
| > detach() |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("pairwise.wilcox.test") |
| > ### * pairwise.wilcox.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: pairwise.wilcox.test |
| > ### Title: Pairwise Wilcoxon Rank Sum Tests |
| > ### Aliases: pairwise.wilcox.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > attach(airquality) |
| > Month <- factor(Month, labels = month.abb[5:9]) |
| > ## These give warnings because of ties : |
| > pairwise.wilcox.test(Ozone, Month) |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| |
| Pairwise comparisons using Wilcoxon rank sum test |
| |
| data: Ozone and Month |
| |
| May Jun Jul Aug |
| Jun 0.5775 - - - |
| Jul 0.0003 0.0848 - - |
| Aug 0.0011 0.1295 1.0000 - |
| Sep 0.4744 1.0000 0.0060 0.0227 |
| |
| P value adjustment method: holm |
| > pairwise.wilcox.test(Ozone, Month, p.adj = "bonf") |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| Warning in wilcox.test.default(xi, xj, paired = paired, ...) : |
| cannot compute exact p-value with ties |
| |
| Pairwise comparisons using Wilcoxon rank sum test |
| |
| data: Ozone and Month |
| |
| May Jun Jul Aug |
| Jun 1.0000 - - - |
| Jul 0.0003 0.1414 - - |
| Aug 0.0012 0.2591 1.0000 - |
| Sep 1.0000 1.0000 0.0074 0.0325 |
| |
| P value adjustment method: bonferroni |
| > detach() |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("plot.acf") |
| > ### * plot.acf |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: plot.acf |
| > ### Title: Plot Autocovariance and Autocorrelation Functions |
| > ### Aliases: plot.acf |
| > ### Keywords: hplot ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > z4 <- ts(matrix(rnorm(400), 100, 4), start = c(1961, 1), frequency = 12) |
| > z7 <- ts(matrix(rnorm(700), 100, 7), start = c(1961, 1), frequency = 12) |
| > acf(z4) |
| > acf(z7, max.mfrow = 7) # squeeze 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 there |
| |
| isoreg> require(graphics) |
| |
| isoreg> (ir <- isoreg(c(1,0,4,3,3,5,4,2,0))) |
| Isotonic regression from isoreg(x = c(1, 0, 4, 3, 3, 5, 4, 2, 0)), |
| with 2 knots / breaks at obs.nr. 2 9 ; |
| initially ordered 'x' |
| and further components List of 4 |
| $ x : num [1:9] 1 2 3 4 5 6 7 8 9 |
| $ y : num [1:9] 1 0 4 3 3 5 4 2 0 |
| $ yf: num [1:9] 0.5 0.5 3 3 3 3 3 3 3 |
| $ yc: num [1:10] 0 1 1 5 8 11 16 20 22 22 |
| |
| isoreg> plot(ir, plot.type = "row") |
| |
| isoreg> (ir3 <- isoreg(y3 <- c(1,0,4,3,3,5,4,2, 3))) # last "3", not "0" |
| Isotonic regression from isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3)), |
| with 3 knots / breaks at obs.nr. 2 5 9 ; |
| initially ordered 'x' |
| and further components List of 4 |
| $ x : num [1:9] 1 2 3 4 5 6 7 8 9 |
| $ y : num [1:9] 1 0 4 3 3 5 4 2 3 |
| $ yf: num [1:9] 0.5 0.5 3.33 3.33 3.33 ... |
| $ yc: num [1:10] 0 1 1 5 8 11 16 20 22 25 |
| |
| isoreg> (fi3 <- as.stepfun(ir3)) |
| Step function |
| Call: isoreg(x = y3 <- c(1, 0, 4, 3, 3, 5, 4, 2, 3)) |
| x[1:3] = 2, 5, 9 |
| 4 plateau levels = 0.5, 0.5, 3.3333, 3.5 |
| |
| isoreg> (ir4 <- isoreg(1:10, y4 <- c(5, 9, 1:2, 5:8, 3, 8))) |
| Isotonic regression from isoreg(x = 1:10, y = y4 <- c(5, 9, 1:2, 5:8, 3, 8)), |
| with 5 knots / breaks at obs.nr. 4 5 6 9 10 ; |
| initially ordered 'x' |
| and further components List of 4 |
| $ x : num [1:10] 1 2 3 4 5 6 7 8 9 10 |
| $ y : num [1:10] 5 9 1 2 5 6 7 8 3 8 |
| $ yf: num [1:10] 4.25 4.25 4.25 4.25 5 6 6 6 6 8 |
| $ yc: num [1:11] 0 5 14 15 17 22 28 35 43 46 ... |
| |
| isoreg> cat(sprintf("R^2 = %.2f\n", |
| isoreg+ 1 - sum(residuals(ir4)^2) / ((10-1)*var(y4)))) |
| R^2 = 0.21 |
| |
| isoreg> ## If you are interested in the knots alone : |
| isoreg> with(ir4, cbind(iKnots, yf[iKnots])) |
| iKnots |
| [1,] 4 4.25 |
| [2,] 5 5.00 |
| [3,] 6 6.00 |
| [4,] 9 6.00 |
| [5,] 10 8.00 |
| |
| isoreg> ## Example of unordered x[] with ties: |
| isoreg> x <- sample((0:30)/8) |
| |
| isoreg> y <- exp(x) |
| |
| isoreg> x. <- round(x) # ties! |
| |
| isoreg> plot(m <- isoreg(x., y)) |
| |
| isoreg> stopifnot(all.equal(with(m, yf[iKnots]), |
| isoreg+ as.vector(tapply(y, x., mean)))) |
| > |
| > plot(y3, main = "simple plot(.) + lines(<isoreg>)") |
| > lines(ir3) |
| > |
| > ## 'same' plot as above, "proving" that only ranks of 'x' are important |
| > plot(isoreg(2^(1:9), c(1,0,4,3,3,5,4,2,0)), plot.type = "row", log = "x") |
| Warning in xy.coords(x, y, xlabel, ylabel, log) : |
| 1 x value <= 0 omitted from logarithmic plot |
| Warning in xy.coords(x, y, xlabel, ylabel, log) : |
| 1 x value <= 0 omitted from logarithmic plot |
| > |
| > plot(ir3, plot.type = "row", ylab = "y3") |
| > plot(isoreg(y3 - 4), plot.t="r", ylab = "y3 - 4") |
| > plot(ir4, plot.type = "ro", ylab = "y4", xlab = "x = 1:n") |
| > |
| > ## experiment a bit with these (C-c C-j): |
| > plot(isoreg(sample(9), y3), plot.type = "row") |
| > plot(isoreg(sample(9), y3), plot.type = "col.wise") |
| > |
| > plot(ir <- isoreg(sample(10), sample(10, replace = TRUE)), |
| + plot.type = "r") |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("plot.lm") |
| > ### * plot.lm |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: plot.lm |
| > ### Title: Plot Diagnostics for an lm Object |
| > ### Aliases: plot.lm |
| > ### 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 test |
| |
| data: 137 time base: 24.19893 |
| number of events = 137, time base = 24.199, p-value < 2.2e-16 |
| alternative hypothesis: true event rate is not equal to 1 |
| 95 percent confidence interval: |
| 4.753125 6.692709 |
| sample estimates: |
| event rate |
| 5.661407 |
| |
| > |
| > ## eba1977, compare Fredericia to other three cities for ages 55-59 |
| > poisson.test(c(11, 6+8+7), c(800, 1083+1050+878)) |
| |
| Comparison of Poisson rates |
| |
| data: c(11, 6 + 8 + 7) time base: c(800, 1083 + 1050 + 878) |
| count1 = 11, expected count1 = 6.7174, p-value = 0.07967 |
| alternative hypothesis: true rate ratio is not equal to 1 |
| 95 percent confidence interval: |
| 0.8584264 4.2772659 |
| sample estimates: |
| rate ratio |
| 1.971488 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("poly") |
| > ### * poly |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: poly |
| > ### Title: Compute Orthogonal Polynomials |
| > ### Aliases: poly polym predict.poly makepredictcall.poly |
| > ### Keywords: math |
| > |
| > ### ** Examples |
| > |
| > od <- options(digits = 3) # avoid too much visual clutter |
| > (z <- poly(1:10, 3)) |
| 1 2 3 |
| [1,] -0.495 0.522 -0.453 |
| [2,] -0.385 0.174 0.151 |
| [3,] -0.275 -0.087 0.378 |
| [4,] -0.165 -0.261 0.335 |
| [5,] -0.055 -0.348 0.130 |
| [6,] 0.055 -0.348 -0.130 |
| [7,] 0.165 -0.261 -0.335 |
| [8,] 0.275 -0.087 -0.378 |
| [9,] 0.385 0.174 -0.151 |
| [10,] 0.495 0.522 0.453 |
| attr(,"coefs") |
| attr(,"coefs")$alpha |
| [1] 5.5 5.5 5.5 |
| |
| attr(,"coefs")$norm2 |
| [1] 1.0 10.0 82.5 528.0 3088.8 |
| |
| attr(,"degree") |
| [1] 1 2 3 |
| attr(,"class") |
| [1] "poly" "matrix" |
| > predict(z, seq(2, 4, 0.5)) |
| 1 2 3 |
| [1,] -0.385 0.1741 0.151 |
| [2,] -0.330 0.0326 0.305 |
| [3,] -0.275 -0.0870 0.378 |
| [4,] -0.220 -0.1850 0.383 |
| [5,] -0.165 -0.2611 0.335 |
| > zapsmall(poly(seq(4, 6, 0.5), 3, coefs = attr(z, "coefs"))) |
| 1 2 3 |
| [1,] -0.165 -0.261 0.335 |
| [2,] -0.110 -0.316 0.246 |
| [3,] -0.055 -0.348 0.130 |
| [4,] 0.000 -0.359 0.000 |
| [5,] 0.055 -0.348 -0.130 |
| attr(,"coefs") |
| attr(,"coefs")$alpha |
| [1] 5.5 5.5 5.5 |
| |
| attr(,"coefs")$norm2 |
| [1] 1.0 10.0 82.5 528.0 3088.8 |
| |
| attr(,"degree") |
| [1] 1 2 3 |
| attr(,"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.315 |
| attr(,"degree") |
| [1] 1 2 3 1 2 3 2 3 3 |
| attr(,"coefs") |
| attr(,"coefs")[[1]] |
| attr(,"coefs")[[1]]$alpha |
| [1] 2.5 2.5 2.5 |
| |
| attr(,"coefs")[[1]]$norm2 |
| [1] 1.0 4.0 5.0 4.0 1.8 |
| |
| |
| attr(,"coefs")[[2]] |
| attr(,"coefs")[[2]]$alpha |
| [1] 4.00 2.71 4.47 |
| |
| attr(,"coefs")[[2]]$norm2 |
| [1] 1.00 4.00 14.00 25.86 9.94 |
| |
| |
| attr(,"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() |
| $linkfun |
| function (mu) |
| mu |
| <environment: namespace:stats> |
| |
| $linkinv |
| function (eta) |
| eta |
| <environment: namespace:stats> |
| |
| $mu.eta |
| function (eta) |
| rep.int(1, length(eta)) |
| <environment: namespace:stats> |
| |
| $valideta |
| function (eta) |
| TRUE |
| <environment: namespace:stats> |
| |
| $name |
| [1] "identity" |
| |
| attr(,"class") |
| [1] "link-glm" |
| > quasi(link = power(1/3))[c("linkfun", "linkinv")] |
| $linkfun |
| function (mu) |
| mu^lambda |
| <bytecode: 0x5cbc1e0> |
| <environment: 0x5ccb6f0> |
| |
| $linkinv |
| function (eta) |
| pmax(eta^(1/lambda), .Machine$double.eps) |
| <bytecode: 0x5cbc090> |
| <environment: 0x5ccb6f0> |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("power.anova.test") |
| > ### * power.anova.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: power.anova.test |
| > ### Title: Power Calculations for Balanced One-Way Analysis of Variance |
| > ### Tests |
| > ### Aliases: power.anova.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > power.anova.test(groups = 4, n = 5, between.var = 1, within.var = 3) |
| |
| Balanced one-way analysis of variance power calculation |
| |
| groups = 4 |
| n = 5 |
| between.var = 1 |
| within.var = 3 |
| sig.level = 0.05 |
| power = 0.3535594 |
| |
| NOTE: n is number in each group |
| |
| > # Power = 0.3535594 |
| > |
| > power.anova.test(groups = 4, between.var = 1, within.var = 3, |
| + power = .80) |
| |
| Balanced one-way analysis of variance power calculation |
| |
| groups = 4 |
| n = 11.92613 |
| between.var = 1 |
| within.var = 3 |
| sig.level = 0.05 |
| power = 0.8 |
| |
| NOTE: n is number in each group |
| |
| > # n = 11.92613 |
| > |
| > ## Assume we have prior knowledge of the group means: |
| > groupmeans <- c(120, 130, 140, 150) |
| > power.anova.test(groups = length(groupmeans), |
| + between.var = var(groupmeans), |
| + within.var = 500, power = .90) # n = 15.18834 |
| |
| Balanced one-way analysis of variance power calculation |
| |
| groups = 4 |
| n = 15.18834 |
| between.var = 166.6667 |
| within.var = 500 |
| sig.level = 0.05 |
| power = 0.9 |
| |
| NOTE: n is number in each group |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("power.prop.test") |
| > ### * power.prop.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: power.prop.test |
| > ### Title: Power Calculations for Two-Sample Test for Proportions |
| > ### Aliases: power.prop.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > power.prop.test(n = 50, p1 = .50, p2 = .75) ## => power = 0.740 |
| |
| Two-sample comparison of proportions power calculation |
| |
| n = 50 |
| p1 = 0.5 |
| p2 = 0.75 |
| sig.level = 0.05 |
| power = 0.7401659 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > power.prop.test(p1 = .50, p2 = .75, power = .90) ## => n = 76.7 |
| |
| Two-sample comparison of proportions power calculation |
| |
| n = 76.70693 |
| p1 = 0.5 |
| p2 = 0.75 |
| sig.level = 0.05 |
| power = 0.9 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > power.prop.test(n = 50, p1 = .5, power = .90) ## => p2 = 0.8026 |
| |
| Two-sample comparison of proportions power calculation |
| |
| n = 50 |
| p1 = 0.5 |
| p2 = 0.8026141 |
| sig.level = 0.05 |
| power = 0.9 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > power.prop.test(n = 50, p1 = .5, p2 = 0.9, power = .90, sig.level=NULL) |
| |
| Two-sample comparison of proportions power calculation |
| |
| n = 50 |
| p1 = 0.5 |
| p2 = 0.9 |
| sig.level = 0.001318068 |
| power = 0.9 |
| alternative = two.sided |
| |
| NOTE: 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 calculation |
| |
| n = 10451937 |
| p1 = 0.5 |
| p2 = 0.501 |
| sig.level = 0.001 |
| power = 0.9 |
| alternative = two.sided |
| |
| NOTE: 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 power |
| |
| Two-sample comparison of proportions power calculation |
| |
| n = 30 |
| p1 = 0.9 |
| p2 = 1.030182 |
| sig.level = 0.05 |
| power = 0.8 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > ## Reason: |
| > power.prop.test( p1=0.90, p2= 1.0, power=0.8) ##-> n = 73.37 |
| |
| Two-sample comparison of proportions power calculation |
| |
| n = 73.37427 |
| p1 = 0.9 |
| p2 = 1 |
| sig.level = 0.05 |
| power = 0.8 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("power.t.test") |
| > ### * power.t.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: power.t.test |
| > ### Title: Power calculations for one and two sample t tests |
| > ### Aliases: power.t.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > power.t.test(n = 20, delta = 1) |
| |
| Two-sample t test power calculation |
| |
| n = 20 |
| delta = 1 |
| sd = 1 |
| sig.level = 0.05 |
| power = 0.8689528 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > power.t.test(power = .90, delta = 1) |
| |
| Two-sample t test power calculation |
| |
| n = 22.0211 |
| delta = 1 |
| sd = 1 |
| sig.level = 0.05 |
| power = 0.9 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > power.t.test(power = .90, delta = 1, alternative = "one.sided") |
| |
| Two-sample t test power calculation |
| |
| n = 17.84713 |
| delta = 1 |
| sd = 1 |
| sig.level = 0.05 |
| power = 0.9 |
| alternative = one.sided |
| |
| NOTE: n is number in *each* group |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("pp.test") |
| > ### * pp.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: PP.test |
| > ### Title: Phillips-Perron Test for Unit Roots |
| > ### Aliases: PP.test |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > x <- rnorm(1000) |
| > PP.test(x) |
| |
| Phillips-Perron Unit Root Test |
| |
| data: x |
| Dickey-Fuller = -33.057, Truncation lag parameter = 7, p-value = 0.01 |
| |
| > y <- cumsum(x) # has unit root |
| > PP.test(y) |
| |
| Phillips-Perron Unit Root Test |
| |
| data: y |
| Dickey-Fuller = -2.6899, Truncation lag parameter = 7, p-value = 0.2863 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("ppoints") |
| > ### * ppoints |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ppoints |
| > ### Title: Ordinates for Probability Plotting |
| > ### Aliases: ppoints |
| > ### Keywords: dplot arith distribution |
| > |
| > ### ** Examples |
| > |
| > ppoints(4) # the same as ppoints(1:4) |
| [1] 0.1470588 0.3823529 0.6176471 0.8529412 |
| > ppoints(10) |
| [1] 0.06097561 0.15853659 0.25609756 0.35365854 0.45121951 0.54878049 |
| [7] 0.64634146 0.74390244 0.84146341 0.93902439 |
| > ppoints(10, a = 1/2) |
| [1] 0.05 0.15 0.25 0.35 0.45 0.55 0.65 0.75 0.85 0.95 |
| > |
| > ## 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.ppr |
| Call: |
| ppr(formula = log(perm) ~ area1 + peri1 + shape, data = rock, |
| nterms = 2, max.terms = 5) |
| |
| Goodness of fit: |
| 2 terms 3 terms 4 terms 5 terms |
| 8.737806 5.289517 4.745799 4.490378 |
| > # Call: |
| > # ppr.formula(formula = log(perm) ~ area1 + peri1 + shape, data = rock, |
| > # nterms = 2, max.terms = 5) |
| > # |
| > # Goodness of fit: |
| > # 2 terms 3 terms 4 terms 5 terms |
| > # 8.737806 5.289517 4.745799 4.490378 |
| > |
| > summary(rock.ppr) |
| Call: |
| ppr(formula = log(perm) ~ area1 + peri1 + shape, data = rock, |
| nterms = 2, max.terms = 5) |
| |
| Goodness of fit: |
| 2 terms 3 terms 4 terms 5 terms |
| 8.737806 5.289517 4.745799 4.490378 |
| |
| Projection direction vectors ('alpha'): |
| term 1 term 2 |
| area1 0.34357179 0.37071027 |
| peri1 -0.93781471 -0.61923542 |
| shape 0.04961846 0.69218595 |
| |
| Coefficients of ridge terms ('beta'): |
| term 1 term 2 |
| 1.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 prediction |
| 1 6.3 5.9 |
| 2 6.3 6.5 |
| 3 6.3 12.1 |
| 4 6.3 7.4 |
| 5 17.1 16.3 |
| 6 17.1 13.2 |
| 7 17.1 41.2 |
| 8 17.1 10.6 |
| 9 119.0 101.9 |
| 10 119.0 73.0 |
| 11 119.0 46.8 |
| 12 119.0 121.7 |
| 13 82.4 107.8 |
| 14 82.4 79.7 |
| 15 82.4 98.3 |
| 16 82.4 128.8 |
| 17 58.6 66.8 |
| 18 58.6 33.2 |
| 19 58.6 58.7 |
| 20 58.6 111.6 |
| 21 142.0 118.9 |
| 22 142.0 128.4 |
| 23 142.0 91.9 |
| 24 142.0 188.5 |
| 25 740.0 341.7 |
| 26 740.0 577.9 |
| 27 740.0 895.7 |
| 28 740.0 1041.0 |
| 29 890.0 560.8 |
| 30 890.0 721.8 |
| 31 890.0 937.9 |
| 32 890.0 848.5 |
| 33 950.0 806.4 |
| 34 950.0 1085.4 |
| 35 950.0 945.6 |
| 36 950.0 848.5 |
| 37 100.0 154.1 |
| 38 100.0 178.0 |
| 39 100.0 321.5 |
| 40 100.0 232.7 |
| 41 1300.0 1067.0 |
| 42 1300.0 697.8 |
| 43 1300.0 1236.6 |
| 44 1300.0 1301.8 |
| 45 580.0 485.1 |
| 46 580.0 285.1 |
| 47 580.0 644.3 |
| 48 580.0 571.5 |
| > detach() |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("prcomp") |
| > ### * prcomp |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: prcomp |
| > ### Title: Principal Components Analysis |
| > ### Aliases: prcomp prcomp.formula prcomp.default plot.prcomp |
| > ### predict.prcomp print.prcomp summary.prcomp print.summary.prcomp |
| > ### Keywords: multivariate |
| > |
| > ### ** Examples |
| > |
| > 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 PC7 |
| Standard deviation 3.6415 2.7178 1.8447 1.39430 1.10207 0.90922 0.76951 |
| Proportion of Variance 0.4173 0.2324 0.1071 0.06118 0.03822 0.02602 0.01864 |
| Cumulative Proportion 0.4173 0.6498 0.7569 0.81806 0.85628 0.88230 0.90094 |
| PC8 PC9 PC10 PC11 PC12 PC13 PC14 |
| Standard deviation 0.67490 0.60833 0.51638 0.49048 0.44452 0.40326 0.3904 |
| Proportion of Variance 0.01433 0.01165 0.00839 0.00757 0.00622 0.00512 0.0048 |
| Cumulative 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 above |
| Importance of first k=3 (out of 32) components: |
| PC1 PC2 PC3 |
| Standard deviation 3.6415 2.7178 1.8447 |
| Proportion of Variance 0.4173 0.2324 0.1071 |
| Cumulative 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.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, ...) NULL |
| predict.HoltWinters : |
| function (object, n.ahead = 1L, prediction.interval = FALSE, level = 0.95, ...) NULL |
| predict.StructTS : |
| function (object, n.ahead = 1L, se.fit = TRUE, ...) NULL |
| predict.ar : |
| function (object, newdata, n.ahead = 1L, se.fit = TRUE, ...) NULL |
| predict.arima0 : |
| function (object, n.ahead = 1L, newxreg = NULL, se.fit = TRUE, ...) NULL |
| predict.bSpline : |
| function (object, x, nseg = 50, deriv = 0, ...) NULL |
| predict.bs : |
| function (object, newx, ...) NULL |
| predict.glm : |
| function (object, newdata = NULL, type = c("link", "response", "terms"), se.fit = FALSE, dispersion = NULL, terms = NULL, na.action = na.pass, ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.glmmPQL : |
| function (object, newdata = NULL, type = c("link", "response"), level = Q, na.action = na.pass, ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.lda : |
| function (object, newdata, prior = object$prior, dimen, method = c("plug-in", "predictive", "debiased"), ...) NULL |
| predict.lm : |
| function (object, newdata, se.fit = FALSE, scale = NULL, df = Inf, interval = c("none", "confidence", "prediction"), level = 0.95, type = c("response", "terms"), terms = NULL, na.action = na.pass, pred.var = res.var/weights, weights = 1, ...) NULL |
| predict.loess : |
| function (object, newdata = NULL, se = FALSE, na.action = na.pass, ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.lqs : |
| function (object, newdata, na.action = na.pass, ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.mca : |
| function (object, newdata, type = c("row", "factor"), ...) NULL |
| predict.mlm : |
| function (object, newdata, se.fit = FALSE, na.action = na.pass, ...) NULL |
| predict.nbSpline : |
| function (object, x, nseg = 50, deriv = 0, ...) NULL |
| predict.nls : |
| function (object, newdata, se.fit = FALSE, scale = NULL, df = Inf, interval = c("none", "confidence", "prediction"), level = 0.95, ...) NULL |
| predict.npolySpline : |
| function (object, x, nseg = 50, deriv = 0, ...) NULL |
| predict.ns : |
| function (object, newx, ...) NULL |
| predict.pbSpline : |
| function (object, x, nseg = 50, deriv = 0, ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.polr : |
| function (object, newdata, type = c("class", "probs"), ...) NULL |
| predict.poly : |
| function (object, newdata, ...) NULL |
| predict.polySpline : |
| function (object, x, nseg = 50, deriv = 0, ...) NULL |
| predict.ppolySpline : |
| function (object, x, nseg = 50, deriv = 0, ...) NULL |
| predict.ppr : |
| function (object, newdata, ...) NULL |
| predict.prcomp : |
| function (object, newdata, ...) NULL |
| predict.princomp : |
| function (object, newdata, ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.qda : |
| function (object, newdata, prior = object$prior, method = c("plug-in", "predictive", "debiased", "looCV"), ...) NULL |
| Warning: namespace ‘MASS’ is not available and has been replaced |
| by .GlobalEnv when processing object ‘’ |
| predict.rlm : |
| function (object, newdata = NULL, scale = NULL, ...) NULL |
| predict.smooth.spline : |
| function (object, x, deriv = 0, ...) NULL |
| predict.smooth.spline.fit : |
| function (object, x, deriv = 0, ...) NULL |
| > ## IGNORE_RDIFF_END |
| > ## Don't show: |
| > old <- Sys.setlocale("LC_COLLATE", old) |
| > ## End(Don't show) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("predict.arima") |
| > ### * predict.arima |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: predict.Arima |
| > ### Title: Forecast from ARIMA fits |
| > ### Aliases: predict.Arima |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > od <- options(digits = 5) # avoid too much spurious accuracy |
| > predict(arima(lh, order = c(3,0,0)), n.ahead = 12) |
| $pred |
| Time Series: |
| Start = 49 |
| End = 60 |
| Frequency = 1 |
| [1] 2.4602 2.2708 2.1986 2.2607 2.3470 2.4145 2.4389 2.4315 2.4102 2.3917 |
| [11] 2.3827 2.3827 |
| |
| $se |
| Time Series: |
| Start = 49 |
| End = 60 |
| Frequency = 1 |
| [1] 0.42268 0.50293 0.52452 0.52472 0.53055 0.53692 0.53880 0.53884 0.53910 |
| [10] 0.53952 0.53970 0.53971 |
| |
| > |
| > (fit <- arima(USAccDeaths, order = c(0,1,1), |
| + seasonal = list(order = c(0,1,1)))) |
| |
| Call: |
| arima(x = USAccDeaths, order = c(0, 1, 1), seasonal = list(order = c(0, 1, 1))) |
| |
| Coefficients: |
| ma1 sma1 |
| -0.430 -0.553 |
| s.e. 0.123 0.178 |
| |
| sigma^2 estimated as 99347: log likelihood = -425.44, aic = 856.88 |
| > predict(fit, n.ahead = 6) |
| $pred |
| Jan Feb Mar Apr May Jun |
| 1979 8336.1 7531.8 8314.6 8616.9 9488.9 9859.8 |
| |
| $se |
| Jan Feb Mar Apr May Jun |
| 1979 315.45 363.01 405.02 443.06 478.09 510.72 |
| |
| > options(od) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("predict.glm") |
| > ### * predict.glm |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: predict.glm |
| > ### Title: Predict Method for GLM Fits |
| > ### Aliases: predict.glm |
| > ### Keywords: models regression |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > ## example from Venables and Ripley (2002, pp. 190-2.) |
| > ldose <- rep(0:5, 2) |
| > numdead <- c(1, 4, 9, 13, 18, 20, 0, 2, 6, 10, 12, 16) |
| > sex <- factor(rep(c("M", "F"), c(6, 6))) |
| > SF <- cbind(numdead, numalive = 20-numdead) |
| > budworm.lg <- glm(SF ~ sex*ldose, family = binomial) |
| > summary(budworm.lg) |
| |
| Call: |
| glm(formula = SF ~ sex * ldose, family = binomial) |
| |
| Deviance Residuals: |
| Min 1Q Median 3Q Max |
| -1.39849 -0.32094 -0.07592 0.38220 1.10375 |
| |
| Coefficients: |
| Estimate Std. Error z value Pr(>|z|) |
| (Intercept) -2.9935 0.5527 -5.416 6.09e-08 *** |
| sexM 0.1750 0.7783 0.225 0.822 |
| ldose 0.9060 0.1671 5.422 5.89e-08 *** |
| sexM:ldose 0.3529 0.2700 1.307 0.191 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| (Dispersion parameter for binomial family taken to be 1) |
| |
| Null deviance: 124.8756 on 11 degrees of freedom |
| Residual deviance: 4.9937 on 8 degrees of freedom |
| AIC: 43.104 |
| |
| Number of Fisher Scoring iterations: 4 |
| |
| > |
| > plot(c(1,32), c(0,1), type = "n", xlab = "dose", |
| + ylab = "prob", log = "x") |
| > text(2^ldose, numdead/20, as.character(sex)) |
| > ld <- seq(0, 5, 0.1) |
| > lines(2^ld, predict(budworm.lg, data.frame(ldose = ld, |
| + sex = factor(rep("M", length(ld)), levels = levels(sex))), |
| + type = "response")) |
| > lines(2^ld, predict(budworm.lg, data.frame(ldose = ld, |
| + sex = factor(rep("F", length(ld)), levels = levels(sex))), |
| + type = "response")) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("predict.lm") |
| > ### * predict.lm |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: predict.lm |
| > ### Title: Predict method for Linear Model Fits |
| > ### Aliases: predict.lm |
| > ### Keywords: regression |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > ## Predictions |
| > x <- rnorm(15) |
| > y <- x + rnorm(15) |
| > predict(lm(y ~ x)) |
| 1 2 3 4 5 6 7 |
| -0.6270917 0.2550840 -0.8548779 1.7923222 0.4139268 -0.8383687 0.5858991 |
| 8 9 10 11 12 13 14 |
| 0.8591183 0.6821126 -0.2774594 1.7013932 0.4796306 -0.6214146 -2.3566523 |
| 15 |
| 1.2801229 |
| > new <- data.frame(x = seq(-3, 3, 0.5)) |
| > predict(lm(y ~ x), new, se.fit = TRUE) |
| $fit |
| 1 2 3 4 5 6 |
| -3.21182462 -2.66733702 -2.12284942 -1.57836182 -1.03387422 -0.48938662 |
| 7 8 9 10 11 12 |
| 0.05510098 0.59958858 1.14407618 1.68856379 2.23305139 2.77753899 |
| 13 |
| 3.32202659 |
| |
| $se.fit |
| 1 2 3 4 5 6 7 8 |
| 0.7545246 0.6449274 0.5380108 0.4357521 0.3423511 0.2672616 0.2292452 0.2461261 |
| 9 10 11 12 13 |
| 0.3090353 0.3966456 0.4960370 0.6013965 0.7100725 |
| |
| $df |
| [1] 13 |
| |
| $residual.scale |
| [1] 0.8832292 |
| |
| > pred.w.plim <- predict(lm(y ~ x), new, interval = "prediction") |
| > pred.w.clim <- predict(lm(y ~ x), new, interval = "confidence") |
| > matplot(new$x, cbind(pred.w.clim, pred.w.plim[,-1]), |
| + lty = c(1,2,2,3,3), type = "l", ylab = "predicted y") |
| > |
| > ## Prediction intervals, special cases |
| > ## The first three of these throw warnings |
| > w <- 1 + x^2 |
| > fit <- lm(y ~ x) |
| > wfit <- lm(y ~ x, weights = w) |
| > predict(fit, interval = "prediction") |
| Warning in predict.lm(fit, interval = "prediction") : |
| predictions on current data refer to _future_ responses |
| |
| fit lwr upr |
| 1 -0.6270917 -2.6311852 1.37700188 |
| 2 0.2550840 -1.7160306 2.22619860 |
| 3 -0.8548779 -2.8806560 1.17090027 |
| 4 1.7923222 -0.3158417 3.90048609 |
| 5 0.4139268 -1.5600794 2.38793297 |
| 6 -0.8383687 -2.8624006 1.18566313 |
| 7 0.5858991 -1.3942769 2.56607519 |
| 8 0.8591183 -1.1372816 2.85551813 |
| 9 0.6821126 -1.3028836 2.66710884 |
| 10 -0.2774594 -2.2586227 1.70370390 |
| 11 1.7013932 -0.3922734 3.79505973 |
| 12 0.4796306 -1.4963611 2.45562227 |
| 13 -0.6214146 -2.6250348 1.38220556 |
| 14 -2.3566523 -4.6435457 -0.06975883 |
| 15 1.2801229 -0.7562734 3.31651909 |
| > predict(wfit, interval = "prediction") |
| Warning in predict.lm(wfit, interval = "prediction") : |
| predictions on current data refer to _future_ responses |
| |
| Warning in predict.lm(wfit, interval = "prediction") : |
| assuming prediction variance inversely proportional to weights used for fitting |
| |
| fit lwr upr |
| 1 -0.6795401 -2.7152943 1.3562142 |
| 2 0.2726114 -2.0676598 2.6128825 |
| 3 -0.9253947 -2.7873163 0.9365269 |
| 4 1.9317861 0.5179227 3.3456495 |
| 5 0.4440538 -1.8206181 2.7087257 |
| 6 -0.9075760 -2.7817747 0.9666227 |
| 7 0.6296673 -1.5219043 2.7812390 |
| 8 0.9245587 -1.0206112 2.8697287 |
| 9 0.7335126 -1.3468740 2.8138992 |
| 10 -0.3021743 -2.5805044 1.9761557 |
| 11 1.8336444 0.3867018 3.2805870 |
| 12 0.5149694 -1.7094216 2.7393604 |
| 13 -0.6734127 -2.7135353 1.3667099 |
| 14 -2.5462925 -3.8073357 -1.2852494 |
| 15 1.3789581 -0.2749888 3.0329051 |
| > predict(wfit, new, interval = "prediction") |
| Warning in predict.lm(wfit, new, interval = "prediction") : |
| Assuming constant prediction variance even though model fit is weighted |
| |
| fit lwr upr |
| 1 -3.46929871 -6.02669183 -0.9119056 |
| 2 -2.88162137 -5.38456191 -0.3786808 |
| 3 -2.29394403 -4.75159401 0.1637059 |
| 4 -1.70626669 -4.12830217 0.7157688 |
| 5 -1.11858935 -3.51511782 1.2779391 |
| 6 -0.53091201 -2.91236575 1.8505417 |
| 7 0.05676532 -2.32024444 2.4337751 |
| 8 0.64444266 -1.73881338 3.0276987 |
| 9 1.23212000 -1.16798909 3.6322291 |
| 10 1.81979734 -0.60755066 4.2471453 |
| 11 2.40747468 -0.05715376 4.8721031 |
| 12 2.99515202 0.48364874 5.5066553 |
| 13 3.58282936 1.01538228 6.1502764 |
| > predict(wfit, new, interval = "prediction", weights = (new$x)^2) |
| fit lwr upr |
| 1 -3.46929871 -4.7661745 -2.17242292 |
| 2 -2.88162137 -4.1752786 -1.58796414 |
| 3 -2.29394403 -3.6870669 -0.90082115 |
| 4 -1.70626669 -3.3884596 -0.02407382 |
| 5 -1.11858935 -3.5151178 1.27793911 |
| 6 -0.53091201 -5.2286061 4.16678211 |
| 7 0.05676532 -Inf Inf |
| 8 0.64444266 -4.0541654 5.34305071 |
| 9 1.23212000 -1.1679891 3.63222909 |
| 10 1.81979734 0.1299644 3.50963027 |
| 11 2.40747468 1.0020775 3.81287188 |
| 12 2.99515202 1.6850045 4.30529950 |
| 13 3.58282936 2.2662384 4.89942029 |
| > predict(wfit, new, interval = "prediction", weights = ~x^2) |
| fit lwr upr |
| 1 -3.46929871 -4.7661745 -2.17242292 |
| 2 -2.88162137 -4.1752786 -1.58796414 |
| 3 -2.29394403 -3.6870669 -0.90082115 |
| 4 -1.70626669 -3.3884596 -0.02407382 |
| 5 -1.11858935 -3.5151178 1.27793911 |
| 6 -0.53091201 -5.2286061 4.16678211 |
| 7 0.05676532 -Inf Inf |
| 8 0.64444266 -4.0541654 5.34305071 |
| 9 1.23212000 -1.1679891 3.63222909 |
| 10 1.81979734 0.1299644 3.50963027 |
| 11 2.40747468 1.0020775 3.81287188 |
| 12 2.99515202 1.6850045 4.30529950 |
| 13 3.58282936 2.2662384 4.89942029 |
| > |
| > ##-- 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:K |
| 1 -0.850 -4.925 0.2083333 -0.9583333 0.9416667 1.175 0.4250000 0 |
| 2 -0.850 4.925 0.2083333 0.9583333 -2.8250000 1.175 -0.1416667 0 |
| 3 -0.850 -4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 4 -0.850 4.925 -0.2083333 -0.9583333 0.9416667 -3.525 -0.1416667 0 |
| 5 2.575 4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 6 2.575 4.925 0.2083333 -0.9583333 -2.8250000 -3.525 0.4250000 0 |
| 7 2.575 -4.925 -0.2083333 -0.9583333 0.9416667 1.175 -0.1416667 0 |
| 8 2.575 -4.925 0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 9 5.900 -4.925 0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 10 5.900 4.925 0.2083333 -0.9583333 -2.8250000 -3.525 0.4250000 0 |
| 11 5.900 4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 12 5.900 -4.925 -0.2083333 -0.9583333 0.9416667 1.175 -0.1416667 0 |
| 13 -4.750 4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 14 -4.750 4.925 0.2083333 -0.9583333 -2.8250000 -3.525 0.4250000 0 |
| 15 -4.750 -4.925 -0.2083333 -0.9583333 0.9416667 1.175 -0.1416667 0 |
| 16 -4.750 -4.925 0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 17 -4.350 4.925 0.2083333 0.9583333 -2.8250000 1.175 -0.1416667 0 |
| 18 -4.350 -4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| 19 -4.350 4.925 -0.2083333 -0.9583333 0.9416667 -3.525 -0.1416667 0 |
| 20 -4.350 -4.925 0.2083333 -0.9583333 0.9416667 1.175 0.4250000 0 |
| 21 1.475 4.925 -0.2083333 -0.9583333 0.9416667 -3.525 -0.1416667 0 |
| 22 1.475 4.925 0.2083333 0.9583333 -2.8250000 1.175 -0.1416667 0 |
| 23 1.475 -4.925 0.2083333 -0.9583333 0.9416667 1.175 0.4250000 0 |
| 24 1.475 -4.925 -0.2083333 0.9583333 0.9416667 1.175 -0.1416667 0 |
| attr(,"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) |
| $fit |
| 1 2 3 4 5 6 7 8 |
| 7.797353 10.002308 12.499786 15.281082 18.446568 21.865315 25.517015 29.350386 |
| 9 10 11 12 13 14 15 16 |
| 33.230660 37.167935 41.205226 45.055736 48.355889 49.824812 51.986702 56.461318 |
| 17 18 19 20 21 22 23 24 |
| 61.959729 68.569313 76.316068 85.212121 95.324047 NA NA NA |
| 25 26 |
| NA NA |
| |
| $se.fit |
| 1 2 3 4 5 6 7 8 |
| 7.568120 5.945831 4.990827 4.545284 4.308639 4.115049 3.789542 3.716231 |
| 9 10 11 12 13 14 15 16 |
| 3.776947 4.091747 4.709568 4.245427 4.035929 3.753410 4.004705 4.043190 |
| 17 18 19 20 21 22 23 24 |
| 4.026105 4.074664 4.570818 5.954217 8.302014 NA NA NA |
| 25 26 |
| NA NA |
| |
| $residual.scale |
| [1] 15.29496 |
| |
| $df |
| [1] 44.6179 |
| |
| > # to get extrapolation |
| > cars.lo2 <- loess(dist ~ speed, cars, |
| + control = loess.control(surface = "direct")) |
| > predict(cars.lo2, data.frame(speed = seq(5, 30, 1)), se = TRUE) |
| $fit |
| 1 2 3 4 5 6 7 |
| 7.741006 9.926596 12.442424 15.281082 18.425712 21.865315 25.713413 |
| 8 9 10 11 12 13 14 |
| 29.350386 33.230660 37.167935 41.205226 45.781544 48.355889 50.067148 |
| 15 16 17 18 19 20 21 |
| 51.986702 56.445263 62.025404 68.569313 76.193111 85.053364 95.300523 |
| 22 23 24 25 26 |
| 106.974661 120.092581 134.665851 150.698545 168.190283 |
| |
| $se.fit |
| 1 2 3 4 5 6 7 8 |
| 7.565991 5.959097 5.012013 4.550013 4.321596 4.119331 3.939804 3.720098 |
| 9 10 11 12 13 14 15 16 |
| 3.780877 4.096004 4.714469 4.398936 4.040129 4.184257 4.008873 4.061865 |
| 17 18 19 20 21 22 23 24 |
| 4.033998 4.078904 4.584606 5.952480 8.306901 11.601911 15.792480 20.864660 |
| 25 26 |
| 26.823827 33.683999 |
| |
| $residual.scale |
| [1] 15.31087 |
| |
| $df |
| [1] 44.55085 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("predict.nls") |
| > ### * predict.nls |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: predict.nls |
| > ### Title: Predicting from Nonlinear Least Squares Fits |
| > ### Aliases: predict.nls |
| > ### Keywords: nonlinear regression models |
| > |
| > ### ** Examples |
| > |
| > ## Don't show: |
| > od <- options(digits = 5) |
| > ## End(Don't show) |
| > require(graphics) |
| > |
| > fm <- nls(demand ~ SSasympOrig(Time, A, lrc), data = BOD) |
| > predict(fm) # fitted values at observed times |
| [1] 7.8874 12.5250 15.2517 16.8549 17.7975 18.6776 |
| > ## Form data plot and smooth line for the predictions |
| > opar <- par(las = 1) |
| > plot(demand ~ Time, data = BOD, col = 4, |
| + main = "BOD data and fitted first-order curve", |
| + xlim = c(0,7), ylim = c(0, 20) ) |
| > tt <- seq(0, 8, length = 101) |
| > lines(tt, predict(fm, list(Time = tt))) |
| > par(opar) |
| > ## Don't show: |
| > options(od) |
| > ## End(Don't show) |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("predict.smooth.spline") |
| > ### * predict.smooth.spline |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: predict.smooth.spline |
| > ### Title: Predict from Smoothing Spline Fit |
| > ### Aliases: predict.smooth.spline |
| > ### Keywords: smooth |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > attach(cars) |
| > cars.spl <- smooth.spline(speed, dist, df = 6.4) |
| > ## Don't show: |
| > print.default(cars.spl) |
| $x |
| [1] 4 7 8 9 10 11 12 13 14 15 16 17 18 19 20 22 23 24 25 |
| |
| $y |
| [1] 5.833836 12.575603 15.037250 17.795007 20.935898 24.228479 28.488199 |
| [8] 33.969567 38.578804 40.986090 43.494687 47.156344 50.862366 52.692043 |
| [15] 54.754531 66.036824 75.010419 85.290273 95.014670 |
| |
| $w |
| [1] 2 2 1 1 3 2 4 4 4 3 2 3 4 3 5 1 1 4 1 |
| |
| $yin |
| [1] 6.00000 13.00000 16.00000 10.00000 26.00000 22.50000 21.50000 35.00000 |
| [9] 50.50000 33.33333 36.00000 40.66667 64.50000 50.00000 50.40000 66.00000 |
| [17] 54.00000 93.75000 85.00000 |
| |
| $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 |
| |
| $iparms |
| icrit ispar iter errorI |
| 3 0 13 0 NA |
| |
| $auxM |
| NULL |
| |
| $fit |
| $knot |
| [1] 0.0000000 0.0000000 0.0000000 0.0000000 0.1428571 0.1904762 0.2380952 |
| [8] 0.2857143 0.3333333 0.3809524 0.4285714 0.4761905 0.5238095 0.5714286 |
| [15] 0.6190476 0.6666667 0.7142857 0.7619048 0.8571429 0.9047619 0.9523810 |
| [22] 1.0000000 1.0000000 1.0000000 1.0000000 |
| |
| $nk |
| [1] 21 |
| |
| $min |
| [1] 4 |
| |
| $range |
| [1] 21 |
| |
| $coef |
| [1] 5.833836 8.018090 10.929996 14.991332 17.703639 20.964154 24.055137 |
| [8] 28.186176 34.129352 39.113818 40.888197 43.249931 47.080201 51.367328 |
| [15] 52.624683 54.840036 62.675393 74.718525 85.502238 91.843521 95.014670 |
| |
| attr(,"class") |
| [1] "smooth.spline.fit" |
| |
| $call |
| smooth.spline(x = speed, y = dist, df = 6.4) |
| |
| attr(,"class") |
| [1] "smooth.spline" |
| > ## End(Don't show) |
| > |
| > ## "Proof" that the derivatives are okay, by comparing with approximation |
| > diff.quot <- function(x, y) { |
| + ## Difference quotient (central differences where available) |
| + n <- length(x); i1 <- 1:2; i2 <- (n-1):n |
| + c(diff(y[i1]) / diff(x[i1]), (y[-i1] - y[-i2]) / (x[-i1] - x[-i2]), |
| + diff(y[i2]) / diff(x[i2])) |
| + } |
| > |
| > xx <- unique(sort(c(seq(0, 30, by = .2), kn <- unique(speed)))) |
| > i.kn <- match(kn, xx) # indices of knots within xx |
| > op <- par(mfrow = c(2,2)) |
| > plot(speed, dist, xlim = range(xx), main = "Smooth.spline & derivatives") |
| > lines(pp <- predict(cars.spl, xx), col = "red") |
| > points(kn, pp$y[i.kn], pch = 3, col = "dark red") |
| > mtext("s(x)", col = "red") |
| > for(d in 1:3){ |
| + n <- length(pp$x) |
| + plot(pp$x, diff.quot(pp$x,pp$y), type = "l", xlab = "x", ylab = "", |
| + col = "blue", col.main = "red", |
| + main = 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)) # inappropriate |
| Call: |
| princomp(x = USArrests) |
| |
| Standard deviations: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| 82.890847 14.069560 6.424204 2.457837 |
| |
| 4 variables and 50 observations. |
| > princomp(USArrests, cor = TRUE) # =^= prcomp(USArrests, scale=TRUE) |
| Call: |
| princomp(x = USArrests, cor = TRUE) |
| |
| Standard deviations: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| 1.5748783 0.9948694 0.5971291 0.4164494 |
| |
| 4 variables and 50 observations. |
| > ## Similar, but different: |
| > ## The standard deviations differ by a factor of sqrt(49/50) |
| > |
| > summary(pc.cr <- princomp(USArrests, cor = TRUE)) |
| Importance of components: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938 |
| Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752 |
| Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000 |
| > loadings(pc.cr) # note that blank entries are small but not zero |
| |
| Loadings: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| Murder 0.536 0.418 0.341 0.649 |
| Assault 0.583 0.188 0.268 -0.743 |
| UrbanPop 0.278 -0.873 0.378 0.134 |
| Rape 0.543 -0.167 -0.818 |
| |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| SS loadings 1.00 1.00 1.00 1.00 |
| Proportion Var 0.25 0.25 0.25 0.25 |
| Cumulative Var 0.25 0.50 0.75 1.00 |
| > ## 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.4 |
| 1.5748783 0.9948694 0.5971291 0.4164494 |
| |
| 4 variables and 50 observations. |
| > |
| > ## NA-handling |
| > USArrests[1, 2] <- NA |
| > pc.cr <- princomp(~ Murder + Assault + UrbanPop, |
| + data = USArrests, na.action = na.exclude, cor = TRUE) |
| > |
| > ## (Simple) Robust PCA: |
| > ## Classical: |
| > (pc.cl <- princomp(stackloss)) |
| Call: |
| princomp(x = stackloss) |
| |
| Standard deviations: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| 13.596589 4.676077 2.617533 1.366320 |
| |
| 4 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 calculation |
| |
| n = 20 |
| delta = 1 |
| sd = 1 |
| sig.level = 0.05 |
| power = 0.8689528 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > print(ptt, digits = 4) # using less digits than default |
| |
| Two-sample t test power calculation |
| |
| n = 20 |
| delta = 1 |
| sd = 1 |
| sig.level = 0.05 |
| power = 0.869 |
| alternative = two.sided |
| |
| NOTE: n is number in *each* group |
| |
| > print(ptt, digits = 12) # using more " " " |
| |
| Two-sample t test power calculation |
| |
| n = 20 |
| delta = 1 |
| sd = 1 |
| sig.level = 0.05 |
| power = 0.868952801692 |
| alternative = two.sided |
| |
| NOTE: 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 p7 |
| 12 1 2 3 4 5 6 |
| 13 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 Dec |
| 1749 58.0 62.6 70.0 55.7 85.0 83.5 94.8 66.3 75.9 75.5 158.6 85.2 |
| 1750 73.3 75.9 89.2 88.3 90.0 100.0 85.4 103.0 91.2 65.7 63.3 75.4 |
| 1751 70.0 43.5 45.3 56.4 60.7 50.7 66.3 59.8 23.5 23.2 28.5 44.0 |
| 1752 35.0 50.0 71.0 59.3 59.7 39.6 78.4 29.3 27.1 46.6 37.6 40.0 |
| 1753 44.0 32.0 45.7 38.0 36.0 31.7 22.0 39.0 28.0 25.0 20.0 6.7 |
| 1754 0.0 3.0 1.7 13.7 20.7 26.7 18.8 12.3 8.2 24.1 13.2 4.2 |
| 1755 10.2 11.2 6.8 6.5 0.0 0.0 8.6 3.2 17.8 23.7 6.8 20.0 |
| 1756 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$A |
| tau par.vals.A par.vals.lrc |
| 1 -3.0873 13.59751 0.14033 |
| 2 -2.4957 14.46884 0.01607 |
| 3 -1.8906 15.41836 -0.11787 |
| 4 -1.2634 16.49088 -0.26877 |
| 5 -0.6080 17.75662 -0.44553 |
| 6 0.0000 19.14258 -0.63282 |
| 7 0.4998 20.52853 -0.80750 |
| 8 0.9465 22.06851 -0.98233 |
| 9 1.3780 23.98253 -1.17103 |
| 10 1.7908 26.44552 -1.37431 |
| 11 2.1841 29.75928 -1.59599 |
| 12 2.5559 34.43804 -1.84209 |
| 13 2.9028 41.42542 -2.12176 |
| > pr1$lrc |
| tau par.vals.A par.vals.lrc |
| 1 -2.9550 42.395076 -2.184153 |
| 2 -2.5201 33.446683 -1.836926 |
| 3 -2.0570 28.124205 -1.547326 |
| 4 -1.5710 24.656989 -1.293871 |
| 5 -1.0653 22.245847 -1.063030 |
| 6 -0.5412 20.482887 -0.845157 |
| 7 0.0000 19.142578 -0.632822 |
| 8 0.5539 18.095015 -0.420487 |
| 9 1.1022 17.273414 -0.207623 |
| 10 1.6298 16.621533 0.007939 |
| 11 2.1335 16.086803 0.234850 |
| 12 2.6052 15.638807 0.485009 |
| 13 3.0276 15.265409 0.779458 |
| > ## 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:K |
| 1 54.875 -0.850 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 |
| 2 54.875 -0.850 2.808333 -0.5916667 1.991667 -0.9416667 1.175 |
| 3 54.875 -0.850 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 |
| 4 54.875 -0.850 2.808333 0.5916667 -1.991667 0.9416667 -1.175 |
| 5 54.875 2.575 2.808333 0.5916667 1.991667 0.9416667 1.175 |
| 6 54.875 2.575 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 |
| 7 54.875 2.575 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 |
| 8 54.875 2.575 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 |
| 9 54.875 5.900 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 |
| 10 54.875 5.900 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 |
| 11 54.875 5.900 2.808333 0.5916667 1.991667 0.9416667 1.175 |
| 12 54.875 5.900 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 |
| 13 54.875 -4.750 2.808333 0.5916667 1.991667 0.9416667 1.175 |
| 14 54.875 -4.750 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 |
| 15 54.875 -4.750 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 |
| 16 54.875 -4.750 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 |
| 17 54.875 -4.350 2.808333 -0.5916667 1.991667 -0.9416667 1.175 |
| 18 54.875 -4.350 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 |
| 19 54.875 -4.350 2.808333 0.5916667 -1.991667 0.9416667 -1.175 |
| 20 54.875 -4.350 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 |
| 21 54.875 1.475 2.808333 0.5916667 -1.991667 0.9416667 -1.175 |
| 22 54.875 1.475 2.808333 -0.5916667 1.991667 -0.9416667 1.175 |
| 23 54.875 1.475 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 |
| 24 54.875 1.475 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 |
| P:K Residuals |
| 1 0.1416667 -1.39166667 |
| 2 -0.1416667 4.47500000 |
| 3 0.1416667 -5.02500000 |
| 4 -0.1416667 1.94166667 |
| 5 0.1416667 -5.30000000 |
| 6 0.1416667 2.80000000 |
| 7 -0.1416667 2.16666667 |
| 8 -0.1416667 0.33333333 |
| 9 -0.1416667 3.80833333 |
| 10 0.1416667 -3.22500000 |
| 11 0.1416667 1.07500000 |
| 12 -0.1416667 -1.65833333 |
| 13 0.1416667 4.22500000 |
| 14 0.1416667 0.42500000 |
| 15 -0.1416667 -0.50833333 |
| 16 -0.1416667 -4.14166667 |
| 17 -0.1416667 -2.82500000 |
| 18 0.1416667 3.17500000 |
| 19 -0.1416667 -1.75833333 |
| 20 0.1416667 1.40833333 |
| 21 -0.1416667 -0.18333333 |
| 22 -0.1416667 -1.65000000 |
| 23 0.1416667 -0.01666667 |
| 24 0.1416667 1.85000000 |
| attr(,"df") |
| (Intercept) block N P K N:P |
| 1 5 1 1 1 1 |
| N:K P:K Residuals |
| 1 1 12 |
| attr(,"formula") |
| yield ~ block + N * P * K |
| attr(,"onedf") |
| [1] FALSE |
| attr(,"factors") |
| attr(,"factors")$`(Intercept)` |
| [1] "(Intercept)" |
| |
| attr(,"factors")$block |
| [1] "block" |
| |
| attr(,"factors")$N |
| [1] "N" |
| |
| attr(,"factors")$P |
| [1] "P" |
| |
| attr(,"factors")$K |
| [1] "K" |
| |
| attr(,"factors")$`N:P` |
| [1] "N" "P" |
| |
| attr(,"factors")$`N:K` |
| [1] "N" "K" |
| |
| attr(,"factors")$`P:K` |
| [1] "P" "K" |
| |
| attr(,"factors")$Residuals |
| [1] "block" "N" "P" "K" "Within" |
| |
| attr(,"call") |
| aov(formula = yield ~ block + N * P * K, data = npk) |
| attr(,"t.factor") |
| block N P K N:P N:K P:K N:P:K |
| yield 0 0 0 0 0 0 0 0 |
| block 1 0 0 0 0 0 0 0 |
| N 0 1 0 0 1 1 0 1 |
| P 0 0 1 0 1 0 1 1 |
| K 0 0 0 1 0 1 1 1 |
| attr(,"class") |
| [1] "aovproj" |
| > |
| > ## as a test, not particularly sensible |
| > options(contrasts = c("contr.helmert", "contr.treatment")) |
| > npk.aovE <- aov(yield ~ N*P*K + Error(block), npk) |
| > proj(npk.aovE) |
| (Intercept) : |
| (Intercept) |
| 1 54.875 |
| 2 54.875 |
| 3 54.875 |
| 4 54.875 |
| 5 54.875 |
| 6 54.875 |
| 7 54.875 |
| 8 54.875 |
| 9 54.875 |
| 10 54.875 |
| 11 54.875 |
| 12 54.875 |
| 13 54.875 |
| 14 54.875 |
| 15 54.875 |
| 16 54.875 |
| 17 54.875 |
| 18 54.875 |
| 19 54.875 |
| 20 54.875 |
| 21 54.875 |
| 22 54.875 |
| 23 54.875 |
| 24 54.875 |
| attr(,"df") |
| attr(,"df")$df |
| (Intercept) |
| 1 |
| |
| attr(,"onedf") |
| attr(,"onedf")$onedf |
| [1] FALSE |
| |
| attr(,"factors") |
| attr(,"factors")$`(Intercept)` |
| [1] "(Intercept)" |
| |
| |
| block : |
| N:P:K Residuals |
| 1 -1.241667 0.3916667 |
| 2 -1.241667 0.3916667 |
| 3 -1.241667 0.3916667 |
| 4 -1.241667 0.3916667 |
| 5 1.241667 1.3333333 |
| 6 1.241667 1.3333333 |
| 7 1.241667 1.3333333 |
| 8 1.241667 1.3333333 |
| 9 1.241667 4.6583333 |
| 10 1.241667 4.6583333 |
| 11 1.241667 4.6583333 |
| 12 1.241667 4.6583333 |
| 13 1.241667 -5.9916667 |
| 14 1.241667 -5.9916667 |
| 15 1.241667 -5.9916667 |
| 16 1.241667 -5.9916667 |
| 17 -1.241667 -3.1083333 |
| 18 -1.241667 -3.1083333 |
| 19 -1.241667 -3.1083333 |
| 20 -1.241667 -3.1083333 |
| 21 -1.241667 2.7166667 |
| 22 -1.241667 2.7166667 |
| 23 -1.241667 2.7166667 |
| 24 -1.241667 2.7166667 |
| attr(,"df") |
| attr(,"df")$df |
| N:P:K Residuals |
| 1 4 |
| |
| attr(,"onedf") |
| attr(,"onedf")$onedf |
| [1] FALSE |
| |
| attr(,"factors") |
| attr(,"factors")$`N:P:K` |
| [1] "N" "P" "K" |
| |
| attr(,"factors")$Residuals |
| [1] "block" |
| |
| |
| Within : |
| N P K N:P N:K P:K Residuals |
| 1 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 -1.39166667 |
| 2 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 4.47500000 |
| 3 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 -5.02500000 |
| 4 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 1.94166667 |
| 5 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 -5.30000000 |
| 6 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 2.80000000 |
| 7 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 2.16666667 |
| 8 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 0.33333333 |
| 9 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 3.80833333 |
| 10 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 -3.22500000 |
| 11 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 1.07500000 |
| 12 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 -1.65833333 |
| 13 2.808333 0.5916667 1.991667 0.9416667 1.175 0.1416667 4.22500000 |
| 14 2.808333 -0.5916667 -1.991667 -0.9416667 -1.175 0.1416667 0.42500000 |
| 15 -2.808333 0.5916667 -1.991667 -0.9416667 1.175 -0.1416667 -0.50833333 |
| 16 -2.808333 -0.5916667 1.991667 0.9416667 -1.175 -0.1416667 -4.14166667 |
| 17 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 -2.82500000 |
| 18 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 3.17500000 |
| 19 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 -1.75833333 |
| 20 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 1.40833333 |
| 21 2.808333 0.5916667 -1.991667 0.9416667 -1.175 -0.1416667 -0.18333333 |
| 22 2.808333 -0.5916667 1.991667 -0.9416667 1.175 -0.1416667 -1.65000000 |
| 23 -2.808333 -0.5916667 -1.991667 0.9416667 1.175 0.1416667 -0.01666667 |
| 24 -2.808333 0.5916667 1.991667 -0.9416667 -1.175 0.1416667 1.85000000 |
| attr(,"df") |
| attr(,"df")$df |
| N P K N:P N:K P:K Residuals |
| 1 1 1 1 1 1 12 |
| |
| attr(,"onedf") |
| attr(,"onedf")$onedf |
| [1] FALSE |
| |
| attr(,"factors") |
| attr(,"factors")$N |
| [1] "N" |
| |
| attr(,"factors")$P |
| [1] "P" |
| |
| attr(,"factors")$K |
| [1] "K" |
| |
| attr(,"factors")$`N:P` |
| [1] "N" "P" |
| |
| attr(,"factors")$`N:K` |
| [1] "N" "K" |
| |
| attr(,"factors")$`P:K` |
| [1] "P" "K" |
| |
| attr(,"factors")$Residuals |
| [1] "block" "Within" |
| |
| |
| > |
| > |
| > |
| > 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 default |
| |
| 1-sample proportions test with continuity correction |
| |
| data: heads out of 100, null probability 0.5 |
| X-squared = 0.09, df = 1, p-value = 0.7642 |
| alternative hypothesis: true p is not equal to 0.5 |
| 95 percent confidence interval: |
| 0.4183183 0.6201278 |
| sample estimates: |
| p |
| 0.52 |
| |
| > prop.test(heads, 100, correct = FALSE) |
| |
| 1-sample proportions test without continuity correction |
| |
| data: heads out of 100, null probability 0.5 |
| X-squared = 0.16, df = 1, p-value = 0.6892 |
| alternative hypothesis: true p is not equal to 0.5 |
| 95 percent confidence interval: |
| 0.4231658 0.6153545 |
| sample estimates: |
| p |
| 0.52 |
| |
| > |
| > ## Data from Fleiss (1981), p. 139. |
| > ## H0: The null hypothesis is that the four populations from which |
| > ## the patients were drawn have the same true proportion of smokers. |
| > ## A: The alternative is that this proportion is different in at |
| > ## least one of the populations. |
| > |
| > smokers <- c( 83, 90, 129, 70 ) |
| > patients <- c( 86, 93, 136, 82 ) |
| > prop.test(smokers, patients) |
| |
| 4-sample test for equality of proportions without continuity |
| correction |
| |
| data: smokers out of patients |
| X-squared = 12.6, df = 3, p-value = 0.005585 |
| alternative hypothesis: two.sided |
| sample estimates: |
| prop 1 prop 2 prop 3 prop 4 |
| 0.9651163 0.9677419 0.9485294 0.8536585 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("prop.trend.test") |
| > ### * prop.trend.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: prop.trend.test |
| > ### Title: Test for trend in proportions |
| > ### Aliases: prop.trend.test |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > smokers <- c( 83, 90, 129, 70 ) |
| > patients <- c( 86, 93, 136, 82 ) |
| > prop.test(smokers, patients) |
| |
| 4-sample test for equality of proportions without continuity |
| correction |
| |
| data: smokers out of patients |
| X-squared = 12.6, df = 3, p-value = 0.005585 |
| alternative hypothesis: two.sided |
| sample estimates: |
| prop 1 prop 2 prop 3 prop 4 |
| 0.9651163 0.9677419 0.9485294 0.8536585 |
| |
| > prop.trend.test(smokers, patients) |
| |
| Chi-squared Test for Trend in Proportions |
| |
| data: smokers out of patients , |
| using scores: 1 2 3 4 |
| X-squared = 8.2249, df = 1, p-value = 0.004132 |
| |
| > prop.trend.test(smokers, patients, c(0,0,0,1)) |
| |
| Chi-squared Test for Trend in Proportions |
| |
| data: smokers out of patients , |
| using scores: 0 0 0 1 |
| X-squared = 12.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])) |
| > y |
| Brand |
| Store A B C D E |
| 1 5 4 7 10 12 |
| 2 1 3 1 0 2 |
| 3 16 12 22 22 35 |
| 4 5 4 3 5 4 |
| 5 10 9 7 13 10 |
| 6 19 18 28 37 58 |
| 7 10 7 6 8 7 |
| > (qTst <- quade.test(y)) |
| |
| Quade test |
| |
| data: y |
| Quade 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 default |
| 0% 25% 50% 75% 100% |
| -3.00804860 -0.69731820 -0.03472603 0.68924373 3.81027668 |
| > quantile(x, probs = c(0.1, 0.5, 1, 2, 5, 10, 50, NA)/100) |
| 0.1% 0.5% 1% 2% 5% 10% |
| -2.99694930 -2.59232767 -2.42431731 -2.24515257 -1.72663060 -1.33880074 |
| 50% |
| -0.03472603 NA |
| > |
| > ### Compare different types |
| > 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 |
| > ## 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.30i |
| 10% 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) |
| > ft1 |
| Intercourse Yes No |
| Race Gender |
| White Male 43 134 |
| Female 26 149 |
| Black Male 29 23 |
| Female 22 36 |
| > unlink(file) |
| > |
| > ## Agresti (1990), page 297, Table 8.16. |
| > ## Almost o.k., but misses the name of the row variable. |
| > file <- tempfile() |
| > cat(" \"Tonsil Size\"\n", |
| + " \"Not Enl.\" \"Enl.\" \"Greatly Enl.\"\n", |
| + "Noncarriers 497 560 269\n", |
| + "Carriers 19 29 24\n", |
| + file = file) |
| > ft <- read.ftable(file, skip = 2, |
| + row.var.names = "Status", |
| + col.vars = list("Tonsil Size" = |
| + c("Not Enl.", "Enl.", "Greatly Enl."))) |
| > ft |
| Tonsil Size Not Enl. Enl. Greatly Enl. |
| Status |
| Noncarriers 497 560 269 |
| Carriers 19 29 24 |
| > unlink(file) |
| > |
| > ft22 <- ftable(Titanic, row.vars = 2:1, col.vars = 4:3) |
| > write.ftable(ft22, quote = FALSE) |
| Survived No Yes |
| Age Child Adult Child Adult |
| Sex Class |
| Male 1st 0 118 5 57 |
| 2nd 0 154 11 14 |
| 3rd 35 387 13 75 |
| Crew 0 670 0 192 |
| Female 1st 0 4 1 140 |
| 2nd 0 13 13 80 |
| 3rd 17 89 14 76 |
| Crew 0 3 0 20 |
| > write.ftable(ft22, quote = FALSE, method="row.compact") |
| Survived No Yes |
| Sex Class Age Child Adult Child Adult |
| Male 1st 0 118 5 57 |
| 2nd 0 154 11 14 |
| 3rd 35 387 13 75 |
| Crew 0 670 0 192 |
| Female 1st 0 4 1 140 |
| 2nd 0 13 13 80 |
| 3rd 17 89 14 76 |
| Crew 0 3 0 20 |
| > write.ftable(ft22, quote = FALSE, method="col.compact") |
| Survived No Yes |
| Age Child Adult Child Adult |
| Sex Class |
| Male 1st 0 118 5 57 |
| 2nd 0 154 11 14 |
| 3rd 35 387 13 75 |
| Crew 0 670 0 192 |
| Female 1st 0 4 1 140 |
| 2nd 0 13 13 80 |
| 3rd 17 89 14 76 |
| Crew 0 3 0 20 |
| > write.ftable(ft22, quote = FALSE, method="compact") |
| Survived No Yes |
| Sex Class | Age Child Adult Child Adult |
| Male 1st 0 118 5 57 |
| 2nd 0 154 11 14 |
| 3rd 35 387 13 75 |
| Crew 0 670 0 192 |
| Female 1st 0 4 1 140 |
| 2nd 0 13 13 80 |
| 3rd 17 89 14 76 |
| Crew 0 3 0 20 |
| > ## Don't show: |
| > 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 6 |
| non.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 Mississippi |
| 1 2 8 18 24 |
| South Carolina |
| 40 |
| |
| [[2]] |
| Connecticut Idaho Indiana Kansas Kentucky Montana |
| 7 12 14 16 17 26 |
| Nebraska Ohio Pennsylvania Utah |
| 27 35 38 44 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("relevel") |
| > ### * relevel |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: relevel |
| > ### Title: Reorder Levels of Factor |
| > ### Aliases: relevel relevel.default relevel.factor relevel.ordered |
| > ### Keywords: utilities models |
| > |
| > ### ** Examples |
| > |
| > warpbreaks$tension <- relevel(warpbreaks$tension, ref = "M") |
| > summary(lm(breaks ~ wool + tension, data = warpbreaks)) |
| |
| Call: |
| lm(formula = breaks ~ wool + tension, data = warpbreaks) |
| |
| Residuals: |
| Min 1Q Median 3Q Max |
| -19.500 -8.083 -2.139 6.472 30.722 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| (Intercept) 29.278 3.162 9.260 2e-12 *** |
| woolB -5.778 3.162 -1.827 0.0736 . |
| tensionL 10.000 3.872 2.582 0.0128 * |
| tensionH -4.722 3.872 -1.219 0.2284 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 11.62 on 50 degrees of freedom |
| Multiple R-squared: 0.2691, Adjusted R-squared: 0.2253 |
| F-statistic: 6.138 on 3 and 50 DF, p-value: 0.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 K |
| 4 12 12 12 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("reshape") |
| > ### * reshape |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: reshape |
| > ### Title: Reshape Grouped Data |
| > ### Aliases: reshape |
| > ### Keywords: manip |
| > |
| > ### ** Examples |
| > |
| > summary(Indometh) |
| Subject time conc |
| 1:11 Min. :0.250 Min. :0.0500 |
| 4:11 1st Qu.:0.750 1st Qu.:0.1100 |
| 2:11 Median :2.000 Median :0.3400 |
| 5:11 Mean :2.886 Mean :0.5918 |
| 6:11 3rd Qu.:5.000 3rd Qu.:0.8325 |
| 3:11 Max. :8.000 Max. :2.7200 |
| > wide <- reshape(Indometh, v.names = "conc", idvar = "Subject", |
| + timevar = "time", direction = "wide") |
| > wide |
| Subject conc.0.25 conc.0.5 conc.0.75 conc.1 conc.1.25 conc.2 conc.3 conc.4 |
| 1 1 1.50 0.94 0.78 0.48 0.37 0.19 0.12 0.11 |
| 12 2 2.03 1.63 0.71 0.70 0.64 0.36 0.32 0.20 |
| 23 3 2.72 1.49 1.16 0.80 0.80 0.39 0.22 0.12 |
| 34 4 1.85 1.39 1.02 0.89 0.59 0.40 0.16 0.11 |
| 45 5 2.05 1.04 0.81 0.39 0.30 0.23 0.13 0.11 |
| 56 6 2.31 1.44 1.03 0.84 0.64 0.42 0.24 0.17 |
| conc.5 conc.6 conc.8 |
| 1 0.08 0.07 0.05 |
| 12 0.25 0.12 0.08 |
| 23 0.11 0.08 0.08 |
| 34 0.10 0.07 0.07 |
| 45 0.08 0.10 0.06 |
| 56 0.13 0.10 0.09 |
| > |
| > reshape(wide, direction = "long") |
| Subject time conc |
| 1.0.25 1 0.25 1.50 |
| 2.0.25 2 0.25 2.03 |
| 3.0.25 3 0.25 2.72 |
| 4.0.25 4 0.25 1.85 |
| 5.0.25 5 0.25 2.05 |
| 6.0.25 6 0.25 2.31 |
| 1.0.5 1 0.50 0.94 |
| 2.0.5 2 0.50 1.63 |
| 3.0.5 3 0.50 1.49 |
| 4.0.5 4 0.50 1.39 |
| 5.0.5 5 0.50 1.04 |
| 6.0.5 6 0.50 1.44 |
| 1.0.75 1 0.75 0.78 |
| 2.0.75 2 0.75 0.71 |
| 3.0.75 3 0.75 1.16 |
| 4.0.75 4 0.75 1.02 |
| 5.0.75 5 0.75 0.81 |
| 6.0.75 6 0.75 1.03 |
| 1.1 1 1.00 0.48 |
| 2.1 2 1.00 0.70 |
| 3.1 3 1.00 0.80 |
| 4.1 4 1.00 0.89 |
| 5.1 5 1.00 0.39 |
| 6.1 6 1.00 0.84 |
| 1.1.25 1 1.25 0.37 |
| 2.1.25 2 1.25 0.64 |
| 3.1.25 3 1.25 0.80 |
| 4.1.25 4 1.25 0.59 |
| 5.1.25 5 1.25 0.30 |
| 6.1.25 6 1.25 0.64 |
| 1.2 1 2.00 0.19 |
| 2.2 2 2.00 0.36 |
| 3.2 3 2.00 0.39 |
| 4.2 4 2.00 0.40 |
| 5.2 5 2.00 0.23 |
| 6.2 6 2.00 0.42 |
| 1.3 1 3.00 0.12 |
| 2.3 2 3.00 0.32 |
| 3.3 3 3.00 0.22 |
| 4.3 4 3.00 0.16 |
| 5.3 5 3.00 0.13 |
| 6.3 6 3.00 0.24 |
| 1.4 1 4.00 0.11 |
| 2.4 2 4.00 0.20 |
| 3.4 3 4.00 0.12 |
| 4.4 4 4.00 0.11 |
| 5.4 5 4.00 0.11 |
| 6.4 6 4.00 0.17 |
| 1.5 1 5.00 0.08 |
| 2.5 2 5.00 0.25 |
| 3.5 3 5.00 0.11 |
| 4.5 4 5.00 0.10 |
| 5.5 5 5.00 0.08 |
| 6.5 6 5.00 0.13 |
| 1.6 1 6.00 0.07 |
| 2.6 2 6.00 0.12 |
| 3.6 3 6.00 0.08 |
| 4.6 4 6.00 0.07 |
| 5.6 5 6.00 0.10 |
| 6.6 6 6.00 0.10 |
| 1.8 1 8.00 0.05 |
| 2.8 2 8.00 0.08 |
| 3.8 3 8.00 0.08 |
| 4.8 4 8.00 0.07 |
| 5.8 5 8.00 0.06 |
| 6.8 6 8.00 0.09 |
| > reshape(wide, idvar = "Subject", varying = list(2:12), |
| + v.names = "conc", direction = "long") |
| Subject time conc |
| 1.1 1 1 1.50 |
| 2.1 2 1 2.03 |
| 3.1 3 1 2.72 |
| 4.1 4 1 1.85 |
| 5.1 5 1 2.05 |
| 6.1 6 1 2.31 |
| 1.2 1 2 0.94 |
| 2.2 2 2 1.63 |
| 3.2 3 2 1.49 |
| 4.2 4 2 1.39 |
| 5.2 5 2 1.04 |
| 6.2 6 2 1.44 |
| 1.3 1 3 0.78 |
| 2.3 2 3 0.71 |
| 3.3 3 3 1.16 |
| 4.3 4 3 1.02 |
| 5.3 5 3 0.81 |
| 6.3 6 3 1.03 |
| 1.4 1 4 0.48 |
| 2.4 2 4 0.70 |
| 3.4 3 4 0.80 |
| 4.4 4 4 0.89 |
| 5.4 5 4 0.39 |
| 6.4 6 4 0.84 |
| 1.5 1 5 0.37 |
| 2.5 2 5 0.64 |
| 3.5 3 5 0.80 |
| 4.5 4 5 0.59 |
| 5.5 5 5 0.30 |
| 6.5 6 5 0.64 |
| 1.6 1 6 0.19 |
| 2.6 2 6 0.36 |
| 3.6 3 6 0.39 |
| 4.6 4 6 0.40 |
| 5.6 5 6 0.23 |
| 6.6 6 6 0.42 |
| 1.7 1 7 0.12 |
| 2.7 2 7 0.32 |
| 3.7 3 7 0.22 |
| 4.7 4 7 0.16 |
| 5.7 5 7 0.13 |
| 6.7 6 7 0.24 |
| 1.8 1 8 0.11 |
| 2.8 2 8 0.20 |
| 3.8 3 8 0.12 |
| 4.8 4 8 0.11 |
| 5.8 5 8 0.11 |
| 6.8 6 8 0.17 |
| 1.9 1 9 0.08 |
| 2.9 2 9 0.25 |
| 3.9 3 9 0.11 |
| 4.9 4 9 0.10 |
| 5.9 5 9 0.08 |
| 6.9 6 9 0.13 |
| 1.10 1 10 0.07 |
| 2.10 2 10 0.12 |
| 3.10 3 10 0.08 |
| 4.10 4 10 0.07 |
| 5.10 5 10 0.10 |
| 6.10 6 10 0.10 |
| 1.11 1 11 0.05 |
| 2.11 2 11 0.08 |
| 3.11 3 11 0.08 |
| 4.11 4 11 0.07 |
| 5.11 5 11 0.06 |
| 6.11 6 11 0.09 |
| > |
| > ## times need not be numeric |
| > df <- data.frame(id = rep(1:4, rep(2,4)), |
| + visit = I(rep(c("Before","After"), 4)), |
| + x = rnorm(4), y = runif(4)) |
| > df |
| id visit x y |
| 1 1 Before -0.6264538 0.62911404 |
| 2 1 After 0.1836433 0.06178627 |
| 3 2 Before -0.8356286 0.20597457 |
| 4 2 After 1.5952808 0.17655675 |
| 5 3 Before -0.6264538 0.62911404 |
| 6 3 After 0.1836433 0.06178627 |
| 7 4 Before -0.8356286 0.20597457 |
| 8 4 After 1.5952808 0.17655675 |
| > reshape(df, timevar = "visit", idvar = "id", direction = "wide") |
| id x.Before y.Before x.After y.After |
| 1 1 -0.6264538 0.6291140 0.1836433 0.06178627 |
| 3 2 -0.8356286 0.2059746 1.5952808 0.17655675 |
| 5 3 -0.6264538 0.6291140 0.1836433 0.06178627 |
| 7 4 -0.8356286 0.2059746 1.5952808 0.17655675 |
| > ## warns that y is really varying |
| > reshape(df, timevar = "visit", idvar = "id", direction = "wide", v.names = "x") |
| Warning in reshapeWide(data, idvar = idvar, timevar = timevar, varying = varying, : |
| some constant variables (y) are really varying |
| id y x.Before x.After |
| 1 1 0.6291140 -0.6264538 0.1836433 |
| 3 2 0.2059746 -0.8356286 1.5952808 |
| 5 3 0.6291140 -0.6264538 0.1836433 |
| 7 4 0.2059746 -0.8356286 1.5952808 |
| > |
| > |
| > ## unbalanced 'long' data leads to NA fill in 'wide' form |
| > df2 <- df[1:7, ] |
| > df2 |
| id visit x y |
| 1 1 Before -0.6264538 0.62911404 |
| 2 1 After 0.1836433 0.06178627 |
| 3 2 Before -0.8356286 0.20597457 |
| 4 2 After 1.5952808 0.17655675 |
| 5 3 Before -0.6264538 0.62911404 |
| 6 3 After 0.1836433 0.06178627 |
| 7 4 Before -0.8356286 0.20597457 |
| > reshape(df2, timevar = "visit", idvar = "id", direction = "wide") |
| id x.Before y.Before x.After y.After |
| 1 1 -0.6264538 0.6291140 0.1836433 0.06178627 |
| 3 2 -0.8356286 0.2059746 1.5952808 0.17655675 |
| 5 3 -0.6264538 0.6291140 0.1836433 0.06178627 |
| 7 4 -0.8356286 0.2059746 NA NA |
| > |
| > ## Alternative regular expressions for guessing names |
| > df3 <- data.frame(id = 1:4, age = c(40,50,60,50), dose1 = c(1,2,1,2), |
| + dose2 = c(2,1,2,1), dose4 = c(3,3,3,3)) |
| > reshape(df3, direction = "long", varying = 3:5, sep = "") |
| id age time dose |
| 1.1 1 40 1 1 |
| 2.1 2 50 1 2 |
| 3.1 3 60 1 1 |
| 4.1 4 50 1 2 |
| 1.2 1 40 2 2 |
| 2.2 2 50 2 1 |
| 3.2 3 60 2 2 |
| 4.2 4 50 2 1 |
| 1.4 1 40 4 3 |
| 2.4 2 50 4 3 |
| 3.4 3 60 4 3 |
| 4.4 4 50 4 3 |
| > |
| > |
| > ## an example that isn't longitudinal data |
| > state.x77 <- as.data.frame(state.x77) |
| > long <- reshape(state.x77, idvar = "state", ids = row.names(state.x77), |
| + times = names(state.x77), timevar = "Characteristic", |
| + varying = list(names(state.x77)), direction = "long") |
| > |
| > reshape(long, direction = "wide") |
| state Population Income Illiteracy Life Exp |
| Alabama.Population Alabama 3615 3624 2.1 69.05 |
| Alaska.Population Alaska 365 6315 1.5 69.31 |
| Arizona.Population Arizona 2212 4530 1.8 70.55 |
| Arkansas.Population Arkansas 2110 3378 1.9 70.66 |
| California.Population California 21198 5114 1.1 71.71 |
| Colorado.Population Colorado 2541 4884 0.7 72.06 |
| Connecticut.Population Connecticut 3100 5348 1.1 72.48 |
| Delaware.Population Delaware 579 4809 0.9 70.06 |
| Florida.Population Florida 8277 4815 1.3 70.66 |
| Georgia.Population Georgia 4931 4091 2.0 68.54 |
| Hawaii.Population Hawaii 868 4963 1.9 73.60 |
| Idaho.Population Idaho 813 4119 0.6 71.87 |
| Illinois.Population Illinois 11197 5107 0.9 70.14 |
| Indiana.Population Indiana 5313 4458 0.7 70.88 |
| Iowa.Population Iowa 2861 4628 0.5 72.56 |
| Kansas.Population Kansas 2280 4669 0.6 72.58 |
| Kentucky.Population Kentucky 3387 3712 1.6 70.10 |
| Louisiana.Population Louisiana 3806 3545 2.8 68.76 |
| Maine.Population Maine 1058 3694 0.7 70.39 |
| Maryland.Population Maryland 4122 5299 0.9 70.22 |
| Massachusetts.Population Massachusetts 5814 4755 1.1 71.83 |
| Michigan.Population Michigan 9111 4751 0.9 70.63 |
| Minnesota.Population Minnesota 3921 4675 0.6 72.96 |
| Mississippi.Population Mississippi 2341 3098 2.4 68.09 |
| Missouri.Population Missouri 4767 4254 0.8 70.69 |
| Montana.Population Montana 746 4347 0.6 70.56 |
| Nebraska.Population Nebraska 1544 4508 0.6 72.60 |
| Nevada.Population Nevada 590 5149 0.5 69.03 |
| New Hampshire.Population New Hampshire 812 4281 0.7 71.23 |
| New Jersey.Population New Jersey 7333 5237 1.1 70.93 |
| New Mexico.Population New Mexico 1144 3601 2.2 70.32 |
| New York.Population New York 18076 4903 1.4 70.55 |
| North Carolina.Population North Carolina 5441 3875 1.8 69.21 |
| North Dakota.Population North Dakota 637 5087 0.8 72.78 |
| Ohio.Population Ohio 10735 4561 0.8 70.82 |
| Oklahoma.Population Oklahoma 2715 3983 1.1 71.42 |
| Oregon.Population Oregon 2284 4660 0.6 72.13 |
| Pennsylvania.Population Pennsylvania 11860 4449 1.0 70.43 |
| Rhode Island.Population Rhode Island 931 4558 1.3 71.90 |
| South Carolina.Population South Carolina 2816 3635 2.3 67.96 |
| South Dakota.Population South Dakota 681 4167 0.5 72.08 |
| Tennessee.Population Tennessee 4173 3821 1.7 70.11 |
| Texas.Population Texas 12237 4188 2.2 70.90 |
| Utah.Population Utah 1203 4022 0.6 72.90 |
| Vermont.Population Vermont 472 3907 0.6 71.64 |
| Virginia.Population Virginia 4981 4701 1.4 70.08 |
| Washington.Population Washington 3559 4864 0.6 71.72 |
| West Virginia.Population West Virginia 1799 3617 1.4 69.48 |
| Wisconsin.Population Wisconsin 4589 4468 0.7 72.48 |
| Wyoming.Population Wyoming 376 4566 0.6 70.29 |
| Murder HS Grad Frost Area |
| Alabama.Population 15.1 41.3 20 50708 |
| Alaska.Population 11.3 66.7 152 566432 |
| Arizona.Population 7.8 58.1 15 113417 |
| Arkansas.Population 10.1 39.9 65 51945 |
| California.Population 10.3 62.6 20 156361 |
| Colorado.Population 6.8 63.9 166 103766 |
| Connecticut.Population 3.1 56.0 139 4862 |
| Delaware.Population 6.2 54.6 103 1982 |
| Florida.Population 10.7 52.6 11 54090 |
| Georgia.Population 13.9 40.6 60 58073 |
| Hawaii.Population 6.2 61.9 0 6425 |
| Idaho.Population 5.3 59.5 126 82677 |
| Illinois.Population 10.3 52.6 127 55748 |
| Indiana.Population 7.1 52.9 122 36097 |
| Iowa.Population 2.3 59.0 140 55941 |
| Kansas.Population 4.5 59.9 114 81787 |
| Kentucky.Population 10.6 38.5 95 39650 |
| Louisiana.Population 13.2 42.2 12 44930 |
| Maine.Population 2.7 54.7 161 30920 |
| Maryland.Population 8.5 52.3 101 9891 |
| Massachusetts.Population 3.3 58.5 103 7826 |
| Michigan.Population 11.1 52.8 125 56817 |
| Minnesota.Population 2.3 57.6 160 79289 |
| Mississippi.Population 12.5 41.0 50 47296 |
| Missouri.Population 9.3 48.8 108 68995 |
| Montana.Population 5.0 59.2 155 145587 |
| Nebraska.Population 2.9 59.3 139 76483 |
| Nevada.Population 11.5 65.2 188 109889 |
| New Hampshire.Population 3.3 57.6 174 9027 |
| New Jersey.Population 5.2 52.5 115 7521 |
| New Mexico.Population 9.7 55.2 120 121412 |
| New York.Population 10.9 52.7 82 47831 |
| North Carolina.Population 11.1 38.5 80 48798 |
| North Dakota.Population 1.4 50.3 186 69273 |
| Ohio.Population 7.4 53.2 124 40975 |
| Oklahoma.Population 6.4 51.6 82 68782 |
| Oregon.Population 4.2 60.0 44 96184 |
| Pennsylvania.Population 6.1 50.2 126 44966 |
| Rhode Island.Population 2.4 46.4 127 1049 |
| South Carolina.Population 11.6 37.8 65 30225 |
| South Dakota.Population 1.7 53.3 172 75955 |
| Tennessee.Population 11.0 41.8 70 41328 |
| Texas.Population 12.2 47.4 35 262134 |
| Utah.Population 4.5 67.3 137 82096 |
| Vermont.Population 5.5 57.1 168 9267 |
| Virginia.Population 9.5 47.8 85 39780 |
| Washington.Population 4.3 63.5 32 66570 |
| West Virginia.Population 6.7 41.6 100 24070 |
| Wisconsin.Population 3.0 54.5 149 54464 |
| Wyoming.Population 6.9 62.9 173 97203 |
| > |
| > reshape(long, direction = "wide", new.row.names = unique(long$state)) |
| state Population Income Illiteracy Life Exp Murder |
| Alabama Alabama 3615 3624 2.1 69.05 15.1 |
| Alaska Alaska 365 6315 1.5 69.31 11.3 |
| Arizona Arizona 2212 4530 1.8 70.55 7.8 |
| Arkansas Arkansas 2110 3378 1.9 70.66 10.1 |
| California California 21198 5114 1.1 71.71 10.3 |
| Colorado Colorado 2541 4884 0.7 72.06 6.8 |
| Connecticut Connecticut 3100 5348 1.1 72.48 3.1 |
| Delaware Delaware 579 4809 0.9 70.06 6.2 |
| Florida Florida 8277 4815 1.3 70.66 10.7 |
| Georgia Georgia 4931 4091 2.0 68.54 13.9 |
| Hawaii Hawaii 868 4963 1.9 73.60 6.2 |
| Idaho Idaho 813 4119 0.6 71.87 5.3 |
| Illinois Illinois 11197 5107 0.9 70.14 10.3 |
| Indiana Indiana 5313 4458 0.7 70.88 7.1 |
| Iowa Iowa 2861 4628 0.5 72.56 2.3 |
| Kansas Kansas 2280 4669 0.6 72.58 4.5 |
| Kentucky Kentucky 3387 3712 1.6 70.10 10.6 |
| Louisiana Louisiana 3806 3545 2.8 68.76 13.2 |
| Maine Maine 1058 3694 0.7 70.39 2.7 |
| Maryland Maryland 4122 5299 0.9 70.22 8.5 |
| Massachusetts Massachusetts 5814 4755 1.1 71.83 3.3 |
| Michigan Michigan 9111 4751 0.9 70.63 11.1 |
| Minnesota Minnesota 3921 4675 0.6 72.96 2.3 |
| Mississippi Mississippi 2341 3098 2.4 68.09 12.5 |
| Missouri Missouri 4767 4254 0.8 70.69 9.3 |
| Montana Montana 746 4347 0.6 70.56 5.0 |
| Nebraska Nebraska 1544 4508 0.6 72.60 2.9 |
| Nevada Nevada 590 5149 0.5 69.03 11.5 |
| New Hampshire New Hampshire 812 4281 0.7 71.23 3.3 |
| New Jersey New Jersey 7333 5237 1.1 70.93 5.2 |
| New Mexico New Mexico 1144 3601 2.2 70.32 9.7 |
| New York New York 18076 4903 1.4 70.55 10.9 |
| North Carolina North Carolina 5441 3875 1.8 69.21 11.1 |
| North Dakota North Dakota 637 5087 0.8 72.78 1.4 |
| Ohio Ohio 10735 4561 0.8 70.82 7.4 |
| Oklahoma Oklahoma 2715 3983 1.1 71.42 6.4 |
| Oregon Oregon 2284 4660 0.6 72.13 4.2 |
| Pennsylvania Pennsylvania 11860 4449 1.0 70.43 6.1 |
| Rhode Island Rhode Island 931 4558 1.3 71.90 2.4 |
| South Carolina South Carolina 2816 3635 2.3 67.96 11.6 |
| South Dakota South Dakota 681 4167 0.5 72.08 1.7 |
| Tennessee Tennessee 4173 3821 1.7 70.11 11.0 |
| Texas Texas 12237 4188 2.2 70.90 12.2 |
| Utah Utah 1203 4022 0.6 72.90 4.5 |
| Vermont Vermont 472 3907 0.6 71.64 5.5 |
| Virginia Virginia 4981 4701 1.4 70.08 9.5 |
| Washington Washington 3559 4864 0.6 71.72 4.3 |
| West Virginia West Virginia 1799 3617 1.4 69.48 6.7 |
| Wisconsin Wisconsin 4589 4468 0.7 72.48 3.0 |
| Wyoming Wyoming 376 4566 0.6 70.29 6.9 |
| HS Grad Frost Area |
| Alabama 41.3 20 50708 |
| Alaska 66.7 152 566432 |
| Arizona 58.1 15 113417 |
| Arkansas 39.9 65 51945 |
| California 62.6 20 156361 |
| Colorado 63.9 166 103766 |
| Connecticut 56.0 139 4862 |
| Delaware 54.6 103 1982 |
| Florida 52.6 11 54090 |
| Georgia 40.6 60 58073 |
| Hawaii 61.9 0 6425 |
| Idaho 59.5 126 82677 |
| Illinois 52.6 127 55748 |
| Indiana 52.9 122 36097 |
| Iowa 59.0 140 55941 |
| Kansas 59.9 114 81787 |
| Kentucky 38.5 95 39650 |
| Louisiana 42.2 12 44930 |
| Maine 54.7 161 30920 |
| Maryland 52.3 101 9891 |
| Massachusetts 58.5 103 7826 |
| Michigan 52.8 125 56817 |
| Minnesota 57.6 160 79289 |
| Mississippi 41.0 50 47296 |
| Missouri 48.8 108 68995 |
| Montana 59.2 155 145587 |
| Nebraska 59.3 139 76483 |
| Nevada 65.2 188 109889 |
| New Hampshire 57.6 174 9027 |
| New Jersey 52.5 115 7521 |
| New Mexico 55.2 120 121412 |
| New York 52.7 82 47831 |
| North Carolina 38.5 80 48798 |
| North Dakota 50.3 186 69273 |
| Ohio 53.2 124 40975 |
| Oklahoma 51.6 82 68782 |
| Oregon 60.0 44 96184 |
| Pennsylvania 50.2 126 44966 |
| Rhode Island 46.4 127 1049 |
| South Carolina 37.8 65 30225 |
| South Dakota 53.3 172 75955 |
| Tennessee 41.8 70 41328 |
| Texas 47.4 35 262134 |
| Utah 67.3 137 82096 |
| Vermont 57.1 168 9267 |
| Virginia 47.8 85 39780 |
| Washington 63.5 32 66570 |
| West Virginia 41.6 100 24070 |
| Wisconsin 54.5 149 54464 |
| Wyoming 62.9 173 97203 |
| > |
| > ## multiple id variables |
| > df3 <- data.frame(school = rep(1:3, each = 4), class = rep(9:10, 6), |
| + time = rep(c(1,1,2,2), 3), score = rnorm(12)) |
| > wide <- reshape(df3, idvar = c("school","class"), direction = "wide") |
| > wide |
| school class score.1 score.2 |
| 1 1 9 0.48742905 0.57578135 |
| 2 1 10 0.73832471 -0.30538839 |
| 5 2 9 1.51178117 -0.62124058 |
| 6 2 10 0.38984324 -2.21469989 |
| 9 3 9 1.12493092 -0.01619026 |
| 10 3 10 -0.04493361 0.94383621 |
| > ## transform back |
| > reshape(wide) |
| school class time score.1 |
| 1.9.1 1 9 1 0.48742905 |
| 1.10.1 1 10 1 0.73832471 |
| 2.9.1 2 9 1 1.51178117 |
| 2.10.1 2 10 1 0.38984324 |
| 3.9.1 3 9 1 1.12493092 |
| 3.10.1 3 10 1 -0.04493361 |
| 1.9.2 1 9 2 0.57578135 |
| 1.10.2 1 10 2 -0.30538839 |
| 2.9.2 2 9 2 -0.62124058 |
| 2.10.2 2 10 2 -2.21469989 |
| 3.9.2 3 9 2 -0.01619026 |
| 3.10.2 3 10 2 0.94383621 |
| > |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("runmed") |
| > ### * runmed |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: runmed |
| > ### Title: Running Medians - Robust Scatter Plot Smoothing |
| > ### Aliases: runmed |
| > ### Keywords: smooth robust |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > utils::example(nhtemp) |
| |
| nhtemp> require(stats); require(graphics) |
| |
| nhtemp> plot(nhtemp, main = "nhtemp data", |
| nhtemp+ ylab = "Mean annual temperature in New Haven, CT (deg. F)") |
| > myNHT <- as.vector(nhtemp) |
| > myNHT[20] <- 2 * nhtemp[20] |
| > plot(myNHT, type = "b", ylim = c(48, 60), main = "Running Medians Example") |
| > lines(runmed(myNHT, 7), col = "red") |
| > |
| > ## special: multiple y values for one x |
| > plot(cars, main = "'cars' data and runmed(dist, 3)") |
| > lines(cars, col = "light gray", type = "c") |
| > with(cars, lines(speed, runmed(dist, k = 3), col = 2)) |
| > |
| > ## nice quadratic with a few outliers |
| > y <- ys <- (-20:20)^2 |
| > y [c(1,10,21,41)] <- c(150, 30, 400, 450) |
| > all(y == runmed(y, 1)) # 1-neighbourhood <==> interpolation |
| [1] TRUE |
| > plot(y) ## lines(y, lwd = .1, col = "light gray") |
| > lines(lowess(seq(y), y, f = 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 6 |
| window []: -2B -2B -BIG +BIG +BIG +2B +2B |
| nrlist[]: -12345 2 1 2 0-12345-12345 |
| outlist[]: 4 2 3 2 |
| runmed(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 14 |
| window []: -2B -2B -2B -2B -BIG -BIG 4 9 9 +BIG +BIG +2B +2B +2B +2B |
| nrlist[]: -12345 4 2 7 3 1 6 5 4 2 0-12345-12345-12345-12345 |
| outlist[]: 10 5 9 4 8 7 6 3 |
| runmed(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 18 |
| window []: -2B -2B -2B -2B -2B -BIG -BIG 4 6 9 9 22 +BIG +BIG +2B +2B +2B +2B +2B |
| nrlist[]: -12345 4 2 7 9 3 1 6 8 5 4 7 2 0-12345-12345-12345-12345-12345 |
| outlist[]: 13 6 12 5 10 9 7 11 8 4 |
| runmed(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 22 |
| window []: -2B -2B -2B -2B -2B -2B -BIG -BIG 1 4 6 7 9 9 22 +BIG +BIG +2B +2B +2B +2B +2B +2B |
| nrlist[]: -12345 2 4 10 7 9 1 3 9 6 8 10 5 4 7 2 0-12345-12345-12345-12345-12345-12345 |
| outlist[]: 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)) # inappropriate |
| Call: |
| princomp(x = USArrests, cor = TRUE) |
| |
| Standard deviations: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| 1.5748783 0.9948694 0.5971291 0.4164494 |
| |
| 4 variables and 50 observations. |
| > screeplot(pc.cr) |
| > |
| > fit <- princomp(covmat = Harman74.cor) |
| > screeplot(fit) |
| > screeplot(fit, npcs = 24, type = "lines") |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("sd") |
| > ### * sd |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: sd |
| > ### Title: Standard Deviation |
| > ### Aliases: sd |
| > ### Keywords: univar |
| > |
| > ### ** Examples |
| > |
| > sd(1:2) ^ 2 |
| [1] 0.5 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("se.contrast") |
| > ### * se.contrast |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: se.contrast |
| > ### Title: Standard Errors for Contrasts in Model Terms |
| > ### Aliases: se.contrast se.contrast.aov se.contrast.aovlist |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > ## From Venables and Ripley (2002) p.165. |
| > N <- c(0,1,0,1,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,1,1,0,0) |
| > P <- c(1,1,0,0,0,1,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,1,1,0) |
| > K <- c(1,0,0,1,0,1,1,0,0,1,0,1,0,1,1,0,0,0,1,1,1,0,1,0) |
| > yield <- c(49.5,62.8,46.8,57.0,59.8,58.5,55.5,56.0,62.8,55.8,69.5, |
| + 55.0, 62.0,48.8,45.5,44.2,52.0,51.5,49.8,48.8,57.2,59.0,53.2,56.0) |
| > |
| > npk <- data.frame(block = gl(6,4), N = factor(N), P = factor(P), |
| + K = factor(K), yield = yield) |
| > ## Set suitable contrasts. |
| > options(contrasts = c("contr.helmert", "contr.poly")) |
| > npk.aov1 <- aov(yield ~ block + N + K, data = npk) |
| > se.contrast(npk.aov1, list(N == "0", N == "1"), data = npk) |
| [1] 1.609175 |
| > # or via a matrix |
| > cont <- matrix(c(-1,1), 2, 1, dimnames = list(NULL, "N")) |
| > se.contrast(npk.aov1, cont[N, , drop = FALSE]/12, data = npk) |
| N |
| 1.609175 |
| > |
| > ## test a multi-stratum model |
| > npk.aov2 <- aov(yield ~ N + K + Error(block/(N + K)), data = npk) |
| > se.contrast(npk.aov2, list(N == "0", N == "1")) |
| [1] 1.812166 |
| > |
| > |
| > ## an example looking at an interaction contrast |
| > ## Dataset from R.E. Kirk (1995) |
| > ## 'Experimental Design: procedures for the behavioral sciences' |
| > score <- c(12, 8,10, 6, 8, 4,10,12, 8, 6,10,14, 9, 7, 9, 5,11,12, |
| + 7,13, 9, 9, 5,11, 8, 7, 3, 8,12,10,13,14,19, 9,16,14) |
| > A <- gl(2, 18, labels = c("a1", "a2")) |
| > B <- rep(gl(3, 6, labels = c("b1", "b2", "b3")), 2) |
| > fit <- aov(score ~ A*B) |
| > cont <- c(1, -1)[A] * c(1, -1, 0)[B] |
| > sum(cont) # 0 |
| [1] 0 |
| > sum(cont*score) # value of the contrast |
| [1] -18 |
| > se.contrast(fit, as.matrix(cont)) |
| Contrast 1 |
| 14.24547 |
| > (t.stat <- sum(cont*score)/se.contrast(fit, as.matrix(cont))) |
| Contrast 1 |
| -1.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.14661 |
| B 2 62.00 31.00 3.666 0.03763 * |
| B: C1 1 1.50 1.50 0.177 0.67662 |
| B: 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.21612 |
| A: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 3 |
| 14.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 contrasts |
| A BC |
| 10.40625 -20.90625 |
| > se.contrast(fit, as.matrix(cont)) |
| A BC |
| 3.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 baz |
| 1 2 3 |
| > # this is just a short form of |
| > tmp <- 1:3 |
| > names(tmp) <- c("foo", "bar", "baz") |
| > tmp |
| foo bar baz |
| 1 2 3 |
| > |
| > ## 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 test |
| |
| data: rnorm(100, mean = 5, sd = 3) |
| W = 0.9956, p-value = 0.9876 |
| |
| > shapiro.test(runif(100, min = 2, max = 4)) |
| |
| Shapiro-Wilk normality test |
| |
| data: runif(100, min = 2, max = 4) |
| W = 0.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 deg8NP |
| 56.92100 86.02325 78.99367 88.54377 109.54451 116.79041 |
| > sqrt(diag(estVar(mlmfit))) |
| deg0NA deg4NA deg8NA deg0NP deg4NP deg8NP |
| 56.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 as |
| 1 2 3 4 5 |
| 0.6885691 2.2329771 3.7790352 5.2775859 6.8131451 |
| > fitted(mod1) |
| 1 2 3 4 5 |
| 0.8 2.3 3.8 5.3 6.8 |
| > |
| > ## repeat identically: |
| > (sseed <- attr(S2, "seed")) # seed; RNGkind as attribute |
| [1] 101 |
| attr(,"kind") |
| attr(,"kind")[[1]] |
| [1] "Mersenne-Twister" |
| |
| attr(,"kind")[[2]] |
| [1] "Inversion" |
| |
| 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 from |
| smooth(x = presidents, kind = "3R") ; n = 120 |
| used 4 iterations |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| 0.0 44.0 57.0 54.2 71.0 82.0 |
| > summary(sm2 <- smooth(presidents,"3RSS")) |
| 3RSS Tukey smoother resulting from |
| smooth(x = presidents, kind = "3RSS") ; n = 120 |
| used 5 iterations |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| 0.00 44.00 57.00 55.45 69.00 82.00 |
| > summary(sm <- smooth(presidents)) |
| 3RS3R Tukey smoother resulting from |
| smooth(x = presidents) ; n = 120 |
| used 7 iterations |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| 24.00 44.00 57.00 55.88 69.00 82.00 |
| > |
| > all.equal(c(sm2), c(smooth(smooth(sm3, "S"), "S"))) # 3RSS === 3R S S |
| [1] TRUE |
| > all.equal(c(sm), c(smooth(smooth(sm3, "S"), "3R"))) # 3RS3R === 3R S 3R |
| [1] TRUE |
| > |
| > plot(presidents, main = "smooth(presidents0, *) : 3R and default 3RS3R") |
| > lines(sm3, col = 3, lwd = 1.5) |
| > lines(sm, col = 2, lwd = 1.25) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("smooth.spline") |
| > ### * smooth.spline |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: smooth.spline |
| > ### Title: Fit a Smoothing Spline |
| > ### Aliases: smooth.spline .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.spl |
| Call: |
| smooth.spline(x = speed, y = dist) |
| |
| Smoothing Parameter spar= 0.7801305 lambda= 0.1112206 (11 iterations) |
| Equivalent Degrees of Freedom (Df): 2.635278 |
| Penalized Criterion (RSS): 4187.776 |
| GCV: 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.103688 |
| |
| attr(,"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)) # GCV |
| Call: |
| smooth.spline(x = y18) |
| |
| Smoothing Parameter spar= 0.3928105 lambda= 9.672776e-05 (13 iterations) |
| Equivalent Degrees of Freedom (Df): 8.494168 |
| Penalized Criterion (RSS): 3.59204 |
| GCV: 0.7155391 |
| > (s02 <- smooth.spline(y18, spar = 0.2)) |
| Call: |
| smooth.spline(x = y18, spar = 0.2) |
| |
| Smoothing Parameter spar= 0.2 lambda= 3.911187e-06 |
| Equivalent Degrees of Freedom (Df): 15.259 |
| Penalized Criterion (RSS): 0.4973656 |
| GCV: 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-06 |
| Equivalent Degrees of Freedom (Df): NA |
| Penalized 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-05 |
| Equivalent Degrees of Freedom (Df): 8.494168 |
| Penalized Criterion (RSS): 3.59204 |
| GCV: 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 256 |
| keep 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 y |
| 1 -3.0194489 0.0475 |
| 2 -1.6331544 0.1300 |
| 3 -0.9400073 0.2160 |
| 4 -0.2468601 0.3920 |
| 5 0.4462871 0.6765 |
| 6 1.1394343 1.0970 |
| 7 1.8325815 1.5400 |
| 8 2.5257286 1.9230 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("spec.ar") |
| > ### * spec.ar |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: spec.ar |
| > ### Title: Estimate Spectral Density of a Time Series from AR Fit |
| > ### Aliases: spec.ar |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > spec.ar(lh) |
| > |
| > spec.ar(ldeaths) |
| > spec.ar(ldeaths, method = "burg") |
| > |
| > 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-values |
| Mode FALSE TRUE |
| logical 22 7 |
| > str(spline(x, y, n = 201, ties="ordered")) # all '$y' entries are NaN |
| List 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 now |
| x y |
| Min. -3.00 -1.07800000 |
| 1st Qu. -1.75 -0.57050000 |
| Median -0.50 -0.13613265 |
| Mean -0.50 -0.08208311 |
| 3rd Qu. 0.75 0.50611122 |
| Max. 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) |
| treatment outcome counts |
| 1 1 1 18 |
| 2 1 2 17 |
| 3 1 3 15 |
| 4 2 1 20 |
| 5 2 2 10 |
| 6 2 3 20 |
| 7 3 1 25 |
| 8 3 2 13 |
| 9 3 3 12 |
| > ## End(Don't show) |
| > print(ag <- anova(glm.D93)) |
| Analysis of Deviance Table |
| |
| Model: poisson, link: log |
| |
| Response: counts |
| |
| Terms added sequentially (first to last) |
| |
| |
| Df Deviance Resid. Df Resid. Dev |
| NULL 8 10.5814 |
| outcome 2 5.4523 6 5.1291 |
| treatment 2 0.0000 4 5.1291 |
| > stat.anova(ag$table, test = "Cp", |
| + scale = sum(resid(glm.D93, "pearson")^2)/4, |
| + df.scale = 4, n = 9) |
| table Cp |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("step") |
| > ### * step |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: step |
| > ### Title: Choose a model by AIC in a Stepwise Algorithm |
| > ### Aliases: step |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > |
| > 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 |
| > sfun0 |
| Step function |
| Call: stepfun(1:3, y0, f = 0) |
| x[1:3] = 1, 2, 3 |
| 4 plateau levels = 1, 2, 4, 3 |
| > summary(sfun0) |
| Step function with continuity 'f'= 0 , 3 knots at |
| [1] 1 2 3 |
| and 4 plateau levels (y) at |
| [1] 1 2 4 3 |
| > summary(sfun.2) |
| Step function with continuity 'f'= 0.2 , 3 knots at |
| [1] 1 2 3 |
| and 4 plateau levels (y) at |
| [1] 1 2 4 3 |
| > |
| > ## look at the internal structure: |
| > unclass(sfun0) |
| function (v) |
| .approxfun(x, y, v, method, yleft, yright, f) |
| <bytecode: 0x536f9a8> |
| <environment: 0x60e3938> |
| attr(,"call") |
| stepfun(1:3, y0, f = 0) |
| > ls(envir = environment(sfun0)) |
| [1] "f" "method" "x" "y" "yleft" "yright" |
| > |
| > x0 <- seq(0.5, 3.5, by = 0.25) |
| > rbind(x = x0, f.f0 = sfun0(x0), f.f02 = sfun.2(x0), |
| + f.f1 = sfun1(x0), f.f1c = sfun1c(x0)) |
| [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] |
| x 0.5 0.75 1 1.25 1.5 1.75 2 2.25 2.5 2.75 3 3.25 3.5 |
| f.f0 1.0 1.00 2 2.00 2.0 2.00 4 4.00 4.0 4.00 3 3.00 3.0 |
| f.f02 1.0 1.00 2 2.40 2.4 2.40 4 3.80 3.8 3.80 3 3.00 3.0 |
| f.f1 1.0 1.00 2 4.00 4.0 4.00 4 3.00 3.0 3.00 3 3.00 3.0 |
| f.f1c 1.0 1.00 1 2.00 2.0 2.00 2 4.00 4.0 4.00 4 3.00 3.0 |
| > ## Identities : |
| > stopifnot(identical(y0[-1], sfun0 (1:3)), # right = FALSE |
| + identical(y0[-4], sfun1c(1:3))) # right = TRUE |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("stl") |
| > ### * stl |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: stl |
| > ### Title: Seasonal Decomposition of Time Series by Loess |
| > ### Aliases: stl |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > plot(stl(nottem, "per")) |
| > plot(stl(nottem, s.window = 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 remainder |
| Min. :-0.009939103 Min. :5.753541 Min. :-0.0022554051 |
| 1st Qu.:-0.004536535 1st Qu.:5.778556 1st Qu.:-0.0004586796 |
| Median : 0.000877761 Median :5.815125 Median :-0.0000088674 |
| Mean :-0.000001304 Mean :5.819267 Mean :-0.0000019655 |
| 3rd Qu.: 0.004997747 3rd Qu.:5.859806 3rd Qu.: 0.0004023465 |
| Max. : 0.009114691 Max. :5.898750 Max. : 0.0019396260 |
| IQR: |
| STL.seasonal STL.trend STL.remainder data |
| 0.009534 0.081250 0.000861 0.079370 |
| % 12.0 102.4 1.1 100.0 |
| |
| Weights: all == 1 |
| |
| Other components: List of 5 |
| $ win : Named num [1:3] 21 21 13 |
| $ deg : Named int [1:3] 0 1 1 |
| $ jump : Named num [1:3] 3 3 2 |
| $ inner: int 2 |
| $ outer: int 0 |
| > ## linear trend, strict period. |
| > plot(stl(log(co2), s.window = "per", t.window = 1000)) |
| > |
| > ## Two STL plotted side by side : |
| > stmd <- stl(mdeaths, s.window = "per") # non-robust |
| > summary(stmR <- stl(mdeaths, s.window = "per", robust = TRUE)) |
| Call: |
| stl(x = mdeaths, s.window = "per", robust = TRUE) |
| |
| Time.series components: |
| seasonal trend remainder |
| Min. :-446.8302 Min. :1318.650 Min. :-314.5835 |
| 1st Qu.:-301.5726 1st Qu.:1432.208 1st Qu.: -32.5392 |
| Median : -79.0561 Median :1448.891 Median : 5.7943 |
| Mean : 0.0000 Mean :1472.880 Mean : 23.0646 |
| 3rd Qu.: 304.5673 3rd Qu.:1548.974 3rd Qu.: 47.5134 |
| Max. : 544.7904 Max. :1615.535 Max. : 872.1992 |
| IQR: |
| STL.seasonal STL.trend STL.remainder data |
| 606.14 116.77 80.05 707.75 |
| % 85.6 16.5 11.3 100.0 |
| |
| Weights: |
| Min. 1st Qu. Median Mean 3rd Qu. Max. |
| 0.0000 0.5594 0.9452 0.7312 0.9853 1.0000 |
| |
| Other components: List of 5 |
| $ win : Named num [1:3] 721 19 13 |
| $ deg : Named int [1:3] 0 1 1 |
| $ jump : Named num [1:3] 73 2 2 |
| $ inner: int 1 |
| $ outer: int 15 |
| > op <- par(mar = c(0, 4, 0, 3), oma = c(5, 0, 4, 0), mfcol = c(4, 2)) |
| > plot(stmd, set.pars = NULL, labels = NULL, |
| + main = "stl(mdeaths, s.w = \"per\", robust = FALSE / TRUE )") |
| > plot(stmR, set.pars = NULL) |
| > # mark the 'outliers' : |
| > (iO <- which(stmR $ weights < 1e-8)) # 10 were considered outliers |
| [1] 24 26 27 28 36 37 50 52 59 61 |
| > sts <- stmR$time.series |
| > points(time(sts)[iO], 0.8* sts[,"remainder"][iO], pch = 4, col = "red") |
| > par(op) # reset |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("summary.aov") |
| > ### * summary.aov |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: summary.aov |
| > ### Title: Summarize an Analysis of Variance Model |
| > ### Aliases: summary.aov summary.aovlist print.summary.aov |
| > ### print.summary.aovlist |
| > ### Keywords: models regression |
| > |
| > ### ** Examples |
| > |
| > ## For a simple example see example(aov) |
| > |
| > # Cochran and Cox (1957, p.164) |
| > # 3x3 factorial with ordered factors, each is average of 12. |
| > CC <- data.frame( |
| + y = c(449, 413, 326, 409, 358, 291, 341, 278, 312)/12, |
| + P = ordered(gl(3, 3)), N = ordered(gl(3, 1, 9)) |
| + ) |
| > CC.aov <- aov(y ~ N * P, data = CC , weights = rep(12, 9)) |
| > summary(CC.aov) |
| Df Sum Sq Mean Sq |
| N 2 1016.7 508.3 |
| P 2 917.4 458.7 |
| N: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 Sq |
| N 2 1016.7 508.3 |
| N: L 1 1012.5 1012.5 |
| N: Q 1 4.2 4.2 |
| P 2 917.4 458.7 |
| P: L 1 917.3 917.3 |
| P: Q 1 0.0 0.0 |
| N:P 4 399.3 99.8 |
| N:P: L.L 1 184.1 184.1 |
| N:P: Q.L 1 152.1 152.1 |
| N:P: L.Q 1 49.0 49.0 |
| N: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 Sq |
| N 2 1016.7 508.3 |
| P 2 917.4 458.7 |
| N:P 4 399.3 99.8 |
| N:P: L.L 1 184.1 184.1 |
| N: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 Sq |
| N 2 1016.7 508.3 |
| P 2 917.4 458.7 |
| P: lin 1 917.3 917.3 |
| P: quad 1 0.0 0.0 |
| N:P 4 399.3 99.8 |
| N:P: lin 2 336.2 168.1 |
| N: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 Sq |
| N 2 1016.7 508.3 |
| P 2 917.4 458.7 |
| P: lin 1 917.3 917.3 |
| P: quad 1 0.0 0.0 |
| N: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 coefficients |
| groupCtl groupTrt |
| 5.032 4.661 |
| > sld90 <- summary(lm.D90 <- lm(weight ~ group -1)) # omitting intercept |
| > sld90 |
| |
| Call: |
| lm(formula = weight ~ group - 1) |
| |
| Residuals: |
| Min 1Q Median 3Q Max |
| -1.0710 -0.4938 0.0685 0.2462 1.3690 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| groupCtl 5.0320 0.2202 22.85 9.55e-15 *** |
| groupTrt 4.6610 0.2202 21.16 3.62e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.6964 on 18 degrees of freedom |
| Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798 |
| F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16 |
| |
| > coef(sld90) # much more |
| Estimate Std. Error t value Pr(>|t|) |
| groupCtl 5.032 0.2202177 22.85012 9.547128e-15 |
| groupTrt 4.661 0.2202177 21.16542 3.615345e-14 |
| > |
| > ## 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 line |
| |
| Call: |
| lm(formula = weight ~ group + I(group != "Ctl")) |
| |
| Residuals: |
| Min 1Q Median 3Q Max |
| -1.0710 -0.4938 0.0685 0.2462 1.3690 |
| |
| Coefficients: (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.249 |
| I(group != "Ctl")TRUE NA NA NA NA |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.6964 on 18 degrees of freedom |
| Multiple R-squared: 0.07308, Adjusted R-squared: 0.02158 |
| F-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.4 |
| Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938 |
| Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752 |
| Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000 |
| > ## 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.4 |
| Standard deviation 1.5748783 0.9948694 0.5971291 0.41644938 |
| Proportion of Variance 0.6200604 0.2474413 0.0891408 0.04335752 |
| Cumulative Proportion 0.6200604 0.8675017 0.9566425 1.00000000 |
| |
| Loadings: |
| Comp.1 Comp.2 Comp.3 Comp.4 |
| Murder 0.54 0.42 0.34 0.65 |
| Assault 0.58 0.27 -0.74 |
| UrbanPop 0.28 -0.87 0.38 |
| Rape 0.54 -0.82 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("supsmu") |
| > ### * supsmu |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: supsmu |
| > ### Title: Friedman's SuperSmoother |
| > ### Aliases: supsmu |
| > ### Keywords: smooth |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > with(cars, { |
| + plot(speed, dist) |
| + lines(supsmu(speed, dist)) |
| + lines(supsmu(speed, dist, bass = 7), lty = 2) |
| + }) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("symnum") |
| > ### * symnum |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: symnum |
| > ### Title: Symbolic Number Coding |
| > ### Aliases: symnum |
| > ### Keywords: utilities character |
| > |
| > ### ** Examples |
| > |
| > ii <- 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 |
| . . . - - + + $ 8 |
| attr(,"legend") |
| [1] 0 ‘.’ 2 ‘-’ 4 ‘+’ 6 ‘$’ 8 |
| > |
| > symnum(1:12 %% 3 == 0) # --> "|" = TRUE, "." = FALSE for logical |
| [1] . . | . . | . . | . . | |
| > |
| > ## Pascal's Triangle modulo 2 -- odd and even numbers: |
| > N <- 38 |
| > pascal <- t(sapply(0:N, function(n) round(choose(n, 0:N - (N-n)%/%2)))) |
| > rownames(pascal) <- rep("", 1+N) # <-- to improve "graphic" |
| > symnum(pascal %% 2, symbols = c(" ", "A"), numeric = FALSE) |
| |
| A |
| A A |
| A A |
| A A A A |
| A A |
| A A A A |
| A A A A |
| A A A A A A A A |
| A A |
| A A A A |
| A A A A |
| A A A A A A A A |
| A A A A |
| A A A A A A A A |
| A A A A A A A A |
| A A A A A A A A A A A A A A A A |
| A A |
| A A A A |
| A A A A |
| A A A A A A A A |
| A A A A |
| A A A A A A A A |
| A A A A A A A A |
| A A A A A A A A A A A A A A A A |
| A A A A |
| A A A A A A A A |
| A A A A A A A A |
| A A A A A A A A A A A A A A A A |
| A A A A A A A A |
| A A A A A A A A A A A A A A A A |
| A A A A A A A A A A A A A A A A |
| A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A |
| A A |
| A A A A |
| A A A A |
| A A A A A A A A |
| A A A A |
| A A A A A A A A |
| A A A A A A A A |
| > |
| > ##-- Symbolic correlation matrices: |
| > symnum(cor(attitude), diag = FALSE) |
| rt cm p l rs cr a |
| rating |
| complaints + |
| privileges . . |
| learning , . . |
| raises . , . , |
| critical . |
| advance . . . |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cor(attitude), abbr. = NULL) |
| |
| rating 1 |
| complaints + 1 |
| privileges . . 1 |
| learning , . . 1 |
| raises . , . , 1 |
| critical . 1 |
| advance . . . 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cor(attitude), abbr. = FALSE) |
| rating complaints privileges learning raises critical advance |
| rating 1 |
| complaints + 1 |
| privileges . . 1 |
| learning , . . 1 |
| raises . , . , 1 |
| critical . 1 |
| advance . . . 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cor(attitude), abbr. = 2) |
| rt cm pr lr rs cr ad |
| rating 1 |
| complaints + 1 |
| privileges . . 1 |
| learning , . . 1 |
| raises . , . , 1 |
| critical . 1 |
| advance . . . 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > |
| > symnum(cor(rbind(1, rnorm(25), rnorm(25)^2))) |
| |
| [1,] 1 |
| [2,] + 1 |
| [3,] . 1 |
| [4,] . B 1 |
| [5,] + B 1 |
| [6,] . B B 1 |
| [7,] , * . . * 1 |
| [8,] . + . , + . B 1 |
| [9,] . + . , * . B B 1 |
| [10,] . B B B . . . 1 |
| [11,] B B . * . , , B 1 |
| [12,] , B . B B + * . 1 |
| [13,] 1 + . . + . , . . . , 1 |
| [14,] , . * + B * + , 1 |
| [15,] . * B . + , + , * B . , 1 |
| [16,] * B B + , , * * . 1 |
| [17,] * B B + , , * * . B 1 |
| [18,] , , + , , * B * , + , . * . . 1 |
| [19,] . + , , + . B B B , + + . . + , , B 1 |
| [20,] + B B B + * . B + . B B , + 1 |
| [21,] , , + , , * B B , + + . * . . B B , 1 |
| [22,] . , , , + . B B B , + + . . + , , B B + B 1 |
| [23,] B , , . , , . . , . , B + + + , 1 |
| [24,] * , , . , , . , . . * * . , , . B 1 |
| [25,] B + . . + . , . . . , B , * * . + . B B 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cor(matrix(rexp(30, 1), 5, 18))) # <<-- PATTERN ! -- |
| |
| [1,] 1 |
| [2,] . 1 |
| [3,] 1 |
| [4,] . . 1 |
| [5,] , . 1 |
| [6,] , , 1 |
| [7,] 1 . . 1 |
| [8,] . 1 . , , . 1 |
| [9,] 1 . 1 |
| [10,] . . 1 . . 1 |
| [11,] , . 1 , , . 1 |
| [12,] , , 1 , , 1 |
| [13,] 1 . . 1 . . 1 |
| [14,] . 1 . , , . 1 . , , . 1 |
| [15,] 1 . 1 . 1 |
| [16,] . . 1 . . 1 . . 1 |
| [17,] , . 1 , , . 1 , , . 1 |
| [18,] , , 1 , , 1 , , 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cm1 <- cor(matrix(rnorm(90) , 5, 18))) # < White Noise SMALL n |
| |
| [1,] 1 |
| [2,] . 1 |
| [3,] . . 1 |
| [4,] , , 1 |
| [5,] . , 1 |
| [6,] . * * 1 |
| [7,] , . . . 1 |
| [8,] , . . 1 |
| [9,] . . . . . . 1 |
| [10,] , . . . B . 1 |
| [11,] , + . + + , . 1 |
| [12,] , + + * . . , 1 |
| [13,] . + + , + . 1 |
| [14,] . . . + , , 1 |
| [15,] . . . . . . + 1 |
| [16,] . , . . . . . . 1 |
| [17,] , + , + . . * . . 1 |
| [18,] . . * , . . . , , . . 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cm1, diag = FALSE) |
| |
| [1,] |
| [2,] . |
| [3,] . . |
| [4,] , , |
| [5,] . , |
| [6,] . * * |
| [7,] , . . . |
| [8,] , . . |
| [9,] . . . . . . |
| [10,] , . . . B . |
| [11,] , + . + + , . |
| [12,] , + + * . . , |
| [13,] . + + , + . |
| [14,] . . . + , , |
| [15,] . . . . . . + |
| [16,] . , . . . . . . |
| [17,] , + , + . . * . . |
| [18,] . . * , . . . , , . . |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cm2 <- cor(matrix(rnorm(900), 50, 18))) # < White Noise "BIG" n |
| |
| [1,] 1 |
| [2,] 1 |
| [3,] 1 |
| [4,] 1 |
| [5,] 1 |
| [6,] 1 |
| [7,] 1 |
| [8,] 1 |
| [9,] 1 |
| [10,] 1 |
| [11,] 1 |
| [12,] 1 |
| [13,] . . 1 |
| [14,] 1 |
| [15,] 1 |
| [16,] 1 |
| [17,] 1 |
| [18,] 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > symnum(cm2, lower = FALSE) |
| |
| [1,] 1 |
| [2,] 1 |
| [3,] 1 |
| [4,] 1 |
| [5,] 1 |
| [6,] 1 |
| [7,] 1 |
| [8,] 1 . |
| [9,] 1 |
| [10,] 1 |
| [11,] 1 . |
| [12,] 1 |
| [13,] . . 1 |
| [14,] 1 |
| [15,] 1 |
| [16,] 1 |
| [17,] 1 |
| [18,] 1 |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 |
| > |
| > ## NA's: |
| > Cm <- cor(matrix(rnorm(60), 10, 6)); Cm[c(3,6), 2] <- NA |
| > symnum(Cm, show.max = NULL) |
| |
| [1,] |
| [2,] |
| [3,] . ? |
| [4,] . , |
| [5,] . |
| [6,] , ? |
| attr(,"legend") |
| [1] 0 ‘ ’ 0.3 ‘.’ 0.6 ‘,’ 0.8 ‘+’ 0.9 ‘*’ 0.95 ‘B’ 1 \t ## NA: ‘?’ |
| > |
| > ## Graphical P-values (aka "significance stars"): |
| > pval <- rev(sort(c(outer(1:6, 10^-(1:3))))) |
| > symp <- symnum(pval, corr = FALSE, |
| + cutpoints = c(0, .001,.01,.05, .1, 1), |
| + symbols = c("***","**","*","."," ")) |
| > noquote(cbind(P.val = format(pval), Signif = symp)) |
| P.val Signif |
| [1,] 0.600 |
| [2,] 0.500 |
| [3,] 0.400 |
| [4,] 0.300 |
| [5,] 0.200 |
| [6,] 0.100 . |
| [7,] 0.060 . |
| [8,] 0.050 * |
| [9,] 0.040 * |
| [10,] 0.030 * |
| [11,] 0.020 * |
| [12,] 0.010 ** |
| [13,] 0.006 ** |
| [14,] 0.005 ** |
| [15,] 0.004 ** |
| [16,] 0.003 ** |
| [17,] 0.002 ** |
| [18,] 0.001 *** |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("t.test") |
| > ### * t.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: t.test |
| > ### Title: Student's t-Test |
| > ### Aliases: t.test t.test.default t.test.formula |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > t.test(1:10, y = c(7:20)) # P = .00001855 |
| |
| Welch Two Sample t-test |
| |
| data: 1:10 and c(7:20) |
| t = -5.4349, df = 21.982, p-value = 1.855e-05 |
| alternative hypothesis: true difference in means is not equal to 0 |
| 95 percent confidence interval: |
| -11.052802 -4.947198 |
| sample estimates: |
| mean of x mean of y |
| 5.5 13.5 |
| |
| > t.test(1:10, y = c(7:20, 200)) # P = .1245 -- NOT significant anymore |
| |
| Welch Two Sample t-test |
| |
| data: 1:10 and c(7:20, 200) |
| t = -1.6329, df = 14.165, p-value = 0.1245 |
| alternative hypothesis: true difference in means is not equal to 0 |
| 95 percent confidence interval: |
| -47.242900 6.376233 |
| sample estimates: |
| mean of x mean of y |
| 5.50000 25.93333 |
| |
| > |
| > ## Classical example: Student's sleep data |
| > plot(extra ~ group, data = sleep) |
| > ## Traditional interface |
| > with(sleep, t.test(extra[group == 1], extra[group == 2])) |
| |
| Welch Two Sample t-test |
| |
| data: extra[group == 1] and extra[group == 2] |
| t = -1.8608, df = 17.776, p-value = 0.07939 |
| alternative hypothesis: true difference in means is not equal to 0 |
| 95 percent confidence interval: |
| -3.3654832 0.2054832 |
| sample estimates: |
| mean of x mean of y |
| 0.75 2.33 |
| |
| > ## Formula interface |
| > t.test(extra ~ group, data = sleep) |
| |
| Welch Two Sample t-test |
| |
| data: extra by group |
| t = -1.8608, df = 17.776, p-value = 0.07939 |
| alternative hypothesis: true difference in means is not equal to 0 |
| 95 percent confidence interval: |
| -3.3654832 0.2054832 |
| sample estimates: |
| mean in group 1 mean in group 2 |
| 0.75 2.33 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("termplot") |
| > ### * termplot |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: termplot |
| > ### Title: Plot Regression Terms |
| > ### Aliases: termplot |
| > ### Keywords: hplot regression |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > had.splines <- "package:splines" %in% search() |
| > if(!had.splines) rs <- require(splines) |
| Loading required package: splines |
| > x <- 1:100 |
| > z <- factor(rep(LETTERS[1:4], 25)) |
| > y <- rnorm(100, sin(x/10)+as.numeric(z)) |
| > model <- glm(y ~ ns(x, 6) + z) |
| > |
| > par(mfrow = c(2,2)) ## 2 x 2 plots for same model : |
| > termplot(model, main = paste("termplot( ", deparse(model$call)," ...)")) |
| > termplot(model, rug = TRUE) |
| > termplot(model, partial.resid = TRUE, se = TRUE, main = TRUE) |
| > termplot(model, partial.resid = TRUE, smooth = panel.smooth, span.smth = 1/4) |
| > if(!had.splines && rs) detach("package:splines") |
| > |
| > |
| > |
| > graphics::par(get("par.postscript", pos = 'CheckExEnv')) |
| > cleanEx() |
| > nameEx("terms.object") |
| > ### * terms.object |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: terms.object |
| > ### Title: Description of Terms Objects |
| > ### Aliases: terms.object |
| > ### Keywords: models |
| > |
| > ### ** Examples |
| > |
| > ## use of specials (as used for gam() in packages mgcv and gam) |
| > (tf <- terms(y ~ x + x:z + s(x), specials = "s")) |
| y ~ x + x:z + s(x) |
| attr(,"variables") |
| list(y, x, z, s(x)) |
| attr(,"factors") |
| x s(x) x:z |
| y 0 0 0 |
| x 1 0 2 |
| z 0 0 1 |
| s(x) 0 1 0 |
| attr(,"term.labels") |
| [1] "x" "s(x)" "x:z" |
| attr(,"specials") |
| attr(,"specials")$s |
| [1] 4 |
| |
| attr(,"order") |
| [1] 1 1 2 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > ## Note that the "factors" attribute has variables as row names |
| > ## and term labels as column names, both as character vectors. |
| > attr(tf, "specials") # index 's' variable(s) |
| $s |
| [1] 4 |
| |
| > rownames(attr(tf, "factors"))[attr(tf, "specials")$s] |
| [1] "s(x)" |
| > |
| > ## we can keep the order by |
| > terms(y ~ x + x:z + s(x), specials = "s", keep.order = TRUE) |
| y ~ x + x:z + s(x) |
| attr(,"variables") |
| list(y, x, z, s(x)) |
| attr(,"factors") |
| x x:z s(x) |
| y 0 0 0 |
| x 1 2 0 |
| z 0 1 0 |
| s(x) 0 0 1 |
| attr(,"term.labels") |
| [1] "x" "x:z" "s(x)" |
| attr(,"specials") |
| attr(,"specials")$s |
| [1] 4 |
| |
| attr(,"order") |
| [1] 1 2 1 |
| attr(,"intercept") |
| [1] 1 |
| attr(,"response") |
| [1] 1 |
| attr(,".Environment") |
| <environment: R_GlobalEnv> |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("time") |
| > ### * time |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: time |
| > ### Title: Sampling Times of Time Series |
| > ### Aliases: time cycle frequency deltat time.default |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > cycle(presidents) |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1945 1 2 3 4 |
| 1946 1 2 3 4 |
| 1947 1 2 3 4 |
| 1948 1 2 3 4 |
| 1949 1 2 3 4 |
| 1950 1 2 3 4 |
| 1951 1 2 3 4 |
| 1952 1 2 3 4 |
| 1953 1 2 3 4 |
| 1954 1 2 3 4 |
| 1955 1 2 3 4 |
| 1956 1 2 3 4 |
| 1957 1 2 3 4 |
| 1958 1 2 3 4 |
| 1959 1 2 3 4 |
| 1960 1 2 3 4 |
| 1961 1 2 3 4 |
| 1962 1 2 3 4 |
| 1963 1 2 3 4 |
| 1964 1 2 3 4 |
| 1965 1 2 3 4 |
| 1966 1 2 3 4 |
| 1967 1 2 3 4 |
| 1968 1 2 3 4 |
| 1969 1 2 3 4 |
| 1970 1 2 3 4 |
| 1971 1 2 3 4 |
| 1972 1 2 3 4 |
| 1973 1 2 3 4 |
| 1974 1 2 3 4 |
| > # a simple series plot |
| > plot(as.vector(time(presidents)), as.vector(presidents), type = "l") |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("toeplitz") |
| > ### * toeplitz |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: toeplitz |
| > ### Title: Form Symmetric Toeplitz Matrix |
| > ### Aliases: toeplitz |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > x <- 1:5 |
| > toeplitz (x) |
| [,1] [,2] [,3] [,4] [,5] |
| [1,] 1 2 3 4 5 |
| [2,] 2 1 2 3 4 |
| [3,] 3 2 1 2 3 |
| [4,] 4 3 2 1 2 |
| [5,] 5 4 3 2 1 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("ts") |
| > ### * ts |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: ts |
| > ### Title: Time-Series Objects |
| > ### Aliases: ts as.ts as.ts.default is.ts Ops.ts cbind.ts is.mts [.ts t.ts |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > |
| > ts(1:10, frequency = 4, start = c(1959, 2)) # 2nd Quarter of 1959 |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1959 1 2 3 |
| 1960 4 5 6 7 |
| 1961 8 9 10 |
| > print( ts(1:10, frequency = 7, start = c(12, 2)), calendar = TRUE) |
| p1 p2 p3 p4 p5 p6 p7 |
| 12 1 2 3 4 5 6 |
| 13 7 8 9 10 |
| > # print.ts(.) |
| > ## Using July 1954 as start date: |
| > gnp <- ts(cumsum(1 + round(rnorm(100), 2)), |
| + start = c(1954, 7), frequency = 12) |
| > plot(gnp) # using 'plot.ts' for time-series plot |
| > |
| > ## Multivariate |
| > z <- ts(matrix(rnorm(300), 100, 3), start = c(1961, 1), frequency = 12) |
| > class(z) |
| [1] "mts" "ts" "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 fdeaths |
| Jan 1974 2134 901 |
| Feb 1974 1863 689 |
| Mar 1974 1877 827 |
| Apr 1974 1877 677 |
| May 1974 1492 522 |
| Jun 1974 1249 406 |
| Jul 1974 1280 441 |
| Aug 1974 1131 393 |
| Sep 1974 1209 387 |
| Oct 1974 1492 582 |
| Nov 1974 1621 578 |
| Dec 1974 1846 666 |
| Jan 1975 2103 830 |
| Feb 1975 2137 752 |
| Mar 1975 2153 785 |
| Apr 1975 1833 664 |
| May 1975 1403 467 |
| Jun 1975 1288 438 |
| Jul 1975 1186 421 |
| Aug 1975 1133 412 |
| Sep 1975 1053 343 |
| Oct 1975 1347 440 |
| Nov 1975 1545 531 |
| Dec 1975 2066 771 |
| Jan 1976 2020 767 |
| Feb 1976 2750 1141 |
| Mar 1976 2283 896 |
| Apr 1976 1479 532 |
| May 1976 1189 447 |
| Jun 1976 1160 420 |
| Jul 1976 1113 376 |
| Aug 1976 970 330 |
| Sep 1976 999 357 |
| Oct 1976 1208 445 |
| Nov 1976 1467 546 |
| Dec 1976 2059 764 |
| Jan 1977 2240 862 |
| Feb 1977 1634 660 |
| Mar 1977 1722 663 |
| Apr 1977 1801 643 |
| May 1977 1246 502 |
| Jun 1977 1162 392 |
| Jul 1977 1087 411 |
| Aug 1977 1013 348 |
| Sep 1977 959 387 |
| Oct 1977 1179 385 |
| Nov 1977 1229 411 |
| Dec 1977 1655 638 |
| Jan 1978 2019 796 |
| Feb 1978 2284 853 |
| Mar 1978 1942 737 |
| Apr 1978 1423 546 |
| May 1978 1340 530 |
| Jun 1978 1187 446 |
| Jul 1978 1098 431 |
| Aug 1978 1004 362 |
| Sep 1978 970 387 |
| Oct 1978 1140 430 |
| Nov 1978 1110 425 |
| Dec 1978 1812 679 |
| Jan 1979 2263 821 |
| Feb 1979 1820 785 |
| Mar 1979 1846 727 |
| Apr 1979 1531 612 |
| May 1979 1215 478 |
| Jun 1979 1075 429 |
| Jul 1979 1056 405 |
| Aug 1979 975 379 |
| Sep 1979 940 393 |
| Oct 1979 1081 411 |
| Nov 1979 1294 487 |
| Dec 1979 1341 574 |
| > cbind(mdeaths, fdeaths) # same as the previous line |
| mdeaths fdeaths |
| Jan 1974 2134 901 |
| Feb 1974 1863 689 |
| Mar 1974 1877 827 |
| Apr 1974 1877 677 |
| May 1974 1492 522 |
| Jun 1974 1249 406 |
| Jul 1974 1280 441 |
| Aug 1974 1131 393 |
| Sep 1974 1209 387 |
| Oct 1974 1492 582 |
| Nov 1974 1621 578 |
| Dec 1974 1846 666 |
| Jan 1975 2103 830 |
| Feb 1975 2137 752 |
| Mar 1975 2153 785 |
| Apr 1975 1833 664 |
| May 1975 1403 467 |
| Jun 1975 1288 438 |
| Jul 1975 1186 421 |
| Aug 1975 1133 412 |
| Sep 1975 1053 343 |
| Oct 1975 1347 440 |
| Nov 1975 1545 531 |
| Dec 1975 2066 771 |
| Jan 1976 2020 767 |
| Feb 1976 2750 1141 |
| Mar 1976 2283 896 |
| Apr 1976 1479 532 |
| May 1976 1189 447 |
| Jun 1976 1160 420 |
| Jul 1976 1113 376 |
| Aug 1976 970 330 |
| Sep 1976 999 357 |
| Oct 1976 1208 445 |
| Nov 1976 1467 546 |
| Dec 1976 2059 764 |
| Jan 1977 2240 862 |
| Feb 1977 1634 660 |
| Mar 1977 1722 663 |
| Apr 1977 1801 643 |
| May 1977 1246 502 |
| Jun 1977 1162 392 |
| Jul 1977 1087 411 |
| Aug 1977 1013 348 |
| Sep 1977 959 387 |
| Oct 1977 1179 385 |
| Nov 1977 1229 411 |
| Dec 1977 1655 638 |
| Jan 1978 2019 796 |
| Feb 1978 2284 853 |
| Mar 1978 1942 737 |
| Apr 1978 1423 546 |
| May 1978 1340 530 |
| Jun 1978 1187 446 |
| Jul 1978 1098 431 |
| Aug 1978 1004 362 |
| Sep 1978 970 387 |
| Oct 1978 1140 430 |
| Nov 1978 1110 425 |
| Dec 1978 1812 679 |
| Jan 1979 2263 821 |
| Feb 1979 1820 785 |
| Mar 1979 1846 727 |
| Apr 1979 1531 612 |
| May 1979 1215 478 |
| Jun 1979 1075 429 |
| Jul 1979 1056 405 |
| Aug 1979 975 379 |
| Sep 1979 940 393 |
| Oct 1979 1081 411 |
| Nov 1979 1294 487 |
| Dec 1979 1341 574 |
| > ts.intersect(window(mdeaths, 1976), window(fdeaths, 1974, 1978)) |
| window(mdeaths, 1976) window(fdeaths, 1974, 1978) |
| Jan 1976 2020 767 |
| Feb 1976 2750 1141 |
| Mar 1976 2283 896 |
| Apr 1976 1479 532 |
| May 1976 1189 447 |
| Jun 1976 1160 420 |
| Jul 1976 1113 376 |
| Aug 1976 970 330 |
| Sep 1976 999 357 |
| Oct 1976 1208 445 |
| Nov 1976 1467 546 |
| Dec 1976 2059 764 |
| Jan 1977 2240 862 |
| Feb 1977 1634 660 |
| Mar 1977 1722 663 |
| Apr 1977 1801 643 |
| May 1977 1246 502 |
| Jun 1977 1162 392 |
| Jul 1977 1087 411 |
| Aug 1977 1013 348 |
| Sep 1977 959 387 |
| Oct 1977 1179 385 |
| Nov 1977 1229 411 |
| Dec 1977 1655 638 |
| Jan 1978 2019 796 |
| > |
| > sales1 <- ts.union(BJsales, lead = BJsales.lead) |
| > ts.intersect(sales1, lead3 = lag(BJsales.lead, -3)) |
| Time Series: |
| Start = 4 |
| End = 150 |
| Frequency = 1 |
| sales1.BJsales sales1.lead lead3 |
| 4 198.9 9.75 10.01 |
| 5 199.0 10.33 10.07 |
| 6 200.2 10.13 10.32 |
| 7 198.6 10.36 9.75 |
| 8 200.0 10.32 10.33 |
| 9 200.3 10.13 10.13 |
| 10 201.2 10.16 10.36 |
| 11 201.6 10.58 10.32 |
| 12 201.5 10.62 10.13 |
| 13 201.5 10.86 10.16 |
| 14 203.5 11.20 10.58 |
| 15 204.9 10.74 10.62 |
| 16 207.1 10.56 10.86 |
| 17 210.5 10.48 11.20 |
| 18 210.5 10.77 10.74 |
| 19 209.8 11.33 10.56 |
| 20 208.8 10.96 10.48 |
| 21 209.5 11.16 10.77 |
| 22 213.2 11.70 11.33 |
| 23 213.7 11.39 10.96 |
| 24 215.1 11.42 11.16 |
| 25 218.7 11.94 11.70 |
| 26 219.8 11.24 11.39 |
| 27 220.5 11.59 11.42 |
| 28 223.8 10.96 11.94 |
| 29 222.8 11.40 11.24 |
| 30 223.8 11.02 11.59 |
| 31 221.7 11.01 10.96 |
| 32 222.3 11.23 11.40 |
| 33 220.8 11.33 11.02 |
| 34 219.4 10.83 11.01 |
| 35 220.1 10.84 11.23 |
| 36 220.6 11.14 11.33 |
| 37 218.9 10.38 10.83 |
| 38 217.8 10.90 10.84 |
| 39 217.7 11.05 11.14 |
| 40 215.0 11.11 10.38 |
| 41 215.3 11.01 10.90 |
| 42 215.9 11.22 11.05 |
| 43 216.7 11.21 11.11 |
| 44 216.7 11.91 11.01 |
| 45 217.7 11.69 11.22 |
| 46 218.7 10.93 11.21 |
| 47 222.9 10.99 11.91 |
| 48 224.9 11.01 11.69 |
| 49 222.2 10.84 10.93 |
| 50 220.7 10.76 10.99 |
| 51 220.0 10.77 11.01 |
| 52 218.7 10.88 10.84 |
| 53 217.0 10.49 10.76 |
| 54 215.9 10.50 10.77 |
| 55 215.8 11.00 10.88 |
| 56 214.1 10.98 10.49 |
| 57 212.3 10.61 10.50 |
| 58 213.9 10.48 11.00 |
| 59 214.6 10.53 10.98 |
| 60 213.6 11.07 10.61 |
| 61 212.1 10.61 10.48 |
| 62 211.4 10.86 10.53 |
| 63 213.1 10.34 11.07 |
| 64 212.9 10.78 10.61 |
| 65 213.3 10.80 10.86 |
| 66 211.5 10.33 10.34 |
| 67 212.3 10.44 10.78 |
| 68 213.0 10.50 10.80 |
| 69 211.0 10.75 10.33 |
| 70 210.7 10.40 10.44 |
| 71 210.1 10.40 10.50 |
| 72 211.4 10.34 10.75 |
| 73 210.0 10.55 10.40 |
| 74 209.7 10.46 10.40 |
| 75 208.8 10.82 10.34 |
| 76 208.8 10.91 10.55 |
| 77 208.8 10.87 10.46 |
| 78 210.6 10.67 10.82 |
| 79 211.9 11.11 10.91 |
| 80 212.8 10.88 10.87 |
| 81 212.5 11.28 10.67 |
| 82 214.8 11.27 11.11 |
| 83 215.3 11.44 10.88 |
| 84 217.5 11.52 11.28 |
| 85 218.8 12.10 11.27 |
| 86 220.7 11.83 11.44 |
| 87 222.2 12.62 11.52 |
| 88 226.7 12.41 12.10 |
| 89 228.4 12.43 11.83 |
| 90 233.2 12.73 12.62 |
| 91 235.7 13.01 12.41 |
| 92 237.1 12.74 12.43 |
| 93 240.6 12.73 12.73 |
| 94 243.8 12.76 13.01 |
| 95 245.3 12.92 12.74 |
| 96 246.0 12.64 12.73 |
| 97 246.3 12.79 12.76 |
| 98 247.7 13.05 12.92 |
| 99 247.6 12.69 12.64 |
| 100 247.8 13.01 12.79 |
| 101 249.4 12.90 13.05 |
| 102 249.0 13.12 12.69 |
| 103 249.9 12.47 13.01 |
| 104 250.5 12.47 12.90 |
| 105 251.5 12.94 13.12 |
| 106 249.0 13.10 12.47 |
| 107 247.6 12.91 12.47 |
| 108 248.8 13.39 12.94 |
| 109 250.4 13.13 13.10 |
| 110 250.7 13.34 12.91 |
| 111 253.0 13.34 13.39 |
| 112 253.7 13.14 13.13 |
| 113 255.0 13.49 13.34 |
| 114 256.2 13.87 13.34 |
| 115 256.0 13.39 13.14 |
| 116 257.4 13.59 13.49 |
| 117 260.4 13.27 13.87 |
| 118 260.0 13.70 13.39 |
| 119 261.3 13.20 13.59 |
| 120 260.4 13.32 13.27 |
| 121 261.6 13.15 13.70 |
| 122 260.8 13.30 13.20 |
| 123 259.8 12.94 13.32 |
| 124 259.0 13.29 13.15 |
| 125 258.9 13.26 13.30 |
| 126 257.4 13.08 12.94 |
| 127 257.7 13.24 13.29 |
| 128 257.9 13.31 13.26 |
| 129 257.4 13.52 13.08 |
| 130 257.3 13.02 13.24 |
| 131 257.6 13.25 13.31 |
| 132 258.9 13.12 13.52 |
| 133 257.8 13.26 13.02 |
| 134 257.7 13.11 13.25 |
| 135 257.2 13.30 13.12 |
| 136 257.5 13.06 13.26 |
| 137 256.8 13.32 13.11 |
| 138 257.5 13.10 13.30 |
| 139 257.0 13.27 13.06 |
| 140 257.6 13.64 13.32 |
| 141 257.3 13.58 13.10 |
| 142 257.5 13.87 13.27 |
| 143 259.6 13.53 13.64 |
| 144 261.1 13.41 13.58 |
| 145 262.9 13.25 13.87 |
| 146 263.3 13.50 13.53 |
| 147 262.8 13.58 13.41 |
| 148 261.8 13.51 13.25 |
| 149 262.2 13.77 13.50 |
| 150 262.7 13.40 13.58 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("tsdiag") |
| > ### * tsdiag |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: tsdiag |
| > ### Title: Diagnostic Plots for Time-Series Fits |
| > ### Aliases: tsdiag tsdiag.arima0 tsdiag.Arima tsdiag.StructTS |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > |
| > |
| > 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.D9 |
| |
| Call: |
| lm(formula = weight ~ group) |
| |
| Coefficients: |
| (Intercept) groupTrt |
| 5.032 -0.371 |
| |
| > summary(lm.D90 <- update(lm.D9, . ~ . - 1)) |
| |
| Call: |
| lm(formula = weight ~ group - 1) |
| |
| Residuals: |
| Min 1Q Median 3Q Max |
| -1.0710 -0.4938 0.0685 0.2462 1.3690 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| groupCtl 5.0320 0.2202 22.85 9.55e-15 *** |
| groupTrt 4.6610 0.2202 21.16 3.62e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 0.6964 on 18 degrees of freedom |
| Multiple R-squared: 0.9818, Adjusted R-squared: 0.9798 |
| F-statistic: 485.1 on 2 and 18 DF, p-value: < 2.2e-16 |
| |
| > options(contrasts = c("contr.helmert", "contr.poly")) |
| > update(lm.D9) |
| |
| Call: |
| lm(formula = weight ~ group) |
| |
| Coefficients: |
| (Intercept) group1 |
| 4.8465 -0.1855 |
| |
| > 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 + x2 |
| y ~ x + x2 |
| > update(y ~ x, log(.) ~ . ) #> log(y) ~ x |
| log(y) ~ x |
| > update(. ~ u+v, res ~ . ) #> res ~ u + v |
| res ~ 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 variances |
| |
| data: x and y |
| F = 2.6522, num df = 49, denom df = 29, p-value = 0.006232 |
| alternative hypothesis: true ratio of variances is not equal to 1 |
| 95 percent confidence interval: |
| 1.332510 4.989832 |
| sample estimates: |
| ratio of variances |
| 2.652168 |
| |
| > var.test(lm(x ~ 1), lm(y ~ 1)) # The same. |
| |
| F test to compare two variances |
| |
| data: lm(x ~ 1) and lm(y ~ 1) |
| F = 2.6522, num df = 49, denom df = 29, p-value = 0.006232 |
| alternative hypothesis: true ratio of variances is not equal to 1 |
| 95 percent confidence interval: |
| 1.332510 4.989832 |
| sample estimates: |
| ratio of variances |
| 2.652168 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("varimax") |
| > ### * varimax |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: varimax |
| > ### Title: Rotation Methods for Factor Analysis |
| > ### Aliases: promax varimax |
| > ### Keywords: multivariate |
| > |
| > ### ** Examples |
| > |
| > ## varimax with normalize = TRUE is the default |
| > fa <- factanal( ~., 2, data = swiss) |
| > varimax(loadings(fa), normalize = FALSE) |
| $loadings |
| |
| Loadings: |
| Factor1 Factor2 |
| Fertility -0.650 0.398 |
| Agriculture -0.628 0.337 |
| Examination 0.681 -0.515 |
| Education 0.997 |
| Catholic -0.117 0.962 |
| Infant.Mortality 0.176 |
| |
| Factor1 Factor2 |
| SS loadings 2.297 1.496 |
| Proportion Var 0.383 0.249 |
| Cumulative Var 0.383 0.632 |
| |
| $rotmat |
| [,1] [,2] |
| [1,] 0.999973881 -0.007227595 |
| [2,] 0.007227595 0.999973881 |
| |
| > promax(loadings(fa)) |
| $loadings |
| |
| Loadings: |
| Factor1 Factor2 |
| Fertility -0.595 0.227 |
| Agriculture -0.599 0.160 |
| Examination 0.577 -0.360 |
| Education 1.192 0.363 |
| Catholic 0.326 1.147 |
| Infant.Mortality 0.180 |
| |
| Factor1 Factor2 |
| SS loadings 2.574 1.686 |
| Proportion Var 0.429 0.281 |
| Cumulative Var 0.429 0.710 |
| |
| $rotmat |
| [,1] [,2] |
| [1,] 1.2114045 0.4029296 |
| [2,] 0.4956199 1.2453063 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("weighted.mean") |
| > ### * weighted.mean |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: weighted.mean |
| > ### Title: Weighted Arithmetic Mean |
| > ### Aliases: weighted.mean weighted.mean.default |
| > ### Keywords: univar |
| > |
| > ### ** Examples |
| > |
| > ## GPA from Siegel 1994 |
| > wt <- c(5, 5, 4, 1)/15 |
| > x <- c(3.7,3.3,3.5,2.8) |
| > xm <- weighted.mean(x, wt) |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("weighted.residuals") |
| > ### * weighted.residuals |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: weighted.residuals |
| > ### Title: Compute Weighted Residuals |
| > ### Aliases: weighted.residuals |
| > ### Keywords: regression |
| > |
| > ### ** Examples |
| > |
| > ## 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.60771924 |
| 8 9 10 |
| 1.37406419 1.06675699 -1.45098819 |
| > weighted.residuals(lmxy, drop0 = FALSE) |
| 1 2 3 4 5 6 |
| 0.00000000 -0.15744267 -1.63534445 2.24282864 0.09895229 -2.41528559 |
| 7 8 9 10 |
| 0.60771924 1.37406419 1.06675699 -1.45098819 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("wilcox.test") |
| > ### * wilcox.test |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: wilcox.test |
| > ### Title: Wilcoxon Rank Sum and Signed Rank Tests |
| > ### Aliases: wilcox.test wilcox.test.default wilcox.test.formula |
| > ### Keywords: htest |
| > |
| > ### ** Examples |
| > |
| > require(graphics) |
| > ## One-sample test. |
| > ## Hollander & Wolfe (1973), 29f. |
| > ## Hamilton depression scale factor measurements in 9 patients with |
| > ## mixed anxiety and depression, taken at the first (x) and second |
| > ## (y) visit after initiation of a therapy (administration of a |
| > ## tranquilizer). |
| > x <- c(1.83, 0.50, 1.62, 2.48, 1.68, 1.88, 1.55, 3.06, 1.30) |
| > y <- c(0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29) |
| > wilcox.test(x, y, paired = TRUE, alternative = "greater") |
| |
| Wilcoxon signed rank test |
| |
| data: x and y |
| V = 40, p-value = 0.01953 |
| alternative hypothesis: true location shift is greater than 0 |
| |
| > wilcox.test(y - x, alternative = "less") # The same. |
| |
| Wilcoxon signed rank test |
| |
| data: y - x |
| V = 5, p-value = 0.01953 |
| alternative hypothesis: true location is less than 0 |
| |
| > wilcox.test(y - x, alternative = "less", |
| + exact = FALSE, correct = FALSE) # H&W large sample |
| |
| Wilcoxon signed rank test |
| |
| data: y - x |
| V = 5, p-value = 0.01908 |
| alternative hypothesis: true location is less than 0 |
| |
| > # approximation |
| > |
| > ## Two-sample test. |
| > ## Hollander & Wolfe (1973), 69f. |
| > ## Permeability constants of the human chorioamnion (a placental |
| > ## membrane) at term (x) and between 12 to 26 weeks gestational |
| > ## age (y). The alternative of interest is greater permeability |
| > ## of the human chorioamnion for the term pregnancy. |
| > x <- c(0.80, 0.83, 1.89, 1.04, 1.45, 1.38, 1.91, 1.64, 0.73, 1.46) |
| > y <- c(1.15, 0.88, 0.90, 0.74, 1.21) |
| > wilcox.test(x, y, alternative = "g") # greater |
| |
| Wilcoxon rank sum test |
| |
| data: x and y |
| W = 35, p-value = 0.1272 |
| alternative hypothesis: true location shift is greater than 0 |
| |
| > wilcox.test(x, y, alternative = "greater", |
| + exact = FALSE, correct = FALSE) # H&W large sample |
| |
| Wilcoxon rank sum test |
| |
| data: x and y |
| W = 35, p-value = 0.1103 |
| alternative hypothesis: true location shift is greater than 0 |
| |
| > # approximation |
| > |
| > wilcox.test(rnorm(10), rnorm(10, 2), conf.int = TRUE) |
| |
| Wilcoxon rank sum test |
| |
| data: rnorm(10) and rnorm(10, 2) |
| W = 7, p-value = 0.0004871 |
| alternative hypothesis: true location shift is not equal to 0 |
| 95 percent confidence interval: |
| -3.024352 -1.348555 |
| sample estimates: |
| difference in location |
| -2.262424 |
| |
| > |
| > ## Formula interface. |
| > boxplot(Ozone ~ Month, data = airquality) |
| > wilcox.test(Ozone ~ Month, data = airquality, |
| + subset = Month %in% c(5, 8)) |
| Warning in wilcox.test.default(x = c(41L, 36L, 12L, 18L, 28L, 23L, 19L, : |
| cannot compute exact p-value with ties |
| |
| Wilcoxon rank sum test with continuity correction |
| |
| data: Ozone by Month |
| W = 127.5, p-value = 0.0001208 |
| alternative hypothesis: true location shift is not equal to 0 |
| |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("window") |
| > ### * window |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: window |
| > ### Title: Time Windows |
| > ### Aliases: window window.default window.ts window<- window<-.ts |
| > ### Keywords: ts |
| > |
| > ### ** Examples |
| > |
| > window(presidents, 1960, c(1969,4)) # values in the 1960's |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1960 71 62 61 57 |
| 1961 72 83 71 78 |
| 1962 79 71 62 74 |
| 1963 76 64 62 57 |
| 1964 80 73 69 69 |
| 1965 71 64 69 62 |
| 1966 63 46 56 44 |
| 1967 44 52 38 46 |
| 1968 36 49 35 44 |
| 1969 59 65 65 56 |
| > window(presidents, deltat = 1) # All Qtr1s |
| Time Series: |
| Start = 1945 |
| End = 1974 |
| Frequency = 1 |
| [1] NA 63 35 36 69 45 36 25 59 71 71 76 79 60 57 71 72 79 76 80 71 63 44 36 59 |
| [26] 66 51 49 68 28 |
| > window(presidents, start = c(1945,3), deltat = 1) # All Qtr3s |
| Time Series: |
| Start = 1945.5 |
| End = 1974.5 |
| Frequency = 1 |
| [1] 82 43 54 NA 57 46 32 NA 75 71 79 67 63 48 61 61 71 62 62 69 69 56 38 35 65 |
| [26] 61 54 NA 40 24 |
| > window(presidents, 1944, c(1979,2), extend = TRUE) |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1944 NA NA NA NA |
| 1945 NA 87 82 75 |
| 1946 63 50 43 32 |
| 1947 35 60 54 55 |
| 1948 36 39 NA NA |
| 1949 69 57 57 51 |
| 1950 45 37 46 39 |
| 1951 36 24 32 23 |
| 1952 25 32 NA 32 |
| 1953 59 74 75 60 |
| 1954 71 61 71 57 |
| 1955 71 68 79 73 |
| 1956 76 71 67 75 |
| 1957 79 62 63 57 |
| 1958 60 49 48 52 |
| 1959 57 62 61 66 |
| 1960 71 62 61 57 |
| 1961 72 83 71 78 |
| 1962 79 71 62 74 |
| 1963 76 64 62 57 |
| 1964 80 73 69 69 |
| 1965 71 64 69 62 |
| 1966 63 46 56 44 |
| 1967 44 52 38 46 |
| 1968 36 49 35 44 |
| 1969 59 65 65 56 |
| 1970 66 53 61 52 |
| 1971 51 48 54 49 |
| 1972 49 61 NA NA |
| 1973 68 44 40 27 |
| 1974 28 25 24 24 |
| 1975 NA NA NA NA |
| 1976 NA NA NA NA |
| 1977 NA NA NA NA |
| 1978 NA NA NA NA |
| 1979 NA NA |
| > |
| > pres <- window(presidents, 1945, c(1949,4)) # values in the 1940's |
| > window(pres, 1945.25, 1945.50) <- c(60, 70) |
| > window(pres, 1944, 1944.75) <- 0 # will generate a warning |
| Warning: extending time series when replacing values |
| > window(pres, c(1945,4), c(1949,4), frequency = 1) <- 85:89 |
| > pres |
| Qtr1 Qtr2 Qtr3 Qtr4 |
| 1944 0 0 0 0 |
| 1945 NA 60 70 85 |
| 1946 63 50 43 86 |
| 1947 35 60 54 87 |
| 1948 36 39 NA 88 |
| 1949 69 57 57 89 |
| > |
| > |
| > |
| > cleanEx() |
| > nameEx("xtabs") |
| > ### * xtabs |
| > |
| > flush(stderr()); flush(stdout()) |
| > |
| > ### Name: xtabs |
| > ### Title: Cross Tabulation |
| > ### Aliases: xtabs print.xtabs |
| > ### Keywords: category |
| > |
| > ### ** Examples |
| > |
| > ## 'esoph' has the frequencies of cases and controls for all levels of |
| > ## the variables 'agegp', 'alcgp', and 'tobgp'. |
| > xtabs(cbind(ncases, ncontrols) ~ ., data = esoph) |
| , , tobgp = 0-9g/day, = ncases |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 0 0 0 0 |
| 35-44 0 0 0 2 |
| 45-54 1 6 3 4 |
| 55-64 2 9 9 5 |
| 65-74 5 17 6 3 |
| 75+ 1 2 1 2 |
| |
| , , tobgp = 10-19, = ncases |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 0 0 0 1 |
| 35-44 1 3 0 0 |
| 45-54 0 4 6 3 |
| 55-64 3 6 8 6 |
| 65-74 4 3 4 1 |
| 75+ 2 1 1 1 |
| |
| , , tobgp = 20-29, = ncases |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 0 0 0 0 |
| 35-44 0 1 0 2 |
| 45-54 0 5 1 2 |
| 55-64 3 4 3 2 |
| 65-74 2 5 2 1 |
| 75+ 0 0 0 0 |
| |
| , , tobgp = 30+, = ncases |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 0 0 0 0 |
| 35-44 0 0 0 0 |
| 45-54 0 5 2 4 |
| 55-64 4 3 4 5 |
| 65-74 0 0 1 1 |
| 75+ 1 1 0 0 |
| |
| , , tobgp = 0-9g/day, = ncontrols |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 40 27 2 1 |
| 35-44 60 35 11 3 |
| 45-54 46 38 16 4 |
| 55-64 49 40 18 10 |
| 65-74 48 34 13 4 |
| 75+ 18 5 1 2 |
| |
| , , tobgp = 10-19, = ncontrols |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 10 7 1 1 |
| 35-44 14 23 6 3 |
| 45-54 18 21 14 4 |
| 55-64 22 21 15 7 |
| 65-74 14 10 12 2 |
| 75+ 6 3 1 1 |
| |
| , , tobgp = 20-29, = ncontrols |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 6 4 0 1 |
| 35-44 7 14 2 4 |
| 45-54 10 15 5 3 |
| 55-64 12 17 6 3 |
| 65-74 7 9 3 1 |
| 75+ 0 3 0 0 |
| |
| , , tobgp = 30+, = ncontrols |
| |
| alcgp |
| agegp 0-39g/day 40-79 80-119 120+ |
| 25-34 5 7 2 2 |
| 35-44 8 8 1 0 |
| 45-54 4 7 4 4 |
| 55-64 6 6 4 6 |
| 65-74 2 0 1 1 |
| 75+ 3 1 0 0 |
| |
| > ## Output is not really helpful ... flat tables are better: |
| > ftable(xtabs(cbind(ncases, ncontrols) ~ ., data = esoph)) |
| ncases ncontrols |
| agegp alcgp tobgp |
| 25-34 0-39g/day 0-9g/day 0 40 |
| 10-19 0 10 |
| 20-29 0 6 |
| 30+ 0 5 |
| 40-79 0-9g/day 0 27 |
| 10-19 0 7 |
| 20-29 0 4 |
| 30+ 0 7 |
| 80-119 0-9g/day 0 2 |
| 10-19 0 1 |
| 20-29 0 0 |
| 30+ 0 2 |
| 120+ 0-9g/day 0 1 |
| 10-19 1 1 |
| 20-29 0 1 |
| 30+ 0 2 |
| 35-44 0-39g/day 0-9g/day 0 60 |
| 10-19 1 14 |
| 20-29 0 7 |
| 30+ 0 8 |
| 40-79 0-9g/day 0 35 |
| 10-19 3 23 |
| 20-29 1 14 |
| 30+ 0 8 |
| 80-119 0-9g/day 0 11 |
| 10-19 0 6 |
| 20-29 0 2 |
| 30+ 0 1 |
| 120+ 0-9g/day 2 3 |
| 10-19 0 3 |
| 20-29 2 4 |
| 30+ 0 0 |
| 45-54 0-39g/day 0-9g/day 1 46 |
| 10-19 0 18 |
| 20-29 0 10 |
| 30+ 0 4 |
| 40-79 0-9g/day 6 38 |
| 10-19 4 21 |
| 20-29 5 15 |
| 30+ 5 7 |
| 80-119 0-9g/day 3 16 |
| 10-19 6 14 |
| 20-29 1 5 |
| 30+ 2 4 |
| 120+ 0-9g/day 4 4 |
| 10-19 3 4 |
| 20-29 2 3 |
| 30+ 4 4 |
| 55-64 0-39g/day 0-9g/day 2 49 |
| 10-19 3 22 |
| 20-29 3 12 |
| 30+ 4 6 |
| 40-79 0-9g/day 9 40 |
| 10-19 6 21 |
| 20-29 4 17 |
| 30+ 3 6 |
| 80-119 0-9g/day 9 18 |
| 10-19 8 15 |
| 20-29 3 6 |
| 30+ 4 4 |
| 120+ 0-9g/day 5 10 |
| 10-19 6 7 |
| 20-29 2 3 |
| 30+ 5 6 |
| 65-74 0-39g/day 0-9g/day 5 48 |
| 10-19 4 14 |
| 20-29 2 7 |
| 30+ 0 2 |
| 40-79 0-9g/day 17 34 |
| 10-19 3 10 |
| 20-29 5 9 |
| 30+ 0 0 |
| 80-119 0-9g/day 6 13 |
| 10-19 4 12 |
| 20-29 2 3 |
| 30+ 1 1 |
| 120+ 0-9g/day 3 4 |
| 10-19 1 2 |
| 20-29 1 1 |
| 30+ 1 1 |
| 75+ 0-39g/day 0-9g/day 1 18 |
| 10-19 2 6 |
| 20-29 0 0 |
| 30+ 1 3 |
| 40-79 0-9g/day 2 5 |
| 10-19 1 3 |
| 20-29 0 3 |
| 30+ 1 1 |
| 80-119 0-9g/day 1 1 |
| 10-19 1 1 |
| 20-29 0 0 |
| 30+ 0 0 |
| 120+ 0-9g/day 2 2 |
| 10-19 1 1 |
| 20-29 0 0 |
| 30+ 0 0 |
| > ## In particular if we have fewer factors ... |
| > ftable(xtabs(cbind(ncases, ncontrols) ~ agegp, data = esoph)) |
| ncases ncontrols |
| agegp |
| 25-34 1 116 |
| 35-44 9 199 |
| 45-54 46 213 |
| 55-64 76 242 |
| 65-74 55 161 |
| 75+ 13 44 |
| > |
| > ## This is already a contingency table in array form. |
| > DF <- as.data.frame(UCBAdmissions) |
| > ## Now 'DF' is a data frame with a grid of the factors and the counts |
| > ## in variable 'Freq'. |
| > DF |
| Admit Gender Dept Freq |
| 1 Admitted Male A 512 |
| 2 Rejected Male A 313 |
| 3 Admitted Female A 89 |
| 4 Rejected Female A 19 |
| 5 Admitted Male B 353 |
| 6 Rejected Male B 207 |
| 7 Admitted Female B 17 |
| 8 Rejected Female B 8 |
| 9 Admitted Male C 120 |
| 10 Rejected Male C 205 |
| 11 Admitted Female C 202 |
| 12 Rejected Female C 391 |
| 13 Admitted Male D 138 |
| 14 Rejected Male D 279 |
| 15 Admitted Female D 131 |
| 16 Rejected Female D 244 |
| 17 Admitted Male E 53 |
| 18 Rejected Male E 138 |
| 19 Admitted Female E 94 |
| 20 Rejected Female E 299 |
| 21 Admitted Male F 22 |
| 22 Rejected Male F 351 |
| 23 Admitted Female F 24 |
| 24 Rejected Female F 317 |
| > ## Nice for taking margins ... |
| > xtabs(Freq ~ Gender + Admit, DF) |
| Admit |
| Gender Admitted Rejected |
| Male 1198 1493 |
| Female 557 1278 |
| > ## And for testing independence ... |
| > summary(xtabs(Freq ~ ., DF)) |
| Call: xtabs(formula = Freq ~ ., data = DF) |
| Number of cases in table: 4526 |
| Number of factors: 3 |
| Test for independence of all factors: |
| Chisq = 2000.3, df = 16, p-value = 0 |
| > |
| > ## with NA's |
| > DN <- DF; DN[cbind(6:9, c(1:2,4,1))] <- NA; DN |
| Admit Gender Dept Freq |
| 1 Admitted Male A 512 |
| 2 Rejected Male A 313 |
| 3 Admitted Female A 89 |
| 4 Rejected Female A 19 |
| 5 Admitted Male B 353 |
| 6 <NA> Male B 207 |
| 7 Admitted <NA> B 17 |
| 8 Rejected Female B NA |
| 9 <NA> Male C 120 |
| 10 Rejected Male C 205 |
| 11 Admitted Female C 202 |
| 12 Rejected Female C 391 |
| 13 Admitted Male D 138 |
| 14 Rejected Male D 279 |
| 15 Admitted Female D 131 |
| 16 Rejected Female D 244 |
| 17 Admitted Male E 53 |
| 18 Rejected Male E 138 |
| 19 Admitted Female E 94 |
| 20 Rejected Female E 299 |
| 21 Admitted Male F 22 |
| 22 Rejected Male F 351 |
| 23 Admitted Female F 24 |
| 24 Rejected Female F 317 |
| > tools::assertError(# 'na.fail' should fail : |
| + xtabs(Freq ~ Gender + Admit, DN, na.action=na.fail)) |
| > xtabs(Freq ~ Gender + Admit, DN) |
| Admit |
| Gender Admitted Rejected |
| Male 1078 1286 |
| Female 540 1270 |
| > xtabs(Freq ~ Gender + Admit, DN, na.action = na.pass) |
| Admit |
| Gender Admitted Rejected |
| Male 1078 1286 |
| Female 540 |
| > ## The Female:Rejected combination has NA 'Freq' (and NA prints 'invisibly' as "") |
| > xtabs(Freq ~ Gender + Admit, DN, addNA = TRUE) # ==> count NAs |
| Admit |
| Gender Admitted Rejected <NA> |
| Male 1078 1286 327 |
| Female 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 9 |
| wool tension |
| A L 26 30 54 25 70 52 51 26 67 |
| M 18 21 29 17 12 18 35 30 36 |
| H 36 21 24 18 10 43 28 15 26 |
| B L 27 14 29 19 29 31 41 20 44 |
| M 42 26 19 16 39 28 21 39 29 |
| H 20 21 24 17 13 15 15 16 28 |
| > |
| > ### ---- Sparse Examples ---- |
| > |
| > |
| > |
| > |
| > 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 Residuals |
| Sum of Squares 450.667 1950.694 83.565 6747.889 |
| Deg. of Freedom 1 1 1 50 |
| |
| Residual standard error: 11.61713 |
| 1 out of 5 effects not estimable |
| Estimated effects may be unbalanced |
| > |
| > ## show the use of ... The default contrast is contr.treatment here |
| > summary(lm(breaks ~ wool + C(tension, base = 2), data = warpbreaks)) |
| |
| Call: |
| lm(formula = breaks ~ wool + C(tension, base = 2), data = warpbreaks) |
| |
| Residuals: |
| Min 1Q Median 3Q Max |
| -19.500 -8.083 -2.139 6.472 30.722 |
| |
| Coefficients: |
| Estimate Std. Error t value Pr(>|t|) |
| (Intercept) 29.278 3.162 9.260 2e-12 *** |
| woolB -5.778 3.162 -1.827 0.0736 . |
| C(tension, base = 2)1 10.000 3.872 2.582 0.0128 * |
| C(tension, base = 2)3 -4.722 3.872 -1.219 0.2284 |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| Residual standard error: 11.62 on 50 degrees of freedom |
| Multiple R-squared: 0.2691, Adjusted R-squared: 0.2253 |
| F-statistic: 6.138 on 3 and 50 DF, p-value: 0.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.0421 |
| |
| Coefficients: |
| Estimate Std. Error z value Pr(>|z|) |
| (Intercept) -1.72420 0.19582 -8.805 < 2e-16 *** |
| agegp.L 2.96113 0.65092 4.549 5.39e-06 *** |
| agegp.Q -1.33735 0.58918 -2.270 0.02322 * |
| agegp.C 0.15292 0.44792 0.341 0.73281 |
| agegp^4 0.06668 0.30776 0.217 0.82848 |
| agegp^5 -0.20288 0.19523 -1.039 0.29872 |
| C(tobgp, , 1).L 0.58501 0.18331 3.191 0.00142 ** |
| C(alcgp, , 1).L 1.46034 0.18899 7.727 1.10e-14 *** |
| --- |
| Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 |
| |
| (Dispersion parameter for binomial family taken to be 1) |
| |
| Null deviance: 227.241 on 87 degrees of freedom |
| Residual deviance: 59.277 on 80 degrees of freedom |
| AIC: 222.76 |
| |
| Number of Fisher Scoring iterations: 6 |
| |
| > |
| > |
| > |
| > 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: 6.32 0.204 6.808 0 0 |
| > grDevices::dev.off() |
| null device |
| 1 |
| > ### |
| > ### Local variables: *** |
| > ### mode: outline-minor *** |
| > ### outline-regexp: "\\(> \\)?### [*]+" *** |
| > ### End: *** |
| > quit('no') |
