The R Project SVN R

## Regression tests for which the printed output is the issue
### _and_ must work (no Recommended packages, please)

postscript("reg-tests-2.ps")
RNGversion("1.6.2")

### moved from various .Rd files
## abbreviate
data(state)
for(m in 1:5) {
  cat("\n",m,":\n")
  print(as.vector(abbreviate(state.name, minl=m)))
}

## apply
x <- cbind(x1 = 3, x2 = c(4:1, 2:5))
dimnames(x)[[1]] <- letters[1:8]
apply(x,  2, summary) # 6 x n matrix
apply(x,  1, quantile)# 5 x n matrix

d.arr <- 2:5
arr <- array(1:prod(d.arr), d.arr,
         list(NULL,letters[1:d.arr[2]],NULL,paste("V",4+1:d.arr[4],sep="")))
aa <- array(1:20,c(2,2,5))
str(apply(aa[FALSE,,,drop=FALSE], 1, dim))# empty integer, `incorrect' dim.
stopifnot(
       apply(arr, 1:2, sum) == t(apply(arr, 2:1, sum)),
       aa == apply(aa,2:3,function(x) x),
       all.equal(apply(apply(aa,2:3, sum),2,sum),
                 10+16*0:4, tol=4*.Machine$double.eps)
)
marg <- list(1:2, 2:3, c(2,4), c(1,3), 2:4, 1:3, 1:4)
for(m in marg) print(apply(arr, print(m), sum))
for(m in marg) ## 75% of the time here was spent on the names
  print(dim(apply(arr, print(m), quantile, names=FALSE)) == c(5,d.arr[m]))

## Bessel
nus <- c(0:5,10,20)

x0 <- 2^(-20:10)
plot(x0,x0, log='xy', ylab="", ylim=c(.1,1e60),type='n',
     main = "Bessel Functions -Y_nu(x)  near 0\n log - log  scale")
for(nu in sort(c(nus,nus+.5))) lines(x0, -besselY(x0,nu=nu), col = nu+2)
legend(3,1e50, leg=paste("nu=", paste(nus,nus+.5, sep=",")), col=nus+2, lwd=1)

x <- seq(3,500);yl <- c(-.3, .2)
plot(x,x, ylim = yl, ylab="",type='n', main = "Bessel Functions  Y_nu(x)")
for(nu in nus){xx <- x[x > .6*nu]; lines(xx,besselY(xx,nu=nu), col = nu+2)}
legend(300,-.08, leg=paste("nu=",nus), col = nus+2, lwd=1)

x <- seq(10,50000,by=10);yl <- c(-.1, .1)
plot(x,x, ylim = yl, ylab="",type='n', main = "Bessel Functions  Y_nu(x)")
for(nu in nus){xx <- x[x > .6*nu]; lines(xx,besselY(xx,nu=nu), col = nu+2)}
summary(bY <- besselY(2,nu = nu <- seq(0,100,len=501)))
which(bY >= 0)
summary(bY <- besselY(2,nu = nu <- seq(3,300,len=51)))
summary(bI <- besselI(x = x <- 10:700, 1))
## end of moved from Bessel.Rd

## data.frame
set.seed(123)
L3 <- LETTERS[1:3]
str(d <- data.frame(cbind(x=1, y=1:10), fac=sample(L3, 10, repl=TRUE)))
(d0  <- d[, FALSE]) # NULL dataframe with 10 rows
(d.0 <- d[FALSE, ]) # <0 rows> dataframe  (3 cols)
(d00 <- d0[FALSE,])  # NULL dataframe with 0 rows
(d000 <- data.frame()) #but not quite the same as d00:
!identical(d00, d000)
dput(d00)
dput(d000)
stopifnot(identical(d, cbind(d, d0)),
          identical(d, cbind(d0, d)),
          identical(d, rbind(d,d.0)),
          identical(d, rbind(d.0,d)),
          identical(d, rbind(d00,d)),
          identical(d, rbind(d,d00)),

          TRUE )
## Comments: failed before ver. 1.4.0

## diag
diag(array(1:4, dim=5))
## test behaviour with 0 rows or columns
diag(0)
z <- matrix(0, 0, 4)
diag(z)
diag(z) <- numeric(0)
z
## end of moved from diag.Rd

## format
## handling of quotes
zz <- data.frame(a=I("abc"), b=I("def\"gh"))
format(zz)
## " (E fontification)

## printing more than 16 is platform-dependent
for(i in c(1:5,10,15,16)) cat(i,":\t",format(pi,digits=i),"\n")

p <- c(47,13,2,.1,.023,.0045, 1e-100)/1000
format.pval(p)
format.pval(p / 0.9)
format.pval(p / 0.9, dig=3)
## end of moved from format.Rd


## is.finite
x <- c(100,-1e-13,Inf,-Inf, NaN, pi, NA)
x #  1.000000 -3.000000       Inf      -Inf        NA  3.141593        NA
names(x) <- formatC(x, dig=3)
is.finite(x)
##-   100 -1e-13 Inf -Inf NaN 3.14 NA
##-     T      T   .    .   .    T  .
is.na(x)
##-   100 -1e-13 Inf -Inf NaN 3.14 NA
##-     .      .   .    .   T    .  T
which(is.na(x) & !is.nan(x))# only 'NA': 7

is.na(x) | is.finite(x)
##-   100 -1e-13 Inf -Inf NaN 3.14 NA
##-     T      T   .    .   T    T  T
is.infinite(x)
##-   100 -1e-13 Inf -Inf NaN 3.14 NA
##-     .      .   T    T   .    .  .

##-- either  finite or infinite  or  NA:
all(is.na(x) != is.finite(x) | is.infinite(x)) # TRUE
all(is.nan(x) != is.finite(x) | is.infinite(x)) # FALSE: have 'real' NA

##--- Integer
(ix <- structure(as.integer(x),names= names(x)))
##-   100 -1e-13    Inf   -Inf    NaN   3.14     NA
##-   100      0     NA     NA     NA      3     NA
all(is.na(ix) != is.finite(ix) | is.infinite(ix)) # TRUE (still)

storage.mode(ii <- -3:5)
storage.mode(zm <- outer(ii,ii, FUN="*"))# integer
storage.mode(zd <- outer(ii,ii, FUN="/"))# double
range(zd, na.rm=TRUE)# -Inf  Inf
zd[,ii==0]

