reg-tests-2.Rout.save

R version 3.3.1 RC (2016-06-14 r70774) -- "Bug in Your Hair"
Copyright (C) 2016 The R Foundation for Statistical Computing
Platform: x86_64-pc-linux-gnu (64-bit)

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

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ## Regression tests for which the printed output is the issue
> ### _and_ must work (no Recommended packages, please)
> 
> pdf("reg-tests-2.pdf", encoding = "ISOLatin1.enc")
> 
> ## force standard handling for data frames
> options(stringsAsFactors=TRUE)
> options(useFancyQuotes=FALSE)
> 
> ### moved from various .Rd files
> ## abbreviate
> for(m in 1:5) {
+   cat("\n",m,":\n")
+   print(as.vector(abbreviate(state.name, minl=m)))
+ }

 1 :
 [1] "Alb"  "Als"  "Arz"  "Ark"  "Clf"  "Clr"  "Cn"   "D"    "F"    "G"   
[11] "H"    "Id"   "Il"   "In"   "Iw"   "Kns"  "Knt"  "L"    "Man"  "Mr"  
[21] "Mssc" "Mc"   "Mnn"  "Msss" "Mssr" "Mnt"  "Nb"   "Nv"   "NH"   "NJ"  
[31] "NM"   "NY"   "NC"   "ND"   "Oh"   "Ok"   "Or"   "P"    "RI"   "SC"  
[41] "SD"   "Tn"   "Tx"   "U"    "Vrm"  "Vrg"  "Wsh"  "WV"   "Wsc"  "Wy"  

 2 :
 [1] "Alb"  "Als"  "Arz"  "Ark"  "Clf"  "Clr"  "Cn"   "Dl"   "Fl"   "Gr"  
[11] "Hw"   "Id"   "Il"   "In"   "Iw"   "Kns"  "Knt"  "Ls"   "Man"  "Mr"  
[21] "Mssc" "Mc"   "Mnn"  "Msss" "Mssr" "Mnt"  "Nb"   "Nv"   "NH"   "NJ"  
[31] "NM"   "NY"   "NC"   "ND"   "Oh"   "Ok"   "Or"   "Pn"   "RI"   "SC"  
[41] "SD"   "Tn"   "Tx"   "Ut"   "Vrm"  "Vrg"  "Wsh"  "WV"   "Wsc"  "Wy"  

 3 :
 [1] "Alb"  "Als"  "Arz"  "Ark"  "Clf"  "Clr"  "Cnn"  "Dlw"  "Flr"  "Grg" 
[11] "Haw"  "Idh"  "Ill"  "Ind"  "Iow"  "Kns"  "Knt"  "Lsn"  "Man"  "Mry" 
[21] "Mssc" "Mch"  "Mnn"  "Msss" "Mssr" "Mnt"  "Nbr"  "Nvd"  "NwH"  "NwJ" 
[31] "NwM"  "NwY"  "NrC"  "NrD"  "Ohi"  "Okl"  "Org"  "Pnn"  "RhI"  "StC" 
[41] "StD"  "Tnn"  "Txs"  "Uth"  "Vrm"  "Vrg"  "Wsh"  "WsV"  "Wsc"  "Wym" 

 4 :
 [1] "Albm" "Alsk" "Arzn" "Arkn" "Clfr" "Clrd" "Cnnc" "Dlwr" "Flrd" "Gerg"
[11] "Hawa" "Idah" "Illn" "Indn" "Iowa" "Knss" "Kntc" "Losn" "Main" "Mryl"
[21] "Mssc" "Mchg" "Mnns" "Msss" "Mssr" "Mntn" "Nbrs" "Nevd" "NwHm" "NwJr"
[31] "NwMx" "NwYr" "NrtC" "NrtD" "Ohio" "Oklh" "Orgn" "Pnns" "RhdI" "SthC"
[41] "SthD" "Tnns" "Texs" "Utah" "Vrmn" "Vrgn" "Wshn" "WstV" "Wscn" "Wymn"

 5 :
 [1] "Alabm" "Alask" "Arizn" "Arkns" "Clfrn" "Colrd" "Cnnct" "Delwr" "Flord"
[10] "Georg" "Hawai" "Idaho" "Illns" "Indin" "Iowa"  "Kanss" "Kntck" "Lousn"
[19] "Maine" "Mryln" "Mssch" "Mchgn" "Mnnst" "Mssss" "Missr" "Montn" "Nbrsk"
[28] "Nevad" "NwHmp" "NwJrs" "NwMxc" "NwYrk" "NrthC" "NrthD" "Ohio"  "Oklhm"
[37] "Oregn" "Pnnsy" "RhdIs" "SthCr" "SthDk" "Tnnss" "Texas" "Utah"  "Vrmnt"
[46] "Virgn" "Wshng" "WstVr" "Wscns" "Wymng"
> 
> ## 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
        x1 x2
Min.     3  1
1st Qu.  3  2
Median   3  3
Mean     3  3
3rd Qu.  3  4
Max.     3  5
> apply(x,  1, quantile)# 5 x n matrix
        a b    c   d    e f    g   h
0%   3.00 3 2.00 1.0 2.00 3 3.00 3.0
25%  3.25 3 2.25 1.5 2.25 3 3.25 3.5
50%  3.50 3 2.50 2.0 2.50 3 3.50 4.0
75%  3.75 3 2.75 2.5 2.75 3 3.75 4.5
100% 4.00 3 3.00 3.0 3.00 3 4.00 5.0
> 
> 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.
 int(0) 
> 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, tolerance = 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))
[1] 1 2
        a    b    c
[1,] 1160 1200 1240
[2,] 1180 1220 1260
[1] 2 3
  [,1] [,2] [,3] [,4]
a  495  555  615  675
b  515  575  635  695
c  535  595  655  715
[1] 2 4
   V5  V6  V7  V8  V9
a  84 276 468 660 852
b 100 292 484 676 868
c 116 308 500 692 884
[1] 1 3
     [,1] [,2] [,3] [,4]
[1,]  765  855  945 1035
[2,]  780  870  960 1050
[1] 2 3 4
, , V5

  [,1] [,2] [,3] [,4]
a    3   15   27   39
b    7   19   31   43
c   11   23   35   47

, , V6

  [,1] [,2] [,3] [,4]
a   51   63   75   87
b   55   67   79   91
c   59   71   83   95

, , V7

  [,1] [,2] [,3] [,4]
a   99  111  123  135
b  103  115  127  139
c  107  119  131  143

, , V8

  [,1] [,2] [,3] [,4]
a  147  159  171  183
b  151  163  175  187
c  155  167  179  191

, , V9

  [,1] [,2] [,3] [,4]
a  195  207  219  231
b  199  211  223  235
c  203  215  227  239

[1] 1 2 3
, , 1

       a   b   c
[1,] 245 255 265
[2,] 250 260 270

, , 2

       a   b   c
[1,] 275 285 295
[2,] 280 290 300

, , 3

       a   b   c
[1,] 305 315 325
[2,] 310 320 330

, , 4

       a   b   c
[1,] 335 345 355
[2,] 340 350 360

[1] 1 2 3 4
, , 1, V5

     a b c
[1,] 1 3 5
[2,] 2 4 6

, , 2, V5

     a  b  c
[1,] 7  9 11
[2,] 8 10 12

, , 3, V5

      a  b  c
[1,] 13 15 17
[2,] 14 16 18

, , 4, V5

      a  b  c
[1,] 19 21 23
[2,] 20 22 24

, , 1, V6

      a  b  c
[1,] 25 27 29
[2,] 26 28 30

, , 2, V6

      a  b  c
[1,] 31 33 35
[2,] 32 34 36

, , 3, V6

      a  b  c
[1,] 37 39 41
[2,] 38 40 42

, , 4, V6

      a  b  c
[1,] 43 45 47
[2,] 44 46 48

, , 1, V7

      a  b  c
[1,] 49 51 53
[2,] 50 52 54

, , 2, V7

      a  b  c
[1,] 55 57 59
[2,] 56 58 60

, , 3, V7

      a  b  c
[1,] 61 63 65
[2,] 62 64 66

, , 4, V7

      a  b  c
[1,] 67 69 71
[2,] 68 70 72

, , 1, V8

      a  b  c
[1,] 73 75 77
[2,] 74 76 78

, , 2, V8

      a  b  c
[1,] 79 81 83
[2,] 80 82 84

, , 3, V8

      a  b  c
[1,] 85 87 89
[2,] 86 88 90

, , 4, V8

      a  b  c
[1,] 91 93 95
[2,] 92 94 96

, , 1, V9

      a   b   c
[1,] 97  99 101
[2,] 98 100 102

, , 2, V9

       a   b   c
[1,] 103 105 107
[2,] 104 106 108

, , 3, V9

       a   b   c
[1,] 109 111 113
[2,] 110 112 114

, , 4, V9

       a   b   c
[1,] 115 117 119
[2,] 116 118 120

> 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]))
[1] 1 2
[1] TRUE TRUE TRUE
[1] 2 3
[1] TRUE TRUE TRUE
[1] 2 4
[1] TRUE TRUE TRUE
[1] 1 3
[1] TRUE TRUE TRUE
[1] 2 3 4
[1] TRUE TRUE TRUE TRUE
[1] 1 2 3
[1] TRUE TRUE TRUE TRUE
[1] 1 2 3 4
[1] TRUE TRUE TRUE TRUE TRUE
> 
> ## 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)))
       Min.     1st Qu.      Median        Mean     3rd Qu.        Max. 
-3.001e+155 -1.067e+107  -1.976e+62 -9.961e+152  -2.059e+23   1.000e+00 
> which(bY >= 0)
[1] 1 2 3 4 5
> summary(bY <- besselY(2,nu = nu <- seq(3,300,len=51)))
       Min.     1st Qu.      Median        Mean     3rd Qu.        Max. 
       -Inf        -Inf -2.248e+263        -Inf -3.777e+116  -1.000e+00 
There were 22 warnings (use warnings() to see them)
> summary(bI <- besselI(x = x <- 10:700, 1))
      Min.    1st Qu.     Median       Mean    3rd Qu.       Max. 
 2.671e+03  6.026e+77 3.161e+152 3.501e+299 2.409e+227 1.529e+302 
> ## end of moved from Bessel.Rd
> 
> ## data.frame
> set.seed(123)
> L3 <- LETTERS[1:3]
> d <- data.frame(cbind(x=1, y=1:10), fac = sample(L3, 10, replace=TRUE))
> str(d)
'data.frame':	10 obs. of  3 variables:
 $ x  : num  1 1 1 1 1 1 1 1 1 1
 $ y  : num  1 2 3 4 5 6 7 8 9 10
 $ fac: Factor w/ 3 levels "A","B","C": 1 3 2 3 3 1 2 3 2 2
> (d0  <- d[, FALSE]) # NULL dataframe with 10 rows
data frame with 0 columns and 10 rows
> (d.0 <- d[FALSE, ]) # <0 rows> dataframe  (3 cols)
[1] x   y   fac
<0 rows> (or 0-length row.names)
> (d00 <- d0[FALSE,]) # NULL dataframe with 0 rows
data frame with 0 columns and 0 rows
> stopifnot(identical(d, cbind(d, d0)),
+           identical(d, cbind(d0, d)))
> stopifnot(identical(d, rbind(d,d.0)),
+           identical(d, rbind(d.0,d)),
+           identical(d, rbind(d00,d)),
+           identical(d, rbind(d,d00)))
> ## Comments: failed before ver. 1.4.0
> 
> ## diag
> diag(array(1:4, dim=5))
     [,1] [,2] [,3] [,4] [,5]
[1,]    1    0    0    0    0
[2,]    0    2    0    0    0
[3,]    0    0    3    0    0
[4,]    0    0    0    4    0
[5,]    0    0    0    0    1
> ## test behaviour with 0 rows or columns
> diag(0)
<0 x 0 matrix>
> z <- matrix(0, 0, 4)
> diag(z)
numeric(0)
> diag(z) <- numeric(0)
> z
     [,1] [,2] [,3] [,4]
> ## end of moved from diag.Rd
> 
> ## format
> ## handling of quotes
> zz <- data.frame(a=I("abc"), b=I("def\"gh"))
> format(zz)
    a      b
1 abc def"gh
> ## " (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")
1 :	 3 
2 :	 3.1 
3 :	 3.14 
4 :	 3.142 
5 :	 3.1416 
10 :	 3.141592654 
15 :	 3.14159265358979 
16 :	 3.141592653589793 
> 
> p <- c(47,13,2,.1,.023,.0045, 1e-100)/1000
> format.pval(p)
[1] "0.0470"  "0.0130"  "0.0020"  "0.0001"  "2.3e-05" "4.5e-06" "< 2e-16"
> format.pval(p / 0.9)
[1] "0.05222222" "0.01444444" "0.00222222" "0.00011111" "2.5556e-05"
[6] "5.0000e-06" "< 2.22e-16"
> format.pval(p / 0.9, dig=3)
[1] "0.052222" "0.014444" "0.002222" "0.000111" "2.56e-05" "5.00e-06" "< 2e-16" 
> ## 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
[1]  1.000000e+02 -1.000000e-13           Inf          -Inf           NaN
[6]  3.141593e+00            NA
> names(x) <- formatC(x, dig=3)
> is.finite(x)
   100 -1e-13    Inf   -Inf    NaN   3.14     NA 
  TRUE   TRUE  FALSE  FALSE  FALSE   TRUE  FALSE 
> ##-   100 -1e-13 Inf -Inf NaN 3.14 NA
> ##-     T      T   .    .   .    T  .
> is.na(x)
   100 -1e-13    Inf   -Inf    NaN   3.14     NA 
 FALSE  FALSE  FALSE  FALSE   TRUE  FALSE   TRUE 
> ##-   100 -1e-13 Inf -Inf NaN 3.14 NA
> ##-     .      .   .    .   T    .  T
> which(is.na(x) & !is.nan(x))# only 'NA': 7
  NA 
   7 
> 
> is.na(x) | is.finite(x)
   100 -1e-13    Inf   -Inf    NaN   3.14     NA 
  TRUE   TRUE  FALSE  FALSE   TRUE   TRUE   TRUE 
> ##-   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 
 FALSE  FALSE   TRUE   TRUE  FALSE  FALSE  FALSE 
> ##-   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
[1] TRUE
> all(is.nan(x) != is.finite(x) | is.infinite(x)) # FALSE: have 'real' NA
[1] FALSE
> 
> ##--- 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 
Warning message:
In structure(as.integer(x), names = names(x)) :
  NAs introduced by coercion to integer range
> ##-   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)
[1] TRUE
> 
> storage.mode(ii <- -3:5)
[1] "integer"
> storage.mode(zm <- outer(ii,ii, FUN="*"))# integer
[1] "double"
> storage.mode(zd <- outer(ii,ii, FUN="/"))# double
[1] "double"
> range(zd, na.rm=TRUE)# -Inf  Inf
[1] -Inf  Inf
> zd[,ii==0]
[1] -Inf -Inf -Inf  NaN  Inf  Inf  Inf  Inf  Inf
> 
> (storage.mode(print(1:1 / 0:0)))# Inf "double"
[1] Inf
[1] "double"
> (storage.mode(print(1:1 / 1:1)))# 1 "double"
[1] 1
[1] "double"
> (storage.mode(print(1:1 + 1:1)))# 2 "integer"
[1] 2
[1] "integer"
> (storage.mode(print(2:2 * 2:2)))# 4 "integer"
[1] 4
[1] "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)
          D:   E:   F:    G:
A:happy  100  400  700  1000
A:sad   1000 4000 7000 10000
B:happy  200  500  800  1100
B:sad   2000 5000 8000 11000
C:happy  300  600  900  1200
C:sad   3000 6000 9000 12000
> 
> bill <- outer(bill, c("cat"=3, "dog"=4))
> kronecker(fred, bill, make.dimnames = TRUE)
        D:cat D:dog E:cat E:dog F:cat F:dog G:cat G:dog
A:happy   300   400  1200  1600  2100  2800  3000  4000
A:sad    3000  4000 12000 16000 21000 28000 30000 40000
B:happy   600   800  1500  2000  2400  3200  3300  4400
B:sad    6000  8000 15000 20000 24000 32000 33000 44000
C:happy   900  1200  1800  2400  2700  3600  3600  4800
C:sad    9000 12000 18000 24000 27000 36000 36000 48000
> 
> # dimnames are hard work: let's test them thoroughly
> 
> dimnames(bill) <- NULL
> kronecker(fred, bill, make=TRUE)
     D:    D:    E:    E:    F:    F:    G:    G:
A:  300   400  1200  1600  2100  2800  3000  4000
A: 3000  4000 12000 16000 21000 28000 30000 40000
B:  600   800  1500  2000  2400  3200  3300  4400
B: 6000  8000 15000 20000 24000 32000 33000 44000
C:  900  1200  1800  2400  2700  3600  3600  4800
C: 9000 12000 18000 24000 27000 36000 36000 48000
> kronecker(bill, fred, make=TRUE)
     :D    :E    :F    :G    :D    :E    :F    :G
:A  300  1200  2100  3000   400  1600  2800  4000
:B  600  1500  2400  3300   800  2000  3200  4400
:C  900  1800  2700  3600  1200  2400  3600  4800
:A 3000 12000 21000 30000  4000 16000 28000 40000
:B 6000 15000 24000 33000  8000 20000 32000 44000
:C 9000 18000 27000 36000 12000 24000 36000 48000
> 
> dim(bill) <- c(2, 2, 1)
> dimnames(bill) <- list(c("happy", "sad"), NULL, "")
> kronecker(fred, bill, make=TRUE)
, , :

          D:    D:    E:    E:    F:    F:    G:    G:
A:happy  300   400  1200  1600  2100  2800  3000  4000
A:sad   3000  4000 12000 16000 21000 28000 30000 40000
B:happy  600   800  1500  2000  2400  3200  3300  4400
B:sad   6000  8000 15000 20000 24000 32000 33000 44000
C:happy  900  1200  1800  2400  2700  3600  3600  4800
C:sad   9000 12000 18000 24000 27000 36000 36000 48000

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

   :D :E :F :G :D :E :F :G :D :E :F  :G :D :E  :F  :G
:A  1  4  7 10  4 16 28 40  7 28 49  70 10 40  70 100
:B  2  5  8 11  8 20 32 44 14 35 56  77 20 50  80 110
:C  3  6  9 12 12 24 36 48 21 42 63  84 30 60  90 120
:A  2  8 14 20  5 20 35 50  8 32 56  80 11 44  77 110
:B  4 10 16 22 10 25 40 55 16 40 64  88 22 55  88 121
:C  6 12 18 24 15 30 45 60 24 48 72  96 33 66  99 132
:A  3 12 21 30  6 24 42 60  9 36 63  90 12 48  84 120
:B  6 15 24 33 12 30 48 66 18 45 72  99 24 60  96 132
:C  9 18 27 36 18 36 54 72 27 54 81 108 36 72 108 144

, , sad:

   :D :E  :F  :G :D  :E  :F  :G :D  :E  :F  :G :D  :E  :F  :G
:A 13 52  91 130 16  64 112 160 19  76 133 190 22  88 154 220
:B 26 65 104 143 32  80 128 176 38  95 152 209 44 110 176 242
:C 39 78 117 156 48  96 144 192 57 114 171 228 66 132 198 264
:A 14 56  98 140 17  68 119 170 20  80 140 200 23  92 161 230
:B 28 70 112 154 34  85 136 187 40 100 160 220 46 115 184 253
:C 42 84 126 168 51 102 153 204 60 120 180 240 69 138 207 276
:A 15 60 105 150 18  72 126 180 21  84 147 210 24  96 168 240
:B 30 75 120 165 36  90 144 198 42 105 168 231 48 120 192 264
:C 45 90 135 180 54 108 162 216 63 126 189 252 72 144 216 288

> kronecker(fred, bill, make=TRUE)
, , :happy

   D: D: D: D: E: E: E: E: F: F: F:  F: G: G:  G:  G:
A:  1  4  7 10  4 16 28 40  7 28 49  70 10 40  70 100
A:  2  5  8 11  8 20 32 44 14 35 56  77 20 50  80 110
A:  3  6  9 12 12 24 36 48 21 42 63  84 30 60  90 120
B:  2  8 14 20  5 20 35 50  8 32 56  80 11 44  77 110
B:  4 10 16 22 10 25 40 55 16 40 64  88 22 55  88 121
B:  6 12 18 24 15 30 45 60 24 48 72  96 33 66  99 132
C:  3 12 21 30  6 24 42 60  9 36 63  90 12 48  84 120
C:  6 15 24 33 12 30 48 66 18 45 72  99 24 60  96 132
C:  9 18 27 36 18 36 54 72 27 54 81 108 36 72 108 144

, , :sad

   D: D: D: D: E:  E:  E:  E:  F:  F:  F:  F:  G:  G:  G:  G:
A: 13 16 19 22 52  64  76  88  91 112 133 154 130 160 190 220
A: 14 17 20 23 56  68  80  92  98 119 140 161 140 170 200 230
A: 15 18 21 24 60  72  84  96 105 126 147 168 150 180 210 240
B: 26 32 38 44 65  80  95 110 104 128 152 176 143 176 209 242
B: 28 34 40 46 70  85 100 115 112 136 160 184 154 187 220 253
B: 30 36 42 48 75  90 105 120 120 144 168 192 165 198 231 264
C: 39 48 57 66 78  96 114 132 117 144 171 198 156 192 228 264
C: 42 51 60 69 84 102 120 138 126 153 180 207 168 204 240 276
C: 45 54 63 72 90 108 126 144 135 162 189 216 180 216 252 288

> 
> fred <- outer(fred, c("frequentist"=4, "bayesian"=4000))
> kronecker(fred, bill, make=TRUE)
, , frequentist:happy

   D: D:  D:  D: E:  E:  E:  E:  F:  F:  F:  F:  G:  G:  G:  G:
A:  4 16  28  40 16  64 112 160  28 112 196 280  40 160 280 400
A:  8 20  32  44 32  80 128 176  56 140 224 308  80 200 320 440
A: 12 24  36  48 48  96 144 192  84 168 252 336 120 240 360 480
B:  8 32  56  80 20  80 140 200  32 128 224 320  44 176 308 440
B: 16 40  64  88 40 100 160 220  64 160 256 352  88 220 352 484
B: 24 48  72  96 60 120 180 240  96 192 288 384 132 264 396 528
C: 12 48  84 120 24  96 168 240  36 144 252 360  48 192 336 480
C: 24 60  96 132 48 120 192 264  72 180 288 396  96 240 384 528
C: 36 72 108 144 72 144 216 288 108 216 324 432 144 288 432 576

, , frequentist:sad

    D:  D:  D:  D:  E:  E:  E:  E:  F:  F:  F:  F:  G:  G:   G:   G:
A:  52  64  76  88 208 256 304 352 364 448 532 616 520 640  760  880
A:  56  68  80  92 224 272 320 368 392 476 560 644 560 680  800  920
A:  60  72  84  96 240 288 336 384 420 504 588 672 600 720  840  960
B: 104 128 152 176 260 320 380 440 416 512 608 704 572 704  836  968
B: 112 136 160 184 280 340 400 460 448 544 640 736 616 748  880 1012
B: 120 144 168 192 300 360 420 480 480 576 672 768 660 792  924 1056
C: 156 192 228 264 312 384 456 528 468 576 684 792 624 768  912 1056
C: 168 204 240 276 336 408 480 552 504 612 720 828 672 816  960 1104
C: 180 216 252 288 360 432 504 576 540 648 756 864 720 864 1008 1152

, , bayesian:happy

      D:    D:     D:     D:    E:     E:     E:     E:     F:     F:     F:
A:  4000 16000  28000  40000 16000  64000 112000 160000  28000 112000 196000
A:  8000 20000  32000  44000 32000  80000 128000 176000  56000 140000 224000
A: 12000 24000  36000  48000 48000  96000 144000 192000  84000 168000 252000
B:  8000 32000  56000  80000 20000  80000 140000 200000  32000 128000 224000
B: 16000 40000  64000  88000 40000 100000 160000 220000  64000 160000 256000
B: 24000 48000  72000  96000 60000 120000 180000 240000  96000 192000 288000
C: 12000 48000  84000 120000 24000  96000 168000 240000  36000 144000 252000
C: 24000 60000  96000 132000 48000 120000 192000 264000  72000 180000 288000
C: 36000 72000 108000 144000 72000 144000 216000 288000 108000 216000 324000
       F:     G:     G:     G:     G:
A: 280000  40000 160000 280000 400000
A: 308000  80000 200000 320000 440000
A: 336000 120000 240000 360000 480000
B: 320000  44000 176000 308000 440000
B: 352000  88000 220000 352000 484000
B: 384000 132000 264000 396000 528000
C: 360000  48000 192000 336000 480000
C: 396000  96000 240000 384000 528000
C: 432000 144000 288000 432000 576000

, , bayesian:sad

       D:     D:     D:     D:     E:     E:     E:     E:     F:     F:     F:
A:  52000  64000  76000  88000 208000 256000 304000 352000 364000 448000 532000
A:  56000  68000  80000  92000 224000 272000 320000 368000 392000 476000 560000
A:  60000  72000  84000  96000 240000 288000 336000 384000 420000 504000 588000
B: 104000 128000 152000 176000 260000 320000 380000 440000 416000 512000 608000
B: 112000 136000 160000 184000 280000 340000 400000 460000 448000 544000 640000
B: 120000 144000 168000 192000 300000 360000 420000 480000 480000 576000 672000
C: 156000 192000 228000 264000 312000 384000 456000 528000 468000 576000 684000
C: 168000 204000 240000 276000 336000 408000 480000 552000 504000 612000 720000
C: 180000 216000 252000 288000 360000 432000 504000 576000 540000 648000 756000
       F:     G:     G:      G:      G:
A: 616000 520000 640000  760000  880000
A: 644000 560000 680000  800000  920000
A: 672000 600000 720000  840000  960000
B: 704000 572000 704000  836000  968000
B: 736000 616000 748000  880000 1012000
B: 768000 660000 792000  924000 1056000
C: 792000 624000 768000  912000 1056000
C: 828000 672000 816000  960000 1104000
C: 864000 720000 864000 1008000 1152000

> ## 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)
   surname nationality deceased                         title other.author
1   McNeil   Australia       no     Interactive Data Analysis         <NA>
2   Ripley          UK       no            Spatial Statistics         <NA>
3   Ripley          UK       no         Stochastic Simulation         <NA>
4  Tierney          US       no                     LISP-STAT         <NA>
5    Tukey          US      yes     Exploratory Data Analysis         <NA>
6 Venables   Australia       no Modern Applied Statistics ...       Ripley
> merge(authors, b2, all.y = TRUE)
   surname nationality deceased                         title     other.author
1   McNeil   Australia       no     Interactive Data Analysis             <NA>
2   Ripley          UK       no            Spatial Statistics             <NA>
3   Ripley          UK       no         Stochastic Simulation             <NA>
4  Tierney          US       no                     LISP-STAT             <NA>
5    Tukey          US      yes     Exploratory Data Analysis             <NA>
6 Venables   Australia       no Modern Applied Statistics ...           Ripley
7   R Core        <NA>     <NA>          An Introduction to R Venables & Smith
> 
> ## empty d.f. :
> merge(authors, b2[7,])
[1] surname      nationality  deceased     title        other.author
<0 rows> (or 0-length row.names)
> 
> merge(authors, b2[7,], all.y = TRUE)
  surname nationality deceased                title     other.author
1  R Core        <NA>     <NA> An Introduction to R Venables & Smith
> merge(authors, b2[7,], all.x = TRUE)
   surname nationality deceased title other.author
