Running examples in ‘sfsmisc-Ex.R’ failed
The error most likely occurred in:

> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Encoding: UTF-8
> 
> ### Name: AsciiToInt
> ### Title: Character to and from Integer Codes Conversion
> ### Aliases: AsciiToInt ichar chars8bit strcodes
> ### Keywords: manip
> 
> ### ** Examples
> 
> chars8bit(65:70)#-> "A" "B" .. "F"
[1] "A" "B" "C" "D" "E" "F"
> stopifnot(identical(LETTERS,   chars8bit(65:90)),
+           identical(AsciiToInt(LETTERS), 65:90))
> 
> ## may only work in ISO-latin1 locale (not in UTF-8):
> try( strcodes(c(a= "ABC", ch="1234", place = "Zürich")) )
$a
[1] 65 66 67

$ch
[1] 49 50 51 52

$place
[1]  90  NA 114 105  99 104

> ## in "latin-1" gives  {otherwise should give NA instead of 252}:
> ## Not run: 
> ##D $a
> ##D [1] 65 66 67
> ##D 
> ##D $ch
> ##D [1] 49 50 51 52
> ##D 
> ##D $place
> ##D [1]  90 252 114 105  99 104
> ## End(Not run)
> 
> myloc <- Sys.getlocale()
> 
> if(.Platform $ OS.type == "unix") withAutoprint({ # ''should work'' here
+   try( Sys.setlocale(locale = "de_CH") )# "try": just in case
+   strcodes(c(a= "ABC", ch="1234", place = "Zürich")) # no NA hopefully
+   AsciiToInt(chars8bit()) # -> 1:255  {if setting latin1 succeeded above}
+ 
+   chars8bit(97:140)
+   try( Sys.setlocale(locale = "de_CH.utf-8") )# "try": just in case
+   chars8bit(97:140) ## typically looks different than above
+ })
> try(Sys.setlocale(locale = "de_CH"))
[1] "LC_CTYPE=de_CH;LC_NUMERIC=C;LC_TIME=de_CH;LC_COLLATE=de_CH;LC_MONETARY=de_CH;LC_MESSAGES=en_US.UTF-8;LC_PAPER=en_US.UTF-8;LC_NAME=C;LC_ADDRESS=C;LC_TELEPHONE=C;LC_MEASUREMENT=en_US.UTF-8;LC_IDENTIFICATION=C"
> strcodes(c(a = "ABC", ch = "1234", place = "Z<fc>rich"))
$a
[1] 65 66 67

$ch
[1] 49 50 51 52

$place
[1]  90 252 114 105  99 104

> AsciiToInt(chars8bit())
  [1]   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18
 [19]  19  20  21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36
 [37]  37  38  39  40  41  42  43  44  45  46  47  48  49  50  51  52  53  54
 [55]  55  56  57  58  59  60  61  62  63  64  65  66  67  68  69  70  71  72
 [73]  73  74  75  76  77  78  79  80  81  82  83  84  85  86  87  88  89  90
 [91]  91  92  93  94  95  96  97  98  99 100 101 102 103 104 105 106 107 108
[109] 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126
[127] 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
[145] 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162
[163] 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180
[181] 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198
[199] 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
[217] 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234
[235] 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252
[253] 253 254 255
> chars8bit(97:140)
 [1] "a"    "b"    "c"    "d"    "e"    "f"    "g"    "h"    "i"    "j"   
[11] "k"    "l"    "m"    "n"    "o"    "p"    "q"    "r"    "s"    "t"   
[21] "u"    "v"    "w"    "x"    "y"    "z"    "{"    "|"    "}"    "~"   
[31] "\177" "\200" "\201" "\202" "\203" "\204" "\205" "\206" "\207" "\210"
[41] "\211" "\212" "\213" "\214"
> try(Sys.setlocale(locale = "de_CH.utf-8"))
[1] "LC_CTYPE=de_CH.utf-8;LC_NUMERIC=C;LC_TIME=de_CH.utf-8;LC_COLLATE=de_CH.utf-8;LC_MONETARY=de_CH.utf-8;LC_MESSAGES=en_US.UTF-8;LC_PAPER=en_US.UTF-8;LC_NAME=C;LC_ADDRESS=C;LC_TELEPHONE=C;LC_MEASUREMENT=en_US.UTF-8;LC_IDENTIFICATION=C"
> chars8bit(97:140)
 [1] "a"    "b"    "c"    "d"    "e"    "f"    "g"    "h"    "i"    "j"   