(storage.mode(print(1:1 / 0:0)))# Inf "double"
(storage.mode(print(1:1 / 1:1)))# 1 "double"
(storage.mode(print(1:1 + 1:1)))# 2 "integer"
(storage.mode(print(2:2 * 2:2)))# 4 "integer"
## end of moved from is.finite.Rd


## kronecker
fred <- matrix(1:12, 3, 4, dimnames=list(LETTERS[1:3], LETTERS[4:7]))
bill <- c("happy" = 100, "sad" = 1000)
kronecker(fred, bill, make.dimnames = TRUE)

bill <- outer(bill, c("cat"=3, "dog"=4))
kronecker(fred, bill, make.dimnames = TRUE)

# dimnames are hard work: let's test them thoroughly

dimnames(bill) <- NULL
kronecker(fred, bill, make=TRUE)
kronecker(bill, fred, make=TRUE)

dim(bill) <- c(2, 2, 1)
dimnames(bill) <- list(c("happy", "sad"), NULL, "")
kronecker(fred, bill, make=TRUE)

bill <- array(1:24, c(3, 4, 2))
dimnames(bill) <- list(NULL, NULL, c("happy", "sad"))
kronecker(bill, fred, make=TRUE)
kronecker(fred, bill, make=TRUE)

fred <- outer(fred, c("frequentist"=4, "bayesian"=4000))
kronecker(fred, bill, make=TRUE)
## end of moved from kronecker.Rd

## merge
authors <- data.frame(
    surname = c("Tukey", "Venables", "Tierney", "Ripley", "McNeil"),
    nationality = c("US", "Australia", "US", "UK", "Australia"),
    deceased = c("yes", rep("no", 4)))
books <- data.frame(
    name = c("Tukey", "Venables", "Tierney",
             "Ripley", "Ripley", "McNeil", "R Core"),
    title = c("Exploratory Data Analysis",
              "Modern Applied Statistics ...",
              "LISP-STAT",
              "Spatial Statistics", "Stochastic Simulation",
              "Interactive Data Analysis",
              "An Introduction to R"),
    other.author = c(NA, "Ripley", NA, NA, NA, NA,
                     "Venables & Smith"))
b2 <- books; names(b2)[1] <- names(authors)[1]

merge(authors, b2, all.x = TRUE)
merge(authors, b2, all.y = TRUE)

## empty d.f. :
merge(authors, b2[7,])

merge(authors, b2[7,], all.y = TRUE)
merge(authors, b2[7,], all.x = TRUE)
## end of moved from merge.Rd

## NA
is.na(c(1,NA))
is.na(paste(c(1,NA)))
is.na(list())# logical(0)
ll <- list(pi,"C",NaN,Inf, 1:3, c(0,NA), NA)
is.na (ll)
is.nan(ll)
## end of moved from NA.Rd

## scale
## test out NA handling
tm <- matrix(c(2,1,0,1,0,NA,NA,NA,0), nrow=3)
scale(tm, , FALSE)
scale(tm)
## end of moved from scale.Rd

## tabulate
tabulate(numeric(0))
## end of moved from tabulate.Rd

## ts
# Ensure working arithmetic for `ts' objects :
stopifnot(z == z)
stopifnot(z-z == 0)

ts(1:5, start=2, end=4) # truncate
ts(1:5, start=3, end=17)# repeat
## end of moved from ts.Rd

### end of moved


## PR 715 (Printing list elements w/attributes)
##
l <- list(a=10)
attr(l$a, "xx") <- 23
l
## Comments:
## should print as
# $a:
# [1] 10
# attr($a, "xx"):
# [1] 23

## On the other hand
m <- matrix(c(1, 2, 3, 0, 10, NA), 3, 2)
na.omit(m)
## should print as
#      [,1] [,2]
# [1,]    1    0
# [2,]    2   10
# attr(,"na.action")
# [1] 3
# attr(,"na.action")
# [1] "omit"

## and
x <- 1
attr(x, "foo") <- list(a="a")
x
## should print as
# [1] 1
# attr(,"foo")
# attr(,"foo")$a
# [1] "a"


## PR 746 (printing of lists)
##
test.list <- list(A = list(formula=Y~X, subset=TRUE),
                  B = list(formula=Y~X, subset=TRUE))

test.list
## Comments:
## should print as
# $A
# $A$formula
# Y ~ X
#
# $A$subset
# [1] TRUE
#
#
# $B
# $B$formula
# Y ~ X
#
# $B$subset
# [1] TRUE

## Marc Feldesman 2001-Feb-01.  Precision in summary.data.frame & *.matrix
data(attenu)
summary(attenu)
summary(attenu, digits = 5)
summary(data.matrix(attenu), digits = 5)# the same for matrix
## Comments:
## No difference between these in 1.2.1 and earlier
set.seed(1)
x <- c(round(runif(10), 2), 10000)
summary(x)
summary(data.frame(x))
## Comments:
## All entries show all 3 digits after the decimal point now.

## Chong Gu 2001-Feb-16.  step on binomials
"detg1" <-
structure(list(Temp = structure(c(2, 1, 2, 1, 2, 1, 2, 1, 2,
1, 2, 1), .Label = c("High", "Low"), class = "factor"), M.user = structure(c(1,
1, 2, 2, 1, 1, 2, 2, 1, 1, 2, 2), .Label = c("N", "Y"), class = "factor"),
    Soft = structure(c(1, 1, 1, 1, 2, 2, 2, 2, 3, 3, 3, 3), .Label = c("Hard",
    "Medium", "Soft"), class = "factor"), M = c(42, 30, 52, 43,
    50, 23, 55, 47, 53, 27, 49, 29), X = c(68, 42, 37, 24, 66,
    33, 47, 23, 63, 29, 57, 19)), .Names = c("Temp", "M.user",
"Soft", "M", "X"), class = "data.frame", row.names = c("1", "3",
"5", "7", "9", "11", "13", "15", "17", "19", "21", "23"))
detg1.m0 <- glm(cbind(X,M)~1,binomial,detg1)
detg1.m0
step(detg1.m0,scope=list(upper=~M.user*Temp*Soft))

## PR 829 (empty values in all.vars)
## This example by Uwe Ligges <ligges@statistik.uni-dortmund.de>

temp <- matrix(1:4, 2)
all.vars(temp ~ 3) # OK
all.vars(temp[1, ] ~ 3) # wrong in 1.2.1