1   McNeil   Australia       no  <NA>         <NA>
2   Ripley          UK       no  <NA>         <NA>
3  Tierney          US       no  <NA>         <NA>
4    Tukey          US      yes  <NA>         <NA>
5 Venables   Australia       no  <NA>         <NA>
> ## end of moved from merge.Rd
> 
> ## NA
> is.na(c(1,NA))
[1] FALSE  TRUE
> is.na(paste(c(1,NA)))
[1] FALSE FALSE
> is.na(list())# logical(0)
logical(0)
> ll <- list(pi,"C",NaN,Inf, 1:3, c(0,NA), NA)
> is.na (ll)
[1] FALSE FALSE  TRUE FALSE FALSE FALSE  TRUE
> lapply(ll, is.nan)  # is.nan no longer works on lists
[[1]]
[1] FALSE

[[2]]
[1] FALSE

[[3]]
[1] TRUE

[[4]]
[1] FALSE

[[5]]
[1] FALSE FALSE FALSE

[[6]]
[1] FALSE FALSE

[[7]]
[1] FALSE

> ## end of moved from NA.Rd
> 
> ## is.na was returning unset values on nested lists
> ll <- list(list(1))
> for (i in 1:5) print(as.integer(is.na(ll)))
[1] 0
[1] 0
[1] 0
[1] 0
[1] 0
> 
> ## scale
> ## test out NA handling
> tm <- matrix(c(2,1,0,1,0,NA,NA,NA,0), nrow=3)
> scale(tm, , FALSE)
     [,1] [,2] [,3]
[1,]    1  0.5   NA
[2,]    0 -0.5   NA
[3,]   -1   NA    0
attr(,"scaled:center")
[1] 1.0 0.5 0.0
> scale(tm)
     [,1]       [,2] [,3]
[1,]    1  0.7071068   NA
[2,]    0 -0.7071068   NA
[3,]   -1         NA  NaN
attr(,"scaled:center")
[1] 1.0 0.5 0.0
attr(,"scaled:scale")
[1] 1.0000000 0.7071068 0.0000000
> ## end of moved from scale.Rd
> 
> ## tabulate
> tabulate(numeric(0))
[1] 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
Time Series:
Start = 2 
End = 4 
Frequency = 1 
[1] 1 2 3
> ts(1:5, start=3, end=17)# repeat
Time Series:
Start = 3 
End = 17 
Frequency = 1 
 [1] 1 2 3 4 5 1 2 3 4 5 1 2 3 4 5
> ## 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
$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(,"class")
[1] "omit"
> ## 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
[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
> 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   1028   :  4   1st Qu.: 11.32  
 Median :18.00   Median :6.100   113    :  4   Median : 23.40  
 Mean   :14.74   Mean   :6.084   112    :  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   1028   :  4   1st Qu.: 11.325  
 Median :18.000   Median :6.1000   113    :  4   Median : 23.400  
 Mean   :14.742   Mean   :6.0841   112    :  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                         
     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.060     0.320     0.630   909.600     0.905 10000.000 
> summary(data.frame(x))
       x            
 Min.   :    0.060  
 1st Qu.:    0.320  
 Median :    0.630  
 Mean   :  909.592  
 3rd Qu.:    0.905  
 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(2L, 1L, 2L, 1L, 2L, 1L, 2L,
+     1L, 2L, 1L, 2L, 1L), .Label = c("High", "Low"), class = "factor"),
+     M.user = structure(c(1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 1L,
+     1L, 2L, 2L), .Label = c("N", "Y"), class = "factor"),
+     Soft = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L),
+     .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.6560 71.354
- M.user:Temp  1   8.4440 72.142
+ Soft         2   5.4952 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 = 1: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.
> 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.3429
> dist(z, method="canberra")
          Girth   Height
Height 21.66477         
Volume 10.96200 13.63365
> 
> ## F. Tusell 2001-03-07.  printing kernels.
> 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))
Daniell(3,5,7) 
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.
> 
> 
> ## 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
> 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
$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.05293     -0.20018  

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

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

Coefficients:
(Intercept)        xTRUE  
   -0.05293     -0.20018  

> 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.1530      -0.1001  

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

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

Coefficients:
(Intercept)           x1            z         x1:z  
  -0.088089    -0.508170    -0.005102     0.073733  

> lm(y ~ x*z - 1)

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

Coefficients:
   xFALSE      xTRUE          z       x1:z  
 0.420081  -0.596259  -0.005102   0.073733  

> options(oldCon)
> 
> ## diffinv, Adrian Trapletti, 2001-08-27
> 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
> 
> ## 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(as.octmode(1:255)), "\"",sep=""))))
> save(x, ascii=TRUE, 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("a") : 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("a") : 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:
In mean.default(as.factor(x)) :
  argument is not numeric or logical: returning NA
> ## 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
> 
> 
> ## Chong Gu 2002-Feb-8: `.' not expanded in drop1
> lab <- dimnames(HairEyeColor)
> HairEye <- cbind(expand.grid(Hair=lab$Hair, Eye=lab$Eye, Sex=lab$Sex,
+ 			     stringsAsFactors = TRUE),
+ 		 Fr = as.vector(HairEyeColor))
> HairEye.fit <- glm(Fr ~ . ^2, poisson, HairEye)
> drop1(HairEye.fit)
Single term deletions

Model:
Fr ~ (Hair + Eye + Sex)^2
         Df Deviance    AIC
<none>         6.761 191.64
Hair:Eye  9  156.678 323.56
Hair:Sex  3   18.327 197.21
Eye:Sex   3   11.764 190.64
> ## 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
     [,1]      [,2]       
[1,] Integer,3 3.141593   
[2,] Integer,3 Character,3
> m[,2]
[[1]]
[1] 3.141593

[[2]]
[1] "a" "b" "c"

> m[2,2]
[[1]]
[1] "a" "b" "c"

> ## 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]      [,2]       
[1,] Integer,3 3.141593   
[2,] Integer,3 Character,3
> ## 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] [,2]        [,3]
[1,] NULL Character,2 NULL
[2,] NULL NULL        NULL
> ## 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
     [,1] [,2]     [,3] [,4]     [,5] [,6]    
[1,] 1    3.141593 3+5i "testit" TRUE factor,1
> ## 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))
+ }
[1] "Wichmann-Hill" "Inversion"    
[1] 0.8308841 0.4640221 0.9460082 0.8764644
[1] 0.12909876 0.07294851 0.45594560 0.68884911
[1] 0.4062450 0.7188432 0.6241738 0.2511611
[1] "Marsaglia-Multicarry" "Inversion"           
[1] 0.3479705 0.9469351 0.2489207 0.7329251
[1] 0.5041512 0.3617873 0.1469184 0.3798119
[1] 0.14388128 0.04196294 0.36214015 0.86053575
[1] "Super-Duper" "Inversion"  
[1] 0.2722510 0.9230240 0.3971743 0.8284474
[1] 0.5706241 0.1806023 0.9633860 0.8434444
[1] 0.09356585 0.41081124 0.38635627 0.72993396
[1] "Mersenne-Twister" "Inversion"       
[1] 0.5999890 0.3328235 0.4886130 0.9544738
[1] 0.5993679 0.4516818 0.1368254 0.7261788
[1] 0.09594961 0.31235651 0.81244335 0.72330846
[1] "Knuth-TAOCP" "Inversion"  
[1] 0.9445502 0.3366297 0.6296881 0.5914161
[1] 0.9213954 0.5468138 0.8817100 0.4442237
[1] 0.8016962 0.9226080 0.1473484 0.8827707
[1] "Knuth-TAOCP-2002" "Inversion"       
[1] 0.9303634 0.2812239 0.1085806 0.8053228
[1] 0.2916627 0.9085017 0.7958965 0.1980655
[1] 0.05247575 0.28290867 0.20930324 0.16794887
> RNGkind(normal.kind = "Kinderman-Ramage")
> set.seed(123)
> RNGkind()
[1] "Knuth-TAOCP-2002" "Kinderman-Ramage"
> rnorm(4)
[1] -1.9699090 -2.2429340  0.5339321  0.2097153
> RNGkind(normal.kind = "Ahrens-Dieter")
> set.seed(123)
> RNGkind()
[1] "Knuth-TAOCP-2002" "Ahrens-Dieter"   
> rnorm(4)
[1]  0.06267229  0.12421568 -1.86653499 -0.14535921
> RNGkind(normal.kind = "Box-Muller")
> set.seed(123)
> RNGkind()
[1] "Knuth-TAOCP-2002" "Box-Muller"      
> rnorm(4)
[1]  2.26160990  0.59010303  0.30176045 -0.01346139
> set.seed(123)
> runif(4)
[1] 0.04062130 0.06511825 0.99290488 0.95540467
> set.seed(123, "default")
> set.seed(123, "Marsaglia-Multicarry") ## Careful, not the default anymore
> runif(4)
[1] 0.1200427 0.1991600 0.7292821 0.8115922
> ## 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)
  x y z
1 1 A 6
> ## 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
[1] A B
Levels: C A B
> ## 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
[1] NA
Warning message:
In sum(x, x) : Integer overflow - use sum(as.numeric(.))
> sum(c(x, x)) # did warn
[1] NA
Warning message:
In sum(c(x, x)) : integer overflow - use sum(as.numeric(.))
> (z <- sum(x, x, 0.0)) # was NA in 1.4.1
[1] 2147483648
> typeof(z)
[1] "double"
> 
> 
> ## NA levels in factors
> (x <- factor(c("a", "NA", "b"), exclude=NULL))
[1] a  NA b 
Levels: NA a b
> ## 1.4.1 had wrong order for levels
> is.na(x)[3] <- TRUE
> x
[1] a    NA   <NA>
Levels: NA a b
> ## missing entry prints as <NA>
> 
> 
> ## printing/formatting NA strings
> (x <- c("a", "NA", NA, "b"))
[1] "a"  "NA" NA   "b" 
> print(x, quote = FALSE)
[1] a    NA   <NA> b   
> paste(x)
[1] "a"  "NA" "NA" "b" 
> format(x)
[1] "a " "NA" "NA" "b "
> format(x, justify = "right")
[1] " a" "NA" "NA" " b"
> format(x, justify = "none")
[1] "a"  "NA" "NA" "b" 
> ## 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)
         tt1 tt2
Feb 1960   1  11
Mar 1960   2  12
Apr 1960   3  13
May 1960   4  14
Jun 1960   5  15
Jul 1960   6  16
Aug 1960   7  17
Sep 1960   8  18
Oct 1960   9  19
Nov 1960  10  20
Dec 1960  11  21
Jan 1961  12  22
Feb 1961  13  23
Mar 1961  14  24
Apr 1961  15  25
May 1961  16  26
Jun 1961  17  27
Jul 1961  18  28
Aug 1961  19  29
Sep 1961  20  30
> ## 1.4.1 had `Jan 1961' as `NA 1961'
> ## ...and 1.9.1 had it as `Jan 1960'!!
> 
> ## 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)))
Error : no valid set of coefficients has been found: please supply starting values
In addition: Warning message:
In log(y/mu) : NaNs produced
> ## failed because start = NULL in 1.4.1
> ## now gives useful error message
> glm(y ~ x, family = poisson(identity), start = c(1,0))

Call:  glm(formula = y ~ x, family = poisson(identity), start = c(1, 
    0))

Coefficients:
(Intercept)            x  
     0.5114       0.1690  

Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
Null Deviance:	    68.01 
Residual Deviance: 60.66 	AIC: 168.7
Warning messages:
1: step size truncated: out of bounds 
2: step size truncated: out of bounds 
> ## 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))

Call:  glm(formula = y ~ x, family = poisson(identity), start = c(1, 
    0))

Coefficients:
(Intercept)            x  
     1.1561       0.4413  

Degrees of Freedom: 99 Total (i.e. Null);  98 Residual
Null Deviance:	    317.2 
Residual Deviance: 228.5 	AIC: 344.7
There were 27 warnings (use warnings() to see them)
> warnings()
Warning messages:
1: step size truncated: out of bounds
2: step size truncated: out of bounds
3: step size truncated: out of bounds
4: step size truncated: out of bounds
5: step size truncated: out of bounds
6: step size truncated: out of bounds
7: step size truncated: out of bounds
8: step size truncated: out of bounds
9: step size truncated: out of bounds
10: step size truncated: out of bounds
11: step size truncated: out of bounds
12: step size truncated: out of bounds
13: step size truncated: out of bounds
14: step size truncated: out of bounds
15: step size truncated: out of bounds
16: step size truncated: out of bounds
17: step size truncated: out of bounds
18: step size truncated: out of bounds
19: step size truncated: out of bounds
20: step size truncated: out of bounds
21: step size truncated: out of bounds
22: step size truncated: out of bounds
23: step size truncated: out of bounds
24: step size truncated: out of bounds
25: step size truncated: out of bounds
26: glm.fit: algorithm did not converge
27: glm.fit: algorithm stopped at boundary value
> 
> 
> ## extending char arrrays
> x <- y <- LETTERS[1:2]
> x[5] <- "C"
> length(y) <- 5
> x
[1] "A" "B" NA  NA  "C"
> y
[1] "A" "B" NA  NA  NA 
> ## 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)
y ~ A:U + A:V - 1
attr(,"variables")
list(y, A, U, V)
attr(,"factors")
  A:U A:V
y   0   0
A   2   2
U   2   0
V   0   1
attr(,"term.labels")
[1] "A:U" "A:V"
attr(,"order")
[1] 2 2
attr(,"intercept")
[1] 0
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> lm(y ~ A:U + A:V - 1)$coefficients  # 1.5.1 used dummies coding for V
       A:Ua        A:Ub        A:Uc        A:V1        A:V2 
 0.25303884 -0.21875499 -0.71708528 -0.61467193 -0.09030436 
> lm(y ~ (A + B) : (U + V) - 1) # 1.5.1 used dummies coding for A:V but not B:V

Call:
lm(formula = y ~ (A + B):(U + V) - 1)

Coefficients:
   A:Ua     A:Ub     A:Uc     A:V1     A:V2     B:Ua     B:Ub     B:Uc  
 0.2530  -0.2188  -0.7171  -0.6147  -0.0903   1.7428   0.0613   0.7649  
   B:V1     B:V2  
-0.4420   0.5388  

> options(oldcon)
> ## 1.5.1 miscomputed the first factor in the formula.
> 
> 
> ## quantile extremes, MM 13 Apr 2000 and PR#1852
> (qq <- sapply(0:5, function(k) {
+     x <- c(rep(-Inf,k+1), 0:k, rep(Inf, k))
+     sapply(1:9, function(typ)
+            quantile(x, pr=(2:10)/10, type=typ))
+ }, simplify="array"))
, , 1

     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9]
20%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf
30%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf
40%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf
50%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf
60%     0    0 -Inf -Inf -Inf -Inf -Inf -Inf -Inf
70%     0    0 -Inf -Inf -Inf    0 -Inf -Inf -Inf
80%     0    0    0 -Inf    0    0 -Inf    0    0
90%     0    0    0 -Inf    0    0 -Inf    0    0
100%    0    0    0    0    0    0    0    0    0

, , 2

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]      [,8]  [,9]
20%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf      -Inf  -Inf
30%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf      -Inf  -Inf
40%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf      -Inf  -Inf
50%     0  0.0 -Inf -Inf  0.0  0.0  0.0 0.0000000 0.000
60%     0  0.5    0  0.0  0.5  0.6  0.4 0.5333333 0.525
70%     1  1.0    1  0.5  1.0  Inf  0.8       Inf   Inf
80%     1  Inf    1  1.0  Inf  Inf  Inf       Inf   Inf
90%   Inf  Inf    1  Inf  Inf  Inf  Inf       Inf   Inf
100%  Inf  Inf  Inf  Inf  Inf  Inf  Inf       Inf   Inf

, , 3

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]     [,8]  [,9]
20%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf     -Inf  -Inf
30%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf     -Inf  -Inf
40%     0  0.0 -Inf -Inf -Inf -Inf -Inf     -Inf  -Inf
50%     0  0.5    0  0.0  0.5  0.5  0.5 0.500000 0.500
60%     1  1.0    1  0.8  1.3  1.4  1.2 1.333333 1.325
70%     2  2.0    2  1.6  Inf  Inf  1.9      Inf   Inf
80%   Inf  Inf    2  Inf  Inf  Inf  Inf      Inf   Inf
90%   Inf  Inf  Inf  Inf  Inf  Inf  Inf      Inf   Inf
100%  Inf  Inf  Inf  Inf  Inf  Inf  Inf      Inf   Inf

, , 4

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]     [,8]  [,9]
20%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf     -Inf  -Inf
30%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf     -Inf  -Inf
40%     0    0 -Inf -Inf -Inf -Inf    0     -Inf  -Inf
50%     1    1    1  0.5  1.0  1.0    1 1.000000 1.000
60%     2    2    2  1.6  2.1  2.2    2 2.133333 2.125
70%     3    3    3  2.7  Inf  Inf    3      Inf   Inf
80%   Inf  Inf  Inf  Inf  Inf  Inf  Inf      Inf   Inf
90%   Inf  Inf  Inf  Inf  Inf  Inf  Inf      Inf   Inf
100%  Inf  Inf  Inf  Inf  Inf  Inf  Inf      Inf   Inf

, , 5

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]       [,8]  [,9]
20%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf       -Inf  -Inf
30%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf       -Inf  -Inf
40%     0  0.0    0 -Inf  0.1  0.0  0.2 0.06666667 0.075
50%     1  1.5    1  1.0  1.5  1.5  1.5 1.50000000 1.500
60%     3  3.0    2  2.4  2.9  3.0  2.8 2.93333333 2.925
70%     4  4.0    4  3.8  Inf  Inf  Inf        Inf   Inf
80%   Inf  Inf  Inf  Inf  Inf  Inf  Inf        Inf   Inf
90%   Inf  Inf  Inf  Inf  Inf  Inf  Inf        Inf   Inf
100%  Inf  Inf  Inf  Inf  Inf  Inf  Inf        Inf   Inf

, , 6

     [,1] [,2] [,3] [,4] [,5] [,6] [,7]      [,8]  [,9]
20%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf      -Inf  -Inf
30%  -Inf -Inf -Inf -Inf -Inf -Inf -Inf      -Inf  -Inf
40%     0    0    0 -Inf  0.3  0.2  0.4 0.2666667 0.275
50%     2    2    1  1.5  2.0  2.0  2.0 2.0000000 2.000
60%     4    4    3  3.2  3.7  3.8  3.6 3.7333333 3.725
70%     5    5    5  4.9  Inf  Inf  Inf       Inf   Inf
80%   Inf  Inf  Inf  Inf  Inf  Inf  Inf       Inf   Inf
90%   Inf  Inf  Inf  Inf  Inf  Inf  Inf       Inf   Inf
100%  Inf  Inf  Inf  Inf  Inf  Inf  Inf       Inf   Inf

> x <- c(-Inf, -Inf, Inf, Inf)
> median(x)
[1] NaN
> quantile(x)
  0%  25%  50%  75% 100% 
-Inf -Inf  NaN  Inf  Inf 
> ## 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
     1 <NA> 3
x    1    4 7
y    2    5 8
<NA> 3    6 9
> ## 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)
  V1 V2 V3 V4  V5
1  1  6 11 16  21
2  2  7 12 17  22
3  3  8 13 18  23
4  4  9 14 19  24
5  5 10 15 20  25
6 -1 -3 -5 -7  -9
7 -2 -4 -6 -8 -10
> rbind(test1, test)
  V1 V2 V3 V4  V5
1 -1 -3 -5 -7  -9
2 -2 -4 -6 -8 -10
3  1  6 11 16  21
4  2  7 12 17  22
5  3  8 13 18  23
6  4  9 14 19  24
7  5 10 15 20  25
> ## 1.6.1 treated matrix as a vector.
> 
> 
> ## escapes in non-quoted printing
> x <- "\\abc\\"
> names(x) <- 1
> x
        1 
"\\abc\\" 
> print(x, quote=FALSE)
      1 
\\abc\\ 
> ## 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)
     X1.10             z.x             z.yyy     
 Min.   : 1.00   Min.   : 1.00    Min.   :11.00  
 1st Qu.: 3.25   1st Qu.: 3.25    1st Qu.:13.25  
 Median : 5.50   Median : 5.50    Median :15.50  
 Mean   : 5.50   Mean   : 5.50    Mean   :15.50  
 3rd Qu.: 7.75   3rd Qu.: 7.75    3rd Qu.:17.75  
 Max.   :10.00   Max.   :10.00    Max.   :20.00  
> ## 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))
y ~ a + b:c + d + e + e:d
attr(,"variables")
list(y, a, b, c, d, e)
attr(,"factors")
  a d e b:c d:e
y 0 0 0   0   0
a 1 0 0   0   0
b 0 0 0   2   0
c 0 0 0   2   0
d 0 1 0   0   1
e 0 0 1   0   1
attr(,"term.labels")
[1] "a"   "d"   "e"   "b:c" "d:e"
attr(,"order")
[1] 1 1 1 2 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> (tt2 <- terms(formula(tt)))
y ~ a + b:c + d + e + e:d
attr(,"variables")
list(y, a, b, c, d, e)
attr(,"factors")
  a d e b:c d:e
y 0 0 0   0   0
a 1 0 0   0   0
b 0 0 0   2   0
c 0 0 0   2   0
d 0 1 0   0   1
e 0 0 1   0   1
attr(,"term.labels")
[1] "a"   "d"   "e"   "b:c" "d:e"
attr(,"order")
[1] 1 1 1 2 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> stopifnot(identical(tt, tt2))
> terms(delete.response(tt))
~a + b:c + d + e + e:d
attr(,"variables")
list(a, b, c, d, e)
attr(,"factors")
  a d e b:c d:e
a 1 0 0   0   0
b 0 0 0   2   0
c 0 0 0   2   0
d 0 1 0   0   1
e 0 0 1   0   1
attr(,"term.labels")
[1] "a"   "d"   "e"   "b:c" "d:e"
attr(,"order")
[1] 1 1 1 2 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 0
attr(,".Environment")
<environment: R_GlobalEnv>
> ## both tt and tt2 re-ordered the formula < 1.7.0
> ## now try with a dot
> terms(breaks ~ ., data = warpbreaks)
breaks ~ wool + tension
attr(,"variables")
list(breaks, wool, tension)
attr(,"factors")
        wool tension
breaks     0       0
wool       1       0
tension    0       1
attr(,"term.labels")
[1] "wool"    "tension"
attr(,"order")
[1] 1 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> terms(breaks ~ . - tension, data = warpbreaks)
breaks ~ (wool + tension) - tension
attr(,"variables")
list(breaks, wool, tension)
attr(,"factors")
        wool
breaks     0
wool       1
tension    0
attr(,"term.labels")
[1] "wool"
attr(,"order")
[1] 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> terms(breaks ~ . - tension, data = warpbreaks, simplify = TRUE)
breaks ~ wool
attr(,"variables")
list(breaks, wool, tension)
attr(,"factors")
        wool
breaks     0
wool       1
tension    0
attr(,"term.labels")
[1] "wool"
attr(,"order")
[1] 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> terms(breaks ~ . ^2, data = warpbreaks)
breaks ~ (wool + tension)^2
attr(,"variables")
list(breaks, wool, tension)
attr(,"factors")
        wool tension wool:tension
breaks     0       0            0
wool       1       0            1
tension    0       1            1
attr(,"term.labels")
[1] "wool"         "tension"      "wool:tension"
attr(,"order")
[1] 1 1 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> terms(breaks ~ . ^2, data = warpbreaks, simplify = TRUE)
breaks ~ wool + tension + wool:tension
attr(,"variables")
list(breaks, wool, tension)
attr(,"factors")
        wool tension wool:tension
breaks     0       0            0
wool       1       0            1
tension    0       1            1
attr(,"term.labels")
[1] "wool"         "tension"      "wool:tension"
attr(,"order")
[1] 1 1 2
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> ## 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] 1 2 3 4
attr(,"other")
[1] A B C
Levels: A B C
> ## < 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
[1] FALSE FALSE FALSE FALSE FALSE
> TEMP
  VAR1 VAR2 VAR3
1    1    5    1
2    2    4    1
3    3    3    1
4    4    2    1
5    5    1   NA
> ##
> 
> ## 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, but depends on strtod
> 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, but depends on strtod
> 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="")
+ }
j.f = 1e-11 ;  rel.range = 553.9 * EPS
par("usr")[3:4]:     3.142     3.142
par("yaxp") :        3.142     3.142         3

j.f = 1e-12 ;  rel.range = 56.02 * EPS
par("usr")[3:4]:     3.142     3.142
par("yaxp") :        3.142     3.142         1

j.f = 7e-13 ;  rel.range = 39.47 * EPS
par("usr")[3:4]:     3.142     3.142
par("yaxp") :        3.142     3.142         1

j.f = 3e-13 ;  rel.range = 16.55 * EPS
par("usr")[3:4]:     3.142     3.142
par("yaxp") :        3.142     3.142         1

j.f = 2e-13 ;  rel.range = 11.46 * EPS
par("usr")[3:4]:     3.108     3.176
par("yaxp") :         3.11      3.17         6

j.f = 1e-13 ;  rel.range = 5.093 * EPS
par("usr")[3:4]:     3.108     3.176
par("yaxp") :         3.11      3.17         6

j.f = 5e-14 ;  rel.range = 2.546 * EPS
par("usr")[3:4]:     3.108     3.176
par("yaxp") :         3.11      3.17         6

j.f = 3e-14 ;  rel.range = 1.273 * EPS
par("usr")[3:4]:     3.108     3.176
par("yaxp") :         3.11      3.17         6

j.f = 1e-14 ;  rel.range =     0 * EPS
par("usr")[3:4]:     1.784     4.499
par("yaxp") :            2         4         4

Warning messages:
1: In plot.window(...) :
  relative range of values =  43 * EPS, is small (axis 2)
2: In plot.window(...) :
  relative range of values =  36 * EPS, is small (axis 2)
3: In plot.window(...) :
  relative range of values =  17 * EPS, is small (axis 2)
> 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
> 
> 
> ## 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 = 1:13)
> teststep <- function(formula, data)
+ {
+     d2 <- data
+     fit <- lm(formula, data=d2)
+     step(fit)
+ }
> teststep(formula(y ~ .), cement)
Start:  AIC=26.94
y ~ x1 + x2 + x3 + x4

       Df Sum of Sq    RSS    AIC
- x3    1    0.1091 47.973 24.974
- x4    1    0.2470 48.111 25.011
- x2    1    2.9725 50.836 25.728
<none>              47.864 26.944
- x1    1   25.9509 73.815 30.576

Step:  AIC=24.97
y ~ x1 + x2 + x4

       Df Sum of Sq    RSS    AIC
<none>               47.97 24.974
- x4    1      9.93  57.90 25.420
- x2    1     26.79  74.76 28.742
- x1    1    820.91 868.88 60.629

Call:
lm(formula = y ~ x1 + x2 + x4, data = d2)

Coefficients:
(Intercept)           x1           x2           x4  
    71.6483       1.4519       0.4161      -0.2365  

> ## failed in 1.6.2
> 
> str(array(1))# not a scalar
 num [1(1d)] 1
> 
> 
> ## na.print="" shouldn't apply to (dim)names!
> (tf <- table(ff <- factor(c(1:2,NA,2), exclude=NULL)))

   1    2 <NA> 
   1    2    1 
> identical(levels(ff), dimnames(tf)[[1]])
[1] TRUE
> str(levels(ff))
 chr [1:3] "1" "2" NA
> ## 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=" ")
     [,1] [,2] [,3] [,4]
[1,]       "a"  "b" "10"
[2,]            "d" "12"
[3,]                "14"
> print(a, right=TRUE, na.print="----")
     [,1] [,2] [,3] [,4]
