R : Copyright 2001, The R Development Core Team
Version 1.4.0 Patched (2001-12-26)

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 tests for which the printed output is the issue
> 
> ## PR 715 (Printing list elements w/attributes)
> ##
> l <- list(a=10)
> attr(l$a, "xx") <- 23
> l
$a
[1] 10
attr(,"xx")
[1] 23

> ## 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)
     [,1] [,2]
[1,]    1    0
[2,]    2   10
attr(,"na.action")
[1] 3
attr(,"na.action")attr(,"class")
[1] "omit"
> ## should print as
> #      [,1] [,2]
> # [1,]    1    0
> # [2,]    2   10
> # attr(,"na.action")
> # [1] 3
> # attr(,"na.action")attr(,"class")
> # [1] "omit"
> 
> ## and
> x <- 1
> attr(x, "foo") <- list(a="a")
> x
[1] 1
attr(,"foo")
attr(,"foo")$a
[1] "a"

> ## 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
$A
$A$formula
Y ~ X

$A$subset
[1] TRUE


$B
$B$formula
Y ~ X

$B$subset
[1] TRUE


> ## 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)
     event            mag           station         dist       
 Min.   : 1.00   Min.   :5.000   117    :  5   Min.   :  0.50  
 1st Qu.: 9.00   1st Qu.:5.300   113    :  4   1st Qu.: 11.32  
 Median :18.00   Median :6.100   1028   :  4   Median : 23.40  
 Mean   :14.74   Mean   :6.084   475    :  3   Mean   : 45.60  
 3rd Qu.:20.00   3rd Qu.:6.600   135    :  3   3rd Qu.: 47.55  
 Max.   :23.00   Max.   :7.700   (Other):147   Max.   :370.00  
                                 NA's   : 16                   
     accel        
 Min.   :0.00300  
 1st Qu.:0.04425  
 Median :0.11300  
 Mean   :0.15422  
 3rd Qu.:0.21925  
 Max.   :0.81000  
                  
> summary(attenu, digits = 5)
     event             mag            station         dist        
 Min.   : 1.000   Min.   :5.0000   117    :  5   Min.   :  0.500  
 1st Qu.: 9.000   1st Qu.:5.3000   113    :  4   1st Qu.: 11.325  
 Median :18.000   Median :6.1000   1028   :  4   Median : 23.400  
 Mean   :14.742   Mean   :6.0841   475    :  3   Mean   : 45.603  
 3rd Qu.:20.000   3rd Qu.:6.6000   135    :  3   3rd Qu.: 47.550  
 Max.   :23.000   Max.   :7.7000   (Other):147   Max.   :370.000  
                                   NA's   : 16                    
     accel        
 Min.   :0.00300  
 1st Qu.:0.04425  
 Median :0.11300  
 Mean   :0.15422  
 3rd Qu.:0.21925  
 Max.   :0.81000  
                  
> summary(data.matrix(attenu), digits = 5)# the same for matrix
     event             mag            station             dist        
 Min.   : 1.000   Min.   :5.0000   Min.   :  1.000   Min.   :  0.500  
 1st Qu.: 9.000   1st Qu.:5.3000   1st Qu.: 24.250   1st Qu.: 11.325  
 Median :18.000   Median :6.1000   Median : 56.500   Median : 23.400  
 Mean   :14.742   Mean   :6.0841   Mean   : 56.928   Mean   : 45.603  
 3rd Qu.:20.000   3rd Qu.:6.6000   3rd Qu.: 86.750   3rd Qu.: 47.550  
 Max.   :23.000   Max.   :7.7000   Max.   :117.000   Max.   :370.000  
                                   NA's   : 16.000                    
     accel        
 Min.   :0.00300  
 1st Qu.:0.04425  
 Median :0.11300  
 Mean   :0.15422  
 3rd Qu.:0.21925  
 Max.   :0.81000  
                  
> ## Comments:
> ## No difference between these in 1.2.1 and earlier
> set.seed(1)
> x <- c(round(runif(10), 2), 10000)
> summary(x)
     Min.   1st Qu.    Median      Mean   3rd Qu.      Max. 
    0.000     0.050     0.550   909.400     0.675 10000.000 
> summary(data.frame(x))
       x            
 Min.   :    0.000  
 1st Qu.:    0.050  
 Median :    0.550  
 Mean   :  909.423  
 3rd Qu.:    0.675  
 Max.   :10000.000  
> ## 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

Call:  glm(formula = cbind(X, M) ~ 1, family = binomial, data = detg1) 

Coefficients:
(Intercept)  
    0.01587  

Degrees of Freedom: 11 Total (i.e. Null);  11 Residual
Null Deviance:	    32.83 
Residual Deviance: 32.83 	AIC: 92.52 
> step(detg1.m0,scope=list(upper=~M.user*Temp*Soft))
Start:  AIC= 92.52 
 cbind(X, M) ~ 1 

         Df Deviance    AIC