## 2001-Feb-22 from David Scott.
## rank-deficient residuals in a manova model.
gofX.df<-
  structure(list(A = c(0.696706709347165, 0.362357754476673,
-0.0291995223012888,
0.696706709347165, 0.696706709347165, -0.0291995223012888, 0.696706709347165,
-0.0291995223012888, 0.362357754476673, 0.696706709347165, -0.0291995223012888,
0.362357754476673, -0.416146836547142, 0.362357754476673, 0.696706709347165,
0.696706709347165, 0.362357754476673, -0.416146836547142, -0.0291995223012888,
-0.416146836547142, 0.696706709347165, -0.416146836547142, 0.362357754476673,
-0.0291995223012888), B = c(0.717356090899523, 0.932039085967226,
0.999573603041505, 0.717356090899523, 0.717356090899523, 0.999573603041505,
0.717356090899523, 0.999573603041505, 0.932039085967226, 0.717356090899523,
0.999573603041505, 0.932039085967226, 0.909297426825682, 0.932039085967226,
0.717356090899523, 0.717356090899523, 0.932039085967226, 0.909297426825682,
0.999573603041505, 0.909297426825682, 0.717356090899523, 0.909297426825682,
0.932039085967226, 0.999573603041505), C = c(-0.0291995223012888,
-0.737393715541246, -0.998294775794753, -0.0291995223012888,
-0.0291995223012888, -0.998294775794753, -0.0291995223012888,
-0.998294775794753, -0.737393715541246, -0.0291995223012888,
-0.998294775794753, -0.737393715541246, -0.653643620863612, -0.737393715541246,
-0.0291995223012888, -0.0291995223012888, -0.737393715541246,
-0.653643620863612, -0.998294775794753, -0.653643620863612,
-0.0291995223012888,
-0.653643620863612, -0.737393715541246, -0.998294775794753),
    D = c(0.999573603041505, 0.67546318055115, -0.0583741434275801,
    0.999573603041505, 0.999573603041505, -0.0583741434275801,
    0.999573603041505, -0.0583741434275801, 0.67546318055115,
    0.999573603041505, -0.0583741434275801, 0.67546318055115,
    -0.756802495307928, 0.67546318055115, 0.999573603041505,
    0.999573603041505, 0.67546318055115, -0.756802495307928,
    -0.0583741434275801, -0.756802495307928, 0.999573603041505,
    -0.756802495307928, 0.67546318055115, -0.0583741434275801
    ), groups = structure(c(1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 2,
    2, 2, 2, 2, 2, 3, 3, 3, 3, 3, 3, 3, 3), class = "factor", .Label = c("1",
    "2", "3"))), .Names = c("A", "B", "C", "D", "groups"), 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"
), class = "data.frame")

gofX.manova <- manova(formula = cbind(A, B, C, D) ~ groups, data = gofX.df)
try(summary(gofX.manova))
## should fail with an error message `residuals have rank 3 < 4'

## Prior to 1.3.0 dist did not handle missing values, and the
## internal C code was incorrectly scaling for missing values.
data(trees)
z <- as.matrix(t(trees))
z[1,1] <- z[2,2] <- z[3,3] <- z[2,4] <- NA
dist(z, method="euclidean")
dist(z, method="maximum")
dist(z, method="manhattan")
dist(z, method="canberra")

## F. Tusell 2001-03-07.  printing kernels.
kernel("daniell", m=5)
kernel("modified.daniell", m=5)
kernel("daniell", m=c(3,5,7))
## fixed by patch from Adrian Trapletti 2001-03-08

## Start new year (i.e. line) at Jan:
(tt <- ts(1:10, start = c(1920,7), end = c(1921,4), freq = 12))
cbind(tt, tt + 1)


## PR 883 (cor(x,y) when is.null(y))
try(cov(rnorm(10), NULL))
try(cor(rnorm(10), NULL))
## gave the variance and 1 respectively in 1.2.2.
try(var(NULL))
try(var(numeric(0)))
## gave NA in 1.2.2


## PR 960 (format() of a character matrix converts to vector)
## example from <John.Peters@tip.csiro.au>
a <- matrix(c("axx","b","c","d","e","f","g","h"), nrow=2)
format(a)
format(a, justify="right")
## lost dimensions in 1.2.3


## PR 963
res <- svd(rbind(1:7))## $v lost dimensions in 1.2.3
if(res$u[1,1] < 0) {res$u <- -res$u; res$v <- -res$v}
res


## Make sure  on.exit() keeps being evaluated in the proper env [from PD]:
## A more complete example:
g1 <- function(fitted) { on.exit(remove(fitted)); return(function(foo) foo) }
g2 <- function(fitted) { on.exit(remove(fitted));        function(foo) foo }
f <- function(g) { fitted <- 1; h <- g(fitted); print(fitted)
                   ls(envir=environment(h)) }
f(g1)
f(g2)

f2 <- function()
{
  g.foo <- g1
  g.bar <- g2
  g <- function(x,...) UseMethod("g")
  fitted <- 1; class(fitted) <- "foo"
  h <- g(fitted); print(fitted); print(ls(envir=environment(h)))
  fitted <- 1; class(fitted) <- "bar"
  h <- g(fitted); print(fitted); print(ls(envir=environment(h)))
  invisible(NULL)
}
f2()
## The first case in f2() is broken in 1.3.0(-patched).

## on.exit() consistency check from Luke:
g <- function() as.environment(-1)
f <- function(x) UseMethod("f")
f.foo <- function(x) { on.exit(e <<- g()); NULL }
f.bar <- function(x) { on.exit(e <<- g()); return(NULL) }
f(structure(1,class = "foo"))
ls(env = e)# only "x", i.e. *not* the GlobalEnv
f(structure(1,class = "bar"))
stopifnot("x" == ls(env = e))# as above; wrongly was .GlobalEnv in R 1.3.x


## some tests that R supports logical variables in formulae
## it coerced them to numeric prior to 1.4.0
## they should appear like 2-level factors, following S

oldCon <- options("contrasts")
y <- rnorm(10)
x <- rep(c(TRUE, FALSE), 5)
model.matrix(y ~ x)
lm(y ~ x)
DF <- data.frame(x, y)
lm(y ~ x, data=DF)
options(contrasts=c("contr.helmert", "contr.poly"))
model.matrix(y ~ x)
lm(y ~ x, data=DF)
z <- 1:10
lm(y ~ x*z)
lm(y ~ x*z - 1)
options(oldCon)