[1,] ----  "a"  "b" "10"
[2,] ---- ----  "d" "12"
[3,] ---- ---- ---- "14"
> ## 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
  [,1] [,2]
a    1    3
b    2    4
> dimnames(A)
[[1]]
[1] "a" "b"

[[2]]
NULL

> ## 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))

Call:
lm(formula = y ~ x1 + x2 + x3)

Coefficients:
(Intercept)           x1           x2           x3  
     1.4719       0.5867           NA       0.2587  

> summary(fit, cor = TRUE)

Call:
lm(formula = y ~ x1 + x2 + x3)

Residuals:
    Min      1Q  Median      3Q     Max 
-1.0572 -0.4836  0.0799  0.4424  1.2699 

Coefficients: (1 not defined because of singularities)
            Estimate Std. Error t value Pr(>|t|)
(Intercept)   1.4719     0.9484   1.552    0.165
x1            0.5867     0.3961   1.481    0.182
x2                NA         NA      NA       NA
x3            0.2587     0.3509   0.737    0.485

Residual standard error: 0.8063 on 7 degrees of freedom
Multiple R-squared:  0.9326,	Adjusted R-squared:  0.9134 
F-statistic: 48.43 on 2 and 7 DF,  p-value: 7.946e-05

Correlation of Coefficients:
   (Intercept) x1   
x1 -0.91            
x3  0.81       -0.97

> (fit <- glm(y ~ x1 + x2 + x3))

Call:  glm(formula = y ~ x1 + x2 + x3)

Coefficients:
(Intercept)           x1           x2           x3  
     1.4719       0.5867           NA       0.2587  

Degrees of Freedom: 9 Total (i.e. Null);  7 Residual
Null Deviance:	    67.53 
Residual Deviance: 4.551 	AIC: 28.51
> summary(fit, cor = TRUE)

Call:
glm(formula = y ~ x1 + x2 + x3)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.0572  -0.4836   0.0799   0.4424   1.2699  

Coefficients: (1 not defined because of singularities)
            Estimate Std. Error t value Pr(>|t|)
(Intercept)   1.4719     0.9484   1.552    0.165
x1            0.5867     0.3961   1.481    0.182
x2                NA         NA      NA       NA
x3            0.2587     0.3509   0.737    0.485

(Dispersion parameter for gaussian family taken to be 0.6501753)

    Null deviance: 67.5316  on 9  degrees of freedom
Residual deviance:  4.5512  on 7  degrees of freedom
AIC: 28.507

Number of Fisher Scoring iterations: 2

Correlation of Coefficients:
   (Intercept) x1   
x1 -0.91            
x3  0.81       -0.97

> ## omitted silently in summary.glm < 1.8.0
> 
> 
> ## list-like indexing of data frames with drop specified
> women["height"]
   height
1      58
2      59
3      60
4      61
5      62
6      63
7      64
8      65
9      66
10     67
11     68
12     69
13     70
14     71
15     72
> women["height", drop = FALSE]  # same with a warning
   height
1      58
2      59
3      60
4      61
5      62
6      63
7      64
8      65
9      66
10     67
11     68
12     69
13     70
14     71
15     72
Warning message:
In `[.data.frame`(women, "height", drop = FALSE) :
  'drop' argument will be ignored
> women["height", drop = TRUE]   # ditto
   height
1      58
2      59
3      60
4      61
5      62
6      63
7      64
8      65
9      66
10     67
11     68
12     69
13     70
14     71
15     72
Warning message:
In `[.data.frame`(women, "height", drop = TRUE) :
  'drop' argument will be ignored
> women[,"height", drop = FALSE] # no warning
   height
1      58
2      59
3      60
4      61
5      62
6      63
7      64
8      65
9      66
10     67
11     68
12     69
13     70
14     71
15     72
> women[,"height", drop = TRUE]  # a vector
 [1] 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
> ## second and third were interpreted as women["height", , drop] in 1.7.x
> 
> 
> ## make.names
> make.names("")
[1] "X"
> make.names(".aa")
[1] ".aa"
> ## was "X.aa" in 1.7.1
> make.names(".2")
[1] "X.2"
> make.names(".2a") # not valid in R
[1] "X.2a"
> make.names(as.character(NA))
[1] "NA."
> ##
> 
> 
> ## strange names in data frames
> as.data.frame(list(row.names=17))  # 0 rows in 1.7.1
  row.names
1        17
> aa <- data.frame(aa=1:3)
> aa[["row.names"]] <- 4:6
> aa # fine in 1.7.1
  aa row.names
1  1         4
2  2         5
3  3         6
> A <- matrix(4:9, 3, 2)
> colnames(A) <- letters[1:2]
> aa[["row.names"]] <- A
> aa
  aa row.names.a row.names.b
1  1           4           7
2  2           5           8
3  3           6           9
> ## wrong printed names in 1.7.1
> 
> ## assigning to NULL
> a <- NULL
> a[["a"]] <- 1
> a
a 
1 
> a <- NULL
> a[["a"]] <- "something"
> a
          a 
"something" 
> a <- NULL
> a[["a"]] <- 1:3
> a
$a
[1] 1 2 3

> ## 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))

Call:
lm(formula = y ~ 0)

No coefficients

> summary(fit)

Call:
lm(formula = y ~ 0)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.36919 -0.21073  0.00840  0.08437  0.55292 

No Coefficients

Residual standard error: 0.5235 on 10 degrees of freedom

> anova(fit)
Analysis of Variance Table

Response: y
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals 10 2.7404 0.27404               
> predict(fit)
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 
> predict(fit, data.frame(x=x), se=TRUE)
$fit
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 

$se.fit
 [1] 0 0 0 0 0 0 0 0 0 0

$df
[1] 10

$residual.scale
[1] 0.5234843

> predict(fit, type="terms", se=TRUE)
$fit
     
 [1,]
 [2,]
 [3,]
 [4,]
 [5,]
 [6,]
 [7,]
 [8,]
 [9,]
[10,]
attr(,"constant")
[1] 0

$se.fit
     
 [1,]
 [2,]
 [3,]
 [4,]
 [5,]
 [6,]
 [7,]
 [8,]
 [9,]
[10,]

$df
[1] 10

$residual.scale
[1] 0.5234843

> variable.names(fit) #should be empty
character(0)
> model.matrix(fit)
  
1 
2 
3 
4 
5 
6 
7 
8 
9 
10
attr(,"assign")
integer(0)
> 
> (fit <- lm(y ~ x + 0))

Call:
lm(formula = y ~ x + 0)

Coefficients:
 x  
NA  

> summary(fit)

Call:
lm(formula = y ~ x + 0)

Residuals:
     Min       1Q   Median       3Q      Max 
-1.36919 -0.21073  0.00840  0.08437  0.55292 

Coefficients: (1 not defined because of singularities)
  Estimate Std. Error t value Pr(>|t|)
x       NA         NA      NA       NA

Residual standard error: 0.5235 on 10 degrees of freedom

> anova(fit)
Analysis of Variance Table

Response: y
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals 10 2.7404 0.27404               
> predict(fit)
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 
> predict(fit, data.frame(x=x), se=TRUE)
$fit
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 

$se.fit
 [1] 0 0 0 0 0 0 0 0 0 0

$df
[1] 10

$residual.scale
[1] 0.5234843

Warning message:
In predict.lm(fit, data.frame(x = x), se = TRUE) :
  prediction from a rank-deficient fit may be misleading
> predict(fit, type="terms", se=TRUE)
$fit
   x
1  0
2  0
3  0
4  0
5  0
6  0
7  0
8  0
9  0
10 0
attr(,"constant")
[1] 0

$se.fit
   x
1  0
2  0
3  0
4  0
5  0
6  0
7  0
8  0
9  0
10 0

$df
[1] 10

$residual.scale
[1] 0.5234843

> variable.names(fit) #should be empty
character(0)
> model.matrix(fit)
   x
1  0
2  0
3  0
4  0
5  0
6  0
7  0
8  0
9  0
10 0
attr(,"assign")
[1] 1
> 
> (fit <- glm(y ~ 0))

Call:  glm(formula = y ~ 0)

No coefficients


Degrees of Freedom: 10 Total (i.e. Null);  10 Residual
Null Deviance:	    2.74 
Residual Deviance: 2.74 	AIC: 17.43
> summary(fit)

Call:
glm(formula = y ~ 0)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.36919  -0.21073   0.00840   0.08437   0.55292  

No Coefficients

(Dispersion parameter for gaussian family taken to be 0.2740358)

    Null deviance: 2.7404  on 10  degrees of freedom
Residual deviance: 2.7404  on 10  degrees of freedom
AIC: 17.434

Number of Fisher Scoring iterations: 0

> anova(fit)
Analysis of Deviance Table

Model: gaussian, link: identity

Response: y

Terms added sequentially (first to last)


     Df Deviance Resid. Df Resid. Dev
NULL                    10     2.7404
> predict(fit)
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 
> predict(fit, data.frame(x=x), se=TRUE)
$fit
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 

$se.fit
 [1] 0 0 0 0 0 0 0 0 0 0

$residual.scale
[1] 0.5234843

> predict(fit, type="terms", se=TRUE)
$fit
     
 [1,]
 [2,]
 [3,]
 [4,]
 [5,]
 [6,]
 [7,]
 [8,]
 [9,]
[10,]
attr(,"constant")
[1] 0

$se.fit
     
 [1,]
 [2,]
 [3,]
 [4,]
 [5,]
 [6,]
 [7,]
 [8,]
 [9,]
[10,]

$residual.scale
[1] 0.5234843

> 
> (fit <- glm(y ~ x + 0))

Call:  glm(formula = y ~ x + 0)

Coefficients:
 x  
NA  

Degrees of Freedom: 10 Total (i.e. Null);  10 Residual
Null Deviance:	    2.74 
Residual Deviance: 2.74 	AIC: 17.43
> summary(fit)

Call:
glm(formula = y ~ x + 0)

Deviance Residuals: 
     Min        1Q    Median        3Q       Max  
-1.36919  -0.21073   0.00840   0.08437   0.55292  

Coefficients: (1 not defined because of singularities)
  Estimate Std. Error t value Pr(>|t|)
x       NA         NA      NA       NA

(Dispersion parameter for gaussian family taken to be 0.2740358)

    Null deviance: 2.7404  on 10  degrees of freedom
Residual deviance: 2.7404  on 10  degrees of freedom
AIC: 17.434

Number of Fisher Scoring iterations: 2

> anova(fit)
Analysis of Deviance Table

Model: gaussian, link: identity

Response: y

Terms added sequentially (first to last)


     Df Deviance Resid. Df Resid. Dev
NULL                    10     2.7404
x     0        0        10     2.7404
> predict(fit)
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 
> predict(fit, data.frame(x=x), se=TRUE)
$fit
 1  2  3  4  5  6  7  8  9 10 
 0  0  0  0  0  0  0  0  0  0 

$se.fit
 [1] 0 0 0 0 0 0 0 0 0 0

$residual.scale
[1] 0.5234843

Warning message:
In predict.lm(object, newdata, se.fit, scale = residual.scale, type = ifelse(type ==  :
  prediction from a rank-deficient fit may be misleading
> predict(fit, type="terms", se=TRUE)
$fit
   x
1  0
2  0
3  0
4  0
5  0
6  0
7  0
8  0
9  0
10 0
attr(,"constant")
[1] 0

$se.fit
   x
1  0
2  0
3  0
4  0
5  0
6  0
7  0
8  0
9  0
10 0

$residual.scale
[1] 0.5234843

> ## 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))
$hat
        b         e         f         g         h         i         j 
0.6546053 0.2105263 0.1546053 0.1447368 0.1809211 0.2631579 0.3914474 

$coefficients
  (Intercept)           x1
b  1.39138784 -0.173267165
e -0.70930972  0.068642877
f  0.12039809 -0.007818058
g  0.01971595  0.001314397
h  0.03272637 -0.017325726
i -0.36929526  0.092323814
j  0.33861311 -0.070163076

$sigma
        b         e         f         g         h         i         j 
0.9641441 0.7434598 1.0496727 1.0681908 1.0389586 0.7633748 1.0093187 

$wt.res
         b          e          f          g          h          i          j 
 0.5513046 -1.3728575  0.4018482  0.1708716 -0.4793451  1.2925334 -0.5643552 

> lm.influence(lm(y ~ x1 + x2, data=dat, weights=wt, na.action=na.exclude))
$hat
        b         e         c         d         f         g         h         i 
0.6546053 0.2105263 0.0000000 0.0000000 0.1546053 0.1447368 0.1809211 0.2631579 
        j 
0.3914474 

$coefficients
  (Intercept)           x1
b  1.39138784 -0.173267165
e -0.70930972  0.068642877
c  0.00000000  0.000000000
d  0.00000000  0.000000000
f  0.12039809 -0.007818058
g  0.01971595  0.001314397
h  0.03272637 -0.017325726
i -0.36929526  0.092323814
j  0.33861311 -0.070163076

$sigma
        b         e         c         d         f         g         h         i 
0.9641441 0.7434598 0.9589854 0.9589854 1.0496727 1.0681908 1.0389586 0.7633748 
        j 
1.0093187 

$wt.res
         b          e          c          d          f          g          h 
 0.5513046 -1.3728575         NA         NA  0.4018482  0.1708716 -0.4793451 
         i          j 
 1.2925334 -0.5643552 

> lm.influence(lm(y ~ 0, data=dat, weights=wt, na.action=na.omit))
$hat
b d e f g h i j 
0 0 0 0 0 0 0 0 

$coefficients
 
b
d
e
f
g
h
i
j

$sigma
        b         d         e         f         g         h         i         j 
0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 

$wt.res
         b          d          e          f          g          h          i 
 0.3604547  0.1146812 -1.1426753  0.7723744  0.6817419  0.1718693  2.0840918 
         j 
 0.3675473 

> lm.influence(lm(y ~ 0, data=dat, weights=wt, na.action=na.exclude))
$hat
b d c e f g h i j 
0 0 0 0 0 0 0 0 0 

$coefficients
 
b
d
c
e
f
g
h
i
j

$sigma
        b         d         c         e         f         g         h         i 
0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 
        j 
0.9366289 

$wt.res
         b          d          c          e          f          g          h 
 0.3604547  0.1146812         NA -1.1426753  0.7723744  0.6817419  0.1718693 
         i          j 
 2.0840918  0.3675473 

> lm.influence(lm(y ~ 0 + x3, data=dat, weights=wt, na.action=na.omit))
$hat
b d e f g h i j 
0 0 0 0 0 0 0 0 

$coefficients
 
b
d
e
f
g
h
i
j

$sigma
        b         d         e         f         g         h         i         j 
0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 

$wt.res
         b          d          e          f          g          h          i 
 0.3604547  0.1146812 -1.1426753  0.7723744  0.6817419  0.1718693  2.0840918 
         j 
 0.3675473 

> lm.influence(lm(y ~ 0 + x3, data=dat, weights=wt, na.action=na.exclude))
$hat
b d c e f g h i j 
0 0 0 0 0 0 0 0 0 

$coefficients
 
b
d
c
e
f
g
h
i
j

$sigma
        b         d         c         e         f         g         h         i 
0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 
        j 
0.9366289 

$wt.res
         b          d          c          e          f          g          h 
 0.3604547  0.1146812         NA -1.1426753  0.7723744  0.6817419  0.1718693 
         i          j 
 2.0840918  0.3675473 

> lm.influence(lm(y ~ 0, data=dat, na.action=na.exclude))
$hat
a b c d e f g h i j 
0 0 0 0 0 0 0 0 0 0 

$coefficients
 
a
b
c
d
e
f
g
h
i
j

$sigma
        a         b         c         d         e         f         g         h 
0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 
        i         j 
0.8860916 0.8860916 

$wt.res
         a          b          c          d          e          f          g 
 0.2196280  0.3604547         NA  0.1146812 -1.1426753  0.7723744  0.6817419 
         h          i          j 
 0.1718693  2.0840918  0.3675473 

> ## 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
        0         1 
1.0000000 0.7644046 
> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=2)
        0         1         2 
1.0000000 0.7644046 0.2676056 
> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=3)
         0          1          2          3 
 1.0000000  0.7644046  0.2676056 -0.2343150 
> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=4)
         0          1          2          3          4 
 1.0000000  0.7644046  0.2676056 -0.2343150 -0.5180538 
> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=5) # failed in 1.7.1
         0          1          2          3          4          5 
 1.0000000  0.7644046  0.2676056 -0.2343150 -0.5180538 -0.5099616 
> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=6)
         0          1          2          3          4          5          6 
 1.0000000  0.7644046  0.2676056 -0.2343150 -0.5180538 -0.5099616 -0.2784942 
> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=10)
         0          1          2          3          4          5          6 
 1.0000000  0.7644046  0.2676056 -0.2343150 -0.5180538 -0.5099616 -0.2784942 
         7          8          9         10 
 0.0241137  0.2486313  0.3134551  0.2256408 