+ M.user  1   12.244 73.942
+ Temp    1   28.464 90.162
<none>        32.826 92.524
+ Soft    2   32.430 96.128

Step:  AIC= 73.94 
 cbind(X, M) ~ M.user 

         Df Deviance    AIC
+ Temp    1    8.444 72.142
<none>        12.244 73.942
+ Soft    2   11.967 77.665
- M.user  1   32.826 92.524

Step:  AIC= 72.14 
 cbind(X, M) ~ M.user + Temp 

              Df Deviance    AIC
+ M.user:Temp  1    5.656 71.354
<none>              8.444 72.142
- Temp         1   12.244 73.942
+ Soft         2    8.228 75.926
- M.user       1   28.464 90.162

Step:  AIC= 71.35 
 cbind(X, M) ~ M.user + Temp + M.user:Temp 

              Df Deviance    AIC
<none>              5.656 71.354
- M.user:Temp  1    8.444 72.142
+ Soft         2    5.495 75.193

Call:  glm(formula = cbind(X, M) ~ M.user + Temp + M.user:Temp, family = binomial,      data = detg1) 

Coefficients:
    (Intercept)          M.userY          TempLow  M.userY:TempLow  
        0.26236         -0.85183          0.04411          0.44427  

Degrees of Freedom: 11 Total (i.e. Null);  8 Residual
Null Deviance:	    32.83 
Residual Deviance: 5.656 	AIC: 71.35 
> 
> ## 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
[1] "temp"
> all.vars(temp[1, ] ~ 3) # wrong in 1.2.1
[1] "temp"
> 
> ## 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))
Error in summary.manova(gofX.manova) : residuals have rank 3 < 4
> ## 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.
> library(mva)
> data(trees)
> z <- as.matrix(t(trees))
> z[1,1] <- z[2,2] <- z[3,3] <- z[2,4] <- NA
> dist(z, method="euclidean")
          Girth   Height
Height 352.4365         
Volume 123.5503 261.5802
> dist(z, method="maximum")
       Girth Height
Height  72.7       
Volume  56.4   63.3
> dist(z, method="manhattan")
           Girth   Height
Height 1954.8821         
Volume  557.1448 1392.343
> dist(z, method="canberra")
          Girth   Height
Height 21.66477         
Volume 10.96200 13.63365
> detach("package:mva")
> 
> ## F. Tusell 2001-03-07.  printing kernels.
> library(ts)
> kernel("daniell", m=5)
Daniell(5) 
coef[-5] = 0.09091
coef[-4] = 0.09091
coef[-3] = 0.09091
coef[-2] = 0.09091
coef[-1] = 0.09091
coef[ 0] = 0.09091
coef[ 1] = 0.09091
coef[ 2] = 0.09091
coef[ 3] = 0.09091
coef[ 4] = 0.09091
coef[ 5] = 0.09091
> kernel("modified.daniell", m=5)
mDaniell(5) 
coef[-5] = 0.05
coef[-4] = 0.10
coef[-3] = 0.10
coef[-2] = 0.10
coef[-1] = 0.10
coef[ 0] = 0.10
coef[ 1] = 0.10
coef[ 2] = 0.10
coef[ 3] = 0.10
coef[ 4] = 0.10
coef[ 5] = 0.05
> kernel("daniell", m=c(3,5,7))
unknown 
coef[-15] = 0.0008658
coef[-14] = 0.0025974
coef[-13] = 0.0051948
coef[-12] = 0.0086580
coef[-11] = 0.0129870
coef[-10] = 0.0181818
coef[ -9] = 0.0242424
coef[ -8] = 0.0303030
coef[ -7] = 0.0363636
coef[ -6] = 0.0424242
coef[ -5] = 0.0484848
coef[ -4] = 0.0536797
coef[ -3] = 0.0580087
coef[ -2] = 0.0614719
coef[ -1] = 0.0640693
coef[  0] = 0.0649351
coef[  1] = 0.0640693
coef[  2] = 0.0614719
coef[  3] = 0.0580087
coef[  4] = 0.0536797
coef[  5] = 0.0484848
coef[  6] = 0.0424242
coef[  7] = 0.0363636
coef[  8] = 0.0303030
coef[  9] = 0.0242424
coef[ 10] = 0.0181818
coef[ 11] = 0.0129870
coef[ 12] = 0.0086580
coef[ 13] = 0.0051948
coef[ 14] = 0.0025974
coef[ 15] = 0.0008658
> ## 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))
     Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec
1920                           1   2   3   4   5   6
1921   7   8   9  10                                
> cbind(tt, tt + 1)
         tt tt + 1
Jul 1920  1      2
Aug 1920  2      3
Sep 1920  3      4
Oct 1920  4      5
Nov 1920  5      6
Dec 1920  6      7
Jan 1921  7      8
Feb 1921  8      9
Mar 1921  9     10
Apr 1921 10     11
> 
> 
> ## PR 883 (cor(x,y) when is.null(y))
> try(cov(rnorm(10), NULL))
Error in cov(rnorm(10), NULL) : supply both x and y or a matrix-like x
> try(cor(rnorm(10), NULL))
Error in cor(rnorm(10), NULL) : supply both x and y or a matrix-like x
> ## gave the variance and 1 respectively in 1.2.2.
> try(var(NULL))
Error in var(NULL) : `x' is empty
> try(var(numeric(0)))
Error in var(numeric(0)) : `x' is empty
> ## 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)
     [,1]  [,2]  [,3]  [,4] 