## diffinv, Adrian Trapletti, 2001-08-27
x <- ts(1:10)
diffinv(diff(x),xi=x[1])
diffinv(diff(x,lag=1,differences=2),lag=1,differences=2,xi=x[1:2])
## last had wrong start and end

## PR#1072  (Reading Inf and NaN values)
as.numeric(as.character(NaN))
as.numeric(as.character(Inf))
## were NA on Windows at least under 1.3.0.

## PR#1092 (rowsum dimnames)
rowsum(matrix(1:12, 3,4), c("Y","X","Y"))
## rownames were 1,2 in <= 1.3.1.

## PR#1115 (saving strings with ascii=TRUE)
x <- y <- unlist(as.list(
    parse(text=paste("\"\\",
          as.character(structure(0:255,class="octmode")),
             "\"",sep=""))))
save(x, ascii=T, file=(fn <- tempfile()))
load(fn)
all(x==y)
unlink(fn)
## 1.3.1 had trouble with \


## Some tests of sink() and connections()
## capture all the output to a file.
zz <- file("all.Rout", open="wt")
sink(zz)
sink(zz, type="message")
try(log("a"))
## back to the console
sink(type="message")
sink()
try(log("a"))

## capture all the output to a file.
zz <- file("all.Rout", open="wt")
sink(zz)
sink(zz, type="message")
try(log("a"))

## bail out
closeAllConnections()
(foo <- showConnections())
stopifnot(nrow(foo) == 0)
try(log("a"))
unlink("all.Rout")
## many of these were untested before 1.4.0.


## test mean() works on logical but not factor
x <- c(TRUE, FALSE, TRUE, TRUE)
mean(x)
mean(as.factor(x))
## last had confusing error message in 1.3.1.


## Kurt Hornik 2001-Nov-13
z <- table(x = 1:2, y = 1:2)
z - 1
unclass(z - 1)
## lost object bit prior to 1.4.0, so printed class attribute.


## PR#1226  (predict.mlm ignored newdata)
ctl <- c(4.17,5.58,5.18,6.11,4.50,4.61,5.17,4.53,5.33,5.14)
trt <- c(4.81,4.17,4.41,3.59,5.87,3.83,6.03,4.89,4.32,4.69)
group <- gl(2,10,20, labels = c("Ctl","Trt"))
weight <- c(ctl, trt)
data <- data.frame(weight, group)
fit <- lm(cbind(w=weight, w2=weight^2) ~ group, data=data)
predict(fit, newdata=data[1:2, ])
## was 20 rows in R <= 1.4.0


## Chong Gu 2002-Feb-8: `.' not expanded in drop1
data(HairEyeColor)
lab <- dimnames(HairEyeColor)
HairEye <- cbind(expand.grid(Hair=lab$Hair, Eye=lab$Eye, Sex=lab$Sex),
                 Fr=as.vector(HairEyeColor))
HairEye.fit <- glm(Fr ~ . ^2, poisson, HairEye)
drop1(HairEye.fit)
## broken around 1.2.1 it seems.


## PR#1329  (subscripting matrix lists)
m <- list(a1=1:3, a2=4:6, a3=pi, a4=c("a","b","c"))
dim(m) <- c(2,2)
m
m[,2]
m[2,2]
## 1.4.1 returned null components: the case was missing from a switch.

m <- list(a1=1:3, a2=4:6, a3=pi, a4=c("a","b","c"))
matrix(m, 2, 2)
## 1.4.1 gave `Unimplemented feature in copyVector'

x <- vector("list",6)
dim(x) <- c(2,3)
x[1,2] <- list(letters[10:11])
x
## 1.4.1 gave `incompatible types in subset assignment'


## printing of matrix lists
m <- list(as.integer(1), pi, 3+5i, "testit", TRUE, factor("foo"))
dim(m) <- c(1, 6)
m
## prior to 1.5.0 had quotes for 2D case (but not kD, k > 2),
## gave "numeric,1" etc, (even "numeric,1" for integers and factors)


## ensure RNG is unaltered.
for(type in c("Wichmann-Hill", "Marsaglia-Multicarry", "Super-Duper",
              "Mersenne-Twister", "Knuth-TAOCP", "Knuth-TAOCP-2002"))
{
    set.seed(123, type)
    print(RNGkind())
    runif(100); print(runif(4))
    set.seed(1000, type)
    runif(100); print(runif(4))
    set.seed(77, type)
    runif(100); print(runif(4))
}
RNGkind(normal.kind = "Kinderman-Ramage")
set.seed(123)
RNGkind()
rnorm(4)
RNGkind(normal.kind = "Ahrens-Dieter")
set.seed(123)
RNGkind()
rnorm(4)
RNGkind(normal.kind = "Box-Muller")
set.seed(123)
RNGkind()
rnorm(4)
set.seed(123)
runif(4)
set.seed(123, "default")
set.seed(123, "Marsaglia-Multicarry") ## Careful, not the default anymore
runif(4)
## last set.seed failed < 1.5.0.


## merging, ggrothendieck@yifan.net, 2002-03-16
d.df <- data.frame(x = 1:3, y = c("A","D","E"), z = c(6,9,10))
merge(d.df[1,], d.df)
## 1.4.1 got confused by inconsistencies in as.character


## PR#1394 (levels<-.factor)
f <- factor(c("a","b"))
levels(f) <- list(C="C", A="a", B="b")
f
## was  [1] C A; Levels:  C A  in 1.4.1


## PR#1408 Inconsistencies in sum()
x <- as.integer(2^30)
sum(x, x)    # did not warn in 1.4.1
sum(c(x, x)) # did warn
(z <- sum(x, x, 0.0)) # was NA in 1.4.1
typeof(z)


## NA levels in factors
(x <- factor(c("a", "NA", "b"), exclude=NULL))
## 1.4.1 had wrong order for levels
is.na(x)[3] <- TRUE
x
## missing entry prints as <NA>


## printing/formatting NA strings
(x <- c("a", "NA", NA, "b"))
print(x, quote = FALSE)
paste(x)
format(x)
format(x, justify = "right")
format(x, justify = "none")
## not ideal.


