[Rd] R-1.7.0 build feedback: NetBSD 1.6 (PR#2837)
beebe at math.utah.edu
beebe at math.utah.edu
Sat May 3 17:10:11 MEST 2003
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 at maths.otago.ac.nz>
> y <- ts(rnorm(24), freq=12)
> x <- ts(rnorm(24), freq=12)
> arima0(y, xreg = x, seasonal = list(order=c(0,1,0)))
Call:
arima0(x = y, seasonal = list(order = c(0, 1, 0)), xreg = x)
Coefficients:
xreg1
0.3218
s.e. 0.2260
sigma^2 estimated as 2.233: log likelihood = -21.85, aic = 47.7
> ## Comments:
>
>
> ## PR 644 (crash using fisher.test on Windows)
> ## By: Uwe Ligges <ligges at statistik.uni-dortmund.de>
> x <- matrix(c(2, 2, 4, 8, 6, 0, 1, 1, 7, 8, 1, 3, 1, 3, 7, 4, 2, 2, 2,
+ 1, 1, 0, 0, 0, 0, 0, 1, 1, 2, 0, 1, 1, 0, 2, 1, 0, 0, 0),
+ nc = 2)
> fisher.test(x)
Fisher's Exact Test for Count Data
data: x
p-value = 0.7178
alternative hypothesis: two.sided
> ## Comments: (wasn't just on Windows)
>
> ## PR 653 (extrapolation in spline)
> ## By: Ian White <imsw at holyrood.ed.ac.uk>
> x <- c(2,5,8,10)
> y <- c(1.2266,-1.7606,-0.5051,1.0390)
> fn <- splinefun(x, y, method="natural")
> xx1 <- fn(0:12)
> # should be the same if reflected
> fn <- splinefun(rev(-x),rev(y),method="natural")
> xx2 <- fn(0:-12)
> stopifnot(all.equal(xx1, xx2))
> # should be the same as interpSpline
> library(splines)
> xx3 <- predict(interpSpline(x, y), 0:12)
> stopifnot(all.equal(xx1, xx3$y))
> 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.2
cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4),
log(inflowd5), log(inflowd6)) ~ precip * I(Tmax^2)
attr(,"variables")
list(cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4),
log(inflowd5), log(inflowd6)), precip, I(Tmax^2))
attr(,"factors")
precip
cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) 0
precip 1
I(Tmax^2) 0
I(Tmax^2)
cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) 0
precip 0
I(Tmax^2) 1
precip:I(Tmax^2)
cbind(log(inflowd1), log(inflowd2), log(inflowd3), log(inflowd4), log(inflowd5), log(inflowd6)) 0
precip 1
I(Tmax^2) 1
attr(,"term.labels")
[1] "precip" "I(Tmax^2)" "precip:I(Tmax^2)"
attr(,"order")
[1] 1 1 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
>
>
> ## PR 881 Incorrect values in non-central chisq values on Linux, 2001-03-21
> x <- dchisq(c(7.1, 7.2, 7.3), df=2, ncp=20)
> stopifnot(diff(x) > 0)
> ## on 1.2.2 on RH6.2 i686 Linux x = 0.01140512 0.00804528 0.01210514
>
>
> ## PR 882 eigen segfaults on 0-diml matrices, 2001-03-23
> m <- matrix(1, 0, 0) # 1 to force numeric not logical
> try(eigen(m))
Error in eigen(m) : 0 x 0 matrix
> ## segfaults on 1.2.2
>
>
> ## 1.3.0 had poor compression on gzfile() with lots of small pieces.
> 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)
> test
x y
a 1 11
b 2 12
c 3 13
d 4 14
e 5 15
f 6 16
g 7 17
h 8 18
i 9 19
j 10 20
> ## error in 1.3.0 in test[]
>
>
> ## PR 1048 bug in dummy.coef.lm, Adrian Baddeley, 2001-08-10
> ## modified to give a sensible test
> old <- getOption("contrasts")
> options(contrasts=c("contr.helmert", "contr.poly"))
> DF <- data.frame(x=1:20,y=rnorm(20),z=factor(1:20 <= 10))
> dummy.coef.lm(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 at stat.umn.edu,
> ## 2001-10-25).
> ## Example 5.4 in Hollander and Wolfe (Nonparametric Statistical
> ## Methods, 2nd ed., Wiley, 1999, pp. 180-181).
> x <- c(-0.15, 8.6, 5, 3.71, 4.29, 7.74, 2.48, 3.25, -1.15, 8.38)
> y <- c(2.55, 12.07, 0.46, 0.35, 2.69, -0.94, 1.73, 0.73, -0.35, -0.37)
> stopifnot(round(ks.test(x, y)$p.value, 4) == 0.0524)
>
>
> ## PR 1150. Wilcoxon rank sum and signed rank tests did not return the
> ## Hodges-Lehmann estimators of the associated confidence interval
> ## (Charles Geyer, charlie at stat.umn.edu, 2001-10-25).
> ## One-sample test: Example 3.1 in Hollander & Wolfe (1973), 29f.
> x <- c(1.83, 0.50, 1.62, 2.48, 1.68, 1.88, 1.55, 3.06, 1.30)
> y <- c(0.878, 0.647, 0.598, 2.05, 1.06, 1.29, 1.06, 3.14, 1.29)
> we <- wilcox.test(y, x, paired = TRUE, conf.int = TRUE)
> ## NOTE order: y then x.
> ## Results from Hollander & Wolfe (1999), 2nd edition, page 40 and 53
> stopifnot(round(we$p.value,4) == 0.0391)
> stopifnot(round(we$conf.int,3) == c(-0.786, -0.010))
> stopifnot(round(we$estimate,3) == -0.46)
> ## Two-sample test: Example 4.1 in Hollander & Wolfe (1973), 69f.
> x <- c(0.80, 0.83, 1.89, 1.04, 1.45, 1.38, 1.91, 1.64, 0.73, 1.46)
> y <- c(1.15, 0.88, 0.90, 0.74, 1.21)
> we <- wilcox.test(y, x, conf.int = TRUE)
> ## NOTE order: y then x.
> ## Results from Hollander & Wolfe (1999), 2nd edition, page 111 and 126
> stopifnot(round(we$p.value,4) == 0.2544)
> stopifnot(round(we$conf.int,3) == c(-0.76, 0.15))
> stopifnot(round(we$estimate,3) == -0.305)
>
>
> ## range gave wrong length result for R < 1.4.0
> stopifnot(length(range(numeric(0))) == 2)
Warning messages:
1: 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 at stat.berkeley.edu, 2001-11-06>
> x2 <- c(0, 0.002242152, 0.004484305, 0.006726457, 0.00896861,
+ 0.01121076, 0.01345291, 0.01569507, 0.01793722, 0.02017937,
+ 0.02242152, 0.02466368, 0.02690583, 0.02914798, 0.03139013,
+ 0.03363229, 0.03587444, 0.03811659, 0.04035874, 0.04932735,
+ 0.05156951, 0.05381166)
> z <- c(0, 0.067, NA, 0.167, 0.083, 0.05, 0.067, NA, 0, 0.1, 0, 0.05,
+ 0.067, 0.067, 0.016, 0.117, 0.017, -0.017, 0.2, 0.35, 0.134, 0.15)
> image(x2, 1, as.matrix(z))
> ## Comments: failed under R 1.3.1.
>
>
> ##PR 1175 and 1123##
> set.seed(123)
> ## We can't seem to get Pearson residuals right ##
> x <- 1:4 # regressor variable
> y <- c(2,6,7,8) # response binomial counts
> n <- rep(10,4) # number of binomial trials
> ym <- cbind(y,n-y) # response variable as a matrix
> glm1 <- glm(ym~x,binomial) # fit a generalized linear model
> f <- fitted(glm1)
> rp1 <- (y-n*f)/sqrt(n*f*(1-f)) # direct calculation of pearson residuals
> rp2 <- residuals(glm1,type="pearson") # should be pearson residuals
> stopifnot(all.equal(rp1,rp2))
> # sign should be same as response residuals
> x <- 1:10
> y <- rgamma(10,2)/x
> glm2 <- glm(y~x,family=Gamma)
> stopifnot(all.equal(sign(resid(glm2,"response")),sign(resid(glm2,"pearson"))))
> # shouldn't depend on link for a saturated model
> x<-rep(0:1,10)
> y<-rep(c(0,1,1,0,1),4)
> glm3<-glm(y~x,family=binomial(),control=glm.control(eps=1e-8))
> glm4<-glm(y~x,family=binomial("log"),control=glm.control(eps=1e-8))
> stopifnot(all.equal(resid(glm3,"pearson"),resid(glm4,"pearson")))
>
>
> ## Torsten Hothorn, 2001-12-04
> stopifnot(pt(-Inf, 3, ncp=0) == 0, pt(Inf, 3, ncp=0) == 1)
> ## Comments: were 0.5 in 1.3.1
>
>
> ## Paul Gilbert, 2001-12-07
> cancor(matrix(rnorm(100),100,1), matrix(rnorm(300),100,3))
$cor
[1] 0.09057181
$xcoef
[,1]
[1,] 0.1117289
$ycoef
[,1] [,2] [,3]
[1,] -0.07465770 -0.04311967 -0.052752879
[2,] -0.04302592 0.09307937 -0.009990484
[3,] -0.05409998 -0.01244767 0.084752170
$xcenter
[1] 0.02784576
$ycenter
[1] -0.03353540 0.08536240 -0.05617746
> ## Comments: failed in R-devel.
>
>
> ## PR#1201: incorrect values in qbeta
> x <- seq(0, 0.8, len=1000)
> xx <- pbeta(qbeta(x, 0.143891, 0.05), 0.143891, 0.05)
> stopifnot(max(abs(x - xx)) < 1e-6)
> ## Comments: Get a range of zeroes in 1.3.1
>
>
> ## PR#1216: binomial null model
> y <- rbinom(20, 1, 0.5)
> glm(y ~ 0, family = binomial)
Call: glm(formula = y ~ 0, family = binomial)
No coefficients
Degrees of Freedom: 20 Total; 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 # failed
Call:
manova(Y ~ 1)
Terms:
Residuals
resp 1 12.10603
resp 2 11.86833
Deg. of Freedom 9
Residual standard error: 1.159790 1.148348
> print(fit, intercept = TRUE)
Call:
manova(Y ~ 1)
Terms:
(Intercept) Residuals
resp 1 0.912842 12.106025
resp 2 0.303404 11.868328
Deg. of Freedom 1 9
Residual standard error: 1.159790 1.148348
Estimated effects are balanced
> summary(fit) # failed
Df Pillai approx F num Df den Df Pr(>F)
Residuals 9
> summary(fit, intercept = TRUE)
Df Pillai approx F num Df den Df Pr(>F)
(Intercept) 1 0.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 representation
polynomial representation of spline for y ~ x
constant linear quadratic cubic
1 3 -0.8360656 0.0000000 -0.1639344
2 2 -1.3278689 -0.4918033 0.8196721
3 1 0.1475410 1.9672131 -0.5204918
5 5 1.7704918 -1.1557377 0.3852459
6 6 0.6147541 0.0000000 0.0000000
> (isB <- interpSpline(x,y, bSpl = TRUE))# B-spline repr.
bSpline representation of spline for y ~ x
-3 -2 -1 1 2 3 5
NA NA NA NA 4.3934426 3.2786885 2.1639344
6 7 9 10
-0.2622951 5.1803279 6.0000000 6.8196721
> xo <- c(0, x, 10)# x + outside points
> op <- options(digits = 4)
> for(der in 0:3) # deriv=3 fails!
+ print(formatC(try(predict(isP, xo, deriv = der)$y), wid=7,format="f"),
+ quote = FALSE)
[1] 3.8361 3.0000 2.0000 1.0000 5.0000 6.0000 8.4590
[1] -0.8361 -0.8361 -1.3279 0.1475 1.7705 0.6148 0.6148
[1] 0.0000 0.0000 -0.9836 3.9344 -2.3115 0.0000 0.0000
[1] 0.0000 -0.9836 -0.9836 4.9180 -3.1230 2.3115 0.0000
> ## and for B-spline (instead of polynomial):
> for(der in 0:3) # deriv=3 failed
+ print(formatC(try(predict(isB, xo, deriv = der)$y), wid=7,format="f"),
+ quote = FALSE)
[1] 3.8361 3.0000 2.0000 1.0000 5.0000 6.0000 8.4590
[1] -0.8361 -0.8361 -1.3279 0.1475 1.7705 0.6148 0.6148
[1] 0.0000 0.0000 -0.9836 3.9344 -2.3115 0.0000 0.0000
[1] 0.0000 -0.9836 4.9180 -3.1230 2.3115 0.0000 0.0000
> options(op)
> 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 at math.utah.edu -
- Department of Mathematics, 110 LCB beebe at acm.org beebe at computer.org -
- 155 S 1400 E RM 233 beebe at ieee.org -
- Salt Lake City, UT 84112-0090, USA URL: http://www.math.utah.edu/~beebe -
More information about the R-devel
mailing list