| |
| R version 3.6.2 Patched (2020-02-12 r77795) -- "Dark and Stormy Night" |
| Copyright (C) 2020 The R Foundation for Statistical Computing |
| Platform: x86_64-pc-linux-gnu (64-bit) |
| |
| R is free software and comes with ABSOLUTELY NO WARRANTY. |
| You are welcome to redistribute it under certain conditions. |
| Type 'license()' or 'licence()' for distribution details. |
| |
| R is a collaborative project with many contributors. |
| Type 'contributors()' for more information and |
| 'citation()' on how to cite R or R packages in publications. |
| |
| Type 'demo()' for some demos, 'help()' for on-line help, or |
| 'help.start()' for an HTML browser interface to help. |
| Type 'q()' to quit R. |
| |
| > #### Testing print(), format() and the like --- mainly with numeric() |
| > #### |
| > #### to be run as |
| > #### |
| > #### R < print-tests.R >& print-tests.out-__version__ |
| > #### == (csh) |
| > opt.conformance <- 0 |
| > |
| > DIG <- function(d) |
| + if(missing(d)) getOption("digits") else options(digits=as.integer(d)) |
| > |
| > DIG(7)#-- the default; just to make sure ... |
| > options(width = 200) |
| > |
| > n1 <- 2^(4*1:7) |
| > i1 <- as.integer(n1) |
| > |
| > v1 <- 2^c(-12, 2*(-4:-2),3,6,9) |
| > v2 <- v1^(63/64) |
| > ## avoid ending in `5' as printing then depends on rounding of |
| > ## the run-time (and not all round to even). |
| > v1[1:4] <-c(2.44140624e-04, 3.90624e-03, 1.5624e-02, 6.24e-02) |
| > |
| > |
| > v3 <- pi*100^(-1:3) |
| > v4 <- (0:2)/1000 + 1e-10 #-- tougher one |
| > |
| > digs1 <- c(1,2*(1:5),11:15) # 16: platform dependent |
| > # 30 gives ERROR : options(digits=30) |
| > digs2 <- c(1:20)#,30) gives 'error' in R: ``print.default(): invalid digits..'' |
| > |
| > all(i1 == n1)# TRUE |
| [1] TRUE |
| > i1# prints nicely |
| [1] 16 256 4096 65536 1048576 16777216 268435456 |
| > n1# did not; does now (same as 'i1') |
| [1] 16 256 4096 65536 1048576 16777216 268435456 |
| > |
| > round (v3, 3)#S+ & R 0.49: |
| [1] 0.031 3.142 314.159 31415.927 3141592.654 |
| > ##[1] 0.031 3.142 314.159 31415.927 3141592.654 |
| > signif(v3, 3) |
| [1] 3.14e-02 3.14e+00 3.14e+02 3.14e+04 3.14e+06 |
| > ##R.49: [1] 0.0314 3.1400 314.0000 31400.0000 3140000.0000 |
| > ##S+ [1] 3.14e-02 3.14e+00 3.14e+02 3.14e+04 3.14e+06 |
| > |
| > ###---------------------------------------------------------------- |
| > ##- Date: Tue, 20 May 97 17:11:18 +0200 |
| > |
| > ##- From: Martin Maechler <maechler@stat.math.ethz.ch> |
| > ##- To: R-devel@stat.math.ethz.ch |
| > ##- Subject: R-alpha: print 'problems': print(2^30, digits=12); comments at start of function() |
| > ##- |
| > ##- Both of these bugs are not a real harm, |
| > ##- however, they have been annoying me for too long ... ;-) |
| > ##- |
| > ##- 1) |
| > print (2^30, digits = 12) #- WAS exponential form, unnecessarily -- now ok |
| [1] 1073741824 |
| > formatC(2^30, digits = 12) #- shows you what you'd want above |
| [1] " 1073741824" |
| > |
| > ## S and R are now the same here; note that the problem also affects |
| > ## paste(.) & format(.) : |
| > |
| > DIG(10); paste(n1); DIG(7) |
| [1] "16" "256" "4096" "65536" "1048576" "16777216" "268435456" |
| > |
| > |
| > ## Assignment to .Options$digits: Does NOT work for print() nor cat() |
| > for(i in digs1) { .Options$digits <- i; cat(i,":"); print (v1[-1]) } |
| 1 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 2 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 4 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 6 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 8 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 10 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 11 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 12 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 13 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 14 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 15 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| > |
| > ## using options() *does* things |
| > for(i in digs1) { DIG(i); cat(i,":"); print (v3) } |
| 1 :[1] 3e-02 3e+00 3e+02 3e+04 3e+06 |
| 2 :[1] 3.1e-02 3.1e+00 3.1e+02 3.1e+04 3.1e+06 |
| 4 :[1] 3.142e-02 3.142e+00 3.142e+02 3.142e+04 3.142e+06 |
| 6 :[1] 3.14159e-02 3.14159e+00 3.14159e+02 3.14159e+04 3.14159e+06 |
| 8 :[1] 3.1415927e-02 3.1415927e+00 3.1415927e+02 3.1415927e+04 3.1415927e+06 |
| 10 :[1] 3.141592654e-02 3.141592654e+00 3.141592654e+02 3.141592654e+04 3.141592654e+06 |
| 11 :[1] 3.1415926536e-02 3.1415926536e+00 3.1415926536e+02 3.1415926536e+04 3.1415926536e+06 |
| 12 :[1] 3.14159265359e-02 3.14159265359e+00 3.14159265359e+02 3.14159265359e+04 3.14159265359e+06 |
| 13 :[1] 3.14159265359e-02 3.14159265359e+00 3.14159265359e+02 3.14159265359e+04 3.14159265359e+06 |
| 14 :[1] 3.1415926535898e-02 3.1415926535898e+00 3.1415926535898e+02 3.1415926535898e+04 3.1415926535898e+06 |
| 15 :[1] 3.14159265358979e-02 3.14159265358979e+00 3.14159265358979e+02 3.14159265358979e+04 3.14159265358979e+06 |
| > for(i in digs1) { DIG(i); cat(i,":", formatC(v3, digits=i, width=8),"\n") } |
| 1 : 0.03 3 3e+02 3e+04 3e+06 |
| 2 : 0.031 3.1 3.1e+02 3.1e+04 3.1e+06 |
| 4 : 0.03142 3.142 314.2 3.142e+04 3.142e+06 |
| 6 : 0.0314159 3.14159 314.159 31415.9 3.14159e+06 |
| 8 : 0.031415927 3.1415927 314.15927 31415.927 3141592.7 |
| 10 : 0.03141592654 3.141592654 314.1592654 31415.92654 3141592.654 |
| 11 : 0.031415926536 3.1415926536 314.15926536 31415.926536 3141592.6536 |
| 12 : 0.0314159265359 3.14159265359 314.159265359 31415.9265359 3141592.65359 |
| 13 : 0.0314159265359 3.14159265359 314.159265359 31415.9265359 3141592.65359 |
| 14 : 0.031415926535898 3.1415926535898 314.15926535898 31415.926535898 3141592.6535898 |
| 15 : 0.0314159265358979 3.14159265358979 314.159265358979 31415.9265358979 3141592.65358979 |
| > |
| > |
| > ## R-0.50: switches to NON-exp at 14, but should only at 15... |
| > ## R-0.61++: doesn' switch at all (or at 20 only) |
| > ## S-plus: does not switch at all.. |
| > for(i in digs1) { cat(i,":"); print(v1, digits=i) } |
| 1 :[1] 2e-04 4e-03 2e-02 6e-02 8e+00 6e+01 5e+02 |
| 2 :[1] 2.4e-04 3.9e-03 1.6e-02 6.2e-02 8.0e+00 6.4e+01 5.1e+02 |
| 4 :[1] 2.441e-04 3.906e-03 1.562e-02 6.240e-02 8.000e+00 6.400e+01 5.120e+02 |
| 6 :[1] 2.44141e-04 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 8 :[1] 2.4414062e-04 3.9062400e-03 1.5624000e-02 6.2400000e-02 8.0000000e+00 6.4000000e+01 5.1200000e+02 |
| 10 :[1] 2.44140624e-04 3.90624000e-03 1.56240000e-02 6.24000000e-02 8.00000000e+00 6.40000000e+01 5.12000000e+02 |
| 11 :[1] 2.44140624e-04 3.90624000e-03 1.56240000e-02 6.24000000e-02 8.00000000e+00 6.40000000e+01 5.12000000e+02 |
| 12 :[1] 2.44140624e-04 3.90624000e-03 1.56240000e-02 6.24000000e-02 8.00000000e+00 6.40000000e+01 5.12000000e+02 |
| 13 :[1] 2.44140624e-04 3.90624000e-03 1.56240000e-02 6.24000000e-02 8.00000000e+00 6.40000000e+01 5.12000000e+02 |
| 14 :[1] 2.44140624e-04 3.90624000e-03 1.56240000e-02 6.24000000e-02 8.00000000e+00 6.40000000e+01 5.12000000e+02 |
| 15 :[1] 2.44140624e-04 3.90624000e-03 1.56240000e-02 6.24000000e-02 8.00000000e+00 6.40000000e+01 5.12000000e+02 |
| > |
| > ## R 0.50-a1: switches at 10 inst. 11 |
| > for(i in digs1) { cat(i,":"); print(v1[-1], digits=i) } |
| 1 :[1] 4e-03 2e-02 6e-02 8e+00 6e+01 5e+02 |
| 2 :[1] 3.9e-03 1.6e-02 6.2e-02 8.0e+00 6.4e+01 5.1e+02 |
| 4 :[1] 3.906e-03 1.562e-02 6.240e-02 8.000e+00 6.400e+01 5.120e+02 |
| 6 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 8 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 10 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 11 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 12 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 13 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 14 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| 15 :[1] 3.90624e-03 1.56240e-02 6.24000e-02 8.00000e+00 6.40000e+01 5.12000e+02 |
| > |
| > for(i in digs1) { DIG(i); cat(i,":", formatC(v2, digits=i, width=8),"\n") } |
| 1 : 0.0003 0.004 0.02 0.07 8 6e+01 5e+02 |
| 2 : 0.00028 0.0043 0.017 0.065 7.7 60 4.6e+02 |
| 4 : 0.000278 0.00426 0.01667 0.06527 7.744 59.97 464.4 |
| 6 : 0.000278025 0.0042598 0.0166741 0.0652671 7.74425 59.9734 464.449 |
| 8 : 0.00027802457 0.0042597958 0.016674069 0.065267111 7.7442472 59.973364 464.44856 |
| 10 : 0.000278024569 0.004259795831 0.01667406876 0.0652671114 7.744247174 59.97336429 464.4485569 |
| 11 : 0.00027802456903 0.0042597958307 0.016674068761 0.065267111402 7.744247174 59.973364292 464.44855693 |
| 12 : 0.000278024569032 0.00425979583072 0.0166740687606 0.0652671114017 7.74424717397 59.9733642915 464.448556928 |
| 13 : 0.0002780245690324 0.004259795830724 0.01667406876058 0.06526711140171 7.744247173969 59.97336429153 464.4485569281 |
| 14 : 0.0002780245690324 0.0042597958307237 0.016674068760575 0.065267111401713 7.7442471739692 59.97336429153 464.4485569281 |
| 15 : 0.000278024569032395 0.00425979583072366 0.0166740687605754 0.0652671114017134 7.74424717396918 59.9733642915296 464.448556928102 |
| > |
| > for(i in digs1) { cat(i,":"); print(v2, digits=i) } #-- exponential all thru |
| 1 :[1] 3e-04 4e-03 2e-02 7e-02 8e+00 6e+01 5e+02 |
| 2 :[1] 2.8e-04 4.3e-03 1.7e-02 6.5e-02 7.7e+00 6.0e+01 4.6e+02 |
| 4 :[1] 2.780e-04 4.260e-03 1.667e-02 6.527e-02 7.744e+00 5.997e+01 4.644e+02 |
| 6 :[1] 2.78025e-04 4.25980e-03 1.66741e-02 6.52671e-02 7.74425e+00 5.99734e+01 4.64449e+02 |
| 8 :[1] 2.7802457e-04 4.2597958e-03 1.6674069e-02 6.5267111e-02 7.7442472e+00 5.9973364e+01 4.6444856e+02 |
| 10 :[1] 2.780245690e-04 4.259795831e-03 1.667406876e-02 6.526711140e-02 7.744247174e+00 5.997336429e+01 4.644485569e+02 |
| 11 :[1] 2.7802456903e-04 4.2597958307e-03 1.6674068761e-02 6.5267111402e-02 7.7442471740e+00 5.9973364292e+01 4.6444855693e+02 |
| 12 :[1] 2.78024569032e-04 4.25979583072e-03 1.66740687606e-02 6.52671114017e-02 7.74424717397e+00 5.99733642915e+01 4.64448556928e+02 |
| 13 :[1] 2.780245690324e-04 4.259795830724e-03 1.667406876058e-02 6.526711140171e-02 7.744247173969e+00 5.997336429153e+01 4.644485569281e+02 |
| 14 :[1] 2.7802456903240e-04 4.2597958307237e-03 1.6674068760575e-02 6.5267111401713e-02 7.7442471739692e+00 5.9973364291530e+01 4.6444855692810e+02 |
| 15 :[1] 2.78024569032395e-04 4.25979583072366e-03 1.66740687605754e-02 6.52671114017134e-02 7.74424717396918e+00 5.99733642915296e+01 4.64448556928102e+02 |
| > ## ^^^^^ digs2 (>= 18: PLATFORM dependent !! |
| > for(i in digs1) { cat(i,":", formatC(v2, digits=i, width=8),"\n") } |
| 1 : 0.0003 0.004 0.02 0.07 8 6e+01 5e+02 |
| 2 : 0.00028 0.0043 0.017 0.065 7.7 60 4.6e+02 |
| 4 : 0.000278 0.00426 0.01667 0.06527 7.744 59.97 464.4 |
| 6 : 0.000278025 0.0042598 0.0166741 0.0652671 7.74425 59.9734 464.449 |
| 8 : 0.00027802457 0.0042597958 0.016674069 0.065267111 7.7442472 59.973364 464.44856 |
| 10 : 0.000278024569 0.004259795831 0.01667406876 0.0652671114 7.744247174 59.97336429 464.4485569 |
| 11 : 0.00027802456903 0.0042597958307 0.016674068761 0.065267111402 7.744247174 59.973364292 464.44855693 |
| 12 : 0.000278024569032 0.00425979583072 0.0166740687606 0.0652671114017 7.74424717397 59.9733642915 464.448556928 |
| 13 : 0.0002780245690324 0.004259795830724 0.01667406876058 0.06526711140171 7.744247173969 59.97336429153 464.4485569281 |
| 14 : 0.0002780245690324 0.0042597958307237 0.016674068760575 0.065267111401713 7.7442471739692 59.97336429153 464.4485569281 |
| 15 : 0.000278024569032395 0.00425979583072366 0.0166740687605754 0.0652671114017134 7.74424717396918 59.9733642915296 464.448556928102 |
| > |
| > DIG(7)#-- the default; just to make sure ... |
| > |
| > N1 <- 10; N2 <- 7; n <- 8 |
| > x <- 0:N1 |
| > Mhyp <- rbind(phyper(x, N1, N2, n), dhyper(x, N1, N2, n)) |
| > Mhyp |
| [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] |
| [1,] 0 0.0004113534 0.01336898 0.117030 0.4193747 0.7821884 0.9635952 0.99814891 1.00000000 1 1 |
| [2,] 0 0.0004113534 0.01295763 0.103661 0.3023447 0.3628137 0.1814068 0.03455368 0.00185109 0 0 |
| > ##- [,1] [,2] [,3] [,4] [,5] [,6] [,7] |
| > ##- [1,] 0 0.0004113534 0.01336898 0.117030 0.4193747 0.7821884 0.9635952 |
| > ##- [2,] 0 0.0004113534 0.01295763 0.103661 0.3023447 0.3628137 0.1814068 |
| > ##- [,8] [,9] [,10] [,11] |
| > ##- [1,] 0.99814891 1.00000000 1 1 |
| > ##- [2,] 0.03455368 0.00185109 0 0 |
| > |
| > m11 <- c(-1,1) |
| > Mm <- pi*outer(m11, 10^(-5:5)) |
| > Mm <- cbind(Mm, outer(m11, 10^-(5:1))) |
| > Mm |
| [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13] [,14] [,15] [,16] |
| [1,] -3.141593e-05 -0.0003141593 -0.003141593 -0.03141593 -0.3141593 -3.141593 -31.41593 -314.1593 -3141.593 -31415.93 -314159.3 -1e-05 -1e-04 -0.001 -0.01 -0.1 |
| [2,] 3.141593e-05 0.0003141593 0.003141593 0.03141593 0.3141593 3.141593 31.41593 314.1593 3141.593 31415.93 314159.3 1e-05 1e-04 0.001 0.01 0.1 |
| > do.p <- TRUE |
| > do.p <- FALSE |
| > for(di in 1:10) { |
| + options(digits=di) |
| + cat(if(do.p)"\n",formatC(di,w=2),":", format.info(Mm),"\n") |
| + if(do.p)print(Mm) |
| + } |
| 1 : 6 0 1 |
| 2 : 8 1 1 |
| 3 : 9 2 1 |
| 4 : 10 3 1 |
| 5 : 11 4 1 |
| 6 : 12 5 1 |
| 7 : 13 6 1 |
| 8 : 14 7 1 |
| 9 : 15 8 1 |
| 10 : 16 9 1 |
| > ##-- R-0.49 (4/1997) R-0.50-a1 (7.7.97) |
| > ##- 1 : 13 5 0 1 : 6 0 1 |
| > ##- 2 : 8 1 1 = 2 : 8 1 1 |
| > ##- 3 : 9 2 1 = 3 : 9 2 1 |
| > ##- 4 : 10 3 1 = 4 : 10 3 1 |
| > ##- 5 : 11 4 1 = 5 : 11 4 1 |
| > ##- 6 : 12 5 1 = 6 : 12 5 1 |
| > ##- 7 : 13 6 1 = 7 : 13 6 1 |
| > ##- 8 : 14 7 1 = 8 : 14 7 1 |
| > ##- 9 : 15 8 1 = 9 : 15 8 1 |
| > ##- 10 : 16 9 1 = 10 : 16 9 1 |
| > nonFin <- list(c(Inf,-Inf), c(NaN,NA), NA_real_, Inf) |
| > mm <- sapply(nonFin, format.info) |
| > fm <- lapply(nonFin, format) |
| > w <- c(4,3,2,3) |
| > stopifnot(sapply(lapply(fm, nchar), max) == w, |
| + mm == rbind(w, 0, 0))# m[2,] was 2147483647; m[3,] was 1 |
| > cnF <- c(lapply(nonFin, function(x) complex(re=x, im=x))[-3], |
| + complex(re=NaN, im=-Inf)) |
| > cmm <- sapply(cnF, format.info) |
| > cfm <- lapply(cnF, format) |
| > cw <- sapply(lapply(cfm, nchar), max) |
| > stopifnot(cw == cmm[1,]+1 +cmm[4,]+1, |
| + nchar(format(c(NA, 1 + 2i))) == 4)# wrongly was (5,4) |
| > |
| > |
| > ##-- Ok now, everywhere |
| > for(d in 1:9) {cat(d,":"); print(v4, digits=d) } |
| 1 :[1] 1e-10 1e-03 2e-03 |
| 2 :[1] 1e-10 1e-03 2e-03 |
| 3 :[1] 1e-10 1e-03 2e-03 |
| 4 :[1] 1e-10 1e-03 2e-03 |
| 5 :[1] 1e-10 1e-03 2e-03 |
| 6 :[1] 1e-10 1e-03 2e-03 |
| 7 :[1] 1e-10 1e-03 2e-03 |
| 8 :[1] 0.0000000001 0.0010000001 0.0020000001 |
| 9 :[1] 0.0000000001 0.0010000001 0.0020000001 |
| > DIG(7) |
| > |
| > |
| > ###------------ Very big and very small |
| > umach <- unlist(.Machine)[paste("double.x", c("min","max"), sep='')] |
| > xmin <- umach[1] |
| > xmax <- umach[2] |
| > tx <- unique(c(outer(-1:1,c(.1,1e-3,1e-7))))# 7 values (out of 9) |
| > tx <- unique(sort(c(outer(umach,1+tx))))# 11 values (+ 1 Inf) |
| > length(tx <- tx[is.finite(tx)]) # 11 |
| [1] 11 |
| > (txp <- tx[tx >= 1])#-- Positive exponent -- 4 values |
| [1] 1.617924e+308 1.795895e+308 1.797693e+308 1.797693e+308 |
| > (txn <- tx[tx < 1])#-- Negative exponent -- 7 values |
| [1] 2.002566e-308 2.222849e-308 2.225074e-308 2.225074e-308 2.225074e-308 2.227299e-308 2.447581e-308 |
| > |
| > x2 <- c(0.099999994, 0.2) |
| > x2 # digits=7: show all seven "9"s |
| [1] 0.09999999 0.20000000 |
| > print(x2, digits=6) # 0.1 0.2 , not 0.10 0.20 |
| [1] 0.1 0.2 |
| > v <- 6:8; names(v) <- v; sapply(v, format.info, x=x2) |
| 6 7 8 |
| [1,] 3 10 11 |
| [2,] 1 8 9 |
| [3,] 0 0 0 |
| > |
| > (z <- sort(c(outer(range(txn), 8^c(0,2:3))))) |
| [1] 2.002566e-308 2.447581e-308 1.281643e-306 1.566452e-306 1.025314e-305 1.253162e-305 |
| > outer(z, 0:6, signif) # had NaN's till 1.1.1 |
| [,1] [,2] [,3] [,4] [,5] [,6] [,7] |
| [1,] 2e-308 2e-308 2.0e-308 2.00e-308 2.003e-308 2.0026e-308 2.00257e-308 |
| [2,] 2e-308 2e-308 2.4e-308 2.45e-308 2.448e-308 2.4476e-308 2.44758e-308 |
| [3,] 1e-306 1e-306 1.3e-306 1.28e-306 1.282e-306 1.2816e-306 1.28164e-306 |
| [4,] 2e-306 2e-306 1.6e-306 1.57e-306 1.566e-306 1.5665e-306 1.56645e-306 |
| [5,] 1e-305 1e-305 1.0e-305 1.03e-305 1.025e-305 1.0253e-305 1.02531e-305 |
| [6,] 1e-305 1e-305 1.3e-305 1.25e-305 1.253e-305 1.2532e-305 1.25316e-305 |
| > |
| > olddig <- options(digits=14) # RH6.0 fails at 15 |
| > z <- 1.234567891234567e27 |
| > for(dig in 1:14) cat(formatC(dig,w=2), |
| + format(z, digits=dig), signif(z, digits=dig), "\n") |
| 1 1e+27 1e+27 |
| 2 1.2e+27 1.2e+27 |
| 3 1.23e+27 1.23e+27 |
| 4 1.235e+27 1.235e+27 |
| 5 1.2346e+27 1.2346e+27 |
| 6 1.23457e+27 1.23457e+27 |
| 7 1.234568e+27 1.234568e+27 |
| 8 1.2345679e+27 1.2345679e+27 |
| 9 1.23456789e+27 1.23456789e+27 |
| 10 1.234567891e+27 1.234567891e+27 |
| 11 1.2345678912e+27 1.2345678912e+27 |
| 12 1.23456789123e+27 1.23456789123e+27 |
| 13 1.234567891235e+27 1.234567891235e+27 |
| 14 1.2345678912346e+27 1.2345678912346e+27 |
| > options(olddig) |
| > # The following are tests of printf inside formatC |
| > ##------ Use Emacs screen width 134 ; Courier 12 ---- |
| > # cat("dig| formatC(txp, d=dig)\n") |
| > # for(dig in 1:17)# about >= 18 is platform dependent [libc's printf()..]. |
| > # cat(formatC(dig,w=2), formatC(txp, dig=dig, wid=-29),"\n") |
| > # cat("signif() behavior\n~~~~~~~~\n", |
| > # "dig| formatC(signif(txp, dig=dig), dig = dig\n") |
| > # for(dig in 1:15)# |
| > # cat(formatC(dig,w=2), formatC(signif(txp, d=dig), dig=dig, wid=-26),"\n") |
| > |
| > # if(opt.conformance >= 1) { |
| > # noquote(cbind(formatC(txp, dig = 22))) |
| > # } |
| > |
| > # cat("dig| formatC(signif(txn, d = dig), dig=dig\n") |
| > # for(dig in 1:15)# |
| > # cat(formatC(dig,w=2), formatC(signif(txn, d=dig), dig=dig, wid=-20),"\n") |
| > |
| > # ##-- Testing 'print' / digits : |
| > # for(dig in 1:13) { ## 12:13: libc-2.0.7 diff; 14:18 --- PLATFORM-dependent !!! |
| > # cat("dig=",formatC(dig,w=2),": "); print(signif(txp, d=dig),dig=dig+1) |
| > # } |
| > |
| > ##-- Wrong alignment when printing character matrices with quote = FALSE |
| > m1 <- matrix(letters[1:24],6,4) |
| > m1 |
| [,1] [,2] [,3] [,4] |
| [1,] "a" "g" "m" "s" |
| [2,] "b" "h" "n" "t" |
| [3,] "c" "i" "o" "u" |
| [4,] "d" "j" "p" "v" |
| [5,] "e" "k" "q" "w" |
| [6,] "f" "l" "r" "x" |
| > noquote(m1) |
| [,1] [,2] [,3] [,4] |
| [1,] a g m s |
| [2,] b h n t |
| [3,] c i o u |
| [4,] d j p v |
| [5,] e k q w |
| [6,] f l r x |
| > |
| > ##--- Complex matrices and named vectors : |
| > |
| > x0 <- x <- c(1+1i, 1.2 + 10i) |
| > names(x) <- c("a","b") |
| > x |
| a b |
| 1.0+ 1i 1.2+10i |
| > (xx <- rbind(x, 2*x)) |
| a b |
| x 1+1i 1.2+10i |
| 2+2i 2.4+20i |
| > rbind(x0, 2*x0) |
| [,1] [,2] |
| x0 1+1i 1.2+10i |
| 2+2i 2.4+20i |
| > x[4:6] <- c(Inf,Inf*c(-1,1i)) |
| > x + pi |
| a b |
| 4.141593+ 1i 4.341593+ 10i NA Inf+ 0i -Inf+NaNi NaN+Infi |
| > matrix(x + pi, 2) |
| [,1] [,2] [,3] |
| [1,] 4.141593+ 1i NA -Inf+NaNi |
| [2,] 4.341593+10i Inf+0i NaN+Infi |
| > matrix(x + 1i*pi, 3) |
| [,1] [,2] |
| [1,] 1.0+ 4.141593i Inf+3.141593i |
| [2,] 1.2+13.141593i -Inf+ NaNi |
| [3,] NA NaN+ Infi |
| > xx + pi |
| a b |
| x 4.141593+1i 4.34159+10i |
| 5.141593+2i 5.54159+20i |
| > t(cbind(xx, xx+ 1i*c(1,pi))) |
| x |
| a 1.0+ 1i 2.0+ 2.000000i |
| b 1.2+10i 2.4+20.000000i |
| a 1.0+ 2i 2.0+ 5.141593i |
| b 1.2+11i 2.4+23.141593i |
| > |
| > #--- format checks after incorrect changes in Nov 2000 |
| > zz <- data.frame("(row names)" = c("aaaaa", "b"), check.names = FALSE) |
| > format(zz) |
| (row names) |
| 1 aaaaa |
| 2 b |
| > format(zz, justify = "left") |
| (row names) |
| 1 aaaaa |
| 2 b |
| > zz <- data.frame(a = I("abc"), b = I("def\"gh")) |
| > format(zz) |
| a b |
| 1 abc def"gh |
| > # " (font-locking: closing the string above) |
| > |
| > # test format.data.frame on former AsIs's. |
| > set.seed(321) |
| > dd <- data.frame(x = 1:5, y = rnorm(5), z = c(1, 2, NA, 4, 5)) |
| > model <- glm(y ~ x, data = dd, subset = 1:4, na.action = na.omit) |
| > expand.model.frame(model, "z", na.expand = FALSE) |
| y x z |
| 1 1.7049032 1 1 |
| 2 -0.7120386 2 2 |
| 4 -0.1196490 4 4 |
| > expand.model.frame(model, "z", na.expand = TRUE) |
| y x z |
| 1 1.7049032 1 1 |
| 2 -0.7120386 2 2 |
| 3 -0.2779849 3 NA |
| 4 -0.1196490 4 4 |
| > |
| > ## print.table() changes affecting summary.data.frame |
| > options(width=82) |
| > summary(attenu) # ``one line'' |
| event mag station dist accel |
| Min. : 1.00 Min. :5.000 117 : 5 Min. : 0.50 Min. :0.00300 |
| 1st Qu.: 9.00 1st Qu.:5.300 1028 : 4 1st Qu.: 11.32 1st Qu.:0.04425 |
| Median :18.00 Median :6.100 113 : 4 Median : 23.40 Median :0.11300 |
| Mean :14.74 Mean :6.084 112 : 3 Mean : 45.60 Mean :0.15422 |
| 3rd Qu.:20.00 3rd Qu.:6.600 135 : 3 3rd Qu.: 47.55 3rd Qu.:0.21925 |
| Max. :23.00 Max. :7.700 (Other):147 Max. :370.00 Max. :0.81000 |
| NA's : 16 |
| > lst <- levels(attenu$station) |
| > levels(attenu$station)[lst == "117"] <- paste(rep(letters,3),collapse="") |
| > summary(attenu) # {2 + one long + 2 } variables |
| event mag |
| Min. : 1.00 Min. :5.000 |
| 1st Qu.: 9.00 1st Qu.:5.300 |
| Median :18.00 Median :6.100 |
| Mean :14.74 Mean :6.084 |
| 3rd Qu.:20.00 3rd Qu.:6.600 |
| Max. :23.00 Max. :7.700 |
| |
| station |
| abcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyzabcdefghijklmnopqrstuvwxyz: 5 |
| 1028 : 4 |
| 113 : 4 |
| 112 : 3 |
| 135 : 3 |
| (Other) :147 |
| NA's : 16 |
| dist accel |
| Min. : 0.50 Min. :0.00300 |
| 1st Qu.: 11.32 1st Qu.:0.04425 |
| Median : 23.40 Median :0.11300 |
| Mean : 45.60 Mean :0.15422 |
| 3rd Qu.: 47.55 3rd Qu.:0.21925 |
| Max. :370.00 Max. :0.81000 |
| |
| > ## in 1.7.0, things were split to more lines |
| > |
| > ## format.default(*, nsmall > 0) -- for real and complex |
| > |
| > sf <- function(x, N=14) sapply(0:N, function(i) format(x,nsmall=i)) |
| > sf(2) |
| [1] "2" "2.0" "2.00" "2.000" |
| [5] "2.0000" "2.00000" "2.000000" "2.0000000" |
| [9] "2.00000000" "2.000000000" "2.0000000000" "2.00000000000" |
| [13] "2.000000000000" "2.0000000000000" "2.00000000000000" |
| > sf(3.141) |
| [1] "3.141" "3.141" "3.141" "3.141" |
| [5] "3.1410" "3.14100" "3.141000" "3.1410000" |
| [9] "3.14100000" "3.141000000" "3.1410000000" "3.14100000000" |
| [13] "3.141000000000" "3.1410000000000" "3.14100000000000" |
| > sf(-1.25, 20) |
| [1] "-1.25" "-1.25" "-1.25" |
| [4] "-1.250" "-1.2500" "-1.25000" |
| [7] "-1.250000" "-1.2500000" "-1.25000000" |
| [10] "-1.250000000" "-1.2500000000" "-1.25000000000" |
| [13] "-1.250000000000" "-1.2500000000000" "-1.25000000000000" |
| [16] "-1.250000000000000" "-1.2500000000000000" "-1.25000000000000000" |
| [19] "-1.250000000000000000" "-1.2500000000000000000" "-1.25000000000000000000" |
| > |
| > oDig <- options(digits= 3) |
| > sf(pi) |
| [1] "3.14" "3.14" "3.14" "3.142" |
| [5] "3.1416" "3.14159" "3.141593" "3.1415927" |
| [9] "3.14159265" "3.141592654" "3.1415926536" "3.14159265359" |
| [13] "3.141592653590" "3.1415926535898" "3.14159265358979" |
| > sf(1.2e7) |
| [1] "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" |
| [8] "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" "1.2e+07" |
| [15] "1.2e+07" |
| > sf(1.23e7) |
| [1] "12300000" "12300000.0" "12300000.00" |
| [4] "12300000.000" "12300000.0000" "12300000.00000" |
| [7] "12300000.000000" "12300000.0000000" "12300000.00000000" |
| [10] "12300000.000000000" "12300000.0000000000" "12300000.00000000000" |
| [13] "12300000.000000000000" "12300000.0000000000000" "12300000.00000000000000" |
| > s <- -0.01234 |
| > sf(s) |
| [1] "-0.0123" "-0.0123" "-0.0123" |
| [4] "-0.0123" "-0.0123" "-0.01234" |
| [7] "-0.012340" "-0.0123400" "-0.01234000" |
| [10] "-0.012340000" "-0.0123400000" "-0.01234000000" |
| [13] "-0.012340000000" "-0.0123400000000" "-0.01234000000000" |
| > |
| > sf(pi + 2.2i) |
| [1] "3.14+2.2i" "3.14+2.2i" |
| [3] "3.14+2.20i" "3.142+2.200i" |
| [5] "3.1416+2.2000i" "3.14159+2.20000i" |
| [7] "3.141593+2.200000i" "3.1415927+2.2000000i" |
| [9] "3.14159265+2.20000000i" "3.141592654+2.200000000i" |
| [11] "3.1415926536+2.2000000000i" "3.14159265359+2.20000000000i" |
| [13] "3.141592653590+2.200000000000i" "3.1415926535898+2.2000000000000i" |
| [15] "3.14159265358979+2.20000000000000i" |
| > sf(s + pi*1i) |
| [1] "-0.01+3.14i" "-0.01+3.14i" |
| [3] "-0.01+3.14i" "-0.012+3.142i" |
| [5] "-0.0123+3.1416i" "-0.01234+3.14159i" |
| [7] "-0.012340+3.141593i" "-0.0123400+3.1415927i" |
| [9] "-0.01234000+3.14159265i" "-0.012340000+3.141592654i" |
| [11] "-0.0123400000+3.1415926536i" "-0.01234000000+3.14159265359i" |
| [13] "-0.012340000000+3.141592653590i" "-0.0123400000000+3.1415926535898i" |
| [15] "-0.01234000000000+3.14159265358979i" |
| > |
| > options(oDig) |
| > |
| > e1 <- tryCatch(options(max.print=Inf), error=function(e)e) |
| Warning message: |
| In options(max.print = Inf) : NAs introduced by coercion to integer range |
| > e2 <- tryCatch(options(max.print= 0), error=function(e)e) |
| > stopifnot(inherits(e1, "error")) |
| > |
| > |
| > ## Printing of "Date"s |
| > options(width = 80) |
| > op <- options(max.print = 500) |
| > dd <- as.Date("2012-03-12") + -10000:100 |
| > writeLines(t1 <- tail(capture.output(dd))) |
| [476] "1986-02-12" "1986-02-13" "1986-02-14" "1986-02-15" "1986-02-16" |
| [481] "1986-02-17" "1986-02-18" "1986-02-19" "1986-02-20" "1986-02-21" |
| [486] "1986-02-22" "1986-02-23" "1986-02-24" "1986-02-25" "1986-02-26" |
| [491] "1986-02-27" "1986-02-28" "1986-03-01" "1986-03-02" "1986-03-03" |
| [496] "1986-03-04" "1986-03-05" "1986-03-06" "1986-03-07" "1986-03-08" |
| [ reached 'max' / getOption("max.print") -- omitted 9601 entries ] |
| > l6 <- length(capture.output(print(dd, max = 600))) |
| > options(op) |
| > t2 <- tail(capture.output(print(dd, max = 500))) |
| > stopifnot(identical(t1, t2), l6 == 121) |
| > ## not quite consistent in R <= 2.14.x |
| > |
| > |
| > ## Calls with S3 class are not evaluated when (auto)-printed |
| > obj <- structure(quote(stop("should not be evaluated")), class = "foo") |
| > #-- |
| > a <- list(obj) |
| > b <- pairlist(obj) |
| > c <- structure(list(), attr = obj) |
| > d <- list(list(obj, pairlist(obj, structure(list(obj), attr = obj)), NULL)) |
| > # Now auto-print, and explicit print(.) : |
| > a |
| [[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| > b |
| [[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| > c |
| list() |
| attr(,"attr") |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| > d |
| [[1]] |
| [[1]][[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| [[1]][[2]] |
| [[1]][[2]][[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| [[1]][[2]][[2]] |
| [[1]][[2]][[2]][[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| attr(,"attr") |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| |
| [[1]][[3]] |
| NULL |
| |
| |
| > print(a) |
| [[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| > print(b) |
| [[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| > print(c) |
| list() |
| attr(,"attr") |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| > print(d) |
| [[1]] |
| [[1]][[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| [[1]][[2]] |
| [[1]][[2]][[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| [[1]][[2]][[2]] |
| [[1]][[2]][[2]][[1]] |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| attr(,"attr") |
| stop("should not be evaluated") |
| attr(,"class") |
| [1] "foo" |
| |
| |
| [[1]][[3]] |
| NULL |
| |
| |
| > # Now with a method defined (again "auto" + explicit print()): |
| > print.foo <- function(x, ...) cat("dispatched\n") |
| > a ; print(a) |
| [[1]] |
| dispatched |
| |
| [[1]] |
| dispatched |
| |
| > b ; print(b) |
| [[1]] |
| dispatched |
| |
| [[1]] |
| dispatched |
| |
| > c ; print(c) |
| list() |
| attr(,"attr") |
| dispatched |
| list() |
| attr(,"attr") |
| dispatched |
| > d ; print(d) |
| [[1]] |
| [[1]][[1]] |
| dispatched |
| |
| [[1]][[2]] |
| [[1]][[2]][[1]] |
| dispatched |
| |
| [[1]][[2]][[2]] |
| [[1]][[2]][[2]][[1]] |
| dispatched |
| |
| attr(,"attr") |
| dispatched |
| |
| |
| [[1]][[3]] |
| NULL |
| |
| |
| [[1]] |
| [[1]][[1]] |
| dispatched |
| |
| [[1]][[2]] |
| [[1]][[2]][[1]] |
| dispatched |
| |
| [[1]][[2]][[2]] |
| [[1]][[2]][[2]][[1]] |
| dispatched |
| |
| attr(,"attr") |
| dispatched |
| |
| |
| [[1]][[3]] |
| NULL |
| |
| |
| > |
| > |
| > ## tagbuf is preserved after print dispatch in pairlists |
| > obj <- structure(list(), class = "foo") |
| > pairlist(a = list(A = obj, B = obj)) |
| $a |
| $a$A |
| dispatched |
| |
| $a$B |
| dispatched |
| |
| |
| > list(list(pairlist(obj), NULL)) ## should print [[1]][[2]] \n NULL |
| [[1]] |
| [[1]][[1]] |
| [[1]][[1]][[1]] |
| dispatched |
| |
| |
| [[1]][[2]] |
| NULL |
| |
| |
| > LLo <- list(list(obj, |
| + pairlist(a=obj, b=structure(list(C=obj), attr=obj)), |
| + NULL)) |
| > LLo ## tags (names and [[<n>]]) were lost in R <= 3.5.0 |
| [[1]] |
| [[1]][[1]] |
| dispatched |
| |
| [[1]][[2]] |
| [[1]][[2]]$a |
| dispatched |
| |
| [[1]][[2]]$b |
| [[1]][[2]]$b$C |
| dispatched |
| |
| attr(,"attr") |
| dispatched |
| |
| |
| [[1]][[3]] |
| NULL |
| |
| |
| > |
| > ## show() is preferred over print() when printing recursively |
| > print.callS4Class <- function(x, ...) stop("should not be dispatched") |
| > .CallS4Class <- setClass("callS4Class", slots = c(x = "numeric")) |
| > setMethod("show", "callS4Class", function(object) cat("S4 show!\n")) |
| > x <- .CallS4Class(x = 1) |
| > ## these should all say 'S4 show!' |
| > list(x) ; pairlist(x) # these 2 failed in R <= 3.5.0 |
| [[1]] |
| S4 show! |
| |
| [[1]] |
| S4 show! |
| |
| > structure(list(), attr = x) |
| list() |
| attr(,"attr") |
| S4 show! |
| > rm(x, .CallS4Class) |
| > |
| > |
| > ## Print dispatch does not reset parameters |
| > local({ |
| + num <- 0.123456789 |
| + print(list(num, obj, num), digits = 2) # should print 2 x '0.12' |
| + }) |
| [[1]] |
| [1] 0.12 |
| |
| [[2]] |
| dispatched |
| |
| [[3]] |
| [1] 0.12 |
| |
| > |
| > |
| > ## User-supplied arguments are forwarded on print-dispatch |
| > print.foo <- function(x, other = FALSE, digits = 0L, ...) { |
| + cat("digits: ", digits, "\n") |
| + stopifnot(other, digits == 4, !...length()) |
| + } |
| > a <- list(obj) |
| > b <- pairlist(obj) |
| > c <- LLo[[1]][[2]]$b |
| > d <- LLo |
| > print(a, digits = 4, other = TRUE) |
| [[1]] |
| digits: 4 |
| |
| > print(b, digits = 4, other = TRUE) |
| [[1]] |
| digits: 4 |
| |
| > print(c, digits = 4, other = TRUE) |
| $C |
| digits: 4 |
| |
| attr(,"attr") |
| digits: 4 |
| > print(d, digits = 4, other = TRUE) |
| [[1]] |
| [[1]][[1]] |
| digits: 4 |
| |
| [[1]][[2]] |
| [[1]][[2]]$a |
| digits: 4 |
| |
| [[1]][[2]]$b |
| [[1]][[2]]$b$C |
| digits: 4 |
| |
| attr(,"attr") |
| digits: 4 |
| |
| |
| [[1]][[3]] |
| NULL |
| |
| |
| > # |
| > ## Deparsing should not reset parameters |
| > print(list(a, expression(foo), b, quote(foo), c, base::list, d), |
| + digits = 4, other = TRUE) |
| [[1]] |
| [[1]][[1]] |
| digits: 4 |
| |
| |
| [[2]] |
| expression(foo) |
| |
| [[3]] |
| [[3]][[1]] |
| digits: 4 |
| |
| |
| [[4]] |
| foo |
| |
| [[5]] |
| [[5]]$C |
| digits: 4 |
| |
| attr(,"attr") |
| digits: 4 |
| |
| [[6]] |
| function (...) .Primitive("list") |
| |
| [[7]] |
| [[7]][[1]] |
| [[7]][[1]][[1]] |
| digits: 4 |
| |
| [[7]][[1]][[2]] |
| [[7]][[1]][[2]]$a |
| digits: 4 |
| |
| [[7]][[1]][[2]]$b |
| [[7]][[1]][[2]]$b$C |
| digits: 4 |
| |
| attr(,"attr") |
| digits: 4 |
| |
| |
| [[7]][[1]][[3]] |
| NULL |
| |
| |
| |
| > ## Cleanup |
| > rm(print.foo, obj, a, b, c, d) |
| > |