[1,] "axx" "c  " "e  " "g  "
[2,] "b  " "d  " "f  " "h  "
> format(a, justify="right")
     [,1]  [,2]  [,3]  [,4] 
[1,] "axx" "  c" "  e" "  g"
[2,] "  b" "  d" "  f" "  h"
> ## lost dimensions in 1.2.3
> 
> 
> ## PR 963
> svd(rbind(1:7))## $v lost dimensions in 1.2.3
$d
[1] 11.83216

$u
     [,1]
[1,]    1

$v
           [,1]
[1,] 0.08451543
[2,] 0.16903085
[3,] 0.25354628
[4,] 0.33806170
[5,] 0.42257713
[6,] 0.50709255
[7,] 0.59160798

> 
> 
> ## 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)
[1] 1
character(0)
> f(g2)
[1] 1
character(0)
> 
> 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()
[1] 1
attr(,"class")
[1] "foo"
character(0)
[1] 1
attr(,"class")
[1] "bar"
character(0)
> ## 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"))
NULL
> ls(env = e)# only "x", i.e. *not* the GlobalEnv
[1] "x"
> f(structure(1,class = "bar"))
NULL
> 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)
   (Intercept) xTRUE
1            1     1
2            1     0
3            1     1
4            1     0
5            1     1
6            1     0
7            1     1
8            1     0
9            1     1
10           1     0
attr(,"assign")
[1] 0 1
attr(,"contrasts")
attr(,"contrasts")$x
[1] "contr.treatment"

> lm(y ~ x)

Call:
lm(formula = y ~ x)

Coefficients:
(Intercept)        xTRUE  
     0.1230       0.3170  

> DF <- data.frame(x, y)
> lm(y ~ x, data=DF)

Call:
lm(formula = y ~ x, data = DF)

Coefficients:
(Intercept)        xTRUE  
     0.1230       0.3170  

> options(contrasts=c("contr.helmert", "contr.poly"))
> model.matrix(y ~ x)
   (Intercept) x1
1            1  1
2            1 -1
3            1  1
4            1 -1
5            1  1
6            1 -1
7            1  1
8            1 -1
9            1  1
10           1 -1
attr(,"assign")
[1] 0 1
attr(,"contrasts")
attr(,"contrasts")$x
[1] "contr.helmert"

> lm(y ~ x, data=DF)

Call:
lm(formula = y ~ x, data = DF)

Coefficients:
(Intercept)           x1  
     0.2814       0.1585  

> z <- 1:10
> lm(y ~ x*z)

Call:
lm(formula = y ~ x * z)

Coefficients:
(Intercept)           x1            z         x1:z  
    0.49064     -0.68273     -0.02433      0.15074  

> lm(y ~ x*z - 1)

Call:
lm(formula = y ~ x * z - 1)

Coefficients:
  xFALSE     xTRUE         z      x1:z  
 1.17337  -0.19209  -0.02433   0.15074  

> options(oldCon)
> 
> ## diffinv, Adrian Trapletti, 2001-08-27
> library(ts)
> x <- ts(1:10)
> diffinv(diff(x),xi=x[1])
Time Series:
Start = 1 
End = 10 
Frequency = 1 
 [1]  1  2  3  4  5  6  7  8  9 10
> diffinv(diff(x,lag=1,differences=2),lag=1,differences=2,xi=x[1:2])
Time Series:
Start = 1 
End = 10 
Frequency = 1 
 [1]  1  2  3  4  5  6  7  8  9 10
> ## last had wrong start and end
> detach("package:ts")
> 
> ## PR#1072  (Reading Inf and NaN values)
> as.numeric(as.character(NaN))
[1] NaN
> as.numeric(as.character(Inf))
[1] 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"))
  [,1] [,2] [,3] [,4]
X    2    5    8   11
Y    4   10   16   22
> ## 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)
[1] TRUE
> 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"))
Error in log(x) : Non-numeric argument to mathematical function
> 
> ## 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())
     description class mode text isopen can read can write
> stopifnot(nrow(foo) == 0)
> try(log("a"))
Error in log(x) : Non-numeric argument to mathematical function
> 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)
[1] 0.75
> mean(as.factor(x))
[1] NA
Warning message: 
argument is not numeric or logical: returning NA in: mean.default(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
   y
x    1  2
  1  0 -1
  2 -1  0
> unclass(z - 1)
   y
x    1  2
  1  0 -1
  2 -1  0
> ## 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, ])
   
        w       w2
  1 5.032 25.62702
  2 5.032 25.62702
> ## was 20 rows in R <= 1.4.0
>