## print.ts problems  ggrothendieck@yifan.net on R-help, 2002-04-01
x <- 1:20
tt1 <- ts(x,start=c(1960,2), freq=12)
tt2 <- ts(10+x,start=c(1960,2), freq=12)
cbind(tt1, tt2)
## 1.4.1 had `Jan 1961' as `NA 1961'

## glm boundary bugs (related to PR#1331)
x <- c(0.35, 0.64, 0.12, 1.66, 1.52, 0.23, -1.99, 0.42, 1.86, -0.02,
       -1.64, -0.46, -0.1, 1.25, 0.37, 0.31, 1.11, 1.65, 0.33, 0.89,
       -0.25, -0.87, -0.22, 0.71, -2.26, 0.77, -0.05, 0.32, -0.64, 0.39,
       0.19, -1.62, 0.37, 0.02, 0.97, -2.62, 0.15, 1.55, -1.41, -2.35,
       -0.43, 0.57, -0.66, -0.08, 0.02, 0.24, -0.33, -0.03, -1.13, 0.32,
       1.55, 2.13, -0.1, -0.32, -0.67, 1.44, 0.04, -1.1, -0.95, -0.19,
       -0.68, -0.43, -0.84, 0.69, -0.65, 0.71, 0.19, 0.45, 0.45, -1.19,
       1.3, 0.14, -0.36, -0.5, -0.47, -1.31, -1.02, 1.17, 1.51, -0.33,
       -0.01, -0.59, -0.28, -0.18, -1.07, 0.66, -0.71, 1.88, -0.14,
       -0.19, 0.84, 0.44, 1.33, -0.2, -0.45, 1.46, 1, -1.02, 0.68, 0.84)
y <- c(1, 0, 1, 1, 1, 1, 0, 1, 1, 1, 0, 1, 1, 1, 0, 0, 1, 1, 1, 0,
       0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 0, 1, 1,
       1, 0, 1, 1, 0, 1, 0, 0, 0, 1, 1, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1,
       0, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1,
       1, 0, 0, 1, 1, 1, 0, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0)
try(glm(y ~ x, family = poisson(identity)))
## failed because start = NULL in 1.4.1
## now gives useful error message
glm(y ~ x, family = poisson(identity), start = c(1,0))
## step reduction failed in 1.4.1
set.seed(123)
y <- rpois(100, pmax(3*x, 0))
glm(y ~ x, family = poisson(identity), start = c(1,0))
warnings()


## extending char arrrays
x <- y <- LETTERS[1:2]
x[5] <- "C"
length(y) <- 5
x
y
## x was filled with "", y with NA in 1.5.0


## formula with no intercept, 2002-07-22
oldcon <- options(contrasts = c("contr.helmert", "contr.poly"))
U <- gl(3, 6, 18, labels=letters[1:3])
V <- gl(3, 2, 18, labels=letters[1:3])
A <- rep(c(0, 1), 9)
B <- rep(c(1, 0), 9)
set.seed(1); y <- rnorm(18)
terms(y ~ A:U + A:V - 1)
lm(y ~ A:U + A:V - 1)$coef  # 1.5.1 used dummies coding for V
lm(y ~ (A + B) : (U + V) - 1) # 1.5.1 used dummies coding for A:V but not B:V
options(oldcon)
## 1.5.1 miscomputed the first factor in the formula.


## quantile extremes, MM 13 Apr 2000 and PR#1852
for(k in 0:5)
    print(quantile(c(rep(-Inf,k+1), 0:k, rep(Inf, k)), pr=seq(0,1, .1)))
x <- c(-Inf, -Inf, Inf, Inf)
median(x)
quantile(x)
## 1.5.1 had -Inf not NaN in several places


## NAs in matrix dimnames
z <- matrix(1:9, 3, 3)
dimnames(z) <- list(c("x", "y", NA), c(1, NA, 3))
z
## NAs in dimnames misaligned when printing in 1.5.1


## weighted aov (PR#1930)
r <- c(10,23,23,26,17,5,53,55,32,46,10,8,10,8,23,0,3,22,15,32,3)
n <- c(39,62,81,51,39,6,74,72,51,79,13,16,30,28,45,4,12,41,30,51,7)
trt <- factor(rep(1:4,c(5,6,5,5)))
Y <- r/n
z <- aov(Y ~ trt, weights=n)
## 1.5.1 gave unweighted RSS


## rbind (PR#2266)
test <- as.data.frame(matrix(1:25, 5, 5))
test1 <- matrix(-(1:10), 2, 5)
rbind(test, test1)
rbind(test1, test)
## 1.6.1 treated matrix as a vector.


## escapes in non-quoted printing
x <- "\\abc\\"
names(x) <- 1
x
print(x, quote=FALSE)
## 1.6.2 had label misaligned


## summary on data frames containing data frames (PR#1891)
x <- data.frame(1:10)
x$z <- data.frame(x=1:10,yyy=11:20)
summary(x)
## 1.6.2 had NULL labels on output with z columns stacked.


## re-orderings in terms.formula (PR#2206)
form <- formula(y ~ a + b:c + d + e + e:d)
(tt <- terms(form))
(tt2 <- terms(formula(tt)))
stopifnot(identical(tt, tt2))
terms(delete.response(tt))
## both tt and tt2 re-ordered the formula < 1.7.0
## now try with a dot
data(warpbreaks)
terms(breaks ~ ., data = warpbreaks)
terms(breaks ~ . - tension, data = warpbreaks)
terms(breaks ~ . - tension, data = warpbreaks, simplify = TRUE)
terms(breaks ~ . ^2, data = warpbreaks)
terms(breaks ~ . ^2, data = warpbreaks, simplify = TRUE)
## 1.6.2 expanded these formulae out as in simplify = TRUE


## printing attributes (PR#2506)
(x <- structure(1:4, other=as.factor(LETTERS[1:3])))
## < 1.7.0 printed the codes of the factor attribute


## add logical matrix replacement indexing for data frames
TEMP <- data.frame(VAR1=c(1,2,3,4,5), VAR2=c(5,4,3,2,1), VAR3=c(1,1,1,1,NA))
TEMP[,c(1,3)][TEMP[,c(1,3)]==1 & !is.na(TEMP[,c(1,3)])] < -10
TEMP
##

## moved from reg-plot.R as exact output depends on rounding error
## PR 390 (axis for small ranges)

