[Rd] reg-tests-1 failing in Ubuntu 9.10

From: Paul Gilbert <pgilbert_at_bank-banque-canada.ca>
Date: Mon, 02 Nov 2009 10:37:02 -0500


I upgraded one of my computers to Ubuntu 9.10 (Karmic) and when I do make check with R-2.10.0 reg-tests-1 is failing. The file reg-tests-1.Rout.fail is attached. I am having difficulty distinguishing what causes the error. Any suggestions would be appreciated.

Paul


La version française suit le texte anglais.


This email may contain privileged and/or confidential information, and the Bank of Canada does not waive any related rights. Any distribution, use, or copying of this email or the information it contains by other than the intended recipient is unauthorized. If you received this email in error please delete it immediately from your system and notify the sender promptly by email that you have done so.


Le présent courriel peut contenir de l'information privilégiée ou confidentielle. La Banque du Canada ne renonce pas aux droits qui s'y rapportent. Toute diffusion, utilisation ou copie de ce courriel ou des renseignements qu'il contient par une personne autre que le ou les destinataires désignés est interdite. Si vous recevez ce courriel par erreur, veuillez le supprimer immédiatement et envoyer sans délai à l'expéditeur un message électronique pour l'aviser que vous avez éliminé de votre ordinateur toute copie du courriel reçu.

R version 2.10.0 (2009-10-26)
Copyright (C) 2009 The R Foundation for Statistical Computing ISBN 3-900051-07-0 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors. Type 'contributors()' for more information 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.

> postscript("reg-tests-1.ps", encoding = "ISOLatin1.enc")
>
> ## force standard handling for data frames
> options(stringsAsFactors=TRUE)
> ## .Machine
> (Meps <- .Machine$double.eps)# and use it in this file
[1] 2.220446e-16
>
> assertError <- function(expr)

+ stopifnot(inherits(try(expr, silent = TRUE), "try-error"))
> assertWarning <- function(expr)

+ stopifnot(inherits(tryCatch(expr, warning = function(w)w), "warning"))
> assertWarning_atleast <- function(expr) {

+     r <- tryCatch(expr, warning = function(w)w, error = function(e)e)
+     stopifnot(inherits(r, "warning") || inherits(r, "error"))
+ }

>
> ## regression test for PR#376
> aggregate(ts(1:20), nfreq=1/3)

Time Series:
Start = 1
End = 16
Frequency = 0.333333333333333
[1] 6 15 24 33 42 51
> ## Comments: moved from aggregate.Rd
>
>
> ## aperm
> # check the names
> x <- array(1:24, c(4, 6))
> nms <- list(happy=letters[1:4], sad=LETTERS[1:6])
>
> dimnames(x) <- nms
> tmp <- aperm(x, c(2, 1))
> stopifnot(all.equal(dimnames(tmp), nms[c(2, 1)]))
>
> dimnames(x) <- c(nms[1], list(NULL))
> tmp <- aperm(x, c(2, 1))
> stopifnot(all.equal(dimnames(tmp), c(list(NULL), nms[1])))
>
> names(nms) <- c("happy", "sad")
> dimnames(x) <- nms
> tmp <- aperm(x, c(2, 1))
> stopifnot(all.equal(names(dimnames(tmp)), names(nms[c(2, 1)])))
>
> dimnames(x) <- c(nms[1], list(NULL))
> tmp <- aperm(x, c(2, 1))
> stopifnot(all.equal(names(dimnames(tmp)), c("", names(nms)[1])))
>
> # check resize
> stopifnot(dim(aperm(x, c(2, 1), FALSE)) == dim(x))
> stopifnot(is.null(dimnames(aperm(x, c(2, 1), FALSE))))
>
> # check the types
> x <- array(1:24, c(4, 6))
> stopifnot(all.equal(aperm(x, c(2, 1)), t(x)))
> stopifnot(is.integer(aperm(x, c(2, 1))))
>
> x <- x + 0.0
> stopifnot(all.equal(aperm(x, c(2, 1)), t(x)))
> stopifnot(is.double(aperm(x, c(2, 1))))
>
> x <- x + 0.0i
> stopifnot(all.equal(aperm(x, c(2, 1)), t(x)))
>
> x[] <- LETTERS[1:24]
> stopifnot(all.equal(aperm(x, c(2, 1)), t(x)))
>
> x <- array(list("fred"), c(4, 6))
> x[[3, 4]] <- 1:10
> stopifnot(all.equal(aperm(x, c(2, 1)), t(x)))
> ## end of moved from aperm.Rd
>
>
> ## append
> stopifnot(append(1:5, 0:1, after=3) == append(1:3, c(0:1, 4:5)))
> ## end of moved from append.Rd
>
>
> ## array
> # funny object, but whatever was the point of that?
> utils::str(array(1:3, 0))

 int[0 (1d)]
> ## end of moved from array.Rd
>
>
> ## as.POSIXlt
> z <- Sys.time()
> stopifnot(range(z) == z,
+ 	  min(z) == z,
+ 	  max(z) == z,
+ 	  mean(z) == z)

> ## end of moved from as.POSIXlt.Rd
>
>
> ## autoload
> stopifnot(ls("Autoloads") == ls(envir = .AutoloadEnv))
> ## end of moved from autoload.Rd
>
>
> ## axis
> Y <- c(10.50, 4.0, 13.75, 7.25)
> plot(1:4, Y, xlim=c(0,5), ylim=c(0,15))
> axis(side=4, at=Y, labels=LETTERS[1:4])
> ## end of moved from axis.Rd
>
>
> ## backsolve
> r <- rbind(c(1,2,3),
+ 	   c(0,1,1),
+ 	   c(0,0,2))

> ( y <- backsolve(r, x <- c(8,4,2)) ) # -1 3 1
[1] -1 3 1
> r %*% y # == x = (8,4,2)

     [,1]

[1,]    8
[2,]    4
[3,]    2

> ( y2 <- backsolve(r, x, transpose = TRUE)) # 8 -12 -5
[1] 8 -12 -5
> stopifnot(all.equal(drop(t(r) %*% y2), x))
> stopifnot(all.equal(y, backsolve(t(r), x, upper = FALSE, transpose = TRUE)))
> stopifnot(all.equal(y2, backsolve(t(r), x, upper = FALSE, transpose = FALSE)))
> ## end of moved from backsolve.Rd
>
>
> ## basename
> dirname(character(0))

character(0)
> ## end of moved from basename.Rd
>
>
> ## Bessel
> ## Check the Scaling :
> nus <- c(0:5,10,20)
> x <- seq(0,40,len=801)[-1]
> for(nu in nus)

+ stopifnot(abs(1- besselK(x,nu)*exp( x) / besselK(x,nu,expo=TRUE)) < 2e-15)
> for(nu in nus)

+ stopifnot(abs(1- besselI(x,nu)*exp(-x) / besselI(x,nu,expo=TRUE)) < 1e-15)
> ## end of moved from Bessel.Rd
>
>
> ## c
> ll <- list(A = 1, c="C")
> stopifnot(identical(c(ll, d=1:3), c(ll, as.list(c(d=1:3)))))
> ## moved from c.Rd
>
>
> ## Cauchy
> stopifnot(all.equal(dcauchy(-1:4), 1 / (pi*(1 + (-1:4)^2))))
> ## end of moved from Cauchy.Rd
>
>
> ## chol
> ( m <- matrix(c(5,1,1,3),2,2) )

     [,1] [,2]
[1,] 5 1
[2,] 1 3
> ( cm <- chol(m) )

         [,1] [,2]
[1,] 2.236068 0.4472136
[2,] 0.000000 1.6733201
> stopifnot(abs(m - t(cm) %*% cm) < 100* Meps)
>
> ## check with pivoting
> ( m <- matrix(c(5,1,1,3),2,2) )

     [,1] [,2]
[1,] 5 1
[2,] 1 3
> ( cm <- chol(m, TRUE) )

         [,1] [,2]
[1,] 2.236068 0.4472136
[2,] 0.000000 1.6733201
attr(,"pivot")
[1] 1 2
attr(,"rank")
[1] 2
> stopifnot(abs(m - t(cm) %*% cm) < 100* Meps)
>
> x <- matrix(c(1:5, (1:5)^2), 5, 2)
> m <- crossprod(x)
> Q <- chol(m)
> stopifnot(all.equal(t(Q) %*% Q, m))
>
> Q <- chol(m, pivot = TRUE)
> pivot <- attr(Q, "pivot")
> oo <- order(pivot)
> stopifnot(all.equal(t(Q[, oo]) %*% Q[, oo], m))
> stopifnot(all.equal(t(Q) %*% Q, m[pivot, pivot]))
>
> # now for something positive semi-definite
> x <- cbind(x, x[, 1]+3*x[, 2])
> m <- crossprod(x)
> qr(m)$rank # is 2, as it should be

[1] 2
>
> (Q <- chol(m, pivot = TRUE)) # NB wrong rank here ... see Warning section.

         [,1] [,2] [,3]

[1,] 101.0742 7.222415  3.128394e+01
[2,]   0.0000 1.684259 -5.614195e-01
[3,]   0.0000 0.000000  2.092056e-07

attr(,"pivot")
[1] 3 1 2
attr(,"rank")
[1] 3
> pivot <- attr(Q, "pivot")
> oo <- order(pivot)
> stopifnot(all.equal(t(Q[, oo]) %*% Q[, oo], m))
> stopifnot(all.equal(t(Q) %*% Q, m[pivot, pivot]))
> ## end of moved from chol.Rd
>
>
> ## chol2inv
> cma <- chol(ma <- cbind(1, 1:3, c(1,3,7)))
> stopifnot(all.equal(diag(3), ma %*% chol2inv(cma)))
> ## end of moved from chol2inv.Rd
>
>
> ## col2rgb
> pp <- palette(); names(pp) <- pp # add & use names :
> stopifnot(col2rgb(1:8) == print(col2rgb(pp)))
      black red green3 blue cyan magenta yellow gray
red       0 255      0    0    0     255    255  190
green     0   0    205    0  255       0    255  190
blue      0   0      0  255  255     255      0  190

> stopifnot(col2rgb("#08a0ff") == c(8, 160, 255))
> grC <- col2rgb(paste("gray",0:100,sep=""))
> stopifnot(grC["red",] == grC["green",],
+ 	  grC["red",] == grC["blue",],
+ 	  grC["red", 1:4] == c(0,3,5,8))

> ## end of moved from col2rgb.Rd
>
>
> ## colnames
> m0 <- matrix(NA, 4, 0)
> rownames(m0, do.NULL = FALSE)

[1] "row1" "row2" "row3" "row4"
> colnames(m0, do.NULL = FALSE)

character(0)
> ## end of moved from colnames.Rd
>
>
> ## Constants
> stopifnot(
+  nchar(letters) == 1,
+  month.abb == substr(month.name, 1, 3)
+ )

>
> stopifnot(all.equal(pi, 4*atan(1), tol= 2*Meps))
>
> # John Machin (1705) computed 100 decimals of pi :
> stopifnot(all.equal(pi/4, 4*atan(1/5) - atan(1/239), 4*Meps))
> ## end of moved from Constants.Rd
>
>
> ## cor
> stopifnot( is.na(var(1)),

+ !is.nan(var(1)))
>
> zz <- c(-1.30167, -0.4957, -1.46749, 0.46927)
> r <- cor(zz,zz); r - 1

[1] 0
> stopifnot(r <= 1) # fails in R <= 1.3.x, for versions of Linux and Solaris
> ## end of moved from cor.Rd
> ## Spearman correlations ranked missing values at end <= 1.8.1
> X <- cbind(c(1,3,4,NA),c(1,4,2,NA))
> X1 <- X[-4,]
> stopifnot(all.equal(cor(X,X,method="spearman",use="complete"),
+                     cor(X1,X1,method="spearman",use="complete")))

> stopifnot(all.equal(cov(X,X,method="spearman",use="complete"),
+ cov(X1,X1,method="spearman",use="complete")))

>
> ## DateTimeClasses
> (dls <- .leap.seconds[-1] - .leap.seconds[-22])
Time differences in secs
 [1] 15897600 31536000 31536000 31536000 31622400 31536000 31536000 31536000
 [9] 47260800 31536000 31536000 63158400 78969600 63158400 31536000 47260800
[17] 31536000 31536000 47433600 47260800 47433600        0        0

> table(dls)

dls
       0 15897600 31536000 31622400 47260800 47433600 63158400 78969600 
       2        1       11        1        3        2        2        1 

> ## end of moved from DateTimeClasses.Rd
>
>
> ## deriv
> trig.exp <- expression(sin(cos(x + y^2)))
> D.sc <- D(trig.exp, "x")
> dxy <- deriv(trig.exp, c("x", "y"))
> y <- 1
> stopifnot(eval(D.sc) ==

+ attr(eval(dxy),"gradient")[,"x"])
> ff <- y ~ sin(cos(x) * y)
> stopifnot(all.equal(deriv(ff, c("x","y"), func = TRUE ),
+ deriv(ff, c("x","y"), func = function(x,y){ } )))
> ## end of moved from deriv.Rd
>
>
> ## diff
> x <- cumsum(cumsum(1:10))
> stopifnot(diff(x, lag = 2) == x[(1+2):10] - x[1:(10 - 2)],
+ 	  diff(x, lag = 2) == (3:10)^2,
+ 	  diff(diff(x))	   == diff(x, differences = 2))

> ## end of moved from diff.Rd
>
>
> ## duplicated
> x <- c(9:20, 1:5, 3:7, 0:8)
> ## extract unique elements
> (xu <- x[!duplicated(x)])

 [1] 9 10 11 12 13 14 15 16 17 18 19 20 1 2 3 4 5 6 7 0 8
> stopifnot(xu == unique(x), # but unique(x) is more efficient
+ 0:20 == sort(x[!duplicated(x)]))
>
> stopifnot(duplicated(iris)[143] == TRUE)
> ## end of moved from duplicated.Rd
>
>
> ## eigen
> set.seed(321, kind = "default") # force a particular seed
> m <- matrix(round(rnorm(25),3), 5,5)
> sm <- m + t(m) #- symmetric matrix
> em <- eigen(sm); V <- em$vect
> print(lam <- em$values) # ordered DEcreasingly
[1] 5.1738946 3.1585064 0.6849974 -1.6299494 -2.5074489
>
> stopifnot(
+  abs(sm %*% V - V %*% diag(lam))	  < 60*Meps,
+  abs(sm	      - V %*% diag(lam) %*% t(V)) < 60*Meps)

>
> ##------- Symmetric = FALSE: -- different to above : ---
>
> em <- eigen(sm, symmetric = FALSE); V2 <- em$vect
> print(lam2 <- em$values) # ordered decreasingly in ABSolute value !
[1] 5.1738946 3.1585064 -2.5074489 -1.6299494 0.6849974
> print(i <- rev(order(lam2)))

[1] 1 2 5 4 3
> stopifnot(abs(lam - lam2[i]) < 100 * Meps) # comparing two solns
>
> zapsmall(Diag <- t(V2) %*% V2)

     [,1] [,2] [,3] [,4] [,5]

[1,]    1    0    0    0    0
[2,]    0    1    0    0    0
[3,]    0    0    1    0    0
[4,]    0    0    0    1    0
[5,]    0    0    0    0    1

> stopifnot( abs(1- diag(Diag)) < 60*Meps)
>
> stopifnot(abs(sm %*% V2 - V2 %*% diag(lam2)) < 60*Meps,
+ abs(sm - V2 %*% diag(lam2) %*% t(V2)) < 60*Meps)
>
> ## Re-ordered as with symmetric:
> sV <- V2[,i]
> slam <- lam2[i]
> stopifnot(abs(sm %*% sV - sV %*% diag(slam)) < 60*Meps)
> stopifnot(abs(sm - sV %*% diag(slam) %*% t(sV)) < 60*Meps)
> ## sV *is* now equal to V -- up to sign (+-) and rounding errors
> stopifnot(abs(c(1 - abs(sV / V))) < 1000*Meps)
> ## end of moved from eigen.Rd
>
>
> ## euro
> stopifnot(euro == signif(euro,6), euro.cross == outer(1/euro, euro))
> ## end of moved from euro.Rd
>
>
> ## Exponential
> r <- rexp(100)
> stopifnot(abs(1 - dexp(1, r) / (r*exp(-r))) < 1e-14)
> ## end of moved from Exponential.Rd
>
>
> ## family
> gf <- Gamma()
> stopifnot(1:10 == gf$linkfun(gf$linkinv(1:10)))
> ## end of moved from family.Rd
>
>
> ## fft
> set.seed(123)
> eps <- 1e-10 # typically see around 1e-11
> for(N in 1:130) {
+     x <- rnorm(N)
+     if(N %% 5 == 0) {
+ 	m5 <- matrix(x,ncol=5)
+ 	stopifnot(apply(m5,2,fft) == mvfft(m5))
+     }
+     dd <- Mod(1 - (f2 <- fft(fft(x), inverse=TRUE)/(x*length(x))))
+     stopifnot(dd < eps)
+ }

> ## end of moved from fft.Rd
>
>
> ## findint
> N <- 100
> X <- sort(round(rt(N, df=2), 2))
> tt <- c(-100, seq(-2,2, len=201), +100)
> it <- findInterval(tt, X)
>
> ## See that this is N * Fn(.) :
> tt <- c(tt,X)
> stopifnot(it[c(1,203)] == c(0, 100),
+ 	  all.equal(N * stats::ecdf(X)(tt),
+ 		    findInterval(tt, X),  tol = 100 * Meps),
+ 	  findInterval(tt,X) ==	 apply( outer(tt, X, ">="), 1, sum)
+ 	  )

> ## end of moved from findint.Rd
> ## NA & Inf's :
> tt[ina <- c(2,3,5,7)] <- NA
> tt[300] <- Inf
> X <- c(-Inf, X, Inf)
> it <- findInterval(tt,X)
> stopifnot(identical(it, as.integer(rowSums(outer(tt, X, ">=")))),
+ is.na(it[ina]))
>
>
> ## fix
> oo <- options(editor="touch") # not really changing anything
> fix(pi)
> if(!is.numeric(pi) || length(pi)!=1 ||
+ !is.null(attributes(pi)) || abs(pi - 3.1415) > 1e-4) + stop("OOPS: fix() is broken ...")
> rm(pi); options(oo)
> ## end of moved from fix.Rd
>
>
> ## format
> (dd <- sapply(1:10, function(i)paste((9:0)[1:i],collapse="")))
 [1] "9"          "98"         "987"        "9876"       "98765"     
 [6] "987654"     "9876543"    "98765432"   "987654321"  "9876543210"

> np <- nchar(pd <- prettyNum(dd, big.mark="'"))
> stopifnot(sapply(0:2, function(m)

+ all(grep("'", substr(pd, 1, np - 4*m)) == (4+3*m):10)))
> ## end of moved from format.Rd
>
>
> ## Geometric
> pp <- sort(c((1:9)/10, 1 - .2^(2:8)))
> print(qg <- qgeom(pp, prob = .2))

 [1] 0 0 1 2 3 4 5 7 10 14 21 28 36 43 50 57
> ## test that qgeom is an inverse of pgeom
> print(qg1 <- qgeom(pgeom(qg, prob=.2), prob =.2))
 [1] 0 0 1 2 3 4 5 7 10 14 21 28 36 43 50 57
> stopifnot(identical(qg, qg1))
> ## moved from Geometric.Rd
>
>
> ## glm
> ## these are the same -- example from Jim Lindsey
> y <- rnorm(20)
> y1 <- y[-1]; y2 <- y[-20]
> summary(g1 <- glm(y1 - y2 ~ 1))

Call:
glm(formula = y1 - y2 ~ 1)

Deviance Residuals:

     Min 1Q Median 3Q Max -1.49564 -0.47332 0.06862 0.43131 1.37700

Coefficients:

            Estimate Std. Error t value Pr(>|t|) (Intercept) 0.01213 0.17481 0.069 0.945

(Dispersion parameter for gaussian family taken to be 0.5806225)

    Null deviance: 10.451 on 18 degrees of freedom Residual deviance: 10.451 on 18 degrees of freedom AIC: 46.563 Number of Fisher Scoring iterations: 2

> summary(g2 <- glm(y1 ~ offset(y2)))

Call:
glm(formula = y1 ~ offset(y2))

Deviance Residuals:

     Min 1Q Median 3Q Max -1.49564 -0.47332 0.06862 0.43131 1.37700

Coefficients:

            Estimate Std. Error t value Pr(>|t|) (Intercept) 0.01213 0.17481 0.069 0.945

(Dispersion parameter for gaussian family taken to be 0.5806225)

    Null deviance: 10.451 on 18 degrees of freedom Residual deviance: 10.451 on 18 degrees of freedom AIC: 46.563 Number of Fisher Scoring iterations: 2

> Eq <- function(x,y) all.equal(x,y, tol = 1e-12)
> stopifnot(Eq(coef(g1), coef(g2)),

+ 	  Eq(deviance(g1), deviance(g2)),
+ 	  Eq(resid(g1), resid(g2)))

> ## from logLik.glm.Rd
> anorexia <-
+ structure(list(Treat = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 2L,
+ 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L,
+ 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
+ 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
+ 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L,
+ 3L), .Label = c("CBT", "Cont", "FT"), class = "factor"), Prewt = c(80.7,
+ 89.4, 91.8, 74, 78.1, 88.3, 87.3, 75.1, 80.6, 78.4, 77.6, 88.7,
+ 81.3, 78.1, 70.5, 77.3, 85.2, 86, 84.1, 79.7, 85.5, 84.4, 79.6,
+ 77.5, 72.3, 89, 80.5, 84.9, 81.5, 82.6, 79.9, 88.7, 94.9, 76.3,
+ 81, 80.5, 85, 89.2, 81.3, 76.5, 70, 80.4, 83.3, 83, 87.7, 84.2,
+ 86.4, 76.5, 80.2, 87.8, 83.3, 79.7, 84.5, 80.8, 87.4, 83.8, 83.3,
+ 86, 82.5, 86.7, 79.6, 76.9, 94.2, 73.4, 80.5, 81.6, 82.1, 77.6,
+ 83.5, 89.9, 86, 87.3), Postwt = c(80.2, 80.1, 86.4, 86.3, 76.1,
+ 78.1, 75.1, 86.7, 73.5, 84.6, 77.4, 79.5, 89.6, 81.4, 81.8, 77.3,
+ 84.2, 75.4, 79.5, 73, 88.3, 84.7, 81.4, 81.2, 88.2, 78.8, 82.2,
+ 85.6, 81.4, 81.9, 76.4, 103.6, 98.4, 93.4, 73.4, 82.1, 96.7,
+ 95.3, 82.4, 72.5, 90.9, 71.3, 85.4, 81.6, 89.1, 83.9, 82.7, 75.7,
+ 82.6, 100.4, 85.2, 83.6, 84.6, 96.2, 86.7, 95.2, 94.3, 91.5,
+ 91.9, 100.3, 76.7, 76.8, 101.6, 94.9, 75.2, 77.8, 95.5, 90.7,
+ 92.5, 93.8, 91.7, 98)), .Names = c("Treat", "Prewt", "Postwt"
+ ), class = "data.frame", row.names = 1:72)

> anorex.1 <- glm(Postwt ~ Prewt + Treat + offset(Prewt),
+ family = gaussian, data = anorexia)

> summary(anorex.1)

Call:
glm(formula = Postwt ~ Prewt + Treat + offset(Prewt), family = gaussian,

    data = anorexia)

Deviance Residuals:

     Min 1Q Median 3Q Max -14.1083 -4.2773 -0.5484 5.4838 15.2922

Coefficients:

            Estimate Std. Error t value Pr(>|t|)

(Intercept)  49.7711    13.3910   3.717 0.000410 ***
Prewt        -0.5655     0.1612  -3.509 0.000803 ***
TreatCont    -4.0971     1.8935  -2.164 0.033999 *  
TreatFT       4.5631     2.1333   2.139 0.036035 *  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 

(Dispersion parameter for gaussian family taken to be 48.69504)

    Null deviance: 4525.4  on 71  degrees of freedom
Residual deviance: 3311.3  on 68  degrees of freedom
AIC: 489.97

Number of Fisher Scoring iterations: 2


> Eq <- function(x,y) all.equal(x,y, tol = 1e-12)
> stopifnot(Eq(AIC(anorex.1), anorex.1$aic),
+ Eq(AIC(g1), g1$aic), + Eq(AIC(g2), g2$aic))
> ## next was wrong in 1.4.1
> x <- 1:10
> lmx <- logLik(lm(x ~ 1)); glmx <- logLik(glm(x ~ 1))
> stopifnot(all.equal(as.vector(lmx), as.vector(glmx)),
+ all.equal(attr(lmx, 'df'), attr(glmx, 'df')))
> ## end of moved from glm.Rd and logLik.glm.Rd
>
>
> ## Hyperbolic
> x <- seq(-3, 3, len=200)
> stopifnot(
+ abs(cosh(x) - (exp(x) + exp(-x))/2) < 20*Meps, + abs(sinh(x) - (exp(x) - exp(-x))/2) < 20*Meps, + Mod(cosh(x) - cos(1i*x)) < 20*Meps, + Mod(sinh(x) - sin(1i*x)/1i) < 20*Meps, + abs(tanh(x)*cosh(x) - sinh(x)) < 20*Meps + )
>
> stopifnot(abs(asinh(sinh(x)) - x) < 20*Meps)
> stopifnot(abs(acosh(cosh(x)) - abs(x)) < 1000*Meps) #- imprecise for small x
> stopifnot(abs(atanh(tanh(x)) - x) < 100*Meps)
>
> stopifnot(abs(asinh(x) - log(x + sqrt(x^2 + 1))) < 100*Meps)
> cx <- cosh(x)
> stopifnot(abs(acosh(cx) - log(cx + sqrt(cx^2 - 1))) < 1000*Meps)
> ## end of moved from Hyperbolic.Rd
>
>
> ## image
> ## Degenerate, should still work
> image(as.matrix(1))
> image(matrix(pi,2,4))
> x <- seq(0,1,len=100)
> image(x, 1, matrix(x), col=heat.colors(10))
> image(x, 1, matrix(x), col=heat.colors(10), oldstyle = TRUE)
> image(x, 1, matrix(x), col=heat.colors(10), breaks = seq(0.1,1.1,len=11))
> ## end of moved from image.Rd
>
>
> ## integrate
> (ii <- integrate(dnorm, -1.96, 1.96))
0.9500042 with absolute error < 1.0e-11
> (i1 <- integrate(dnorm, -Inf, Inf))
1 with absolute error < 9.4e-05
> stopifnot(all.equal(0.9500042097, ii$val, tol = ii$abs.err, scale=1),
+ all.equal( 1, i1$val, tol = i1$abs.err, scale=1))
>
> integrand <- function(x) {1/((x+1)*sqrt(x))}
> (ii <- integrate(integrand, lower = 0, upper = Inf, rel.tol = 1e-10))
3.141593 with absolute error < 4.7e-13
> stopifnot(all.equal(pi, ii$val, tol = ii$abs.err, scale=1))
> ## end of moved from integrate.Rd
>
>
> ## is.finite
> ( weird.values <- c(-20.9/0, 1/0, 0/0, NA) )
[1] -Inf Inf NaN NA
>
> Mmax <- .Machine$double.xmax
> Mmin <- .Machine$double.xmin
> ( X.val <- c(Mmin*c(2^(-10:3),1e5,1e10),
+ Mmax*c(1e-10,1e-5,2^(-3:0),1.001)) ) [1] 2.172924e-311 4.345847e-311 8.691695e-311 1.738339e-310 3.476678e-310 [6] 6.953356e-310 1.390671e-309 2.781342e-309 5.562685e-309 1.112537e-308 [11] 2.225074e-308 4.450148e-308 8.900295e-308 1.780059e-307 2.225074e-303 [16] 2.225074e-298 1.797693e+298 1.797693e+303 2.247116e+307 4.494233e+307 [21] 8.988466e+307 1.797693e+308 Inf
> ( tst.val <- sort(c(X.val, weird.values), na.last = TRUE) )
[1] -Inf 2.172924e-311 4.345847e-311 8.691695e-311 1.738339e-310 [6] 3.476678e-310 6.953356e-310 1.390671e-309 2.781342e-309 5.562685e-309 [11] 1.112537e-308 2.225074e-308 4.450148e-308 8.900295e-308 1.780059e-307 [16] 2.225074e-303 2.225074e-298 1.797693e+298 1.797693e+303 2.247116e+307 [21] 4.494233e+307 8.988466e+307 1.797693e+308 Inf Inf [26] NaN NA
> ( x2 <- c(-1:1/0,pi,1,NA) )
[1] -Inf NaN Inf 3.141593 1.000000 NA
> ( z2 <- c(x2, 1+1i, Inf -Inf* 1i) )
[1] -Inf+ 0i NaN+ 0i Inf+ 0i 3.141593+ 0i 1.000000+ 0i [6] NA 1.000000+ 1i NaN-Infi
>
> is.inf <-
+ function(x) (is.numeric(x) || is.complex(x)) && !is.na(x) && !is.finite(x)
>
> for(x in list(tst.val, x2, z2))
+ print(cbind(format(x), is.infinite=format(is.infinite(x))), quote=FALSE) is.infinite [1,] -Inf TRUE [2,] 2.172924e-311 FALSE [3,] 4.345847e-311 FALSE [4,] 8.691695e-311 FALSE [5,] 1.738339e-310 FALSE [6,] 3.476678e-310 FALSE [7,] 6.953356e-310 FALSE [8,] 1.390671e-309 FALSE [9,] 2.781342e-309 FALSE [10,] 5.562685e-309 FALSE [11,] 1.112537e-308 FALSE [12,] 2.225074e-308 FALSE [13,] 4.450148e-308 FALSE [14,] 8.900295e-308 FALSE [15,] 1.780059e-307 FALSE [16,] 2.225074e-303 FALSE [17,] 2.225074e-298 FALSE [18,] 1.797693e+298 FALSE [19,] 1.797693e+303 FALSE [20,] 2.247116e+307 FALSE [21,] 4.494233e+307 FALSE [22,] 8.988466e+307 FALSE [23,] 1.797693e+308 FALSE [24,] Inf TRUE [25,] Inf TRUE [26,] NaN FALSE [27,] NA FALSE is.infinite [1,] -Inf TRUE [2,] NaN FALSE [3,] Inf TRUE [4,] 3.141593 FALSE [5,] 1.000000 FALSE [6,] NA FALSE is.infinite [1,] -Inf+ 0i TRUE [2,] NaN+ 0i FALSE [3,] Inf+ 0i TRUE [4,] 3.141593+ 0i FALSE [5,] 1.000000+ 0i FALSE [6,] NA FALSE [7,] 1.000000+ 1i FALSE [8,] NaN-Infi TRUE
>
> rbind(is.nan(tst.val),
+ is.na (tst.val)) [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [1,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [2,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [,13] [,14] [,15] [,16] [,17] [,18] [,19] [,20] [,21] [,22] [,23] [,24] [1,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [2,] FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE FALSE [,25] [,26] [,27] [1,] FALSE TRUE FALSE [2,] FALSE TRUE TRUE
> tst.val [ is.nan(tst.val) != is.na(tst.val) ]
[1] NA
>
> stopifnot(
+ is.na(0/0), + !is.na(Inf), + is.nan(0/0), + + !is.nan(NA) && !is.infinite(NA) && !is.finite(NA), + is.nan(NaN) && !is.infinite(NaN) && !is.finite(NaN), + !is.nan(c(1,NA)), + c(FALSE,TRUE,FALSE) == is.nan(c (1,NaN,NA)), + c(FALSE,TRUE,FALSE) == is.nan(list(1,NaN,NA))#-> FALSE in older versions + )
>
> stopifnot(identical(lgamma(Inf), Inf))
Warning message: In identical(lgamma(Inf), Inf) : value out of range in 'lgamma'
> stopifnot(identical(Inf + Inf, Inf))
> stopifnot(identical(Inf - Inf, NaN))
> stopifnot(identical((1/0) * (1/0), Inf))
> stopifnot(identical((1/0) / (1/0), NaN))
> stopifnot(identical(exp(-Inf), 0))
> stopifnot(identical(log(0), -Inf))
> stopifnot(identical((-1)/0, -Inf))
> pm <- c(-1,1) # 'pm' = plus/minus
> stopifnot(atan(Inf*pm) == pm*pi/2)
> ## end of moved from is.finite.Rd
>
>
> ## kronecker
> ( M <- matrix(1:6, ncol=2) )
[,1] [,2] [1,] 1 4 [2,] 2 5 [3,] 3 6
> stopifnot(kronecker(4, M)==4 * M)
> # Block diagonal matrix:
> stopifnot(kronecker(diag(1, 3), M) == diag(1, 3) %x% M)
> ## end of moved from kronecker.Rd
>
>
> ## list
> str(pl <- as.pairlist(ps.options()))
Dotted pair list of 18 $ onefile : logi TRUE $ family : chr "Helvetica" $ title : chr "R Graphics Output" $ fonts : NULL $ encoding : chr "default" $ bg : chr "transparent" $ fg : chr "black" $ width : num 0 $ height : num 0 $ horizontal : logi TRUE $ pointsize : num 12 $ paper : chr "default" $ pagecentre : logi TRUE $ print.it : logi FALSE $ command : chr "default" $ colormodel : chr "rgb" $ useKerning : logi TRUE $ fillOddEven: logi FALSE
>
> ## These are all TRUE:
> stopifnot(is.list(pl) && is.pairlist(pl),
+ !is.null(list()), + is.null(pairlist()), + !is.list(NULL), + is.pairlist(pairlist()), + is.null(as.pairlist(list())), + is.null(as.pairlist(NULL)) + )
> ## end of moved from list.Rd
>
>
> ## log
> stopifnot(all.equal(log(1:10), log(1:10, exp(1))))
> stopifnot(all.equal(log10(30), log(30, 10)))
> stopifnot(all.equal(log2(2^pi), 2^log2(pi)))
> stopifnot(Mod(pi - log(exp(pi*1i)) / 1i) < 10* Meps)
> stopifnot(Mod(1+exp(pi*1i)) < 10* Meps)
> ## end of moved from Log.Rd
>
>
> ## logistic
> eps <- 100 * Meps
> x <- c(0:4, rlogis(100))
> stopifnot(all.equal(plogis(x), 1 / (1 + exp(-x)), tol = eps))
> stopifnot(all.equal(plogis(x, lower=FALSE), exp(-x)/ (1 + exp(-x)), tol = eps))
> stopifnot(all.equal(plogis(x, lower=FALSE, log=TRUE), -log(1 + exp(x)),
+ tol = eps))
> stopifnot(all.equal(dlogis(x), exp(x) * (1 + exp(x))^-2, tol = eps))
> ## end of moved from Logistic.Rd
>
>
> ## Lognormal
> x <- rlnorm(1000) # not yet always :
> stopifnot(abs(x - qlnorm(plnorm(x))) < 1e4 * Meps * x)
> ## end of moved from Lognormal.Rd
>
>
> ## lower.tri
> ma <- matrix(1:20, 4, 5)
> stopifnot(lower.tri(ma) == !upper.tri(ma, diag=TRUE))
> ## end of moved from lower.tri.Rd
>
>
> ## make.names
> stopifnot(make.names(letters) == letters)
> ## end of make.names
>
>
> ## mean
> x <- c(0:10, 50)
> stopifnot(all.equal(mean(x, trim = 0.5), median(x)))
> ## moved from mean.Rd
>
>
> ## Multinom
> N <- 20
> pr <- c(1,3,6,10) # normalization not necessary for generation
> set.seed(153)
> rr <- rmultinom(5000, N, prob = pr)
> stopifnot(colSums(rr) == N)
> (m <- rowMeans(rr))
[1] 0.9952 2.9802 6.0382 9.9864
> all.equal(m, N * pr/sum(pr)) # rel.error ~0.003
[1] "Mean relative difference: 0.00382"
> stopifnot(max(abs(m/(N*pr/sum(pr)) - 1)) < 0.01)
>
> (Pr <- dmultinom(c(0,0,3), prob = c(1, 1, 14)))
[1] 0.6699219
> stopifnot(all.equal(Pr, dbinom(3, 3, p = 14/16)))
>
> X <- t(as.matrix(expand.grid(0:3, 0:3)))
> X <- X[, colSums(X) <= 3]
> X <- rbind(X, 3:3 - colSums(X))
> for(p in list(c(1,2,5), 1:3, 3:1, 2:0, 0:2, c(1,2,1), c(0,0,1))) {
+ px <- apply(X, 2, function(x) dmultinom(x, prob = p)) + stopifnot(all.equal(sum(px), 1)) + }
> ## end of moved from Multinom.Rd
>
>
> ## Poisson
> dpois(c(0, 1, 0.17, 0.77), 1)
[1] 0.3678794 0.3678794 0.0000000 0.0000000 Warning messages: 1: In dpois(c(0, 1, 0.17, 0.77), 1) : non-integer x = 0.170000 2: In dpois(c(0, 1, 0.17, 0.77), 1) : non-integer x = 0.770000
> ## end of moved from Poisson.Rd
>
>
> ## qr
> ## tests of complex case
> set.seed(1)
> A <- matrix(rnorm(25), 5, 5, dimnames=list(1:5, letters[1:5]))
> qr.solve(A, 1:5)
a b c d e 3.795761 -7.034826 -7.390881 6.397972 9.866288
> A[] <- as.complex(A)
> qr.coef(qr(A), 1:5)
[1] 3.795761+0i -7.034826+0i -7.390881+0i 6.397972+0i 9.866288+0i
> qr.solve(A, 1:5)
[1] 3.795761+0i -7.034826+0i -7.390881+0i 6.397972+0i 9.866288+0i
>
> ## check for rank-deficient cases
> X <- cbind(1:3, 1:3, 1)
> stopifnot(all.equal(qr.X(qr(X)), X))
> ## end of moved from qr.Rd
>
>
> ## qraux
> p <- ncol(x <- LifeCycleSavings[,-1]) # not the `sr'
> qrstr <- qr(x) # dim(x) == c(n,p)
> Q <- qr.Q(qrstr) # dim(Q) == dim(x)
> R <- qr.R(qrstr) # dim(R) == ncol(x)
> X <- qr.X(qrstr) # X == x
> stopifnot(all.equal(X, as.matrix(x)))
>
> ## X == Q %*% R :
> stopifnot((1 - X /( Q %*% R))< 100*Meps)
>
> dim(Qc <- qr.Q(qrstr, complete=TRUE)) # Square: dim(Qc) == rep(nrow(x),2)
[1] 50 50
> stopifnot((crossprod(Qc) - diag(nrow(x))) < 10*Meps)
>
> QD <- qr.Q(qrstr, D=1:p) # QD == Q \%*\% diag(1:p)
> stopifnot(QD - Q %*% diag(1:p) < 8* Meps)
>
> dim(Rc <- qr.R(qrstr, complete=TRUE)) # == dim(x)
[1] 50 4
> dim(Xc <- qr.X(qrstr, complete=TRUE)) # square: nrow(x) ^ 2
[1] 50 50
> dimnames(X) <- NULL
> stopifnot(all.equal(Xc[,1:p], X))
> ## end of moved from qraux.Rd
>
>
> ## quantile
> x <- rnorm(1001)
> n <- length(x) ## the following is exact, because 1/(1001-1) is exact:
> stopifnot(sort(x) == quantile(x, probs = ((1:n)-1)/(n-1), names=FALSE))
>
> n <- 777
> ox <- sort(x <- round(rnorm(n),1))# round() produces ties
> ox <- c(ox, ox[n]) #- such that ox[n+1] := ox[n]
> p <- c(0,1,runif(100))
> i <- floor(r <- 1 + (n-1)*p)
> f <- r - i
> stopifnot(abs(quantile(x,p) - ((1-f)*ox[i] + f*ox[i+1])) < 20*Meps)
> ## end of moved from quantile.Rd
>
>
> ## rep
> stopifnot(identical(rep(letters, 0), character(0)),
+ identical(rep.int(1:2, 0), integer(0)))
> ## end of moved from rep.Rd
>
>
> ## Round
> x1 <- seq(-2, 4, by = .5)
> non.int <- ceiling(x1) != floor(x1)
> stopifnot(
+ trunc(x1) == as.integer(x1), + non.int == (ceiling(x1) != trunc(x1) | trunc(x1) != floor(x1)), + (signif(x1, 1) != round(x1,1)) == (non.int & abs(x1) > 1) + )
> ## end of moved from Round.Rd
>
>
> ## seq
> stopifnot(
+ 3 == seq(3,3, by=pi), + 3 == seq(3,3.1,by=pi), + seq(1,6,by=3) == c(1,4), + seq(10,4.05,by=-3) == c(10,7) + )
> ## end of moved from seq.Rd
>
>
> ## sort
> x <- swiss$Education[1:25]
> stopifnot(!is.unsorted(sort(x)),
+ !is.unsorted(LETTERS), + is.unsorted(c(NA,1:3,2), na.rm = TRUE))
>
> for(n in 1:20) {
+ z <- rnorm(n) + for(x in list(z, round(z,1))) { ## 2nd one has ties + qxi <- sort(x, method = "quick", index.return = TRUE) + stopifnot(qxi$x == sort(x, method = "shell"), + any(duplicated(x)) || qxi$ix == order(x), + x[qxi$ix] == qxi$x) + } + }
> ## end of moved from sort.Rd
>
>
> ## substr
> ss <- substring("abcdef",1:6,1:6)
> stopifnot(ss == strsplit ("abcdef",NULL)[[1]])
> x <- c("asfef", "qwerty", "yuiop[", "b", "stuff.blah.yech")
> stopifnot(substr(x, 2, 5) == substring(x, 2, 5))
> ## end of moved from substr.Rd
>
>
> ## svd
> hilbert <- function(n) { i <- 1:n; 1 / outer(i - 1, i, "+") }
> str(X <- hilbert(9)[,1:6])
num [1:9, 1:6] 1 0.5 0.333 0.25 0.2 ...
> str(s <- svd(X))
List of 3 $ d: num [1:6] 1.67 2.77e-01 2.22e-02 1.08e-03 3.24e-05 ... $ u: num [1:9, 1:6] -0.724 -0.428 -0.312 -0.248 -0.206 ... $ v: num [1:6, 1:6] -0.736 -0.443 -0.327 -0.263 -0.22 ...
> Eps <- 100 * Meps
>
> D <- diag(s$d)
> stopifnot(abs(X - s$u %*% D %*% t(s$v)) < Eps)# X = U D V'
> stopifnot(abs(D - t(s$u) %*% X %*% s$v) < Eps)# D = U' X V
>
> X <- cbind(1, 1:7)
> str(s <- svd(X)); D <- diag(s$d)
List of 3 $ d: num [1:2] 12.07 1.16 $ u: num [1:7, 1:2] 0.0976 0.1788 0.2601 0.3413 0.4225 ... $ v: num [1:2, 1:2] 0.198 0.98 0.98 -0.198
> stopifnot(abs(X - s$u %*% D %*% t(s$v)) < Eps)# X = U D V'
> stopifnot(abs(D - t(s$u) %*% X %*% s$v) < Eps)# D = U' X V
> ## end of moved from svd.Rd
>
>
> ## Trig
> ## many of these tested for machine accuracy, which seems a bit extreme
> set.seed(123)
> stopifnot(cos(0) == 1)
> stopifnot(sin(3*pi/2) == cos(pi))
> x <- rnorm(99)
> stopifnot(all.equal( sin(-x), - sin(x)))
> stopifnot(all.equal( cos(-x), cos(x)))
> x <- abs(x); y <- abs(rnorm(x))
> stopifnot(abs(atan2(y, x) - atan(y/x)) < 10 * Meps)
> stopifnot(abs(atan2(y, x) - atan(y/x)) < 10 * Meps)
>
> x <- 1:99/100
> stopifnot(Mod(1 - (cos(x) + 1i*sin(x)) / exp(1i*x)) < 10 * Meps)
> ## error is about 650* at x=0.01:
> stopifnot(abs(1 - x / acos(cos(x))) < 1000 * Meps)
> stopifnot(abs(1 - x / asin(sin(x))) <= 10 * Meps)
> stopifnot(abs(1 - x / atan(tan(x))) <= 10 *Meps)
> ## end of moved from Trig.Rd
>
> ## Uniform
> u <- runif(20)
> stopifnot(punif(u) == u, dunif(u) == 1,
+ runif(100, 2,2) == 2)#-> TRUE [bug in R version <= 0.63.1]
> ## end of moved from Uniform.Rd
>
>
> ## unique
> my.unique <- function(x) x[!duplicated(x)]
> for(i in 1:4)
+ { x <- rpois(100, pi); stopifnot(unique(x) == my.unique(x)) }
>
> unique(iris)
Sepal.Length Sepal.Width Petal.Length Petal.Width Species 1 5.1 3.5 1.4 0.2 setosa 2 4.9 3.0 1.4 0.2 setosa 3 4.7 3.2 1.3 0.2 setosa 4 4.6 3.1 1.5 0.2 setosa 5 5.0 3.6 1.4 0.2 setosa 6 5.4 3.9 1.7 0.4 setosa 7 4.6 3.4 1.4 0.3 setosa 8 5.0 3.4 1.5 0.2 setosa 9 4.4 2.9 1.4 0.2 setosa 10 4.9 3.1 1.5 0.1 setosa 11 5.4 3.7 1.5 0.2 setosa 12 4.8 3.4 1.6 0.2 setosa 13 4.8 3.0 1.4 0.1 setosa 14 4.3 3.0 1.1 0.1 setosa 15 5.8 4.0 1.2 0.2 setosa 16 5.7 4.4 1.5 0.4 setosa 17 5.4 3.9 1.3 0.4 setosa 18 5.1 3.5 1.4 0.3 setosa 19 5.7 3.8 1.7 0.3 setosa 20 5.1 3.8 1.5 0.3 setosa 21 5.4 3.4 1.7 0.2 setosa 22 5.1 3.7 1.5 0.4 setosa 23 4.6 3.6 1.0 0.2 setosa 24 5.1 3.3 1.7 0.5 setosa 25 4.8 3.4 1.9 0.2 setosa 26 5.0 3.0 1.6 0.2 setosa 27 5.0 3.4 1.6 0.4 setosa 28 5.2 3.5 1.5 0.2 setosa 29 5.2 3.4 1.4 0.2 setosa 30 4.7 3.2 1.6 0.2 setosa 31 4.8 3.1 1.6 0.2 setosa 32 5.4 3.4 1.5 0.4 setosa 33 5.2 4.1 1.5 0.1 setosa 34 5.5 4.2 1.4 0.2 setosa 35 4.9 3.1 1.5 0.2 setosa 36 5.0 3.2 1.2 0.2 setosa 37 5.5 3.5 1.3 0.2 setosa 38 4.9 3.6 1.4 0.1 setosa 39 4.4 3.0 1.3 0.2 setosa 40 5.1 3.4 1.5 0.2 setosa 41 5.0 3.5 1.3 0.3 setosa 42 4.5 2.3 1.3 0.3 setosa 43 4.4 3.2 1.3 0.2 setosa 44 5.0 3.5 1.6 0.6 setosa 45 5.1 3.8 1.9 0.4 setosa 46 4.8 3.0 1.4 0.3 setosa 47 5.1 3.8 1.6 0.2 setosa 48 4.6 3.2 1.4 0.2 setosa 49 5.3 3.7 1.5 0.2 setosa 50 5.0 3.3 1.4 0.2 setosa 51 7.0 3.2 4.7 1.4 versicolor 52 6.4 3.2 4.5 1.5 versicolor 53 6.9 3.1 4.9 1.5 versicolor 54 5.5 2.3 4.0 1.3 versicolor 55 6.5 2.8 4.6 1.5 versicolor 56 5.7 2.8 4.5 1.3 versicolor 57 6.3 3.3 4.7 1.6 versicolor 58 4.9 2.4 3.3 1.0 versicolor 59 6.6 2.9 4.6 1.3 versicolor 60 5.2 2.7 3.9 1.4 versicolor 61 5.0 2.0 3.5 1.0 versicolor 62 5.9 3.0 4.2 1.5 versicolor 63 6.0 2.2 4.0 1.0 versicolor 64 6.1 2.9 4.7 1.4 versicolor 65 5.6 2.9 3.6 1.3 versicolor 66 6.7 3.1 4.4 1.4 versicolor 67 5.6 3.0 4.5 1.5 versicolor 68 5.8 2.7 4.1 1.0 versicolor 69 6.2 2.2 4.5 1.5 versicolor 70 5.6 2.5 3.9 1.1 versicolor 71 5.9 3.2 4.8 1.8 versicolor 72 6.1 2.8 4.0 1.3 versicolor 73 6.3 2.5 4.9 1.5 versicolor 74 6.1 2.8 4.7 1.2 versicolor 75 6.4 2.9 4.3 1.3 versicolor 76 6.6 3.0 4.4 1.4 versicolor 77 6.8 2.8 4.8 1.4 versicolor 78 6.7 3.0 5.0 1.7 versicolor 79 6.0 2.9 4.5 1.5 versicolor 80 5.7 2.6 3.5 1.0 versicolor 81 5.5 2.4 3.8 1.1 versicolor 82 5.5 2.4 3.7 1.0 versicolor 83 5.8 2.7 3.9 1.2 versicolor 84 6.0 2.7 5.1 1.6 versicolor 85 5.4 3.0 4.5 1.5 versicolor 86 6.0 3.4 4.5 1.6 versicolor 87 6.7 3.1 4.7 1.5 versicolor 88 6.3 2.3 4.4 1.3 versicolor 89 5.6 3.0 4.1 1.3 versicolor 90 5.5 2.5 4.0 1.3 versicolor 91 5.5 2.6 4.4 1.2 versicolor 92 6.1 3.0 4.6 1.4 versicolor 93 5.8 2.6 4.0 1.2 versicolor 94 5.0 2.3 3.3 1.0 versicolor 95 5.6 2.7 4.2 1.3 versicolor 96 5.7 3.0 4.2 1.2 versicolor 97 5.7 2.9 4.2 1.3 versicolor 98 6.2 2.9 4.3 1.3 versicolor 99 5.1 2.5 3.0 1.1 versicolor 100 5.7 2.8 4.1 1.3 versicolor 101 6.3 3.3 6.0 2.5 virginica 102 5.8 2.7 5.1 1.9 virginica 103 7.1 3.0 5.9 2.1 virginica 104 6.3 2.9 5.6 1.8 virginica 105 6.5 3.0 5.8 2.2 virginica 106 7.6 3.0 6.6 2.1 virginica 107 4.9 2.5 4.5 1.7 virginica 108 7.3 2.9 6.3 1.8 virginica 109 6.7 2.5 5.8 1.8 virginica 110 7.2 3.6 6.1 2.5 virginica 111 6.5 3.2 5.1 2.0 virginica 112 6.4 2.7 5.3 1.9 virginica 113 6.8 3.0 5.5 2.1 virginica 114 5.7 2.5 5.0 2.0 virginica 115 5.8 2.8 5.1 2.4 virginica 116 6.4 3.2 5.3 2.3 virginica 117 6.5 3.0 5.5 1.8 virginica 118 7.7 3.8 6.7 2.2 virginica 119 7.7 2.6 6.9 2.3 virginica 120 6.0 2.2 5.0 1.5 virginica 121 6.9 3.2 5.7 2.3 virginica 122 5.6 2.8 4.9 2.0 virginica 123 7.7 2.8 6.7 2.0 virginica 124 6.3 2.7 4.9 1.8 virginica 125 6.7 3.3 5.7 2.1 virginica 126 7.2 3.2 6.0 1.8 virginica 127 6.2 2.8 4.8 1.8 virginica 128 6.1 3.0 4.9 1.8 virginica 129 6.4 2.8 5.6 2.1 virginica 130 7.2 3.0 5.8 1.6 virginica 131 7.4 2.8 6.1 1.9 virginica 132 7.9 3.8 6.4 2.0 virginica 133 6.4 2.8 5.6 2.2 virginica 134 6.3 2.8 5.1 1.5 virginica 135 6.1 2.6 5.6 1.4 virginica 136 7.7 3.0 6.1 2.3 virginica 137 6.3 3.4 5.6 2.4 virginica 138 6.4 3.1 5.5 1.8 virginica 139 6.0 3.0 4.8 1.8 virginica 140 6.9 3.1 5.4 2.1 virginica 141 6.7 3.1 5.6 2.4 virginica 142 6.9 3.1 5.1 2.3 virginica 144 6.8 3.2 5.9 2.3 virginica 145 6.7 3.3 5.7 2.5 virginica 146 6.7 3.0 5.2 2.3 virginica 147 6.3 2.5 5.0 1.9 virginica 148 6.5 3.0 5.2 2.0 virginica 149 6.2 3.4 5.4 2.3 virginica 150 5.9 3.0 5.1 1.8 virginica
> stopifnot(dim(unique(iris)) == c(149, 5))
> ## end of moved from unique.Rd
>
>
> ## which.min
> stopifnot(length(which.min(numeric(0))) == 0)
> stopifnot(length(which.max( c(NA,NA) )) == 0)
> ## end of moved from which.min.Rd
>
>
> ## Wilcoxon
> x <- -1:(4*6 + 1)
> fx <- dwilcox(x, 4, 6)
> stopifnot(fx == dwilcox(x, 6, 4))
> Fx <- pwilcox(x, 4, 6)
> stopifnot(abs(Fx - cumsum(fx)) < 10 * Meps)
> ## end of moved from Wilcoxon.Rd
>
>
> ## All the following relations must hold :
> stopifnot(
+ 1 + Meps != 1, + 1 + .5* Meps == 1, + log2(.Machine$double.xmax) == .Machine$double.max.exp, + log2(.Machine$double.xmin) == .Machine$double.min.exp + )
> # This test fails on HP-UX since pow(2,1024) returns DBL_MAX and sets
> # errno = ERANGE. Most other systems return Inf and set errno
> if (Sys.info()["sysname"] != "HP-UX")
+ stopifnot(is.infinite(.Machine$double.base ^ .Machine$double.max.exp))
> ## end of moved from zMachine.Rd
>
>
> ## PR 640 (diff.default computes an incorrect starting time)
> ## By: Laimonis Kavalieris <lkavalieris_at_maths.otago.ac.nz>
> y <- ts(rnorm(24), freq=12)
> x <- ts(rnorm(24), freq=12)
> arima0(y, xreg = x, seasonal = list(order=c(0,1,0)))
Call: arima0(x = y, seasonal = list(order = c(0, 1, 0)), xreg = x) Coefficients: xreg1 0.3218 s.e. 0.2260 sigma^2 estimated as 2.233: log likelihood = -21.85, aic = 47.7
> ## Comments:
>
>
> ## PR 644 (crash using fisher.test on Windows)
> ## By: Uwe Ligges <ligges_at_statistik.uni-dortmund.de>
> x <- matrix(c(2, 2, 4, 8, 6, 0, 1, 1, 7, 8, 1, 3, 1, 3, 7, 4, 2, 2, 2,
+ 1, 1, 0, 0, 0, 0, 0, 1, 1, 2, 0, 1, 1, 0, 2, 1, 0, 0, 0), + nc = 2)
> fisher.test(x)
Fisher's Exact Test for Count Data data: x p-value = 0.7178 alternative hypothesis: two.sided
> ## Comments: (wasn't just on Windows)
>
> ## PR 653 (extrapolation in spline)
> ## By: Ian White <imsw_at_holyrood.ed.ac.uk>
> x <- c(2,5,8,10)
> y <- c(1.2266,-1.7606,-0.5051,1.0390)
> fn <- splinefun(x, y, method="natural")
> xx1 <- fn(0:12)
> # should be the same if reflected
> fn <- splinefun(rev(-x),rev(y),method="natural")
> xx2 <- fn(0:-12)
> stopifnot(all.equal(xx1, xx2))
> # should be the same as interpSpline
> library(splines)
> xx3 <- predict(interpSpline(x, y), 0:12)
> stopifnot(all.equal(xx1, xx3$y))
> unloadNamespace("splines")
> ## Comments: all three differed in 1.2.1.
>
>
> ## PR 698 (print problem with data frames)
> ## actually, a subsetting problem with data frames
> fred <- data.frame(happy=c(TRUE, FALSE, TRUE), sad=7:9)
> z <- try(tmp <- fred[c(FALSE, FALSE, TRUE, TRUE)])
Error in `[.data.frame`(fred, c(FALSE, FALSE, TRUE, TRUE)) : undefined columns selected
> stopifnot(class(z) == "try-error")
> ## Comments: No error before 1.2.1
>
>
> ## PR 753 (step can't find variables)
> ##
> x <- data.frame(a=rnorm(10), b=rnorm(10), c=rnorm(10))
> x0.lm <- lm(a ~ 1, data=x)
> step(x0.lm, ~ b + c)
Start: AIC=-4.17 a ~ 1 Df Sum of Sq RSS AIC + c 1 1.33690 4.0562 -5.0234 <none> 5.3931 -4.1747 + b 1 0.07256 5.3205 -2.3101 Step: AIC=-5.02 a ~ c Df Sum of Sq RSS AIC + b 1 1.0784 2.9778 -6.1139 <none> 4.0562 -5.0234 - c 1 1.3369 5.3931 -4.1747 Step: AIC=-6.11 a ~ c + b Df Sum of Sq RSS AIC <none> 2.9778 -6.1139 - b 1 1.0784 4.0562 -5.0234 - c 1 2.3427 5.3205 -2.3101 Call: lm(formula = a ~ c + b, data = x) Coefficients: (Intercept) c b -0.4553 0.9121 0.4021
> ## Comments:
>
>
> ## PR 796 (aic in binomial models is often wrong)
> ##
> a1 <- glm(cbind(ncases, ncontrols) ~ agegp + tobgp * alcgp,
+ data = esoph, family = binomial())$aic
> a1
[1] 236.9645
> a2 <- glm(ncases/(ncases+ncontrols) ~ agegp + tobgp * alcgp,
+ data = esoph, family = binomial(), weights=ncases+ncontrols)$aic
> a2
[1] 236.9645
> stopifnot(all.equal(a1, a2))
> ## Comments:
> # both should be 236.9645
> # changed to use all.equal rather than == in 2.1.0 -pd
>
> ## Follow up: example from Lindsey, purportedly of inaccuracy in aic
> y <- matrix(c(2, 0, 7, 3, 0, 9), ncol=2)
> x <- gl(3, 1)
> a <- glm(y ~ x, family=binomial)$aic
> stopifnot(is.finite(a))
> ## Comments: gave NaN prior to 1.2.1
>
>
> ## PR 802 (crash with scan(..., what=list(,,)))
> ##
> m <- matrix(1:9, 3,3)
> write(m, "test.dat", 3)
> try(scan("test.dat", what=list(,,,)))
Error in scan("test.dat", what = list(, , , )) : element 1 is empty; the part of the args list of 'list' being evaluated was: (, , , )
> unlink("test.dat")
> ## Comments: segfaulted in 1.2.0
>
>
> ## Jonathan Rougier, 2001-01-30 [bug in 1.2.1 and earlier]
> tmp <- array(list(3), c(2, 3))
> tmp[[2, 3]] <- "fred"
> all.equal(t(tmp), aperm(tmp))
[1] TRUE
>
>
> ## PR 860 (Context problem with ... and rbind) Prof Brian D Ripley, 2001-03-03,
> f <- function(x, ...)
+ { + g <- function(x, ...) x + rbind(numeric(), g(x, ...)) + }
> f(1:3)
[,1] [,2] [,3] [1,] 1 2 3
> ## Error in 1.2.2
> f <- function(x, ...) h(g(x, ...))
> g <- function(x, ...) x
> h <- function(...)substitute(list(...))
> f(1)
list(g(x, ...))
> ## Error in 1.2.2
> substitute(list(...))
list(...)
> ## Error in 1.2.2
>
>
> ## Martin Maechler, 2001-03-07 [1.2.2 and in parts earlier]
> tf <- tempfile()
> cat(1:3,"\n", file = tf)
> for(line in list(4:6, "", 7:9)) cat(line,"\n", file = tf, append = TRUE)
>
> count.fields(tf) # 3 3 3 : ok {blank line skipped}
[1] 3 3 3
> z <- scan(tf, what=rep(list(""),3), nmax = 3)
Read 3 records
> stopifnot(sapply(z, length) == 3)
> ## FALSE in 1.2.2
> z <- as.data.frame(scan(tf, what=rep(list(""),3), n=9))
Read 3 records
> dim(z)
[1] 3 3
> ## should be 3 3. Was 2 3 in 1.2.2.
> read.table(tf)
V1 V2 V3 1 1 2 3 2 4 5 6 3 7 8 9
> ## gave error in 1.2.2
> unlink(tf)
>
>
> ## PR 870 (as.numeric and NAs) Harald Fekjær, 2001-03-08,
> is.na(as.numeric(" "))
[1] TRUE
> is.na(as.integer(" "))
[1] TRUE
> is.na(as.complex(" "))
[1] TRUE
> ## all false in 1.2.2
>
>
> ## PR 871 (deparsing of attribute names) Harald Fekjær, 2001-03-08,
> midl <- 4
> attr(midl,"Object created") <- date()
> deparse(midl)
[1] "structure(4, \"Object created\" = \"Mon Nov 2 10:15:14 2009\")"
> dump("midl", "midl.R")
> source("midl.R") ## syntax error in 1.2.2
> unlink("midl.R")
>
>
> ## PR 872 (surprising behavior of match.arg()) Woodrow Setzer, 2001-03-08,
> fun1 <- function(x, A=c("power","constant")) {
+ arg <- match.arg(A) + formals() + }
> topfun <- function(x, Fun=fun1) {
+ a1 <- fun1(x) + print(a1) + a2 <- Fun(x,A="power") + stopifnot(all.equal(a1, a2)) + print(a2) + }
> topfun(2, fun1)
$x $A c("power", "constant") $x $A c("power", "constant")
> ## a1 printed without defaults in 1.2.2
>
>
> ## PR 873 (long formulas in terms()) Jerome Asselin, 2001-03-08,
> form <- cbind(log(inflowd1),log(inflowd2),log(inflowd3),
+ log(inflowd4),log(inflowd5),log(inflowd6)) ~ precip*I(Tmax^2)
> terms(form) # error in 1.2.2
cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) ~ precip * I(Tmax^2) attr(,"variables") list(cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)), precip, I(Tmax^2)) attr(,"factors") precip cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) 0 precip 1 I(Tmax^2) 0 I(Tmax^2) cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) 0 precip 0 I(Tmax^2) 1 precip:I(Tmax^2) cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) 0 precip 1 I(Tmax^2) 1 attr(,"term.labels") [1] "precip" "I(Tmax^2)" "precip:I(Tmax^2)" attr(,"order") [1] 1 1 2 attr(,"intercept") [1] 1 attr(,"response") [1] 1 attr(,".Environment") <environment: R_GlobalEnv>
>
>
> ## PR 881 Incorrect values in non-central chisq values on Linux, 2001-03-21
> x <- dchisq(c(7.1, 7.2, 7.3), df=2, ncp=20)
> stopifnot(diff(x) > 0)
> ## on 1.2.2 on RH6.2 i686 Linux x = 0.01140512 0.00804528 0.01210514
>
>
> ## PR 882 eigen segfaults on 0-diml matrices, 2001-03-23
> m <- matrix(1, 0, 0) # 1 to force numeric not logical
> try(eigen(m))
Error in eigen(m) : 0 x 0 matrix
> ## segfaults on 1.2.2
>
>
> ## 1.3.0 had poor compression on gzfile() with lots of small pieces.
> zz <- gzfile("t1.gz", "w")
> write(1:1000, zz)
> close(zz)
> (sz <- file.info("t1.gz")$size)
[1] 1856
> unlink("t1.gz")
> stopifnot(sz < 2000)
>
>
> ## PR 1010: plot.mts (type="p") was broken in 1.3.0 and this call failed.
> plot(ts(matrix(runif(10), ncol = 2)), type = "p")
>
>
> ## in 1.3.0 readLines(ok=FALSE) failed.
> cat(file="foo.txt", 1:10, sep="\n")
> x <- try(readLines("foo.txt", 100, ok=FALSE))
Error in readLines("foo.txt", 100, ok = FALSE) : too few lines read in readLines
> unlink("foo.txt")
> stopifnot(length(class(x)) == 1 && class(x) == "try-error")
>
>
> ## PR 1047 [<-data.frame failure, BDR 2001-08-10
> test <- df <- data.frame(x=1:10, y=11:20, row.names=letters[1:10])
> test[] <- lapply(df, factor)
> test
x y a 1 11 b 2 12 c 3 13 d 4 14 e 5 15 f 6 16 g 7 17 h 8 18 i 9 19 j 10 20
> ## error in 1.3.0 in test[]
>
>
> ## PR 1048 bug in dummy.coef.lm, Adrian Baddeley, 2001-08-10
> ## modified to give a sensible test
> old <- getOption("contrasts")
> options(contrasts=c("contr.helmert", "contr.poly"))
> DF <- data.frame(x=1:20,y=rnorm(20),z=factor(1:20 <= 10))
> dummy.coef(lm(y ~ z * I(x), data=DF))
Full coefficients are (Intercept): 0.2425610 z: FALSE TRUE -0.1386709 0.1386709 I(x): -0.04996379 z:I(x): FALSE TRUE 0.0186591 -0.0186591
> dummy.coef(lm(y ~ z * poly(x,1), data=DF))
Full coefficients are (Intercept): -0.2820588 z: FALSE TRUE 0.05724965 -0.05724965 poly(x, 1): 0.474656 z:poly(x, 1): FALSE TRUE -0.1772615 0.1772615
> ## failed in 1.3.0. Second one warns: deficiency of the method.
> options(contrasts=old)
>
>
> ## PR 1050 error in ksmooth C code + patch, Hsiu-Khuern Tang, 2001-08-12
> x <- 1:4
> y <- 1:4
> z <- ksmooth(x, y, x.points=x)
> stopifnot(all.equal(z$y, y))
> ## did some smoothing prior to 1.3.1.
>
>
> ## The length of lines read by scan() was limited before 1.4.0
> xx <- paste(rep(0:9, 2000), collapse="")
> zz <- file("foo.txt", "w")
> writeLines(xx, zz)
> close(zz)
> xxx <- scan("foo.txt", "", sep="\n")
Read 1 item
> stopifnot(identical(xx, xxx))
> unlink("foo.txt")
>
>
> ## as.character was truncating formulae: John Fox 2001-08-23
> mod <- this ~ is + a + very + long + formula + with + a + very + large + number + of + characters
> zz <- as.character(mod)
> zz
[1] "~" [2] "this" [3] "is + a + very + long + formula + with + a + very + large + number + of + characters"
> nchar(zz)
[1] 1 4 83
> stopifnot(nchar(zz)[3] == 83)
> ## truncated in 1.3.0
>
>
> ## substr<-, Tom Vogels, 2001-09-07
> x <- "abcdef"
> substr(x, 2, 3) <- "wx"
> stopifnot(x == "awxdef")
>
> x <- "abcdef"
> substr(x, 2, 3) <- "wxy"
> stopifnot(x == "awxdef")
>
> x <- "abcdef"
> substr(x, 2, 3) <- "w"
> stopifnot(x == "awcdef")
> ## last was "aw" in 1.3.1
>
>
> ## reading bytes from a connection, Friedrich Leisch 2001-09-07
> cat("Hello World", file="world.txt")
> con <- file("world.txt", "r")
> zz <- readChar(con, 100)
> close(con)
> unlink("world.txt")
> stopifnot(zz == "Hello World")
> ## was "" in 1.3.1.
>
>
> ## prediction was failing for intercept-only model
> ## as model frame has no columns.
> d <- data.frame(x=runif(50), y=rnorm(50))
> d.lm <- lm(y ~ 1, data=d)
> predict(d.lm, data.frame(x=0.5))
[1] -0.008940623
> ## error in 1.3.1
>
>
> ## predict.arima0 needed a matrix newxreg: Roger Koenker, 2001-09-27
> u <- rnorm(120)
> s <- 1:120
> y <- 0.3*s + 5*filter(u, c(.95,-.1), "recursive", init=rnorm(2))
> fit0 <- arima0(y,order=c(2,0,0), xreg=s)
> fit1 <- arima0(y,order=c(2,1,0), xreg=s, include.mean=TRUE)
> fore0 <- predict(fit0 ,n.ahead=44, newxreg=121:164)
> fore1 <- predict(fit1, n.ahead=44, newxreg=121:164)
> par(mfrow=c(1,2))
> ts.plot(y,fore0$pred, fore0$pred+2*fore0$se, fore0$pred-2*fore0$se,
+ gpars=list(lty=c(1,2,3,3)))
> abline(fit0$coef[3:4], lty=2)
> ts.plot(y, fore1$pred, fore1$pred+2*fore1$se, fore1$pred-2*fore1$se,
+ gpars=list(lty=c(1,2,3,3)))
> abline(c(0, fit1$coef[3]), lty=2)
>
>
> ## merging when NA is a level
> a <- data.frame(x = 1:4)
> b <- data.frame(x = 1:3, y = factor(c("NA", "a", "b"), exclude=""))
> (m <- merge(a, b, all.x = TRUE))
x y 1 1 NA 2 2 a 3 3 b 4 4 <NA>
> stopifnot(is.na(m[4, 2]))
> ## was level NA in 1.3.1
> stopifnot(!is.na(m[1, 2]))
>
>
> ## merging with POSIXct columns:
> x <- data.frame(a = as.POSIXct(Sys.time() + (1:3)*10000), b = LETTERS[1:3])
> y <- data.frame(b = LETTERS[3:4], c = 1:2)
> stopifnot(1 == nrow(merge(x, y)))
> stopifnot(4 == nrow(merge(x, y, all = TRUE)))
>
>
> ## PR 1149. promax was returning the wrong rotation matrix.
> ability.FA <- factanal(factors = 2, covmat = ability.cov, rotation = "none")
> pm <- promax(ability.FA$loadings)
> tmp1 <- as.vector(ability.FA$loadings %*% pm$rotmat)
> tmp2 <- as.vector(pm$loadings)
> stopifnot(all.equal(tmp1, tmp2))
>
>
> ## PR 1155. On some systems strptime was not setting the month or mday
> ## when yday was supplied.
> bv1 <- data.frame(day=c(346,346,347,347,347), time=c(2340,2350,0,10,20))
> attach(bv1)
> tmp <- strptime(paste(day, time %/% 100, time %% 100), "%j %H %M")
> detach()
> stopifnot(tmp$mon == 11)
> # day of month will be different in a leap year on systems that default
> # to the current year, so test differences:
> stopifnot(diff(tmp$mday) == c(0, 1, 0, 0))
> ## Comments: failed on glibc-based systems in 1.3.1, including Windows.
>
>
> ## PR 1004 (follow up). Exact Kolmogorov-Smirnov test gave incorrect
> ## results due to rounding errors (Charles Geyer, charlie_at_stat.umn.edu,
> ## 2001-10-25).
> ## Example 5.4 in Hollander and Wolfe (Nonparametric Statistical
> ## Methods, 2nd ed., Wiley, 1999, pp. 180-181).
> x <- c(-0.15, 8.6, 5, 3.71, 4.29, 7.74, 2.48, 3.25, -1.15, 8.38)
> y <- c(2.55, 12.07, 0.46, 0.35, 2.69, -0.94, 1.73, 0.73, -0.35, -0.37)
> stopifnot(round(ks.test(x, y)$p.value, 4)
== 0.0524)
>
>
> ## PR 1150. Wilcoxon rank sum and signed rank tests did not return the
> ## Hodges-Lehmann estimators of the associated confidence interval
> ## (Charles Geyer, charlie_at_stat.umn.edu, 2001-10-25).
> ## One-sample test: Example 3.1 in Hollander & Wolfe (1973), 29f.
> 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)
> we <- wilcox.test(y, x, paired = TRUE, conf.int = TRUE)
> ## NOTE order: y then x.
> ## Results from Hollander & Wolfe (1999), 2nd edition, page 40 and 53
> stopifnot(round(we$p.value,4) == 0.0391)
> stopifnot(round(we$conf.int,3) == c(-0.786, -0.010))
> stopifnot(round(we$estimate,3) == -0.46)
> ## Two-sample test: Example 4.1 in Hollander & Wolfe (1973), 69f.
> 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)
> we <- wilcox.test(y, x, conf.int = TRUE)
> ## NOTE order: y then x.
> ## Results from Hollander & Wolfe (1999), 2nd edition, page 111 and 126
> stopifnot(round(we$p.value,4) == 0.2544)
> stopifnot(round(we$conf.int,3) == c(-0.76, 0.15))
> stopifnot(round(we$estimate,3) == -0.305)
>
>
> ## range gave wrong length result for R < 1.4.0
> stopifnot(length(range(numeric(0))) == 2)
Warning messages: 1: In min(x) : no non-missing arguments to min; returning Inf 2: In max(x) : no non-missing arguments to max; returning -Inf
> ## Comments: was just NA
>
>
> ## mishandling of integer(0) in R < 1.4.0
> x1 <- integer(0) / (1:3)
> x2 <- integer(0) ^ (1:3)
> stopifnot(length(x1) == 0 & length(x2) == 0)
> ## Comments: were integer NAs in real answer in 1.3.1.
>
>
> ## PR#1138/9 rounding could give non-integer answer.
> x <- round(100000/3, -2) - 33300
> stopifnot(x == 0)
> ## failed in 1.3.x on Solaris and Windows but not Debian Linux.
>
>
> ## PR#1160 finding midpoints in image <janef_at_stat.berkeley.edu, 2001-11-06>
> x2 <- c(0, 0.002242152, 0.004484305, 0.006726457, 0.00896861,
+ 0.01121076, 0.01345291, 0.01569507, 0.01793722, 0.02017937, + 0.02242152, 0.02466368, 0.02690583, 0.02914798, 0.03139013, + 0.03363229, 0.03587444, 0.03811659, 0.04035874, 0.04932735, + 0.05156951, 0.05381166)
> z <- c(0, 0.067, NA, 0.167, 0.083, 0.05, 0.067, NA, 0, 0.1, 0, 0.05,
+ 0.067, 0.067, 0.016, 0.117, 0.017, -0.017, 0.2, 0.35, 0.134, 0.15)
> image(x2, 1, as.matrix(z))
> ## Comments: failed under R 1.3.1.
>
>
> ##PR 1175 and 1123##
> set.seed(123)
> ## We can't seem to get Pearson residuals right ##
> x <- 1:4 # regressor variable
> y <- c(2,6,7,8) # response binomial counts
> n <- rep(10,4) # number of binomial trials
> ym <- cbind(y,n-y) # response variable as a matrix
> glm1 <- glm(ym~x,binomial) # fit a generalized linear model
> f <- fitted(glm1)
> rp1 <- (y-n*f)/sqrt(n*f*(1-f)) # direct calculation of pearson residuals
> rp2 <- residuals(glm1,type="pearson") # should be pearson residuals
> stopifnot(all.equal(rp1,rp2))
> # sign should be same as response residuals
> x <- 1:10
> y <- rgamma(10,2)/x
> glm2 <- glm(y~x,family=Gamma)
> stopifnot(all.equal(sign(resid(glm2,"response")),sign(resid(glm2,"pearson"))))
> # shouldn't depend on link for a saturated model
> x<-rep(0:1,10)
> y<-rep(c(0,1,1,0,1),4)
> glm3<-glm(y~x,family=binomial(),control=glm.control(eps=1e-8))
> glm4<-glm(y~x,family=binomial("log"),control=glm.control(eps=1e-8))
> stopifnot(all.equal(resid(glm3,"pearson"),resid(glm4,"pearson")))
>
>
> ## Torsten Hothorn, 2001-12-04
> stopifnot(pt(-Inf, 3, ncp=0) == 0, pt(Inf, 3, ncp=0) == 1)
> ## Comments: were 0.5 in 1.3.1
>
>
> ## Paul Gilbert, 2001-12-07
> cancor(matrix(rnorm(100),100,1), matrix(rnorm(300),100,3))
$cor [1] 0.09057181 $xcoef [,1] [1,] 0.1117289 $ycoef [,1] [,2] [,3] [1,] -0.07465770 -0.04311967 -0.052752879 [2,] -0.04302592 0.09307937 -0.009990484 [3,] -0.05409998 -0.01244767 0.084752170 $xcenter [1] 0.02784576 $ycenter [1] -0.03353540 0.08536240 -0.05617746
> ## Comments: failed in R-devel.
>
>
> ## PR#1201: incorrect values in qbeta
> x <- seq(0, 0.8, len=1000)
> xx <- pbeta(qbeta(x, 0.143891, 0.05), 0.143891, 0.05)
> stopifnot(max(abs(x - xx)) < 1e-6)
> ## Comments: Get a range of zeroes in 1.3.1
>
>
> ## PR#1216: binomial null model
> y <- rbinom(20, 1, 0.5)
> glm(y ~ 0, family = binomial)
Call: glm(formula = y ~ 0, family = binomial) No coefficients Degrees of Freedom: 20 Total (i.e. Null); 20 Residual Null Deviance: 27.73 Residual Deviance: 27.73 AIC: 27.73
> ## Comments: 1.3.1 gave Error in any(n > 1) : Object "n" not found
>
>
> ## Integer overflow in type.convert
> res <- type.convert("12345689")
> stopifnot(typeof(res) == "integer")
> res <- type.convert("12345689012")
> stopifnot(typeof(res) == "double")
> ## Comments: was integer in 1.4.0
>
>
> ## La.eigen() segfault
> #e1 <- La.eigen(m <- matrix(1:9,3))
> #stopifnot(e1$values == La.eigen(m, only.values = TRUE)$values)
> ## 2.0.0: La.eigen is defunct
>
>
> ## Patrick Connelly 2001-01-22, prediction with offsets failed
> ## a simpler example
> counts <- c(18, 17, 15, 20, 10, 20, 25, 13, 12)
> outcome <- gl(3, 1, 9)
> treatment <- gl(3, 3)
> DF <- data.frame(counts = c(18, 17, 15, 20, 10, 20, 25, 13, 12),
+ outcome = gl(3, 1, 9), treatment = gl(3, 3), + exposure = c(1.17, 1.78, 1.00, 2.36, 2.58, 0.80, 2.51, + 1.16, 1.77))
> fit <- glm(counts ~ outcome + treatment + offset(log(exposure)),
+ family = poisson, data = DF)
> p1 <- predict(fit)
> p2 <- predict(fit, se = TRUE) ## failed < 1.4.1
> p3 <- predict(fit, newdata = DF)
> p4 <- predict(fit, newdata = DF, se = TRUE)
> stopifnot(all.equal(p1, p2$fit), all.equal(p1, p3), all.equal(p2, p4))
> fit <- glm(counts ~ outcome + treatment, offset = log(exposure),
+ family = poisson, data = DF)
> p1 <- predict(fit)
> p2 <- predict(fit, se = TRUE) ## failed < 1.4.1
> p3 <- predict(fit, newdata = DF)
> p4 <- predict(fit, newdata = DF, se = TRUE)
> stopifnot(all.equal(p1, p2$fit), all.equal(p1, p3), all.equal(p2, p4))
>
>
> ## PR#1267 hashing NaN
> load(file.path(Sys.getenv("SRCDIR"), "nanbug.rda"))
> bb <- b; bb[5] <- NaN
> identical(b, bb) # TRUE
[1] TRUE
> unique(c(NaN, bb)) #[1] NaN 0 1 2 3 NA
[1] NaN 0 1 2 3 NA
> stopifnot(identical(unique(c(NaN, b)), unique(c(NaN, bb))))
> ## 1.4.0 gives [1] NaN 0 1 2 NaN 3 NA on most platforms
>
>
> ## PR 1271 detach("package:base") crashes R.
> try(detach("package:base"))
Error in detach("package:base") : detaching "package:base" is not allowed
>
>
> ## reported by PD 2002-01-24
> Y <- matrix(rnorm(20), , 2)
> fit <- manova(Y ~ 1)
> fit # failed
Call: manova(Y ~ 1) Terms: Residuals resp 1 12.10603 resp 2 11.86833 Deg. of Freedom 9 Residual standard error: 1.159790 1.148348
> print(fit, intercept = TRUE)
Call: manova(Y ~ 1) Terms: (Intercept) Residuals resp 1 0.912842 12.106025 resp 2 0.303404 11.868328 Deg. of Freedom 1 9 Residual standard error: 1.159790 1.148348 Estimated effects are balanced
> summary(fit) # failed
Df Pillai approx F num Df den Df Pr(>F) Residuals 9
> summary(fit, intercept = TRUE)
Df Pillai approx F num Df den Df Pr(>F) (Intercept) 1 0.076001 0.32901 2 8 0.729 Residuals 9
>
>
> ## Several qr.*() functions lose (dim)names.
> ## reported by MM 2002-01-26
>
> ## the following should work both in R and S+ :
> q4 <- qr(X4 <- cbind(a = 1:9, b = c(1:6,3:1), c = 2:10, d = rep(1,9)))
> ##q2 <- qr(X4[,1:2])
> y04 <- y4 <- cbind(A=1:9,B=2:10,C=3:11,D=4:12)
> dimnames(y4)[[1]] <- paste("c",1:9,sep=".")
> y1 <- y4[,2]
> y40 <- y4 ; dimnames(y40) <- list(dimnames(y4)[[1]], NULL)
>
> c1 <- qr.coef( q4, y4) # row- AND col-names
> c2 <- qr.coef( q4, y04)# ditto
> c3 <- qr.coef( q4, y40)# row--names
> dn3 <- dimnames(c3)
> stopifnot(identical(dimnames(c1), dimnames(c2)),
+ identical(dimnames(c1), list(letters[1:4], LETTERS[1:4])), + identical(dn3[[1]], letters[1:4]), length(dn3[[2]]) == 0, + identical(names(qr.coef(q4,y1)), letters[1:4]), + identical(dimnames(qr.R(q4))[[2]], letters[1:4]), + + identical(dimnames(qr.qty(q4,y4)), dimnames(y4)), + identical(dimnames(qr.qty(q4,y40)), dimnames(y40)), + identical(dimnames(qr.qy (q4,y04)), dimnames(y04)), + + all.equal(y1, qr.fitted(q4, y1 ), tol = 1e-12), + all.equal(y4, qr.fitted(q4, y4 ), tol = 1e-12), + all.equal(y40, qr.fitted(q4, y40), tol = 1e-12), + all.equal(y04, qr.fitted(q4, y04), tol = 1e-12), + + all.equal(X4, qr.X(q4), tol = 1e-12) + )
>
>
> ## PR 1297 read.fwf() was interpreting `#' in 1.4.0/1
> cat(file="test.fwf", "123ABC123", "123#3 123", "123XYZ123", sep="\n")
> (res <- read.fwf("test.fwf", widths=c(3,3,3), comment.char=""))
V1 V2 V3 1 123 ABC 123 2 123 #3 123 3 123 XYZ 123
> unlink("test.fwf")
> stopifnot(res[2, 2] == "#3 ")
>
>
> ## abs was failing to dispatch as part of the Math group generic
> tmp <- data.frame(x = -5:5)
> abs(tmp)
x 1 5 2 4 3 3 4 2 5 1 6 0 7 1 8 2 9 3 10 4 11 5
> ## failed in 1.4.1.
>
>
> ## PR 1363 La.svd was not working for integer args
> m <- matrix(1:4, 2)
> (s1 <- svd(m))
$d [1] 5.4649857 0.3659662 $u [,1] [,2] [1,] -0.5760484 -0.8174156 [2,] -0.8174156 0.5760484 $v [,1] [,2] [1,] -0.4045536 0.9145143 [2,] -0.9145143 -0.4045536
> (s2 <- La.svd(m))
$d [1] 5.4649857 0.3659662 $u [,1] [,2] [1,] -0.5760484 -0.8174156 [2,] -0.8174156 0.5760484 $vt [,1] [,2] [1,] -0.4045536 -0.9145143 [2,] 0.9145143 -0.4045536
> stopifnot(all.equal(s1$d, s2$d), all.equal(s1$u, s2$u),
+ all.equal(s1$v, t(s2$vt)))
> (e1 <- eigen(m))
$values [1] 5.3722813 -0.3722813 $vectors [,1] [,2] [1,] -0.5657675 -0.9093767 [2,] -0.8245648 0.4159736
> # (e2 <- La.eigen(m)) # 2.0.0: La.eigen is defunct
> stopifnot(all.equal(e1$d, e1$d))
>
>
> ## order/sort.list on NA_STRING
> x <- c("A", NA, "Z")
> stopifnot(identical(sort(x, na.last = TRUE), x[sort.list(x, na.last = TRUE)]))
> stopifnot(identical(sort(x, na.last = FALSE), x[sort.list(x, na.last = FALSE)]))
> ## 1.4.1 sorted NA correctly with sort but not sort.list.
>
>
> ## Don MacQueen 2002-03-26
> stopifnot(length(seq(1024902010, 1024902025, by=1)) == 16)
> t0 <- ISOdatetime(2002,6,24,0,0,10)
> x <- seq.POSIXt(from=t0,to=t0+15,by='1 sec')
> stopifnot(length(x) == 16)
>
>
> ## whilst reading the code BDR 2002-03-31
> z <- try(max(complex(0)))
Error in max(complex(0)) : invalid 'type' (complex) of argument
> stopifnot(inherits(z, "try-error"))
> z <- try(min(complex(0)))
Error in min(complex(0)) : invalid 'type' (complex) of argument
> stopifnot(inherits(z, "try-error"))
> ## 1.4.1 gave +-Inf + random imaginary part
>
>
> ## PR#1283 min/max(NULL) or (integer(0))
> z <- min(NULL)
Warning message: In min(NULL) : no non-missing arguments to min; returning Inf
> stopifnot(!is.na(z), mode(z) == "numeric", z == Inf)
> z <- min(integer(0))
Warning message: In min(integer(0)) : no non-missing arguments to min; returning Inf
> stopifnot(!is.na(z), mode(z) == "numeric", z == Inf)
> z <- max(NULL)
Warning message: In max(NULL) : no non-missing arguments to max; returning -Inf
> stopifnot(!is.na(z), mode(z) == "numeric", z == -Inf)
> z <- max(integer(0))
Warning message: In max(integer(0)) : no non-missing arguments to max; returning -Inf
> stopifnot(!is.na(z), mode(z) == "numeric", z == -Inf)
>
>
> ## more reading the code BDR 2002-03-31
> stopifnot(identical(range(), range(numeric(0))))
Warning messages: 1: In min(x, na.rm = na.rm) : no non-missing arguments to min; returning Inf 2: In max(x, na.rm = na.rm) : no non-missing arguments to max; returning -Inf 3: In min(x) : no non-missing arguments to min; returning Inf 4: In max(x) : no non-missing arguments to max; returning -Inf
> ## in 1.4.1 range() was c(1,1)
> stopifnot(is.null(c()))
> ## in 1.4.1 this was structure(TRUE, names="recursive")
>
> ## range(numeric(0)) was not as documented
> x <- numeric(0)
> (rx <- range(x))
[1] Inf -Inf Warning messages: 1: In min(x) : no non-missing arguments to min; returning Inf 2: In max(x) : no non-missing arguments to max; returning -Inf
> stopifnot(identical(rx, c(min(x), max(x))))
Warning messages: 1: In min(x) : no non-missing arguments to min; returning Inf 2: In max(x) : no non-missing arguments to max; returning -Inf
> ## 1.4.1 had c(NA, NA)
>
>
> ## PR 1431 persp() crashes with numeric values for [x,y,z]lab
> persp(1:2, 1:2, matrix(1:4, 2), xlab=1)
> ## segfaulted in 1.4.1
>
>
> ## PR#1244 bug in det using method="qr"
> ## method argument is no longer used in det
> #m2 <- structure(c(9822616000, 3841723000, 79790.09, 3841723000, 1502536000,
> # 31251.82, 79790.09, 31251.82, 64156419.36), .Dim = c(3, 3))
> #(d1 <- det(m2, method="eigenvalues"))
> #(d2 <- det(m2, method="qr"))
> #stopifnot(d2 == 0) ## 1.4.1 gave 9.331893e+19
> #(d3 <- det(m2, method="qr", tol = 1e-10))
> #stopifnot(all.equal(d1, d3, tol=1e-3))
>
>
> ## PR#1422 glm start/offset bugs
> res <- try(data(ships, package = MASS))
Error in data(ships, package = MASS) : object 'MASS' not found
> if(!inherits(res, "try-error")) {
+ ships.glm <- glm(incidents ~ type + year + period + offset(log(service)), + family = poisson, data = ships, subset = (service != 0)) + update(ships.glm, start = coef(ships.glm)) + }
> ## failed in 1.4.1.
>
>
> ## PR#1439 file.info()$isdir was only partially logical
> (info <- file.info("."))
size isdir mode mtime ctime atime . 4096 TRUE 755 2009-11-02 10:15:15 2009-11-02 10:15:15 2009-11-02 10:15:14 uid gid uname grname . 1000 1000 paul paul
> info$isdir
[1] TRUE
> stopifnot(info$isdir == TRUE)
> ## 1.4.1 had a TRUE value that was not internally integer 1.
>
> ## PR#1473 predict.*bSpline() bugs extrapolating for deriv >= 1
> library(splines)
> x <- c(1:3,5:6)
> y <- c(3:1,5:6)
> (isP <- interpSpline(x,y))# poly-spline representation
polynomial representation of spline for y ~ x constant linear quadratic cubic 1 3 -0.8360656 0.0000000 -0.1639344 2 2 -1.3278689 -0.4918033 0.8196721 3 1 0.1475410 1.9672131 -0.5204918 5 5 1.7704918 -1.1557377 0.3852459 6 6 0.6147541 0.0000000 0.0000000
> (isB <- interpSpline(x,y, bSpl = TRUE))# B-spline repr.
bSpline representation of spline for y ~ x -3 -2 -1 1 2 3 5 NA NA NA NA 4.3934426 3.2786885 2.1639344 6 7 9 10 -0.2622951 5.1803279 6.0000000 6.8196721
> xo <- c(0, x, 10)# x + outside points
> op <- options(digit
s = 4)
> for(der in 0:3) # deriv=3 fails!
+ print(formatC(try(predict(isP, xo, deriv = der)$y), wid=7,format="f"), + quote = FALSE) [1] 3.8361 3.0000 2.0000 1.0000 5.0000 6.0000 8.4590 [1] -0.8361 -0.8361 -1.3279 0.1475 1.7705 0.6148 0.6148 [1] 0.0000 0.0000 -0.9836 3.9344 -2.3115 0.0000 0.0000 [1] 0.0000 -0.9836 -0.9836 4.9180 -3.1230 2.3115 0.0000
> ## and for B-spline (instead of polynomial):
> for(der in 0:3) # deriv=3 failed
+ print(formatC(try(predict(isB, xo, deriv = der)$y), wid=7,format="f"), + quote = FALSE) [1] 3.8361 3.0000 2.0000 1.0000 5.0000 6.0000 8.4590 [1] -0.8361 -0.8361 -1.3279 0.1475 1.7705 0.6148 0.6148 [1] 0.0000 0.0000 -0.9836 3.9344 -2.3115 0.0000 0.0000 [1] 0.0000 -0.9836 4.9180 -3.1230 2.3115 0.0000 0.0000
> options(op)
> unloadNamespace("splines")
>
>
> ## PR 902 segfaults when warning string is too long, Ben Bolker 2001-04-09
> provoke.bug <- function(n=9000) {
+ warnmsg <- paste(LETTERS[sample(1:26,n,replace=TRUE)],collapse="") + warning(warnmsg) + }
> provoke.bug()
Warning message: In provoke.bug() : TYKHGFOTROVTAJBUYOWPRNTXVBABWOIYPNJIVBJWSRJODUXFUPYENWWAZMKKCEKIKHOEYBJZQBKLNLQDXOODTMUBVHHQYAJKLSXQXTDDELCFOKOVQKSCHPEWWMUHBLMIENAUOQMHLUPKVIPLGOGOLDQODOLLVSLNGBKAWZSVXOOHRGHSSEHJCSODZOUWWUQQHAKJKEIKTHDAUMUCCDTTZQHFUSFTWNPYYRBVMKHGKYGOFFSIDBYODOOVSOSTJHNGVKBYFKQQIDXPTXNJBWNFJFLGDBRHDZKKQXFOSKCQAFRWUDKUSPDOLTAFWCZKWXMSMZBEUOKZGNCVJUFYINCXYBMFWNAHIPGBCSYICIQLUHOBESVNOADWCGZPGPADSBQYCZASLOWOTQIKFWPTOHTOINVNFWJHUTVOAMOVSOBDRCFJWGSCUGOAUIXJZJMMAQNIPQLESTVNHLJGRYHQNPAADACMFVGMQEVLGHEPDEIEKPRVJYAPMJWBWEFWBGZRLJLURMBGGFBMGTOYCYSXPEESPIUIWPKYMCMZYLWHUUKJQWRNDPBMTTBLNHPTSDOUGSVDYTVEAWXDMMSBTKLSMZVVTCVVZBTKPVAAZTIVZFQLYZLFSOPLLPLYVFKKAJKESATLTABKQFVSXKKGJGYMBUIORHBLPZZCMKKIRHKZUIVFNEDXCWHAUJATALGMQCECVQQKLJUXQPIBPETHQDGVUBWDPMOSMZZKPILFAABTMWPEPXUNKRXXEGCUCVUYMYUWKCHSJJANDXBUWAHQUKYKLHPOBTFRNQQHFOZIIANPTYMCGWWVYQMESCLYVSDPZQHBBWJYONYCVJOICUFRLFZLAYWPHVYWDZOADAVUYJZVUQZMXKLYRAEMLZXISXRQDPHLFGQMEHSPDBZJRVGAPVJIQYPNEVFRQBYPWNGPURMMQLPAZKDWOWAWSUWNYFAIRIYUIMKUMAQGTHXWMBPPZIRYORCWNFKXMRHVGJGYKDXJWDJG [... truncated]
> ## segfaulted in 1.2.2, will also on machines without vsnprintf (none now)
>
>
> ## PR#1510 merge with multiple match rows and different names.
> df1 <- data.frame(z = 1:10, m = letters[1:10], w = rnorm(10))
> df2 <- data.frame(x = 1:10, y = rnorm(10), n = letters[1:10])
> merge(df2, df1, by.x = c("x", "n"), by.y = c("z", "m"))
x n y w 1 1 a -0.1310038 -1.6852624 2 10 j 1.8186184 -2.4514910 3 2 b -1.0533970 1.2106916 4 3 c 1.1271659 -1.0471136 5 4 d -0.7278346 0.4385468 6 5 e 0.9353406 -0.3378052 7 6 f -0.4682921 -2.3794764 8 7 g 0.1298211 0.2593449 9 8 h 1.4623528 -1.1030047 10 9 i -0.6821694 0.9223011
> ## failed in 1.5.0
>
>
> ## PR 1524 Problems with paste/unlist
> l <- names(unlist(list(aa = list(bb = 1))))
> l
[1] "aa.bb"
> # this is exactly "aa.bb"
> stopifnot(identical(l, "aa.bb"))
> l2 <- paste(l, "this should be added")
> stopifnot(identical(l2, "aa.bb this should be added"))
> ## 1.5.0 gave l2 printing as l.
>
>
> ## PR 1530 drop inconsistency for data frames
> DF <- data.frame(x = 1:3, y = c("A","D","E"), z = c(6,9,10))
> a1 <- DF[1,1:3]
> xx <- DF[1,]
> a2 <- xx[, 1:3]
> a3 <- DF[1,1:3, drop = TRUE]
> a4 <- xx[, 1:3, drop = TRUE]
> stopifnot(identical(a1, a2), identical(a3, a4))
> ## <= 1.5.0 had a2 == a3.
>
>
> ## PR 1536 rbind.data.frame converts logical to factor
> df <- data.frame(a = 1:10)
> df$b <- df$a < 5
> ddf <- rbind(df, df)
> stopifnot(!is.factor(ddf$b))
> ## 1.5.0 had b as a factor.
>
>
> ## PR 1548 : prettyNum inserted leading commas
> stopifnot(prettyNum(123456, big.mark=",") == "123,456")
>
>
> ## PR 1552: cut.dendrogram
> hc <- hclust(dist(USArrests), "ave")
> cc <- cut(as.dendrogram(hc), h = 20)## error in 1.5.0
>
> ## predict.smooth.spline(*, deriv > 0) :
> x <- (1:200)/32
> ss <- smooth.spline(x, 10*sin(x))
> stopifnot(length(x) == length(predict(ss,deriv=1)$x))# not yet in 1.5.0
>
> ## pweibull(large, log=T):
> stopifnot(pweibull(seq(1,50,len=1001), 2,3, log = TRUE) < 0)
>
> ## part of PR 1662: fisher.test with total one
> fisher.test(cbind(0, c(0,0,0,1)))
Fisher's Exact Test for Count Data data: cbind(0, c(0, 0, 0, 1)) p-value = 1 alternative hypothesis: two.sided
> ## crashed in R <= 1.5.0
>
> stopifnot(Mod(vector("complex", 7)) == 0) # contained garbage in 1.5.0
>
> ## hist.POSIXt with numeric `breaks'
> hist(.leap.seconds, breaks = 5)
> ## error in 1.5.1
>
>
> ##Jonathan Rougier 2002-06-18
> x <- matrix(runif(30), 10, 3)
> poly(x, degree=2)
1.0.0 2.0.0 0.1.0 1.1.0 0.2.0 0.0.1 [1,] 0.28084977 -0.03985730 0.2547644 0.07155051 -0.1240656 0.26026943 [2,] 0.32718706 0.21245677 0.1703099 0.05572320 -0.3043708 0.16631637 [3,] 0.33339531 0.24892926 0.3675572 0.12254184 0.2203821 0.38913237 [4,] 0.29640232 0.04091377 -0.4173666 -0.12370842 0.2810483 -0.07295707 [5,] -0.41259698 0.37913276 -0.2514058 0.10372929 -0.2103128 -0.40950764 [6,] 0.27625006 -0.06298756 -0.1289935 -0.03563447 -0.4082940 0.32100275 [7,] -0.05921096 -0.81706655 -0.2155515 0.01276301 -0.2827586 -0.41820235 [8,] -0.30403855 -0.20566870 0.2532657 -0.07700254 -0.1278443 -0.38974885 [9,] -0.36312620 0.08873201 -0.4667428 0.16948653 0.4767680 0.34000546 [10,] -0.37511183 0.15541555 0.4341630 -0.16285968 0.4794476 -0.18631048 1.0.1 0.1.1 0.0.2 [1,] 0.07309661 0.06630738 -0.1007631 [2,] 0.05441656 0.02832533 -0.3520547 [3,] 0.12973491 0.14302839 0.4035865 [4,] -0.02162464 0.03044984 -0.5485956 [5,] 0.16896162 0.10295261 0.2527466 [6,] 0.08867703 -0.04140728 0.1139256 [7,] 0.02476216 0.09014414 0.2901437 [8,] 0.11849867 -0.09871002 0.1708882 [9,] -0.12346489 -0.15869509 0.1895259 [10,] 0.06988727 -0.08088912 -0.4194031 attr(,"degree") [1] 1 2 1 2 2 1 2 2 2
> ## failed in 1.5.1
>
>
> ## PR#1694 cut with infinite values -> NA (Markus Jäntti)
> cut.off <- c(-Inf, 0, Inf)
> x <- c(-Inf, -10, 0, 10, Inf)
> (res <- cut(x, cut.off, include.lowest=TRUE))
[1] [-Inf,0] [-Inf,0] [-Inf,0] (0, Inf] (0, Inf] Levels: [-Inf,0] (0, Inf]
> stopifnot(!is.na(res))
> (res <- cut(x, cut.off, include.lowest=TRUE, right=FALSE))
[1] [-Inf,0) [-Inf,0) [0, Inf] [0, Inf] [0, Inf] Levels: [-Inf,0) [0, Inf]
> stopifnot(!is.na(res))
> ## outer values were NA in 1.5.1
>
>
> ## ls.str() for function environments:
> Fn <- ecdf(rnorm(50))
> ls.str(envir = environment(Fn))
f : num 0 lenR : int 1 method : int 2 n : int 50 x : num [1:50] -3.14 -1.95 -1.55 -1.43 -1.4 ... y : num [1:50] 0.02 0.04 0.06 0.08 0.1 0.12 0.14 0.16 0.18 0.2 ... yleft : num 0 yright : num 1
> ## failed in 1.5.1
>
>
> ## PR 1767 all.equal.character for non-matching NAs
> all.equal(c("A", "B"), c("A", NA))
[1] "'is.NA' value mismatch: 1 in current 0 in target"
> ## failed in 1.5.1
>
>
> ## failed since at least version 0.90:
> stopifnot(is.character(a12 <- all.equal(1,1:2)),
+ length(a12) == 1,# was 2 till 1.6.2 + a12 == "Numeric: lengths (1, 2) differ")
> ## a12 was *list* of length 3
>
>
> ## related to PR 1577/1608, conversions to character
> DF <- data.frame(b = LETTERS[1:3])
> sapply(DF, class)
b "factor"
> DF[[1]] <- LETTERS[1:3]
> stopifnot(is.character(DF$b)) ## was factor < 1.6.0
> DF <- data.frame(b = LETTERS[1:3])
> DF$b <- LETTERS[1:3]
> stopifnot(is.character(DF$b)) ## always was character.
>
> x <- data.frame(var = LETTERS[1:3]); x$var <- as.character(x$var)
> x[[1]][2] <- "3"
> x
var 1 A 2 3 3 C
> stopifnot(is.character(x$var))
> is.na(x[[1]]) <- 2
> stopifnot(is.character(x$var))
>
> x <- data.frame(var = I(LETTERS[1:3]))
> x[[1]][2] <- "3"
> x
var 1 A 2 3 3 C
> stopifnot(is.character(x$var))
> is.na(x[[1]]) <- 2
> stopifnot(is.character(x$var))
>
> x <- data.frame(var = LETTERS[1:3])
> x[[1]][2] <- "3"
Warning message: In `[<-.factor`(`*tmp*`, 2, value = "3") : invalid factor level, NAs generated
> x
var 1 A 2 <NA> 3 C
> stopifnot(is.factor(x$var))
> is.na(x[[1]]) <- 2
> stopifnot(is.factor(x$var))
>
> x <- data.frame(a = 1:4)
> y <- data.frame(b = LETTERS[1:3])
> y$b <- as.character(y$b)
> z <- merge(x, y, by = 0, all.x = TRUE)
> sapply(z, data.class)
Row.names a b "AsIs" "numeric" "character"
> stopifnot(is.character(z$b))
> ## end of `related to PR 1577/1608'
>
>
> ## logicals became factors < 1.6.0
> stopifnot(sapply(as.data.frame(matrix((1:12)%% 4 == 1, 3,4)),
+ is.logical))
>
>
> ## recycling of factors in data.frame (wish from PR#1713)
> data.frame(x=c("A","B"), y="C") # failed to recycle in 1.5.1
x y 1 A C 2 B C
> X <- data.frame(x=c("A","B"), y=I("C")) # also failed
> XX <- data.frame(x=c("A","B"), y=I(rep("C", 2))) # fine
> stopifnot(identical(X, XX))
> ## Last is false in some S variants.
>
>
> ## test of rank-deficient prediction, as various claims this did not work
> ## on R-help in June 2002
> x1 <- rnorm(100)
> x3 <- rnorm(100)
> y <- rnorm(100)
> train <- data.frame(y=y, x1=x1, x2=x1, x3=x3)
> fit <- lm(y ~ ., train)
> stopifnot(all.equal(predict(fit), predict(fit, train)))
Warning message: In predict.lm(fit, train) : prediction from a rank-deficient fit may be misleading
> ## warning added for 1.6.0
>
>
> ## terms(y ~ .) on data frames with duplicate names
> DF <- data.frame(y = rnorm(10), x1 = rnorm(10), x2 = rnorm(10), x3 = rnorm(10))
> names(DF)[3] <- "x1"
> fit <- try(lm(y ~ ., DF))
Error in terms.formula(formula, data = data) : duplicated name 'x1' in data frame using '.'
> stopifnot(class(fit) == "try-error")
> ## had formula y ~ x1 + x1 + x3 in 1.5.1.
>
>
> ## PR#1759 as.character.octmode() (Henrik Bengtsson)
> x <- 0; class(x) <- "octmode"
> stopifnot(as.character(x) == "0")
> ## gave "" in 1.5.1
>
>
> ## PR#1843 unsplit() with f a list
> g <- factor(round(10 * runif(1000)))
> x <- rnorm(1000) + sqrt(as.numeric(g))
> xg <- split(x, list(g1=g,g2=g))
> res <- unsplit(xg, list(g1=g, g2=g))
> stopifnot(x == res) # can't have rounding error here
> ## gave incorrect result with warning in 1.5.1.
>
>
> ## matching NAs on Solaris (MM 2002-08-02)
> # x <- as.double(NA)
> # identical(x + 0, x)
> # stopifnot(match(x + 0, x, 0) == 1)
> ## match failed on Solaris with some compiler settings
> ## NA+0 is not guaranteed to be NA: could be NaN
>
>
> ## identical on specials (BDR 2002-08-02)
> stopifnot(identical(as.double(NA), NaN) == FALSE)
> ## was identical on 1.5.1
>
>
> ## safe prediction (PR#1840)
> cars.1 <- lm(dist ~ poly(speed, degree = 1), data = cars)
> cars1 <- lm(dist ~ speed, data = cars)
> DF <- data.frame(speed=4)
> stopifnot(all.equal(predict(cars.1, DF), predict(cars1, DF)))
> ## error in 1.5.1
>
>
> ## Ops.data.frame (PR#1889)
> d <- data.frame(1:10)
> d > list(5)
X1.10 [1,] FALSE [2,] FALSE [3,] FALSE [4,] FALSE [5,] FALSE [6,] TRUE [7,] TRUE [8,] TRUE [9,] TRUE [10,] TRUE
> ## failed in 1.5.1
>
>
> ## order(na.last = NA) (PR#1913 / 1906 / 1981)
> x <- 1
> order(x, na.last=NA)
[1] 1
> order(x, x, x, na.last=NA)
[1] 1
> ## failed in 1.5.1, since sapply simplified to a scalar.
> stopifnot(3:1 == order(c(1,2,3,NA), na.last=NA, decreasing=TRUE))
> ## ignored `decreasing' in 1.5.1
> order(c(NA, NA), na.last = NA)
integer(0)
> ## error in 1.5.1, now integer(0)
>
> ## as.list() coerced logical to integer (PR#1926)
> x <- c(TRUE,FALSE,NA)
> stopifnot(identical(x, unlist(as.list(x))))
> ## the 2nd was (1,0,NA) before 1.6
>
>
> ## test of long Error expression in aov(): PR#1315 and later,
> ## and also a cross-check of deparse(, cutoff = 500)
> AA <- structure(list(Y2 = c(10, 9, 0, 0, 5, 6, 0, 0, 8, 9, 0, 0, 4,
+ 4, 0, 0, 12, 11, 2, 0, 6, 7, 0, 0), P2 = structure(c(1L, 1L, + 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, + 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("1", "2", "3"), class = "factor"), + AAAAAAAA = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, + 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L + ), .Label = c("E1", "E2"), class = "factor"), B2 = structure(c(1L, + 1L, 2L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, + 1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L), .Label = c("Red", "Unred" + ), class = "factor"), C2 = structure(c(1L, 2L, 1L, 2L, 1L, + 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, 1L, 2L, + 1L, 2L, 1L, 2L), .Label = c("Agent", "Patient"), class = "factor")), + .Names = c("Y2", "P2", "AAAAAAAA", "B2", "C2"), + class = "data.frame", row.names = 1:24)
> AK2anova.out <-
+ aov(Y2 ~ AAAAAAAA * B2 * C2 + + Error(P2 + P2:AAAAAAAA + P2:B2 + P2:C2 + P2:AAAAAAAA:B2 + + P2:AAAAAAAA:C2 + P2:B2:C2 + P2:AAAAAAAA:B2:C2), + data=AA)
> ## failed in 1.5.1
>
> ## as.character was silently truncating expressions to 60 chars
> q2 <- expression(c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19))
> (q3 <- as.character(q2))
[1] "c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19)"
> stopifnot(nchar(q3) == 68)
> ## was 61 in 1.5.1
>
>
> ## Ops wasn't using NextMethod correctly
>
> ## Ops.ordered:
> or <- ordered(c("a","b","c"))
> stopifnot( (or == "a") == c(TRUE,FALSE,FALSE))
> stopifnot(or == or)
> stopifnot(or != "d")
> ## last was NA NA NA in 1.5.1
>
>
> Ops.foo <- function(e1, e2) {
+ NextMethod() + }
> Ops.baz <- function(e1, e2) {
+ NextMethod() + }
> a <- b <- 1
> class(a) <- c("foo","bar","baz")
> class(b) <- c("foo","baz")
> stopifnot(a == 1,
+ b == a)
> ##(already worked in 1.5.1)
>
>
> ## t() wrongly kept "ts" class and "tsp"
> t(ts(c(a=1, d=2)))
a d [1,] 1 2
> ## gave error while printing in 1.5.1
> at <- attributes(t(ts(cbind(1, 1:20))))
> stopifnot(length(at) == 2,
+ at$dim == c(2, 20), + at$dimnames[[1]] == paste("Series", 1:2))
> ## failed in 1.5.1
>
>
> ## Nextmethod from anonymous function (PR#1211)
> try( get("print.ts")(1) )# -> Error
Time Series: Start = 1 End = 1 Frequency = 1 Error in NextMethod("print", x, quote = FALSE, right = TRUE, ...) : 'NextMethod' called from an anonymous function
> ## seg.faulted till 1.5.1
>
>
> ## cbind/rbind should work with NULL only args
> stopifnot(is.null(cbind(NULL)), is.null(cbind(NULL,NULL)),
+ is.null(rbind(NULL)), is.null(rbind(NULL,NULL)))
> ## gave error from 0.63 till 1.5.1
>
>
> ## seq.POSIXt() had rounding problem:
> stopifnot(4 == length(seq(from=ISOdate(2000,1,1), to=ISOdate(2000,1,4),
+ length.out=4)))
> ## length was 5 till 1.6.0
>
>
> ## loess has a limit of 4 predictors (John Deke on R-help, 2002-09-16)
> data1 <- array(runif(500*5),c(500,5))
> colnames(data1) <- c("x1","x2","x3","x4","x5")
> y <- 3+2*data1[,"x1"]+15*data1[,"x2"]+13*data1[,"x3"]-8*data1[,"x4"]+14*data1[,"x5"]+rnorm(500)
> data2 <- as.data.frame(cbind(y,data1))
> result4 <- loess(y~x1+x2+x3+x4,data2)
> try(result5 <- loess(y~x1+x2+x3+x4+x5,data2))
Error in simpleLoess(y, x, w, span, degree, parametric, drop.square, normalize, : only 1-4 predictors are allowed
> ## segfaulted in 1.5.1
>
>
> ## format.AsIs was not handling matrices
> jk <- data.frame(x1=2, x2=I(matrix(0,1,2)))
> jk
x1 x2.1 x2.2 1 2 0 0
> ## printing failed in 1.5.1
>
>
> ## eigenvectors got irrelevant names (PR#2116)
> set.seed(1)
> A <- matrix(rnorm(20), 5, 5)
> dimnames(A) <- list(LETTERS[1:5], letters[1:5])
> (ev <- eigen(A)$vectors)
[,1] [,2] [,3] [,4] [1,] -0.44539808-0.0028723i -0.44539808+0.0028723i 0.1142333+0i 0.2637591+0i [2,] -0.03511148+0.0970809i -0.03511148-0.0970809i -0.1939796+0i -0.7185193+0i [3,] -0.04533792-0.5490862i -0.04533792+0.5490862i -0.2252482+0i -0.3641295+0i [4,] 0.64015861+0.0000000i 0.64015861+0.0000000i -0.7389874+0i -0.1740621+0i [5,] -0.27222633+0.0591049i -0.27222633-0.0591049i -0.5937033+0i -0.5012716+0i [,5] [1,] 7.071068e-01+0i [2,] 6.685221e-17+0i [3,] 5.372014e-17+0i [4,] 3.230410e-16+0i [5,] -7.071068e-01+0i
> stopifnot(is.null(colnames(ev)))
> ## had colnames in 1.6.0
>
>
> ## pretty was not pretty {because seq() isn't} (PR#1032 and D.Brahm)
> stopifnot(pretty(c(-.1, 1))[2] == 0, ## [2] was -2.775558e-17
+ pretty(c(-.4,.8))[3] == 0, ## [3] was 5.551115e-17 + pretty(100+ c(0, pi*1e-10))[4] > 100,# < not too much rounding! + pretty(c(2.8,3))[1] == 2.8)
> ## last differed by 4.44e-16 in R 1.1.1
>
>
> ## add1 was giving misleading message when scope was nonsensical.
> counts <- c(18,17,15,20,10,20,25,13,12)
> fit <- glm(counts ~ 1, family=poisson)
> res <- try(add1(fit, ~ .))
Error in add1.glm(fit, ~.) : no terms in scope for adding to object
> ## error in 1.6.0 was
> ## `Error in if (ncol(add) > 1) { : missing value where logical needed'
> stopifnot(length(grep("missing value", res)) == 0)
>
>
> ## stripchart with NAs (PR#2018)
> Sepal <- iris$Sepal.Length
> Sepal[27] <- NA
> stripchart(Sepal ~ iris$Species, method="stack")
> ## failed in 1.6.1
>
>
> ## losing is.object bit internally (PR#2315)
> stopifnot(is.ts(log(as.ts(1:10))))
> ## failed for integer original as here in 1.6.1.
>
>
> ## formatC ignored rounding up (PR#2299)
> stopifnot(formatC(99.9, 1, format="fg") == "100")
> stopifnot(formatC(99.9, 2, format="fg") == "100")
> stopifnot(formatC(99.9, 3, format="fg") == "99.9")
> ## gave exponential format on 1.6.1
>
>
> ## full/partial matching in attr.
> tmp <- list(id=1)
> attr(tmp,"n.ch") <- 2
> attr(tmp,"n") <- 1
> attributes(tmp)
$names [1] "id" $n.ch [1] 2 $n [1] 1
> (res <- attr(tmp, "n"))
[1] 1
> stopifnot(length(res) == 1 && res == 1)
> ## gave NULL in 1.6.1
>
>
> ## Undocumented line limit in system(intern=TRUE)
> ## Naoki Takebayashi <ntakebay_at_bio.indiana.edu> 2002-12-07
> tmp <- tempfile()
> long <- paste(rep("0123456789", 20), collapse="")
> cat(long, "\n", sep="", file=tmp)
> # system(intern=TRUE) depends on popen.
> junk <- try(system(paste("cat", tmp), intern = TRUE))
> if(!inherits(junk, "try-error"))
+ stopifnot(length(junk) == 1, nchar(junk[1]) == 200)
> ## and split truncated on 1.6.1
>
>
> ## missing group generics for `difftime' (related to PR#2345)
> x <- as.difftime(c("0:3:20", "11:23:15"))
> y <- ISOdate(2001, 4, 26) - ISOdate(2001, 2, 26)
> x + x
Time differences in mins [1] 6.666667 1366.500000 attr(,"tzone") [1] ""
> 2*x
Time differences in mins [1] 6.666667 1366.500000 attr(,"tzone") [1] ""
> x < y
[1] TRUE TRUE
> x < 100
[1] TRUE FALSE
> ## all but last failed in R < 1.7.0
>
>
> ## PR 2358 (part)
> mm <- 1:2
> names(mm)[2] <- 'y'
> (mm <- c(mm, 3))
<NA> y 1 2 3
> stopifnot(is.na(names(mm)[1]))
> ## 1.6.1 had "NA"
>
>
> ## PR 2357
> a <- matrix(c(1,2,3,-1,-2,3),2,3,dimnames=list(c("A","B"),NULL))
> (z <- pmax(a, 0))
[,1] [,2] [,3] A 1 3 0 B 2 0 3
> stopifnot(identical(dimnames(z), dimnames(a)))
> # further checks
> a <- matrix(c(1,2,3,-1,-2,3),2,3,dimnames=list(c("A","B"),1:3))
> (z <- pmax(a, 0))
1 2 3 A 1 3 0 B 2 0 3
> stopifnot(identical(dimnames(z), dimnames(a)))
> a <- matrix(c(1,2,3,-1,-2,3),2,3,dimnames=list(NULL, letters[1:3]))
> (z <- pmax(a, 0))
a b c [1,] 1 3 0 [2,] 2 0 3
> stopifnot(identical(dimnames(z), dimnames(a)))
> ## 1.6.1 only transferred dimnames if both components were non-null
>
>
> ## internal conversion to factor in type.convert was not right
> ## if a character string NA was involved.
> x <- c(NA, "NA", "foo")
> (z <- type.convert(x))
[1] <NA> <NA> foo Levels: foo
> stopifnot(identical(levels(z), "foo"))
> (z <- type.convert(x, na.strings=character(0)))
[1] <NA> NA foo Levels: NA foo
> stopifnot(identical(levels(z), sort(c("foo", "NA"))))
> (z <- type.convert(x, na.strings="foo"))
[1] <NA> NA <NA> Levels: NA
> stopifnot(identical(levels(z), "NA"))
> ## extra level in 1.6.1
>
>
> ## related example
> tmp <- tempfile()
> cat(c("1", "foo", "\n", "2", "NA", "\n"), file = tmp)
> (z <- read.table(tmp, na.strings="foo"))
V1 V2 1 1 <NA> 2 2 NA
> unlink(tmp)
> stopifnot(identical(levels(z$V2), "NA"),
+ identical(is.na(z$V2), c(TRUE, FALSE)))
> ## 1.6.1 had V2 as NA NA.
>
>
> ## PR#2396, parsing and pushbacks.
> tmp <- tempfile()
> cat( c( "1", "a+b", "2"), file=tmp, sep="\n")
> open(tcon <- file(tmp))
> readLines(tcon, n=1)
[1] "1"
> pushBack("a1+b1", tcon)
> parse(file=tcon, n=1)
expression(a1 + b1)
> close(tcon)
> unlink(tmp)
> ## failed with syntax error in 1.6.1
>
>
> ## NAs in max.col
> a <- matrix(1, 3, 3)
> a[1,2] <- NA
> (z <- max.col(a))
[1] NA 1 1
> stopifnot(is.na(z[1]))
> ## gave (randomly) 1 or 3 in 1.6.1
>
>
> ## PR#2469: read.table on MacOS CR-terminated files.
> tmp <- tempfile()
> x <- c("aaa", "bbb", "ccc")
> cat(x, sep="\r", file=tmp)
> con <- file(tmp)
> open(con)
> line <- readLines(con, 1)
> pushBack(line, con)
> (y <- readLines(con))
[1] "aaa" "bbb" "ccc" Warning message: In readLines(con) : incomplete final line found on '/tmp/RtmppYw1SC/file587720a0'
> close(con)
> unlink(tmp)
> stopifnot(identical(x, y))
> ## pushback problems in 1.6.2 only
>
>
> ## dimnames in solve(): not a bug just an improvement in 1.7.0
> A <- diag(3)
> dimnames(A) <- list(LETTERS[1:3], letters[1:3])
> (B <- solve(A))
A B C a 1 0 0 b 0 1 0 c 0 0 1
> stopifnot(identical(colnames(B), rownames(A)))
> ## R < 1.7.0 had no colnames for B, and S has the colnames of A.
> stopifnot(all.equal(t(B), solve(t(A))))
> ## test here is of dimnames
>
>
> ## PR#2507: extracting 0-length dimensions for arrays
> dn <- list(LETTERS[1:2], letters[1:3], paste("t",1:4,sep=""))
> A. <- array(1:24, dim = 2:4, dimnames = dn)
> str(A.[1, 0, 2 ])
int(0)
> str(A.[1, 0, 2, drop = FALSE])
int[1, 0 , 1] - attr(*, "dimnames")=List of 3 ..$ : chr "A" ..$ : NULL ..$ : chr "t2"
> ## both gave errors in 1.6.2
>
> plot(sf <- stepfun(2, 3:4))
> ## failed in 1.6.2
>
>
> ## PR#2541, cbind (and rbind) with zero-length components
> y <- matrix(0,1,0)
> cbind(y, integer(0))
[1,]
> y <- matrix(0,0,1)
> rbind(y, integer(0))
[,1]
> ## gave fatal error in 1.6.2, since miscalculated no of rows/cols.
>
>
> ## PR#2518 multiple objects in AIC.default.
> lm1 <- lm(y ~ x, list(x=1:10, y=jitter(1:10)))
> lm2 <- lm(y ~ x, list(x=1:10, y=jitter(1:10)))
> AIC(lm1, lm2)
df AIC lm1 3 -12.18185 lm2 3 -14.47102
> AIC(lm1, lm2, k=2)
df AIC lm1 3 -12.18185 lm2 3 -14.47102
> ## second failed in 1.6.2
>
>
> ## PR#2591 unique on ordered factor
> f <- ordered(month.name, levels=month.name)
> (uf <- unique(f))
[1] January February March April May June July [8] August September October November December 12 Levels: January < February < March < April < May < June < ... < December
> stopifnot(is.ordered(uf))
> ## gave factor in 1.6.2
>
>
> ## PR#2587 coercion of length-0 vectors
> x <- numeric(0)
> x[1] <- NA
> stopifnot(identical(mode(x), "numeric"))
> ##
>
>
> ## PR#2586 labelling in alias()
> Y <- c(0,1,2)
> X1 <- c(0,1,0)
> X2 <- c(0,1,0)
> X3 <- c(0,0,1)
> (res <- alias(lm(Y ~ X1 + X2 + X3)))
Model : Y ~ X1 + X2 + X3 Complete : (Intercept) X1 X3 X2 0 1 0
> stopifnot(identical(rownames(res[[2]]), "X2"))
> ## the error was in lm.(w)fit
>
>
> ## coercion lost the object bit in [<-
> x <- I(TRUE)
> is.object(x)
[1] TRUE
> x[2] <- "N"
> stopifnot(is.object(x))
> ## failed in 1.6.2
>
>
> ## check inherits now works for basic classes:
> x <- 1:3
> is.object(x) # FALSE
[1] FALSE
> stopifnot(inherits(x, "integer"))
> ## 2003-Mar-12 it did not
>
>
> ## rank() is numeric also for NA char vectors
> stopifnot(is.numeric(rk <- rank(c("ch","c", NA))),
+ all(rk == c(2,1,3)))
> ## did not from R 1.2 -- 1.6
>
>
> ## table() should by default keep NA levels of factors
> i <- c(1:2,NA); fi <- factor(i, exclude = NULL)
> stopifnot(identical(as.character(i), dimnames(table(fi))[[1]]))
> ## not in 2003-Mar-10 unstable
>
>
> ## [lm.]influence() for multivariate lm :
> n <- 32
> Y <- matrix(rnorm(3 * n), n, 3)
> X <- matrix(rnorm(5 * n), n, 5)
> infm <- lm.influence(mod <- lm(Y ~ X))
> ## failed up to 2003-03-29 (pre 1.7.0)
> im1 <- influence.measures(mod)
> stopifnot(identical(unname(im1$infmat[,1:6]),
+ unname(dfbetas(mod))))
>
> ## rbind.data.frame with character and ordered columns
> A <- data.frame(a=1)
> A$b <- "A"
> B <- data.frame(a=2)
> B$b <- "B"
> AB <- rbind(A,B)
> (cl <- sapply(AB, class))
a b "numeric" "character"
> stopifnot(cl[2] == "character") # was factor in 1.6.2
>
> A <- data.frame(a=1:3, b=ordered(letters[1:3]))
> B <- data.frame(a=7:9, b=ordered(letters[7:9]))
> AB <- rbind(A,B)
> (cl <- sapply(AB, class))
$a [1] "integer" $b [1] "ordered" "factor"
> stopifnot(cl$b[1] == "ordered") # was factor in 1.6.2
> C <- data.frame(a=4:6, b=letters[4:6])
> ABC <- rbind(AB, C)
> (cl <- sapply(ABC, class))
a b "integer" "factor"
> stopifnot(cl[2] == "factor")
>
> A <- data.frame(a=1)
> A$b <- "A"
> B <- data.frame(a=2, b="B")
> (AB <- rbind(A,B))
a b 1 1 A 2 2 B
> (cl <- sapply(AB, class))
a b "numeric" "character"
> stopifnot(cl[2] == "character")
>
> A <- data.frame(a=1, b="A")
> B <- data.frame(a=2)
> B$b <- "B"
> (AB <- rbind(A,B))
a b 1 1 A 2 2 B
> (cl <- sapply(AB, class))
a b "numeric" "factor"
> stopifnot(cl[2] == "factor")
> A <- data.frame(a=c("A", NA, "C"))
> B <- data.frame(a=c("B", NA, "C"))
> (AB <- rbind(A,B))
a 1 A 2 <NA> 3 C 4 B 5 <NA> 6 C
> stopifnot(levels(AB$a) == c("A", "C", "B"))
> A <- data.frame(a=I(c("A", NA, "C")))
> B <- data.frame(a=I(c("B", NA, "C")))
> (AB <- rbind(A,B))
a 1 A 2 <NA> 3 C 4 B 5 <NA> 6 C
> (cl <- sapply(AB, class))
a "AsIs"
> stopifnot(cl[1] == "AsIs")
>
> A <- data.frame(a=1)
> A$b <- "A"
> B <- data.frame(a=2, b=I("B"))
> (AB <- rbind(A,B))
a b 1 1 A 2 2 B
> (cl <- sapply(AB, class))
a b "numeric" "character"
> stopifnot(cl[2] == "character")
>
> A <- data.frame(a=1, b="A")
> B <- data.frame(a=2, b=I("B"))
> (AB <- rbind(A,B))
a b 1 1 A 2 2 B
> (cl <- sapply(AB, class))
a b "numeric" "factor"
> stopifnot(cl[2] == "factor")
> ##
>
>
> ## hclust(), as.hclust.twins(), agnes() consistency
> x <- matrix(rnorm(30), ncol=3) # no observation names
> xn <- x; rownames(xn) <- letters[10:1]# has obs. names
> hc <- hclust(dist(x), method="complete")
> hcn <- hclust(dist(xn), method="complete")
> iC1 <- !names(hc) %in% c("labels", "call")
> stopifnot(identical(hc, hhc <- as.hclust(hc)),
+ identical(hhc, as.hclust(hhc)), + identical(hc[iC1], hcn[iC1]), + identical(hcn$labels, rownames(xn)) + )
>
> if(require(cluster)) { # required package
+ ag <- agnes(x, method="complete") + hcag <- as.hclust(ag) + agn <- agnes(xn, method="complete") + hcagn <- as.hclust(agn) + iC2 <- !names(hcag) %in% c("labels", "call") + stopifnot(identical(hcagn[iC2], hcag[iC2]), + identical(hcagn$labels, hcn$labels), + all.equal(hc$height, hcag$height, tol = 1e-12), + all(hc$merge == hcag$merge | hc$merge == hcag$merge[ ,2:1]) + ) + detach("package:cluster") + } Loading required package: cluster
> ## as.hclust.twins() lost labels and more till (incl) 1.6.2
>
>
> ## PR#2867 qr(LAPACK=TRUE) didn't always pivot in 1.7.0
> set.seed(1)
> X <- matrix(rnorm(40),10,4)
> X[,1] <- X[,2]
> (qrx <- qr(X, LAPACK=TRUE))
$qr [,1] [,2] [,3] [,4] [1,] -3.303633764 -1.58110829 -0.5051549 -3.303634e+00 [2,] 0.080957351 -2.42846765 0.1577757 1.315930e-17 [3,] -0.129010810 0.13200671 -2.3978478 -1.145583e-16 [4,] -0.459918806 -0.27907528 0.2235442 -2.181240e-16 [5,] 0.233610381 0.01189407 -0.5868205 3.617237e-02 [6,] -0.009331202 -0.01090350 -0.1305361 3.176185e-02 [7,] -0.003362174 -0.04899595 -0.1325145 2.909434e-02 [8,] 0.196003091 -0.65180990 -0.2249207 -2.962304e-01 [9,] 0.170540069 -0.30068271 0.2137623 -9.694394e-02 [10,] 0.123333364 0.03643290 0.1780006 -1.470420e-01 $rank [1] 4 $qraux [1] 1.457612 1.238725 1.284606 1.782633 $pivot [1] 1 3 4 2 attr(,"useLAPACK") [1] TRUE attr(,"class") [1] "qr"
> stopifnot(any(qrx$pivot != 1:4)) # check for pivoting
> ##
>
>
> ## rownames<- did not work on an array with > 2 dims in 1.7.0
> A <- array(1:12, dim=c(2, 3, 2))
> rownames(A) <- letters[1:2]
> A <- array(1:12, dim=c(2, 3, 2))
> colnames(A) <- 1:3
> ## failed in 1.7.0
>
>
> ## predict on constant model, PR#2958
> res <- model.frame(~1, data.frame(x = 1:5))
> stopifnot(nrow(res) == 5)
> res <- predict(lm(y ~ 1, data = data.frame(y = rep(0:3, c(5,9,7,1)))),
+ newdata = data.frame(x = 1:5))
> stopifnot(length(res) == 5)
> res <- predict(glm(y ~ 1, family = poisson,
+ data = data.frame(y = rep(0:3, c(5,9,7,1)))), + newdata = data.frame(x = 1:5), type = "r")
> stopifnot(length(res) == 5)
> ## all length one in 1.7.0
>
>
> ## PR#3035 problems with sep > ASCII(127)
> f <- tempfile()
> cat("x¦a¦b¦c¦d", "1¦7¦13¦19¦25", "2¦8¦14¦20¦26", "3¦9¦15¦21¦27",
+ "4¦10¦16¦22¦28", "5¦11¦17¦23¦29", "6¦12¦18¦24¦30", sep="\n", file=f)
> read.table(f, header = TRUE, sep ="¦")
x a b c d 1 1 7 13 19 25 2 2 8 14 20 26 3 3 9 15 21 27 4 4 10 16 22 28 5 5 11 17 23 29 6 6 12 18 24 30
> ## failed in 1.7.0
>
>
> ## PR#2993 need to consider delta=NULL in power.t.test{ctest}
> power.t.test(n=10, delta=NULL, power=.9, alternative="two.sided")
Two-sample t test power calculation n = 10 delta = 1.533670 sd = 1 sig.level = 0.05 power = 0.9 alternative = two.sided NOTE: n is number in *each* group
> ## failed in 1.7.0
>
>
> ## PR#3221 eigenvectors should be a matrix even in the 1x1 case
> A <- matrix(1)
> stopifnot(is.matrix(eigen(A)$vectors))
> stopifnot(is.matrix(eigen(A, EISPACK = TRUE)$vectors))
> # stopifnot(is.matrix(La.eigen(A)$vectors)) defunct in 2.0.0
> ## gave vector in 1.7.0
>
>
> ## [[<-.data.frame
> testdata <- data.frame(a=1:2, b = rep(NA, 2))
> try(testdata[["a"]] <- strptime(c("31121991", "31121991"), "%d%m%Y"))
Error in `[[<-.data.frame`(`*tmp*`, "a", value = structure(list(sec = c(0, : replacement has 9 rows, data has 2
> stopifnot(inherits(.Last.value, "try-error"))
> ## succeeded in 1.7.0
>
>
> ## pacf on n x 1 matrix: Paul Gilbert, R-devel, 2003-06-18
> z <- as.ts(matrix(rnorm(100), , 1))
> class(z) # not "mts"
[1] "ts"
> is.matrix(z) # TRUE in 1.7.1
[1] TRUE
> pacf(z)
> pacf(matrix(rnorm(100), , 1))
> ## both failed in 1.7.1.
>
>
> ## lsfit was not setting residuals in the rank=0 case
> fit <- lsfit(matrix(0, 10, 1), 1:10, intercept=FALSE)
Warning message: In lsfit(matrix(0, 10, 1), 1:10, intercept = FALSE) : 'X' matrix was collinear
> stopifnot(fit$residuals == 1:10)
> ## zero residuals in 1.7.1.
>
>
> ## interval calculations on predict.lm
> x <- 1:10
> y <- rnorm(10)
> predict(lm(y ~ x), type="terms", interval="confidence")
$fit x 1 0.27655518 2 0.21509848 3 0.15364177 4 0.09218506 5 0.03072835 6 -0.03072835 7 -0.09218506 8 -0.15364177 9 -0.21509848 10 -0.27655518 attr(,"constant") [1] 0.03028722 $se.fit x 1 0.52124304 2 0.40541125 3 0.28957946 4 0.17374768 5 0.05791589 6 0.05791589 7 0.17374768 8 0.28957946 9 0.40541125 10 0.52124304 $lwr x 1 -0.9254334 2 -0.7197815 3 -0.5141297 4 -0.3084778 5 -0.1028259 6 -0.1642826 7 -0.4928479 8 -0.8214132 9 -1.1499785 10 -1.4785438 attr(,"constant") [1] 0.03028722 $upr x 1 1.4785438 2 1.1499785 3 0.8214132 4 0.4928479 5 0.1642826 6 0.1028259 7 0.3084778 8 0.5141297 9 0.7197815 10 0.9254334 attr(,"constant") [1] 0.03028722 $df [1] 8 $residual.scale [1] 1.052094
> ##
>
>
> ## 0-level factors
> f <- factor(numeric(0))
> sort(f)
factor(0) Levels:
> unique(f)
factor(0) Levels:
> ## both failed in 1.7.1
>
>
> ## data failed with some multiple inputs
> data(cars, women)
> ## failed in 1.7.1
>
>
> ## body() and formals() looked in different places
> bar <- function(x=NULL)
+ { + foo <- function(y=3) testit() + print(formals("foo")) + print(body("foo")) + }
> bar()
$y [1] 3 testit()
> ## the call to body() failed in 1.7.0
>
>
> ## string NAs shouldn't have any internal structure.(PR#3078)
> a <- c("NA", NA, "BANANA")
> na <- NA_character_
> a1 <- substr(a,1,1)
> stopifnot(is.na(a1)==is.na(a))
> a2 <- substring(a,1,1)
> stopifnot(is.na(a2)==is.na(a))
> a3 <- sub("NA","na",a)
> stopifnot(is.na(a3)==is.na(a))
> a3 <- gsub("NA","na",a)
> stopifnot(is.na(a3)==is.na(a))
> substr(a3, 1, 2) <- "na"
> stopifnot(is.na(a3)==is.na(a))
> substr(a3, 1, 2) <- na
> stopifnot(all(is.na(a3)))
> stopifnot(agrep("NA", a) == c(1, 3))
> stopifnot(grep("NA", a) == c(1, 3))
> stopifnot(grep("NA", a, perl=TRUE) == c(1, 3))
> stopifnot(all(is.na(agrep(na, a))))
> stopifnot(all(is.na(grep(na, a))))
> stopifnot(all(is.na(grep(na, a, perl=TRUE))))
> a4 <- abbreviate(a)
> stopifnot(is.na(a4) == is.na(a))
> a5 <- chartr("NA", "na", a)
> stopifnot(is.na(a5) == is.na(a))
> a6 <- gsub(na, "na", a)
> stopifnot(all(is.na(a6)))
> a6a <- gsub("NANA", na, a)
> stopifnot(is.na(a6a)==c(FALSE, TRUE, TRUE))
> a7 <- a; substr(a7, 1, 2) <- "na"
> stopifnot(is.na(a7) == is.na(a))
> a8 <- a; substr(a8, 1, 2) <- na
> stopifnot(all(is.na(a8)))
> stopifnot(identical(a, toupper(tolower(a))))
> a9 <- strsplit(a, "NA")
> stopifnot(identical(a9, list("", na ,c("BA",""))))
> a9 <- strsplit(a, "NA", fixed = TRUE)
> stopifnot(identical(a9, list("", na ,c("BA",""))))
> a9 <- strsplit(a, "NA", perl = TRUE)
> stopifnot(identical(a9, list("", na ,c("BA",""))))
> a10 <- strsplit(a, na)
> stopifnot(identical(a10, as.list(a)))
> ## but nchar doesn't fit this pattern
> stopifnot(all(!is.na(nchar(a))))
> ## NA and "NA" were not distinguished in 1.7.x
>
>
> ## coercing 0-length generic vectors
> as.double(list())
numeric(0)
> as.integer(list())
integer(0)
> as.logical(list())
logical(0)
> as.complex(list())
complex(0)
> as.character(list())
character(0)
> ## all but the last failed in 1.7.x
>
>
> ## help on reserved words
> ## if else repeat while function for in next break will fail
> if(.Platform$OS.type == "windows") options(pager="console")
> for(topic in c("TRUE", "FALSE", "NULL", "NA", "Inf", "NaN",
+ "NA_integer_", "NA_real_", "NA_complex_", "NA_character_")) { + eval(parse(text=paste("?", topic, sep=""))) + eval(parse(text=paste("help(", topic, ")", sep=""))) + }
> ## ?NULL and all the help calls fail in 1.7.x
>
>
> ## row names in data frames
> xx <- structure(1:3, names=letters[1:3])
> data.frame(xx)
xx a 1 b 2 c 3
> data.frame(xx, yy=1:6) # failed with misleading message in 1.7.x
xx yy 1 1 1 2 2 2 3 3 3 4 1 4 5 2 5 6 3 6 Warning message: In data.frame(xx, yy = 1:6) : row names were found from a short variable and have been discarded
> data.frame(xx, yy=1:6, row.names=NULL) # no warning
xx yy 1 1 1 2 2 2 3 3 3 4 1 4 5 2 5 6 3 6
> ##
>
>
> ## empty paste
> stopifnot(length(paste(character(0), character(0))) == 0) # was ""
> stopifnot(identical(paste(character(0), character(0), collapse="+"), ""))
> ##
>
>
> ## concatenation of make.names (Tom Minka, R-help, 2003-06-17)
> a1 <- make.names(c("a", "a", "a"), unique=TRUE)
> a2 <- make.names(c(make.names(c("a", "a"), unique=TRUE), "a"), unique=TRUE)
> stopifnot(identical(a1, a2))
>
> df1 <- rbind(data.frame(x=1), data.frame(x=2), data.frame(x=3))
> df2 <- rbind(rbind(data.frame(x=1), data.frame(x=2)), data.frame(x=3))
> stopifnot(identical(df1, df2))
> ##
>
>
> ## PR#3280 data.frame(check.name=FALSE) was not always respected
> DF <- data.frame(list("a*" = 3), check.names = FALSE)
> stopifnot(identical(names(DF), "a*"))
> ## gave "a." in 1.7.1
>
>
> ## functions using get() were not always looking for functions or in the
> ## right place
> x <- factor(1:3)
> contrasts(x) <- "ctr"
> test <- function(x)
+ { + ctr <- contr.treatment + contrasts(x) # failed in 1.7.1 + }
> test(x)
2 3 1 0 0 2 1 0 3 0 1
> ##
>
> ## get/exists were ignoring mode in base
> stopifnot(exists(".Device"))
> stopifnot(!exists(".Device", mode="function")) # was true in 1.7.1
> ##
>
>
> ## inadvertent recursive indexing bug (PR#3324)
> x <- list(a=1:3, b=2:4)
> try(x[[c("c", "d")]])
Error in x[[c("c", "d")]] : no such index at level 1
> try(x[[c("c", "d")]] <- NA)
Error in `[[<-`(`*tmp*`, c("c", "d"), value = NA) : no such index at level 1
> ## both segfaulted in 1.7.1
>
>
> ## empty indexing of data frames (PR#3532)
> x <- data.frame(x = "1.5")
> num <- numeric(0)
> x[num] <- list()
> x[, num] <- list()
> ## x[[num]] is rightly an error
> ## x[num] etc failed in 1.7.x.
>
>
> ## .Random.seed was searched for with inherits=TRUE
> rm(.Random.seed)
> attach(list(.Random.seed=c(0:4)))
> runif(1)
[1] 0.7070356
> detach(2)
> (new <- RNGkind())
[1] "Mersenne-Twister" "Inversion"
> stopifnot(identical(new, c("Mersenne-Twister", "Inversion")))
> stopifnot(identical(find(".Random.seed"), ".GlobalEnv"))
> ## took from and assigned to list in 1.7.x.
>
>
> ## PR#3750
> y <- c(1, NA, NA, 7)
> identical(y, qqnorm(y, plot.it=FALSE)$y)
[1] TRUE
> ## qqnorm() used to drop NA's in its result till 1.7.x
>
>
> ## PR#3763
> d0 <- ISOdate(2001,1,1)[0] # length 0 POSIX
> (rd0 <- round(d0, "day"))
character(0)
> stopifnot(identical(rd0, as.POSIXlt(d0)))
> ## 2nd line gave floating point exception (in format(*)!)
>
>
> ## New det() function
> stopifnot(det(m <- cbind(1, c(1, 1))) == 0,
+ determinant(m )$mod == -Inf, + determinant(m, log=FALSE)$mod == 0)
> ## gave error for singular matrices in earlier Aug.2003
>
>
> ## tests of model fitting in the presence of non-syntactic names
> names(swiss)[6] <- "Infant Mortality"
> (lm1 <- lm(Fertility ~ ., data = swiss))
Call: lm(formula = Fertility ~ ., data = swiss) Coefficients: (Intercept) Agriculture Examination Education 66.9152 -0.1721 -0.2580 -0.8709 Catholic `Infant Mortality` 0.1041 1.0770
> formula(lm1) # is expanded out
Fertility ~ Agriculture + Examination + Education + Catholic + `Infant Mortality`
> slm1 <- step(lm1)
Start: AIC=190.69 Fertility ~ Agriculture + Examination + Education + Catholic + `Infant Mortality` Df Sum of Sq RSS AIC - Examination 1 53.03 2158.1 189.86 <none> 2105.0 190.69 - Agriculture 1 307.72 2412.8 195.10 - `Infant Mortality` 1 408.75 2513.8 197.03 - Catholic 1 447.71 2552.8 197.75 - Education 1 1162.56 3267.6 209.36 Step: AIC=189.86 Fertility ~ Agriculture + Education + Catholic + `Infant Mortality` Df Sum of Sq RSS AIC <none> 2158.1 189.86 - Agriculture 1 264.18 2422.2 193.29 - `Infant Mortality` 1 409.81 2567.9 196.03 - Catholic 1 956.57 3114.6 205.10 - Education 1 2249.97 4408.0 221.43
> 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.0 190.69 I(Education^2) 1 11.819 2093.2 192.43 Agriculture:Examination 1 10.667 2094.4 192.45 Agriculture:Education 1 1.827 2103.2 192.65 Agriculture:Catholic 1 75.048 2030.0 190.99 Agriculture:`Infant Mortality` 1 4.438 2100.6 192.59 Examination:Education 1 48.694 2056.3 191.59 Examination:Catholic 1 40.758 2064.3 191.77 Examination:`Infant Mortality` 1 65.857 2039.2 191.20 Education:Catholic 1 278.189 1826.8 186.03 Education:`Infant Mortality` 1 92.950 2012.1 190.57 Catholic:`Infant Mortality` 1 2.359 2102.7 192.64
> step(lm1, scope=~ I(Education^2) + .^2)
Start: AIC=190.69 Fertility ~ Agriculture + Examination + Education + Catholic + `Infant Mortality` Df Sum of Sq RSS AIC + Education:Catholic 1 278.19 1826.9 186.03 - Examination 1 53.03 2158.1 189.86 + Education:`Infant Mortality` 1 92.95 2012.1 190.57 <none> 2105.0 190.69 + Agriculture:Catholic 1 75.05 2030.0 190.99 + Examination:`Infant Mortality` 1 65.86 2039.2 191.20 + Examination:Education 1 48.69 2056.3 191.59 + Examination:Catholic 1 40.76 2064.3 191.77 + I(Education^2) 1 11.82 2093.2 192.43 + Agriculture:Examination 1 10.67 2094.4 192.45 + Agriculture:`Infant Mortality` 1 4.44 2100.6 192.59 + Catholic:`Infant Mortality` 1 2.36 2102.7 192.64 + Agriculture:Education 1 1.83 2103.2 192.65 - Agriculture 1 307.72 2412.8 195.10 - `Infant Mortality` 1 408.75 2513.8 197.03 - Catholic 1 447.71 2552.8 197.75 - Education 1 1162.56 3267.6 209.36 Step: AIC=186.03 Fertility ~ Agriculture + Examination + Education + Catholic + `Infant Mortality` + Education:Catholic Df Sum of Sq RSS AIC <none> 1826.8 186.03 + Examination:Catholic 1 74.58 1752.3 186.07 - Examination 1 98.63 1925.5 186.50 + Agriculture:`Infant Mortality` 1 25.37 1801.5 187.37 + Examination:`Infant Mortality` 1 23.88 1803.0 187.41 + Education:`Infant Mortality` 1 17.84 1809.0 187.57 + Examination:Education 1 11.78 1815.1 187.73 + Agriculture:Examination 1 8.12 1818.7 187.82 + Catholic:`Infant Mortality` 1 1.51 1825.3 187.99 + I(Education^2) 1 0.65 1826.2 188.01 + Agriculture:Education 1 0.64 1826.2 188.01 + Agriculture:Catholic 1 0.11 1826.8 188.03 - Agriculture 1 250.40 2077.2 190.07 - Education:Catholic 1 278.19 2105.0 190.69 - `Infant Mortality` 1 533.77 2360.6 196.08 Call: lm(formula = Fertility ~ Agriculture + Examination + Education + Catholic + `Infant Mortality` + Education:Catholic, data = swiss) Coefficients: (Intercept) Agriculture Examination Education 59.50006 -0.15601 -0.35675 -0.31333 Catholic `Infant Mortality` Education:Catholic 0.18758 1.25531 -0.01248
>
> Quine <- structure(list(Eth = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1,
+ 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 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, 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, 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), .Label = c("A", "N"), class = "factor"), + Sex = structure(c(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, 2, 2, 2, 2, 2, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 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, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), .Label = c("F", + "M"), class = "factor"), Age = structure(c(1, 1, 1, 1, 1, + 1, 1, 1, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 4, 4, 4, 4, 4, 4, 4, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, 4, + 4, 4, 4, 4, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4), .Label = c("F0", "F1", "F2", "F3" + ), class = "factor"), Lrn = structure(c(2, 2, 2, 1, 1, 1, + 1, 1, 2, 2, 2, 1, 1, 2, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, + 2, 2, 2, 1, 1, 2, 2, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 2, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 1, 1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1), .Label = c("AL", "SL"), class = "factor"), + Days = c(2, 11, 14, 5, 5, 13, 20, 22, 6, 6, 15, 7, 14, 6, + 32, 53, 57, 14, 16, 16, 17, 40, 43, 46, 8, 23, 23, 28, 34, + 36, 38, 3, 5, 11, 24, 45, 5, 6, 6, 9, 13, 23, 25, 32, 53, + 54, 5, 5, 11, 17, 19, 8, 13, 14, 20, 47, 48, 60, 81, 2, 0, + 2, 3, 5, 10, 14, 21, 36, 40, 6, 17, 67, 0, 0, 2, 7, 11, 12, + 0, 0, 5, 5, 5, 11, 17, 3, 4, 22, 30, 36, 8, 0, 1, 5, 7, 16, + 27, 0, 30, 10, 14, 27, 41, 69, 25, 10, 11, 20, 33, 5, 7, + 0, 1, 5, 5, 5, 5, 7, 11, 15, 5, 14, 6, 6, 7, 28, 0, 5, 14, + 2, 2, 3, 8, 10, 12, 1, 1, 9, 22, 3, 3, 5, 15, 18, 22, 37)), + .Names = c("Eth", "Sex", "Age", "Slow or fast", "Days"), + class = "data.frame", row.names = 1:46)
> step(aov(log(Days+2.5) ~ .^4, data=Quine))
Start: AIC=-65.99 log(Days + 2.5) ~ (Eth + Sex + Age + `Slow or fast`)^4 Df Sum of Sq RSS AIC - Eth:Sex:Age:`Slow or fast` 2 0.78865 64.099 -68.184 <none> 63.310 -65.991 Step: AIC=-68.18 log(Days + 2.5) ~ Eth + Sex + Age + `Slow or fast` + Eth:Sex + Eth:Age + Eth:`Slow or fast` + Sex:Age + Sex:`Slow or fast` + Age:`Slow or fast` + Eth:Sex:Age + Eth:Sex:`Slow or fast` + Eth:Age:`Slow or fast` + Sex:Age:`Slow or fast` Df Sum of Sq RSS AIC - Eth:Sex:Age 3 0.97387 65.073 -71.982 - Sex:Age:`Slow or fast` 2 1.46623 65.565 -68.882 <none> 64.099 -68.184 - Eth:Age:`Slow or fast` 2 2.12841 66.227 -67.415 - Eth:Sex:`Slow or fast` 1 1.57879 65.678 -66.631 Step: AIC=-71.98 log(Days + 2.5) ~ Eth + Sex + Age + `Slow or fast` + Eth:Sex + Eth:Age + Eth:`Slow or fast` + Sex:Age + Sex:`Slow or fast` + Age:`Slow or fast` + Eth:Sex:`Slow or fast` + Eth:Age:`Slow or fast` + Sex:Age:`Slow or fast` Df Sum of Sq RSS AIC - Sex:Age:`Slow or fast` 2 1.5268 66.600 -72.597 <none> 65.073 -71.982 - Eth:Age:`Slow or fast` 2 2.0831 67.156 -71.382 - Eth:Sex:`Slow or fast` 1 2.9687 68.042 -67.469 Step: AIC=-72.6 log(Days + 2.5) ~ Eth + Sex + Age + `Slow or fast` + Eth:Sex + Eth:Age + Eth:`Slow or fast` + Sex:Age + Sex:`Slow or fast` + Age:`Slow or fast` + Eth:Sex:`Slow or fast` + Eth:Age:`Slow or fast` Df Sum of Sq RSS AIC <none> 66.600 -72.597 - Eth:Age:`Slow or fast` 2 2.0960 68.696 -72.072 - Eth:Sex:`Slow or fast` 1 3.0325 69.632 -68.096 - Sex:Age 3 10.7959 77.396 -56.663 Call: aov(formula = log(Days + 2.5) ~ Eth + Sex + Age + `Slow or fast` + Eth:Sex + Eth:Age + Eth:`Slow or fast` + Sex:Age + Sex:`Slow or fast` + Age:`Slow or fast` + Eth:Sex:`Slow or fast` + Eth:Age:`Slow or fast`, data = Quine) Terms: Eth Sex Age `Slow or fast` Eth:Sex Eth:Age Sum of Squares 10.68203 0.62388 3.76424 0.65290 0.01533 5.98964 Deg. of Freedom 1 1 3 1 1 3 Eth:`Slow or fast` Sex:Age Sex:`Slow or fast` Sum of Squares 0.01246 8.68925 0.57977 Deg. of Freedom 1 3 1 Age:`Slow or fast` Eth:Sex:`Slow or fast` Sum of Squares 2.38640 4.69558 Deg. of Freedom 2 1 Eth:Age:`Slow or fast` Residuals Sum of Squares 2.09602 66.59962 Deg. of Freedom 2 125 Residual standard error: 0.7299294 2 out of 23 effects not estimable Estimated effects may be unbalanced
> DF <- data.frame(y=rnorm(21), `x 1`=-10:10., check.names = FALSE)
> lm(y ~ ., data = DF)
Call: lm(formula = y ~ ., data = DF) Coefficients: (Intercept) `x 1` 0.1365 -0.0365
> (fm <- lm(y ~ `x 1` + I(`x 1`^2), data = DF))
Call: lm(formula = y ~ `x 1` + I(`x 1`^2), data = DF) Coefficients: (Intercept) `x 1` I(`x 1`^2) 0.3528 -0.0365 -0.0059
> step(fm)
Start: AIC=-8.68 y ~ `x 1` + I(`x 1`^2) Df Sum of Sq RSS AIC - I(`x 1`^2) 1 0.78089 11.221 -9.1607 - `x 1` 1 1.02595 11.466 -8.7070 <none> 10.441 -8.6754 Step: AIC=-9.16 y ~ `x 1` Df Sum of Sq RSS AIC - `x 1` 1 1.0259 12.247 -9.3235 <none> 11.221 -9.1607 Step: AIC=-9.32 y ~ 1 Call: lm(formula = y ~ 1, data = DF) Coefficients: (Intercept) 0.1365
>
> 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 no`=gl(6,4), N=factor(N), P=factor(P),
+ K=factor(K), yield=yield, check.names=FALSE)
> op <- options(contrasts=c("contr.helmert", "contr.treatment"))
> (npk.aovE <- aov(yield ~ N*P*K + Error(`block no`), npk))
Call: aov(formula = yield ~ N * P * K + Error(`block no`), data = npk) Grand Mean: 54.875 Stratum 1: block no Terms: N:P:K Residuals Sum of Squares 37.00167 306.29333 Deg. of Freedom 1 4 Residual standard error: 8.750619 Estimated effects are balanced Stratum 2: Within Terms: N P K N:P N:K P:K Sum of Squares 189.28167 8.40167 95.20167 21.28167 33.13500 0.48167 Deg. of Freedom 1 1 1 1 1 1 Residuals Sum of Squares 185.28667 Deg. of Freedom 12 Residual standard error: 3.929447 Estimated effects are balanced
> summary(npk.aovE)
Error: block no Df Sum Sq Mean Sq F value Pr(>F) N:P:K 1 37.002 37.002 0.4832 0.5252 Residuals 4 306.293 76.573 Error: Within Df Sum Sq Mean Sq F value Pr(>F) N 1 189.282 189.282 12.2587 0.004372 ** P 1 8.402 8.402 0.5441 0.474904 K 1 95.202 95.202 6.1657 0.028795 * N:P 1 21.282 21.282 1.3783 0.263165 N:K 1 33.135 33.135 2.1460 0.168648 P:K 1 0.482 0.482 0.0312 0.862752 Residuals 12 185.287 15.441 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> model.tables(npk.aovE)
Tables of effects N N 0 1 -2.8083 2.8083 P P 0 1 0.5917 -0.5917 K K 0 1 1.9917 -1.9917 N:P P N 0 1 0 -0.9417 0.9417 1 0.9417 -0.9417 N:K K N 0 1 0 -1.175 1.175 1 1.175 -1.175 P:K K P 0 1 0 0.14167 -0.14167 1 -0.14167 0.14167 N:P:K , , K = 0 P N 0 1 0 -1.2417 1.2417 1 1.2417 -1.2417 , , K = 1 P N 0 1 0 1.2417 -1.2417 1 -1.2417 1.2417
> model.tables(npk.aovE, "means")
Tables of means Grand mean 54.875 N N 0 1 52.07 57.68 P P 0 1 55.47 54.28 K K 0 1 56.87 52.88 N:P P N 0 1 0 51.72 52.42 1 59.22 56.15 N:K K N 0 1 0 52.88 51.25 1 60.85 54.52 P:K K P 0 1 0 57.60 53.33 1 56.13 52.43 N:P:K , , K = 0 P N 0 1 0 51.43 54.33 1 63.77 57.93 , , K = 1 P N 0 1 0 52.00 50.50 1 54.67 54.37
> options(op)# reset to previous
> ## Didn't work before 1.8.0
>
>
> ## cmdscale
> ## failed in versions <= 1.4.0 :
> cm1 <- cmdscale(eurodist, k=1, add=TRUE, x.ret = TRUE)
> cmdsE <- cmdscale(eurodist, k=20, add = TRUE, eig = TRUE, x.ret = TRUE)
> # FAILED on Debian testing just prior to 1.9.0!
> #stopifnot(identical(cm1$x, cmdsE$x),
> # identical(cm1$ac, cmdsE$ac))
> stopifnot(all.equal(cm1$x, cmdsE$x),
+ all.equal(cm1$ac, cmdsE$ac))
> ## end of moved from cmdscale.Rd
>
>
> ## cutree
> hc <- hclust(dist(USArrests))
> ct <- cutree(hc, h = c(0, hc$height[c(1,49)], 1000))
> stopifnot(ct[,"0"]== 1:50,
+ unique(ct[,2]) == 1:49, + ct[,3] == ct[,4], + ct[,4] == 1)
> ## end of moved from cutree.Rd
>
>
> ## princomp
> USArrests[1, 2] <- NA
> pc.cr <- princomp(~ Murder + Assault + UrbanPop,
+ data = USArrests, na.action=na.exclude, cor = TRUE)
> update(pc.cr, ~ . + Rape)
Call: princomp(formula = ~Murder + Assault + UrbanPop + Rape, data = USArrests, na.action = na.exclude, cor = TRUE) Standard deviations: Comp.1 Comp.2 Comp.3 Comp.4 1.5797241 0.9866993 0.5952482 0.4202094 4 variables and 49 observations.
> ## end of moved from princomp.Rd
>
>
> ## smooth.spline.Rd
> 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, cv=TRUE,con=list(trace=TRUE, tol=1e-6,low= -3,maxit=20))
sbart (ratio = 3.5942194e-05) iterations; initial tol1 = 3.589564e-07 : spar CV b - a e Kind NEW lspar crit ------------------------------------------------------------------------------- -1.28115295 0.16779002 4.5000e+00 0 GS -- 3.68346e-09 1.11272 -1.28115295 0.16779002 2.7812e+00 2.7812 FP GS 1.40627e-21 inf spar-finding: non-finite value inf; using BIG value -1.28115295 0.16779002 1.7188e+00 -1.7188 GS -- 6.65166e-14 1.10499 -1.28115295 0.16779002 1.0623e+00 1.0623 FP GS 1.20117e-18 0.0154641 -1.53192935 0.0154640648 6.5654e-01 -0.65654 FP PI 1.37794e-18 0.0226061 -1.53192935 0.0154640648 4.1402e-01 -0.25078 FP GS 9.1171e-20 0.0246914 -1.53192935 0.0154640648 1.6324e-01 -0.40576 FP PI 3.6115e-19 0.0161185 -1.53192935 0.0154640648 8.0493e-02 -0.15499 FP PI 6.63221e-19 0.017033 -1.53192935 0.0154640648 4.3956e-02 -0.07224 FP GS 9.57365e-19 0.0190675 -1.53192935 0.0154640648 2.1891e-02 -0.035703 FP GS 1.10146e-18 0.0289093 -1.53192935 0.0154640648 1.3462e-02 -0.013637 FP GS 1.26584e-18 0.019493 -1.53192935 0.0154640648 8.3614e-03 0.0082531 FP GS 1.16206e-18 0.0246032 -1.53192935 0.0154640648 5.1421e-03 -0.005209 FP GS 1.22547e-18 0.0213886 -1.53192935 0.0154640648 3.1938e-03 0.0031524 FP GS 1.18608e-18 0.0159573 -1.53192935 0.0154640648 1.9641e-03 -0.0019897 FP GS 1.21039e-18 0.0214677 -1.53192935 0.0154640648 1.2199e-03 0.0012041 FP GS 1.19538e-18 0.0221115 -1.53192935 0.0154640648 7.5022e-04 -0.00075999 FP GS 1.20468e-18 0.0172541 -1.53192935 0.0154640648 4.6597e-04 0.00045993 FP GS 1.19896e-18 0.0419896 -1.53192935 0.0154640648 2.8656e-04 -0.00029029 FP GS 1.20251e-18 0.0172276 -1.53192935 0.0154640648 1.7798e-04 0.00017568 FP GS 1.20032e-18 0.0200826 -1.53192935 0.0154640648 1.0946e-04 -0.00011088 >>> 1.20032e-18 0.0154641
> s2. ## Intel-Linux: Df ~= (even! > ) 18 : interpolating -- much smaller PRESS
Call: smooth.spline(x = y18, cv = TRUE, control.spar = list(trace = TRUE, tol = 1e-06, low = -3, maxit = 20)) Smoothing Parameter spar= -1.531929 lambda= 1.200323e-18 (21 iterations) Equivalent Degrees of Freedom (Df): 18.00014 Penalized Criterion: 1.391768e-25 PRESS: 0.02008257
> ## {others, e.g., may end quite differently!}
> lines(predict(s2., xx), col = 4)
> mtext(deparse(s2.$call,200), side= 1, line= -1, cex= 0.8, col= 4)
>
> sdf8 <- smooth.spline(y18, df = 8, con=list(trace=TRUE))
sbart (ratio = 3.5942194e-05) iterations; initial tol1 = 3.334042e-05 : spar (df0-df)^2 b - a e Kind NEW lspar crit ------------------------------------------------------------------------------- -0.35410197 99.9915098 3.0000e+00 0 GS -- 5.07753e-05 2.97655 0.35410197 2.97654935 1.8541e+00 1.8541 FP GS 0.0737682 30.6098 0.35410197 2.97654935 1.1459e+00 1.1459 FP PI 9.56917e-05 0.263677 0.39219645 0.263677031 4.3769e-01 0.43769 FP PI 0.000405904 2.93065 0.39219645 0.263677031 1.2496e-01 0.038094 FP GS 0.000166179 0.178429 0.42537453 0.178428942 8.6861e-02 0.086861 FP PI 0.000130527 0.000705384 0.41085824 0.000705384101 3.3178e-02 0.033178 FP PI 0.000129544 0.00019138 0.41040405 0.000191379589 1.8662e-02 -0.014516 FP PI 0.000128396 1.41589e-06 0.40986876 1.41588963e-06 1.8208e-02 -0.00045419 FP PI 0.000128485 4.20394e-10 0.40991039 4.20394386e-10 5.3529e-04 -0.00053529 FP PI 0.000128556 8.39052e-07 0.40991039 4.20394386e-10 7.4969e-05 4.1628e-05 >>> 0.000128556 4.20394e-10
> sdf8 ; sdf8$df - 8
Call: smooth.spline(x = y18, df = 8, control.spar = list(trace = TRUE)) Smoothing Parameter spar= 0.4099104 lambda= 0.0001285563 (11 iterations) Equivalent Degrees of Freedom (Df): 7.999084 Penalized Criterion: 4.016055 GCV: 0.7227574 [1] -0.0009159978
>
> try(smooth.spline(y18, spar = 50)) #>> error : spar 'way too large'
Error in smooth.spline(y18, spar = 50) : NA lev[]; probably smoothing parameter 'spar' way too large!
> ## end of moved from smooth.spline.Rd
>
>
> ## arima{0}
> (fit <- arima(lh, 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
> tsdiag(fit)
> (fit <- arima0(lh, c(1,0,0)))
Call: arima0(x = lh, order = c(1, 0, 0)) Coefficients: ar1 intercept 0.5739 2.4124 s.e. 0.1161 0.1466 sigma^2 estimated as 0.1975: log likelihood = -29.38, aic = 64.76
> tsdiag(fit)
> ## end of moved from arima{0}.Rd
>
>
> ## predict.arima
> predict(arima(lh, order=c(1,0,1)), n.ahead=5)
$pred Time Series: Start = 49 End = 53 Frequency = 1 [1] 2.679611 2.531951 2.465179 2.434985 2.421331 $se Time Series: Start = 49 End = 53 Frequency = 1 [1] 0.4385341 0.5231218 0.5387858 0.5419332 0.5425745
> predict(arima(lh, order=c(1,1,0)), n.ahead=5)
$pred Time Series: Start = 49 End = 53 Frequency = 1 [1] 2.904039 2.903875 2.903882 2.903882 2.903882 $se Time Series: Start = 49 End = 53 Frequency = 1 [1] 0.5025424 0.6964990 0.8476226 0.9755949 1.0886266
> predict(arima(lh, order=c(0,2,1)), n.ahead=5)
$pred Time Series: Start = 49 End = 53 Frequency = 1 [1] 2.910638 2.921277 2.931915 2.942554 2.953192 $se Time Series: Start = 49 End = 53 Frequency = 1 [1] 0.5136728 0.7339711 0.9080537 1.0589635 1.1955083
> ## end of moved from predict.arima.Rd
>
>
> library(splines)
> ## ns
> ## Consistency:
> x <- c(1:3,5:6)
> stopifnot(identical(ns(x), ns(x, df = 1)),
+ !is.null(kk <- attr(ns(x), "knots")),# not true till 1.5.1 + length(kk) == 0)
> ## end of moved from ns.Rd
>
>
> ## predict.bs
> ## Consistency:
> basis <- ns(women$height, df = 5)
> newX <- seq(58, 72, len = 51)
> wh <- women$height
> bbase <- bs(wh)
> nbase <- ns(wh)
> stopifnot(identical(predict(basis), predict(basis, newx=wh)),
+ identical(predict(bbase), predict(bbase, newx=wh)), + identical(predict(nbase), predict(nbase, newx=wh)))
> ## end of moved from predict.bs.Rd
>
>
> ## internal coerceVector() was too lenient
> plot(1)
> r <- try(strwidth(plot))## Error: cannot coerce
Error in strwidth(plot) : cannot coerce type 'closure' to vector of type 'character'
> stopifnot(inherits(r, "try-error"),
+ grep("cannot coerce", r) == 1)
> ## gave seg.fault or memory allocation error before 1.8.0
>
>
> ## rank sometimes kept and sometimes dropped names
> x2 <- c(3, 1, 4, 1, 5, NA, 9, 2, 6, 5, 3, 5)
> names(x2) <- letters[1:12]
> (y1 <- rank(x2))
a b c d e f g h i j k l 4.5 1.5 6.0 1.5 8.0 12.0 11.0 3.0 10.0 8.0 4.5 8.0
> (y2 <- rank(x2, na.last=FALSE))
a b c d e f g h i j k l 5.5 2.5 7.0 2.5 9.0 1.0 12.0 4.0 11.0 9.0 5.5 9.0
> (y3 <- rank(x2, na.last=NA))
a b c d e g h i j k l 4.5 1.5 6.0 1.5 8.0 11.0 3.0 10.0 8.0 4.5 8.0
> (y4 <- rank(x2, na.last="keep"))
a b c d e f g h i j k l 4.5 1.5 6.0 1.5 8.0 NA 11.0 3.0 10.0 8.0 4.5 8.0
> stopifnot(identical(names(y1), names(x2)),
+ identical(names(y2), names(x2)), + identical(names(y4), names(x2)), + identical(names(y3), names(x2)[-6]))
> ##
>
> ## as.dist(x) only obeyed `diag=TRUE' or `upper=TRUE' when x was "dist" already
> m <- as.matrix(dist(matrix(rnorm(100), nrow=5)))
> stopifnot(identical(TRUE, attr(as.dist(m, diag=TRUE), "Diag")))
> ## failed previous to 1.8.0
>
> stopifnot(1:2 == ave(1:2,factor(2:3,levels=1:3)))
> ## gave "2 NA" previous to 1.8.0, because unused levels weren't dropped
>
>
> ## PR#4092: arrays with length(dim(.)) = 1
> z <- array(c(-2:1, 1.4),5)
> cz <- crossprod(as.vector(z))
> dimnames(z) <- list(letters[1:5])
> z0 <- z
> names(dimnames(z)) <- "D1"
> stopifnot(crossprod(z) == cz,# the first has NULL dimnames
+ identical(crossprod(z), crossprod(z0)), + identical(crossprod(z), crossprod(z,z0)))
> ## crossprod(z) segfaulted (or gave silly error message) before 1.8.0
>
>
> ## PR#4431
> stopifnot(!is.na(rmultinom(12,100, c(3, 4, 2, 0,0))))
> ## 3rd line was all NA before 1.8.0
>
>
> ## PR#4275: getAnywhere with extra "."
> g0 <- getAnywhere("predict.loess")
> g1 <- getAnywhere("as.dendrogram.hclust")
> g2 <- getAnywhere("predict.smooth.spline")
> g3 <- getAnywhere("print.data.frame")
> is.S3meth <- function(ga) any(substr(ga$where, 1,20) == "registered S3 method")
> stopifnot(is.S3meth(g0), is.S3meth(g1),
+ is.S3meth(g2), is.S3meth(g3))
> ## all but g0 failed until 1.8.0 (Oct 6)
>
>
> ## symnum(x) for length 0 and some logical arrays:
> sm <- symnum(m <- matrix(1:8 %% 3 == 0, 2))
> stopifnot(identical(symnum(FALSE[FALSE]), noquote(""[FALSE])),
+ identical(symnum(c(m)), c(symnum(m))), + dim(sm) == dim(m), class(sm) == "noquote")
> ## symnum(<length 0>) gave noquote("()") before 1.8.1
>
>
> ## abbreviate with leading (or trailing) space differences (PR#4564)
> abbreviate(c("A"," A"), 4)
A A "A" "A"
> ## this gave infinite loop before 1.8.1
>
>
> ## crossprod on 0-extent matrices
> a <- matrix(,0,5)
> stopifnot(crossprod(a) == 0)
> stopifnot(crossprod(a,a) == 0)
> stopifnot(crossprod(a+0i) == 0+0i)
> ## were random areas in <= 1.8.0
>
>
> ## DF[[i, j]] should be row i, col j
> stopifnot(women[[2, 1]] == women[2, 1])
> women[[2, 1]] <- 77
> stopifnot(women[2, 1] == 77)
> ## was reversed from May 2002 to Oct 2003
>
>
> ## merge.data.frame with a single-column df (PR#4299)
> x <- data.frame(x = 1:5, y = letters[1:5])
> y <- data.frame(z = 1:2)
> z <- merge(x, y)
> stopifnot(identical(names(z), c("x", "y", "z")))
> ## third name was wrong in 1.8.0
>
>
> ## cor(mat, use = "pair") was plainly wrong
> # longley has no NA's -- hence all "use = " should give the same!
> X <- longley
> ep <- 32 * Meps
> for(meth in eval(formals(cor)$method)) {
+ cat("method = ", meth,"\n") + Cl <- cor(X, method = meth) + stopifnot(all.equal(Cl, cor(X, method= meth, use= "complete"), tol=ep), + all.equal(Cl, cor(X, method= meth, use= "pairwise"), tol=ep), + all.equal(Cl, cor(X, X, method= meth), tol=ep), + all.equal(Cl, cor(X, X, method= meth, use= "pairwise"), tol=ep), + all.equal(Cl, cor(X, X, method= meth, use= "pairwise"), tol=ep) + ) + } method = pearson method = kendall method = spearman
> ## "pairwise" failed in 1.8.0
>
>
> ## regexpr(*, fixed=TRUE) had 0-index from C
> txt <- c("english", "french", "swiss")
> ir <- regexpr("en", txt, fixed = TRUE)
> stopifnot(ir == c(1, 3, -1),
+ identical(ir, regexpr("en", txt)))
> ## (*, fixed=TRUE) gave 0 2 -1 before R 1.8.1
>
>
> ## PR#5017: filter(init=) had the wrong time order
> xx <- filter(4:8, c(1, 0.5, 0.25), method="recursive", init=3:1)
> stopifnot(identical(xx[1:3], c(8.25, 15.25, 26.125)))
> ## 1.8.0 gave 6.75 12.75 22.375
>
>
> ## PR#5090 user error with writeChar could segfault
> tf <- tempfile()
> zz <- file(tf, "wb")
> writeChar("", zz, nchars=10000000)
Warning message: In writeChar("", zz, nchars = 1e+07) : writeChar: more characters requested than are in the string - will zero-pad
> close(zz)
> unlink(tf)
> ## segfaults in 1.8.0
>
>
> ## PR#4710 round (and signif) dropped attributes
> x <- round(matrix(0, 0, 3))
> stopifnot(identical(dim(x), as.integer(c(0, 3))))
> ## numeric(0) in 1.8.0
>
>
> ## PR#5405
> try(stepfun(c(), 1)(2))# > Error
Error in stepfun(c(), 1) : 'x' must have length >= 1
> ## segfaults in 1.8.1 and earlier
>
>
> ## PR#4955 now allow embedded newlines in quoted fields in read.table
> temp <- tempfile()
> data <- data.frame(a=c("c", "e\nnewline"))
> write.table(data, sep=",", row.names=FALSE, file=temp)
> data2 <- read.csv(temp)
> unlink(temp)
> # attributes get a different order here
> stopifnot(identical(data$a, data2$a))
> ## not allowed prior to 1.9.0
>
>
> ## scoping problems with model.frame methods
> foo <- c(1,1,0,0,1,1)
> rep <- 1:6
> m <- lm(foo ~ rep, model=FALSE)
> model.matrix(m)
(Intercept) rep 1 1 1 2 1 2 3 1 3 4 1 4 5 1 5 6 1 6 attr(,"assign") [1] 0 1
> n <- 1:6
> m <- lm(foo ~ n, model=FALSE)
> model.matrix(m)
(Intercept) n 1 1 1 2 1 2 3 1 3 4 1 4 5 1 5 6 1 6 attr(,"assign") [1] 0 1
> ## failed in 1.8.0 because the wrong n or rep was found.
> rm(foo, rep)
> func <- function()
+ { + foo <- c(1,1,0,0,1,1) + rep <- 1:6 + m <- lm(foo ~ rep, model=FALSE) + model.matrix(m) + }
> func()
(Intercept) rep 1 1 1 2 1 2 3 1 3 4 1 4 5 1 5 6 1 6 attr(,"assign") [1] 0 1
> ##
>
>
> ## broken strptime in glibc (and code used on Windows)
> # the spec says %d is allowed in 1-31, but it seems HP-UX thinks
> # the date is invalid.
> # stopifnot(!is.na(strptime("2003-02-30", format="%Y-%m-%d")))
> stopifnot(is.na(strptime("2003-02-35", format="%Y-%m-%d")))
> # this one is still wrong in glibc
> stopifnot(is.na(strptime("2003-02-40", format="%Y-%m-%d")))
> stopifnot(is.na(strptime("2003-22-20", format="%Y-%m-%d")))
> # and so is this one
> stopifnot(is.na(strptime("2003 22 20", format="%Y %m %d")))
> stopifnot(is.na(ISOdate(year=2003, month=22, day=20)))
> ## several after the first gave non-NA values in 1.8.1 on some broken OSes
>
>
> ## PR#4582 %*% with NAs
> stopifnot(is.na(NA %*% 0), is.na(0 %*% NA))
> ## depended on the BLAS in use.
>
>
> ## PR#4688
> reli <- cbind(Si = c(2121, 100, 27, 0),
+ av = c(4700, 216, 67, 0), + Nc = c(6234,2461,502,14))
> stopifnot(inherits(try(fisher.test(reli, workspace=2000000)), "try-error"))
Error in fisher.test(reli, workspace = 2e+06) : FEXACT error 501. The hash table key cannot be computed because the largest key is larger than the largest representable int. The algorithm cannot proceed. Reduce the workspace size or use another algorithm.
> ## gave p.value = Inf ; now gives FEXACT error 501
>
>
> ## PR#5701
> chisq.test(matrix(23171,2,2), simulate=TRUE)
Pearson's Chi-squared test with simulated p-value (based on 2000 replicates) data: matrix(23171, 2, 2) X-squared = 0, df = NA, p-value = 1
> ## gave infinite loop in 1.8.1 and earlier
>
>
> ## as.matrix on an all-logical data frame
> ll <- data.frame(a = rpois(10,1) > 0, b = rpois(10,1) > 0)
> stopifnot(mode(as.matrix(ll)) == "logical")
> lll <- data.frame(a = LETTERS[1:10], b = rpois(10,1) > 0)
> stopifnot(mode(as.matrix(lll)) == "character")
> ## both were char before 1.9.0
>
>
> ## outer called rep with a non-generic arg
> x <- .leap.seconds[1:6]
> outer(x, x, "<")
[,1] [,2] [,3] [,4] [,5] [,6] [1,] FALSE TRUE TRUE TRUE TRUE TRUE [2,] FALSE FALSE TRUE TRUE TRUE TRUE [3,] FALSE FALSE FALSE TRUE TRUE TRUE [4,] FALSE FALSE FALSE FALSE TRUE TRUE [5,] FALSE FALSE FALSE FALSE FALSE TRUE [6,] FALSE FALSE FALSE FALSE FALSE FALSE
> outer(x, x, "-")
Time differences in secs [,1] [,2] [,3] [,4] [,5] [,6] [1,] 0 -15897600 -47433600 -78969600 -110505600 -142128000 [2,] 15897600 0 -31536000 -63072000 -94608000 -126230400 [3,] 47433600 31536000 0 -31536000 -63072000 -94694400 [4,] 78969600 63072000 31536000 0 -31536000 -63158400 [5,] 110505600 94608000 63072000 31536000 0 -31622400 [6,] 142128000 126230400 94694400 63158400 31622400 0
> (z <- outer(x, x, "difftime", units="days"))
Time differences in days [,1] [,2] [,3] [,4] [,5] [,6] [1,] 0 -184 -549 -914 -1279 -1645 [2,] 184 0 -365 -730 -1095 -1461 [3,] 549 365 0 -365 -730 -1096 [4,] 914 730 365 0 -365 -731 [5,] 1279 1095 730 365 0 -366 [6,] 1645 1461 1096 731 366 0
> stopifnot(class(z) == "difftime")
> ## failed in 1.8.1
>
>
> ## PR#5900 qbinom when probability is 1
> stopifnot(qbinom(0.95, 10, 1) == 10)
> stopifnot(qbinom(0, 10, 1) == 0)
> # and for prob = 0
> stopifnot(qbinom(0.95, 10, 0) == 0)
> stopifnot(qbinom(0, 10, 0) == 0)
> # and size = 0
> stopifnot(qbinom(0.95, 0, 0.5) == 0)
> ## 1.8.1 was programmed to give NaN
>
>
> ## base:: and ::: were searching in the wrong places
> stopifnot(inherits(try(base::lm), "try-error"))
Error in get(name, envir = ns, inherits = FALSE) : object 'lm' not found
> stopifnot(inherits(try(graphics::log), "try-error"))
Error : 'log' is not an exported object from 'namespace:graphics'
> ## equivalent constructs succeeded in 1.8.1
>
>
> ## (PR#6452) princomp prediction without specifying centers should give NAs
> x <- matrix(rnorm(400), ncol=4)
> fit <- princomp(covmat=cov(x))
> stopifnot(is.null(fit$scores))
> stopifnot(is.na(predict(fit, newdata=x[1:10, ])))
> ## failed in 1.8.1
>
>
> ## (PR#6451) regex functions did not coerce args to character.
> sub(x=NA, pattern="x", replacement="y")
[1] NA
> ## failed in 1.8.1
>
>
> ## length<- needed a factor method, and so needed to be generic
> aa <- factor(letters)
> length(aa) <- 20
> aa
[1] a b c d e f g h i j k l m n o p q r s t 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
> stopifnot(is.factor(aa))
> ## returned a vector in 1.8.1
>
>
> ## spec.pgram() was too
> pAR <- c(2.7607, -3.82, 2.6535, -0.9238)
> N <- 1 + 2^14# 16385
> set.seed(123)
> x <- arima.sim(model = list(ar = pAR), n = N)
> spP <- spec.pgram(x, spans = 41, plot=FALSE)
> spA <- spec.ar(x=list(ar=pAR, order=4, var.pred=1, frequency=1),
+ n.freq = spP$n.used %/% 2, plot=FALSE)
> r <- spP$spec / spA$spec
> stopifnot(abs(mean(r) - 1) < 0.003)
> ## was 0.0268 in R 1.8.1
>
>
> ## check for a Microsoft bug in timezones ahead of GMT
> stopifnot(!is.na(as.POSIXct("1970-01-01 00:00:00")))
> ##
>
>
> ## PR#6672, split.default on factors
> x <- c(NA, 1, 2)
> y <- as.factor(x)
> split(x, y)
$`1` [1] 1 $`2` [1] 2
> split(y, y) # included NAs in 1.8.1
$`1` [1] 1 Levels: 1 2 $`2` [1] 2 Levels: 1 2
> r1 <- tapply(x, y, length)
> r2 <- tapply(y, y, length)
> stopifnot(r1 == r2)
> ##
>
>
> ## PR#6652, points.formula with subset and extra arguments.
> roller <-
+ data.frame(weight = c(1.9, 3.1, 3.3, 4.8, 5.3, 6.1, 6.4, 7.6, 9.8, 12.4), + depression = c(2, 1, 5, 5, 20, 20, 23, 10, 30, 25))
> plot(depression ~ weight, data=roller, type="n")
> with(roller, points( depression~weight, subset=8:10, col=2))
> with(roller, points( depression~weight, subset=8:10, col=2:4))
> plot(depression ~ weight, data=roller, type="n")
> points(depression~weight, subset=8:10, col=2:4, data=roller)
> ## first two gave error in 1.8.1
>
>
> ## PR#4558 part 2
> x <- seq(as.POSIXct("2004-03-25"), as.POSIXct("2004-03-31"), by="DSTdays")
> stopifnot(length(x) == 7)
> ## was length 6 in the UK time zone.
>
>
> ## PR#6702 c/rbind on list matrices
> A <- matrix(as.list(1:4), 2, 2)
> (res <- cbind(A, A))
[,1] [,2] [,3] [,4] [1,] 1 3 1 3 [2,] 2 4 2 4
> stopifnot(typeof(res) == "list")
> (res <- rbind(A, A))
[,1] [,2] [1,] 1 3 [2,] 2 4 [3,] 1 3 [4,] 2 4
> stopifnot(typeof(res) == "list")
> ## were not implemented in 1.8.1
>
>
> ## Date objects with NA's
> (t1 <- strptime(c("6. Aug. 1930", "3. Nov. 1925", "28. Mar. 1959",
+ NA, paste(1:29," Feb. 1960", sep=".")), + format = "%d. %b. %Y")) [1] "1930-08-06" "1925-11-03" "1959-03-28" NA "1960-02-01" [6] "1960-02-02" "1960-02-03" "1960-02-04" "1960-02-05" "1960-02-06" [11] "1960-02-07" "1960-02-08" "1960-02-09" "1960-02-10" "1960-02-11" [16] "1960-02-12" "1960-02-13" "1960-02-14" "1960-02-15" "1960-02-16" [21] "1960-02-17" "1960-02-18" "1960-02-19" "1960-02-20" "1960-02-21" [26] "1960-02-22" "1960-02-23" "1960-02-24" "1960-02-25" "1960-02-26" [31] "1960-02-27" "1960-02-28" "1960-02-29"
> stopifnot(6 == length(print(s1 <- summary(t1))),
+ s1== summary(as.POSIXct(t1)), + 6 == length(print(format(as.Date(s1)))) ) Min. 1st Qu. Median "1925-11-03 00:00:00 EST" "1960-02-05 18:00:00 EST" "1960-02-13 12:00:00 EST" Mean 3rd Qu. Max. "1958-02-06 12:43:08 EST" "1960-02-21 06:00:00 EST" "1960-02-29 00:00:00 EST" Min. 1st Qu. Median Mean 3rd Qu. Max. "1925-11-03" "1960-02-05" "1960-02-13" "1958-02-06" "1960-02-21" "1960-02-29"
> ## gave bizarre "NA's" entry in R 1.8.1 and 1.9.0alpha
>
>
> ## as.Date on a factor
> as.Date(factor("2000-01-02"))
[1] "2000-01-02"
> ## failed in 1.9.0
>
>
> ## as.data.frame.list (PR#6782)
> xx <- list(row.names=1:2,foxglove=3:4,toadflax=5:6)
> foo <- as.data.frame(xx)
> stopifnot(identical(names(xx), names(foo)))
> ## 1.9.0 changed the last name to "x".
>
>
> ## type.convert quirk (PR#6781)
> res1 <- type.convert( c("abc","-"), as.is=TRUE, na.strings="-" )
> stopifnot(identical(mode(res1), "character"), is.na(res1[2]))
> ## res1[2] was "-" <= 1.9.0.
>
>
> ## subsetting factor swaps order of attributes (PR#6799)
> af <- factor(c('A','B'))
> stopifnot(identical(af, af[1:2]))
> ## failed in 1.9.0 as the attributes were class, level for af[1:2]
>
>
> ## Comparison between lists and expressions
> stopifnot(inherits(try(list(1) <= list(2)), "try-error"))
Error in list(1) <= list(2) : comparison of these types is not implemented
> e <- expression(3 + 2 * 4)
> stopifnot(inherits(try(e == e), "try-error"))
Error in e == e : comparison is not allowed for expressions
> ## both were allowed but nonsense in 1.9.0
>
>
> ## "nowhere" interpolation (PR#6809)
> try(approx(list(x=rep(NaN, 9), y=1:9), xout=NaN))
Error in approx(list(x = rep(NaN, 9), y = 1:9), xout = NaN) : need at least two non-NA values to interpolate
> ## gave a seg.fault in 1.9.0
>
>
> ## aggregate.data.frame failed if result would have one row
> ## Philippe Hupé, R-help, 2004-05-14
> dat <- data.frame(a=rep(2,10),b=rep("a",10))
> aggregate(dat$a, by=list(a1=dat$a, b1=dat$b), NROW)
a1 b1 x 1 2 a 10
> ## failed due to missing drop = FALSE
>
>
> ## [<-.data.frame with a data-frame value
> x <- data.frame(a=1:3, b=4:6, c=7:9)
> info <- x[1:2]
> x[, names(info)] <- info[1,]
> ##
>
>
> ## invalid 'lib.loc'
> stopifnot(length(installed.packages("mgcv")) == 0)
Warning message: In list.files(lib) : list.files: 'mgcv' is not a readable directory
> ## gave a low-level error message
>
>
> ## as.dendrogram.hclust()
> d <- as.dendrogram(hEU <- hclust(eurodist, "ave"))
> stopifnot(order.dendrogram(d) == hEU$order)# not new
> ##N require(gclus); hE1 <- reorder.hclust(hEU, dis)
> ## reconstruct without gclus (for R's testing)
> hE2 <- hEU; ii <- c(5,9:11, 13, 15:18); hE2$merge[ii,] <- hEU$merge[ii, 2:1]
> hE2$order <- as.integer(c(1,19,9,12,14,2,15,8,13,16,17,21,6,3,11,4,18,5,10,7,20))
> ##N stopifnot(identical(hE1, hE2))
> d1 <- as.dendrogram(hE2)
> stopifnot(order.dendrogram(d1) == hE2$order,
+ identical(d1, rev(rev(d1))))
> ## not true in 1.9.0
>
>
> ## trunc on a Date
> trunc(xx <- Sys.Date()) # failed in 1.9.1
[1] "2009-11-02"
> x <- xx + 0.9
> stopifnot(identical(trunc(x), xx)) # gave next day in 1.9.1
> xx <- as.Date("1960-02-02")
> x <- xx + 0.2
> stopifnot(identical(trunc(x), xx)) # must not truncate towards 0.
> ##
>
> ### end of tests added in 1.9.1 ###
>
> ## 1.9.1 patched
>
> ## options(list('..', '..'))
> try(options(list('digits', 'width')))# give an error
Error in options(list("digits", "width")) : list argument has no valid names
> ## gave a segfault in 1.9.1
>
>
> ## PR#7100 seg faulted or path too long error on ././././././. ...
> list.files('.', all.files = TRUE, recursive = TRUE)
[1] "Embedding/Makefile" "Embedding/Makefile.in" [3] "Embedding/Makefile.win" "Embedding/RNamedCall.c" [5] "Embedding/RParseEval.c" "Embedding/Rerror.c" [7] "Embedding/Rpackage.c" "Embedding/Rplot.c" [9] "Embedding/Rpostscript.c" "Embedding/Rshutdown.c" [11] "Embedding/Rtest.c" "Embedding/embeddedRCall.c" [13] "Embedding/embeddedRCall.h" "Embedding/error.R" [15] "Embedding/foo.R" "Embedding/index.html" [17] "Embedding/tryEval.c" "Examples/Makefile" [19] "Examples/Makefile.in" "Examples/Makefile.win" [21] "Examples/base-Ex.R" "Examples/base-Ex.Rout" [23] "Examples/base-Ex.Rout.prev" "Examples/base-Ex.ps" [25] "Examples/datasets-Ex.R" "Examples/datasets-Ex.Rout" [27] "Examples/datasets-Ex.Rout.prev" "Examples/datasets-Ex.ps" [29] "Examples/grDevices-Ex.R" "Examples/grDevices-Ex.Rout" [31] "Examples/grDevices-Ex.Rout.prev" "Examples/grDevices-Ex.ps" [33] "Examples/graphics-Ex.R" "Examples/graphics-Ex.Rout" [35] "Examples/graphics-Ex.Rout.prev" "Examples/graphics-Ex.ps" [37] "Examples/grid-Ex.R" "Examples/grid-Ex.Rout" [39] "Examples/grid-Ex.Rout.prev" "Examples/grid-Ex.ps" [41] "Examples/methods-Ex.R" "Examples/methods-Ex.Rout" [43] "Examples/methods-Ex.Rout.prev" "Examples/methods-Ex.ps" [45] "Examples/splines-Ex.R" "Examples/splines-Ex.Rout" [47] "Examples/splines-Ex.Rout.prev" "Examples/splines-Ex.ps" [49] "Examples/stats-Ex.R" "Examples/stats-Ex.Rout" [51] "Examples/stats-Ex.Rout.prev" "Examples/stats-Ex.ps" [53] "Examples/stats4-Ex.R" "Examples/stats4-Ex.Rout" [55] "Examples/stats4-Ex.Rout.prev" "Examples/stats4-Ex.ps" [57] "Examples/tcltk-Ex.R" "Examples/tcltk-Ex.Rout" [59] "Examples/tcltk-Ex.Rout.prev" "Examples/tcltk-Ex.ps" [61] "Examples/tools-Ex.R" "Examples/tools-Ex.Rout" [63] "Examples/tools-Ex.Rout.prev" "Examples/tools-Ex.ps" [65] "Examples/utils-Ex.R" "Examples/utils-Ex.Rout" [67] "Examples/utils-Ex.Rout.prev" "Examples/utils-Ex.ps" [69] "Makefile" "Makefile.common" [71] "Makefile.in" "Makefile.install" [73] "Makefile.win" "Native/Makefile" [75] "Native/Makefile.in" "Native/Tests.c" [77] "Native/check.S" "Pkgs/exNSS4/DESCRIPTION" [79] "Pkgs/exNSS4/NAMESPACE" "Pkgs/exNSS4/R/nss4.R" [81] "Pkgs/exS4noNS/DESCRIPTION" "Pkgs/pkgA/DESCRIPTION" [83] "Pkgs/pkgA/NAMESPACE" "Pkgs/pkgA/R/pkgA.R" [85] "Pkgs/pkgB/DESCRIPTION" "Pkgs/pkgB/NAMESPACE" [87] "R-intro.Rout.save" "README" [89] "WinUnicode.dat" "arith-true.R" [91] "arith-true.Rout" "arith-true.Rout.save" [93] "arith.R" "arith.Rout" [95] "arith.Rout.save" "complex.R" [97] "complex.Rout" "complex.Rout.save" [99] "d-p-q-r-tests.R" "d-p-q-r-tests.Rout" [101] "d-p-q-r-tests.Rout.save" "datasets.R" [103] "datasets.Rout" "datasets.Rout.save" [105] "demos.R" "demos.Rout.save" [107] "demos2.R" "encodings.R" [109] "eval-etc.R" "eval-etc.Rout" [111] "eval-etc.Rout.save" "gct-foot.R" [113] "internet.R" "internet.Rout.save" [115] "isas-tests.Rin" "isas-tests.Rout.save" [117] "lapack.R" "lapack.Rout" [119] "lapack.Rout.save" "lm-tests.R" [121] "lm-tests.Rout" "lm-tests.Rout.save" [123] "method-dispatch.R" "method-dispatch.Rout" [125] "method-dispatch.Rout.save" "myLib/R.css" [127] "myLib/myTst/DESCRIPTION" "myLib/myTst/INDEX" [129] "myLib/myTst/Meta/Rd.rds" "myLib/myTst/Meta/hsearch.rds" [131] "myLib/myTst/Meta/links.rds" "myLib/myTst/Meta/nsInfo.rds" [133] "myLib/myTst/Meta/package.rds" "myLib/myTst/NAMESPACE" [135] "myLib/myTst/R/myTst" "myLib/myTst/R/myTst.rdb" [137] "myLib/myTst/R/myTst.rdx" "myLib/myTst/help/AnIndex" [139] "myLib/myTst/help/aliases.rds" "myLib/myTst/help/myTst.rdb" [141] "myLib/myTst/help/myTst.rdx" "myLib/myTst/help/paths.rds" [143] "myLib/myTst/html/00Index.html" "myLib/pkgA/DESCRIPTION" [145] "myLib/pkgA/Meta/Rd.rds" "myLib/pkgA/Meta/hsearch.rds" [147] "myLib/pkgA/Meta/links.rds" "myLib/pkgA/Meta/nsInfo.rds" [149] "myLib/pkgA/Meta/package.rds" "myLib/pkgA/NAMESPACE" [151] "myLib/pkgA/R/pkgA" "myLib/pkgA/R/pkgA.rdb" [153] "myLib/pkgA/R/pkgA.rdx" "myLib/pkgA/help/AnIndex" [155] "myLib/pkgA/help/aliases.rds" "myLib/pkgA/help/paths.rds" [157] "myLib/pkgA/help/pkgA.rdb" "myLib/pkgA/help/pkgA.rdx" [159] "myLib/pkgA/html/00Index.html" "myLib/pkgB/DESCRIPTION" [161] "myLib/pkgB/Meta/Rd.rds" "myLib/pkgB/Meta/hsearch.rds" [163] "myLib/pkgB/Meta/links.rds" "myLib/pkgB/Meta/nsInfo.rds" [165] "myLib/pkgB/Meta/package.rds" "myLib/pkgB/NAMESPACE" [167] "myLib/pkgB/help/AnIndex" "myLib/pkgB/help/aliases.rds" [169] "myLib/pkgB/help/paths.rds" "myLib/pkgB/help/pkgB.rdb" [171] "myLib/pkgB/help/pkgB.rdx" "myLib/pkgB/html/00Index.html" [173] "myTst/DESCRIPTION" "myTst/NAMESPACE" [175] "myTst/R/file6cc95416.R" "myTst/Read-and-delete-me" [177] "myTst/man/foo-class.Rd" "myTst/man/myTst-package.Rd" [179] "myTst/man/show-methods.Rd" "nanbug.rda" [181] "no-segfault.Rin" "ok-errors.R" [183] "ok-errors.Rout" "ok-errors.Rout.save" [185] "p-r-random-tests.R" "p-r-random-tests.Rout.save" [187] "pkgA_1.0.tar.gz" "pkgB_1.0.tar.gz" [189] "primitives.R" "print-tests.R" [191] "print-tests.Rout" "print-tests.Rout.save" [193] "reg-IO.R" "reg-IO.Rout.save" [195] "reg-IO2.R" "reg-IO2.Rout.save" [197] "reg-S4.R" "reg-S4.Rout.save" [199] "reg-plot-latin1.R" "reg-plot-latin1.ps.save" [201] "reg-plot.R" "reg-plot.Rout.save" [203] "reg-plot.ps.save" "reg-tests-1.R" [205] "reg-tests-1.Rout" "reg-tests-1.ps" [207] "reg-tests-2.R" "reg-tests-2.Rout.save" [209] "reg-tests-3.R" "reg-tests-3.Rout.save" [211] "reg-win.R" "simple-true.R" [213] "simple-true.Rout" "simple-true.Rout.save" [215] "testit-Ex.R.save" "testit.Rd" [217] "testit.html.save" "testit.tex.save" [219] "testit.txt.save" "utf8-regex.R" [221] "ver20-Ex.R.save" "ver20.Rd" [223] "ver20.html.save" "ver20.tex.save" [225] "ver20.txt.save"
>
>
> ## PR#7116 seg faulted :
> cor(as.array(c(a=1,b=2)), cbind(1:2))
[,1] [1,] 1
>
>
> ## regression test for PR#7108
> ans <- gsub(" ", "", "b c + d | a * b", perl=TRUE) # NULL in 1.9.1
> stopifnot(identical(ans, gsub(" ", "", "b c + d | a * b")))
> gsub(" ", "", "a: 12345 :a", perl=TRUE) # segfaulted in 1.9.1
[1] "a:12345:a"
> ## wrong answers, segfaults in 1.9.1.
>
>
> ## regression test for PR#7132
> tmp <- data.frame(y=rnorm(8),
+ aa=factor(c(1,1,1,1,2,2,2,2)), + bb=factor(c(1,1,2,2,1,1,2,2)), + cc=factor(c(1,2,3,4,1,2,3,4)))
> tmp.aov <- aov(y ~ cc + bb/aa, data=tmp)
> anova(tmp.aov)
Analysis of Variance Table Response: y Df Sum Sq Mean Sq F value Pr(>F) cc 3 7.4213 2.47378 1.0694 0.5165 bb:aa 2 0.0441 0.02203 0.0095 0.9906 Residuals 2 4.6265 2.31327
> model.tables(tmp.aov, type="means")
Tables of means Grand mean 0.01753825 cc cc 1 2 3 4 1.0937 -1.4183 -0.2642 0.6590 bb:aa aa bb 1 2 1 0.11461 -0.07953 2 -0.02237 0.05745
> ## failed in 1.9.1.
>
> if(require(survival)) { # required package
+ a <- Surv(1:4, 2:5, c(0,1,1,0)) + str(a) + str(a[rep(1:4,3)], vec.len = 7) + detach("package:survival") + } Loading required package: survival Surv [1:4, 1:3] (1,2+] (2,3 ] (3,4 ] (4,5+] - attr(*, "dimnames")=List of 2 ..$ : NULL ..$ : chr [1:3] "start" "stop" "status" - attr(*, "type")= chr "counting" Surv [1:12, 1:3] (1,2+] (2,3 ] (3,4 ] (4,5+] (1,2+] (2,3 ] (3,4 ] ... - attr(*, "dimnames")=List of 2 ..$ : NULL ..$ : chr [1:3] "start" "stop" "status" - attr(*, "type")= chr "counting"
>
> ### end of tests added in 1.9.1 patched ###
>
>
> ## names in columns of data frames
> x <- 1:10
> names(x) <- letters[x]
> DF <- data.frame(x=x)
> (nm <- names(DF$x))
NULL
> stopifnot(is.null(nm))
> DF$y1 <- x
> DF["y2"] <- x
> DF[, "y3"] <- x
> DF[["y4"]] <- x
> stopifnot(is.null(names(DF$y1)), is.null(names(DF$y2)),
+ is.null(names(DF$y3)), is.null(names(DF$y4)))
> # names were preserved in 1.9.x
> # check factors
> xx <- as.factor(x)
> DF <- data.frame(x=xx)
> (nm <- names(DF$xx))
NULL
> stopifnot(is.null(nm))
> DF$y1 <- xx
> DF["y2"] <- xx
> DF[, "y3"] <- xx
> DF[["y4"]] <- xx
> stopifnot(is.null(names(DF$y1)), is.null(names(DF$y2)),
+ is.null(names(DF$y3)), is.null(names(DF$y4)))
> # how about AsIs? This should preserve names
> DF <- data.frame(x=I(x))
> (nm <- names(DF$x))
[1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j"
> stopifnot(identical(nm, names(x)))
> DF2 <- rbind(DF, DF[7:8,, drop=FALSE])
> (nm <- names(DF2$x))
[1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "g" "h"
> stopifnot(identical(nm, c(names(x), names(x)[7:8])))
> # and matrices? Ordinary matrices will be split into columns
> x <- 1:10
> dim(x) <- c(5,2)
> dimnames(x) <- list(letters[1:5], c("i", "ii"))
> DF <- data.frame(x=I(x))
> DF2 <- rbind(DF, DF)
> (rn <- rownames(DF2$x))
[1] "a" "b" "c" "d" "e" "a" "b" "c" "d" "e"
> stopifnot(identical(rn, c(rownames(x), rownames(x))))
> class(x) <- "model.matrix"
> DF <- data.frame(x=x)
> DF2 <- rbind(DF, DF)
> (rn <- rownames(DF2$x))
[1] "a" "b" "c" "d" "e" "a" "b" "c" "d" "e"
> stopifnot(identical(rn, c(rownames(x), rownames(x))))
> ## names were always preserved in 1.9.x, but rbind dropped names and dimnames.
>
>
> ## cumsum etc dropped names
> x <- rnorm(10)
> names(x) <- nm <- letters[1:10]
> stopifnot(identical(names(cumsum(x)), nm),
+ identical(names(cumprod(x)), nm), + identical(names(cummax(x)), nm), + identical(names(cummin(x)), nm))
> x <- x+1i
> stopifnot(identical(names(cumsum(x)), nm),
+ identical(names(cumprod(x)), nm))
> ## 1.9.x dropped names
>
>
> ## complex superassignments
> e <- c(a=1, b=2)
> f <- c(a=1, b=2)
> g <- e
> h <- list(a=1, list(b=2, list(c=3, d=4), list(e=5)))
> j <- matrix(1, 2, 2)
> a <- "A"
> local({
+ eold <- e <- c(A=10, B=11) + hold <- h <- 2 + jold <- j <- 7 + gold <- g <- e + a <- "B" + + e[2] <<- e[2]+1 + names(f)[2] <<- a + g <<- 1 + h[[2]][[h]][[ f[e==10] ]] <<- h + names(h[[2]][[h]])[f[e==10] ] <<- a + j[h, h] <<- h + colnames(j)[2] <<- a + + stopifnot(identical(e, eold)) + stopifnot(identical(h, hold)) + stopifnot(identical(g, gold)) + stopifnot(identical(j, jold)) + })
>
> stopifnot(identical(e, c(a=1, b=12)))
> stopifnot(identical(f, c(a=1, B=2)))
> stopifnot(identical(g, 1))
> stopifnot(identical(h, list(a=1, list(b=2, list(B=2, d=4), list(e=5)))))
> stopifnot(identical(as.vector(j), c(1, 1, 1, 2)))
> stopifnot(identical(colnames(j), c(NA,"B")))
> ## gave error 'subscript out of bounds' in 1.9.1
>
> ## make sure we don't get cycles out of changes to subassign3.
> x <- list(a=1, y=2)
> x$a <- x
> print(x)
$a $a$a [1] 1 $a$y [1] 2 $y [1] 2
> x$d <- x
> print(x)
$a $a$a [1] 1 $a$y [1] 2 $y [1] 2 $d $d$a $d$a$a [1] 1 $d$a$y [1] 2 $d$y [1] 2
> y <- x
> x$b <- y
> print(x)
$a $a$a [1] 1 $a$y [1] 2 $y [1] 2 $d $d$a $d$a$a [1] 1 $d$a$y [1] 2 $d$y [1] 2 $b $b$a $b$a$a [1] 1 $b$a$y [1] 2 $b$y [1] 2 $b$d $b$d$a $b$d$a$a [1] 1 $b$d$a$y [1] 2 $b$d$y [1] 2
> x$f <- y
> print(x)
$a $a$a [1] 1 $a$y [1] 2 $y [1] 2 $d $d$a $d$a$a [1] 1 $d$a$y [1] 2 $d$y [1] 2 $b $b$a $b$a$a [1] 1 $b$a$y [1] 2 $b$y [1] 2 $b$d $b$d$a $b$d$a$a [1] 1 $b$d$a$y [1] 2 $b$d$y [1] 2 $f $f$a $f$a$a [1] 1 $f$a$y [1] 2 $f$y [1] 2 $f$d $f$d$a $f$d$a$a [1] 1 $f$d$a$y [1] 2 $f$d$y [1] 2
> ##
>
>
> ## model.frame incorrectly preserved ts attributes
> x1 <- ts(c(1:10, NA))
> y1 <- ts(rnorm(11))
> lm(y1 ~ x1)
Call: lm(formula = y1 ~ x1) Coefficients: (Intercept) x1 1.0555 -0.2129
> lm(y1 ~ x1 + I(x1^2)) # second term has two classes
Call: lm(formula = y1 ~ x1 + I(x1^2)) Coefficients: (Intercept) x1 I(x1^2) 1.84053 -0.60544 0.03568
> ## failed in 1.9.1
>
>
> ## range checks missing in recursive assignments (PR#7196)
> l <- list()
> try(l[[2:3]] <- 1)
Error in `[[<-`(`*tmp*`, 2:3, value = 1) : no such index at level 1
> l <- list(x=2)
> try(l[[2:3]] <- 1)
Error in `[[<-`(`*tmp*`, 2:3, value = 1) : no such index at level 1
> l <- list(x=2, y=3)
> l[[2:3]] <- 1
> ## first two segfaulted in 1.9.x
>
>
> ## apply() on an array of dimension >=3 AND when for each iteration
> ## the function returns a named vector of length >=2 (PR#7205)
> a <- array(1:24, dim=2:4)
> func1 <- function(x) c(a=mean(x), b=max(x))
> apply(a, 1:2, func1)
, , 1 [,1] [,2] a 10 11 b 19 20 , , 2 [,1] [,2] a 12 13 b 21 22 , , 3 [,1] [,2] a 14 15 b 23 24
> ## failed in 1.9.1
>
>
> # col2rgb must return a matrix for a single colour
> stopifnot(is.matrix(col2rgb("red")))
> ## was vector at one point in pre-2.0.0
>
>
> ## Subscripting matrices with NA's
> AAA <- array(1:6, c(6,1,1))
> idx <- c(1,2,NA,NA,5,6)
> B <- 10
> AAA[idx,1,1] <- B
> stopifnot(all.equal(as.vector(AAA), c(10,10,3,4,10,10)))
> ## assigned only the first two elements in 1.9.1.
> ## Tests for >= 2.0.0
> A <- c(1,2,3,4,5,6)
> A[idx] <- 27 # OK, one value
> stopifnot(identical(A, c(27,27,3,4,27,27)))
> try(A[idx] <- 6:1) # was 6 5 3 4 2 1 in 1.9.1
Error in A[idx] <- 6:1 : NAs are not allowed in subscripted assignments
> stopifnot(inherits(.Last.value, "try-error"))
>
> AA <- matrix(c(1,2,3,4,5,6), 6, 1)
> AA[idx,] <- 27 # OK, one value
> stopifnot(identical(AA, matrix(c(27,27,3,4,27,27), 6, 1)))
> try(AA[idx,] <- 6:1) # was 6 5 3 4 4 3 in 1.9.1
Error in AA[idx, ] <- 6:1 : NAs are not allowed in subscripted assignments
> stopifnot(inherits(.Last.value, "try-error"))
>
> AAA <- array(c(1,2,3,4,5,6), c(6,1,1))
> AAA[idx,,] <- 27 # OK, one value
> stopifnot(identical(AAA, array(c(27,27,3,4,27,27), c(6,1,1))))
> try(AAA[idx,,] <- 6:1) # was 6 5 3 4 5 6 in 1.9.1
Error in AAA[idx, , ] <- 6:1 : NAs are not allowed in subscripted assignments
> stopifnot(inherits(.Last.value, "try-error"))
> ## only length-1 values are allowed in >= 2.0.0.
>
>
> ## hist with infinite values (PR#7220)
> hist(log(-5:100), plot = FALSE)
$breaks [1] 0.0 0.5 1.0 1.5 2.0 2.5 3.0 3.5 4.0 4.5 5.0 $counts [1] 1 1 2 3 5 8 13 21 36 10 $intensities [1] 0.02000000 0.02000000 0.04000000 0.06000000 0.10000000 0.16000000 [7] 0.26000000 0.42000000 0.72000000 0.20000000 $density [1] 0.02000000 0.02000000 0.04000000 0.06000000 0.10000000 0.16000000 [7] 0.26000000 0.42000000 0.72000000 0.20000000 $mids [1] 0.25 0.75 1.25 1.75 2.25 2.75 3.25 3.75 4.25 4.75 $xname [1] "log(-5:100)" $equidist [1] TRUE attr(,"class") [1] "histogram" Warning message: In log(-5:100) : NaNs produced
> ## failed in 1.9.1: will warn, correctly.
>
>
> ## merge problem with names/not in rbind.data.frame
> x <- structure(c("a", "b", "2", "0.2-26", "O", "O"), .Dim = 2:3,
+ .Dimnames = list(c("1", "2"), c("P", "V", "2")))
> y <- structure(c("a", "b", "2", "0.2-25", "O", "O"), .Dim = 2:3,
+ .Dimnames = list(c("1", "2"), c("P", "V", "1")))
> merge(x, y, all.y = TRUE)
P V 2 1 1 a 2 O O 2 b 0.2-25 <NA> O
> ## failed for a while in pre-2.0.0
>
>
> ## matrix responses in binomial glm lost names prior to 2.0.0
> y <- rbinom(10, 10, 0.5)
> x <- 1:10
> names(y) <- letters[1:10]
> ym <- cbind(y, 10-y)
> fit2 <- glm(ym ~ x, binomial)
> stopifnot(identical(names(resid(fit2)), names(y)))
> ## Note: fit <- glm(y/10 ~ x, binomial, weights=rep(10, 10))
> ## Does not preserve names in R < 2.0.1, but does in S.
> fit <- glm(y/10 ~ x, binomial, weights=rep(10, 10))
> stopifnot(identical(names(resid(fit)), names(y)))
> ## The problem was glm.fit assumed a vector response.
>
>
> ## dlogis(-2000) was NaN in <= 2.0.0.
> stopifnot(identical(dlogis(-2000), 0.0))
> ##
>
>
> ## short vectors in spline[fun] (PR#7290)
> try(splinefun(1[0], 1[0])(1)) # segfault in <= 2.0.0
Error in splinefun(1[0], 1[0]) : zero non-NA points
> for(meth in c("fmm", "nat", "per"))
+ stopifnot(all(splinefun(1, pi, method = meth)(0:2) == rep(pi, 3)))
> ## exactly constant for n=1; was NA for "periodic" in <= 2.0.0
>
>
> ## ecdf with NAs (part of PR#7292).
> x <- c(1,2,2,4,7, NA, 10,12, 15,20)
> ecdf(x)
Empirical CDF Call: ecdf(x) x[1:8] = 1, 2, 4, ..., 15, 20
> ## failed in <= 2.0.0.
>
>
> ## Incorrect use of as.Date segfaulted on some x86_64 systems.
> as.Date("2001", "%Y")
[1] "2001-11-02"
> ## answer is usually current mon & day, but 2001-01-01 on Solaris.
>
>
> ## rank and order accepted invalid inputs (and gave nonsense)
> x1 <- as.list(10:1)
> x2 <- charToRaw("A test string")
> stopifnot(inherits(try(order(x1)), "try-error"),
+ inherits(try(order(x2)), "try-error"), + inherits(try(rank(x1)), "try-error"), + inherits(try(rank(x2)), "try-error")) Error in order(x1) : unimplemented type 'list' in 'orderVector1' Error in order(x2) : unimplemented type 'raw' in 'orderVector1' Error in switch(ties.method, average = , min = , max = .Internal(rank(x[!nas], : unimplemented type 'list' in 'greater' Error in switch(ties.method, average = , min = , max = .Internal(rank(x[!nas], : raw vectors cannot be sorted
> ## worked but gave 1:n in 2.0.0.
> stopifnot(inherits(try(sort(x1)), "try-error"),
+ inherits(try(sort(x2)), "try-error"), + inherits(try(sort(x1, partial=5)), "try-error"), + inherits(try(sort(x2, partial=5)), "try-error")) Error in sort.list(x1) : 'x' must be atomic for 'sort.list' Have you called 'sort' on a list? Error in switch(method, quick = { : raw vectors cannot be sorted Error in sort.list(x1, partial = 5) : 'x' must be atomic for 'sort.list' Have you called 'sort' on a list? Error in sort.int(x, na.last = na.last, decreasing = decreasing, ...) : raw vectors cannot be sorted
> ##
>
>
> ## pmax failed with NA inputs
> pmax(c(1,2,NA), c(3,4,NA), na.rm=TRUE)
[1] 3 4 NA
> ## failed after for 2.0.0 change to subassignment
>
>
> ## subassigning expression could segfault (PR#7326)
> foo <- expression(alpha, beta, gamma)
> foo[2]
expression(beta)
> foo[2] <- NA
> foo
expression(alpha, NA, gamma)
> ## segfaulted in 2.0.0
>
>
> ## incorrect arg matching in sum min max prod any all
> ## Pat Burns, R-devel 2004-11-19
> stopifnot(identical(sum(1:4, NA, n = 78, na.rm = TRUE), 88))
> ## was 11 in 2.0.1
>
>
> ## segfault from text, P Ehlers, R-devel 2004-11-24
> plot(1:10)
> loc <- list(5, 6)
> try(text(loc, labels = "a"))
Error in text.default(loc, labels = "a") : no coordinates were supplied
> ## segfaulted in 2.0.1
>
>
> ## automatic row.names can be number-like, MM, 2004-11-26
> d0 <- data.frame(x=1:3, y=pi*2:0)
> row.names(d0)[3] <- c("01.00")
> write.table(d0, (tf <- tempfile()))
> d <- read.table(tf)
> ## gave error ("duplicate row.names") in 2.0.1
> stopifnot(all.equal(d,d0))
> unlink(tf)
>
>
> ## seq() should be more consistent in returning "integer"
> stopifnot(typeof(seq(length=0)) == "integer",
+ identical(seq(length=0), seq(along.with=0[0])), + identical(seq(length=3), 1:3), + identical(seq(length=3), seq(along.with=1:3)))
>
>
> ## labels.lm was broken (PR#7417)
> # part of example(lm)
> 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)
> stopifnot(labels(lm.D9) == "group")
> ## failed in 2.0.1, giving length 0
>
>
> ## sprintf had no length check (PR#7554)
> a <- matrix (ncol=100, nrow=100, data=c(1,2,3,4,5))
> a.serial <- rawToChar(serialize(a, NULL, ascii=TRUE))
> try(sprintf('foo: %s\n', a.serial))
[1] "foo: A\n2\n133632\n131840\n526\n10000\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1\n2\n3\n4\n5\n1026\n1\n9\n3\ndim\n13\n2\n100\n100\n254\n\n"
> ## seqfaulted in 2.0.1
>
>
> ## all/any did not coerce as the Blue Book described.
> for(x in c("F", "FALSE", "T", "TRUE", "NA")) {
+ print(all(x)) + print(any(x)) + } [1] FALSE [1] FALSE [1] FALSE [1] FALSE [1] TRUE [1] TRUE [1] TRUE [1] TRUE [1] NA [1] NA Warning messages: 1: In all(x) : coercing argument of type 'character' to logical 2: In any(x) : coercing argument of type 'character' to logical 3: In all(x) : coercing argument of type 'character' to logical 4: In any(x) : coercing argument of type 'character' to logical 5: In all(x) : coercing argument of type 'character' to logical 6: In any(x) : coercing argument of type 'character' to logical 7: In all(x) : coercing argument of type 'character' to logical 8: In any(x) : coercing argument of type 'character' to logical 9: In all(x) : coercing argument of type 'character' to logical 10: In any(x) : coercing argument of type 'character' to logical
> all(list())
[1] TRUE
> any(list())
[1] FALSE
> ## all failed in 2.0.1 with 'incorrect argument type'
>
>
> ##---- named dimnames of %*% and crossprod() -- matrices and 1-d arrays:
> tst1 <- function(m) {
+ stopifnot(identical(t(m) %*% (m), crossprod(m))) + stopifnot(identical(m %*% t(m), crossprod(t(m)))) + }
> tst2 <- function(x, y=x) {
+ stopifnot(identical(t(x) %*% (y),(crossprod(x,y) -> C))) + stopifnot(identical(t(y) %*% (x),(crossprod(y,x) -> tC))) + stopifnot(identical(tC, t(C))) + }
>
> {m1 <- array(1:2,1:2); dimnames(m1) <- list(D1="A", D2=c("a","b")); m1}
D2 D1 a b A 1 2
> tst1(m1)
> m2 <- m1; names(dimnames(m2)) <- c("", "d2"); tst1(m2)
> m3 <- m1; names(dimnames(m3)) <- c("", "") ; tst1(m3)
> m4 <- m1; names(dimnames(m4)) <- NULL ; tst1(m4)
>
> tst2(m1,m2)
> tst2(m1,m3)
> tst2(m1,m4)
> tst2(m2,m3)
> tst2(m2,m4)
> tst2(m3,m4)
>
> ## 2) Now the 'same' with 1-d arrays:
> a1 <- m1; dim(a1) <- length(a1); dimnames(a1) <- dimnames(m1)[2]; a1 # named dn
D2 a b 1 2
> a2 <- a1; names(dimnames(a2)) <- NULL ; a2 # unnamed dn
a b 1 2
> a3 <- a1; dimnames(a3) <- NULL ; a3 # no dn
[1] 1 2
> stopifnot(identical(dimnames(t(a1))[2], dimnames(a1)))
> ## in version <= 2.0.1, t(.) was loosing names of dimnames()
> tst1(a1)# failed in 2.0.1 ("twice")
> tst1(a2)# failed in 2.0.1
> tst1(a3)# ok
> ## these all three failed in (2.0.1) for more than one reason:
> tst2(a1,a2)
> tst2(a1,a3)
> tst2(a2,a3)
> ## end {testing named dimnames for %*% and crossprod()}
>
>
> ## -- coercing as.data.frame(NULL) to a pairlist didn't work
> y<-1:10
> eval(quote(y), as.data.frame(NULL))
[1] 1 2 3 4 5 6 7 8 9 10
> ## NULL as the second argument of eval should be treated
> ## like a list or data frame
> eval(quote(y), NULL)
[1] 1 2 3 4 5 6 7 8 9 10
> ## end
>
>
> ## data frame with nothing to replace
> A <- matrix(1:4, 2, 2)
> A[is.na(A)] <- 0
> A <- as.data.frame(A)
> A[is.na(A)] <- 0
> ## last not accepted prior to 2.1.0
>
>
> ## scan on partial lines on an open connection
> cat("TITLE extra line", "235 335 535 735", "115 135 175",
+ file="ex.data", sep="\n")
> cn.x <- file("ex.data", open="r")
> res <- scan(cn.x, skip=1, n=2)
Read 2 items
> res <- c(res, scan(cn.x, n=2))
Read 2 items
> res <- c(res, scan(cn.x, n=2))
Read 2 items
> res <- c(res, scan(cn.x, n=2))
Read 1 item
> close(cn.x, sep=" ")
> unlink("ex.data")
> stopifnot(identical(res, c(235, 335, 535, 735, 115, 135, 175)))
> ## dropped some first chars < 2.1.0
>
>
> ## PR#7686 formatC does not pick up on incorrect 'flag' inputs
> try(formatC(1, flag="s"))
Error in formatC(1, flag = "s") : 'flag' can contain only '0+- #'
> ## segfaulted in 2.0.1
>
>
> ## PR#7695 contrasts needed coercion to double
> c <- matrix(c(0,1,2), nrow=3)
> storage.mode(c) <- "integer"
> f <- factor(1:3)
> contrasts(f, 1) <- c
> x <- model.matrix(~f)
> stopifnot(x == c(1,1,1,0,1,2))
> ## gave machine-dependendent silly numbers in 2.0.1
>
>
> ## extreme (de-normalized) axis range
> x <- 2^-seq(67, 1067, length=20)
> plot(x^.9, x, type="l", log="xy") # still warning and ugly labels because
> ## e.g., 10^-323 |==> 9.881313e-324 numerically
> ## gave error "log - axis(), 'at' creation, _LARGE_ range..." in 2.0.1
>
>
> ## torture test of scan() with allowEscape=TRUE
> tf <- tempfile()
> x <- c('ABC', '"123"', "a'b")
> cat(shQuote(x, "cmd"), sep="\n", file=tf)
> (x2 <- scan(tf, ""))
Read 3 items [1] "ABC" "\"123\"" "a'b"
> unlink(tf)
> stopifnot(identical(x, x2))
> ## At one point pre-2.1.0 got confused
>
>
> ## se.contrast failed in 2.0.1 with some effectively one-stratum designs.
> old <- getOption("contrasts")
> options(contrasts = c("contr.helmert", "contr.poly"))
> Lab <- factor(rep(c("1","2","3"), each=12))
> Material <- factor(rep(c("A","B","C","D"),each=3,times=3))
> Measurement <- c(12.20,12.28,12.16,15.51,15.02,15.29,18.14,18.08,18.21,
+ 18.54,18.36,18.45,12.59,12.30,12.67,14.98,15.46,15.22, + 18.54,18.31,18.60,19.21,18.77,18.69,12.72,12.78,12.66, + 15.33,15.19,15.24,18.00,18.15,17.93,18.88,18.12,18.03)
> testdata <- data.frame(Lab, Material, Measurement)
> (test.aov <- aov(Measurement ~ Material + Error(Lab/Material),
+ data = testdata)) Call: aov(formula = Measurement ~ Material + Error(Lab/Material), data = testdata) Grand Mean: 16.12806 Stratum 1: Lab Terms: Residuals Sum of Squares 0.4325056 Deg. of Freedom 2 Residual standard error: 0.4650299 Stratum 2: Lab:Material Terms: Material Residuals Sum of Squares 219.01981 0.80418 Deg. of Freedom 3 6 Residual standard error: 0.3661018 Estimated effects are balanced Stratum 3: Within Terms: Residuals Sum of Squares 1.025867 Deg. of Freedom 24 Residual standard error: 0.2067473
> eff.aovlist(test.aov)
Material Lab:Material 1
> (res <- se.contrast(test.aov,
+ list(Material=="A", Material=="B", + Material=="C", Material=="D"), + coef = c(1, 1, -1, -1), data = testdata)) [1] 0.2440679
> ## failed in 2.0.1 as a matrix was 1 x 1.
>
> ## 2.0.1 also failed to check for orthogonal contrasts
> ## in calculating the efficiencies (which are 1 here).
> options(contrasts = c("contr.treatment", "contr.poly"))
> (test2.aov <- aov(Measurement ~ Material + Error(Lab/Material),
+ data = testdata)) Call: aov(formula = Measurement ~ Material + Error(Lab/Material), data = testdata) Grand Mean: 16.12806 Stratum 1: Lab Terms: Residuals Sum of Squares 0.4325056 Deg. of Freedom 2 Residual standard error: 0.4650299 Stratum 2: Lab:Material Terms: Material Residuals Sum of Squares 219.01981 0.80418 Deg. of Freedom 3 6 Residual standard error: 0.3661018 Estimated effects may be unbalanced Stratum 3: Within Terms: Residuals Sum of Squares 1.025867 Deg. of Freedom 24 Residual standard error: 0.2067473
> (res2 <- se.contrast(test2.aov,
+ list(Material=="A", Material=="B", + Material=="C", Material=="D"), + coef = c(1, 1, -1, -1), data = testdata)) [1] 0.2440679
> stopifnot(all.equal(res, res2))
>
> ## related checks on eff.aovlist
> # from example(eff.aovlist) # helmert contrasts
> Block <- gl(8, 4)
> A<-factor(c(0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1))
> B<-factor(c(0,0,1,1,0,0,1,1,0,1,0,1,1,0,1,0,0,0,1,1,0,0,1,1,0,0,1,1,0,0,1,1))
> C<-factor(c(0,1,1,0,1,0,0,1,0,0,1,1,0,0,1,1,0,1,0,1,1,0,1,0,0,0,1,1,1,1,0,0))
> Yield <- c(101, 373, 398, 291, 312, 106, 265, 450, 106, 306, 324, 449,
+ 272, 89, 407, 338, 87, 324, 279, 471, 323, 128, 423, 334, + 131, 103, 445, 437, 324, 361, 302, 272)
> aovdat <- data.frame(Block, A, B, C, Yield)
> old <- getOption("contrasts")
> options(contrasts=c("contr.helmert", "contr.poly"))
> fit <- aov(Yield ~ A * B * C + Error(Block), data = aovdat)
> eff1 <- eff.aovlist(fit)
> options(contrasts = old)
> fit <- aov(Yield ~ A * B * C + Error(Block), data = aovdat)
> eff2 <- eff.aovlist(fit)
> stopifnot(all.equal(eff1, eff2)) # will have rounding-error differences
> ## Were different in earlier versions
>
>
> ## parts of PR#7742 and other examples
> sub('^','v_', 1:3, perl=TRUE)
[1] "v_1" "v_2" "v_3"
> ## 2.0.1 did not coerce to character (nor was it documented to).
> x <- LETTERS[1:3]
> stopifnot(identical(paste('v_', x, sep=""),
+ sub('^','v_', x, perl = TRUE)))
> ## 2.0.1 added random chars at the end
> stopifnot(identical(paste('v_', x, sep=""), sub('^','v_', x)))
> ## 2.0.1 did not substitute at all
> (x <- gsub("\\b", "|", "The quick brown fox", perl = TRUE))
[1] "|The| |quick| |brown| |fox|"
> stopifnot(identical(x, "|The| |quick| |brown| |fox|"))
> ## checked against sed: 2.0.1 infinite-looped.
> ## NB, the help page warns you not to do this one except in perl
> (x <- gsub("\\b", "|", "The quick brown fox", perl = TRUE))
[1] "|The| |quick| |brown| |fox|"
> stopifnot(identical(x, "|The| |quick| |brown| |fox|"))
> ## 2.0.1 gave wrong answer
> ## Another boundary case, same warning
> ## (x <- gsub("\\b", "|", " The quick "))
> ## stopifnot(identical(x, " |The| |quick| "))
> (x <- gsub("\\b", "|", " The quick ", perl = TRUE))
[1] " |The| |quick| "
> stopifnot(identical(x, " |The| |quick| "))
> ## and some from a comment in the GNU sed code
> x <- gsub("a*", "x", "baaaac")
> stopifnot(identical(x, "xbxcx"))
> x <- gsub("a*", "x", "baaaac", perl = TRUE)
> stopifnot(identical(x, "xbxcx"))
> ## earlier versions got "bxc" or "xbxxcx"
> (x <- gsub("^12", "x", "1212")) # was "xx"
[1] "x12"
> stopifnot(identical(x, "x12"))
> (x <- gsub("^12", "x", "1212", perl = TRUE)) # was "xx"
[1] "x12"
> stopifnot(identical(x, "x12"))
> ## various fixes in 2.1.0
>
> ## length(0) "dist":
> (d01. <- dist(matrix(0., 0,1)))
dist(0)
> ## failed in 2.0.1 and earlier
>
>
> ## Wish of PR#7775
> x <- matrix(0, nrow=0, ncol=2)
> colSums(x); rowSums(x)
[1] 0 0 numeric(0)
> x <- matrix(0, nrow=2, ncol=0)
> colSums(x); rowSums(x)
numeric(0) [1] 0 0
> ## not allowed in 2.0.1
>
>
> ## infinite recursion in 2.0.1 (and R-beta 2005-04-11):
> summary(data.frame(mat = I(matrix(1:8, 2))))
mat.V1 mat.V2 mat.V3 mat.V4 Min. :1.00 Min. :3.00 Min. :5.00 Min. :7.00 1st Qu.:1.25 1st Qu.:3.25 1st Qu.:5.25 1st Qu.:7.25 Median :1.50 Median :3.50 Median :5.50 Median :7.50 Mean :1.50 Mean :3.50 Mean :5.50 Mean :7.50 3rd Qu.:1.75 3rd Qu.:3.75 3rd Qu.:5.75 3rd Qu.:7.75 Max. :2.00 Max. :4.00 Max. :6.00 Max. :8.00
> summary(data.frame(x = gl(2,2), I(matrix(1:8, 4))))
x matrix.1.8..4..V1 matrix.1.8..4..V2 1:2 Min. :1.00 Min. :5.00 2:2 1st Qu.:1.75 1st Qu.:5.75 Median :2.50 Median :6.50 Mean :2.50 Mean :6.50 3rd Qu.:3.25 3rd Qu.:7.25 Max. :4.00 Max. :8.00
> ##
>
>
>
> ### fixes for 2.1.1 ###
>
> ## PR#7792: predict.glm dropped names
> nm <- names(predict(glm(y ~ x, family=binomial,
+ data=data.frame(y=c(1, 0, 1, 0), x=c(1, 1, 0, 0))), + newdata=data.frame(x=c(0, 0.5, 1)), type="response"))
> stopifnot(identical(nm, as.character(1:3)))
> ## no names in 2.1.0
>
>
> ## PR#7808: as.data.frame: Error in "names<-.default"
> x1 <- array(1:9, c(3, 3, 3))
> FUN <- function(x1, x2, x3, x4) cbind(x1[, 1, 1:2], x1[, 2, 1:2])[, 1]
> as.data.frame(FUN(x1[1:3,,], x2 = c("a", "b"),
+ x3 = c("a", "b"), x4 = c("a", "b"))) FUN(x1[1:3, , ], x2 = c("a", "b"), x3 = c("a", "b"), x4 = c("a", "b")) 1 1 2 2 3 3
> ## failed in 2.1.0
>
>
> ## PR#7797 citation() chops "Roeland "
> stopifnot(as.personList("Roeland Lastname")[[1]]$name[1] == "Roeland")
> ## was empty in 2.1.0.
>
>
> ## runmed()'s Turlach algorithm seg.faulted in rare cases:
> t2 <- c(-2,-7,5,2,-3, 0,1,3,2,-1,2,1,2,1,1,1,-2,4, 1,1,1, 32)
> rS <- runmed(t2, k=21, algorithm= "Stuetzle")
> rT <- runmed(t2, k=21, algorithm= "Turlach")
> stopifnot(identical(rS, rT))
> ## seg.fault in 2.1.0
>
>
> ## duplicated and unique on a list
> x <- list(1, 2, 3, 2)
> duplicated(x)
[1] FALSE FALSE FALSE TRUE
> unique(x)
[[1]] [1] 1 [[2]] [1] 2 [[3]] [1] 3
> ## unique failed in 2.1.0
>
>
> ## prog.aovlist on data with row.names
> 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)
> row.names(npk) <- letters[2:25]
> npk.aovE <- aov(yield ~ N*P*K + Error(block), npk)
> pr <- proj(npk.aovE)
> ## failed in 2.1.0
>
>
> ## PR#7894: Reversing axis in a log plot
> x <- 1:3
> plot(x, exp(x), log = "y", ylim = c(30,1))
> ## gave error (and warning) in log - axis(), 'at' creation
>
> ### end of tests added in 2.1.0 patched ###
>
>
>
> ## Multibyte character set regular expressions had buffer overrun
> regexpr("[a-z]", NA)
[1] NA attr(,"match.length") [1] NA
> ## crashed on 2.1.1 on Windows in MBCS build.
>
>
> ## PR#8033: density with 'Inf' in x:
> d <- density(1/0:2, kern = "rect", bw=1, from=0, to=1, n=2)
> stopifnot(all.equal(rep(1/sqrt(27), 2), d$y, tol=1e-14))
> ## failed in R 2.1.1 (since about 1.9.0)
>
> stopifnot(all.equal(Arg(-1), pi))
> ## failed in R <= 2.1.1
>
>
> ## PR#7973: reversed log-scaled axis
> plot(1:100, log="y", ylim=c(100,10))
> stopifnot(axTicks(2) == 10*c(1,2,5,10))
> ## empty < 2.2.0
>
>
> ## rounding errors in window.default (reported by Stefano Iacus)
> x <- ts(rnorm(50001), start=0, deltat=0.1)
> length(window(x, deltat=0.4))
[1] 12501
> length(window(x, deltat=1))
[1] 5001
> length(window(x, deltat=4.9))
[1] 1021
> length(window(x, deltat=5))
[1] 1001
> ## last failed in 2.1.1
>
>
> ## incorrect sort in order with na.last != NA
> x <- c("5","6",NA,"4",NA)
> y <- x[order(x,na.last=FALSE)]
> stopifnot(identical(y, c(NA, NA, "4", "5", "6")))
> ## 2.1.1 sorted "4" first: the fence was wrong.
>
>
> ## integer overflow in cor.test (PR#8087)
> n <- 46341
> (z <- cor.test(runif(n), runif(n), method = "spearman"))
Spearman's rank correlation rho data: runif(n) and runif(n) S = 1.656868e+13, p-value = 0.8208 alternative hypothesis: true rho is not equal to 0 sample estimates: rho 0.001052027 Warning message: In cor.test.default(runif(n), runif(n), method = "spearman") : Cannot compute exact p-values with ties
> stopifnot(!is.na(z$p.value))
> ##
>
> ## seek on a file messed up in Windows (PR#7896)
> tf <- tempfile()
> f <- file(tf, "w+b")
> writeChar("abcdefghijklmnopqrstuvwxyz", f, eos=NULL)
> seek(f, 0, "end", rw="r")
[1] 0
> stopifnot(seek(f, NA, rw="r") == 26) # MinGW messed up seek to end of file that was open for writing
> close(f)
> f <- file(tf, "rb")
> seek(f, 12)
[1] 0
> stopifnot(readChar(f, 1) == "m") # First patch messed up on read-only files
> close(f)
> unlink(tf)
> ##
>
> ### end of tests added in 2.1.1 patched ###
>
>
>
> ## tests of hexadecimal constants
> x <- 0xAbc
> stopifnot(x == 2748)
> xx <- as.integer("0xAbc")
> stopifnot(x == xx)
> xx <- as.numeric("0xAbc")
> stopifnot(x == xx)
> stopifnot(as.integer("13.7") == 13)
> ## new in 2.2.0
>
>
> ## save() of raw vector was incorrect on big-endian system
> (y <- x <- charToRaw("12345"))
[1] 31 32 33 34 35
> save(x, file="x.Rda")
> rm(x)
> load("x.Rda")
> x
[1] 31 32 33 34 35
> stopifnot(identical(x, y))
> unlink("x.Rda")
> ## 00 00 00 00 00 in 2.1.0 on MacOS X
> ## fixed for 2.1.1, but test added only in 2.2.x
>
>
> ## PR#7922: Could not use expression() as an initial expression value
> setClass("test2", representation(bar = "expression"))
[1] "test2"
> new("test2", bar = expression())
An object of class "test2" Slot "bar": expression()
> ## failed
>
>
> ## Ops.data.frame had the default check.names=TRUE
> DF <- data.frame("100"=1:2, "200"=3:4, check.names=FALSE)
> DF/DF
100 200 1 1 1 2 1 1
> stopifnot(identical(names(DF), names(DF/DF)))
> ## DF/DF names had X prepended < 2.2.0
>
>
> ## sum(T) was double
> x <- 1:10
> stopifnot(typeof(sum(x)) == "integer")
> x <- c(TRUE, FALSE)
> stopifnot(typeof(sum(x)) == "integer")
> ## double < 2.2.0
>
>
> ## Overflow in PrintGenericVector
> x <- paste(1:5000, collapse="+")
> as.matrix(list(a=1:2, b=2:3, c=x))
[,1] a Integer,2 b Integer,2 c "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+27+28+29+30+31+32+33+34+35+36+" [truncated]
> ## segfault in 2.1.1, silent truncation in 2.1.1 patched
>
>
> ## weighted.residuals for glm fits (PR#7961)
> set.seed(1)
> x <- runif(10)
> y <- x + rnorm(10)
> w <- 0:9
> r1 <- weighted.residuals(lm(y ~ x, weights = w))
> r2 <- weighted.residuals(glm(y ~ x, weights = w))
> stopifnot(all.equal(r1, r2))
> ## different in 2.1.1
>
>
> ## errors in add1.{lm,glm} when adding vars with missing values(PR#8049)
> set.seed(2)
> y <- rnorm(10)
> x <- 1:10
> is.na(x[9]) <- TRUE
>
> lm0 <- lm(y ~ 1)
> lm1 <- lm(y ~ 1, weights = rep(1, 10))
>
> add1(lm0, scope = ~ x)
Single term additions Model: y ~ 1 Df Sum of Sq RSS AIC <none> 5.2377 -2.87203 x 1 0.017853 5.2199 -0.90276 Warning message: In add1.lm(lm0, scope = ~x) : using the 9/10 rows from a combined fit
> add1(lm1, scope = ~ x) ## error in 2.1.1
Single term additions Model: y ~ 1 Df Sum of Sq RSS AIC <none> 5.2377 -2.87203 x 1 0.017853 5.2199 -0.90276 Warning message: In add1.lm(lm1, scope = ~x) : using the 9/10 rows from a combined fit
>
> glm0 <- glm(y ~ 1)
> glm1 <- glm(y ~ 1, weights = rep(1, 10))
> glm2 <- glm(y ~ 1, offset = rep(0, 10))
>
> add1(glm0, scope = ~ x) ## error in 2.1.1
Single term additions Model: y ~ 1 Df Deviance AIC <none> 5.2377 31.023 x 1 5.2199 32.992 Warning message: In add1.glm(glm0, scope = ~x) : using the 9/10 rows from a combined fit
> add1(glm1, scope = ~ x) ## error in 2.1.1
Single term additions Model: y ~ 1 Df Deviance AIC <none> 5.2377 31.023 x 1 5.2199 32.992 Warning message: In add1.glm(glm1, scope = ~x) : using the 9/10 rows from a combined fit
> add1(glm2, scope = ~ x) ## error in 2.1.1
Single term additions Model: y ~ 1 Df Deviance AIC <none> 5.2377 31.023 x 1 5.2199 32.992 Warning message: In add1.glm(glm2, scope = ~x) : using the 9/10 rows from a combined fit
> ##
>
>
> ## levels<-.factor dropped other attributes.
> ## Heinz Tuechler, R-help, 2005-07-18
> f1 <- factor(c("level c", "level b", "level a", "level c"), ordered=TRUE)
> attr(f1, "testattribute") <- "teststring"
> (old <- attributes(f1))
$levels [1] "level a" "level b" "level c" $class [1] "ordered" "factor" $testattribute [1] "teststring"
> levels(f1) <- c("L-A", "L-B", "L-C")
> f1
[1] L-C L-B L-A L-C attr(,"testattribute") [1] teststring Levels: L-A < L-B < L-C
> (new <- attributes(f1))
$levels [1] "L-A" "L-B" "L-C" $class [1] "ordered" "factor" $testattribute [1] "teststring"
> new$levels <- old$levels <- NULL
> stopifnot(identical(old, new))
> f2 <- factor(letters[1:4])
> levels(f2) <- as.character(c(1:3, NA))
> f2
[1] 1 2 3 <NA> Levels: 1 2 3
> stopifnot(nlevels(f2) == 3)
> ## dropped other attributes < 2.2.0.
>
>
> ## regressed at one point in pre-2.2.0
> A <- matrix(pi, 0, 2)
> stopifnot(identical(dim(A), dim(format(A))))
> ## dropped dim at one point
>
>
> ## ls.diag with missing values (PR#8139)
> x <- matrix(c(1,-1,1,-1,1,-1,1,-1,1,-1, 1,2,3,4,5,6,7,8,9,10), 10, 2)
> y <- as.matrix(c(1,2,3,NA,3,4,3,4,5,4))
> wt <- c(1,1,1,1,1,1,1,1,1,0)
> regres <- lsfit(x, y, wt=wt)
Warning message: In lsfit(x, y, wt = wt) : 1 missing values deleted
> regdiag <- ls.diag(regres)
Warning messages: 1: In ls.diag(regres) : missing observations deleted 2: In ls.diag(regres) : observations with 0 weight not used in calculating standard deviation
> ## failed < 2.2.0.
>
>
> ## window.default had an inappropriate tolerance
> a <- ts(1:5000, start = 0, freq = 10)
> b <- lag(a, 1)
> bb <- window(b, start = 0)
> stopifnot(length(bb) == length(a) - 1)
> ## was length(a) - 2 in 2.1.1, since the tolerance was abs(start) * ts.end
>
>
> ## subassignment of length zero vector to NULL gave garbage answer (PR#8157)
> x <- NULL
> x[[1]] <- numeric(0)
> stopifnot(length(x[[1]]) == 0)
> ## failed < 2.2.0
>
>
> ## some checks for raw in data frames and lists
> x <- charToRaw("test")
> (z <- data.frame(x))
x 1 74 2 65 3 73 4 74
> z$y <- x
> z[["y2"]] <- x
> z["y3"] <- x
> z
x y y2 y3 1 74 74 74 74 2 65 65 65 65 3 73 73 73 73 4 74 74 74 74
> ## lists use separate code
> z <- list(x=x)
> z$y <- x
> z[["y2"]] <- x
> z["y3"] <- list(x)
> z
$x [1] 74 65 73 74 $y [1] 74 65 73 74 $y2 [1] 74 65 73 74 $y3 [1] 74 65 73 74
> ## Not completely supported prior to 2.2.0
>
>
> ### end of tests added in 2.2.0 ###
>
>
> ## summary.matrix failed on some classed objects
> surv <- structure(c(2.06, 2.13, 0.09, 0.27, 1, 0.36, 3.04, 0.67, 0.35,
+ 0.24, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0), + .Dim = c(10L, 2L), + .Dimnames = list(NULL, c("time", "status")), + type = "right", class = "Surv")
> summary(surv)
time status Min. :0.090 Min. :0.0 1st Qu.:0.290 1st Qu.:0.0 Median :0.515 Median :0.0 Mean :1.021 Mean :0.2 3rd Qu.:1.795 3rd Qu.:0.0 Max. :3.040 Max. :1.0
> ## Had infinite recursion (sometimes segfault) on 2.2.0.
>
> ## need fuzz even for ">=" :
> set.seed(1)
> stopifnot(all.equal(chisq.test(cbind(1:0, c(7,16)), simulate.p = TRUE)$p.value,
+ 0.3368315842, tol = 1e-6))
> ## some i686 platforms gave 0.00049975
>
>
> ## PR#8228 image() failed on a matrix with all NAs
> image(z=matrix(NA, 1, 1), x=0:1, y=0:1)
Warning messages: 1: In min(x, na.rm = na.rm) : no non-missing arguments to min; returning Inf 2: In max(x, na.rm = na.rm) : no non-missing arguments to max; returning -Inf
>
>
> ## read.fwf(header=TRUE) failed (PR#8226)
> ff <- tempfile()
> cat(file=ff, "A\tB\tC", "123456", "987654", sep="\n")
> z <- read.fwf(ff, width=c(1,2,3), header=TRUE)
> stopifnot(identical(names(z), LETTERS[1:3]))
> unlink(ff)
> ## failed in <= 2.2.0
>
> ## diag() failed if matrix had NA dimnames
> x <- matrix(1, 2, 2)
> dimnames(x) <- list(c("a", NA), c("a", NA))
> diag(x)
a <NA> 1 1
>
>
> ## colnames in pivoted decompositions (PR#8258)
> A <- 1:10
> X <- cbind(A,B=A^2, C=A^2-A, D=1)
> qrX <- qr(X)
> oo <- order(qrX$pivot)
> Q <- qr.Q(qrX)
> R <- qr.R(qrX)
> (z <- (Q%*%R)[,oo])
A B C D [1,] 1 1 2.148451e-14 1 [2,] 2 4 2.000000e+00 1 [3,] 3 9 6.000000e+00 1 [4,] 4 16 1.200000e+01 1 [5,] 5 25 2.000000e+01 1 [6,] 6 36 3.000000e+01 1 [7,] 7 49 4.200000e+01 1 [8,] 8 64 5.600000e+01 1 [9,] 9 81 7.200000e+01 1 [10,] 10 100 9.000000e+01 1
> stopifnot(identical(colnames(X), colnames(z)))
>
> qrX <- qr(X, LAPACK=TRUE)
> oo <- order(qrX$pivot)
> Q <- qr.Q(qrX)
> R <- qr.R(qrX)
> (z <- (Q%*%R)[,oo])
A B C D [1,] 1 1 -3.088079e-15 1 [2,] 2 4 2.000000e+00 1 [3,] 3 9 6.000000e+00 1 [4,] 4 16 1.200000e+01 1 [5,] 5 25 2.000000e+01 1 [6,] 6 36 3.000000e+01 1 [7,] 7 49 4.200000e+01 1 [8,] 8 64 5.600000e+01 1 [9,] 9 81 7.200000e+01 1 [10,] 10 100 9.000000e+01 1
> stopifnot(identical(colnames(X), colnames(z)))
>
> Y <- crossprod(X)
> U <- chol(Y, pivot=TRUE)
> oo <- order(attr(U, "pivot"))
> (z <- t(U[,oo])%*% U[,oo])
A B C D A 385 3025 2640 55 B 3025 25333 22308 385 C 2640 22308 19668 330 D 55 385 330 10
> stopifnot(identical(colnames(X), colnames(z)))
> ## unpivoted colnames in R <= 2.2.0
>
>
> ## Im(-1) (PR#8272)
> stopifnot(all.equal(Im(c(1, 0, -1)), rep(0, 3)))
> ## R <= 2.2.0 had Im and Arg the same for non-complex numbers
>
>
> ## rounding errors in aggregate.ts
> aggregate(as.ts(c(1,2,3,4,5,6,7,8,9,10)),1/5,mean)
Time Series: Start = 1 End = 6 Frequency = 0.2 [1] 2.5 6.5
> ## failed in 2.2.0
>
>
> ## prcomp(tol=1e-6)
> x <- matrix(runif(30),ncol=10)
> s <- prcomp(x, tol=1e-6)
> stopifnot(length(s$sdev) == ncol(s$rotation))
> summary(s)
Importance of components: PC1 PC2 Standard deviation 0.712 0.613 Proportion of Variance 0.575 0.425 Cumulative Proportion 0.575 1.000
> ## last failed in 2.2.0
>
>
> ## mapply did not test type of MoreArgs
> try(mapply(rep,times=1:4, MoreArgs=42))
Error in mapply(rep, times = 1:4, MoreArgs = 42) : argument 'MoreArgs' of 'mapply' is not a list
> ## segfaulted in 2.2.0
>
>
> ## qbinom had incorrect test for p with log=TRUE
> (z <- qbinom(-Inf, 1, 0.5, log.p = TRUE))
[1] 0
> stopifnot(is.finite(z))
> ## was NaN in 2.2.0
>
>
> ## t(.) with NULL dimnames
> x <- diag(2)
> dimnames(x) <- list(NULL, NULL)
> stopifnot(identical(x, t(x)),
+ identical(dimnames(x), dimnames(t(array(3, 1, dimnames=list(NULL))))))## dropped the length-2 list till 2.2.0
>
>
> ## infinite influence measures (PR#8367)
> data(occupationalStatus)
> Diag <- as.factor(diag(1:8))
> Rscore <- scale(as.numeric(row(occupationalStatus)), scale = FALSE)
> Cscore <- scale(as.numeric(col(occupationalStatus)), scale = FALSE)
> Uniform <- glm(Freq ~ origin + destination + Diag + Rscore:Cscore,
+ family = poisson, data = occupationalStatus)
> Ind <- as.logical(diag(8))
> residuals(Uniform)[Ind] #zero/near-zero
1 10 19 28 37 0.000000e+00 0.000000e+00 0.000000e+00 0.000000e+00 -2.107342e-08 46 55 64 -1.724934e-07 0.000000e+00 -2.980232e-08
> stopifnot(is.nan(rstandard(Uniform)[Ind]),
+ is.nan(rstudent (Uniform)[Ind]), + is.nan(dffits (Uniform)[Ind]), + is.nan(covratio (Uniform)[Ind]), + is.nan(cooks.distance(Uniform)[Ind]))
> ## had infinities in 2.2.0 on some platforms
> ## plot.lm() on <glm> objects:
> plot(Uniform) # last plot gives warning on h_ii ~= 1
Warning messages: 1: Not plotting observations with leverage one: 1, 10, 19, 28, 37, 46, 55, 64 2: Not plotting observations with leverage one: 1, 10, 19, 28, 37, 46, 55, 64
> plot(Uniform, 6) # added 2006-01-10
Warning message: Not plotting observations with leverage one: 1, 10, 19, 28, 37, 46, 55, 64
> plot(Uniform, 5:6)# failed for a few days 2008-05
Warning messages: 1: Not plotting observations with leverage one: 1, 10, 19, 28, 37, 46, 55, 64 2: Not plotting observations with leverage one: 1, 10, 19, 28, 37, 46, 55, 64
> plot(Uniform, 1:2, caption = "")# ditto
Warning message: Not plotting observations with leverage one: 1, 10, 19, 28, 37, 46, 55, 64
> ##
>
>
> ### end of tests added in 2.2.1 ###
>
> ## sub(fixed=TRUE), reported by Roger Peng 2005-12-21
> x <- 0:10
> v <- paste(x, "asdf", sep=".")
> (xx <- sub(".asdf", "", v, fixed = TRUE))
[1] "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"
> stopifnot(nchar(xx) == nchar(x), xx == x)
> ## had random trailing bytes from second element on in 2.2.1.
> ## identical reported true, fixed in 2.3.0.
>
> ## eigen(EISPACK=TRUE) problem reported to R-devel by Ole Christensen
> ## 2006-01-03
> Gm <- rbind(c(-0.3194373786, 0.2444066686, 0.0428108831, 3.221983e-02),
+ c(0.0002071301, -0.0003282719, 0.0001211418, 5.128830e-12), + c(0.0621332005, 0.0545850010, -0.2098487035, 9.313050e-02), + c(0.0280936142, 0.0586642184, 0.1658310277, -2.525889e-01))
> temp <- eigen(Gm)
> temp
$values [1] -3.464342e-01+1.3161e-03i -3.464342e-01-1.3161e-03i [3] -8.933478e-02+0.0000e+00i -1.690692e-11+0.0000e+00i $vectors [,1] [,2] [,3] [1,] -3.419132e-01-3.74814e-02i -3.419132e-01+3.74814e-02i -0.222056459+0i [2,] 3.508446e-04+1.92097e-05i 3.508446e-04-1.92097e-05i 0.001421758+0i [3,] -4.179744e-01+1.30153e-02i -4.179744e-01-1.30153e-02i -0.664932272+0i [4,] 8.407249e-01+0.00000e+00i 8.407249e-01+0.00000e+00i -0.713129708+0i [,4] [1,] -0.5000000+0i [2,] -0.5000001+0i [3,] -0.5000000+0i [4,] -0.4999999+0i
> temp2 <- eigen(Gm, EISPACK = TRUE)
> temp2$vectors <- apply(temp2$vectors, 2, function(x) x/sqrt(sum(Mod(x)^2)))
> temp2
$values [1] -3.464342e-01+1.3161e-03i -3.464342e-01-1.3161e-03i [3] -8.933478e-02+0.0000e+00i -1.690693e-11+0.0000e+00i $vectors [,1] [,2] [,3] [1,] 2.338145e-01-6.860369e-01i 2.338145e-01+6.860369e-01i 0.222056459+0i [2,] -2.358048e-04+3.342377e-04i -2.358048e-04-3.342377e-04i -0.001421758+0i [3,] 2.732447e-01+2.912927e-01i 2.732447e-01-2.912927e-01i 0.664932272+0i [4,] -5.552109e-01-8.313100e-02i -5.552109e-01+8.313100e-02i 0.713129708+0i [,4] [1,] 0.5000000+0i [2,] 0.5000001+0i [3,] 0.5000000+0i [4,] 0.4999999+0i
> ## segfaulted in 2.2.1
>
> ## rbind on data frames with 0 rows (PR#8506)
> foo <- data.frame(x = 1:10, y = rnorm(10))
> bar1 <- rbind.data.frame(foo[1:5,], foo[numeric(0),])
> stopifnot(dim(bar1) == c(5,2))
> bar2 <- rbind.data.frame(a = foo[1:5,], b = foo[numeric(0),])
> stopifnot(dim(bar2) == c(5,2))
> ## Last had 6 rows in 2.2.1, and was a corrupt data frame
>
> ## environments are recursive but cannot be indexed - all.equal.default()
> d <- data.frame(k=1:7, n=2:8, x=0:6)
> r <- glm(cbind(k, n-k) ~ x, family=binomial, data=d)
> stopifnot(all.equal(r,r))
> ## failed in 2.2.1
>
> ### end of tests added in 2.2.1 patched ###
>
>
> ## sort used to preserve inappropriate attributes and not always sort names.
> x <- runif(10)
> tsp(x) <- c(1,10,1)
> (z <- sort(x)) # kept tsp attribute
[1] 0.09537672 0.10522010 0.15636656 0.15846793 0.26157572 0.26918273 [7] 0.59475907 0.70109071 0.71554579 0.77379137
> stopifnot(is.null(attributes(z)))
> (z <- sort(x, method="quick")) # same
[1] 0.09537672 0.10522010 0.15636656 0.15846793 0.26157572 0.26918273 [7] 0.59475907 0.70109071 0.71554579 0.77379137
> stopifnot(is.null(attributes(z)))
> (z <- sort(x, partial = 1:10)) # same
[1] 0.09537672 0.10522010 0.15636656 0.15846793 0.26157572 0.26918273 [7] 0.59475907 0.70109071 0.71554579 0.77379137
> stopifnot(is.null(attributes(z)))
>
> names(x) <- letters[1:10]
> o <- sort.list(x)
> z2 <- structure(c(x)[o], names=names(x)[o])
> (z <- sort(x)) # sorted names, dropped the tsp attribute
g a c h d j f 0.09537672 0.10522010 0.15636656 0.15846793 0.26157572 0.26918273 0.59475907 i b e 0.70109071 0.71554579 0.77379137
> stopifnot(identical(z, z2))
> (z <- sort(x, method="quick")) # sorted names, kept the tsp attribute.
g a c h d j f 0.09537672 0.10522010 0.15636656 0.15846793 0.26157572 0.26918273 0.59475907 i b e 0.70109071 0.71554579 0.77379137
> stopifnot(identical(z, z2))
> (z <- sort(x, partial = 1:10)) # did not sort names, kept tsp attribute
[1] 0.09537672 0.10522010 0.15636656 0.15846793 0.26157572 0.26918273 [7] 0.59475907 0.70109071 0.71554579 0.77379137
> stopifnot(is.null(attributes(z)))
> ## fixed for 2.3.0 to sort names (except partial), drop all other attributes.
>
>
> ## formatC on as.single (PR#8211)
> # not documented to work but someone tried it.
> (z <- formatC(as.single(1)))
[1] "1"
> stopifnot(identical(z, "1"))
> ## was wrong < 2.3.0
>
>
> ## outer on factors was broken in pre-2.3.0
> x <- factor(1:3)
> outer(x, x, "!=")
[,1] [,2] [,3] [1,] FALSE TRUE TRUE [2,] TRUE FALSE TRUE [3,] TRUE TRUE FALSE
> ## failed 2005-10-17
>
>
> ## add tests for < 0 shape in [dpqr]gamma
> dgamma(1, -2)
[1] NaN Warning message: In dgamma(x, shape, scale, log) : NaNs produced
> pgamma(1, -2)
[1] NaN Warning message: In pgamma(q, shape, scale, lower.tail, log.p) : NaNs produced
> qgamma(0.95, -2)
[1] NaN Warning message: In qgamma(p, shape, scale, lower.tail, log.p) : NaNs produced
> rgamma(3, -20)
[1] NaN NaN NaN Warning message: In rgamma(3, -20) : NAs produced
> ## all errors < 2.1.1, now NaNs
>
>
> ## Make sure reference to local environment is serialized
> f <- function() { function(){} }
> serialize(f(), NULL)
[1] 58 0a 00 00 00 02 00 02 0a 00 00 02 03 00 00 00 04 03 00 00 00 04 00 00 00 [26] 00 00 00 00 fd 00 00 00 fe 00 00 00 fe 00 00 00 fe 00 00 00 fe 00 00 00 06 [51] 00 00 00 01 00 00 00 09 00 00 00 01 7b 00 00 00 fe
> ##
>
>
> ## dummy_vfprintf with overlong format
> xx <- paste(rep("a", 10000), collapse="+")
> con <- gzfile("test.gz", "w")
> writeLines(xx, con)
> close(con)
> unlink("test.gz")
> ## segfaulted in 2.2.0 on some x86_64 systems.
>
>
> ## format() with *.marks:
> x <- 1.2345 + 10^(0:5)
> ff <- format(x, width = 11, big.mark = "'")
> stopifnot(nchar(ff) == 12)
> ## small marks test
> f2 <- format(x, big.mark = "'", small.mark="_", small.interval = 2)
> nc <- nchar(f2)
> stopifnot(substring(f2, nc,nc) != "_", # no traling small mark
+ nc == nc[1])# all the same
> fc <- formatC(1.234 + 10^(0:8), format="fg", width=11, big.mark = "'")
> stopifnot(nchar(fc) == 11)
> ## had non-adjusted strings before 2.3.0
>
>
> ## data.matrix on zero-length columns
> DF <- data.frame(x=c("a", "b"), y=2:3)[FALSE,]
> stopifnot(is.numeric(data.matrix(DF)))
> # was logical in 2.2.1.
> DF <- data.frame(a=I(character(0)))
> X <- data.matrix(DF)
> stopifnot(is.numeric(X))
> ## gave logical matrix in 2.2.1.
>
> stopifnot(pbirthday(950, coincident=250) == 0,
+ pbirthday(950, coincident=200) > 0)
> ## gave error before 2.3.0
>
>
> ## raw matrices (PR#8529/30)
> v <- as.raw(c(1:6))
> dim(v) <- c(2,3)
> dimnames(v) <- list(c("x","y"), c("P", "Q", "R"))
> v
P Q R x 01 03 05 y 02 04 06
> s <- as.raw(c(11:16))
> dim(s) <- c(2,3)
> s
[,1] [,2] [,3] [1,] 0b 0d 0f [2,] 0c 0e 10
> rbind(s,v,v)
P Q R 0b 0d 0f 0c 0e 10 x 01 03 05 y 02 04 06 x 01 03 05 y 02 04 06
> (m <- cbind(s,v,v,s))
P Q R P Q R x 0b 0d 0f 01 03 05 01 03 05 0b 0d 0f y 0c 0e 10 02 04 06 02 04 06 0c 0e 10
> m[2,4] <- as.raw(254)
> m
P Q R P Q R x 0b 0d 0f 01 03 05 01 03 05 0b 0d 0f y 0c 0e 10 fe 04 06 02 04 06 0c 0e 10
> m[1:2,2:4] <- s
> m
P Q R P Q R x 0b 0b 0d 0f 03 05 01 03 05 0b 0d 0f y 0c 0c 0e 10 04 06 02 04 06 0c 0e 10
> ## unimplemented before 2.3.0
>
>
> ## window with non-overlapping ranges (PR#8545)
> test <- ts(1:144, start=c(1,1), frequency=12)
> window(test, start=c(15,1), end=c(17,1), extend=TRUE)
Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec 15 NA NA NA NA NA NA NA NA NA NA NA NA 16 NA NA NA NA NA NA NA NA NA NA NA NA 17 NA
> ## failed < 2.3.0
>
>
> ## pbinom(size=0) gave NaN (PR#8560)
> x <- c(-1,0,1,2)
> stopifnot(identical(pbinom(x, size = 0, p = 0.5), c(0,1,1,1)))

> ## 2.2.1 gave NaN in all cases (forced explicitly in C code).
>
>
> ## Limits on [dpqr]nbinom and [dqpr]geom
> stopifnot(is.nan(dnbinom(0, 1, 0)), dnbinom(0, 1, 1) == 1,
+ pnbinom(c(-1, 0, 1), 1, 1) == c(0, 1, 1), + is.nan(pnbinom(0, 1, 0)), + qnbinom(0.5, 1, 1) == 0, + is.nan(qnbinom(0.5, 1, 0)), + is.finite(rnbinom(1, 1, 1)), + !is.finite(rnbinom(1, 1, 0))) Warning messages: 1: In dnbinom(x, size, prob, log) : NaNs produced 2: In pnbinom(q, size, prob, lower.tail, log.p) : NaNs produced 3: In qnbinom(p, size, prob, lower.tail, log.p) : NaNs produced 4: In rnbinom(1, 1, 0) : NAs produced
> ## d allowed p=0, [pq] disallowed p=1 for R < 2.3.0, r gave NaN for p=1.
> stopifnot(is.nan(dgeom(0, 0)), dgeom(0, 1) == 1,
+ pgeom(c(-1, 0, 1), 1) == c(0, 1, 1), is.nan(pgeom(0, 0)), + qgeom(0.5, 1) == 0, is.nan(qgeom(0.5, 0)), + is.finite(rgeom(1, 1)), + !is.finite(rgeom(1, 0))) Warning messages: 1: In dgeom(x, prob, log) : NaNs produced 2: In pgeom(q, prob, lower.tail, log.p) : NaNs produced 3: In qgeom(p, prob, lower.tail, log.p) : NaNs produced 4: In rgeom(1, 0) : NAs produced
>
>
> ## A response to PR#8528 incorrectly claimed these to be wrong.
> stopifnot(all.equal(df(0, 2, 2), 1))
> stopifnot(is.infinite(df(0, 1.3, 2)))
> x <- 1e-170
> stopifnot(all.equal(pbeta(x,x,x), 0.5))
> ## just a regression check.
> ## This underflowed
> stopifnot(all.equal(dbeta(x,x,x), 0.5))
> ## this was slow
> stopifnot(system.time(qnbinom(1e-10, 1e3, 1e-7))[3] < 0.1)
> ## but this failed
> qnbinom(0.5, 10000000000, 0.000000002)
[1] 5e+18
> ## infinite-looped in 2.2.1 (answer is approx 4e18)
> qpois(0.9, 1e50)
[1] 1e+50
> ## infinite-looped in 2.2.1
> z <- 10^seq(10, 300, 10)
> stopifnot(all.equal(pt(-z, 1, log=TRUE), pcauchy(-z, 1, log=TRUE)))
> ## failed at about 1e150 in 2.2.1
> stopifnot(pt(-1e200, 0.001) > 0)
> ## was 0 in 2.2.1, should be about 31%
>
>
> ## all.equal.numeric overflowed for large integers
> set.seed(1); r1 <- .Random.seed
> set.seed(2); r2 <- .Random.seed
> stopifnot(is.character(all.equal(r1, r2)))
> ## all.equal() gave NA in 2.2.1
>
>
> ## support for raw indices in for() was added in 2.3.0
> xx <- as.raw(40:48)
> for(i in xx) print(i)
[1] 28 [1] 29 [1] 2a [1] 2b [1] 2c [1] 2d [1] 2e [1] 2f [1] 30
> ## was error < 2.3.0
>
>
> ## atan2 with one complex argument
> atan2(1, 1i)
[1] 0-Infi
> ## was error in 2.2.1
>
>
> ## as.list on a symbol, for S-compatibility
> as.list(as.name("data.frame"))
[[1]] data.frame
> ## was error in 2.2.1
>
>
> ## min ignored INT_MAX, (PR#8731)
> stopifnot(min(.Machine$integer.max) == .Machine$integer.max)
> stopifnot(max(-.Machine$integer.max) == -.Machine$integer.max)
> op <- options(warn=2)
> min(Inf)
[1] Inf
> max(-Inf)
[1] -Inf
> options(op)
> ## were +/-Inf with warning in 2.2.1.
>
>
> ## PR#8718: invalid usage in R >= 2.7.0
> #a <- matrix(2,2,2)
> #apply(a,1,"$","a")
> #apply(a,1,sum)
> ## first apply was corrupting apply() code in 2.2.1
>
>
> ## NULL results in apply()
> apply(as.matrix(1), 1, function(x) NULL)
NULL
> ## was error in 2.2.1.
>
>
> ## sum on data frames (PR#8385)
> DF <- data.frame(m1=1:2, m2=3:4)
> sum(DF)
[1] 10
> sum(DF=DF) # needed arg named x
[1] 10
> sum(DF, DF) # failed
[1] 20
> DF[1, 1] <- NA
> stopifnot(is.na(sum(DF)), sum(DF, na.rm=TRUE) == 9)
> ## failures < 2.4.0
>
> ## plot.lm
> # which=4 failed in R 1.0.1
> par(mfrow=c(1,1), oma= rep(0,4))
> summary(lm.fm2 <- lm(Employed ~ . - Population - GNP.deflator, data = longley))
Call: lm(formula = Employed ~ . - Population - GNP.deflator, data = longley) Residuals: Min 1Q Median 3Q Max -0.42165 -0.12457 -0.02416 0.08369 0.45268 Coefficients: Estimate Std. Error t value Pr(>|t|) (Intercept) -3.599e+03 7.406e+02 -4.859 0.000503 *** GNP -4.019e-02 1.647e-02 -2.440 0.032833 * Unemployed -2.088e-02 2.900e-03 -7.202 1.75e-05 *** Armed.Forces -1.015e-02 1.837e-03 -5.522 0.000180 *** Year 1.887e+00 3.828e-01 4.931 0.000449 *** --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1 Residual standard error: 0.2794 on 11 degrees of freedom Multiple R-squared: 0.9954, Adjusted R-squared: 0.9937 F-statistic: 589.8 on 4 and 11 DF, p-value: 9.5e-13
> for(wh in 1:6) plot(lm.fm2, which = wh)
>
> op <- par(mfrow = c(2,2), mar = .1+c(3,3,2,1), mgp = c(1.5, .6, 0))
> y <- rt(200, df= 3)
> plot(lm(y ~ 1))
hat values (leverages) are all = 0.005 and there are no factor predictors; no plot no. 5
> par(op)
> ## 4th plot (which = 5: "leverages") failed in 2.2.0 <= R <= 2.3.0
>
>
> ## Re-fix PR#8506
> z <- rbind(x = data.frame(a = 1, b = 2), y = data.frame(a = 1, b = 2))
> stopifnot(row.names(z) == c("x", "y"))
> ## were NAs (and failed to print) in 2.3.0
>
> dd <- data.frame(x = 3:4)
> stopifnot(identical(rownames(dd), row.names(dd)),
+ identical(rownames(dd), c("1", "2")))
> ## one was integer in an intermediate version of "pre 2.4.0"
>
>
> ## mean on integer vector ignored NAs
> stopifnot(is.na(mean(NA)))
> ## failed in R 2.3.0
>
>
> ## title etc failed if passed col etc of length > 1
> plot(1:2)
> title("foo", col=1:3)
> title("foo", cex=1:3)
> title("foo", lty=1:3)
> title("foo", lwd=1:3)
> title("foo", bg=4:7)
> ## threw errors in R <= 2.3.0
>
>
> ## glm did not allow array offsets
> df1 <- data.frame(u=1:10,
+ v=rpois(10,10), + z=array(1,10, dimnames=list(1:10)))
> glm(v ~ u+offset(log(z)), data=df1, family=poisson)
Call: glm(formula = v ~ u + offset(log(z)), family = poisson, data = df1) Coefficients: (Intercept) u 2.49262 -0.02801 Degrees of Freedom: 9 Total (i.e. Null); 8 Residual Null Deviance: 6.377 Residual Deviance: 5.705 AIC: 51.35
> ## was error in R <= 2.3.0
>
>
> ## invalid values of a logical vector from bindingIsLocked
> ## Martin Morgan, R-devel, 2006-05-14
> e <- new.env()
> e$x <- 1
> e$y <- 2
> lockBinding("x", e)
> stopifnot(bindingIsLocked("x", e), bindingIsLocked("x", e)==TRUE,
+ !bindingIsLocked("y", e), bindingIsLocked("y", e)==FALSE)
> ## on some systems in R <= 2.3.0, bindingIsLocked("x", e)==TRUE was false
>
>
> ## ccf on non-aligned time series
> x <- ts(rnorm(100), start=1)
> y <- ts(rnorm(120), start=3)
> ccf(x, y)
> ## needed na.action=na.contiguous in 2.3.0
>
>
> ## merge.data.frame was not making column names unique when
> ## doing a Cartesian product.
> DF <- data.frame(col=1:3)
> DF2 <- merge(DF, DF, by=numeric(0))
> stopifnot(identical(names(DF2), c("col.x", "col.y")))
> ## both were 'col' in 2.3.0.
>
>
> ## [pq]unif were not consistent on infinite ranges.
> stopifnot(is.na(qunif(.5, 0, Inf)))
Warning message: In qunif(p, min, max, lower.tail, log.p) : NaNs produced
> ## was Inf in 2.3.1.
> stopifnot(is.na(punif(1, 0, Inf)))
Warning message: In punif(q, min, max, lower.tail, log.p) : NaNs produced
> ## was 0 in 2.3.1
> ## and failed on zero ranges despite the documentation.
> stopifnot(punif(c(0, 1, 2), 1, 1) == c(0, 1, 1))
> stopifnot(qunif(c(0, 0.5, 1), 1, 1) == 1)
> ## were all NaN on 2.3.1
>
>
> ## cbind segfaulted if coercion of the result to list failed.
> cbind(as.name("foo"), 1:3)
[,1] [,2] [1,] ? 1 [2,] ? 2 [3,] ? 3
> # segfaulted in 2.3.1
> (x <- cbind(y ~ x, 1))
[,1] [,2] [1,] ? 1 [2,] ? 1 [3,] ? 1
> x[,1]
[[1]] `~` [[2]] y [[3]] x
> ## last is 3 x 2 list matrix
>
>
> ## empty point set
> r <- xy.coords(numeric(0))
> ## gave an error with misleading message in 2.3.1
>
>
> ## [<- could extend a ts but not change tsp.
> xx <- x <- ts(rnorm(6), frequency=7)
> try(x[8] <- NA)
Error in `[<-.ts`(`*tmp*`, 8, value = NA) : only replacement of elements is allowed
> stopifnot(identical(x, xx))
> ## Allowed in R < 2.4.0, but corrupted tsp.
>
>
> ## Looking up generic in UseMethod
> mycoef <- function(object, ....) UseMethod("coef")
> x <- list(coefficients=1:3)
> mycoef(x)
[1] 1 2 3
> ## failed to find default method < 2.4.0
>
>
> ## regression tests on changes to model.frame and model.matrix
> A <- data.frame(y = 1:10, z = 1:10+1i,
+ x = rep(c("a", "b"), each = 5), + r = as.raw(1:10), + stringsAsFactors = FALSE)
> model.frame(z ~ x+y+r, data = A) # includes character, raw and complex
z x y r 1 1+1i a 1 01 2 2+1i a 2 02 3 3+1i a 3 03 4 4+1i a 4 04 5 5+1i a 5 05 6 6+1i b 6 06 7 7+1i b 7 07 8 8+1i b 8 08 9 9+1i b 9 09 10 10+1i b 10 0a
> lm(z ~ x+y, data = A) # complex response, character RHS
Call: lm(formula = z ~ x + y, data = A) Coefficients: (Intercept) xb y 0 0 1 Warning messages: 1: In storage.mode(v) <- "double" : imaginary parts discarded in coercion 2: In model.matrix.default(mt, mf, contrasts) : variable 'x' converted to a factor
> # but we do not allow complex nor raw variables on the rhs
> stopifnot(inherits(try(model.matrix(y ~ x+z, data = A)), "try-error"))
Error in model.matrix.default(y ~ x + z, data = A) : complex variables are not currently allowed in model matrices In addition: Warning message: In model.matrix.default(y ~ x + z, data = A) : variable 'x' converted to a factor
> stopifnot(inherits(try(model.matrix(y ~ r, data = A)), "try-error"))
Error in model.matrix.default(y ~ r, data = A) : variables of type 'raw' are not allowed in model matrices
> ## new in 2.4.0
>
>
> ## tests of stringsAsFactors
> a <- letters[1:8]
> aa <- matrix(a, 4, 2)
> aaa <- list(aaa=letters[20:23])
> colnames(aa) <- paste("aa", 1:2, sep=".")
> (A <- data.frame(a=a[1:4], aa, aaa, stringsAsFactors = FALSE))
a aa.1 aa.2 aaa 1 a a e t 2 b b f u 3 c c g v 4 d d h w
> stopifnot(all(sapply(A, class) == "character"))
> stopifnot(class(as.data.frame(list(a=a), stringsAsFactors = TRUE)$a)
+ == "factor")
> ## new in 2.4.0
>
>
> ## failure to duplicate in environment<-().
> ## Thomas Petzoldt, R-help, 2006-06-23.
> envfun <- function(L) {
+ p <- parent.frame() + assign("test", L$test, p) + environment(p$test) <- p + }
> solver <- function(L) envfun(L)
> L <- list(test = function() 1 + 2)
>
> environment(L$test)
<environment: R_GlobalEnv>
> solver(L)
> (e <- environment(L$test))
<environment: R_GlobalEnv>
> stopifnot(identical(e, .GlobalEnv))
> ## failed to look at NAMED
>
>
> ## sort.list(<a factor>, method="radix") stopped working at some point
> x <- factor(sample(letters, 1000, replace=TRUE))
> o <- sort.list(x, method = "radix")
> ## failed in 2.3.1
>
>
> ## qt() bisection search: PR#9050
> x <- -2:2
> stopifnot(isTRUE(all.equal(x, qt(pt(x, df=20, ncp=1),df=20,ncp=1))))
> ## failed in 2.3.1
>
>
> ## poly() didn't pass 'raw' to polym()
> x <- -3:3
> y <- 10*(1:7)
> stopifnot(identical(poly (x,y, degree = 2, raw = TRUE),
+ polym(x,y, degree = 2, raw = TRUE)))
> ## failed in 2.3.1
>
>
> ## plot.xy( type = "s" | "S" ) was missing an initial test: PR#9046
> types <- c("p", "l", "b", "o", "h", "s", "S")
> p <- palette(hcl(h = seq(30,330, length= length(types))))
> plot(c(1,6), c(-.4, 1.5), type="n", ann = FALSE); off <- 1:6 / 16
> for(i in seq(types)) {
+ lines(i*off /-1:4, type = types[i], col = i, pch = types[i]) + mtext(types[i], 4, line= .5, at = i*off[6]/4, col = i, las = 1) + }
> palette(p)# restored to previous
> ## failed in 2.3.1
>
>
> ## qf for large df2
> stopifnot(isTRUE(all.equal(qf(0.9,df1=1,df2=1e10,ncp=0),
+ qf(0.9,df1=1,df2=1e10))))
> ## failed in 2.3.1
>
>
> ## some regression tests of as.vector() and as.list()
> x <- list(a=1, b=2)
> stopifnot(identical(x, as.list(x))) # was said to drop names
> x <- pairlist(a=1, b=2)
> stopifnot(is.list(x))
> xx <- as.vector(x, "list")
> stopifnot(typeof(xx) == "list")
> stopifnot(!identical(x, xx))
> stopifnot(identical(names(x), names(xx)))
>
> x <- expression(a=2+3, b=pi)
> xx <- as.vector(x, "list") # not allowed in 2.3.1
> stopifnot(identical(names(x), names(xx)))
> xx <- as.list(x) # lost names in 2.3.1
> stopifnot(identical(names(x), names(xx)))
> ## was incorrectly documented in 2.3.1
>
>
> ## subsetting arrays preserved attributes, although it did not for matrices
> x <- structure(1:8, names=letters[1:8], comm="a comment", dim = c(2L,2L,2L))
> stopifnot(is.null(attr(x[,,], "comm")))
> x <- structure(1:8, names=letters[1:8], comm="a comment", dim = c(2L,4L))
> stopifnot(is.null(attr(x[,], "comm")))
> x <- structure(1:8, names=letters[1:8], comm="a comment")
> stopifnot(!is.null(attr(x[], "comm"))) # this does preserve
> stopifnot(is.null(attr(x[1:8], "comm")))
> ## 2.3.1 preserved the first.
>
>
> ## diff() for POSIX(cl)t :
> ds1 <- diff(lsec <- .leap.seconds[1:12])
> (ds2 <- diff(llsec <- as.POSIXlt(lsec))) # in days
Time differences in days [1] 184 365 365 365 366 365 365 365 547 365 365 attr(,"tzone") [1] ""
> stopifnot(ds1 == ds2)
> ## gave different result for POSIXlt up to 2.3.1
>
>
> ## format(trim = TRUE, big.mark=",") did not work correctly (PR#9118)
> (a <- format(c(-1,1,10,999,1e6), trim=TRUE))
[1] "-1" "1" "10" "999" "1000000"
> (b <- format(c(-1,1,10,999,1e6), big.mark=",", trim=TRUE))
[1] "-1" "1" "10" "999" "1,000,000"
> stopifnot(a[1:4] == b[1:4])
> ## no trim in 2.3.1 if big.mark was used.
>
>
> ## residuals.glm needed 'y = TRUE' (PR#9124)
> # example for poisson GLM from ?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, family = poisson,
+ data = d.AD, y = FALSE)
> residuals(glm.D93, type = "working")
1 2 3 4 5 6 -0.14285714 0.27500000 -0.04255319 -0.04761905 -0.25000000 0.27659574 7 8 9 0.19047619 -0.02500000 -0.23404255
> residuals(glm.D93, type = "partial")
outcome treatment 1 0.10622366 -0.14285714 2 0.06982553 0.27500000 3 -0.08645952 -0.04255319 4 0.20146175 -0.04761905 5 -0.45517447 -0.25000000 6 0.23268942 0.27659574 7 0.43955699 0.19047619 8 -0.23017447 -0.02500000 9 -0.27794888 -0.23404255 attr(,"constant") [1] 2.795442
> residuals(glm.D93, type = "response")
1 2 3 4 5 6 7 -3.0000000 3.6666667 -0.6666667 -1.0000000 -3.3333333 4.3333333 4.0000000 8 9 -0.3333333 -3.6666667
> residuals(glm.D93, type = "deviance")
1 2 3 4 5 6 -0.67124923 0.96272360 -0.16964662 -0.21998507 -0.95552353 1.04938637 7 8 9 0.84715368 -0.09167147 -0.96656372
> residuals(glm.D93, type = "pearson")
1 2 3 4 5 6 7 -0.6546537 1.0041580 -0.1684304 -0.2182179 -0.9128709 1.0947975 0.8728716 8 9 -0.0912871 -0.9263671
> ## all failed in 2.3.1
>
>
> ## anova.mlm failed
> dat<-matrix( c(9,7,8,8,12,11,8,13, 6,5,6,3,6,7,10,9,
+ 10,13,8,13,12,14,14,16, 9,11,13,14,16,12,15,14), + ncol = 4, dimnames = list(s=1:8, c=1:4))
> mlmfit <- lm(dat ~ 1)
> anova(mlmfit, X = ~1)
Analysis of Variance Table Contrasts orthogonal to ~1 Df Pillai approx F num Df den Df Pr(>F) (Intercept) 1 0.90126 15.213 3 5 0.006016 ** Residuals 7 --- Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> ## worked in 2.2.1, failed in 2.3.1
>
>
> ## stopifnot(<expr>) for a long expression (do not wrap the following line!!):
> r <- try(stopifnot(c("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O")),
+ silent = TRUE)
> if(length(grep("TRUE.*TRUE",r)))
+ stop("stopifnot() gives bad message for long expression")
> ## happened in 2.3.[01]
>
>
> ## rownames on 0-extent matrix (PR#9136)
> A <- matrix(NA, 0, 0)
> stopifnot(identical(rownames(A, do.NULL = FALSE), character(0)))
> stopifnot(identical(colnames(A, do.NULL = FALSE), character(0)))
> ## were 'row' etc in 2.3.1.
>
>
> ## misuse of a method (based on example from package mmlcr)
> model.matrix.lm(height ~ weight, women)
(Intercept) weight 1 1 115 2 1 117 3 1 120 4 1 123 5 1 126 6 1 129 7 1 132 8 1 135 9 1 139 10 1 142 11 1 146 12 1 150 13 1 154 14 1 159 15 1 164 attr(,"assign") [1] 0 1
> # although it is an incorrect call, it should not crash in NextMethod.
> ## fixed in 2.4.0
>
>
> ## grep(value = TRUE) sometimes preserved names, sometimes not
> x <- 1:3
> xx <- letters[1:3]
> names(x) <- names(xx) <- xx
> z <- grep(1, x, value = TRUE)
> stopifnot(!is.null(names(z)), names(z) == xx[1])
> z <- grep(1, x, value = TRUE, perl = TRUE)
> stopifnot(!is.null(names(z)), names(z) == xx[1])
> z <- grep("a", xx, value = TRUE)
> stopifnot(!is.null(names(z)), names(z) == xx[1])
> z <- grep("a", xx, value = TRUE, perl = TRUE)
> stopifnot(!is.null(names(z)), names(z) == xx[1])
> z <- agrep("a", xx, value = TRUE)
> stopifnot(!is.null(names(z)), names(z) == xx[1:3])
> ## perl=TRUE, agrep did not in 2.3.1, all did not for pre-2.4.0
> x[2] <- xx[2] <- NA
> z <- grep(NA, x, value = TRUE)
> stopifnot(identical(names(z), names(xx)))
> z <- grep(NA, x, value = TRUE, perl = TRUE)
> stopifnot(identical(names(z), names(xx)))
> z <- grep(NA, xx, value = TRUE)
> stopifnot(identical(names(z), names(xx)))
> z <- grep(NA, xx, value = TRUE, perl = TRUE)
> stopifnot(identical(names(z), names(xx)))
> z <- agrep(NA, xx, value = TRUE)
> stopifnot(identical(names(z), names(xx)))
> ## always dropped names on NA matches < 2.4.0
>
>
> oo <- options(max.print = 20)
> cc <- capture.output(women)
> options(oo)
> c2 <- capture.output(women[1:10,])
> stopifnot(length(cc) == 1 + 20/2 + 1,
+ identical(cc[-12], c2[1:11]))
> ## was wrong for some days in Aug.2006
>
>
> ## errors in identical()
> stopifnot(!identical(pairlist(a=1, b=2), pairlist(a=1, aa=2)))
> stopifnot(!identical(structure(pi, a=1, b=2), structure(pi, a=1, aa=2)))
> stopifnot(identical(structure(pi, a=1, b=2), structure(pi, b=2, a=1)))
> ## ignored names of pairlists, but tested order of attributes < 2.4.0
>
>
> ## failed subassign could leave '*tmp*' around
> ## Parlamis Franklin, R-devel, 2006-09-20
> test <- 1:10
> try(test[2:4] <- ls) # fails
Error in test[2:4] <- ls : incompatible types (from closure to integer) in subassignment type fix
> stopifnot(!exists("*tmp*", where=1))
> ## was true < 2.4.0
>
>
> ## merge on zero-row data frames
> L3 <- LETTERS[1:3]
> d <- data.frame(cbind(x=1, y=1), fac=sample(L3, 1, repl=TRUE))
> e <- d[-1,]
> merge(d, e, by.x = "x", by.y = "x", all.x = TRUE)
x y.x fac.x y.y fac.y 1 1 1 A NA <NA>
> ## not allowed <= 2.4.0
>
>
> ## PR#9313
> library(stats4)
> g <- function(x, y) -cos(x) + abs(y)
> fit1 <- mle(g, start = list(x = 0, y = 7))
> fit2 <- mle(g, start = list(y = 7, x = 0))
> stopifnot(all.equal(coef(fit1), coef(fit2)))
> ## Found different solutions in 2.4.0, as names were not remapped in fit2
>
>
> ## PR#9446
> rbind( data.frame(x=1), list(x=2) )
x 1 1 2 2
> ## was error in 2.4.0 as list gave double row names.
>
>
> ## extreme case
> bs <- boxplot.stats(c(1,Inf,Inf,Inf))
> ## gave an error in 2.4.0
>
>
> ## t.test with one group of size one
> x <- c(23,25,29,27,30,30)
> t.test(x=x[1], y=x[-1], var.equal=TRUE)
Two Sample t-test data: x[1] and x[-1] t = -2.1896, df = 4, p-value = 0.09373 alternative hypothesis: true difference in means is not equal to 0 95 percent confidence interval: -11.793692 1.393692 sample estimates: mean of x mean of y 23.0 28.2
> t.test(y=x[1], x=x[-1], var.equal=TRUE)
Two Sample t-test data: x[-1] and x[1] t = 2.1896, df = 4, p-value = 0.09373 alternative hypothesis: true difference in means is not equal to 0 95 percent confidence interval: -1.393692 11.793692 sample estimates: mean of x mean of y 28.2 23.0
> ## failed in 2.4.0
>
>
> ## corrupted "ts" objects
> structure(1:3, class="ts")
[1] 1 2 3 Warning message: In print.ts(1:3) : series is corrupt, with no 'tsp' attribute
> ## failed in print method < 2.4.1
>
>
> ## PR#9399
> x1 <- "x2"
> x2 <- pi
> rm(x1) # removes x1, not x2
> stopifnot(!exists("x1", .GlobalEnv), exists("x2", .GlobalEnv))
> rm("x2")
> # incorrectly documented <= 2.4.0
> a <- b <- c <- 1
> z <- try(rm(c("a", "b")))
Error in rm(c("a", "b")) : ... must contain names or character strings
> stopifnot(inherits(z, "try-error"))
> ## removed 'a', 'b' and 'c' in 2.4.0
>
> ### end of tests added in 2.4.1 ###
>
>
> ## translation error in optimize (PR#9438)
> ex2 <- function(x) log((18/41) * x - 2 * x^2) +
+ 16 * log(4 * x^2 - (36/41) * x + (9/41)) + + 24 * log((23/82) + (18/41) * x - 2 * x^2)
> opt <- optimise(ex2, lower = 0, upper = 9/41, maximum = TRUE)$maximum
> # there are two global maxima
> stopifnot(abs(opt - 0.187) < 0.01 || abs(opt - 0.033) < 0.01)
> ## changed both ends of interval at the first step, gave opt = 0.136
>
>
> ## Needlessly failing subassignments
> e <- 1:10
> e[2] <- expression(e)
> e <- pi
> e[2] <- expression(e)
> e <- letters
> e[2] <- expression(e)
> e <- as.raw(1:3)
> e[2] <- list(e=pi)
> ## all failed < 2.5.0
>
>
> ## uniroot did not allow zero at the end of an interval
> f <- function(x) x-1
> uniroot(f, c(0,2))
$root [1] 1 $f.root [1] 0 $iter [1] 1 $estim.prec [1] 1
> uniroot(f, c(0,1))
$root [1] 1 $f.root [1] 0 $iter [1] 0 $estim.prec [1] 0
> uniroot(f, c(1,2))
$root [1] 1 $f.root [1] 0 $iter [1] 0 $estim.prec [1] 0
> ## last two failed in 2.4.x
>
>
> ## PR#9360 and PR#9394
> acf(1, lag.max=0, plot=FALSE)
Autocorrelations of series '1', by lag 0 1
> ## gave an error in 2.4.0
> stopifnot( all.equal(ccf(1:3,-(1:3))$acf[2,1,1], -1) )
> ## gave positive lag 0 cross-correlation after patching PR#9360
>
>
> ## regression tests for complex sum/prod (briefly broken in Jan 2007)
> z <- rnorm(10) + rnorm(10)*(0+1i)
> sum(z)
[1] 3.249118+2.350713i
> (x <- sum(pi, z))
[1] 6.390711+2.350713i
> stopifnot(all.equal(x, sum(pi,Re(z)) + sum(Im(z))*(0+1i)))
> prod(z)
[1] -0.1082727+0.2047492i
> ##
>
>
> ## problems with 0-row data frames created by read.table
> x <- structure(list(one = NULL, two = NULL, three = NULL),
+ .Names = c("one", "two", "three"), class = "data.frame")
> y <- data.frame(one=1,two=2,three=3)
> (z <- rbind(x,y))
one two three 1 1 2 3
> stopifnot(dim(z) == c(1, 3))
> (z <- rbind(y,x))
one two three 1 1 2 3
> stopifnot(dim(z) == c(1, 3))
> (z <- rbind(x,x))
[1] one two three <0 rows> (or 0-length row.names)
> stopifnot(dim(z) == c(0, 3))
> ## variously failed or gave zero-column data frame in 2.4.1
>
>
> ## tests of partial matching of attributes
> x <- 1:4
> attr(x, "ab") <- 1
> for(y in c("abc", "abcd", "abcde")) {
+ attr(x, y) <- 1 + stopifnot(is.null(attr(x, "a"))) + }
> # second was '1' on 2.4.1.
> x <- 1:4
> names(x) <- letters[x]
> stopifnot(identical(attr(x, "n"), names(x)))
> x <- as.pairlist(x)
> stopifnot(identical(attr(x, "n"), names(x)))
> ## worked for pairlists but not vectors in 2.4.1
>
>
> ## which(arr.ind = TRUE) failed to give matrix on a 0-length input
> C <- matrix(1:16, 4)
> (ind <- which(C < 0, arr.ind = TRUE))
row col
> stopifnot(is.matrix(ind))
> ## gave integer(0) in 2.4.1
>
>
> ## plnorm wrong for out-of-range values (PR#9520)
> stopifnot(plnorm(0, lower.tail=FALSE) == 1, plnorm(0, lower.tail=TRUE) == 0)
> ## both lower tail in R < 2.5.0
>
>
> ## supsmu with all NA values (PR#9519)
> x <- seq(0, 1, len = 100)
> y <- x + NA
> try(supsmu(x,y))
Error in supsmu(x, y) : no finite observations
> ## segfaulted < 2.5.0
>
>
> ## which.max when max is Inf (PR#9522)
> which.min(c(NA, NA, Inf))
[1] 3
> which.max(c(NA, NA, -Inf, -Inf))
[1] 3
> ## were integer(0) in < 2.5.0
>
>
> ## str.dendrogram did not work with 'max.level=NA'
> ## which has become default when called from str.default():
> cm <- cor(USJudgeRatings)
> hm <- heatmap(cm, symm = TRUE, keep.dendro = TRUE)
> str(hm, max=2) # reasonable
List of 4 $ rowInd: int [1:12] 1 3 2 11 6 5 4 8 7 12 ... $ colInd: int [1:12] 1 3 2 11 6 5 4 8 7 12 ... $ Rowv : ..--[dendrogram w/ 2 branches and 12 members at h = 3.36, midpoint = 9.45, value = 9.34] .. |--[dendrogram w/ 2 branches and 11 members at h = 0.505, midpoint = 7.9, value = 9.27] .. .. `--leaf "CONT" ( value.CONT = 0.075 ) $ Colv : ..--[dendrogram w/ 2 branches and 12 members at h = 3.36, midpoint = 1.55, value = 9.34] .. |--leaf "CONT" ( value.CONT = 0.075 ) .. `--[dendrogram w/ 2 branches and 11 members at h = 0.505, midpoint = 2.09, value = 9.27] ..
> str(hm) # gave error (less reasonable than above)
List of 4 $ rowInd: int [1:12] 1 3 2 11 6 5 4 8 7 12 ... $ colInd: int [1:12] 1 3 2 11 6 5 4 8 7 12 ... $ Rowv : ..--[dendrogram w/ 2 branches and 12 members at h = 3.36, midpoint = 9.45, value = 9.34] .. |--[dendrogram w/ 2 branches and 11 members at h = 0.505, midpoint = 7.9, value = 9.27] .. | |--[dendrogram w/ 2 branches and 9 members at h = 0.419, midpoint = 6.31, value = 7.68] .. | | |--[dendrogram w/ 2 branches and 8 members at h = 0.28, midpoint = 4.62, value = 6.89] .. | | | |--[dendrogram w/ 2 branches and 6 members at h = 0.201, midpoint = 2.75, value = 5.18] .. | | | | |--[dendrogram w/ 2 branches and 3 members at h = 0.116, midpoint = 1.25, value = 2.61] .. | | | | | |--[dendrogram w/ 2 branches and 2 members at h = 0.0543, midpoint = 0.5, value = 1.74] .. | | | | | | |--leaf "ORAL" ( value.ORAL = 0.874 ) .. | | | | | | `--leaf "WRIT" ( value.WRIT = 0.867 ) .. | | | | | `--leaf "RTEN" ( value.RTEN = 0.865 ) .. | | | | `--[dendrogram w/ 2 branches and 3 members at h = 0.0936, midpoint = 1.25, value = 2.57] .. | | | | |--[dendrogram w/ 2 branches and 2 members at h = 0.0561, midpoint = 0.5, value = 1.72] .. | | | | | |--leaf "PREP" ( value.PREP = 0.866 ) .. | | | | | `--leaf "FAMI" ( value.FAMI = 0.856 ) .. | | | | `--leaf "DILG" ( value.DILG = 0.852 ) .. | | | `--[dendrogram w/ 2 branches and 2 members at h = 0.06, midpoint = 0.5, value = 1.71] .. | | | |--leaf "CFMG" ( value.CFMG = 0.858 ) .. | | | `--leaf "DECI" ( value.DECI = 0.852 ) .. | | `--leaf "PHYS" ( value.PHYS = 0.791 ) .. | `--[dendrogram w/ 2 branches and 2 members at h = 0.0887, midpoint = 0.5, value = 1.59] .. | |--leaf "INTG" ( value.INTG = 0.797 ) .. | `--leaf "DMNR" ( value.DMNR = 0.791 ) .. `--leaf "CONT" ( value.CONT = 0.075 ) $ Colv : ..--[dendrogram w/ 2 branches and 12 members at h = 3.36, midpoint = 1.55, value = 9.34] .. |--leaf "CONT" ( value.CONT = 0.075 ) .. `--[dendrogram w/ 2 branches and 11 members at h = 0.505, midpoint = 2.09, value = 9.27] .. |--[dendrogram w/ 2 branches and 2 members at h = 0.0887, midpoint = 0.5, value = 1.59] .. | |--leaf "DMNR" ( value.DMNR = 0.791 ) .. | `--leaf "INTG" ( value.INTG = 0.797 ) .. `--[dendrogram w/ 2 branches and 9 members at h = 0.419, midpoint = 1.69, value = 7.68] .. |--leaf "PHYS" ( value.PHYS = 0.791 ) .. `--[dendrogram w/ 2 branches and 8 members at h = 0.28, midpoint = 2.38, value = 6.89] .. |--[dendrogram w/ 2 branches and 2 members at h = 0.06, midpoint = 0.5, value = 1.71] .. | |--leaf "DECI" ( value.DECI = 0.852 ) .. | `--leaf "CFMG" ( value.CFMG = 0.858 ) .. `--[dendrogram w/ 2 branches and 6 members at h = 0.201, midpoint = 2.25, value = 5.18] .. |--[dendrogram w/ 2 branches and 3 members at h = 0.0936, midpoint = 0.75, value = 2.57] .. | |--leaf "DILG" ( value.DILG = 0.852 ) .. | `--[dendrogram w/ 2 branches and 2 members at h = 0.0561, midpoint = 0.5, value = 1.72] .. | |--leaf "FAMI" ( value.FAMI = 0.856 ) .. | `--leaf "PREP" ( value.PREP = 0.866 ) .. `--[dendrogram w/ 2 branches and 3 members at h = 0.116, midpoint = 0.75, value = 2.61] .. |--leaf "RTEN" ( value.RTEN = 0.865 ) .. `--[dendrogram w/ 2 branches and 2 members at h = 0.0543, midpoint = 0.5, value = 1.74] .. |--leaf "WRIT" ( value.WRIT = 0.867 ) .. `--leaf "ORAL" ( value.ORAL = 0.874 )
>
>
> ## [<-.data.frame did not allow deleting the last column (PR#9565)
> DF <- data.frame(x = 1:3, y = 4:6, z = 7:9)
> DF[, "z"] <- NULL
> stopifnot(identical(dim(DF), c(3L, 2L)))
> ## 'subscript out of bounds' in 2.4.1.
>
> ## new tryCatch() based try() with anonymous function
> v <- try(do.call(function(x) stop("died"), list(1)), silent=TRUE)
> stopifnot(inherits(v, "try-error"))
> ## failed in some version of R-devel (2.5.0)
>
>
> ## choose(n,k) should be integer if n is
> stopifnot(choose(11,6) == 462)
> ## was < 462 on some AMD64 Linux
>
>
> ## fix up use of %j" format in strptime (PR#9577)
> x <- strptime(31:33, "%j")
> x
[1] "2009-01-31" "2009-02-01" "2009-02-02"

> stopifnot(!is.na(x))
> ## day 32 was NA in R < 2.5.0
>
>
> ## mosaicplot() broken by undocumented 'bug fix' r39655
> x <- matrix(1:4,2,2)
> mosaicplot(x, sort = seq_len(dim(x)))
> ## failed in 2.4.1, fixed in 2.5.0
>
>
> ## jitter failed in wierd case (PR#9580)
> stopifnot(is.finite( jitter(c(-1, 3)) ))
> ## was repeated NaN in 2.4.1
>
>
> ## max.col() problems (PR#9542)
> x <- rep(0, 10)
> dim(x) <- c(1, 10)
> # max.col(x) should be random.
> ans <- numeric(100)
> for(i in 1:100) ans[i] <- max.col(x)
> table(ans)
ans 1 2 3 4 5 6 7 8 9 10 12 13 5 10 12 10 5 12 10 11
> stopifnot(any(ans != 10))
> ## always gave last in 2.4.1
>
>
> ## rep could segfault: Hiroyuki Kawakatsu, R-help, 2007-03-30
> try(rep(each = 0, length.out = 1))
Error in rep(each = 0, length.out = 1) : invalid 'each' argument
> # segfaulted in 2.4.1
>
>
> ## readBin could read beyond the end of a raw vector.
> # Henrik Bengtsson, Rdevel, 2007-04-07
> bfr <- as.raw(1:12)
> (x <- readBin(con=bfr, what="raw", n=20))
[1] 01 02 03 04 05 06 07 08 09 0a 0b 0c
> stopifnot(length(x) == 12)
> (x <- readBin(con=bfr, what="integer", n=20))
[1] 67305985 134678021 202050057
> stopifnot(length(x) == 3)
> (x <- readBin(con=bfr, what="integer", size=4, n=20))
[1] 67305985 134678021 202050057
> stopifnot(length(x) == 3)
> (x <- readBin(con=bfr, what="integer", size=2, n=20))
[1] 513 1027 1541 2055 2569 3083
> stopifnot(length(x) == 6)
> (x <- readBin(con=bfr, what="integer", size=1, n=20))
[1] 1 2 3 4 5 6 7 8 9 10 11 12
> stopifnot(length(x) == 12)
> ## read too far where size-changing was involved in 2.4.x
>
>
> ## density() could give negative values by rounding error (PR#8876)
> x <- c(0.006, 0.002, 0.024, 0.02, 0.034, 0.09, 0.074, 0.072, 0.122,
+ 0.048, 0.044, 0.168)
> result <- density(x, n = 20, from = -1, to = 1)
> stopifnot(result$y >= 0)
> ## slightly negative < 2.5.0
>
>
> ## bw.SJ() used too small search interval in rare cases:
> bw.SJ(1:20) # error: "no solution in the specified range of bandwidths" in < 2.5.1
[1] 3.874882
> ## this is not ok when called as density(1:20, bw = "SJ")
> ## [that's a matter of opinion, since the example is ridiculous.]
>
>
> ## hexadecimal integer constants failed on some platforms (PR#9648)
> stopifnot(identical(0x10L, 16L))
> ## first was 0L on Windows in 2.5.0
>
>
> ## rbind failed if the only data frame had 0 rows (PR#9657)
> A <- data.frame(foo=character(0), bar=character(0))
> rbind(A, c(foo="a", bar="b"))
X.a. X.b. 1 a b
> ## failed in 2.5.0
>
>
> ## factor() with NA in dimnames():
> x <- matrix(1:2, 2)
> rownames(x) <- factor(c("A", NA))
> ## segfaulted <= 2.5.0
>
>
> ## return value of median.
> z <- median(integer(0))
> stopifnot(identical(z, NA_integer_))
> z <- median(numeric(0))
> stopifnot(identical(z, NA_real_))
> ## returned logical NA in 2.5.0
>
>
> ## seq.int on small reversed 'by'
> stopifnot(inherits(try(seq.int(1.2, 1, by=1)), "try-error"))
Error in seq.int(1.2, 1, by = 1) : wrong sign in 'by' argument
> ## was '1.2' in 2.5.0
>
>
> ## subassignment on pairlists: Uwe Ligges on R-help, 2007-05-29
> Call <- call("round", 10.5)
> try({Call[] <- NULL; Call})
Error in Call[] <- NULL : result is zero-length and so cannot be a language object
> ## seqgfaulted in 2.5.0
>
>
> ## Bessel bugs for nu < 0:
> x <- seq(0., 3, length = 101)
> nu <- -0.4
> stopifnot(all.equal(besselI(x,nu, TRUE),
+ exp(-x)*besselI(x,nu, FALSE), tol = 1e-13))
> ## wrong in 2.5.0
> stopifnot(all.equal(besselY(seq(0.5, 3, 0.5), nu),
+ c(0.309568577942, 0.568866844337, 0.626095631907, + 0.544013906248, 0.366321150943, 0.141533189246), + tol = 1e-11))
> ## wrong numbers in 2.5.0
>
> ### end of tests added in 2.5.1 ###
>
>
> ## regression tests for unlink and wildcards
> owd <- setwd(tempdir())
> f <- c("ftest1", "ftest2", "ftestmore", "ftest&more")
> file.create(f)
[1] TRUE TRUE TRUE TRUE
> stopifnot(file.exists(f))
> unlink("ftest?")
> stopifnot(file.exists(f) == c(FALSE, FALSE, TRUE, TRUE))
> unlink("ftest*", recursive = TRUE)
> stopifnot(!file.exists(f))
>
> stopifnot(unlink("no_such_file") == 0) # not an error
>
> dd <- c("dir1", "dir2", "dirs", "moredirs")
> for(d in dd) dir.create(d)
> dir(".")
[1] "6b8b4567" "dir1" "dir2" "dirs" "file13d35f92" [6] "file756059da" "moredirs"
> file.create(file.path(dd, "somefile"))
[1] TRUE TRUE TRUE TRUE
> dir(".", recursive=TRUE)
[1] "6b8b4567" "dir1/somefile" "dir2/somefile" [4] "dirs/somefile" "file13d35f92" "file756059da" [7] "moredirs/somefile"
> stopifnot(unlink("dir?") == 1) # not an error
> unlink("dir?", recursive = TRUE)
> stopifnot(file.exists(dd) == c(FALSE, FALSE, FALSE, TRUE))
> unlink("*dir*", recursive = TRUE)
> stopifnot(!file.exists(dd))
>
> # Windows needs short path names for leading spaces
> dir.create(" test")
> dir(".", recursive=TRUE)
[1] "6b8b4567" "file13d35f92" "file756059da"
> unlink(" test", recursive = TRUE)
> stopifnot(!file.exists(" test"))
> setwd(owd)
> ## wildcards were broken in 2.5.0 on Unix, and always on Windows
>
>
> ## duplicated columns in a data frame
> x <- matrix(seq(1:12),ncol=3)
> colnames(x) <- c("A","B","A") #a redundant name for column 2
> x.df <- as.data.frame(x)
> stopifnot(x.df[4,3] == x[4,3])
> ## wrong column in 2.5.0
>
>
> ## it really is unclear if this should work as the fit is to a
> ## numeric variable with levels, and the prediction does not have
> ## levels. But some people expected it to.
> worms <- data.frame(sex=gl(2,6), Dose=factor(rep(2^(0:5),2)),
+ deaths=c(1,4,9,13,18,20,0,2,6,10,12,16))
> worms$doselin <- unclass(worms$Dose)
> worms.glm <- glm(cbind(deaths, (20-deaths)) ~ sex+ doselin,
+ data=worms, family=binomial)
> predict(worms.glm, new=data.frame(sex="1", doselin=6))
1 2.948658
> ## failed < 2.6.0
>
>
> ## regression test for changes in aggregate.data.frame
> z <- aggregate(state.x77,
+ list(Region = state.region, + Cold = state.x77[,"Frost"] > 130), + mean)
> stopifnot(sapply(z, class)[1:2] == c("factor", "logical"),
+ identical(levels(z[[1]]), levels(state.region)) )
> f1 <- c("a","b","a","b")
> f2 <- factor(f1, levels=c("b","c","a"), ordered=TRUE)
> z <- aggregate(1:4, list(groups=f1), sum)
> stopifnot(sapply(z, class) == c("character", "integer"))
> z <- aggregate(1:4, list(groups=f2), sum)
> stopifnot(identical(sapply(z, class), list(groups=class(f2), x="integer")),
+ identical(levels(z[[1]]), levels(f2)), + is.ordered(z[[1]]) )
> ## converted to factors < 2.6.0
>
>
> ## formals<- on function with NULL body (PR#9758)
> f <- function() NULL
> g <- alist(a=, b=4, c=)
> formals(f) <- g
> # identical(formals(f), g) is false as g has .Names attribute
> stopifnot(is.null(body(f)), identical(names(formals(f)), names(g)))
> ## was function(a, b=4) before 2.6.0
>
>
> ## subsetting R.version
> stopifnot(identical("simple.list", class(R.version[1:7])))
>
>
> ## <data frame>[[<character>, j]]
> swiss[["Broye", "Agriculture"]]
[1] 70.2
> swiss[[7, "Agriculture"]]
[1] 70.2
> swiss[["Broye", 2]]
[1] 70.2
> swiss[[7, 2]]
[1] 70.2
> ## first and third failed < 2.6.0
>
>
> ## load of raw vector from ASCII save
> s1 <- "this is a test string 123"
> r0 <- r1 <- charToRaw(s1)
> save(r1, file="r1-ascii.rda", ascii=TRUE)
> save(r1, file="r1.rda", ascii=FALSE)
> load("r1.rda")
> unlink("r1.rda")
> stopifnot(identical(r1, r0))
> # was OK, but add regression test
> load("r1-ascii.rda")
> unlink("r1-ascii.rda")
> stopifnot(identical(r1, r0))
> ## wrong < 2.5.1 patched
>
>
> ## match.arg with multiple values (PR#9859)
> x <- letters[1:3]
> y <- c('aa','bb')
> try(match.arg(x,y)) # gave spurious warning
Error in match.arg(x, y) : 'arg' must be of length 1
> res <- match.arg(x,y, several.ok = TRUE) # error
> stopifnot(identical(res, y))
> ## failed in 2.5.1
>
>
> ## sweep() must work with 0-extent matrix/STATS :
> m <- matrix(1:5, 5,0)
Warning message: In matrix(1:5, 5, 0) : data length exceeds size of matrix
> stopifnot(identical(m, sweep(m, 2, apply(m,2, min))))
> ## failed in R-devel around 2007-08-31
>
>
> ## julian with POSIXlt origin (PR#9908)
> julian(as.POSIXlt("1999-2-1"), origin=as.POSIXlt("1999-1-1"))
Time difference of 31 days
> ## failed < 2.6.0
>
>
> ## str() assumes a "sensical" '[[' for list-alikes :
> "[[.foo" <- function(x,i) x
> x <- structure(list(2), class="foo")
> str(x)
Class 'foo' hidden list of 1 $ : num 2
> ## gave infinite recursion < 2.6.0
>
> curve(sin, -2*pi, 3*pi); pu1 <- par("usr")[1:2]
> curve(cos); stopifnot(all.equal(par("usr")[1:2], pu1))
> ## failed in R <= 2.6.0
>
> ## tests of side-effects with CHARSXP caching
> x <- y <- "abc"
> Encoding(x) <- "UTF-8"
> stopifnot(Encoding(y) == "unknown") # was UTF-8 in 2.6.0
> x <- unserialize(serialize(x, NULL))
> stopifnot(Encoding(y) == "unknown") # was UTF-8 in 2.6.0
> ## problems in earlier versions of cache
>
>
> ## regression test for adding functions to deriv()
> deriv3(~ gamma(y), namevec="y")
expression({ .expr1 <- gamma(y) .expr2 <- digamma(y) .expr3 <- .expr1 * .expr2 .value <- .expr1 .grad <- array(0, c(length(.value), 1L), list(NULL, c("y"))) .hessian <- array(0, c(length(.value), 1L, 1L), list(NULL, c("y"), c("y"))) .grad[, "y"] <- .expr3 .hessian[, "y", "y"] <- .expr3 * .expr2 + .expr1 * trigamma(y) attr(.value, "gradient") <- .grad attr(.value, "hessian") <- .hessian .value })
> deriv3(~ lgamma(y), namevec="y")
expression({ .value <- lgamma(y) .grad <- array(0, c(length(.value), 1L), list(NULL, c("y"))) .hessian <- array(0, c(length(.value), 1L, 1L), list(NULL, c("y"), c("y"))) .grad[, "y"] <- digamma(y) .hessian[, "y", "y"] <- trigamma(y) attr(.value, "gradient") <- .grad attr(.value, "hessian") <- .hessian .value })
> # failed in R < 2.7.0
> D(quote(digamma(sin(x))),"x")
cos(x) * trigamma(sin(x))
> D(quote(trigamma(sin(x))),"x")
cos(x) * psigamma(sin(x), 2L)
> D(quote(psigamma(sin(x))),"x")
cos(x) * psigamma(sin(x), 1L)
> D(quote(psigamma(sin(x), 3)),"x")
cos(x) * psigamma(sin(x), 4L)
> n <- 2L; D(quote(psigamma(sin(x), n)),"x")
cos(x) * psigamma(sin(x), n + 1L)
> ## rest are new
>
>
> ## .subset2 quirk
> iris[1, c(TRUE, FALSE, FALSE, FALSE, FALSE)]
[1] 5.1
> iris[1, c(FALSE, FALSE, FALSE, FALSE, TRUE)]
[1] setosa Levels: setosa versicolor virginica
> ## failed in 2.6.0
>
>
> ## indexing by "": documented as 'no name' and no match
> x <- structure(1:4, names=c(letters[1:3], ""))
> stopifnot(is.na(x[""])) # always so
> stopifnot(is.na(x[NA_character_]))
> z <- tryCatch(x[[NA_character_]], error=function(...) {})
> stopifnot(is.null(z))
> z <- tryCatch(x[[""]], error=function(...) {})
> stopifnot(is.null(z)) # x[[""]] == 4 < 2.7.0
> x[[""]] <- 5 # no match, so should add an element, but replaced.
> stopifnot(length(x) == 5)
> x[""] <- 6 # also add
> stopifnot(length(x) == 6)
> xx <- list(a=1, 2)
> stopifnot(is.null(xx[[""]])) # 2 < 2.7.0
> ##
>
>
> ## negative n gave choose(n, k) == 0
> stopifnot(isTRUE(all.equal(choose(-1,3),-1)))
> ##
>
>
> ## by() on 1-column data frame (PR#10506)
> X <- data.frame(a=1:10)
> g <- gl(2,5)
> by(X, g, colMeans)
g: 1 [1] 3 ------------------------------------------------------------ g: 2 [1] 8
> ## failed in 2.6.1
>
>
> ## range.default omitted na.rm on non-numeric objects
> (z <- range(as.Date(c("2007-11-06", NA)), na.rm = TRUE))
[1] "2007-11-06" "2007-11-06"
> stopifnot(!is.na(z))
> ## NAs in 2.6.1
>
>
> ## cut() on constant values used the min, not abs(min)
> z <- cut(rep(-1,5), 2)
> stopifnot(!is.na(z))
> ##
>
>
> ## extreme example of two-sample wilcox.test
> ## reported by Wolfgang Huber to R-devel, 2008-01-01
> ## normal approximation is way off here.
> wilcox.test(1, 2:60, conf.int=TRUE, exact=FALSE)
Wilcoxon rank sum test with continuity correction data: 1 and 2:60 W = 0, p-value = 0.09402 alternative hypothesis: true location shift is not equal to 0 95 percent confidence interval: -59 -1 sample estimates: difference in location -30
> ## failed in R < 2.7.0
>
>
> ## more corner cases for cor()
> z <- cor(c(1,2,3),c(3,4,6),use="pairwise.complete.obs",method="kendall")
> stopifnot(!is.matrix(x)) # was 1x1 in R < 2.7.0
> Z <- cbind(c(1,2,3),c(3,4,6))
> # next gave 0x0 matrix < 2.7.0
> z <- try(cor(Z[, FALSE], use="pairwise.complete.obs",method="kendall"))
Error in cor(Z[, FALSE], use = "pairwise.complete.obs", method = "kendall") : 'x' is empty
> stopifnot(inherits(z, "try-error"))
> # next gave NA < 2.7.0
> z <- try(cor(numeric(0), numeric(0), use="pairwise.complete.obs",
+ method="kendall")) Error in cor(numeric(0), numeric(0), use = "pairwise.complete.obs", method = "kendall") : both 'x' and 'y' must be non-empty
> stopifnot(inherits(z, "try-error"))
> ##
>
>
> ## infinite loop in format.AsIs reported on R-help by Bert Gunter
> ## https://stat.ethz.ch/pipermail/r-help/2008-January/149504.html
> z <- rep(Sys.time(),5)
> data.frame(I(z))
z 1 2009-11-.... 2 2009-11-.... 3 2009-11-.... 4 2009-11-.... 5 2009-11-....
> ##
>
>
> ## drop with length-one result
> x <- matrix(1:4, 4,1, dimnames=list(letters[1:4], NULL))
> stopifnot(identical(names(drop(x)), letters[1:4])) # was OK
> stopifnot(identical(names(drop(x[1,,drop=FALSE])), "a")) # was no names
> stopifnot(identical(names(x[1,]), "a")) # ditto
> # now consistency tests.
> x <- matrix(1, 1, 1, dimnames=list("a", NULL))
> stopifnot(identical(names(x[,]), "a"))
> x <- matrix(1, 1, 1, dimnames=list(NULL, "a"))
> stopifnot(identical(names(x[,]), "a"))
> x <- matrix(1, 1, 1, dimnames=list("a", "b"))
> stopifnot(is.null(names(x[,])))
> ## names were dropped in R < 2.7.0 in all cases except the first.
>
>
> ## fisher.test with extreme degeneracy PR#10558
> a <- diag(1:3)
> p <- fisher.test(a, simulate.p.value=TRUE)$p.value
> # true value is 1/60, but should not be small
> stopifnot(p > 0.001)
> ## was about 0.0005 in 2.6.1 patched
>
>
> ## tests of problems fixed by Marc Schwartz's patch for
> ## cut/hist for Dates and POSIXt
> Dates <- seq(as.Date("2005/01/01"), as.Date("2009/01/01"), "day")
> months <- format(Dates, format = "%m")
> years <- format(Dates, format = "%Y")
> mn <- as.vector(unlist(sapply(split(months, years), table)))
> ty <- as.vector(table(years))
> # Test hist.Date() for months
> stopifnot(identical(hist(Dates, "month", plot = FALSE)$counts, mn))
> # Test cut.Date() for months
> stopifnot(identical(as.vector(table(cut(Dates, "month"))), mn))
> # Test cut.Date() for 3 months
> stopifnot(identical(as.vector(table(cut(Dates, "3 months"))),
+ as.integer(colSums(matrix(c(mn, 0, 0), nrow = 3)))))
> # Test hist.Date() for years
> stopifnot(identical(hist(Dates, "year", plot = FALSE)$counts, ty))
> # Test cut.Date() for years
> stopifnot(identical(as.vector(table(cut(Dates, "years"))),ty))
> # Test cut.Date() for 3 years
> stopifnot(identical(as.vector(table(cut(Dates, "3 years"))),
+ as.integer(colSums(matrix(c(ty, 0), nrow = 3)))))
>
> Dtimes <- as.POSIXlt(Dates)
> # Test hist.POSIXt() for months
> stopifnot(identical(hist(Dtimes, "month", plot = FALSE)$counts, mn))
> # Test cut.POSIXt() for months
> stopifnot(identical(as.vector(table(cut(Dtimes, "month"))), mn))
> # Test cut.POSIXt() for 3 months
> stopifnot(identical(as.vector(table(cut(Dtimes, "3 months"))),
+ as.integer(colSums(matrix(c(mn, 0, 0), nrow = 3)))))
> # Test hist.POSIXt() for years
> stopifnot(identical(hist(Dtimes, "year", plot = FALSE)$counts, ty))
> # Test cut.POSIXt() for years
> stopifnot(identical(as.vector(table(cut(Dtimes, "years"))), ty))
> # Test cut.POSIXt() for 3 years
> stopifnot(identical(as.vector(table(cut(Dtimes, "3 years"))),
+ as.integer(colSums(matrix(c(ty, 0), nrow = 3)))))
> ## changed in 2.6.2
>
>
> ## zero-length args in tapply (PR#10644)
> tapply(character(0), factor(letters)[FALSE], length)
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 NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA NA
> ## failed < 2.6.2
>
>
> ## zero-length patterns in gregexpr
> expect <- structure(1:3, match.length=rep(0L, 3))
> stopifnot(identical(expect, gregexpr("", "abc")[[1]]))
> stopifnot(identical(expect, gregexpr("", "abc", fixed=TRUE)[[1]]))
> stopifnot(identical(expect, gregexpr("", "abc", perl=TRUE)[[1]]))
> ## segfaulted < 2.6.2
>
>
> ## test of internal argument matching
> stopifnot(all.equal(round(d=2, x=pi), 3.14))
> ## used positional matching in 2.6.x
>
>
> ## kappa.tri(x, exact=TRUE) wrongly ended using exact=FALSE:
> data(longley)
> fm1 <- lm(Employed ~ ., data = longley)
> stopifnot(all.equal(23845862, kappa(fm1, exact=TRUE)))
>
>
> ## names from pairlists (PR#10807, esoteric)
> m <- c("a", "b", "c")
> mp <- pairlist("a", "b", "c")
> x <- 1:3
> names(x) <- mp
> stopifnot(identical(names(x), m)) # OK before
> x <- 1:3
> attr(x, "names") <- mp
> stopifnot(identical(names(x), m)) # rep("a", 3) in 2.6.x
> ##
>
>
> ## preserving attributes in [<-.data.frame (PR#10873)
> df <- data.frame(a=1:3, b=letters[1:3])
> attr(df,"foo") <- 10
> df[, "b"] <- 10:12
> stopifnot(identical(attr(df, "foo"), 10))
> ## dropped attributes < 2.7.0
>
>
> ## r<foo> NA warnings, and rnorm(*, mu = +- Inf) consistency
> op <- options(warn=2)
> m <- c(-Inf,Inf)
> stopifnot(rnorm(2, mean = m) == m,
+ rexp (2, Inf) == 0)
> rt(1, Inf)
[1] 0.7096318
> R <- list(try(rnorm(2, numeric())),
+ try(rexp (2, numeric())), + try(rnorm(2, c(1,NA))), + try(rnorm(1, sd = Inf)) ) Error in rnorm(2, numeric()) : (converted from warning) NAs produced Error in rexp(2, numeric()) : (converted from warning) NAs produced Error in rnorm(2, c(1, NA)) : (converted from warning) NAs produced Error in rnorm(1, sd = Inf) : (converted from warning) NAs produced
> options(op)
> stopifnot(sapply(R, function(ch) sub(".* : ", '', ch) ==
+ "(converted from warning) NAs produced\n"))
> ## was inconsistent in R < 2.7.0
>
>
> ## package.skeleton() with metadata-only code
> ## work in current (= ./tests/ directory):
> tmp <- tempfile()
> writeLines(c('setClass("foo", contains="numeric")',
+ 'setMethod("show", "foo",', + ' function(object) cat("I am a \\"foo\\"\\n"))'), + tmp)
> if(file.exists("myTst")) unlink("myTst", recursive=TRUE)
> package.skeleton("myTst", code_files = tmp)# with a file name warning
Creating directories ... Creating DESCRIPTION ... Creating Read-and-delete-me ... Copying code files ... Making help files ... Done. Further steps are described in './myTst/Read-and-delete-me'. Warning message: In package.skeleton("myTst", code_files = tmp) : Invalid file name(s) for R code in ./myTst/R: 'file241bacb1' are now renamed to 'z<name>.R'
> file.copy(tmp, (tm2 <- paste(tmp,".R", sep="")))
[1] TRUE
> unlink("myTst", recursive=TRUE)
> op <- options(warn=2) # *NO* "invalid file name" warning {failed in 2.7.[01]}:
> package.skeleton("myTst", code_files = tm2, namespace=TRUE)
Creating directories ... Creating DESCRIPTION ... Creating NAMESPACE ... Creating Read-and-delete-me ... Copying code files ... Making help files ... Done. Further steps are described in './myTst/Read-and-delete-me'.
> options(op)
> stopifnot(1 == grep("setClass",
+ readLines(list.files("myTst/R", full.names=TRUE))), + c("foo-class.Rd","show-methods.Rd") %in% list.files("myTst/man"))
> ## failed for several reasons in R < 2.7.0
> ##
> ## Part 2: -- build, install, load and "inspect" the package:
> if(.Platform$OS.type == "unix") {
+ ## <FIXME> need build.package() + dir.exists <- function(x) + is.character(x) && file.exists(x) && file.info(path.expand(x))$isdir + build.pkg <- function(dir) { + stopifnot(dir.exists(dir)) + Rcmd <- paste(file.path(R.home("bin"), "R"), "CMD") + ## return name of tar file built + r <- tail(system(paste(Rcmd, "build", dir), intern = TRUE), 3) + sub(".*'", "", sub("'$", "", + grep("building.*tar\\.gz", r, value=TRUE))) + } + build.pkg("myTst") + # clean up any previous attempt (which might have left a 00LOCK) + system("rm -rf myLib") + dir.create("myLib") + install.packages("myTst", lib = "myLib", repos=NULL, type = "source") # with warnings + print(installed.packages(lib.loc= "myLib", priority= "NA"))## (PR#13332) + stopifnot(require("myTst",lib = "myLib")) + sm <- getMethods(show, where= as.environment("package:myTst")) + stopifnot(names(sm_at_methods) == "foo") + unlink("myTst_*") + + ## More building & installing packages + op <- options(warn=2) # There should be *NO* warnings here! + p.lis <- c("pkgA", "pkgB", "exS4noNS", "exNSS4") + for(p. in p.lis) { + cat("building package", p., "...\n") + r <- build.pkg(file.path(Sys.getenv("SRCDIR"), "Pkgs", p.)) + cat("installing package", p., "using file", r, "...\n") + ## we could install the tar file ... (see build.pkg()'s definition) + install.packages(r, lib = "myLib", repos=NULL, type = "source") + stopifnot(require(p.,lib = "myLib", character.only=TRUE)) + detach(pos = match(p., sub("^package:","", search()))) + } + ## TODO: not just print, but check the "list": + print(installed.packages(lib.loc = "myLib", priority = "NA")) + options(op) + unlink("myLib", recursive=TRUE) + } * installing *source* package 'myTst' ... ** R ** preparing package for lazy loading ** help Warning: ./man/foo-class.Rd:31: All text must be in a section Warning: ./man/foo-class.Rd:31: All text must be in a section Warning: ./man/myTst-package.Rd:35: All text must be in a section Warning: ./man/myTst-package.Rd:36: All text must be in a section Warning: ./man/show-methods.Rd:12: unknown macro '\signature' *** installing help indices ** building package indices ... * DONE (myTst) Package LibPath Version Priority Bundle Contains Depends Imports myTst "myTst" "myLib" "1.0" NA NA NA "methods" NA LinkingTo Suggests Enhances OS_type License Built myTst NA NA NA NA "What license is it under?" "2.10.0" Loading required package: myTst building package pkgA ... installing package pkgA using file pkgA_1.0.tar.gz ... * installing *source* package 'pkgA' ... ** R ** preparing package for lazy loading Creating a new generic function for "plot" in "pkgA" ** help No man pages found in package 'pkgA' *** installing help indices ** building package indices ... * DONE (pkgA) Loading required package: pkgA building package pkgB ... installing package pkgB using file pkgB_1.0.tar.gz ... * installing *source* package 'pkgB' ... ** help No man pages found in package 'pkgB' *** installing help indices ** building package indices ... * DONE (pkgB) Loading required package: pkgB Error in loadNamespace(package, c(which.lib.loc, lib.loc), keep.source = keep.source) : (converted from warning) package 'pkgB' contains no R code Error: require(p., lib = "myLib", character.only = TRUE) is not TRUE Execution halted

______________________________________________ R-devel_at_r-project.org mailing list https://stat.ethz.ch/mailman/listinfo/r-devel

Received on Mon 02 Nov 2009 - 16:20:33 GMT

This archive was generated by hypermail 2.2.0 : Fri 20 Nov 2009 - 00:40:43 GMT