
R version 2.12.0 beta (2010-10-01 r53110)
Copyright (C) 2010 The R Foundation for Statistical Computing
ISBN 3-900051-07-0
Platform: i686-pc-linux-gnu (32-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

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-1b.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"))
> 
> 
> ## str() 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 2010-10-....
2 2010-10-....
3 2010-10-....
4 2010-10-....
5 2010-10-....
> ##
> 
> 
> ## 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.3156163
> 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
> 
> 
> ## predict.loess with transformed variables
> y <- 1:100 + rnorm(100)
> od <- data.frame(x=1:100, z=1:100 + rnorm(100, 10))
> nd <- data.frame(x=1:100, z=11:110)
> fit <- loess(y ~ log(x) + log(z), od)
> p1 <- predict(fit, nd) # failed in 2.6.x
> fit.log <- loess(y ~ x + z, log(od))
> p2 <- predict(fit.log, log(nd))
> stopifnot(identical(p1,p2))
> 
> 
> ## wishlist PR#11192
> plot(1:10)
> segments(1, 1, 10, 10, col='green')
> segments(numeric(0), numeric(0), numeric(0), numeric(0), col='green')
> ## last was error in R < 2.8.0
> 
> 
> ## merging with a zero-row data frame
> merge(NULL, women)
[1] height weight
<0 rows> (or 0-length row.names)
> merge(women, NULL)
[1] height weight
<0 rows> (or 0-length row.names)
> merge(women[FALSE, ], women)
[1] height weight
<0 rows> (or 0-length row.names)
> merge(women, women[FALSE, ])
[1] height weight
<0 rows> (or 0-length row.names)
> ## first two failed in 2.7.0
> 
> 
> ## influence.measures() for lm and glm, and its constituents
> if(require(MASS)) {
+     fit <- lm(formula = 1000/MPG.city ~ Weight + Cylinders + Type + EngineSize + DriveTrain, data = Cars93)
+     gf <- glm(formula(fit), data=Cars93) # should be "identical"
+     im1 <- influence.measures(fit)
+     im2 <- influence.measures(gf)
+     stopifnot(all.equal(im1[1:2], im2[1:2]),
+ 	      all.equal(unname(im1$infmat[,1:15]), unname(dfbetas(fit))),
+ 	      all.equal(im1$infmat[,"dffit"], dffits(fit)),
+ 	      all.equal(im1$infmat[,"cov.r"], covratio(fit)),
+ 	      all.equal(im1$infmat[,"cook.d"], cooks.distance(fit)),
+ 	      all.equal(im2$infmat[,"cook.d"], cooks.distance(gf)),
+ 	      all.equal(im1$infmat[,"hat"],  hatvalues(fit)))
+ }
Loading required package: MASS
> ## "cook.d" part of influence.measures(<glm>) differed in R <= 2.7.0
> 
> 
> ## short list value for dimnames
> n <- matrix(c(1259, 845, 719,390,1360,1053,774,413), nrow = 2, byrow = TRUE)
> dimnames(n)[[1]] <- c("a", "b")
> ## was (correctly) an error in R < 2.8.0
> 
> 
> ## glob2rx(pattern, .) with "(", "[" or "{" in pattern :
> nm <- "my(ugly[file{name"
> stopifnot(identical(regexpr(glob2rx("*[*"), nm),
+ 		    structure(1L, match.length = 8L)),
+ 	  identical(regexpr(glob2rx("*{n*"), nm),
+ 		    structure(1L, match.length = 14L)),
+ 	  identical(regexpr(glob2rx("*y(*{*"), nm),
+ 		    structure(1L, match.length = 13L))
+ 	  )
> ## gave 'Invalid regular expression' in R <= 2.7.0
> 
> 
> ## showDefault() problem with "unregistered" S3 classes:
> show(structure(1:3, class = "myClass"))
[1] 1 2 3
attr(,"class")
[1] "myClass"
> ## failed in R <= 2.7.0
> 
> 
> ## formatC(.., format="fg", flag="#"):
> x <- 0.599 * c(.1, .01, .001, 1e-4,1e-5,1e-6)
> (fCx <- formatC(x, digits=2, format="fg", flag="#"))
[1] "0.060"      "0.0060"     "0.00060"    "0.000060"   "0.0000060" 
[6] "0.00000060"
> stopifnot(sub(".*(..)$", "\\1", fCx) == "60")
> ## dropped the trailing "0" in the last 3 cases, in R <= 2.7.0
> 
> 
> ## c.noquote bug, posted to R-devel by Ray Brownrigg, 2008-06-16
> z <- c(noquote('z'), 'y', 'x', 'w')
> stopifnot(identical(unclass(z), c('z', 'y', 'x', 'w')))
> ## repeated third and later args in R < 2.7.1.
> 
> ## PD found that f==f contains NA when f has NA levels (but no missing value)
> f1 <- factor(c(1, 2, NA), exclude = "")
> f2 <- factor(c(1, 2, NA), exclude = NULL)
> stopifnot(identical(f1, factor(c(1,2,NA))),
+           nlevels(f1) == 2, nlevels(f2) == 3,
+           all(f2 == f2), !any(f2 != f2),
+           identical(f1 == f1, c(TRUE,TRUE,NA)))
> 
> f. <- f <- factor(c(letters[c(1:3,3:1)],"NA", "d","d", NA), exclude=NULL)
> is.na(f.)[2:3] <- TRUE
> f.
 [1] a    <NA> <NA> c    b    a    NA   d    d    <NA>
Levels: NA a b c d <NA>
> stopifnot(all(f == f), identical(f == f., f. == f.),
+           identical(2:3, which(is.na(f. == f.))))
> ## f == f was wrong in R 1.5.0 -- 2.7.1
> 
> 
> ## data.frame[, <char>] must match exactly
> dd <- data.frame(ii = 1:10, xx = pi * -3:6)
> t1 <- try(dd[,"x"])# partial match
Error in `[.data.frame`(dd, , "x") : undefined columns selected
> t2 <- try(dd[,"C"])# no match
Error in `[.data.frame`(dd, , "C") : undefined columns selected
> stopifnot(inherits(t1, "try-error"),
+ 	  inherits(t2, "try-error"),
+ 	  ## partial matching is "ok" for '$' {hence don't use for dataframes!}
+ 	  identical(dd$x, dd[,"xx"]))
> ## From 2.5.0 to 2.7.1, the non-match indexing gave NULL instead of error
> 
> ## data.frame[ (<NA>), ] when row.names had  "NA"
> x <- data.frame(x=1:3, y=2:4, row.names=c("a","b","NA"))
> y  <- x [c(2:3, NA),]
> y.ok <- data.frame(x=c(2:3,NA), y=c(3:4,NA), row.names=c("b", "NA", "NA.1"))
> stopifnot(identical(y, y.ok))
> ## From 2.5.0 to 2.7.1,  y had row name "NA" twice
> 
> stopifnot(shapiro.test(c(0,0,1))$p.value >= 0)
> ## was wrong up to 2.7.1, because of rounding errors (in single precision).
> 
> stopifnot(rcond(cbind(1, c(3,3))) == 0)
> ## gave an error (because Lapack's LU detects exact singularity)
> 
> 
> ## dispatch when primitives are called from lapply.
> x <- data.frame(d=Sys.Date())
> stopifnot(sapply(x, is.numeric) == FALSE)
> # TRUE in 2.7.1, tried to dispatch on "FUN"
> (ds <- seq(from=Sys.Date(), by=1, length=4))
[1] "2010-10-03" "2010-10-04" "2010-10-05" "2010-10-06"
> lapply(list(d=ds), round)
$d
[1] "2010-10-03" "2010-10-04" "2010-10-05" "2010-10-06"

> # failed in 2.7.1 with 'dispatch error' since call had '...' arg
> ## related to calls being passed unevaluated by lapply.
> 
> 
> ## subsetting data frames with NA cols
> ## Dieter Menne: https://stat.ethz.ch/pipermail/r-help/2008-January/151266.html
> df3 <- data.frame(a=0:10,b=10:20,c=20:30)
> names(df3) <- c("A","B", NA)
> df3[-2]
    A NA
1   0 20
2   1 21
3   2 22
4   3 23
5   4 24
6   5 25
7   6 26
8   7 27
9   8 28
10  9 29
11 10 30
> df3[, -2]
    A NA
1   0 20
2   1 21
3   2 22
4   3 23
5   4 24
6   5 25
7   6 26
8   7 27
9   8 28
10  9 29
11 10 30
> df3[1:4, -2]
  A NA
1 0 20
2 1 21
3 2 22
4 3 23
> df3[c(TRUE,FALSE,TRUE)]
    A NA
1   0 20
2   1 21
3   2 22
4   3 23
5   4 24
6   5 25
7   6 26
8   7 27
9   8 28
10  9 29
11 10 30
> df3[, c(TRUE,FALSE,TRUE)]
    A NA
1   0 20
2   1 21
3   2 22
4   3 23
5   4 24
6   5 25
7   6 26
8   7 27
9   8 28
10  9 29
11 10 30
> df3[1:4, c(TRUE,FALSE,TRUE)]
  A NA
1 0 20
2 1 21
3 2 22
4 3 23
> ## all gave 'undefined columns selected', 2.6.1 to 2.7.x
> ## note that you can only select columns by number, not by name
> 
> 
> ## nls with weights in an unusual model
> Data <- data.frame(x=c(1,1,1,1,1,2,2,3,3,3,3,3,3,4,4,4,5,5,5,5,6,6,6,6,6,6,
+                    7,7,7,7,7,7,7,7,7,8,8,8, 8,8,8,8,8,8,8,9,9,9,9,9,11,12),
+                    y=c(73,73,70,74,75,115,105,107,124,107,116,125,102,144,178,
+                    149,177,124,157,128, 169,165,186,152,181,139,173,151,138,
+                    181,152,188,173,196,180,171,188,174,198, 172, 176,162,188,
+                    182,182,141,191,190,159,170,163,197),
+                    weight=c(1, rep(0.1, 51)))
> G.st <- c(k=0.005, g1=50,g2=550)
> # model has length-1 (and 52) variables
> Ta <- min(Data$x)
> Tb <- max(Data$x)
> 
> #no weights
> nls(y~((g1)*exp((log(g2/g1))*(1-exp(-k*(x-Ta)))
+                 /(1-exp(-k*(Tb-Ta))))), data=Data, start=G.st, trace=TRUE)
347023 :    0.005  50.000 550.000 
78907.68 :   -0.02991565  93.57375426 171.08665060 
19087.29 :    0.4777446  83.3732024 164.8154581 
13781.48 :    0.3629916  73.3504087 182.0860915 
13190.43 :    0.4133111  72.8306628 181.7931517 
13186.62 :    0.4113185  72.8991618 182.2698029 
13186.62 :    0.411475  72.891816 182.261563 
13186.62 :    0.4114651  72.8922646 182.2621707 
Nonlinear regression model
  model:  y ~ ((g1) * exp((log(g2/g1)) * (1 - exp(-k * (x - Ta)))/(1 -      exp(-k * (Tb - Ta))))) 
   data:  Data 
       k       g1       g2 
  0.4115  72.8923 182.2622 
 residual sum-of-squares: 13187

Number of iterations to convergence: 7 
Achieved convergence tolerance: 1.184e-06 
> 
> #with weights
> nls(y~((g1)*exp((log(g2/g1))*(1-exp(-k*(x-Ta)))
+                 /(1-exp(-k*(Tb-Ta))))), data=Data, start=G.st,
+     trace=TRUE, weights=weight)
35178.4 :    0.005  50.000 550.000 
9712.782 :   -0.00760028  86.01302279 165.43038281 
2026.680 :    0.5067711  77.6966729 162.6149685 
1395.279 :    0.3610181  73.1992751 181.6661949 
1319.081 :    0.4127379  72.9311318 181.7915524 
1318.666 :    0.4109011  72.9590456 182.2836317 
1318.666 :    0.4110222  72.9561057 182.2767516 
1318.666 :    0.4110158  72.9562565 182.2771849 
Nonlinear regression model
  model:  y ~ ((g1) * exp((log(g2/g1)) * (1 - exp(-k * (x - Ta)))/(1 -      exp(-k * (Tb - Ta))))) 
   data:  Data 
      k      g1      g2 
  0.411  72.956 182.277 
 weighted residual sum-of-squares: 1319

Number of iterations to convergence: 7 
Achieved convergence tolerance: 7.27e-07 
> ## failed for find weights in R <= 2.7.1
> 
> 
> ## barplot(log = "y") with NAs (PR#11585)
> dat <- matrix(1:25, 5)
> dat[2,3] <- NA
> barplot(dat, beside = TRUE, log = "y")
> ## failed in 2.7.1
> 
> 
> ## related to PR#12551
> unique("a", c("a", "b"))
[1] "a"
> unique(1, 1:2)
[1] 1
> # could seqfault in 2.7.1 on some platforms
> stopifnot(!duplicated(rep("a", 3), "a"))
> ## wrong answer in 2.7.1
> 
> 
> ## drop1.lm() bug
> dd <- stackloss ; dd[1,3] <- NA
> rr <- lm(stack.loss ~ ., data=dd, na.action=na.exclude)
> drop1(rr)
Single term deletions

Model:
stack.loss ~ Air.Flow + Water.Temp + Acid.Conc.
           Df Sum of Sq    RSS    AIC
<none>                  163.85 50.064
Air.Flow    1   228.733 392.58 65.540
Water.Temp  1   121.979 285.83 59.193
Acid.Conc.  1     5.999 169.85 48.784
> ## failed in 2.7.x
> 
> 
> ## explicit row.names=NULL in data.frame()
> stopifnot(identical(row.names(data.frame(x=c(a=1,b=2), row.names=NULL)),
+                     c("1", "2")))
> stopifnot(identical(row.names(data.frame(x=c(a=1,b=2))), c("a", "b")))
> ## same as default in 2.5.0 <= R < 2.7.2
> 
> stopifnot(all.equal(chol2inv(2), matrix(0.25, 1), tol = 4*Meps),
+ 	  all.equal(solve(chol2inv(chol(4))), matrix(4, 1), tol = 10*Meps))
> ## chol2inv() did not accept non-matrices up to 2.7.*
> 
> 
> ## seek should discard pushback. (PR#12640)
> cat(c("1\t2\t3", "4\t5\t6"), file="foo.txt", sep="\n")
> fd <- file("foo.txt",open="rt")
> scan(file=fd,what=double(),n=2)
Read 2 items
[1] 1 2
> seek(con=fd,where=0,origin="start")
[1] 5
> z <- scan(file=fd,what=double(),n=2)
Read 2 items
> close(fd)
> unlink("foo.txt")
> stopifnot(identical(z, c(1,2)))
> ## changed in 2.7.2 patched
> 
> ## cov / cor / var etc with NAs :
> stopifnot(inherits(try(var(NULL)), "try-error"))## gave NA in 1.2.2
Error in var(NULL) : 'x' is NULL
> v0 <- var(0[FALSE]) # gave "'x' is empty" in the past;  NA in 1.2.2
> x <- c(1:2,NA)
> v1 <- var(c(1,NA))
> v2 <- var(c(NA,0/0, Inf-Inf))
> sx <- sd(x)# sd() -> var()
> ## all three gave "missing observations in cov/cor"  for a long time in the past
> is.NA <- function(x) is.na(x) & !is.nan(x)
> stopifnot(is.NA(v1), is.NA(v2), is.NA(sx),
+ 	  all.equal(0.5, var(x, na.rm=TRUE), tol=8*Meps)# should even be exact
+ 	  )
> 
> ## write.dcf() indenting for ".<foo>" (PR#12816)
> zz <- textConnection("foo", "w")
> write.dcf(list(Description = 'what a fat goat .haha'),
+           file = zz, indent=1, width=10)
> stopifnot(substring(foo[-1], 1,1) == " ", length(foo) == 4,
+           foo[4] == "  .haha")
> close(zz)
> ## was " .haha" (not according to DCF standard)
> 
> 
> ## Pdf() with CIDfonts active -- they need MBCS to be supported
> pdf(family="Japan1") # << for CIDfonts, pd->fonts is NULL
> try({
+     plot(1,1,pch="", axes=FALSE)
+     text(1,1,"F.1", family="Helvetica")
+ })
> dev.off()
postscript 
         2 
> ## text() seg.faulted up to 2.7.2 (and early 2.8.0-alpha)
> 
> ## PS mixing CIDfonts and Type1 - reverse case
> postscript(family="Helvetica")
> plot(1,1,pch="", axes=FALSE)
> try(text(1,1,"A",family="Japan1"))
Error in text.default(1, 1, "A", family = "Japan1") : 
  family 'Japan1' not included in PostScript device
> ## error instead of seg.fault
> 
> 
> ## splinefun with derivatives evaluated to the left of first knot
> x <- 1:10; y <- sin(x)
> splfun <- splinefun(x,y, method='natural')
> x1 <- splfun( seq(0,1, 0.1), deriv=1 )
> x2 <- splfun( seq(0,1, 0.1), deriv=2 )
> x3 <- splfun( seq(0,1, 0.1), deriv=3 )
> stopifnot(x1 == x1[1], x2 == 0, x3 == 0)
> ##
> 
> 
> ## glm(y = FALSE), in part PR#1398
> fit <- glm(1:10 ~ I(1:10) + I((1:10)^2), y = FALSE)
> anova(fit)
Analysis of Deviance Table

Model: gaussian, link: identity

Response: 1:10

Terms added sequentially (first to last)


            Df Deviance Resid. Df Resid. Dev
NULL                            9       82.5
I(1:10)      1     82.5         8        0.0
I((1:10)^2)  1      0.0         7        0.0
> ## obscure errors < 2.8.0
> 
> 
> ## boundary case in cut.Date (PR#13159)
> d <- as.Date("2008-07-07")
> cut(d, "weeks")
[1] 2008-07-07
Levels: 2008-07-07
> d <- as.POSIXct("2008-07-07", tz="UTC")
> cut(d, "weeks")
[1] 2008-07-07
Levels: 2008-07-07
> ## failed < 2.8.0
> 
> 
> ### end of tests added for 2.8.x
> 
> 
> ## (Deliberate) overshot in seq(from, to, by) because of fuzz
> stopifnot(seq(0, 1, 0.00025+5e-16) <= 1, seq.int(0, 1, 0.00025+5e-16) <= 1)
> ## overshot by about 2e-12 in 2.8.x
> ## no longer reaches 1 in 2.11.0 (needed a fuzz of 8e-9)
> 
> 
> ## str() with an "invalid object"
> ob <- structure(1, class = "test") # this is fine
> is.object(ob)# TRUE
[1] TRUE
> ob <- 1 + ob # << this is "broken"
> is.object(ob)# FALSE - hmm..
[1] FALSE
> identical(ob, unclass(ob)) # TRUE !
[1] TRUE
> stopifnot(grep("num 2", capture.output(str(ob))) == 1)
> ## str(ob) lead to infinite recursion in R <= 2.8.0
> 
> 
> ## row.names(data.frame(matrixWithDimnames)) (PR#13230)
> rn0 <- c("","Row 2","Row 3")
> A <- matrix(1:6, nrow=3, ncol=2, dimnames=list(rn0, paste("Col",1:2)))
> rn <- row.names(data.frame(A))
> stopifnot(identical(rn, rn0))
> # was 1:3 in R 2.8.0, whereas
> rn0 <- c("Row 1","","Row 3")
> A <- matrix(1:6, nrow=3, ncol=2, dimnames=list(rn0, paste("Col",1:2)))
> rn <- row.names(data.frame(A))
> stopifnot(identical(rn, rn0))
> ## used the names.
> 
> 
> ## rounding error in windowing a time series (PR#13272)
> x <- ts(1:290, start=c(1984,10), freq=12)
> window(x, start=c(2008,9), end=c(2008,9), extend=FALSE)
     Sep
2008 288
> window(x, start=c(2008,9), end=c(2008,9), extend=TRUE)
     Sep
2008 288
> ## second failed in 2.8.0
> 
> 
> ## deparse(nlines=) should shrink the result (PR#13299)
> stopifnot(length(deparse(quote(foo(1,2,3)), width.cutoff = 20, nlines=7)) ==1)
> ## was 7.
> 
> 
> ## legend did not reset xpd correctly (PR#12756)
> par(xpd = FALSE)
> plot(1)
> legend("top", legend="Tops", xpd=NA, inset=-0.1)
> stopifnot(identical(par("xpd"), FALSE))
> ## left xpd as NA
> 
> 
> ## lines.formula with 'subset' and no 'data' needed a tweak
> ## (R-help, John Field, 20008-11-14)
> x <- 1:5
> y <- c(1,3,NA,2,5)
> plot(y ~ x, type="n")
> lines(y ~ x, subset = !is.na(y), col="red")
> ## error in 2.8.0
> 
> 
> ## prettyNum(*, drop0trailing) erronously dropped 0 in '1e10':
> cn <- c("1.107", "2.3120", "3.14e+0", "4.2305400", "120.0",
+         "5.31e-01", "6.3333e-20", "8.1e100", "9.9e+00", "10.1e-0")
> d <- cn != (pcn <- prettyNum(cn, drop0trailing=TRUE))
> stopifnot(identical(pcn[d],
+ 		    c("2.312", "3.14", "4.23054","120","9.9","10.1")),
+ 	  identical("-3", prettyNum("-3.0",drop0trailing=TRUE)) )
> ## first failed, e.g. for 8.1e100
> 
> 
> ## (R-help, 2008-12-01)
> transform(mtcars, t1=3, t2=4)
                     mpg cyl  disp  hp drat    wt  qsec vs am gear carb t1 t2
Mazda RX4           21.0   6 160.0 110 3.90 2.620 16.46  0  1    4    4  3  4
Mazda RX4 Wag       21.0   6 160.0 110 3.90 2.875 17.02  0  1    4    4  3  4
Datsun 710          22.8   4 108.0  93 3.85 2.320 18.61  1  1    4    1  3  4
Hornet 4 Drive      21.4   6 258.0 110 3.08 3.215 19.44  1  0    3    1  3  4
Hornet Sportabout   18.7   8 360.0 175 3.15 3.440 17.02  0  0    3    2  3  4
Valiant             18.1   6 225.0 105 2.76 3.460 20.22  1  0    3    1  3  4
Duster 360          14.3   8 360.0 245 3.21 3.570 15.84  0  0    3    4  3  4
Merc 240D           24.4   4 146.7  62 3.69 3.190 20.00  1  0    4    2  3  4
Merc 230            22.8   4 140.8  95 3.92 3.150 22.90  1  0    4    2  3  4
Merc 280            19.2   6 167.6 123 3.92 3.440 18.30  1  0    4    4  3  4
Merc 280C           17.8   6 167.6 123 3.92 3.440 18.90  1  0    4    4  3  4
Merc 450SE          16.4   8 275.8 180 3.07 4.070 17.40  0  0    3    3  3  4
Merc 450SL          17.3   8 275.8 180 3.07 3.730 17.60  0  0    3    3  3  4
Merc 450SLC         15.2   8 275.8 180 3.07 3.780 18.00  0  0    3    3  3  4
Cadillac Fleetwood  10.4   8 472.0 205 2.93 5.250 17.98  0  0    3    4  3  4
Lincoln Continental 10.4   8 460.0 215 3.00 5.424 17.82  0  0    3    4  3  4
Chrysler Imperial   14.7   8 440.0 230 3.23 5.345 17.42  0  0    3    4  3  4
Fiat 128            32.4   4  78.7  66 4.08 2.200 19.47  1  1    4    1  3  4
Honda Civic         30.4   4  75.7  52 4.93 1.615 18.52  1  1    4    2  3  4
Toyota Corolla      33.9   4  71.1  65 4.22 1.835 19.90  1  1    4    1  3  4
Toyota Corona       21.5   4 120.1  97 3.70 2.465 20.01  1  0    3    1  3  4
Dodge Challenger    15.5   8 318.0 150 2.76 3.520 16.87  0  0    3    2  3  4
AMC Javelin         15.2   8 304.0 150 3.15 3.435 17.30  0  0    3    2  3  4
Camaro Z28          13.3   8 350.0 245 3.73 3.840 15.41  0  0    3    4  3  4
Pontiac Firebird    19.2   8 400.0 175 3.08 3.845 17.05  0  0    3    2  3  4
Fiat X1-9           27.3   4  79.0  66 4.08 1.935 18.90  1  1    4    1  3  4
Porsche 914-2       26.0   4 120.3  91 4.43 2.140 16.70  0  1    5    2  3  4
Lotus Europa        30.4   4  95.1 113 3.77 1.513 16.90  1  1    5    2  3  4
Ford Pantera L      15.8   8 351.0 264 4.22 3.170 14.50  0  1    5    4  3  4
Ferrari Dino        19.7   6 145.0 175 3.62 2.770 15.50  0  1    5    6  3  4
Maserati Bora       15.0   8 301.0 335 3.54 3.570 14.60  0  1    5    8  3  4
Volvo 142E          21.4   4 121.0 109 4.11 2.780 18.60  1  1    4    2  3  4
> ## failed in 2.8.0 since extra columns were passed as a list.
> 
> 
> ## deparsing transform failed
> parse(text = deparse(transform))
expression(function(`_data`, ...) UseMethod("transform"))
> ## failed in 2.8.0
> 
> 
> ## crashed on some systems (PR#13361)
> matrix(1:4, nrow=2, dimnames=list())
     [,1] [,2]
[1,]    1    3
[2,]    2    4
> ##
> 
> 
> ## col(as.factor=TRUE) failed
> col(matrix(0, 5, 5), as.factor=TRUE)
     [,1] [,2] [,3] [,4] [,5]
[1,] 1    2    3    4    5   
[2,] 1    2    3    4    5   
[3,] 1    2    3    4    5   
[4,] 1    2    3    4    5   
[5,] 1    2    3    4    5   
Levels: 1 2 3 4 5
> ## failed in 2.8.0
> 
> 
> ## qt failure in R-devel in early Dec 2008
> stopifnot(!is.nan(qt(0.1, 0.1)))
> ##
> 
> 
> ## formals<- gave wrong result for list body
> f <- f0 <- function(x) list(pi)
> formals(f) <- formals(f)
> stopifnot(identical(body(f), body(f)))
> ## had body 'pi' < 2.8.1
> 
> 
> ## body<- failed on a function with no arguments.
> f <- function() {pi}
> body(f) <- 2
> f
function () 
2
> ## Failed < 2.8.1
> 
> 
> ## body<- with value a list
> f <- function(x) NULL
> body(f) <- list(pi)
> stopifnot(is.list(body(f))) # was 'pi'
> body(f) <- b0 <- list(a=1, b=2)
> stopifnot(identical(body(f), b0)) # 'a' became an argument
> f <- function(x) NULL
> body(f) <- list(1, 2, 3) # was error
> ## pre-2.9.0 behaviour was erratic.
> 
> 
> ## PR#13305
> qr.solve(cbind(as.complex(1:11), as.complex(1)),
+          as.complex(2*(20:30)))
[1]  2+0i 38+0i
> ## failed in 2.8.1
> 
> 
> ## PR#13433: is ....\nEOF an empty last line?
> aa <- "field1\tfield2\n 1\ta\n 2\tb"
> zz <- textConnection(aa)
> res <- read.table(zz, blank.lines.skip = FALSE)
> close(zz)
> stopifnot(nrow(res) == 3)
> ## was 4 in 2.8.1
> 
> 
> ## segfault from cbind() reported by Hadley Wickham
> ## https://stat.ethz.ch/pipermail/r-devel/2009-January/051853.html
> e <- environment()
> a <- matrix(list(e), ncol = 1, nrow = 2)
> b <- matrix(ncol = 0, nrow = 2) # zero-length
> cbind(a, b)
     [,1]
[1,] ?   
[2,] ?   
> cbind(a, b)
     [,1]
[1,] ?   
[2,] ?   
> ## crashed in 2.9.0
> 
> 
> ## besselI(x, -n) == besselI(x, +n)  when n is an integer
> set.seed(7) ; x <- rlnorm(216) ; nu <- c(1,44,111)
> ## precision lost warnings {may be gone in the future}:
> suppressWarnings(r <- outer(x, c(-nu, nu), besselI))
> stopifnot(identical(r[,1:3], r[,4:6]))
> ## suffered from sin(n * pi) imprecision in R <= 2.8.1
> 
> 
> ## Large sanples in mood.test
> ## https://stat.ethz.ch/pipermail/r-help/2009-March/190479.html
> set.seed(123)
> x <- rnorm(50, 10, 5)
> y <- rnorm(50, 2 ,5)
> (z <- mood.test(x, y))

	Mood two-sample test of scale

data:  x and y 
Z = -0.2275, p-value = 0.82
alternative hypothesis: two.sided 

> stopifnot(!is.na(z$p.value))
> ## gave warning and incorrect result in 2.8.x
> 
> 
> ## heatmap without dendrogram (PR#13512)
> X <- matrix(rnorm(200),20,10)
> XX <- crossprod(X)
> heatmap(XX, Rowv =  NA, revC = TRUE)
> heatmap(XX, Rowv = NA, symm = TRUE)
> ## both failed in 2.8.1
> 
> 
> ## sprintf with 0-length args
> stopifnot(identical(sprintf("%d", integer(0L)), character(0L)))
> stopifnot(identical(sprintf(character(0L), pi), character(0L)))
> ## new feature in 2.9.0
> 
> 
> ## C-level asLogical(x) or c(<raw>, <number>) did not work
> r <- as.raw(1)
> stopifnot(if(r) TRUE)
> for (type in c("null", "logical", "integer", "real", "complex",
+                "character", "list", "expression"))
+     c(r, r, get(sprintf('as.%s', type))(1))
> ## failed  before 2.9.0
> 
> 
> ### Non-unique levels in factor should be forbidden from R 2.10.0 on
> c1 <- c("a.b","a"); c2 <- c("c","b.c")
> fi <- interaction(c1, c2)
> stopifnot(length(lf <- levels(fi)) == 3, lf[1] == "a.b.c",
+ 	  identical(as.integer(fi), rep.int(1L, 2)))
> ## interaction() failed to produce unique levels before 2.9.1
> 
> levs <- c("A","A")
> ## warnings for now {errors in the future}
> local({ oo <- options(warn=2); on.exit(options(oo))
+ 	assertError(gl(2,3, labels = levs))
+ 	assertError(factor(levs, levels=levs))
+ 	assertError(factor(1:2,	 labels=levs))
+     })
> ## failed in R < 2.10.0
> L <- c("no", "yes")
> x <- (5:1)/10; lx <- paste("0.", 1:5, sep="")
> y <- pi + (-9:9)*2^-53
> z <- c(1:2,2:1) ; names(z) <- nz <- letters[seq_along(z)]
> of <- ordered(4:1)
> stopifnot(identical(factor(c(2, 1:2), labels = L),
+ 		    structure(c(2L, 1:2), .Label = L, class="factor")),
+ 	  identical(factor(x),
+ 		    structure(5:1, .Label = lx, class="factor")),
+ 	  length(levels(factor(y))) == 1, length(unique(y)) == 5,
+ 	  identical(factor(z),
+ 		    structure(z, .Names = nz, .Label = c("1","2"),
+ 			      class="factor")),
+ 	  identical(of, factor(of)))
> ## partly failed in R <= 2.9.0, partly in R-devel(2.10.0)
> 
> 
> ## "misuses" of sprintf()
> assertError(sprintf("%S%"))
> assertError(sprintf("%n %g", 1))
> ## seg.faulted in R <= 2.9.0
> 
> 
> ## sprintf(., e)  where length(as.character(e)) < length(e):
> e <- tryCatch(stop(), error=identity)
> stopifnot(identical(sprintf("%s", e),
+ 		    sprintf("%s", as.character(e))))
> ## seg.faulted in R <= 2.9.0
> e <- tryCatch(sprintf("%q %d",1), error=function(e)e)
> e2 <- tryCatch(sprintf("%s", quote(list())), error=function(e)e)
> e3 <- tryCatch(sprintf("%s", quote(blabla)), error=function(e)e)
> stopifnot(inherits(e, "error"), inherits(e2, "error"),inherits(e3, "error"),
+ 	  grep("invalid", c(msg	 <- conditionMessage(e),
+ 			    msg2 <- conditionMessage(e2),
+ 			    msg3 <- conditionMessage(e3))) == 1:3,
+ 	  1 == c(grep("%q", msg), grep("language", msg2), grep("symbol", msg3))
+           )
> ## less helpful error messages previously
> 
> 
> ## bw.SJ on extreme example
> ep <- 1e-3
> stopifnot(all.equal(bw.SJ(c(1:99, 1e6), tol=ep), 0.725, tol=ep))
> ## bw.SJ(x) failed for R <= 2.9.0 (in two ways!), when x had extreme outlier
> 
> 
> ## anyDuplicated() with 'incomp' ...
> oo <- options(warn=2) # no warnings allowed
> stopifnot(identical(0L, anyDuplicated(c(1,NA,3,NA,5), incomp=NA)),
+ 	  identical(5L, anyDuplicated(c(1,NA,3,NA,3), incomp=NA)),
+ 	  identical(4L, anyDuplicated(c(1,NA,3,NA,3), incomp= 3)),
+ 	  identical(0L, anyDuplicated(c(1,NA,3,NA,3), incomp=c(3,NA))))
Warning: stack imbalance in 'anyDuplicated', 43 then 44
Warning: stack imbalance in '.Internal', 42 then 43
Warning: stack imbalance in '{', 40 then 41
Warning: stack imbalance in 'anyDuplicated', 43 then 44
Warning: stack imbalance in '.Internal', 42 then 43
Warning: stack imbalance in '{', 40 then 41
> options(oo)
> ## missing UNPROTECT and partly wrong in development versions of R
> 
> 
> ## test of 'stringsAsFactors' argument to expand.grid()
> z <- expand.grid(letters[1:3], letters[1:4], stringsAsFactors = TRUE)
> stopifnot(sapply(z, class) == "factor")
> z <- expand.grid(letters[1:3], letters[1:4], stringsAsFactors = FALSE)
> stopifnot(sapply(z, class) == "character")
> ## did not work in 2.9.0, fixed in 2.9.1 patched
> 
> 
> ## print.srcref should not fail; a bad encoding should fail; neither should
> ## leave an open connection
> nopen <- nrow(showConnections())
> tmp <- tempfile()
> cat( c( "1", "a+b", "2"), file=tmp, sep="\n")
> p <- parse(tmp)
> print(p)
expression(1, a + b, 2)
> con <- try(file(tmp, open="r", encoding="unknown"))
Error in file(tmp, open = "r", encoding = "unknown") : 
  unsupported conversion from 'unknown' to ''
> unlink(tmp)
> stopifnot(inherits(con, "try-error") && nopen == nrow(showConnections()))
> ##
> 
> 
> ## PR#13574
> x <- 1:11; y <- c(6:1, 7, 11:8)
> stopifnot(all.equal(cor.test(x, y, method="spearman", alternative="greater")$p.value, cor.test(x, -y, method="spearman", alternative="less")$p.value))
> ## marginally different < 2.9.0 patched
> 
> 
> ## median should work on POSIXt objects (it did in 2.8.0)
> median(rep(Sys.time(), 2))
[1] "2010-10-03 01:57:46 CEST"
> ## failed in 2.8.1, 2.9.0
> 
> 
> ## repeated NA in dim() (PR#13729)
> L0 <- logical(0)
> try(dim(L0) <- c(1,NA,NA))
Error in dim(L0) <- c(1, NA, NA) : the dims contain missing values
> stopifnot(is.null(dim(L0)))
> L1 <- logical(1)
> try(dim(L1) <- c(-1,-1))
Error in dim(L1) <- c(-1, -1) : the dims contain negative values
> stopifnot(is.null(dim(L)))
> ## dim was set in 2.9.0
> 
> 
> ## as.character(<numeric>)
> nx <- 0.3 + 2e-16 * -2:2
> stopifnot(identical("0.3", unique(as.character(nx))),
+           identical("0.3+0.3i", unique(as.character(nx*(1+1i)))))
> ## the first gave ("0.300000000000000" "0.3") in R < 2.10.0
> 
> 
> ## aov evaluated a test in the wrong place ((PR#13733)
> DF <- data.frame(y = c(rnorm(10), rnorm(10, mean=3), rnorm(10, mean=6)),
+                  x = factor(rep(c("A", "B", "C"), c(10, 10, 10))),
+                  sub = factor(rep(1:10, 3)))
> ## In 2.9.0, the following line raised an error because "x" cannot be found
> junk <- summary(aov(y ~ x + Error(sub/x), data=DF, subset=(x!="C")))
> ## safety check added in 2.9.0 evaluated the call.
> 
> 
> ## for(var in seq) .. when seq is modified  "inside" :
> x <- c(1,2); s <- 0; for (i in x) { x[i+1] <- i + 42.5; s <- s + i }
> stopifnot(s == 3)
> ## s was  44.5  in R <= 2.9.0
> 
> 
> ## ":" at the boundary
> M <- .Machine$integer.max
> s <- (M-2):(M+.1)
> stopifnot(is.integer(s), s-M == -2:0)
> ## was "double" in R <= 2.9.1
> 
> 
> ## too many columns model.matrix()
> dd <- as.data.frame(sapply(1:40, function(i) gl(2, 100)))
> (f <- as.formula(paste("~ - 1 + ", paste(names(dd), collapse = ":"), sep = "")))
~-1 + V1:V2:V3:V4:V5:V6:V7:V8:V9:V10:V11:V12:V13:V14:V15:V16:V17:V18:V19:V20:V21:V22:V23:V24:V25:V26:V27:V28:V29:V30:V31:V32:V33:V34:V35:V36:V37:V38:V39:V40
> e <- tryCatch(X <- model.matrix(f, data = dd), error=function(e)e)
> stopifnot(inherits(e, "error"))
> ## seg.faulted in R <= 2.9.1
> 
> 
> ## seq_along( <obj> )
> x <- structure(list(a = 1, value = 1:7), class = "FOO")
> length.FOO <- function(x) length(x$value)
> stopifnot(identical(seq_len(length(x)),
+ 		    seq_along(x)))
> ## used C-internal non-dispatching length() in R <= 2.9.1
> 
> 
> ## factor(NULL)
> stopifnot(identical(factor(), factor(NULL)))
> ## gave an error from R ~1.3.0 to 2.9.1
> 
> 
> ## methods() gave two wrong warnings in some cases:
> op <- options(warn = 2)# no warning, please!
> m1 <- methods(na.omit) ## should give (no warning):
> ##
> setClass("bla")
[1] "bla"
> setMethod("na.omit", "bla", function(object, ...) "na.omit(<bla>)")
Creating a new generic function for "na.omit" in ".GlobalEnv"
[1] "na.omit"
> (m2 <- methods(na.omit)) ## should give (no warning):
[1] na.omit.data.frame* na.omit.default*    na.omit.ts*        

   Non-visible functions are asterisked
> stopifnot(identical(m1, m2))
> options(op)
> ## gave two warnings, when an S3 generic had turned into an S4 one
> 
> 
> ## raw vector assignment with NA index
> x <- charToRaw("abc")
> y <- charToRaw("bbb")
> x[c(1, NA, 3)] <- x[2]
> stopifnot(identical(x, y))
> ## used to segfault
> 
> 
> ## Logic operations with complex
> stopifnot(TRUE & -3i, FALSE | 0+1i,
+ 	  TRUE && 1i, 0+0i || 1+0i)
> ## was error-caught explicitly in spite of contrary documentation
> 
> 
> ## Tests of save/load with different types of compression
> x <- xx <- 1:1000
> test1 <- function(ascii, compress)
+ {
+     tf <- tempfile()
+     save(x, ascii = ascii, compress = compress, file = tf)
+     load(tf)
+     stopifnot(identical(x, xx))
+     unlink(tf)
+ }
> for(compress in c(FALSE, TRUE))
+     for(ascii in c(TRUE, FALSE)) test1(ascii, compress)
> for(compress in c("bzip2", "xz"))
+     for(ascii in c(TRUE, FALSE)) test1(ascii, compress)
> 
> 
> ## tests of read.table with different types of compressed input
> mor <- system.file("data/morley.tab", package="datasets")
> ll <- readLines(mor)
> tf <- tempfile()
> ## gzip copression
> writeLines(ll, con <- gzfile(tf)); close(con)
> file.info(tf)$size
[1] 583
> stopifnot(identical(read.table(tf), morley))
> ## bzip2 copression
> writeLines(ll, con <- bzfile(tf)); close(con)
> file.info(tf)$size
[1] 482
> stopifnot(identical(read.table(tf), morley))
> ## xz copression
> writeLines(ll, con <- xzfile(tf, compression = -9)); close(con)
> file.info(tf)$size
[1] 480
> stopifnot(identical(read.table(tf), morley))
> unlink(tf)
> 
> 
> ## weighted.mean with NAs (PR#14032)
> x <- c(101, 102, NA)
> stopifnot(all.equal(mean(x, na.rm = TRUE), weighted.mean(x, na.rm = TRUE)))
> ## divided by 3 in 2.10.0 (only)
> ## but *should* give NaN for empty:
> stopifnot(identical(NaN, weighted.mean(0[0])),
+ 	  identical(NaN, weighted.mean(NA,		na.rm=TRUE)),
+ 	  identical(NaN, weighted.mean(rep(NA_real_,2), na.rm=TRUE)))
> ## all three gave 0  in 2.10.x and 2.11.x (but not previously)
> 
> 
> ## regexpr(fixed = TRUE) with a single-byte pattern matching to a MBCS string
> x <- iconv("fa\xE7ile a ", "latin1", "UTF-8")
> stopifnot(identical(regexpr(" ", x), regexpr(" ", x, fixed=TRUE)))
> # fixed=TRUE reported match position in bytes in R <= 2.10.0
> stopifnot(identical(regexpr(" a", x), regexpr(" a", x, fixed=TRUE)))
> ## always worked.
> 
> ## unname() on 0-length vector
> stopifnot(identical(1[FALSE], unname(c(a=1)[FALSE])))
> ## failed to drop names in 2.10.0
> 
> 
> ## complete.cases on 0-column data frame
> complete.cases(data.frame(1:10)[-1])
 [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
> ## failed in 2.10.0
> 
> 
> ## PR#14035, converting (partially) unnamed lists to environments.
> (qq <- with(list(2), ls()))
character(0)
> nchar(qq)
integer(0)
> with(list(a=1, 2), ls())
[1] "a"
> ## failed in R < 2.11.0
> 
> 
> ## chisq.test with over-long 'x' or 'y' arg
> # https://stat.ethz.ch/pipermail/r-devel/2009-November/055700.html
> x <- y <- rep(c(1000, 1001, 1002), each=5)
> z <- eval(substitute(chisq.test(x,y), list(x=x)))
Warning message:
In chisq.test(c(1000, 1000, 1000, 1000, 1000, 1001, 1001, 1001,  :
  Chi-squared approximation may be incorrect
> z

	Pearson's Chi-squared test

data:  c(1000, 1000, 1000, 1000, 1000, 1001, 1001, 1001, 1001, 1001, 
1002, 1002, 1002, 1002, 1002) and y 
X-squared = 30, df = 4, p-value = 4.894e-06

> z$observed
      y
       1000 1001 1002
  1000    5    0    0
  1001    0    5    0
  1002    0    0    5
> ## failed in 2.10.0
> 
> 
> ## unsplit(drop = TRUE) on a data frame failed (PR#14084)
> dff <- data.frame(gr1 = factor(c(1,1,1,1,1,2,2,2,2,2,2), levels=1:4),
+                   gr2 = factor(c(1,2,1,2,1,2,1,2,1,2,3), levels=1:4),
+                   yy = rnorm(11), row.names = as.character(1:11))
> dff2 <- split(dff, list(dff$gr1, dff$gr2), drop=TRUE)
> dff3 <- unsplit(dff2, list(dff$gr1, dff$gr2), drop=TRUE)
> stopifnot(identical(dff, dff3))
> ## failed in 2.10.0
> 
> 
> ## mean.difftime ignored its na.rm argument
> z <- as.POSIXct(c("1980-01-01", "1980-02-01", NA, "1980-03-01", "1980-04-01"))
> zz <- diff(z)
> stopifnot(is.finite(mean(zz, na.rm=TRUE)))
> ## was NA in 2.10.0
> 
> 
> ## weighted means with zero weights and infinite values
> x <- c(0, 1, 2, Inf)
> w <- c(1, 1, 1, 0)
> z <- weighted.mean(x, w)
> stopifnot(is.finite(z))
> ## was NaN in 2.10.x
> 
> 
> ## Arithmetic operations involving "difftime"
> z <- as.POSIXct(c("2009-12-01", "2009-12-02"), tz="UTC")
> (zz <- z[2] - z[1])
Time difference of 1 days
> (zzz <- z[1] + zz)
[1] "2009-12-02 UTC"
> stopifnot(identical(zzz, z[2]),
+           identical(zz + z[1], z[2]),
+           identical(z[2] - zz, z[1]))
> z <- as.Date(c("2009-12-01", "2009-12-02"))
> (zz <- z[2] - z[1])
Time difference of 1 days
> (zzz <- z[1] + zz)
[1] "2009-12-02"
> stopifnot(identical(zzz, z[2]),
+           identical(zz + z[1], z[2]),
+           identical(z[2] - zz, z[1]))
> ## failed/gave wrong answers when Ops.difftime was introduced.
> 
> 
> ## quantiles, new possibilities in 2.11.0
> x <- ordered(1:11, labels=letters[1:11])
> quantile(x, type = 1)
  0%  25%  50%  75% 100% 
   a    c    f    i    k 
Levels: a < b < c < d < e < f < g < h < i < j < k
> quantile(x, type = 3)
  0%  25%  50%  75% 100% 
   a    c    f    h    k 
Levels: a < b < c < d < e < f < g < h < i < j < k
> st <- as.Date("1998-12-17")
> en <- as.Date("2000-1-7")
> ll <- seq(as.Date("2000-1-7"), as.Date("1997-12-17"), by="-1 month")
> quantile(ll, type = 1)
          0%          25%          50%          75%         100% 
"1997-12-07" "1998-06-07" "1998-12-07" "1999-07-07" "2000-01-07" 
> quantile(ll, type = 3)
          0%          25%          50%          75%         100% 
"1997-12-07" "1998-05-07" "1998-12-07" "1999-07-07" "2000-01-07" 
> ## failed prior to 2.11.0
> 
> 
> ## (asymptotic) point estimate in wilcox.test(*, conf.int=TRUE)
> alt <- eval(formals(stats:::wilcox.test.default)$alternative)
> Z <- c(-2, 0, 1, 1, 2, 2, 3, 5, 5, 5, 7)
> E1 <- sapply(alt, function(a.)
+ 	     wilcox.test(Z, conf.int = TRUE,
+ 			 alternative = a., exact = FALSE)$estimate)
> X <- c(6.5, 6.8, 7.1, 7.3, 10.2)
> Y <- c(5.8, 5.8, 5.9, 6, 6, 6, 6.3, 6.3, 6.4, 6.5, 6.5)
> E2 <- sapply(alt, function(a.)
+ 	     wilcox.test(X,Y, conf.int = TRUE,
+ 			 alternative = a., exact = FALSE)$estimate)
> stopifnot(E1[-1] == E1[1],
+ 	  E2[-1] == E2[1])
> ## was continiuity corrected, dependent on 'alternative', prior to 2.10.1
> 
> 
> ## read.table with embedded newlines in header (PR#14103)
> writeLines(c('"B1', 'B2"', 'B3'), "test.dat")
> z <- read.table("test.dat", header = TRUE)
> unlink("test.dat")
> stopifnot(identical(z, data.frame("B1.B2"="B3")))
> ## Left part of header to be read as data in R < 2.11.0
> 
> ## switch() with  empty  '...'
> stopifnot(is.null(switch("A")),
+ 	  is.null(switch(1)), is.null(switch(3L)))
> ## the first one hung, 2nd gave error, in R <= 2.10.1
> 
> 
> ## factors with NA levels
> V <- addNA(c(0,0,NA,0,1,1,0,NA,1,1))
> stopifnot(identical(V, V[, drop = TRUE]))
> stopifnot(identical(model.frame(~V), model.frame(~V, xlev = list(V=levels(V)))))
> # dropped NA levels (in two places) in 2.10.1
> V <- c(0,0,NA,0,1,1,0,NA,1,1)
> stopifnot(identical(V, V[, drop = TRUE]))
> stopifnot(identical(model.frame(~V), model.frame(~V, xlev = list(V=levels(V)))))
> ## check other cases have not been changed
> 
> 
> ## ks.test gave p=1 rather than p=0.9524 because abs(1/2-4/5)>3/10 was TRUE
> stopifnot(all.equal(ks.test(1:5, c(2.5,4.5))$p.value, 20/21))
> 
> 
> ## NAs in utf8ToInt and v.v.
> stopifnot(identical(utf8ToInt(NA_character_), NA_integer_),
+           identical(intToUtf8(NA_integer_), NA_character_),
+           identical(intToUtf8(NA_integer_, multiple = TRUE), NA_character_))
> ## no NA-handling prior to 2.11.0
> 
> 
> ## tcrossprod() for  matrix - vector combination
> u <- 1:3 ; v <- 1:5
> ## would not work identically: names(u) <- LETTERS[seq_along(u)]
> U <- as.matrix(u)
> stopifnot(identical(tcrossprod(u,v), tcrossprod(U,v)),
+ 	  identical(tcrossprod(u,v), u %*% t(v)),
+ 	  identical(tcrossprod(v,u), tcrossprod(v,U)),
+ 	  identical(tcrossprod(v,u), v %*% t(u)))
> ## tcrossprod(v,U) and (U,v) wrongly failed in R <= 2.10.1
> 
> 
> ## det() and determinant() in NA cases
> m <- matrix(c(0, NA, 0, NA, NA, 0, 0, 0, 1), 3,3)
> m0 <- rbind(0, cbind(0, m))
> if(FALSE) { ## ideally, we'd want -- FIXME --
+ stopifnot(is.na(det(m)), 0 == det(m0))
+ } else print(c(det.m = det(m), det.m0 = det(m0)))
 det.m det.m0 
     0      0 
> ## the first wrongly gave 0  (still gives .. FIXME)
> 
> 
> ## c/rbind(deparse.level=2)
> attach(mtcars)
> (cn <- colnames(cbind(qsec, hp, disp)))
[1] "qsec" "hp"   "disp"
> stopifnot(identical(cn, c("qsec", "hp", "disp")))
> (cn <- colnames(cbind(qsec, hp, disp, deparse.level = 2)))
[1] "qsec" "hp"   "disp"
> stopifnot(identical(cn, c("qsec", "hp", "disp")))
> (cn <- colnames(cbind(qsec, log(hp), sqrt(disp))))
[1] "qsec" ""     ""    
> stopifnot(identical(cn, c("qsec", "", "")))
> (cn <- colnames(cbind(qsec, log(hp), sqrt(disp), deparse.level = 2)))
[1] "qsec"       "log(hp)"    "sqrt(disp)"
> stopifnot(identical(cn, c("qsec", "log(hp)", "sqrt(disp)")))
> detach()
> ## 2.10.1 gave no column names for deparse.level=2
> 
> 
> ## Infinite-loops with match(incomparables=)
> match(c("A", "B", "C"), "A", incomparables=NA)
[1]  1 NA NA
> match(c("A", "B", "C"), c("A", "B"), incomparables="A")
[1] NA  2 NA
> ## infinite-looped in 2.10.1
> 
> 
> ## path.expand did not propagate NA
> stopifnot(identical(c("foo", NA), path.expand(c("foo", NA))))
> ## 2.10.1 gave "NA"
> 
> 
> ## prettyNum(drop0trailing=TRUE) mangled complex values (PR#14201)
> z <- c(1+2i, 1-3i)
> str(z) # a user
 cplx [1:2] 1+2i 1-3i
> stopifnot(identical(format(z, drop0trailing=TRUE), as.character(z)))
> ## 2.10.1 gave 'cplx [1:2] 1+2i 1+3i'
> 
> 
> ## "exact" fisher.test
> dd <- data.frame(group=1, score=c(rep(0,14), rep(1,29), rep(2, 16)))[rep(1:59, 2),]
> dd[,"group"] <- c(rep("DOG", 59), rep("kitty", 59))
> Pv <- with(dd, fisher.test(score, group)$p.value)
> stopifnot(0 <= Pv, Pv <= 1)
> ## gave P-value 1 + 1.17e-13  in R < 2.11.0
> 
> 
> ## Use of switch inside lapply (from BioC package ChromHeatMap)
> lapply("forward", switch, forward = "posS", reverse = "negS")
[[1]]
[1] "posS"

> ## failed  when first converted to primitive.
> 
> 
> ## evaluation of arguments of log2
> assertError(try(log2(quote(1:10))))
Error in log2(quote(1:10)) : 
  Non-numeric argument to mathematical function
> ## 'worked' in 2.10.x by evaluting the arg twice.
> 
> 
> ## mean with NAs and trim (Bill Dunlap,
> ## https://stat.ethz.ch/pipermail/r-devel/2010-March/056982.html)
> stopifnot(is.na(mean(c(1,10,100,NA), trim=0.1)),
+           is.na(mean(c(1,10,100,NA), trim=0.26)))
> ## gave error, real value respectively in R <= 2.10.1
> 
> 
> ## all.equal(*, tol) for objects with numeric attributes
> a <- structure(1:17, xtras = c(pi, exp(1)))
> b <- a * (II <- (1 + 1e-7))
> attr(b,"xtras") <- attr(a,"xtras") * II
> stopifnot(all.equal(a,b, tol=2e-7))
> ## gave  "Attributes: .... relative difference: 1e-07"  in R <= 2.10.x
> 
> 
> ## Misuse of gzcon() [PR# 14237]
> (ac <- getAllConnections())
[1] 0 1 2
> tc <- textConnection("x", "w")
> try(f <- gzcon(tc)) # -> error.. but did *damage* tc
Error in gzcon(tc) : 
  cannot create a gzcon connection from a writable textConnection; maybe use rawConnection
> newConn <- function(){ A <- getAllConnections(); A[is.na(match(A,ac))] }
> (newC <- newConn())
[1] 3
> gg <- tryCatch(getConnection(newC), error=identity)
> stopifnot(identical(gg, tc))
> close(tc)
> stopifnot(length(newConn()) == 0)
> ## getConn..(*) seg.faulted in R <= 2.10.x
> 
> 
> ## splinefun(., method = "monoH.FC")
> x <- 1:7 ; xx <- seq(0.9, 7.1, length=2^12)
> y <- c(-12, -10, 3.5, 4.45, 4.5, 140, 142)
> Smon <- splinefun(x, y, method = "monoH.FC")
> stopifnot(0 <= min(Smon(xx, deriv=1)))
> ## slopes in [4.4, 4.66] were slightly negative, because m[] adjustments
> ## could be sightly off in cases of adjacency, for  R <= 2.11.0
> 
> 
> ## prettyDate( <Date> )
> x <- as.Date("2008-04-22 09:45") + 0:5
> px <- pretty(x, n = 5)
> stopifnot(px[1] == "2008-04-22", length(px) == 6)
> ## did depend on the local timezone  at first
> 
> 
> ## cut( d, breaks = n) - for d of class  'Date' or 'POSIXt'
> x <- seq(as.POSIXct("2000-01-01"), by = "days", length = 20)
> stopifnot(nlevels(c1 <- cut(x, breaks = 3)) == 3,
+ 	  nlevels(c2 <- cut(as.POSIXlt(x), breaks = 3)) == 3,
+ 	  nlevels(c3 <- cut(as.Date(x), breaks = 3)) == 3,
+ 	  identical(c1, c2))
> ## failed in R <= 2.11.0
> 
> 
> ## memDecompress (https://stat.ethz.ch/pipermail/r-devel/2010-May/057419.html)
> char <- paste(replicate(200, "1234567890"), collapse="")
> char.comp <- memCompress(char, type="xz")
> char.dec <- memDecompress(char.comp, type="xz", asChar=TRUE)
> stopifnot(nchar(char.dec) == nchar(char))
> ## short in R <= 2.11.0
> 
> 
> ## rbeta() with mass very close to 1 -- bug PR#14291
> set.seed(1)
> if(any(ii <- is.na(rbeta(5000, 100, 0.001))))
+     stop("rbeta() gave NAs at ", paste(which(ii), collapse=", "),
+          "\n")
> ## did give several, but platform dependently, in R <= 2.11.0
> 
> 
> ## print.ls_str() should not eval() some objects
> E <- environment((function(miss)function(){})())
> E$i <- 2:4
> E$o <- as.name("foobar")
> E$cl <- expression(sin(x))[[1]]
> ls.str(E)
cl :  language sin(x)
i :  int [1:3] 2 3 4
miss : <missing>
o :  symbol foobar
> ## 'o' failed in R <= 2.11.0 (others in earlier versions of R)
> 
> 
> ## print() {& str()} should distinguish named empty lists
> stopifnot(identical("named list()",
+ 		    capture.output(list(.=2)[0])))
> ## was just "list()" up to R <= 2.11.x
> 
> 
> ## stripchart with empty first level (PR#14317)
> stripchart(decrease ~ treatment, data = OrchardSprays,
+            subset = treatment != "A")
> ## failed in 2.11.1
> 
> 
> ## versions of pre-2.12.0 using zlib 1.2.[45] failed
> zz <- gzfile("ex.gz", "w")  # compressed file
> cat("TITLE extra line", "2 3 5 7", "", "11 13 17", file = zz, sep ="\n")
> close(zz)
> blah <- file("ex.gz", "r")
> stopifnot(seek(blah) == 0)
> ## gave random large multiple of 2^32 on Linux systems attempting to
> ## use LFS support.
> 
> 
> ## pre-2.12.0 wrongly accessed 0-length entries
> o0 <- as.octmode(integer(0))
> stopifnot(identical(o0, o0 & "400"))
> ## gave a seg.fault at some point
> 
> 
> ## as.logical on factors
> x <- factor(c("FALSE", "TRUE"))
> stopifnot(identical(as.logical(x), c(FALSE, TRUE)))
> # Lost documented behaviour when taken primitive in R 2.6.0
> stopifnot(identical(as.vector(x, "logical"), c(FALSE, TRUE)))
> # continued to work
> ## Reverted in 2.12.0.
> 
> 
> ## missing backquoting of default arguments in in prompt()
> f <- function (FUN = `*`) {}
> pr <- prompt(f, NA)$usage
> stopifnot(identical(pr[2], "f(FUN = `*`)"))
> ## see https://stat.ethz.ch/pipermail/r-devel/2010-August/058126.html
> 
> 
> ## cut.POSIXt very near boundaries (PR#14351)
> x <- as.POSIXlt("2010-08-10 00:00:01")
> stopifnot(!is.na(cut(x, "5 hours")))
> ## was NA in 2.11.x
> 
> 
> ## summary() on data frames with invalid names -- in UTF-8 locale
> DF <- data.frame(a = 1:3, b = 4:6)
> nm <- names(DF) <- c("\xca", "\xcb")
> cn <- gsub(" ", "", colnames(summary(DF)), useBytes = TRUE)
> stopifnot(identical(cn, nm))
> m <- as.matrix(DF)
> DF <- data.frame(a = 1:3, m=I(m))
> cn <- gsub(" ", "", colnames(summary(DF)), useBytes = TRUE)
> stopifnot(identical(cn, c("a", paste("m.", nm, sep="", collapse=""))))
> ##  Had NAs in < 2.12.0
> 
> 
> ## [[<- could create invalid objects,
> ## https://stat.ethz.ch/pipermail/r-devel/2010-August/058312.html
> z0 <- z <- factor(c("Two","Two","Three"), levels=c("One","Two","Three"))
> z[[2]] <- "One"
> stopifnot(typeof(z) == "integer")
> z[[2]] <- "Two"
> stopifnot(identical(z, z0))
> ## failed < 2.12.0
> 
> 
> ## predict.loess with NAs
> cars.lo <- loess(dist ~ speed, cars)
> res <- predict(cars.lo, data.frame(speed = c(5, NA, 25)))
> stopifnot(length(res) == 3L, is.na(res[2]))
> res <- predict(cars.lo, data.frame(speed = c(5, NA, 25)), se = TRUE)
> stopifnot(length(res$fit) == 3L, is.na(res$fit[2]),
+           length(res$se.fit) == 3L, is.na(res$se.fit[2]))
> cars.lo2 <- loess(dist ~ speed, cars, control = loess.control(surface = "direct"))
> res <- predict(cars.lo2, data.frame(speed = c(5, NA, 25)))
> stopifnot(length(res) == 3L, is.na(res[2]))
> res <- predict(cars.lo2, data.frame(speed = c(5, NA, 25)), se = TRUE)
> stopifnot(length(res$fit) == 3L, is.na(res$fit[2]),
+           length(res$se.fit) == 3L, is.na(res$se.fit[2]))
> ## Used na.omit prior to 2.12.0
> 
> 
> ## student typo
> try( ksmooth(cars$speed, cars$dists) )
Error in ksmooth(cars$speed, cars$dists) : numeric y must be supplied.
For density estimation use density()
> ## now error about y (== NULL);  segfaulted <= 2.11.1
> 
> 
> ## do.call()ing NextMethod and empty args:
> try( do.call(function(x) NextMethod('foo'),list()) )
Error in NextMethod("foo") : object not specified
> ## segfaulted <= 2.11.1
> 
> 
> ## identical() returned FALSE on external ptr with
> ## identical addresses <= 2.11.1
> stopifnot(identical(
+                     getNativeSymbolInfo("R_getSymbolInfo", "base"),
+                     getNativeSymbolInfo("R_getSymbolInfo", "base")
+                     ))
> stopifnot(!identical(
+                      getNativeSymbolInfo("R_getSymbolInfo", "base"),
+                      getNativeSymbolInfo("R_getRegisteredRoutines", "base")
+                      ))
> 
> 
> ## getNamespaceVersion() etc
> stopifnot(getNamespaceVersion("stats") == getRversion())
> ## failed in R 2.11.x
> 
> 
> ## PR#14383
> x <- rnorm(100)
> z1 <- quantile(x, type = 6, probs = c(0, .5))
> z2 <- quantile(x, type = 6, probs = c(.5, 0))
> stopifnot(z1 == rev(z2))
> ## differed in 2.11.x
> 
> 
> 
> ## found from fallback test in slam 0.1-15
> x <- matrix(c(1, 0, NA, 1), 2, 2)
> y <- matrix(c(1, 0, 0, 2, 1, 0), 3, 2)
> (z <- tcrossprod(x, y))
     [,1] [,2] [,3]
[1,]   NA   NA    0
[2,]    2    1    0
> stopifnot(identical(z, x %*% t(y)))
Error: identical(z, x %*% t(y)) is not TRUE
Execution halted