> ##
> 
> 
> ## Indexing non-existent columns in a data frame
> x <- data.frame(a = 1, b = 2)
> try(x[c("a", "c")])
Error in `[.data.frame`(x, c("a", "c")) : undefined columns selected
> try(x[, c("a", "c")])
Error in `[.data.frame`(x, , c("a", "c")) : undefined columns selected
> try(x[1, c("a", "c")])
Error in `[.data.frame`(x, 1, c("a", "c")) : undefined columns selected
> ## 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=""),"", c(.S3methods(class = cl))))
> meth2gen("data.frame")
 [1] $             $<-           Math          Ops           Summary      
 [6] [             [<-           [[            [[<-          aggregate    
[11] anyDuplicated as.data.frame as.list       as.matrix     by           
[16] cbind         dim           dimnames      dimnames<-    droplevels   
[21] duplicated    edit          format        formula       head         
[26] is.na         merge         na.exclude    na.omit       plot         
[31] print         prompt        rbind         row.names     row.names<-  
[36] rowsum        split         split<-       stack         str          
[41] subset        summary       t             tail          transform    
[46] unique        unstack       within       
> meth2gen("dendrogram")
 [1] [[            as.dendrogram as.hclust     cophenetic    cut          
 [6] labels        merge         nobs          plot          print        
[11] reorder       rev           str          
> ## --> the output may need somewhat frequent updating..
> 
> 
> ## subsetting a 1D array lost the dimensions
> x <- array(1:5, dim=c(5))
> dim(x)
[1] 5
> dim(x[, drop=TRUE])
[1] 5
> dim(x[2:3])
[1] 2
> dim(x[2])
NULL
> dim(x[2, drop=FALSE])
[1] 1
> dimnames(x) <- list(some=letters[1:5])
> x[]
some
a b c d e 
1 2 3 4 5 
> x[2:3]
some
b c 
2 3 
> x[2]
b 
2 
> x[2, drop=FALSE]
some
b 
2 
> ## 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))
         1        2        3
2       NA                  
3 1.414214       NA         
4 2.828427 1.414214 1.414214
> print(d, diag = TRUE)
         1        2        3        4
1 0.000000                           
2       NA 0.000000                  
3 1.414214       NA 0.000000         
4 2.828427 1.414214 1.414214 0.000000
> ##
> 
> 
> ## offsets in model terms where sometimes not deleted correctly
> attributes(terms(~ a + b + a:b + offset(c)))[c("offset", "term.labels")]
$offset
[1] 3

$term.labels
[1] "a"   "b"   "a:b"

> attributes(terms(y ~ a + b + a:b + offset(c)))[c("offset", "term.labels")]
$offset
[1] 4

$term.labels
[1] "a"   "b"   "a:b"

> attributes(terms(~ offset(c) + a + b + a:b))[c("offset", "term.labels")]
$offset
[1] 1

$term.labels
[1] "a"   "b"   "a:b"

> attributes(terms(y ~ offset(c) + a + b + a:b))[c("offset", "term.labels")]
$offset
[1] 2

$term.labels
[1] "a"   "b"   "a:b"

> ## 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)
  (Intercept) xTRUE
1           1    NA
attr(,"assign")
[1] 0 1
attr(,"contrasts")
attr(,"contrasts")$x
[1] "contr.treatment"

> lm.fit <- lm(y ~ x, data.frame(x=1:10, y=1:10))
> try(predict(lm.fit, data.frame(x=NA)))
Error : variable 'x' was fitted with type "numeric" but type "logical" was supplied
> ## 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)
    y
1   1
2   2
3   3
4   4
5   5
6   6
7   7
8   8
9   9
10 10
> data.frame(y=y2)
   y.a y.b y.c
1    1  11  21
2    2  12  22
3    3  13  23
4    4  14  24
5    5  15  25
6    6  16  26
7    7  17  27
8    8  18  28
9    9  19  29
10  10  20  30
> data.frame(y=y3)
   y.a.1 y.b.1 y.a.2 y.b.2
1      1    11    21    31
2      2    12    22    32
3      3    13    23    33
4      4    14    24    34
5      5    15    25    35
6      6    16    26    36
7      7    17    27    37
8      8    18    28    38
9      9    19    29    39
10    10    20    30    40
> 
> as.data.frame(y1)
   y1
1   1
2   2
3   3
4   4
5   5
6   6
7   7
8   8
9   9
10 10
> as.data.frame(y2)
    a  b  c
1   1 11 21
2   2 12 22
3   3 13 23
4   4 14 24
5   5 15 25
6   6 16 26
7   7 17 27
8   8 18 28
9   9 19 29
10 10 20 30
> as.data.frame(y3)
   a.1 b.1 a.2 b.2
1    1  11  21  31
2    2  12  22  32
3    3  13  23  33
4    4  14  24  34
5    5  15  25  35
6    6  16  26  36
7    7  17  27  37
8    8  18  28  38
9    9  19  29  39
10  10  20  30  40
> 
> X <- data.frame(x=1:10)
> X$y <- y1
> X
    x  y
1   1  1
2   2  2
3   3  3
4   4  4
5   5  5
6   6  6
7   7  7
8   8  8
9   9  9
10 10 10
> sapply(X, dim)
$x
NULL

$y
[1] 10

> 
> X$y <- y2
> X
    x y.a y.b y.c
1   1   1  11  21
2   2   2  12  22
3   3   3  13  23
4   4   4  14  24
5   5   5  15  25
6   6   6  16  26
7   7   7  17  27
8   8   8  18  28
9   9   9  19  29
10 10  10  20  30
> sapply(X, dim)
$x
NULL

$y
[1] 10  3

> 
> X$y <- y3
> X
    x y.a.1 y.b.1 y.a.2 y.b.2
1   1     1    11    21    31
2   2     2    12    22    32
3   3     3    13    23    33
4   4     4    14    24    34
5   5     5    15    25    35
6   6     6    16    26    36
7   7     7    17    27    37
8   8     8    18    28    38
9   9     9    19    29    39
10 10    10    20    30    40
> sapply(X, dim)
$x
NULL

$y
[1] 10  2  2

> ## 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")
onLoad 'stats4' A 
onLoad 'stats4' B 
<environment: namespace:stats4>
> library("stats4")
attach 'stats4' A 
attach 'stats4' B 
> detach("package:stats4")
detach 'stats4' B 
detach 'stats4' A 
> unloadNamespace("stats4")
onUnload 'stats4' B 
onUnload 'stats4' A 
> ## Just tests
> 
> 
> ## rep(0-length-vector, length.out > 0)
> rep(integer(0), length.out=0)
integer(0)
> rep(integer(0), length.out=10)
 [1] NA NA NA NA NA NA NA NA NA NA
> typeof(.Last.value)
[1] "integer"
> rep(logical(0), length.out=0)
logical(0)
> rep(logical(0), length.out=10)
 [1] NA NA NA NA NA NA NA NA NA NA
> typeof(.Last.value)
[1] "logical"
> rep(numeric(0), length.out=0)
numeric(0)
> rep(numeric(0), length.out=10)
 [1] NA NA NA NA NA NA NA NA NA NA
> typeof(.Last.value)
[1] "double"
> rep(character(0), length.out=0)
character(0)
> rep(character(0), length.out=10)
 [1] NA NA NA NA NA NA NA NA NA NA
> typeof(.Last.value)
[1] "character"
> rep(complex(0), length.out=0)
complex(0)
> rep(complex(0), length.out=10)
 [1] NA NA NA NA NA NA NA NA NA NA
> typeof(.Last.value)
[1] "complex"
> rep(list(), length.out=0)
list()
> rep(list(), length.out=10)
[[1]]
NULL

[[2]]
NULL

[[3]]
NULL

[[4]]
NULL

[[5]]
NULL

[[6]]
NULL

[[7]]
NULL

[[8]]
NULL

[[9]]
NULL

[[10]]
NULL

> ## always 0-length before 1.9.0
> 
> 
> ## supplying 0-length data to array and matrix
> array(numeric(0), c(2, 2))
     [,1] [,2]
[1,]   NA   NA
[2,]   NA   NA
> array(list(), c(2,2))
     [,1] [,2]
[1,] NULL NULL
[2,] NULL NULL
> # worked < 1.8.0, error in 1.8.x
> matrix(character(0), 1, 2)
     [,1] [,2]
[1,] NA   NA  
> matrix(integer(0), 1, 2)
     [,1] [,2]
[1,]   NA   NA
> matrix(logical(0), 1, 2)
     [,1] [,2]
[1,]   NA   NA
> matrix(numeric(0), 1, 2)
     [,1] [,2]
[1,]   NA   NA
> matrix(complex(0), 1, 2)
     [,1] [,2]
[1,]   NA   NA
> matrix(list(), 1, 2)
     [,1] [,2]
[1,] NULL NULL
> ## did not work < 1.9.0
> 
> 
> ## S compatibility change in 1.9.0
> rep(1:2, each=3, length=12)
 [1] 1 1 1 2 2 2 1 1 1 2 2 2
> ## 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)

Call:
aov(formula = y ~ a + b + Error(c), data = test.df)

Grand Mean: 0.8066534

Stratum 1: c

Terms:
                        b
Sum of Squares  0.3176489
Deg. of Freedom         1

Estimated effects are balanced

Stratum 2: Within

Terms:
                       a        b Residuals
Sum of Squares  1.389453 2.148149  5.048689
Deg. of Freedom        1        1         4

Residual standard error: 1.123464
Estimated effects may be unbalanced
> aov(y ~ a + b - 1 + Error(c), data=test.df)

Call:
aov(formula = y ~ a + b - 1 + Error(c), data = test.df)

Stratum 1: c

Terms:
                       a        b
Sum of Squares  5.205518 0.317649
Deg. of Freedom        1        1

1 out of 3 effects not estimable
Estimated effects may be unbalanced

Stratum 2: Within

Terms:
                       a        b Residuals
Sum of Squares  1.389453 2.148149  5.048689
Deg. of Freedom        1        1         4

Residual standard error: 1.123464
1 out of 3 effects not estimable
Estimated effects may be unbalanced
> ## 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

	Exact binomial test

data:  c(800, 10)
number of successes = 800, number of trials = 810, p-value < 2.2e-16
alternative hypothesis: true probability of success is not equal to 0.5
95 percent confidence interval:
 0.9774134 0.9940643
sample estimates:
probability of success 
             0.9876543 

> 
> 
> ## 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)
Warning message:
In aov(dep.variable ~ f1 * f2 + Error(subject/(f1 + f2)), data = sample.df) :
  Error() model is singular
> sample.aov

Call:
aov(formula = dep.variable ~ f1 * f2 + Error(subject/(f1 + f2)), 
    data = sample.df)

Grand Mean: 65.07444

Stratum 1: subject

Terms:
                       f1        f2     f1:f2
Sum of Squares   47815.99 312824.49 100370.96
Deg. of Freedom         1         2         2

2 out of 7 effects not estimable
Estimated effects may be unbalanced

Stratum 2: subject:f1

Terms:
                      f1    f1:f2
Sum of Squares  483.9628 869.6876
Deg. of Freedom        2        4

Estimated effects may be unbalanced

Stratum 3: Within

Terms:
                Residuals
Sum of Squares   29204.13
Deg. of Freedom        42

Residual standard error: 26.36923
> summary(sample.aov)

Error: subject
      Df Sum Sq Mean Sq
f1     1  47816   47816
f2     2 312824  156412
f1:f2  2 100371   50185

Error: subject:f1
      Df Sum Sq Mean Sq
f1     2  484.0   242.0
f1:f2  4  869.7   217.4

Error: Within
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals 42  29204   695.3               
> sample.aov <- aov(dep.variable ~ f1 * f2 + Error(subject/(f2+f1)), data=sample.df)
Warning message:
In aov(dep.variable ~ f1 * f2 + Error(subject/(f2 + f1)), data = sample.df) :
  Error() model is singular
> sample.aov

Call:
aov(formula = dep.variable ~ f1 * f2 + Error(subject/(f2 + f1)), 
    data = sample.df)

Grand Mean: 65.07444

Stratum 1: subject

Terms:
                       f1        f2     f1:f2
Sum of Squares   47815.99 312824.49 100370.96
Deg. of Freedom         1         2         2

2 out of 7 effects not estimable
Estimated effects may be unbalanced

Stratum 2: subject:f1

Terms:
                      f1    f1:f2
Sum of Squares  483.9628 869.6876
Deg. of Freedom        2        4

Estimated effects may be unbalanced

Stratum 3: Within

Terms:
                Residuals
Sum of Squares   29204.13
Deg. of Freedom        42

Residual standard error: 26.36923
> summary(sample.aov)

Error: subject
      Df Sum Sq Mean Sq
f1     1  47816   47816
f2     2 312824  156412
f1:f2  2 100371   50185

Error: subject:f1
      Df Sum Sq Mean Sq
f1     2  484.0   242.0
f1:f2  4  869.7   217.4

Error: Within
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals 42  29204   695.3               
> ## failed in 1.8.1
> 
> 
> ## PR#6645  stem() with near-constant values
> stem(rep(1, 100))

  The decimal point is at the |

  1 | 00000000000000000000000000000000000000000000000000000000000000000000+20

> stem(rep(0.1, 10))

  The decimal point is 1 digit(s) to the left of the |

  1 | 0000000000

> stem(c(rep(1, 10), 1+1.e-8))

  The decimal point is 8 digit(s) to the left of the |

  100000000 | 0000000000
  100000000 | 
  100000001 | 0

> stem(c(rep(1, 10), 1+1.e-9))

  The decimal point is 8 digit(s) to the left of the |

  100000000 | 00000000001

> stem(c(rep(1, 10), 1+1.e-10), atom=0) # integer-overflow is avoided.

  The decimal point is 8 digit(s) to the left of the |

  100000000 | 00000000000

> ##  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
[1]  0.5574682  0.1410502  0.1609194 -0.3641637
Warning message:
In x1 * y1 :
  longer object length is not a multiple of shorter object length
> x1 * as.matrix(y1) # no warning in 1.8.1
           [,1]
[1,]  0.5574682
[2,]  0.1410502
[3,]  0.1609194
[4,] -0.3641637
Warning message:
In x1 * as.matrix(y1) :
  longer object length is not a multiple of shorter object length
> x1 * matrix(y1,2,2)# ditto
          [,1]       [,2]
[1,] 0.5574682  0.1609194
[2,] 0.1410502 -0.3641637
Warning message:
In x1 * matrix(y1, 2, 2) :
  longer object length is not a multiple of shorter object length
> z1 <- x1 > 0
> z2 <- y1 > 0
> z1 & z2
[1]  TRUE  TRUE  TRUE FALSE
Warning message:
In z1 & z2 :
  longer object length is not a multiple of shorter object length
> z1 & as.matrix(z2) # no warning in 1.8.1
      [,1]
[1,]  TRUE
[2,]  TRUE
[3,]  TRUE
[4,] FALSE
Warning message:
In z1 & as.matrix(z2) :
  longer object length is not a multiple of shorter object length
> x1 < y1            # no warning in 1.8.1
[1] FALSE  TRUE FALSE FALSE
Warning message:
In x1 < y1 :
  longer object length is not a multiple of shorter object length
> x1 < as.matrix(y1) # ditto
      [,1]
[1,] FALSE
[2,]  TRUE
[3,] FALSE
[4,] FALSE
Warning message:
In x1 < as.matrix(y1) :
  longer object length is not a multiple of shorter object length
> ##
> 
> 
> ## summary method for mle
> library(stats4)
onLoad 'stats4' A 
onLoad 'stats4' B 
attach 'stats4' A 
attach 'stats4' B 
> 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))))
Maximum likelihood estimation

Call:
mle(minuslogl = function(Lam = 1) -sum(dpois(N, Lam)))

Coefficients:
    Estimate Std. Error
Lam 6.063755   2.307546

-2 log L: -5.437059 
> ## "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
glm(formula = y ~ z + offset(x), data = df)
> ## lost offset in 1.7.0 to 1.8.1
> terms(y ~ offset(x) + offset(log(x)) + z, data=df)
y ~ offset(x) + offset(log(x)) + z
attr(,"variables")
list(y, offset(x), offset(log(x)), z)
attr(,"offset")
[1] 2 3
attr(,"factors")
               z
y              0
offset(x)      0
offset(log(x)) 0
z              1
attr(,"term.labels")
[1] "z"
attr(,"order")
[1] 1
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> ## failed to remove second offset from formula in 1.8.1
> terms(y ~ offset(x) + z - z, data=df, simplify = TRUE)
y ~ offset(x)
attr(,"variables")
list(y, offset(x), z)
attr(,"offset")
[1] 2
attr(,"factors")
integer(0)
attr(,"term.labels")
character(0)
attr(,"order")
integer(0)
attr(,"intercept")
[1] 1
attr(,"response")
[1] 1
attr(,".Environment")
<environment: R_GlobalEnv>
> ## 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
[1] 3e-100 4e-100
> 8:11* 1e-100
[1] 8.0e-100 9.0e-100  1.0e-99  1.1e-99
> 1:2 * 1e-99
[1] 1e-99 2e-99
> 1:2 * 1e+99
[1] 1e+99 2e+99
> 8:11* 1e+99
[1]  8.0e+99  9.0e+99 1.0e+100 1.1e+100
> 3:4 * 1e+100
[1] 3e+100 4e+100
> ##
> 
> 
> ## negative subscripts could be mixed with NAs
> x <- 1:3
> try(x[-c(1, NA)])
Error in x[-c(1, NA)] : only 0's may be mixed with negative subscripts
> ## worked on some platforms, segfaulted on others in 1.8.1
> 
> 
> ## vector 'border' (and no 'pch', 'cex' nor 'bg'):
> boxplot(count ~ spray, data = InsectSprays, border=2:7)
> ## gave warnings in 1.9.0
> 
> summary(as.Date(paste("2002-12", 26:31, sep="-")))
        Min.      1st Qu.       Median         Mean      3rd Qu.         Max. 
"2002-12-26" "2002-12-27" "2002-12-28" "2002-12-28" "2002-12-29" "2002-12-31" 
> ## printed all "2002.-12-29" in 1.9.1 {because digits was too small}
> as.matrix(data.frame(d = as.POSIXct("2004-07-20")))
     d           
[1,] "2004-07-20"
> ## gave a warning in 1.9.1
> 
> 
> ## Dump should quote when necessary (PR#6857)
> x <- quote(b)
> dump("x", "")
x <-
quote(b)
> ## 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
  a   b   c   d   e   f   g   h   i   j   k   l   m   n   o   p   q   r   s   t 
100   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
  u   v   w   x   y   z  aa 
 21  22  23  24  25  26 102 
> 
> x <- 1:26
> names(x) <- rep("", 26)
> x[c("a", "aa", "aa")] <- 100:102
> x
                                                                                
  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
                          a  aa 
 21  22  23  24  25  26 100 102 
> ##
> 
> 
> ## tests of raw type
> # tests of logic operators
> x <- "A test string"
> (y <- charToRaw(x))
 [1] 41 20 74 65 73 74 20 73 74 72 69 6e 67
> (xx <- c(y, as.raw(0), charToRaw("more")))
 [1] 41 20 74 65 73 74 20 73 74 72 69 6e 67 00 6d 6f 72 65
> 
> !y
 [1] be df 8b 9a 8c 8b df 8c 8b 8d 96 91 98
> y & as.raw(15)
 [1] 01 00 04 05 03 04 00 03 04 02 09 0e 07
> y | as.raw(128)
 [1] c1 a0 f4 e5 f3 f4 a0 f3 f4 f2 e9 ee e7
> 
> # tests of binary read/write
> zz <- file("testbin", "wb")
> writeBin(xx, zz)
> close(zz)
> zz <- file("testbin", "rb")
> (yy <- readBin(zz, "raw", 100))
 [1] 41 20 74 65 73 74 20 73 74 72 69 6e 67 00 6d 6f 72 65
> seek(zz, 0, "start")
[1] 18
> readBin(zz, "integer", n=100, size = 1) # read as small integers
 [1]  65  32 116 101 115 116  32 115 116 114 105 110 103   0 109 111 114 101
> seek(zz, 0, "start")
[1] 18
> readBin(zz, "character", 100)  # is confused by embedded nul.
[1] "A test string"
Warning message:
In readBin(zz, "character", 100) :
  incomplete string at end of file has been discarded
> seek(zz, 0, "start")
[1] 18
> readChar(zz, length(xx)) # truncates at embedded nul
[1] "A test string"
> seek(zz) # make sure current position is reported properly
[1] 18
> close(zz)
> unlink("testbin")
> 
> # tests of ASCII read/write.
> cat(xx, file="testascii")
> scan("testascii", what=raw(0))
Read 18 items
 [1] 41 20 74 65 73 74 20 73 74 72 69 6e 67 00 6d 6f 72 65
> 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))

Call:
lm(formula = y ~ x)

Coefficients:
(Intercept)           x1           x2  
     0.4359      -0.1376       0.1539  

> predict(lm1, newdata = data.frame(x= xt))
          1           2           3           4           5           6 
 1.83760728  0.93041126  0.17714205  0.19350695  1.13343277  0.84194402 
          7           8           9          10 
 0.08867482  0.25896653  0.27533143 -0.47793778 
Warning message:
'newdata' had 2 rows but variables found have 10 rows 
> ## warns as from 2.0.0
> 
> 
> ## eval could alter a data.frame/list second argument
> data(trees)
> a <- trees
> eval(quote({Girth[1]<-NA;Girth}),a)
 [1]   NA  8.6  8.8 10.5 10.7 10.8 11.0 11.0 11.1 11.2 11.3 11.4 11.4 11.7 12.0
[16] 12.9 12.9 13.3 13.7 13.8 14.0 14.2 14.5 16.0 16.3 17.3 17.5 17.9 18.0 18.0
[31] 20.6
> a[1, ]
  Girth Height Volume
1   8.3     70   10.3
> trees[1, ]
  Girth Height Volume
1   8.3     70   10.3
> ## both a and trees got altered in 1.9.1
> 
> 
> ## write.table did not apply qmethod to col.names (PR#7171)
> x <- data.frame("test string with \"" = c("a \" and a '"), check.names=FALSE)
> write.table(x)
"test string with \""
"1" "a \" and a '"
> write.table(x, qmethod = "double")
"test string with """
"1" "a "" and a '"
> ## Quote in col name was unescaped in 1.9.1.
> 
> 
> ## extensions to read.table
> Mat <- matrix(c(1:3, letters[1:3], 1:3, LETTERS[1:3],
+                 c("2004-01-01", "2004-02-01", "2004-03-01"),
+                 c("2004-01-01 12:00", "2004-02-01 12:00", "2004-03-01 12:00")),
+               3, 6)
> foo <- tempfile()
> write.table(Mat, foo, col.names = FALSE, row.names = FALSE)
> read.table(foo, colClasses = c(NA, NA, "NULL", "character", "Date", "POSIXct"))
  V1 V2 V4         V5                  V6
1  1  a  A 2004-01-01 2004-01-01 12:00:00
2  2  b  B 2004-02-01 2004-02-01 12:00:00
3  3  c  C 2004-03-01 2004-03-01 12:00:00
> unlist(sapply(.Last.value, class))
         V1          V2          V4          V5         V61         V62 
  "integer"    "factor" "character"      "Date"   "POSIXct"    "POSIXt" 
> read.table(foo, colClasses = c("factor",NA,"NULL","factor","Date","POSIXct"))
  V1 V2 V4         V5                  V6
1  1  a  A 2004-01-01 2004-01-01 12:00:00
2  2  b  B 2004-02-01 2004-02-01 12:00:00
3  3  c  C 2004-03-01 2004-03-01 12:00:00
> unlist(sapply(.Last.value, class))
       V1        V2        V4        V5       V61       V62 
 "factor"  "factor"  "factor"    "Date" "POSIXct"  "POSIXt" 
> read.table(foo, colClasses = c(V4="character"))
  V1 V2 V3 V4         V5               V6
1  1  a  1  A 2004-01-01 2004-01-01 12:00
2  2  b  2  B 2004-02-01 2004-02-01 12:00
3  3  c  3  C 2004-03-01 2004-03-01 12:00
> unlist(sapply(.Last.value, class))
         V1          V2          V3          V4          V5          V6 
  "integer"    "factor"   "integer" "character"    "factor"    "factor" 
> unlink(foo)
> ## added in 2.0.0
> 
> 
> ## write.table with complex columns (PR#7260, in part)
> write.table(data.frame(x = 0.5+1:4, y = 1:4 + 1.5i), file = "")
"x" "y"
"1" 1.5 1+1.5i
"2" 2.5 2+1.5i
"3" 3.5 3+1.5i
"4" 4.5 4+1.5i
> # printed all as complex in 2.0.0.
> write.table(data.frame(x = 0.5+1:4, y = 1:4 + 1.5i), file = "", dec=",")
"x" "y"
"1" 1,5 1+1,5i
"2" 2,5 2+1,5i
"3" 3,5 3+1,5i
"4" 4,5 4+1,5i
> ## used '.' not ',' in 2.0.0
> 
> ## splinefun() value test
> (x <- seq(0,6, length=25))
 [1] 0.00 0.25 0.50 0.75 1.00 1.25 1.50 1.75 2.00 2.25 2.50 2.75 3.00 3.25 3.50
[16] 3.75 4.00 4.25 4.50 4.75 5.00 5.25 5.50 5.75 6.00
> mx <- sapply(c("fmm", "nat", "per"),
+              function(m) splinefun(1:5, c(1,2,4,3,1), method = m)(x))
> cbind(x,mx)
         x       fmm         nat       per
 [1,] 0.00 5.3333333  0.46428571 3.0000000
 [2,] 0.25 3.5312500  0.59821429 2.4062500
 [3,] 0.50 2.2500000  0.73214286 1.8125000
 [4,] 0.75 1.4270833  0.86607143 1.3125000
 [5,] 1.00 1.0000000  1.00000000 1.0000000
 [6,] 1.25 0.9062500  1.14118304 0.9453125
 [7,] 1.50 1.0833333  1.32589286 1.1250000
 [8,] 1.75 1.4687500  1.59765625 1.4921875
 [9,] 2.00 2.0000000  2.00000000 2.0000000
[10,] 2.25 2.6093750  2.54854911 2.5937500
[11,] 2.50 3.2083333  3.14732143 3.1875000
[12,] 2.75 3.7031250  3.67243304 3.6875000
[13,] 3.00 4.0000000  4.00000000 4.0000000
[14,] 3.25 4.0312500  4.03962054 4.0546875
[15,] 3.50 3.8333333  3.83482143 3.8750000
[16,] 3.75 3.4687500  3.46261161 3.5078125
[17,] 4.00 3.0000000  3.00000000 3.0000000
[18,] 4.25 2.4843750  2.51171875 2.4062500
[19,] 4.50 1.9583333  2.01339286 1.8125000
[20,] 4.75 1.4531250  1.50837054 1.3125000
[21,] 5.00 1.0000000  1.00000000 1.0000000
[22,] 5.25 0.6302083  0.49107143 0.9453125
[23,] 5.50 0.3750000 -0.01785714 1.1250000
[24,] 5.75 0.2656250 -0.52678571 1.4921875
[25,] 6.00 0.3333333 -1.03571429 2.0000000
> 
> 
> ## infinite loop in read.fwf (PR#7350)
> cat(file="test.txt", sep = "\n", "# comment 1", "1234567   # comment 2",
+     "1 234567  # comment 3", "12345  67 # comment 4", "# comment 5")
> read.fwf("test.txt", width=c(2,2,3), skip=1, n=4) # looped
  V1 V2  V3
1 12 34 567
2  1 23 456
3 12 34   5
> read.fwf("test.txt", width=c(2,2,3), skip=1)      # 1 line short
  V1 V2  V3
1 12 34 567
2  1 23 456
3 12 34   5
> read.fwf("test.txt", width=c(2,2,3), skip=0)
  V1 V2  V3
1 12 34 567
2  1 23 456
3 12 34   5
> unlink("test.txt")
> ##
> 
> 
> ## split was not handling lists and raws
> split(as.list(1:3), c(1,1,2))
$`1`
$`1`[[1]]
[1] 1

$`1`[[2]]
[1] 2


$`2`
$`2`[[1]]
[1] 3


> (y <- charToRaw("A test string"))
 [1] 41 20 74 65 73 74 20 73 74 72 69 6e 67
> (z <- split(y, rep(1:5, times=c(1,1,4,1,6))))
$`1`
[1] 41

$`2`
[1] 20

$`3`
[1] 74 65 73 74

$`4`
[1] 20

$`5`
[1] 73 74 72 69 6e 67

> sapply(z, rawToChar)
       1        2        3        4        5 
     "A"      " "   "test"      " " "string" 
> ## wrong results in 2.0.0
> 
> 
> ## tests of changed S3 implicit classes in 2.1.0
> foo <- function(x, ...) UseMethod("foo")
> foo.numeric <- function(x) cat("numeric arg\n")
> foo(1:10)
numeric arg
> foo(pi)
numeric arg
> foo(matrix(1:10, 2, 5))
numeric arg
> foo.integer <- function(x) cat("integer arg\n")
> foo.double <- function(x) cat("double arg\n")
> foo(1:10)
integer arg
> foo(pi)
double arg
> foo(matrix(1:10, 2, 5))
integer arg
> ##
> 
> 
> ## str() interpreted escape sequences prior to 2.1.0
> x <- "ab\bc\ndef"
> str(x)
 chr "ab\bc\ndef"
> str(x, vec.len=0)# failed in rev 32244
 chr  ...
> str(factor(x))
 Factor w/ 1 level "ab\bc\ndef": 1
> 
> x <- c("a", NA, "b")
> factor(x)
[1] a    <NA> b   
Levels: a b
> factor(x, exclude="")
[1] a    <NA> b   
Levels: a b <NA>
> str(x)
 chr [1:3] "a" NA "b"
> str(factor(x))
 Factor w/ 2 levels "a","b": 1 NA 2
> str(factor(x, exclude=""))
 Factor w/ 3 levels "a","b",NA: 1 3 2
> ##
> 
> 
> ## print.factor(quote=TRUE) was not quoting levels
> x <- c("a", NA, "b", 'a " test') #" (comment for fontification)
> factor(x)
[1] a        <NA>     b        a " test
Levels: a a " test b
> factor(x, exclude="")
[1] a        <NA>     b        a " test
Levels: a a " test b <NA>
> print(factor(x), quote=TRUE)
[1] "a"         NA          "b"         "a \" test"
Levels: "a" "a \" test" "b"
> print(factor(x, exclude=""), quote=TRUE)
[1] "a"         NA          "b"         "a \" test"
Levels: "a" "a \" test" "b" NA
> ## last two printed levels differently from values in 2.0.1
> 
> 
> ## write.table in marginal cases
> x <- matrix(, 3, 0)
> write.table(x) # 3 rows
"1" 
"2" 
"3" 
> write.table(x, row.names=FALSE)



> # note: scan and read.table won't read this as they take empty fields as NA
> ## was 1 row in 2.0.1
> 
> 
> ## More tests of write.table
> x <- list(a=1, b=1:2, c=3:4, d=5)
> dim(x) <- c(2,2)
> x
     [,1]      [,2]     
[1,] 1         Integer,2
[2,] Integer,2 5        
> write.table(x)
"V1" "V2"
"1" 1 3:4
"2" 1:2 5
> 
> x1 <- data.frame(a=1:2, b=I(matrix(LETTERS[1:4], 2, 2)), c = c("(i)", "(ii)"))
> x1
  a b.1 b.2    c
1 1   A   C  (i)
2 2   B   D (ii)
> write.table(x1) # In 2.0.1 had 3 headers, 4 cols
"a" "b.1" "b.2" "c"
"1" 1 A C "(i)"
"2" 2 B D "(ii)"
> write.table(x1, quote=c(2,3,4))
"a" "b.1" "b.2" "c"
"1" 1 "A" "C" "(i)"
"2" 2 "B" "D" "(ii)"
> 
> x2 <- data.frame(a=1:2, b=I(list(a=1, b=2)))
> x2
  a b
a 1 1
b 2 2
> write.table(x2)
"a" "b"
"a" 1 1
"b" 2 2
> 
> x3 <- seq(as.Date("2005-01-01"), len=6, by="day")
> x4 <- data.frame(x=1:6, y=x3)
> dim(x3) <- c(2,3)
> x3
[1] "2005-01-01" "2005-01-02" "2005-01-03" "2005-01-04" "2005-01-05"
[6] "2005-01-06"
> write.table(x3) # matrix, so loses class
"V1" "V2" "V3"
"1" 12784 12786 12788
"2" 12785 12787 12789
> x4
  x          y
1 1 2005-01-01
2 2 2005-01-02
3 3 2005-01-03
4 4 2005-01-04
5 5 2005-01-05
6 6 2005-01-06
> write.table(x4) # preserves class, does not quote
"x" "y"
"1" 1 2005-01-01
"2" 2 2005-01-02
"3" 3 2005-01-03
"4" 4 2005-01-04
"5" 5 2005-01-05
"6" 6 2005-01-06
> ##
> 
> 
> ## Problem with earlier regexp code spotted by KH
> grep("(.*s){2}", "Arkansas", v = TRUE)
[1] "Arkansas"
> grep("(.*s){3}", "Arkansas", v = TRUE)
character(0)
> grep("(.*s){3}", state.name, v = TRUE)
[1] "Massachusetts" "Mississippi"  
> ## Thought Arkansas had 3 s's.
> 
> 
> ## Replacing part of a non-existent column could create a short column.
> xx<- data.frame(a=1:4, b=letters[1:4])
> xx[2:3, "c"] <- 2:3
> ## gave short column in R < 2.1.0.
> 
> 
> ## add1/drop1 could give misleading results if missing values were involved
> y <- rnorm(1:20)
> x <- 1:20; x[10] <- NA
> x2 <- runif(20); x2[20] <- NA
> fit <- lm(y ~ x)
> drop1(fit)
Single term deletions

Model:
y ~ x
       Df Sum of Sq    RSS    AIC
<none>              20.191 5.1555
x       1    1.4798 21.671 4.4993
> res <-  try(stats:::drop1.default(fit))
Error in stats:::drop1.default(fit) : 
  number of rows in use has changed: remove missing values?
> stopifnot(inherits(res, "try-error"))
> add1(fit, ~ . +x2)
Single term additions

Model:
y ~ x
       Df Sum of Sq    RSS    AIC
<none>              17.605 3.6005
x2      1  0.011746 17.593 5.5885
Warning message:
In add1.lm(fit, ~. + x2) : using the 18/19 rows from a combined fit
> res <-  try(stats:::add1.default(fit, ~ . +x2))
Error in stats:::add1.default(fit, ~. + x2) : 
  number of rows in use has changed: remove missing values?
> stopifnot(inherits(res, "try-error"))
> ## 2.0.1 ran and gave incorrect answers.
> 
> 
> ## (PR#7789) escaped quotes in the first five lines for read.table
> tf <- tempfile()
> x <- c("6 'TV2  Shortland Street'",
+        "2 'I don\\\'t watch TV at 7'",
+        "1 'I\\\'m not bothered, whatever that looks good'",
+        "2 'I channel surf'")
> writeLines(x, tf)
> read.table(tf)
  V1                                         V2
1  6                      TV2  Shortland Street
2  2                      I don't watch TV at 7
3  1 I'm not bothered, whatever that looks good
4  2                             I channel surf
> x <- c("6 'TV2  Shortland Street'",
+        "2 'I don''t watch TV at 7'",
+        "1 'I''m not bothered, whatever that looks good'",
+        "2 'I channel surf'")
> writeLines(x, tf)
> read.table(tf, sep=" ")
  V1                                         V2
1  6                      TV2  Shortland Street
2  2                      I don't watch TV at 7
3  1 I'm not bothered, whatever that looks good
4  2                             I channel surf
> unlink(tf)
> ## mangled in 2.0.1
> 
> 
> ## (PR#7802) printCoefmat(signif.legend =FALSE) failed
> set.seed(123)
> cmat <- cbind(rnorm(3, 10), sqrt(rchisq(3, 12)))
> cmat <- cbind(cmat, cmat[,1]/cmat[,2])
> cmat <- cbind(cmat, 2*pnorm(-cmat[,3]))
> colnames(cmat) <- c("Estimate", "Std.Err", "Z value", "Pr(>z)")
> printCoefmat(cmat, signif.stars = TRUE)
     Estimate Std.Err Z value    Pr(>z)    
[1,]  11.3092  2.8636  3.9493 7.837e-05 ***
[2,]  11.2301  3.5301  3.1812  0.001467 ** 
[3,]   9.9161  3.0927  3.2063  0.001344 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> printCoefmat(cmat, signif.stars = TRUE, signif.legend = FALSE)
     Estimate Std.Err Z value    Pr(>z)    
[1,]  11.3092  2.8636  3.9493 7.837e-05 ***
[2,]  11.2301  3.5301  3.1812  0.001467 ** 
[3,]   9.9161  3.0927  3.2063  0.001344 ** 
> # no stars, so no legend
> printCoefmat(cmat, signif.stars = FALSE)
     Estimate Std.Err Z value    Pr(>z)
[1,]  11.3092  2.8636  3.9493 7.837e-05
[2,]  11.2301  3.5301  3.1812  0.001467
[3,]   9.9161  3.0927  3.2063  0.001344
> printCoefmat(cmat, signif.stars = TRUE, signif.legend = TRUE)
     Estimate Std.Err Z value    Pr(>z)    
[1,]  11.3092  2.8636  3.9493 7.837e-05 ***
[2,]  11.2301  3.5301  3.1812  0.001467 ** 
[3,]   9.9161  3.0927  3.2063  0.001344 ** 
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> ## did not work in 2.1.0
> 
> 
> ## PR#7824 subscripting an array by a matrix
> x <- matrix(1:6, ncol=2)
> x[rbind(c(1,1), c(2,2))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(0,1))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(0,0))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(0,2))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(0,3))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(1,0))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(2,0))]
[1] 1 5
> x[rbind(c(1,1), c(2,2), c(3,0))]
[1] 1 5
> x[rbind(c(1,0), c(0,2), c(3,0))]
integer(0)
> x[rbind(c(1,0), c(0,0), c(3,0))]
integer(0)
> x[rbind(c(1,1), c(2,2), c(1,2))]
[1] 1 5 4
> x[rbind(c(1,1), c(2,NA), c(1,2))]
[1]  1 NA  4
> x[rbind(c(1,0), c(2,NA), c(1,2))]
[1] NA  4
> try(x[rbind(c(1,1), c(2,2), c(-1,2))])
Error in x[rbind(c(1, 1), c(2, 2), c(-1, 2))] : 
  negative values are not allowed in a matrix subscript
