
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@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@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@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@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@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@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(digits = 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@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@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