relrange <- function(x) {
    ## The relative range in EPS units
    r <- range(x)
    diff(r)/max(abs(r))/.Machine$double.eps
}

x <- c(0.12345678912345678,
       0.12345678912345679,
       0.12345678912345676)
relrange(x) ## 1.0125
plot(x) # `extra horizontal' ;  +- ok on Solaris; label off on Linux

y <- c(0.9999563255363383973418,
       0.9999563255363389524533,
       0.9999563255363382863194)
## The relative range number:
relrange(y) ## 3.000131
plot(y)# once gave infinite loop on Solaris [TL];  y-axis too long

## Comments: The whole issue was finally deferred to main/graphics.c l.1944
##    error("relative range of values is too small to compute accurately");
## which is not okay.

set.seed(101)
par(mfrow = c(3,3))
for(j.fac in 1e-12* c(10, 1, .7, .3, .2, .1, .05, .03, .01)) {
##           ====
    #set.seed(101) # or don't
    x <- pi + jitter(numeric(101), f = j.fac)
    rrtxt <- paste("rel.range =", formatC(relrange(x), dig = 4),"* EPS")
    cat("j.f = ", format(j.fac)," ;  ", rrtxt,"\n",sep="")
    plot(x, type = "l", main = rrtxt)
    cat("par(\"usr\")[3:4]:", formatC(par("usr")[3:4], wid = 10),"\n",
        "par(\"yaxp\") :   ", formatC(par("yaxp"), wid = 10),"\n\n", sep="")
}
par(mfrow = c(1,1))
## The warnings from inside GScale() will differ in their  relrange() ...
## >> do sloppy testing
## 2003-02-03 hopefully no more.  BDR
## end of PR 390


## print/show dispatch
hasMethods <- .isMethodsDispatchOn()
require(methods)
setClass("bar", representation(a="numeric"))
foo <- new("bar", a=pi)
foo
show(foo)
print(foo)

setMethod("show", "bar", function(object){cat("show method\n")})
show(foo)
foo
print(foo)
print(foo, digits = 4)

print.bar <- function(x, ...) cat("print method\n")
foo
print(foo)
show(foo)

setMethod("print", "bar", function(x, ...){cat("S4 print method\n")})
foo
print(foo)
show(foo)
print(foo, digits = 4)
if(!hasMethods) detach("package:methods")
##


## scoping rules calling step inside a function
"cement" <-
    structure(list(x1 = c(7, 1, 11, 11, 7, 11, 3, 1, 2, 21, 1, 11, 10),
                   x2 = c(26, 29, 56, 31, 52, 55, 71, 31, 54, 47, 40, 66, 68),
                   x3 = c(6, 15, 8, 8, 6, 9, 17, 22, 18, 4, 23, 9, 8),
                   x4 = c(60, 52, 20, 47, 33, 22, 6, 44, 22, 26, 34, 12, 12),
                   y = c(78.5, 74.3, 104.3, 87.6, 95.9, 109.2, 102.7, 72.5,
                   93.1, 115.9, 83.8, 113.3, 109.4)),
              .Names = c("x1", "x2", "x3", "x4", "y"), class = "data.frame",
              row.names = c("1", "2", "3", "4", "5", "6", "7", "8", "9",
              "10", "11", "12", "13"))
teststep <- function(formula, data)
{
    d2 <- data
    fit <- lm(formula, data=d2)
    step(fit)
}
teststep(formula(y ~ .), cement)
## failed in 1.6.2

str(array(1))# not a scalar


## na.print="" shouldn't apply to (dim)names!
(tf <- table(ff <- factor(c(1:2,NA,2), exclude=NULL)))
identical(levels(ff), dimnames(tf)[[1]])
str(levels(ff))
## not quite ok previous to 1.7.0


## PR#3058  printing with na.print and right=TRUE
a <- matrix( c(NA, "a", "b", "10",
               NA, NA,  "d", "12",
               NA, NA,  NA,  "14"),
            byrow=T, ncol=4 )
print(a, right=TRUE, na.print=" ")
print(a, right=TRUE, na.print="----")
## misaligned in 1.7.0


## assigning factors to dimnames
A <- matrix(1:4, 2)
aa <- factor(letters[1:2])
dimnames(A) <- list(aa, NULL)
A
dimnames(A)
## 1.7.0 gave internal codes as display and dimnames()
## 1.7.1beta gave NAs via dimnames()
## 1.8.0 converts factors to character


## wishlist PR#2776: aliased coefs in lm/glm
set.seed(123)
x2 <- x1 <- 1:10
x3 <- 0.1*(1:10)^2
y <- x1 + rnorm(10)
(fit <- lm(y ~ x1 + x2 + x3))
summary(fit, cor = TRUE)
(fit <- glm(y ~ x1 + x2 + x3))
summary(fit, cor = TRUE)
## omitted silently in summary.glm < 1.8.0


## list-like indexing of data frames with drop specified
data(women)
women["height"]
women["height", drop = FALSE]  # same with a warning
women["height", drop = TRUE]   # ditto
women[,"height", drop = FALSE] # no warning
women[,"height", drop = TRUE]  # a vector
## second and third were interpreted as women["height", , drop] in 1.7.x


## make.names
make.names("")
make.names(".aa")
## was "X.aa" in 1.7.1
make.names(".2")
make.names(".2a") # not valid in R
make.names(as.character(NA))
##


## strange names in data frames
as.data.frame(list(row.names=17))  # 0 rows in 1.7.1
aa <- data.frame(aa=1:3)
aa[["row.names"]] <- 4:6
aa # fine in 1.7.1
A <- matrix(4:9, 3, 2)
colnames(A) <- letters[1:2]
aa[["row.names"]] <- A
aa
## wrong printed names in 1.7.1

## assigning to NULL
a <- NULL
a[["a"]] <- 1
a
a <- NULL
a[["a"]] <- "something"
a
a <- NULL
a[["a"]] <- 1:3
a
## Last was an error in 1.7.1


## examples of 0-rank models, some empty, some rank-deficient
y <- rnorm(10)
x <- rep(0, 10)
(fit <- lm(y ~ 0))
summary(fit)
anova(fit)
predict(fit)
predict(fit, data.frame(x=x), se=TRUE)
predict(fit, type="terms", se=TRUE)
variable.names(fit) #should be empty
model.matrix(fit)