> try(x[rbind(c(1,1), c(2,2), c(-2,2))])
Error in x[rbind(c(1, 1), c(2, 2), c(-2, 2))] : 
  negative values are not allowed in a matrix subscript
> try(x[rbind(c(1,1), c(2,2), c(-3,2))])
Error in x[rbind(c(1, 1), c(2, 2), c(-3, 2))] : 
  negative values are not allowed in a matrix subscript
> try(x[rbind(c(1,1), c(2,2), c(-4,2))])
Error in x[rbind(c(1, 1), c(2, 2), c(-4, 2))] : 
  negative values are not allowed in a matrix subscript
> try(x[rbind(c(1,1), c(2,2), c(-1,-1))])
Error in x[rbind(c(1, 1), c(2, 2), c(-1, -1))] : 
  negative values are not allowed in a matrix subscript
> try(x[rbind(c(1,1,1), c(2,2,2))])
[1] 1 2 1 2 1 2
> 
> # verify that range checks are applied to negative indices
> x <- matrix(1:6, ncol=3)
> try(x[rbind(c(1,1), c(2,2), c(-3,3))])
Error in x[rbind(c(1, 1), c(2, 2), c(-3, 3))] : 
  negative values are not allowed in a matrix subscript
> try(x[rbind(c(1,1), c(2,2), c(-4,3))])
Error in x[rbind(c(1, 1), c(2, 2), c(-4, 3))] : 
  negative values are not allowed in a matrix subscript
> ## generally allowed in 2.1.0.
> 
> 
> ## printing RAW matrices/arrays was not implemented
> s <- sapply(0:7, function(i) rawShift(charToRaw("my text"),i))
> s
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]   6d   da   b4   68   d0   a0   40   80
[2,]   79   f2   e4   c8   90   20   40   80
[3,]   20   40   80   00   00   00   00   00
[4,]   74   e8   d0   a0   40   80   00   00
[5,]   65   ca   94   28   50   a0   40   80
[6,]   78   f0   e0   c0   80   00   00   00
[7,]   74   e8   d0   a0   40   80   00   00
> dim(s) <- c(7,4,2)
> s
, , 1

     [,1] [,2] [,3] [,4]
[1,]   6d   da   b4   68
[2,]   79   f2   e4   c8
[3,]   20   40   80   00
[4,]   74   e8   d0   a0
[5,]   65   ca   94   28
[6,]   78   f0   e0   c0
[7,]   74   e8   d0   a0

, , 2

     [,1] [,2] [,3] [,4]
[1,]   d0   a0   40   80
[2,]   90   20   40   80
[3,]   00   00   00   00
[4,]   40   80   00   00
[5,]   50   a0   40   80
[6,]   80   00   00   00
[7,]   40   80   00   00

> ## empty < 2.1.1
> 
> 
> ## interpretation of '.' directly by model.matrix
> dd <- data.frame(a = gl(3,4), b = gl(4,1,12))
> model.matrix(~ .^2, data = dd)
   (Intercept) a2 a3 b2 b3 b4 a2:b2 a3:b2 a2:b3 a3:b3 a2:b4 a3:b4
1            1  0  0  0  0  0     0     0     0     0     0     0
2            1  0  0  1  0  0     0     0     0     0     0     0
3            1  0  0  0  1  0     0     0     0     0     0     0
4            1  0  0  0  0  1     0     0     0     0     0     0
5            1  1  0  0  0  0     0     0     0     0     0     0
6            1  1  0  1  0  0     1     0     0     0     0     0
7            1  1  0  0  1  0     0     0     1     0     0     0
8            1  1  0  0  0  1     0     0     0     0     1     0
9            1  0  1  0  0  0     0     0     0     0     0     0
10           1  0  1  1  0  0     0     1     0     0     0     0
11           1  0  1  0  1  0     0     0     0     1     0     0
12           1  0  1  0  0  1     0     0     0     0     0     1
attr(,"assign")
 [1] 0 1 1 2 2 2 3 3 3 3 3 3
attr(,"contrasts")
attr(,"contrasts")$a
[1] "contr.treatment"

attr(,"contrasts")$b
[1] "contr.treatment"

> ## lost ^2 in 2.1.1
> 
> 
> ## add1.lm and drop.lm did not know about offsets (PR#8049)
> set.seed(2)
> y <- rnorm(10)
> z <- 1:10
> lm0 <- lm(y ~ 1)
> lm1 <- lm(y ~ 1, offset = 1:10)
> lm2 <- lm(y ~ z, offset = 1:10)
> 
> add1(lm0, scope = ~ z)
Single term additions

Model:
y ~ 1
       Df  Sum of Sq    RSS      AIC
<none>               6.3161 -2.59479
z       1 0.00029765 6.3158 -0.59526
> anova(lm1, lm2)
Analysis of Variance Table

Model 1: y ~ 1
Model 2: y ~ z
  Res.Df    RSS Df Sum of Sq     F    Pr(>F)    
1      9 89.130                                 
2      8  6.316  1    82.814 104.9 7.099e-06 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> add1(lm1, scope = ~ z)
Single term additions

Model:
y ~ 1
       Df Sum of Sq    RSS     AIC
<none>              89.130 23.8751
z       1    82.814  6.316 -0.5953
> drop1(lm2)
Single term deletions

Model:
y ~ z
       Df Sum of Sq    RSS     AIC
<none>               6.316 -0.5953
z       1    82.814 89.130 23.8751
> ## Last two ignored the offset in 2.1.1
> 
> 
> ## tests of raw conversion
> as.raw(1234)
[1] 00
Warning message:
out-of-range values treated as 0 in coercion to raw 
> as.raw(list(a=1234))
[1] 00
Warning message:
out-of-range values treated as 0 in coercion to raw 
> ## 2.1.1: spurious and missing messages, wrong result for second.
> 
> 
> ### end of tests added in 2.1.1 patched ###
> 
> 
> ## Tests of logical matrix indexing with NAs
> df1 <- data.frame(a = c(NA, 0, 3, 4)); m1 <- as.matrix(df1)
> df2 <- data.frame(a = c(NA, 0, 0, 4)); m2 <- as.matrix(df2)
> df1[df1 == 0] <- 2; df1
   a
1 NA
2  2
3  3
4  4
> m1[m1 == 0] <- 2;   m1
      a
[1,] NA
[2,]  2
[3,]  3
[4,]  4
> df2[df2 == 0] <- 2; df2  # not allowed in 2.{0,1}.z
   a
1 NA
2  2
3  2
4  4
> m2[m2 == 0] <- 2;   m2
      a
[1,] NA
[2,]  2
[3,]  2
[4,]  4
> df1[df1 == 2] # this is first coerced to a matrix, and drops to a vector
[1] NA  2
> df3 <- data.frame(a=1:2, b=2:3)
> df3[df3 == 2]            # had spurious names
[1] 2 2
> # but not allowed
> ## (modified to make printed result the same whether numeric() is
> ##  compiled or interpreted)
> ## try(df2[df2 == 2] <- 1:2)
> ## try(m2[m2 == 2] <- 1:2)
> tryCatch(df2[df2 == 2] <- 1:2,
+          error = function(e) paste("Error:", conditionMessage(e)))
[1] "Error: NAs are not allowed in subscripted assignments"
> tryCatch(m2[m2 == 2] <- 1:2,
+          error = function(e) paste("Error:", conditionMessage(e)))
[1] "Error: NAs are not allowed in subscripted assignments"
> ##
> 
> 
> ## vector indexing of matrices: issue is when rownames are used
> # 1D array
> m1 <- c(0,1,2,0)
> dim(m1) <- 4
> dimnames(m1) <- list(1:4)
> m1[m1 == 0]                        # has rownames
1 4 
0 0 
> m1[which(m1 == 0)]                 # has rownames
1 4 
0 0 
> m1[which(m1 == 0, arr.ind = TRUE)] # no names < 2.2.0 (side effect of PR#937)
1 4 
0 0 
> 
> # 2D array with 2 cols
> m2 <- as.matrix(data.frame(a=c(0,1,2,0), b=0:3))
> m2[m2 == 0]                        # a vector, had names < 2.2.0
[1] 0 0 0
> m2[which(m2 == 0)]                 # a vector, had names < 2.2.0
[1] 0 0 0
> m2[which(m2 == 0, arr.ind = TRUE)] # no names (PR#937)
[1] 0 0 0
> 
> # 2D array with one col: could use rownames but do not.
> m21 <- m2[, 1, drop = FALSE]
> m21[m21 == 0]
[1] 0 0
> m21[which(m21 == 0)]
[1] 0 0
> m21[which(m21 == 0, arr.ind = TRUE)]
[1] 0 0
> ## not consistent < 2.2.0: S never gives names
> 
> 
> ## tests of indexing as quoted in Extract.Rd
> x <- NULL
> x$foo <- 2
> x # length-1 vector
$foo
[1] 2

> x <- NULL
> x[[2]] <- pi
> x # numeric vector
[1]       NA 3.141593
> x <- NULL
> x[[1]] <- 1:3
> x # list
[[1]]
[1] 1 2 3

> ##
> 
> 
> ## printing of a kernel:
> kernel(1)
unknown 
coef[0] = 1
> ## printed wrongly in R <= 2.1.1
> 
> 
> ## using NULL as a replacement value
> DF <- data.frame(A=1:2, B=3:4)
> try(DF[2, 1:3] <- NULL)
Error in `[<-.data.frame`(`*tmp*`, 2, 1:3, value = NULL) : 
  replacement has length zero
> ## wrong error message in R < 2.2.0
> 
> 
> ## tests of signif
> ob <- 0:9 * 2000
> print(signif(ob, 3), digits=17) # had rounding error in 2.1.1
 [1]     0  2000  4000  6000  8000 10000 12000 14000 16000 18000
> signif(1.2347e-305, 4)
[1] 1.235e-305
> signif(1.2347e-306, 4)  # only 3 digits in 2.1.1
[1] 1.235e-306
> signif(1.2347e-307, 4)
[1] 1.235e-307
> ##
> 
> ### end of tests added in 2.2.0 patched ###
> 
> 
> ## printing lists with NA names
> A <- list(1, 2)
> names(A) <- c("NA", NA)
> A
$`NA`
[1] 1

$<NA>
[1] 2

> ## both printed as "NA" in 2.2.0
> 
> 
> ## subscripting with both NA and "NA" names
> x <- 1:4
> names(x) <- c(NA, "NA", "a", "")
> x[names(x)]
<NA>   NA    a <NA> 
  NA    2    3   NA 
> ## 2.2.0 had the second matching the first.
> lx <- as.list(x)
> lx[[as.character(NA)]]
NULL
> lx[as.character(NA)]
$<NA>
NULL

> ## 2.2.0 had both matching element 1
> 
> 
> ## data frame replacement subscripting
> # Charles C. Berry, R-devel, 2005-10-26
> a.frame <- data.frame( x=letters[1:5] )
> a.frame[ 2:5, "y" ] <- letters[2:5]
> a.frame  # added rows 1:4
  x    y
1 a <NA>
2 b    b
3 c    c
4 d    d
5 e    e
> # and adding and replacing matrices failed
> a.frame[ ,"y" ] <- matrix(1:10, 5, 2)
> a.frame
  x y.1 y.2
1 a   1   6
2 b   2   7
3 c   3   8
4 d   4   9
5 e   5  10
> a.frame[3:5 ,"y" ] <- matrix(1:6, 3, 2)
> a.frame
  x y.1 y.2
1 a   1   6
2 b   2   7
3 c   1   4
4 d   2   5
5 e   3   6
> a.frame <- data.frame( x=letters[1:5] )
> a.frame[3:5 ,"y" ] <- matrix(1:6, 3, 2)
> a.frame
  x y.1 y.2
1 a  NA  NA
2 b  NA  NA
3 c   1   4
4 d   2   5
5 e   3   6
> ## failed/wrong ans in 2.2.0
> 
> 
> ### end of tests added in 2.2.0 patched ###
> 
> 
> ## test of fix of trivial warning PR#8252
> pairs(iris[1:4], oma=rep(3,4))
> ## warned in 2.2.0 only
> 
> 
> ## str(<dendrogram>)
> dend <- as.dendrogram(hclust(dist(USArrests), "ave")) # "print()" method
> dend2 <- cut(dend, h=70)
> str(dend2$upper)
--[dendrogram w/ 2 branches and 4 members at h = 152]
  |--[dendrogram w/ 2 branches and 2 members at h = 77.6]
  |  |--leaf "Branch 1" (h= 38.5 midpoint = 0.5, x.member = 2 )
  |  `--leaf "Branch 2" (h= 44.3 midpoint = 5.03, x.member = 14 )
  `--[dendrogram w/ 2 branches and 2 members at h = 89.2]
     |--leaf "Branch 3" (h= 44.8 midpoint = 6.8, x.member = 14 )
     `--leaf "Branch 4" (h= 54.7 midpoint = 7.65, x.member = 20 )
> ## {{for Emacs: `}}  gave much too many spaces in 2.2.[01]
> 
> 
> ## formatC on Windows (PR#8337)
> xx  <- pi * 10^(-5:4)
> cbind(formatC(xx, wid = 9))
      [,1]       
 [1,] "3.142e-05"
 [2,] "0.0003142"
 [3,] " 0.003142"
 [4,] "  0.03142"
 [5,] "   0.3142"
 [6,] "    3.142"
 [7,] "    31.42"
 [8,] "    314.2"
 [9,] "     3142"
[10,] "3.142e+04"
> cbind(formatC(xx, wid = 9, flag = "-"))
      [,1]       
 [1,] "3.142e-05"
 [2,] "0.0003142"
 [3,] "0.003142 "
 [4,] "0.03142  "
 [5,] "0.3142   "
 [6,] "3.142    "
 [7,] "31.42    "
 [8,] "314.2    "
 [9,] "3142     "
[10,] "3.142e+04"
> cbind(formatC(xx, wid = 9, flag = "0"))
      [,1]       
 [1,] "3.142e-05"
 [2,] "0.0003142"
 [3,] "00.003142"
 [4,] "000.03142"
 [5,] "0000.3142"
 [6,] "00003.142"
 [7,] "000031.42"
 [8,] "0000314.2"
 [9,] "000003142"
[10,] "3.142e+04"
> ## extra space on 2.2.1
> 
> 
> ## an impossible glm fit
> success <- c(13,12,11,14,14,11,13,11,12)
> failure <- c(0,0,0,0,0,0,0,2,2)
> predictor <- c(0, 5^(0:7))
> try(glm(cbind(success,failure) ~ 0+predictor, family = binomial(link="log")))
Error : no valid set of coefficients has been found: please supply starting values
> # no coefficient is possible as the first case will have mu = 1
> ## 2.2.1 gave a subscript out of range warning instead.
> 
> 
> ## error message from solve (PR#8494)
> temp <- diag(1, 5)[, 1:4]
> rownames(temp) <- as.character(1:5)
> colnames(temp) <- as.character(1:4)
> try(solve(temp))
Error in solve.default(temp) : 'a' (5 x 4) must be square
> # also complex
> try(solve(temp+0i))
Error in solve.default(temp + (0+0i)) : 'a' (5 x 4) must be square
> # and non-comformant systems
> try(solve(temp, diag(3)))
Error in solve.default(temp, diag(3)) : 'a' (5 x 4) must be square
> ## gave errors from rownames<- in 2.2.1
> 
> 
> ## PR#8462 terms.formula(simplify = TRUE) needs parentheses.
> update.formula (Reaction ~ Days + (Days | Subject), . ~ . + I(Days^2))
Reaction ~ Days + (Days | Subject) + I(Days^2)
> ## < 2.3.0 dropped parens on second term.
> 
> 
> ## PR#8528: errors in the post-2.1.0 pgamma
> pgamma(seq(0.75, 1.25, by=0.05)*1e100, shape = 1e100, log=TRUE)
 [1] -3.768207e+98 -2.314355e+98 -1.251893e+98 -5.360516e+97 -1.293294e+97
 [6] -6.931472e-01  0.000000e+00  0.000000e+00  0.000000e+00  0.000000e+00
[11]  0.000000e+00
> pgamma(seq(0.75, 1.25, by=0.05)*1e100, shape = 1e100, log=TRUE, lower=FALSE)
 [1]  0.000000e+00  0.000000e+00  0.000000e+00  0.000000e+00  0.000000e+00
 [6] -6.931472e-01 -1.209836e+97 -4.689820e+97 -1.023806e+98 -1.767844e+98
