The R Project SVN
R
(root)/branches/R-matOps/tests/reg-tests-2.Rout.save – Rev 84152
Rev 84054 | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed
R Under development (unstable) (2023-03-28 r84086) -- "Unsuffered Consequences"Copyright (C) 2023 The R Foundation for Statistical ComputingPlatform: 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=FALSE) # R >= 4.0.0> 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 matrixx1 x2Min. 3 11st Qu. 3 2Median 3 3Mean 3 33rd Qu. 3 4Max. 3 5> apply(x, 1, quantile)# 5 x n matrixa b c d e f g h0% 3.00 3 2.00 1.0 2.00 3 3.00 3.025% 3.25 3 2.25 1.5 2.25 3 3.25 3.550% 3.50 3 2.50 2.0 2.50 3 3.50 4.075% 3.75 3 2.75 2.5 2.75 3 3.75 4.5100% 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 2a b c[1,] 1160 1200 1240[2,] 1180 1220 1260[1] 2 3[,1] [,2] [,3] [,4]a 495 555 615 675b 515 575 635 695c 535 595 655 715[1] 2 4V5 V6 V7 V8 V9a 84 276 468 660 852b 100 292 484 676 868c 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 39b 7 19 31 43c 11 23 35 47, , V6[,1] [,2] [,3] [,4]a 51 63 75 87b 55 67 79 91c 59 71 83 95, , V7[,1] [,2] [,3] [,4]a 99 111 123 135b 103 115 127 139c 107 119 131 143, , V8[,1] [,2] [,3] [,4]a 147 159 171 183b 151 163 175 187c 155 167 179 191, , V9[,1] [,2] [,3] [,4]a 195 207 219 231b 199 211 223 235c 203 215 227 239[1] 1 2 3, , 1a b c[1,] 245 255 265[2,] 250 260 270, , 2a b c[1,] 275 285 295[2,] 280 290 300, , 3a b c[1,] 305 315 325[2,] 310 320 330, , 4a b c[1,] 335 345 355[2,] 340 350 360[1] 1 2 3 4, , 1, V5a b c[1,] 1 3 5[2,] 2 4 6, , 2, V5a b c[1,] 7 9 11[2,] 8 10 12, , 3, V5a b c[1,] 13 15 17[2,] 14 16 18, , 4, V5a b c[1,] 19 21 23[2,] 20 22 24, , 1, V6a b c[1,] 25 27 29[2,] 26 28 30, , 2, V6a b c[1,] 31 33 35[2,] 32 34 36, , 3, V6a b c[1,] 37 39 41[2,] 38 40 42, , 4, V6a b c[1,] 43 45 47[2,] 44 46 48, , 1, V7a b c[1,] 49 51 53[2,] 50 52 54, , 2, V7a b c[1,] 55 57 59[2,] 56 58 60, , 3, V7a b c[1,] 61 63 65[2,] 62 64 66, , 4, V7a b c[1,] 67 69 71[2,] 68 70 72, , 1, V8a b c[1,] 73 75 77[2,] 74 76 78, , 2, V8a b c[1,] 79 81 83[2,] 80 82 84, , 3, V8a b c[1,] 85 87 89[2,] 86 88 90, , 4, V8a b c[1,] 91 93 95[2,] 92 94 96, , 1, V9a b c[1,] 97 99 101[2,] 98 100 102, , 2, V9a b c[1,] 103 105 107[2,] 104 106 108, , 3, V9a b c[1,] 109 111 113[2,] 110 112 114, , 4, V9a 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+00There 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),+ stringsAsFactors=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": 3 3 3 2 3 2 2 2 3 1> (d0 <- d[, FALSE]) # NULL dataframe with 10 rowsdata 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 rowsdata 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 b1 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 : 32 : 3.13 : 3.144 : 3.1425 : 3.141610 : 3.14159265415 : 3.1415926535897916 : 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 NATRUE 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 NAFALSE 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': 7NA7>> is.na(x) | is.finite(x)100 -1e-13 Inf -Inf NaN 3.14 NATRUE 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 NAFALSE 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 NA100 0 NA NA NA 3 NAWarning 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 1000A:sad 1000 4000 7000 10000B:happy 200 500 800 1100B:sad 2000 5000 8000 11000C:happy 300 600 900 1200C: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:dogA:happy 300 400 1200 1600 2100 2800 3000 4000A:sad 3000 4000 12000 16000 21000 28000 30000 40000B:happy 600 800 1500 2000 2400 3200 3300 4400B:sad 6000 8000 15000 20000 24000 32000 33000 44000C:happy 900 1200 1800 2400 2700 3600 3600 4800C: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 4000A: 3000 4000 12000 16000 21000 28000 30000 40000B: 600 800 1500 2000 2400 3200 3300 4400B: 6000 8000 15000 20000 24000 32000 33000 44000C: 900 1200 1800 2400 2700 3600 3600 4800C: 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 4000A:sad 3000 4000 12000 16000 21000 28000 30000 40000B:happy 600 800 1500 2000 2400 3200 3300 4400B:sad 6000 8000 15000 20000 24000 32000 33000 44000C:happy 900 1200 1800 2400 2700 3600 3600 4800C: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), , :happyD: 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 100A: 2 5 8 11 8 20 32 44 14 35 56 77 20 50 80 110A: 3 6 9 12 12 24 36 48 21 42 63 84 30 60 90 120B: 2 8 14 20 5 20 35 50 8 32 56 80 11 44 77 110B: 4 10 16 22 10 25 40 55 16 40 64 88 22 55 88 121B: 6 12 18 24 15 30 45 60 24 48 72 96 33 66 99 132C: 3 12 21 30 6 24 42 60 9 36 63 90 12 48 84 120C: 6 15 24 33 12 30 48 66 18 45 72 99 24 60 96 132C: 9 18 27 36 18 36 54 72 27 54 81 108 36 72 108 144, , :sadD: 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 220A: 14 17 20 23 56 68 80 92 98 119 140 161 140 170 200 230A: 15 18 21 24 60 72 84 96 105 126 147 168 150 180 210 240B: 26 32 38 44 65 80 95 110 104 128 152 176 143 176 209 242B: 28 34 40 46 70 85 100 115 112 136 160 184 154 187 220 253B: 30 36 42 48 75 90 105 120 120 144 168 192 165 198 231 264C: 39 48 57 66 78 96 114 132 117 144 171 198 156 192 228 264C: 42 51 60 69 84 102 120 138 126 153 180 207 168 204 240 276C: 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:happyD: 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 400A: 8 20 32 44 32 80 128 176 56 140 224 308 80 200 320 440A: 12 24 36 48 48 96 144 192 84 168 252 336 120 240 360 480B: 8 32 56 80 20 80 140 200 32 128 224 320 44 176 308 440B: 16 40 64 88 40 100 160 220 64 160 256 352 88 220 352 484B: 24 48 72 96 60 120 180 240 96 192 288 384 132 264 396 528C: 12 48 84 120 24 96 168 240 36 144 252 360 48 192 336 480C: 24 60 96 132 48 120 192 264 72 180 288 396 96 240 384 528C: 36 72 108 144 72 144 216 288 108 216 324 432 144 288 432 576, , frequentist:sadD: 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 880A: 56 68 80 92 224 272 320 368 392 476 560 644 560 680 800 920A: 60 72 84 96 240 288 336 384 420 504 588 672 600 720 840 960B: 104 128 152 176 260 320 380 440 416 512 608 704 572 704 836 968B: 112 136 160 184 280 340 400 460 448 544 640 736 616 748 880 1012B: 120 144 168 192 300 360 420 480 480 576 672 768 660 792 924 1056C: 156 192 228 264 312 384 456 528 468 576 684 792 624 768 912 1056C: 168 204 240 276 336 408 480 552 504 612 720 828 672 816 960 1104C: 180 216 252 288 360 432 504 576 540 648 756 864 720 864 1008 1152, , bayesian:happyD: D: D: D: E: E: E: E: F: F: F:A: 4000 16000 28000 40000 16000 64000 112000 160000 28000 112000 196000A: 8000 20000 32000 44000 32000 80000 128000 176000 56000 140000 224000A: 12000 24000 36000 48000 48000 96000 144000 192000 84000 168000 252000B: 8000 32000 56000 80000 20000 80000 140000 200000 32000 128000 224000B: 16000 40000 64000 88000 40000 100000 160000 220000 64000 160000 256000B: 24000 48000 72000 96000 60000 120000 180000 240000 96000 192000 288000C: 12000 48000 84000 120000 24000 96000 168000 240000 36000 144000 252000C: 24000 60000 96000 132000 48000 120000 192000 264000 72000 180000 288000C: 36000 72000 108000 144000 72000 144000 216000 288000 108000 216000 324000F: G: G: G: G:A: 280000 40000 160000 280000 400000A: 308000 80000 200000 320000 440000A: 336000 120000 240000 360000 480000B: 320000 44000 176000 308000 440000B: 352000 88000 220000 352000 484000B: 384000 132000 264000 396000 528000C: 360000 48000 192000 336000 480000C: 396000 96000 240000 384000 528000C: 432000 144000 288000 432000 576000, , bayesian:sadD: D: D: D: E: E: E: E: F: F: F:A: 52000 64000 76000 88000 208000 256000 304000 352000 364000 448000 532000A: 56000 68000 80000 92000 224000 272000 320000 368000 392000 476000 560000A: 60000 72000 84000 96000 240000 288000 336000 384000 420000 504000 588000B: 104000 128000 152000 176000 260000 320000 380000 440000 416000 512000 608000B: 112000 136000 160000 184000 280000 340000 400000 460000 448000 544000 640000B: 120000 144000 168000 192000 300000 360000 420000 480000 480000 576000 672000C: 156000 192000 228000 264000 312000 384000 456000 528000 468000 576000 684000C: 168000 204000 240000 276000 336000 408000 480000 552000 504000 612000 720000C: 180000 216000 252000 288000 360000 432000 504000 576000 540000 648000 756000F: G: G: G: G:A: 616000 520000 640000 760000 880000A: 644000 560000 680000 800000 920000A: 672000 600000 720000 840000 960000B: 704000 572000 704000 836000 968000B: 736000 616000 748000 880000 1012000B: 768000 660000 792000 924000 1056000C: 792000 624000 768000 912000 1056000C: 828000 672000 816000 960000 1104000C: 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)), stringsAsFactors=TRUE)> 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"),+ stringsAsFactors=TRUE)> b2 <- books; names(b2)[1] <- names(authors)[1]>> merge(authors, b2, all.x = TRUE)surname nationality deceased title other.author1 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.author1 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 ... Ripley7 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.author1 R Core <NA> <NA> An Introduction to R Venables & Smith> merge(authors, b2[7,], all.x = TRUE)surname nationality deceased title other.author1 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 0attr(,"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 NaNattr(,"scaled:center")[1] 1.0 0.5 0.0attr(,"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 :> z <- ts(matrix(1:300, 100, 3), start = c(1961, 1), frequency = 12)> stopifnot(z == z)> stopifnot(z-z == 0)> if(FALSE) ## <<-- not currently: _R_CHECK_MATRIX_DATA_ \\ related to earlier code:+ tools::assertWarning(matrix(1:90, 10, 3), verbose=TRUE)>> ts(1:5, start=2, end=4) # truncateTime Series:Start = 2End = 4Frequency = 1[1] 1 2 3> ts(1:5, start=3, end=17)# repeatTime Series:Start = 3End = 17Frequency = 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] 10attr(,"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 10attr(,"na.action")[1] 3attr(,"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] 1attr(,"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$formulaY ~ X$A$subset[1] TRUE$B$B$formulaY ~ 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 distMin. : 1.00 Min. :5.000 117 : 5 Min. : 0.501st Qu.: 9.00 1st Qu.:5.300 1028 : 4 1st Qu.: 11.32Median :18.00 Median :6.100 113 : 4 Median : 23.40Mean :14.74 Mean :6.084 112 : 3 Mean : 45.603rd Qu.:20.00 3rd Qu.:6.600 135 : 3 3rd Qu.: 47.55Max. :23.00 Max. :7.700 (Other):147 Max. :370.00NA's : 16accelMin. :0.003001st Qu.:0.04425Median :0.11300Mean :0.154223rd Qu.:0.21925Max. :0.81000> summary(attenu, digits = 5)event mag station distMin. : 1.000 Min. :5.0000 117 : 5 Min. : 0.5001st Qu.: 9.000 1st Qu.:5.3000 1028 : 4 1st Qu.: 11.325Median :18.000 Median :6.1000 113 : 4 Median : 23.400Mean :14.742 Mean :6.0841 112 : 3 Mean : 45.6033rd Qu.:20.000 3rd Qu.:6.6000 135 : 3 3rd Qu.: 47.550Max. :23.000 Max. :7.7000 (Other):147 Max. :370.000NA's : 16accelMin. :0.003001st Qu.:0.04425Median :0.11300Mean :0.154223rd Qu.:0.21925Max. :0.81000> summary(data.matrix(attenu), digits = 5)# the same for matrixevent mag station distMin. : 1.000 Min. :5.0000 Min. : 1.000 Min. : 0.5001st Qu.: 9.000 1st Qu.:5.3000 1st Qu.: 24.250 1st Qu.: 11.325Median :18.000 Median :6.1000 Median : 56.500 Median : 23.400Mean :14.742 Mean :6.0841 Mean : 56.928 Mean : 45.6033rd Qu.:20.000 3rd Qu.:6.6000 3rd Qu.: 86.750 3rd Qu.: 47.550Max. :23.000 Max. :7.7000 Max. :117.000 Max. :370.000NA's :16accelMin. :0.003001st Qu.:0.04425Median :0.11300Mean :0.154223rd Qu.:0.21925Max. :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.592 0.905 10000.000> summary(data.frame(x))xMin. : 0.0601st Qu.: 0.320Median : 0.630Mean : 909.5923rd Qu.: 0.905Max. :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 = factor(c(2L, 1L, 2L, 1L, 2L, 1L, 2L,+ 1L, 2L, 1L, 2L, 1L), labels = c("High", "Low")),+ M.user = factor(c(1L, 1L, 2L, 2L, 1L, 1L, 2L, 2L, 1L,+ 1L, 2L, 2L), labels = c("N", "Y")),+ Soft = factor(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L),+ labels = c("Hard", "Medium", "Soft")),+ 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.m0Call: glm(formula = cbind(X, M) ~ 1, family = binomial, data = detg1)Coefficients:(Intercept)0.01587Degrees of Freedom: 11 Total (i.e. Null); 11 ResidualNull Deviance: 32.83Residual Deviance: 32.83 AIC: 92.52> step(detg1.m0,scope=list(upper=~M.user*Temp*Soft))Start: AIC=92.52cbind(X, M) ~ 1Df 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.128Step: AIC=73.94cbind(X, M) ~ M.userDf 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.524Step: AIC=72.14cbind(X, M) ~ M.user + TempDf 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.162Step: AIC=71.35cbind(X, M) ~ M.user + Temp + M.user:TempDf Deviance AIC<none> 5.6560 71.354- M.user:Temp 1 8.4440 72.142+ Soft 2 5.4952 75.193Call: glm(formula = cbind(X, M) ~ M.user + Temp + M.user:Temp, family = binomial,data = detg1)Coefficients:(Intercept) M.userY TempLow M.userY:TempLow0.26236 -0.85183 0.04411 0.44427Degrees of Freedom: 11 Total (i.e. Null); 8 ResidualNull Deviance: 32.83Residual 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 = factor(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L,+ 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L),+ labels = 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 HeightHeight 352.4365Volume 123.5503 261.5802> dist(z, method="maximum")Girth HeightHeight 72.7Volume 56.4 63.3> dist(z, method="manhattan")Girth HeightHeight 1954.8821Volume 557.1448 1392.3429> dist(z, method="canberra")Girth HeightHeight 21.66477Volume 10.96200 13.63365>> ## F. Tusell 2001-03-07. printing kernels.> kernel("daniell", m=5)Daniell(5)coef[-5] = 0.09091coef[-4] = 0.09091coef[-3] = 0.09091coef[-2] = 0.09091coef[-1] = 0.09091coef[ 0] = 0.09091coef[ 1] = 0.09091coef[ 2] = 0.09091coef[ 3] = 0.09091coef[ 4] = 0.09091coef[ 5] = 0.09091> kernel("modified.daniell", m=5)mDaniell(5)coef[-5] = 0.05coef[-4] = 0.10coef[-3] = 0.10coef[-2] = 0.10coef[-1] = 0.10coef[ 0] = 0.10coef[ 1] = 0.10coef[ 2] = 0.10coef[ 3] = 0.10coef[ 4] = 0.10coef[ 5] = 0.05> kernel("daniell", m=c(3,5,7))Daniell(3,5,7)coef[-15] = 0.0008658coef[-14] = 0.0025974coef[-13] = 0.0051948coef[-12] = 0.0086580coef[-11] = 0.0129870coef[-10] = 0.0181818coef[ -9] = 0.0242424coef[ -8] = 0.0303030coef[ -7] = 0.0363636coef[ -6] = 0.0424242coef[ -5] = 0.0484848coef[ -4] = 0.0536797coef[ -3] = 0.0580087coef[ -2] = 0.0614719coef[ -1] = 0.0640693coef[ 0] = 0.0649351coef[ 1] = 0.0640693coef[ 2] = 0.0614719coef[ 3] = 0.0580087coef[ 4] = 0.0536797coef[ 5] = 0.0484848coef[ 6] = 0.0424242coef[ 7] = 0.0363636coef[ 8] = 0.0303030coef[ 9] = 0.0242424coef[ 10] = 0.0181818coef[ 11] = 0.0129870coef[ 12] = 0.0086580coef[ 13] = 0.0051948coef[ 14] = 0.0025974coef[ 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 Dec1920 1 2 3 4 5 61921 7 8 9 10> cbind(tt, tt + 1)tt tt + 1Jul 1920 1 2Aug 1920 2 3Sep 1920 3 4Oct 1920 4 5Nov 1920 5 6Dec 1920 6 7Jan 1921 7 8Feb 1921 8 9Mar 1921 9 10Apr 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] 1character(0)> f(g2)[1] 1character(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] 1attr(,"class")[1] "foo"character(0)[1] 1attr(,"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) xTRUE1 1 12 1 03 1 14 1 05 1 16 1 07 1 18 1 09 1 110 1 0attr(,"assign")[1] 0 1attr(,"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) x11 1 12 1 -13 1 14 1 -15 1 16 1 -17 1 18 1 -19 1 110 1 -1attr(,"assign")[1] 0 1attr(,"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:z0.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 = 1End = 10Frequency = 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 = 1End = 10Frequency = 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 11Y 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(tmpdir = getwd())))> 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] NAWarning 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 - 1yx 1 21 0 -12 -1 0> unclass(z - 1)yx 1 21 0 -12 -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 w21 5.032 25.627022 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 deletionsModel:Fr ~ (Hair + Eye + Sex)^2Df Deviance AIC<none> 6.761 191.64Hair:Eye 9 156.678 323.56Hair:Sex 3 18.327 197.21Eye: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 foo> ## 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" "Rejection"[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" "Rejection"[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" "Rejection"[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" "Rejection"[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" "Rejection"[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" "Rejection"[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.16794887Warning messages:1: In set.seed(123, type) :RNGkind: Marsaglia-Multicarry has poor statistical properties2: In set.seed(1000, type) :RNGkind: Marsaglia-Multicarry has poor statistical properties3: In set.seed(77, type) :RNGkind: Marsaglia-Multicarry has poor statistical properties> RNGkind(normal.kind = "Kinderman-Ramage")> set.seed(123)> RNGkind()[1] "Knuth-TAOCP-2002" "Kinderman-Ramage" "Rejection"> 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" "Rejection"> 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" "Rejection"> 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 anymoreWarning message:In set.seed(123, "Marsaglia-Multicarry") :RNGkind: Marsaglia-Multicarry has poor statistical properties> 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 z1 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 BLevels: C A B> ## was [1] C A; Levels: C A in 1.4.1>>> ## NA levels in factors> (x <- factor(c("a", "NA", "b"), exclude=NULL))[1] a NA bLevels: 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 tt2Feb 1960 1 11Mar 1960 2 12Apr 1960 3 13May 1960 4 14Jun 1960 5 15Jul 1960 6 16Aug 1960 7 17Sep 1960 8 18Oct 1960 9 19Nov 1960 10 20Dec 1960 11 21Jan 1961 12 22Feb 1961 13 23Mar 1961 14 24Apr 1961 15 25May 1961 16 26Jun 1961 17 27Jul 1961 18 28Aug 1961 19 29Sep 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 valuesIn 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) x0.5114 0.1690Degrees of Freedom: 99 Total (i.e. Null); 98 ResidualNull Deviance: 68.01Residual Deviance: 60.66 AIC: 168.7Warning messages:1: step size truncated: out of bounds2: 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) x1.1561 0.4413Degrees of Freedom: 99 Total (i.e. Null); 98 ResidualNull Deviance: 317.2Residual Deviance: 228.5 AIC: 344.7There were 27 warnings (use warnings() to see them)> summary(warnings())Summary of (a total of 27) warning messages:25x : step size truncated: out of bounds1x : glm.fit: algorithm did not converge1x : 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 - 1attr(,"variables")list(y, A, U, V)attr(,"factors")A:U A:Vy 0 0A 2 2U 2 0V 0 1attr(,"term.labels")[1] "A:U" "A:V"attr(,"order")[1] 2 2attr(,"intercept")[1] 0attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> lm(y ~ A:U + A:V - 1)$coefficients # 1.5.1 used dummies coding for VA:Ua A:Ub A:Uc A:V1 A:V20.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:VCall:lm(formula = y ~ (A + B):(U + V) - 1)Coefficients:A:Ua A:Ub A:Uc A:V1 A:V2 B:Ua B:Ub B:Uc0.2530 -0.2188 -0.7171 -0.6147 -0.0903 1.7428 0.0613 0.7649B: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 -Inf30% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf40% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf50% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf60% 0 0 -Inf -Inf -Inf -Inf -Inf -Inf -Inf70% 0 0 -Inf -Inf -Inf 0 -Inf -Inf -Inf80% 0 0 0 -Inf 0 0 -Inf 0 090% 0 0 0 -Inf 0 0 -Inf 0 0100% 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 -Inf30% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf40% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf50% 0 0.0 -Inf -Inf 0.0 0.0 0.0 0.0000000 0.00060% 0 0.5 0 0.0 0.5 0.6 0.4 0.5333333 0.52570% 1 1.0 1 0.5 1.0 Inf 0.8 Inf Inf80% 1 Inf 1 1.0 Inf Inf Inf Inf Inf90% Inf Inf 1 Inf Inf Inf Inf Inf Inf100% 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 -Inf30% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf40% 0 0.0 -Inf -Inf -Inf -Inf -Inf -Inf -Inf50% 0 0.5 0 0.0 0.5 0.5 0.5 0.500000 0.50060% 1 1.0 1 0.8 1.3 1.4 1.2 1.333333 1.32570% 2 2.0 2 1.6 Inf Inf 1.9 Inf Inf80% Inf Inf 2 Inf Inf Inf Inf Inf Inf90% Inf Inf Inf Inf Inf Inf Inf Inf Inf100% 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 -Inf30% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf40% 0 0 -Inf -Inf -Inf -Inf 0 -Inf -Inf50% 1 1 1 0.5 1.0 1.0 1 1.000000 1.00060% 2 2 2 1.6 2.1 2.2 2 2.133333 2.12570% 3 3 3 2.7 Inf Inf 3 Inf Inf80% Inf Inf Inf Inf Inf Inf Inf Inf Inf90% Inf Inf Inf Inf Inf Inf Inf Inf Inf100% 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 -Inf30% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf40% 0 0.0 0 -Inf 0.1 0.0 0.2 0.06666667 0.07550% 1 1.5 1 1.0 1.5 1.5 1.5 1.50000000 1.50060% 3 3.0 2 2.4 2.9 3.0 2.8 2.93333333 2.92570% 4 4.0 4 3.8 Inf Inf Inf Inf Inf80% Inf Inf Inf Inf Inf Inf Inf Inf Inf90% Inf Inf Inf Inf Inf Inf Inf Inf Inf100% 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 -Inf30% -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf -Inf40% 0 0 0 -Inf 0.3 0.2 0.4 0.2666667 0.27550% 2 2 1 1.5 2.0 2.0 2.0 2.0000000 2.00060% 4 4 3 3.2 3.7 3.8 3.6 3.7333333 3.72570% 5 5 5 4.9 Inf Inf Inf Inf Inf80% Inf Inf Inf Inf Inf Inf Inf Inf Inf90% Inf Inf Inf Inf Inf Inf Inf Inf Inf100% 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))> z1 <NA> 3x 1 4 7y 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 V51 1 6 11 16 212 2 7 12 17 223 3 8 13 18 234 4 9 14 19 245 5 10 15 20 256 -1 -3 -5 -7 -97 -2 -4 -6 -8 -10> rbind(test1, test)V1 V2 V3 V4 V51 -1 -3 -5 -7 -92 -2 -4 -6 -8 -103 1 6 11 16 214 2 7 12 17 225 3 8 13 18 236 4 9 14 19 247 5 10 15 20 25> ## 1.6.1 treated matrix as a vector.>>> ## escapes in non-quoted printing> x <- "\\abc\\"> names(x) <- 1> x1"\\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.yyyMin. : 1.00 Min. : 1.00 Min. :11.001st Qu.: 3.25 1st Qu.: 3.25 1st Qu.:13.25Median : 5.50 Median : 5.50 Median :15.50Mean : 5.50 Mean : 5.50 Mean :15.503rd Qu.: 7.75 3rd Qu.: 7.75 3rd Qu.:17.75Max. :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:dattr(,"variables")list(y, a, b, c, d, e)attr(,"factors")a d e b:c d:ey 0 0 0 0 0a 1 0 0 0 0b 0 0 0 2 0c 0 0 0 2 0d 0 1 0 0 1e 0 0 1 0 1attr(,"term.labels")[1] "a" "d" "e" "b:c" "d:e"attr(,"order")[1] 1 1 1 2 2attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> (tt2 <- terms(formula(tt)))y ~ a + b:c + d + e + e:dattr(,"variables")list(y, a, b, c, d, e)attr(,"factors")a d e b:c d:ey 0 0 0 0 0a 1 0 0 0 0b 0 0 0 2 0c 0 0 0 2 0d 0 1 0 0 1e 0 0 1 0 1attr(,"term.labels")[1] "a" "d" "e" "b:c" "d:e"attr(,"order")[1] 1 1 1 2 2attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> stopifnot(identical(tt, tt2))> terms(delete.response(tt))~a + b:c + d + e + e:dattr(,"variables")list(a, b, c, d, e)attr(,"factors")a d e b:c d:ea 1 0 0 0 0b 0 0 0 2 0c 0 0 0 2 0d 0 1 0 0 1e 0 0 1 0 1attr(,"term.labels")[1] "a" "d" "e" "b:c" "d:e"attr(,"order")[1] 1 1 1 2 2attr(,"intercept")[1] 1attr(,"response")[1] 0attr(,".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 + tensionattr(,"variables")list(breaks, wool, tension)attr(,"factors")wool tensionbreaks 0 0wool 1 0tension 0 1attr(,"term.labels")[1] "wool" "tension"attr(,"order")[1] 1 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> terms(breaks ~ . - tension, data = warpbreaks)breaks ~ (wool + tension) - tensionattr(,"variables")list(breaks, wool, tension)attr(,"factors")woolbreaks 0wool 1tension 0attr(,"term.labels")[1] "wool"attr(,"order")[1] 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> terms(breaks ~ . - tension, data = warpbreaks, simplify = TRUE)breaks ~ woolattr(,"variables")list(breaks, wool, tension)attr(,"factors")woolbreaks 0wool 1tension 0attr(,"term.labels")[1] "wool"attr(,"order")[1] 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> terms(breaks ~ . ^2, data = warpbreaks)breaks ~ (wool + tension)^2attr(,"variables")list(breaks, wool, tension)attr(,"factors")wool tension wool:tensionbreaks 0 0 0wool 1 0 1tension 0 1 1attr(,"term.labels")[1] "wool" "tension" "wool:tension"attr(,"order")[1] 1 1 2attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".Environment")<environment: R_GlobalEnv>> terms(breaks ~ . ^2, data = warpbreaks, simplify = TRUE)breaks ~ wool + tension + wool:tensionattr(,"variables")list(breaks, wool, tension)attr(,"factors")wool tension wool:tensionbreaks 0 0 0wool 1 0 1tension 0 1 1attr(,"term.labels")[1] "wool" "tension" "wool:tension"attr(,"order")[1] 1 1 2attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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 4attr(,"other")[1] A B CLevels: 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> TEMPVAR1 VAR2 VAR31 1 5 12 2 4 13 3 3 14 4 2 15 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 * EPSpar("usr")[3:4]: 3.142 3.142par("yaxp") : 3.142 3.142 3j.f = 1e-12 ; rel.range = 56.02 * EPSpar("usr")[3:4]: 3.142 3.142par("yaxp") : 3.142 3.142 3j.f = 7e-13 ; rel.range = 39.47 * EPSpar("usr")[3:4]: 3.142 3.142par("yaxp") : 3.142 3.142 5j.f = 3e-13 ; rel.range = 16.55 * EPSpar("usr")[3:4]: 3.142 3.142par("yaxp") : 3.142 3.142 1j.f = 2e-13 ; rel.range = 11.46 * EPSpar("usr")[3:4]: 3.108 3.176par("yaxp") : 3.11 3.17 6j.f = 1e-13 ; rel.range = 5.093 * EPSpar("usr")[3:4]: 3.108 3.176par("yaxp") : 3.11 3.17 6j.f = 5e-14 ; rel.range = 2.546 * EPSpar("usr")[3:4]: 3.108 3.176par("yaxp") : 3.11 3.17 6j.f = 3e-14 ; rel.range = 1.273 * EPSpar("usr")[3:4]: 3.108 3.176par("yaxp") : 3.11 3.17 6j.f = 1e-14 ; rel.range = 0 * EPSpar("usr")[3:4]: 1.784 4.499par("yaxp") : 2 4 4Warning message:In plot.window(...) :axis(2, *): range of values ( 0) is small wrt |M| = 4 --> not pretty()> 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.94y ~ x1 + x2 + x3 + x4Df 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.576Step: AIC=24.97y ~ x1 + x2 + x4Df 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.629Call:lm(formula = y ~ x1 + x2 + x4, data = d2)Coefficients:(Intercept) x1 x2 x471.6483 1.4519 0.4161 -0.2365> ## failed in 1.6.2>> str(array(1))# not a scalarnum [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 3b 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 x31.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.2699Coefficients: (1 not defined because of singularities)Estimate Std. Error t value Pr(>|t|)(Intercept) 1.4719 0.9484 1.552 0.165x1 0.5867 0.3961 1.481 0.182x2 NA NA NA NAx3 0.2587 0.3509 0.737 0.485Residual standard error: 0.8063 on 7 degrees of freedomMultiple R-squared: 0.9326, Adjusted R-squared: 0.9134F-statistic: 48.43 on 2 and 7 DF, p-value: 7.946e-05Correlation of Coefficients:(Intercept) x1x1 -0.91x3 0.81 -0.97> (fit <- glm(y ~ x1 + x2 + x3))Call: glm(formula = y ~ x1 + x2 + x3)Coefficients:(Intercept) x1 x2 x31.4719 0.5867 NA 0.2587Degrees of Freedom: 9 Total (i.e. Null); 7 ResidualNull Deviance: 67.53Residual Deviance: 4.551 AIC: 28.51> summary(fit, cor = TRUE)Call:glm(formula = y ~ x1 + x2 + x3)Coefficients: (1 not defined because of singularities)Estimate Std. Error t value Pr(>|t|)(Intercept) 1.4719 0.9484 1.552 0.165x1 0.5867 0.3961 1.481 0.182x2 NA NA NA NAx3 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 freedomResidual deviance: 4.5512 on 7 degrees of freedomAIC: 28.507Number of Fisher Scoring iterations: 2Correlation of Coefficients:(Intercept) x1x1 -0.91x3 0.81 -0.97> ## omitted silently in summary.glm < 1.8.0>>> ## list-like indexing of data frames with drop specified> women["height"]height1 582 593 604 615 626 637 648 659 6610 6711 6812 6913 7014 7115 72> women["height", drop = FALSE] # same with a warningheight1 582 593 604 615 626 637 648 659 6610 6711 6812 6913 7014 7115 72Warning message:In `[.data.frame`(women, "height", drop = FALSE) :'drop' argument will be ignored> women["height", drop = TRUE] # dittoheight1 582 593 604 615 626 637 648 659 6610 6711 6812 6913 7014 7115 72Warning message:In `[.data.frame`(women, "height", drop = TRUE) :'drop' argument will be ignored> women[,"height", drop = FALSE] # no warningheight1 582 593 604 615 626 637 648 659 6610 6711 6812 6913 7014 7115 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>> op <- options(warn = 2) # *no* warnings (for now)>> ## 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.1row.names1 17> aa <- data.frame(aa=1:3)> aa[["row.names"]] <- 4:6> aa # fine in 1.7.1aa row.names1 1 42 2 53 3 6> A <- matrix(4:9, 3, 2)> colnames(A) <- letters[1:2]> aa[["row.names"]] <- A> aaaa row.names.a row.names.b1 1 4 72 2 5 83 3 6 9> ## wrong printed names in 1.7.1>> ## assigning to NULL --- now consistently behaves as if assigning to list() !> a <- NULL> a[["a"]] <- 1> a$a[1] 1> a <- NULL> a[["a"]] <- "something"> a$a[1] "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.55292No CoefficientsResidual standard error: 0.5235 on 10 degrees of freedom> anova(fit)Analysis of Variance TableResponse: yDf 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 100 0 0 0 0 0 0 0 0 0> predict(fit, data.frame(x=x), se=TRUE)$fit1 2 3 4 5 6 7 8 9 100 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 emptycharacter(0)> model.matrix(fit)12345678910attr(,"assign")integer(0)>> (fit <- lm(y ~ x + 0))Call:lm(formula = y ~ x + 0)Coefficients:xNA> summary(fit)Call:lm(formula = y ~ x + 0)Residuals:Min 1Q Median 3Q Max-1.36919 -0.21073 0.00840 0.08437 0.55292Coefficients: (1 not defined because of singularities)Estimate Std. Error t value Pr(>|t|)x NA NA NA NAResidual standard error: 0.5235 on 10 degrees of freedom> anova(fit)Analysis of Variance TableResponse: yDf 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 100 0 0 0 0 0 0 0 0 0> tools::assertWarning(+ predict(fit, data.frame(x=x), se=TRUE) -> p0+ )> p0$fit1 2 3 4 5 6 7 8 9 100 0 0 0 0 0 0 0 0 0attr(,"non-estim")1 2 3 4 5 6 7 8 9 101 2 3 4 5 6 7 8 9 10$se.fit[1] 0 0 0 0 0 0 0 0 0 0$df[1] 10$residual.scale[1] 0.5234843> if(FALSE)## not yet:+ stopifnot(identical(p0$fit, predict(fit, data.frame(x=x), rankdeficient = "NA")))> predict(fit, type="terms", se=TRUE)$fitx1 02 03 04 05 06 07 08 09 010 0attr(,"constant")[1] 0$se.fitx1 02 03 04 05 06 07 08 09 010 0$df[1] 10$residual.scale[1] 0.5234843> variable.names(fit) #should be emptycharacter(0)> model.matrix(fit)x1 02 03 04 05 06 07 08 09 010 0attr(,"assign")[1] 1>> (fit <- glm(y ~ 0))Call: glm(formula = y ~ 0)No coefficientsDegrees of Freedom: 10 Total (i.e. Null); 10 ResidualNull Deviance: 2.74Residual Deviance: 2.74 AIC: 17.43> summary(fit)Call:glm(formula = y ~ 0)No Coefficients(Dispersion parameter for gaussian family taken to be 0.2740358)Null deviance: 2.7404 on 10 degrees of freedomResidual deviance: 2.7404 on 10 degrees of freedomAIC: 17.434Number of Fisher Scoring iterations: 0> anova(fit)Analysis of Deviance TableModel: gaussian, link: identityResponse: yTerms added sequentially (first to last)Df Deviance Resid. Df Resid. Dev F Pr(>F)NULL 10 2.7404> predict(fit)1 2 3 4 5 6 7 8 9 100 0 0 0 0 0 0 0 0 0> predict(fit, data.frame(x=x), se=TRUE)$fit1 2 3 4 5 6 7 8 9 100 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:xNADegrees of Freedom: 10 Total (i.e. Null); 10 ResidualNull Deviance: 2.74Residual Deviance: 2.74 AIC: 17.43> summary(fit)Call:glm(formula = y ~ x + 0)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 freedomResidual deviance: 2.7404 on 10 degrees of freedomAIC: 17.434Number of Fisher Scoring iterations: 2> anova(fit)Analysis of Deviance TableModel: gaussian, link: identityResponse: yTerms added sequentially (first to last)Df Deviance Resid. Df Resid. Dev F Pr(>F)NULL 10 2.7404x 0 0 10 2.7404> predict(fit)1 2 3 4 5 6 7 8 9 100 0 0 0 0 0 0 0 0 0> tools::assertWarning(+ predict(fit, data.frame(x=x), se=TRUE) -> p0+ )> p0$fit1 2 3 4 5 6 7 8 9 100 0 0 0 0 0 0 0 0 0attr(,"non-estim")1 2 3 4 5 6 7 8 9 101 2 3 4 5 6 7 8 9 10$se.fit[1] 0 0 0 0 0 0 0 0 0 0$residual.scale[1] 0.5234843> if(FALSE)## not yet:+ stopifnot(identical(p0$fit, predict(fit, data.frame(x=x), rankdeficient = "NA")))> predict(fit, type="terms", se=TRUE)$fitx1 02 03 04 05 06 07 08 09 010 0attr(,"constant")[1] 0$se.fitx1 02 03 04 05 06 07 08 09 010 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))$hatb e f g h i j0.6546053 0.2105263 0.1546053 0.1447368 0.1809211 0.2631579 0.3914474$coefficients(Intercept) x1b 1.39138784 -0.173267165e -0.70930972 0.068642877f 0.12039809 -0.007818058g 0.01971595 0.001314397h 0.03272637 -0.017325726i -0.36929526 0.092323814j 0.33861311 -0.070163076$sigmab e f g h i j0.9641441 0.7434598 1.0496727 1.0681908 1.0389586 0.7633748 1.0093187$wt.resb e f g h i j0.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))$hatb e c d f g h i0.6546053 0.2105263 0.0000000 0.0000000 0.1546053 0.1447368 0.1809211 0.2631579j0.3914474$coefficients(Intercept) x1b 1.39138784 -0.173267165e -0.70930972 0.068642877c 0.00000000 0.000000000d 0.00000000 0.000000000f 0.12039809 -0.007818058g 0.01971595 0.001314397h 0.03272637 -0.017325726i -0.36929526 0.092323814j 0.33861311 -0.070163076$sigmab e c d f g h i0.9641441 0.7434598 0.9589854 0.9589854 1.0496727 1.0681908 1.0389586 0.7633748j1.0093187$wt.resb e c d f g h0.5513046 -1.3728575 NA NA 0.4018482 0.1708716 -0.4793451i j1.2925334 -0.5643552> lm.influence(lm(y ~ 0, data=dat, weights=wt, na.action=na.omit))$hatb d e f g h i j0 0 0 0 0 0 0 0$coefficientsbdefghij$sigmab d e f g h i j0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289$wt.resb d e f g h i0.3604547 0.1146812 -1.1426753 0.7723744 0.6817419 0.1718693 2.0840918j0.3675473> print(width = 99,+ lm.influence(lm(y ~ 0, data=dat, weights=wt, na.action=na.exclude))+ ) ; stopifnot(getOption("width") == 80)$hatb d c e f g h i j0 0 0 0 0 0 0 0 0$coefficientsbdcefghij$sigmab d c e f g h i j0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289$wt.resb d c e f g h i j0.3604547 0.1146812 NA -1.1426753 0.7723744 0.6817419 0.1718693 2.0840918 0.3675473> lm.influence(lm(y ~ 0 + x3, data=dat, weights=wt, na.action=na.omit))$hatb d e f g h i j0 0 0 0 0 0 0 0$coefficientsbdefghij$sigmab d e f g h i j0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289$wt.resb d e f g h i0.3604547 0.1146812 -1.1426753 0.7723744 0.6817419 0.1718693 2.0840918j0.3675473> lm.influence(lm(y ~ 0 + x3, data=dat, weights=wt, na.action=na.exclude))$hatb d c e f g h i j0 0 0 0 0 0 0 0 0$coefficientsbdcefghij$sigmab d c e f g h i0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289 0.9366289j0.9366289$wt.resb d c e f g h0.3604547 0.1146812 NA -1.1426753 0.7723744 0.6817419 0.1718693i j2.0840918 0.3675473> lm.influence(lm(y ~ 0, data=dat, na.action=na.exclude))$hata b c d e f g h i j0 0 0 0 0 0 0 0 0 0$coefficientsabcdefghij$sigmaa b c d e f g h0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 0.8860916 0.8860916i j0.8860916 0.8860916$wt.resa b c d e f g0.2196280 0.3604547 NA 0.1146812 -1.1426753 0.7723744 0.6817419h i j0.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.10 11.0000000 0.7644046> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=2)0 1 21.0000000 0.7644046 0.2676056> ARMAacf(ar=c(1.3,-0.6, -0.2, 0.1),lag.max=3)0 1 2 31.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 41.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.10 1 2 3 4 51.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 61.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 61.0000000 0.7644046 0.2676056 -0.2343150 -0.5180538 -0.5099616 -0.27849427 8 9 100.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 anyDuplicated[11] anyNA as.data.frame as.list as.matrix as.vector[16] by cbind dim dimnames dimnames<-[21] droplevels duplicated edit format formula[26] head is.na merge na.exclude na.omit[31] plot print prompt rbind row.names[36] row.names<- rowsum split split<- stack[41] str subset summary t tail[46] transform type.convert unique unstack within[51] xtfrm> 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[]somea b c d e1 2 3 4 5> x[2:3]someb c2 3> x[2]b2> x[2, drop=FALSE]someb2> ## 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 32 NA3 1.414214 NA4 2.828427 1.414214 1.414214> print(d, diag = TRUE)1 2 3 41 0.0000002 NA 0.0000003 1.414214 NA 0.0000004 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) xTRUE1 1 NAattr(,"assign")[1] 0 1attr(,"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)y1 12 23 34 45 56 67 78 89 910 10> data.frame(y=y2)y.a y.b y.c1 1 11 212 2 12 223 3 13 234 4 14 245 5 15 256 6 16 267 7 17 278 8 18 289 9 19 2910 10 20 30> data.frame(y=y3)y.a.1 y.b.1 y.a.2 y.b.21 1 11 21 312 2 12 22 323 3 13 23 334 4 14 24 345 5 15 25 356 6 16 26 367 7 17 27 378 8 18 28 389 9 19 29 3910 10 20 30 40>> as.data.frame(y1)y11 12 23 34 45 56 67 78 89 910 10> as.data.frame(y2)a b c1 1 11 212 2 12 223 3 13 234 4 14 245 5 15 256 6 16 267 7 17 278 8 18 289 9 19 2910 10 20 30> as.data.frame(y3)a.1 b.1 a.2 b.21 1 11 21 312 2 12 22 323 3 13 23 334 4 14 24 345 5 15 25 356 6 16 26 367 7 17 27 378 8 18 28 389 9 19 29 3910 10 20 30 40>> X <- data.frame(x=1:10)> X$y <- y1> Xx y1 1 12 2 23 3 34 4 45 5 56 6 67 7 78 8 89 9 910 10 10> sapply(X, dim)$xNULL$y[1] 10>> X$y <- y2> Xx y.a y.b y.c1 1 1 11 212 2 2 12 223 3 3 13 234 4 4 14 245 5 5 15 256 6 6 16 267 7 7 17 278 8 8 18 289 9 9 19 2910 10 10 20 30> sapply(X, dim)$xNULL$y[1] 10 3>> X$y <- y3> Xx y.a.1 y.b.1 y.a.2 y.b.21 1 1 11 21 312 2 2 12 22 323 3 3 13 23 334 4 4 14 24 345 5 5 15 25 356 6 6 16 26 367 7 7 17 27 378 8 8 18 28 389 9 9 19 29 3910 10 10 20 30 40> sapply(X, dim)$xNULL$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' AonLoad 'stats4' B<environment: namespace:stats4>> library("stats4")attach 'stats4' Aattach 'stats4' B> detach("package:stats4")detach 'stats4' Bdetach 'stats4' A> unloadNamespace("stats4")onUnload 'stats4' BonUnload '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.8066534Stratum 1: cTerms:bSum of Squares 0.3176489Deg. of Freedom 1Estimated effects are balancedStratum 2: WithinTerms:a b ResidualsSum of Squares 1.389453 2.148149 5.048689Deg. of Freedom 1 1 4Residual standard error: 1.123464Estimated 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: cTerms:a bSum of Squares 5.205518 0.317649Deg. of Freedom 1 11 out of 3 effects not estimableEstimated effects may be unbalancedStratum 2: WithinTerms:a b ResidualsSum of Squares 1.389453 2.148149 5.048689Deg. of Freedom 1 1 4Residual standard error: 1.1234641 out of 3 effects not estimableEstimated 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 < epsilonExact binomial testdata: c(800, 10)number of successes = 800, number of trials = 810, p-value < 2.2e-16alternative hypothesis: true probability of success is not equal to 0.595 percent confidence interval:0.9774134 0.9940643sample estimates:probability of success0.9876543>> options(op) # revert: warnings allowed>> ## 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: singularWarning message:In aov(dep.variable ~ f1 * f2 + Error(subject/(f1 + f2)), data = sample.df) :Error() model is singular> sample.aovCall:aov(formula = dep.variable ~ f1 * f2 + Error(subject/(f1 + f2)),data = sample.df)Grand Mean: 65.07444Stratum 1: subjectTerms:f1 f2 f1:f2Sum of Squares 47815.99 312824.49 100370.96Deg. of Freedom 1 2 22 out of 7 effects not estimableEstimated effects may be unbalancedStratum 2: subject:f1Terms:f1 f1:f2Sum of Squares 483.9628 869.6876Deg. of Freedom 2 4Estimated effects may be unbalancedStratum 3: WithinTerms:ResidualsSum of Squares 29204.13Deg. of Freedom 42Residual standard error: 26.36923> summary(sample.aov)Error: subjectDf Sum Sq Mean Sqf1 1 47816 47816f2 2 312824 156412f1:f2 2 100371 50185Error: subject:f1Df Sum Sq Mean Sqf1 2 484.0 242.0f1:f2 4 869.7 217.4Error: WithinDf 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.aovCall:aov(formula = dep.variable ~ f1 * f2 + Error(subject/(f2 + f1)),data = sample.df)Grand Mean: 65.07444Stratum 1: subjectTerms:f1 f2 f1:f2Sum of Squares 47815.99 312824.49 100370.96Deg. of Freedom 1 2 22 out of 7 effects not estimableEstimated effects may be unbalancedStratum 2: subject:f1Terms:f1 f1:f2Sum of Squares 483.9628 869.6876Deg. of Freedom 2 4Estimated effects may be unbalancedStratum 3: WithinTerms:ResidualsSum of Squares 29204.13Deg. of Freedom 42Residual standard error: 26.36923> summary(sample.aov)Error: subjectDf Sum Sq Mean Sqf1 1 47816 47816f2 2 312824 156412f1:f2 2 100371 50185Error: subject:f1Df Sum Sq Mean Sqf1 2 484.0 242.0f1:f2 4 869.7 217.4Error: WithinDf 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 | 0000000000100000000 |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.3641637Warning 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.3641637Warning 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.3641637Warning 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 FALSEWarning 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,] FALSEWarning 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 FALSEWarning 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,] FALSEWarning 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' AonLoad 'stats4' Battach 'stats4' Aattach '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 estimationCall:mle(minuslogl = function(Lam = 1) -sum(dpois(N, Lam)))Coefficients:Estimate Std. ErrorLam 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, ". ~.")$callglm(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)) + zattr(,"variables")list(y, offset(x), offset(log(x)), z)attr(,"offset")[1] 2 3attr(,"factors")zy 0offset(x) 0offset(log(x)) 0z 1attr(,"term.labels")[1] "z"attr(,"order")[1] 1attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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] 2attr(,"factors")integer(0)attr(,"term.labels")character(0)attr(,"order")integer(0)attr(,"intercept")[1] 1attr(,"response")[1] 1attr(,".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> xa b c d e f g h i j k l m n o p q r s t100 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20u v w x y z aa21 22 23 24 25 26 102>> x <- 1:26> names(x) <- rep("", 26)> x[c("a", "aa", "aa")] <- 100:102> x1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20a aa21 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"Warning message:In readChar(zz, length(xx)) : truncating string with embedded nuls> 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 x21.88803 -0.15694 -0.09072> predict(lm1, newdata = data.frame(x= xt))1 2 3 4 5 61.36820341 1.02982433 1.14505218 0.35306615 0.92190094 0.129914927 8 9 100.33586416 -0.09323631 -0.15945124 0.22794078Warning 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 Volume1 8.3 70 10.3> trees[1, ]Girth Height Volume1 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(tmpdir = getwd())> write.table(Mat, foo, col.names = FALSE, row.names = FALSE)> read.table(foo, colClasses = c(NA, NA, "NULL", "character", "Date", "POSIXct"),+ stringsAsFactors=TRUE)V1 V2 V4 V5 V61 1 a A 2004-01-01 2004-01-01 12:00:002 2 b B 2004-02-01 2004-02-01 12:00:003 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"),+ stringsAsFactors=TRUE)V1 V2 V4 V5 V61 1 a A 2004-01-01 2004-01-01 12:00:002 2 b B 2004-02-01 2004-02-01 12:00:003 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"), stringsAsFactors=TRUE)V1 V2 V3 V4 V5 V61 1 a 1 A 2004-01-01 2004-01-01 12:002 2 b 2 B 2004-02-01 2004-02-01 12:003 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) # loopedV1 V2 V31 12 34 5672 1 23 4563 12 34 5> read.fwf("test.txt", width=c(2,2,3), skip=1) # 1 line shortV1 V2 V31 12 34 5672 1 23 4563 12 34 5> read.fwf("test.txt", width=c(2,2,3), skip=0)V1 V2 V31 12 34 5672 1 23 4563 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 32244chr ...> str(factor(x))Factor w/ 1 level "ab\bc\ndef": 1>> x <- c("a", NA, "b")> factor(x)[1] a <NA> bLevels: a b> factor(x, exclude="")[1] a <NA> bLevels: 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 " testLevels: a a " test b> factor(x, exclude="")[1] a <NA> b a " testLevels: 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)"))> x1a b.1 b.2 c1 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)))> x2a ba 1 1b 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> x4x y1 1 2005-01-012 2 2005-01-023 3 2005-01-034 4 2005-01-045 5 2005-01-056 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 deletionsModel:y ~ xDf Sum of Sq RSS AIC<none> 9.1728 -9.8358x 1 1.6593 10.8321 -8.6766> 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 additionsModel:y ~ xDf Sum of Sq RSS AIC<none> 8.8475 -8.7842x2 1 0.030932 8.8166 -6.8473Warning 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(tmpdir = getwd())> 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 V21 6 TV2 Shortland Street2 2 I don't watch TV at 73 1 I'm not bothered, whatever that looks good4 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 V21 6 TV2 Shortland Street2 2 I don't watch TV at 73 1 I'm not bothered, whatever that looks good4 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:b41 1 0 0 0 0 0 0 0 0 0 0 02 1 0 0 1 0 0 0 0 0 0 0 03 1 0 0 0 1 0 0 0 0 0 0 04 1 0 0 0 0 1 0 0 0 0 0 05 1 1 0 0 0 0 0 0 0 0 0 06 1 1 0 1 0 0 1 0 0 0 0 07 1 1 0 0 1 0 0 0 1 0 0 08 1 1 0 0 0 1 0 0 0 0 1 09 1 0 1 0 0 0 0 0 0 0 0 010 1 0 1 1 0 0 0 1 0 0 0 011 1 0 1 0 1 0 0 0 0 1 0 012 1 0 1 0 0 1 0 0 0 0 0 1attr(,"assign")[1] 0 1 1 2 2 2 3 3 3 3 3 3attr(,"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 additionsModel:y ~ 1Df Sum of Sq RSS AIC<none> 6.3161 -2.59479z 1 0.00029765 6.3158 -0.59526> anova(lm1, lm2)Analysis of Variance TableModel 1: y ~ 1Model 2: y ~ zRes.Df RSS Df Sum of Sq F Pr(>F)1 9 89.1302 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 additionsModel:y ~ 1Df Sum of Sq RSS AIC<none> 89.130 23.8751z 1 82.814 6.316 -0.5953> drop1(lm2)Single term deletionsModel:y ~ zDf Sum of Sq RSS AIC<none> 6.316 -0.5953z 1 82.814 89.130 23.8751> ## Last two ignored the offset in 2.1.1>>> ## tests of raw conversion> as.raw(1234)[1] 00Warning message:out-of-range values treated as 0 in coercion to raw> as.raw(list(a=1234))[1] 00Warning 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; df1a1 NA2 23 34 4> m1[m1 == 0] <- 2; m1a[1,] NA[2,] 2[3,] 3[4,] 4> df2[df2 == 0] <- 2; df2 # not allowed in 2.{0,1}.za1 NA2 23 24 4> m2[m2 == 0] <- 2; m2a[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 rownames1 40 0> m1[which(m1 == 0)] # has rownames1 40 0> m1[which(m1 == 0, arr.ind = TRUE)] # no names < 2.2.0 (side effect of PR#937)1 40 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 # now, a list$foo[1] 2> x <- NULL> x[[2]] <- pi> x # now, a list, too[[1]]NULL[[2]][1] 3.141593> x <- NULL> x[[1]] <- 1:3> x # list[[1]][1] 1 2 3> ##>>> ## printing of a kernel:> kernel(1)unknowncoef[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 x[[jj]][iseq] <- vjj : 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:4x y1 a <NA>2 b b3 c c4 d d5 e e> # and adding and replacing matrices failed> a.frame[ ,"y" ] <- matrix(1:10, 5, 2)> a.framex y.1 y.21 a 1 62 b 2 73 c 3 84 d 4 95 e 5 10> a.frame[3:5 ,"y" ] <- matrix(1:6, 3, 2)> a.framex y.1 y.21 a 1 62 b 2 73 c 1 44 d 2 55 e 3 6> a.frame <- data.frame( x=letters[1:5] )> a.frame[3:5 ,"y" ] <- matrix(1:6, 3, 2)> a.framex y.1 y.21 a NA NA2 b NA NA3 c 1 44 d 2 55 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)> Sys.unsetenv("_R_CHECK_BROWSER_NONINTERACTIVE_")> 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>> op <- c(op, 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)> ## unlimited < 2.3.0> options(op)>> ## Debugger can handle a function that has a single function call as its body> g <- function(fun) fun(1)> debug(g)> g(function(x) x+1)debugging in: g(function(x) x + 1)debug: fun(1)Browse[2]> cexiting from: g(function(x) x + 1)[1] 2>> ## Trap debugger in non-interactive sessions> if (!interactive()) {+ Sys.setenv("_R_CHECK_BROWSER_NONINTERACTIVE_" = "true")+ tools::assertError(browser())+ browser(expr = FALSE) # but this passes (with no output)+ Sys.unsetenv("_R_CHECK_BROWSER_NONINTERACTIVE_")+ }>>> ## row names in as.table (PR#8652)> as.table(matrix(1:60, ncol=2))A BA 1 31B 2 32C 3 33D 4 34E 5 35F 6 36G 7 37H 8 38I 9 39J 10 40K 11 41L 12 42M 13 43N 14 44O 15 45P 16 46Q 17 47R 18 48S 19 49T 20 50U 21 51V 22 52W 23 53X 24 54Y 25 55Z 26 56A1 27 57B1 28 58C1 29 59D1 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)Coefficients:Estimate Std. Error t value Pr(>|t|)(Intercept) -0.7532 0.7862 -0.958 0.370x 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 freedomResidual deviance: 8.1988 on 7 degrees of freedomAIC: InfNumber of Fisher Scoring iterations: 2Warning 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)Coefficients:Estimate Std. Error t value Pr(>|t|)(Intercept) -0.7532 0.7862 -0.958 0.370x 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 freedomResidual deviance: 8.1988 on 7 degrees of freedomAIC: 30.702Number 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.8295023Warning 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 z1 1 a 12 2 b 23 3 c 34 4 d 45 5 e 56 6 f 67 7 g 78 8 h 89 9 i 910 10 j 1011 7 A 512 8 B 413 9 C 314 10 D 215 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 x1 1 5 82 2 6 93 3 8 -14 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 72 5 83 6 9> # wrong < 2.3.1 patched.> write.table(m, quote=FALSE)I II IIIA 1 4 7B 2 5 8C 3 6 9> write.table(m, col.names=FALSE, quote=FALSE)A 1 4 7B 2 5 8C 3 6 9> write.table(m, row.names=FALSE, quote=FALSE)I II III1 4 72 5 83 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 72 5 83 6 9> write.table(d, quote=FALSE)I II IIIA 1 4 7B 2 5 8C 3 6 9> write.table(d, col.names=FALSE, quote=FALSE)A 1 4 7B 2 5 8C 3 6 9> write.table(d, row.names=FALSE, quote=FALSE)I II III1 4 72 5 83 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 DLevels: A B C D E> x[2][1] CLevels: A B C D E> x[[2]][1] CLevels: A B C D E> stopifnot(identical(x[2], x[[2]]))> as.list(x)[[1]][1] BLevels: A B C D E[[2]][1] CLevels: A B C D E[[3]][1] DLevels: A B C D E> (xx <- unlist(as.list(x)))[1] B C DLevels: A B C D E> stopifnot(identical(x, xx))> as.vector(x, "list")[[1]][1] BLevels: A B C D E[[2]][1] CLevels: A B C D E[[3]][1] DLevels: A B C D E> (sx <- sapply(x, function(.).))[1] B C DLevels: 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)))> print(residuals(fit, type="working"),+ width = 37) # first was NA < 2.4.0 // using new 'width'1 2 3-0.31250000 0.15546875 -0.132313834 5 6-0.11111111 -0.20909091 0.346228247 8 90.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)D2D1abc> apply(A, 1, f)a b c5 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 d1 2 3 4Levels: 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 12Levels: 7 8 9 10 11 12> str(A)Factor[1:2, 1:3] w/ 6 levels "7","8","9","10",..: 1 2 3 4 5 6> A[, 1:2][,1] [,2][1,] 7 9[2,] 8 10Levels: 7 8 9 10 11 12> A[, 1:2, drop=TRUE][1] 7 8 9 10Levels: 7 8 9 10> A[1,1] <- "9"> A[,1] [,2] [,3][1,] 9 9 11[2,] 8 10 12Levels: 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 b1 2002-09-15 NA 12 2002-10-15 NA 23 2002-11-15 1 34 2002-12-15 2 45 2003-01-15 3 NA6 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.2359 -0.8766 0.2338 0.9944 2.5905Coefficients:Estimate Std. Error t value Pr(>|t|)(Intercept) 1.1419 0.1966 5.808 6.47e-07 ***---Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Residual standard error: 1.319 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.2822 -1.2548 0.4364 1.2185 3.8575Coefficients:Estimate Std. Error t value Pr(>|t|)(Intercept) 2.7098 0.2798 9.685 1.77e-12 ***---Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Residual standard error: 1.877 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 = NA_integer_, c = NA_real_, d = NA_complex_,+ 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(NA, NA, NA, NA, 1, 1, 1:3, c(NA, 1, 2, 3), NA, c("foo",NA, "bar"))> dput(x, control="keepInteger")list(NA, NA_integer_, NA, NA, 1, 1L, 1:3, c(NA, 1L, 2L, 3L),NA, c("foo", NA, "bar"))> dput(x, control="keepNA")list(NA, NA_integer_, NA_real_, NA_complex_, 1, 1, 1:3, c(NA,1, 2, 3), NA_character_, c("foo", NA, "bar"))> dput(x)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"))> dput(x, control="all")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"))> dput(x, control=c("all", "S_compatible"))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"))> tmp <- tempfile(tmpdir = getwd())> 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-01Levels: 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-01Levels: 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 2006Error in `.rowNamesDF<-`(x, value = value) : 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> Aax 1y 2z 3> ##>>> ## extreme cases for subsetting of data frames> w <- women[1, ]> w[]height weight1 58 115> w[,drop = TRUE]height weight1 58 115Warning message:In `[.data.frame`(w, , drop = TRUE) : 'drop' argument will be ignored> w[1,]height weight1 58 115> w[,]height weight1 58 115> w[1, , drop = FALSE]height weight1 58 115> w[, , drop = FALSE]height weight1 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), class = "data.frame", row.names = c(NA,-4L))> dput(d1)structure(list(X1.4 = 1:4), class = "data.frame", row.names = c(NA,4L))> identical(d0, d1)[1] TRUE> all.equal(d0, d1)[1] TRUE> ## change to identical(,attrib.as.set) code to support internal representation in 4.2.0> identical(d0, d1, attrib.as.set = FALSE)[1] TRUE> ##> row.names(d1) <- as.character(1:4)> dput(d1)structure(list(X1.4 = 1:4), class = "data.frame", row.names = c("1","2", "3", "4"))> 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 sourcefunction(x, xm = max(1L, x)) {xx <- 0L; yy <- NA_real_}> dput(f) # not sourcefunction (x, xm = max(1L, x)){xx <- 0Lyy <- NA_real_}> dput(f, control="all") # uses the sourcefunction(x, xm = max(1L, x)) {xx <- 0L; yy <- NA_real_}> cat(deparse(f), sep="\n")function (x, xm = max(1L, x)){xx <- 0Lyy <- NA_real_}> dump("f", file="")f <-function(x, xm = max(1L, x)) {xx <- 0L; yy <- NA_real_}> # remove the source> attr(f, "srcref") <- NULL> ffunction (x, xm = max(1L, x)){xx <- 0Lyy <- NA_real_}> dput(f, control="all")function (x, xm = max(1L, x)){xx <- 0Lyy <- NA_real_}> dump("f", file="")f <-function (x, xm = max(1L, x)){xx <- 0Lyy <- 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 okinteger(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(y, x)) ## (updating "filled")[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)))> ## regression 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)yzero NAone 7> qr.fitted(qr(A), y)yA 7B 7C 7>> qr.coef(qr(matrix(0:1, 1, dimnames=list(NULL, c("zero","one")))), 5)zero oneNA 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(tmpdir = getwd())> 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.3224857 2.2194594x NA NAuY -2.6821240 0.3560815> confint.default(fit)2.5 % 97.5 %(Intercept) -0.1317629 2.0287366x NA NAuY -2.4541666 0.1281242> ## 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] <- xWarning message:In `[<-.data.frame`(`*tmp*`, , 3, value = list(a = 1:3, b = 2:4)) :provided 2 variables to replace 1 variables> xa b a.11 1 2 12 2 3 23 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 c1 1 32 2 43 3 54 4 65 5 7> within(abc,{d<-a+7;b<-NULL})a c d1 1 3 82 2 4 93 3 5 104 4 6 115 5 7 12> within(abc,{a<-a+7;b<-NULL})a c1 8 32 9 43 10 54 11 65 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.11 12 2> ## used to fail obscurely.>>> ## subsetting data frames with duplicate rows> z <- data.frame(a=1, a=2, b=3, check.names=FALSE)> z[] # OKa a b1 1 2 3> z[1, ]a a b1 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> Callfoo(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 (...) .Primitive(\"c\")"))> ## ^^ would have failed up to R 2.9.x> foofunction(given = NULL) {callObj <- quote(callFunc())if(!is.null(given)) callObj$given <- givenif (is.null(given)) callObj$default <- TRUEcallObj}<bytecode: 0x5555f08>> print(foo, useSource = FALSE)function (given = NULL){callObj <- quote(callFunc())if (!is.null(given))callObj$given <- givenif (is.null(given))callObj$default <- TRUEcallObj}<bytecode: 0x5555f08>> attr(foo, "srcref") <- NULL> foofunction (given = NULL){callObj <- quote(callFunc())if (!is.null(given))callObj$given <- givenif (is.null(given))callObj$default <- TRUEcallObj}<bytecode: 0x5555f08>> (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 = TRUE)function(){}attr(,"note")[1] "just a note"attr(,"yada")function() "not the same"> print(f, useSource = FALSE) # must print attributesfunction (){}attr(,"note")[1] "just a note"attr(,"yada")function ()"not the same"> print.function <- function(x, ...) {+ cat("my print(<function>): "); str(x, give.attr=FALSE); invisible(x) }> print.functionmy print(<function>): function (x, ...)> print(print.function)my print(<function>): function (x, ...)> rm(print.function)> ## auto-printing and printing differed up to R 2.9.x -- and then *AGAIN* in R 3.6.0>>> ## Make sure deparsing does not reset parameters> print(list(f, expression(foo), f, quote(foo), f, base::list, f),+ useSource = FALSE)[[1]]function (){}attr(,"note")[1] "just a note"attr(,"yada")function ()"not the same"[[2]]expression(foo)[[3]]function (){}attr(,"note")[1] "just a note"attr(,"yada")function ()"not the same"[[4]]foo[[5]]function (){}attr(,"note")[1] "just a note"attr(,"yada")function ()"not the same"[[6]]function (...) .Primitive("list")[[7]]function (){}attr(,"note")[1] "just a note"attr(,"yada")function ()"not the same">> 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 taudata: c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)T = 1, p-value = 0.08333alternative hypothesis: true tau is not equal to 0sample 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 taudata: c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)z = -1.9596, p-value = 0.05004alternative hypothesis: true tau is not equal to 0sample 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 taudata: c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)z = -1.7146, p-value = 0.08641alternative hypothesis: true tau is not equal to 0sample 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 rhodata: c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)S = 38, p-value = 0.08333alternative hypothesis: true rho is not equal to 0sample 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 rhodata: c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)S = 38, p-value = 0.03739alternative hypothesis: true rho is not equal to 0sample 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 rhodata: c(1, 2, 3, 4, 5) and c(8, 6, 7, 5, 3)S = 38, p-value = 0.09689alternative hypothesis: true rho is not equal to 0sample 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> barV1 V2 V3 V4 NewCol NewCol2 NewCol31 1 4 7 10 NA NA NA2 2 5 8 11 NA NA NA3 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()) # even nicer since R 3.5.0's change to sequential stopifnot()Error in tst() : 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-01Levels: 2009-01-01> cut(as.POSIXlt(x), breaks= "quarter")[1] 2009-01-01 2009-01-01Levels: 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.valueNULL> 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 = 1End = 11Frequency = 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 = 1End = 11Frequency = 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] <- ""> dfrx f1 1 11 12 2 12 13 3 13 24 4 14 25 5 15 36 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 tablesdata: NitrousS = 57, p-value = 0.1959alternative hypothesis: true common odds ratio is less than 195 percent confidence interval:0.000000 1.388197sample estimates:common odds ratio0.6652418> mantelhaen.test(Nitrous, exact=FALSE, alternative="less")Mantel-Haenszel chi-squared test with continuity correctiondata: NitrousMantel-Haenszel X-squared = 0.71432, df = 1, p-value = 0.199alternative hypothesis: true common odds ratio is less than 195 percent confidence interval:0.000000 1.260053sample estimates:common odds ratio0.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 yx 1.0000000 0.2380952y 0.2380952 1.0000000> cor(xy, method = "spearman", use = "complete.obs")x yx 1.0000000 0.2380952y 0.2380952 1.0000000> cor(xy, method = "spearman", use = "pairwise.complete.obs")x yx 1.0000000 0.2380952y 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"))za 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] kLevels: 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 = 1End = 9Frequency = 1x 1 2 31 1 1.000 1.000 1.0002 2 2.500 2.500 2.5003 3 4.250 4.250 4.2504 4 6.125 6.125 6.1255 NA NA NA NA6 6 NA NA NA7 7 NA NA NA8 8 NA NA NA9 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.1165Coefficients:Estimate Std. Error t value Pr(>|t|)(Intercept) 0.03949 0.08612 0.459 0.663x 0.99788 0.01502 66.419 7.83e-10 ***---Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Residual standard error: 0.1232 on 6 degrees of freedomMultiple R-squared: 0.9986, Adjusted R-squared: 0.9984F-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> assertErrorV <- function(expr) assertError(expr, verbose=TRUE)> assertErrorV( getMethod(ls, "bar", fdef=ls) )Asserted error: no generic function found for 'ls'> assertErrorV( getMethod(show, "bar") )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)123logi[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)> dfx y z1 a b.c 12 a.b c 23 a b.c 34 a.b c 45 a b.c 56 a.b c 6> split(df, df[, 1:2]) # default is sep = "."$a.b.cx y z1 a b.c 12 a.b c 23 a b.c 34 a.b c 45 a b.c 56 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 z1 a b.c 13 a b.c 35 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 z2 a.b c 24 a.b c 46 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> formreallylongnamey ~ reallylongnamex0 + reallylongnamex1 + reallylongnamex2 +reallylongnamex3> op <- options(deparse.cutoff=80)> formreallylongnamey ~ reallylongnamex0 + reallylongnamex1 + reallylongnamex2 + reallylongnamex3> options(deparse.cutoff=50)> formreallylongnamey ~ 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, stringsAsFactors=TRUE)> 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 22 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] 1Warning message:In pl$ab : partial match of 'ab' to 'abc'> options(saveopt)> ## 'abc' was just ''>>> ## seq() with NaN etc inputs now gives explicit error messages> try(seq(NaN))Error in seq.default(NaN) : 'from' must be a finite number> try(seq(to = NaN))Error in seq.default(to = NaN) : 'to' must be a finite number> try(seq(NaN, NaN))Error in seq.default(NaN, NaN) : 'from' must be a finite number> try(seq.int(NaN))Error in seq.int(NaN) : 'from' must be a finite number> try(seq.int(to = NaN))Error in seq.int(to = NaN) : 'to' must be a finite number> try(seq.int(NaN, NaN))Error in seq.int(NaN, NaN) : 'from' must be a finite number> ## 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]))> xd1A B C0 1 2> x[]d1A B C0 1 2> x[3:1]d1C B A2 1 0> x <- array(0, dimnames=list(d1="A"))> xd1A0> x[]d1A0> x[drop = FALSE]d1A0> ## 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.3574s.e. 0.4162 0.4420 0.0329 0.2209 0.7440sigma^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.3571s.e. 0.4162 0.4420 0.0329 0.2210 0.7441sigma^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; PR#18098 ==> digits=0 not ok:> format(9992, digits = 3)[1] "9992"> format(9996, digits = 3)[1] "9996"> format(0.0002, digits = 1, nsmall = 2, scientific = FALSE)[1] "0.0002"> assertErrorV(+ format(pi*10, digits = 0))Asserted error: invalid value 0 for 'digits' argument> format(pi*10, digits = 1)[1] "31"> format(pi*10, digits = 1, nsmall = 1)[1] "31.4"> ## second added an extra space.>> ## 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 Col2Row1 11 13Row2 12 14L 1 2> rbind(L, M)elem1 elem2L 1 2Row1 11 13Row2 12 14> cbind(M, L)Col1 Col2 LRow1 11 13 1Row2 12 14 2> cbind(L, M)L Col1 Col2elem1 1 11 13elem2 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)> 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 = factor(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) # warnsX...ColA ColB ColC1 a NA NA2 b NA NA3 c NA NA4 d NA NA5 e NA 16 f NA 1Warning messages:1: In read.table(file = file, header = header, sep = sep, quote = quote, :line 2 appears to contain embedded nulls2: In read.table(file = file, header = header, sep = sep, quote = quote, :line 3 appears to contain embedded nulls3: In read.table(file = file, header = header, sep = sep, quote = quote, :line 4 appears to contain embedded nulls4: In read.table(file = file, header = header, sep = sep, quote = quote, :line 5 appears to contain embedded nulls5: 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 ColC1 a NA 12 b NA 13 c NA 14 d NA 15 e NA 16 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>> # FIXME: check.tzone = FALSE needed because since 79037, all.equal.POSIXt> # strictly reports "" and the current time zone (even from TZ environment> # variable) as different. The conversion round-trip from Sys.time()> # (POSIXct) via POSIXlt and back to POSIXct creates an object with the> # current time zone, yet the original is with "" as time zone (and both> # refer to the same time zone).> all.equal(x, as.POSIXlt(x), check.tzone = FALSE)[1] TRUE>> all.equal(x, as.numeric(x)) # errored in R <= 4.0.2[1] "'current' is not a POSIXt"> all.equal(x, as.POSIXlt(x, tz = "EST5EDT"))[1] "'tzone' attributes are inconsistent ('' and 'EST5EDT')"> 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 xxJan 1960 417 417Feb 1960 391 391Mar 1960 419 419Apr 1960 461 461May 1960 472 472Jun 1960 535 535Jul 1960 622 622Aug 1960 606 606Sep 1960 508 508Oct 1960 461 461Nov 1960 390 390Dec 1960 432 432> op <- options(digits = 2)> cbind(xx, xx)xx xxJan 1960 417 417Feb 1960 391 391Mar 1960 419 419Apr 1960 461 461May 1960 472 472Jun 1960 535 535Jul 1960 622 622Aug 1960 606 606Sep 1960 508 508Oct 1960 461 461Nov 1960 390 390Dec 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)> aaAnalysis of Variance TableResponse: srDf 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.3593551ddpi 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 TableResponse: srDf Sum Sq Mean Sq F valuepop15 1 204.12 204.118 14.1157pop75 1 53.34 53.343 3.6889dpi 1 12.40 12.401 0.8576ddpi 1 63.05 63.054 4.3605Residuals 45 650.71 14.460Pr(>F)pop15 0.0004922 ***pop75 0.0611255 .dpi 0.3593551ddpi 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 text32 2 1 4 15 32 0 expr FALSE3 2 1 2 8 3 32 FUNCTION TRUE function4 2 9 2 9 4 32 '(' TRUE (5 2 11 2 11 5 32 SYMBOL_FORMALS TRUE a6 2 15 2 27 6 32 COMMENT TRUE # parameter 18 3 10 3 10 8 32 ',' TRUE ,10 3 12 3 12 10 32 SYMBOL_FORMALS TRUE b11 3 13 3 13 11 32 EQ_FORMALS TRUE =12 3 14 3 14 12 13 NUM_CONST TRUE 213 3 14 3 14 13 32 expr FALSE14 3 16 3 28 14 32 COMMENT TRUE # parameter 216 4 10 4 10 16 32 ')' TRUE )29 4 11 4 15 29 32 expr FALSE19 4 11 4 11 19 29 '{' TRUE {26 4 12 4 14 26 29 expr FALSE20 4 12 4 12 20 22 SYMBOL TRUE a22 4 12 4 12 22 26 expr FALSE21 4 13 4 13 21 26 '+' TRUE +23 4 14 4 14 23 25 SYMBOL TRUE b25 4 14 4 14 25 26 expr FALSE24 4 15 4 15 24 29 '}' 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,19742Coefficients:Estimate Std. Error t value Pr(>|t|)(Intercept) 0,8994 0,6282 1,432 0,190x -1,3275 0,9780 -1,357 0,212Residual standard error: 0,8648 on 8 degrees of freedomMultiple R-squared: 0,1872, Adjusted R-squared: 0,08557F-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 herea\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)))> rColRow c1 c2 c3 c4> t(r) # did not print "Row", "Col"RowColc1c2c3c4> 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>D2D1 X Yabc> A[,,"I",] # ditto<3 x 2 x 0 array of logical>D2D1 X Yabc> A[,,0,] # ditto<3 x 2 x 0 x 0 array of logical>D2D1 X Yabc> aperm(A, c(3:1,4)) # ditto<1 x 2 x 3 x 0 array of logical>D2D3 X YI> aperm(A, c(1:2, 4:3))# ditto<3 x 2 x 0 x 1 array of logical>D2D1 X Yabc> 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>D2D1 X Yabc> aperm(A, 4:1) # was ok, is unchanged, , D2 = X, D1 = aD3D4 I, , D2 = Y, D1 = aD3D4 I, , D2 = X, D1 = bD3D4 I, , D2 = Y, D1 = bD3D4 I, , D2 = X, D1 = cD3D4 I, , D2 = Y, D1 = cD3D4 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 TRUaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaTRUE> setNames(TRUE, make_long_name(1002)) # value printed as TaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaTRUE> setNames(TRUE, make_long_name(1003)) # value not printedaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaTRUE> ##>>> ## 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 meansGrand mean5FFA B C2 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 meansFFA B C2 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)list(one = 1, two = )> ## deparsed two to quote()>> ## Deparsing of repeated unary operators; the first 3 were "always" ok:> quote(~~x)~~x> quote(++x)++x> quote(--x)--x> quote(!!x) # was `!(!x)`!!x> quote(??x) # Suboptimal`?`(`?`(x))> quote(~+-!?x) # ditto: ....`?`(x)~+-!`?`(x)> ## `!` no longer produces parentheses now> ##> ## There should be no parentheses (always worked)> quote(+!x)+!x>>> ## 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 :c1Min. :1881-09-241st Qu.:1902-12-04Median :1920-09-10Mean :1923-04-123rd Qu.:1941-01-17Max. :1969-12-28NA's :3> DF.Dates$x1 <- 1:7> summary(DF.Dates) ## NA's still missingc1 x1Min. :1881-09-24 Min. :1.01st Qu.:1902-12-04 1st Qu.:2.5Median :1920-09-10 Median :4.0Mean :1923-04-12 Mean :4.03rd Qu.:1941-01-17 3rd Qu.:5.5Max. :1969-12-28 Max. :7.0NA's :3> DF.Dates$x2 <- c(1:6, NA)> ## now, NA's show fine:> summary(DF.Dates)c1 x1 x2Min. :1881-09-24 Min. :1.0 Min. :1.001st Qu.:1902-12-04 1st Qu.:2.5 1st Qu.:2.25Median :1920-09-10 Median :4.0 Median :3.50Mean :1923-04-12 Mean :4.0 Mean :3.503rd Qu.:1941-01-17 3rd Qu.:5.5 3rd Qu.:4.75Max. :1969-12-28 Max. :7.0 Max. :6.00NA's :3 NA's :1> ## 2 of 4 summary(.) above did not show NA's in R <= 3.2.3>>> ## Printing complex matrix> matrix(1i,2,13)[,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13][1,] 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i[2,] 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i 0+1i> ## Spacing was wrong in R <= 3.2.4>>> E <- expression(poly = x^3 - 3 * x^2)> str(E)expression(poly = x^3 - 3 * x^2)> ## no longer shows "structure(...., .Names = ..)">>> ## summary(<logical>) working via table():> logi <- c(NA, logical(3), NA, !logical(2), NA)> summary(logi)Mode FALSE TRUE NA'slogical 3 2 3> summary(logi[!is.na(logi)])Mode FALSE TRUElogical 3 2> summary(TRUE)Mode TRUElogical 1> ## was always showing counts for NA's even when 0 in 2.8.0 <= R <= 3.3.1> ii <- as.integer(logi)> summary(ii)Min. 1st Qu. Median Mean 3rd Qu. Max. NA's0.0 0.0 0.0 0.4 1.0 1.0 3> summary(ii[!is.na(ii)])Min. 1st Qu. Median Mean 3rd Qu. Max.0.0 0.0 0.0 0.4 1.0 1.0> summary(1L)Min. 1st Qu. Median Mean 3rd Qu. Max.1 1 1 1 1 1>>> ## str.default() for "AsIs" arrays> str(I(m <- matrix(pi*1:4, 2)))'AsIs' num [1:2, 1:2] 3.14 6.28 9.42 12.57> ## did look ugly (because of toString() for numbers) in R <= 3.3.1>>> ## check automatic coercions from double to integer> ##> ## these should work due to coercion> sprintf("%d", 1)[1] "1"> sprintf("%d", NA_real_)[1] "NA"> sprintf("%d", c(1,2))[1] "1" "2"> sprintf("%d", c(1,NA))[1] "1" "NA"> sprintf("%d", c(NA,1))[1] "NA" "1"> ##> ## these should fail> assertErrorV( sprintf("%d", 1.1) )Asserted error: invalid format '%d'; use format %f, %e, %g or %a for numeric objects> assertErrorV( sprintf("%d", c(1.1,1)) )Asserted error: invalid format '%d'; use format %f, %e, %g or %a for numeric objects> assertErrorV( sprintf("%d", c(1,1.1)) )Asserted error: invalid format '%d'; use format %f, %e, %g or %a for numeric objects> assertErrorV( sprintf("%d", NaN) )Asserted error: invalid format '%d'; use format %f, %e, %g or %a for numeric objects> assertErrorV( sprintf("%d", c(1,NaN)) )Asserted error: invalid format '%d'; use format %f, %e, %g or %a for numeric objects>>> ## formatting of named raws:> setNames(as.raw(1:3), c("a", "bbbb", "c"))a bbbb c01 02 03> ## was quite ugly for R <= 3.4.2>>> ## str(x) when is.vector(x) is false :> str(structure(c(a = 1, b = 2:7), color = "blue"))Named num [1:7] 1 2 3 4 5 6 7- attr(*, "names")= chr [1:7] "a" "b1" "b2" "b3" ...- attr(*, "color")= chr "blue"> ## did print " atomic [1:7] ..." in R <= 3.4.x>>> ## check stopifnot(exprs = ....)> tryCatch(stopifnot(exprs = {+ all.equal(pi, 3.1415927)+ 2 < 2+ cat("Kilroy was here!\n")+ all(1:10 < 12)+ "a" < "b"+ }), error = function(e) e$message) -> M ; cat("Error: ", M, "\n")Error: 2 < 2 is not TRUE>> tryCatch(stopifnot(exprs = {+ all.equal(pi, 3.1415927)+ { cat("Kilroy was here!\n"); TRUE }+ pi < 3+ cat("whereas I won't be printed ...\n")+ all(1:10 < 12)+ "a" < "b"+ }), error = function(e) e$message) -> M2 ; cat("Error: ", M2, "\n")Kilroy was here!Error: pi < 3 is not TRUE>> stopifnot(exprs = {+ all.equal(pi, 3.1415927)+ { cat("\nKilroy was here! ... "); TRUE }+ pi > 3+ all(1:10 < 12)+ "a" < "b"+ { cat("and I'm printed as well ...\n"); TRUE}+ })Kilroy was here! ... and I'm printed as well ...> ## without "{ .. }" :> stopifnot(exprs = 2 == 2)> try(stopifnot(exprs = 1 > 2))Error : 1 > 2 is not TRUE> ## passing an expression object:> stopifnot(exprObject = expression(2 == 2, pi < 4))> tryCatch(stopifnot(exprObject = expression(+ 2 == 2,+ { cat("\n Kilroy again .."); TRUE },+ pi < 4,+ 0 == 1,+ { cat("\n no way..\n"); TRUE })),+ error = function(e) e$message) -> M3Kilroy again ..> cat("Error: ", M3, "\n")Error: 0 == 1 is not TRUE> ## was partly not ok for many weeks in R-devel, early 2018>>> ## print.htest() with small 'digits'> print(t.test(1:28), digits = 3)One Sample t-testdata: 1:28t = 9, df = 27, p-value = 6e-10alternative hypothesis: true mean is not equal to 095 percent confidence interval:11.3 17.7sample estimates:mean of x14.5> ## showed 'df = 30' from signif(*, digits=1) and too many digits for CI, in R <= 3.5.1>>> ## str(<d.frame w/ attrib>):> treeA <- trees> attr(treeA, "someA") <- 1:77> str(treeA)'data.frame': 31 obs. of 3 variables:$ Girth : num 8.3 8.6 8.8 10.5 10.7 10.8 11 11 11.1 11.2 ...$ Height: num 70 65 63 72 81 83 66 75 80 75 ...$ Volume: num 10.3 10.3 10.2 16.4 18.8 19.7 15.6 18.2 22.6 19.9 ...- attr(*, "someA")= int [1:77] 1 2 3 4 5 6 7 8 9 10 ...> ## now shows the *length* of "someA">>> ## summaryRprof() bug PR#15886 + "Rprof() not enabled" PR#17836> if(capabilities("Rprof")) {+ Rprof(tf <- tempfile("Rprof.out", tmpdir = getwd()), memory.profiling=TRUE, line.profiling=FALSE)+ out <- lapply(1:10000, rnorm, n= 512)+ Rprof(NULL)+ if(interactive())+ print(length(readLines(tf))) # ca. 10 .. 20 lines+ op <- options(warn = 2) # no warnings, even !+ for (cs in 1:21) s <- summaryRprof(tf, memory="tseries", chunksize=cs)+ ## "always" triggered an error (or a warning) in R <= 3.6.3+ options(op)+ unlink(tf)+ }>>> ## printing *named* complex vectors (*not* arrays), PR#17868 (and PR#18019):> a <- 1:12; (z <- a + a*1i); names(z) <- letters[seq_along(z)]; z[1] 1+ 1i 2+ 2i 3+ 3i 4+ 4i 5+ 5i 6+ 6i 7+ 7i 8+ 8i 9+ 9i 10+10i[11] 11+11i 12+12ia b c d e f g h i j k1+ 1i 2+ 2i 3+ 3i 4+ 4i 5+ 5i 6+ 6i 7+ 7i 8+ 8i 9+ 9i 10+10i 11+11il12+12i> ## fixed in R-devel in July 2020; R 4.0.3 patched on Dec 26, 2020>>> ## identical(*) on "..." object> (ddd <- (function(...) environment())(1)$...) # <...><...>> dd2 <- (function(...) environment())(1)$...> stopifnot( identical(ddd, dd2) )> ## In R <= 4.0.3, printed to console (no warning, no message!):> ## "Unknown Type: ... (11)">>> ## printCoefmat() should keep NaN values (PR#17336)> ##cm <- summary(lm(c(0,0,0) ~ 1))$coefficients> cm <- cbind(Estimate = 0, SE = 0, t = NaN, "Pr(>|t|)" = NaN)> printCoefmat(cm) # NaN's were replaced by NA in R < 4.1.0Estimate SE t Pr(>|t|)[1,] 0 0 NaN NaN>>> ## deparse() wraps cflow bodies when deeply burried through a LHS (PR#18232)> ##> ## These didn't print the same before fix, the bquote() expression> ## missed parentheses> quote(1 + (if (TRUE) 2) + 3)1 + (if (TRUE) 2) + 3> bquote(1 + .(quote(if (TRUE) 2)) + 3)1 + (if (TRUE) 2) + 3> bquote(2 * .(quote(if (TRUE) 2 else 3)) / 4)2 * (if (TRUE) 2 else 3)/4> ## From Suharto. Failed `left` state wasn't properly forwarded across operators> bquote(1 + ++.(quote(if (TRUE) 2)) + 3)1 + ++(if (TRUE) 2) + 3> bquote(1^- . (quote(if (TRUE) 2)) + 3)1^-(if (TRUE) 2) + 3> ## (found when fiddling w/ cases below):> quote(`-`(1 + if(L) 2, 3+4))# wrongly was 1 + if (L) 2 - (3 + 4)1 + (if (L) 2) - (3 + 4)> ##> ##__ All the following were ok in R <= 4.1.x already __> bquote(1 + .(quote(if (TRUE) 2)) ^ 3) # already correct previously1 + (if (TRUE) 2)^3> ## other constructs cancel the LHS state ==> `if` call isn't wrapped:> bquote(1 + .(quote( f(if (TRUE) 2))) + 3)1 + f(if (TRUE) 2) + 3> bquote(1 + .(quote((2 + if (TRUE) 3))) + 4)1 + (2 + if (TRUE) 3) + 4> ## cflow bodies are only wrapped if needed ==> no parentheses here :> quote(a <- if (TRUE) 1)a <- if (TRUE) 1> ## print the same> quote(`^`(-1, 2))(-1)^2> quote((-1)^2)(-1)^2> ## no parentheses:> quote(1^-2)1^-2> quote(1^-2 + 3)1^-2 + 3> ## The "formula" case of Adrian Dusa (maintainer of QCA); R-devel ML, Nov.15, 2021> quote(A + ~B + C ~ D) # no parensA + ~B + C ~ D> ## 'simple' binary op> quote(a$"b")a$b> ## When cflow body is burried deeply through the right, don't rewrap> ## unnecessarily. There should be only one set of parentheses.> ## Cases where R-devel 81211 still gave unneeded parens:> quote(`^`(1 + if(L) 2, 3))(1 + if (L) 2)^3> quote(`*`(1 - if(L) 2 else 22, 3))(1 - if (L) 2 else 22) * 3> quote(`^`(1 + repeat 2, 3))(1 + repeat 2)^3> quote(`*`(1 + repeat 2, 3))(1 + repeat 2) * 3> quote(`=`(1 + repeat 2, 3))# *no* parens in R <= 4.1.x1 + (repeat 2) = 3> quote(`=`(1 + `+`(2, repeat 3), 4))1 + (2 + repeat 3) = 4> quote(`+`(`<-`(1, `=`(2, repeat 3)), 4)) # (1 <- (2 = ..(1 <- (2 = repeat 3)) + 4> quote(`+`(`:`(1, `=`(2, repeat 3)), 4))1:(2 = repeat 3) + 4> ## No parentheses when the cflow form is trailing> quote(1 + +repeat 2)1 + +repeat 2> quote(`<-`(1, +repeat 2))1 <- +repeat 2> quote(1^+repeat 2)1^+repeat 2> quote(`$`(1, +repeat 2))`$`(1, +repeat 2)> ## More cases where parens are needed> quote(`^`(`+`(repeat 1, 2), 3))((repeat 1) + 2)^3> quote(`+`(`+`(repeat 1, 2), 3))(repeat 1) + 2 + 3> quote(`+`(`+`(`+`(repeat 1, repeat 2), repeat 3), 4))(repeat 1) + (repeat 2) + (repeat 3) + 4> ##__ end { all fine in older R }>> ## Unary operators are parenthesised if needed; print the same:> quote((-a)$b)(-a)$b> quote(`$`(-a, b)) # no parens in R <= 4.1.x(-a)$b> ## Binary operators are parenthesised on the LHS of `$`. ; the same:> quote((1 + 1)$b)(1 + 1)$b> quote(`$`(1 + 1, b)) # no parens in R <= 4.1.x(1 + 1)$b> ##> ## Unparseable expressions are deparsed in prefixed form> quote(`$`(1)) # was 1$NULL in R <= 4.1.x`$`(1)> quote(`$`(1, 2, 3)) # was 1$2`$`(1, 2, 3)> quote(`$`(1, NA_character_)) # was 1$NA_char..`$`(1, NA_character_)> quote(`$`(1, if(L) 2)) # was 1$if (L) 2`$`(1, if (L) 2)> quote(`$`(`$`(1, if(L) 2), 3))`$`(`$`(1, if (L) 2), 3)> ## No parens because prefix form> quote(`$`(1 + repeat 2, 3))`$`(1 + repeat 2, 3)> quote(`=`(`$`(1, `$`(2, repeat 3)), 4))`$`(1, `$`(2, repeat 3)) = 4> ## these were really bad in R <= 4.1.x>>> ## Deparsing of ! -- PR#18284> ## no parens in 3.5.0 <= R <= 4.1.x:> quote(1 + `!`(2) + 3) -> x; x1 + (!2) + 3> quote(1 + +`!`(2) + 3)1 + +(!2) + 3> quote(1 + `!`(!2) + 3)1 + (!!2) + 3> quote(1 + `!`(if(L) 2) + 3)1 + (!if (L) 2) + 3> ## ok in 3.5.0 <= R <= 4.1.x:> quote(`&`(a < !b, d))a < !b & d> ## deparse--parse roundtrip is stable (basically)> stopifnot(eval(x) == 4, eval(parse(text = deparse(x))) == 4)> ## eval()ed to 1 since R 3.5.0 {also because of the weak precedence of `!`}>>> ## packageDate(<pkg>) w/o valid package> dput(packageDate("foo"))structure(NA, class = "Date")Warning message:In packageDescription(pkg, lib.loc = lib.loc, fields = date.fields) :no package 'foo' was found> ## gave *five* warnings* in R <= 4.2.x>>> ## object not found error mentions lexical call> if (exists("foo")) rm(foo)> ## Should not mention call because called at top level> try(identity(foo))Error : object 'foo' not found> try(do.call("identity", alist(foo)))Error : object 'foo' not found> ##> ## Should mention `f()` call> f <- function() identity(foo)> try(f())Error in f() : object 'foo' not found> f <- compiler::cmpfun(f)> try(f())Error in f() : object 'foo' not found> f <- function() do.call("identity", alist(foo))> try(f())Error in f() : object 'foo' not found> f <- compiler::cmpfun(f)> try(f())Error in f() : object 'foo' not found> ##> ## Should not mention call because there is no matching execution env> try(do.call("identity", alist(foo), envir = new.env()))Error : object 'foo' not found> f <- function() do.call("identity", alist(foo), envir = new.env())> try(f())Error : object 'foo' not found> f <- compiler::cmpfun(f)> try(f())Error : object 'foo' not found>>> ## Missing argument error mentions lexical call> ## Local evaluation: Mentions `identity()`> try(identity())Error in identity() : argument "x" is missing, with no default> f <- function() identity()> try(f())Error in identity() : argument "x" is missing, with no default> f <- compiler::cmpfun(f)> try(f())Error in identity() : argument "x" is missing, with no default> ##> ## Promise evaluation: Mentions `f()` or `g()`> f <- function(arg) is.factor(arg)> g <- function(x) f(x)> try(f())Error in f() : argument "arg" is missing, with no default> try(g())Error in g() : argument "x" is missing, with no default> f <- compiler::cmpfun(f)> g <- compiler::cmpfun(g)> try(f())Error in f() : argument "arg" is missing, with no default> try(g())Error in g() : argument "x" is missing, with no default> ##> ## Direct evaluation, `eval()` wrapper: Mentions `eval()`> f <- function() eval(quote(expr = ))> try(f())Error in eval(quote(expr = )) : argument is missing, with no default> f <- compiler::cmpfun(f)> try(f())Error in eval(quote(expr = )) : argument is missing, with no default> ##> ## Direct evaluation, no `eval()` wrapper: Mentions `f()`> f <- function() {+ eval(bquote(delayedAssign("go", .(quote(expr = )))))+ go+ }> try(f())Error in f() : argument is missing, with no default> f <- compiler::cmpfun(f)> try(f())Error in f() : argument is missing, with no default>