(fit <- lm(y ~ x + 0))
summary(fit)
anova(fit)
predict(fit)
predict(fit, data.frame(x=x), se=TRUE)
predict(fit, type="terms", se=TRUE)
variable.names(fit) #should be empty
model.matrix(fit)

(fit <- glm(y ~ 0))
summary(fit)
anova(fit)
predict(fit)
predict(fit, data.frame(x=x), se=TRUE)
predict(fit, type="terms", se=TRUE)

(fit <- glm(y ~ x + 0))
summary(fit)
anova(fit)
predict(fit)
predict(fit, data.frame(x=x), se=TRUE)
predict(fit, type="terms", se=TRUE)
## Lots of problems in 1.7.x


## lm.influence on deficient lm models
dat <- data.frame(y=rnorm(10), x1=1:10, x2=1:10, x3 = 0, wt=c(0,rep(1, 9)),
                  row.names=letters[1:10])
dat[3, 1] <- dat[4, 2] <- NA
lm.influence(lm(y ~ x1 + x2, data=dat, weights=wt, na.action=na.omit))
lm.influence(lm(y ~ x1 + x2, data=dat, weights=wt, na.action=na.exclude))
lm.influence(lm(y ~ 0, data=dat, weights=wt, na.action=na.omit))
lm.influence(lm(y ~ 0, data=dat, weights=wt, na.action=na.exclude))
lm.influence(lm(y ~ 0 + x3, data=dat, weights=wt, na.action=na.omit))
lm.influence(lm(y ~ 0 + x3, data=dat, weights=wt, na.action=na.exclude))
lm.influence(lm(y ~ 0, data=dat, na.action=na.exclude))
## last three misbehaved in 1.7.x, none had proper names.


## length of results in ARMAacf when lag.max is used
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=1) # was 4 in 1.7.1
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=2)
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=3)
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=4)
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=5) # failed in 1.7.1
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=6)
ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=10)
##


## Indexing non-existent columns in a data frame
x <- data.frame(a = 1, b = 2)
try(x[c("a", "c")])
try(x[, c("a", "c")])
try(x[1, c("a", "c")])
## Second succeeded, third gave uniformative error message in 1.7.x.


## methods(class = ) with namespaces, .Primitives etc (many missing in 1.7.x):
meth2gen <- function(cl)
    noquote(sub(paste("\\.",cl,"$",sep=""),"", methods(class = cl)))
meth2gen("data.frame")
meth2gen("dendrogram")
## --> the output may need somewhat frequent updating..


## subsetting a 1D array lost the dimensions
x <- array(1:5, dim=c(5))
dim(x)
dim(x[, drop=TRUE])
dim(x[2:3])
dim(x[2])
dim(x[2, drop=FALSE])
dimnames(x) <- list(some=letters[1:5])
x[]
x[2:3]
x[2]
x[2, drop=FALSE]
## both dim and dimnames lost in 1.8.0


## print.dist() didn't show NA's prior to 1.8.1
x <- cbind(c(1,NA,2,3), c(NA,2,NA,1))
(d <- dist(x))
print(d, diag = TRUE)
##


## offsets in model terms where sometimes not deleted correctly
attributes(terms(~ a + b + a:b + offset(c)))[c("offset", "term.labels")]
attributes(terms(y ~ a + b + a:b + offset(c)))[c("offset", "term.labels")]
attributes(terms(~ offset(c) + a + b + a:b))[c("offset", "term.labels")]
attributes(terms(y ~ offset(c) + a + b + a:b))[c("offset", "term.labels")]
## errors prior to 1.8.1


## 0-level factors gave nonsensical answers in model.matrix
m <- model.frame(~x, data.frame(x=NA), na.action=na.pass)
model.matrix(~x, m)
lm.fit <- lm(y ~ x, data.frame(x=1:10, y=1:10))
try(predict(lm.fit, data.frame(x=NA)))
## wrong answers in 1.8.0, refused to run in 1.8.1



## failure to print data frame containing arrays
## raised by John Fox on R-devel on 2004-01-08
y1 <- array(1:10, dim=10)
y2 <- array(1:30, dim=c(10,3), dimnames=list(NULL, letters[1:3]))
y3 <- array(1:40, dim=c(10,2,2),
            dimnames=list(NULL, letters[1:2], NULL))
data.frame(y=y1)
data.frame(y=y2)
data.frame(y=y3)

as.data.frame(y1)
as.data.frame(y2)
as.data.frame(y3)

X <- data.frame(x=1:10)
X$y <- y1
X
sapply(X, dim)

X$y <- y2
X
sapply(X, dim)

X$y <- y3
X
sapply(X, dim)
## The last one fails in S.

## test of user hooks
for(id in c("A", "B")) {
    eval(substitute(
    {
setHook(packageEvent("stats4", "onLoad"),
        function(pkgname, ...) cat("onLoad", sQuote(pkgname), id, "\n"));
setHook(packageEvent("stats4", "attach"),
        function(pkgname, ...) cat("attach", sQuote(pkgname), id, "\n"));
setHook(packageEvent("stats4", "detach"),
        function(pkgname, ...) cat("detach", sQuote(pkgname), id, "\n"));
setHook(packageEvent("stats4", "onUnload"),
        function(pkgname, ...) cat("onUnload", sQuote(pkgname), id, "\n"))
    },
                    list(id=id)))
}
loadNamespace("stats4")
library("stats4")
detach("package:stats4")
unloadNamespace("stats4")
## Just tests


## rep(0-length-vector, length.out > 0)
rep(integer(0), length.out=0)
rep(integer(0), length.out=10)
typeof(.Last.value)
rep(logical(0), length.out=0)
rep(logical(0), length.out=10)
typeof(.Last.value)
rep(numeric(0), length.out=0)
rep(numeric(0), length.out=10)
typeof(.Last.value)
rep(character(0), length.out=0)
rep(character(0), length.out=10)
typeof(.Last.value)
rep(complex(0), length.out=0)
rep(complex(0), length.out=10)
typeof(.Last.value)
rep(list(), length.out=0)
rep(list(), length.out=10)
## always 0-length before 1.9.0


## supplying 0-length data to array and matrix
array(numeric(0), c(2, 2))
array(list(), c(2,2))
# worked < 1.8.0, error in 1.8.x
matrix(character(0), 1, 2)
matrix(integer(0), 1, 2)
matrix(logical(0), 1, 2)
matrix(numeric(0), 1, 2)
matrix(complex(0), 1, 2)
matrix(list(), 1, 2)
## did not work < 1.9.0