[11] -2.685645e+98
> pgamma(c(1-1e-10, 1+1e-10)*1e100, shape = 1e100)
[1] 0 1
> pgamma(0.9*1e25, 1e25, log=TRUE)
[1] -5.360516e+22
> ## were NaN, -Inf etc in 2.2.1.
> 
> 
> ## + for POSIXt objects was non-commutative
> # SPSS-style dates
> c(10485849600,10477641600,10561104000,10562745600)+ISOdate(1582,10,14)
[1] "1915-01-26 12:00:00 GMT" "1914-10-23 12:00:00 GMT"
[3] "1917-06-15 12:00:00 GMT" "1917-07-04 12:00:00 GMT"
> ## was in the local time zone in 2.2.1.
> 
> 
> ## Limiting lines on deparse (wishlist PR#8638)
> op <- options(deparse.max.lines = 3)
> f <- function(...) browser()
> do.call(f, mtcars)
Called from: (function (...) 
browser())(mpg = c(21, 21, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 
22.8, 19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 32.4, 30.4, 
  ...
Browse[1]> c
> 
> options(error = expression(NULL))
> f <- function(...) stop()
> do.call(f, mtcars)
Error in (function (...)  : 
Calls: do.call -> <Anonymous>
> traceback()
3: stop()
2: (function (...) 
   stop())(mpg = c(21, 21, 22.8, 21.4, 18.7, 18.1, 14.3, 24.4, 22.8, 
   19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 32.4, 30.4, 33.9, 
    ...
1: do.call(f, mtcars)
> 
> options(op)
> ## unlimited < 2.3.0
> 
> 
> ## row names in as.table (PR#8652)
> as.table(matrix(1:60, ncol=2))
    A  B
A   1 31
B   2 32
C   3 33
D   4 34
E   5 35
F   6 36
G   7 37
H   8 38
I   9 39
J  10 40
K  11 41
L  12 42
M  13 43
N  14 44
O  15 45
P  16 46
Q  17 47
R  18 48
S  19 49
T  20 50
U  21 51
V  22 52
W  23 53
X  24 54
Y  25 55
Z  26 56
A1 27 57
B1 28 58
C1 29 59
D1 30 60
> ## rows past 26 had NA row names
> 
> 
> ## summary on a glm with zero weights and estimated dispersion (PR#8720)
> y <- rnorm(10)
> x <- 1:10
> w <- c(rep(1,9), 0)
> summary(glm(y ~ x, weights = w))

Call:
glm(formula = y ~ x, weights = w)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.7806  -0.1416   0.1863   0.5690   1.2057  

Coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept)  -0.7532     0.7862  -0.958    0.370
x             0.1311     0.1397   0.938    0.379

(Dispersion parameter for gaussian family taken to be 1.17125)

    Null deviance: 9.2298  on 8  degrees of freedom
Residual deviance: 8.1988  on 7  degrees of freedom
AIC: Inf

Number of Fisher Scoring iterations: 2

Warning message:
In summary.glm(glm(y ~ x, weights = w)) :
  observations with zero weight not used for calculating dispersion
> summary(glm(y ~ x, subset = w > 0))

Call:
glm(formula = y ~ x, subset = w > 0)

Deviance Residuals: 
    Min       1Q   Median       3Q      Max  
-1.7806  -0.1582   0.3726   0.5896   1.2057  

Coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept)  -0.7532     0.7862  -0.958    0.370
x             0.1311     0.1397   0.938    0.379

(Dispersion parameter for gaussian family taken to be 1.17125)

    Null deviance: 9.2298  on 8  degrees of freedom
Residual deviance: 8.1988  on 7  degrees of freedom
AIC: 30.702

Number of Fisher Scoring iterations: 2

> ## has NA dispersion in 2.2.1
> 
> 
> ## substitute was losing "..." after r37269
> yaa <- function(...) substitute(list(...))
> yaa(foo(...))
list(foo(...))
> ## and wasn't substituting after "..."
> substitute(list(..., x), list(x=1))
list(..., 1)
> ## fixed for 2.3.0
> 
> 
> ## uniroot never warned (PR#8750)
> ff <- function(x) (x-pi)^3
> uniroot(ff, c(-10,10), maxiter=10)
$root
[1] 3.291126

$f.root
[1] 0.003343587

$iter
[1] 10

$init.it
[1] NA

$estim.prec
[1] 0.8295023

Warning message:
In uniroot(ff, c(-10, 10), maxiter = 10) : _NOT_ converged in 10 iterations
> ## should warn, did not < 2.3.0
> 
> 
> ### end of tests added in 2.3.0 ###
> 
> 
> ## prod etc on empty lists and raw vectors
> try(min(list()))
Error in min(list()) : invalid 'type' (list) of argument
> try(max(list()))
Error in max(list()) : invalid 'type' (list) of argument
> try(sum(list()))
Error in sum(list()) : invalid 'type' (list) of argument
> try(prod(list()))
Error in prod(list()) : invalid 'type' (list) of argument
> try(min(raw()))
Error in min(raw()) : invalid 'type' (raw) of argument
> try(max(raw()))
Error in max(raw()) : invalid 'type' (raw) of argument
> try(sum(raw()))
Error in sum(raw()) : invalid 'type' (raw) of argument
> try(prod(raw()))
Error in prod(raw()) : invalid 'type' (raw) of argument
> ## Inf, -Inf, list(NULL) etc in 2.2.1
> 
> r <- hist(rnorm(100), plot = FALSE, breaks = 12,
+           ## arguments which don't make sense for plot=FALSE - give a warning:
+           xlab = "N(0,1)", col = "blue")
Warning message:
In hist.default(rnorm(100), plot = FALSE, breaks = 12, xlab = "N(0,1)",  :
  arguments 'col', 'xlab' are not made use of
> ## gave no warning in 2.3.0 and earlier
> 
> 
> ## rbind.data.frame on permuted cols (PR#8868)
> d1 <- data.frame(x=1:10, y=letters[1:10], z=1:10)
> d2 <- data.frame(y=LETTERS[1:5], z=5:1, x=7:11)
> rbind(d1, d2)
    x y  z
1   1 a  1
2   2 b  2
3   3 c  3
4   4 d  4
5   5 e  5
6   6 f  6
7   7 g  7
8   8 h  8
9   9 i  9
10 10 j 10
11  7 A  5
12  8 B  4
13  9 C  3
14 10 D  2
15 11 E  1
> # got factor y  wrong in 2.3.0
> # and failed with duplicated col names.
> d1 <- data.frame(x=1:2, y=5:6, x=8:9, check.names=FALSE)
> d2 <- data.frame(x=3:4, x=-(1:2), y=8:9, check.names=FALSE)
> rbind(d1, d2)
  x y  x
1 1 5  8
2 2 6  9
3 3 8 -1
4 4 9 -2
> ## corrupt in 2.3.0
> 
> 
> ## sort.list on complex vectors was unimplemented prior to 2.4.0
> x <- rep(2:1, c(2, 2)) + 1i*c(4, 1, 2, 3)
> (o <- sort.list(x))
[1] 3 4 2 1
> x[o]
[1] 1+2i 1+3i 2+1i 2+4i
> sort(x)  # for a cross-check
[1] 1+2i 1+3i 2+1i 2+4i
> ##
> 
> 
> ## PR#9044 write.table(quote=TRUE, row.names=FALSE) did not quote column names
> m <- matrix(1:9, nrow=3, dimnames=list(c("A","B","C"),  c("I","II","III")))
> write.table(m)
"I" "II" "III"
"A" 1 4 7
"B" 2 5 8
"C" 3 6 9
> write.table(m, col.names=FALSE)
"A" 1 4 7
"B" 2 5 8
"C" 3 6 9
> write.table(m, row.names=FALSE)
"I" "II" "III"
1 4 7
2 5 8
3 6 9
> # wrong < 2.3.1 patched.
> write.table(m, quote=FALSE)
I II III
A 1 4 7
B 2 5 8
C 3 6 9
> write.table(m, col.names=FALSE, quote=FALSE)
A 1 4 7
B 2 5 8
C 3 6 9
> write.table(m, row.names=FALSE, quote=FALSE)
I II III
1 4 7
2 5 8
3 6 9
> d <- as.data.frame(m)
> write.table(d)
"I" "II" "III"
"A" 1 4 7
"B" 2 5 8
"C" 3 6 9
> write.table(d, col.names=FALSE)
"A" 1 4 7
"B" 2 5 8
"C" 3 6 9
> write.table(d, row.names=FALSE)
"I" "II" "III"
1 4 7
2 5 8
3 6 9
> write.table(d, quote=FALSE)
I II III
A 1 4 7
B 2 5 8
C 3 6 9
> write.table(d, col.names=FALSE, quote=FALSE)
A 1 4 7
B 2 5 8
C 3 6 9
> write.table(d, row.names=FALSE, quote=FALSE)
I II III
1 4 7
2 5 8
3 6 9
> write.table(m, quote=numeric(0)) # not the same as FALSE
"I" "II" "III"
"A" 1 4 7
"B" 2 5 8
"C" 3 6 9
> ##
> 
> 
> ## removing variable from baseenv
> try(remove("ls", envir=baseenv()))
Error in remove("ls", envir = baseenv()) : 
  cannot remove variables from the base environment
> try(remove("ls", envir=asNamespace("base")))
Error in remove("ls", envir = asNamespace("base")) : 
  cannot remove variables from base namespace
> ## no message in 2.3.1
> 
> 
> ## tests of behaviour of factors
> (x <- factor(LETTERS[1:5])[2:4])
[1] B C D
Levels: A B C D E
> x[2]
[1] C
Levels: A B C D E
> x[[2]]
[1] C
Levels: A B C D E
> stopifnot(identical(x[2], x[[2]]))
> as.list(x)
[[1]]
[1] B
Levels: A B C D E

[[2]]
[1] C
Levels: A B C D E

[[3]]
[1] D
Levels: A B C D E

> (xx <- unlist(as.list(x)))
[1] B C D
Levels: A B C D E
> stopifnot(identical(x, xx))
> as.vector(x, "list")
[[1]]
[1] B
Levels: A B C D E

[[2]]
[1] C
Levels: A B C D E

[[3]]
[1] D
Levels: A B C D E

> (sx <- sapply(x, function(.).))
[1] B C D
Levels: A B C D E
> stopifnot(identical(x, sx))
> ## changed in 2.4.0
> 
> 
> ## as.character on a factor with "NA" level
> as.character(as.factor(c("AB", "CD", NA)))
[1] "AB" "CD" NA  
> as.character(as.factor(c("NA", "CD", NA)))  # use <NA> is 2.3.x
[1] "NA" "CD" NA  
> as.vector(as.factor(c("NA", "CD", NA)))     # but this did not
[1] "NA" "CD" NA  
> ## used <NA> before
> 
> 
> ## [ on a zero-column data frame, names of such
> data.frame()[FALSE]
data frame with 0 columns and 0 rows
> names(data.frame())
character(0)
> # gave NULL names and hence spurious warning.
> 
> 
> ## residuals from zero-weight glm fits
> d.AD <- data.frame(treatment = gl(3,3), outcome = gl(3,1,9),
+                    counts = c(18,17,15,20,10,20,25,13,12))
> fit <- glm(counts ~ outcome + treatment, family = poisson,
+            data = d.AD, weights = c(0, rep(1,8)))
> residuals(fit, type="working") # first was NA < 2.4.0
          1           2           3           4           5           6 
-0.31250000  0.15546875 -0.13231383 -0.11111111 -0.20909091  0.34622824 
          7           8           9 
 0.11111111  0.02818182 -0.19226306 
> ## working residuals were NA for zero-weight cases.
> fit2 <- glm(counts ~ outcome + treatment, family = poisson,
+            data = d.AD, weights = c(0, rep(1,8)), y = FALSE)
> for(z in c("response", "working", "deviance", "pearson"))
+     stopifnot(all.equal(residuals(fit, type=z), residuals(fit2, type=z),
+                         scale = 1, tolerance = 1e-10))
> 
> ## apply on arrays with zero extents
> ## Robin Hankin, R-help, 2006-02-13
> A <- array(0, c(3, 0, 4))
> dimnames(A) <- list(D1 = letters[1:3], D2 = NULL, D3 = LETTERS[1:4])
> f <- function(x) 5
> apply(A, 1:2, f)
   D2
D1 
  a
  b
  c
> apply(A, 1, f)
a b c 
5 5 5 
> apply(A, 2, f)
numeric(0)
> ## dropped dims in 2.3.1
> 
> 
> ## print a factor with names
> structure(factor(1:4), names = letters[1:4])
a b c d 
1 2 3 4 
Levels: 1 2 3 4
> ## dropped names < 2.4.0
> 
> 
> ## some tests of factor matrices
> A <- factor(7:12)
> dim(A) <- c(2, 3)
> A
     [,1] [,2] [,3]
[1,] 7    9    11  
[2,] 8    10   12  
Levels: 7 8 9 10 11 12
> str(A)
 factor [1:2, 1:3] 7 8 9 10 ...
 - attr(*, "levels")= chr [1:6] "7" "8" "9" "10" ...
> A[, 1:2]
     [,1] [,2]
[1,] 7    9   
[2,] 8    10  
Levels: 7 8 9 10 11 12
> A[, 1:2, drop=TRUE]
[1] 7  8  9  10
Levels: 7 8 9 10
> A[1,1] <- "9"
> A
     [,1] [,2] [,3]
[1,] 9    9    11  
[2,] 8    10   12  
Levels: 7 8 9 10 11 12
> ## misbehaved < 2.4.0
> 
> 
> ## [dpqr]t with vector ncp
> nc <- c(0, 0.0001, 1)
> dt(1.8, 10, nc)
[1] 0.08311639 0.08312972 0.26650393
> pt(1.8, 10, nc)
[1] 0.9489739 0.9489641 0.7584267
> qt(0.95, 10, nc)
[1] 1.812461 1.812579 3.041742
> ## gave warnings in 2.3.1, short answer for qt.
> dt(1.8, 10, -nc[-1])
[1] 0.08310306 0.01074629
> pt(1.8, 10, -nc[-1])
[1] 0.9489837 0.9949472
> qt(0.95, 10, -nc[-1])
[1] 1.8123429 0.6797902
> ## qt in 2.3.1 did not allow negative ncp.
> 
> 
> ## merge() used to insert row names as factor, not character, so
> ## sorting was unexpected.
> A <- data.frame(a = 1:4)
> row.names(A) <- c("2002-11-15", "2002-12-15", "2003-01-15", "2003-02-15")
> B <- data.frame(b = 1:4)
> row.names(B) <- c("2002-09-15", "2002-10-15", "2002-11-15", "2002-12-15")
> merge(A, B, by=0, all=TRUE)
   Row.names  a  b
1 2002-09-15 NA  1
2 2002-10-15 NA  2
3 2002-11-15  1  3
4 2002-12-15  2  4
5 2003-01-15  3 NA
6 2003-02-15  4 NA
> 
> 
> ## assigning to a list loop index could alter the index (PR#9216)
> L <- list(a = list(txt = "original value"))
> f <- function(LL) {
+     for (ll in LL) ll$txt <- "changed in f"
+     LL
+ }
> f(L)
$a
$a$txt
[1] "original value"


> L
$a
$a$txt
[1] "original value"


> ## both were changed < 2.4.0
> 
> 
> ## summary.mlm misbehaved with na.action = na.exclude
> n <- 50
> x <- runif(n=n)
> y1 <- 2 * x + rnorm(n=n)
> y2 <- 5 * x + rnorm(n=n)
> y2[sample(1:n, size=5)] <- NA
> y <- cbind(y1, y2)
> fit <- lm(y ~ 1, na.action="na.exclude")
> summary(fit)
Response y1 :

Call:
lm(formula = y1 ~ 1, na.action = "na.exclude")

Residuals:
    Min      1Q  Median      3Q     Max 
-3.2806 -0.9057  0.0500  0.8020  2.5458 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   1.1866     0.1797   6.602  4.4e-08 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.206 on 44 degrees of freedom
  (5 observations deleted due to missingness)


Response y2 :

Call:
lm(formula = y2 ~ 1, na.action = "na.exclude")

Residuals:
    Min      1Q  Median      3Q     Max 
-4.4712 -0.6591  0.3364  1.0945  3.6686 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)   2.8988     0.2586   11.21 1.75e-14 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 1.735 on 44 degrees of freedom
  (5 observations deleted due to missingness)


> ## failed < 2.4.0
> 
> RNGkind("default","default")## reset to default - ease  R core
> 
> ## prettyNum lost attributes (PR#8695)
> format(matrix(1:16, 4), big.mark = ",")
     [,1] [,2] [,3] [,4]
[1,] " 1" " 5" " 9" "13"
[2,] " 2" " 6" "10" "14"
[3,] " 3" " 7" "11" "15"
[4,] " 4" " 8" "12" "16"
> ## was a vector < 2.4.0
> 
> 
> ## printing of complex numbers of very different magnitudes
> 1e100  + 1e44i
[1] 1e+100+0e+00i
> 1e100 + pi*1i*10^(c(-100,0,1,40,100))
[1] 1e+100+ 0.000000e+00i 1e+100+ 0.000000e+00i 1e+100+ 0.000000e+00i
[4] 1e+100+ 0.000000e+00i 1e+100+3.141593e+100i
> ## first was silly, second not rounded correctly in 2.2.0 - 2.3.1
> ## We don't get them lining up, but that is a printf issue
> ## that only happens for very large complex nos.
> 
> 
> ### end of tests added in 2.4.0 ###
> 
> 
> ## Platform-specific behaviour in lowess reported to R-help
> ## 2006-10-12 by Frank Harrell
> x <- c(0,7,8,14,15,120,242)
> y <- c(122,128,130,158,110,110,92)
> lowess(x, y, iter=0)
$x
[1]   0   7   8  14  15 120 242

$y
[1] 121.95735 128.00000 131.06649 136.93673 126.76467 109.99903  92.00003

> lowess(x, y)
$x
[1]   0   7   8  14  15 120 242

$y
[1] 122 128 128 158 110 110  92

> ## MAD of iterated residuals was zero, and result depended on the platform.
> 
> 
> ## PR#9263: problems with R_Visible
> a <- list(b=5)
> a[[(t<-'b')]]
[1] 5
> x <- matrix(5:-6, 3)
> x[2, invisible(3)]
[1] -2
> ## both invisible in 2.4.0
> 
> 
> ### end of tests added in 2.4.1 ###
> 
> 
> ## tests of deparsing
> x <-list(a = NA, b = as.integer(NA), c=0+NA, d=0i+NA,
+          e = 1, f = 1:1, g = 1:3, h = c(NA, 1:3),
+          i = as.character(NA), j = c("foo", NA, "bar")
+          )
> dput(x, control=NULL)
list(a = NA, b = NA, c = NA, d = NA, e = 1, f = 1, g = 1:3, h = c(NA, 
1, 2, 3), i = NA, j = c("foo", NA, "bar"))
> dput(x, control="keepInteger")
list(a = NA, b = NA_integer_, c = NA, d = NA, e = 1, f = 1L, 
    g = 1:3, h = c(NA, 1L, 2L, 3L), i = NA, j = c("foo", NA, 
    "bar"))
> dput(x, control="keepNA")
list(a = NA, b = NA_integer_, c = NA_real_, d = NA_complex_, 
    e = 1, f = 1, g = 1:3, h = c(NA, 1, 2, 3), i = NA_character_, 
    j = c("foo", NA, "bar"))
> dput(x)
structure(list(a = NA, b = NA_integer_, c = NA_real_, d = NA_complex_, 
    e = 1, f = 1L, g = 1:3, h = c(NA, 1L, 2L, 3L), i = NA_character_, 
    j = c("foo", NA, "bar")), .Names = c("a", "b", "c", "d", 
"e", "f", "g", "h", "i", "j"))
> dput(x, control="all")
structure(list(a = NA, b = NA_integer_, c = NA_real_, d = NA_complex_, 
    e = 1, f = 1L, g = 1:3, h = c(NA, 1L, 2L, 3L), i = NA_character_, 
    j = c("foo", NA, "bar")), .Names = c("a", "b", "c", "d", 
"e", "f", "g", "h", "i", "j"))
> dput(x, control=c("all", "S_compatible"))
structure(list(a = NA, b = as.integer(NA), c = as.double(NA), 
    d = as.complex(NA), e = 1., f = as.integer(1), g = 1:3, h = as.integer(c(NA, 
    1, 2, 3)), i = as.character(NA), j = c("foo", NA, "bar")), .Names = c("a", 
"b", "c", "d", "e", "f", "g", "h", "i", "j"))
> tmp <- tempfile()
> dput(x, tmp, control="all")
> stopifnot(identical(dget(tmp), x))
> dput(x, tmp, control=c("all", "S_compatible"))
> stopifnot(identical(dget(tmp), x))
> unlink(tmp)
> ## changes in 2.5.0
> 
> 
> ## give better error message for nls with no parameters
> ## Ivo Welch, R-help, 2006-12-23.
> d <- data.frame(y= runif(10), x=runif(10))
> try(nls(y ~ 1/(1+x), data = d, start=list(x=0.5,y=0.5), trace=TRUE))
Error in nls(y ~ 1/(1 + x), data = d, start = list(x = 0.5, y = 0.5),  : 
  no parameters to fit
> ## changed in 2.4.1 patched
> 
> 
> ## cut(breaks="years"), in part PR#9433
> cut(as.Date(c("2000-01-17","2001-01-13","2001-01-20")), breaks="years")
[1] 2000-01-01 2001-01-01 2001-01-01
Levels: 2000-01-01 2001-01-01
> cut(as.POSIXct(c("2000-01-17","2001-01-13","2001-01-20")), breaks="years")
[1] 2000-01-01 2001-01-01 2001-01-01
Levels: 2000-01-01 2001-01-01
> ## did not get day 01 < 2.4.1 patched
> 
> 
> ## manipulating rownames: problems in pre-2.5.0
> A <- data.frame(a=character(0))
> try(row.names(A) <- 1:10) # succeeded in Dec 2006
Error in `row.names<-.data.frame`(`*tmp*`, value = 1:10) : 
  invalid 'row.names' length
> A <- list(a=1:3)
> class(A) <- "data.frame"
> row.names(A) <- letters[24:26] # failed at one point in Dec 2006
> A
  a
x 1
y 2
z 3
> ##
> 
> 
> ## extreme cases for subsetting of data frames
> w <- women[1, ]
> w[]
  height weight
1     58    115
> w[,drop = TRUE]
  height weight
1     58    115
Warning message:
In `[.data.frame`(w, , drop = TRUE) : 'drop' argument will be ignored
> w[1,]
  height weight
1     58    115
> w[,]
  height weight
1     58    115
> w[1, , drop = FALSE]
  height weight
1     58    115
> w[, , drop = FALSE]
  height weight
1     58    115
> w[1, , drop = TRUE]
$height
[1] 58

$weight
[1] 115

> w[, , drop = TRUE]
$height
[1] 58

$weight
[1] 115

> ## regression test: code changed for 2.5.0
> 
> 
> ## data.frame() with zero columns ignored 'row.names'
> (x <- data.frame(row.names=1:4))
data frame with 0 columns and 4 rows
> nrow(x)
[1] 4
> row.names(x)
[1] "1" "2" "3" "4"
> attr(x, "row.names")
[1] 1 2 3 4
> ## ignored prior to 2.5.0.
> 
> 
> ## identical on data.frames
> d0 <- d1 <- data.frame(1:4, row.names=1:4)
> row.names(d0) <- NULL
> dput(d0)
structure(list(X1.4 = 1:4), .Names = "X1.4", row.names = c(NA, 
-4L), class = "data.frame")
> dput(d1)
structure(list(X1.4 = 1:4), .Names = "X1.4", row.names = c(NA, 
4L), class = "data.frame")
> identical(d0, d1)
[1] TRUE
> all.equal(d0, d1)
[1] TRUE
> row.names(d1) <- as.character(1:4)
> dput(d1)
structure(list(X1.4 = 1:4), .Names = "X1.4", row.names = c("1", 
"2", "3", "4"), class = "data.frame")
> identical(d0, d1)
[1] FALSE
> all.equal(d0, d1)
[1] "Attributes: < Component \"row.names\": Modes: numeric, character >"              
[2] "Attributes: < Component \"row.names\": target is numeric, current is character >"
> ## identical used internal representation prior to 2.5.0
> 
> 
> ## all.equal
> # ignored check.attributes in 2.4.1
> all.equal(data.frame(x=1:5, row.names=letters[1:5]),
+           data.frame(x=1:5,row.names=LETTERS[1:5]),
+           check.attributes=FALSE)
[1] TRUE
> # treated logicals as numeric
> all.equal(c(T, F, F), c(T, T, F))
[1] "1 element mismatch"
> all.equal(c(T, T, F), c(T, F, F))
[1] "1 element mismatch"
> # ignored raw:
> all.equal(as.raw(1:3), as.raw(1:3))
[1] TRUE
> all.equal(as.raw(1:3), as.raw(3:1))
[1] "2 element mismatches"
> ##
> 
> 
> ## tests of deparsing
> # if we run this from stdin, we will have no source, so fake it
> f <- function(x, xm  = max(1L, x)) {xx <- 0L; yy <- NA_real_}
> attr(f, "srcref") <- srcref(srcfilecopy("",
+     "function(x, xm  = max(1L, x)) {xx <- 0L; yy <- NA_real_}"),
+     c(1L, 1L, 1L, 56L))
> f # uses the source
function(x, xm  = max(1L, x)) {xx <- 0L; yy <- NA_real_}
> dput(f) # not source
function (x, xm = max(1L, x)) 
{
    xx <- 0L
    yy <- NA_real_
}
> dput(f, control="all") # uses the source
function(x, xm  = max(1L, x)) {xx <- 0L; yy <- NA_real_}
> cat(deparse(f), sep="\n")
function (x, xm = max(1L, x)) 
{
    xx <- 0L
    yy <- NA_real_
}
> dump("f", file="")
f <-
function(x, xm  = max(1L, x)) {xx <- 0L; yy <- NA_real_}
> # remove the source
> attr(f, "srcref") <- NULL
> f
function (x, xm = max(1L, x)) 
{
    xx <- 0L
    yy <- NA_real_
}
> dput(f, control="all")
function (x, xm = max(1L, x)) 
{
    xx <- 0L
    yy <- NA_real_
}
> dump("f", file="")
f <-
function (x, xm = max(1L, x)) 
{
    xx <- 0L
    yy <- NA_real_
}
> 
> expression(bin <- bin + 1L)
expression(bin <- bin + 1L)
> ## did not preserve e.g. 1L at some point in pre-2.5.0
> 
> 
> ## NAs in substr were handled as large negative numbers
> x <- "abcde"
> substr(x, 1, 3)
[1] "abc"
> substr(x, NA, 1)
[1] NA
> substr(x, 1, NA)
[1] NA
> substr(x, NA, 3) <- "abc"; x
[1] NA
> substr(x, 1, NA) <- "AA"; x
[1] NA
> substr(x, 1, 2) <- NA_character_; x
[1] NA
> ## "" or no change in 2.4.1, except last
> 
> 
> ## regression tests for pmin/pmax, rewritten in C for 2.5.0
> # NULL == integer(0)
> pmin(NULL, integer(0))
integer(0)
> pmax(integer(0), NULL)
integer(0)
> pmin(NULL, 1:3)# now ok
integer(0)
> pmax(pi, NULL, 2:4)
numeric(0)
> 
> x <- c(1, NA, NA, 4, 5)
> y <- c(2, NA, 4, NA, 3)
> pmin(x, y)
[1]  1 NA NA NA  3
> stopifnot(identical(pmin(x, y), pmin(y, x)))
> pmin(x, y, na.rm=TRUE)
[1]  1 NA  4  4  3
> stopifnot(identical(pmin(x, y, na.rm=TRUE), pmin(y, x, na.rm=TRUE)))
> pmax(x, y)
[1]  2 NA NA NA  5
> stopifnot(identical(pmax(x, y), pmax(y, x)))
> pmax(x, y, na.rm=TRUE)
[1]  2 NA  4  4  5
> stopifnot(identical(pmax(x, y, na.rm=TRUE), pmax(y, x, na.rm=TRUE)))
> 
> x <- as.integer(x); y <- as.integer(y)
> pmin(x, y)
[1]  1 NA NA NA  3
> stopifnot(identical(pmin(x, y), pmin(y, x)))
> pmin(x, y, na.rm=TRUE)
[1]  1 NA  4  4  3
> stopifnot(identical(pmin(x, y, na.rm=TRUE), pmin(y, x, na.rm=TRUE)))
> pmax(x, y)
[1]  2 NA NA NA  5
> stopifnot(identical(pmax(x, y), pmax(y, x)))
> pmax(x, y, na.rm=TRUE)
[1]  2 NA  4  4  5
> stopifnot(identical(pmax(x, y, na.rm=TRUE), pmax(y, x, na.rm=TRUE)))
> 
> x <- as.character(x); y <- as.character(y)
> pmin(x, y)
[1] "1" NA  NA  NA  "3"
> stopifnot(identical(pmin(x, y), pmin(y, x)))
> pmin(x, y, na.rm=TRUE)
[1] "1" NA  "4" "4" "3"
> stopifnot(identical(pmin(x, y, na.rm=TRUE), pmin(y, x, na.rm=TRUE)))
> pmax(x, y)
[1] "2" NA  NA  NA  "5"
> stopifnot(identical(pmax(x, y), pmax(y, x)))
> pmax(x, y, na.rm=TRUE)
[1] "2" NA  "4" "4" "5"
> stopifnot(identical(pmax(x, y, na.rm=TRUE), pmax(y, x, na.rm=TRUE)))
> 
> # tests of classed quantities
> x <- .leap.seconds[1:23]; y <- rev(x)
> x[2] <- y[2] <- x[3] <- y[4] <- NA
> format(pmin(x, y), tz="GMT")  # TZ names differ by platform
 [1] "1972-07-01" NA           NA           NA           "1976-01-01"
 [6] "1977-01-01" "1978-01-01" "1979-01-01" "1980-01-01" "1981-07-01"
[11] "1982-07-01" "1983-07-01" "1982-07-01" "1981-07-01" "1980-01-01"
[16] "1979-01-01" "1978-01-01" "1977-01-01" "1976-01-01" "1975-01-01"
[21] "1974-01-01" "1973-01-01" "1972-07-01"
> class(pmin(x, y))
[1] "POSIXct" "POSIXt" 
> stopifnot(identical(pmin(x, y), pmin(y, x)))
> format(pmin(x, y, na.rm=TRUE), tz="GMT")
 [1] "1972-07-01" NA           "1997-07-01" "1975-01-01" "1976-01-01"
 [6] "1977-01-01" "1978-01-01" "1979-01-01" "1980-01-01" "1981-07-01"
[11] "1982-07-01" "1983-07-01" "1982-07-01" "1981-07-01" "1980-01-01"
[16] "1979-01-01" "1978-01-01" "1977-01-01" "1976-01-01" "1975-01-01"
[21] "1974-01-01" "1973-01-01" "1972-07-01"
> stopifnot(identical(pmin(x, y, na.rm=TRUE), pmin(y, x, na.rm=TRUE)))
> format(pmax(x, y), tz="GMT")
 [1] "2006-01-01" NA           NA           NA           "1994-07-01"
 [6] "1993-07-01" "1992-07-01" "1991-01-01" "1990-01-01" "1988-01-01"
[11] "1985-07-01" "1983-07-01" "1985-07-01" "1988-01-01" "1990-01-01"
[16] "1991-01-01" "1992-07-01" "1993-07-01" "1994-07-01" "1996-01-01"
[21] "1997-07-01" "1999-01-01" "2006-01-01"
> stopifnot(identical(pmax(x, y), pmax(y, x)))
> format(pmax(x, y, na.rm=TRUE), tz="GMT")
 [1] "2006-01-01" NA           "1997-07-01" "1975-01-01" "1994-07-01"
 [6] "1993-07-01" "1992-07-01" "1991-01-01" "1990-01-01" "1988-01-01"
[11] "1985-07-01" "1983-07-01" "1985-07-01" "1988-01-01" "1990-01-01"
[16] "1991-01-01" "1992-07-01" "1993-07-01" "1994-07-01" "1996-01-01"
[21] "1997-07-01" "1999-01-01" "2006-01-01"
> stopifnot(identical(pmax(x, y, na.rm=TRUE), pmax(y, x, na.rm=TRUE)))
> 
> x <- as.POSIXlt(x, tz="GMT"); y <- as.POSIXlt(y, tz="GMT")
> format(pmin(x, y), tz="GMT")
 [1] "1972-07-01" NA           NA           NA           "1976-01-01"
 [6] "1977-01-01" "1978-01-01" "1979-01-01" "1980-01-01" "1981-07-01"
[11] "1982-07-01" "1983-07-01" "1982-07-01" "1981-07-01" "1980-01-01"
[16] "1979-01-01" "1978-01-01" "1977-01-01" "1976-01-01" "1975-01-01"
[21] "1974-01-01" "1973-01-01" "1972-07-01"
> class(pmin(x, y))
[1] "POSIXlt" "POSIXt" 
> stopifnot(identical(pmin(x, y), pmin(y, x)))
> format(pmin(x, y, na.rm=TRUE), tz="GMT")
 [1] "1972-07-01" NA           "1997-07-01" "1975-01-01" "1976-01-01"
 [6] "1977-01-01" "1978-01-01" "1979-01-01" "1980-01-01" "1981-07-01"
[11] "1982-07-01" "1983-07-01" "1982-07-01" "1981-07-01" "1980-01-01"
[16] "1979-01-01" "1978-01-01" "1977-01-01" "1976-01-01" "1975-01-01"
[21] "1974-01-01" "1973-01-01" "1972-07-01"
> stopifnot(identical(pmin(x, y, na.rm=TRUE), pmin(y, x, na.rm=TRUE)))
> format(pmax(x, y), tz="GMT")
 [1] "2006-01-01" NA           NA           NA           "1994-07-01"
 [6] "1993-07-01" "1992-07-01" "1991-01-01" "1990-01-01" "1988-01-01"
[11] "1985-07-01" "1983-07-01" "1985-07-01" "1988-01-01" "1990-01-01"
[16] "1991-01-01" "1992-07-01" "1993-07-01" "1994-07-01" "1996-01-01"
[21] "1997-07-01" "1999-01-01" "2006-01-01"
> stopifnot(identical(pmax(x, y), pmax(y, x)))
> format(pmax(x, y, na.rm=TRUE), tz="GMT")
 [1] "2006-01-01" NA           "1997-07-01" "1975-01-01" "1994-07-01"
 [6] "1993-07-01" "1992-07-01" "1991-01-01" "1990-01-01" "1988-01-01"
[11] "1985-07-01" "1983-07-01" "1985-07-01" "1988-01-01" "1990-01-01"
[16] "1991-01-01" "1992-07-01" "1993-07-01" "1994-07-01" "1996-01-01"
[21] "1997-07-01" "1999-01-01" "2006-01-01"
> stopifnot(identical(pmax(x, y, na.rm=TRUE), pmax(y, x, na.rm=TRUE)))
> ## regresion tests
> 
> 
> ## regression tests on names of 1D arrays
> x <- as.array(1:3)
> names(x) <- letters[x] # sets dimnames, really
> names(x)
[1] "a" "b" "c"
> dimnames(x)
[[1]]
[1] "a" "b" "c"

> attributes(x)
$dim
[1] 3

$dimnames
$dimnames[[1]]
[1] "a" "b" "c"


> names(x) <- NULL
> attr(x, "names") <- LETTERS[x] # sets dimnames, really
> names(x)
[1] "A" "B" "C"
> dimnames(x)
[[1]]
[1] "A" "B" "C"

> attributes(x)
$dim
[1] 3

$dimnames
$dimnames[[1]]
[1] "A" "B" "C"


> ## regression tests
> 
> 
> ## regression tests on NA attribute names
> x <- 1:3
> attr(x, "NA") <- 4
> attributes(x)
$`NA`
[1] 4

> attr(x, "NA")
[1] 4
> attr(x, NA_character_)
NULL
> try(attr(x, NA_character_) <- 5)
Error in attr(x, NA_character_) <- 5 : 
  'name' must be non-null character string
> ## prior to 2.5.0 NA was treated as "NA"
> 
> 
> ## qr with pivoting (PR#9623)
> A <- matrix(c(0,0,0, 1,1,1), nrow = 3,
+             dimnames = list(letters[1:3], c("zero","one")))
> y <- matrix(c(6,7,8), nrow = 3, dimnames = list(LETTERS[1:3], "y"))
> qr.coef(qr(A), y)
      y
zero NA
one   7
> qr.fitted(qr(A), y)
  y
A 7
B 7
C 7
> 
> qr.coef(qr(matrix(0:1, 1, dimnames=list(NULL, c("zero","one")))), 5)
zero  one 
  NA    5 
> ## coef names were returned unpivoted <= 2.5.0
> 
> ## readChar read extra items, terminated on zeros
> x <- as.raw(65:74)
> readChar(x, nchar=c(3,3,0,3,3,3))
[1] "ABC" "DEF" ""    "GHI" "J"  
> f <- tempfile()
> writeChar("ABCDEFGHIJ", con=f, eos=NULL)
> readChar(f, nchar=c(3,3,0,3,3,3))
[1] "ABC" "DEF" ""    "GHI" "J"  
> unlink(f)
> ##
> 
> 
> ## corner cases for cor
> set.seed(1)
> X <- cbind(NA, 1:3, rnorm(3))
> try(cor(X, use = "complete"))
Error in cor(X, use = "complete") : no complete element pairs
> try(cor(X, use = "complete", method="spearman"))
Error in cor(X, use = "complete", method = "spearman") : 
  no complete element pairs
> try(cor(X, use = "complete", method="kendall"))
Error in cor(X, use = "complete", method = "kendall") : 
  no complete element pairs
> cor(X, use = "pair")
     [,1]       [,2]       [,3]
[1,]   NA         NA         NA
[2,]   NA  1.0000000 -0.1942739
[3,]   NA -0.1942739  1.0000000
> cor(X, use = "pair", method="spearman")
     [,1] [,2] [,3]
[1,]   NA   NA   NA
[2,]   NA  1.0 -0.5
[3,]   NA -0.5  1.0
> cor(X, use = "pair", method="kendall")
     [,1]       [,2]       [,3]
[1,]   NA         NA         NA
[2,]   NA  1.0000000 -0.3333333
[3,]   NA -0.3333333  1.0000000
> 
> X[1,1] <- 1
> cor(X, use = "complete")
     [,1] [,2] [,3]
[1,]   NA   NA   NA
[2,]   NA   NA   NA
[3,]   NA   NA   NA
> cor(X, use = "complete", method="spearman")
     [,1] [,2] [,3]
[1,]   NA   NA   NA
[2,]   NA   NA   NA
[3,]   NA   NA   NA
> cor(X, use = "complete", method="kendall")
     [,1] [,2] [,3]
[1,]   NA   NA   NA
[2,]   NA   NA   NA
[3,]   NA   NA   NA
> cor(X, use = "pair")
     [,1]       [,2]       [,3]
[1,]   NA         NA         NA
[2,]   NA  1.0000000 -0.1942739
[3,]   NA -0.1942739  1.0000000
> cor(X, use = "pair", method="spearman")
     [,1] [,2] [,3]
[1,]   NA   NA   NA
[2,]   NA  1.0 -0.5
[3,]   NA -0.5  1.0
> cor(X, use = "pair", method="kendall")
     [,1]       [,2]       [,3]
[1,]   NA         NA         NA
[2,]   NA  1.0000000 -0.3333333
[3,]   NA -0.3333333  1.0000000
> ## not consistent in 2.6.x
> 
> 
> ## confint on rank-deficient models (in part, PR#10494)
> junk <- data.frame(x = rep(1, 10L),
+                    u = factor(sample(c("Y", "N"), 10, replace=TRUE)),
+                    ans = rnorm(10))
> fit <-  lm(ans ~ x + u, data = junk)
> confint(fit)
                 2.5 %    97.5 %
(Intercept) -0.4634457 1.6198116
x                   NA        NA
uY          -2.3607073 0.5854635
> confint.default(fit)
                 2.5 %    97.5 %
(Intercept) -0.3071384 1.4635043
x                   NA        NA
uY          -2.1396554 0.3644116
> ## Mismatch gave NA for 'u' in 2.6.1
> 
> 
> ## corrupt data frame produced by subsetting (PR#10574)
> x <- data.frame(a=1:3, b=2:4)
> x[,3] <- x
Warning message:
In `[<-.data.frame`(`*tmp*`, , 3, value = list(a = 1:3, b = 2:4)) :
  provided 2 variables to replace 1 variables
> x
  a b a.1
1 1 2   1
2 2 3   2
3 3 4   3
> ## warning during printing < 2.7.0
> 
> 
> ## format.factor used to lose dim[names] and names (PR#11512)
> x <- factor(c("aa", letters[-1]))
> dim(x) <- c(13,2)
> format(x, justify="right")
      [,1] [,2]
 [1,] "aa" " n"
 [2,] " b" " o"
 [3,] " c" " p"
 [4,] " d" " q"
 [5,] " e" " r"
 [6,] " f" " s"
 [7,] " g" " t"
 [8,] " h" " u"
 [9,] " i" " v"
[10,] " j" " w"
[11,] " k" " x"
[12,] " l" " y"
[13,] " m" " z"
> ##
> 
> 
> ## removing columns in within (PR#1131)
> abc <- data.frame(a=1:5, b=2:6, c=3:7)
> within(abc, b<-NULL)
  a c
1 1 3
2 2 4
3 3 5
4 4 6
5 5 7
> within(abc,{d<-a+7;b<-NULL})
  a c  d
1 1 3  8
2 2 4  9
3 3 5 10
4 4 6 11
5 5 7 12
> within(abc,{a<-a+7;b<-NULL})
   a c
1  8 3
2  9 4
3 10 5
4 11 6
5 12 7
> ## Second produced corrupt data frame in 2.7.1
> 
> 
> ## aggregate on an empty data frame (PR#13167)
> z <- data.frame(a=integer(0), b=numeric(0))
> try(aggregate(z, by=z[1], FUN=sum))
Error in aggregate.data.frame(z, by = z[1], FUN = sum) : 
  no rows to aggregate
> ## failed in unlist in 2.8.0, now gives explicit message.
> aggregate(data.frame(a=1:10)[F], list(rep(1:2, each=5)), sum)
  Group.1
1       1
2       2
> ## used to fail obscurely.
> 
> 
> ## subsetting data frames with duplicate rows
> z <- data.frame(a=1, a=2, b=3, check.names=FALSE)
> z[] # OK
  a a b
1 1 2 3
> z[1, ]
  a a b
1 1 2 3
> ## had row names a, a.1, b in 2.8.0.
> 
> 
> ## incorrect warning due to lack of fuzz.
> TS <-  ts(co2[1:192], freq=24)
> tmp2 <- window(TS, start(TS), end(TS))
> ## warned in 2.8.0
> 
> ## failed to add tag
> Call <- call("foo", 1)
> Call[["bar"]] <- 2
> Call
foo(1, bar = 2)
> ## unnamed call in 2.8.1
> 
> options(keep.source = TRUE)
> ## $<- on pairlists failed to duplicate (from Felix Andrews,
> ## https://stat.ethz.ch/pipermail/r-devel/2009-January/051698.html)
> foo <- function(given = NULL) {
+     callObj <- quote(callFunc())
+     if(!is.null(given)) callObj$given <- given
+     if (is.null(given)) callObj$default <- TRUE
+     callObj
+ }
> 
> foo()
callFunc(default = TRUE)
> foo(given = TRUE)
callFunc(given = TRUE)
> foo("blah blah")
callFunc(given = "blah blah")
> foo(given = TRUE)
callFunc(given = TRUE)
> foo()
callFunc(default = TRUE)
> ## altered foo() in 2.8.1.
> 
> ## Using  '#' flag in  sprintf():
> forms <- c("%#7.5g","%#5.f", "%#7x", "%#5d", "%#9.0e")
> nums <- list(-3.145, -31,   0xabc,  -123L, 123456)
> rbind(mapply(sprintf, forms,               nums),
+       mapply(sprintf, sub("#", '', forms), nums))
     %#7.5g    %#5.f   %#7x      %#5d    %#9.0e     
[1,] "-3.1450" " -31." "  0xabc" " -123" "   1.e+05"
[2,] " -3.145" "  -31" "    abc" " -123" "    1e+05"
> ## gave an error in pre-release versions of 2.9.0
> 
> ## (auto)printing of functions {with / without source attribute},
> ## including primitives
> sink(con <- textConnection("of", "w")) ; c ; sink(NULL); close(con)
> of2 <- capture.output(print(c))
> stopifnot(identical(of2, of),
+           identical(of2, "function (..., recursive = FALSE)  .Primitive(\"c\")"))
> ## ^^ would have failed up to R 2.9.x
> foo
function(given = NULL) {
    callObj <- quote(callFunc())
    if(!is.null(given)) callObj$given <- given
    if (is.null(given)) callObj$default <- TRUE
    callObj
}
> print(foo, useSource = FALSE)
function (given = NULL) 
{
    callObj <- quote(callFunc())
    if (!is.null(given)) 
        callObj$given <- given
    if (is.null(given)) 
        callObj$default <- TRUE
    callObj
}
> attr(foo, "srcref") <- NULL
> foo
function (given = NULL) 
{
    callObj <- quote(callFunc())
    if (!is.null(given)) 
        callObj$given <- given
    if (is.null(given)) 
        callObj$default <- TRUE
    callObj
}
> (f <- structure(function(){}, note = "just a note",
+                 yada = function() "not the same"))
function(){}
attr(,"note")
[1] "just a note"
attr(,"yada")
function () 
"not the same"
> print(f, useSource = FALSE) # must print attributes
function () 
{
}
attr(,"note")
[1] "just a note"
attr(,"yada")
function () 
"not the same"
> print.function <- function(x, ...) { str(x,...); invisible(x) }
> print.function
function (x, ...)  
 - attr(*, "srcref")=Class 'srcref'  atomic [1:8] 1 19 1 63 19 63 1 1
  .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x4133960> 
> f
function ()  
 - attr(*, "srcref")=Class 'srcref'  atomic [1:8] 1 17 1 28 17 28 1 1
  .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x4125bf8> 
 - attr(*, "note")= chr "just a note"
 - attr(*, "yada")=function ()  
  ..- attr(*, "srcref")=Class 'srcref'  atomic [1:8] 2 24 2 48 24 48 2 2
  .. .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x4125bf8> 
> rm(print.function)
> ## auto-printing and printing differed up to R 2.9.x
> 
> printCoefmat(cbind(0,1))
     [,1] [,2]
[1,]    0    1
> ## would print NaN up to R 2.9.0
> 
> 
> ## continuity correction for Kendall's tau.  Improves this example.
> cor.test(c(1, 2, 3, 4, 5), c(8, 6, 7, 5, 3), method = "kendall",
+          exact = TRUE)

	Kendall's rank correlation tau

data:  c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)
T = 1, p-value = 0.08333
alternative hypothesis: true tau is not equal to 0
sample estimates:
 tau 
-0.8 

> cor.test(c(1, 2, 3, 4, 5), c(8, 6, 7, 5, 3), method = "kendall",
+          exact = FALSE)

	Kendall's rank correlation tau

data:  c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)
z = -1.9596, p-value = 0.05004
alternative hypothesis: true tau is not equal to 0
sample estimates:
 tau 
-0.8 

> cor.test(c(1, 2, 3, 4, 5), c(8, 6, 7, 5, 3), method = "kendall",
+          exact = FALSE, continuity = TRUE)

	Kendall's rank correlation tau

data:  c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)
z = -1.7146, p-value = 0.08641
alternative hypothesis: true tau is not equal to 0
sample estimates:
 tau 
-0.8 

> # and a little for Spearman's
> cor.test(c(1, 2, 3, 4, 5), c(8, 6, 7, 5, 3), method = "spearman",
+          exact = TRUE)

	Spearman's rank correlation rho

data:  c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)
S = 38, p-value = 0.08333
alternative hypothesis: true rho is not equal to 0
sample estimates:
 rho 