[11] "k"    "l"    "m"    "n"    "o"    "p"    "q"    "r"    "s"    "t"   
[21] "u"    "v"    "w"    "x"    "y"    "z"    "{"    "|"    "}"    "~"   
[31] "\177" "\x80" "\x81" "\x82" "\x83" "\x84" "\x85" "\x86" "\x87" "\x88"
[41] "\x89" "\x8a" "\x8b" "\x8c"
> 
> ## Resetting to original locale .. works "mostly":
> lapply(strsplit(strsplit(myloc, ";")[[1]], "="),
+        function(cc) try(Sys.setlocale(cc[1], cc[2]))) -> .scratch
Error in Sys.setlocale(cc[1], cc[2]) : invalid 'category' argument
Error in Sys.setlocale(cc[1], cc[2]) : invalid 'category' argument
Error in Sys.setlocale(cc[1], cc[2]) : invalid 'category' argument
Error in Sys.setlocale(cc[1], cc[2]) : invalid 'category' argument
> 
> Sys.getlocale() == myloc # TRUE if we have succeeded to reset it
[1] TRUE
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("AsciiToInt", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("D1D2")
> ### * D1D2
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: D1D2
> ### Title: Numerical Derivatives of (x,y) Data via Smoothing Splines
> ### Aliases: D1D2
> ### Keywords: smooth
> 
> ### ** Examples
> 
>  set.seed(8840)
>  x <- runif(100, 0,10)
>  y <- sin(x) + rnorm(100)/4
> 
>  op <- par(mfrow = c(2,1))
>  plot(x,y)
>  lines(ss <- smooth.spline(x,y), col = 4)
>  str(ss[c("df", "spar")])
List of 2
 $ df  : num 10.3
 $ spar: num 0.716
>  if(is.R()) plot(cos, 0, 10, ylim = c(-1.5,1.5), lwd=2) else { # Splus
+    xx <- seq(0,10, len=201); plot(xx, cos(xx), type = 'l', ylim = c(-1.5,1.5))
+  }
>  title(expression("Estimating f'() :  " * frac(d,dx) * sin(x) == cos(x)))
>  offs <- c(-0.1, 0, 0.1, 0.2, 0.3)
>  i <- 1
>  for(off in offs) {
+    d12 <- D1D2(x,y, spar.offset = off)
+    lines(d12$x, d12$D1, col = i <- i+1)
+  }
>  legend(2,1.6, c("true cos()",paste("sp.off. = ", format(offs))), lwd=1,
+         col = 1:(1+length(offs)), cex = 0.8, bg = NA)
>  par(op)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("D1D2", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("D2ss")
> ### * D2ss
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: D2ss
> ### Title: Numerical Derivatives of (x,y) Data (via Smoothing Splines)
> ### Aliases: D2ss D1ss D1tr
> ### Keywords: smooth
> 
> ### ** Examples
> 
> 
> ## First Derivative  --- spar.off = 0  ok "asymptotically" (?)
> set.seed(330)
> mult.fig(12)
> for(i in 1:12) {
+   x <- runif(500, 0,10); y <- sin(x) + rnorm(500)/4
+   f1 <- D1ss(x=x,y=y, spar.off=0.0)
+   plot(x,f1, ylim = range(c(-1,1,f1)))
+   curve(cos(x), col=3, add= TRUE)
+ }
> 
>  set.seed(8840)
>  x <- runif(100, 0,10)
>  y <- sin(x) + rnorm(100)/4
> 
>  op <- par(mfrow = c(2,1))
>  plot(x,y)
>  lines(ss <- smooth.spline(x,y), col = 4)
>  str(ss[c("df", "spar")])
List of 2
 $ df  : num 10.3
 $ spar: num 0.716
>  xx <- seq(0,10, len=201)
>  plot(xx, -sin(xx), type = 'l', ylim = c(-1.5,1.5))
>  title(expression("Estimating f''() :  " * frac(d^2,dx^2) * sin(x) == -sin(x)))
>  offs <- c(0.05, 0.1, 0.1348, 0.2)
>  i <- 1
>  for(off in offs) {
+    d12 <- D2ss(x,y, spar.offset = off)
+    lines(d12, col = i <- i+1)
+  }
>  legend(2,1.6, c("true :  -sin(x)",paste("sp.off. = ", format(offs))), lwd=1,
+         col = 1:(1+length(offs)), cex = 0.8, bg = NA)
>  par(op)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("D2ss", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("Duplicated")
> ### * Duplicated
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: Duplicated
> ### Title: Counting-Generalization of duplicated()
> ### Aliases: Duplicated
> ### Keywords: manip
> 
> ### ** Examples
> 
> x <- c(9:12, 1:4, 3:6, 0:7)
> data.frame(x, dup = duplicated(x),
+               dupL= duplicated(x, fromLast=TRUE),
+               Dup = Duplicated(x),
+               DupL= Duplicated(x, fromLast=TRUE))
    x   dup  dupL Dup DupL
1   9 FALSE FALSE  NA   NA
2  10 FALSE FALSE  NA   NA
3  11 FALSE FALSE  NA   NA
4  12 FALSE FALSE  NA   NA
5   1 FALSE  TRUE   3    1
6   2 FALSE  TRUE   4    2
7   3 FALSE  TRUE   1    3
8   4 FALSE  TRUE   2    4
9   3  TRUE  TRUE   1    3
10  4  TRUE  TRUE   2    4
11  5 FALSE  TRUE   7    7
12  6 FALSE  TRUE   8    8
13  0 FALSE FALSE  NA   NA
14  1  TRUE FALSE   3    1
15  2  TRUE FALSE   4    2
16  3  TRUE FALSE   1    3
17  4  TRUE FALSE   2    4
18  5  TRUE FALSE   7    7
19  6  TRUE FALSE   8    8
20  7 FALSE FALSE  NA   NA
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("Duplicated", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("KSd")
> ### * KSd
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: KSd
> ### Title: Approximate Critical Values for Kolmogorov-Smirnov's D
> ### Aliases: KSd
> ### Keywords: distribution
> 
> ### ** Examples
> 
> KSd(90)
[1] 0.1411873
> KSd(1:9)# now works
[1] 0.97500 0.84189 0.70760 0.62394 0.56328 0.51926 0.48342 0.45427 0.43001
> 
> op <- par(mfrow=c(2,1))
>   plot(KSd, 10, 150)# nice
>   abline(v = c(75,85), col = "gray")
>   plot(KSd, 79, 81, n = 1001)# *very* tiny discontinuity at 80
> par(op)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("KSd", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("QUnif")
> ### * QUnif
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: QUnif
> ### Title: Quasi Randum Numbers via Halton Sequences
> ### Aliases: QUnif sHalton
> ### Keywords: math multivariate datagen
> 
> ### ** Examples
> 
> 32*sHalton(20, base=2)
 [1] 16  8 24  4 20 12 28  2 18 10 26  6 22 14 30  1 17  9 25  5
> 
> stopifnot(sHalton(20, base=3, leap=2) ==
+           sHalton(20, base=3)[1+2*(0:9)])
> ## ------- a 2D Visualization -------
> 
> Uplot <- function(xy, axes=FALSE, xlab="", ylab="", ...) {
+   plot(xy, xaxs="i", yaxs="i", xlim=0:1, ylim=0:1, xpd = FALSE,
+        axes=axes, xlab=xlab, ylab=ylab, ...)
+   box(lty=2, col="gray40")
+ }
> 
> do4 <- function(n, ...) {
+   op <- mult.fig(4, main=paste("n =", n,": Quasi vs. (Pseudo) Random"),
+                  marP=c(-2,-2,-1,0))$old.par
+   on.exit(par(op))
+   for(i in 1:2) {
+      Uplot(QUnif(n, p=2), main="QUnif", ...)
+      Uplot(cbind(runif(n), runif(n)), main="runif", ...)
+   }
+ }
> do4(100)
> do4(500)
> do4(1000, cex = 0.8, col="slateblue")
> do4(10000, pch= ".", col="slateblue")
> do4(40000, pch= ".", col="slateblue")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("QUnif", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("Sys.cpuinfo")
> ### * Sys.cpuinfo
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: Sys.cpuinfo
> ### Title: Provide Information about the Linux Hardware (CPU, Memory, etc)
> ### Aliases: Sys.procinfo Sys.cpuinfo Sys.meminfo Sys.memGB Sys.MIPS
> ### Keywords: utilities
> 
> ### ** Examples
> 
> (n.cores <- parallel::detectCores())
[1] 32
> if(substr(R.version[["os"]], 1,5) == "linux") { ##-- only on Linux
+   Sys.cpuinfo() # which is often ugly; this looks much better:
+   length(Sys.cpu2 <- local({I <- Sys.cpuinfo(); I[ !grepl("^flags", names(I)) ] }))
+   ## may still be too much, notably if n.cores > 2:
+   (Sys3 <- Sys.cpu2[!grepl("[.][0-9]+$", names(Sys.cpu2))])
+ 
+   Sys.MIPS() ## just the 'bogomips' from above:
+   Sys.MIPS() / as.numeric(Sys.cpuinfo()["cpu.MHz"]) ## ~~ 2 * #{cores} ((no longer))
+ 
+   ## Available Memory -- can be crucial:
+   Sys.memGB() #- default "MemTotal"
+   if(Sys.memGB("MemFree") > 16)
+      message("Be happy! You have more than 16 Gigabytes of free memory")
+ }
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("Sys.cpuinfo", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("Sys.ps")
> ### * Sys.ps
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: Sys.ps
> ### Title: Return Process Status (Unix 'ps') Information
> ### Aliases: Sys.ps Sys.sizes
> ### Keywords: utilities
> 
> ### ** Examples
> 
> (.pid <- Sys.getpid()) ## process ID of current process
[1] 17196
> Sys.sizes(.pid)
   rss    vsz 
113332 438812 
> 
> ## The default process statistics about the running R process
> try( Sys.ps() )
       pid       pcpu       time        vsz       comm 
   "17196"     "60.0" "00:00:02"   "438812"        "R" 
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("Sys.ps", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("TA.plot")
> ### * TA.plot
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: TA.plot
> ### Title: Tukey-Anscombe Plot (Residual vs. Fitted) of a Linear Model
> ### Aliases: TA.plot
> ### Keywords: models regression
> 
> ### ** Examples
> 
> data(stackloss)
> TA.plot(lm(stack.loss ~ stack.x))
> 
> example(airquality)

arqlty> require(graphics)

arqlty> pairs(airquality, panel = panel.smooth, main = "airquality data")
> summary(lmO <- lm(Ozone ~ ., data= airquality))

Call:
lm(formula = Ozone ~ ., data = airquality)

Residuals:
    Min      1Q  Median      3Q     Max 
-37.014 -12.284  -3.302   8.454  95.348 

Coefficients:
             Estimate Std. Error t value Pr(>|t|)    
(Intercept) -64.11632   23.48249  -2.730  0.00742 ** 
Solar.R       0.05027    0.02342   2.147  0.03411 *  
Wind         -3.31844    0.64451  -5.149 1.23e-06 ***
Temp          1.89579    0.27389   6.922 3.66e-10 ***
Month        -3.03996    1.51346  -2.009  0.04714 *  
Day           0.27388    0.22967   1.192  0.23576    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 20.86 on 105 degrees of freedom
  (42 observations deleted due to missingness)
Multiple R-squared:  0.6249,	Adjusted R-squared:  0.6071 
F-statistic: 34.99 on 5 and 105 DF,  p-value: < 2.2e-16

> TA.plot(lmO)
> TA.plot(lmO, label = "O") # instead of case numbers
> 
> if(FALSE) { 
+  TA.plot(lm(cost ~ age+type+car.age, claims, weights=number, na.action=na.omit))
+ }
> 
> ##--- for  aov(.) : -------------
> data(Gun, package = "nlme")
> TA.plot( aov(rounds ~ Method + Physique/Team, data = Gun))
> 
> ##--- Not so clear what it means for GLM, but: ------
> if(require(rpart)) { # for the two datasets only
+  data(solder, package = "rpart")
+  TA.plot(glm(skips ~ ., data = solder, family = poisson), cex= .6)
+ 
+  data(kyphosis, package = "rpart")
+  TA.plot(glm(Kyphosis ~ poly(Age,2) + Start, data=kyphosis, family = binomial),
+ 	 cex=.75) # smaller title and plotting characters
+ }
Loading required package: rpart
Warning in library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE,  :
  there is no package called ‘rpart’
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("TA.plot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("axTexpr")
> ### * axTexpr
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: axTexpr
> ### Title: Axis Ticks Expressions in Nice 10 ** k Form
> ### Aliases: axTexpr
> ### Keywords: dplot
> 
> ### ** Examples
> 
> x <- 1e7*(-10:50)
> y <- dnorm(x, m=10e7, s=20e7)
> plot(x,y)## not really nice,  the following is better:
> 
> ## For horizontal y-axis labels, need more space:
> op <- par(mar= .1+ c(5,5,4,1))
> plot(x,y, axes= FALSE, frame=TRUE)
> aX <- axTicks(1); axis(1, at=aX, label= axTexpr(1, aX))
> ## horizontal labels on y-axis:
> aY <- axTicks(2); axis(2, at=aY, label= axTexpr(2, aY), las=2)
> par(op)
> 
> ### -- only 'x' and using log-scale there:
> plot(x,y, xaxt= "n", log = "x")
Warning in xy.coords(x, y, xlabel, ylabel, log) :
  11 x values <= 0 omitted from logarithmic plot
> aX <- axTicks(1); axis(1, at=aX, label= axTexpr(1, aX))
> 
> ## Now an "engineer's version" ( more ticks; only label "10 ^ k" ) :
> 
> axp <- par("xaxp") #-> powers of 10 *inside* 'usr'
> axp[3] <- 1 # such that only 10^. are labeled
> aX <- axTicks(1, axp = axp)
> xu <- 10 ^ par("usr")[1:2]
> e10 <- c(-1,1) + round(log10(axp[1:2])) ## exponents of 10 *outside* 'usr'
> v <- c(outer(1:9, e10[1]:e10[2], function(x,E) x * 10 ^ E))
> v <- v[xu[1] <= v & v <= xu[2]]
> 
> plot(x,y, xaxt= "n", log = "x", main = "engineer's version of x - axis")
Warning in xy.coords(x, y, xlabel, ylabel, log) :
  11 x values <= 0 omitted from logarithmic plot
> axis(1, at = aX, label = axTexpr(1, aX, drop.1=TRUE)) # 'default'
> axis(1, at = v,  label = FALSE, tcl = 2/3 * par("tcl"))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("axTexpr", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("capture-n-write")
> ### * capture-n-write
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: capture.and.write
> ### Title: Capture output and Write / Print First and Last Parts
> ### Aliases: capture.and.write
> 
> ### ** Examples
> 
> x <- seq(0, 10, by = .1)
> 
> ## for matrix, dataframe, .. first lines include a header line:
> capture.and.write( cbind(x, log1p(exp(x))),  first = 5)
          x           
  [1,]  0.0  0.6931472
  [2,]  0.1  0.7443967
  [3,]  0.2  0.7981389
  [4,]  0.3  0.8543552
 ....... 
 ....... 
[100,]  9.9  9.9000502
[101,] 10.0 10.0000454
> 
> ## first, *middle* and last :
> capture.and.write( cbind(x, x^2, x^3), first = 4, middle = 3, n.dots= 1)
          x                
  [1,]  0.0   0.00    0.000
  [2,]  0.1   0.01    0.001
  [3,]  0.2   0.04    0.008
 ....... 
 [49,]  4.8  23.04  110.592
 [50,]  4.9  24.01  117.649
 [51,]  5.0  25.00  125.000
 ....... 
[100,]  9.9  98.01  970.299
[101,] 10.0 100.00 1000.000
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("capture-n-write", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("col01scale")
> ### * col01scale
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: col01scale
> ### Title: Matrix Scaling Utilities
> ### Aliases: col01scale colcenter
> ### Keywords: array
> 
> ### ** Examples
> 
> ## See the simple function definitions:
> 
> colcenter ## simply one line
function (mat) 
sweep(mat, 2, apply(mat, 2, mean))
<bytecode: 0x55b497e4d128>
<environment: namespace:sfsmisc>
> 
> col01scale# almost as simple
function (mat, scale.func = function(x) diff(range(x)), location.func = mean) 
{
    mat <- sweep(mat, 2, apply(mat, 2, location.func))
    sweep(mat, 2, apply(mat, 2, scale.func), "/")
}
<bytecode: 0x55b497e59a58>
<environment: namespace:sfsmisc>
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("col01scale", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("compresid2way")
> ### * compresid2way
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: compresid2way
> ### Title: Plot Components + Residuals for Two Factors
> ### Aliases: compresid2way
> ### Keywords: hplot
> 
> ### ** Examples
> 
>  ## From Venables and Ripley (2002) p.165.
>  N <- c(0,1,0,1,1,1,0,0,0,1,1,0,1,1,0,0,1,0,1,0,1,1,0,0)
>  P <- c(1,1,0,0,0,1,0,1,1,1,0,0,0,1,0,1,1,0,0,1,0,1,1,0)
>  K <- c(1,0,0,1,0,1,1,0,0,1,0,1,0,1,1,0,0,0,1,1,1,0,1,0)
>  yield <- c(49.5,62.8,46.8,57.0,59.8,58.5,55.5,56.0,62.8,55.8,69.5,55.0,
+             62.0,48.8,45.5,44.2,52.0,51.5,49.8,48.8,57.2,59.0,53.2,56.0)
>  npk <- data.frame(block=gl(6,4), N=factor(N), P=factor(P),
+                    K=factor(K), yield=yield)
>  npk.cr <- compresid2way(yield ~ N+P+K, data=npk, fac=c("P","K"))
> 
>  ## Fisher's 1926 data on potatoe yield
>  data(potatoes)
>  pot.aov <- aov(yield ~ nitrogen+potash+pos, data=potatoes)
>  compresid2way(pot.aov, pch=as.character(potatoes$pos))
> 
>  compresid2way(yield~nitrogen+potash, data=subset(potatoes, pos == 2))
> 
>  ## 2 x 3 design :
>  data(warpbreaks)
>  summary(fm1 <- aov(breaks ~ wool + tension, data = warpbreaks))
            Df Sum Sq Mean Sq F value  Pr(>F)   
wool         1    451   450.7   3.339 0.07361 . 
tension      2   2034  1017.1   7.537 0.00138 **
Residuals   50   6748   135.0                   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>  compresid2way(fm1)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("compresid2way", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("cum.Vert.funkt")
> ### * cum.Vert.funkt
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: cum.Vert.funkt
> ### Title: Kumulative Verteilung Aufzeichnen
> ### Aliases: cum.Vert.funkt
> ### Keywords: hplot
> 
> ### ** Examples
> 
> cum.Vert.funkt(runif(12))
> cum.Vert.funkt(runif(20))
> 
> Z <- rnorm(50)
> cum.Vert.funkt(Z)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("cum.Vert.funkt", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("diagDA")
> ### * diagDA
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: diagDA
> ### Title: Diagonal Discriminant Analysis
> ### Aliases: diagDA dDA print.dDA predict.dDA
> ### Keywords: naive Bayes classifier models classif
> 
> ### ** Examples
> 
> ## two artificial examples by Andreas Greutert:
> d1 <- data.frame(x = c(1, 5, 5, 5, 10, 25, 25, 25, 25, 29),
+                  y = c(4, 1, 2, 4,  4,  4,     6:8,     7))
> n.plot(d1)
> library(cluster)
> (cl1P <- pam(d1,k=4)$cluster) # 4 surprising clusters
 [1] 1 2 2 2 3 4 4 4 4 4
> with(d1, points(x+0.5, y, col = cl1P, pch =cl1P))
> 
> i1 <- c(1,3,5,6)
> tr1 <- d1[-i1,]
> cl1. <- c(1,2,1,2,1,3)
> cl1  <- c(2,2,1,1,1,3)
> plot(tr1, cex=2, col = cl1, pch = 20+cl1)
> (dd.<- diagDA(tr1, cl1., ts = d1[ i1,]))# ok
[1] 2 2 2 1
> (dd <- diagDA(tr1, cl1 , ts = d1[ i1,]))# ok, too!
[1] 2 2 2 1
> points(d1[ i1,], pch = 10, cex=3, col = dd)
> 
> ## use new fit + predict instead :
> (r1 <- dDA(tr1, cl1))
Linear (pooled var) Diagonal Discriminant Analysis,
  dDA(x = tr1, cll = cl1) 
  (n= 6) x (p= 2) data in K=3 classes of [3, 2, 1] observations each

> (r1.<- dDA(tr1, cl1.))
Linear (pooled var) Diagonal Discriminant Analysis,
  dDA(x = tr1, cll = cl1.) 
  (n= 6) x (p= 2) data in K=3 classes of [3, 2, 1] observations each

> stopifnot(dd == predict(r1,  new = d1[ i1,]),
+           dd.== predict(r1., new = d1[ i1,]))
> 
> plot(tr1, cex=2, col = cl1, bg = cl1, pch = 20+cl1,
+      xlim=c(1,30), ylim= c(0,10))
> xy <- cbind(x= runif(500, min=1,max=30), y = runif(500, min=0, max=10))
> points(xy, cex= 0.5, col = predict(r1, new = xy))
> abline(v=c( mean(c(5,25)), mean(c(25,29))))
> 
> ## example where one variable xj has  Var(xj) = 0:
> x4 <- matrix(c(2:4,7, 6,8,5,6,  7,2,3,1, 7,7,7,7), ncol=4)
> y <- c(2,2, 1,1)
> m4.1 <- dDA(x4, y, pool = FALSE)
> m4.2 <- dDA(x4, y, pool = TRUE)
> xx <- matrix(c(3,7,5,7), ncol=4)
> predict(m4.1, xx)## gave integer(0) previously
[1] 2
> predict(m4.2, xx)
[1] 2
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("diagDA", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()

detaching ‘package:cluster’

> nameEx("diagX")
> ### * diagX
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: diagX
> ### Title: The "Other" Diagonal Matrix
> ### Aliases: diagX
> ### Keywords: array utilities
> 
> ### ** Examples
> 
> diagX(4)
     [,1] [,2] [,3] [,4]
[1,]    0    0    0    1
[2,]    0    0    1    0
[3,]    0    1    0    0
[4,]    1    0    0    0
> for(m in 1:5)
+   stopifnot(identical(diagX(m), diag(m)[, m:1, drop = FALSE]))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("diagX", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("digitsBase")
> ### * digitsBase
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: digitsBase
> ### Title: Digit/Bit Representation of Integers in any Base
> ### Aliases: digitsBase as.intBase bi2int as.integer.basedInt
> ###   print.basedInt
> ### Keywords: arith utilities
> 
> ### ** Examples
> 
> digitsBase(0:12, 8) #-- octal representation
Class 'basedInt'(base = 8) [1:13]
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8] [,9] [,10] [,11] [,12] [,13]
[1,]    0    0    0    0    0    0    0    0    1     1     1     1     1
[2,]    0    1    2    3    4    5    6    7    0     1     2     3     4
> empty.dimnames(digitsBase(0:33, 2)) # binary
Class 'basedInt'(base = 2) [1:34]
                                                                    
 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1
 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 0 0
 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1 0 0
 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1 0 0
 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1 0 0
 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
> 
> ## This may be handy for just one number (and default decimal):
> digits <- function(n, base = 10) as.vector(digitsBase(n, base = base))
> digits(128982734)     # 1 2 8 9 8 2 7 3 4
[1] 1 2 8 9 8 2 7 3 4
> digits(128, base = 8) # 2 0 0
[1] 2 0 0
> 
> ## one way of pretty printing (base <= 10!)
> b2ch <- function(db)
+         noquote(gsub("^0+(.{1,})$"," \\1", 
+                 apply(db, 2, paste, collapse = "")))
> b2ch(digitsBase(0:33, 2))  #->  0 1 10 11 100 101 ... 100001
 [1]  0      1      10     11     100    101    110    111    1000   1001 
[11]  1010   1011   1100   1101   1110   1111   10000  10001  10010  10011
[21]  10100  10101  10110  10111  11000  11001  11010  11011  11100  11101
[31]  11110  11111 100000 100001
> b2ch(digitsBase(0:33, 4))  #->  0 1 2 3 10 11 12 13 20 ... 200 201
 [1]  0   1   2   3   10  11  12  13  20  21  22  23  30  31  32  33 100 101 102
[20] 103 110 111 112 113 120 121 122 123 130 131 132 133 200 201
> 
> ## Hexadecimal:
> i <- c(1:20, 100:106)
> M <- digitsBase(i, 16)
> hexdig <- c(0:9, LETTERS[1:6])
> cM <- hexdig[1 + M]; dim(cM) <- dim(M)
> b2ch(cM) #->  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F 10 11 ... 6A
 [1]  1  2  3  4  5  6  7  8  9  A  B  C  D  E  F 10 11 12 13 14 64 65 66 67 68
[26] 69 6A
> 
> ## IP (Internet Protocol) numbers coding:  <n>.<n>.<n>.<n>  <-->  longinteger
> ip_ntoa <- function(n)
+         apply(digitsBase(n, base = 256), 2, paste, collapse=".")
> ip_ntoa(2130706430 + (0:9))# "126.255.255.254" ... "127.0.0.7"
 [1] "126.255.255.254" "126.255.255.255" "127.0.0.0"       "127.0.0.1"      
 [5] "127.0.0.2"       "127.0.0.3"       "127.0.0.4"       "127.0.0.5"      
 [9] "127.0.0.6"       "127.0.0.7"      
> ## and the inverse:
> ip_aton <- function(a)
+         bi2int(lapply(strsplit(a, ".", fixed=TRUE), as.integer), 256)
> 
> n <- 2130706430 + (0:9)
> head(ip <- ip_ntoa(n))
[1] "126.255.255.254" "126.255.255.255" "127.0.0.0"       "127.0.0.1"      
[5] "127.0.0.2"       "127.0.0.3"      
> head(ip_aton(ip))
[1] 2130706430 2130706431 2130706432 2130706433 2130706434 2130706435
> stopifnot( n == ip_aton(ip_ntoa(n )),
+           ip == ip_ntoa(ip_aton(ip)))
> 
> 
> ## Inverse of digitsBase() : as.integer method for the "basedInt" class
> as.integer(M)
  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
  1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20 
 21  22  23  24  25  26  27 
100 101 102 103 104 105 106 
> ## or also as.intBase() working from strings:
> (cb <- apply(digitsBase(0:33, 4), 2, paste, collapse = ""))
 [1] "000" "001" "002" "003" "010" "011" "012" "013" "020" "021" "022" "023"
[13] "030" "031" "032" "033" "100" "101" "102" "103" "110" "111" "112" "113"
[25] "120" "121" "122" "123" "130" "131" "132" "133" "200" "201"
> ##-> "000" "001" ..... "200" "201"
> all(0:33 == as.intBase(cb, base = 4))
[1] TRUE
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("digitsBase", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("eaxis")
> ### * eaxis
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: eaxis
> ### Title: Extended / Engineering Axis for Graphics
> ### Aliases: eaxis
> ### Keywords: aplot
> 
> ### ** Examples
> 
> x <- lseq(1e-10, 0.1, length = 201)
> plot(x, pt(x, df=3), type = "l", xaxt = "n", log = "x")
> eaxis(1)
> ## without small ticks:
> eaxis(3, at.small=FALSE, col="blue")
> 
> ## If you like the ticks, but prefer traditional (non-"plotmath") labels:
> plot(x,  gamma(x),   type = "l", log = "x")
> eaxis(1, labels=NA)
> 
> x <- lseq(.001, 0.1, length = 1000)
> plot(x, sin(1/x)*x, type = "l", xaxt = "n", log = "x")
> eaxis(1)
> eaxis(3, n.axp = 1)# -> xaxp[3] = 1:  only  10^j (main) ticks
> 
> ## non- log-scale : draw small ticks, but no "10^k" if not needed:
> x <- seq(-100, 100, length = 1000)
> plot(x, sin(x)/x, type = "l", xaxt = "n")
> eaxis(1)           # default -> {1, 2, 5} * 10^j  ticks
> eaxis(3, n.axp = 2)# -> xaxp[3] := 2 -- approximately two (main) ticks
> 
> x <- seq(-1, 1, length = 1000)
> plot(x, sin(x)/x, type = "l", xaxt = "n")
> eaxis(1, small.args = list(col="blue"))
> 
> x <- x/1000
> plot(x, 1-sin(x)/x, type = "l", xaxt = "n", yaxt = "n")
> eaxis(1)
> eaxis(2)
> ## more labels than default:
> op <- par(lab=c(10,5,7))
> plot(x, sin(x)/x, type = "l", xaxt = "n")
> eaxis(1) # maybe (depending on your canvas), there are too many,
> ## in that case, maybe use
> plot(x, sin(x)/x, type = "l", xaxt = "n")
> eaxis(1, axTicks(1)[c(TRUE,FALSE)]) # drop every 2nd label
> eaxis(3, labels=FALSE)
> 
> ## ore use 'max.at' which thins as well:
> plot(x, sin(x)/x, type = "l", xaxt = "n")
> eaxis(1, max.at=6)
> par(op)
> 
> ### Answering R-help "How do I show real values on a log10 histogram", 26 Mar 2013
> ## the data:
>        set.seed(1); summary(x <- rlnorm(100, m = 2, sdl = 3))
    Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
   0.010    1.683   10.472  248.639   58.832 9945.279 
> ## the plot (w/o  x-axis) :
>        r <- hist(log10(x), xaxt = "n", xlab = "x [log scale]")
> ## the nice axis:
>        axt <- axTicks(1)
>        eaxis(1, at = axt, labels = pretty10exp(10^axt, drop.1=TRUE))
> ## Additionally demo'ing   'sub10' options:
>        plot(r, xaxt="n")
>        eaxis(1, at = axt, labels = pretty10exp(10^axt, drop.1=TRUE, sub10 = 2))
> ## or
>        plot(r, xaxt="n")
>        eaxis(1, at = axt, labels = pretty10exp(10^axt, drop.1=TRUE, sub10 = "10"))
> ## or
>        plot(r, xaxt="n")
>        eaxis(1, at = axt, labels = pretty10exp(10^axt, drop.1=TRUE, sub10 = c(-2, 2)))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("eaxis", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("ecdf.ksCI")
> ### * ecdf.ksCI
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ecdf.ksCI
> ### Title: Plot Empirical Distribution Function With 95% Confidence Curves
> ### Aliases: ecdf.ksCI
> ### Keywords: hplot
> 
> ### ** Examples
> 
> ecdf.ksCI( rchisq(50,3) )
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("ecdf.ksCI", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("ellipsePoints")
> ### * ellipsePoints
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ellipsePoints
> ### Title: Compute Radially Equispaced Points on Ellipse
> ### Aliases: ellipsePoints
> ### Keywords: iplot utilities
> 
> ### ** Examples
> 
> ## Simple Ellipse, centered at (0,0), x-/y- axis parallel:
> ep <- ellipsePoints(5,2)
> str(ep)
 num [1:201, 1:2] 5 4.98 4.94 4.87 4.77 ...
> plot(ep, type="n",asp=1) ; polygon(ep, col = 2)
> ## (a,b) = (2,5)  is equivalent to (5,2) :
> lines(ellipsePoints(2,5), lwd=2, lty=3)
> ## keep.order=TRUE : Now, (2,5) are axes in x- respective y- direction:
> lines(ellipsePoints(2,5, keep.ab.order=TRUE), col="blue")
> 
> ## rotate by 30 degrees :
> plot(ellipsePoints(5,2, alpha = 30), asp=1)
> abline(h=0,v=0,col="gray")
> abline(a=0,b= tan( 30 *pi/180), col=2, lty = 2)
> abline(a=0,b= tan(120 *pi/180), col=3, lty = 2)
> 
> ## NB: use x11(type = "Xlib") for the following if you can
> if(dev.interactive(TRUE)) {
+   ## Movie : rotating ellipse  :
+   nTurns <- 4 # #{full 360 deg turns}
+   for(al in 1:(nTurns*360)) {
+       ep <- ellipsePoints(3,6, alpha=al, loc = c(5,2))
+       plot(ep,type="l",xlim=c(-1,11),ylim=c(-4,8),
+ 	   asp=1, axes = FALSE, xlab="", ylab="")
+   }
+ 
+   ## Movie : rotating _filled_ ellipse {less nice to look at}
+   for(al in 1:180) {
+       ep <- ellipsePoints(3,6, alpha=al, loc = c(5,2))
+       plot(ep,type="n",xlim=c(-1,11),ylim=c(-4,8),
+ 	   asp=1, axes = FALSE, xlab="", ylab="")
+       polygon(ep,col=2,border=3,lwd=2.5)
+   }
+ }# only if interactive
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("ellipsePoints", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("empty.dimnames")
> ### * empty.dimnames
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: empty.dimnames
> ### Title: Empty Dimnames of an Array
> ### Aliases: empty.dimnames
> ### Keywords: array print utilities
> 
> ### ** Examples
> 
> empty.dimnames(diag(5)) # looks much nicer
          
 1 0 0 0 0
 0 1 0 0 0
 0 0 1 0 0
 0 0 0 1 0
 0 0 0 0 1
> 
> (a <- matrix(-9:10, 4,5))
     [,1] [,2] [,3] [,4] [,5]
[1,]   -9   -5   -1    3    7
[2,]   -8   -4    0    4    8
[3,]   -7   -3    1    5    9
[4,]   -6   -2    2    6   10
> empty.dimnames(a) # nicer, right?
              
 -9 -5 -1 3  7
 -8 -4  0 4  8
 -7 -3  1 5  9
 -6 -2  2 6 10
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("empty.dimnames", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("errbar")
> ### * errbar
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: errbar
> ### Title: Scatter Plot with Error Bars
> ### Aliases: errbar
> ### Keywords: hplot
> 
> ### ** Examples
> 
> y <- rnorm(10); d <- 1 + .1*rnorm(10)
> errbar(1:10, y, y + d, y - d, main="Error Bars example")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("errbar", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("f.robftest")
> ### * f.robftest
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: f.robftest
> ### Title: Robust F-Test: Wald test for multiple coefficients of rlm()
> ###   Object.
> ### Aliases: f.robftest
> ### Keywords: robust htest
> 
> ### ** Examples
> 
> if(require("MASS")) {
+   ## same data as  example(rlm)
+   data(stackloss)
+   summary(rsl <- rlm(stack.loss ~ ., stackloss))
+   f.robftest(rsl)
+  } else  " forget it "
Loading required package: MASS

	robust F-test (as if non-random weights)

data:  from rlm(formula = stack.loss ~ ., data = stackloss)
F = 90.189, p-value = 1.212e-10
alternative hypothesis: two.sided
null values:
  Air.Flow Water.Temp Acid.Conc. 
         0          0          0 

> 
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("f.robftest", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()

detaching ‘package:MASS’

> nameEx("factorize")
> ### * factorize
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: factorize
> ### Title: Prime Factorization of Integers
> ### Aliases: factorize
> ### Keywords: math
> 
> ### ** Examples
> 
>  factorize(47)
$`47`
      p m
[1,] 47 1

>  factorize(seq(101, 120, by=2))
$`101`
       p m
[1,] 101 1

$`103`
       p m
[1,] 103 1

$`105`
     p m
[1,] 3 1
[2,] 5 1
[3,] 7 1

$`107`
       p m
[1,] 107 1

$`109`
       p m
[1,] 109 1

$`111`
      p m
[1,]  3 1
[2,] 37 1

$`113`
       p m
[1,] 113 1

$`115`
      p m
[1,]  5 1
[2,] 23 1

$`117`
      p m
[1,]  3 2
[2,] 13 1

$`119`
      p m
[1,]  7 1
[2,] 17 1

> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("factorize", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("funEnv")
> ### * funEnv
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: funEnv
> ### Title: List-like Environment of Functions (and More)
> ### Aliases: funEnv
> ### Keywords: programming data
> 
> ### ** Examples
> 
> ee <- funEnv(f = function(x) g(2*(x+1)),
+              g = function(y) hh(y+1),
+             hh = function(u) u^2,
+           info = "Some Information (not a function)")
> ls(ee) # here the same as  names(ee)
[1] "f"    "g"    "hh"   "info"
> ## Check that it works: i.e., that "f sees g" and "g sees hh":
> stopifnot(all.equal(ee$f(pi), (2*pi+3)^2))
> ee$f(0:4) # [1]  9  25  49  81 121
[1]   9  25  49  81 121
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("funEnv", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("hatMat")
> ### * hatMat
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: hatMat
> ### Title: Hat Matrix of a Smoother
> ### Aliases: hatMat
> ### Keywords: smooth regression
> 
> ### ** Examples
> 
> require(stats) # for smooth.spline() or loess()
> 
> x1 <- c(1:4, 7:12)
> H1 <- hatMat(x1, spar = 0.5) # default : smooth.spline()
> 
> matplot(x1, H1, type = "l", main = "columns of smoother hat matrix")
> 
> ## Example 'pred.sm' arguments for hatMat() :
> pspl <-  function(x,y,...) predict(smooth.spline(x,y, ...), x = x)$y
> pksm <-  function(x,y,...) ksmooth(sort(x),y, "normal", x.points=x, ...)$y
> ## Rather than ksmooth():
> if(require("lokern"))
+   pksm2 <- function(x,y,...) glkerns(x,y, x.out=x, ...)$est
Loading required package: lokern
> 
> 
> ## Explaining 'trace = TRUE'
> all.equal(sum(diag((hatMat(c(1:4, 7:12), df = 4)))),
+                     hatMat(c(1:4, 7:12), df = 4, trace = TRUE), tol = 1e-12)
[1] TRUE
> 
> ## ksmooth() :
> Hk <- hatMat(x1, pr = pksm, bandwidth = 2)
> cat(sprintf("df = %.2f\n", sum(diag(Hk))))
df = 6.06
> image(Hk)
> Matrix::printSpMatrix(as(round(Hk, 2), "sparseMatrix"))
                                                       
 [1,] 0.70 0.28 0.02 .    .    .    .    .    .    .   
 [2,] 0.22 0.55 0.22 0.01 .    .    .    .    .    .   
 [3,] 0.01 0.22 0.55 0.22 .    .    .    .    .    .   
 [4,] .    0.02 0.28 0.70 .    .    .    .    .    .   
 [5,] .    .    .    .    0.70 0.28 0.02 .    .    .   
 [6,] .    .    .    .    0.22 0.55 0.22 0.01 .    .   
 [7,] .    .    .    .    0.01 0.22 0.54 0.22 0.01 .   
 [8,] .    .    .    .    .    0.01 0.22 0.54 0.22 0.01
 [9,] .    .    .    .    .    .    0.01 0.22 0.55 0.22
[10,] .    .    .    .    .    .    .    0.02 0.28 0.70
> 
> ##--->  see demo("hatmat-ex")  for more (and larger) examples
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("hatMat", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()

detaching ‘package:lokern’

> nameEx("histBxp")
> ### * histBxp
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: histBxp
> ### Title: Plot a Histogram and a Boxplot
> ### Aliases: histBxp
> ### Keywords: hplot
> 
> ### ** Examples
> 
>  lab <- "50 samples from a t distribution with 5 d.f."
>  mult.fig(2*3, main = "Hist() + Rug()   and    histBxp(*)")
>  for(i in 1:3) {
+    my.sample <-  rt(50, 5)
+    hist(my.sample, main=lab); rug(my.sample)# for 50 obs., this is ok, too..
+    histBxp(my.sample, main=lab)
+  }
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("histBxp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("integrate.xy")
> ### * integrate.xy
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: integrate.xy
> ### Title: Cheap Numerical Integration through Data points.
> ### Aliases: integrate.xy
> ### Keywords: math utilities
> 
> ### ** Examples
> 
>  x <- 1:4
>  integrate.xy(x, exp(x))
[1] 52.40261
>  print(exp(4) - exp(1), digits = 10) # the true integral
[1] 51.8798682
> 
>  for(n in c(10, 20,50,100, 200)) {
+    x <- seq(1,4, len = n)
+    cat(formatC(n,wid=4), formatC(integrate.xy(x, exp(x)), dig = 9),"\n")
+  }
  10 51.8822763 
  20 51.8799518 
  50 51.8799052 
 100 51.8799054 
 200 51.8799054 
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("integrate.xy", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("inv.seq")
> ### * inv.seq
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: inv.seq
> ### Title: Inverse seq() - Short Expression for Index Vector
> ### Aliases: inv.seq
> ### Keywords: arith utilities
> 
> ### ** Examples
> 
> (rr <- inv.seq(i1 <- c(3:12, 20:24, 27, 30:33)))
c(3:12, 20:24, 27, 30:33)
> eval(rr)
 [1]  3  4  5  6  7  8  9 10 11 12 20 21 22 23 24 27 30 31 32 33
> stopifnot(eval(rr) == i1)
> 
> e2 <- expression(c(20:13, 3:12, -1:-4, 27, 30:31))
> (i2 <- eval(e2))
 [1] 20 19 18 17 16 15 14 13  3  4  5  6  7  8  9 10 11 12 -1 -2 -3 -4 27 30 31
> (r2 <- inv.seq(i2))
c(20:13, 3:12, -1:-4, 27, 30:31)
> stopifnot(all.equal(r2, e2[[1]]))
> 
> ## Had {mapply()} bug in this example:
> ii <- c(1:3, 6:9, 11:16)
> stopifnot(identical(ii, eval(inv.seq(ii))))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("inv.seq", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("is.whole")
> ### * is.whole
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: is.whole
> ### Title: Test Whether a Vector or Array Consists of Whole Numbers
> ### Aliases: is.whole
> ### Keywords: arith
> 
> ### ** Examples
> 
> ## Create a random array, matrix, vector
> set.seed(307)
> a <- array(runif(24), dim = c(2, 3, 4))
> a[4:8] <- 4:8
> m <- matrix(runif(12), 3, 4)
> m[2:4] <- 2:4
> v <- complex(real      = seq(0.5, 1.5, by = 0.1),
+              imaginary = seq(2.5, 3.5, by = 0.1))
> 
> ## Find whole entries
> is.whole(a)
, , 1

      [,1]  [,2] [,3]
[1,] FALSE FALSE TRUE
[2,] FALSE  TRUE TRUE

, , 2

     [,1]  [,2]  [,3]
[1,] TRUE FALSE FALSE
[2,] TRUE FALSE FALSE

, , 3

      [,1]  [,2]  [,3]
[1,] FALSE FALSE FALSE
[2,] FALSE FALSE FALSE

, , 4

      [,1]  [,2]  [,3]
[1,] FALSE FALSE FALSE
[2,] FALSE FALSE FALSE

> is.whole(m)
      [,1]  [,2]  [,3]  [,4]
[1,] FALSE  TRUE FALSE FALSE
[2,]  TRUE FALSE FALSE FALSE
[3,]  TRUE FALSE FALSE FALSE
> is.whole(v)
 [1] FALSE FALSE FALSE FALSE FALSE  TRUE FALSE FALSE FALSE FALSE FALSE
> 
> ## Numbers of class integer are always whole
> is.whole(dim(a))
[1] TRUE TRUE TRUE
> is.whole(length(v))
[1] TRUE
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("is.whole", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("iterate.lin.recursion")
> ### * iterate.lin.recursion
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: iterate.lin.recursion
> ### Title: Generate Sequence Iterating a Linear Recursion
> ### Aliases: iterate.lin.recursion
> ### Keywords: arith
> 
> ### ** Examples
> 
> ## The Fibonacci sequence:
> iterate.lin.recursion(0:1, c(1,1), nr = 12)
 [1]   0   1   1   2   3   5   8  13  21  34  55  89 144 233
> ## 0 1 1 2 3 5 8 13 21 34 55 89 144 233
> 
> ## seq() as a special case:
> stopifnot(iterate.lin.recursion(4,1, d=2, nr=20)
+           == seq(4, by=2, length=1+20))
> 
> ## ''Deterministic AR(2)'' :
> round(iterate.lin.recursion(1:4, c(-0.7, 0.9), d = 2, nr=15), dig=3)
 [1] 1.000 2.000 3.000 4.000 3.500 2.350 1.665 1.854 2.503 2.955 2.908 2.548
[13] 2.258 2.249 2.443 2.625 2.652 2.550 2.438
> ## slowly decaying :
> plot(ts(iterate.lin.recursion(1:4, c(-0.9, 0.95), nr=150)))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("iterate.lin.recursion", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("last")
> ### * last
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: last
> ### Title: Get Last Elements of a Vector
> ### Aliases: last
> ### Keywords: manip
> 
> ### ** Examples
> 
> a <- c(NA, 1, 2, NA, 3, 4, NA)
> last(a)
[1] NA
> last(a, na.rm=TRUE)
[1] 4
> 
> last(a, length = 2)
[1]  4 NA
> last(a, length = -3)
[1] NA  1  2 NA
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("last", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("linesHyberb.lm")
> ### * linesHyberb.lm
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: linesHyperb.lm
> ### Title: Plot Confidence or Prediction Hyperbolas around a Regression
> ###   Line
> ### Aliases: linesHyperb.lm
> ### Keywords: regression aplot
> 
> ### ** Examples
> 
> data(swiss)
>       plot(Fertility ~ Education, data = swiss) # the data
> (lmS <- lm(Fertility ~ Education, data = swiss))

Call:
lm(formula = Fertility ~ Education, data = swiss)

Coefficients:
(Intercept)    Education  
    79.6101      -0.8624  

> linesHyperb.lm(lmS)
> linesHyperb.lm(lmS, conf=TRUE, col="blue")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("linesHyberb.lm", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("loessDemo")
> ### * loessDemo
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: loessDemo
> ### Title: Graphical Interactive Demo of loess()
> ### Aliases: loessDemo
> ### Keywords: loess dynamic hplot
> 
> ### ** Examples
> 
> if(dev.interactive()) {
+ 
+  if(requireNamespace("lattice")) {
+     data("ethanol", package = "lattice")
+     attach(ethanol)
+     loessDemo(E,NOx, span=.25)
+     loessDemo(E,NOx, span=.25, family = "symmetric")
+ 
+     loessDemo(E,NOx, degree=0)# Tricube Kernel estimate
+   }
+ 
+  ## Artificial Example with one outlier
+  n2 <- 50; x <- 1:(1+2*n2)
+  fx <- (x/10 - 5)^2
+  y <- fx + 4*rnorm(x)
+  y[n2+1] <- 1e4
+  loessDemo(x,y, span=1/3, ylim= c(0,1000))# not robust !!
+  loessDemo(x,y, span=1/3, family = "symm")
+  loessDemo(x,y, span=1/3, family = "symm", w.symb = FALSE, ylim = c(0,40))
+  loessDemo(x,y, span=1/3, family = "symm", ylim = c(0,40))
+  ## but see warnings() --- there's a "fixup"
+ 
+ }
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("loessDemo", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("lseq")
> ### * lseq
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: lseq
> ### Title: Generate Sequences, Equidistant on Log Scale
> ### Aliases: lseq
> ### Keywords: manip
> 
> ### ** Examples
> 
> (x <- lseq(1, 990, length= 21))
 [1]   1.000000   1.411828   1.993258   2.814137   3.973078   5.609302
 [7]   7.919369  11.180786  15.785345  22.286190  31.464265  44.422128
[13]  62.716399  88.544762 125.009966 176.492557 249.177116 351.795205
[19] 496.674285 701.218612 990.000000
> plot(x, x^4,    type = "b", col = 2, log = "xy")
> if(with(R.version, major >= 2 && minor >= 1))
+ plot(x, exp(x), type = "b", col = 2, log = "xy")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("lseq", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("mat2tex")
> ### * mat2tex
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: mat2tex
> ### Title: Produce LaTeX commands to print a matrix
> ### Aliases: mat2tex
> ### Keywords: interface utilities
> 
> ### ** Examples
> 
> mex <- matrix(c(pi,pi/2,pi/4,exp(1),exp(2),exp(3)),nrow=2, byrow=TRUE,
+                dimnames = list(c("$\\pi$","$e$"), c("a","b","c")))
> mat2tex(mex, file = print(tf <- tempfile("mat", , ".tex")),
+         title="$\\pi, e$, etc." )
[1] "/tmp/Rtmp8sMsbs/mat432c57caeb29.tex"
> 
> ## The last command produces the file "mat<xyz>.tex" containing
> 
> ##>  \begin{tabular} {| l|| c| c| c|}
> ##>  \multicolumn{ 4 }{c}{ $\pi, e$, etc. } \\ \hline
> ##>     \  & a & b & c \\ \hline \hline
> ##>  $\pi$ & 3.14 & 1.57 & 0.785 \\ \hline
> ##>  $e$ & 2.72 & 7.39 & 20.1 \\ \hline
> ##>  \end{tabular}
> 
> ## Now you have to properly embed the contents of this file
> ## in a LaTeX document -- for example, you will need a
> ## preamble, the \begin{document} statement, etc.
> 
> ## Note that the backslash needs protection in dimnames
> ## or title actions.
> 
> mat2tex(mex, stdout(), col.center = c("r","r","c"))
\begin{tabular} {| l ||r |r |c |}  
 \hline 
   \  & a & b & c \\ \hline \hline 
$\pi$ & 3.14 & 1.57 & 0.785 \\ \hline 
$e$ & 2.72 & 7.39 & 20.1 \\ \hline 
\end{tabular}
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("mat2tex", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("missingCh")
> ### * missingCh
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: missingCh
> ### Title: Has a Formal Argument been Set or is it Missing?
> ### Aliases: missingCh
> ### Keywords: programming
> 
> ### ** Examples
> 
> tst1 <- function(a, b, dd, ...) ## does not work an with argument named 'c' !
+     c(b = missingCh("b"), dd = missingCh("dd"))
> tst1(2)#-> both 'b' and 'dd' are missing
   b   dd 
TRUE TRUE 
> tst1(,3,,3)
    b    dd 
FALSE  TRUE 
> ##     b    dd
> ## FALSE  TRUE  -- as 'b' is not missing but 'dd' is.
> 
> Tst <- function(a,b,cc,dd,EEE, ...)
+     vapply(c("a","b","cc","dd","EEE"), missingCh, NA, envir=environment())
> Tst()
   a    b   cc   dd  EEE 
TRUE TRUE TRUE TRUE TRUE 
> ## TRUE ... TRUE -- as all are missing()
> Tst(1,,3)
    a     b    cc    dd   EEE 
FALSE  TRUE FALSE  TRUE  TRUE 
> ##     a     b    cc    dd   EEE
> ## FALSE  TRUE FALSE  TRUE  TRUE
> ## .....       .....
> ## as 'a' and 'cc' where not missing()
> 
> ## Formal testing:
> stopifnot(tst1(), !tst1(,3,3), Tst(),
+                         Tst(1,,3, b=2, E="bar") == c(0,0,1,0,0))
> ## maybe surprising that this ^^ becomes 'dd' and only 'cc' is missing
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("missingCh", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("mpl")
> ### * mpl
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: mpl
> ### Title: Simple Matrix Plots
> ### Aliases: mpl p.m
> ### Keywords: hplot array
> 
> ### ** Examples
> 
> data(animals, package = "cluster")
> mpl(animals, type = "l")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("mpl", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("mult.fig")
> ### * mult.fig
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: mult.fig
> ### Title: Plot Setup for MULTiple FIGures, incl. Main Title
> ### Aliases: mult.fig
> ### Keywords: hplot
> 
> ### ** Examples
> 
> opl <- mult.fig(5, main= expression("Sine Functions " * sin(n * pi * x)))
> x <- seq(0, 1, len = 201)
> for (n in 1:5)
+   plot(x, sin(n * pi * x), ylab ="", main = paste("n = ",n))
> par(opl$old.par)
> 
> rr <- mult.fig(mfrow=c(5,1), main= "Cosinus Funktionen", cex = 1.5,
+                marP = - c(0, 1, 2, 0))
> for (n in 1:5)
+   plot(x, cos(n * pi * x), type = 'l', col="red", ylab ="")
> str(rr)
List of 2
 $ new.par:List of 5
  ..$ mfrow: int [1:2] 5 1
  ..$ mfcol: int [1:2] 5 1
  ..$ oma  : num [1:4] 0 0 3.25 0
  ..$ mar  : num [1:4] 4.1 3.1 0.1 1.1
  ..$ mgp  : num [1:3] 1.5 0.6 0
 $ old.par:List of 4
  ..$ mfrow: int [1:2] 3 2
  ..$ oma  : num [1:4] 0 0 2.8 0
  ..$ mar  : num [1:4] 4.1 4.1 2.1 1.1
  ..$ mgp  : num [1:3] 1.5 0.6 0
> par(rr$old.par)
> ## The *restored* par settings:
> str(do.call("par", as.list(names(rr$new.par))))
List of 5
 $ mfrow: int [1:2] 3 2
 $ mfcol: int [1:2] 3 2
 $ oma  : num [1:4] 0 0 2.8 0
 $ mar  : num [1:4] 4.1 4.1 2.1 1.1
 $ mgp  : num [1:3] 1.5 0.6 0
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("mult.fig", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("n.code")
> ### * n.code
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: n.code
> ### Title: Convert "Round" Integers to Short Strings and Back
> ### Aliases: n.code code2n
> ### Keywords: utilities
> 
> ### ** Examples
> 
> n10 <-  c(10,20,90, 100,500, 2000,10000)
> (c10 <- n.code(n10))#-> "1d" "2d" "9d" "1c" ..
[1] "1d"  "2d"  "9d"  "1c"  "5c"  "2k"  "10k"
> stopifnot(code2n(c10) == n10)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("n.code", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("n.plot")
> ### * n.plot
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: n.plot
> ### Title: Name Plot: Names or Numbers instead of Points in Plot
> ### Aliases: n.plot
> ### Keywords: hplot
> 
> ### ** Examples
> 
>  n.plot(1:20, cumsum(rnorm(20)))
>  data(cars)
>  with(cars, n.plot(speed, dist, cex = 0.8, col = "forest green"))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("n.plot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("nearcor")
> ### * nearcor
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: nearcor
> ### Title: Find the Nearest Proper Correlation Matrix
> ### Aliases: nearcor
> ### Keywords: algebra array
> 
> ### ** Examples
> 
>  cat("pr is the example matrix used in Knol DL, ten Berge (1989)\n")
pr is the example matrix used in Knol DL, ten Berge (1989)
>  pr <- matrix(c(1,     0.477, 0.644, 0.478, 0.651, 0.826,
+ 		0.477, 1,     0.516, 0.233, 0.682, 0.75,
+ 		0.644, 0.516, 1,     0.599, 0.581, 0.742,
+ 		0.478, 0.233, 0.599, 1,     0.741, 0.8,
+ 		0.651, 0.682, 0.581, 0.741, 1,     0.798,
+ 		0.826, 0.75,  0.742, 0.8,   0.798, 1),
+ 	      nrow = 6, ncol = 6)
> 
>  ncr <- nearcor(pr)
>  nr <- ncr$cor
>  ## Don't show: 
>   stopifnot(all.equal(nr[lower.tri(nr)],
+             c(0.487968018215891, 0.642651880010905, 0.490638670907082, 0.64409905308119,
+               0.808711184549399, 0.514114729435273, 0.250668810831206, 0.672351311297071,
+               0.725832055882792, 0.596827778712155, 0.582191779051908, 0.744963163381413,
+               0.729882058012398, 0.772150225146827, 0.813191720191943)))
>  
> ## End(Don't show)
>  plot(pr[lower.tri(pr)],
+       nr[lower.tri(nr)]); abline(0,1, lty=2)
>  round(cbind(eigen(pr)$values, eigen(nr)$values), 8)
        [,1]     [,2]
[1,]  4.2132 4.20e+00
[2,]  0.7715 7.54e-01
[3,]  0.5154 5.08e-01
[4,]  0.3845 3.80e-01
[5,]  0.1780 1.61e-01
[6,] -0.0626 4.00e-08
> 
>  cat("The following will fail:\n")
The following will fail:
>  try(factanal(cov=pr, factors=2))
Warning in log(e) : NaNs produced
Error in optim(start, FAfn, FAgr, method = "L-BFGS-B", lower = lower,  : 
  L-BFGS-B needs finite values of 'fn'
>  cat("and this should work\n")
and this should work
>  try(factanal(cov=nr, factors=2))

Call:
factanal(factors = 2, covmat = nr)

Uniquenesses:
[1] 0.309 0.232 0.441 0.005 0.307 0.005

Loadings:
     Factor1 Factor2
[1,] 0.735   0.388  
[2,] 0.868   0.123  
[3,] 0.534   0.523  
[4,] 0.151   0.986  
[5,] 0.508   0.660  
[6,] 0.740   0.669  

               Factor1 Factor2
SS loadings      2.407   2.295
Proportion Var   0.401   0.382
Cumulative Var   0.401   0.784

The degrees of freedom for the model is 4 and the fit was 13.8129 
> 
>  if(require("polycor")) {
+ 
+     n <- 400
+     x <- rnorm(n)
+     y <- rnorm(n)
+ 
+     x1 <- (x + rnorm(n))/2
+     x2 <- (x + rnorm(n))/2
+     x3 <- (x + rnorm(n))/2
+     x4 <- (x + rnorm(n))/2
+ 
+     y1 <- (y + rnorm(n))/2
+     y2 <- (y + rnorm(n))/2
+     y3 <- (y + rnorm(n))/2
+     y4 <- (y + rnorm(n))/2
+ 
+     dat <- data.frame(x1, x2, x3, x4, y1, y2, y3, y4)
+ 
+     x1 <- ordered(as.integer(x1 > 0))
+     x2 <- ordered(as.integer(x2 > 0))
+     x3 <- ordered(as.integer(x3 > 1))
+     x4 <- ordered(as.integer(x4 > -1))
+ 
+     y1 <- ordered(as.integer(y1 > 0))
+     y2 <- ordered(as.integer(y2 > 0))
+     y3 <- ordered(as.integer(y3 > 1))
+     y4 <- ordered(as.integer(y4 > -1))
+ 
+     odat <- data.frame(x1, x2, x3, x4, y1, y2, y3, y4)
+ 
+     xcor <- cor(dat)
+     pcor <- cor(data.matrix(odat)) # cor() no longer works for factors
+     hcor <- hetcor(odat, ML=TRUE, std.err=FALSE)$correlations
+     ncor <- nearcor(hcor)$cor
+ 
+     try(factanal(covmat=xcor, factors=2, n.obs=n))
+     try(factanal(covmat=pcor, factors=2, n.obs=n))
+     try(factanal(covmat=hcor, factors=2, n.obs=n))
+     try(factanal(covmat=ncor, factors=2, n.obs=n))
+   }
Loading required package: polycor
Warning in library(package, lib.loc = lib.loc, character.only = TRUE, logical.return = TRUE,  :
  there is no package called ‘polycor’
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("nearcor", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("nr.sign.chg")
> ### * nr.sign.chg
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: nr.sign.chg
> ### Title: Number of Sign Changes in Sequence
> ### Aliases: nr.sign.chg
> ### Keywords: arith
> 
> ### ** Examples
> 
> (y <- c(1:2,1:-1,0:-2))
[1]  1  2  1  0 -1  0 -1 -2
> nr.sign.chg(y)## = 1
[1] 1
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("nr.sign.chg", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("p.arrows")
> ### * p.arrows
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.arrows
> ### Title: Prettified Arrows Plots
> ### Aliases: p.arrows
> ### Keywords: aplot
> 
> ### ** Examples
> 
> example(arrows, echo = FALSE) #-> x, y, s
> plot(x,y, main="p.arrows(.)")
> p.arrows(x[s], y[s], x[s+1], y[s+1], col= 1:3, fill = "dark blue")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.arrows", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("p.datum")
> ### * p.datum
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.datum
> ### Title: Plot 'Datum' (deutsch!) unten rechts
> ### Aliases: p.datum
> ### Keywords: hplot
> 
> ### ** Examples
> 
> plot(1)
> p.datum()
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.datum", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("p.dnorm")
> ### * p.dnorm
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.dnorm
> ### Title: Plot Parametric Density Functions
> ### Aliases: p.dnorm p.dchisq p.dgamma
> ### Keywords: hplot utilities
> 
> ### ** Examples
> 
> p.dnorm()
> p.dnorm(mu=1.5, add = TRUE, ms.lines = FALSE) # add to the plot above
> 
> p.dchisq(2, main= "Chi^2 Densities -- nu = 2,3,4")
> p.dchisq(3, add = TRUE, col = "red")
> p.dchisq(4, add = TRUE, col = "blue")
> 
> op <- par(mfrow = c(2,2), mgp = c(1.6, 0.6,0), mar = c(3,3,1,1))
> for(sh in 1:4)
+    p.dgamma(sh)
> par(op)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.dnorm", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("p.hboxp")
> ### * p.hboxp
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.hboxp
> ### Title: Add a Horizontal Boxplot to the Current Plot
> ### Aliases: p.hboxp
> ### Keywords: aplot
> 
> ### ** Examples
> 
>   ## ==>  See code in 'histBxp' (.)  and  example(histBxp) !
>   ##
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.hboxp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("p.profileTraces")
> ### * p.profileTraces
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.profileTraces
> ### Title: Plot a profile.nls Object With Profile Traces
> ### Aliases: p.profileTraces
> ### Keywords: hplot nonlinear
> 
> ### ** Examples
> 
> require(stats)
> data(Puromycin)
> Treat <- Puromycin[Puromycin$state == "treated", ]
> fm <- nls(rate ~ T1*conc/(T2+conc), data=Treat,
+           start = list(T1=207,T2=0.06))
> (pr <- profile(fm)) # quite a few things..
$T1
      tau par.vals.T1 par.vals.T2
1  -3.209    190.8634      0.0455
2  -2.563    195.0840      0.0488
3  -1.916    199.3911      0.0523
4  -1.269    203.7889      0.0560
5  -0.621    208.2802      0.0600
6   0.000    212.6837      0.0641
7   0.609    217.0872      0.0684
8   1.229    221.6741      0.0730
9   1.848    226.3617      0.0780
10  2.468    231.1568      0.0833
11  3.086    236.0657      0.0890
12  3.704    241.0959      0.0951

$T2
      tau par.vals.T1 par.vals.T2
1  -3.356    195.0005      0.0397
2  -2.672    198.4424      0.0440
3  -1.988    201.9612      0.0486
4  -1.305    205.5617      0.0535
5  -0.624    209.2376      0.0589
6   0.000    212.6837      0.0641
7   0.583    215.9820      0.0694
8   1.177    219.4187      0.0751
9   1.770    222.9382      0.0812
10  2.363    226.5483      0.0877
11  2.955    230.2558      0.0946
12  3.547    234.0683      0.1021

attr(,"original.fit")
Nonlinear regression model
  model: rate ~ T1 * conc/(T2 + conc)
   data: Treat
      T1       T2 
212.6837   0.0641 
 residual sum-of-squares: 1195

Number of iterations to convergence: 5 
Achieved convergence tolerance: 1.38e-06
attr(,"summary")

Formula: rate ~ T1 * conc/(T2 + conc)

Parameters:
   Estimate Std. Error t value Pr(>|t|)    
T1 2.13e+02   6.95e+00   30.61  3.2e-11 ***
T2 6.41e-02   8.28e-03    7.74  1.6e-05 ***
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

Residual standard error: 10.9 on 10 degrees of freedom

Number of iterations to convergence: 5 
Achieved convergence tolerance: 1.38e-06

attr(,"class")
[1] "profile.nls" "profile"    
> op <- par(mfcol=1:2)
> plot(pr) # -> 2 'standard' plots
> par(op)
> ## ours:
> p.profileTraces(pr)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.profileTraces", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("p.res.2fact")
> ### * p.res.2fact
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.res.2fact
> ### Title: Plot Numeric (e.g. Residuals) vs 2 Factors Using Boxplots
> ### Aliases: p.res.2fact
> ### Keywords: hplot regression
> 
> ### ** Examples
> 
> I <- 8; J <- 3; K <- 20
> xx <- factor(rep(rep(1:I, rep(K,I)),J))
> yy <- factor(rep(1:J, rep(I*K,J)))
> zz <- rt(I*J*K, df=5) #-- Student t with 5 d.f.
> p.res.2fact(xx,yy,zz, restr= 4, main= "i.i.d. t <- 5 random  |.| <= 4")
..Cut z=  4.35 -6.70  5.21 -6.54  at  xx = 2 5 6 6 ,   yy = 3 
..Cut z=  7.01 -4.22 -4.68  at  xx = 2 2 6 ,   yy = 2 
..Cut z=  5.37 -4.18  at  xx = 5 5 ,   yy = 1 
9 restricted observation(s)
> mtext("p.res.2fact(xx,yy,zz, restr= 4, ..)",
+       line=1, adj=1, outer=TRUE, cex=1)
> 
> ## Real data
> data(warpbreaks)
> (fm1 <- lm(breaks ~ wool*tension, data = warpbreaks))

Call:
lm(formula = breaks ~ wool * tension, data = warpbreaks)

Coefficients:
   (Intercept)           woolB        tensionM        tensionH  woolB:tensionM  
          44.6           -16.3           -20.6           -20.0            21.1  
woolB:tensionH  
          10.6  

> ## call via formula method of p.res.2x():
> p.res.2x(~ ., fm1) # is shorter than, but equivalent to
> ## p.res.2x(~ wool + tension, fm1)  ##  or the direct
> ## with(warpbreaks, p.res.2fact(wool, tension, residuals(fm1)))
> ##
> ## whereas this is "transposed":
> p.res.2x(~ tension+wool, fm1)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.res.2fact", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("p.res.2x")
> ### * p.res.2x
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.res.2x
> ### Title: Stahel's Residual Plot against 2 X's
> ### Aliases: p.res.2x p.res.2x.default p.res.2x.formula
> ### Keywords: hplot regression
> 
> ### ** Examples
> 
> xx <- rep(1:10,7)
> yy <- rep(1:7, rep(10,7))
> zz <- rnorm(70)
> p.res.2x(xx,yy,zz, restricted = 2, main = "i.i.d.  N(0,1) random residuals")
> ## Don't show: 
>  p.res.2x(xx,yy,zz, restricted = 2, main = "p.res.2x(*, xlim, ylim)",
+           xlim = c(2,8), ylim = c(1,4))
> ## End(Don't show)
> example(lm.influence, echo = FALSE)
List of 4
 $ hat         : Named num [1:50] 0.0677 0.1204 0.0875 0.0895 0.0696 ...
  ..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
 $ coefficients: num [1:50, 1:5] 0.0916 -0.0747 -0.4752 0.0429 0.6604 ...
  ..- attr(*, "dimnames")=List of 2
  .. ..$ : chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
  .. ..$ : chr [1:5] "(Intercept)" "pop15" "pop75" "dpi" ...
 $ sigma       : Named num [1:50] 3.84 3.84 3.83 3.84 3.81 ...
  ..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
 $ wt.res      : Named num [1:50] 0.864 0.616 2.219 -0.698 3.553 ...
  ..- attr(*, "names")= chr [1:50] "Australia" "Austria" "Belgium" "Bolivia" ...
> 
> op <- mult.fig(2, marP=c(-1,-1,-1,0), main="p.res.2x(*,*, residuals(lm.SR))")$old.par
> with(LifeCycleSavings,
+      { p.res.2x(pop15, ddpi, residuals(lm.SR), scol=c("red", "blue"))
+        p.res.2x(pop75, dpi,  residuals(lm.SR), scol=2:1)
+      })
> 
> ## with formula interface:
> p.res.2x(~ pop15 + ddpi, lm.SR, scol=c("red", "blue"))
> p.res.2x(~ pop75 +  dpi, lm.SR, scol=2:1)
> 
> par(op) # revert par() settings above
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.res.2x", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("p.scales")
> ### * p.scales
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.scales
> ### Title: Conversion between plotting scales: usr, cm, symbol
> ### Aliases: p.scales
> ### Keywords: dplot
> 
> ### ** Examples
> 
> p.scales()
  sy2usr usr2cm
x 0.0448   14.6
y 0.0500   13.1
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.scales", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("p.tachoPlot")
> ### * p.tachoPlot
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.tachoPlot
> ### Title: Draw Symbol on a Plot
> ### Aliases: p.tachoPlot
> ### Keywords: hplot
> 
> ### ** Examples
> 
> data(state)
> data(USArrests)
> p.tachoPlot(state.center $x, state.center $y, USArrests[,"UrbanPop"])
> 
> data(mtcars)
> par(mfrow=c(2,2))
> ## see the difference between the three methods (not much differ. here!)
> p.tachoPlot(mtcars$hp, mtcars$disp, mtcars$mpg, method="sens")
> p.tachoPlot(mtcars$hp, mtcars$disp, mtcars$mpg, method="rank")
> p.tachoPlot(mtcars$hp, mtcars$disp, mtcars$mpg, method="rob")
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.tachoPlot", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> graphics::par(get("par.postscript", pos = 'CheckExEnv'))
> cleanEx()
> nameEx("p.ts")
> ### * p.ts
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: p.ts
> ### Title: plot.ts with multi-plots and Auto-Title - on 1 page
> ### Aliases: p.ts
> ### Keywords: hplot ts
> 
> ### ** Examples
> 
> stopifnot(require(stats))
> ## stopifnot(require(datasets))
> 
> data(sunspots)
> p.ts(sunspots, nr=1) # == usual  plot.ts(..)
> p.ts(sunspots)
 1 -- start{0}= (1749, 1); end{426}= (1784.36, 2.66229)
 2 -- start{376}= (1780.21, 2.46719); end{828}= (1817.73, 4.23093)
 3 -- start{778}= (1813.58, 4.03583); end{1230}= (1851.1, 5.79957)
 4 -- start{1180}= (1846.95, 5.60447); end{1632}= (1884.47, 7.36822)
 5 -- start{1582}= (1880.32, 7.17311); end{2034}= (1917.84, 8.93686)
 6 -- start{1984}= (1913.69, 8.74175); end{2436}= (1951.21, 10.5055)
 7 -- start{2386}= (1947.06, 10.3104); end{2819}= (1983, 12)
> p.ts(sunspots, nr=3, col=2)
 1 -- start{0}= (1749, 1); end{997}= (1831.76, 4.89039)
 2 -- start{881}= (1822.13, 4.43774); end{1937}= (1909.79, 8.55835)
 3 -- start{1821}= (1900.16, 8.10571); end{2819}= (1983, 12)
> 
> data(EuStockMarkets)
> p.ts(EuStockMarkets[,"SMI"])
 1 -- start{0}= (1991, 130); end{493}= (1992.86, 140.343)
 2 -- start{435}= (1992.64, 139.126); end{958}= (1994.61, 150.098)
 3 -- start{900}= (1994.39, 148.881); end{1423}= (1996.36, 159.853)
 4 -- start{1365}= (1996.14, 158.636); end{1859}= (1998, 169)
> ## multivariate :
> p.ts(log10(EuStockMarkets), col = 2:5)
 1 -- start{0}= (1991, 130); end{493}= (1992.86, 140.343)
 2 -- start{435}= (1992.64, 139.126); end{958}= (1994.61, 150.098)
 3 -- start{900}= (1994.39, 148.881); end{1423}= (1996.36, 159.853)
 4 -- start{1365}= (1996.14, 158.636); end{1859}= (1998, 169)
> 
> ## with Date - x-axis (dense random dates):
> set.seed(12)
> x <- as.Date("2000-02-29") + cumsum(1+ rpois(1000, lambda= 2.5))
> z <- cumsum(.1 + 2*rt(1000, df=3))
> p.ts(z, 4, date.x = x)
 1 -- start{0}= (1, 1); end{264}= (265, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2000-03-01 01:00:00" "2000-10-13 02:00:00" "2001-06-17 02:00:00" 
                 Mean               3rd Qu.                  Max. 
"2001-06-05 12:24:54" "2002-01-27 01:00:00" "2002-09-11 02:00:00" 
 2 -- start{234}= (235, 1); end{514}= (515, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2002-05-25 02:00:00" "2003-01-31 01:00:00" "2003-09-21 02:00:00" 
                 Mean               3rd Qu.                  Max. 
"2003-09-27 13:01:04" "2004-05-31 02:00:00" "2005-01-24 01:00:00" 
 3 -- start{484}= (485, 1); end{764}= (765, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2004-10-07 02:00:00" "2005-06-11 02:00:00" "2006-01-29 01:00:00" 
                 Mean               3rd Qu.                  Max. 
"2006-02-01 19:06:24" "2006-10-05 02:00:00" "2007-06-08 02:00:00" 
 4 -- start{734}= (735, 1); end{999}= (1000, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2007-02-11 01:00:00" "2007-10-07 08:00:00" "2008-05-18 14:00:00" 
                 Mean               3rd Qu.                  Max. 
"2008-05-23 23:50:04" "2009-01-05 01:00:00" "2009-09-05 02:00:00" 
> p.ts(z, 6, date.x = x, ax.format = "%b %Y", do.x.rug = TRUE)
 1 -- start{0}= (1, 1); end{175}= (176, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2000-03-01 01:00:00" "2000-07-25 20:00:00" "2000-12-28 13:00:00" 
                 Mean               3rd Qu.                  Max. 
"2000-12-30 09:51:49" "2001-06-11 20:00:00" "2001-11-12 01:00:00" 
 2 -- start{155}= (156, 1); end{341}= (342, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2001-09-06 02:00:00" "2002-02-08 13:00:00" "2002-07-14 02:00:00" 
                 Mean               3rd Qu.                  Max. 
"2002-07-20 10:05:08" "2002-12-28 01:00:00" "2003-06-11 02:00:00" 
 3 -- start{321}= (322, 1); end{507}= (508, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2003-04-04 02:00:00" "2003-08-28 14:00:00" "2004-02-07 01:00:00" 
                 Mean               3rd Qu.                  Max. 
"2004-02-12 06:08:01" "2004-07-22 14:00:00" "2004-12-27 01:00:00" 
 4 -- start{487}= (488, 1); end{673}= (674, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2004-10-17 02:00:00" "2005-04-02 14:00:00" "2005-09-06 02:00:00" 
                 Mean               3rd Qu.                  Max. 
"2005-09-02 20:44:16" "2006-02-08 01:00:00" "2006-07-21 02:00:00" 
 5 -- start{653}= (654, 1); end{839}= (840, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2006-05-03 02:00:00" "2006-10-22 14:00:00" "2007-04-06 02:00:00" 
                 Mean               3rd Qu.                  Max. 
"2007-04-01 22:47:29" "2007-09-14 02:00:00" "2008-02-27 01:00:00" 
 6 -- start{819}= (820, 1); end{999}= (1000, 1)
summary(date.x):
                 Min.               1st Qu.                Median 
"2007-12-14 01:00:00" "2008-05-10 02:00:00" "2008-10-10 02:00:00" 
                 Mean               3rd Qu.                  Max. 
"2008-10-17 13:56:01" "2009-03-30 02:00:00" "2009-09-05 02:00:00" 
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("p.ts", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("paste.vec")
> ### * paste.vec
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: paste.vec
> ### Title: Utility for 'Showing' S vectors
> ### Aliases: paste.vec
> ### Keywords: utilities
> 
> ### ** Examples
> 
>  x <- 1:4
>  paste.vec(x)   ##->  "x = 1 2 3 4"
[1] "x = 1 2 3 4"
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("paste.vec", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("pkgDesc")
> ### * pkgDesc
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: pkgDesc
> ### Title: Version of packageDescription() as Simple Vector
> ### Aliases: pkgDesc pkgBuilt
> 
> ### ** Examples
> 
> str(pd <- pkgDesc("sfsmisc"))
 'Dlist' Named chr [1:25] "sfsmisc" ...
 - attr(*, "names")= chr [1:25] "Package" "Title" "Version" "VersionNote" ...
> pd[c("Date","Packaged", "Built","file")]
Date                    2021-04-03
Packaged                2021-04-08 19:05:19 UTC; maechler
Built                   R 4.1.1; ; 2021-08-05 07:52:06 UTC; unix
file                    /home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/sfsmisc/Meta/package.rds
> 
> pkgBuilt("sfsmisc")
Built                   R 4.1.1; ; 2021-08-05 07:52:06 UTC; unix
file                    /home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/sfsmisc/Meta/package.rds
> 
> ## Show "Built" (and "file") for all packages whose namespaces are loaded:
> lNs <- loadedNamespaces()
> mlNs <- sapply(lNs, pkgBuilt)
> t(mlNs) # typically prints nicely
          Built                                                        
MASS      "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:49:58 UTC; unix"
compiler  "R 4.1.1; ; 2021-08-05 07:33:04 UTC; unix"                   
Matrix    "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 08:28:08 UTC; unix"
graphics  "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:33:54 UTC; unix"
parallel  "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:34:47 UTC; unix"
tools     "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:33:04 UTC; unix"
utils     "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:33:37 UTC; unix"
grDevices "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:33:47 UTC; unix"
stats     "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:34:01 UTC; unix"
lokern    "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 08:02:02 UTC; unix"
datasets  "R 4.1.1; ; 2021-08-05 07:34:21 UTC; unix"                   
splines   "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:34:44 UTC; unix"
grid      "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:34:38 UTC; unix"
methods   "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:34:23 UTC; unix"
base      "R 4.1.1; ; 2021-08-05 07:34:49 UTC; unix"                   
cluster   "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:49:51 UTC; unix"
lattice   "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:49:53 UTC; unix"
sfsmisc   "R 4.1.1; ; 2021-08-05 07:52:06 UTC; unix"                   
          file                                                                                  
MASS      "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/MASS/Meta/package.rds"    
compiler  "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/compiler/Meta/package.rds" 
Matrix    "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/Matrix/Meta/package.rds"  
graphics  "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/graphics/Meta/package.rds" 
parallel  "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/parallel/Meta/package.rds" 
tools     "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/tools/Meta/package.rds"    
utils     "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/utils/Meta/package.rds"    
grDevices "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/grDevices/Meta/package.rds"
stats     "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/stats/Meta/package.rds"    
lokern    "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/lokern/Meta/package.rds"  
datasets  "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/datasets/Meta/package.rds" 
splines   "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/splines/Meta/package.rds"  
grid      "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/grid/Meta/package.rds"     
methods   "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/methods/Meta/package.rds"  
base      "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/base/Meta/package.rds"     
cluster   "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/cluster/Meta/package.rds" 
lattice   "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/lattice/Meta/package.rds" 
sfsmisc   "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/sfsmisc/Meta/package.rds" 
> 
> pkgs <- c("grid", "lattice", "MASS", "Matrix", "nlme", "lme4", "sfsmisc")
> pkgs <- c("foobar", "barbar", pkgs, "kitty") # + names that typically don't exist
> pkgsOk <- basename(find.package(pkgs, quiet=TRUE))
> mpkg <- sapply(pkgsOk, pkgBuilt)
> stopifnot(is.matrix(mpkg), nrow(mpkg) == 2)
> mpkg["Built",]
                                                         grid 
"R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:34:38 UTC; unix" 
                                                      lattice 
"R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:49:53 UTC; unix" 
                                                         MASS 
"R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 07:49:58 UTC; unix" 
                                                       Matrix 
"R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 08:28:08 UTC; unix" 
                                                         nlme 
"R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 08:28:09 UTC; unix" 
                                                      sfsmisc 
                   "R 4.1.1; ; 2021-08-05 07:52:06 UTC; unix" 
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("pkgDesc", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("pkgLibs")
> ### * pkgLibs
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: pkgLibs
> ### Title: R Package Compiled Code Library Dependencies (on Unix-alikes)
> ### Aliases: pkgLibs
> ### Keywords: interface
> 
> ### ** Examples
> 
> # for the example only using standard R packages :
> myPkgs <- c("stats", "MASS", "rpart", "Matrix")
> pl <- pkgLibs(myPkgs)
	not a dynamic executable
Warning in system(paste(cmd, so), intern = TRUE) :
  running command 'ldd /home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/MASS/libs/symbols.rds' had status 1
	not a dynamic executable
Warning in system(paste(cmd, so), intern = TRUE) :
  running command 'ldd /home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/Matrix/libs/symbols.rds' had status 1
> pl
$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/stats`
$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library/stats`$stats.so
 [1] "linux-vdso.so.1 (0x00007ffd2e281000)"                                                                     
 [2] "libRlapack.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRlapack.so (0x00007f0cf7807000)"
 [3] "libRblas.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRblas.so (0x00007f0cf77da000)"    
 [4] "libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007f0cf766d000)"                                        
 [5] "libR.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libR.so (0x00007f0cf71a5000)"            
 [6] "libgomp.so.1 => /usr/lib/x86_64-linux-gnu/libgomp.so.1 (0x00007f0cf7165000)"                              
 [7] "libpthread.so.0 => /lib/x86_64-linux-gnu/libpthread.so.0 (0x00007f0cf7143000)"                            
 [8] "libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007f0cf6f7c000)"                                        
 [9] "libgfortran.so.5 => /usr/lib/x86_64-linux-gnu/libgfortran.so.5 (0x00007f0cf6cc6000)"                      
[10] "/lib64/ld-linux-x86-64.so.2 (0x00007f0cf7a7e000)"                                                         
[11] "libreadline.so.8 => /lib/x86_64-linux-gnu/libreadline.so.8 (0x00007f0cf6c6f000)"                          
[12] "libpcre2-8.so.0 => /usr/lib/x86_64-linux-gnu/libpcre2-8.so.0 (0x00007f0cf6bd7000)"                        
[13] "liblzma.so.5 => /lib/x86_64-linux-gnu/liblzma.so.5 (0x00007f0cf6baf000)"                                  
[14] "libbz2.so.1.0 => /lib/x86_64-linux-gnu/libbz2.so.1.0 (0x00007f0cf6b9c000)"                                
[15] "libz.so.1 => /lib/x86_64-linux-gnu/libz.so.1 (0x00007f0cf6b7d000)"                                        
[16] "libdl.so.2 => /lib/x86_64-linux-gnu/libdl.so.2 (0x00007f0cf6b77000)"                                      
[17] "libicuuc.so.67 => /usr/lib/x86_64-linux-gnu/libicuuc.so.67 (0x00007f0cf698e000)"                          
[18] "libicui18n.so.67 => /usr/lib/x86_64-linux-gnu/libicui18n.so.67 (0x00007f0cf6688000)"                      
[19] "libquadmath.so.0 => /usr/lib/x86_64-linux-gnu/libquadmath.so.0 (0x00007f0cf663f000)"                      
[20] "libgcc_s.so.1 => /lib/x86_64-linux-gnu/libgcc_s.so.1 (0x00007f0cf6625000)"                                
[21] "libtinfo.so.6 => /lib/x86_64-linux-gnu/libtinfo.so.6 (0x00007f0cf65f4000)"                                
[22] "libicudata.so.67 => /usr/lib/x86_64-linux-gnu/libicudata.so.67 (0x00007f0cf4adb000)"                      
[23] "libstdc++.so.6 => /usr/lib/x86_64-linux-gnu/libstdc++.so.6 (0x00007f0cf490e000)"                          


$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/MASS`
$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/MASS`$MASS.so
 [1] "linux-vdso.so.1 (0x00007ffc7adfd000)"                                                                 
 [2] "libR.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libR.so (0x00007fcc199fc000)"        
 [3] "libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007fcc1980e000)"                                    
 [4] "libRblas.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRblas.so (0x00007fcc197e1000)"
 [5] "libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007fcc1969d000)"                                    
 [6] "libreadline.so.8 => /lib/x86_64-linux-gnu/libreadline.so.8 (0x00007fcc19646000)"                      
 [7] "libpcre2-8.so.0 => /usr/lib/x86_64-linux-gnu/libpcre2-8.so.0 (0x00007fcc195ae000)"                    
 [8] "liblzma.so.5 => /lib/x86_64-linux-gnu/liblzma.so.5 (0x00007fcc19584000)"                              
 [9] "libbz2.so.1.0 => /lib/x86_64-linux-gnu/libbz2.so.1.0 (0x00007fcc19571000)"                            
[10] "libz.so.1 => /lib/x86_64-linux-gnu/libz.so.1 (0x00007fcc19554000)"                                    
[11] "libdl.so.2 => /lib/x86_64-linux-gnu/libdl.so.2 (0x00007fcc1954e000)"                                  
[12] "libicuuc.so.67 => /usr/lib/x86_64-linux-gnu/libicuuc.so.67 (0x00007fcc19365000)"                      
[13] "libicui18n.so.67 => /usr/lib/x86_64-linux-gnu/libicui18n.so.67 (0x00007fcc1905f000)"                  
[14] "libgomp.so.1 => /usr/lib/x86_64-linux-gnu/libgomp.so.1 (0x00007fcc1901d000)"                          
[15] "libpthread.so.0 => /lib/x86_64-linux-gnu/libpthread.so.0 (0x00007fcc18ffb000)"                        
[16] "/lib64/ld-linux-x86-64.so.2 (0x00007fcc19ece000)"                                                     
[17] "libtinfo.so.6 => /lib/x86_64-linux-gnu/libtinfo.so.6 (0x00007fcc18fcc000)"                            
[18] "libicudata.so.67 => /usr/lib/x86_64-linux-gnu/libicudata.so.67 (0x00007fcc174b3000)"                  
[19] "libstdc++.so.6 => /usr/lib/x86_64-linux-gnu/libstdc++.so.6 (0x00007fcc172e6000)"                      
[20] "libgcc_s.so.1 => /lib/x86_64-linux-gnu/libgcc_s.so.1 (0x00007fcc172ca000)"                            

$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/MASS`$symbols.rds
character(0)
attr(,"status")
[1] 1


[[3]]
NULL

$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/Matrix`
$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/Matrix`$Matrix.so
 [1] "linux-vdso.so.1 (0x00007ffed4d96000)"                                                                     
 [2] "libRlapack.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRlapack.so (0x00007fabe701c000)"
 [3] "libRblas.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRblas.so (0x00007fabe6fef000)"    
 [4] "libm.so.6 => /lib/x86_64-linux-gnu/libm.so.6 (0x00007fabe6e82000)"                                        
 [5] "libR.so => /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libR.so (0x00007fabe69ba000)"            
 [6] "libc.so.6 => /lib/x86_64-linux-gnu/libc.so.6 (0x00007fabe67f5000)"                                        
 [7] "libgfortran.so.5 => /usr/lib/x86_64-linux-gnu/libgfortran.so.5 (0x00007fabe653f000)"                      
 [8] "libpthread.so.0 => /lib/x86_64-linux-gnu/libpthread.so.0 (0x00007fabe651b000)"                            
 [9] "/lib64/ld-linux-x86-64.so.2 (0x00007fabe72bb000)"                                                         
[10] "libreadline.so.8 => /lib/x86_64-linux-gnu/libreadline.so.8 (0x00007fabe64c4000)"                          
[11] "libpcre2-8.so.0 => /usr/lib/x86_64-linux-gnu/libpcre2-8.so.0 (0x00007fabe642c000)"                        
[12] "liblzma.so.5 => /lib/x86_64-linux-gnu/liblzma.so.5 (0x00007fabe6404000)"                                  
[13] "libbz2.so.1.0 => /lib/x86_64-linux-gnu/libbz2.so.1.0 (0x00007fabe63f1000)"                                
[14] "libz.so.1 => /lib/x86_64-linux-gnu/libz.so.1 (0x00007fabe63d4000)"                                        
[15] "libdl.so.2 => /lib/x86_64-linux-gnu/libdl.so.2 (0x00007fabe63cc000)"                                      
[16] "libicuuc.so.67 => /usr/lib/x86_64-linux-gnu/libicuuc.so.67 (0x00007fabe61e3000)"                          
[17] "libicui18n.so.67 => /usr/lib/x86_64-linux-gnu/libicui18n.so.67 (0x00007fabe5edd000)"                      
[18] "libgomp.so.1 => /usr/lib/x86_64-linux-gnu/libgomp.so.1 (0x00007fabe5e9d000)"                              
[19] "libquadmath.so.0 => /usr/lib/x86_64-linux-gnu/libquadmath.so.0 (0x00007fabe5e54000)"                      
[20] "libgcc_s.so.1 => /lib/x86_64-linux-gnu/libgcc_s.so.1 (0x00007fabe5e3a000)"                                
[21] "libtinfo.so.6 => /lib/x86_64-linux-gnu/libtinfo.so.6 (0x00007fabe5e09000)"                                
[22] "libicudata.so.67 => /usr/lib/x86_64-linux-gnu/libicudata.so.67 (0x00007fabe42f0000)"                      
[23] "libstdc++.so.6 => /usr/lib/x86_64-linux-gnu/libstdc++.so.6 (0x00007fabe4123000)"                          

$`/home/hornik/tmp/R.check/r-patched-gcc/Work/build/Packages/Matrix`$symbols.rds
character(0)
attr(,"status")
[1] 1


> stopifnot(exprs = {
+   is.list(pl)
+   length(pl) == length(myPkgs)
+   is.character(pkgD <- names(pl))
+ })
> ## Have seen this failing when a strange development version of "Matrix" was picked up:
> try( stopifnot( dir.exists(pkgD)) )
Error : dir.exists(pkgD) are not all TRUE
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("pkgLibs", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("plotDS")
> ### * plotDS
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: plotDS
> ### Title: Plot Data and Smoother / Fitted Values
> ### Aliases: plotDS
> ### Keywords: hplot
> 
> ### ** Examples
> 
>  data(cars)
>  x <-  cars$speed
>  yd <- cars$dist
>  ys <- lowess(x, yd, f = .3)$y
>  plotDS(x, yd, ys)
> 
>  ## More interesting : Version of example(Theoph)
>  data(Theoph)
>  Th4 <- subset(Theoph, Subject == 4)
>  ## just for "checking" purposes -- permute the observations:
>  Th4 <- Th4[sample(nrow(Th4)), ]
>  fm1 <- nls(conc ~ SSfol(Dose, Time, lKe, lKa, lCl), data = Th4)
> 
>  ## Simple
>  plotDS(Th4$Time, Th4$conc, fitted(fm1),
+         sub  = "Theophylline data - Subject 4 only",
+         segP = list(lty=1,col=2), las = 1)
> 
>  ## Nicer: Draw the smoother not only at x = x[i] (observations):
>  xsm <- unique(sort(c(Th4$Time, seq(0, 25, length = 201))))
>  ysm <- c(predict(fm1, newdata = list(Time = xsm)))
Warning in .expr4 * (.expr8 - .expr12) :
  longer object length is not a multiple of shorter object length
Warning in .expr4 * (.expr8 * (.expr5 * input)) :
  longer object length is not a multiple of shorter object length
Warning in .expr4 * (.expr12 * (.expr9 * input)) :
  longer object length is not a multiple of shorter object length
>  plotDS(Th4$Time, Th4$conc, ys = list(x=xsm, y=ysm),
+         sub  = "Theophylline data - Subject 4 only",
+         segP = list(lwd=2), las = 1)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("plotDS", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("plotStep")
> ### * plotStep
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: plotStep
> ### Title: Plot a Step Function
> ### Aliases: plotStep
> ### Keywords: nonparametric hplot
> 
> ### ** Examples
> 
> ##-- Draw an Empirical CDF  (and see the default title ..)
> plotStep(rnorm(15))
> 
> plotStep(runif(25), cad.lag=FALSE)
> plotStep(runif(25), cad.lag=FALSE, add=TRUE, lty = 2)
> 
> ui <- sort(runif(20))
> plotStep(ui, ni <- cumsum(rpois(19, lambda=1.5) - 1.5), cad.lag = FALSE)
> plotStep(ui, ni, verticals = TRUE, right.points = TRUE)
> 
> plotStep(rnorm(201), pch = '.') #- smaller points
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("plotStep", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("polyn.eval")
> ### * polyn.eval
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: polyn.eval
> ### Title: Evaluate Polynomials
> ### Aliases: polyn.eval
> ### Keywords: arith
> 
> ### ** Examples
> 
> polyn.eval(c(1,-2,1), x = 0:3)# (x - 1)^2
[1] 1 0 1 4
> polyn.eval(c(0, 24, -50, 35, -10, 1), x = matrix(0:5, 2,3))# 5 zeros!
     [,1] [,2] [,3]
[1,]    0    0    0
[2,]    0    0  120
> (cf <- rbind(diag(3), c(1,-2,1)))
     [,1] [,2] [,3]
[1,]    1    0    0
[2,]    0    1    0
[3,]    0    0    1
[4,]    1   -2    1
> polyn.eval(cf, 0:5)
     [,1] [,2] [,3] [,4]
[1,]    1    0    0    1
[2,]    1    1    1    0
[3,]    1    2    4    1
[4,]    1    3    9    4
[5,]    1    4   16    9
[6,]    1    5   25   16
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("polyn.eval", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("posdefify")
> ### * posdefify
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: posdefify
> ### Title: Find a Close Positive Definite Matrix
> ### Aliases: posdefify
> ### Keywords: algebra array
> 
> ### ** Examples
> 
>  set.seed(12)
>  m <- matrix(round(rnorm(25),2), 5, 5); m <- 1+ m + t(m); diag(m) <- diag(m) + 4
>  m
      [,1]  [,2]  [,3]  [,4]  [,5]
[1,]  2.04  2.31 -0.74 -0.62 -0.78
[2,]  2.31  4.36 -0.92  2.08  3.44
[3,] -0.74 -0.92  3.44  1.35  1.86
[4,] -0.62  2.08  1.35  6.02  0.41
[5,] -0.78  3.44  1.86  0.41  2.94
>  posdefify(m)
       [,1]   [,2]   [,3]   [,4]   [,5]
[1,]  2.040  1.560 -0.887 -0.408 -0.246
[2,]  1.560  4.360 -0.533  1.706  2.345
[3,] -0.887 -0.533  3.440  1.195  1.353
[4,] -0.408  1.706  1.195  6.020  0.578
[5,] -0.246  2.345  1.353  0.578  2.940
>  1000 * zapsmall(m - posdefify(m))
     [,1] [,2] [,3] [,4] [,5]
[1,]    0  750  147 -212 -534
[2,]  750    0 -387  374 1095
[3,]  147 -387    0  155  507
[4,] -212  374  155    0 -168
[5,] -534 1095  507 -168    0
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("posdefify", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("potatoes")
> ### * potatoes
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: potatoes
> ### Title: Fisher's Potato Crop Data
> ### Aliases: potatoes
> ### Keywords: datasets
> 
> ### ** Examples
> 
> data(potatoes)
> ## See the experimental design:
> with(potatoes, {
+      cat("4 blocks of experiments;",
+          "each does every (nitrogen,potash) combination (aka 'treat'ment) once.",
+          '', sep="\n")
+      print(ftable(table(nitrogen, potash, treat)))
+      print(ftable(tt <- table(pos,potash,nitrogen)))
+      tt[cbind(pos,potash,nitrogen)] <- as.character(treat)
+      cat("The 4 blocks  pos = 1, 2, 3, 4:\n")
+      ftable(tt)
+      })
4 blocks of experiments;
each does every (nitrogen,potash) combination (aka 'treat'ment) once.

                treat A B C D E F G H J K L M N O P Q
nitrogen potash                                      
0        0            4 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         1            0 4 0 0 0 0 0 0 0 0 0 0 0 0 0 0
         2            0 0 4 0 0 0 0 0 0 0 0 0 0 0 0 0
         4            0 0 0 4 0 0 0 0 0 0 0 0 0 0 0 0
1        0            0 0 0 0 4 0 0 0 0 0 0 0 0 0 0 0
         1            0 0 0 0 0 4 0 0 0 0 0 0 0 0 0 0
         2            0 0 0 0 0 0 4 0 0 0 0 0 0 0 0 0
         4            0 0 0 0 0 0 0 4 0 0 0 0 0 0 0 0
2        0            0 0 0 0 0 0 0 0 4 0 0 0 0 0 0 0
         1            0 0 0 0 0 0 0 0 0 4 0 0 0 0 0 0
         2            0 0 0 0 0 0 0 0 0 0 4 0 0 0 0 0
         4            0 0 0 0 0 0 0 0 0 0 0 4 0 0 0 0
4        0            0 0 0 0 0 0 0 0 0 0 0 0 4 0 0 0
         1            0 0 0 0 0 0 0 0 0 0 0 0 0 4 0 0
         2            0 0 0 0 0 0 0 0 0 0 0 0 0 0 4 0
         4            0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 4
           nitrogen 0 1 2 4
pos potash                 
1   0               1 1 1 1
    1               1 1 1 1
    2               1 1 1 1
    4               1 1 1 1
2   0               1 1 1 1
    1               1 1 1 1
    2               1 1 1 1
    4               1 1 1 1
3   0               1 1 1 1
    1               1 1 1 1
    2               1 1 1 1
    4               1 1 1 1
4   0               1 1 1 1
    1               1 1 1 1
    2               1 1 1 1
    4               1 1 1 1
The 4 blocks  pos = 1, 2, 3, 4:
           nitrogen 0 1 2 4
pos potash                 
1   0               A E J N
    1               B F K O
    2               C G L P
    4               D H M Q
2   0               A E J N
    1               B F K O
    2               C G L P
    4               D H M Q
3   0               A E J N
    1               B F K O
    2               C G L P
    4               D H M Q
4   0               A E J N
    1               B F K O
    2               C G L P
    4               D H M Q
> ## First plot:
> with(potatoes, interaction.plot(potash,nitrogen, response=yield))
> 
> ## ANOVAs:
> summary(aov(yield ~ nitrogen * potash + Error(pos), data = potatoes))

Error: pos
          Df Sum Sq Mean Sq F value Pr(>F)
Residuals  3  11303    3768               

Error: Within
                Df Sum Sq Mean Sq F value  Pr(>F)    
nitrogen         3 209646   69882   32.30 2.7e-11 ***
potash           3  32926   10975    5.07  0.0041 ** 
nitrogen:potash  9  18925    2103    0.97  0.4756    
Residuals       45  97361    2164                    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>     # "==>" can use simply
> summary(aov(yield ~ nitrogen + potash + pos, data = potatoes))
            Df Sum Sq Mean Sq F value Pr(>F)    
nitrogen     3 209646   69882   32.45  4e-12 ***
potash       3  32926   10975    5.10 0.0035 ** 
pos          3  11303    3768    1.75 0.1678    
Residuals   54 116286    2153                   
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
>     # and
> summary(aov(yield ~ nitrogen + potash, data = potatoes))
            Df Sum Sq Mean Sq F value  Pr(>F)    
nitrogen     3 209646   69882    31.2 4.5e-12 ***
potash       3  32926   10975     4.9  0.0042 ** 
Residuals   57 127589    2238                    
---
Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("potatoes", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("pretty10exp")
> ### * pretty10exp
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: pretty10exp
> ### Title: Nice 10 ** k Label Expressions
> ### Aliases: pretty10exp
> ### Keywords: dplot
> 
> ### ** Examples
> 
> pretty10exp(-1:3 * 1000)
expression(-1 %*% 10^3, 0, 1 %*% 10^3, 2 %*% 10^3, 3 %*% 10^3)
> pretty10exp(-1:3 * 1000, drop.1 = TRUE)
expression(-10^3, 0, 10^3, 2 %*% 10^3, 3 %*% 10^3)
> pretty10exp(c(1,2,5,10,20,50,100,200) * 1e3)
expression(1 %*% 10^3, 2 %*% 10^3, 5 %*% 10^3, 1 %*% 10^4, 2 %*% 
    10^4, 5 %*% 10^4, 1 %*% 10^5, 2 %*% 10^5)
> pretty10exp(c(1,2,5,10,20,50,100,200) * 1e3, drop.1 = TRUE)
expression(10^3, 2 %*% 10^3, 5 %*% 10^3, 10^4, 2 %*% 10^4, 5 %*% 
    10^4, 10^5, 2 %*% 10^5)
> 
> set.seed(17); lx <- rlnorm(10, m=8, s=6)
> pretty10exp(lx, digits = 3)
expression(6.75 %*% 10^0, 1.85 %*% 10^3, 7.37 %*% 10^2, 2.21 %*% 
    10^1, 3.06 %*% 10^5, 1.1 %*% 10^3, 1.02 %*% 10^6, 8.86 %*% 
    10^7, 1.38 %*% 10^4, 2.69 %*% 10^4)
> pretty10exp(lx, digits = 3, sub10 = 2)
expression(6.75, 1.85 %*% 10^3, 737, 22.1, 3.06 %*% 10^5, 1.1 %*% 
    10^3, 1.02 %*% 10^6, 8.86 %*% 10^7, 1.38 %*% 10^4, 2.69 %*% 
    10^4)
> 
> pretty10exp(lx, digits = 3, lab.type="latex")
 [1] "$6.75 \\cdot 10^{0}$" "$1.85 \\cdot 10^{3}$" "$7.37 \\cdot 10^{2}$"
 [4] "$2.21 \\cdot 10^{1}$" "$3.06 \\cdot 10^{5}$" "$1.1 \\cdot 10^{3}$" 
 [7] "$1.02 \\cdot 10^{6}$" "$8.86 \\cdot 10^{7}$" "$1.38 \\cdot 10^{4}$"
[10] "$2.69 \\cdot 10^{4}$"
> pretty10exp(lx, digits = 3, lab.type="latex", lab.sep="times", sub10=2)
 [1] "6.75"                  "$1.85 \\times 10^{3}$" "737"                  
 [4] "22.1"                  "$3.06 \\times 10^{5}$" "$1.1 \\times 10^{3}$" 
 [7] "$1.02 \\times 10^{6}$" "$8.86 \\times 10^{7}$" "$1.38 \\times 10^{4}$"
[10] "$2.69 \\times 10^{4}$"
> 
> ## use regular formatted numbers from 0.03 to 300 :
> pretty10exp(3*10^(-3:4), sub10 = c(-2,2))
expression(3 %*% 10^-3, 0.03, 0.3, 3, 30, 300, 3 %*% 10^3, 3 %*% 
    10^4)
> pretty10exp(3*10^(-3:4), sub10 = c(-2,2), lab.type = "l")
[1] "$3 \\cdot 10^{-3}$" "0.03"               "0.3"               
[4] "3"                  "30"                 "300"               
[7] "$3 \\cdot 10^{3}$"  "$3 \\cdot 10^{4}$" 
> 
> ## Don't show: 
> stopifnot(identical(pretty10exp(numeric(0)), expression()))
> ## End(Don't show)
> ax <- 10^(-6:0) - 2e-16
> pretty10exp(ax, drop.1=TRUE) # nice for plotting
expression(10^-6, 10^-5, 10^-4, 10^-3, 10^-2, 10^-1, 10^0)
> pretty10exp(ax, drop.1=TRUE, sub10=TRUE)
expression(10^-6, 10^-5, 10^-4, 10^-3, 10^-2, 10^-1, 1)
> pretty10exp(ax, drop.1=TRUE, sub10=c(-2,2))
expression(10^-6, 10^-5, 10^-4, 10^-3, 0.01, 0.1, 1)
> 
> ## in sfsmisc version <= 1.0-16, no 'digits',
> ## i.e., implicitly had  digits := #{double precision digits} ==
> (dig. <- .Machine$double.digits * log10(2)) # 15.95
[1] 16
> pretty10exp(ax, drop.1=TRUE, digits= dig.)  # ''ugly''
expression(9.999999998 %*% 10^-7, 9.9999999998 %*% 10^-6, 9.99999999998 %*% 
    10^-5, 9.999999999998 %*% 10^-4, 9.9999999999998 %*% 10^-3, 
    9.99999999999998 %*% 10^-2, 1 %*% 10^0)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("pretty10exp", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("primes")
> ### * primes
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: primes
> ### Title: Find all Primes Less Than n
> ### Aliases: primes
> ### Keywords: math arithmetic
> 
> ### ** Examples
> 
>  (p1 <- primes(100))
 [1]  2  3  5  7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97
>  system.time(p1k <- primes(1000)) # still lightning fast
   user  system elapsed 
  0.001   0.000   0.001 
>  stopifnot(length(p1k) == 168)
> 
> ## Exploring  p(n) := the n-th prime number  ~=~ n * pnn(n), where
> ## pnn(n) := log n + log log n
> pnn <- function(n) { L <- log(n); L + log(L) }
> n <- 6:(N <- length(PR <- primes(1e5)))
> m.pn <- cbind(l.pn = ceiling(n*(pnn(n)-1)), pn = PR[n], u.pn = floor(n*pnn(n)))
> matplot(n, m.pn, type="l", ylab = quote(p[n]), main = quote(p[n] ~~
+         "with lower/upper bounds" ~ n*(log(n) + log(log(n)) -(1~"or"~0))))
> ## (difference to the lower approximation) / n   --> ~ 0.0426  (?) :
> plot(n, PR[n]/n - (pnn(n)-1), type = 'l', cex = 1/8, log="x", xaxt="n")
> eaxis(1); abline(h=0, col=adjustcolor(1, 0.5))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("primes", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("printTable2")
> ### * printTable2
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: printTable2
> ### Title: Add and Print Marginals for 2-way Contingency Tables
> ### Aliases: printTable2 margin2table print.margin2table
> ### Keywords: utilities
> 
> ### ** Examples
> 
> margin2table(diag(4),,TRUE)
                | sum
     1  0  0  0 |   1
     0  1  0  0 |   1
     0  0  1  0 |   1
     0  0  0  1 |   1
--  -- -- -- -- |  --
sum  1  1  1  1 |   4
> m <- diag(3); colnames(m) <- letters[1:3]
> margin2table(m)
      a  b  c | sum
[1,]  1  0  0 |   1
[2,]  0  1  0 |   1
[3,]  0  0  1 |   1
[4,] -- -- -- |  --
[5,]  1  1  1 |   3
> margin2table(m / sum(m))
         a     b     c |   sum
[1,] 0.333 0.000 0.000 | 0.333
[2,] 0.000 0.333 0.000 | 0.333
[3,] 0.000 0.000 0.333 | 0.333
[4,]    --    --    -- |    --
[5,] 0.333 0.333 0.333 | 1.000
> 
> data(HairEyeColor)
> margin2table(HairEyeColor[,, "Male"])
       Eye
Hair    Brown Blue Hazel Green | sum
  Black    32   11    10     3 |  56
  Brown    53   50    25    15 | 143
  Red      10   10     7     7 |  34
  Blond     3   30     5     8 |  46
  --       --   --    --    -- |  --
  sum      98  101    47    33 | 279
> printTable2(HairEyeColor[,, "Male"])

Kontingenz-Tafel mit Randsummen:
       Eye
Hair    Brown Blue Hazel Green | sum
  Black    32   11    10     3 |  56
  Brown    53   50    25    15 | 143
  Red      10   10     7     7 |  34
  Blond     3   30     5     8 |  46
  --       --   --    --    -- |  --
  sum      98  101    47    33 | 279

Gemeinsame Verteilung mit Randverteilungen:
       Eye
Hair    Brown  Blue Hazel Green |   sum
  Black 0.115 0.039 0.036 0.011 | 0.201
  Brown 0.190 0.179 0.090 0.054 | 0.513
  Red   0.036 0.036 0.025 0.025 | 0.122
  Blond 0.011 0.108 0.018 0.029 | 0.165
  --       --    --    --    -- |    --
  sum   0.351 0.362 0.168 0.118 | 1.000
Bedingte Verteilung gegen y:
       Eye
Hair    Brown  Blue Hazel Green
  Black 0.571 0.196 0.179 0.054
  Brown 0.371 0.350 0.175 0.105
  Red   0.294 0.294 0.206 0.206
  Blond 0.065 0.652 0.109 0.174

Bedingte Verteilung gegen x:
       Eye
Hair    Brown  Blue Hazel Green
  Black 0.327 0.109 0.213 0.091
  Brown 0.541 0.495 0.532 0.455
  Red   0.102 0.099 0.149 0.212
  Blond 0.031 0.297 0.106 0.242

Freiheitsgrade: df = 9 
Chi^2 - Annahmebereich: [0,16.9] (alpha=0.05)


Testwerte unter der Unabhaengigkeitshypothese:
  Test mit Chi^2: 41.3 (P-Wert: 0)
  Test mit Devianz:  44.4 (P-Wert: 0)

> printTable2(HairEyeColor[,, "Female"])

Kontingenz-Tafel mit Randsummen:
       Eye
Hair    Brown Blue Hazel Green | sum
  Black    36    9     5     2 |  52
  Brown    66   34    29    14 | 143
  Red      16    7     7     7 |  37
  Blond     4   64     5     8 |  81
  --       --   --    --    -- |  --
  sum     122  114    46    31 | 313

Gemeinsame Verteilung mit Randverteilungen:
       Eye
Hair    Brown  Blue Hazel Green |   sum
  Black 0.115 0.029 0.016 0.006 | 0.166
  Brown 0.211 0.109 0.093 0.045 | 0.457
  Red   0.051 0.022 0.022 0.022 | 0.118
  Blond 0.013 0.204 0.016 0.026 | 0.259
  --       --    --    --    -- |    --
  sum   0.390 0.364 0.147 0.099 | 1.000
Bedingte Verteilung gegen y:
       Eye
Hair    Brown  Blue Hazel Green
  Black 0.692 0.173 0.096 0.038
  Brown 0.462 0.238 0.203 0.098
  Red   0.432 0.189 0.189 0.189
  Blond 0.049 0.790 0.062 0.099

Bedingte Verteilung gegen x:
       Eye
Hair    Brown  Blue Hazel Green
  Black 0.295 0.079 0.109 0.065
  Brown 0.541 0.298 0.630 0.452
  Red   0.131 0.061 0.152 0.226
  Blond 0.033 0.561 0.109 0.258

Freiheitsgrade: df = 9 
Chi^2 - Annahmebereich: [0,16.9] (alpha=0.05)


Testwerte unter der Unabhaengigkeitshypothese:
  Test mit Chi^2: 107 (P-Wert: 0)
  Test mit Devianz:  112 (P-Wert: 0)

> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("printTable2", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("ps.end")
> ### * ps.end
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ps.end
> ### Title: Close PostScript or Acrobat Graphics Device opened by 'ps.do' /
> ###   'pdf.do'
> ### Aliases: ps.end pdf.end
> ### Keywords: device
> 
> ### ** Examples
> 
> if(interactive() ## Don't show: 
+  || Sys.getenv("USER") == "maechler" 
+ ## End(Don't show)
+   ) {
+     myPS <- tempfile("ex", fileext = ".ps")
+     ps.do(myPS)
+     data(sunspots)
+     plot(sunspots)
+     ps.end()
+ 
+     tempfile("ex-sun", fileext = ".pdf") -> myPDF
+     pdf.latex(myPDF)
+     plot(sunspots)
+     pdf.end(call. = FALSE) # basically the same as dev.off()
+   }
>   ps.latex(tempfile("ex2", fileext = ".eps"))
>   plot(sunspots)
>   ps.end(call.gv = FALSE) # basically the same as dev.off()
sh: 1: gv: not found
Warning in system(paste(cmd, "> /dev/null")) : error in running command
sh: 1: ggv: not found
Warning in system(paste(cmd, "> /dev/null")) : error in running command
sh: 1: evince: not found
Warning in system(paste(cmd, "> /dev/null")) : error in running command
sh: 1: kghostview: not found
Warning in system(paste(cmd, "> /dev/null")) : error in running command
Warning in .set.eps_view() :
  no valid postscript previewer found; consider setting
  options("eps_view"=  "....")	    yourself

 >> switch to replace_with_postscript_previewer (postscript viewer) window -- updated automagically!

> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("ps.end", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("ps.latex")
> ### * ps.latex
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: ps.latex
> ### Title: PostScript/PDF Preview Device with Optional 'LaTeX' Touch
> ### Aliases: pdf.do pdf.latex ps.do ps.latex
> ### Keywords: device
> 
> ### ** Examples
> 
> if(interactive()) {
+ 
+  ps.latex("ps.latex-ex.ps", main= TRUE)
+   data(sunspots)
+   plot(sunspots,main=paste("Sunspots Data, n=",length(sunspots)),col="red")
+  ps.end()
+ 
+  pdf.latex("pdf.latex-ex.pdf", main= TRUE)
+   data(sunspots)
+   plot(sunspots,main=paste("Sunspots Data, n=",length(sunspots)),col="red")
+  pdf.end()
+ 
+  ps.do("ps_do_ex.ps")
+    example(plot.function)
+  ps.end()
+ 
+  pdf.do("pdf_do_ex.pdf", width=12, height=5)
+    plot(sunspots, main="Monthly Sunspot numbers (in Zurich, then Tokyo)")
+  pdf.end()
+ }
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("ps.latex", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("quadrant")
> ### * quadrant
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: quadrant
> ### Title: Give the Quadrant Number of Planar Points
> ### Aliases: quadrant
> ### Keywords: utilities
> 
> ### ** Examples
> 
> xy <- as.matrix(expand.grid(x= -7:7, y= -7:7)); rownames(xy) <- NULL
> (qu <- quadrant(xy))
  [1] 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 3 3 3 3 3 3 3
 [38] 4 4 4 4 4 4 4 4 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 3 3 3 3 3 3 3 4 4 4 4 4 4 4
 [75] 4 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 3 3 3 3 3 3 3 4 4 4 4 4 4 4 4 2 2 2 2 2 2
[112] 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 1 1 1 1 1 1
[149] 1 1 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2
[186] 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 1 1 1 1 1
[223] 1 1 1
> plot(xy, col = qu+1, main = "quadrant() number", axes = FALSE)
> abline(h=0, v=0, col="gray") # the x- and y- axis
> text(xy, lab = qu, col = qu+1, adj = c(1.4,0))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("quadrant", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("read.org.table")
> ### * read.org.table
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: read.org.table
> ### Title: Read.table for an Emacs Org Table
> ### Aliases: read.org.table
> ### Keywords: file utilities
> 
> ### ** Examples
> 
> t1 <-
+ "
+ | a | var2 |   C |
+ |---+------+-----|
+ | 2 | may  | 3.4 |
+ | 7 | feb  | 4.7 |
+ "
> d <- read.org.table(text = t1)
> d
  a   var2   C
1 2  may   3.4
2 7  feb   4.7
> stopifnot(dim(d) == c(2, 3),
+           identical(names(d), c("a", "var2", "C")),
+           d[,"a"] == c(2,7))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("read.org.table", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("relErr")
> ### * relErr
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: relErr
> ### Title: Relative Error When Appropriate, Absolute Otherwise
> ### Aliases: relErrV relErr
> ### Keywords: arith utilities
> 
> ### ** Examples
> 
> ## relErrV() test example: showing how it works fine with {NA, Inf, 0} :
> eps <- 1e-4*c(-9, -8, -6, -4, 0.5, 1, 5)
> target  <- c(-1:1, 0,   0, NA, NaN, Inf, -Inf, Inf, 0 , Inf, 1 , -3:3)
> current <- c(-1:1,1e-7,NaN,NA,  0 , Inf,  Inf,  0, Inf,  1, Inf, -3:3+ eps)
> cbind(target, current, absE = current-target, relE = relErrV(target,current))
      target current   absE      relE
 [1,]     -1  -1e+00  0e+00  0.00e+00
 [2,]      0   0e+00  0e+00  0.00e+00
 [3,]      1   1e+00  0e+00  0.00e+00
 [4,]      0   1e-07  1e-07  1.00e-07
 [5,]      0     NaN    NaN       NaN
 [6,]     NA      NA     NA        NA
 [7,]    NaN   0e+00    NaN       NaN
 [8,]    Inf     Inf    NaN  0.00e+00
 [9,]   -Inf     Inf    Inf       Inf
[10,]    Inf   0e+00   -Inf      -Inf
[11,]      0     Inf    Inf       Inf
[12,]    Inf   1e+00   -Inf      -Inf
[13,]      1     Inf    Inf       Inf
[14,]     -3  -3e+00 -9e-04  3.00e-04
[15,]     -2  -2e+00 -8e-04  4.00e-04
[16,]     -1  -1e+00 -6e-04  6.00e-04
[17,]      0  -4e-04 -4e-04 -4.00e-04
[18,]      1   1e+00  5e-05  5.00e-05
[19,]      2   2e+00  1e-04  5.00e-05
[20,]      3   3e+00  5e-04  1.67e-04
> 
> ## relErr() is pretty simple --- (possibly too simple, currently)
> relErr
function (target, current) 
{
    n <- length(current)
    if (length(target) < n) 
        target <- rep(target, length.out = n)
    sum(abs(target - current))/sum(abs(target))
}
<bytecode: 0x55b4a2bc2a90>
<environment: namespace:sfsmisc>
> relErr(target, current) # NA (of course)
[1] NA
> all.equal.numeric(target, current) ## "'is.NA' value mismatch ..."
[1] "'is.NA' value mismatch: 2 in current 2 in target"
> 
> ## comparison after dropping NA's :
> hasN <- is.na(target) | is.na(current)
> all.equal(target[!hasN], current[!hasN], tolerance=0) # "Mean abs. diff.: Inf"
[1] "Mean absolute difference: Inf"
>    relErr(target[!hasN], current[!hasN]) # NaN  (to improve?)
[1] NaN
> 
> ## comparison after only keeping cases where both are finite:
> finN <- is.finite(target) & is.finite(current)
> all.equal(target[finN], current[finN], tol=0)          # "Mean abs.d.: 0.000279.."
[1] "Mean relative difference: 0.000279"
> all.equal(target[finN], current[finN], tol=0, countEQ=TRUE) #   "  " : 0.000239..
[1] "Mean relative difference: 0.000239"
>    relErr(target[finN], current[finN]) # 0.0002392929
[1] 0.000239
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("relErr", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("repChar")
> ### * repChar
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: repChar
> ### Title: Make Simple String from Repeating a Character, e.g. Blank String
> ### Aliases: repChar bl.string
> ### Keywords: character
> 
> ### ** Examples
> 
> r <- sapply(0:8, function(n) ccat(repChar(" ",n), n))
> cbind(r)
      r          
 [1,] "0"        
 [2,] " 1"       
 [3,] "  2"      
 [4,] "   3"     
 [5,] "    4"    
 [6,] "     5"   
 [7,] "      6"  
 [8,] "       7" 
 [9,] "        8"
> 
> repChar("-", 4)
[1] "----"
> repChar("_", 6)
[1] "______"
> ## it may make sense to a string of more than one character:
> repChar("-=- ", 6)
[1] "-=- -=- -=- -=- -=- -=- "
> 
> ## show the very simple function definitions:
> repChar
function (char, no) 
paste(rep.int(char, no), collapse = "")
<bytecode: 0x55b4a2b88380>
<environment: namespace:sfsmisc>
> bl.string
function (no) 
sprintf("%*s", no, "")
<bytecode: 0x55b4a2ae83d8>
<environment: namespace:sfsmisc>
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("repChar", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("rot13")
> ### * rot13
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: rotn
> ### Title: Generalized Rot13 Character Translation (Rotation)
> ### Aliases: rotn
> ### Keywords: manip
> 
> ### ** Examples
> 
> rotn(c("ABC", "a","b","c"), 1)
[1] "BCD" "b"   "c"   "d"  
> rotn(c("ABC", "a","b","c"), 2)
[1] "CDE" "c"   "d"   "e"  
> rotn(c("ABC", "a","b","c"), 26) # rotation by 26 does not change much
[1] "ABC" "a"   "b"   "c"  
> 
> (ch <- paste("Hello", c("World!", "you too")))
[1] "Hello World!"  "Hello you too"
> rotn(ch)
[1] "Uryyb Jbeyq!"  "Uryyb lbh gbb"
> rotn( rotn(ch ) ) # rotn(*, 13) is its own inverse
[1] "Hello World!"  "Hello you too"
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("rot13", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("rot2")
> ### * rot2
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Encoding: UTF-8
> 
> ### Name: rot2
> ### Title: Rotate Planar Points by Angle
> ### Aliases: rot2
> ### Keywords: manip math
> 
> ### ** Examples
> 
> ## Rotate three points by 60 degrees :
> (xy0 <- rbind(c(1,0.5), c(1,1), c(0,1)))
     [,1] [,2]
[1,]    1  0.5
[2,]    1  1.0
[3,]    0  1.0
> (Txy <- rot2(xy0, phi = 60 * pi/180))
       [,1] [,2]
[1,]  0.067 1.12
[2,] -0.366 1.37
[3,] -0.866 0.50
> plot(xy0, col = 2, type = "b", asp = 1,
+      xlim=c(-1,1), ylim=c(0,1.5), main = "rot2(*, pi/3) : 2d rotation by 60°")
> points(Txy, col = 3, type = "b")
> O <- rep(0,2); P2 <- rbind(xy0[2,], Txy[2,])
> arrows(O,O,P2[,1],P2[,2], col = "dark gray")
> 
> xy0 <- .8*rbind(c(1,0), c(.5,.6), c(.7,1), c(1,1), c(.9,.8), c(1,0)) - 0.2
> plot(xy0, col= 2, type="b", main= "rot2( <polygon>, pi/4 * 1:7)", asp=1,
+      xlim=c(-1,1),ylim=c(-1,1), lwd= 2, axes = FALSE, xlab="", ylab="")
> abline(h=0, v=0, col="thistle"); text(1.05, -.05, "x"); text(-.05,1.05, "y")
> for(phi in pi/4 * 0:7)
+    do.call("arrows",c(list(0,0),rot2(xy0[2,], phi), length=0.1, col="gray40"))
> for(phi in pi/4 * 1:7)
+    polygon(rot2(xy0, phi = phi), col = 1+phi/(pi/4), border=2, type = "b")
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
Warning in polygon(rot2(xy0, phi = phi), col = 1 + phi/(pi/4), border = 2,  :
  graphical parameter "type" is obsolete
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("rot2", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("roundfixS")
> ### * roundfixS
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: roundfixS
> ### Title: Round to Integer Keeping the Sum Fixed
> ### Aliases: roundfixS
> ### Keywords: arith manip
> 
> ### ** Examples
> 
> ## trivial example
> kk <- c(0,1,7)
> stopifnot(identical(kk, roundfixS(kk))) # failed at some point
> 
> x <- c(-1.4, -1, 0.244, 0.493, 1.222, 1.222, 2, 2, 2.2, 2.444, 3.625, 3.95)
> sum(x) # an integer
[1] 17
> r <- roundfixS(x)
> stopifnot(all.equal(sum(r), sum(x)))
> m <- cbind(x=x, `r2i(x)` = r, resid = x - r, `|res|` = abs(x-r))
> rbind(m, c(colSums(m[,1:2]), 0, sum(abs(m[,"|res|"]))))
           x r2i(x)  resid |res|
 [1,] -1.400     -1 -0.400 0.400
 [2,] -1.000     -1  0.000 0.000
 [3,]  0.244      0  0.244 0.244
 [4,]  0.493      1 -0.507 0.507
 [5,]  1.222      1  0.222 0.222
 [6,]  1.222      1  0.222 0.222
 [7,]  2.000      2  0.000 0.000
 [8,]  2.000      2  0.000 0.000
 [9,]  2.200      2  0.200 0.200
[10,]  2.444      2  0.444 0.444
[11,]  3.625      4 -0.375 0.375
[12,]  3.950      4 -0.050 0.050
[13,] 17.000     17  0.000 2.664
> 
> chk <- function(y) {
+   cat("sum(y) =", format(S <- sum(y)),"\n")
+   r2  <- roundfixS(y, method="offset")
+   r2. <- roundfixS(y, method="round")
+   r2_ <- roundfixS(y, method="1g")
+   stopifnot(all.equal(sum(r2 ), S),
+             all.equal(sum(r2.), S),
+             all.equal(sum(r2_), S))
+   all(r2 == r2. & r2. == r2_) # TRUE if all give the same result
+ }
> 
> makeIntSum <- function(y) {
+    n <- length(y)
+    y[n] <- ceiling(y[n]) - (sum(y[-n]) %% 1)
+    y
+ }
> set.seed(11)
> y <- makeIntSum(rnorm(100))
> chk(y)
sum(y) = -12 
[1] TRUE
> 
> ## nastier example:
> set.seed(7)
> y <- makeIntSum(rpois(100, 10) + c(runif(75, min= 0, max=.2),
+                                    runif(25, min=.5, max=.9)))
> chk(y)
sum(y) = 1128 
[1] TRUE
> 
> ## Not run: 
> ##D for(i in 1:1000)
> ##D     stopifnot(chk(makeIntSum(rpois(100, 10) +
> ##D                              c(runif(75, min= 0, max=.2),
> ##D                                runif(25, min=.5, max=.9)))))
> ## End(Not run)
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("roundfixS", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("rrange")
> ### * rrange
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: rrange
> ### Title: Robust Range using Boxplot 'Quartiles'
> ### Aliases: rrange
> ### Keywords: univar robust
> 
> ### ** Examples
> 
> stopifnot(rrange(c(1:10,1000)) == c(1,10))
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("rrange", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("seqXtend")
> ### * seqXtend
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: seqXtend
> ### Title: Sequence Covering the Range of X, including X
> ### Aliases: seqXtend
> ### Keywords: manip utilities
> 
> ### ** Examples
> 
> a <- c(1,2,10,12)
> seqXtend(a, 12)# --> simply 1:12
 [1]  1  2  3  4  5  6  7  8  9 10 11 12
> seqXtend(a, 12, "interp")# ditto
 [1]  1  2  3  4  5  6  7  8  9 10 11 12
> seqXtend(a, 12, "aim")# really worse
 [1]  1.00  2.00  2.22  3.44  4.67  5.89  7.11  8.33  9.56 10.00 10.78 12.00
> stopifnot(all.equal(seqXtend(a, 12, "interp"), 1:12))
> 
> ## for a "general" x, however, "aim" aims better than default
> x <- c(1.2, 2.4, 4.6, 9.9)
> length(print(seqXtend(x, 12)))        # 14
 [1] 1.20 1.99 2.40 2.78 3.57 4.36 4.60 5.15 5.95 6.74 7.53 8.32 9.11 9.90
[1] 14
> length(print(seqXtend(x, 12, "aim"))) # 12
 [1] 1.20 2.17 2.40 3.13 4.10 4.60 5.07 6.03 7.00 7.97 8.93 9.90
[1] 12
> length(print(seqXtend(x, 12, "int"))) # 12
 [1] 1.20 2.40 3.13 3.87 4.60 5.36 6.11 6.87 7.63 8.39 9.14 9.90
[1] 12
> 
> ## "interpolate" is really nice:
> xt <- seqXtend(x, 100, "interp")
> plot(xt, main="seqXtend(*, 100, \"interpol\")")
> points(match(x,xt), x, col = 2, pch = 20)
> # .... you don't even see that it's not equidistant
> # whereas the cheap method shows ...
> xt2 <- seqXtend(x, 100)
> plot(xt2, col="blue")
> points(match(x,xt2), x, col = 2, pch = 20)
> 
> ## with "Date" objects
> Drng <- as.Date(c("2007-11-10", "2012-07-12"))
> (px <- pretty(Drng, n = 16)) # say, for the main labels
 [1] "2007-10-01" "2008-01-01" "2008-04-01" "2008-07-01" "2008-10-01"
 [6] "2009-01-01" "2009-04-01" "2009-07-01" "2009-10-01" "2010-01-01"
[11] "2010-04-01" "2010-07-01" "2010-10-01" "2011-01-01" "2011-04-01"
[16] "2011-07-01" "2011-10-01" "2012-01-01" "2012-04-01" "2012-07-01"
[21] "2012-10-01"
> ## say, a finer grid, for ticks -- should be almost equidistant
> n3 <- 3*length(px)
> summary(as.numeric(diff(seqXtend(px, n3))))        # wildly varying
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    0.5    16.0    29.5    22.6    29.5    29.5 
> summary(as.numeric(diff(seqXtend(px, n3, "aim")))) #   (ditto)
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
    1.7    17.1    33.8    29.5    42.5    42.5 
> summary(as.numeric(diff(seqXtend(px, n3, "int")))) # around 30
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
   23.0    30.0    30.3    29.5    30.7    30.7 
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("seqXtend", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("sessionInfoX")
> ### * sessionInfoX
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: sessionInfoX
> ### Title: Extended Information About the Current R Session
> ### Aliases: isRshared sessionInfoX print.sessionInfoX
> ### Keywords: misc
> 
> ### ** Examples
> 
> six0 <- sessionInfoX()
> six0$shared # useful (for some, e.g., MM) on Unix alikes
NULL
> 
> sixN <- sessionInfoX("nlme", list.libP = TRUE)
> sixN # -> print() method for "sessionInfoX"
Extended  sessionInfo():
-----------------------
specific  packageDescription()s:
$nlme
Package: nlme
Version: 3.1-152
Date: 2021-02-03
Priority: recommended
Title: Linear and Nonlinear Mixed Effects Models
Authors@R: c(person("José", "Pinheiro", role = "aut", comment = "S
        version"), person("Douglas", "Bates", role = "aut", comment =
        "up to 2007"), person("Saikat", "DebRoy", role = "ctb", comment
        = "up to 2002"), person("Deepayan", "Sarkar", role = "ctb",
        comment = "up to 2005"), person("EISPACK authors", role =
        "ctb", comment = "src/rs.f"), person("Siem", "Heisterkamp",
        role = "ctb", comment = "Author fixed sigma"), person("Bert",
        "Van Willigen",role = "ctb", comment = "Programmer fixed
        sigma"), person("Johannes", "Ranke", role = "ctb", comment =
        "varConstProp()"), person("R-core", email =
        "R-core@R-project.org", role = c("aut", "cre")))
Contact: see 'MailingList'
Description: Fit and compare Gaussian linear and nonlinear
        mixed-effects models.
Depends: R (>= 3.4.0)
Imports: graphics, stats, utils, lattice
Suggests: Hmisc, MASS
LazyData: yes
ByteCompile: yes
Encoding: UTF-8
License: GPL (>= 2) | file LICENCE
BugReports: https://bugs.r-project.org
MailingList: R-help@r-project.org
URL: https://svn.r-project.org/R-packages/trunk/nlme/
NeedsCompilation: yes
Packaged: 2021-02-03 21:06:11 UTC; ripley
Author: José Pinheiro [aut] (S version), Douglas Bates [aut] (up to
        2007), Saikat DebRoy [ctb] (up to 2002), Deepayan Sarkar [ctb]
        (up to 2005), EISPACK authors [ctb] (src/rs.f), Siem
        Heisterkamp [ctb] (Author fixed sigma), Bert Van Willigen [ctb]
        (Programmer fixed sigma), Johannes Ranke [ctb]
        (varConstProp()), R-core [aut, cre]
Maintainer: R-core <R-core@R-project.org>
Repository: CRAN
Date/Publication: 2021-02-04 07:01:07 UTC
Built: R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 08:28:09 UTC; unix

-- File: /tmp/RtmpENLnnw/RLIBS_77eb3399210f/nlme/Meta/package.rds 

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Capabilities:
       jpeg         png        tiff       tcltk         X11        aqua 
          X           X           X           X           X           - 
   http/ftp     sockets      libxml        fifo      cledit       iconv 
          X           X           X           X           -           X 
        NLS       Rprof     profmem       cairo         ICU long.double 
          X           X           -           X           X           X 
    libcurl 
          X 
Sys.info:
nodename                gimli
user                    hornik

LAPACK version: 3.9.0 
External software (versions):
zlib                    1.2.11
bzlib                   1.0.8, 13-Jul-2019
xz                      5.2.5
PCRE                    10.36 2020-12-04
ICU                     67.1
TRE                     TRE 0.8.0 R_fixes (BSD)
iconv                   glibc 2.31
readline                8.1
BLAS                    /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRblas.so
Graphical software (versions):
cairo                   1.16.0
cairoFT                 
pango                   1.46.2
libpng                  1.6.37
jpeg                    6.2
libtiff                 LIBTIFF, Version 4.2.0

PCRE (regex) config.: ("UTF-8" = TRUE, "Unicode properties" = TRUE, JIT = TRUE, stack = FALSE) 
R executable linked against libR.* ['is R shared']: TRUE 

R_LIBS:
libPath contains not more than RLIBS and .Library (normalized)
Main R env. variables (for more, inspect the 'xR.env' component):
                [,1]
R_ENVIRON       ""  
R_PROFILE       ""  
R_CHECK_ENVIRON ""  
---------------- standard sessionInfo():
R version 4.1.1 RC (2021-08-03 r80712)
Platform: x86_64-pc-linux-gnu (64-bit)
Running under: Debian GNU/Linux 11 (bullseye)

Matrix products: default
BLAS:   /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRblas.so
LAPACK: /home/hornik/tmp/R.check/r-patched-gcc/Work/build/lib/libRlapack.so

locale:
 [1] LC_CTYPE=en_US.UTF-8       LC_NUMERIC=C              
 [3] LC_TIME=en_US.UTF-8        LC_COLLATE=C              
 [5] LC_MONETARY=en_US.UTF-8    LC_MESSAGES=en_US.UTF-8   
 [7] LC_PAPER=en_US.UTF-8       LC_NAME=C                 
 [9] LC_ADDRESS=C               LC_TELEPHONE=C            
[11] LC_MEASUREMENT=en_US.UTF-8 LC_IDENTIFICATION=C       

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

other attached packages:
[1] sfsmisc_1.1-11

loaded via a namespace (and not attached):
 [1] MASS_7.3-54     compiler_4.1.1  Matrix_1.3-4    parallel_4.1.1 
 [5] tools_4.1.1     lokern_1.1-9    splines_4.1.1   grid_4.1.1     
 [9] cluster_2.1.2   lattice_0.20-44
> names(sixN)
 [1] "sInfo"        "sysInf"       "capabilities" "extSoft"      "grSoft"      
 [6] "tclVersion"   "LAPACK"       "pcre"         "isRshared"    "pkgDescr"    
[11] "libPath"      ".Library"     "RLIBS"        "n.RLIBS"      "list.libP"   
[16] "R.env"        "xR.env"      
> str(sixN, max = 1)# outline of lower-level structure
List of 17
 $ sInfo       :List of 13
  ..- attr(*, "class")= chr "sessionInfo"
 $ sysInf      : Named chr [1:8] "Linux" "4.18.0-3-amd64" "#1 SMP Debian 4.18.20-2 (2018-11-23)" "gimli" ...
  ..- attr(*, "names")= chr [1:8] "sysname" "release" "version" "nodename" ...
 $ capabilities: Named logi [1:19] TRUE TRUE TRUE TRUE TRUE FALSE ...
  ..- attr(*, "names")= chr [1:19] "jpeg" "png" "tiff" "tcltk" ...
 $ extSoft     : Named chr [1:9] "1.2.11" "1.0.8, 13-Jul-2019" "5.2.5" "10.36 2020-12-04" ...
  ..- attr(*, "names")= chr [1:9] "zlib" "bzlib" "xz" "PCRE" ...
 $ grSoft      : Named chr [1:6] "1.16.0" "" "1.46.2" "1.6.37" ...
  ..- attr(*, "names")= chr [1:6] "cairo" "cairoFT" "pango" "libpng" ...
 $ tclVersion  : NULL
 $ LAPACK      : chr "3.9.0"
 $ pcre        : Named logi [1:4] TRUE TRUE TRUE FALSE
  ..- attr(*, "names")= chr [1:4] "UTF-8" "Unicode properties" "JIT" "stack"
 $ isRshared   : logi TRUE
 $ pkgDescr    :List of 1
 $ libPath     : chr [1:2] "/tmp/RtmpENLnnw/RLIBS_77eb3399210f" "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library"
 $ .Library    : chr "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/library"
 $ RLIBS       : chr "/tmp/RtmpENLnnw/RLIBS_77eb3399210f"
 $ n.RLIBS     : chr "/tmp/RtmpENLnnw/RLIBS_77eb3399210f"
 $ list.libP   :List of 2
 $ R.env       : Named chr [1:3] "" "" ""
  ..- attr(*, "names")= chr [1:3] "R_ENVIRON" "R_PROFILE" "R_CHECK_ENVIRON"
 $ xR.env      : 'Dlist' Named chr [1:106] "" "false" "/bin/bzip2" "/home/hornik/tmp/R.check/r-patched-gcc/Work/build/bin/Rcmd" ...
  ..- attr(*, "names")= chr [1:106] "R_ARCH" "R_BROWSER" "R_BZIPCMD" "R_CMD" ...
 - attr(*, "class")= chr "sessionInfoX"
> str(sixN$pkgDescr) # list with one component "nlme"
List of 1
 $ nlme:List of 25
  ..$ Package         : chr "nlme"
  ..$ Version         : chr "3.1-152"
  ..$ Date            : chr "2021-02-03"
  ..$ Priority        : chr "recommended"
  ..$ Title           : chr "Linear and Nonlinear Mixed Effects Models"
  ..$ Authors@R       : chr "c(person(\"José\", \"Pinheiro\", role = \"aut\", comment = \"S version\"),\n             person(\"Douglas\", \""| __truncated__
  ..$ Contact         : chr "see 'MailingList'"
  ..$ Description     : chr "Fit and compare Gaussian linear and nonlinear mixed-effects models."
  ..$ Depends         : chr "R (>= 3.4.0)"
  ..$ Imports         : chr "graphics, stats, utils, lattice"
  ..$ Suggests        : chr "Hmisc, MASS"
  ..$ LazyData        : chr "yes"
  ..$ ByteCompile     : chr "yes"
  ..$ Encoding        : chr "UTF-8"
  ..$ License         : chr "GPL (>= 2) | file LICENCE"
  ..$ BugReports      : chr "https://bugs.r-project.org"
  ..$ MailingList     : chr "R-help@r-project.org"
  ..$ URL             : chr "https://svn.r-project.org/R-packages/trunk/nlme/"
  ..$ NeedsCompilation: chr "yes"
  ..$ Packaged        : chr "2021-02-03 21:06:11 UTC; ripley"
  ..$ Author          : chr "José Pinheiro [aut] (S version),\n  Douglas Bates [aut] (up to 2007),\n  Saikat DebRoy [ctb] (up to 2002),\n  D"| __truncated__
  ..$ Maintainer      : chr "R-core <R-core@R-project.org>"
  ..$ Repository      : chr "CRAN"
  ..$ Date/Publication: chr "2021-02-04 07:01:07 UTC"
  ..$ Built           : chr "R 4.1.1; x86_64-pc-linux-gnu; 2021-08-05 08:28:09 UTC; unix"
  ..- attr(*, "class")= chr "packageDescription"
  ..- attr(*, "file")= chr "/tmp/RtmpENLnnw/RLIBS_77eb3399210f/nlme/Meta/package.rds"
> 
> 
> 
> base::assign(".dptime", (proc.time() - get(".ptime", pos = "CheckExEnv")), pos = "CheckExEnv")
> base::cat("sessionInfoX", base::get(".format_ptime", pos = 'CheckExEnv')(get(".dptime", pos = "CheckExEnv")), "\n", file=base::get(".ExTimings", pos = 'CheckExEnv'), append=TRUE, sep="\t")
> cleanEx()
> nameEx("shortRversion")
> ### * shortRversion
> 
> flush(stderr()); flush(stdout())
> 
> base::assign(".ptime", proc.time(), pos = "CheckExEnv")
> ### Name: shortRversion
> ### Title: Short R Version String
> ### Aliases: shortRversion
> ### Keywords: utilities
> 
> ### ** Examples
> 
> shortRversion() ## (including the date, typically for an R Core developer)
Error in shortRversion() : invalid R.version $ status: ‘RC’
Execution halted