beebe@math.utah.edu
2003-Apr-24 19:45 UTC
[Rd] R-1.7.0 build feedback: NetBSD 1.6 (PR#2837)
R-1.7.0 built on NetBSD 1.6, but the validation test suite failed:
Machinetype: Intel Pentium III (600 MHz); NetBSD 1.6 (GENERIC)
Remote gcc version: gcc (GCC) 3.2.2
Remote g++ version: g++ (GCC) 3.2.2
Configure environment: CC=gcc CXX=g++ LDFLAGS=-Wl,-rpath,/usr/local/lib
make[5]: Entering directory `/local/build/R-1.7.0/src/library'
>>> Building/Updating help pages for package 'base'
Formats: text example
make[5]: Leaving directory `/local/build/R-1.7.0/src/library'
running code in 'base-Ex.R' ...make[4]: *** [base-Ex.Rout] Error 1
make[4]: Leaving directory `/local/build/R-1.7.0/tests/Examples'
make[3]: *** [test-Examples-Base] Error 2
make[3]: Leaving directory `/local/build/R-1.7.0/tests/Examples'
make[2]: *** [test-Examples] Error 2
make[2]: Leaving directory `/local/build/R-1.7.0/tests'
I forced the tests to run with "make -i check", getting output like
this:
running code in 'base-Ex.R' ...make[4]: [base-Ex.Rout] Error 1 (ignored)
OK
collecting examples for package 'ctest' ...
make[5]: Entering directory `/local/build/R-1.7.0/src/library'
>>> Building/Updating help pages for package 'ctest'
Formats: text example
make[5]: Leaving directory `/local/build/R-1.7.0/src/library'
running code in 'ctest-Ex.R' ...make[4]: [ctest-Ex.Rout] Error 1
(ignored)
OK
...
mv: cannot stat `eval-etc.Rout': No such file or directory
comparing 'eval-etc.Rout' to './eval-etc.Rout.save'
...2a3,158> > #### eval / parse / deparse / substitute etc
> >
> > ##- From: Peter Dalgaard BSA <p.dalgaard@biostat.ku.dk>
> > ##- Subject: Re: source() / eval() bug ??? (PR#96)
> > ##- Date: 20 Jan 1999 14:56:24 +0100
> > e1 <- parse(text='c(F=(f <- .3), "Tail area" = 2 *
if(f < 1) 30 else 90)')[[1]]
> > e1
> c(F = (f <- 0.3), "Tail area" = 2 * if (f < 1) 30 else 90)
...
This is followed by 9900+ lines of differences.
-------------------------------------------------------------------------------
- Nelson H. F. Beebe Tel: +1 801 581 5254 -
- Center for Scientific Computing FAX: +1 801 581 4148 -
- University of Utah Internet e-mail: beebe@math.utah.edu -
- Department of Mathematics, 110 LCB beebe@acm.org beebe@computer.org -
- 155 S 1400 E RM 233 beebe@ieee.org -
- Salt Lake City, UT 84112-0090, USA URL: http://www.math.utah.edu/~beebe -
>>>>> beebe writes:> R-1.7.0 built on NetBSD 1.6, but the validation test suite failed: > Machinetype: Intel Pentium III (600 MHz); NetBSD 1.6 (GENERIC) > Remote gcc version: gcc (GCC) 3.2.2 > Remote g++ version: g++ (GCC) 3.2.2 > Configure environment: CC=gcc CXX=g++ LDFLAGS=-Wl,-rpath,/usr/local/lib> make[5]: Entering directory `/local/build/R-1.7.0/src/library' >>>> Building/Updating help pages for package 'base' > Formats: text example > make[5]: Leaving directory `/local/build/R-1.7.0/src/library' > running code in 'base-Ex.R' ...make[4]: *** [base-Ex.Rout] Error 1 > make[4]: Leaving directory `/local/build/R-1.7.0/tests/Examples' > make[3]: *** [test-Examples-Base] Error 2 > make[3]: Leaving directory `/local/build/R-1.7.0/tests/Examples' > make[2]: *** [test-Examples] Error 2 > make[2]: Leaving directory `/local/build/R-1.7.0/tests'Did you look at base-Ex.Rout.fail to maybe see what the problem is? -k
beebe@math.utah.edu
2003-May-03 16:10 UTC
[Rd] R-1.7.0 build feedback: NetBSD 1.6 (PR#2837)
This is a followup to my report of a SIGSEGV in R-1.7.0 built on NetBSD 1.6. Kurt Hornik responded:>> ... >> After some discussions on r-core, two suggestions. >> >> * It might be helpful to know if zlib has found in the OS or compiled >> from the sources within R: if the first you could try configure >> --without-zlib as it is possible the OS has a modified version. >> >> * You have >> >> R : Copyright 2003, The R Development Core Team >> Version 1.7.0 Under development (unstable) (2003-04-11) >> ^^^^^^^^^^^^^^^^^^^^^^ ^^^ >> >> and might just have hit a bad day of the r-devel daily snapshot. >> ...I don't think that the latter is the problem. This version built, validated, and installed on several other platforms. Since my initial bug report for this system, I upgraded the gcc release from 3.2.2 to the latest 3.2.3, so the compilation environment is now a bit different. I tried your suggestion of the --without-zlib configure option, and that produced a working R, which I've installed. There was one *.fail file in the tests directory: reg-tests-1.Rout.fail. It is 2280 lines long, and contains a fair number of "Error xxx" reports. In view of the gcc upgrade, I'm going to go back now and do a fresh build, and see if the zlib problem recurs. Here is a copy of reg-tests-1.Rout.fail: R : Copyright 2003, The R Development Core Team Version 1.7.0 Under development (unstable) (2003-04-11) 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. Type `demo()' for some demos, `help()' for on-line help, or `help.start()' for a HTML browser interface to help. Type `q()' to quit R.> ## 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 > > > ## 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 > > > ## 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* .Machine$double.eps) > ( Lcm <- La.chol(m) )[,1] [,2] [1,] 2.236068 0.4472136 [2,] 0.000000 1.6733201> stopifnot(abs(m - crossprod(Lcm)) < 100* .Machine$double.eps) > > ## 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* .Machine$double.eps) > > 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 1.010646e-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))) > stopifnot(all.equal(diag(3), ma %*% La.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 > > > ## complex > z <- 0i ^ (-3:3) > stopifnot(Re(z) == 0 ^ (-3:3)) > set.seed(123) > z <- complex(real = rnorm(100), imag = rnorm(100)) > stopifnot(Mod ( 1 - sin(z) / ( (exp(1i*z)-exp(-1i*z))/(2*1i) ))+ < 20 * .Machine$double.eps)> ## end of moved from complex.Rd > > > ## Constants > stopifnot(+ nchar(letters) == 1, + month.abb == substr(month.name, 1, 3) + )> > eps <- .Machine$double.eps > stopifnot(all.equal(pi, 4*atan(1), tol= 2*eps)) > > # John Machin (1705) computed 100 decimals of pi : > stopifnot(all.equal(pi/4, 4*atan(1/5) - atan(1/239), 4*eps)) > ## 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 > > > ## DateTimeClasses > (dls <- .leap.seconds[-1] - .leap.seconds[-22])Time differences of 184, 365, 365, 365, 366, 365, 365, 365, 547, 730, 731, 365, 549, 731, 365, 547, 365, 365, 549, 547, 549 days> table(dls)dls 184 365 366 547 549 730 731 1 10 1 3 3 1 2> ## 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)]))> > data(iris) > stopifnot(duplicated(iris)[143] == TRUE) > ## end of moved from duplicated.Rd > > > ## eigen > Meps <- .Machine$double.eps > 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]) < 60 * Meps) > > 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 > data(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-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) > eps <- 100 * .Machine$double.eps > require(stepfun)Loading required package: stepfun [1] TRUE> stopifnot(it[c(1,203)] == c(0, 100),+ all.equal(N * ecdf(X)(tt), + findInterval(tt, X), tol = eps), + findInterval(tt,X) == apply( outer(tt, X, ">="), 1, sum) + )> ## end of moved from findint.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(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, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3 + ), .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 = 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", "37", "38", + "39", "40", "41", "42", "43", "44", "45", "46", "47", "48", "49", + "50", "51", "52", "53", "54", "55", "56", "57", "58", "59", "60", + "61", "62", "63", "64", "65", "66", "67", "68", "69", "70", "71", + "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 > Ceps <- .Machine$double.eps # ``Computer epsilon'' > x <- seq(-3, 3, len=200) > stopifnot(+ abs(cosh(x) - (exp(x) + exp(-x))/2) < 20*Ceps, + abs(sinh(x) - (exp(x) - exp(-x))/2) < 20*Ceps, + Mod(cosh(x) - cos(1i*x)) < 20*Ceps, + Mod(sinh(x) - sin(1i*x)/1i) < 20*Ceps, + abs(tanh(x)*cosh(x) - sinh(x)) < 20*Ceps + )> > stopifnot(abs(asinh(sinh(x)) - x) < 20*Ceps) > stopifnot(abs(acosh(cosh(x)) - abs(x)) < 1000*Ceps) #- imprecise for small x > stopifnot(abs(atanh(tanh(x)) - x) < 100*Ceps) > > stopifnot(abs(asinh(x) - log(x + sqrt(x^2 + 1))) < 100*Ceps) > cx <- cosh(x) > stopifnot(abs(acosh(cx) - log(cx + sqrt(cx^2 - 1))) < 1000*Ceps) > ## 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 < 2.8e-12> 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)) > 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 > > > ## 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) < .Machine$double.eps) > stopifnot(Mod(1+exp(pi*1i)) < .Machine$double.eps) > ## end of moved from Log.Rd > > > ## logistic > eps <- 100 * .Machine$double.eps > 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 * .Machine$double.eps * 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(identical(TRUE, all.equal(sum(px), 1))) + }> ## end of moved from Multinom.Rd > > > ## plot.lm > # which=4 failed in R 1.0.1 > par(mfrow=c(1,1), oma= rep(0,4)) > data(longley) > 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:4) plot(lm.fm2, which = wh) > ## end of moved from plot.lm.Rd > > > ## Poisson > dpois(c(0, 1, 0.17, 0.77), 1)[1] 0.3678794 0.3678794 0.0000000 0.0000000 Warning messages: 1: non-integer x = 0.170000 2: 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 > data(LifeCycleSavings) > 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*.Machine$double.eps) > > dim(Qc <- qr.Q(qrstr, complete=TRUE)) # Square: dim(Qc) == rep(nrow(x),2) > stopifnot((crossprod(Qc) - diag(nrow(x))) < 10*.Machine $double.eps) > > QD <- qr.Q(qrstr, D=1:p) # QD == Q \%*\% diag(1:p) > stopifnot(QD - Q %*% diag(1:p) < 8* .Machine$double.eps) > > dim(Rc <- qr.R(qrstr, complete=TRUE)) # == dim(x) > dim(Xc <- qr.X(qrstr, complete=TRUE)) # square: nrow(x) ^ 2 > 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*.Machine$double.eps) > ## 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 > data(swiss) > 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.000 0.500 0.333 0.250 0.200 ...> str(s <- svd(X))List of 3 $ d: num [1:6] 1.67e+00 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.220 ...> Eps <- 100 * .Machine$double.eps > > 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.980 0.980 -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 > > > ## trace > hasMethods <- .isMethodsDispatchOn() ## trace requires methods > f <- function(x, y) { c(x,y)} > xy <- 0 > > trace(f, quote(x <- c(1, x)), exit = quote(xy <<- x), print = FALSE)[1] "f"> > fxy <- f(2,3) > > stopifnot(identical(fxy, c(1,2,3))) > stopifnot(identical(xy, c(1,2))) > > untrace(f) > > ## a generic and its methods > > setGeneric("f")[1] "f"> > setMethod("f", c("character", "character"), function(x, y) paste(x,y))[1] "f"> > ## trace the generic > trace("f", quote(x <- c("A", x)), exit = quote(xy <<- c(x, "Z")), print = FALSE)[1] "f"> > ## should work for any method > > stopifnot(identical(f(4,5), c("A",4,5))) > stopifnot(identical(xy, c("A", 4, "Z"))) > > stopifnot(identical(f("B", "C"), paste(c("A","B"), "C"))) > stopifnot(identical(xy, c("A", "B", "Z"))) > > ## trace a method > > trace("f", sig = c("character", "character"), quote(x <- c(x, "D")),+ exit = quote(xy <<- xyy <<- c(x, "W")), print = FALSE) [1] "f"> > stopifnot(identical(f("B", "C"), paste(c("A","B","D"), "C"))) > # These two got broken by Luke's lexical scoping fix > #stopifnot(identical(xy, c("A", "B", "D", "W"))) > #stopifnot(identical(xy, xyy)) > > ## but the default method is unchanged > > stopifnot(identical(f(4,5), c("A",4,5))) > stopifnot(identical(xy, c("A", 4, "Z"))) > > removeGeneric("f")[1] TRUE> > if(!hasMethods) detach("package:methods") > ## end of moved from trace.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 * .Machine$double.eps) > stopifnot(abs(atan2(y, x) - atan(y/x)) < 10 * .Machine$double.eps) > > x <- 1:99/100 > stopifnot(Mod(1 - (cos(x) + 1i*sin(x)) / exp(1i*x)) < 10 * .Machine$double.eps) > ## error is about 650* are x=0.01 > stopifnot(abs(1 - x / acos(cos(x))) < 1000 * .Machine$double.eps) > stopifnot(abs(1 - x / asin(sin(x))) <= 10 * .Machine$double.eps) > stopifnot(abs(1 - x / atan(tan(x))) <= 10 *.Machine$double.eps) > ## 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)) }> > data(iris) > 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 * .Machine$double.eps) > ## end of moved from Wilcoxon.Rd > > > ## .Machine > (Meps <- .Machine$double.eps)[1] 2.220446e-16> ## 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)) > detach("package: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.3369 4.0562 -5.0234 <none> 5.3931 -4.1747 + b 1 0.0726 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) > ## > data(esoph) > 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(a1 == a2) > ## Comments: > # both should be 236.9645 > > ## 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(, , , )) : empty `what=' specified> 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\" = \"Sat May 3 05:55:00 2003\")"> 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.2cbind(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. > if (capabilities("libz")) {+ zz <- gzfile("t1.gz", "w") + write(1:1000, zz) + close(zz) + (sz <- file.info("t1.gz")$size) + 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", 1:10, sep="\n") > x <- try(readLines("foo", 100, ok=FALSE))Error in readLines("foo", 100, ok = FALSE) : too few lines read in readLines> unlink("foo") > 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) > testx 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(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(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 items> 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. > data(ability.cov) > 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)) > rm(ability.cov) > > > ## 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: no finite arguments to min; returning Inf 2: no finite 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; 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) > > > ## 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(pos) : detaching "package:base" is not allowed> > > ## reported by PD 2002-01-24 > Y <- matrix(rnorm(20), , 2) > fit <- manova(Y ~ 1) > fit # failedCall: 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) # failedDf 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.07600 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))$values [1] 5.3722813 -0.3722813 $vectors [,1] [,2] [1,] -0.5657675 -0.9093767 [2,] -0.8245648 0.4159736> 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(..., na.rm = na.rm) : invalid "mode" of argument> stopifnot(inherits(z, "try-error")) > z <- try(min(complex(0)))Error in min(..., na.rm = na.rm) : invalid "mode" of argument> stopifnot(inherits(z, "try-error")) > ## 1.4.1 gave +-Inf + random imaginary part > > > ## PR#1238 min/max(NULL) or (integer(0)) > z <- min(NULL)Warning message: no finite arguments to min; returning Inf> stopifnot(!is.na(z), mode(z) == "numeric", z == Inf) > z <- min(integer(0))Warning message: no finite arguments to min; returning Inf> stopifnot(!is.na(z), mode(z) == "numeric", z == Inf) > z <- max(NULL)Warning message: no finite arguments to max; returning -Inf> stopifnot(!is.na(z), mode(z) == "numeric", z == -Inf) > z <- max(integer(0))Warning message: no finite 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: no finite arguments to min; returning Inf 2: no finite arguments to max; returning -Inf 3: no finite arguments to min; returning Inf 4: no finite 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: no finite arguments to min; returning Inf 2: no finite arguments to max; returning -Inf> stopifnot(identical(rx, c(min(x), max(x))))Warning messages: 1: no finite arguments to min; returning Inf 2: no finite 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" > 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"))[1] -9.331893e+19> (d2 <- det(m2, method="qr"))[1] 0> stopifnot(d2 == 0) ## 1.4.1 gave 9.331893e+19 > (d3 <- det(m2, method="qr", tol = 1e-10))[1] -9.331893e+19> stopifnot(all.equal(d1, d3, tol=1e-3)) > > > ## PR#1422 glm start/offset bugs > if(require(MASS)) {+ data(ships, package = MASS) + ships.glm <- glm(incidents ~ type + year + period + offset(log(service)), + family = poisson, data = ships, subset = (service != 0)) + update(ships.glm, start = coef(ships.glm)) + detach("package:MASS") + } Loading required package: MASS Warning message: There is no package called 'MASS' in: library(package, char = TRUE, logical = TRUE, warn.conflicts = warn.conflicts,> ## failed in 1.4.1. > > > ## PR#1439 file.info()$isdir was only partially logical > (info <- file.info("."))size isdir mode mtime ctime atime . 2048 TRUE 755 2003-05-03 05:55:03 2003-05-03 05:55:03 2003-05-03 05:54:49 uid gid uname grname . 887 10 beebe sysstaff> 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 representationpolynomial 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) > detach("package: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: TYKHGFOTROVTAJBUYOWPRNTXVBABWOIYPNJIVBJWSRJODUXFUPYENWWAZMKKCEKIKHOEYBJZQBKLNLQDXOODTMUBVHHQYAJKLSXQXTDDELCFOKOVQKSCHPEWWMUHBLMIENAUOQMHLUPKVIPLGOGOLDQODOLLVSLNGBKAWZSVXOOHRGHSSEHJCSODZOUWWUQQHAKJKEIKTHDAUMUCCDTTZQHFUSFTWNPYYRBVMKHGKYGOFFSIDBYODOOVSOSTJHNGVKBYFKQQIDXPTXNJBWNFJFLGDBRHDZKKQXFOSKCQAFRWUDKUSPDOLTAFWCZKWXMSMZBEUOKZGNCVJUFYINCXYBMFWNAHIPGBCSYICIQLUHOBESVNOADWCGZPGPADSBQYCZASLOWOTQIKFWPTOHTOINVNFWJHUTVOAMOVSOBDRCFJWGSCUGOAUIXJZJMMAQNIPQLESTVNHLJGRYHQNPAADACMFVGMQEVLGHEPDEIEKPRVJYAPMJWBWEFWBGZRLJLURMBGGFBMGTOYCYSXPEESPIUIWPKYMCMZYLWHUUKJQWRNDPBMTTBLNHPTSDOUGSVDYTVEAWXDMMSBTKLSMZVVTCVVZBTKPVAAZTIVZFQLYZLFSOPLLPLYVFKKAJKESATLTABKQFVSXKKGJGYMBUIORHBLPZZCMKKIRHKZUIVFNEDXCWHAUJATALGMQCECVQQKLJUXQPIBPETHQDGVUBWDPMOSMZZKPILFAABTMWPEPXUNKRXXEGCUCVUYMYUWKCHSJJANDXBUWAHQUKYKLHPOBTFRNQQHFOZIIANPTYMCGWWVYQMESCLYVSDPZQHBBWJYONYCVJOICUFRLFZLAYWPHVYWDZOADAVUYJZVUQZMXKLYRAEMLZXISXRQDPHLFGQMEHSPDBZJRVGAPVJIQYPNEVFRQBYPWNGPURMMQLPAZKDWOWAWSUWNYFAIRIYUIMKUMAQGTHXWMBPPZIRYORCWNFKXMRHVG! JGYKDXJWDJ in: provoke.bug()> ## 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 > data(USArrests) > 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)Error: pweibull(seq(1, 50, len = 1001), 2, 3, log = TRUE) < 0 is not TRUE Execution halted ------------------------------------------------------------------------------- - Nelson H. F. Beebe Tel: +1 801 581 5254 - - Center for Scientific Computing FAX: +1 801 581 4148 - - University of Utah Internet e-mail: beebe@math.utah.edu - - Department of Mathematics, 110 LCB beebe@acm.org beebe@computer.org - - 155 S 1400 E RM 233 beebe@ieee.org - - Salt Lake City, UT 84112-0090, USA URL: http://www.math.utah.edu/~beebe -