## S compatibility change in 1.9.0
rep(1:2, each=3, length=12)
## used to pad with NAs.


## PR#6510: aov() with error and -1
set.seed(1)
test.df <- data.frame (y=rnorm(8), a=gl(2,1,8), b=gl(2,3,8),c=gl(2,4,8))
aov(y ~ a + b + Error(c), data=test.df)
aov(y ~ a + b - 1 + Error(c), data=test.df)
## wrong assignment to strata labels < 1.9.0
## Note this is unbalanced and not a good example

binom.test(c(800,10))# p-value < epsilon


## Misleading error messages on integer overflow
## Uwe Ligges, R-devel, 2004-02-19
try(numeric(2^31))
try(matrix( , 2^31, 1))
try(matrix( , 2^31/10, 100))
try(array(dim=c(2^31/10, 100)))
## reported negative values (really integer NA) for R < 1.9.0


## aov with a singular error model
rd <- c(16.53, 12.12, 10.04, 15.32, 12.33, 10.1, 17.09, 11.69, 11.81, 14.75,
        10.72, 8.79, 13.14, 9.79, 8.36, 15.62, 9.64, 8.72, 15.32,
        11.35, 8.52, 13.27, 9.74, 8.78, 13.16, 10.16, 8.4, 13.08, 9.66,
        8.16, 12.17, 9.13, 7.43, 13.28, 9.16, 7.92, 118.77, 78.83, 62.2,
        107.29, 73.79, 58.59, 118.9, 66.35, 53.12, 372.62, 245.39, 223.72,
        326.03, 232.67, 209.44, 297.55, 239.71, 223.8)
sample.df <- data.frame(dep.variable=rd,
                        subject=factor(rep(paste("subj",1:6, sep=""),each=9)),
                        f1=factor(rep(rep(c("f1","f2","f3"),each=6),3)),
                        f2=factor(rep(c("g1","g2","g3"),each=18))
)
sample.aov <- aov(dep.variable ~ f1 * f2 + Error(subject/(f1+f2)), data=sample.df)
sample.aov
summary(sample.aov)
sample.aov <- aov(dep.variable ~ f1 * f2 + Error(subject/(f2+f1)), data=sample.df)
sample.aov
summary(sample.aov)
## failed in 1.8.1


## PR#6645  stem() with near-constant values
stem(rep(1, 100))
stem(rep(0.1, 10))
stem(c(rep(1, 10), 1+1.e-8))
stem(c(rep(1, 10), 1+1.e-9))
stem(c(rep(1, 10), 1+1.e-10), atom=0) # integer-overflow is avoided.
##  had integer overflows in 1.8.1, and silly shifts of decimal point


## PR#6633 warnings with vector op matrix, and more
set.seed(1)
x1 <- rnorm(3)
y1 <- rnorm(4)
x1 * y1
x1 * as.matrix(y1) # no warning in 1.8.1
x1 * matrix(y1,2,2)# ditto
z1 <- x1 > 0
z2 <- y1 > 0
z1 & z2
z1 & as.matrix(z2) # no warning in 1.8.1
x1 < y1            # no warning in 1.8.1
x1 < as.matrix(y1) # ditto
##


## summary method for mle
library(stats4)
N <- c(rep(3:6, 3), 7,7, rep(8,6), 9,9, 10,12)# sample from Pois(lam = 7)
summary(mle(function(Lam = 1) -sum(dpois(N, Lam))))
## "Coefficients" was "NULL" in 1.9.0's "devel"


## PR#6656 terms.formula(simplify = TRUE) was losing offset terms
## successive offsets caused problems
df <- data.frame(x=1:4, y=sqrt( 1:4), z=c(2:4,1))
fit1 <- glm(y ~ offset(x) + z, data=df)
update(fit1, ". ~.")$call
## lost offset in 1.7.0 to 1.8.1
terms(y ~ offset(x) + offset(log(x)) + z, data=df)
## failed to remove second offset from formula in 1.8.1
terms(y ~ offset(x) + z - z, data=df, simplify = TRUE)
## first fix failed for models with no non-offset terms.


## only the first two were wrong up to 1.8.1:
3:4 * 1e-100
8:11* 1e-100
1:2 * 1e-99
1:2 * 1e+99
8:11* 1e+99
3:4 * 1e+100
##


## negative subscripts could be mixed with NAs
x <- 1:3
try(x[-c(1, NA)])
## worked on some platforms, segfaulted on others in 1.8.1


## vector 'border' (and no 'pch', 'cex' nor 'bg'):
data(InsectSprays)
boxplot(count ~ spray, data = InsectSprays, border=2:7)
## gave warnings in 1.9.0


## Dump should quote when necessary (PR#6857)
x <- quote(b)
dump("x", "")
## doesn't quote b in 1.9.0


## some checks of indexing by character, used to test hashing code
x <- 1:26
names(x) <- letters
x[c("a", "aa", "aa")] <- 100:102
x

x <- 1:26
names(x) <- rep("", 26)
x[c("a", "aa", "aa")] <- 100:102
x
##


## tests of raw type
# tests of logic operators
x <- "A test string"
(y <- charToRaw(x))
(xx <- c(y, as.raw(0), charToRaw("more")))

!y
y & as.raw(15)
y | as.raw(128)

# tests of binary read/write
zz <- file("testbin", "wb")
writeBin(xx, zz)
close(zz)
zz <- file("testbin", "rb")
(yy <- readBin(zz, "raw", 100))
seek(zz, 0, "start")
readBin(zz, "integer", n=100, size = 1) # read as small integers
seek(zz, 0, "start")
readBin(zz, "character", 100)  # is confused by embedded nul.
seek(zz, 0, "start")
readChar(zz, length(xx)) # correct
close(zz)
unlink("testbin")

# tests of ASCII read/write.
cat(xx, file="testascii")
scan("testascii", what=raw(0))
unlink("testascii")
##


## Example of prediction not from newdata as intended.
set.seed(1)
y <- rnorm(10)
x  <- cbind(1:10, sample(1:10)) # matrix
xt <- cbind(1:2,  3:4)
(lm1 <- lm(y ~ x))
predict(lm1, newdata = data.frame(x= xt))
## warns as from 2.0.0