-0.9 

> cor.test(c(1, 2, 3, 4, 5), c(8, 6, 7, 5, 3), method = "spearman",
+          exact = FALSE)

	Spearman's rank correlation rho

data:  c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)
S = 38, p-value = 0.03739
alternative hypothesis: true rho is not equal to 0
sample estimates:
 rho 
-0.9 

> cor.test(c(1, 2, 3, 4, 5), c(8, 6, 7, 5, 3), method = "spearman",
+          exact = FALSE, continuity = TRUE)

	Spearman's rank correlation rho

data:  c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)
S = 38, p-value = 0.09689
alternative hypothesis: true rho is not equal to 0
sample estimates:
 rho 
-0.9 

> ## Kendall case is wish of PR#13691
> 
> 
> ## corrupt data frame, PR#13724
> foo <- matrix(1:12, nrow = 3)
> bar <- as.data.frame(foo)
> val <- integer(0)
> try(bar$NewCol <- val)
Error in `$<-.data.frame`(`*tmp*`, "NewCol", value = integer(0)) : 
  replacement has 0 rows, data has 3
> # similar, not in the report
> try(bar[["NewCol"]] <- val)
Error in `[[<-.data.frame`(`*tmp*`, "NewCol", value = integer(0)) : 
  replacement has 0 rows, data has 3
> # [ ] is tricker, so just check the result is reasonable and prints
> bar["NewCol"] <- val
> bar[, "NewCol2"] <- val
> bar[FALSE, "NewCol3"] <- val
> bar
  V1 V2 V3 V4 NewCol NewCol2 NewCol3
1  1  4  7 10     NA      NA      NA
2  2  5  8 11     NA      NA      NA
3  3  6  9 12     NA      NA      NA
> ## Succeeded but gave corrupt result in 2.9.0
> 
> 
> ## Printing NA_complex_
> m22 <- matrix(list(NA_complex_, 3, "A string", NA_complex_), 2,2)
> print(m22)
     [,1] [,2]      
[1,] NA   "A string"
[2,] 3    NA        
> print(m22, na.print="<missing value>")
     [,1]            [,2]           
[1,] <missing value> "A string"     
[2,] 3               <missing value>
> ## used uninitialized variable in C, noticably Windows, for R <= 2.9.0
> 
> 
> ## non-standard variable names in update etc
> ## never guaranteed to work, requested by Sundar Dorai-Raj in
> ## https://stat.ethz.ch/pipermail/r-devel/2009-July/054184.html
> update(`a: b` ~ x, ~ . + y)
`a: b` ~ x + y
> ## 2.9.1 dropped backticks
> 
> 
> ## print(ls.str(.)) did evaluate calls
> E <- new.env(); E$cl <- call("print", "Boo !")
> ls.str(E)
cl :  language print("Boo !")
> ## 2.10.0 did print..
> 
> 
> ## complete.cases with no input
> try(complete.cases())
Error in complete.cases() : no input has determined the number of cases
> try(complete.cases(list(), list()))
Error in complete.cases(list(), list()) : 
  no input has determined the number of cases
> ## gave unhelpful messages in 2.10.0, silly results in pre-2.10.1
> 
> 
> ## error messages from (C-level) evalList
> tst <- function(y) { stopifnot(is.numeric(y)); y+ 1 }
> try(tst())
Error in stopifnot(is.numeric(y)) : 
  argument "y" is missing, with no default
> try(c(1,,2))
Error in c(1, , 2) : argument 2 is empty
> ## change in 2.8.0 made these less clear
> 
> 
> ## empty levels from cut.Date (cosmetic, PR#14162)
> x <- as.Date(c("2009-03-21","2009-03-31"))
> cut(x, breaks= "quarter") # had two levels in 2.10.1
[1] 2009-01-01 2009-01-01
Levels: 2009-01-01
> cut(as.POSIXlt(x), breaks= "quarter")
[1] 2009-01-01 2009-01-01
Levels: 2009-01-01
> ## remove empty final level
> 
> 
> ## tests of error conditions in switch()
> switch("a", a=, b=, c=, 4)
[1] 4
> switch("a", a=, b=, c=, )
> .Last.value
NULL
> switch("a", a=, b=, c=, invisible(4))
> .Last.value
[1] 4
> ## visiblilty changed in 2.11.0
> 
> 
> ## rounding error in aggregate.ts
> ## https://stat.ethz.ch/pipermail/r-devel/2010-April/057225.html
> x <- rep(6:10, 1:5)
> aggregate(as.ts(x), FUN = mean, ndeltat = 5)
Time Series:
Start = 1 
End = 11 
Frequency = 0.2 
[1]  7.2  8.8 10.0
> x <- rep(6:10, 1:5)
> aggregate(as.ts(x), FUN = mean, nfrequency = 0.2)
Time Series:
Start = 1 
End = 11 
Frequency = 0.2 
[1]  7.2  8.8 10.0
> ## platform-dependent in 2.10.1
> 
> 
> ## wish of PR#9574
> a <- c(0.1, 0.3, 0.4, 0.5, 0.3, 0.0001)
> format.pval(a, eps=0.01)
[1] "0.1"   "0.3"   "0.4"   "0.5"   "0.3"   "<0.01"
> format.pval(a, eps=0.01, nsmall =2)
[1] "0.10"  "0.30"  "0.40"  "0.50"  "0.30"  "<0.01"
> ## granted in 2.12.0
> 
> 
> ## printing fractional dates
> as.Date(0.5, origin="1969-12-31")
[1] "1969-12-31"
> ## changed to round down in 2.12.1
> 
> 
> ## printing data frames with  ""  colnames
> dfr <- data.frame(x=1:6, CC=11:16, f = gl(3,2)); colnames(dfr)[2] <- ""
> dfr
  x    f
1 1 11 1
2 2 12 1
3 3 13 2
4 4 14 2
5 5 15 3
6 6 16 3
> ## now prints the same as data.matrix(dfr) does here
> 
> 
> ## format(., zero.print) --> prettyNum()
> set.seed(9); m <- matrix(local({x <- rnorm(40)
+                                 sign(x)*round(exp(2*x))/10}), 8,5)
> noquote(format(m, zero.print= "."))
     [,1] [,2] [,3] [,4] [,5]
[1,]  .   -0.1 -0.1  .    0.8
[2,]  .    .    .   21.4  0.1
[3,] -0.1  1.3  0.6  0.2  0.1
[4,] -0.1  .    .    .    .  
[5,]  0.2  0.1  3.4  0.2  0.2
[6,]  .   -0.1  0.1  0.2  .  
[7,]  1.1  4.0 -0.1  .    0.2
[8,] -0.1  .    0.6 -0.1  0.1
> ## used to print  ". 0" instead of ".  "
> 
> 
> ## tests of NA having precedence over NaN -- all must print "NA"
> min(c(NaN, NA))
[1] NA
> min(c(NA, NaN)) # NaN in 2.12.2
[1] NA
> min(NaN, NA_real_)  # NaN in 2.12.2
[1] NA
> min(NA_real_, NaN)
[1] NA
> max(c(NaN, NA))
[1] NA
> max(c(NA, NaN))  # NaN in 2.12.2
[1] NA
> max(NaN, NA_real_)  # NaN in 2.12.2
[1] NA
> max(NA_real_, NaN)
[1] NA
> ## might depend on compiler < 2.13.0
> 
> 
> ## PR#14514
> # Data are from Conover, "Nonparametric Statistics", 3rd Ed, p. 197,
> # re-arranged to make a lower-tail test the issue of relevance:  we
> # want to see if pregnant nurses exposed to nitrous oxide have higher
> # rates of miscarriage, stratifying on the type of nurse.
> Nitrous <- array(c(32,210,8,26,18,21,3,3,7,75,0,10), dim = c(2,2,3),
+                  dimnames = list(c("Exposed","NotExposed"),
+                  c("FullTerm","Miscarriage"),
+                  c("DentalAsst","OperRoomNurse","OutpatientNurse")))
> mantelhaen.test(Nitrous, exact=TRUE, alternative="less")

	Exact conditional test of independence in 2 x 2 x k tables

data:  Nitrous
S = 57, p-value = 0.1959
alternative hypothesis: true common odds ratio is less than 1
95 percent confidence interval:
 0.000000 1.388197
sample estimates:
common odds ratio 
        0.6652418 

> mantelhaen.test(Nitrous, exact=FALSE, alternative="less")

	Mantel-Haenszel chi-squared test with continuity correction

data:  Nitrous
Mantel-Haenszel X-squared = 0.71432, df = 1, p-value = 0.199
alternative hypothesis: true common odds ratio is less than 1
95 percent confidence interval:
 0.000000 1.260053
sample estimates:
common odds ratio 
        0.6645374 

> ## exact = FALSE gave the wrong tail in 2.12.2.
> 
> 
> ## scan(strip.white=TRUE) could strip trailing (but not leading) space
> ## inside quoted strings.
> writeLines(' "  A  "; "B" ;"C";" D ";"E ";  F  ;G  ', "foo")
> cat(readLines("foo"), sep = "\n")
 "  A  "; "B" ;"C";" D ";"E ";  F  ;G  
> scan('foo', list(""), sep=";")[[1]]
Read 7 records
[1] "   A  " " B "    "C"      " D "    "E "     "  F  "  "G  "   
> scan('foo', "", sep=";")
Read 7 items
[1] "   A  " " B "    "C"      " D "    "E "     "  F  "  "G  "   
> scan('foo', list(""), sep=";", strip.white = TRUE)[[1]]
Read 7 records
[1] "  A  " "B"     "C"     " D "   "E "    "F"     "G"    
> scan('foo', "", sep=";", strip.white = TRUE)
Read 7 items
[1] "  A  " "B"     "C"     " D "   "E "    "F"     "G"    
> unlink('foo')
> 
> writeLines(' "  A  "\n "B" \n"C"\n" D "\n"E "\n  F  \nG  ', "foo2")
> scan('foo2', "")
Read 7 items
[1] "  A  " "B"     "C"     " D "   "E "    "F"     "G"    
> scan('foo2', "", strip.white=TRUE) # documented to be ignored ...
Read 7 items
[1] "  A  " "B"     "C"     " D "   "E "    "F"     "G"    
> unlink('foo2')
> ## Changed for 2.13.0, found when investigating non-bug PR#14522.
> 
> 
> ## PR#14488: missing values in rank correlations
> set.seed(1)
> x <- runif(10)
> y <- runif(10)
> x[3] <- NA; y[5] <- NA
> xy <- cbind(x, y)
> 
> cor(x, y, method = "spearman", use = "complete.obs")
[1] 0.2380952
> cor(x, y, method = "spearman", use = "pairwise.complete.obs")
[1] 0.2380952
> cor(na.omit(xy),  method = "spearman", use = "complete.obs")
          x         y
x 1.0000000 0.2380952
y 0.2380952 1.0000000
> cor(xy,  method = "spearman", use = "complete.obs")
          x         y
x 1.0000000 0.2380952
y 0.2380952 1.0000000
> cor(xy,  method = "spearman", use = "pairwise.complete.obs")
          x         y
x 1.0000000 0.2380952
y 0.2380952 1.0000000
> ## inconsistent in R < 2.13.0
> 
> 
> ## integer overflow in rowsum() went undetected
> # https://stat.ethz.ch/pipermail/r-devel/2011-March/060304.html
> x <- 2e9L
> rowsum(c(x, x), c("a", "a"))
  [,1]
a   NA
> rowsum(data.frame(z = c(x, x)), c("a", "a"))
   z
a NA
> ## overflow in R < 2.13.0.
> 
> 
> ## method dispatch in [[.data.frame:
> ## https://stat.ethz.ch/pipermail/r-devel/2011-April/060409.html
> d <- data.frame(num = 1:4,
+           fac = factor(letters[11:14], levels = letters[1:15]),
+           date = as.Date("2011-04-01") + (0:3),
+           pv = package_version(c("1.2-3", "4.5", "6.7", "8.9-10")))
> for (i in seq_along(d)) print(d[[1, i]])
[1] 1
[1] k
Levels: a b c d e f g h i j k l m n o
[1] "2011-04-01"
[1] '1.2.3'
> ## did not dispatch in R < 2.14.0
> 
> 
> ## some tests of 24:00 as midnight
> as.POSIXlt("2011-05-16 24:00:00", tz = "GMT")
[1] "2011-05-17 GMT"
> as.POSIXlt("2010-01-31 24:00:00", tz = "GMT")
[1] "2010-02-01 GMT"
> as.POSIXlt("2011-02-28 24:00:00", tz = "GMT")
[1] "2011-03-01 GMT"
> as.POSIXlt("2008-02-28 24:00:00", tz = "GMT")
[1] "2008-02-29 GMT"
> as.POSIXlt("2008-02-29 24:00:00", tz = "GMT")
[1] "2008-03-01 GMT"
> as.POSIXlt("2010-12-31 24:00:00", tz = "GMT")
[1] "2011-01-01 GMT"
> ## new in 2.14.0
> 
> 
> ## Unwarranted conversion of logical values
> try(double(FALSE))
Error in double(FALSE) : invalid 'length' argument
> x <- 1:3
> try(length(x) <- TRUE)
Error in length(x) <- TRUE : invalid value
> ## coerced to integer in 2.13.x
> 
> 
> ## filter(recursive = TRUE) on input with NAs
> # https://stat.ethz.ch/pipermail/r-devel/2011-July/061547.html
> x <- c(1:4, NA, 6:9)
> cbind(x, "1"=filter(x, 0.5, method="recursive"),
+          "2"=filter(x, c(0.5, 0.0), method="recursive"),
+          "3"=filter(x, c(0.5, 0.0, 0.0), method="recursive"))
Time Series:
Start = 1 
End = 9 
Frequency = 1 
   x     1     2     3
1  1 1.000 1.000 1.000
2  2 2.500 2.500 2.500
3  3 4.250 4.250 4.250
4  4 6.125 6.125 6.125
5 NA    NA    NA    NA
6  6    NA    NA    NA
7  7    NA    NA    NA
8  8    NA    NA    NA
9  9    NA    NA    NA
> ## NAs in wrong place in R <= 2.13.1.
> 
> 
> ## PR#14679.  Format depends if TZ is set.
> x <- as.POSIXlt(c("2010-02-27 22:30:33", "2009-08-09 06:01:03",
+                   "2010-07-23 17:29:59"))
> stopifnot(!is.na(trunc(x, units = "days")[1:3]))
> ## gave NAs after the first in R < 2.13.2
> 
> 
> ## explicit error message for silly input (tol = 0)
> aa <- c(1, 2, 3, 8, 8, 8, 8, 8, 8, 8, 8, 8, 12, 13, 14)
> try(smooth.spline(aa, seq_along(aa)))
Error in smooth.spline(aa, seq_along(aa)) : 
  'tol' must be strictly positive and finite
> fit <- smooth.spline(aa, seq_along(aa), tol = 0.1)
> # actual output is too unstable to diff.
> ## Better message from R 2.14.2
> 
> 
> ## PR#14840
> d <- data.frame(x = 1:9,
+                 y = 1:9 + 0.1*c(1, 2, -1, 0, 1, 1000, 0, 1, -1),
+                 w = c(1, 0.5, 2, 1, 2, 0, 1, 2, 1))
> fit <- lm(y ~ x, data=d, weights=w)
> summary(fit)

Call:
lm(formula = y ~ x, data = d, weights = w)

Weighted Residuals:
    Min      1Q  Median      3Q     Max 
-0.1883 -0.0310  0.0000  0.1006  0.1165 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)    
(Intercept)  0.03949    0.08612   0.459    0.663    
x            0.99788    0.01502  66.419 7.83e-10 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1

Residual standard error: 0.1232 on 6 degrees of freedom
Multiple R-squared:  0.9986,	Adjusted R-squared:  0.9984 
F-statistic:  4412 on 1 and 6 DF,  p-value: 7.834e-10

> ## issue is how the 5-number summary is labelled
> ## (also seen in example(case.names))
> 
> 
> ## is.unsorted got it backwards for dataframes of more than one column
> ## it is supposed to look for violations of x[2] > x[1], x[3] > x[2], etc.
> is.unsorted(data.frame(x=2:1))
[1] FALSE
> is.unsorted(data.frame(x=1:2, y=3:4))
[1] FALSE
> is.unsorted(data.frame(x=3:4, y=1:2))
[1] TRUE
> ## R < 2.15.1 got these as FALSE, TRUE, FALSE.
> 
> 
> library("methods")# (not needed here)
> assertError <- tools::assertError
> assertError( getMethod(ls, "bar", fdef=ls), verbose=TRUE)
Asserted error: no generic function found for 'ls'
> assertError( getMethod(show, "bar"), verbose=TRUE)
Asserted error: no method found for function 'show' and signature bar
> ## R < 2.15.1 gave
> ##   cannot coerce type 'closure' to vector of type 'character'
> 
> 
> ## corner cases for array
> # allowed, gave non-array in 2.15.x
> try(array(1, integer()))
Error in array(1, integer()) : 'dims' cannot be of length 0
> # if no dims, an error to supply dimnames
> try(array(1, integer(), list(1, 2)))
Error in array(1, integer(), list(1, 2)) : 'dims' cannot be of length 0
> ##
> 
> 
> ## is.na() on an empty dataframe (PR#14059)
> DF <- data.frame(row.names=1:3)
> is.na(DF); str(.Last.value)
 
1
2
3
 logi[1:3, 0 ] 
 - attr(*, "dimnames")=List of 2
  ..$ : chr [1:3] "1" "2" "3"
  ..$ : NULL
> is.na(DF[FALSE, ]); str(.Last.value)
<0 x 0 matrix>
 logi[0 , 0 ] 
> ## first failed in R 2.15.1, second gave NULL
> 
> 
> ## split() with dots in levels
> df <- data.frame(x = rep(c("a", "a.b"), 3L), y = rep(c("b.c", "c"), 3L),
+                  z = 1:6)
> df
    x   y z
1   a b.c 1
2 a.b   c 2
3   a b.c 3
4 a.b   c 4
5   a b.c 5
6 a.b   c 6
> split(df, df[, 1:2]) # default is sep = "."
$a.b.c
    x   y z
1   a b.c 1
2 a.b   c 2
3   a b.c 3
4 a.b   c 4
5   a b.c 5
6 a.b   c 6

$a.b.b.c
[1] x y z
<0 rows> (or 0-length row.names)

$a.c
[1] x y z
<0 rows> (or 0-length row.names)

> split(df, df[, 1:2], sep = ":")
$`a:b.c`
  x   y z
1 a b.c 1
3 a b.c 3
5 a b.c 5

$`a.b:b.c`
[1] x y z
<0 rows> (or 0-length row.names)

$`a:c`
[1] x y z
<0 rows> (or 0-length row.names)

$`a.b:c`
    x y z
2 a.b c 2
4 a.b c 4
6 a.b c 6

> ##
> 
> 
> ## The difference between sort.list and order
> z <- c(4L, NA, 2L, 3L, NA, 1L)
> order(z, na.last = NA)
[1] 6 3 4 1
> sort.list(z, na.last = NA)
[1] 4 2 3 1
> sort.list(z, na.last = NA, method = "shell")
[1] 4 2 3 1
> sort.list(z, na.last = NA, method = "quick")
[1] 4 2 3 1
> sort.list(z, na.last = NA, method = "radix")
[1] 4 2 3 1
> ## Differences first documented in R 2.15.2
> 
> 
> ## PR#15028: names longer than cutoff NB (= 1000)
> NB <- 1000
> lns <- capture.output(
+     setNames(c(255, 1000, 30000),
+              c(paste(rep.int("a", NB+2), collapse=""),
+                paste(rep.int("b", NB+2), collapse=""),
+                paste(rep.int("c", NB+2), collapse=""))))
> sub("^ +", '', lns[2* 1:3])
[1] "255 "   "1000 "  "30000 "
> ## *values* were cutoff when printed
> 
> 
> ## allows deparse limits to be set
> form <- reallylongnamey ~ reallylongnamex0 + reallylongnamex1 + reallylongnamex2 + reallylongnamex3
> form
reallylongnamey ~ reallylongnamex0 + reallylongnamex1 + reallylongnamex2 + 
    reallylongnamex3
> op <- options(deparse.cutoff=80)
> form
reallylongnamey ~ reallylongnamex0 + reallylongnamex1 + reallylongnamex2 + reallylongnamex3
> options(deparse.cutoff=50)
> form
reallylongnamey ~ reallylongnamex0 + reallylongnamex1 + 
    reallylongnamex2 + reallylongnamex3
> options(op)
> ## fixed to 60 in R 2.15.x
> 
> 
> ## PR#15179: user defined binary ops were not deparsed properly
> quote( `%^%`(x, `%^%`(y,z)) )
x %^% (y %^% z)
> quote( `%^%`(x) )
`%^%`(x)
> ##
> 
> 
> ## Anonymous function calls were not deparsed properly
> substitute(f(x), list(f = function(x) x + 1))
(function (x) 
x + 1)(x)
> substitute(f(x), list(f = quote(function(x) x + 1)))
(function(x) x + 1)(x)
> substitute(f(x), list(f = quote(f+g)))
(f + g)(x)
> substitute(f(x), list(f = quote(base::mean)))
base::mean(x)
> substitute(f(x), list(f = quote(a[n])))
a[n](x)
> substitute(f(x), list(f = quote(g(y))))
g(y)(x)
> ## The first three need parens, the last three don't.
> 
> 
> ## PR#15247 : str() on invalid data frame names (where print() works):
> d <- data.frame(1:3, "B", 4); names(d) <- c("A", "B\xba","C\xabcd")
> str(d)
'data.frame':	3 obs. of  3 variables:
 $ A      : int  1 2 3
 $ Bº  : Factor w/ 1 level "B": 1 1 1
 $ C«cd: num  4 4 4
> ## gave an error in R <= 3.0.0
> 
> 
> ## PR#15299 : adding a simple vector to a classed object produced a bad result:
> 1:2 + table(1:2)

1 2 
2 3 
> ## Printed the class attribute in R <= 3.0.0
> 
> 
> ## PR#15311 : regmatches<- mishandled regexpr results.
>   x <- c('1', 'B', '3')
>   m <- regexpr('\\d', x)
>   regmatches(x, m) <- c('A', 'C')
>   print(x)
[1] "A" "B" "C"
> ## Gave a warning and a wrong result up to 3.0.1
> 
> 
> ## Bad warning found by Radford Neal
>   saveopt <- options(warnPartialMatchDollar=TRUE)
>   pl <- pairlist(abc=1, def=2)
>   pl$ab
[1] 1
Warning message:
In pl$ab : partial match of 'ab' to 'abc'
>   if (!is.null(saveopt[["warnPartialMatchDollar"]])) options(saveopt)
> ## 'abc' was just ''
> 
> 
> ## seq() with NaN etc inputs now gives explicit error messages
> try(seq(NaN))
Error in seq.default(NaN) : 'from' cannot be NA, NaN or infinite
> try(seq(to = NaN))
Error in seq.default(to = NaN) : 'to' cannot be NA, NaN or infinite
> try(seq(NaN, NaN))
Error in seq.default(NaN, NaN) : 'from' cannot be NA, NaN or infinite
> try(seq.int(NaN))
Error in seq.int(NaN) : 'from' cannot be NA, NaN or infinite
> try(seq.int(to = NaN))
Error in seq.int(to = NaN) : 'to' cannot be NA, NaN or infinite
> try(seq.int(NaN, NaN))
Error in seq.int(NaN, NaN) : 'from' cannot be NA, NaN or infinite
> ## R 3.0.1 gave messages from ':' or about negative-length vectors.
> 
> 
> ## Some dimnames were lost from 1D arrays: PR#15301
> x <- array(0:2, dim=3, dimnames=list(d1=LETTERS[1:3]))
> x
d1
A B C 
0 1 2 
> x[]
d1
A B C 
0 1 2 
> x[3:1]
d1
C B A 
2 1 0 
> x <- array(0, dimnames=list(d1="A"))
> x
d1
A 
0 
> x[]
d1
A 
0 
> x[drop = FALSE]
d1
A 
0 
> ## lost dimnames in 3.0.1
> 
> 
> ## PR#15396
> load(file.path(Sys.getenv('SRCDIR'), 'arima.rda'))
> (f1 <- arima(x, xreg = xreg, order = c(1,1,1), seasonal = c(1,0,1)))

Call:
arima(x = x, order = c(1, 1, 1), seasonal = c(1, 0, 1), xreg = xreg)

Coefficients:
          ar1     ma1    sar1     sma1    xreg
      -0.4791  0.3525  0.9877  -0.8295  0.3574
s.e.   0.4162  0.4420  0.0329   0.2209  0.7440

sigma^2 estimated as 0.001499:  log likelihood = 163.79,  aic = -315.58
> (f2 <- arima(diff(x), xreg = diff(xreg), order = c(1,0,1), seasonal = c(1,0,1),
+              include.mean = FALSE))

Call:
arima(x = diff(x), order = c(1, 0, 1), seasonal = c(1, 0, 1), xreg = diff(xreg), 
    include.mean = FALSE)

Coefficients:
          ar1     ma1    sar1     sma1  diff(xreg)
      -0.4791  0.3526  0.9877  -0.8295      0.3571
s.e.   0.4162  0.4420  0.0329   0.2210      0.7441

sigma^2 estimated as 0.001499:  log likelihood = 163.79,  aic = -315.58
> stopifnot(all.equal(coef(f1), coef(f2), tolerance = 1e-3, check.names = FALSE))
> ## first gave local optim in 3.0.1
> 
> ## all.equal always checked the names
> x <- c(a=1, b=2)
> y <- c(a=1, d=2)
> all.equal(x, y, check.names = FALSE)
[1] TRUE
> ## failed on mismatched attributes
> 
> 
> ## PR#15411, plus digits change
> format(9992, digits = 3)
[1] "9992"
> format(9996, digits = 3)
[1] "9996"
> format(0.0002, digits = 0, nsmall = 2)
[1] "0.00"
> format(pi*10, digits = 0, nsmall = 1)
[1] "31.4"
> ## second added an extra space; 3rd and 4th were not allowed.
> 
> ## and one branch of this was wrong:
> xx <- c(-86870268, 107833358, 302536985, 481015309, 675718935, 854197259,
+         1016450281, 1178703303, 1324731023, 1454533441)
> xx
 [1]  -86870268  107833358  302536985  481015309  675718935  854197259
 [7] 1016450281 1178703303 1324731023 1454533441
> ## dropped spaces without long doubles
> 
> ## and rounding was being detected improperly (PR#15583)
> 1000* ((10^(1/4)) ^ c(0:4))
[1]  1000.000  1778.279  3162.278  5623.413 10000.000
> 7/0.07
[1] 100
> ## Spacing was incorrect
> 
> 
> ## PR#15468
> M <- matrix(11:14, ncol=2, dimnames=list(paste0("Row", 1:2), paste0("Col",
+ 1:2)))
> L <- list(elem1=1, elem2=2)
> rbind(M, L)
     Col1 Col2
Row1 11   13  
Row2 12   14  
L    1    2   
> rbind(L, M)
     elem1 elem2
L    1     2    
Row1 11    13   
Row2 12    14   
> cbind(M, L)
     Col1 Col2 L
Row1 11   13   1
Row2 12   14   2
> cbind(L, M)
      L Col1 Col2
elem1 1 11   13  
elem2 2 12   14  
> ## lost the dim of M, so returned NULL entries
> 
> 
> ## NA_character_ was not handled properly in min and max (reported by Magnus Thor Torfason)
> str(min(NA, "bla"))
 chr NA
> str(min("bla", NA))
 chr NA
> str(min(NA_character_, "bla"))
 chr NA
> str(max(NA, "bla"))
 chr NA
> str(max("bla", NA))
 chr NA
> str(max(NA_character_, "bla"))
 chr NA
> ## NA_character_ could be treated as "NA"; depending on the locale, it would not necessarily
> ## be the min or max.
> 
> 
> ## When two entries needed to be cut to width, str() mixed up
> ## the values (reported by Gerrit Eichner)
> oldopts <- options(width=70, stringsAsFactors=TRUE)
> n <- 11      # number of rows of data frame
> M <- 10000   # order of magnitude of numerical values
> longer.char.string <- "zjtvorkmoydsepnxkabmeondrjaanutjmfxlgzmrbjp"
> X <- data.frame( A = 1:n * M,
+                  B = rep( longer.char.string, n))
> str( X, strict.width = "cut")
'data.frame':	11 obs. of  2 variables:
 $ A: num  1e+04 2e+04 3e+04 4e+04 5e+04 6e+04 7e+04 8e+04 9e+04 1e+..
 $ B: Factor w/ 1 level "zjtvorkmoydsepnxkabmeondrjaanutjmfxlgzmrbj"..
> options(oldopts)
> ## The first row of the str() result was duplicated.
> 
> 
> ## PR15624: rounding in extreme cases
> dpois(2^52,1,1)
[1] -1.578226e+17
> dpois(2^52+1,1,1)
[1] -1.578226e+17
> ## second warned in R 3.0.2.
> 
> 
> ## Example from PR15625
> f <- file.path(Sys.getenv('SRCDIR'), 'EmbeddedNuls.csv')
> ## This is a file with a UTF-8 BOM and some fields which are a single nul.
> ## The output does rely on this being run in a non-UTF-8 locale (C in tests).
> read.csv(f) # warns
  X...ColA ColB ColC
1        a   NA   NA
2        b   NA   NA
3        c   NA   NA
4        d   NA   NA
5        e   NA    1
6        f   NA    1
Warning messages:
1: In read.table(file = file, header = header, sep = sep, quote = quote,  :
  line 2 appears to contain embedded nulls
2: In read.table(file = file, header = header, sep = sep, quote = quote,  :
  line 3 appears to contain embedded nulls
3: In read.table(file = file, header = header, sep = sep, quote = quote,  :
  line 4 appears to contain embedded nulls
4: In read.table(file = file, header = header, sep = sep, quote = quote,  :
  line 5 appears to contain embedded nulls
5: In scan(file = file, what = what, sep = sep, quote = quote, dec = dec,  :
  embedded nul(s) found in input
> read.csv(f, skipNul = TRUE, fileEncoding = "UTF-8-BOM")
  ColA ColB ColC
1    a   NA    1
2    b   NA    1
3    c   NA    1
4    d   NA    1
5    e   NA    1
6    f   NA    1
> ## 'skipNul' is new in 3.1.0.  Should not warn on BOM, ignore in second.
> 
> 
> ## all.equal datetime method
> x <- Sys.time()
> all.equal(x,x)
[1] TRUE
> all.equal(x, as.POSIXlt(x))
[1] TRUE
> all.equal(x, as.POSIXlt(x, tz = "EST5EDT"))
[1] TRUE
> all.equal(x, x+1e-4)
[1] TRUE
> isTRUE(all.equal(x, x+0.002)) # message will depend on representation error
[1] FALSE
> ## as.POSIXt method is new in 3.1.0.
> 
> 
> 
> ## Misuse of PR#15633
> try(bartlett.test(yield ~ block*N, data = npk))
Error in bartlett.test.formula(yield ~ block * N, data = npk) : 
  'formula' should be of the form response ~ group
> try(fligner.test (yield ~ block*N, data = npk))
Error in fligner.test.formula(yield ~ block * N, data = npk) : 
  'formula' should be of the form response ~ group
> ## used the first factor with an incorrect description in R < 3.0.3
> 
> 
> ## Misguided expectation of PR#15687
> xx <- window(AirPassengers, start = 1960)
> cbind(xx, xx)
          xx  xx
Jan 1960 417 417
Feb 1960 391 391
Mar 1960 419 419
Apr 1960 461 461
May 1960 472 472
Jun 1960 535 535
Jul 1960 622 622
Aug 1960 606 606
Sep 1960 508 508
Oct 1960 461 461
Nov 1960 390 390
Dec 1960 432 432
> op <- options(digits = 2)
> cbind(xx, xx)
          xx  xx
Jan 1960 417 417
Feb 1960 391 391
Mar 1960 419 419
Apr 1960 461 461
May 1960 472 472
Jun 1960 535 535
Jul 1960 622 622
Aug 1960 606 606
Sep 1960 508 508
Oct 1960 461 461
Nov 1960 390 390
Dec 1960 432 432
> options(op)
> ## 'digits' was applied to the time.
> 
> 
> ## Related to PR#15190
> difftime(
+     as.POSIXct(c("1970-01-01 00:00:00", "1970-01-01 12:00:00"), tz="EST5EDT"),
+     as.POSIXct(c("1970-01-01 00:00:00", "1970-01-01 00:00:00"), tz="UTC"))
Time differences in hours
[1]  5 17
> ## kept tzone from first arg.
> 
> 
> ## PR#15706
> x1 <- as.dendrogram(hclust(dist(c(i=1,ii=2,iii=3,v=5,vi=6,vii=7))))
> attr(cophenetic(x1), "Labels")
[1] "iii" "i"   "ii"  "vii" "v"   "vi" 
> ## gave a matrix in 3.0.3
> 
> 
> ## PR#15708
> aa <- anova( lm(sr ~ ., data = LifeCycleSavings) )
> op <- options(width = 50)
> aa
Analysis of Variance Table

Response: sr
          Df Sum Sq Mean Sq F value    Pr(>F)    
pop15      1 204.12 204.118 14.1157 0.0004922 ***
pop75      1  53.34  53.343  3.6889 0.0611255 .  
dpi        1  12.40  12.401  0.8576 0.3593551    
ddpi       1  63.05  63.054  4.3605 0.0424711 *  
Residuals 45 650.71  14.460                      
---
Signif. codes:  
0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
> options(width = 40)
> aa ; options(op)
Analysis of Variance Table

Response: sr
          Df Sum Sq Mean Sq F value
pop15      1 204.12 204.118 14.1157
pop75      1  53.34  53.343  3.6889
dpi        1  12.40  12.401  0.8576
ddpi       1  63.05  63.054  4.3605
Residuals 45 650.71  14.460        
             Pr(>F)    
pop15     0.0004922 ***
pop75     0.0611255 .  
dpi       0.3593551    
ddpi      0.0424711 *  
Residuals              
---
Signif. codes:  
  0 '***' 0.001 '**' 0.01 '*' 0.05
  '.' 0.1 ' ' 1
> ## did not line wrap "Signif. codes" previously
> 
> 
> ## PR#15718
> d <- data.frame(a=1)
> d[integer(), "a"] <- 2
> ## warned in 3.0.3.
> 
> 
> ## PR#15781
> options(foo = 1)
> print(options(foo = NULL))
$foo
[1] 1

> ## printed wrong value in 3.1.0
> 
> 
> ## getParseData bug reported by Andrew Redd
> raw <- "
+ function( a   # parameter 1
+          , b=2 # parameter 2
+          ){a+b}"
> p <- parse(text = raw)
> getParseData(p)
   line1 col1 line2 col2 id parent          token terminal          text
31     2    1     4   15 31      0           expr    FALSE              
3      2    1     2    8  3     31       FUNCTION     TRUE      function
4      2    9     2    9  4     31            '('     TRUE             (
5      2   11     2   11  5     31 SYMBOL_FORMALS     TRUE             a
6      2   15     2   27  6     31        COMMENT     TRUE # parameter 1
8      3   10     3   10  8     31            ','     TRUE             ,
10     3   12     3   12 10     31 SYMBOL_FORMALS     TRUE             b
11     3   13     3   13 11     31     EQ_FORMALS     TRUE             =
12     3   14     3   14 12     13      NUM_CONST     TRUE             2
13     3   14     3   14 13     31           expr    FALSE              
14     3   16     3   28 14     31        COMMENT     TRUE # parameter 2
16     4   10     4   10 16     31            ')'     TRUE             )
28     4   11     4   15 28     31           expr    FALSE              
18     4   11     4   11 18     28            '{'     TRUE             {
25     4   12     4   14 25     28           expr    FALSE              
19     4   12     4   12 19     21         SYMBOL     TRUE             a
21     4   12     4   12 21     25           expr    FALSE              
20     4   13     4   13 20     25            '+'     TRUE             +
22     4   14     4   14 22     24         SYMBOL     TRUE             b
24     4   14     4   14 24     25           expr    FALSE              
23     4   15     4   15 23     28            '}'     TRUE             }
> ## Got some parents wrong
> 
> 
> ## wish of PR#15819
> set.seed(123); x <- runif(10); y <- rnorm(10)
> op <- options(OutDec = ",")
> fit <- lm(y ~ x)
> summary(fit)

Call:
lm(formula = y ~ x)

Residuals:
     Min       1Q   Median       3Q      Max 
-1,62155 -0,33471  0,05238  0,55227  1,19742 

Coefficients:
            Estimate Std. Error t value Pr(>|t|)
(Intercept)   0,8994     0,6282   1,432    0,190
x            -1,3275     0,9780  -1,357    0,212

Residual standard error: 0,8648 on 8 degrees of freedom
Multiple R-squared:  0,1872,	Adjusted R-squared:  0,08557 
F-statistic: 1,842 on 1 and 8 DF,  p-value: 0,2117

> options(op)
> ## those parts using formatC still used a decimal point.
> 
> 
> ## Printing a list with "bad" component names
> L <- list(`a\\b` = 1, `a\\c` = 2, `a\bc` = "backspace")
> setClass("foo", representation(`\\C` = "numeric"))
> ## the next three all print correctly:
> names(L)
[1] "a\\b" "a\\c" "a\bc"
> unlist(L)
       a\\b        a\\c        a\bc 
        "1"         "2" "backspace" 
> as.pairlist(L)
$`a\\b`
[1] 1

$`a\\c`
[1] 2

$`a\bc`
[1] "backspace"

> cat(names(L), "\n")# yes, backspace is backspace here
a\b a\c ac 
> L
$`a\\b`
[1] 1

$`a\\c`
[1] 2

$`a\bc`
[1] "backspace"

> new("foo")
An object of class "foo"
Slot "\\C":
numeric(0)

> ## the last two lines printed wrongly in R <= 3.1.1
> 
> 
> ## Printing of arrays where last dim(.) == 0 :
> r <- matrix(,0,4, dimnames=list(Row=NULL, Col=paste0("c",1:4)))
> r
      Col
Row    c1 c2 c3 c4
> t(r) # did not print "Row", "Col"
    Row
Col 
  c1
  c2
  c3
  c4
> A <- array(dim=3:0, dimnames=list(D1=c("a","b","c"), D2=c("X","Y"), D3="I", D4=NULL))
> A ## did not print *anything*
<3 x 2 x 1 x 0 array of logical>
   D2
D1  X Y
  a
  b
  c

> A[,,"I",] # ditto
<3 x 2 x 0 array of logical>
   D2
D1  X Y
  a
  b
  c

> A[,,0,]   # ditto
<3 x 2 x 0 x 0 array of logical>
   D2
D1  X Y
  a
  b
  c

> aperm(A, c(3:1,4))   # ditto
<1 x 2 x 3 x 0 array of logical>
   D2
D3  X Y
  I

> aperm(A, c(1:2, 4:3))# ditto
<3 x 2 x 0 x 1 array of logical>
   D2
D1  X Y
  a
  b
  c

> unname(A)            # ditto
<3 x 2 x 1 x 0 array of logical>
     [,1] [,2]
[1,]
[2,]
[3,]

> format(A[,,1,])	     # ditto
<3 x 2 x 0 array of character>
   D2
D1  X Y
  a
  b
  c

> aperm(A, 4:1) # was ok, is unchanged
, , D2 = X, D1 = a

      D3
D4     I

, , D2 = Y, D1 = a

      D3
D4     I

, , D2 = X, D1 = b

      D3
D4     I

, , D2 = Y, D1 = b

      D3
D4     I

, , D2 = X, D1 = c

      D3
D4     I

, , D2 = Y, D1 = c

      D3
D4     I

> ## sometimes not printing anything in R <= 3.1.1
> 
> 
> ## Printing objects with very long names cut off literal values (PR#15999)
> make_long_name <- function(n)
+ {
+   paste0(rep("a", n), collapse = "")
+ }
> setNames(TRUE, make_long_name(1000))  # value printed as TRU
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   TRUE 
> setNames(TRUE, make_long_name(1002))  # value printed as T
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   TRUE 
> setNames(TRUE, make_long_name(1003))  # value not printed
aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   TRUE 
> ##
> 
> 
> ## PR#16437
> dd <- data.frame(F = factor(rep(c("A","B","C"), each = 3)), num = 1:9)
> cs <- list(F = contr.sum(3, contrasts = FALSE))
> a1 <- aov(num ~ F, data = dd, contrasts = cs)
> model.tables(a1, "means")
Tables of means
Grand mean
  
5 

 F 
F
A B C 
2 5 8 
> t1 <- TukeyHSD(a1) ## don't print to avoid precision issues.
> a2 <- aov(num ~ 0+F, data = dd, contrasts = cs)
> model.tables(a2, "means")
Tables of means

 F 
F
A B C 
2 5 8 
> t2 <- TukeyHSD(a2)
> attr(t1, "orig.call") <- attr(t2, "orig.call")
> stopifnot(all.equal(t1, t2))
> ## functions both failed on a2 in R <= 3.2.2.
> 
> 
> ## deparse() did not add parens before [
> substitute(a[1], list(a = quote(x * y)))
(x * y)[1]
> ## should be (x * y)[1], was x * y[1]
> # Check all levels of precedence
> # (Comment out illegal ones)
> quote(`$`(a :: b, c))
a::b$c
> # quote(`::`(a $ b, c $ d))
> quote(`[`(a $ b, c $ d))
a$b[c$d]
> quote(`$`(a[b], c))
a[b]$c
> quote(`^`(a[b], c[d]))
a[b]^c[d]
> quote(`[`(a ^ b, c ^ d))
(a^b)[c^d]
> quote(`-`(a ^ b))
-a^b
> quote(`^`(-b, -d))
(-b)^-d
> quote(`:`(-b, -d))
-b:-d
> quote(`-`(a : b))
-(a:b)
> quote(`%in%`(a : b, c : d))
a:b %in% c:d
> quote(`:`(a %in% b, c %in% d))
(a %in% b):(c %in% d)
> quote(`*`(a %in% b, c %in% d))
a %in% b * c %in% d
> quote(`%in%`(a * b, c * d))
(a * b) %in% (c * d)
> quote(`+`(a * b, c * d))
a * b + c * d
> quote(`*`(a + b, c + d))
(a + b) * (c + d)
> quote(`<`(a + b, c + d))
a + b < c + d
> quote(`+`(a < b, c < d))
(a < b) + (c < d)
> quote(`!`(a < b))
!a < b
> quote(`<`(!b, !d))
(!b) < (!d)
> quote(`&`(!b, !d))
!b & !d
> quote(`!`(a & b))
!(a & b)
> quote(`|`(a & b, c & d))
a & b | c & d
> quote(`&`(a | b, c | d))
(a | b) & (c | d)
> quote(`~`(a | b, c | d))
a | b ~ c | d
> quote(`|`(a ~ b, c ~ d))
(a ~ b) | (c ~ d)
> quote(`->`(a ~ b, d))
`->`(a ~ b, d)
> quote(`~`(a -> b, c -> d))
(b <- a) ~ (d <- c)
> quote(`<-`(a, c -> d))
a <- d <- c
> quote(`->`(a <- b, c))
`->`(a <- b, c)
> quote(`=`(a, c <- d))
a = c <- d
> quote(`<-`(a, `=`(c, d)))
a <- (c = d)
> quote(`?`(`=`(a, b), `=`(c, d)))
`?`((a = b), (c = d))
> quote(`=`(a, c ? d))
a = `?`(c, d)
> quote(`?`(a = b))
`?`(a = b)
> quote(`=`(b, ?d))
b = `?`(d)
> 
> ## dput() quoted the empty symbol (PR#16686)
> a <- alist(one = 1, two = )
> dput(a)
structure(list(one = 1, two = ), .Names = c("one", "two"))
> ## deparsed two to quote()
> 
> 
> ## summary.data.frame() with NAs in columns of class "Date" -- PR#16709
> x <- c(18000000, 18810924, 19091227, 19027233, 19310526, 19691228, NA)
> x.Date <- as.Date(as.character(x), format = "%Y%m%d")
> summary(x.Date)
        Min.      1st Qu.       Median         Mean      3rd Qu.         Max. 
"1881-09-24" "1902-12-04" "1920-09-10" "1923-04-12" "1941-01-17" "1969-12-28" 
        NA's 
         "3" 
> DF.Dates <- data.frame(c1 = x.Date)
> summary(DF.Dates) ## NA's missing from output :
       c1            
 Min.   :1881-09-24  
 1st Qu.:1902-12-04  
 Median :1920-09-10  
 Mean   :1923-04-12  
 3rd Qu.:1941-01-17  
 Max.   :1969-12-28  
 NA's   :3           
> DF.Dates$x1 <- 1:7
> summary(DF.Dates) ## NA's still missing
       c1                   x1     
 Min.   :1881-09-24   Min.   :1.0  
 1st Qu.:1902-12-04   1st Qu.:2.5  
 Median :1920-09-10   Median :4.0  
 Mean   :1923-04-12   Mean   :4.0  
 3rd Qu.:1941-01-17   3rd Qu.:5.5  
 Max.   :1969-12-28   Max.   :7.0  
 NA's   :3                         
> DF.Dates$x2 <- c(1:6, NA)
> ## now, NA's show fine:
> summary(DF.Dates)
       c1                   x1            x2      
 Min.   :1881-09-24   Min.   :1.0   Min.   :1.00  
 1st Qu.:1902-12-04   1st Qu.:2.5   1st Qu.:2.25  
 Median :1920-09-10   Median :4.0   Median :3.50  
 Mean   :1923-04-12   Mean   :4.0   Mean   :3.50  
 3rd Qu.:1941-01-17   3rd Qu.:5.5   3rd Qu.:4.75  
 Max.   :1969-12-28   Max.   :7.0   Max.   :6.00  
 NA's   :3                          NA's   :1     
> ## 2 of 4  summary(.) above did not show NA's  in R <= 3.2.3
>