[r-cran-sfsmisc] 01/02: New upstream version 1.1-1
Andreas Tille
tille at debian.org
Mon Oct 23 09:51:06 UTC 2017
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-sfsmisc.
commit 907254cefc0c359b45de1145b91910d04cf52187
Author: Andreas Tille <tille at debian.org>
Date: Mon Oct 23 11:50:41 2017 +0200
New upstream version 1.1-1
---
DESCRIPTION | 19 +
MD5 | 154 +++++++
NAMESPACE | 176 +++++++
R/D1D2.R | 118 +++++
R/Defunct.R | 46 ++
R/Deprecated.R | 30 ++
R/Duplicated.R | 22 +
R/Ftest-rlm.R | 50 ++
R/KS-confint.R | 56 +++
R/TA.plot.R | 124 +++++
R/diagDA.R | 207 +++++++++
R/ellipse.R | 30 ++
R/glob2rx.R | 16 +
R/hatMat.R | 25 +
R/huber.R | 2 +
R/integratexy.R | 74 +++
R/linesHyberb.lm.R | 28 ++
R/loessDemo.R | 134 ++++++
R/mat2tex.R | 60 +++
R/misc-goodies.R | 1037 ++++++++++++++++++++++++++++++++++++++++++
R/missingCh.R | 5 +
R/mult.fig.R | 42 ++
R/nearcor.R | 87 ++++
R/p.goodies.R | 236 ++++++++++
R/p.res.2x.WSt.R | 194 ++++++++
R/p.res.2x.formula.R | 54 +++
R/p.tachoPlot.R | 98 ++++
R/p.ts.R | 97 ++++
R/pd-matrix.R | 40 ++
R/plotCI.R | 0
R/prettylab.R | 228 ++++++++++
R/prime-numbers-fn.R | 395 ++++++++++++++++
R/printTable.R | 72 +++
R/ps.goodies.R | 268 +++++++++++
R/rot13.R | 10 +
R/rrange.R | 14 +
R/sessionInfo-ext.R | 72 +++
R/sourceAttach.R | 14 +
R/str_data.R | 66 +++
R/tkdensity.R | 164 +++++++
R/twoway-r-plot.R | 116 +++++
R/u.goodies.R | 86 ++++
R/unix/Sys.ps.R | 192 ++++++++
R/zzz.R | 41 ++
README.md | 15 +
TODO | 36 ++
data/potatoes.rda | Bin 0 -> 661 bytes
demo/00Index | 3 +
demo/hatmat-ex.R | 120 +++++
demo/pretty-lab.R | 35 ++
demo/prime-numbers.R | 157 +++++++
inst/ChangeLog | 1019 +++++++++++++++++++++++++++++++++++++++++
inst/NEWS.Rd | 451 ++++++++++++++++++
man/AsciiToInt.Rd | 91 ++++
man/D1D2.Rd | 82 ++++
man/D2ss.Rd | 104 +++++
man/Deprecated.Rd | 33 ++
man/Duplicated.Rd | 48 ++
man/KSd.Rd | 43 ++
man/QUnif.Rd | 88 ++++
man/TA.plot.Rd | 97 ++++
man/axTexpr.Rd | 67 +++
man/cairoSwd.Rd | 37 ++
man/capture-n-write.Rd | 50 ++
man/col01scale.Rd | 31 ++
man/compresid2way.Rd | 84 ++++
man/cum.Vert.funkt.Rd | 42 ++
man/diagDA.Rd | 105 +++++
man/diagX.Rd | 26 ++
man/digitsBase.Rd | 102 +++++
man/eaxis.Rd | 158 +++++++
man/ecdf.ksCI.Rd | 34 ++
man/ellipsePoints.Rd | 71 +++
man/empty.dimnames.Rd | 26 ++
man/errbar.Rd | 36 ++
man/f.robftest.Rd | 46 ++
man/factorize.Rd | 48 ++
man/hatMat.Rd | 73 +++
man/histBxp.Rd | 105 +++++
man/integrate.xy.Rd | 44 ++
man/inv.seq.Rd | 38 ++
man/is.whole.Rd | 49 ++
man/iterate.lin.recursion.Rd | 44 ++
man/last.Rd | 45 ++
man/linesHyberb.lm.Rd | 39 ++
man/loessDemo.Rd | 94 ++++
man/lseq.Rd | 26 ++
man/mat2tex.Rd | 119 +++++
man/missingCh.Rd | 54 +++
man/mpl.Rd | 35 ++
man/mult.fig.Rd | 67 +++
man/n.code.Rd | 42 ++
man/n.plot.Rd | 43 ++
man/nearcor.Rd | 128 ++++++
man/nr.sign.chg.Rd | 22 +
man/p.arrows.Rd | 27 ++
man/p.datum.Rd | 21 +
man/p.dnorm.Rd | 47 ++
man/p.hboxp.Rd | 33 ++
man/p.profileTraces.Rd | 48 ++
man/p.res.2fact.Rd | 56 +++
man/p.res.2x.Rd | 83 ++++
man/p.scales.Rd | 27 ++
man/p.tachoPlot.Rd | 66 +++
man/p.ts.Rd | 73 +++
man/paste.vec.Rd | 25 +
man/plotDS.Rd | 81 ++++
man/plotStep.Rd | 72 +++
man/polyn.eval.Rd | 38 ++
man/posdefify.Rd | 84 ++++
man/potatoes.Rd | 63 +++
man/pretty10exp.Rd | 101 ++++
man/primes.Rd | 73 +++
man/printTable2.Rd | 61 +++
man/prt.DEBUG.Rd | 28 ++
man/ps.end.Rd | 55 +++
man/ps.latex.Rd | 118 +++++
man/quadrant.Rd | 30 ++
man/read.org.table.Rd | 59 +++
man/repChar.Rd | 39 ++
man/rot13.Rd | 47 ++
man/rot2.Rd | 40 ++
man/roundfixS.Rd | 103 +++++
man/rrange.Rd | 44 ++
man/seqXtend.Rd | 80 ++++
man/sessionInfoX.Rd | 75 +++
man/sfsmisc-defunct.Rd | 38 ++
man/signi.Rd | 30 ++
man/sourceAttach.Rd | 37 ++
man/str_data.Rd | 50 ++
man/tapplySimpl.Rd | 45 ++
man/tkdensity.Rd | 60 +++
man/toLatex.numeric.Rd | 56 +++
man/u.Datumvonheute.Rd | 44 ++
man/u.assign0.Rd | 27 ++
man/u.boxplot.x.Rd | 28 ++
man/u.date.Rd | 22 +
man/u.datumdecode.Rd | 40 ++
man/u.log.Rd | 34 ++
man/u.sys.Rd | 41 ++
man/unif.Rd | 33 ++
man/uniqueL.Rd | 44 ++
man/unix/Sys.cpuinfo.Rd | 77 ++++
man/unix/Sys.ps.Rd | 475 +++++++++++++++++++
man/vcat.Rd | 39 ++
man/wrapFormula.Rd | 50 ++
man/xy.grid.Rd | 33 ++
man/xy.unique.x.Rd | 42 ++
tests/dDA.R | 76 ++++
tests/dDA.Rout.save | 123 +++++
tests/misc.R | 45 ++
tests/p.R | 8 +
tests/p.Rout.save | 29 ++
tests/posdef.R | 38 ++
tests/posdef.Rout.save | 79 ++++
155 files changed, 12991 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100644
index 0000000..1d345ef
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,19 @@
+Package: sfsmisc
+Title: Utilities from 'Seminar fuer Statistik' ETH Zurich
+Version: 1.1-1
+Date: 2017-06-08
+Author: Martin Maechler et al.
+Maintainer: Martin Maechler <maechler at stat.math.ethz.ch>
+Description: Useful utilities ['goodies'] from Seminar fuer Statistik ETH
+ Zurich, quite a few related to graphics; some were ported from S-plus.
+Depends: R (>= 3.0.1)
+Imports: grDevices, methods, utils, stats
+Suggests: datasets, tcltk, cluster, lattice, MASS, Matrix, nlme, lokern
+Enhances: mgcv, rpart, nor1mix, polycor, sm, tikzDevice
+Encoding: latin1
+ByteCompile: yes
+License: GPL (>= 2)
+NeedsCompilation: no
+Packaged: 2017-06-08 08:37:43 UTC; maechler
+Repository: CRAN
+Date/Publication: 2017-06-08 16:46:33 UTC
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..9db7ad6
--- /dev/null
+++ b/MD5
@@ -0,0 +1,154 @@
+88a34700eb06fe16ff8473714c0d0d05 *DESCRIPTION
+7e6256b16d1f741e3f7e9e77cdccc75b *NAMESPACE
+8afd533b4259c17ed53c20efe8f699d7 *R/D1D2.R
+7af13f18048a8ec0db9c46cd3e789431 *R/Defunct.R
+b93d90d641372d1c0dc28b9e15681010 *R/Deprecated.R
+2faf7fdfe633f527dea219910e888a2b *R/Duplicated.R
+bcf3db2731b901cc6e501f3d13cf6eba *R/Ftest-rlm.R
+3757b9510f3471b5dfc9ba2834c8a632 *R/KS-confint.R
+f15812299bc1da8724bff80ab1d45366 *R/TA.plot.R
+35220955505c3ac9e6548be35871362b *R/diagDA.R
+91ea7964ab5ecac601bf38e69ca45ae1 *R/ellipse.R
+f05c0bbec8bd887ae30b60859f23d825 *R/glob2rx.R
+930c6c46ae96c3887530bab04987ba35 *R/hatMat.R
+7ae63a44db92d439094ec6de8fff76bb *R/huber.R
+8eb07c22307d4020dabd2554fea86c55 *R/integratexy.R
+b4a9d17e432ff9b979425f62582d49c6 *R/linesHyberb.lm.R
+a48c705692ea66ef396a718062987788 *R/loessDemo.R
+e79599c4011a87a736be27bece1ce107 *R/mat2tex.R
+1cf22c6162b23652afbf764d889c52d2 *R/misc-goodies.R
+ad4627d9c2d46aa969ca7361abbd33c0 *R/missingCh.R
+53d3ae56bf1986a12d8b70c50c05ddb8 *R/mult.fig.R
+bc1b64f3982e7219ffa337c6020f816e *R/nearcor.R
+89e3070888c1e6ebf01119654926e833 *R/p.goodies.R
+3720ed20d9d2b6c04158c17bc5bc5ee8 *R/p.res.2x.WSt.R
+d0cb50e45537e34eef3a8915f3c2df37 *R/p.res.2x.formula.R
+9afd1506d2d741d04f243e9b35706d24 *R/p.tachoPlot.R
+dc0726ef099ffb6cf05d583f6610abd9 *R/p.ts.R
+c3dbae94f06bc46451e1367e6782e35c *R/pd-matrix.R
+d41d8cd98f00b204e9800998ecf8427e *R/plotCI.R
+0240971bc497302a9a27d96d940fdd53 *R/prettylab.R
+7e49e6fed6eb866899dcff83ce8c4058 *R/prime-numbers-fn.R
+579103392ad91392e2aea09f5d967909 *R/printTable.R
+e7837a5a0149b5af23eb1be650e98daf *R/ps.goodies.R
+87b45273be3601faf5c40d852b08e152 *R/rot13.R
+11a6ed2caf724846b43282bef7b56c10 *R/rrange.R
+cbe69b727f6a615909711d47b936e731 *R/sessionInfo-ext.R
+a45f0b7dd9f5f05ca801b13afc180fae *R/sourceAttach.R
+9157d8065f07a8a3c048553cbe1cb5e0 *R/str_data.R
+8a24f77bf447231bbd8c436a40dc14ef *R/tkdensity.R
+92ef1cc410fab9f832703185c1cb0827 *R/twoway-r-plot.R
+2c7dd1c656423473d9a8e993d1dfd035 *R/u.goodies.R
+7a433b70c7c787e2d0622ab17ab60e75 *R/unix/Sys.ps.R
+a65dd335f51ca06a4959af1262980407 *R/zzz.R
+c4a956f80ac6252c0f23515283ae867f *README.md
+5dcc423a5ff167a5277b8aaa7bfc5bec *TODO
+24c4be0aa52face72313592ef90cf899 *data/potatoes.rda
+3162005b7c7bcef9a60f61223ee381aa *demo/00Index
+f9218ba6ed399a453f42f7104605783b *demo/hatmat-ex.R
+c90bddd957b7fd59ad0ec2fbc069ed5b *demo/pretty-lab.R
+1cfe5644e4ebaf2f16906018b6a9be8d *demo/prime-numbers.R
+4d314a8c0c266297365a8fa808c12e30 *inst/ChangeLog
+4d8efd52a096a3bf143333e3610ab534 *inst/NEWS.Rd
+47b5d63c5026d11a11f94827bd1919a7 *man/AsciiToInt.Rd
+9cabb0a929659d2fd8bd6fe39116e8af *man/D1D2.Rd
+4778c6d3e74920fc8f277e79f5092bc1 *man/D2ss.Rd
+6539612fd8fbe186385ae3d303e525d1 *man/Deprecated.Rd
+78565841a2acdb7dae5a050872f76c59 *man/Duplicated.Rd
+f4ea7840b26cc4f113a878867055b915 *man/KSd.Rd
+fddde42e537fd46697621fed8f817f73 *man/QUnif.Rd
+8ab46f1f7e557527e83ad0ca158cc8ca *man/TA.plot.Rd
+d103f8ace017a9e94763249c91416e65 *man/axTexpr.Rd
+e11463f8a85b1ec729fa88edb8117f52 *man/cairoSwd.Rd
+2b262f3ea5da111df612742e5d5907d6 *man/capture-n-write.Rd
+c32625326c3ad34c095abb66e9b839c7 *man/col01scale.Rd
+edad636e43c3a9687547909f1ec117d4 *man/compresid2way.Rd
+e30198b92a39a77ec6569ad3e99f3a5b *man/cum.Vert.funkt.Rd
+2c97d9f7c8f78ac88aeeb58ef89e98cd *man/diagDA.Rd
+82aa7de273908725619762b73e8e268d *man/diagX.Rd
+ba25be2bdb3a36501db554648a27a356 *man/digitsBase.Rd
+bd47e4cdc353d029830ed26dd4559251 *man/eaxis.Rd
+e80b3e87a64c4761858c4d29489b30e0 *man/ecdf.ksCI.Rd
+939f600e0d0acb65adbabc05759e5380 *man/ellipsePoints.Rd
+098c821a13e368c63219154298501bb3 *man/empty.dimnames.Rd
+c93637b1384059fcde70546118468b76 *man/errbar.Rd
+5a373f447a945503c7ac4d41b6d3169a *man/f.robftest.Rd
+1c0866e7b57306e77c56cd9ea7318fec *man/factorize.Rd
+0ae00c51dc7e08c30c394cba19a4a52d *man/hatMat.Rd
+4d7c3af47d7eb1fbbc4a42119a7f9bb9 *man/histBxp.Rd
+8152fbae8c8c8a7d0f01567b248d9b4e *man/integrate.xy.Rd
+f5a1b593e29d536987373ae72f497197 *man/inv.seq.Rd
+f82f08573df90f601b1a59758d88cd30 *man/is.whole.Rd
+8cc8f0928dcdd19d1bf1e924f616f3b7 *man/iterate.lin.recursion.Rd
+83840f1720d69217f1a656ba03838c6d *man/last.Rd
+a17165f1928e3efe1a2c05edde235652 *man/linesHyberb.lm.Rd
+45e6cf8a67e11924e101c14c9a8295c4 *man/loessDemo.Rd
+decfa636a77108a710aba7f4bc36e23d *man/lseq.Rd
+469aa6a6819323b5de0cbfe8de151bb4 *man/mat2tex.Rd
+5873be6b49f0fc4a15403f83f73a9656 *man/missingCh.Rd
+2354c1ba3878c02499591992e6343cb5 *man/mpl.Rd
+28216bd8986545b68d9b2864c1463e15 *man/mult.fig.Rd
+01ac9b09b78f3a002ef13ec2a7cddc7f *man/n.code.Rd
+1b59a0f1c4740ad78500d195cb0aa37d *man/n.plot.Rd
+806e62e68ae0e2bd712e2217547155a4 *man/nearcor.Rd
+63139976748a77241ff080e800279928 *man/nr.sign.chg.Rd
+0fb19621eb65c1e0f28f8019733fd359 *man/p.arrows.Rd
+bde004dd9e970ec7b8b6b2261078908e *man/p.datum.Rd
+d2f5e8d2dd849bfa59803733ecb4180e *man/p.dnorm.Rd
+c5fec55fa6c8cb765f26b3b6a93f45dd *man/p.hboxp.Rd
+540c3505da5ee5c0983a84d7a57be607 *man/p.profileTraces.Rd
+f5f94c0b8d8248d216f393d2c4f4d01b *man/p.res.2fact.Rd
+57a802e7e5c8e7b30b89e783356d2416 *man/p.res.2x.Rd
+b0f106196081b0eeb1e1ae8f4c4590ad *man/p.scales.Rd
+bb8a9dd6fe567286f3747c1dcf639dad *man/p.tachoPlot.Rd
+cd418d8d300dbde09a1346425d1932c9 *man/p.ts.Rd
+6c0ccb8210f8f0b09bc36b4ce60d5220 *man/paste.vec.Rd
+a4bf6c3ebaf4a67c378e3b03f8d6c79c *man/plotDS.Rd
+0f8a0b40f8e1bf7e75ac5d2e61d33faf *man/plotStep.Rd
+ea47575a7ff59d58b5775d4efc6957c7 *man/polyn.eval.Rd
+1632af2dfccc6657d3024f21245c6e99 *man/posdefify.Rd
+e6f3999639e01408aabf962f3a595f6c *man/potatoes.Rd
+897c3e76312ccf562726afd6212a0129 *man/pretty10exp.Rd
+44aa3a5963a34af87d7d07b61379c561 *man/primes.Rd
+4c478f18f6cdf79a2814836ae4363fc7 *man/printTable2.Rd
+ce4d70e480ae39799ab528d90d5de6c8 *man/prt.DEBUG.Rd
+b0522194f4e6bbe5d212343ac1d06618 *man/ps.end.Rd
+65f23aff7a86d1c3039348c20c99c238 *man/ps.latex.Rd
+09cdba33a2a6a9c02566de87ab750e4f *man/quadrant.Rd
+06a30a59acab3fa21ff25a50266af23c *man/read.org.table.Rd
+800eb35ba8c0bff4f2311cec50380fdb *man/repChar.Rd
+e67d5425ab7ff233223712a92e150d9c *man/rot13.Rd
+9eb4b1c5c27e9cda929a144d7f5cc59b *man/rot2.Rd
+f0501860745806007efd81e7da6419a0 *man/roundfixS.Rd
+2b242ddffbdc912f66501d1944aba8e2 *man/rrange.Rd
+13219b81885b1869bb54ee8160d968f9 *man/seqXtend.Rd
+c2bdc0eb35e8cb45076523368e47b9b5 *man/sessionInfoX.Rd
+ab412268eaa1dc6f3dfd06d883c9d183 *man/sfsmisc-defunct.Rd
+2872bc2847f68b1d01aff5966ed71ea8 *man/signi.Rd
+aa9fa49a5740239ecf3468467956a3e8 *man/sourceAttach.Rd
+2658a2f34a55896efac98469172f2012 *man/str_data.Rd
+8daffacd134142a2fffb3691eba6f9a2 *man/tapplySimpl.Rd
+9fd3e3bd1cb05ea34dbd503774a6d557 *man/tkdensity.Rd
+8878d15f6ece1b0aaec0daac9345c7aa *man/toLatex.numeric.Rd
+41dbd15b8b65775ea1c8f2b10ae4d064 *man/u.Datumvonheute.Rd
+4b4e1b7f34c404258dcad9577c5ea218 *man/u.assign0.Rd
+5655b7f3a36b440a890aea93df0883cd *man/u.boxplot.x.Rd
+e065504c7e7e95e8ee84040cb6cf2796 *man/u.date.Rd
+b5033eea712aeab04bd2424967639956 *man/u.datumdecode.Rd
+a2514a8ae496c191deb921da1b285f7b *man/u.log.Rd
+ed0a0387325d6fef9df166209efa273e *man/u.sys.Rd
+b2fe80d0e0ce5047170efde9d7d90dad *man/unif.Rd
+a47d6a51a729bc2649a128b9a82ba953 *man/uniqueL.Rd
+966d8d71d643c54234330ad5f8271914 *man/unix/Sys.cpuinfo.Rd
+da64aa2c4ed2bf470a71c67fb257358d *man/unix/Sys.ps.Rd
+9a55a48b31382a23af157cd6e72471e3 *man/vcat.Rd
+6c68743e5e2e66aee945d5270dd3fa6f *man/wrapFormula.Rd
+823cdd617db69384a2c649a41f70a62e *man/xy.grid.Rd
+1acc56972f51bf6e8ede412dc3f54dda *man/xy.unique.x.Rd
+f4b09238483ccdbe2c57441d261b7af6 *tests/dDA.R
+14be382e178b768c0cd019e7bef90e3e *tests/dDA.Rout.save
+45c24a122a1139cd0e796f9f9a8c574d *tests/misc.R
+0d1474c2a9ea1b0c12a4b5bd21afa273 *tests/p.R
+a43879df91dd2e235443b2d27d017aac *tests/p.Rout.save
+f860fb8e7bc5d43fa652bcd39ab56993 *tests/posdef.R
+a22adb590f0df4ffe22e80a17f34f6e1 *tests/posdef.Rout.save
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100644
index 0000000..4f7ab26
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,176 @@
+importFrom("grDevices", boxplot.stats, cairo_pdf,
+ dev.cur, dev.off, n2mfrow, pdf, postscript, xy.coords)
+
+importFrom("graphics", abline, arrows, axTicks, axis, axis.POSIXct,
+ boxplot, curve, frame, hist, lines, locator, matplot, mtext,
+ par, plot, plot.new, points, polygon,
+ rug, segments, symbols, text, xyinch)
+
+importFrom("stats",
+ IQR, approx, as.formula, as.ts, dchisq, dgamma, density.default,
+ dnorm, dummy.coef, ecdf, end, fitted, formula, is.ts,
+ lm, lowess, loess, loess.control,
+ mad, median, model.frame, na.exclude, na.omit, napredict,
+ pchisq, pf, plot.ts, predict, qchisq, qgamma, qnorm, qt, quantile,
+ resid, residuals, runif,
+ smooth.spline, spline, splinefun, start, stepfun, symnum,
+ terms, time, update.formula, var, window)
+
+importFrom("utils", head, tail, toLatex, #<- S3 generics !
+ capture.output, data, packageDescription, read.table,
+ sessionInfo, str)
+
+## Using "::" in code -> no need here:
+importFrom("methods", existsFunction)
+
+
+### Export almost all
+## ------
+## New scheme (at first: for new things, only):
+# group exported objects __by ./R/ (and maybe ./man/) source file__
+export (
+ ## ./R/prime-numbers-fn.R :
+ primes, factorize,
+
+ "AsciiToInt",
+ "as.intBase", "bi2int",
+ ## FIXME: currently needed from FrF2 (Ulrike Groemping):
+ "as.integer.basedInt",
+ "axTexpr",
+ "repChar", "bl.string",
+ "cairoSwd",
+ "capture.and.write",
+ "ccat",
+ "chars8bit",
+ "code2n",
+ "col01scale",
+ "colcenter",
+ "compresid2way",
+ "cum.Vert.funkt",
+
+ "C.Monatsname", "C.weekday", "C.Wochentag", "C.Wochentagkurz",
+
+ "D1D2", "D1ss", "D1tr", "D2ss",
+ "dDA",
+ "diagDA",
+ "diagX",
+ "digitsBase",
+ "Duplicated",
+ "eaxis",
+ "ecdf.ksCI",
+ "ellipsePoints",
+ "empty.dimnames",
+ "errbar",
+ "f.robftest",
+ "hatMat",
+ "histBxp", # defunct: "hist.bxp"
+ "ichar",
+ "integrate.xy",
+ "inv.seq",
+ "is.whole",
+ "iterate.lin.recursion",
+ "KSd",
+ "last",
+ "linesHyperb.lm",
+ "list2mat",
+ loessDemo,
+ "lseq",
+ "margin2table",
+ "mat2tex",
+ missingCh,
+ "mpl",
+ "mult.fig",
+## FIXME: This is deprecated (but was never announced anyway...) :
+ nearcor,
+ "n.code",
+ "n.plot",
+ "nr.sign.chg",
+ "paste.vec",
+
+ "p.arrows",
+ "p.datum",
+
+ "p.dchisq", "p.dgamma", "p.dnorm",
+
+ "p.hboxp",
+ "plotDS",
+ "pl.ds", ## <- deprecated
+ "plotStep",
+ "p.m",
+
+ ## these should probably be deprecated for pmax.int(), pmin.int():
+ "pmax.sa", "pmin.sa",
+
+ "polyn.eval",
+ "posdefify",
+ "p.pllines",
+ "p.profileTraces",
+ "p.res.2fact",
+ "p.res.2x",
+ "pretty10exp",
+
+ ## not the S3 methods:
+ ## "predict.dDA",
+ ## "print.basedInt", "print.dDA", "print.margin2table",
+
+ "printTable2",
+ "prt.DEBUG",
+
+ "pdf.do", "pdf.end", "pdf.latex",
+ "ps.do", "ps.end", "ps.latex",
+
+ "p.scales",
+ "p.tachoPlot",
+ "p.ts",
+
+ "quadrant",
+ "QUnif",
+
+ read.org.table,
+ "rot2", "rotn",
+ "roundfixS",
+ "rrange",
+ "sHalton",
+ "seqXtend",
+ sessionInfoX,
+ "signi",
+ "sourceAttach",
+ "strcodes",
+ "str_data",
+ "TA.plot",
+ "tapplySimpl",
+ "tkdensity",
+ "u.boxplot.x",
+ "u.date", "u.datumdecode", "u.Datumvonheute",
+ "u.assign0", "u.get0",
+ "u.log",
+ "unif",
+ "uniqueL",
+ "u.sys",
+ "vcat",
+ "wrapFormula",
+ "xy.grid", "xy.unique.x"
+ )
+
+export("Sys.ps.cmd") # now in general.. even though possibly nonfunctional in non-unix
+if(tools:::.OStype() == "unix") { ## those are inside R/unix/
+
+ export("Sys.ps", "Sys.sizes")
+
+ if(identical(1L, grep("linux", R.version[["os"]]))) { ##--- Linux - only ---
+ export("Sys.cpuinfo", "Sys.meminfo", "Sys.MIPS", "Sys.memGB")
+ }
+}
+
+S3method(predict, dDA)
+S3method(print, dDA)
+S3method(print, basedInt)
+S3method(print, sessionInfoX)
+S3method(as.integer, basedInt)
+
+S3method(print, margin2table)
+
+S3method(toLatex, numeric)
+
+S3method(p.res.2x, default)
+S3method(p.res.2x, formula)
diff --git a/R/D1D2.R b/R/D1D2.R
new file mode 100644
index 0000000..9fd0942
--- /dev/null
+++ b/R/D1D2.R
@@ -0,0 +1,118 @@
+## This is also sym.linked into
+## Martin's WpDensity package /u/maechler/R/Pkgs/WpDensity/
+
+###------- Numerical Derivatives ------------------------------------------
+
+### Test Programs and examples for those two are in
+### --> "/u/maechler/S/NUMERICS/D1-tst.S"
+###
+### For 'optimal' 2nd Deriv.: d2.est(..)
+### --> "/u/maechler/S/NUMERICS/diff2.S" "/u/maechler/S/NUMERICS/diff2-user.S"
+
+
+D1tr <- function(y, x = 1)
+{
+ ## Purpose: discrete trivial estimate of 1st derivative.
+ ## -------------------------------------------------------------------------
+ ## Arguments: x is optional
+ ## -------------------------------------------------------------------------
+ ##--> See also D1.naive in ~/S/D1-tst.S (and the (smoothing) one: 'D1') !
+ ## Author: Martin Maechler, ~ 1990
+ n <- length(y)
+ if(length(x) == 1)
+ c(y[2] - y[1], 0.5 * (y[-(1:2)] - y[-((n-1):n)]), y[n] - y[n-1])/x
+ else {
+ if(n != length(x)) stop("lengths of 'x' & 'y' must equal")
+ if(is.unsorted(x)) stop("'x' must be sorted !")
+ c(y[2] - y[1], 0.5 * (y[-(1:2)] - y[-((n-1):n)]), y[n] - y[n-1]) /
+ c(x[2] - x[1], 0.5 * (x[-(1:2)] - x[-((n-1):n)]), x[n] - x[n-1])
+ }
+}
+
+
+D1ss <- function(x, y, xout = x, spar.offset = 0.1384, spl.spar=NULL)
+{
+ ## Purpose: Numerical first derivatives of f() for y_i = f(x_i) + e_i.
+ ## Find f'(xout) -- using smoothing splines with GCV'
+ ## Author: Martin Maechler, Date: 6 Sep 92, 00:04
+ ## -------------------------------------------------------------------------
+ ## Arguments: x = { x_i } MUST be sorted increasingly // y = { y_i }
+ ## -------------------------------------------------------------------------
+ sp <-
+ if(is.null(spl.spar)) {
+ sp <- smooth.spline(x,y)
+ smooth.spline(x,y, spar = sp$ spar + spar.offset)
+ } else smooth.spline(x,y, spar = spl.spar)
+ predict(sp, xout, deriv = 1) $ y
+}
+
+D2ss <- function(x, y, xout = x, spar.offset = 0.1384, spl.spar=NULL)
+{
+ ## Purpose: Numerical 2nd derivative of f() for y_i = f(x_i) + e_i.
+ ## Find f''(xout) -- using smoothing splines (with GCV) -- DOUBLY:
+ ## f --ss-> f' --ss-> f''
+ ## -------------------------------------------------------------------------
+ ## Arguments: x = { x_i } MUST be sorted increasingly // y = { y_i }
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 29 Jan 1997, 17:55 -- for S-plus
+ ## -------------------------------------------------------------------------
+
+ use.fudge <- is.null(spl.spar)
+ if(use.fudge) { ##-- use GCV * 'spar.offset' ---
+ if(is.null(spar.offset)) stop("must specify 'spl.spar' OR 'spar.offset'!")
+ lf <- length(spar.offset)
+ if(!is.numeric(spar.offset) || lf == 0 || lf > 2)
+ stop("'spar.offset' must be numeric(1 or 2) !")
+ if(lf == 1) spar.offset <- rep(spar.offset, 2)
+ sp <- smooth.spline(x,y)
+ sp <- smooth.spline(x,y, spar = spar.offset[1] + sp $ spar)
+ spl.spar <- numeric(2); spl.spar[1] <- sp $ spar
+ }
+ else {
+ lf <- length(spl.spar)
+ if(!is.numeric(spl.spar) || lf == 0 || lf > 2)
+ stop("'spl.spar' must be numeric(1 or 2) !")
+ if(lf == 1) spl.spar <- rep(spl.spar, 2)
+ sp <- smooth.spline(x,y, spar = spl.spar[1])
+ }
+
+ D1 <- predict(sp, x, deriv = 1) $ y #-- 1st derivative ...
+
+ if(use.fudge) { ##-- use GCV * 'spar.offset' ---
+ sp <- smooth.spline(x, D1)
+ sp <- smooth.spline(x, D1, spar = spar.offset[2] + sp $ spar)
+ spl.spar[2] <- sp $ spar
+ } else {
+ sp <- smooth.spline(x, D1, spar = spl.spar[2])
+ }
+ if(is.unsorted(xout))
+ xout <- sort(xout)
+ list(x=xout, y = predict(sp, xout, deriv = 1) $ y,
+ spl.spar = spl.spar, spar.offset = spar.offset)
+}
+
+
+
+D1D2 <- function(x, y, xout = x, spar.offset = 0.1384,
+ deriv = 1:2, spl.spar=NULL)
+{
+ ## Purpose: Numerical first derivatives of f() for y_i = f(x_i) + e_i.
+ ## Find f'(xout) & f''(xout) -- using smoothing splines with GCV'
+ ## Author: Martin Maechler, Date: 23 Sep 1992, 9:40ith GCV'
+ ## Author: Martin Maechler, Date: 23 Sep 1992, 9:40
+ ## -------------------------------------------------------------------------
+ ## Arguments: x = { x_i } MUST be sorted increasingly // y = { y_i }
+ ## -------------------------------------------------------------------------
+
+ if(is.unsorted(xout))
+ xout <- sort(xout)
+ sp <-
+ if(is.null(spl.spar)) {
+ sp <- smooth.spline(x,y)
+ smooth.spline(x,y, spar = sp$ spar + spar.offset)
+ } else smooth.spline(x,y, spar = spl.spar)
+ c(list(x = xout,
+ D1 = if(any(deriv==1)) predict(sp, xout, deriv = 1) $ y,
+ D2 = if(any(deriv==2)) predict(sp, xout, deriv = 2) $ y),
+ sp[c("spar", "df")])
+}
diff --git a/R/Defunct.R b/R/Defunct.R
new file mode 100644
index 0000000..57d8537
--- /dev/null
+++ b/R/Defunct.R
@@ -0,0 +1,46 @@
+### Functions moved from ./Deprecated.R
+### ~~~~~~~~~~~~~~~
+###--- remove things from here to ../Old_Defunct/ex-Deprecated.R
+### ==== == ==============================
+
+###___ add on top ___
+
+## Deprecated in 2005; defunctified 2016-12-01 :
+list2mat <- function(x, check = TRUE)
+{
+ ## Purpose: list -> matrix
+ ## -------------------------------------------------------------------------
+ ## Arguments: x a list whose first 2 el. MUST be equal length vectors
+ ## check: if T, check if lengths are ok. F: "quick & dirty"
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 19 May 93, 09:46
+
+ stop("list2mat(x) has been deprecated in 2005 and is defunct now.
+ Use sapply(x, c) or vapply(..) instead!")
+}
+
+
+pl.ds <- function(...) {
+ stop("pl.ds() has been renamed to plotDS() and is defunct now.\n",
+ "Please change your code to use the new name")
+ plotDS(...)
+}
+
+p.pllines <- function(x,y,group,lty=c(1,3,2,4),...)
+{
+ ## Purpose: lines according to group
+ ## -------------------------------------------------------------------------
+ ## Arguments:
+ ## -------------------------------------------------------------------------
+ ## Author: Werner Stahel, Date: 21 Jun 93, 15:45
+
+ stop("p.pllines() is defunct: in R, use",
+ "plot(x,y, lty=group, type='l', ...)")
+
+ plot(x,y,type="n",...)
+ ngr <- max(group)
+ for (gg in 1:ngr) {
+ ii <- group==gg & !is.na(x) & !is.na(y)
+ if(sum(ii)) lines(x[ii],y[ii],lty=lty[1+(gg-1)%%length(lty)])
+ }
+}
diff --git a/R/Deprecated.R b/R/Deprecated.R
new file mode 100644
index 0000000..9845d82
--- /dev/null
+++ b/R/Deprecated.R
@@ -0,0 +1,30 @@
+###--> Synchronize with ../man/Deprecated.Rd !!
+###--> move things from here as defunct to ./Defunct.R
+### =========
+
+## Deprecation of these, as of 2016-12-01 :
+pmax.sa <- function(scalar, arr)
+{
+ warning("pmax.sa(s,a) is deprecated; use pmax(a,s) instead")
+}
+
+pmin.sa <- function(scalar, arr)
+{
+ warning("pmin.sa(s,a) is deprecated; use pmin(a,s) instead")
+}
+
+
+## Deprecation of these, as of 2013-08-03 :
+u.assign0 <- function(x, value, immediate = FALSE) {
+ ## Purpose: Simple function with identical UI for both R & S
+ ## Author: Martin Maechler, Date: 7 Jul 1999
+ warning("u.assign0(..) is deprecated, use assign(.., , envir = .GlobalEnv)\n",
+ " {if you really must; that is deprecated in packages as well}")
+ ## assign(x, value, envir = .GlobalEnv) :
+ .a <- as.name(paste0("a", "ss", "ign"))
+ eval(substitute(AA(x, value, envir = .GlobalEnv), list(AA = .a)))
+}
+u.get0 <- function(x) {
+ warning("u.get0(x) is deprecated, use get(x, envir = .GlobalEnv)")
+ get(x, envir = .GlobalEnv)
+}
diff --git a/R/Duplicated.R b/R/Duplicated.R
new file mode 100644
index 0000000..26dd0b4
--- /dev/null
+++ b/R/Duplicated.R
@@ -0,0 +1,22 @@
+## From: Christoph Buser <buser at stat.....ethz.ch>
+## To: maechler at ....
+## Subject: Duplicated
+## Date: Tue, 25 Sep 2007 14:29:46 +0200
+
+### Changes and more arguments: entirely by MM
+Duplicated <- function(v, incomparables = FALSE, fromLast = FALSE,
+ nomatch = NA_integer_)
+{
+ ## Purpose: A counting-generalization of duplicated()
+ ## ----------------------------------------------------------------------
+ ## Arguments: a numeric vector
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler & Christoph Buser, Date: Sep 2007
+
+ uv <- unique(nv <- na.omit(v))
+ ## easier (but less general?): uv <- unique(nv <- v[!is.na(v)])
+ fv <- factor(nv, levels = uv)
+ dup <- duplicated(as.integer(fv),
+ incomparables = incomparables, fromLast = fromLast)
+ match(v, nv[dup], incomparables = incomparables, nomatch = nomatch)
+}
diff --git a/R/Ftest-rlm.R b/R/Ftest-rlm.R
new file mode 100644
index 0000000..957d7dd
--- /dev/null
+++ b/R/Ftest-rlm.R
@@ -0,0 +1,50 @@
+##- From: Werner Stahel <stahel at stat.math.ethz.ch>
+##- To: holzer at stat.math.ethz.ch, maechler at stat.math.ethz.ch
+##- Subject: robuster F-test
+##- Date: Fri, 14 Jul 2000 17:01:55 +0200 (CEST)
+
+f.robftest <- function(object, var = -1)
+{
+ ## Purpose: robust F-test: Wald test for several coefficients of
+ ## an rlm object
+ ## -------------------------------------------------------------------------
+ ## Arguments:
+ ## object result of rlm(...)
+ ## var variables. Either their names or their indices
+ ## Default: all *but* the intercept
+ ## -------------------------------------------------------------------------
+ ## Author: Werner Stahel, Date: 14 Jul 2000; MM, 2000-07-14
+
+ if (!inherits(object, "rlm"))
+ stop("f.robftest() only works for 'rlm' objects")
+
+ ## determine and check coefficients to be tested
+ cf <- object$coef
+ iind <- if(is.character(var)) match(var,names(cf)) else seq(length(cf))[var]
+ wrong <- is.na(iind) | iind > length(cf) | iind < 1
+ if (any(wrong))
+ stop(paste("variable ",var[wrong]," not found"))
+ cf <- cf[iind]
+ if (0 == (t.nv <- length(cf)))
+ stop("no variables to be tested")
+ ## covariance matrix of estimated coefficients: calls summary.rlm():
+ stopifnot(requireNamespace("MASS"))
+ t.r <- summary(object, method="XtWX")
+ ## Nota BENE: vcov() calls vcov.lm() which uses $sigma instead of $stddev !
+ t.cov <- t.r$cov.unscaled[iind,iind] * t.r$stddev ^ 2
+
+ ## Instead of c(cf %*% solve(t.cov) %*% cf)/t.nv
+ ## quite a bit more efficient (for larger p): x' A^-1 x :
+ t.f <- sum(cf * solve(t.cov, cf))/t.nv
+ df <- c(t.nv, t.r$df[2])
+
+ ## MM: Return an object of class "htest" ---> nice print.*() method !
+ structure(list(statistic = c(F = t.f), df = df,
+ data.name = paste("from", deparse(object$call)),
+ method = "robust F-test (as if non-random weights)",
+ alternative = "two.sided",
+ null.value = {c0 <- cf; c0[] <- 0; c0},
+ p.value = pf(t.f, df[1], df[2], lower.tail = FALSE)),
+ class = "htest")
+}
+
diff --git a/R/KS-confint.R b/R/KS-confint.R
new file mode 100644
index 0000000..383054e
--- /dev/null
+++ b/R/KS-confint.R
@@ -0,0 +1,56 @@
+### Fixme: In the following, computing and plotting should be separated
+
+###--> ./ecdf.R plot.ecdf() should get conf.type and conf.int argument!!
+
+### Also, I've posted a pre-version of this:
+## Date: Mon, 22 Oct 2001 19:15:35 +0200
+## From: Martin Maechler <maechler at stat.math.ethz.ch>
+## Subject: [R] Re: conf.int. for ecdfs {was "Two questions"}
+## To: cblouin at is2.dal.ca
+## Cc: Kjetil Halvorsen <kjetilh at umsanet.edu.bo>, r-help at stat.math.ethz.ch
+
+### Note -- this is related to the pkstwo() function inside ks.test()
+### ==== in stats : ~/R/D/r-devel/R/src/library/stats/R/ks.test.R
+
+ecdf.ksCI <- function(x, main = NULL, sub = NULL,
+ xlab = deparse(substitute(x)), ci.col = "red", ...)
+{
+ force(xlab)
+ if(is.null(main))
+ main <- paste0("ecdf(",deparse(substitute(x)),") + 95% K.S. bands")
+ n <- length(x)
+ if(is.null(sub))
+ sub <- paste("n = ", n)
+ ec <- ecdf(x)
+ xx <- get("x", envir=environment(ec))# = sort(x)
+ yy <- get("y", envir=environment(ec))
+ D <- KSd(n)
+ yyu <- pmin(yy + D, 1)
+ yyl <- pmax(yy - D, 0)
+ ecu <- stepfun(xx, c(yyu, 1) )
+ ecl <- stepfun(xx, c(yyl, yyl[n]) )
+
+ ## Plots -- all calling plot.stepfun
+
+ plot(ec, main = main, sub = sub, xlab = xlab, ...)
+ plot(ecu, add=TRUE, verticals=TRUE, do.points=FALSE,
+ col.hor= ci.col, col.vert= ci.col, ...)
+ plot(ecl, add=TRUE, verticals=TRUE, do.points=FALSE,
+ col.hor= ci.col, col.vert= ci.col, ...)
+}
+
+KSd <- function(n)
+{
+ ## `approx.ksD()'
+ ## approximations for the critical level for Kolmogorov-Smirnov statistic D,
+ ## for confidence level 0.95. Taken from Bickel & Doksum, table IX, p.483
+ ## and Lienert G.A.(1975) who attributes to Miller,L.H.(1956), JASA
+ ifelse(n > 80,
+ 1.358/( sqrt(n) + .12 + .11/sqrt(n)),## Bickel&Doksum, table IX,p.483
+
+ splinefun(c(1:9, 10, 15, 10 * 2:8),# from Lienert
+ c(.975, .84189, .70760, .62394, .56328,# 1:5
+ .51926, .48342, .45427, .43001, .40925,# 6:10
+ .33760, .29408, .24170, .21012,# 15,20,30,40
+ .18841, .17231, .15975, .14960)) (n))
+}
diff --git a/R/TA.plot.R b/R/TA.plot.R
new file mode 100644
index 0000000..2338ea5
--- /dev/null
+++ b/R/TA.plot.R
@@ -0,0 +1,124 @@
+n.plot <-
+ function(x, y=NULL, nam = NULL, abbr = n >= 20 || max(nchar(nam))>=8,
+ xlab = NULL, ylab = NULL, log = "",
+ cex = par("cex"), col = par("col"), ...)
+{
+ ## Purpose: "Name Plot"; Names (or numbers) instead of points in plot(..)
+ ## --> help(n.plot) !
+ if(inherits(x,"formula")) # is(x, "formula")
+ stop("formula not yet supported")
+ ## this is like plot.default():
+ xlabel <- if (!missing(x)) deparse(substitute(x))
+ ylabel <- if (!missing(y)) deparse(substitute(y))
+ xy <- xy.coords(x, y, xlabel, ylabel, log)
+ xlab <- if (is.null(xlab)) xy$xlab else xlab
+ ylab <- if (is.null(ylab)) xy$ylab else ylab
+ plot(xy, type = 'n', xlab = xlab, ylab = ylab, log = log, ...)
+ n <- length(x)
+ if(is.null(nam)) { nam <- rownames(x)
+ if (is.null(nam)) { nam <- names(x)
+ if (is.null(nam)) { nam <- names(y)
+ if (is.null(nam)) { nam <- paste(1:n) #- Use 1,2,.. if no names
+ }}}}
+ if(abbr) nam <- abbreviate(nam, minlength=1)
+ text(xy, labels=nam, cex=cex, col=col)
+ invisible(nam)
+}
+
+TA.plot <-
+ function(lm.res, fit = fitted(lm.res),
+ res = residuals(lm.res, type = "pearson"),
+ labels = NULL, main = mk.main(), xlab = "Fitted values",
+ draw.smooth = n >= 10, show.call = TRUE, show.2sigma = TRUE,
+ lo.iter = NULL, lo.cex = NULL,
+ par0line = list(lty = 2, col = "gray"),
+ parSmooth = list(lwd = 1.5, lty = 4, col = 2),
+ parSigma = list(lwd = 1.2, lty = 3, col = 4),
+ verbose = FALSE, ...)
+{
+ ## Purpose: Produce a Tukey-Anscombe plot of a linear model fit
+ ## Note that residuals and fitted are UN-correlated (IFF intercept..)
+ ## -------------------------------------------------------------------------
+ ## Arguments: lm.res = RESult of lm(..)
+ ## res : (weighted) residuals by default,
+ ## labels = 'symbols' for point, default(NULL): extract names or use seq.nr
+ ## use '*' to get simple '*' symbols.
+ ##
+ ## --- see on-line help by "?TA.plot" !!
+ ## -------------------------------------------------------------------------
+ ## Uses : n.plot(.)
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: Dec 92 / Nov.93; for R: 1999/2000
+ if(missing(main)) {
+ call <- lm.res $ call
+ if(is.call(call[["formula"]]) && any(c("lm", "aov") == call[[1]]))
+ call <- call[["formula"]]
+ else { #-- only formula part; no extra 'data ='
+ if (length(call) >= 3 && !is.na(m.f <- match("formula", names(call)))) {
+ call <- call[c(1, m.f)]
+ names(call)[2] <- ""
+ }
+ }
+ mk.main <- function() {
+ cal <- call ## if(is.R()) call else get("call", frame = sys.parent())
+ if(is.null(cal))
+ "Tukey-Anscombe plot of ???"
+ else {
+ nc <- nchar(ccal <- deparse(cal, width.cutoff = 200)[1])
+ if(verbose)
+ cat("|cal|=", length(cal), "; nchar(ccal) =", nc,": '", ccal, "'\n", sep="")
+ if(nc > 36)
+ warning("TA.plot: 'main' title is long; consider using cex.main = 0.8",
+ call. = FALSE)
+ ##-- now should even go further:
+ ##-- E.g. if nc > 50, use cex = .8 in the call to n.plot below
+ paste(if(nc < 13) "Tukey-Anscombe plot of : "
+ else if(nc < 24) "T.A. plot of: " else "TA-pl:", ccal)
+ }
+ }
+ }
+ if("ylab" %in% names(list(...))) {
+ n.plot(fit, res, nam = labels, xlab = xlab, main = main, ...)
+ } else {
+ yl <- "Residuals"
+ if(!is.null(lm.res$weights) &&
+ any(abs(lm.res$resid- res) > 1e-6*mad(res)))
+ yl <- paste("WEIGHTED", yl)
+ n.plot(fit, res, nam = labels, xlab = xlab, ylab = yl, main = main, ...)
+ }
+ if(show.call)
+ mtext(deparse(match.call()), side = 3, line = 0.5, cex = 0.6, adj=1)
+ do.call("abline", c(list(h= 0), par0line))
+ p.mgp <- par("mgp")[1:2] #-- line numbers of margin text: xlab & label
+ if(missing(lo.cex))
+ lo.cex <- max(.2, min(0.8*par("mex"), .9*-diff(p.mgp))/par("mfg")[4])
+ m.line <- if(par("mfg")[4]==1) .2+ p.mgp[1] else
+ max(p.mgp[1] - .2*lo.cex, sum(p.mgp)/2)
+ if(show.2sigma) {
+ s2 <- c(-2,2) * mad(res, center=0)
+ rr <- range(res)
+ if(s2[1] < rr[1] || s2[2] > rr[2])
+ mtext(paste("2 sigma = ", format(s2[2])),
+ side= 1, line= m.line, adj = 0, cex= lo.cex)
+ ##abline(h= s2, lwd=1.8, lty=3, col=4)
+ do.call("abline", c(list(h= s2), parSigma))
+ }
+ n <- length(res)
+ if(draw.smooth) {
+ if(!is.list(parSmooth)) stop("`parSmooth' must be a list")
+ ##-- lo.iter: idea of Werner Stahel: no robustness for 'glm' residuals
+ if (is.null(lo.iter))
+ lo.iter <- if(inherits(lm.res, "glm")&& lm.res$family[1]!="Gaussian")
+ 0 else 3
+ f <- max(0.2, 1.25 * n^-.2) #'-- Martin's very empirical formula...
+ rlow <- lowess(fit, res, f = f, iter = lo.iter)
+ do.call("lines",c(rlow, parSmooth))
+
+ mtext(paste("-.-.-.- : lowess smooth (f =", format(round(f,2)),
+ if(lo.iter!=3) paste(", it=", lo.iter), ")"),
+ side = 1, line = m.line, cex = lo.cex, adj = 1)
+ }
+ ##- "Correlation:", formatC(cor(fit,res), dig=3),
+ ## mtext(paste(" -- Rank corr.:", formatC(cor(rank(fit),rank(res)), dig=3)) )
+ invisible()
+}
diff --git a/R/diagDA.R b/R/diagDA.R
new file mode 100644
index 0000000..698e9f9
--- /dev/null
+++ b/R/diagDA.R
@@ -0,0 +1,207 @@
+diagDA <- function(ls, cll, ts, pool= TRUE)
+{
+ ## Purpose: Diagonal (Linear or Quadratic) Discriminant Analysis
+ ## ----------------------------------------------------------------------
+ ## Arguments: --> ?diagDA (i.e. ../man/diagDA.Rd )
+ ## ----------------------------------------------------------------------
+ ## Authors: Sandrine Dudoit, sandrine at stat.berkeley.edu
+ ## Jane Fridlyand, janef at stat.berkeley.edu
+ ## as function stat.diag.da() in package "sma"
+ ##
+ ## Modification (API and speed): Martin Maechler, Date: 19 Nov 2003, 15:34
+
+### ---------------------- Fit Model ------------------------------
+ ls <- data.matrix(ls)
+ n <- nrow(ls)
+ p <- ncol(ls)
+
+ cl0 <- as.integer(min(cll, na.rm=TRUE) - 1)
+ cll <- as.integer(cll) - cl0 ## cll now in 1:K
+ inaC <- is.na(cll)
+ clL <- cll[!inaC]
+ K <- max(clL)
+ if(K != length(unique(clL)))
+ stop(sQuote("cll")," did not contain *consecutive* integers")
+
+ nk <- integer(K)
+ m <- v <- matrix(0,p,K)
+
+ colVars <- function(x, means = colMeans(x, na.rm = na.rm), na.rm=FALSE) {
+ x <- sweep(x, 2, means)
+ colSums(x*x, na.rm = na.rm) / (nrow(x) - 1)
+ }
+ sum.na <- function(x) sum(x, na.rm=TRUE)
+
+ ## Class means and variances
+ for(k in 1:K) {
+ which <- (cll == k)
+ nk[k] <- sum.na(which)
+ lsk <- ls[which, , drop = FALSE]
+ m[,k] <- colMeans(lsk, na.rm = TRUE)
+ if(nk[k] > 1)
+ v[,k] <- colVars (lsk, na.rm = TRUE, means = m[,k]) ## else 0
+ }
+
+### ---------------------- Predict from Model -----------------------------
+
+ ts <- data.matrix(ts)
+ if(p != ncol(ts))
+ stop("test set matrix must have same columns as learning one")
+ ## any NA's in test set currently must give NA predictions
+ ts <- na.exclude(ts)
+ nt <- nrow(ts)
+ disc <- matrix(0, nt,K)
+
+ if(pool) { ## LDA
+ ## Pooled estimates of variances
+ vp <- rowSums(rep(nk - 1, each=p) * v) / (n - K)
+ ## == apply(v, 1, function(z) sum.na((nk-1)*z))/(n-K)
+ if(any(i0 <- vp == 0)) vp[i0] <- 1e-7 * min(vp[!i0])
+
+ ivp <- rep(1/vp, each = nt) # to use in loop
+
+ for(k in 1:K) {
+ y <- ts - rep(m[,k], each=nt)
+ disc[,k] <- rowSums(y*y * ivp)
+ ## == apply(ts, 1, function(z) sum.na((z-m[,k])^2/vp))
+ }
+ }
+ else { ## QDA
+if(FALSE) { ## not yet quite : fails ../tests/dDA.R -- FIXME
+ for(k in 1:K) {
+ ts <- ts - rep(m[,k], each=nt)
+ disc[,k] <- rowSums((ts*ts) / rep(v[,k], each=nt)) + sum(log(v[,k]))
+ }
+} else {
+ for(k in 1:K) {
+ disc[,k] <-
+ apply(ts,1, function(z) sum((z-m[,k])^2/v[,k])) +
+ sum.na(log(v[,k]))
+ }
+}
+ }
+
+ ## predictions
+
+ pred <- cl0 + apply(disc, 1, which.min)
+ if(inherits(attr(ts,"na.action"), "exclude")) # had missings in `ts'
+ pred <- napredict(omit = attr(ts,"na.action"), pred)
+ pred
+}
+
+## Cleaner: One function to estimate; one to predict :
+## ------- (my tests give a time-penalty 5% for doing things two steps)
+
+dDA <- function(x, cll, pool= TRUE)
+{
+ ## Purpose: Diagonal (Linear or Quadratic) Discriminant Analysis
+
+ x <- data.matrix(x)
+ n <- nrow(x)
+ p <- ncol(x)
+
+ cl0 <- as.integer(min(cll, na.rm=TRUE) - 1)
+ cll <- as.integer(cll) - cl0 ## cll now in 1:K
+ inaC <- is.na(cll)
+ clL <- cll[!inaC]
+ K <- max(clL)
+ if(K != length(unique(clL)))
+ stop(sQuote("cll")," did not contain *consecutive* integers")
+
+ nk <- integer(K)
+ m <- v <- matrix(0,p,K)
+
+ colVars <- function(x, means = colMeans(x, na.rm = na.rm), na.rm=FALSE) {
+ x <- sweep(x, 2, means)
+ colSums(x*x, na.rm = na.rm) / (nrow(x) - 1)
+ }
+ sum.na <- function(x) sum(x, na.rm=TRUE)
+
+ ## Class means and variances
+ for(k in 1:K) {
+ which <- (cll == k)
+ nk[k] <- sum.na(which)
+ lsk <- x[which, , drop = FALSE]
+ m[,k] <- colMeans(lsk, na.rm = TRUE)
+ if(nk[k] > 1)
+ v[,k] <- colVars (lsk, na.rm = TRUE, means = m[,k]) ## else 0
+ }
+ structure(list(call = match.call(), cl0 = cl0, n=n, p=p, K=K,
+ means=m, vars=v, nk=nk, pool=pool),
+ class = "dDA")
+}
+
+print.dDA <- function(x, ...)
+{
+ cat(if(x$pool)"Linear (pooled var)" else "Quadratic (no pooling)",
+ "Diagonal Discriminant Analysis,\n ", deparse(x$call),"\n")
+ with(x,
+ cat(" (n= ",n,") x (p= ",p,") data in K=",K," classes of [",
+ paste(nk, collapse=", "),"] observations each\n", sep=""))
+ cat("\n")
+ invisible(x)
+}
+
+predict.dDA <- function(object, newdata, pool = object$pool, ...)
+{
+ newdata <- data.matrix(newdata)
+ n <- object$n
+ p <- object$p
+ K <- object$K
+ ## means and vars are (p x K) matrices:
+ mu <- object$means
+ Vr <- object$vars
+ if(p != ncol(newdata))
+ stop("test set matrix must have same columns as learning one")
+ ## any NA's in test set currently must give NA predictions
+ newdata <- na.exclude(newdata)
+ nt <- nrow(newdata)
+ disc <- matrix(0, nt,K)
+
+ if(pool) { ## LDA
+ ## Pooled estimates of variances
+ vp <- rowSums(Vr * rep(object$nk - 1, each=p)) / (n - K)
+ ## == apply(Vr, 1, function(z) sum.na((nk-1)*z))/(n-K)
+ if(any(i0 <- vp == 0)) vp[i0] <- 1e-7 * min(vp[!i0])
+
+ ivp <- rep(1/vp, each = nt) # to use in loop
+
+ for(k in 1:K) {
+ y <- newdata - rep(mu[,k], each=nt)
+ disc[,k] <- rowSums(y*y * ivp)
+ ## == apply(newdata, 1, function(z) sum.na((z-mu[,k])^2/vp))
+ }
+ }
+ else { ## QDA
+ sum.na <- function(x) sum(x, na.rm=TRUE)
+ ## zero - variances are not acceptable later
+ if(any(i0 <- Vr == 0)) {
+ if(all(i0))
+ stop("all variances are 0 -- cannot predict")
+ Vr[i0] <- 1e-7 * min(Vr[!i0])
+ }
+
+if(FALSE) { ## not yet quite : fails ../tests/dDA.R -- FIXME
+ for(k in 1:K) {
+ y <- newdata - rep(mu[,k], each=nt)
+ disc[,k] <- rowSums((y*y) / rep(Vr[,k], each=nt)) + sum(log(Vr[,k]))
+ }
+} else {
+ for(k in 1:K) {
+ disc[,k] <-
+ apply(newdata,1, function(z) sum((z-mu[,k])^2/Vr[,k])) +
+ sum.na(log(Vr[,k]))
+ }
+}
+ }
+
+ ## predictions
+
+ pred <- object$cl0 + apply(disc, 1, which.min)
+ if(inherits(attr(newdata,"na.action"), "exclude")) {
+ ## had missings in `newdata'
+ pred <- napredict(omit = attr(newdata,"na.action"), pred)
+ } ## ^^^^^^^^^ typically stats:::napredict.exclude()
+ pred
+}
+
diff --git a/R/ellipse.R b/R/ellipse.R
new file mode 100644
index 0000000..a037fff
--- /dev/null
+++ b/R/ellipse.R
@@ -0,0 +1,30 @@
+ellipsePoints <- function(a,b, alpha = 0, loc = c(0,0), n = 201,
+ keep.ab.order = FALSE)
+{
+ ## Purpose: ellipse points,radially equispaced, given geometric par.s
+ ## -------------------------------------------------------------------------
+ ## Arguments: a, b : length of half axes in (x,y) direction
+ ## alpha: angle (in degrees) for rotation
+ ## loc : center of ellipse
+ ## n : number of points
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 19 Mar 2002
+
+ stopifnot(is.numeric(a), is.numeric(b))
+ reorder <- a < b && keep.ab.order
+ B <- min(a,b)
+ A <- max(a,b)
+ ## B <= A
+ d2 <- (A-B)*(A+B) ## = A^2 - B^2
+ phi <- 2*pi*seq(0,1, len = n)
+ sp <- sin(phi)
+ cp <- cos(phi)
+ r <- a*b / sqrt(B^2 + d2 * sp^2)
+ xy <- r * if(reorder) cbind(sp, cp) else cbind(cp, sp)
+ ## xy are the ellipse points for alpha = 0 and loc = (0,0)
+ al <- alpha * pi/180
+ ca <- cos(al)
+ sa <- sin(al)
+ xy %*% rbind(c(ca, sa), c(-sa, ca)) + cbind(rep(loc[1],n),
+ rep(loc[2],n))
+}
diff --git a/R/glob2rx.R b/R/glob2rx.R
new file mode 100644
index 0000000..24bde0d
--- /dev/null
+++ b/R/glob2rx.R
@@ -0,0 +1,16 @@
+if(getRversion() < "2.2")
+ ## R 2.2.0 and later contain this in 'utils'
+glob2rx <- function(pattern, trim.head = FALSE, trim.tail = TRUE)
+{
+ ## Purpose: Change "ls" aka "wildcard" aka "globbing" _pattern_ to
+ ## Regular Expression (as in grep, perl, emacs, ...)
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler ETH Zurich, ~ 1991
+ ## New version using [g]sub() : 2004
+ p <- gsub('\\.','\\\\.', paste0('^', pattern, '$'))
+ p <- gsub('\\?', '.', gsub('\\*', '.*', p))
+ ## these are trimming '.*$' and '^.*' - in most cases only for esthetics
+ if(trim.tail) p <- sub("\\.\\*\\$$", '', p)
+ if(trim.head) p <- sub("\\^\\.\\*", '', p)
+ p
+}
diff --git a/R/hatMat.R b/R/hatMat.R
new file mode 100644
index 0000000..78c6242
--- /dev/null
+++ b/R/hatMat.R
@@ -0,0 +1,25 @@
+hatMat <- function(x, trace = FALSE,
+ pred.sm = function(x,y,...)
+ predict(smooth.spline(x,y, ...), x = x)$y,
+ ...)
+{
+ ## Purpose: Return Hat matrix of a smoother -- very general (but slow)
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 7 Mar 2001, 11:12
+ stopifnot(is.logical(trace), length(trace) == 1)
+ n <- NROW(x)
+ if(is.unsorted(x) && !missing(pred.sm))
+ warning("'x' is not sorted increasingly:\n ",
+ " this may be inefficient and lead to wrong results")
+ y <- pred.sm(x, numeric(n), ...)
+ if(!is.numeric(y) || length(y) !=n)
+ stop("`pred.sm' does not return a numeric length n vector")
+ H <- if(trace) 0 else matrix(as.numeric(NA), n,n)
+ for (i in 1:n) {
+ y <- numeric(n) ; y[i] <- 1
+ y <- pred.sm(x, y, ...)
+ if(trace) H <- H + y[i] else H[,i] <- y
+ }
+ H
+}
+
diff --git a/R/huber.R b/R/huber.R
new file mode 100644
index 0000000..2d6f683
--- /dev/null
+++ b/R/huber.R
@@ -0,0 +1,2 @@
+#### NOTA BENE: New version of huberM() is only in 'robustbase' !!!
+#### -------- ----------------------------------------
diff --git a/R/integratexy.R b/R/integratexy.R
new file mode 100644
index 0000000..b14d766
--- /dev/null
+++ b/R/integratexy.R
@@ -0,0 +1,74 @@
+## This is also sym.linked into
+## Martin's WpDensity package /u/maechler/R/Pkgs/WpDensity/
+
+integrate.xy <- function(x,fx, a,b, use.spline = TRUE, xtol = 2e-8)
+{
+ if(is.list(x)) {
+ fx <- x$y; x <- x$x
+ if(length(x) == 0)
+ stop("list 'x' has no valid $x component")
+ }
+ if((n <- length(x)) != length(fx))
+ stop("'fx' must have same length as 'x'")
+
+ if(is.unsorted(x)) { i <- sort.list(x); x <- x[i]; fx <- fx[i] }
+ if(any(i <- duplicated(x))) {
+ n <- length(x <- x[!i])
+ ## we might have to check that the same fx[] are duplicated
+ ## otherwise either give an error or take the mean() of those...
+ fx <- fx[!i]
+ }
+ if(any(diff(x) == 0))
+ stop("bug in 'duplicated()' killed me: have still multiple x[]!")
+
+ if(missing(a)) a <- x[1]
+ else if(any(a < x[1])) stop("'a' must NOT be smaller than min(x)")
+ if(missing(b)) b <- x[n]
+ else if(any(b > x[n])) stop("'b' must NOT be larger than max(x)")
+ if(length(a) != 1 && length(b) != 1 && length(a) != length(b))
+ stop("'a' and 'b' must have length 1 or same length !")
+ else {
+ k <- max(length(a),length(b))
+ if(any(b < a)) stop("'b' must be elementwise >= 'a'")
+ }
+
+ if(use.spline) {
+ xy <- spline(x,fx, n = max(1024, 3*n))
+ ##-- Work around spline(.) BUG: (ex.: range(spline(1:20,1:20,n=95)))
+ if(xy$x[length(xy$x)] < x[n]) {
+ if(TRUE) cat("working around spline(.) BUG --- hmm, really?\n\n")
+ xy$x <- c(xy$x, x[n])
+ xy$y <- c(xy$y, fx[n])
+ }
+ ## END if work around ----
+ x <- xy$x; fx <- xy$y
+ n <- length(x)
+ }
+
+ ab <- unique(c(a,b))
+ BB <- abs(outer(x,ab,"-")) < (xtol * max(b - a))
+ if(any(j <- 0 == colSums(BB))) { # the j-th element(s) of ab are not in x[]
+ y <- approx(x,fx, xout = ab[j])$y
+ x <- c(ab[j],x)
+ i <- sort.list(x)
+ x <- x[i]; fx <- c(y,fx)[i]; n <- length(x)
+ }
+
+ ##--- now we could use 'Simpson's formula IFF the x[i] are equispaced... --
+ ##--- Since this may well be wrong, just use 'trapezoid formula':
+
+ dig0 <- floor(-log10(xtol)) #
+ f.match <- function(x,table,dig) match(signif(x,dig), signif(table,dig))
+ ## was (S+) f.match <- function(x,table) match(as.single(x), as.single(table))
+
+ d <- dig0; while(anyNA(ai <- f.match(a,x, d))) d <- d - 1/8 ; ai <- rep_len(ai, k)
+ d <- dig0; while(anyNA(bi <- f.match(b,x, d))) d <- d - 1/8 ; bi <- rep_len(bi, k)
+ dfx <- fx[-c(1,n)] * diff(x,lag = 2)
+ r <- numeric(k)
+ for (i in 1:k) {
+ a <- ai[i]; b <- bi[i]
+ r[i] <- (x[a+1] - x[a])*fx[a] + (x[b] - x[b-1])*fx[b] +
+ sum(dfx[seq(a, length = max(0,b-a-1))])
+ }
+ r/2
+}
diff --git a/R/linesHyberb.lm.R b/R/linesHyberb.lm.R
new file mode 100644
index 0000000..822c214
--- /dev/null
+++ b/R/linesHyberb.lm.R
@@ -0,0 +1,28 @@
+linesHyperb.lm <-
+ function(object, c.prob = .95, confidence = FALSE,
+ k = if(confidence) Inf else 1,
+ col = 2, lty = 2, do.abline = TRUE)
+{
+ n <- length(Res <- residuals(object))
+ df <- object $ df.resid
+ s2 <- sum(Res^2)/df
+ s <- sqrt(s2)
+ if(is.null(R <- object $ R)) ## in R
+ R <- qr.R(object $ qr)
+ Xm <- R[1,2]/R[1,1] # = mean(x_i) : (X'X)[1,] = (R'R)[1,] = [n sum_{x_i}]
+ ##-- S_{xx} = sum_i{(x_i - mean(x_i))^2} : you can prove this: (R'R) = ...
+ S.xx <- R[2,2]^2
+
+ ux <- par("usr")[1:2]
+ d.xs <- data.frame(x = xs <- seq(ux[1],ux[2], length = 100))
+ names(d.xs) <- attr(object$terms,"term.labels") #-- proper x-variable name
+ ys <- predict(object, new = d.xs)
+ pred.err <- qt(1-(1-c.prob)/2, df) * s * sqrt(1/k + 1/n + (xs-Xm)^2/S.xx)
+ o.p <- par(err=-1)
+ on.exit(par(o.p))
+ if(do.abline)
+ abline(object)
+ lines(xs, ys - pred.err, col=col, lty=lty)
+ lines(xs, ys + pred.err, col=col, lty=lty)
+}
+
diff --git a/R/loessDemo.R b/R/loessDemo.R
new file mode 100644
index 0000000..ec67f5f
--- /dev/null
+++ b/R/loessDemo.R
@@ -0,0 +1,134 @@
+loessDemo <-
+ function(x, y, span = 1/2, degree = 1, family = c("gaussian", "symmetric"),
+ nearest = FALSE, nout = 501,
+ xlim = numeric(0), ylim = numeric(0), strictlim=TRUE, verbose = TRUE,
+ inch.sym = 0.25, pch = 4,
+ shade = TRUE, w.symbols = TRUE,
+ sym.col = "blue", w.col = "light blue", line.col = "steelblue")
+{
+ ## function to demonstrate the locally weighted regression function loess
+ ## written and posted to S-news, Thu, 27 Sep 2001 07:48
+ ### Dr. Greg Snow
+ ## Brigham Young University, Department of Statistics
+ ## gls at byu.edu
+ ## Modified by Henrik Aa. Nielsen, IMM, DTU (han at imm.dtu.dk)
+ ## spiffed up (R only), by M.Mächler, SfS ETH Zurich
+
+ family <- match.arg(family)
+ ## drop NA's and sort:
+ miss.xy <- is.na(x) | is.na(y)
+ x <- x[!miss.xy]
+ y <- y[!miss.xy]
+ ix <- order(x)
+ x <- x[ix]
+ y <- y[ix]
+ degree <- as.integer(degree)
+ if(length(degree) != 1 || is.na(degree) || degree < 0 || 2 < degree)
+ stop("'degree' must be in {0,1,2}")
+
+ fit.D <- loess(y ~ x, degree = degree, span = span, family = family,
+ control = loess.control(surface = "direct"))
+
+ fit.I <- loess(y ~ x, degree = degree, span = span, family = family)
+
+ xx <- seq(min(x), max(x), len = nout)
+ est <- list(x = xx,
+ y = predict(fit.I, newdata = data.frame(x = xx)))
+
+ xl <- if(strictlim && is.numeric(xlim) && length(xlim) == 2)
+ xlim
+ else {
+ xl <- range(x, est$x, xlim)
+ xl <- xl + c(-1, 1) * 0.03 * diff(xl)
+ }
+ yl <- if(strictlim && is.numeric(ylim) && length(ylim) == 2) {
+ dy <- 0.05 * diff(ylim)
+ ylim
+ }
+ else {
+ yl <- range(y, est$y, ylim, fitted(fit.D))
+ dy <- 0.05 * diff(yl)
+ yl + c(-1, 1) * dy
+ }
+ ## room below for weights
+ dy <- 4*dy
+ yl[1] <- yl[1] - dy
+ stit <- paste("span = ", span,"; degree = ", degree)
+ if(family != "gaussian")
+ stit <- paste(stit,". family = \"", family,'"',sep="")
+
+ fitPlot <- function(x, y, w, est, fit.D, xl, yl)
+ {
+ pU <- par("usr")
+ plot(x, y, pch = pch, xlim = xl, ylim = yl, sub = stit)
+ if(!is.null(w)) {
+ w <- w/max(w) # in [0,1]
+ wP <- w > 1e-5
+ nw <- length(xw <- x[wP])
+ if(w.symbols)
+ symbols(xw, y[wP], circles = sqrt(w[wP]),
+ inches = inch.sym, add = TRUE, fg = sym.col)
+ # scale [0,1] to yl[1] + [0, dy] :
+ y0 <- pU[3]
+ wy <- y0 + (dy+yl[1]-y0) * w[wP]
+ polygon(c(xw[1], xw, xw[nw]), c(y0, wy, y0), col = w.col)
+ segments(xw, rep(y0,nw), xw, wy, col=sym.col)
+ }
+ lines(x, fitted(fit.D), col = 2, lwd = 2)
+ mtext("Exact estimate with linear interpolation between x-values ('surface = \"direct\")",
+ col = 2, adj = 0.5, line = 0.5)
+ lines(est, col = 3, lwd = 2)
+ mtext("Estimate obtained using the default interpolation scheme",
+ col = 3, adj = 0.5, line = 2)
+ pU
+ }
+
+ fitPlot(x, y, w=NULL, est, fit.D, xl, yl)
+
+ repeat {
+ if(verbose)
+ cat("click left for x0 to predict -- click right to stop ")
+ x0 <- locator(1)$x
+ if(verbose) cat("\n")
+ if(length(x0) < 1)## right clicking leaves loop
+ break
+ if(nearest)
+ x0 <- unique(x[abs(x - x0) == min(abs(x - x0))])
+ if(verbose)
+ cat("x0 =", x0, "\n")
+ Dx <- abs(x - x0)
+ d <-
+ if(span < 1)
+ sort(Dx)[as.integer(span * length(x))]
+ else max(Dx) * sqrt(span)
+ w <- rep(0, length(x))
+ s <- Dx <= d
+ w[s] <- (1 - (Dx[s]/d)^3)^3 # tricube weights
+ pU <- fitPlot(x, y, w, est, fit.D, xl, yl)
+ ## ======= ==
+
+ if(degree > 0L) { ## is '1' or '2
+ if(degree == 1)
+ abline(lm(y ~ x, weights = w), col = line.col)
+ else ## (degree == 2) # predict(lm( ~ poly()) fails!
+ lines(xx, predict(lm(y ~ x + I(x^2), weights = w),
+ data.frame(x=xx)),
+ col = line.col, err = -1)
+ } else { ## degree == 0
+ ##lines(x, fitted(lm(y ~ 1, weights = w)), col = line.col, err = -1)
+ abline(a = sum(w*y)/sum(w), b = 0, col = line.col)
+ }
+ abline(v = x0, col = line.col, lty = 3, lwd = 0.2)
+ axis(1, at= x0, labels = formatC(x0, digits=3), col.axis = line.col)
+ if((x1 <- x0 - d) > xl[1]) {
+ abline(v = x1, col = line.col, lty = 2)
+ if(shade) polygon(c(pU[1],x1,x1,pU[1]), pU[c(3,3, 4,4)], density = 5)
+ }
+ if((x1 <- x0 + d) < xl[2]) {
+ abline(v = x1, col = line.col, lty = 2)
+ if(shade)
+ polygon(c(x1, pU[c(2,2)],x1), pU[c(3,3, 4,4)], density = 5,
+ angle = -45)
+ }
+ }
+}
diff --git a/R/mat2tex.R b/R/mat2tex.R
new file mode 100644
index 0000000..32989c8
--- /dev/null
+++ b/R/mat2tex.R
@@ -0,0 +1,60 @@
+### Port to R and a few small improvements:
+### Copyright � 2000 Martin Maechler, ETH Zurich
+
+mat2tex <- function(x, file = "mat.tex", envir = "tabular",
+ nam.center = "l", col.center = "c",
+ append = TRUE, digits = 3, title)
+{
+ if(length(d.x <- dim(x)) != 2)
+ stop("'x' must be a matrix like object with dim(x) of length 2")
+ if(any(d.x <= 0))
+ stop("'dim(x)' must be positive")
+ nr.x <- d.x[1]
+ nc.x <- d.x[2]
+ c2ind <- (1:nc.x)[-1] # possibly empty
+
+ ## determine if there are labels to be processed
+ dn.x <- dimnames(x)
+ if(has.rowlabs <- !is.null(dn.x[[1]])) rowlabs <- dn.x[[1]]
+ if(has.collabs <- !is.null(dn.x[[2]])) collabs <- dn.x[[2]]
+
+ ## produce column specification
+ stopifnot(any(nam.center == c("l","r","c")))
+ stopifnot(all(col.center %in% c("l","r","c")))
+ col.center <- rep(col.center, length = nc.x)
+ colspec <- "{|"
+ if(has.rowlabs)
+ colspec <- paste(colspec, nam.center, "||")
+ colspec <- paste0(colspec, paste(col.center, "|", collapse=""), "}")
+ cat(paste(sprintf("\\begin{%s}", envir), colspec, " \n"), file=file, append=append)
+
+ span <- nc.x + if(has.rowlabs) 1 else 0
+ cat(if(!missing(title)) paste("\\multicolumn{", span,
+ "}{c}{", title, "} \\\\"),
+ "\\hline \n", file = file, append = TRUE)
+ ## output column labels if needed
+ if(has.collabs) {
+ collabline <- " "
+ if(has.rowlabs)
+ collabline <- paste(collabline, " \\ &")
+ collabline <- paste(collabline, collabs[1])
+ for(i in c2ind)
+ collabline <- paste(collabline, "&", collabs[i])
+ collabline <- paste(collabline, "\\\\ \\hline \\hline")
+ cat(collabline, "\n", file = file, append = TRUE)
+ }
+ ## output matrix entries
+ options(digits = digits)
+ for(i in 1:nr.x) {
+ thisline <-
+ if(has.rowlabs)
+ paste(rowlabs[i], "&", format(x[i, 1])) else format(x[i, 1])
+ for(j in c2ind)
+ thisline <- paste(thisline, "&", format(x[i, j]))
+
+ thisline <- paste(thisline, "\\\\ \\hline")
+ cat(paste(thisline, "\n"), file = file, append = TRUE)
+ }
+ cat(paste0("\\end{", envir, "}\n"), file = file, append = TRUE)
+}
+
diff --git a/R/misc-goodies.R b/R/misc-goodies.R
new file mode 100644
index 0000000..38aab2c
--- /dev/null
+++ b/R/misc-goodies.R
@@ -0,0 +1,1037 @@
+#### misc-goodies.R
+#### ~~~~~~~~~~~~~~ SfS - R - goodies that are NOT in
+#### "/u/sfs/R/SfS/R/u.goodies.R"
+#### "/u/sfs/R/SfS/R/p.goodies.R"
+
+###--- Original: From 'S' in /u/sfs/S/misc-goodies.S
+###--- ======== But start doing *less* here !
+
+###==================================================================
+### Functions <<<<<<<< Please use a few subsections like "Plotting"...
+###==================================================================
+
+### ___Note___ we have some of these headers __MESS__
+### But we leave it because of RCS {rather dismantle everything into 4-6 pieces
+
+##-#### Vector, Matrix (or higher Array) stuff ########
+##-### -------------------------------------- ########
+
+last <- function(x, length.out = 1, na.rm = FALSE)
+{
+ ## Purpose: last element(s) of a vector
+ ## Author: Werner Stahel, Date: Tue Jan 21 17:29:42 1992
+ ## ----------------------------------------------------------------
+ ## Arguments:
+ ## x: vector
+ ## length.out: if positive, return the length.out last elements of x,
+ ## if negative, the last length.out elements are dropped
+ ## ----------------------------------------------------------------
+ if (na.rm)
+ x <- x[!is.na(x)]
+ n <- length(x)
+ x[sign(length.out)*(n-abs(length.out)+1):n]
+}
+
+empty.dimnames <- function(a)
+{
+ ## 'Remove' all dimension names from an array for compact printing.
+ n <- length(da <- dim(a))
+ if(n == 0) return(a)
+ dimnames(a) <- lapply(1:n, function(i) rep.int("", da[i]))
+ a
+}
+
+
+##-#### Plot / Devices related stuff ########
+##-### ----------------------------- ########
+##-### >>>>> "p.goodies.S" or "ps.goodies.S" ########
+
+errbar <- function(x, y, yplus, yminus, cap = 0.015,
+ ylim = range(y, yplus, yminus),
+ xlab = deparse(substitute(x)),
+ ylab = deparse(substitute(y)), ... )
+{
+ ## Purpose: Makes a plot with error bars
+ ## Authors: Charles Geyer, Statistics, U. Chicago, geyer at galton.uchicago.edu
+ ## Martin Maechler, Date: 11 Apr 91 and Mar 27 1992, 12:32
+ ## ----------------------------------------------------------------
+ ## Arguments: --- see help(..) page ---> ?errbar
+ ## ----------------------------------------=======
+
+ plot( x, y, ylim=ylim, xlab=xlab, ylab=ylab, ... )
+ xcoord <- par()$usr[1:2]
+ segments( x, yminus, x, yplus )
+ smidge <- cap * ( xcoord[2] - xcoord[1] ) / 2
+ segments( x - smidge, yminus, x + smidge, yminus )
+ segments( x - smidge, yplus, x + smidge, yplus )
+}
+## C.Monatsname , etc.. sind jetzt bei der zugehoerigen Funktion
+## u.Datumvonheute in /u/sfs/S/u.goodies.S
+
+cum.Vert.funkt <- function(x, Quartile = TRUE, titel = TRUE, Datum = TRUE,
+ rang.axis = n <= 20, xlab = "", main = "", ...)
+{
+ ## Ziel: Kumulative Verteilung von x aufzeichnen, auf Wunsch auch Median
+ ## und Quartile
+ op <- par(xaxs = "r", yaxs = "r", las = 1)# the default anyway
+ on.exit(par(op))
+ r <- plotStep(x, xlab = xlab, main = main, ...)
+ #### FIXME : stepfun() / ecdf() instead
+ n <- length(x)
+ if(rang.axis)
+ axis(4, at = (0:n)/n, labels = 0:n, pos = par("usr")[1])#, las = 1)
+ if(titel) mtext("Kumulative Verteilungsfunktion", 3, line = 0.5)
+ if(Quartile) for(i in 1:3) abline(h = i/4, lty = 2)
+ if(Datum) p.datum()
+ invisible(r)
+}
+
+
+## This was "plot.step()" but that's in conflict with S3 methods
+plotStep <- function(ti, y,
+ cad.lag = TRUE,
+ verticals = !cad.lag,
+ left.points = cad.lag,
+ right.points = FALSE,
+ end.points = FALSE,
+
+ add = FALSE,
+
+ pch = par('pch'),
+ xlab = deparse(substitute(ti)),
+ ylab = deparse(substitute(y)),
+ main = NULL,
+ ...)
+
+#####- FIXME ----------- use stepfun(), plot.stepfun() etc !!! ----------------
+
+{
+ ## Purpose: plot step-function f(x)= sum{ y[i] * 1_[ t[i-1], t[i] ] (x) }
+ ## -------------------------------------------------------------------------
+ ## Arguments: for missing 'y', do empirical CDF; ==> ON-LINE Help "?plot.step"
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, 1990, U.Washington, Seattle; improved -- Dec.1993
+ ##
+ ## EXAMPLE: ##-- Plot empirical cdf Fn(x) for a small n:
+ ## xx <- runif(20); plot.step(xx); plot.step( xx, cad.lag = F )
+ ## plot.step( runif(20), add=T, cad.lag=F)
+ xlab
+ ylab
+ if(missing(y)) {
+ if(is.vector(ti) && is.numeric(ti)) { # -- Do empirical CDF --
+ nt <- length(ti)
+ ti <- sort(ti)
+ dt <- (ti[nt] - ti[1])/20
+ ti <- c(ti[1] - dt, ti, ti[nt] + dt)
+ n <- nt + 1
+ y <- (0:nt)/nt
+ } else {
+ xy <- xy.coords(ti,NULL,NULL,NULL)
+ ti <- c(xy$x[1], xy$x)
+ y <- xy$y
+ n <- length(y)
+ }
+ } else {
+ n <- length(y)
+ if(length(ti) != (n + 1)) stop("length(ti) MUST == length(y) + 1")
+ }
+ if(length(ti) != (n + 1) || length(y) != n)
+ stop("NEVER CALLED! --length(ti) MUST == length(y) + 1")
+ if(missing(main)) main <- deparse(sys.call())
+
+ n1 <- n+1
+ ##-- horizontal segments:
+ if (add) segments(ti[-n1], y, ti[-1], y, ...)
+ else {
+ plot(ti, c(y[1],y), type = 'n', xlab = xlab, ylab = ylab, main = main, ...)
+ segments(ti[-n1], y, ti[-1], y)
+ }
+ if(left.points) points(ti[-n1],y, pch = pch)
+ if(right.points) points(ti[-1], y, pch = pch)
+ ##-- col=0 <==> "erase" :
+ if(! end.points) points(ti[c(1,n1)], y[c(1,n)], pch = pch, col = 0)
+ if(verticals) {
+ if (add) segments(ti[2:n], y[-n], ti[2:n], y[-1], ...)
+ else segments(ti[2:n], y[-n], ti[2:n], y[-1])
+ }
+ invisible(list(t = ti, y = y))
+}
+
+histBxp <-
+ function(x, nclass, breaks, probability = FALSE, include.lowest = TRUE,
+ xlab = deparse(substitute(x)), ..., width = 0.2,
+ boxcol = 3, medcol = 2, medlwd = 5, whisklty = 2, staplelty = 1)
+{
+ ## Purpose: Plot a histogram and a boxplot
+ ## -------------------------------------------------------------------------
+ ## Arguments: ---> see help(hist.bxp) !
+ ## -------------------------------------------------------------------------
+ ## Authors: Christian Keller, Date: 10 Nov 95, (Martin Maechler, Jan 96)
+ ## calls p.hboxp(.) !
+
+ ## determine the height of the plot
+ if(missing(breaks)){
+ if(missing(nclass))
+ h <- hist(x, probability = probability, include.lowest = include.lowest,
+ plot = FALSE)
+ else
+ h <- hist(x, nclass = nclass, probability = probability,
+ include.lowest = include.lowest, plot = FALSE)
+ }
+ else
+ h <- hist(x, breaks = breaks, probability = probability,
+ include.lowest = include.lowest, plot = FALSE)
+ ymax <- max(h$counts)
+ ymin <- - ymax * width # range: (-w,1)*ymax instead of (0,1)*ymax
+
+ ##------- drawing the histogram -------------
+ hist(x, breaks = h$breaks, probability = probability,
+ include.lowest = include.lowest, plot = TRUE, xlab = xlab,
+ ylim = c(ymin, ymax), axes = FALSE, ...)
+ axis(1)
+ axis(2, at = pretty(c(0,ymax), n = 5), srt = 90) ## ph, 8.5.00: n instead of nint
+ abline(h = 0) #
+ ##-------- drawing the boxplot --------------
+
+ ##-- scale a range
+ scale.r <- function(x1,x2, fact = 1.1)
+ (x1+x2)/2 + c(-fact,fact) * (x2-x1)/2
+
+ ##-- since 4% extra space above x-axis (just below ymin):
+ ##- cat("par$usr[3:4]:", par("usr")[3:4],
+ ##- " ymin -.04 *(ymax-ymin)",ymin -.04 *(ymax-ymin),"\n")
+ ##-- NOTE: Always have (seemingly): par("usr")[3] == ymin -.04 *(ymax-ymin)
+
+##-O- ORIGINAL VERSION (Keller & Keller) :
+##-O- p.hboxp(x, ymin, -.04 *(ymax-ymin),
+##-O- boxcol=boxcol, medcol=medcol,
+##-O- medlwd=medlwd, whisklty=whisklty, staplelty=staplelty)
+
+ ##---- This is much better for width <=.1 or so...
+ ##-- but you should leave some white space -> scale down
+ ##-- The scaling factor is really a KLUDGE but works for a wide range!
+ p.hboxp(x, scale.r(par("usr")[3], 0, ## ph, 8.5.00: changed f=.9 to f=.8
+ f = .8 - max(0, .15 - width)*(1+(par("mfg")[3] >= 3))),
+ boxcol = boxcol, medcol = medcol,
+ medlwd = medlwd, whisklty = whisklty, staplelty = staplelty)
+}
+
+
+##-#### Print & Strings ########
+##-### =============== ########
+
+ccat <- ## character 'concat'
+ function(...) paste0(..., collapse = "")
+vcat <- ## (numeric) vector 'concat'
+ function(vec, sep = " ") paste(vec, collapse = sep)
+
+paste.vec <- function(name, digits = options()$digits)
+{
+ ## Purpose: Utility for "showing vectors"
+ ## -------------------------------------------------------------------------
+ ## Example: x <- 1:4; paste.vec(x) ##-> "x = 1 2 3 4"
+ paste(paste(deparse(substitute(name))), "=",
+ paste(format(name, digits = digits), collapse = " "))
+}
+signi <- function(x, digits = 6) round(x, digits - trunc(log10(abs(x))))
+
+repChar <- function(char, no) paste(rep.int(char, no), collapse = "")
+## correct, but slower than the next one:
+bl.string <- function(no) repChar(" ", no)
+## faster:
+bl.string <- function(no) sprintf("%*s", no, "")
+
+### symnum : standard R function !!
+
+wrapFormula <- function(f, data, wrapString = "s(*)")
+{
+ ## Purpose: Mainly: Construct a useful gam() formula from "Y ~ ."
+ ## ----------------------------------------------------------------------
+ ## Arguments: f : the initial formula; typically something like "Y ~ ."
+ ## data: data.frame to which the formula applies
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 22 May 2007, 18:03
+
+ form <- formula(terms(f, data = data))
+ if(length(form) != 3)
+ stop("invalid formula; need something like 'Y ~ .'")
+ wrapS <- strsplit(wrapString, "\\*")[[1]]
+ stopifnot(length(wrapS) == 2)
+ cc <- gsub("([^+ ]+)", paste0(wrapS[1], "\\1", wrapS[2]),
+ format(form[[3]]))
+ form[[3]] <- parse(text = cc, srcfile = NULL)[[1]]
+ form
+}
+
+##' Capture Output and print first and last parts, eliding middle parts.
+##' Particularly useful for teaching purposes, and e.g., in Sweave
+##'
+##' @title Capture output and Write / Print First and Last Parts
+##' @param EXPR the (literal) expression the output is to be captured
+##' @param first integer: how many lines should be printed at beginning
+##' @param last integer: how many lines should be printed at the end.
+##' @param middle numeric (or NA logical):
+##' @param i.middle index start of middle part
+##' @param dotdots string to be used for elided lines
+##' @param n.dots number of \code{dotdots} ....{FIXME}
+##' @return return value of \code{\link{capture.output}(EXPR)}
+##' @author Martin Maechler
+## -> ../man/capture-n-write.Rd
+capture.and.write <- function(EXPR, first, last = 2,
+ middle = NA, i.middle,
+ dotdots = " ....... ", n.dots = 2) {
+ co <- capture.output(EXPR)
+ writeLines(head(co, first))
+ catDots <- function(M) cat(rep.int(paste0(dotdots,"\n"), M), sep="")
+ catDots(n.dots)
+ if(is.numeric(middle)) {
+ stopifnot(length(middle) == 1, middle >= 0, middle == round(middle))
+ i0 <- first+2
+ if(missing(i.middle)) {
+ i.middle <- max(i0, length(co) %/% 2 - middle %/% 2)
+ } else { ## !missing(i.middle)
+ if(i.middle < i0)
+ stop("'i.middle' is too small, should be at least ", i0)
+ }
+ writeLines(co[i.middle-1 + seq_len(middle)])
+ catDots(n.dots)
+ }
+ writeLines(tail(co, last))
+ invisible(co)
+}
+
+
+
+##-#### "Calculus" Mathematical stuff ########
+##-### ----------------------------- ########
+
+polyn.eval <- function(coef, x)
+{
+ ## Purpose: compute coef[1] + coef[2]*x + ... + coef[p+1]* x^p
+ ## if coef is vector, x can be any array; result : of same dim. as x
+ ## if coef is matrix, x must be vector; dim(result) = len(x) * nrow(coef)
+ ## coef = matrix: evaluate SEVERAL polynomials (of same degree)
+ ## ---- contains coefficient-vectors as ROWS ==> coef[,i] <-> x^{i-1}
+ ## Author: Martin Maechler <maechler at stat.math.ethz.ch>
+ if(is.null(dim(coef))) {
+ lc <- length(coef)
+ if (lc == 0) 0 else {
+ r <- coef[lc]
+ if (lc > 1)
+ for (i in (lc-1):1) r <- coef[i] + r*x
+ r
+ }
+ } else { #-- coef is MATRIX --
+ dc <- dim(coef)
+ lc <- dc[2]; dc <- dc[1]
+ n <- length(x)
+ if (lc == 0) matrix(0, n, dc) else {
+ r <- matrix(coef[,lc], n, dc, byrow = TRUE)
+ if (lc > 1)
+ for (i in (lc-1):1) r <- r*x + matrix(coef[,i], n, dc, byrow = TRUE)
+ r
+ }
+ }
+}
+
+## negative x .. may make sense in some cases,.... but not yet :
+##digitsBase <- function(x, base = 2, ndigits = 1 + floor(log(max(abs(x)),base)))
+digitsBase <- function(x, base = 2, ndigits = 1 + floor(1e-9+ log(max(x),base)))
+{
+ ## Purpose: Give the vector A of the base-_base_ representation of _n_:
+ ## ------- n = sum_{k=0}^M A_{M-k} base ^ k , where M = length(a) - 1
+ ## Value: MATRIX M where M[,i] corresponds to x[i]
+ ## Author: Martin Maechler, Date: Wed Dec 4 14:10:27 1991
+ ## ----------------------------------------------------------------
+ ## ----> help(digitsBase) !
+ ## ------------------------------
+ if(any(x < 0))
+ stop("'x' must be non-negative integers")
+ if(any(x != trunc(x)))
+ stop("'x' must be integer-valued")
+ r <- matrix(0, nrow = ndigits, ncol = length(x))
+ if(ndigits >= 1) for (i in ndigits:1) {
+ r[i,] <- x %% base
+ if (i > 1) x <- x %/% base
+ }
+ class(r) <- "basedInt"
+ attr(r, "base") <- base
+ r
+}
+
+bi2int <- function(xlist, base)
+ vapply(xlist, function(u) polyn.eval(rev(u), base), numeric(1))
+
+as.intBase <- function(x, base = 2) {
+ xl <- if(is.character(x)) lapply(strsplit(x,""), as.integer)
+ else if(is.numeric(x) && is.matrix(x)) tapply(x, col(x), c)
+ else if(!is.list(x))
+ stop("'x' must be character, list or a digitsBase() like matrix")
+ bi2int(xl, base)
+}
+
+as.integer.basedInt <- function(x, ...)
+ as.intBase(x, base = attr(x, "base"))
+
+print.basedInt <- function (x, ...) {
+ cat(sprintf("Class 'basedInt'(base = %d) [1:%d]\n",
+ attr(x,"base"), ncol(x)))
+ cx <- x
+ attr(cx,"base") <- NULL
+ print(unclass(cx), ...)
+ invisible(x)
+}
+
+sHalton <- function(n.max, n.min = 1, base = 2, leap = 1)
+{
+ ## Purpose: Halton sequence H(k,b) for k=n.min:n.max -- for Quasi Monte Carlo
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 29 Jul 2004, 21:34
+
+ stopifnot((leap <- as.integer(leap)) >= 1)
+ ## now do this via digitsBase(), later go directly
+ nd <- as.integer(1 + log(n.max, base))
+ dB <- digitsBase(if(leap == 1) n.min:n.max else seq(n.min, n.max, by=leap),
+ base = base, ndigits = nd)
+ colSums(dB/base^(nd:1))
+}
+
+QUnif <- function(n, min = 0, max = 1, n.min = 1, p, leap = 1, silent = FALSE)
+{
+ ## Purpose: p-dimensional ''Quasi Random'' sample in [min,max]^p
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 29 Jul 2004, 21:43
+ ## Example: plot(QUnif(1000, 2), cex=.6, pch=20, xaxs='i', yaxs='i')
+ stopifnot(1 <= (n <- as.integer(n)), length(n) == 1,
+ 1 <= (p <- as.integer(p)), length(p) == 1,
+ length(min) == p || length(min) == 1,
+ length(max) == p || length(max) == 1,
+ 1 <= (n.min <- as.integer(n.min)),
+ 1 <= (leap <- as.integer(leap)),
+ (n.max <- n.min + (n - 1:1)*leap) < .Machine$integer.max)
+ pr. <- c(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,101,103,107,109,113,127,131,137,139,149,151,157,163,167,173,
+ 179,181,191, 193,197,199,211,223,227,229,233,239,241,251,257,263,
+ 269,271,277,281,283,293,307,311,313,317,331,337,347,349,353,359,
+ 367,373,379,383,389,397,401,409,419,421,431,433,439,443,449,457)
+ if(length(pr.) < p) {
+ if(!silent)
+ message("enlarging internal prime table for \"large\" p=",p)
+ Lp <- log(p)
+ pr. <- primes(p*(Lp + log(Lp))) ## using p_n/n < log n + log log n
+ }
+ pr <- pr.[1:p]
+ if(leap > 1 && any(leap == pr) && length(pr.) >= p+1) # take a non-leap pr
+ pr <- c(pr[leap != pr], pr.[p+1])
+ max <- rep.int(max, p)
+ min <- rep.int(min, p)
+ dU <- max - min
+ r <- matrix(0., n, p)
+ for(j in 1:p)
+ r[,j] <- min[j] + dU[j] *
+ sHalton(n.max, n.min, base = pr[j], leap = leap)
+ r
+}
+
+
+
+chars8bit <- function(i = 1:255)
+{
+ ## Purpose: Compute a character vector from its "ASCII" codes.
+ ## We seem to have to use this complicated way thru text and parse.
+
+ ## Author: Martin Maechler, Original date: Wed Dec 4, 1991
+ ## this is an improved version of make.ASCII() from ~/S/Good-string.S !
+ ## ----------------------------------------------------------------
+ i <- as.integer(i)
+ if(any(i < 0 | i > 255)) stop("'i' must be in 0:255")
+ if(any(i == 0))
+ warning("\\000 (= 'nul') is no longer allowed in R strings")
+ i8 <- apply(digitsBase(i, base = 8), 2, paste, collapse="")
+ c8 <- paste0('"\\', i8, '"')
+ eval(parse(text = paste0("c(",paste(c8, collapse=","),")")))
+}
+
+strcodes <- function(x, table = chars8bit(1:255))
+{
+ ## Purpose: R (code) implementation of old S's ichar()
+ ## ----------------------------------------------------------------------
+ ## Arguments: x: character vector
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 23 Oct 2003, 12:42
+
+ lapply(strsplit(x, ""), match, table = table)
+}
+
+## S-PLUS has AsciiToInt() officially, and ichar() in library(examples):
+AsciiToInt <- ichar <- function(strings) unname(unlist(strcodes(strings)))
+
+
+
+
+
+##-#### "Miscellaneous" (not any other category) ########
+##-### ============= ------------------------- ########
+
+uniqueL <- function(x, isuniq = !duplicated(x), need.sort = is.unsorted(x))
+{
+ ## return list(ix, uniq)
+ ## such that all(x == uniq[ix]) and (of course) uniq == x[isuniq]
+ if(need.sort) {
+ xs <- sort(x, index.return = TRUE)
+ ixS <- xs $ ix
+ isuniq <- isuniq[ixS]
+ x <- xs$x
+ }
+ ix <- as.integer(cumsum(isuniq))
+ if(need.sort)
+ ix <- ix[sort.list(ixS)]
+ list(ix = ix, xU = x[isuniq])
+}
+
+
+is.whole <- function(x, tolerance = sqrt(.Machine$double.eps))
+{
+ ## Tests if a numeric scalar (or vector, matrix or array) is a whole
+ ## number; returns an boolean object of the same dimension as x, each entry
+ ## indicating whether the corresponding entry in x is whole.
+ is.whole.scalar <-
+ if (is.integer(x)) {
+ function(x) TRUE
+ } else if (is.numeric(x)) {
+ function(x) isTRUE(all.equal(x, round(x), tolerance = tolerance))
+ } else if (is.complex(x)) {
+ function(x)
+ isTRUE(all.equal(Re(x), round(Re(x)), tolerance = tolerance)) &&
+ isTRUE(all.equal(Im(x), round(Im(x)), tolerance = tolerance))
+ } else stop("Input must be of type integer, numeric or complex.")
+
+ if (is.null(dim(x)))
+ vapply(x, is.whole.scalar, NA)
+ else
+ apply(x, seq_along(dim(x)), is.whole.scalar)
+}
+
+##'
+##' @title Generate Random Date/Time Sequences
+##' @param n number of entries to generate
+##' @param min, max character strings or \R objects inheriting from \code{"POSIXt"}.
+##' @return vector
+##' @author Martin Maechler
+##
+## __ NOT YET EXPORTED
+## FIXME: consider 'mean = Sys.time(), delta.tim = "1 month"'
+## ----- ==> min = mean - as.difftime(delta.tim),
+## max = mean - as.difftime(delta.tim)
+## now <- Sys.time(); del <- as.difftime(100, units="weeks")
+## rDatetime(100, now-del, now+del)
+rDatetime <- function(n, min = "1900-01-01", max = "2100-12-31") {
+ if(is.character(min) || inherits(min, "POSIXt"))
+ min <- as.POSIXct(min)
+ else stop("'min' must be string (coercable to \"POSIXct\") or \"POSIXt\" object")
+ if(is.character(max) || inherits(max, "POSIXt"))
+ max <- as.POSIXct(max)
+ else stop("'max' must be string (coercable to \"POSIXct\") or \"POSIXt\" object")
+ stopifnot(length(min) == 1, length(max) == 1)
+ structure(runif(n, as.numeric(min), as.numeric(max)),
+ class = c("POSIXct", "POSIXt"), tzone = "")
+}
+
+###
+### autoreg(), mean.cor() etc ... not yet
+###
+### if we take them, use different file !!
+
+
+
+####========== This is from /u/maechler/S/Good.S =============
+####========== --------------------------------- =============
+
+##-#### Plot / Devices related stuff ########
+##-### ----------------------------- ########
+
+mpl <- function(mat, ...) {
+ matplot(1:nrow(mat), mat, xaxt = 'n',...)
+ if(0 == length(dn <- dimnames(mat)[[1]]))
+ axis(1) else
+ axis(1, at = 1:nrow(mat), labels = dn)
+}
+
+roundfixS <- function(x, method = c("offset-round", "round+fix", "1greedy"))
+{
+ ## Purpose: y := r2i(x) with integer y *and* sum(y) == sum(x)
+ ## Author: Martin Maechler, 28 Nov 2007
+ n <- length(x)
+ x0 <- floor(x)
+ e <- x - x0 ## == (x %% 1) in [0, 1)
+ S. <- sum(e)
+ stopifnot(all.equal(S., (S <- round(S.))))
+ method <- match.arg(method)
+
+ ## The problem is equivalent to transforming
+ ## e[] \in [0,1) into f[] \in {0,1}, with sum(e) == sum(f)
+ ## Goal: transform e[] into f[] gradually, by "shifting" mass
+ ## such that the sum() remains constant
+
+ switch(method,
+ "offset-round" = {
+ ## This is going to be equivalent to
+ ## r := round(x + f) with the correct f \in [-1/2, 1/2], or
+ ## r == floor(x + f + 1/2) = floor(x + g), g \in [0, 1]
+ ##
+ ## Need sum(floor(e + g)) = S;
+ ## since sum(floor(e)) == 0, sum(floor(e+1)) == n,
+ ## we just need to floor(.) the S smallest, and ceiling(.) the others
+ if(S > 0) {
+ r <- numeric(n) # all 0; set to 1 those corresponding to large e:
+ r[sort.list(e, decreasing=TRUE)[1:S]] <- 1
+ x0 + r
+ } else x
+ }, ## end{offset-round}
+
+ "round+fix" = {
+ r <- round(e)
+ if((del <- S - sum(r)) != 0) { # need to add +/- 1 to 'del' entries
+ s <- sign(del) ## +1 or -1: add +1 only to r < x entries,
+ aD <- abs(del) ## and -1 only to r > x entries,
+ ## those with the "worst" rounding are made a bit worse
+ if(del > 0) {
+ iCand <- e > r
+ dx <- (e - r)[iCand] # > 0
+ } else { ## del < 0
+ iCand <- e < r
+ dx <- (e - x)[iCand] # > 0
+ }
+ ii <- sort.list(dx, decreasing = TRUE)[1:aD]
+ r[iCand][ii] <- r[iCand][ii] + s
+ }
+
+ return(x0 + r)
+
+ }, ## end{round+fix}
+
+ "1greedy" = {
+ ii <- e != 0
+ while(any(ii)) {
+ ci <- cumsum(ii) # used to revert u[ii] subsetting
+ m <- length(e. <- e[ii])
+ ie <- sort.list(e.) # both ends are relevant
+ left <- e.[ie[1]] < 1 - e.[ie[m]]
+ iThis <- if(left) 1 else m
+ iother <- if(left) m else 1
+ J <- which.max(ci == ie[iThis]) ## which(.)[1] but faster
+ I <- which.max(ci == ie[iother])
+ r <- x[J]
+ x[J] <- k <- if(left) floor(r) else ceiling(r)
+ mass <- r - k # if(left) > 0 else < 0
+ if(m <= 2) { # short cut and evade rounding error
+ if(m == 1) { # should happen **rarely**
+ if(!(min(abs(mass), abs(1-mass)) < 1e-10))
+ warning('m==1 in "1greedy" w/ mass not close to {0,1}')
+ } else { ## m==2
+ x[I] <- round(x[I] + mass)
+ }
+ break ## ii <- FALSE
+ }
+ else { ## m >= 3
+ e[J] <- if(left) 0 else 1
+ ii[J] <- FALSE
+ ## and move it's mass to the other end:
+ e.new <- e[I] + mass
+ if(e.new > 1)
+ stop("e[I] would be > 1 -- internal error")
+ else if(e.new < 0)
+ stop("e[I] would be < 0 -- internal error")
+ x[I] <- x[I] + mass
+ e[I] <- e.new
+ } ## m >= 3
+ } ## end{while}
+ x
+
+ }) # end{switch}
+}## roundfixS
+
+
+seqXtend <- function(x, length., method = c("simple","aim","interpolate"),
+ from = NULL, to = NULL)
+{
+ ## Purpose: produce a seq(.) covering the range of 'x' and INCLUDING x
+ ## ----------------------------------------------------------------------
+ ## Arguments:
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 28 Nov 2007, 11:09
+ x <- unique(sort(x))
+ n <- length(x)
+ method <- match.arg(method)
+ if(length. > n) {
+ if((from_is1 <- is.null(from))) from <- x[1]
+ if((from_isL <- is.null(to))) to <- x[n]
+ if(method == "interpolate") {
+ if(!from_is1) {
+ if(from > x[1])
+ stop("'from' > min(x) not allowed for method ", method)
+ x <- c(from, x)
+ }
+ if(!from_isL) {
+ if(to < x[n])
+ stop("'to' < max(x) not allowed for method ", method)
+ x <- c(x, to)
+ }
+ n <- length(x)
+ dx <- x[-1] - x[-n] ## == diff(x)
+ w <- as.numeric(x[n] - x[1]) ## == sum(dx);
+ ## as.n..(.) -> works with "Date" etc
+ nn <- length. - n ## need 'nn' new points in 'n - 1' intervals
+ ## how many in each?
+ ## Want them approximately equidistant, ie. of width ~= w / (nn + 1)
+ ## but do this smartly such that dx[i] / (k1[i] + 1) {= stepsize in interval i}
+ ## is approximately constant
+ k1 <- (nn + n-1) * dx / w - 1 ## ==> sum(k1) == nn
+ ## now "round" the k1[] such that sum(.) remains == nn
+ k <- roundfixS(k1) ## keep the right border, drop the left
+ seqI <- function(i) seq(x[i], x[i+1], length.out=k[i]+2)[-1]
+ c(x[1], unlist(lapply(1:(n-1), seqI)))
+
+ } else {
+ nn <- switch(method, "simple" = length.,
+ "aim" = length. - n + from_is1 + from_isL)
+ ## a more sophisticated 'method' would have to use iteration, *or*
+ ## interpolate between the 'x' values instead
+ ## which might be considered to be too far from seq()
+ unique(sort(c(x, seq(from, to, length.out = nn))))
+ }
+ } else x
+}## {seqXtnd}
+
+plotDS <-
+function(x, yd, ys, xlab = "", ylab = "", ylim = rrange(c(yd, ys)),
+ xpd = TRUE, do.seg = TRUE, seg.p = .95,
+ segP = list(lty = 2, lwd = 1, col = 2),
+ linP = list(lty = 1, lwd = 2.5, col = 3), ...)
+{
+ ## Purpose: Plot Data & Smooth
+ ## -------------------------------------------------------------------------
+ ## Arguments: do.seg: logical, plot "residual segments" iff T (= default).
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, 1990-1994
+ ## 2007: allow ys to be a (xs,ys)-xycoords structure, where {x[] \in xs[]}
+ if((hasMoreSmooth <- !is.numeric(ys))) {
+ ysl <- xy.coords(ys)
+ ixs <- match(x, ysl$x)
+ if(any(is.na(ixs)))
+ stop("'x' inside the 'ys' structure must contain all the observational 'x'")
+ ys <- ysl$y[ixs]
+ }
+ if(is.unsorted(x)) {
+ i <- sort.list(x)
+ x <- x[i]
+ yd <- yd[i]
+ ys <- ys[i]
+ }
+ addDefaults <- function(listArg) {
+ ## trick such that user can call 'segP = list(col = "pink")' :
+ nam <- deparse(substitute(listArg))
+ P <- as.list(formals(sys.function(sys.parent()))[[nam]])[-1] # w/o "list"
+ for(n in names(listArg)) P[[n]] <- listArg[[n]]
+ P
+ }
+
+ plot(x, yd, xlab = xlab, ylab = ylab, ylim = ylim, ...) #pch = pch,
+ if(!missing(linP))
+ linP <- addDefaults(linP)
+ if(hasMoreSmooth)
+ lines(ysl, xpd = xpd, lty = linP$lty, lwd = linP$lwd, col = linP$col)
+ else lines(x, ys, xpd = xpd, lty = linP$lty, lwd = linP$lwd, col = linP$col)
+ if(do.seg) {
+ if(!missing(segP))
+ segP <- addDefaults(segP)
+ segments(x, seg.p*ys + (1-seg.p)*yd, x, yd,
+ xpd = xpd, lty = segP$lty, lwd = segP$lwd, col = segP$col)
+ }
+ invisible()
+}
+
+
+
+##-#### Matrix (or higher Array) stuff ########
+##-### ------------------------------ ########
+
+colcenter <- function(mat) sweep(mat,2, apply(mat,2,mean))
+
+col01scale <- function(mat, scale.func = function(x) diff(range(x)),
+ location.func = mean)
+{
+ ##-- See also 'scale' (std. S func) --
+ mat <- sweep(mat,2, apply(mat,2, location.func))
+ sweep( mat, 2, apply(mat,2, scale.func), "/")
+}
+
+## diag.ex <- function(n) --- now renamed :
+diagX <- function(n)
+{
+ ## Purpose: Returns "the other diagonal" matrix
+ ## Author: Martin Maechler, Date: Tue Jan 14 1992; Nov.2002
+ ## ----------------------------------------------------------------
+ ## Arguments: n: integer dimension of matrix
+ ## ----------------------------------------------------------------
+ m <- numeric(n * n)
+ m[1+ (n-1)* (1:n)] <- 1
+ dim(m) <- c(n,n)
+ m
+}
+
+xy.grid <- function(x,y)
+{
+ ## Purpose: Produce the grid used by persp, contour, .. as N x 2 matrix
+ nx <- length(x)
+ ny <- length(y)
+ cbind(rep.int(x,rep.int(ny,nx)), rep.int(y,nx))
+}
+
+rot2 <- function(xy, phi)
+{
+ ## Purpose: rotate xy-points by angle 'phi' (in radians)
+ ## -------------------------------------------------------------------------
+ ## Arguments: xy : n x 2 matrix; phi: angle (in [0, 2pi])
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 26 Oct 94, 22:16
+ co <- cos(phi); s <- sin(phi)
+ xy %*% t( matrix(c(co,s, -s, co), 2,2) )
+}
+
+tapplySimpl <- function(X, INDEX, FUN, ...)
+{
+ ## Purpose: Nicer result for tapply(..) when Function returns
+ ## vector AND there is >= 2 "INDEX", i.e., categories.
+ ## -------------------------------------------------------------------------
+ ## Arguments: as for tapply,
+ ## FUN: Must return [named, if possible] FIXED length vector
+ ## [num/char] EVEN for NULL and NA !
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 14 Jun 93, 17:34
+ rl <- tapply(X, INDEX, FUN, ..., simplify = TRUE)
+ if (is.list(rl)) { #-- when >=2 indices AND length(FUN(x)) > 1 ---
+ if(any(Nas <- unlist(lapply(rl, is.null))))
+ rl[Nas] <- list(FUN(NULL))
+ array(unlist(rl),
+ dim = c(length(rl[[1]]), dim(rl)),
+ dimnames = c(list(names(rl[[1]])), dimnames(rl)) )
+ } else rl
+}
+
+
+##-#### "Calculus" Mathematical stuff ########
+##-### ----------------------------- ########
+
+u.log <- function(x, c = 1)
+{
+ ## Purpose: log(.) only for high x- values ... identity for low ones
+ ## This f(x) is continuously differentiable (once).
+ ## f(x) = x for |x| <= c
+ ## f(x) = sign(x)*c*(1 + log(|x|/c)) for |x| >= c
+ ## -------------------------------------------------------------------------
+ ## Arguments: x: numeric vector; c: scalar > 0
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 24 Jan 95, 17:28
+ if(!is.numeric(c)|| c < 0) stop("'c' must be positive number")
+ r <- x
+ to.log <- abs(x) > c ; x <- x[to.log]
+ r[to.log] <- sign(x) * c * (1 + log(abs(x/c)))
+ r
+}
+
+xy.unique.x <- function(x, y, w, fun.mean = mean, ...)
+{
+ ## Purpose: given 'smoother data' (x_i, y_i) [and maybe weight w_i]
+ ## with multiple x_i, use unique x's, replacing y's by their mean
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 8 Mar 93, 16:36
+ ##--*--*--*--*--*--*--*--*--*-- x,y,w treatment --*--*--*--*--*--*--*--*--
+ if(missing(x)) x <- time(y) else
+ if(missing(y)) {
+ if(is.list(x)) {
+ if(any(is.na(match(c("x", "y"), names(x)))))
+ stop("cannot find x and y in list")
+ y <- x$y; x <- x$x; if(!is.null(x$w)) w <- x$w
+ } else if(is.complex(x)) {
+ y <- Im(x); x <- Re(x)
+ } else if(is.matrix(x) && ncol(x) == 2) {
+ y <- x[, 2]; x <- x[, 1]
+ } else if(is.matrix(x) && ncol(x) == 3) {
+ y <- x[, 2]; w <- x[, 3]; x <- x[, 1]
+ } else {
+ y <- x; x <- time(x)
+ }
+ }
+ n <- length(x)
+ if(n != length(y)) stop("lengths of x and y must match")
+ if(missing(w)) w <- rep.int(1,n)
+ else if(n != length(w)) stop("lengths of x and w must match")
+ ##--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--*--
+ gr <- match(x, ux <- unique(x, ...))
+ cbind(x = ux,
+ y = tapply(y, gr, FUN = fun.mean),
+ w = tapply(w, gr, FUN = sum))
+}
+
+
+
+##-#### Non-calculus ("Discrete") Mathematical stuff ########
+##-### -------------------------------------------- ########
+
+lseq <- function(from, to, length)
+{
+ ## Purpose: seq(.) : equidistant on log scale
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 3 Feb 2005, 08:34
+ stopifnot(from > 0)
+ exp(seq(log(from), log(to), length.out = length))
+}
+
+inv.seq <- function(i) {
+ ## Purpose: 'Inverse seq': Return a short expression for the 'index' 'i'
+ ## --------------------------------------------------------------------
+ ## Arguments: i: vector of (usually increasing) integers.
+ ## --------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 3 Oct 95, 18:08
+ ## --------------------------------------------------------------------
+ ## EXAMPLES: cat(rr <- inv.seq(c(3:12, 20:24, 27, 30:33)),"\n"); eval(rr)
+ ## r2 <- inv.seq(c(20:13, 3:12, -1:-4, 27, 30:31)); eval(r2); r2
+ li <- length(i <- as.integer(i))
+ if(li == 0) return(expression(NULL))
+ else if(li == 1) return(as.expression(i))
+ ##-- now have: length(i) >= 2
+ di1 <- abs(diff(i)) == 1 #-- those are just simple sequences n1:n2 !
+ i <- i + 0 # coercion to "double", so result has no 'L' appended integers.
+ s1 <- i[!c(FALSE,di1)] # beginnings
+ s2 <- i[!c(di1,FALSE)] # endings
+ mkseq <- function(i, j) if (i==j) i else call(':', i, j)
+ as.call(c(list(as.name('c')),
+ mapply(s1, s2, FUN=mkseq, SIMPLIFY=FALSE, USE.NAMES=FALSE)))
+}
+
+iterate.lin.recursion <- function(x, coeff, delta = 0, nr.it)
+{
+ r <- c(x, numeric(nr.it))
+ n <- length(x)
+ ic <- length(coeff):1
+ for(i in 1:nr.it)
+ r[n + i] <- delta + c(coeff %*% r[n + i - ic])
+ r
+}
+
+quadrant <- function(x,y=NULL) {
+ xy <- xy.coords(x,y); x <- xy$x; y <- xy$y
+ Sgn <- function(u) ifelse(u >= 0, 1, -1)
+ y <- Sgn(y); 2 - y + (y != Sgn(x))
+}
+
+n.code <- function(n, ndig = 1, dec.codes = c("","d","c","k"))
+{
+ ##-- convert "round integers" to short char.strings
+ ##-- useful to build-up variable names in simulations
+ ##-- e.g.,
+ nd <- length(dec.codes)
+ e10 <- pmin(floor(log10(n) + 1e-12), nd - 1)
+ if (any(e10 < 0)) {
+ e10 <- pmax(0, e10) ; warning("some 'n' too small")
+ }
+ ## IDEA: Things like
+ ## ---- n.code(c(2000,1e4,5e4,6e5,7e6,8e7),
+ ## dec. = c("","d","c","k","-","-","M"))
+ ## could work; (not quite yet, see ex. above)
+##- if(any(id <- is.na(dec.codes) | dec.codes == "-")) {
+##- ## then use previous code for these (things like "20k", "300k")
+##- ## sequentially from the left:
+##- for(k in which(id)) {
+##- dec.codes[k] <- dec.codes[k - 1]
+##- ii <- 1+e10 == k
+##- e10[ii] <- e10[ii] - 1
+##- }
+##- }
+ paste0(round(n/ 10^(e10 + 1 - ndig)), dec.codes[1 + e10])
+}
+
+code2n <- function(ncod, ndig = 1, dec.codes = c("","d","c","k"))
+{
+ ## The inverse function to n.code
+ le <- nchar(ncod)
+ cod <- substring(ncod, le, le)
+ as.integer(substring(ncod, 1, le-1)) * 10^(match(cod, dec.codes)-1)
+}
+
+nr.sign.chg <- function(y)
+{
+ ## Purpose: Compute number of sign changes in sequence
+ ## Be careful with y[i] that were 0 !!
+ y <- sign(c(y))
+ y <- y[y != 0]
+ sum(y[-1] != y[-length(y)])
+}
+
+unif <- function(n, round.dig = 1 + trunc(log10(n)))
+{
+ ## Purpose: Give regular points on [-c,c] with mean 0 and variance ~= 1
+ if(n %% 2 == 0) {
+ if(n > 0) round((2 * 1:n - (n + 1)) * sqrt(3/(n * (n + 1))), round.dig)
+ } else {
+ m <- n %/% 2 #--> m+1 = (n+1)/2
+ ( - m:m) * round(sqrt(6/((m + 1) * n)), round.dig)
+ }
+}
+
+prt.DEBUG <- function(..., LEVEL = 1) {
+ stop("prt.DEBUG() is defunct: use a 'verbose' argument or options(verbose=.) instead")
+ ## if (exists("DEBUG", where = 1) && DEBUG >= LEVEL )#
+ ## ##
+ ## cat(paste0("in '", sys.call(sys.nframe()-1)[1], "':"), ..., "\n")
+}
+
+
+
+##' @title Read an Emacs Org Table by read.table()
+## --> ../man/read.org.table.Rd
+read.org.table <- function(file, header = TRUE, skip = 0, fileEncoding = "", text, ...) {
+ ## file - text handling --- cut'n'paste from read.table()'s header
+ if (missing(file) && !missing(text)) {
+ file <- textConnection(text, encoding = "UTF-8")
+ on.exit(close(file))
+ }
+ if(is.character(file)) {
+ file <- if(nzchar(fileEncoding))
+ file(file, "rt", encoding = fileEncoding) else file(file, "rt")
+ on.exit(close(file))
+ }
+ if(!inherits(file, "connection"))
+ stop("'file' must be a character string or connection")
+ if(!isOpen(file, "rt")) {
+ open(file, "rt")
+ on.exit(close(file))
+ }
+ if("encoding" %in% names(list(...)))
+ warning("'encoding' does not make sense here")
+
+ if(skip > 0L) readLines(file, skip)
+ ll <- readLines(file)
+ close(file); on.exit()
+ ## drop |--------+---------+--------+--| :
+ if(any(i <- grep("---+\\+--", ll[1:3]))) ll <- ll[-i]
+ ## drop beginning and ending "|" :
+ ll <- sub("^ *\\|", "",
+ sub("\\| *$", "", ll))
+ if(header) { ## assume header in first 2 lines
+ ii <- if(nchar(ll[1]) < 2) 2 else 1
+ ## header line
+ hl <- ll[ii]
+ ## drop header line(s)
+ ll <- ll[-seq_len(ii)]
+ ## split the header lines into column names
+ col.names <- sub("^ +", "", sub(" +$", "", strsplit(hl, " *\\| *") [[1L]]))
+ }
+ ## drop empty lines at end only
+ while(grepl("^ *$", tail(ll, 1L))) ll <- ll[-length(ll)]
+ f.ll <- textConnection(ll, encoding = "UTF-8")
+ on.exit(close(f.ll))
+ read.table(f.ll, header=FALSE, sep = "|",
+ col.names = col.names, encoding = "UTF-8", ...)
+}
diff --git a/R/missingCh.R b/R/missingCh.R
new file mode 100644
index 0000000..eb4eaa5
--- /dev/null
+++ b/R/missingCh.R
@@ -0,0 +1,5 @@
+missingCh <- function(x, envir = parent.frame()) {
+ stopifnot(is.character(x))
+ eval(substitute(missing(VAR), list(VAR=as.name(x))),
+ envir = envir)
+}
diff --git a/R/mult.fig.R b/R/mult.fig.R
new file mode 100644
index 0000000..934c9c6
--- /dev/null
+++ b/R/mult.fig.R
@@ -0,0 +1,42 @@
+mult.fig <-
+function(nr.plots, mfrow, mfcol,
+ marP = rep(0, 4), mgp = c(if(par("las") != 0) 2. else 1.5, 0.6, 0),
+ mar = marP + 0.1 + c(4,4,2,1), oma = c(0,0, tit.wid, 0),
+ main = NULL, tit.wid = if (is.null(main)) 0 else 1 + 1.5*cex.main,
+ cex.main = par("cex.main"), line.main = cex.main - 1/2,
+ col.main = par("col.main"),
+ font.main = par("font.main"),
+ ...)
+{
+ ## Purpose: 'MULTiple FIGures' incl. title and other good defaults
+ ## -------------------------------------------------------------------------
+ ## Arguments: -- Either ONE of the first 3 arguments --
+ ### =========> help(mult.fig)
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, 1990 (UW, Seattle) -- 1995
+ ## -------------------------------------------------------------------------
+
+ use.row <- missing(mfcol)
+ if (use.row)
+ if (missing(mfrow)) {
+ if (missing(nr.plots))
+ stop("must either specify 'nr.plots', 'mfrow' or 'mfcol' !")
+ else mfrow <- n2mfrow (nr.plots)
+ }
+ old.par <-
+ if(use.row) par(mfrow = mfrow, oma = oma, mar = mar, mgp= mgp)
+ else par(mfcol = mfcol, oma = oma, mar = mar, mgp= mgp)
+ ##---- now go ahead :
+ if(!is.R())
+ frame()
+ if (!is.null(main)) {# Do title *before* first plot!
+ if(is.R()) plot.new()
+ mtext(main, side = 3, outer = TRUE,
+ line = line.main,
+ cex = cex.main,
+ font = font.main, col = col.main, ...)
+ if(is.R()) par(new=TRUE)# reverse `plot.new()' above
+ }
+ invisible(list(new.par = par(c("mfrow","mfcol","oma","mar","mgp")),
+ old.par = old.par))
+}
diff --git a/R/nearcor.R b/R/nearcor.R
new file mode 100644
index 0000000..e38a0f9
--- /dev/null
+++ b/R/nearcor.R
@@ -0,0 +1,87 @@
+#### Copyright (2007) Jens Oehlschl�gel
+#### GPL licence, no warranty, use at your own risk
+
+### NOTA BENE: nearPD() in package Matrix is a new version, slightly more elegant
+### ^^^^^^^^ also using Matrix-builtin functionality
+
+nearcor <- function( # Computes the nearest correlation matrix to an approximate correlation matrix, i.e. not positive semidefinite.
+ R # n-by-n approx correlation matrix
+, eig.tol = 1.0e-6 # defines relative positiveness of eigenvalues compared to largest
+, conv.tol = 1.0e-7 # convergence tolerance for algorithm
+, posd.tol = 1.0e-8 # tolerance for enforcing positive definiteness
+, maxits = 100 # maximum number of iterations allowed
+, verbose = FALSE # set to TRUE to verbose convergence
+
+ # RETURNS list of class nearcor with components cor, iterations, converged
+){
+ if (!(is.numeric(R) && is.matrix(R) && identical(R,t(R))))
+ stop('Error: Input matrix R must be square and symmetric')
+
+ # Inf norm
+ inorm <- function(x)max(rowSums(abs(x)))
+ # Froebenius norm
+ fnorm <- function(x)sqrt(sum(diag(t(x) %*% x)))
+
+ n <- ncol(R)
+ U <- matrix(0, n, n)
+ Y <- R
+ iter <- 0
+
+ while (TRUE){
+ T <- Y - U
+
+ # PROJECT ONTO PSD MATRICES
+ e <- eigen(Y, symmetric=TRUE)
+ Q <- e$vectors
+ d <- e$values
+ D <- diag(d)
+
+ # create mask from relative positive eigenvalues
+ p <- (d>eig.tol*d[1]);
+
+ # use p mask to only compute 'positive' part
+ X <- Q[,p,drop=FALSE] %*% D[p,p,drop=FALSE] %*% t(Q[,p,drop=FALSE])
+
+ # UPDATE DYKSTRA'S CORRECTION
+ U <- X - T
+
+ # PROJECT ONTO UNIT DIAG MATRICES
+ X <- (X + t(X))/2
+ diag(X) <- 1
+
+ conv <- inorm(Y-X) / inorm(Y)
+ iter <- iter + 1
+ if (verbose)
+ cat("iter=", iter, " conv=", conv, "\n", sep="")
+
+ if (conv <= conv.tol){
+ converged <- TRUE
+ break
+ }else if (iter==maxits){
+ warning(paste("nearcor did not converge in", iter, "iterations"))
+ converged <- FALSE
+ break
+ }
+ Y <- X
+ }
+ X <- (X + t(X))/2
+ # begin from posdefify(sfsmisc)
+ e <- eigen(X, symmetric = TRUE)
+ d <- e$values
+ Eps <- posd.tol * abs(d[1])
+ if (d[n] < Eps) {
+ d[d < Eps] <- Eps
+ Q <- e$vectors
+ o.diag <- diag(X)
+ X <- Q %*% (d * t(Q))
+ D <- sqrt(pmax(Eps, o.diag)/diag(X))
+ X[] <- D * X * rep(D, each = n)
+ ## force symmetry
+ X <- (X + t(X))/2
+ }
+ # end from posdefify(sfsmisc)
+ diag(X) <- 1
+ ret <- list(cor=X, fnorm=fnorm(R-X), iterations=iter, converged=converged)
+ class(ret) <- "nearcor"
+ ret
+}
diff --git a/R/p.goodies.R b/R/p.goodies.R
new file mode 100644
index 0000000..d684dd4
--- /dev/null
+++ b/R/p.goodies.R
@@ -0,0 +1,236 @@
+#### Original is /u/sfs/S/p.goodies.S [v 1.12 1999/05/06 10:17:00 sfs Exp ]
+####
+### p.goodies.S ---- SfS- S(plus) - Funktionen, welche
+### ---------------- mit 'p.' (f�r "Plot") beginnen [alte SfS-Tradition ..]
+### == =
+###
+### see also "/u/sfs/S/u.goodies.S"
+### "/u/sfs/S/f.goodies.S"
+### "/u/sfs/S/misc-goodies.S"
+###
+
+### **********************
+### INHALT von p.goodies.S (bitte jeweils ergaenzen):
+### **********************
+
+### p.clear Bildschirm "putzen"
+### p.datum Deutsches Datum "unten rechts"
+### p.dchisq \
+### p.dgamma > Dichten plotten
+### p.dnorm /
+### p.pairs 'pairs' mit mehr Moeglichkeiten
+### p.pllines
+### p.lm.hyperb --> ./linesHyberb.lm.R
+### p.scales
+### p.two.forget
+### p.two.res
+
+### p.profileTraces Profil-Spuren fuer Nichtlineare Regression
+### p.hboxp Horizontale Boxplots
+### p.arrows Nicer arrows(): FILLED arrow heads
+###
+### ==========================================================================
+
+p.datum <- function(outer = FALSE, cex = 0.75, ...)
+ mtext(u.Datumvonheute(...), 4, cex = cex, adj = 0, outer = outer, las = 0)
+
+
+## ===========================================================================
+
+## curve(.. xlim..) only satisfactory from R version 1.2 on ..
+p.dchisq <- function(nu, h0.col = "light gray", ...) {
+ x <- NULL # against codetools' FP warning
+ curve(dchisq(x, nu), xlim= qchisq(c(1e-5,.999), nu),
+ ylab = paste("dchisq(x, nu=",format(nu),")"), ...)
+ abline(h=0, col = h0.col)
+}
+
+p.dgamma <- function(shape, h0.col = "light gray", ...) {
+ x <- NULL # against codetools' FP warning
+ curve(dgamma(x, shape), xlim= qgamma(c(1e-5,.999), shape),
+ ylab = paste("dgamma(x, shape=",format(shape),")"), ...)
+ abline(h=0, col = h0.col)
+}
+
+p.dnorm <- function(mu = 0, s = 1, h0.col = "light gray",
+ ms.lines = TRUE, ms.col = "gray", ...)
+{
+ f <- function(x) dnorm(x, mu, s)
+ curve(f, xlim = qnorm(c(1e-5, 0.999), mu, s),
+ ylab = substitute(phi(x, mu == m, sigma == ss),
+ list(m=format(mu), ss=format(s))), ...)
+ abline(h=0, col = h0.col)
+ if(ms.lines) {
+ segments(mu,0, mu, f(mu), col=ms.col)
+ f.ms <- f(mu-s)
+ arrows(mu-s, f.ms, mu+s, f.ms, length= 1/8, code= 3, col=ms.col)
+ text(mu+c(-s/2,s/2), f.ms, expression(-sigma, +sigma), adj=c(.5,0))
+ }
+}
+
+p.m <- function(mat, ...)
+ matplot(mat[, 1], mat[, -1, drop = FALSE], ...)
+
+## ===========================================================================
+
+p.scales <- function(unit = relsysize * 2.54 * min(pin), relsysize = 0.05)
+{
+ ## Fn.name: p.scales
+ ## Purpose: Conversion between plot scales: usr, cm, symbol
+ ## Author: W. Stahel , Date: May/90; updated: M.Mae. 9/93
+ ## ----------------------------------------------------------------
+ ## Arguments:
+ ## unit: length of unit (or x and y units) of symbol coordinates in cm
+ ## relsysize: same, as a proportion of the plotting area
+ ## ----------------------------------------------------------------
+ usr <- par("usr")
+ pin <- par("pin")
+ usr2cm <- (2.54 * pin)/(usr[c(2, 4)] - usr[c(1, 3)])
+ names(usr2cm) <- c("x", "y")
+ cbind(sy2usr = unit/usr2cm,
+ usr2cm = usr2cm)
+}
+
+
+
+p.profileTraces <-
+ function(x, cex=1, subtitle=paste("t-Profiles and traces of ",
+ deparse(attr(x,"summary")$formula)))
+{
+ nx <- names(x)
+ np <- length(x)
+ opar <- par(oma = c(2, 2, 1.5, 0), mfrow = c(np, np),
+ mar = c(2,4, 0, 0) + 0.2)
+ on.exit(par(opar))
+ for (i in 1:np) {
+ for (j in 1:i) {
+ if (i == j) { ## Diagonale : Profil t-Funktionen
+ if (!is.null(this.comp <- x[[i]])) {
+ xx <- this.comp$par[, nx[i]]
+ tau <- this.comp[[1]]
+ plot(spline(xx, tau), xlab = "", ylab = "",
+ type = "l", las = 1, mgp = c(3, 0.8, 0),
+ cex = 0.5 * cex)
+ points(xx[tau == 0], 0, pch = 3)
+ pusr <- par("usr")
+ ## "at = " muss anders sein R & SPlus
+ if(is.R()) { ## mtext(outer = TRUE, at= <NICHT "usr" Koord>):
+ mtext(side = 1, line = 0.8, at = -1/(2*np)+i/np,
+ text = nx[j] , outer = TRUE, cex = cex)
+ mtext(side = 2, line = 0.8, at = 1+1/(2*np)-i/np,
+ text = nx[i], outer = TRUE, cex = cex)
+ }
+ else {
+ mtext(side = 1, line = 0.8, at = mean(pusr[1:2]),
+ text = nx[j] , outer = TRUE, cex = cex)
+ mtext(side = 2, line = 0.8, at = mean(pusr[3:4]),
+ text = nx[i], outer = TRUE, cex = cex)
+ }
+ }
+ }
+ else { ## j < i : Likelihood Profilspuren
+ if ((!is.null(x.comp <- x[[j]])) & (!is.null(y.comp <- x[[i]]))) {
+ xx <- x.comp$par[, nx[j]]
+ xy <- x.comp$par[, nx[i]]
+ yx <- y.comp$par[, nx[j]]
+ yy <- y.comp$par[, nx[i]]
+ plot(xx, xy, xlab = "", ylab = "", las = 1,
+ mgp = c(3, 0.8, 0), type = "n",
+ xlim = range(c(xx, yx)),
+ ylim = range(c(xy, yy)), cex = 0.5 * cex)
+ lines(xx, xy, col = 2)
+ lines(yx, yy, col = 3)
+ }
+ }
+ }
+ if (i < np) # frame()s: S-plus braucht h�ufig eines mehr :
+ for (k in 1:(np - i + if(is.R()) 0 else 1)) frame()
+ }
+ mtext(side = 3, line = 0.2, text = subtitle,
+ outer = TRUE, cex = 1.2 * cex)
+}
+
+## Test Beispiel :
+
+## --> /u/sfs/ueb/fortgeschrittene/loesungen/loes-rg.truthennen.R
+
+## mainly auxiliary of hist.bxp() :
+p.hboxp <- function(x, y.lo, y.hi, boxcol = 3, medcol = 2,
+ medlwd = 5, whisklty = 2, staplelty = 1)
+{
+ if(missing(y.hi) && length(y.lo) == 2) { y.hi <- y.lo[2]; y.lo <- y.lo[1] }
+ ## should test y.lo < y.hi, both to be numbers...
+
+ ##--- 2nd set of Defaults (by setting the args to NA) :
+ if(is.na(medcol)) medcol <- par("col")
+ if(is.na(medlwd)) medlwd <- par("lwd")
+ if(is.na(whisklty)) whisklty <- par("lty")
+ if(is.na(staplelty)) staplelty <- par("lty") #
+
+ b <- boxplot(x, plot = FALSE)
+ st <- c(b$stats)## names(st) <- c("max","Q3","med","Q1","min")
+
+ ##-------- drawing the boxplot --------------
+ ## coordinates :
+ m <- (y.hi + y.lo)/2
+ llhh <- c(y.lo, y.lo, y.hi, y.hi)
+ ## drawing the box
+ polygon(c(st[4], st[2], st[2], st[4]), llhh,
+ col = ifelse(boxcol == 0, par("col"), boxcol), lty = 1,
+ density = ifelse(boxcol == 0, 0, -1)) #
+ ## Median
+ lines(rep.int(st[3], 2), c(y.lo, y.hi),
+ col = ifelse(boxcol == 0 && missing(medcol), par("col"), medcol),
+ lwd = medlwd, lty = 1) #
+ ## Border of the box
+ lines(c(st[4], st[2], st[2], st[4]), llhh,
+ col = ifelse(boxcol == 0, par("col"), boxcol), lty = 1) #
+ ## Whiskers
+ lines(c(st[1:2], NA, st[4:5]), rep.int(m, 5), lty = whisklty) #
+ ## Staples
+ k <- .01 * diff(range(x))
+ lines(st[1]+ c(-k, 0, 0, -k), llhh, lty = staplelty)
+ lines(st[5]+ c( k, 0, 0, k), llhh, lty = staplelty)#
+ ## Outliers
+ for(out in b$out)
+ lines(rep.int(out, 2), c(y.lo, y.hi), lty = staplelty)
+}
+
+
+
+p.arrows <- function(x1, y1, x2, y2,
+ size=1, width = (sqrt(5)-1)/4/cin, fill = 2, ...)
+{
+ ## Purpose: Nicer arrows(): FILLED arrow heads
+ ## -------------------------------------------------------------------------
+ ## Arguments: size: symbol size as a fraction of a character height
+ ## width: width of the Arrow Head
+ ## ...: further arguments for the segment routine
+ ## Author: Andreas Ruckstuhl, Date: 19 May 94; Cosmetic by MM: June'98
+ ## -------------------------------------------------------------------------
+ cin <- size*par("cin")[2] ## vertical symbol size in inches
+ uin <- if(is.R()) 1/xyinch() else par("uin") ## inches per usr unit
+
+ segments(x1, y1, x2, y2, ...)
+
+ ## Create coordinate of a polygon for a ``unit arrow head'':
+ x <- sqrt(seq(0, cin^2, length=floor(35*cin)+2))
+ delta <- 0.005/2.54 # ? 2.54cm = 1 in
+ x.arr <- c(-x, -rev(x))
+ wx2 <- width* x^2
+ y.arr <- c(- wx2 - delta, rev(wx2) + delta)
+ ## Polar(x.., y..):
+ deg.arr <- c(atan2(y.arr, x.arr), NA)# - NA to 'break' long polygon
+ r.arr <- c(sqrt(x.arr^2 + y.arr^2), NA)
+
+ ## Draw Arrow Head at (x2,y2)
+ theta <- atan2((y2-y1)*uin[2], (x2-x1)*uin[1])
+ lx <- length(x1)
+ Rep <- rep.int(length(deg.arr), lx)
+ x2 <- rep.int(x2, Rep)
+ y2 <- rep.int(y2, Rep)
+ theta <- rep.int(theta, Rep) + rep.int(deg.arr, lx)
+ r.arr <- rep.int(r.arr, lx)
+ polygon(x2+ r.arr*cos(theta)/uin[1],
+ y2+ r.arr*sin(theta)/uin[2], col= fill)
+}
diff --git a/R/p.res.2x.WSt.R b/R/p.res.2x.WSt.R
new file mode 100644
index 0000000..56a303d
--- /dev/null
+++ b/R/p.res.2x.WSt.R
@@ -0,0 +1,194 @@
+#### was part of ./p.goodies.R
+
+### Exports :
+
+### p.res.2x Werner Stahels Plot; z.B Residuen gegen 2 x-Var.
+### p.res.2fact Aehnliche Idee: Residuen gegen 2 Faktoren (boxplots)
+
+## p.wstPlot <- function(...)
+## {
+## warning("\n\n*** p.wstPlot(.) heisst neu p.res.2x(.)\n** Diese verwenden!\n")
+## p.res.2x(...)
+## }
+
+p.res.2x <- function(x, ...) UseMethod("p.res.2x")
+
+p.res.2x.default <-
+ function(x, y, z, restricted = NULL, size = 1, slwd = 1, scol = 2:3,
+ xlab = NULL, ylab = NULL, main = NULL,
+ xlim = range(x), ylim = range(y), ...)
+{
+ ## Purpose: Stahels Residuen-Plot
+ ## Author: ARu , Date: 11/Jun/91
+ ## Aenderungen: MMae, 30/Jan/92, Dez.94 --> help(p.res.2x)
+ if(is.null(xlab)) xlab <- deparse(substitute(x))
+ if(is.null(ylab)) ylab <- deparse(substitute(y))
+ if(is.null(main)) main <- deparse(substitute(z))
+
+ ok <- !(is.na(x) | is.na(y) | is.na(z))
+ x <- x[ok]; y <- y[ok]; z <- z[ok]
+ ##
+ ##--- restrict z values: ---
+ az <- abs(z)
+ has.restr <-
+ if(is.null(restricted)) FALSE else any(restr <- az > restricted)
+ if(has.restr) {
+ z[z > restricted] <- restricted
+ z[z < - restricted] <- - restricted
+ }
+
+ ##--- fix plot region: ---
+ pcm <- par("pin") * 2.54 #damit in cm
+ ##--- damit im Plot das Symbol wirklich die Groesse size hat:
+ size <- size/(2 * sqrt(2))
+ fx <- (size * diff(xlim))/(pcm[1] - 2 * size)/2
+ fy <- (size * diff(ylim))/(pcm[2] - 2 * size)/2
+ ##--
+ plot(x, y, xlim = xlim + c(-1,1)* fx, ylim = ylim + c(-1,1)* fy, pch = ".",
+ xlab = xlab, ylab = ylab, main = main, ...)
+
+ ##--- draw symbols: ---
+ z <- z/max(az, na.rm = TRUE)
+ usr <- par("usr")
+ sxz <- diff(usr[1:2])/pcm[1] * size * z
+ syz <- abs(diff(usr[3:4])/pcm[2] * size * z)
+ if(length(scol) == 2) scol <- scol[1 + as.integer(z < 0)]
+ segments(x - sxz, y - syz, x + sxz, y + syz, lwd = slwd, col = scol)
+
+ ##--- mark restricted observations: ---
+ if(has.restr) {
+ points((x - sxz)[restr], (y - syz)[restr], pch = 8, mkh = 1/40)
+ points((x + sxz)[restr], (y + syz)[restr], pch = 8, mkh = 1/40)
+ }
+ invisible()
+}
+
+## graphics:::mosaicplot.formula as an example
+p.res.2x.formula <- function(x = ~., data,
+ main = deparse(substitute(data)),
+ xlab = NULL, ylab = NULL, ...)
+{
+ ## Purpose: plot residuals vs. two x's
+ ## Author: ARu , Date: 11/Jun/91
+ ## Aenderungen: MMae, 30/Jan/92, Dez.94 / WSt
+ ## --------------------------------------------------------------------------
+ ## Arguments:
+ ## x formula defining the variables zu be used, either
+ ## z ~ x + y
+ ## ~ x + y in this case, data must inherit from lm ,
+ ## and the residuals of data will be used as z .
+ ## data a data.frame or an lm or aov object.
+ ## In the latter case, p.res.2x will look for the data
+ ## that was used to fit the model.
+ ## restricted absolute value which truncates the size.
+ ## The corresponding symbols are marked by stars.
+ ## size the symbols are scaled so that 'size' is the size of
+ ## the largest symbol in cm.
+ ## slwd, scol line width and color to be used for the symbols
+ ## ... additional arguments for the S-function 'plot'
+ ## EXAMPLE :
+ ## g.res2x(zz~.,data=data.frame(xx=rep(1:10,7),yy=rep(1:7, rep(10,7)),
+ ## zz=rnorm(70)), restr = 2, main = "i.i.d. N(0,1) random residuals")
+ ## --------------------------------------------------------------------------
+ if(miss.main <- missing(main))
+ force(main)
+ formula <- as.formula(x)
+ t.d <- if(inherits(data, "lm")) {
+ if(miss.main) main <- paste0("residuals(", main, ")")
+ if(!is.data.frame(t.d <- data$model)) {
+ ## try to look for the data that was used to fit the model.
+ cl <- data$call
+ i <- if("data" %in% names(cl)) "data" else 3 # try ..
+ t.d <- get(as.character(cl[[i]]))
+ }
+ if (length(formula) < 3) {
+ if(identical(format(formula), "~.")) formula <- formula(data)
+ formula <- update.formula(formula, residuals ~ .)
+ ## formula <- substitute(residuals ~ RHS, list(RHS = formula[[2]]))
+ cbind(t.d, residuals = residuals(data))
+ } else t.d
+ } else
+ data
+ if (!is.data.frame(t.d)) {
+ if(is.matrix(data)) data <- as.data.frame(data) else
+ stop("data is not a data frame or 'lm' object with 'model' or existing data")
+ }
+ t.d <- na.omit(model.frame(formula, t.d))
+ z <- t.d[,1]
+ x <- t.d[,2]; if(is.null(xlab)) xlab <- names(t.d)[2]
+ y <- t.d[,3]; if(is.null(ylab)) ylab <- names(t.d)[3]
+ if(is.factor(x) && is.factor(y))
+ p.res.2fact(x, y, z, main=main, xlab=xlab, ylab=ylab, ...)
+ else {
+ x <- as.numeric(t.d[,2])
+ y <- as.numeric(t.d[,3])
+ p.res.2x.default(x,y,z, main=main, xlab=xlab, ylab=ylab, ...)
+ }
+}
+
+p.res.2fact <-
+ function(x, y, z, restricted, notch = FALSE,
+ xlab = NULL, ylab = NULL, main = NULL)
+{
+ if(is.null(xlab)) xlab <- deparse(substitute(x))
+ if(is.null(ylab)) ylab <- deparse(substitute(y))
+ if(is.null(main)) main <- deparse(substitute(z))
+
+ ok <- !(is.na(x) | is.na(y) | is.na(z))
+ x <- x[ok]; y <- y[ok]; z <- z[ok]
+ x <- as.factor(x)
+ y <- as.factor(y)
+ lx <- levels(x); ly <- levels(y)
+
+ ##--- restrict z values: ---
+ if(missing(restricted)) restr <- FALSE
+ else {
+ if(!is.numeric(restricted) || restricted <= 0)
+ stop("'restricted' must be POSITIVE !")
+ if(any(restr <- abs(z) > restricted)) {
+ zorig <- z
+ z[z > restricted] <- restricted
+ z[z < -restricted] <- - restricted
+ }
+ }
+ rz <- range(z)
+ op <- par(mfrow = c(length(ly), 1), oma = c(5,6,6,0), mar = .1 + c(2,4,0,1))
+ on.exit(par(op))
+ for (yv in rev(ly)) {
+ Ind <- y == yv
+ plot (x[Ind], z[Ind], ylim = rz, xlab = "", ylab = yv, notch = notch)
+ abline(h = 0, lty = 3, lwd = 0)
+ if(any(II <- restr & Ind)) {
+ ## boxplot creates a coord.system with x = [-4, 104]
+ jx <- as.numeric(x[II]) #-- in 1:length(lx)..
+ cat("..Cut z=",format(zorig[II])," at ",
+ xlab,"=",x[II],", ", ylab, "=",yv,"\n")
+ points( u.boxplot.x(length(lx),jx) , z[II]*1.02, pch = 8, mkh = 1/25)
+ }
+ }
+ mtext (xlab, side = 1, line = 1, outer = TRUE, cex = 1.3)
+ mtext (ylab, side = 2, line = 3, outer = TRUE, cex = 1.3)
+ mtext (main, side = 3, line = 2, cex = 1.5, outer = TRUE)
+ if(any(restr)) message(sum(restr), " restricted observation(s)")
+ invisible()
+}
+
+
+## Not sure if I want this (as global function).
+## I had eliminated it long ago (from "SfS") but it's used above:
+
+u.boxplot.x <- function(n, j = 1:n, fullrange = 100)
+{
+ ## Purpose: Return the j-th x-coordinates in an 'n' side-by-side boxplot
+ ## -------------------------------------------------------------------------
+ ## Arguments: n : number of boxplots; j: indices of boxplots
+ ## fullrange: x-coords as 'uniform' in [0,fullrange] (f.=100, Splus 3.1,3.2)
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 19 Jan 95, 17:57
+ cn <- fullrange/(3*n*(n+1))
+ Dn <- cn*(3*n+2) ## Delta_{n}
+ an <- cn*(2*n+1) ## a_{n}
+ ## x(j) = an + (j-1)*Dn :
+ an + (j-1)*Dn
+}
+
diff --git a/R/p.res.2x.formula.R b/R/p.res.2x.formula.R
new file mode 100644
index 0000000..4939523
--- /dev/null
+++ b/R/p.res.2x.formula.R
@@ -0,0 +1,54 @@
+if(FALSE) ##: This is not yet ready for prime time
+## NOTE we have had p.res.2x(x,y,z, ...) forever in --> ./p.res.2x.WSt.R
+## --- ~~~~~~~~~ ------- ~~~~~~~~~~~~~~~
+p.res.2x.formula <- ## Change the name ; no 'lm'
+ ## take graphics:::mosaicplot.formula() as example
+function(formula = ~., data, restricted = NULL, size = 1,
+ slwd = 1, scol = 2,
+ xlab = NULL, ylab = NULL, xlim = NULL, ylim = NULL, ...)
+{
+ ## Purpose: plot residuals vs. two x's
+ ## Author: ARu , Date: 11/Jun/91
+ ## Aenderungen: MMae, 30/Jan/92, Dez.94 / WSt
+ ## --------------------------------------------------------------------------
+ ## Arguments:
+ ## formula formula defining the variables zu be used, either
+ ## z ~ x + y
+ ## ~ x + y in this case, data must inherit from lm ,
+ ## and the residuals of data will be used as z .
+ ## data a data.frame or an lm or aov object.
+ ## In the latter case, g.rex2x will look for the data
+ ## that was used to fit the model.
+ ## restricted absolute value which truncates the size.
+ ## The corresponding symbols are marked by stars.
+ ## size the symbols are scaled so that 'size' is the size of
+ ## the largest symbol in cm.
+ ## slwd, scol line width and color to be used for the symbols
+ ## ... additional arguments for the S-function 'plot'
+ ## EXAMPLE :
+ ## g.res2x(zz~.,data=data.frame(xx=rep(1:10,7),yy=rep(1:7, rep(10,7)),
+ ## zz=rnorm(70)), restr = 2, main = "i.i.d. N(0,1) random residuals")
+ ## --------------------------------------------------------------------------
+ formula <- as.formula(formula)
+ if (inherits(data,"lm")) {
+ t.d <- get(as.character(data$call[3]))
+ if (length(formula) < 3) {
+ formula <- update.formula(formula,residuals~.)
+ t.d <- f.merge1(t.d,resid(data),namefrom = "residuals")
+ }
+ } else t.d <- data
+ if (!is.data.frame(t.d)) {
+ if(is.matrix(data)) data <- as.data.frame(data) else
+ stop("data is not a data frame or 'lm' object")
+ }
+ t.d <- na.omit(model.frame(formula, t.d))
+ z <- t.d[,1]
+ x <- as.numeric(t.d[,2])
+ y <- as.numeric(t.d[,3])
+ if(is.null(xlab)) xlab <- names(t.d)[2]
+ if(is.null(ylab)) ylab <- names(t.d)[3]
+
+ p.res.2x.numeric(x,y,z, restricted=restricted, size=size, slwd=slwd, scol=scol,
+ xlab=xlab, ylab=ylab, xlim=xlim, ylim=ylim, ...)
+}
+
diff --git a/R/p.tachoPlot.R b/R/p.tachoPlot.R
new file mode 100644
index 0000000..83e40af
--- /dev/null
+++ b/R/p.tachoPlot.R
@@ -0,0 +1,98 @@
+p.tachoPlot <- function(x, y, z, angle= c(pi/4,3*pi/4), size,
+ method= c("robust", "sensitive", "rank"),
+ legend = TRUE, show.method= legend,
+ xlab= deparse(substitute(x)),
+ ylab= deparse(substitute(y)), xlim, ylim, ...)
+{
+ ## Purpose: Puts a symbol (pointer) on a plot at each of the
+ ## specified locations.
+ ## -------------------------------------------------------------------------
+ ## Arguments: see on-line help (?p.tachoPlot)
+ ## -------------------------------------------------------------------------
+ ## Author: Christian Keller, Date: 16 Jun 95, 18:35
+
+ if(length(angle) != 2)
+ stop("length of angle must be 2")
+ if(angle[1]<=0 | angle[1]>=pi/2)
+ stop("angle[1] should be between 0 and pi/2")
+ if(angle[2]<=pi/2 | angle[2]>=pi)
+ stop("angle[2] should be between pi/2 and pi")
+
+ method <- match.arg(method)
+
+ xlab ; ylab ## eval substitute(.) now
+
+ ii <- !is.na(x) & !is.na(y)
+ x <- x[ii]; y <- y[ii]; z <- z[ii]
+
+ if(method=="sensitive"){
+ Min <- min(z, na.rm=TRUE)
+ Max <- max(z, na.rm=TRUE)
+ b <- (z-Min)/(Max-Min)
+ }
+ else if(method=="robust"){
+ Range <- rrange(z)
+ Min <- Range[1]
+ Max <- Range[2]
+ b <- pmin(pmax(z-Min,0),Max-Min)/(Max-Min)
+ }
+ else if(method=="rank"){
+ Min <- min(z, na.rm=TRUE)
+ Max <- max(z, na.rm=TRUE)
+ Rank <- replace(rep(NA,length(z)), !is.na(z), rank(z[!is.na(z)]))
+ b <- (Rank-1)/(sum(!is.na(z))-1)
+ } else stop("unknown method (impossible)")
+
+ ## -- range of the Plot
+ range.x <- range(x)
+ range.y <- range(y)
+ pcm <- par("pin") * 2.54
+ if(missing(size))
+ size <- min(pcm)/20
+ else {
+ if(length(size) != 1)
+ stop("length of size must be 1")
+ }
+ size <- size/2
+ sx <- size*max(c(abs(cos(pi-angle[1])),abs(cos(pi-angle[2]))))
+ sy <- size*max(c(abs(sin(pi-angle[1])),abs(sin(pi-angle[2]))))
+ fx <- sx*diff(range.x)/(pcm[1]-2*size)
+ fy <- sy*diff(range.y)/(pcm[2]-2*size)
+
+ if(missing(xlim)) xlim <- range.x + c(-1,1)*fx
+ if(missing(ylim)) ylim <- range.y + c(-1,1)*fy
+ plot(x, y, pch=".", xlim=xlim, ylim=ylim, xlab=xlab, ylab=ylab, ...)
+
+ ## -- calculate angles
+ alpha <- angle[1] + (angle[2]-angle[1])*b
+ usr <- par("usr")
+ xd <- size*cos(pi-alpha)*diff(usr[1:2])/pcm[1]
+ yd <- size*sin(pi-alpha)*diff(usr[3:4])/pcm[2]
+
+ ## -- draw symbols
+ if(method == "robust"){
+ out <- z<Min | z>Max
+ segments((x+xd)[!out],(y+yd)[!out], (x-xd)[!out], (y-yd)[!out], lty=1)
+ if(any(out,na.rm=TRUE)) {
+ segments((x+xd)[out],(y+yd)[out], (x-xd)[out], (y-yd)[out], lty=2,col=2)
+ }
+ }
+ else{
+ segments(x+xd, y+yd, x-xd, y-yd, lty=1)
+ }
+ if(legend){## -- draw legend
+ cxy <- par("cxy")
+ x1 <- min(pcm)/20*cos(pi-angle[1])*diff(usr[1:2])/pcm[1]
+ x2 <- min(pcm)/20*cos(pi-angle[2])*diff(usr[1:2])/pcm[1]
+ y1 <- min(pcm)/20*sin(pi-angle[1])*diff(usr[3:4])/pcm[2]
+ y2 <- min(pcm)/20*sin(pi-angle[2])*diff(usr[3:4])/pcm[2]
+ x <- usr[2] - 3*cxy[1] - x2
+ y <- cxy[2] + usr[4]
+ lines(c(x+x1,x,x+x2), c(y+y1,y,y+y2), lty=1, xpd=TRUE)
+ text(x+x2, y, labels=formatC(Max), adj=0, cex=0.8*par("cex"), xpd=TRUE)
+ text(x+x1, y, labels=formatC(Min), adj=1, cex=0.8*par("cex"), xpd=TRUE)
+ }
+ if(show.method) ## -- print method name
+ mtext(paste("method =",method),line=0, adj=1, cex=0.8*par("cex"))
+ invisible()
+}
diff --git a/R/p.ts.R b/R/p.ts.R
new file mode 100644
index 0000000..55eec17
--- /dev/null
+++ b/R/p.ts.R
@@ -0,0 +1,97 @@
+p.ts <-
+ function(x, nrplots = max(1, min(8, n%/%400)), overlap = nk %/% 16,
+ date.x = NULL, do.x.axis = !is.null(date.x), do.x.rug = FALSE,
+ ax.format, main.tit = NULL, ylim = NULL, ylab = "", xlab = "Time",
+ quiet = FALSE, mgp = c(1.25, .5, 0), ...)
+{
+ ## Purpose: plot.ts with multi-plots + Auto-Title -- currently all on 1 page
+ ## -------------------------------------------------------------------------
+ ## Arguments: x : timeseries [ts,rts,its,cts] or numeric vector
+ ## nrplots: number of sub-plots [DEFAULT: in {1..8}, ~= n/400]
+ ## overlap: how much should subsequent plots overlap [DEFAULT:..]
+ ##
+ ## Depends on mult.fig()
+ ##
+ ## ---> help page ?p.ts
+ ##
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 1 Jul 1994; 18 Dec 1998.
+
+ if(is.null(main.tit)) main.tit <- paste(deparse(substitute(x)))
+ isMat <- is.matrix(x)
+ n <- if(isMat) nrow(x) else length(x)
+ has.date.x <- !is.null(date.x)
+ if(do.x.axis && !has.date.x)
+ stop("'do.x.axis' is true, but 'date.x' is NULL")
+ if(has.date.x) {
+ if(n != length(date.x))
+ stop("'date.x' must be date vector of the same length as series")
+ if(do.x.axis)
+ date.x <- as.POSIXct(date.x) # work, or give error now
+ if(is.unsorted(date.x, na.rm=TRUE)) {
+ i <- order(date.x)
+ x <- if(isMat) x[i,] else x[i]
+ date.x <- date.x[i]
+ }
+ xaxt <- "n"
+ } else xaxt <- par("xaxt")
+ if(nrplots == 1) {
+ if(has.date.x) {
+ plot(date.x, x, ..., ylim = ylim, type = 'l',
+ main = main.tit, xlab = xlab, ylab = ylab, xaxt = xaxt)
+ if(do.x.axis) axis.POSIXct(1, x = date.x, format = ax.format)
+ }
+ else
+ plot.ts(x, ..., ylim = ylim,
+ main = main.tit, xlab = xlab, ylab = ylab, xaxt = xaxt)
+ }
+ else if(nrplots <= 0)
+ return(nrplots)
+ else { # nrplots >= 2 :
+ if(n <= 1) stop("`x' must have at least two points!")
+ if(!is.ts(x)) x <- as.ts(x)
+ ##- do.dates <- !is.null(class(x)) && class(x) == "cts"
+ ##- if(do.dates) x <- as.rts(x)# dates() as below fails [S+ 3.4]
+ ## NB: end() and start() are of length 1 _or_ 2 (!)
+ scal <- (end(x) - (t1 <- start(x))) / (n-1)
+ nk <- n %/% nrplots
+ if(is.null(ylim))
+ ylim <- range(pretty(range(x, na.rm = TRUE)))
+ ## --------
+ if(!quiet)
+ Form <- function(x)
+ paste("(",paste(formatC(x, digits=6, width=1), collapse=", "),
+ ")",sep='')
+ pp <- mult.fig(mfrow=c(nrplots,1), main = main.tit,
+ mgp = mgp, marP = c(-1,-1,-2,0))
+ on.exit(par(pp $ old.par))
+ for(i in 1:nrplots) {
+ i0 <- as.integer(max(0, (-overlap + (i-1)*nk)-1) )
+ in1 <- as.integer(min(n, i*nk + overlap)-1 )
+ st <- t1 + scal*i0 ##; if(do.dates) st <- dates(st)
+ en <- t1 + scal*in1 ##; if(do.dates) en <- dates(en)
+ if(!quiet)
+ cat(sprintf("%2d -- start{%d}= %s; end{%d}= %s\n",
+ i, i0,Form(st), in1, Form(en)))
+ if(has.date.x) {
+ plot(date.x[1+ i0:in1], window(x, start= st, end = en),
+ ..., ylim = ylim, type = 'l',
+ xlab = xlab, ylab = ylab, xaxt = xaxt)
+ if(do.x.axis) {
+ if(!quiet) {
+ cat("summary(date.x):\n"); print(summary(date.x[1+ i0:in1]))
+ }
+ axis.POSIXct(1, x = date.x[1+ i0:in1], format = ax.format)
+ ## (I've lost my improved version of this which had 'nYrs = 12'
+
+ if(do.x.rug) ## this can be ugly
+ rug(date.x[1+ i0:in1])
+ }
+ }
+ else
+ plot(window(x, start= st, end = en), ylim = ylim,
+ xlab = xlab, ylab = ylab, xaxt = xaxt, ...,
+ plot.type= "single")# plot.type : for plot.mts only,
+ }
+ }
+}
diff --git a/R/pd-matrix.R b/R/pd-matrix.R
new file mode 100644
index 0000000..3c82412
--- /dev/null
+++ b/R/pd-matrix.R
@@ -0,0 +1,40 @@
+
+## testing code is currently in
+## /u/maechler/R/MM/MISC/posdefify.R
+
+## TODO: probaby add 'rescale.kind = c("diag", "trace")'
+## ---- they would differ only when some EV's were negative
+
+### Higham's code by Ravi
+
+posdefify <- function(m, method = c("someEVadd", "allEVadd"),
+ symmetric = TRUE,
+ eigen.m = eigen(m, symmetric= symmetric),
+ eps.ev = 1e-7)
+{
+ ## Purpose: From a matrix m, make a "close" positive definite one
+ ## -------------------------------------------------------------------------
+ ## Arguments: m: numeric matrix (n x n), usually symmetric
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 19 Dec 1997; 7 Jul 2004
+ stopifnot(is.numeric(m) && is.matrix(m))
+ method <- match.arg(method)
+ n <- length(lam <- eigen.m $values)
+ Eps <- eps.ev * abs(lam[1])# lam[1] is largest EV; "small" is *relative*
+ ## lam[n] is the SMALLEST eigenvalue
+ if(lam[n] < Eps) { # fix up small or negative values
+ switch(method,
+ "someEVadd" = lam[lam < Eps] <- Eps,
+ "allEVadd" = lam <- lam + Eps-lam[n]
+ )
+ Q <- eigen.m $vectors
+ o.diag <- diag(m)# original one - for rescaling
+ m <- Q %*% (lam * t(Q)) ## == Q %*% diag(lam) %*% t(Q)
+ ## rescale to the original diagonal values
+ ## D <- sqrt(o.diag/diag(m))
+ ## where they are >= Eps :
+ D <- sqrt(pmax(Eps,o.diag)/diag(m))
+ m[] <- D * m * rep(D, each = n) ## == diag(D) %*% m %*% diag(D)
+ }
+ m
+}
diff --git a/R/plotCI.R b/R/plotCI.R
new file mode 100644
index 0000000..e69de29
diff --git a/R/prettylab.R b/R/prettylab.R
new file mode 100644
index 0000000..dcc0ed8
--- /dev/null
+++ b/R/prettylab.R
@@ -0,0 +1,228 @@
+#### Pretty Labels for "plotmath" axes -- Main function: eaxis()
+
+### --> these are from ~/R/MM/GRAPHICS/axis-prettylab.R
+
+### Help files: ../man/pretty10exp.Rd ../man/axTexpr.Rd ../man/eaxis.Rd
+### -------------- ---------- --------
+
+pretty10exp <- function(x, drop.1 = FALSE, sub10 = FALSE,
+ digits = 7, digits.fuzz,
+ lab.type = c("plotmath","latex"),
+ lab.sep = c("cdot","times"))
+{
+ ## Purpose: produce "a 10^k" label expressions instead of "a e<k>"
+ ## ----------------------------------------------------------------------
+ ## Arguments: x: numeric vector (e.g. axis tick locations)
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 7 May 2004; 24 Jan 2006
+
+ if(!missing(digits.fuzz)) {
+ if(!missing(digits))
+ stop("No sense to specify both 'digits' and 'digits.fuzz'")
+ ## Later: use warning():
+ message("'digits.fuzz' is deprecated; use 'digits' instead")
+ digits <- digits.fuzz
+ }
+ lab.type <- match.arg(lab.type)
+ lab.sep <- match.arg(lab.sep)
+
+ eT <- floor(log10(abs(x)) + 10^-digits) # x == 0 case is dealt with below
+ mT <- signif(x / 10^eT, digits) # m[antissa]
+ ss <- vector("list", length(x))
+ if(sub.10 <- !identical(sub10, FALSE)) {
+ if(identical(sub10, TRUE))
+ sub10 <- c(0,0)
+ else if(identical(sub10, "10"))
+ sub10 <- 0:1
+ sub10 <- as.integer(sub10)
+ noE <-
+ if(length(sub10) == 1) {
+ if(sub10 < 0)
+ stop("'sub10' must not be negative if a single number")
+ eT <= sub10
+ } else if(length(sub10) == 2) {
+ stopifnot(sub10[1] <= sub10[2])
+ sub10[1] <= eT & eT <= sub10[2]
+ } else stop("invalid 'sub10'")
+ ## for noE's, mt := value (instead of mantissa):
+ mT[noE] <- mT[noE] * 10^eT[noE]
+ }
+ if (lab.type == "plotmath") {
+ for(i in seq(along = x))
+ ss[[i]] <-
+ if(x[i] == 0) quote(0)
+ else if(sub.10 && noE[i] ) substitute( A, list(A = mT[i]))
+ else if(drop.1 && mT[i] == 1) substitute( 10^E, list(E = eT[i]))
+ else if(drop.1 && mT[i] == -1) substitute(-10^E, list(E = eT[i]))
+ else substitute(A %*% 10^E, list(A = mT[i], E = eT[i]))
+ do.call("expression", ss)
+ } else { ## lab.type=="latex"
+ ## TO DO: allow format specifier??
+ mTf <- format(mT)
+ eTf <- format(eT)
+ for(i in seq(along = x))
+ ss[[i]] <-
+ if(x[i] == 0) ""
+ else if(sub.10 && noE[i] ) mTf[i]
+ else if(drop.1 && mT[i] == 1) sprintf("$10^{%s}$", eTf[i])
+ else if(drop.1 && mT[i] == -1) sprintf("$-10^{%s}$",eTf[i])
+ else sprintf("$%s \\%s 10^{%s}$", mTf[i], lab.sep, eTf[i])
+ ss ## perhaps unlist(ss) ?
+ }
+}
+
+axTexpr <- function(side, at = axTicks(side, axp=axp, usr=usr, log=log),
+ axp = NULL, usr = NULL, log = NULL, drop.1 = FALSE)
+{
+ ## Purpose: Do "a 10^k" labeling instead of "a e<k>"
+ ## -------------------------------------------------
+ ## Arguments: as for axTicks()
+ pretty10exp(at, drop.1)
+}
+
+### TODO:
+###
+### Myaxis(.) function with at least two options ("engineering/not")
+### Really wanted: allow xaxt = "p" (pretty) or "P" (pretty, "Engineer")
+### FIXME(2): max.at is only needed because axTicks() is sometimes too large
+### FIXME(3): ?? axisTicks() instead of axTicks():
+## set.seed(1);x <- runif(100,-0.18, 1.13)
+## par(mar=.1+c(5,4,2,4)); plot(x,axes=FALSE)
+## eaxis(4) # ugly
+## eaxis(2, at=axisTicks(par("usr")[3:4],log=FALSE)) # much better
+eaxis <- function(side, at = if(log) axTicks(side, axp=axp, log=log, nintLog=nintLog)
+ else axTicks(side, axp=axp, log=log),
+ labels = NULL, log = NULL,
+ f.smalltcl = 3/5, at.small = NULL, small.mult = NULL,
+ small.args = list(),
+ draw.between.ticks = TRUE, between.max = 4,
+ outer.at = TRUE, drop.1 = TRUE, sub10 = FALSE, las = 1,
+ nintLog = max(10, par("lab")[2L - is.x]), axp = NULL, n.axp = NULL,
+ max.at = Inf, lab.type="plotmath", lab.sep="cdot", ...)
+{
+ ## Purpose: "E"xtended, "E"ngineer-like (log-)axis
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 13 Oct 2007
+
+ ## first part: same as graphics::axTicks() [also by MM] :
+ is.x <- side%%2 == 1
+ XY <- function(ch) paste0(if (is.x) "x" else "y", ch)
+ if(is.null(log)) log <- par(XY("log"))
+ if(is.null(axp)) {
+ axp <- par(XY("axp"))
+ if(!is.null(n.axp)) {
+ if(is.numeric(n.axp) && length(n.axp) == 1 && n.axp == as.integer(n.axp))
+ axp[3] <- n.axp
+ else stop(gettextf(
+ "'n.axp' must be an integer to be used as '%s', see ?par and there 'xaxp'",
+ XY("axp")), domain=NA)
+ }
+ }
+ if(is.finite(max.at <- round(max.at))) { ## "thin the 'at' values
+ if(max.at < 1) stop("'max.at' must be >= 1")
+ at <- quantile(at, (0:max.at)/max.at, names = FALSE,
+ type = 3) ## <-- ensure that order statistics are used
+ if(!log && is.null(at.small) &&
+ { d <- diff(at)
+ any(abs(diff(d)) > 1e-3 * mean(d))}) ## at is not equidistant
+ at.small <- FALSE
+ }
+ ## use expression (i.e. plotmath/latex) if 'log' or exponential format:
+ use.expr <- log || format.info(as.numeric(at), digits=7)[3] > 0
+ if(is.null(labels))
+ labels <- if(use.expr) {
+ pretty10exp(at, drop.1=drop.1, sub10=sub10,
+ lab.type=lab.type, lab.sep=lab.sep)
+ } else if(lab.type == "latex")
+ paste("$", at, "$", sep="")
+ else TRUE
+ else if(length(labels) == 1 && is.na(labels)) # no 'plotmath'
+ labels <- TRUE
+ axis(side, at = at, labels = labels, las=las, ...)
+ if(log) {
+ if(any(at <= 0)) stop("invalid 'log=TRUE' for at <= 0: not a true log scale plot?")
+ l1 <- (lat <- log10(at)) %% 1 ## the 10^k ones
+ l.int <- l1 < 1e-5 | l1 > 1 - 1e-5
+ if(draw.between.ticks && all(l.int)) { ## all lat are integer
+ ## check if have "thinned" but still want to draw ticks
+ if(any(diff(lat <- sort(round(lat, 5))) > 1)) {
+ nl <- length(lat0 <- lat)
+ ## extend 'at' (new must contain the previous!)
+ lat <- lat[1]:lat[nl]
+ if(length(lat) > between.max*nl) { ## too many: thin them!
+ lat <- unique(round(seqXtend(lat0, between.max*nl,
+ "interpolate")))
+ if(is.null(at.small) && median(diff(lat)) > 1.5)
+ ## no small ticks, if large are mostly not 10^(k1..k2)
+ at.small <- FALSE
+ }
+ at <- 10^lat
+ axis(side, at = at, labels = FALSE, las=las, ...)
+ }
+ }
+ }
+ if(is.null(at.small)) { ## create smart default, using small.mult
+ at.small <-
+ if(log) {
+ if(!all(l.int)) at <- at[l.int]
+ if(is.null(small.mult)) small.mult <- 9
+ if(length(at))
+ outer(2:small.mult, c(if(outer.at) at[1]/10, at))
+ } else {
+ ## assumes that 'at' is equidistant
+ d <- diff(at <- sort(at))
+ if(any(abs(diff(d)) > 1e-3 * (dd <- mean(d))))
+ stop("'at' is not equidistant")
+ if(is.null(small.mult)) {
+ ## look at 'dd' , e.g. in {5, 50, 0.05, 0.02 ..}
+ d. <- dd / 10^floor(log10(dd))
+ small.mult <- {
+ if(d. %% 5 == 0) 5
+ else if(d. %% 4 == 0) 4
+ else if(d. %% 2 == 0) 2
+ else if(d. %% 3 == 0) 3
+ else if(d. %% 0.5 == 0) 5
+ else 2 }
+ }
+ outer(1:(small.mult-1)/small.mult * dd,
+ c(if(outer.at) at[1]-dd, at), "+")
+ }
+ ##
+ if(outer.at) { # make sure 'at.small' remain inside "usr"
+ p.u <- sort(par("usr")[if(is.x) 1:2 else 3:4])
+ if(log) p.u <- 10^p.u
+ at.small <- at.small[p.u[1] <= at.small & at.small <= p.u[2]]
+ }
+ }
+ if(is.numeric(at.small) && any(is.finite(at.small))) ## can use NA or FALSE to suppress
+ ## axis(side, at = at.small, .....)
+ do.call(axis, c(list(side, at = at.small, labels = FALSE,
+ tcl = f.smalltcl * par("tcl")),
+ small.args))
+}
+
+
+
+## @author Alain Hauser <alain at huschhus.ch>
+## @date 2014-02-12 originally
+
+toLatex.numeric <- function(object,
+ digits = format.info(object)[2],
+ scientific = format.info(object)[3] > 0,
+ times = "\\cdot", ...)
+{
+ sround <- function(x, digits) sprintf("%0.*f", digits, x)
+ if(scientific) {
+ ## Strings in scientific format -- isn't regex a funny thing? ;-)
+ # res <- as.character(pretty10exp(object, digits = digits + 1))
+ # res <- sub("%\\*%", gsub("\\\\", "\\\\\\\\", times), res)
+ # sub("10\\^(.*)$", "10^{\\1}", res)
+ ## Original version without pretty10exp and regex:
+ eT <- floor(log10(abs(object)) + 10^(-digits-1))
+ sprintf("%s %s 10^{%d}",
+ sround(object/10^eT, digits), times, eT)
+ } else {
+ ## Actual output strings
+ sround(object, digits)
+ }
+}
diff --git a/R/prime-numbers-fn.R b/R/prime-numbers-fn.R
new file mode 100644
index 0000000..1068d5a
--- /dev/null
+++ b/R/prime-numbers-fn.R
@@ -0,0 +1,395 @@
+####---- Prime numbers, factorization, etc. --- "illustatration of programming"
+####---- Function definitions --------
+
+## for examples, see "../demo/prime-numbers.R"
+
+### MM: Currently only export primes() and factorize() ---- TODO: CLEAN UP!
+
+
+## NOTA BENE:
+## ---------
+## I found out [R 1.9.x, July 2004], that the primes() function
+## Bill Venables' "conf.design" package (== primes.() below) is almost an ordner of
+## magnitude faster than the primes.*() or prime.sieve() ones further below :
+## but read on: I'm improving it a bit:
+primes. <- function(n) {
+ ## By Bill Venables <= 2001
+
+ ## Find all primes less than n (or max(n) if length(n) > 1).
+ ## Uses an obvious sieve method. Nothing flash.
+ ##
+ if ((M2 <- max(n)) <= 1)
+ return(numeric(0))
+ x <- 1:M2
+ x[1] <- 0
+ p <- 1
+ M <- floor(sqrt(M2))
+ while((p <- p + 1) <= M)
+ if(x[p] != 0)
+ x[seq(p^2, n, p)] <- 0
+ x[x > 0]
+}
+
+##' New 'pSeq' is still (almost ?) always **slower** than pSeq = NULL !!!!
+primes <- function(n, pSeq = NULL) {
+ ## Find all primes less than n (or max(n) if length(n) > 1).
+ ## Uses an obvious sieve method. Nothing flash.
+ ##
+ ## By Bill Venables <= 2001
+ ## MM: work with logical(), keep to integer --> another 40% speedier for R
+ ## --- 2016-01: replacing seq() by seq.int() in loop got another 20% !!
+ if ((M2 <- max(n)) <= 1)
+ return(integer(0))
+ n <- as.integer(M2)
+ if(is.null(pSeq)) {
+ P <- rep.int(TRUE, n)
+ P[1] <- FALSE
+ } else { ## assume pSeq = c(2, 3, 5, ..., P_max)
+ ## stopifnot(pSeq[1:2] == 2:3, !is.unsorted(pSeq))
+ if(!is.integer(pSeq)) pSeq <- as.integer(pSeq)
+ maxP1 <- pSeq[length(pSeq)] + 1L
+ if(maxP1 >= n)
+ return(pSeq)
+ ## else (maxP1 := max(pSeq) + 1) < n
+ P <- logical(maxP1) # all FALSE
+ P[pSeq] <- TRUE
+ P <- c(P, rep.int(TRUE, n - maxP1))
+ }
+ M <- as.integer(sqrt(M2))
+ ## p <- 1:1
+ ## while((p <- p + 1:1) <= M)
+ for(p in seq_len(M))
+ if(P[p])# p is prime, sieve with it
+ P[seq.int(p*p, n, p)] <- FALSE
+ seq_len(n)[P]
+}
+
+
+## much slower than primes (even after improvement Jan.2016)
+prime.sieve <- function(maxP = pM*pM, p2et = c(2,3,5))
+{
+ ## Purpose: Produce ALL prime numbers from 2, 3.., using 2,3,5,7,...
+ ## -------------------------------------------------------------------------
+ ## Arguments: maxP : want primes up to maxP
+ ## p2et: primes c(2,3,5,..., pM);
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 26 Jan 96, 15:08
+ if(any(p2et[1:2] != 2:3) || is.unsorted(p2et <- as.integer(p2et)))
+ stop("argument 'p2et' must contain SORTED primes 2,3,..")
+ k <- length(p2et)
+ pM <- p2et[k]
+ if(maxP <= pM+1L) p2et #- no need to compute more
+ else if((maxP <- as.integer(maxP)) > pM*pM)
+ prime.sieve(maxP, prime.sieve(pM*pM, p2et))
+ else { #-- pM < maxP <= pM^2
+ r <- seq.int(from = pM+2L, to = maxP, by = 2L)
+ for(pr in p2et[p2et <= sqrt(maxP)])
+ if(0 == length(r <- r[r %% pr != 0])) break
+ c(p2et,r)
+ }
+}
+
+factorize <- function(n, verbose = FALSE)
+{
+ ## Purpose: Prime factorization of integer(s) 'n'
+ ## -------------------------------------------------------------------------
+ ## Arguments: n vector of integers to factorize (into prime numbers)
+ ## --> needs a primes() function [originally prime.sieve]
+ ## >> Better would be: Define class 'primefactors' and "multiply" method
+ ## then use this function recursively only "small" factors
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 26--30 Jan 96
+ n <- if(all(n < .Machine$integer.max)) as.integer(n)
+ else {
+ warning("factorizing large int ( > maximal integer )")
+ round(n)
+ }
+ N <- length(n)
+ M <- as.integer(sqrt(max(n))) #-- check up to this prime number
+ ##-- for M > 100 to 200: should DIVIDE first and then go on ..
+ ##-- Here, I am just (too) lazy:
+ pr <- primes(M) # was: prime.sieve(maxP = M)
+ ## k <- length(pr)
+ nDp <- outer(pr, n, FUN = function(p,n) n %% p == 0) ## which are divisible?
+ ## dim(nDp) = (k,N) ;
+ ## Divide those that are divisible :
+ ## quot <- matrix(n,k,N,byrow=T)[nDp] %/% matrix(pr,k,N)[nDp]
+ ## quot <- rep(n,rep(k,N))[nDp] %/% rep(pr,N)[nDp]
+ res <- vector("list",length = N)
+ names(res) <- n
+ for(i in 1:N) { ## factorize n[i]
+ nn <- n[i]
+ if(any(Dp <- nDp[,i])) { #- Dp: which primes are factors
+ nP <- length(pfac <- pr[Dp]) # all the small prime factors
+ if(verbose) cat(nn," ")
+ } else { # nn is a prime
+ res[[i]] <- cbind(p = nn, m = 1L)
+ if(verbose) cat("direct prime", nn, "\n")
+ next # i
+ }
+ m.pr <- rep(1L, nP)# multiplicities
+ Ppf <- prod(pfac)
+ while(1 < (nn <- nn %/% Ppf)) { #-- have multiple or only bigger factors
+ Dp <- nn %% pfac == 0
+ if(any(Dp)) { # have more smaller factors
+ m.pr[Dp] <- m.pr[Dp] + 1L
+ Ppf <- prod(pfac[Dp])
+ } else { #-- the remainder is a bigger prime
+ pfac <- c(pfac,nn)
+ m.pr <- c(m.pr, 1L)
+ break # out of while(.)
+ }
+ }
+ res[[i]] <- cbind(p = pfac, m = m.pr)
+ } # end for(i ..)
+
+ res
+}
+
+test.factorize <- function(res)
+{
+ ## Purpose: Test prime factorization
+ ## -------------------------------------------------------------------------
+ ## Arguments: result of factorize
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 29 Jan 96, 10:29
+ n <- as.numeric(names(res))# as.integer() may fail for *large* ones
+ n == vapply(res, function(pf) prod(pf[,"p"] ^ pf[,"m"]), 1.)
+}
+
+##- From: Bill Venables <wvenable at attunga.stats.adelaide.edu.au>
+##- Date: Thu, 10 Sep 1998 21:02:20 +0930
+##- To: mona kanaan <M.N.Kanaan at open.ac.uk>
+##- Cc: s-news at wubios.wustl.edu
+##- Subject: Re: [S] factors (divisors ) of an integer
+##-
+##- > Dear all,
+##- > I wonder whether there is an already built in Splus function to find
+##- > the divisors of a given integer, if so could you please point it out to
+##- > me.
+##- > Or if someone has already written such a function, could you
+##- > please pass it over, if possible.
+##- >
+##- >
+##- > The function I am looking for works sth like this
+##- >
+##- > N <- 6
+##- > DN <- DIV(N)
+##- > DN
+##- > 1 2 3 6
+##- >
+##- > Thanks a lot,
+##- > Mona
+##-
+##- This turns out to be a pretty little programming exercise.
+##- Here's a vectorized version, even, although it only returns the
+##- *prime* divisors, not all the devisors. That a supplmentary
+##- exercise...
+
+factorizeBV <- function(n) {
+ if(!is.numeric(n))
+ stop("cannot factorize non-numeric arguments")
+ if(length(n) > 1) {
+ l <- list()
+ for(i in seq(along = n))
+ l[[i]] <- Recall(n[i])
+ return(l)
+ }
+ if(n != round(n) || n < 2)
+ return(n)
+ tab <- 2:n
+ fac <- numeric(0)
+ while(n > 1) {
+ while(n %% tab[1] == 0) {
+ fac <- c(fac, tab[1])
+ n <- n/tab[1]
+ }
+ tab <- tab[tab <= n]
+ omit <- tab[1] * c(1, tab[tab <= n/tab[1]])
+ tab <- tab[ - match(omit, tab, nomatch = 0)]
+ }
+ fac
+}
+
+
+##- From: mona kanaan <M.N.Kanaan at open.ac.uk>
+##- Date: Fri, 11 Sep 1998 08:52:59 +0100 (BST)
+##- To: "'S-News'" <s-news at wubios.wustl.edu>
+##- Subject: [S] Summary: Factors (divisors) of an inreger
+
+##- Thanks a lot, for everybody who replied to my query.
+##- Here is a summary of what was passed on.
+##- The first two codes due to Bill Venables and Bill Dunlap give the Prime
+##- divisors of an integer(this is what i was actually looking for), the last
+##- code gives all divisors but is not efficient for "large"
+##- integers (this is what i was trying to avoid).
+##-
+##- Thanks again
+##- Mona
+
+## .... Bill Venables solution [see above !] ........
+
+
+##- -----------------------------------------------------------------
+##- -----------------------------------------------------------------
+##- Bill Dunlap
+##-
+##- I use the following factors(), which uses the enclosed primes():
+##
+## MM�: mv'ed all examples to file ... (now ../demo/prime-numbers.R )
+
+factors <- function(x)
+{
+ factor1 <- function(y, max.factor, .Primes)
+ {
+ .Primes <- if(missing(.Primes))
+ primes.t(max.factor) else primes.t(max.factor, .Primes)
+ f <- numeric(0)
+ while(y > 1) {
+ ## note: 1 has no factors according to this
+ which <- y %% .Primes == 0
+ if(sum(which) == 0) {
+ f <- c(f, y)
+ break
+ }
+ else f <- c(f, .Primes[which])
+ y <- y/prod(.Primes[which])
+ }
+ val <- sort(f)
+ if(length(val) && any(big <- val > max.factor^2)) {
+ if(sum(big) != 1)
+ stop("internal error: sum(big)!=1")
+ val <- sort(c(val[!big],
+ Recall(val[big], min(ceiling(sqrt(val[big])),
+ max.factor^2), .Primes)))
+ }
+ val
+ }
+ val <- lapply(x, factor1, 43)
+ names(val) <- as.character(x)
+ val
+}
+
+## MM: this version (Bill Dunlap's maybe slightly modified ?) is
+## -- *much* slower than primes() above !
+primes.t <- function(n, .Primes = c(2, 3, 5, 7, 11, 13, 17, 19,
+ 23, 29, 31, 37, 41, 43))
+{
+ ## primes() function using table
+ if(is.unsorted(.Primes)) stop("'.Primes' must be increasing")
+ nP <- length(.Primes <- as.integer(.Primes))
+ maxP <- .Primes[nP]
+ stopifnot(.Primes[1:3] == c(2,3,5),
+ maxP > 30, maxP %% 2 == 1, maxP %% c(3,5) != 0)
+ if(maxP < n) {
+ ## compute longer .Primes by sieve
+ .Primes <- seq(from = 2, to = n)
+ for(i in 1:length(.Primes)) {
+ composite <- .Primes %% .Primes[i] == 0
+ composite[i] <- FALSE
+ if(all(!composite))
+ break
+ .Primes <- .Primes[!composite]
+ if(i >= length(.Primes))
+ break
+ }
+ }
+ .Primes[.Primes <= n]
+}
+
+
+##- factors.simple() is easier to understand and is faster on small numbers
+##- but can work very slowly on large numbers with lots of small factors
+##- (like numbers arising in combinatorics).
+
+factors.simple <- function(x)
+{
+ factor1 <- function(y, .Primes)
+ {
+ f <- numeric(0)
+ while(y > 1) {
+## note 1 has no factors according to this
+ which <- y %% .Primes == 0
+ if(sum(which) == 0) {
+ f <- c(f, y)
+ break
+ }
+ else f <- c(f, .Primes[which])
+ y <- y/prod(.Primes[which])
+ }
+ sort(f)
+ }
+ val <- lapply(x, factor1, primes(ceiling(sqrt(max(x)))))
+ names(val) <- as.character(x)
+ val
+}
+
+##----------------------------------------------------------------------------
+##----------------------------------------------------------------------------
+##----------------------------------------------------------------------------
+##
+## Guido Schwarzer ,Gardar Johannesson, Remy vande Ven, Henrik Aalborg-Nielsen
+
+DIV <- function(N) {
+ N.seq <- 1:N
+ N.seq[(N %% N.seq) == 0]
+}
+
+
+
+
+##- From: "Frank E Harrell Jr" <fharrell at virginia.edu>
+##- To: "s-news" <s-news at wubios.wustl.edu>
+##- Subject: [S] An improved factorize()
+##- Date: Sat, 12 Sep 1998 22:34:05 -0400
+##-
+##- Here is a modification of Michael Bramley's (bramley.m at pg.com) factorize
+##- function with memory usage of approx. the square root of the original.
+
+divisors <- function(n)
+{
+ ## Frank E Harrell Jr -- called this "factorize()"
+ p <- n/(z <- 1:ceiling(sqrt(n)))
+ z <- z[trunc(p) == p]
+ unique(c(z, rev(n/z)))
+}
+
+##- From: Paul A Tukey <paul at bellcore.com>
+##- Date: Wed, 16 Sep 1998 18:27:15 -0400 (EDT)
+##- To: fharrell at virginia.edu, lifer at fuse.net, s-news at wubios.wustl.edu
+##- Subject: Re: [S] Prime divisors
+
+##- This discussion has been fun.
+
+##- Seems to me we've been gradually heading toward
+##- computing the prime factorization of a number.
+##- That is, a collection of prime numbers (with possible
+##- duplication) whose product is the given number.
+
+##- A recursive layer on top of Frank Harrell's factorize() does
+##- it -- but the code below uses a slightly shortened version
+##- of factorize() that only returns the smallest divisor > 1.
+
+fac <- function(n) {
+ p <- n/(z <- 1:floor(sqrt(n)))
+ z <- z[trunc(p) == p]
+ c(z, rev(n/z))[2]
+}
+
+pfac <- function(n, nn = 0)
+{
+ if(nn == 0)
+ pfac(n, fac(n))
+ else if(n <= nn)
+ nn
+ else c(nn, pfac(n/nn))
+}
+
+##- Note that prod(pfac(n)) == n.
+
+##- Now I'm sure someone can write a more elegant version.
+##- Also, recursion is probably neither memory-efficient
+##- nor CPU-efficient in Splus.
+
+##- -- Paul Tukey
+##- Bellcore
diff --git a/R/printTable.R b/R/printTable.R
new file mode 100644
index 0000000..6f4c445
--- /dev/null
+++ b/R/printTable.R
@@ -0,0 +1,72 @@
+
+printTable2 <- function(table2, digits = 3)
+{
+ ##-- 2-weg Kontingenztafel mit allem zusammen ... -- ruft catCon(.) auf
+ ##-- Urspruneglich fuer NDK-Uebungen 1992
+ ##-- Verbessert und Fehler korrigiert! : M.Maechler, Feb.1993
+ d <- dim(table2)
+ if(length(d) != 2)
+ stop("Argument muss numerische Matrix sein: Die (2-Weg) Kontingenz Tafel")
+ N <- sum(table2)
+ cat("\nKontingenz-Tafel mit Randsummen:\n")
+ print(margin2table(table2), digits=0)
+ cat("\nGemeinsame Verteilung mit Randverteilungen:\n")
+ I <- d[1]; J <- d[2]; df <- (I-1)*(J-1)
+ r <- margin2table(table2/N)
+ print(r, digits)
+ joint <- r[1:I, 1:J]
+ xrand <- r[I+1, 1:J]
+ yrand <- r[1:I, J+1]
+ condy <- joint/yrand
+ condx <- t(t(joint)/xrand)
+ cat("Bedingte Verteilung gegen y:\n"); print(round(condy,digits)); cat("\n")
+ cat("Bedingte Verteilung gegen x:\n"); print(round(condx,digits)); cat("\n")
+ exp.ind <- N * outer(yrand,xrand)#- Expected under INDEPendence: n * p_i * p_j
+ cat("Freiheitsgrade: df =",df,"\n")
+ cat("Chi^2 - Annahmebereich: [0,", round(qchisq(0.95,df),1),
+ "] (alpha=0.05)\n\n\n", sep = "")
+ test.chisq <- sum((as.matrix(table2)-exp.ind)^2/exp.ind)
+ cat("Testwerte unter der Unabhaengigkeitshypothese:\n")
+ cat(" Test mit Chi^2: ",format(round(test.chisq,2)),
+ " (P-Wert: ",round(1-pchisq(test.chisq,df),4),")\n",sep = "")
+ is.pos <- table2 != 0
+ test.deviance <- 2*sum(table2[is.pos]*log(table2[is.pos]/exp.ind[is.pos]))
+ cat(" Test mit Devianz: ",format(round(test.deviance,2)),
+ " (P-Wert: ",round(1-pchisq(test.deviance,df),4),")\n\n",sep = "")
+ invisible(list(p.condx = condx, p.condy = condy, expected.indep = exp.ind,
+ df = df, chisq.test = test.chisq, deviance = test.deviance))
+}
+
+### The original catCon() function did compute and print;
+### now separated :
+
+margin2table <- function(x, totName = "sum", name.if.empty=FALSE) {
+ x <- as.matrix(x)
+ if(name.if.empty) x <- empty.dimnames(x)
+ r <- rowSums(x)
+ r <- rbind(cbind(x, r), c(colSums(x), sum(r)))
+ dimnames(r) <-
+ if(!is.null(dnx <- dimnames(x))) {
+ dn <- list(if(!is.null(dnx[[1]])) c(dnx[[1]], totName),
+ if(!is.null(dnx[[2]])) c(dnx[[2]], totName))
+ names(dn) <- names(dnx)
+ dn
+ } ## else NULL
+ class(r) <- c("margin2table", "table")
+ r
+}
+
+print.margin2table <- function(x, digits = 3, quote = FALSE, right = TRUE, ...)
+{
+ if(is.null(d <- dim(x)) || length(d <- d - 1) !=2)
+ stop("'x' is not a matrix")
+ N <- d[1]; M <- d[2]
+ cx <- format(round(x, digits))[c(1:N,N+1,N+1), c(1:M,M+1,M+1)]
+ cx[N+1,] <- "--"; if(!is.null(rownames(cx))) rownames(cx)[N+1] <- "--"
+ cx[,M+1] <- "|" ; if(!is.null(colnames(cx))) colnames(cx)[M+1] <- "|"
+ ## TODO: think of implementing zero.print = "." -- as in print.table()
+ ## TODO(2): improve that in print.table(),
+ ## (e.g. replace "0.0" or "0e0" by ". "; "00.0" by " . ")
+ print(cx, quote=quote, right=right, ...)
+ invisible(x)
+}
diff --git a/R/ps.goodies.R b/R/ps.goodies.R
new file mode 100644
index 0000000..29e1cfb
--- /dev/null
+++ b/R/ps.goodies.R
@@ -0,0 +1,268 @@
+#### PostScript Goodies f�r R --- `a la /u/sfs/S/ps.goodies.S
+####
+####
+
+## hidden in the name space -- FIXME? maybe more useful ?? ---
+dev.latex <-
+ function(file, DEV, height= 5+ main.space*1.25, width= 9.5,
+ main.space = FALSE, lab.space = main.space,
+ paper = "special", title = NULL,
+ lab = c(10, 10, 7), mgp.lab = c(1.6, 0.7, 0),
+ mar = c(4, 4, 0.9, 1.1), ...)
+{
+ ## Purpose: Setup for 1 LaTeX-includable picture SAVING on white space !
+ ## Calls ps.do(.) ; par(.) [ old par in global 'o.p']; USE ps.end() !
+ ## -------------------------------------------------------------------------
+ ## Arguments: height & width in INCHES. (5, 9.5) is 'horizontal look'
+ ## title: to be used in PostScript (-> for gv/ghostview !)
+ ## main.space & lab.space: if T, leave space for 'main' & 'x/ylab'
+ ## lab : for par(.); (10,10,7): use more axis 'labels' ..
+ ## mgp.lab & mar : for par(.): these are values for 'lab.space=T'
+ ## Note: FIRST fiddle with 'main.sp.', 'lab.sp.' before 'mgp.lab' and 'mar'!
+ ## -------------------------------------------------------------------------
+ ## EXAMPLE:for(m in c(T,F)){str(ps.latex("q.ps",main=m));acf(hstart);ps.end()}
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: Sep 94; Sept. 95
+
+ ## Cannot use missing(.) here, as all arg.s *are* specified
+ ## from the calling pdf.latex() etc ..
+ frms <- formals()
+ lab.def <- identical(lab, eval(frms[["lab"]]))
+ mar.def <- identical(mar, eval(frms[["mar"]]))
+ mgp.lab.def <- identical(mgp.lab, eval(frms[["mgp.lab"]]))
+
+ if(!lab.def && !(length(lab)==3 && is.numeric(lab) && all(lab >=0)))
+ stop("'lab' must be numeric vector >= 0, of length 3")
+ if(!mgp.lab.def && !(length(mgp.lab)==3 && is.numeric(mgp.lab) &&
+ all(mgp.lab >=0) && all(diff(mgp.lab)<=0)))
+ stop("'mgp.lab' must be non-increasing numeric vector >= 0, of length 3")
+ if(!mar.def && !(length(mar)==4 && is.numeric(mar) && all(mar >=0)))
+ stop("'mar' must be non-negative numeric vector of length 4")
+
+ DEV(file=file, height=height, width=width, paper=paper, title = title, ...)
+ ##=
+
+ ## Now: just do the proper par(...) calls :
+ mar.main.Extra <- c(0,0, 3.2,0)
+ mar.nolab.Minus <- c(1,1, 0.3,0)
+ if(main.space && mar.def)
+ mar <- mar + mar.main.Extra
+
+ if(!lab.space) {
+ mar <- mar - mar.nolab.Minus
+ if(main.space)
+ warning("'main.space' is TRUE, but 'lab.space' is FALSE ...")
+ }
+ o.p <- par(mar = mar, mgp= mgp.lab)
+ o.p <- c(o.p, par(lab=lab)) # need 2 step for bug ?
+ ## "frame 0 / GlobalEnv assignment deprecated: u.assign0("o.par.psl", o.p)
+ invisible(list(old.par=o.p, new.par= par(c("mar","mgp","lab"))))
+}
+
+ps.latex <- function(file, height= 5+ main.space*1.25, width= 9.5,
+ main.space = FALSE, lab.space = main.space,
+ paper = "special", title = NULL,
+ lab = c(10, 10, 7), mgp.lab = c(1.6, 0.7, 0),
+ mar = c(4, 4, 0.9, 1.1), ...)
+{
+ dev.latex(DEV = ps.do, file=file, height=height, width=width,
+ main.space=main.space, lab.space=lab.space, paper=paper,
+ title=title, lab=lab, mgp.lab=mgp.lab, mar=mar, ...)
+}
+
+pdf.latex <- function(file, height= 5+ main.space*1.25, width= 9.5,
+ main.space = FALSE, lab.space = main.space,
+ paper = "special", title = NULL,
+ lab = c(10, 10, 7), mgp.lab = c(1.6, 0.7, 0),
+ mar = c(4, 4, 0.9, 1.1), ...)
+{
+ dev.latex(DEV = pdf.do, file=file, height=height, width=width,
+ main.space=main.space, lab.space=lab.space, paper=paper,
+ title=title, lab=lab, mgp.lab=mgp.lab, mar=mar, ...)
+}
+
+
+ps.do <- local({
+ myfile <- NULL
+ function(file, width = -1, height = -1,
+ onefile = FALSE, horizontal = FALSE, title = NULL, ...)
+{
+ ## Purpose: "Ghostview" device driver. --- to be "closed" by ps.end(..) --
+ ## -------------------------------------------------------------------------
+ ## Arguments: file, width, height : file name and dims in inch; 1 in:=2.54 cm
+ ## onefile = F <==> Encapsulated PS (Splus default: T, simple PS)
+
+ ## -- new Args: combining former ps.do(.) and ps.col(.) :
+
+ ## ... : passed to ps.options
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, 1992-1995
+ ##
+ ## --->>>>>> CONSIDER 'ps.latex' instead for pictures !
+
+ myfile <<- file
+## if(length(l... <- list(...))) {
+## ## This does NOT work : pso are the *NEW*, not the *former* ones!
+## oldop <- ps.options()[names(l...)]
+## ps.options(...)
+## on.exit( do.call("ps.options", oldop) ) #- reset ps.options !
+## }
+
+ if(is.null(title))
+ title <- paste("R", paste(R.version[c("major", "minor")], collapse = "."),
+ "plot:", file)
+ postscript(file = file, width = width, height = height, horizontal=horizontal,
+ onefile = onefile, title = title, print.it = FALSE, ...)
+}## ps.do()
+})## local(..)
+
+ps.end <- function(call.gv = NULL, command = getOption("eps_view"),
+ debug = getOption("verbose"))
+{
+ ## Purpose: A "ghostview" device driver (almost).
+ ## Author: Martin Maechler, Date: May 26 1992, 15:32
+ ## ----------------------------------------------------------------
+ ## Arguments: call.gv: If TRUE, call ghostview.
+ ## Default: Find out if ghostview already runs on this file,
+ ## If yes, do not call it again.
+ ## MUST be called after ps.do(..) or ps.latex() !
+ ## Example: ps.end(com = "ghostview --media a4")
+ ## ----------------------------------------------------------------
+ ## Only if postscript is running !! --
+ if( names(dev.cur()) == "postscript")
+ dev.off()
+ if(.Platform $ OS.type == "unix") {
+ .set.eps_view()
+ } else { ## OS.type != "unix" --- i.e. Windows :
+ warning("using ps, ghostview,...is currently not implemented for non-Unix")
+ return(FALSE)
+ }
+ ..ps.file <- environment(ps.do)$myfile
+ if (is.null(call.gv)) {
+ f <- u.sys(Sys.ps.cmd(), " | grep '", command, "' | grep -v grep")
+ if(debug) { cat("ps.end(): f:\n");print(f) }
+ call.gv <- length(f) == 0
+ if(!call.gv) {
+ ##--- STILL does NOT work
+ ##--- if you work with two different pictures simultaneously
+ for(i in 1:length(f)) { #-- only NOT call if THIS ps.file .. --
+ ## find command in 'ps' output line (sub/gsub have no 'fixed=TRUE')
+ ic <- regexpr(command, f[i], fixed=TRUE)
+ ## only keep the file name
+ fil <- substr(f[i], ic + attr(ic,"match.length") + 1, 1e4)
+ cat("ps.end(): fil:",fil,"\n")
+ call.gv <- length(fil) < 1 || all(..ps.file != fil)
+ if(!call.gv)
+ break #-- don't call ghostview since it runs this file..
+ }
+ }
+ } else if(identical(call.gv, FALSE))
+ fil <- "<unknown>"
+ if (call.gv) {
+ fil <- ..ps.file
+ u.sys(command, " ", fil, "&", intern=FALSE)
+ } else
+ cat("\n >> switch to", sub(" .*", '', command),
+ "(postscript viewer) window -- updated automagically!\n\n")
+ invisible(fil)
+}
+
+
+###--- Using pdf() instead of postscript() --- otherwise "same" :
+
+pdf.do <- local({
+ myfile <- NULL
+ function(file, paper = "default",
+ width = -1, height = -1, onefile = FALSE,
+ title = NULL, version = "1.4", quiet=FALSE, ...)
+{
+ ## Purpose: "PDF + view" device driver. --- to be "closed" by pdf.end(..) --
+ ## -------------------------------------------------------------------------
+ ## Arguments: file, width, height : file name and dims in inch; 1 in:=2.54 cm
+ ## onefile = FALSE <==> "Encapsulated"
+ ## ... : passed to pdf.options
+ ## -------------------------------------------------------------------------
+ ## Author: Martin Maechler, April 26, 2007 {built on much older ps.do()}
+
+## if(length(l... <- list(...))) {
+## ## ps.options also used for pdf -- in some way
+## oldop <- ps.options()[names(l...)]
+## ps.options(...)
+## on.exit( do.call("ps.options", oldop) ) #- reset ps.options !
+## }
+ myfile <<- file
+
+ if(missing(paper) && !missing(width) && !missing(height)) {
+ if(!quiet)
+ message("as 'width' and 'height' are specified, setting 'paper = \"special\"")
+ paper <- "special"
+ }
+
+ if(is.null(title))
+ title <- paste("R", paste(R.version[c("major", "minor")], collapse = "."),
+ "plot:", file)
+ ## default for 'paper' is now 'missing'
+ pdf(file = file, version = version, paper = paper,
+ width = width, height = height,
+ onefile = onefile, title = title, ...)
+}## pdf.do()
+})## local(..)
+
+
+pdf.end <- function(call.viewer = NULL, command = getOption("pdfviewer"),
+ debug = getOption("verbose"))
+{
+ ## Purpose: A "ghostview" device driver (almost).
+ ## Author: Martin Maechler, Date: April 26, 2007
+ ## ----------------------------------------------------------------
+ ## Arguments: call.viewer: If TRUE, call ghostview.
+ ## Default: Find out if ghostview already runs on this file,
+ ## If yes, do not call it again.
+ ## MUST be called after pdf.do(..) or pdf.latex() !
+ ## Example: pdf.end(com = "acroread")
+ ## ----------------------------------------------------------------
+ ## Only if postscript is running !! --
+ if( names(dev.cur()) == "pdf")
+ dev.off()
+ if(.Platform $ OS.type != "unix") {
+ warning("using ps (process status) is currently not implemented for non-Unix")
+ return(FALSE)
+ }
+ ..pdf.file <- environment(pdf.do)$myfile
+ if (is.null(call.viewer)) {
+ cmd <- basename(command)
+ f <- u.sys(Sys.ps.cmd(), " | grep '", cmd, "' | grep -v grep")
+ if(debug) { cat("pdf.end(): f:\n");print(f) }
+ call.viewer <- length(f) == 0
+ if(!call.viewer) {
+ ##--- STILL does NOT work
+ ##--- if you work with two different pictures simultaneously
+ for(i in 1:length(f)) { #-- only NOT call if THIS pdf.file .. --
+ ## find command in 'ps' output line (sub/gsub have no 'fixed=TRUE')
+ ic <- regexpr(cmd, f[i], fixed=TRUE)
+ ## only keep the file name
+ fil <- substr(f[i], ic + attr(ic,"match.length") + 1, 1e4)
+ cat("pdf.end(): fil:",fil,"\n")
+ call.viewer <- length(fil) < 1 || all(..pdf.file != fil)
+ if(!call.viewer)
+ break #-- don't call ghostview since it runs this file..
+ }
+ }
+ } else if(identical(call.viewer, FALSE))
+ fil <- "<unknown>"
+ if (call.viewer) {
+ fil <- ..pdf.file
+ u.sys(command, " ", fil, "&", intern=FALSE)
+ } else {
+ msg <- if(length(grep("acroread", command)))
+ " acroread -- and refresh via C-w M-f 1 !"
+ else " PDF viewer window and maybe refresh!"
+ cat("\n >> switch to", msg,"\n\n")
+ }
+ invisible(fil)
+}
+
+## Alain Hauser <alain at huschhus.ch> --> ../man/cairoSwd.Rd
+cairoSwd <- function(name, width, height, ...)
+ cairo_pdf(filename = paste(name, "pdf", sep = "."),
+ width = width, height = height)
diff --git a/R/rot13.R b/R/rot13.R
new file mode 100644
index 0000000..b740e14
--- /dev/null
+++ b/R/rot13.R
@@ -0,0 +1,10 @@
+##' Generalized rot13 --> ../man/rot13.Rd
+rotn <- function (ch, n = 13)
+{
+ ch <- as.character(ch) # or error
+ stopifnot(0 <= n, n <= 26)
+ i <- c(if(n < 26) (n+1):26, seq_len(n))
+ chartr(old = paste(c(letters, LETTERS ), collapse=""),
+ new = paste(c(letters[i],LETTERS[i]), collapse=""),
+ x = ch)
+}
diff --git a/R/rrange.R b/R/rrange.R
new file mode 100644
index 0000000..7e96d66
--- /dev/null
+++ b/R/rrange.R
@@ -0,0 +1,14 @@
+rrange <- function(x, range = 1, coef = 1.5, na.rm = TRUE)
+{
+ ## Purpose: `Robust RANGE', ===> ?rrange
+ ## Author: Martin Maechler, 1990
+ if(!missing(range)) {
+ if(!missing(coef)) stop("Must use either 'range' or 'coef'")
+ coef <- 1.5 * range
+ }
+ if(!na.rm && any(is.na(x)))
+ return(0+ c(NA,NA))# numeric NA
+
+ ## S: (boxplot(..., plot = FALSE)$stats)[c(5, 1)]
+ boxplot.stats(x, coef = coef, do.conf= FALSE, do.out= FALSE)$stats[c(1,5)]
+}
diff --git a/R/sessionInfo-ext.R b/R/sessionInfo-ext.R
new file mode 100644
index 0000000..1827ff8
--- /dev/null
+++ b/R/sessionInfo-ext.R
@@ -0,0 +1,72 @@
+sessionInfoX <- function(pkgs=NULL, list.libP = FALSE, extraR.env = TRUE) {
+ ## return an object; then print() via method
+ if(!is.null(pkgs)) stopifnot(is.character(pkgs), length(pkgs) > 0)
+ lP <- .libPaths() # *is* normalized in the sense of normalizePath()
+ nRL <- normalizePath(RLIBS <- strsplit(Sys.getenv("R_LIBS"), ":")[[1]])
+ si <- sessionInfo()
+ Rver <- package_version(si$R.version)
+ structure(class = "sessionInfoX",
+ list(sInfo = si,
+ sysInf = Sys.info(),
+ capabilities = capabilities(),
+ extSoft = if(Rver >= "3.2.0") extSoftVersion(),
+ LAPACK = if(Rver >= "3.0.3") La_version(),
+ pcre = if(Rver >= "3.1.3") pcre_config(),
+ pkgDescr = if(!is.null(pkgs)) sapply(pkgs, packageDescription, simplify=FALSE),
+ libPath = lP, .Library = .Library, RLIBS = RLIBS, n.RLIBS = nRL,
+ list.libP = if(list.libP) sapply(lP, list.files, simplify=FALSE),
+ R.env = Sys.getenv(c("R_ENVIRON", "R_PROFILE", "R_CHECK_ENVIRON")),
+ xR.env = if(extraR.env) local({
+ ss <- Sys.getenv()
+ ss[grepl("^_?R_", names(ss))]
+ })))
+}
+
+print.sessionInfoX <- function(x, locale = TRUE, RLIBS = TRUE, Renv = TRUE, ...) {
+ cat("Extended sessionInfo():",
+ "-----------------------", sep="\n")# does add a final '\n'
+ if(!is.null(pkgD <- x$pkgDescr)) {
+ cat("specific packageDescription()s:\n")
+ print(pkgD, ...)
+ cat("~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~\n\n")
+ }
+ cat("Capabilities:\n")
+ print(symnum(x$capabilities, symbols = c("-", "X")), ...)
+ cat("Sys.info:\n")
+ print(structure(x$sysInf[c("nodename", "user")], class="Dlist"), ...)
+ cat("\n")
+ if(!is.null(x$LAPACK)) cat("LAPACK version:", x$LAPACK, "\n")
+ if(!is.null(x$extSoft)) {
+ cat("External software (versions):\n")
+ print(structure(x$extSoft, class="Dlist"), ...)
+ }
+ ## if(!is.null(x$pcre)) {
+ ## cat("\nPCRE (regex) config.: ")
+ ## print(........)
+ ## }
+ cat("\n")
+ if(RLIBS) {
+ cat("R_LIBS:\n")
+ cbind(x$RLIBS)
+ xtr.lp <- setdiff(x$libPath,
+ union(normalizePath(x$.Library), x$n.RLIBS))
+ if(length(xtr.lp)) {
+ cat("libPath [.libPaths()] contents in addition to R_LIBS and .Library:\n")
+ print(xtr.lp)
+ } else
+ cat("libPath contains not more than RLIBS and .Library (normalized)\n")
+ if(length(xx <- setdiff(x$n.RLIBS, x$libPath))) { ## typically empty
+ cat("** RLIBS has entries not in .libPaths():\n")
+ print(xx)
+ }
+ }
+ if(Renv) {
+ cat("Main R env. variables",
+ if(!is.null(x$xR.env)) " (for more, inspect the 'xR.env' component)",
+ ":\n", sep="")
+ print(cbind(x$R.env), ...)
+ }
+ cat("---------------- standard sessionInfo():\n")
+ print(x$sInf, locale=locale, ...)
+ invisible(x)
+}
diff --git a/R/sourceAttach.R b/R/sourceAttach.R
new file mode 100644
index 0000000..b9c917d
--- /dev/null
+++ b/R/sourceAttach.R
@@ -0,0 +1,14 @@
+##' @title "Source + Attach" an R source file
+##' @author Martin Maechler, 29 Jul 2011
+sourceAttach <- function(file, pos = 2,
+ name = paste(abbreviate(gsub(fsep, "", dirname(file)), 12,
+ method="both.sides"),
+ basename(file), sep=fsep),
+ keep.source = getOption("keep.source.pkgs"),
+ warn.conflicts = TRUE)
+{
+ ENV <- new.env()
+ sys.source(file, envir = ENV, keep.source = keep.source)# also checks file
+ fsep <- .Platform$file.sep # for default 'name' :
+ attach(ENV, pos=pos, name=name, warn.conflicts=warn.conflicts)
+}
diff --git a/R/str_data.R b/R/str_data.R
new file mode 100644
index 0000000..93f5008
--- /dev/null
+++ b/R/str_data.R
@@ -0,0 +1,66 @@
+
+str_data <- function(pkgs, filterFUN, ...)
+{
+ ## Purpose: str(.) of all datasets in a package
+ ## ----------------------------------------------------------------------
+ ## Arguments: pkgs : character vector of names of R packages
+ ## ... : potential further arguments to be passed to str()
+ ## ----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 17 Jun 2005, 09:04
+ stopifnot(is.character(pkgs))
+ ans <- as.list(pkgs); names(ans) <- pkgs
+ if(hasFilter <- !missing(filterFUN)) {
+ stopifnot(is.function(filterFUN))
+ filtName <- deparse(substitute(filterFUN))
+ }
+ for(pkg in pkgs) {
+ cat("\nAll data sets in R package '",pkg,"' ",
+ if(hasFilter)
+ paste0(" filtered by ", paste(filtName, collapse=" "),"()"),
+ ":\n--------------------------"," ", rep("=", nchar(pkg)),
+ "\n\n", sep='')
+ dd <- data(package = pkg)
+ items <- unique( dd$results[,"Item"] ) # unique(): bug in data(), R <= 3.2.2
+ ## not those that are part of "another" (multi-object) one:
+ if(length(i <- grep(".*\\(.*\\)$", items)) > 0)
+ items <- items[- i]
+ its <- vector("list", length=length(items)); names(its) <- items
+ ##
+ ## TODO Gabor's wishes (2005-03-25):
+ ## 1) allow filtering on class(),
+ ## 2) sorting according to size -- that needs 2 passes through...
+ ## MM: [optionally?] *return* class; also *return* dim(), length()
+ dat.env <- new.env()
+ for(n in items) {
+ data(list = n, package = pkg, envir = dat.env)
+ nm0 <- ls(envir = dat.env, all.names=TRUE)## all objects created from above data(.)
+ nms <- if(hasFilter)
+ nm0[vapply(nm0, function(n) filterFUN(get(n, envir = dat.env)), TRUE)]
+ else nm0
+ if(length(nms)) {
+ cat(n, ": ")
+ if(length(nms) == 1) { ## one data set == normal case
+ if(nms != n) cat(nms, ": ")
+ ob <- get(nms, envir = dat.env)
+ str(ob, ...)
+ }
+ else { ## more than one data set
+ cat("\n")
+ for(nn in nms) {
+ cat(" ", nn, ": ")
+ str(get(nn, envir=dat.env), indent.str = paste(" ", ''), ...)
+ }
+ }
+ cat("--------------\n")
+ its[[n]] <- nms
+ }
+ else {
+ if(!hasFilter) warning(gettextf("no objects found from data(\"%s\")", n))
+ its[n] <- NULL # delete that list entry
+ }
+ rm(list = nm0, envir = dat.env)
+ }
+ ans[[pkg]] <- its
+ }
+ invisible(ans)
+}
diff --git a/R/tkdensity.R b/R/tkdensity.R
new file mode 100644
index 0000000..e503244
--- /dev/null
+++ b/R/tkdensity.R
@@ -0,0 +1,164 @@
+### demo(tkdensity) ## is at
+### /u/maechler/R/D/r-devel/Linux-inst/library/tcltk/demo/tkdensity.R
+
+tkdensity <- function(y, n = 1024, log.bw = TRUE, showvalue = TRUE,
+ xlim = NULL, do.rug = size < 1000, kernels = NULL,
+ from.f = if(log.bw) -2 else 1/1000,
+ to.f = if(log.bw) +2.2 else 2, col = 2)
+{
+ ## Purpose: as density() but with scrollbar - bandwidth selection
+ ## -----------------------------------------------------------------------
+ ## Author: Martin Maechler, Date: 8 Nov 2000, 19:00
+
+ requireNamespace("tcltk") || stop("tcltk support is absent")
+ tclVar <- tcltk::tclVar
+ tclvalue <- tcltk::tclvalue
+ tkframe <- tcltk::tkframe
+ tkpack <- tcltk::tkpack
+ tklabel <- tcltk::tklabel
+ tkscale <- tcltk::tkscale
+ nbw <- xZ <- xM <- NA_real_ # so '<<-' keeps them here
+
+ dFun <- density.default
+ all.kerns <- eval(formals(dFun)$kernel)
+ kernels <-
+ if(is.null(kernels)) all.kerns
+ else match.arg(kernels, all.kerns, several.ok = TRUE)
+ ynam <- deparse(substitute(y))
+ size <- length(y)
+ sd.y <- sqrt(var(y))
+
+ ## Use Silverman's Rule of Thumb initially :
+ hi <- sd.y
+ if ((lo <- min(hi, IQR(y)/1.34)) == 0)
+ (lo <- hi) || (lo <- abs(y[1])) || (lo <- 1)
+ bw <- bw0 <- 0.9 * lo * size^(-0.2)
+ if(log.bw) lbw <- lbw0 <- log10(bw0)
+
+ ry <- range(y)
+ xlim <- if(is.null(xlim)) ry + c(-2,2)* bw0 else as.numeric(xlim)
+ xlmid <- xm0 <- mean(xlim)
+ xr0 <- diff(xlim)
+
+ ## Initialize Tcl variables:
+
+ xZoom <- tclVar(100)# %
+ xlmid <- tclVar(xlmid)
+
+ if(log.bw)
+ Lbw <- tclVar(log10(bw))
+ else
+ bw <- tclVar(bw)
+
+ kernel <- tclVar("gaussian")
+
+ ## Tvar <- function(v) as.numeric(tclvalue(substitute(v)))
+
+ replot <- function(...) {
+ if (is.null(y)) return() # too early...
+
+ b <- if(log.bw) 10 ^ (lbw <<- as.numeric(tclvalue(Lbw))) else
+ nbw <<- as.numeric(tclvalue(bw))
+ ##Dbg cat("b = ", formatC(b),"\n")
+ k <- tclvalue(kernel) # *is* char
+ ##Dbg cat("tclvalue(kernel)"); str(k)
+
+ xZ <<- as.numeric(tclvalue(xZoom))
+ xM <<- as.numeric(tclvalue(xlmid))
+
+ ## "codetools, please do believe that we do use 'b', 'k', 'xlim' !":
+ if(0 > 1)
+ b <- xlim + b + k
+ xr.half <- (xr0 / 2) * 100 / xZ
+ xlim <- xM + c(-xr.half, xr.half)
+ eval(substitute(plot(density(y, bw = b, kernel = k, n = n),
+ main = paste("density(",ynam,
+ ", bw = ",format(b, dig = 3),
+ ", kernel = \"", k, "\")", sep=""),
+ xlim = xlim, col = col)))
+ if(do.rug) rug(y) ## points(y,rep(0,size), col = 3)
+ }
+
+ replot.maybe <- function(...)
+ if ((log.bw && !identical(lbw, as.numeric(tclvalue(Lbw)))) ||
+ (!log.bw && !identical(nbw, as.numeric(tclvalue(bw)))) ||
+ !identical(xZ, as.numeric(tclvalue(xZoom))) ||
+ !identical(xM, as.numeric(tclvalue(xlmid)))
+ )
+ replot()
+
+ base <- tcltk::tktoplevel()
+ tcltk::tkwm.title(base, paste("Tk Density(",ynam,")"))
+
+ base.frame <- tkframe(base, borderwidth = 2)
+ bw.frame <- tkframe(base.frame, relief = "groove", borderwidth = 3)
+ kern.frame <- tkframe(base.frame, relief = "groove", borderwidth = 2)
+
+ x.frame <- tkframe(base.frame)
+ xr.frame <- tkframe(x.frame)
+ xmid.frame <- tkframe(x.frame)
+ tkpack(xr.frame, xmid.frame, side = "left", anchor = "s")
+
+ q.but <- tcltk::tkbutton(base, text = "Quit", command = function() {
+ par(op) ## see par() below !
+ tcltk::tkdestroy(base) })
+ tkpack(base.frame,
+ bw.frame, kern.frame,
+ x.frame,
+ q.but)
+
+ ## Bandwith Frame :
+ tkpack(tklabel (bw.frame,
+ text = if(log.bw)"log10(Bandwidth)" else "Bandwidth"))
+ tkpack(tkscale (bw.frame, command = replot.maybe,
+ from = if(log.bw) lbw0 + (from.f) else bw0 * from.f,
+ to = if(log.bw) lbw0 + (to.f) else bw0 * to.f,
+ showvalue = showvalue,
+ variable = if(log.bw) Lbw else bw,
+ resolution = if(log.bw) lbw0/20 else bw0/4 * from.f,
+ length = 200,
+ orient = "horiz"))
+
+ ## Kernel Frame :
+ tkpack(tklabel(kern.frame, text = "Kernel"))
+ for (k.name in kernels)
+ tkpack(tcltk::tkradiobutton(kern.frame, command = replot,
+ text = k.name, value = k.name, variable=kernel),
+ anchor = "w")
+
+ ## [x Zoom] Frame :
+ tkpack(tklabel (xr.frame, text = "x zoom [%]"))
+ tkpack(tkscale (xr.frame, command = replot.maybe,
+ from = 5,# = 1/20
+ to = 500,# = * 5
+ showvalue = TRUE, variable = xZoom,
+ length = 80, orient = "horiz"))
+
+ ## [x Pan] Frame :
+ tkpack(tklabel (xmid.frame, text = "x pan"))
+ tkpack(tkscale (xmid.frame, command = replot.maybe,
+ from = xm0 - xr0,
+ to = xm0 + xr0,
+ showvalue = FALSE, variable = xlmid,
+ resolution = xr0/2000,
+ length = 80, orient = "horiz"))
+
+
+ if((op <- par("ask")) || prod(par("mfrow")) > 1)
+ op <- par(ask = FALSE, mfrow = c(1,1))
+ ## on.exit(par(op)) is *NOT* sufficient; do it only when quitting tk !!
+
+ ##Dbg cat("Before calling `replot()' : \n")
+ replot()
+
+ ## Returning doesn't work!!
+ ##return(tclvar[c("bw", "kernel")])
+}
+
+###---
+
+## tkpack() :
+##- .Tcl(.Tcl.args(...)) :
+##- [tcl] unknown or ambiguous option "": must be \
+## -after, -anchor, -before, -expand, -fill, -in,
+## -ipadx, -ipady, -padx, -pady, or -side.
diff --git a/R/twoway-r-plot.R b/R/twoway-r-plot.R
new file mode 100644
index 0000000..5fd0e93
--- /dev/null
+++ b/R/twoway-r-plot.R
@@ -0,0 +1,116 @@
+compresid2way <-
+ function(aov, data=NULL, fac=1:2,
+ label = TRUE, numlabel = FALSE, xlab=NULL, ylab=NULL, main=NULL,
+ col=c(2,3,4,4),lty=c(1,1,2,4), pch=c(1,2))
+{
+ ## Zweck: forget-it-plot Autor: Stahel Datum: Dez 89
+ ## Arguments:
+ ## aov either a aov object with a formula of the form
+ ## y ~ a + b , where a and b are factors
+ ## or such a formula
+ ## data data frame containing a and b
+ ## fac the two factors used for plotting
+ ## label show levels of factors in the plot
+ ## numlabel show effects of factors in the plot
+ ## col,lty,pch colors, line types, plotting characters to be used
+ ## [1] positive residuals
+ ## [2] negative residuals
+ ## [3] grid
+ ## [4] labels
+
+ if (inherits(aov,"aov")) {
+ lform <- formula(aov)
+ if (is.null(data)) {
+ datanm <- as.character(aov$call)[3]
+ if (is.na(datanm))
+ stop("no data found")
+ data <- eval(parse(text=datanm))
+ }
+ } else {
+ if (!is.data.frame(data))
+ stop("unsuitable argument data")
+ lform <- aov
+ aov <- aov(lform,data)
+ }
+ lmm <- model.frame(aov)
+ fac <- if (is.numeric(fac)) fac+1 else match(fac,names(lmm))
+ if (any(is.na(fac)))
+ stop("factor(s) not found")
+ if (!all(vapply(lmm[,fac], is.factor, NA)))
+ stop("variables are not both factors")
+ ## coefficients, components of the fit
+ lcf <- dummy.coef(aov)
+ lic <- lcf[["(Intercept)"]]
+ if (is.na(lic)) lic <- 0
+ lia <- fac[1]
+ lib <- fac[2]
+ lfa <- lmm[,lia]
+ lfb <- lmm[,lib]
+ lcfa <- lcf[[lia]]
+ lcfb <- lcf[[lib]]
+ lmna <- min(lcfa)
+ lmnb <- min(lcfb)
+ lcfa <- lcfa-lmna
+ lcfb <- lcfb-lmnb
+ lic <- lic+lmna+lmnb
+ lefa <- lcfa[lfa]
+ lefb <- lcfb[lfb]
+ lfit <- lic+lefa+lefb
+ lfnames <- names(lmm)[c(lia,lib)]
+ lyname <- names(lmm)[1]
+ ly <- lfit+resid(aov)
+ ## prepare plot
+ lx <- lefb-lefa
+ if (is.null(main))
+ main <- format(lform)
+ if (is.null(ylab))
+ ylab <- lyname
+ if (is.null(xlab))
+ xlab <- paste("-",paste(lfnames,collapse = " + "))
+ lty <- rep(lty,length = 4)
+ if (length(pch) <= 1) pch <- rep(c(pch,pch,1),length = 2)
+ lrgy <- range(c(lfit, ly))
+ lrgx <- range(lx)
+ lht <- 0.05 * diff(lrgy)
+ lwd <- 0.05 * diff(lrgx)
+ plot(lrgx+lwd*c(-1,1), lrgy+lwd*c(-1,1), type = "n", xlab = "", ylab = ylab)
+ mtext(main, 3, 1,
+ cex = par("cex.main"), col = par("col.main"), font = par("font.main"))
+ mtext(xlab,1, par("mgp")[1], at = 0)
+ ## residuals
+ li <- ly > lfit
+ if (any(li)) {
+ lpch <- if (length(pch) >= length(li)) pch[li] else pch[1]
+ segments(lx[li], lfit[li], lx[li], ly[li], lty = lty[1], col = col[1])
+ points(lx[li], ly[li], col = col[1], pch = lpch)
+ }
+ li <- !li
+ if (any(li)) {
+ lpch <- if (length(pch) >= length(li)) pch[li] else pch[2]
+ segments(lx[li], lfit[li], lx[li], ly[li], lty = lty[2], col = col[2])
+ points(lx[li], ly[li], col = col[2], pch = lpch)
+ }
+ ## grid
+ lmxa <- max(lcfa)
+ segments(lcfb, lic + lcfb, lcfb - lmxa, lic + lmxa + lcfb,
+ lty = lty[3], col = col[3])
+ lmxb <- max(lcfb)
+ segments( - lcfa, lic + lcfa, lmxb - lcfa, lic + lmxb + lcfa,
+ lty = lty[3], col = col[3])
+ ## labels
+ if(label)
+ text(c(lcfb - lmxa - lwd, lmxb - lcfa + lwd),
+ c(lmxa + lcfb, lmxb + lcfa) + lic + lht,
+ c(levels(lfb), levels(lfa)), col = col[4])
+ if(numlabel) {
+ ldg <- - min(0, floor(log10(max(abs(lrgy)))) - 3)
+ text(c(lcfb + lwd, - lcfa - lwd), lic + c(lcfb, lcfa) - lht,
+ round(c(lcfb, lcfa), ldg), col = col[4])
+ }
+ lcf <- list(lic,lcfa,lcfb)
+ names(lcf) <- c("(Intercept)",lfnames)
+ lcompy <- data.frame(ly,lefa,lefb)
+ names(lcompy) <- c(paste("part",lyname,sep = "."),
+ paste("eff",lfnames,sep = "."))
+ invisible(list(compy = lcompy,coef = lcf))
+}
diff --git a/R/u.goodies.R b/R/u.goodies.R
new file mode 100644
index 0000000..0773f8c
--- /dev/null
+++ b/R/u.goodies.R
@@ -0,0 +1,86 @@
+####--- Utilities -----------------
+
+## Was in ./unix/ -- but is called from pdf.end() / ps.end() which are here: ./ps.goodies.R
+Sys.ps.cmd <- function() {
+ sys <- (si <- Sys.info())[["sysname"]]
+ if(sys == "Linux") {
+ s.rel <- si[["release"]] ## 2013-7: Kurt sees s.rel <- "3.9-1-amd64"
+ rel <- c(as.integer(strsplit(s.rel,"[[:punct:]]")[[1]][1:2]) %*% c(1000,1))
+ if(is.na(rel)) rel <- 3000
+ if(rel >= 2006) "/bin/ps w" ## Linux kernel >= 2.6 (this is true for Ubuntu!)
+ else if(rel >= 2002) "/bin/ps --width 1000" ## Linux >= 2.2
+ else structure("/bin/ps w",type="BSD")
+ }
+ else if(sys == "SunOS") "/usr/bin/ps"
+ else {
+ warning("Unknown OS [Operating System]; 'ps' may not be compatible")
+ "ps"
+ }
+}
+
+
+u.sys <- function(..., intern=TRUE) system(paste0(...), intern=intern)
+
+u.date <- function(short = FALSE)
+ format(Sys.time(), paste0("%d/%h/%Y", if(!short) ", %H:%M"))
+## Unix-only: u.sys("date '+%d/%h/%Y", if(!short) ", %H:%M", "'")
+
+u.Datumvonheute <- function(W.tag = 2, Zeit = FALSE)
+{
+ ## Ziel: Deutsches (kurzes) Datum (als string)
+ ##
+ ## ==> ?u.Datumvonheute [online help]
+ ## Unix-only: dat <- as.numeric(system("date '+%w %d %m %Y %H %M' | tr ' ' '\n'",TRUE))
+ dat <- as.integer(strsplit(format(Sys.time(),"%w %d %m %Y %H %M"), " ")[[1]])
+ ## 1 2 3 4 5 6
+ DMY <- paste0(dat[2], ". ", C.Monatsname[dat[3]], " ", dat[4])
+ r <- if (W.tag) { #-- wollen Wochentag
+ W <- ifelse(dat[1]==0, 7, dat[1])
+ if (W.tag==2) Wtag <- C.Wochentag[W]
+ else Wtag <- C.Wochentagkurz[W]
+ paste(Wtag, DMY, sep=", ")
+ } else DMY
+ if(Zeit) {
+ paste(r, if (Zeit==2) paste(dat[5:6], collapse=":") else dat[5],
+ sep="; ")
+ } else r
+}
+
+C.Monatsname <- c("Januar", "Februar", "Maerz", "April", "Mai", "Juni",
+ "Juli", "August", "September", "Oktober", "November", "Dezember")
+
+C.Wochentag <- c("Montag", "Dienstag", "Mittwoch", "Donnerstag",
+ "Freitag", "Samstag", "Sonntag")
+C.Wochentagkurz <- c("Mon", "Die", "Mit", "Don", "Fre", "Sam", "Son")
+
+C.weekday <- c("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun")
+
+## Months: we had
+## C.monthname === month.name in R
+## C.monthshort === month.abb in R
+
+##>>> Please: Forget the following !! it is ===== S function date() !!
+##>>> "u.datum"<- function() unix("date")
+
+u.datumdecode <-
+ function(d, YMDHMnames = c("Jahr", "Monat", "Tag", "Std", "Min"))
+{
+ ## Ziel: Daten der Form 8710230920 aufspalten in Jahr, Monat, Tag, Std, Min
+ ## ----------------------------------------------------------------------
+ ## Bemerkungen: Dies scheint mir nicht das richtige Konzept.
+ ## Wenn man numerische Datuemer will, soll man doch julianische
+ ## Daten verwenden !! Dann hat man auch eine richtige Zeit-Skala
+ ## Diese Funktionen sind in library(examples) und (verbessert) in
+ ## /u/maechler/s/date.Data !! (Martin Maechler)
+ ##=======================================================================
+ if(length(YMDHMnames) != 5 || !is.character(YMDHMnames))
+ stop("invalid `YMDHMnames': must be character(5)")
+ n <- length(d)
+ z <- matrix(NA, n, 5, dimnames = list(names(d), YMDHMnames))
+ for(j in 5:1) {
+ h <- d %/% 100
+ z[, j] <- d - 100 * h
+ d <- h
+ }
+ drop(z)# vector if `d' was a scalar (length 1)
+}
diff --git a/R/unix/Sys.ps.R b/R/unix/Sys.ps.R
new file mode 100644
index 0000000..41d40a4
--- /dev/null
+++ b/R/unix/Sys.ps.R
@@ -0,0 +1,192 @@
+#### Martin Maechler, Aug.2000, originally in /u/maechler/R/MISC/ps.R
+
+### --> ../../man/unix/Sys.ps.Rd to see more comments
+### --> ../../man/unix/Sys.ps.Rd to see more comments
+
+## I would really like builtin Sys.ps() for these
+
+### Sys.ps.cmd() ---> now moved to ../R/
+
+## These only apply to "System V" compatible `ps', not to BSD ones
+.Sys.ps.fields <-
+ list(POSIX = c("args", "comm", "time", "etime", "nice", "pcpu",
+ "pid", "pgid", "ppid", "group", "rgroup", "user", "ruser",
+ "tty", "vsz"),
+
+ ## Now the extras, not in above POSIX:
+ SunOS = c( "addr", "pri", "c", "rgid", "class", "rss", "f",
+ "ruid", "fname", "s", "gid", "sid", "opri", "stime", "osz",
+ "uid", "pmem", "wchan"),
+ Linux =## These are Linux (RH 6.2):"Docu" at end ..
+ c("%cpu", "%mem", "alarm", "blocked", "bsdstart", "bsdtime",
+ "c", "caught", "cmd", "command", "cputime", "drs", "dsiz", "egid",
+ "egroup", "eip", "esp", "euid", "euser", "f", "fgid", "fgroup",
+ "flag", "flags", "fname", "fsgid", "fsgroup", "fsuid", "fsuser",
+ "fuid", "fuser", "gid", "ignored", "intpri", "lim", "longtname",
+ "lstart", "m_drs", "m_trs", "maj_flt", "majflt", "min_flt", "minflt",
+ "ni", "nwchan", "opri", "pagein", "pending", "pgrp", "pmem",
+ "pri", "rgid", "rss", "rssize", "rsz", "ruid", "s", "sess", "session",
+ "sgi_p", "sgi_rss", "sgid", "sgroup", "sid", "sig", "sig_block",
+ "sig_catch", "sig_ignore", "sig_pend", "sigcatch", "sigignore",
+ "sigmask", "stackp", "start", "start_stack", "start_time", "stat",
+ "state", "stime", "suid", "suser", "svgid", "svgroup", "svuid",
+ "svuser", "sz", "timeout", "tmout", "tname", "tpgid", "trs",
+ "trss", "tsiz", "tt", "tty4", "tty8", "ucomm", "uid", "uid_hack",
+ "uname", "vsize", "wchan")
+ )
+
+## Note that proc.time() gives part of that info better
+
+## command == cmd == args gives "command + arguments : too long
+.Sys.ps.multifields <- c("command", "cmd","args", "lstart")
+
+Sys.ps <-
+ function(process = Sys.getpid(),
+ fields = c("pid", "pcpu", "time", "vsz", "comm"),
+ usefile = length(fields) > 10,
+ ps.cmd = Sys.ps.cmd(),
+ verbose = getOption("verbose"),
+ warn.multi = verbose || any(fields != "ALL"))
+{
+ if(!is.null(tp <- attr(ps.cmd,"type")) && tp == "BSD")
+ stop("this function cannot work with BSD kind of `ps'.")
+
+ ps.opt <- {
+ if(is.numeric(process) && process == round(process))
+ paste("-p",process) # PID
+ else if(process == "ALL") {
+ warning("`process = \"ALL\"' not yet working properly")
+ "-e" # all process
+ }
+ else if(is.character(process) && length(process) == 1)
+ paste("-C",process) # Command name
+ else stop(paste("invalid `process':",format(process)))
+ }
+ if(length(ps.opt) > 1)
+ warning("Multiple processes : not yet working ...")
+
+ Sys.ps.fields <- c(.Sys.ps.fields $ POSIX,
+ if(any(ii <- Sys.info()["sysname"] ==
+ names(.Sys.ps.fields)))
+ .Sys.ps.fields[ii][[1]])
+
+ if(identical(fields, "ALL"))
+ i.field <- TRUE
+ else {
+ i.field <- pmatch(fields, Sys.ps.fields) # allow abbreviated ones
+ if(any(ina <- is.na(i.field))) {
+ warning(paste("Dropping invalid field names",
+ fields[ina]))
+ i.field <- i.field[!ina]
+ }
+ }
+ fields <- Sys.ps.fields[i.field]
+ imult <- !is.na(match(fields, .Sys.ps.multifields))
+ if(any(imult) && length(fields) > 1) {
+ if(warn.multi)
+ warning(paste("Not using `multi fields' ",
+ paste(fields[imult],collapse=",")))
+ fields <- fields[!imult]
+ imult <- FALSE
+ }
+ ## Don't use "-w" with cmd/args, or command : gives space in between
+ ## Must use "--width" (GNU ps only) when there are many fields ...
+ ## Need temporary file & scan since system cannot get very long
+ ## lines ...
+ if(usefile)
+ ofile <- tempfile("R.Sys.ps")
+ cmd <- paste(ps.cmd, ps.opt,
+ "-o", paste(fields, collapse=","),
+ if(usefile) paste(" >", ofile))
+ if(verbose) cat("Now calling\n\t",cmd,"\n")
+ lines <- system(cmd, intern = !usefile)
+ if(usefile) {
+ if(lines) warning(paste("system() returned non-0 :",lines))
+ lines <- scan(ofile, what = "", sep="\n", quiet = TRUE)## incl header
+ }
+ if(length(lines) <= 1)
+ stop(paste("call returned less than two lines:", lines, sep="\n"))
+
+ r <- sub("^ ","", gsub("[ ]+"," ", lines))
+ ## SP & TAB
+ if(length(fields) == 1) {
+ if(length(r) == 2)
+ return(structure(r[2], names = fields))
+ else
+ warning(paste("Funny result with one `fields': length(r)=",
+ length(r)))
+ }
+ ## else {
+ ll <- strsplit(r, " ")
+ d.len <- diff(lenl <- sapply(ll, length))
+ if(lenl[1] == length(fields))
+ ## use fields!
+ ll[[1]] <- fields
+ else
+ warning(paste("Number returned headers =", lenl[1], " != ",
+ "#{fields} =", length(fields)))
+ if(d.len) { # names and result differ
+ warning(paste("Lengths differ:",
+ paste(lenl, collapse=",")))
+ }
+ r <- c(ll[[2]], rep(NA, max(0,-d.len)))
+ names(r) <-
+ if( d.len > 0) c(ll[[1]], rep(".x.",d.len)) else ll[[1]][1:lenl[2]]
+ r
+ ##}
+}
+
+Sys.sizes <- function(process = Sys.getpid(),
+ ps.cmd = Sys.ps.cmd())
+{
+ ## For both Solaris and GNU(Linux); GNU/Linux additionally has dsize
+
+ if(!is.null(tp <- attr(ps.cmd,"type")) && tp == "BSD") {
+ ## a *real* hack [needed for Linux 2.0 or SunOS 4.x ..]
+ r <- system(paste(ps.cmd,"m",process), intern = TRUE)[1:2] # 2 lines
+ r <- strsplit(r," *")
+ hd <- r[[1]]; hd <- hd[hd != "" & hd != "COMMAND"]
+ i <- match(c("RSS","DRS"), hd)
+ r <- structure(r[[2]][i], names = hd[i])
+ }
+ else { ## proper "System V like" ps :
+ r <- Sys.ps(process, c("rss","vsz"))
+ }
+ storage.mode(r) <- "integer"
+ r
+}
+
+if(Sys.info()[["sysname"]] == "Linux") { ##----- Linux-only ----
+
+ Sys.procinfo <- function(procfile)
+ {
+ l2 <- strsplit(readLines(procfile),"[ \t]*:[ \t]*")
+ r <- sapply(l2[sapply(l2, length) == 2],
+ function(c2)structure(c2[2], names= c2[1]))
+ attr(r,"Name") <- procfile
+ names(r) <- make.names(names(r), unique = TRUE) # <- so the result can be name-indexed!
+ class(r) <- "simple.list"
+ r
+ }
+
+} else { ## non-Linux "unix" -- including MacOS X "Darwin"
+
+ Sys.procinfo <- function(procfile) {
+ stop("Sys.procinfo() is not yet implemented for non-Linux unix-alikes")
+ }
+
+}
+
+Sys.cpuinfo <- function() Sys.procinfo("/proc/cpuinfo")
+Sys.meminfo <- function() Sys.procinfo("/proc/meminfo")
+
+Sys.MIPS <- function() as.numeric(Sys.cpuinfo()["bogomips"])
+
+Sys.memGB <- function(kind = "MemTotal") {
+ mm <- drop(read.dcf("/proc/meminfo", fields=kind))
+ if(any(is.na(mm))) stop("Non-existing 'kind': ", names(mm)[is.na(mm)][1])
+ if(!all(grepl(" kB$", mm)))
+ stop("Memory info ", dQuote(kind), " is not returned in 'kB' aka kiloBytes")
+ ## return memory in giga bytes
+ as.numeric(sub(" kB$", "", mm)) / (1000 * 1024)
+}
diff --git a/R/zzz.R b/R/zzz.R
new file mode 100644
index 0000000..9d3822f
--- /dev/null
+++ b/R/zzz.R
@@ -0,0 +1,41 @@
+## .onLoad <- function(lib, pkg)
+## {
+
+## }
+
+## if(!exists("rep_len", mode = "function")) # old R version
+## rep_len <- function(x, length.out) rep(x, length.out=length.out)
+
+
+.set.eps_view <- function() {
+ ## This assumes "gv" in your path --- ideally this would be configured!
+ if(!is.character(getOption("eps_view")) && .Platform $ OS.type == "unix") {
+ SYS <- function(cmd) system(cmd, intern=TRUE, ignore.stderr=TRUE)
+ ## doesRespond <- function(cmd) length(SYS(cmd)) > 0
+ doesRespond <- function(cmd) ## should be portable (thanks BDR):
+ all(system(paste(cmd,"> /dev/null")) != c(1,256)*127)
+ if(doesRespond("gv -h")) { ## 'gv'
+ cmd <- "gv -watch -geometry -0+0 -magstep -2 -media BBox -noantialias"
+ hyphens <-
+ SYS(paste("gv -h | fgrep watch | head -1",
+ "| sed 's/watch.*//; s/^[\\s ]*//'"))
+ if(length(hyphens) && hyphens == "--")
+ cmd <- sub(" --geometry", " -geometry",
+ sub(" --magstep ", " --scale=",
+ sub(" --media ", " --media=",
+ gsub(" -([a-z])", " --\\1", cmd))))
+ }
+ else if (doesRespond("ggv --version")) { ## try 'ggv'
+ cmd <- "ggv --geometry -0+0"
+ } else if (doesRespond("evince --version")) { ## try 'evince'
+ cmd <- "evince" # no geometry options
+ } else if (doesRespond("kghostview --version")) { ## try 'kghostview'
+ cmd <- "kghostview --geometry -0+0"
+ } else {
+ warning("no valid postscript previewer found; consider setting\n",
+ " options(\"eps_view\"= \"....\") yourself")
+ cmd <- "replace_with_postscript_previewer"
+ }
+ options("eps_view" = cmd)
+ }
+}
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..2577f3a
--- /dev/null
+++ b/README.md
@@ -0,0 +1,15 @@
+sfsmisc
+=======
+
+The R package sfsmisc has finally made it into a revision control system,
+and the fad of the day being git & github, so be it!
+
+sfsmisc has been on CRAN for a very long time, and containing R code that is up to 17.5 years old.
+
+It is a collection of "goodies" as we used to call these nice utility functions. Whereas the package has been
+written and maintained by Martin Maechler, really there are quite a few more members of the SfS (Seminar fuer Statistik at ETH Zurich)
+who have authored some of the functions or contributed to them.
+
+DESCRIPTION
+===========
+Useful utilities 'goodies' from Seminar fuer Statistik ETH Zurich, quite a few related to graphics; many ported from S-plus times.
diff --git a/TODO b/TODO
new file mode 100644
index 0000000..e1e9db6
--- /dev/null
+++ b/TODO
@@ -0,0 +1,36 @@
+##-*- org -*-
+
+* TODO in [[DESCRIPTION]], use Authors at R with Werner, Andreas, .., Alain, ..
+* TODO New utilities for MASS::boxcox() "diagnostics", notably histogram nicely labeled
+** --> ~/R/MM/Pkg-ex/microbenchmark/seq-mb.R
+** Maybe ask Brian about willingness to improve: boxcox(*, plotit=TRUE) looks nice,
+** but the estimate + conf.interval computations are inside the plotting, not available as numbers
+* TODO Better ylim for boxplot(<microbenchmark>), see, ~/R/MM/Pkg-ex/microbenchmark/simple-ex.R
+* TODO mat2tex() is really not flexible enough; and there are better functions
+ in other packages, e.g. latex in 'Hmisc' --> deprecate this! [2005-04]
+
+* TODO str_data() could become more flexible (class = ".";
+ also (optionally) return class + dim()/length(); see 'TODO' in [[R/str_data.R]]
+* TODO is.whole() [[R/misc-goodies.R]] conflicts with gmp::is.whole() -- as it has a 'tolerance'
+
+* TODO move some demo/*.R to vignettes/*.Rmd -- notably the prime-numbers (for those, see also below)
+* TODO clean up R/prime-numbers-fn.R -- move all non-exported functions to
+** TODO (a new file) ./inst/primes-extra-fns.R
+** TODO and source() that from ./demo/prime-numbers.R !!
+* Reverse Dep. status: 2014-06-16 http://stat.ethz.ch/CRAN/web/packages/sfsmisc/
+** Reverse depends: ascrda, catIrt, distr, ICEbox, lordif, modiscloud, plfm, polycor, random.polychor.pa
+** Reverse imports: CDM, Demerelate, FrF2, lokern, mcmcplots, ReliabilityTheory, simsalapar, sirt, TAM
+
+* TODO Improve ps.end(): should return something useful
+ ==> new ./tests/psend-ex.R which tests that 2 x {ps.do() ... ps.end()}
+ *does* work properly
+* TODO eaxis() [ ./R/prettylab.R ] :
+** TODO allow log2-scale and "2^..." labelling --- or log_k and 'k^..'
+** TODO this is a range where the *defaults* of eaxis are completely bad
+ --> but really it is because axTicks(*, log=TRUE) can be bad:
+ curve(qgamma(1e-100, x, lower.tail=FALSE), 1e-110, 1e-70, log="xy", col=2, axes=FALSE)
+ eaxis(1);eaxis(2)
+* TODO Work on R/approx2.R, for now [[approx2.R]] -- implement remaining "vectorized" part
+
+* DONE 2008-10-22: Copied boxplot.matrix() to R-devel (2.9.0 to be)
+ Remove this from 'sfsmisc' eventually.
diff --git a/data/potatoes.rda b/data/potatoes.rda
new file mode 100644
index 0000000..0b1b46d
Binary files /dev/null and b/data/potatoes.rda differ
diff --git a/demo/00Index b/demo/00Index
new file mode 100644
index 0000000..5c36dac
--- /dev/null
+++ b/demo/00Index
@@ -0,0 +1,3 @@
+hatmat-ex hat matrix / smoother Matrix examples
+prime-numbers Prime numbers, factorization, etc: (Simple) implementations
+pretty-lab Pretty axis labels, including using tikz
diff --git a/demo/hatmat-ex.R b/demo/hatmat-ex.R
new file mode 100644
index 0000000..20c1df8
--- /dev/null
+++ b/demo/hatmat-ex.R
@@ -0,0 +1,120 @@
+#### Demos for sfsmisc::hatMat()
+
+##' Matrix trace -- tr(M) = \sum_i M_{i,i}
+##'
+##' .. content for \details{} ..
+##' @title Matrix trace
+##' @param m
+##' @return sum(<diagonal elements of 'm'>)
+##' @author Martin Maechler
+TR <- function(m) { ## Matrix trace(.) == tr(.) :
+ stopifnot(length(d <- dim(m)) == 2, d[1] == d[2])
+ sum(diag(m))
+}
+
+## Take those from ?hatMat -- modified --
+##--.--.--.--.--.--.--.--
+## Example 'pred.sm' arguments for hatMat() :
+pspl <- function(x,y,...) predict(smooth.spline(x,y, ...), x = x)$y
+## needed! default surface="interpolate" is not good enough :
+loess.C <- loess.control(surface = "direct")
+ploess <- function(x,y,...) predict(loess(y ~ x, ..., control=loess.C))
+
+pksm <- function(x,y,...) ksmooth(sort(x),y, kernel="normal", x.points=x, ...)$y
+## maybe rather than ksmooth():
+if(require("sm"))
+ pksm2 <- function(x,y,...)
+ sm.regression(x,y, display="none", eval.points=x, ...)$estimate
+##--.--.--.--.--.--.--.--
+
+set.seed(21)
+
+x <- seq(0, 10, length= 201) ## sorted !! -- otherwise:
+mf <- function(x) x^1.5 * sin(x)
+y <- mf(x) + 5*rnorm(x)
+
+## Plot data + smooths -- smoothing parameters carefully chosen
+## such that df ~= 8.8 for all:
+plot(x,y, cex=.6)
+lines(x, mf(x), col="gray", lwd=3)## true m(x)
+lines(predict(s1 <- smooth.spline(x,y, spar=.8)), col="blue"); s1 #-> df = 8.8
+lines(x, predict(s2 <- loess(y ~ x, span=.385, control=loess.C)),
+ col="forest green"); s2 # df = 8.77
+lines(x, s3y <- ksmooth(x,y, "normal", bandwidth= 1.3)$y, col="tomato")
+s4 <- sm.regression(x,y, h = 0.54, display="none", eval.points=x)
+lines(x, s4$estimate, col = "purple")
+legend("topleft", c("true m(.)", "sm.spline", "loess", "ksmooth", "sm.regression"),
+ col=c("gray","blue","forest green","tomato","purple"),
+ lty=1, lwd=c(3, 1,1,1,1), inset=.01)
+
+TR(H.sspl <- hatMat(x, pred.sm = pspl, spar = .8)) # 8.808432
+TR(H.loess <- hatMat(x, pred.sm = ploess, span = .385)) # 8.865958
+TR(H.ksm <- hatMat(x, pred.sm = pksm, bandwidth = 1.3))# 8.788017
+TR(H.ksm2 <- hatMat(x, pred.sm = pksm2, h = 0.54)) # 8.80269 -- sm.regression is S.L.O.W
+
+## Check consistency:
+stopifnot(
+ ## Smoothing Spline:
+ all.equal(c(H.sspl %*% y), fitted(s1))
+ ,
+ all.equal(sum(diag(H.sspl)), s1$df)
+ ,
+ ## Loess
+ all.equal(c(H.loess %*% y), fitted(s2))
+ ,
+ ## ksmooth()
+ all.equal(c(H.ksm %*% y), s3y)
+ ,
+ ## sm.regression()
+ all.equal(c(H.ksm2 %*% y), s4$estimate)
+ )
+
+
+op <- mult.fig(mfrow=c(4,1), marP=-.5)$old.par
+yl <- c(-.01, 0.10)
+matplot(x, H.sspl, type="l", ylim=yl)
+matplot(x, H.loess, type="l", ylim=yl)
+matplot(x, H.ksm, type="l", ylim=yl)
+matplot(x, H.ksm2, type="l", ylim=yl)
+par(op)
+
+## or just a subset
+i <- c(1, seq(10,200, by=20), length(x))
+op <- mult.fig(mfrow=c(4,1), marP= -.5,
+ main = paste("rows",paste(i,collapse=",")," of hat matrices"))$old.par
+matplot(x, H.sspl [,i], type="l", ylim=yl)
+matplot(x, H.loess[,i], type="l", ylim=yl)
+matplot(x, H.ksm [,i], type="l", ylim=yl)
+matplot(x, H.ksm2 [,i], type="l", ylim=yl)
+par(op)
+
+##' Image plot of a symmetric matrix -- traditional graphics
+##'
+##' @title Image Plot of Symmetric Matrix
+##' @param m symmetric numeric matrix
+##' @param color
+##' @param levels
+##' @param ... passed to filled.contour()
+##' @return
+##' @author Martin Maechler
+pMatrix <- function(m, color=topo.colors, levels= pretty(range(m), 20), ...)
+{
+ stopifnot(length(d <- dim(m)) == 2, d[1] == d[2])
+ n <- d[1]
+ ii <- seq_len(n)
+ i. <- rev(ii)
+ il <- unique(c(1,pretty(ii)))
+ op <- par(mgp = c(3, .6, 0)); on.exit(par(op))
+ filled.contour(ii, ii, m[i.,], color=color, levels=levels,
+ plot.axes = { axis(3, il); axis(2, at = n+1-il, labels = il)}, ...)
+}
+
+levs <- pretty(c(-0.025, 0.15), 25)
+pMatrix(H.sspl, levels=levs,
+ main = "hat matrix S for smooth.spline()")
+
+if(dev.interactive()) dev.new()
+pMatrix(H.loess, levels=levs, main = "hat matrix S for loess()")
+
+if(dev.interactive()) dev.new()
+pMatrix(H.ksm, levels=levs, main = "hat matrix S for ksmooth()")
diff --git a/demo/pretty-lab.R b/demo/pretty-lab.R
new file mode 100644
index 0000000..2fdd63e
--- /dev/null
+++ b/demo/pretty-lab.R
@@ -0,0 +1,35 @@
+## Original from David Seifert (ETHZ Basel, c/o Beerenwinkel)
+## https://github.com/mmaechler/sfsmisc/pull/2
+
+### Example showing how eaxis() / pretty10exp() lab.type = "latex"
+### can be used together with LaTeX package "tikz" and
+stopifnot(require("tikzDevice"))
+### to produce LaTeX math labels
+require("sfsmisc")
+
+x <- (-3:10) * 10^10
+y <- abs(x / 1e9)
+
+(t.file <- tempfile("tikz-eaxis", fileext = ".tex"))
+tikz(file = t.file, standAlone=TRUE)
+plot(x, y, axes=FALSE, type = "b")
+eaxis(1, at=x, lab.type="latex")
+eaxis(2, lab.type="latex")
+dev.off()# i.e. finish and close file 't.file'
+
+## Now add two lines to (the preamble of the latex file
+## such that all axis tick labels are in latex math if requested by lab.type="latex".
+## {Note : "\" (backslash) must be doubled in R strings}
+helvet.lns <- c("\\renewcommand{\\familydefault}{\\sfdefault}",
+ "\\usepackage{helvet}")
+str(ll <- readLines(t.file))
+writeLines(c(ll[1:4], "", "%% Added from R (pkg 'sfsmisc', demo 'pretty-lab'):",
+ helvet.lns, "", ll[-(1:5)]), t.file)
+
+## Produce PDF from LaTeX
+system(paste(paste0("pdflatex -output-directory=", dirname(t.file)),
+ t.file))
+
+## and view it
+if(file.exists(p.file <- sub("tex$", "pdf", t.file)) && interactive())
+ system(paste(getOption("pdfviewer"), p.file), wait=FALSE)
diff --git a/demo/prime-numbers.R b/demo/prime-numbers.R
new file mode 100644
index 0000000..f4bb48f
--- /dev/null
+++ b/demo/prime-numbers.R
@@ -0,0 +1,157 @@
+####---- Prime numbers, factorization, etc. --- "illustration of programming"
+####---- A Collection of pure S / R -- Experiments from the 1990's
+####---- mostly carried by discussions on the good old S-news mailing list
+
+### Mostly using the functions currently hidden in sfsmisc namespace
+### FIXME: ---> Move these function definitons to ../inst/ ---> see ../TODO (10)
+factorizeBV <- sfsmisc:::factorizeBV
+primes. <- sfsmisc:::primes.
+test.factorize <- sfsmisc:::test.factorize
+prime.sieve <- sfsmisc:::prime.sieve
+factors <- sfsmisc:::factors
+
+##
+factorizeBV(6)
+##[1] 2 3
+str( factorizeBV(4:8) )
+
+
+### 1) The super speedy primes() function from Bill Venables
+### {and improved by M.Maechler}:
+
+## on a Pentium 4 2.80 GHz with 2 GB RAM ;
+
+N <- 1e7
+
+## keep this working for S+ ! compatible
+for(i in 1:3) print(system.time(p7 <- primes.(N))[1:3]) ## Bill Venables' original
+##- [1] 3.86 1.93 8.75
+##- [1] 4.02 1.60 11.34
+##- [1] 4.14 1.60 11.51
+## about 10-20% slower on 'lynne'
+
+for(i in 1:3) print(system.time(p7. <- primes(N))[1:3]) ## Martin Maechler's improvement
+##- [1] 2.29 0.76 6.47
+##- [1] 2.58 0.73 6.67
+##- [1] 2.71 0.59 6.64
+stopifnot(p7 == p7.)
+
+## On 'lynne' (AMD Athlon 64bit 2800+, 1G RAM), speedup somewhat similar;
+## Also here
+system.time(for(i in 1:50) p5 <- primes (1e5))[1:3]
+system.time(for(i in 1:50) p5. <- primes.(1e5))[1:3]
+stopifnot(p5 == p5.)
+
+
+## 2)
+
+factorize(n <- c(7,27,37,5*c(1:5, 8, 10)))
+factorize(47)
+factorize(7207619)## quick !
+factorize(131301607)# prime -> still only 0.02 seconds (on lynne)!
+
+## Factorizing larger than max.int -- not prime;
+## should be much quicker with other algo (2nd largest prime == 71) !!
+factorize(76299312910)
+
+system.time(fac.1ex <- factorize(1000 + 1:99)) #-- 0.95 sec (sophie Sparc 5)
+#-- 0.02 sec (P 4, 1.6GHz); 0.4 / .65 sec (florence Ultra 1/170)
+system.time(fac.2ex <- factorize(10000 + 1:999))
+## R 0.49 : 5.4 sec (florence Ultra 1/170)
+## ------ 6.1 sec (sophie Ultra 1/140)
+## R 0.50-: ~ 3.5 sec (sophie ..........) <<< FASTER !
+## ------
+
+## This really used to take time -- no longer w/ current factorize() in 2004 !
+system.time(factorize.10000 <- factorize(1:10000))
+## sophie: Sparc 5 (..) :lots of swapping after while, >= 20 minutes CPU;
+## then using less and less CPU, ..more swapping ==> KILL
+## florence (hypersparc): [1] 1038.90 5.09 1349. ( 17 min. CPU)
+## lynne (Ultra-1): [1] 658.77 0.90 677.
+## lynne (Pentium 4): [1] 2.43 0.16 2.68
+## helen (Pentium 4), R1.9.1: 1.02 0.01 1.04
+## lynne (64b,2800+), R2.0.1: 0.86 0.00 0.86
+
+object.size(factorize.10000) #--> 3027743 now (R 1.5.1) 3188928;
+ # '* 2' for 64-bit
+###--- test
+test.factorize(fac.1ex[1:10]) #-- T T T ..
+which(!test.factorize(fac.1ex))
+which(!test.factorize(factorize(8000 + 1:1000)))
+
+
+prime.sieve(prime.sieve())
+system.time(P1e4 <- prime.sieve(prime.sieve(prime.sieve()), max=10000))
+##-> 1.45 (on sophie: fast Sparc 5 ..)
+##-> ~0.8 (on jessica: Ultra-2)
+##-> 0.08 (on lynne, Pentium 4 (1600 MHz))
+##----> see below for a sample of 20 !
+stopifnot(length(P1e4) == 1229)
+
+CPU.p1e4 <- numeric(20)
+for(i in 1:20) CPU.p1e4[i] <-
+ system.time(P1e4 <- prime.sieve(prime.sieve(prime.sieve()), max=10000))[1]
+CPU.p1e4
+summary(CPU.p1e4)
+##-Ultra-2 Min. 1st Qu. Median Mean 3rd Qu. Max.
+##-Ultra-2 0.690 0.690 0.790 0.755 0.800 0.810
+## P4 R-?) 0.070 0.070 0.080 0.078 0.080 0.100
+## P4 R-1.9 0.040 0.050 0.050 0.048 0.050 0.050
+system.time(P1e4.2 <- prime.sieve( max=10000))
+##-> 1.46 (sophie) maybe a little longer
+stopifnot(identical(P1e4 , P1e4.2))
+
+system.time(P1e5 <- prime.sieve(P1e4, max=1e5)) ## note! primes() is faster!
+##-> 105.7 (on sophie: fast Sparc 5)
+##-> 58.83 (on jessica: Ultra2)
+##-> 5.67 (on lynne: Pentium 4)
+##-> 3.96 (on lynne: Pentium 4 -- R 1.9)
+##-> 1.37 (on lynne: AMD 64 -- R 2.0.1)
+
+stopifnot(p5 == P1e5,
+ length(P1e5) == 9592)
+
+P1000 <- prime.sieve(max=1000)
+
+plot(P1000, seq(P1000), type='b', main="Prime number theorem")
+lines(P1000, P1000/log(P1000), col=2, lty=2, lwd=1.5)
+
+plot(P1e4, seq(P1e4), type='l', main="Prime number theorem")
+lines(P1e4, P1e4/log(P1e4), col=2, lty=2, lwd=1.5)
+
+stopifnot(require("sfsmisc"))
+## For a nice plot:
+ps.do("prime-number.ps")
+mult.fig(2, main="Prime number theorem")
+plot(P1e5,seq(P1e5), type='l', main="pi(n) & n/log(n) ",
+ xlab='n',ylab='pi(n)', log='xy', sub = 'log - log - scale')
+lines(P1e5, P1e5/log(P1e5), col=2, lty=2, lwd=1.5)
+mtext("demo(\"prime-numbers\", package = \"sfsmisc\")",
+ side = 3, cex=.75, adj=1, line=3, outer=TRUE)
+plot(P1e5, seq(P1e5) / (P1e5/log(P1e5)), type='b', pch='.',
+ main= "Prime number theorem : pi(n) / {n/log(n)}", ylim =c(1,1.3),
+ xlab = 'n', ylab='pi(n) / (n/log(n)', log='x')
+abline(h=1, col=3, lty=2)
+ps.end()
+
+
+## 3) the factors() from Bill Dunlap etc
+factors( round(gamma(13:14)))
+##- $"479001600":
+##- [1] 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 5 7 11
+##-
+##- $"6227020800":
+##- [1] 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 5 5 7 11 13
+
+
+## --- You can use table() to collect repeated factors : ----
+
+lapply( factors( round(gamma(13:14))), table)
+##- $"479001600":
+##- 2 3 5 7 11
+##- 10 5 2 1 1
+##-
+##- $"6227020800":
+##- 2 3 5 7 11 13
+##- 10 5 2 1 1 1
+
diff --git a/inst/ChangeLog b/inst/ChangeLog
new file mode 100644
index 0000000..4f760e2
--- /dev/null
+++ b/inst/ChangeLog
@@ -0,0 +1,1019 @@
+2015-01-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (pretty10exp): extended 'sub10' possibilities
+
+2014-07-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-27, released to CRAN on 2015 <<<<<<<
+ * R/KS-confint.R (ecdf.ksCI): '...' now also passed to first of
+ three plot() calls to plot.stepfun().
+
+2014-07-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (eaxis): sub10 (=FALSE) can be set for pretty10exp()
+
+2014-06-15 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (toLatex.numeric): times="\\cdot" .. from Alain
+
+ * R/misc-goodies.R (is.whole): new from Alain (May 12).
+
+2014-06-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.res.2x.WSt.R (p.res.2x.formula): new, method for p.res.2x()
+ which is now generic
+ * man/p.res.2fact.Rd: p.res.2x(~., <lm>) now can work
+
+2014-05-02 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (pretty10exp): new 'lab.type' (and 'lab.sep')
+ from Ben Bolker
+
+2014-04-24 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (bi2int): new utility, called in as.intBase()
+ * man/digitsBase.Rd: add the IP "n <-> a" example w/ base=256
+
+2014-04-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-26, released to CRAN on 2014-06-16
+ * R/prettylab.R (pretty10exp): new 'sub10' option
+ * R/prettylab.R (toLatex.numeric): new, original from Alain
+
+2013-10-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-25, released to CRAN on 2014-01-24.
+ * R/unix/Sys.ps.R (Sys.memGB): new utility
+ * man/unix/Sys.cpuinfo.Rd: incl example
+
+2013-01-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (pdf.do): set paper to "special" when user
+ specifies 'width' and 'height'.
+
+2013-01-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-24, released to CRAN on 2013-08-03.
+
+ * R/prettylab.R (eaxis): for 'log': new 'between.max = 4';
+ set 'at.small <- FALSE' in such cases, when small ticks are not
+ sensible.
+
+
+2012-11-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-23, released to CRAN on 2012-11-01
+
+ * R/misc-goodies.R (digitsBase): ndigits default argument needs
+ fuzz (1e-9), e.g., for base 3.
+
+2012-10-20 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-22, released to CRAN on 2012-10-20
+
+ * R/ps.goodies.R (dev.latex): oops: finally found and fixed bug
+ where the missing(.) checks where never true, as dev.latex() is
+ always called from above with explicit argument passing.
+
+ * man/histBxp.Rd: renamed hist.bxp() to histBxp() .. on CRAN's
+ urging.
+
+2012-09-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-21, released to CRAN today
+ * R/prettylab.R (eaxis): new 'small.args' for Marius
+
+2012-04-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/unix/Sys.cpuinfo.Rd: fix example
+
+2012-03-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-20, released to CRAN on 2012-03-18
+
+ * man/capture-n-write.Rd: new capture.and.write() function
+
+2011-11-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (seqXtend): change to enable "interpolate" with
+ 'Date' objects.
+
+2011-10-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-19, released to CRAN on 2011-11-21
+
+ * man/str_data.Rd: + examples for 'filterFUN'
+
+2011-10-08 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/str_data.R (str_data): new arg 'filterFUN'
+
+2011-10-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-18, released to CRAN.
+ * R/prettylab.R (eaxis): fix Rversion check.
+
+2011-10-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (pretty10exp): digits.fuzz = 7:
+ add fuzz before rounding, twice.
+ (eaxis): new arg draw.between.ticks = TRUE.
+
+2011-07-29 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-17, released to CRAN on 2011-10-01.
+
+ * R/sourceAttach.R (sourceAttach): new utility function
+
+2011-07-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-16, released to CRAN.
+
+ * R/pd-matrix.R (posdefify): symmetric = TRUE is now default, as
+ that's needed for asymmetric input.
+
+ * R/misc-goodies.R: get completely rid of boxplot.matrix: that's
+ been in R, since 2.9.0 now.
+
+2011-05-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-15, released to CRAN.
+
+ * R/misc-goodies.R (errbar): 'ylim' now is argument (with same default).
+
+2011-05-04 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prime-numbers-fn.R: finally prime number and factorization
+ "utility" code (partly ~ 13 years old!) to a place where it's
+ easily found.
+
+2011-04-28 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (eaxis): new argument 'max.at'
+
+ * man/eaxis.Rd: fix docu for at.small & small.mult.
+
+2011-04-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/diagDA.R (predict.dDA): check for var()==0 als for pool=FALSE.
+
+2010-12-06 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-14
+
+ * R/pd-matrix.R (posdefify): new argument 'eigen.m'; for efficiency
+ to pass to eigen() in case it's already available.
+
+2010-11-04 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (inv.seq): workaround mapply() infelicity
+
+2010-10-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (repChar): new utility {generalization of bl.string()}
+
+ * R/printTable.R (margin2table): return *named* dimnames, if
+ original has them.
+ (print.margin2table): use 'right = TRUE' by default
+
+2010-10-20 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-13; "Enhances:" for everything in our examples
+
+ * inst/NEWS: partial update
+
+2010-09-28 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * demo/hatmat-ex.R: add demo for hatMat(), notably how it works for
+ loess(); rather than extending the examples in
+ * man/hatMat.Rd
+
+2010-09-04 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (ps.end): call .set.eps_view() only when needed.
+
+ * R/zzz.R (.set.eps_view): utility function instead of using
+ .onLoad() for setting options("eps_view").
+
+
+2010-08-28 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-12
+
+ * R/misc-goodies.R (plotDS): fix bug for unsorted x and "moreSmooth"
+
+2010-02-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/nearcor.Rd: cor() no longer works for factors;
+ --> adapt the old example (from Jens or other users).
+
+2009-12-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/mat2tex.Rd: need quadruple escapes ( \\\\pi )
+
+2009-12-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-10
+
+ * R/ps.goodies.R (pdf.do): paper="default", width=-1, height=-1
+ such as to produce the same default as ps.do().
+
+ * man/ps.latex.Rd: update accordingly
+
+2009-11-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-9, CRAN-released: today
+
+ * man/polyn.eval.Rd, man/p.ts.R, man/eaxis.Rd: fix \link{}s
+
+2009-10-07 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (lseq): check that 'from > 0'
+
+2009-08-10 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-8
+
+ * R/unix/Sys.ps.R (Sys.procinfo): produce unique names;
+ important for multi-core/processor CPUs.
+
+ * man/unix/Sys.cpuinfo.Rd: ditto
+
+2009-07-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/uniqueL.Rd: link to Duplicated
+
+2009-04-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/Duplicated.Rd: clarification
+
+2009-01-10 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-7 ready to release
+
+2009-01-09 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/n.code.Rd: Rd_parse fixes
+ * ...., man/u.log.Rd: ditto
+
+2008-12-09 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (digitsBase): allow integer-valued non-integers
+
+2008-12-08 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R: get rid of more `x' like backquotes.
+
+2008-11-25 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-6 ready to release
+
+ * R/prettylab.R (eaxis): change default to las = 1, "2" was a thinko!
+
+2008-11-10 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.goodies.R (p.profileTraces): default 'subtitle' now includes formula
+
+2008-11-08 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * NAMESPACE: export Sys.meminfo()
+
+2008-10-31 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-5 released to CRAN
+
+ * R/Duplicated.R (Duplicated): new by Christoph Buser and MM
+ * NAMESPACE, man/Duplicated.Rd
+
+ * R/ellipse.R (ellipsePoints): add 'keep.ab.order' argument
+ * man/ellipsePoints.Rd: allowing differ (a,b) from (b,a);
+ thanks to a suggestion from Duncan Elkins
+
+2008-10-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (eaxis): add 'las = 2' (new default!) and "..."
+
+2008-10-22 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (boxplot.matrix): "moved" to R 2.9.0
+
+2008-09-15 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (uniqueL): make 'need.sort' an optional argument
+ which allows for slight speedup
+ * man/uniqueL.Rd: ditto
+
+ * R/integratexy.R: no longer use backquote ( ` ) in error messages.
+
+2008-08-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/str_data.R (str_data): fix bug {if there are no "(..)" in the
+ items, they were all dropped accidentally}.
+
+2008-07-31 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-4 released to CRAN
+
+ * R/zzz.R (.onLoad): set options(eps_view) only if unset
+
+2008-06-28 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (chars8bit,strcodes): do not use '0' anymore,
+ since \000 = nul is no longer allowed in R strings.
+
+ * tests/misc.R: new file, testing the above.
+
+2008-06-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-3, released to CRAN.
+ * R/ps.goodies.R (pdf.do): default for 'paper' is now missing;
+ which is much better than "default".
+ * man/ps.latex.Rd: add useful example for that.
+
+2008-05-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-2; add 'Encoding: latin1'
+
+2008-02-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/unix/Sys.ps.R (Sys.procinfo): define, calling stop(".. not yet..."),
+ for non-Linux unix-alikes
+ * man/unix/Sys.cpuinfo.Rd: ditto
+
+2008-01-30 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 1.0-1
+
+ * NAMESPACE: export Sys.cpuinfo() and Sys.MIPS() only on Linux
+
+2008-01-29 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (inv.seq): use "non-integer integers" so result
+ has no "L" appended
+
+ * man/inv.seq.Rd: all.equal(), not identical anymore
+
+2008-01-11 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (eaxis): no wrong warning when labels are expression
+
+2007-12-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (inv.seq): slight improvement, using mapply(.)
+ instead of apply(.); notably now returning 'language' instead of
+ 'expression'; the nice improvement (parse |-> call(.)) is by Tony Plate
+
+2007-12-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version, Depends): 1.0-0 now depending on R >= 2.5.0
+
+2007-11-29 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (roundfixS): new utility used to
+ implement new method = "interpolate" in seqXtend().
+
+ * man/plotDS.Rd: rename pl.ds() to plotDS()
+
+2007-11-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (seqXtend): new function, e.g., for
+ constructing extended x ranges for pl.ds()
+
+ * R/misc-goodies.R: allow an extend 'ys' argument to pl.ds()
+ with smooth values on a finer grid.
+
+2007-11-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.96-01; (License): standardized
+
+ * R/prettylab.R (eaxis): 10^par(.) , not exp()
+
+ * inst/NEWS: renamed from earlier inst/doc/CHANGES.txt and linked
+ to toplevel;
+ * inst/ChangeLog: moved from ./ChangeLog and sym.linked back to toplevel.
+
+ * man/eaxis.Rd: add example with "traditional" labels
+
+ * man/potatoes.Rd: add content to \description{.} to make 'R CMD
+ check' happy
+
+2007-10-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/prettylab.R (eaxis): new function for nice (log) axis
+ labeling. (pretty10exp): drop.1: -10^k instead of -1*10^k
+
+2007-09-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-13 tested with R-alpha; for release
+
+ * man/ps.latex.Rd: document change of pdf.do (on July 13).
+
+2007-09-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.ts.R (p.ts): is.unsorted(date.x, na.rm=TRUE)
+
+2007-07-17 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (pdf.do): Bug fix: cannot use 'width= -1, height= -1'
+ as for ps.do() !
+
+2007-08-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/nearcor.R (nearcor): new function from Jens Oehlschlaegel.
+
+2007-07-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (ps.do, pdf.do): do *not* use ps.options(), since
+ you cannot pass all postscript() / pdf() options.
+
+2007-06-30 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-12 (released)
+ * R/ps.goodies.R (pdf.end): fix
+
+2007-06-29 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-11
+
+ * R/unix/Sys.ps.R (Sys.meminfo): added via new Sys.procInfo()
+
+ * R/zzz.R (options("eps_view")): add 'evince'
+
+2007-06-25 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Suggests): add 'tcltk' {needed for tkdensity()}
+
+2007-05-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * NAMESPACE: Sys.cpuinfo etc: only if(... == "unix")
+
+2007-05-22 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/wrapFormula.Rd: new function wrapFormula() mainly for gam() etc.
+
+2007-04-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * NAMESPACE: now explicitly export (instead of pattern), keeping
+ predict and print S3 methods hidden.
+
+ * R/ps.goodies.R (pdf.do, pdf.end, pdf.latex): analogues to
+ ps.do() etc.
+ (dev.latex): instead of ps.latex();
+ (pdf.latex, ps.latex): now wrappers to dev.latex
+
+2007-04-20 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/hatMat.Rd (Examples): add sm.regression(); fix '\'
+
+2007-04-19 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/hatMat.R (hatMat): add test for sensible 'trace';
+ give a warning for unsorted 'x', since that can too quickly give
+ wrong answers (not for the default smoothing spline though).
+
+2007-04-17 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/digitsBase.Rd: double the \\ so it appears correctly in
+ help() and example()
+
+2007-03-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/str_data.R (str_data): use indent.str for multi-data datasets;
+ add note about Gabor's wishlist.
+
+2007-03-15 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-9 released
+
+ * R/tkdensity.R (tkdensity): fix to allow *several* 'kernels' to
+ be specified.
+ (tkdensity): temporarily reset par()s such as par("ask")
+ and only reset when quitting tk widget.
+
+ * man/tkdensity.Rd: complete unfinished 'nor1mix' example
+
+2007-01-24 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/str_data.R: new function; very useful to get overview
+ * man/str_data.Rd: over packages' datasets.
+
+ * R/Deprecated.R: HuberM() and plotCI() are now *Defunct*, i.e.,
+ no longer visible but in file Old_Defunct/ex-Deprecated.R
+
+2007-01-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-8 to be released
+
+ * R/ps.goodies.R (ps.end): make sure 'call.gv = FALSE' works
+
+2007-01-17 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.goodies.R: using rep.int() instead of rep() in a few places.
+ * R/misc-goodies.R: ditto
+
+2006-10-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/posdefify.Rd: note about litterature
+
+2006-10-19 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-7 to be released
+
+ * R/rnls.R (rnls): becomes defunct -- leave stub in
+ * R/Deprecated.R:
+ * man/rnls.Rd.R: removed, too
+
+ * R/unix/Sys.ps.R (Sys.PID): removed: has been deprecated for long.
+ * man/unix/Sys.ps.Rd: ditto
+
+ * R/zzz.R (.onLoad): replace \s by \\s
+
+
+2006-09-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/Deprecated.R: remove nna(), digits.v(), digits(),
+ tapply.num(), subtit(),
+ p.triangle(), p.panelL() and p.panelS() ---
+ These have been deprecated since Jan. 2004 (!)
+ * man/Deprecated.Rd: ditto
+
+2006-09-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/unix/Sys.ps.R (Sys.MIPS): if(.Linux-only.)
+ * man/unix/Sys.cpuinfo.Rd: ditto ==> should "work" on MacOS X
+
+2006-08-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/mult.fig.R (mult.fig): no longer globally assign 'old.par'.
+ This has been deprecated since 2004-08-12, rel. 0.9-5.
+
+2006-08-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/rrange.R (rrange): no need for old workaround
+
+2006-06-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/zzz.R (.onLoad): for "unix": more cautious when 'gv' is not there.
+
+2006-06-22 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version, Date): 0.95-5
+
+2006-05-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/TA.plot.R (TA.plot): slightly better warning in mk.main();
+ slightly improved defaults {line colors}
+
+2006-04-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/zzz.R (.onLoad): smarter 'gv' command
+ * R/ps.goodies.R (ps.end): use Sys.ps.cmd() -> work on non-antique
+ Linuxen !
+ * R/unix/Sys.ps.R (Sys.ps.cmd): newer Linux has 'ps w' too!
+
+2006-02-22 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-4
+
+ * man/Deprecated.Rd: huberM() now in package "robustbase"
+ * R/Deprecated.R: is deprecated here.
+ * R/huber.R:
+
+ * man/tkdensity.Rd: if(dev.interactive()) { ... } now suddenly
+ needed for CRAN
+
+2006-01-24 Martin Maechler <maechler at stat.math.ethz.ch>
+
+
+ * DESCRIPTION (Version, Date): 0.95-3
+
+ * R/prettylab.R (pretty10exp, axTexpr): new functions
+
+2005-11-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (digitsBase): return S3 class "basedInt"
+ * R/misc-goodies.R (as.intBase): new; inverse of digitsBase()
+
+ * R/Deprecated.R (digits): point to digitsBase() {not "baseDigits"}!
+
+2005-11-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-2 --- RELEASED to CRAN
+
+ * R/rnls.R (rnls): incorporate changes by Andreas Ruckstuhl
+ (fitted.rnls): new basic methods for S3 class "rnls"
+
+2005-10-16 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Date): update
+
+ * R/p.goodies.R (p.arrows): use atan2() instead of 2-arg. atan()
+
+2005-07-11 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/p.profileTraces.Rd: 'x' must be 'profile' not 'nls' result
+
+2005-07-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/glob2rx.R (glob2rx): copied glob2rx() to "R-devel"
+ ==> should be part of R-2.2.x
+
+2005-05-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/diagDA.Rd: fixed typo: s/i.e./e.g./
+
+2005-05-12 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Depends): R (>= 2.0.0) is needed for datasets
+
+ * R/glob2rx.R (glob2rx): add 'trim.*' arguments, with defaults to
+ be exactly back compatible.
+
+2005-05-10 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Depends): also on 'methods' and 'utils'
+
+ * R/tkdensity.R (tkdensity): careful to get stats::density.default
+ for R versions >= 2.2.0; new argument 'kernels'
+
+2005-05-09 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (ps.end): use 'ps wx' (no "-")
+
+2005-04-25 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-2
+
+ * INDEX: updated
+
+ * man/p.hboxp.Rd: also change default to 'medcol= 2'
+
+2005-04-25 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-1 --> CRAN
+
+ * man/*.Rd: added \encoding{latin1} to quite a few
+
+ * man/AsciiToInt.Rd: example with Umlaut fails to parse(!)
+ in utf-8 locale -> \dontrun{} it.
+
+ * R/misc-goodies.R (hist.bxp): new default 'medcol = 2':
+ "medcol = 0" is not sensible for '0 = "transparent"'.
+
+ * R/mat2tex.R (mat2tex): new arg.s 'nam.center', 'col.center'
+
+2005-04-19 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/hatMat.Rd: slight improvement in example
+
+2005-02-17 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.95-0
+
+ * NAMESPACE: added a namespace (finally).
+
+2005-02-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (lseq): new function
+
+2005-01-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/rnls.R (rnls): new function (from A.Ruckstuhl, Ch.Sangiorgio)
+ still quite a few FIXMEs
+
+2004-12-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-8 --> CRAN
+
+ * R/pd-matrix.R (posdefify): fix bug in non-default method
+ "allEVadd"!
+
+ * tests/posdef.R: new file: test the bug I just fixed (and more).
+
+
+2004-12-09 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/diagDA.R (predict.dDA) (diagDA): fix NA prediction
+
+ * tests/dDA.R: add check for NA prediction
+
+ * R/misc-goodies.R (QUnif): typo fixed (checkUsagePackage() !)
+
+ * R/integratexy.R (integrate.xy): dito
+
+ * R/TA.plot.R (TA.plot): add `type=' in call to residuals;
+ consequently now also works for some lme() results.
+
+2004-11-05
+2004-11-04 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-7
+
+ * INDEX: updated (and saved to ./INDEX-manual)
+
+ * R/plot.ts.R (plot.ts): remove! (was for R < 1.2.0 !)
+ * R/lag.plot.R (lag.plot): dito
+ * R/misc-goodies.R: remove "stepun" package in comments;
+ drop more old comments
+
+ * man/*.Rd: in many man pages, remove \link[<..>]s to old package names.
+ * R/D1D2.R: remove "stepfun" package links
+ * R/KS-confint.R:
+
+2004-09-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-6
+
+ * tests/p.R: new test file {for the fixed bug}
+
+ * R/p.ts.R: oops; need length-2 start(), end() !
+ (fix bug introduced for 0.9-5)
+
+ * man/p.ts.Rd: add SMI
+
+2004-08-12 Martin Maechler <maechler at stat.math.ethz.ch>
+
+
+ * DESCRIPTION (Date): release 0.9-5 to CRAN
+
+ * R/mult.fig.R (mult.fig): no mentioning of global 'old.par'
+ which is now deprecated!
+
+ * man/mult.fig.Rd: make sure we work with the return value in the
+ example.
+
+ * man/D2ss.Rd: extraneous "}" in example - left off last 3/4
+
+ * man/cum.Vert.funkt.Rd: fix Rd "extraneous" text
+
+2004-08-09 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (sHalton): add 'leap = 1' argument.
+
+2004-08-02 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/compresid2way.Rd: add the 'warpbreaks' example which clearly
+ exhibits the following (bug and) fix:
+
+ * R/twoway-r-plot.R (compresid2way): fix the level labeling
+ in 'if(label)' where "A" and "B" where switched, thanks to
+ Christoph Buser.
+
+ * DESCRIPTION (Version): 0.9-5 - not yet on CRAN
+
+ * R/plotCI.R (plotCI): deprecate plotCI() from "sfsmisc",
+ since it is in "gregmisc" which has been on CRAN (but not
+ in existence!) long before "sfsmisc".
+
+ * R/00a.R eliminated (renamed to R/00a.R.~2~) and created
+ * R/zzz.R instead which has a simple .First.lib().
+
+
+2004-07-29 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (QUnif): new function for Quasi-Random uniform
+ numbers built on Halton sequences: sHalton().
+ * man/QUnif.Rd: documentation with nice examples
+
+2004-07-27 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * inst/doc/CHANGES.txt: rather than inst/doc/ChangeLog
+
+ * R/pd-matrix.R (posdefify): new file and new function
+ * man/posdefify.Rd: dito
+
+2004-05-26 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-4 --> CRAN
+
+ * inst/doc/ChangeLog: new symbolic link to this file
+
+ * man/p.ts.Rd: new arguments; also new example
+ * R/p.ts.R (p.ts): new arg 'do.x.rug'
+
+2004-05-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (strcodes): fix, needing 0-origin;
+ also fixes the "offset by 1" bug in AsciiToInt()
+ * man/AsciiToInt.Rd: (adapt example output)
+
+2004-04-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.ts.R (p.ts): new arguments 'date.x', 'do.x.axis',
+ 'ax.format' and 'xlab'
+
+2004-03-09 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (empty.dimnames): use lapply()
+
+2004-02-25 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.res.2x.WSt.R (p.res.2x): new default 'scol = 2:3'
+ new arguments xlim, ylim.
+ * man/p.res.2x.Rd: dito
+
+2004-02-24 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Depends): 1.8.x
+ because of regexpr(*, fixed=TRUE) in ps.end()
+
+ * R/p.res.2x.WSt.R (p.res.2x): new 'main' argument with default 'z'
+ * man/p.res.2x.Rd: dito
+ * man/p.res.2fact.Rd: dito
+
+2004-02-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-3
+
+ * man/tkdensity.Rd: try for working tcltk
+
+2004-02-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/TA.plot.R (n.plot): fix non-default 'log = ".."'
+
+ * R/p.res.2x.WSt.R (p.res.2x): allow scol[1:2}
+ * man/p.res.2x.Rd: dito; + example
+
+2004-02-07 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-2
+
+ * R/unix/Sys.ps.R: put my Sys.* to unix-only directory - no way for Windows
+ * man/unix/ : put Sys.ps.Rd and Sys.cpuinfo.Rd there
+
+ * R/u.goodies.R (u.date): make OS-independent, using Sys.time()
+ (u.Datumvonheute): dito
+
+ * R/ps.goodies.R (ps.end): check for non-Unix and gracefully exit
+ in that case.
+
+2004-02-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (ps.end): try better to find file name.
+
+2004-02-04 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.9-1 (for first CRAN release)
+
+2004-02-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/twoway-r-plot.R: new version of old p.two.forget(),
+ from Werner Stahel, called compresid2way().
+
+2004-01-12 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/Ftest-rlm.R (f.robftest): now returns object of class "htest"
+
+ * DESCRIPTION (Version): 0.9-0
+
+ * R/ps.goodies.R (ps.end): command = getOption("eps_view")
+
+ * R/misc-goodies.R: renamed tapply.num() to tapplySimpl()
+ and use same arguments as tapply().
+ move p.panel[LS] to ./Deprecated.R
+ * man/tapplySimpl.Rd: new
+ * man/col01scale.Rd : new
+
+2004-01-11 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.goodies.R: removed p.tst.dev(); deprecated p.triangle()
+
+2004-01-05 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R: remove test.par() -> ~/R/MM/GRAPHICS/par-misc.R
+
+ * R/D1D2.R (D1tr, D1ss): renamed d1() to D1tr(), D1() to D1ss();
+ to get some consistency.
+ * man/D2ss.Rd (D2ss): newly these.
+
+2004-01-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/AsciiToInt.Rd: new
+ * man/Deprecated.Rd: new; with digits(), 'digits.v' and 'nna'
+ * R/Deprecated.R: <dito>
+
+2003-12-15 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/ps.goodies.R (ps.do), ps.latex(), ps.end(): get rid of old
+ S-plus color and iso.latin1 stuff
+
+2003-12-10 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (table.mat): dropped this (undocumented) function
+
+2003-12-03 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/misc-goodies.R (uniqueL): new utility function
+
+2003-12-02 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/Sys.ps.R (Sys.ps): better test for "ALL" (warning);
+ (Sys.PID): deprecated {use Sys.getpid() !}
+
+2003-11-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/diagDA.R (dDA): new function with returns fit of class `dDa';
+ gets print() and predict() methods.
+ Improve functionality such that it works for single point clusters.
+
+ * man/Sys.ps.Rd: codoc( use.values = NULL) inconsistency fixes
+ * man/ps.end.Rd:
+ * man/ecdf.ksCI.Rd:
+
+ * R/TA.plot.R (n.plot): naming ok with data.frames; `col=' argument
+
+2003-11-18 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/diagDA.R (diagDA): new: Diagonal Discriminant Analysis
+ = improvement of stat.diag.da() from 'sma'
+
+2003-08-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * man/u.boxplot.x.Rd: new
+
+ * R/misc-goodies.R: boxplot.matrix(): `use.cols' instead of `cols'
+ * man/boxplot.matrix.Rd:
+
+2003-07-14 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/plotCI.R (plotCI): new arguments `type' and `log'.
+
+ * R/tkdensity.R (tkdensity): new `do.rug' argument with sensible default
+
+2003-06-13 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/smad.R (huber): improved again: gives (NA,NA) when y has NAs only.
+
+2003-06-10 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/rrange.R (rrange): new argument `na.rm = TRUE'
+ * man/rrange.Rd:
+
+2002-12-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/TA.plot.R (TA.plot): now works with specified (or default!) `ylab'
+
+2002-11-30 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/TA.plot.R (n.plot): fix for omitted `ylab' => TA.plot() shows
+ residuals (again!). Use xy.coords() instead of home-made
+
+ * R/p.goodies.R: drop p.hboxp:
+ Rather use boxplot(*, horizontal=TRUE, add=TRUE)
+ Also drop p.clear()
+
+2002-11-11 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Version): 0.8-5
+ * quite a few new man pages (+clean) since Oct; see also ./SfS-changes
+ `only' CMD check warning of 39 undocu. functions
+
+2002-10-01 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * Version 0.8-0 : ``released'' on ftp://stat.ethz.ch/U/maechler/R/
+
+ * several man fixes; dropped old "SfS" stuff, see ./SfS-changes
+
+ * DESCRIPTION (Package): new "sfsmisc" (from internal "SfS")
+
+
+2002-06-19 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * TODO-MM: new
+
+ * R/ellipse.R (ellipsePoints): new (from Martin's ..)
+ * man/ellipsePoints.Rd:
+
+
+ * R/TA.plot.R (n.plot): add `cex' explicitly; finally :
+ * man/n.plot.Rd: new
+
+ * R/TA.plot.R (TA.plot): changed some col/lty/lwd defaults
+ (Ruth Meili's hint) and made these arguments (`par0line',..)
+
+
+2002-05-17 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * INDEX: updated (via build) and manually edited
+
+ * R/hatMat.R (hatMat): allow matrix predictors `x'
+
+2002-04-30 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/tkdensity.R (tkdensity): finally made working again, using
+ tclVar() and tclvalue(.).
+
+
+2002-04-23 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/mult.fig.R: add "line.main" argument, shifting down 1/2 by
+ default.
+
+2002-04-17 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * R/p.goodies.R (p.tst.dev): fix function, now works
+
+2001-05-21 Martin Maechler <maechler at stat.math.ethz.ch>
+
+ * DESCRIPTION (Title): a bit shorter
+ (Version): upped to 1.0-2
diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd
new file mode 100644
index 0000000..ba4902e
--- /dev/null
+++ b/inst/NEWS.Rd
@@ -0,0 +1,451 @@
+% Check from R:
+% news(db = tools:::.build_news_db_from_package_NEWS_Rd("~/R/Pkgs/sfsmisc/inst/NEWS.Rd"))
+\name{NEWS}
+\title{News for \R Package \pkg{sfsmisc}}
+\encoding{UTF-8}
+
+\section{CHANGES in sfsmisc VERSION 1.1-1 [2017-06-08]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item \code{sessionInfoX()} now also reports \code{capabilities()}
+ (and more, depending on \R's version).
+
+ \item \code{mult.fig()}'s default for \code{mgp} now adapts to a
+ non-default value of \code{par("las")}.
+%%% TODO:
+ %% \item New \code{rDatetime()} for random date/time sequences
+ %% within a specified time range.
+
+ \item \code{eaxis()} gets new options \code{axp} and \code{n.axp}
+ for more flexible automatic tick marks.
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item \code{integrate.xy()} is more careful in matching "data"
+ with grid points, thanks to a bug report by Loraine Liping Seng.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.1-0 [2016-02-22]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item \code{primes()} has optional \code{pSeq} argument,
+ surprisingly with no known benefit.
+ \item tweaks for \code{xy.unique.x()} speedup.
+ \item \code{QUnif(..., p, ...)} now works for large \eqn{p} (and
+ gets a \code{silent} option to suppress the message).
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item Fix the \code{tkdensity()} bug introduced on 2015-07-22,
+ hence, for \pkg{sfsmisc} versions \code{1.0-28} and \code{1.0-29},
+ with the \dQuote{codetools cleanup}.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-29 [2016-01-22]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new function \code{read.org.table()} to read emacs
+ \file{org} files via \code{\link{read.table}()}.
+
+ \item new \code{loessDemo()}, providing a version of an old
+ \code{loess.demo()}.
+
+ \item new \code{sessionInfoX()} utility (with \code{print()} method).
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item (workaround R (<= 3.2.2) bug:) the (invisible) return value
+ \code{str_data()} no longer contains extraneous \code{NULL}
+ entries in the filtering case.
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 1.0-28 [2015-08-06]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item \code{tkdensity()} is tweaked such as to look more standard
+ to \pkg{codetools};
+ \item similarly (much less) for \code{factorize()} and \code{roundfixS()}
+ \item new \code{demo("pretty-lab")}
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item also import from "base" packages
+ \item \code{pretty10exp(*, lab.type = "latex")} typo fixed;
+ \code{eaxis()} works better with \code{lab.type = "latex"}, both
+ thanks to David Seifert.
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 1.0-27 [2015-01-05]}{
+ \subsection{Repository}{
+ \itemize{
+ \item Moved sources to Github (\url{https://github.com/mmaechler/sfsmisc}),
+ on Aug. 9, 2014, from years of emacs backups and a few RCS \dQuote{archives}.
+ Blogged about it on \url{http://mmaechler.blogspot.ch/}.
+ }
+ }
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item New \code{missingCh()} utility, also for didactical purposes;
+ \item new \code{rotn()} "utility".
+ \item \code{eaxis()} gets an optional \code{sub10} argument.
+ \item \code{mat2tex()} gets new option \code{envir = "tabular"}.
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item \code{cairoSwd()} adapted to new Sweave conventions.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-26 [2014-06-16]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new \code{is.whole()} to test if numbers are integer valued.
+ \item new \code{cairoSwd()} from Alain Hauser (not yet exported).
+ \item new \code{bi2int()} utility (called from \code{as.intBase()})
+ with a nice IP numbers transformation example.
+ \item \code{toLatex.numeric()} gets \code{times} arg (from Alain).
+ \item \code{pretty10exp()} gets new args \code{lab.type} and
+ \code{lab.sep} from Ben Bolker.
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item not using \code{prt.DEBUG()} anymore ourselves, as it has been
+ deprecated.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-25 [2014-01-24]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item better docu on \code{Sys.cpuinfo()}
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item finally deprecate \code{prt.DEBUG()}
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-24 [2013-08-03]}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item Deprecate u.assign0() as globalenv assignment is mostly
+ deprecated, and the S <-> R compatibility is unneeded now.
+ \item ps.do() and pdf.do() are now closures with their own file name.
+ ==> no globalenv assignment needed anymore.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-13 [2010-10-20]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new \code{demo(hatMat)} being more explicit than \code{?hatMat}
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-12 [2010-09-04]}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item \code{plotDS()} bug fix
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 1.0-11 [2010-02-22]}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item fix nearCor() example
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-10 [2009-12-16]}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item pdf.do() with better defaults [ ==> compatible to ps.do() ]
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-9 [2009-11-18]}{
+
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-8 [2009-08-10]}{
+
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-7 [2009-01-10]}{
+
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-6 [2008-11-25]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new Sys.meminfo()
+ \item p.profileTraces() improved; eaxis()
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 1.0-5 [2008-11-01]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new Duplicated()
+ \item ellipsePoints() improvements
+ \item eaxis() improvements
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item str_data() buglet
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-4 [2008-07-31]}{
+
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-3 [2008-06-26]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item pdf.do() has better default behavior.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-2 [2008-05-03]}{
+
+}
+
+\section{CHANGES in sfsmisc VERSION 1.0-1 [2008-01-30]}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item Encoding (latin1), and other platform issues
+ \item inv.seq() and eaxis() improvements
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 1.0-0 [2007-12-10]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item plotDS() is new name for pl.ds() now allows 'ys' to be a smooth
+ "fit structure". That is now easily constructed via
+ \item new seqXtend() function for constructing a sequence which includes
+ a give set of numbers x.
+ \item y <- roundfixS(x) yields integers y[i] with the same sum as x[i].
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.96-01 [2007-11-21]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new function eaxis() for "engineering" / "extended" axis
+ drawing, notably for log-axis labeling
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-13 [2007-09-13]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new function nearcor() {find nearest correlation matrix};
+ almost as donated by Jens Oehlschlaegel.
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item pdf.latex(), pdf.do() : defaults; viewer specifications...
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-12 [2007-06-30]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item New internal Sys.procinfo() function for cleaner implementation of
+ Sys.cpuinfo() and Sys.meminfo().
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 0.95-10 [2007-06-25]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new pdf.do(), pdf.end(), pdf.latex()), as analogues to ps.do() etc,
+ \item implemented as wrapper to new dev.latex() utility function
+ (dev.latex): instead of ps.latex();
+ (pdf.latex, ps.latex): now wrappers to dev.latex
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-9 [2007-03-15]}{
+
+}
+
+\section{CHANGES in sfsmisc VERSION 0.95-8 [2007-01-18]}{
+
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-7 [2006-10-19]}{
+
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-6 [2006-06-26]}{
+
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-5 [2006-06-22]}{
+
+}
+
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-4 [2006-02-26]}{
+
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-3 [2006-01-25]}{
+
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-2 [2005-11-03]}{
+
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.95-1 [2005-04-25]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item rnls() for robust nonlinear regression;
+ lseq() {seq() on log scale} utility
+ \item now has a NAMESPACE
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-8 [2004-12-14]}{
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item TA.plot() now also works for lme() results.
+ }
+ }
+}
+
+\section{CHANGES in sfsmisc VERSION 0.9-7 [2004-11-04]}{
+ \itemize{
+ \item Depends on R 1.9.0 (was effectively the case earlier):
+ Removing old package names "modreg", "stepfun", etc
+ }
+}
+
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-6 [2004-09-27]}{
+ \itemize{
+ \item bug fix in p.ts(): case of start(.) of length 2
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-5 [2004-08-12]}{
+ \subsection{NEW FEATURES}{
+ \itemize{
+ \item new posdefify(m) returns a positive definite matrix close to 'm'
+ \item New QUnif() and sHalton() for quasi-random number generation
+ }
+ }
+ \subsection{BUG FIXES}{
+ \itemize{
+ \item fixed labeling bug in compresid2way().
+ }
+ }
+ \subsection{DEPRECATED & DEFUNCT}{
+ \itemize{
+ \item mult.fig()'s global assignment to 'old.par' is now deprecated.
+ do work with op <- mult.fig(...)$old.par instead !!
+ \item plotCI() is now deprecated -- use the one from package "gregmisc"!
+ }
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-4 [2004-05-26]}{
+ \itemize{
+ \item p.ts() allows date-time objects for x-axis labeling, with new
+ arguments 'date.x', 'do.x.axis', 'do.x.rug', 'ax.format' and 'xlab'
+ \item strcodes() had a bug (offset by 1) which also lead to one in AsciiToInt()
+ \item p.res.2x() has new arguments 'xlim', 'ylim', 'main' and a new default
+ for 'scol' (= 2:3).
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-3 [2004-02-23]}{
+ \itemize{
+ \item p.res.2x() allows 'scol' of length 2.
+ \item n.plot() fixed the "log = .." (non-default) option.
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-2 [2004-02-07]}{
+ \itemize{
+ \item put Sys.*() functions into unix-only directory
+ \item ps.end() tries behaves better for non-unix finding the file
+ \item u.date() becomes OS-independent.
+ }
+}
+
+
+\section{CHANGES in sfsmisc VERSION 0.9-1 [2004-02-04 -- 1st CRAN ver.!]}{
+ \itemize{
+ \item new function compresid2way() from Werner Stahel.
+ \item f.robftest() now returns an object of class "htest"
+
+ \cr \cr
+%% FIXME: It seems wrong that this cannot be put into a final \note{.}
+%% tools:::.build_news_db_from_package_NEWS_Rd("~/R/Pkgs/sfsmisc/inst/NEWS.Rd")
+
+ \item For more details, see the \file{ChangeLog} file!
+ }
+}
+
diff --git a/man/AsciiToInt.Rd b/man/AsciiToInt.Rd
new file mode 100644
index 0000000..8abb7e6
--- /dev/null
+++ b/man/AsciiToInt.Rd
@@ -0,0 +1,91 @@
+\name{AsciiToInt}
+\encoding{latin1}
+\alias{AsciiToInt}
+\alias{ichar}
+\alias{chars8bit}
+\alias{strcodes}
+\title{Character to and from Integer Codes Conversion}
+\description{
+ \code{AsciiToInt} returns \code{\link{integer}} codes in \code{0:255}
+ for each (one byte) character in \code{strings}. \code{ichar} is an
+ alias for it, for old S compatibility.
+
+ \code{strcodes} implements in \R the basic engine for translating
+ characters to corresponding integer codes.
+
+ \code{chars8bit()} is the \emph{inverse} function of
+ \code{AsciiToint}, producing \dQuote{one byte} characters from integer
+ codes. Note that it (and hence \code{strcodes()} depends on the
+ locale, see \code{\link{Sys.getlocale}()}.
+}
+\usage{
+AsciiToInt(strings)
+ ichar(strings)
+chars8bit(i = 1:255)
+strcodes(x, table = chars8bit(1:255))
+}
+\arguments{
+ \item{strings, x}{\code{\link{character}} vector.}
+ \item{i}{numeric (integer) vector of values in \code{1:255}.}
+ \item{table}{a vector of (unique) character strings, typically of one
+ character each.}
+}
+\details{
+ Only codes in \code{1:127} make up the ASCII encoding which should be
+ identical for all \R versions, whereas the \emph{\sQuote{upper}} half
+ is often determined from the ISO-8859-1 (aka \dQuote{ISO-Latin 1)}
+ encoding, but may well differ, depending on the locale setting, see
+ also \code{\link{Sys.setlocale}}.
+
+ Note that \code{0} is no longer allowed since, \R does not allow
+ \code{\\0} aka \code{nul} characters in a string anymore.
+}
+\value{
+ \code{AsciiToInt} (and hence \code{ichar}) and \code{chars8bit} return a
+ vector of the same length as their argument.
+
+ \code{strcodes(x, tab)} returns a \code{\link{list}} of the same
+ \code{\link{length}} and \code{\link{names}} as \code{x} with list
+ components of integer vectors with codes in \code{1:255}.
+}
+\author{Martin Maechler, partly in 1991 for S-plus}
+\examples{
+chars8bit(65:70)#-> "A" "B" .. "F"
+stopifnot(identical(LETTERS, chars8bit(65:90)),
+ identical(AsciiToInt(LETTERS), 65:90))
+
+% In R 2.1.0, the "�" could not even be parsed in UTF-8; now gives NA
+## may only work in ISO-latin1 locale (not in UTF-8):
+try( strcodes(c(a= "ABC", ch="1234", place = "Z�rich")) )
+## in "latin-1" gives {otherwise should give NA instead of 252}:
+\dontrun{
+$a
+[1] 65 66 67
+
+$ch
+[1] 49 50 51 52
+
+$place
+[1] 90 252 114 105 99 104
+}
+ myloc <- Sys.getlocale()
+
+if(.Platform $ OS.type == "unix") { # ''should work'' here
+ try( Sys.setlocale(locale = "de_CH") )# "try": just in case
+ print(strcodes(c(a= "ABC", ch="1234", place = "Z�rich"))) # no NA hopefully
+ print(AsciiToInt(chars8bit()))# -> 1:255 {if setting latin1 succeeded above}
+
+ print(chars8bit(97:140))
+ try( Sys.setlocale(locale = "de_CH.utf-8") )# "try": just in case
+ print(chars8bit(97:140)) ## typically looks different than above
+}
+
+## Resetting to original locale .. works "mostly":
+lapply(strsplit(strsplit(myloc, ";")[[1]], "="),
+ function(cc) try(Sys.setlocale(cc[1], cc[2]))) -> .scratch
+
+Sys.getlocale() == myloc # TRUE if we have succeeded to reset it
+
+}
+\keyword{manip}
+%\keyword{utilities}
diff --git a/man/D1D2.Rd b/man/D1D2.Rd
new file mode 100644
index 0000000..5c2ecda
--- /dev/null
+++ b/man/D1D2.Rd
@@ -0,0 +1,82 @@
+% This is also sym.linked into
+% Martin's WpDensity package /u/maechler/R/Pkgs/WpDensity/
+\name{D1D2}
+\alias{D1D2}
+\title{Numerical Derivatives of (x,y) Data via Smoothing Splines}
+\description{
+ Compute numerical derivatives of \eqn{f()} given observations
+ \code{(x,y)}, using cubic smoothing splines with GCV, see
+ \code{\link[stats]{smooth.spline}}. In other words, estimate \eqn{f'()}
+ and/or \eqn{f''()} for the model
+ \deqn{Y_i = f(x_i) + E_i, \ \ i = 1,\dots n,}
+}
+\usage{
+D1D2(x, y, xout = x, spar.offset = 0.1384, deriv = 1:2, spl.spar = NULL)
+}
+\arguments{
+ \item{x,y}{numeric vectors of same length, supposedly from a model
+ \code{y ~ f(x)}.}
+ \item{xout}{abscissa values at which to evaluate the derivatives.}
+ \item{spar.offset}{numeric fudge added to the smoothing parameter,
+ see \code{spl.par} below.}
+ \item{deriv}{integer in \code{1:2} indicating which
+ derivatives are to be computed.}
+ \item{spl.spar}{direct smoothing parameter for \code{smooth.spline}.
+ If it is \code{NULL} (as per default), the smoothing parameter used
+ will be \code{spar.offset + sp$spar}, where \code{sp$spar} is the GCV
+ estimated smoothing parameter, see \code{\link{smooth.spline}}.}
+}
+\details{
+ It is well known that for derivative estimation, the optimal smoothing
+ parameter is larger (more smoothing) than for the function itself.
+ \code{spar.offset} is really just a \emph{fudge} offset added to the
+ smoothing parameter. Note that in \R's implementation of
+ \code{\link{smooth.spline}}, \code{spar} is really on the
+ \eqn{\log\lambda} scale.
+
+ When \code{deriv = 1:2} (as per default), both derivatives are
+ estimated with the \emph{same} smoothing parameter which is suboptimal
+ for the single functions individually. Another possibility is to call
+ \code{D1D2(*, deriv = k)} twice with \code{k = 1} and \code{k = 2} and
+ use a \emph{larger} smoothing parameter for the second derivative.
+}
+\value{
+ a list with several components,
+ \item{x}{the abscissae values at which the derivative(s) are evaluated.}
+ \item{D1}{if \code{deriv} contains 1, estimated values of
+ \eqn{f'(x_i)} where \eqn{x_i} are the values from \code{xout}.}
+ \item{D2}{if \code{deriv} contains 2, estimated values of \eqn{f''(x_i)}.}
+ \item{spar}{the \bold{s}moothing \bold{par}ameter used in the (final)
+ \code{smooth.spline} call.}
+ \item{df}{the equivalent \bold{d}egrees of \bold{f}reedom in that
+ \code{smooth.spline} call.}
+}
+\author{Martin Maechler, in 1992 (for S).}
+\seealso{\code{\link{D2ss}} which calls \code{smooth.spline} twice,
+ first on \code{y}, then on the \eqn{f'(x_i)} values;
+ \code{\link[stats]{smooth.spline}} on which it relies completely.
+}
+\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")])
+ 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)
+}
+\keyword{smooth}
diff --git a/man/D2ss.Rd b/man/D2ss.Rd
new file mode 100644
index 0000000..f6069ac
--- /dev/null
+++ b/man/D2ss.Rd
@@ -0,0 +1,104 @@
+\name{D2ss}
+\alias{D2ss}
+\alias{D1ss}
+\alias{D1tr}
+\title{Numerical Derivatives of (x,y) Data (via Smoothing Splines)}
+\description{
+ Compute the numerical first or 2nd derivatives of \eqn{f()} given
+ observations \code{(x[i], y ~= f(x[i]))}.
+
+ \code{D1tr} is the \emph{\bold{tr}ivial} discrete first derivative
+ using simple difference ratios, whereas \code{D1ss} and \code{D2ss}
+ use cubic smoothing splines (see \code{\link[stats]{smooth.spline}})
+ to estimate first or second derivatives, respectively.
+
+ \code{D2ss} first uses \code{smooth.spline} for the first derivative
+ \eqn{f'()} and then applies the same to the predicted values
+ \eqn{\hat f'(t_i)}{f'^(t[i])} (where \eqn{t_i}{t[i]} are the values of
+ \code{xout}) to find \eqn{\hat f''(t_i)}{f''^(t[i])}.
+}
+\usage{
+D1tr(y, x = 1)
+
+D1ss(x, y, xout = x, spar.offset = 0.1384, spl.spar=NULL)
+D2ss(x, y, xout = x, spar.offset = 0.1384, spl.spar=NULL)
+}
+\arguments{
+ \item{x,y}{numeric vectors of same length, supposedly from a model
+ \code{y ~ f(x)}. For \code{D1tr()}, \code{x} can have length one
+ and then gets the meaning of \eqn{h = \Delta x}.}
+ \item{xout}{abscissa values at which to evaluate the derivatives.}
+ \item{spar.offset}{numeric fudge added to the smoothing parameter(s),
+ see \code{spl.par} below. Note that the current default is there
+ for historical reasons only, and we often would recommend to use
+ \code{spar.offset = 0} instead.}
+ \item{spl.spar}{direct smoothing parameter(s) for \code{smooth.spline}.
+ If it is \code{NULL} (as per default), the smoothing parameter used
+ will be \code{spar.offset + sp$spar}, where \code{sp$spar} is the GCV
+ estimated smoothing parameter for \emph{both} smooths, see
+ \code{\link{smooth.spline}}.}
+}
+\details{
+ It is well known that for derivative estimation, the optimal smoothing
+ parameter is larger (more smoothing needed) than for the function itself.
+ \code{spar.offset} is really just a \emph{fudge} offset added to the
+ smoothing parameters. Note that in \R's implementation of
+ \code{\link{smooth.spline}}, \code{spar} is really on the
+ \eqn{\log\lambda} scale.
+%
+% When \code{deriv = 1:2} (as per default), both derivatives are
+% estimated with the \emph{same} smoothing parameter which is suboptimal
+% for the single functions individually. Another possibility is to call
+% \code{D1D2(*, deriv = k)} twice with \code{k = 1} and \code{k = 2} and
+% use a \emph{larger} smoothing parameter for the second derivative.
+}
+\value{
+ \code{D1tr()} and \code{D1ss()} return a numeric vector of the length
+ of \code{y} or \code{xout}, respectively.
+
+ \code{D2ss()} returns a list with components
+ \item{x}{the abscissae values (= \code{xout}) at which the
+ derivative(s) are evaluated.}
+ \item{y}{estimated values of \eqn{f''(x_i)}.}
+ \item{spl.spar}{numeric vector of length 2, contain the \code{spar}
+ arguments to the two \code{smooth.spline} calls.}
+ \item{spar.offset}{as specified on input (maybe rep()eated to length 2).}
+}
+\author{Martin Maechler, in 1992 (for S).}
+\seealso{\code{\link{D1D2}} which directly uses the 2nd derivative of
+ the smoothing spline; \code{\link{smooth.spline}}.
+}
+\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")])
+ 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)
+}
+\keyword{smooth}
diff --git a/man/Deprecated.Rd b/man/Deprecated.Rd
new file mode 100644
index 0000000..6014d9f
--- /dev/null
+++ b/man/Deprecated.Rd
@@ -0,0 +1,33 @@
+\name{Deprecated}% <<< would like "special name": don't check \arguments{}
+\title{Deprecated 'sfsmisc' Functions}
+% NOTE: ../R/Deprecated.R must be synchronized with this!
+% ~~~~~~~~~~~~~~~~~
+\alias{pmax.sa}
+\alias{pmin.sa}
+% Move things from here to ./sfsmisc-defunct.Rd
+% ~~~~~~~~~~~~~~~~~~
+% (and even older to ../Old_Defunct/ )
+%
+%------ PLEASE: put \alias{.} here for EACH !
+%
+\description{
+ These functions are provided for compatibility with older versions of
+ the \pkg{sfsmisc} package only, and may be defunct as soon as of the
+ next release.
+}
+\usage{
+pmax.sa(scalar, arr)
+pmin.sa(scalar, arr)
+}
+\arguments{
+ \item{scalar}{numeric scalar.}
+ \item{arr}{any numeric \R object, typically array.}
+}
+\details{
+ \code{pmax.sa(s, a)} and \code{pmin.sa(s, a)} return (more-dimensional) arrays.
+ These have been deprecated, because \code{\link{pmax}} and
+ \code{\link{pmin}} do so too, \bold{if} the array is used as
+ \emph{first} argument.
+}
+
+\keyword{documentation}
diff --git a/man/Duplicated.Rd b/man/Duplicated.Rd
new file mode 100644
index 0000000..8bb1670
--- /dev/null
+++ b/man/Duplicated.Rd
@@ -0,0 +1,48 @@
+\name{Duplicated}
+\alias{Duplicated}
+\title{Counting-Generalization of duplicated()}
+\description{
+ Duplicated() generalizes the \code{\link{duplicated}} method for
+ vectors, by returning indices of \dQuote{equivalence classes} for
+ duplicated entries and returning \code{nomatch} (\code{NA} by default)
+ for unique entries.
+
+ Note that \code{duplicated()} is not \code{TRUE} for the first time a
+ duplicate appears, whereas \code{Duplicated()} only marks unique
+ entries with \code{nomatch} (\code{NA}).
+}
+\usage{
+Duplicated(v, incomparables = FALSE, fromLast = FALSE, nomatch = NA_integer_)
+}
+\arguments{
+ \item{v}{a vector, often character, factor, or numeric.}
+ \item{incomparables}{a vector of values that cannot be compared,
+ passed to both \code{\link{duplicated}()} and \code{\link{match}()}.
+ \code{FALSE} is a special value, meaning that all values can be
+ compared, and may be the only value accepted for methods other than
+ the default. It will be coerced internally to the same type as \code{x}.}
+ \item{fromLast}{logical indicating if duplication should be considered
+ from the reverse side, i.e., the last (or rightmost) of identical
+ elements would correspond to \code{duplicated=FALSE}.}
+ \item{nomatch}{passed to \code{\link{match}()}: the value to be
+ returned in the case when no match is found. Note that it is
+ coerced to \code{integer}.}
+}
+\value{
+ an integer vector of the same length as \code{v}. Can be used as a
+ \code{\link{factor}}, e.g., in \code{\link{split}},
+ \code{\link{tapply}}, etc.
+}
+\author{Christoph Buser and Martin Maechler, Seminar fuer Statistik, ETH
+ Zurich, Sep.2007}
+\seealso{\code{\link{uniqueL}} (also in \pkg{sfsmisc});
+ \code{\link{duplicated}}, \code{\link{match}}.
+}
+\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))
+}
+\keyword{manip}
diff --git a/man/KSd.Rd b/man/KSd.Rd
new file mode 100644
index 0000000..077324e
--- /dev/null
+++ b/man/KSd.Rd
@@ -0,0 +1,43 @@
+\name{KSd}
+\alias{KSd}
+\title{Approximate Critical Values for Kolmogorov-Smirnov's D}
+\description{
+ Computes the critical value for Kolmogorov-Smirnov's \eqn{D_n}, for
+ sample sizes \eqn{n \ge 10}{n >= 10} and confidence level 95\%.
+}
+\details{
+ Based on tables values given in the reference below.
+ For \eqn{n\le 80}{n <= 80} uses interpolations from exact values, elsewhere
+ uses asymptotic approximation.
+}
+\usage{
+KSd(n)
+}
+\arguments{
+ \item{n}{the sample size, \code{n >= 10}.}
+}
+\value{
+ The critical value for D (two-sided) for significance level 0.05 (or
+ confidence level 95\%).
+}
+\references{
+ Peter J. Bickel and Kjell A. Doksum (1977),
+ \emph{Mathematical Statistics: Basic Ideas and Selected Topics}.
+ Holden Day.
+ Section 9.6 and table IX.
+}
+\author{Kjetil Halvorsen and Martin Maechler}
+
+\seealso{Is used from \code{\link{ecdf.ksCI}}.}
+
+\examples{
+KSd(90)
+KSd(1:9)# now works
+
+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)
+}
+\keyword{distribution}
diff --git a/man/QUnif.Rd b/man/QUnif.Rd
new file mode 100644
index 0000000..6ef65e9
--- /dev/null
+++ b/man/QUnif.Rd
@@ -0,0 +1,88 @@
+\name{QUnif}
+\title{Quasi Randum Numbers via Halton Sequences}
+\alias{QUnif}
+\alias{sHalton}
+%
+\concept{Quasi Monte Carlo}
+\concept{low discrepancy sequence}
+\concept{space filling}
+%
+\description{
+ These functions provide quasi random numbers or \emph{space filling} or
+ \emph{low discrepancy} sequences in the \eqn{p}-dimensional unit cube.
+}
+\usage{
+sHalton(n.max, n.min = 1, base = 2, leap = 1)
+ QUnif (n, min = 0, max = 1, n.min = 1, p, leap = 1, silent = FALSE)
+}
+\arguments{
+ \item{n.max}{maximal (sequence) number.}
+ \item{n.min}{minimal sequence number.}
+ \item{n}{number of \eqn{p}-dimensional points generated in
+ \code{QUnif}. By default, \code{n.min = 1, leap = 1} and
+ the maximal sequence number is \code{n.max = n.min + (n-1)*leap}.}
+ \item{base}{integer \eqn{\ge 2}{>= 2}: The base with respect to which
+ the Halton sequence is built.}
+ \item{min, max}{lower and upper limits of the univariate intervals.
+ Must be of length 1 or \code{p}.}
+ \item{p}{dimensionality of space (the unit cube) in which points are
+ generated.}
+ \item{leap}{integer indicating (if \eqn{> 1}) if the series should be
+ leaped, i.e., only every \code{leap}th entry should be taken.}
+ \item{silent}{logical asking to suppress the message about enlarging
+ the prime table for large \code{p}.}
+}
+\value{
+ \code{sHalton(n,m)} returns a numeric vector of length \code{n-m+1} of
+ values in \eqn{[0,1]}.
+
+ \code{QUnif(n, min, max, n.min, p=p)} generates \code{n-n.min+1}
+ p-dimensional points in \eqn{[min,max]^p} returning a numeric matrix
+ with p columns.
+}
+\note{
+ For \code{leap} Kocis and Whiten recommend values of
+ \eqn{L=31,61,149,409}, and particularly the \eqn{L=409} for dimensions
+ up to 400.
+}
+\references{
+ James Gentle (1998)
+ \emph{Random Number Generation and Monte Carlo Simulation}; sec.\ 6.3.
+ Springer.
+
+ Kocis, L. and Whiten, W.J. (1997)
+ Computational Investigations of Low-Discrepancy Sequences.
+ \emph{ACM Transactions of Mathematical Software} \bold{23}, 2, 266--294.
+}
+\author{Martin Maechler}
+\examples{
+32*sHalton(20, base=2)
+
+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")
+}
+\keyword{math}
+\keyword{multivariate}
+\keyword{datagen}
diff --git a/man/TA.plot.Rd b/man/TA.plot.Rd
new file mode 100644
index 0000000..e252132
--- /dev/null
+++ b/man/TA.plot.Rd
@@ -0,0 +1,97 @@
+\name{TA.plot}
+\alias{TA.plot}
+\title{Tukey-Anscombe Plot (Residual vs. Fitted) of a Linear Model}
+\description{
+ From a linear (or glm) model fitted, produce the so-called Tukey-Anscombe
+ plot. Useful (optional) additions include: 0-line, lowess smooth,
+ 2sigma lines, and automatic labeling of observations.
+}
+\usage{
+TA.plot(lm.res,
+ fit= fitted(lm.res), res= residuals(lm.res, type="pearson"),
+ labels= NULL, main= mk.main(), xlab = "Fitted values",
+ draw.smooth= n >= 10, show.call = TRUE, show.2sigma= TRUE,
+ lo.iter = NULL, lo.cex= NULL,
+ par0line = list(lty = 2, col = "gray"),
+ parSmooth = list(lwd = 1.5, lty = 4, col = 2),
+ parSigma = list(lwd = 1.2, lty = 3, col = 4),
+ verbose = FALSE,
+ \dots)
+}
+\arguments{
+ \item{lm.res}{Result of \code{\link{lm}(..)}, \code{\link{aov}(..)},
+ \code{\link{glm}(..)} or a similar object.}
+ \item{fit}{fitted values; you probably want the default here.}
+ \item{res}{residuals to use. Default: \bold{Weighted} ("Pearson") residuals if
+ weights have been used for the model fit.}
+ \item{labels}{strings to use as plotting symbols for each point.
+ Default(\code{NULL}): extract observations' names or use its sequence number.
+ Use, e.g., "*" to get simple \code{*} symbols.
+ }
+ \item{main}{main title to plot. Default: sophisticated, resulting in
+ something like "Tukey-Anscombe Plot of : y \~ x" constructed from
+ \code{lm.res $ call}.
+ }
+ \item{xlab}{x-axis label for plot.}
+ \item{draw.smooth}{logical; if \code{TRUE}, draw a \code{lowess} smoother
+ (with automatic smoothing fraction).}
+ \item{show.call}{logical; if \code{TRUE}, write the "call"ing syntax with
+ which the fit was done.}
+ \item{show.2sigma}{logical; if \code{TRUE}, draw horizontal lines at
+ \eqn{\pm 2\sigma}{+- 2 sigma} where \eqn{\sigma} is \code{mad(resid)}.}
+ \item{lo.iter}{positive integer, giving the number of lowess
+ robustness iterations. The default depends on the model and
+ is \code{0} for non Gaussian \code{\link{glm}}'s.}
+ \item{lo.cex}{character expansion ("cex") for lowess and other
+ marginal texts.}
+ \item{par0line}{a list of arguments (with reasonable defaults) to be passed to
+ \code{\link{abline}(.)} when drawing the x-axis, i.e.,
+ the \eqn{y = 0} line.}
+ \item{parSmooth, parSigma}{each a list of arguments (with reasonable
+ default) for drawing the smooth curve (if \code{draw.smooth} is
+ true), or the horizontal sigma boundaries (if \code{show.2sigma} is
+ true) respectively.}
+ \item{verbose}{logical indicating if some construction details should
+ be reported (\code{\link{print}()}ed).}
+ \item{\dots}{further graphical parameters are passed to
+ \code{\link{n.plot}(.)}.}
+}
+\section{Side Effects}{
+ The above mentioned plot is produced on the current graphic device.
+}
+\author{
+ Martin Maechler, Seminar fuer Statistik, ETH Zurich, Switzerland;
+ \email{maechler at stat.math.ethz.ch}
+}
+\seealso{\code{\link{plot.lm}} which also does a QQ normal plot and more.
+}
+\examples{
+data(stackloss)
+TA.plot(lm(stack.loss ~ stack.x))
+
+example(airquality)
+summary(lmO <- lm(Ozone ~ ., data= airquality))
+TA.plot(lmO)
+TA.plot(lmO, label = "O") # instead of case numbers
+
+if(FALSE) { %% from S-plus
+ 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
+}
+}
+\keyword{models}
+\keyword{regression}
+
diff --git a/man/axTexpr.Rd b/man/axTexpr.Rd
new file mode 100644
index 0000000..27aaadb
--- /dev/null
+++ b/man/axTexpr.Rd
@@ -0,0 +1,67 @@
+\name{axTexpr}
+\alias{axTexpr}
+\title{Axis Ticks Expressions in Nice 10 ** k Form}
+\description{
+ Produce nice \eqn{a \times 10^k}{a * 10^k} expressions for
+ \code{\link{axis}} labeling instead of the scientific notation
+ \code{"a E<k>"}.
+
+}
+\usage{
+axTexpr(side, at = axTicks(side, axp = axp, usr = usr, log = log),
+ axp = NULL, usr = NULL, log = NULL,
+ drop.1 = FALSE)
+}
+\arguments{
+ \item{side}{integer in 1:4 specifying the axis side, as for
+ \code{\link{axis}}.}
+ \item{at}{numeric vector; with identical default as in
+ \code{\link{axTicks}()}.}
+ \item{axp, usr, log}{as for \code{\link{axTicks}()}.}
+ \item{drop.1}{logical indicating if \eqn{1 \times}{1 *} should be
+ dropped from the resulting expressions.}
+}
+\details{
+ This is just a utility with the same arguments as
+ \code{\link{axTicks}}, a wrapper \code{\link{pretty10exp}(at, *)}.
+}
+\value{
+ an expression of the same length as \code{x}, with elements of the
+ form \code{a \%*\% 10 ^ k}.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{pretty10exp}};
+ \code{\link{eaxis}}, \code{\link{axis}}, \code{\link{axTicks}}.
+}
+\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")
+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")
+axis(1, at = aX, label = axTexpr(1, aX, drop.1=TRUE)) # 'default'
+axis(1, at = v, label = FALSE, tcl = 2/3 * par("tcl"))
+}
+\keyword{dplot}
diff --git a/man/cairoSwd.Rd b/man/cairoSwd.Rd
new file mode 100644
index 0000000..1b90f1a
--- /dev/null
+++ b/man/cairoSwd.Rd
@@ -0,0 +1,37 @@
+\name{cairoSwd}
+\alias{cairoSwd}
+\title{Cairo PDF Graphics Device useful for Sweave}
+\description{
+ Provides a graphics device for Sweave, based on
+ \code{\link{cairo_pdf}}. The advantage of \code{cairoSwd()} compared
+ to \code{\link{pdf}()} is its support of Unicode characters.
+}
+\usage{
+cairoSwd(name, width, height, ...)
+}
+\arguments{
+ \item{name}{file name prefix to which \file{.pdf} will be appended.}
+ \item{width, height}{in inches, see \code{\link{cairo_pdf}}.}
+
+ \item{\dots}{further arguments, passed to \code{\link{cairo_pdf}()}}
+}
+\note{
+ Sweave devices need to have an argument list as above.
+
+ Usage in a Sweave chunk:
+ \preformatted{
+<<some-plot, fig=TRUE, grdevice=cairoSwd>>=
+}
+}
+\author{Alain Hauser}
+%% \details{
+%% }
+%% \references{
+%% }
+\seealso{
+ \code{\link{pdf}}, \code{\link{cairo_pdf}}, \code{\link{Sweave}}.
+}
+%% \examples{
+%% }
+\keyword{device}
+
diff --git a/man/capture-n-write.Rd b/man/capture-n-write.Rd
new file mode 100644
index 0000000..1dbfecb
--- /dev/null
+++ b/man/capture-n-write.Rd
@@ -0,0 +1,50 @@
+\name{capture.and.write}
+\alias{capture.and.write}
+\title{Capture output and Write / Print First and Last Parts}
+\description{
+ Capture output and print first and last parts, eliding
+ middle parts. Particularly useful for teaching purposes, and, e.g.,
+ in Sweave (\code{\link{RweaveLatex}}).
+
+ By default, when \code{middle = NA}, \code{capture.output(EXPR, first, last)}
+ basically does
+ \preformatted{
+ co <- capture.output(EXPR)
+ writeLines(head(co, first))
+ cat( ... dotdots ...)
+ writeLines(tail(co, last))
+ }
+}
+\usage{
+capture.and.write(EXPR, first, last = 2, middle = NA,
+ i.middle, dotdots = " ....... ", n.dots = 2)
+}
+\arguments{
+ \item{EXPR}{the (literal) expression the output of which is to be
+ captured.}
+ \item{first}{integer: how many lines should be printed at beginning.}
+ \item{last}{integer: how many lines should be printed at the end.}
+ \item{middle}{numeric (or NA logical):}
+ \item{i.middle}{index start of middle part}
+ \item{dotdots}{string to be used for elided lines}
+ \item{n.dots}{number of \code{dotdots} lines added between parts.}
+}
+\value{
+ return value of \code{\link{capture.output}(EXPR)}.
+}
+\seealso{
+ \code{\link{head}}, \code{\link{tail}}
+}
+\author{Martin Maechler, ETH Zurich}
+\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)
+
+## first, *middle* and last :
+capture.and.write( cbind(x, x^2, x^3), first = 4, middle = 3, n.dots= 1)
+}
+%% some of MM's own "real use" examples:
+%% ~/R/Meetings-Kurse-etc/2012-Rmpfr-ZurichR/BinCoef.Rnw
+%% ~/R/MM/NUMERICS/log1exp/log1exp-note.Rnw
diff --git a/man/col01scale.Rd b/man/col01scale.Rd
new file mode 100644
index 0000000..5ba16f3
--- /dev/null
+++ b/man/col01scale.Rd
@@ -0,0 +1,31 @@
+\name{col01scale}
+\alias{col01scale}
+\alias{colcenter}
+\title{Matrix Scaling Utilities}
+\description{
+ \code{col01scale} and \code{colcenter} (re)scale the columns of a
+ matrix. These are simple one-line utilities, mainly with a didactical
+ purpose.
+}
+\usage{
+colcenter (mat)
+col01scale(mat, scale.func = function(x) diff(range(x)), location.func = mean)
+}
+\arguments{
+ \item{mat}{numeric matrix, to rescaled.}
+ \item{scale.func, location.func}{two functions mapping a numeric
+ vector to a single number.}
+}
+\value{
+ a matrix with the same attributes as the input \code{mat}.
+}
+\author{Martin Maechler}
+\seealso{The standard \R function \code{\link{scale}()}.}
+\examples{
+## See the simple function definitions:
+
+colcenter ## simply one line
+
+col01scale# almost as simple
+}
+\keyword{array}
diff --git a/man/compresid2way.Rd b/man/compresid2way.Rd
new file mode 100644
index 0000000..11e5021
--- /dev/null
+++ b/man/compresid2way.Rd
@@ -0,0 +1,84 @@
+\name{compresid2way}
+\alias{compresid2way}
+\title{Plot Components + Residuals for Two Factors}
+\description{
+ For an analysis of variance or regression with (at least) two factors:
+ Plot components + residuals for two factors according to Tukey's
+ \dQuote{forget-it plot}. Try it!
+}
+\usage{
+compresid2way(aov, data=NULL, fac=1:2, label = TRUE, numlabel = FALSE,
+ xlab=NULL, ylab=NULL, main=NULL,
+ col=c(2,3,4,4), lty=c(1,1,2,4), pch=c(1,2))
+}
+\arguments{
+ \item{aov}{either an \code{\link{aov}} object with a formula of the form
+% \code{y \~{} a + b}, where \code{a} and \code{b} are factors,
+ \code{y ~ a + b}, where \code{a} and \code{b} are factors,
+ or such a formula.}
+ \item{data}{data frame containing \code{a} and \code{b}.}
+ \item{fac}{the two factors used for plotting. Either column numbers or
+ names for argument \code{data}.}
+ \item{label}{logical indicating if levels of factors should be shown
+ in the plot.}
+ \item{numlabel}{logical indicating if effects of factors will be shown
+ in the plot.}
+ \item{xlab,ylab,main}{the usual \code{\link{title}} components, here
+ with a non-trivial default constructed from \code{aov} and the
+ component factors used.}
+ \item{col,lty,pch}{colors, line types, plotting characters to be used
+ for plotting [1] positive residuals, [2] negative residuals,
+ [3] grid, [4] labels. If \code{pch} is sufficiently long, it will be used
+ as the list of individual symbols for plotting the y values.}
+}
+\details{For a two-way analysis of variance, the plot shows the additive
+ components of the fits for the two factors by the intersections of a
+ grid, along with the residuals.
+ The observed values of the target variable are identical to the
+ vertical coordinate.
+
+ The application of the function has been extended to cover more
+ complicated models. The components of the fit for two factors are
+ shown as just described, and the residuals are added. The result is a
+ \dQuote{component plus residual} plot for two factors in one display.
+}
+\value{Invisibly, a list with components
+ \item{compy}{data.frame containing the component effects of the two
+ factors, and combined effects plus residual}
+ \item{coef}{coefficients: Intercept and effects of the factors}
+}
+\references{
+ F. Mosteller and J. W. Tukey (1977)
+ \emph{Data Analysis and Regression: A Second Course in Statistics}.
+ Addison-Wesley, Reading, Mass., p. 176.
+
+ John W. Tukey (1977)
+ \emph{Exploratory Data Analysis}.
+ Addison-Wesley, Reading, Mass., p. 381.
+}
+\author{Werner Stahel \email{stahel at stat.math.ethz.ch}}
+\seealso{\code{\link{interaction.plot}}}
+\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))
+ compresid2way(fm1)
+}
+\keyword{hplot}
diff --git a/man/cum.Vert.funkt.Rd b/man/cum.Vert.funkt.Rd
new file mode 100644
index 0000000..89e9cd9
--- /dev/null
+++ b/man/cum.Vert.funkt.Rd
@@ -0,0 +1,42 @@
+\name{cum.Vert.funkt}
+\alias{cum.Vert.funkt}
+
+\title{Kumulative Verteilung Aufzeichnen}
+\description{
+ Kumulative Verteilung von \code{x} aufzeichnen, auf Wunsch auch Median
+ und Quartile.
+
+ This is just an old German language version of
+ \code{\link[stats]{plot.ecdf}()} used for teaching at ETHZ.
+}
+\usage{
+cum.Vert.funkt(x, Quartile = TRUE, titel = TRUE, Datum = TRUE,
+ rang.axis = n <= 20, xlab = "", main = "", \dots)
+}
+\arguments{
+ \item{x}{numeric vector whose empirical distribution should be plotted.}
+ \item{Quartile}{logical indicating if all 3 non-trivial quartiles
+ should be drawn.}
+ \item{titel}{logical indicating if a German title should be drawn.}
+ \item{Datum}{logical indicating if \code{\link{p.datum}} should be added.}
+ \item{rang.axis}{logical indicating if all the ranks should be marked at
+ the y-axis. Defaults to true if there are not more than 20 observations.}
+ \item{xlab, main}{x-axis label and main title; default to empty.}
+ \item{\dots}{optional further arguments, passed to \code{\link{plotStep}}.}
+}
+\value{
+ the return value of \code{\link{plotStep}()} which is called
+ internally, \emph{invisibly}.
+}
+\author{Martin Maechler et al.}
+\seealso{\code{\link{plotStep}} on which it is based; but you should
+ really consider using \code{\link[stats]{plot.ecdf}()} from the
+ \pkg{stats} package instead of this.}
+\examples{
+cum.Vert.funkt(runif(12))
+cum.Vert.funkt(runif(20))
+
+Z <- rnorm(50)
+cum.Vert.funkt(Z)
+}
+\keyword{hplot}
diff --git a/man/diagDA.Rd b/man/diagDA.Rd
new file mode 100644
index 0000000..911b91f
--- /dev/null
+++ b/man/diagDA.Rd
@@ -0,0 +1,105 @@
+\name{diagDA}
+\title{Diagonal Discriminant Analysis}
+\alias{diagDA}
+\alias{dDA}
+\alias{print.dDA}
+\alias{predict.dDA}
+\keyword{naive Bayes classifier}
+\description{
+ This function implements a simple Gaussian maximum likelihood
+ discriminant rule, for diagonal class covariance matrices.
+
+ In machine learning lingo, this is called \dQuote{Naive Bayes} (for
+ continuous predictors). Note that naive Bayes is more general, as it
+ models discrete predictors as multinomial, i.e., binary predictor
+ variables as Binomial / Bernoulli.
+}
+\usage{
+dDA(x, cll, pool = TRUE)
+\method{predict}{dDA}(object, newdata, pool = object$pool, \dots)
+\method{print}{dDA}(x, \dots)
+
+diagDA(ls, cll, ts, pool = TRUE)
+}
+\arguments{
+ \item{x,ls}{learning set data matrix, with rows corresponding to
+ cases (e.g., mRNA samples) and columns to predictor variables
+ (e.g., genes).}
+ \item{cll}{class labels for learning set, must be consecutive integers.}
+ \item{object}{object of class \code{dDA}.}
+ \item{ts, newdata}{test set (prediction) data matrix, with rows corresponding
+ to cases and columns to predictor variables.}
+ \item{pool}{logical flag. If true (by default), the covariance matrices
+ are assumed to be constant across classes and the discriminant rule
+ is linear in the data. Otherwise (\code{pool= FALSE}), the
+ covariance matrices may vary across classes and the discriminant
+ rule is quadratic in the data.}
+ \item{\dots}{further arguments passed to and from methods.}
+}
+\value{
+ \code{dDA()} returns an object of class \code{dDA} for which there are
+ \code{\link{print}} and \code{\link{predict}} methods. The latter
+ returns the same as \code{diagDA()}:
+
+ \code{diagDA()} returns an integer vector of class predictions for the
+ test set.
+}
+\references{
+ S. Dudoit, J. Fridlyand, and T. P. Speed. (2000)
+ Comparison of Discrimination Methods for the Classification of Tumors
+ Using Gene Expression Data.
+ (Statistics, UC Berkeley, June 2000, Tech Report \#576)
+}
+\author{
+ Sandrine Dudoit, \email{sandrine at stat.berkeley.edu} and\cr
+ Jane Fridlyand, \email{janef at stat.berkeley.edu} originally wrote
+ \code{stat.diag.da()} in CRAN package \pkg{sma} which was modified
+ for speedup by Martin Maechler \email{maechler at R-project.org}
+ who also introduced \code{dDA} etc.
+}
+\seealso{\code{\link[MASS]{lda}} and \code{\link[MASS]{qda}} from the
+ \pkg{MASS} package;
+ \code{\link[e1071]{naiveBayes}} from \pkg{e1071}.
+}
+\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
+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
+(dd <- diagDA(tr1, cl1 , ts = d1[ i1,]))# ok, too!
+points(d1[ i1,], pch = 10, cex=3, col = dd)
+
+## use new fit + predict instead :
+(r1 <- dDA(tr1, cl1))
+(r1.<- dDA(tr1, cl1.))
+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
+predict(m4.2, xx)
+}
+\keyword{models}
+\keyword{classif}
+
diff --git a/man/diagX.Rd b/man/diagX.Rd
new file mode 100644
index 0000000..3056841
--- /dev/null
+++ b/man/diagX.Rd
@@ -0,0 +1,26 @@
+\name{diagX}
+\alias{diagX}
+\title{The \dQuote{Other} Diagonal Matrix}
+\description{
+ Compute the \emph{other} diagonal identity matrix.
+ The result is basically a \emph{fast} version of \code{diag(n)[, n:1]}.
+}
+\usage{
+diagX(n)
+}
+\arguments{
+ \item{n}{positive integer.}
+}
+\value{
+ a numeric \eqn{n \times n}{n * n} matrix with many zeros -- apart from
+ \code{1}s in the \emph{other} diagonal.
+}
+\author{Martin Maechler, 1992.}
+\seealso{\code{\link{diag}}.}
+\examples{
+diagX(4)
+for(m in 1:5)
+ stopifnot(identical(diagX(m), diag(m)[, m:1, drop = FALSE]))
+}
+\keyword{array}
+\keyword{utilities}
diff --git a/man/digitsBase.Rd b/man/digitsBase.Rd
new file mode 100644
index 0000000..6da3687
--- /dev/null
+++ b/man/digitsBase.Rd
@@ -0,0 +1,102 @@
+\name{digitsBase}
+\alias{digitsBase}
+\alias{as.intBase}
+\alias{bi2int}
+\alias{as.integer.basedInt}
+\alias{print.basedInt}
+\title{Digit/Bit Representation of Integers in any Base}
+\description{
+ Integer number representations in other Bases.
+
+ Formally, for every element \eqn{N =}\code{x[i]}, compute the (vector
+ of) \dQuote{digits} \eqn{A} of the \code{base} \eqn{b}
+ representation of the number \eqn{N}, \eqn{N = \sum_{k=0}^M A_{M-k} b ^ k}{%
+ N = sum(k = 0:M ; A[M-k] * b^k)}.\cr
+ Revert such a representation to integers.
+}
+\usage{
+digitsBase(x, base = 2, ndigits = 1 + floor(1e-9+ log(max(x),base)))
+\method{as.integer}{basedInt}(x, \dots)
+\method{print}{basedInt}(x, \dots)
+
+as.intBase(x, base = 2)
+bi2int(xlist, base)
+}
+\arguments{
+ \item{x}{For \code{digitsBase()}: non-negative integer (vector) whose
+ base \code{base} digits are wanted.
+
+ For \code{as.intBase()}: \cr a list of numeric vectors, a character
+ vector, or an integer matrix as returned by \code{digitsBase()},
+ representing digits in base \code{base}.
+ }
+ \item{base}{integer, at least 2 specifying the base for representation.}
+ \item{ndigits}{number of bits/digits to use.}
+ \item{\dots}{potential further arguments passed to methods, notably
+ \code{\link{print}}.}
+ \item{xlist}{a \code{\link{list}} of integer vectors with entries
+ typically in \code{0:(base-1)}, such as resulting from
+ \code{digitsBase()}.}
+}
+\value{
+ For \code{digitsBase()}, an object, say \code{m}, of class
+ \code{"basedInt"} which is basically a (\code{ndigits} x \code{n})
+ \code{\link{matrix}} where \code{m[,i]} corresponds to \code{x[i]},
+ \code{n <- length(x)} and \code{attr(m,"base")} is the input
+ \code{base}.
+
+ \code{as.intBase()} and the \code{\link{as.integer}} method for
+ \code{basedInt} objects return an \code{\link{integer}} vector.
+ \cr \code{bi2int()} is the low-level workhorse of \code{as.intBase()}.
+}
+\note{Some of these functions existed under names \code{digits} and
+ \code{digits.v} in previous versions of the \pkg{sfsmisc} package.
+}
+\author{Martin Maechler, Dec 4, 1991 (for S-plus; then called \code{digits.v}).}
+\examples{
+digitsBase(0:12, 8) #-- octal representation
+empty.dimnames(digitsBase(0:33, 2)) # binary
+
+## 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
+digits(128, base = 8) # 2 0 0
+
+## one way of pretty printing (base <= 10!)
+b2ch <- function(db)
+ noquote(gsub("^0+(.{1,})$"," \\\\1", % \\\\ |--> \\ in example R core
+ apply(db, 2, paste, collapse = "")))
+b2ch(digitsBase(0:33, 2)) #-> 0 1 10 11 100 101 ... 100001
+b2ch(digitsBase(0:33, 4)) #-> 0 1 2 3 10 11 12 13 20 ... 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
+
+## 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"
+## 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))
+head(ip_aton(ip))
+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)
+## or also as.intBase() working from strings:
+(cb <- apply(digitsBase(0:33, 4), 2, paste, collapse = ""))
+##-> "000" "001" ..... "200" "201"
+all(0:33 == as.intBase(cb, base = 4))
+}
+\keyword{arith}
+\keyword{utilities}
diff --git a/man/eaxis.Rd b/man/eaxis.Rd
new file mode 100644
index 0000000..104af90
--- /dev/null
+++ b/man/eaxis.Rd
@@ -0,0 +1,158 @@
+\name{eaxis}
+\alias{eaxis}
+\title{Extended / Engineering Axis for Graphics}
+\description{
+ An extended \code{\link[graphics]{axis}()} function which labels more
+ prettily, in particular for log-scale axes.
+
+ It makes use of \link{plotmath} or (LaTeX) \code{\link{expression}}s of
+ the form \eqn{k \times 10^k}{k * 10^k} for labeling a
+ log-scaled axis and when otherwise exponential formatting would be
+ used (see \code{\link{pretty10exp}}).
+}
+\usage{
+eaxis(side, at = if(log) axTicks(side, axp=axp, log=log, nintLog=nintLog)
+ else axTicks(side, axp=axp, log=log),
+ labels = NULL, log = NULL,
+ f.smalltcl = 3/5, at.small = NULL, small.mult = NULL,
+ small.args = list(),
+ draw.between.ticks = TRUE, between.max = 4,
+ outer.at = TRUE, drop.1 = TRUE, sub10 = FALSE, las = 1,
+ nintLog = max(10, par("lab")[2 - is.x]),
+ axp = NULL, n.axp = NULL, max.at = Inf,
+ lab.type = "plotmath", lab.sep = "cdot",
+ \dots)
+}
+\arguments{
+ \item{side}{integer in 1:4, specifying side of \code{\link{axis}}.}
+ \item{at}{numeric vector of (\dQuote{normalsized}) tick locations; by
+ default \code{\link[graphics]{axTicks}(side, ..)}, i.e., the same as
+ \code{\link{axis}()} would use.}
+ \item{labels}{\code{NULL} (default), \code{\link{logical}},
+ \code{character} or \code{expression}, as in \code{\link{axis}()};
+ in addition, if \code{NA}, \code{labels = TRUE} is passed to
+ \code{\link{axis}()}, i.e. \code{\link{pretty10exp}} is \emph{not}
+ used. Use \code{FALSE} to suppress any labeling.}
+ \item{log}{logical or \code{NULL} specifying if log-scale should be
+ used; the default depends on the current plot's axis.}
+ \item{f.smalltcl}{factor specifying the lengths of the small ticks in
+ proportion to the normalsized, labeled ticks.}
+ \item{at.small}{locations of \emph{small} ticks; the default,
+ \code{NULL}, uses \code{small.mult} and constructs \dQuote{smart}
+ locations.}
+ \item{small.mult}{positive integer (or \code{NULL}), used when
+ \code{at.small} is NULL to indicate which multiples of
+ \code{at} (typically \code{\link{axTicks}()}) should be used as
+ \dQuote{small ticks}. The default \code{NULL} will use \code{9} in
+ the log case and a number in 2:5 otherwise.}% depending on scale details
+ \item{small.args}{optional \code{\link{list}} of further arguments to
+ the \code{\link{axis}()} call which draws the small ticks.}
+ \item{draw.between.ticks}{(only if \code{log} is true): logical indicating
+ that possible (non-small) ticks between the labeled (via \code{at})
+ ones should be drawn as well (and possibly also used for \code{at.small}
+ construction), see also \code{between.max}.}
+ \item{between.max}{(only if \code{log} and \code{draw.between.ticks}
+ are true): integer indicating ticks should be drawn (approximately)
+ between the labeled ones.}
+ \item{outer.at}{logical specifying that \code{at.small} should also be
+ constructed outside the \code{at} range, but still inside the
+ corresponding \code{\link{par}("usr")}.}
+ \item{drop.1}{logical specifying if \eqn{1 \times}{1 *} should be dropped
+ from labels, passed to \code{\link{pretty10exp}()}.}
+ \item{sub10}{logical, integer (of length 1 or 2) or \code{"10"}, indicating if
+ some \eqn{10^k} should be simplified to \dQuote{traditional}
+ formats, see \code{\link{pretty10exp}}.}
+ \item{nintLog}{only used in \R > 2.13.x, when \code{log} is true:
+ approximate (lower bound on) number of intervals for log scaling.}
+ \item{axp}{to be passed to \code{\link{axTicks}()} if \code{at} is not
+ specified.}
+ \item{n.axp}{to be set to \code{axp[3]} when \code{axp} and \code{at}
+ are not specified, in order to tweak the \emph{number} of (non-small)
+ tick marks produced from \code{\link{axTicks}(..)}, notably when
+ \code{log} is true, set \code{n.axp} to 1, 2, or 3:
+ \describe{
+ \item{1:}{will produce tick marks at \eqn{10^j} for integer \eqn{j},}
+ \item{2:}{gives marks \eqn{k 10^j} with \eqn{k \in \{1, 5\}}{k in {1,5}},}
+ \item{3:}{gives marks \eqn{k 10^j} with \eqn{k \in \{1, 2, 5\}}{k in {1,2,5}}}
+ } see \code{'xaxp'} on the \code{\link{par}} help page.}
+ \item{max.at}{maximal number of \code{at} values to be used
+ effectively. If you don't specify \code{at} yourself carefully, it
+ is recommended to set this to something like \code{25}, but this is
+ not the default, for back compatibility reasons.}
+ \item{las, \dots}{arguments passed to (the first) \code{\link{axis}}
+ call. Note that the default \code{las = 1} differs from
+ \code{axis}'s default \code{las = 0}.}
+ \item{lab.type}{string, passed to \code{\link{pretty10exp}} to choose
+ between default \code{\link{plotmath}} or LaTeX label format.}
+ \item{lab.sep}{separator between mantissa and exponent for LaTeX labels,
+ see \code{\link{pretty10exp}}.}
+}
+\author{Martin Maechler}
+\seealso{\code{\link[graphics]{axis}},
+ \code{\link[graphics]{axTicks}},
+ \code{\link{axTexpr}},
+ \code{\link{pretty10exp}}.
+}
+\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))
+## 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)))
+}
+\keyword{aplot}
diff --git a/man/ecdf.ksCI.Rd b/man/ecdf.ksCI.Rd
new file mode 100644
index 0000000..9b37408
--- /dev/null
+++ b/man/ecdf.ksCI.Rd
@@ -0,0 +1,34 @@
+\name{ecdf.ksCI}
+\alias{ecdf.ksCI}
+\title{Plot Empirical Distribution Function With 95\% Confidence Curves}
+\description{
+ Plots the empirical (cumulative) distribution function (ECDF) for
+ univariate data, together with upper and lower simultaneous 95\% confidence curves,
+ computed via Kolmogorov-Smirnov' \eqn{D}, see \code{\link{KSd}}.
+}
+\usage{
+ecdf.ksCI(x, main = NULL, sub = NULL, xlab = deparse(substitute(x)),
+ ci.col = "red", \dots)
+}
+\arguments{
+ \item{x}{\code{x} numerical vector of observations.}
+ \item{main,sub,xlab}{arguments passed to \code{\link{title}}.}
+ \item{ci.col}{color for confidence interval lines.}
+ \item{\dots}{optional arguments passed to \code{\link{plot.stepfun}}.}
+}
+\value{
+ Nothing. Used for its side effect, to produce a plot.
+}
+\references{Bickel and Doksum, see \code{\link{KSd}}.
+}
+\author{Kjetil Halvorsen}
+
+\note{Presently, will only work if \code{length(x)} > 9. }
+
+\seealso{\code{\link{ecdf}} and \code{\link{plot.stepfun}} in package
+ \code{\link{stepfun}}. }
+
+\examples{
+ecdf.ksCI( rchisq(50,3) )
+}
+\keyword{hplot}
diff --git a/man/ellipsePoints.Rd b/man/ellipsePoints.Rd
new file mode 100644
index 0000000..30536d3
--- /dev/null
+++ b/man/ellipsePoints.Rd
@@ -0,0 +1,71 @@
+\name{ellipsePoints}
+\alias{ellipsePoints}
+\title{Compute Radially Equispaced Points on Ellipse}
+\description{
+ Compute points on (the boundary of) an ellipse which is given by
+ elementary geometric parameters.
+}
+\usage{
+ellipsePoints(a, b, alpha = 0, loc = c(0, 0), n = 201, keep.ab.order=FALSE)
+}
+\arguments{
+ \item{a,b}{length of half axes in (x,y) direction. Note that
+ \eqn{(a,b)} is equivalent to \eqn{(b,a)} \emph{unless}
+ \code{keep.ab.order=TRUE}.}
+ \item{alpha}{angle (in degrees) giving the orientation of the ellipse,
+ i.e., the original (x,y)-axis ellipse is rotated by \code{angle}.}
+ \item{loc}{center (LOCation) of the ellipse.}
+ \item{n}{number of points to generate.}
+ \item{keep.ab.order}{logical indicating if \eqn{(a,b)} should be
+ considered \emph{ordered}. When \code{FALSE}, as per default,
+ the orientation of the ellipse is solely determined by \code{alpha}.
+
+ Note that \code{keep.ab.order = TRUE} seems a more natural default,
+ but \code{FALSE} is there for back-compatibility.}
+}
+\value{
+ A numeric matrix of dimension \code{n x 2}, each row containing the
+ (x,y) coordinates of a point.
+}
+\author{Martin Maechler, March 2002.}
+\seealso{the \file{ellipse} package and \code{\link[cluster]{ellipsoidhull}}
+ and \code{\link[cluster]{ellipsoidPoints}}
+ in the \file{cluster} package.
+}
+\examples{
+## Simple Ellipse, centered at (0,0), x-/y- axis parallel:
+ep <- ellipsePoints(5,2)
+str(ep)
+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
+}
+\keyword{iplot}
+\keyword{utilities}
diff --git a/man/empty.dimnames.Rd b/man/empty.dimnames.Rd
new file mode 100644
index 0000000..acad715
--- /dev/null
+++ b/man/empty.dimnames.Rd
@@ -0,0 +1,26 @@
+\name{empty.dimnames}
+\alias{empty.dimnames}
+\title{Empty Dimnames of an Array}
+\description{
+ Remove all dimension names from an array for compact printing.
+}
+\usage{
+empty.dimnames(a)
+}
+\arguments{
+ \item{a}{an \code{\link{array}}, i.e., as special case a matrix.}
+}
+\value{
+ Returns \code{a} with its dimnames replaced by empty character strings.
+}
+\author{Bill Venables / Martin Maechler, Sept 1993.}
+\seealso{\code{\link{unname}} \emph{removes} the dimnames.}
+\examples{
+empty.dimnames(diag(5)) # looks much nicer
+
+(a <- matrix(-9:10, 4,5))
+empty.dimnames(a) # nicer, right?
+}
+\keyword{array}
+\keyword{print}
+\keyword{utilities}
diff --git a/man/errbar.Rd b/man/errbar.Rd
new file mode 100644
index 0000000..187b141
--- /dev/null
+++ b/man/errbar.Rd
@@ -0,0 +1,36 @@
+\name{errbar}
+\encoding{latin1}
+\title{Scatter Plot with Error Bars}
+\alias{errbar}
+\description{
+ Draws a scatter plot, adding vertical \dQuote{error bars} to all the points.
+}
+\usage{
+errbar(x, y, yplus, yminus, cap = 0.015,
+ ylim = range(y,yplus,yminus),
+ xlab= deparse(substitute(x)),
+ ylab= deparse(substitute(y)), \dots)
+}
+\arguments{
+ \item{x}{vector of x values.}
+ \item{y}{vector of y values.}
+ \item{yplus}{vector of y values: the tops of the error bars.}
+ \item{yminus}{vector of y values: the bottoms of the error bars.}
+ \item{cap}{the width of the little lines at the tops and bottoms of
+ the error bars in units of the width of the plot. Default is 0.015.}
+ \item{ylim}{(numeric of length 2): the y-axis extents with a sensible default.}
+ \item{xlab, ylab}{axis labels for the plot, as in
+ \code{\link{plot.default}}.}
+ \item{\dots}{Graphical parameters (see \code{\link{par}}) may also
+ be supplied as arguments to this function.}
+}
+\author{Originally Charles Geyer, U.Chicago, early 1991; then Martin M�chler.}
+\seealso{\code{\link[Hmisc]{errbar}} in package \pkg{Hmisc} is similar.
+%% maybe deprecate ours? FIXME
+}
+\examples{
+y <- rnorm(10); d <- 1 + .1*rnorm(10)
+errbar(1:10, y, y + d, y - d, main="Error Bars example")
+}
+\keyword{hplot}
+
diff --git a/man/f.robftest.Rd b/man/f.robftest.Rd
new file mode 100644
index 0000000..e54b295
--- /dev/null
+++ b/man/f.robftest.Rd
@@ -0,0 +1,46 @@
+\name{f.robftest}
+\alias{f.robftest}
+\title{Robust F-Test: Wald test for multiple coefficients of rlm() Object.}
+\description{
+ Compute a robust F-Test, i.e., a Wald test for multiple coefficients
+ of an \code{\link[MASS]{rlm}} object.
+}
+\usage{
+f.robftest(object, var = -1)
+}
+\arguments{
+ \item{object}{result of \code{\link[MASS]{rlm}()}.}
+ \item{var}{variables. Either their names or their indices; the
+ default, \code{-1} means all \emph{but} the intercept.}
+}
+\details{
+ This builds heavily on \code{\link[MASS]{summary.rlm}()}, the
+ \code{\link{summary}} method for \code{\link[MASS]{rlm}} results.
+}
+\value{
+ An object of class \code{"htest"}, hence with the standard print
+ methods for hypothesis tests. This is basically a list with components
+ \item{statistic}{the F statistic, according to ...}% FIXME
+ \item{df}{numerator and denominator degrees of freedom.}
+ \item{data.name}{(extracted from input \code{object}.)}
+ \item{alternative}{\code{"two.sided"}, always.}
+ \item{p.value}{the P-value, using an F-test on \code{statistic} and
+ \code{df[1:2]}.}
+}
+\references{
+ FIXME --- Need some here !
+}
+\author{Werner Stahel, Jul.2000; updates by Martin Maechler.}
+\seealso{\code{\link[MASS]{rlm}}, \code{\link{summary.aov}}, etc.}
+\examples{
+if(require("MASS")) {
+ ## same data as example(rlm)
+ data(stackloss)
+ summary(rsl <- rlm(stack.loss ~ ., stackloss))
+ f.robftest(rsl)
+ } else " forget it "
+
+}
+\keyword{robust}
+\keyword{htest}
+
diff --git a/man/factorize.Rd b/man/factorize.Rd
new file mode 100644
index 0000000..3e79c1a
--- /dev/null
+++ b/man/factorize.Rd
@@ -0,0 +1,48 @@
+\name{factorize}
+\alias{factorize}
+\title{Prime Factorization of Integers}
+\description{
+ Compute the prime factorization(s) of integer(s) \code{n}.
+
+ % ## Purpose: Prime factorization of integer(s) 'n'
+ % ## -------------------------------------------------------------------------
+ % ## Arguments: n vector of integers to factorize (into prime numbers)
+ % ## --> needs 'prime.sieve'
+ % ## >> Better would be: Define class 'primefactors' and "multiply" method
+ % ## then use this function recursively only "small" factors
+ % ## -------------------------------------------------------------------------
+}
+\usage{
+factorize(n, verbose = FALSE)
+}
+\arguments{
+ \item{n}{vector of integers to factorize.}
+ \item{verbose}{logical indicating if some progress information should
+ be printed.}
+}
+\details{
+ works via \code{\link{primes}}, currently in a cheap way, sub-optimal
+ for large composite \eqn{n}.
+%% FIXME: ALSO,
+%% % ## >> Better would be: Define class 'primefactors' and "multiply" method
+}
+\value{
+ A named \code{\link{list}} of the same length as \code{n},
+ each element a 2-column matrix with column \code{"p"} the prime
+ factors and column~\code{"m"} their respective exponents (or
+ multiplities), i.e., for a prime number \code{n}, the resulting matrix
+ is \code{cbind(p = n, m = 1)}.
+}
+\author{Martin Maechler, Jan. 1996.}
+\seealso{
+ \code{\link{primes}}.
+
+ For factorization of moderately or really large numbers, see the \pkg{gmp}
+ package, and its \code{\link[gmp]{factorize}()}.
+}
+\examples{
+ factorize(47)
+ factorize(seq(101, 120, by=2))
+}
+\keyword{math}
+
diff --git a/man/hatMat.Rd b/man/hatMat.Rd
new file mode 100644
index 0000000..1ccee03
--- /dev/null
+++ b/man/hatMat.Rd
@@ -0,0 +1,73 @@
+\name{hatMat}
+\alias{hatMat}
+\title{Hat Matrix of a Smoother}
+\description{
+ Compute the hat matrix or smoother matrix, of \sQuote{any} (linear) smoother,
+ smoothing splines, by default.
+}
+\usage{
+hatMat(x, trace= FALSE,
+ pred.sm = function(x, y, ...)
+ predict(smooth.spline(x, y, ...), x = x)$y,
+ \dots)
+}
+\arguments{
+ \item{x}{numeric vector or matrix.}
+ \item{trace}{logical indicating if the whole hat matrix, or only its
+ trace, i.e. the sum of the diagonal values should be computed.}
+ \item{pred.sm}{a function of at least two arguments \code{(x,y)}
+ which returns fitted values, i.e. \eqn{\hat{y}}{y.hat}, of length
+ compatible to \code{x} (and \code{y}).}
+ \item{\dots}{optionally further arguments to the smoother function
+ \code{pred.sm}.}
+}
+\value{
+ The hat matrix \eqn{H} (if \code{trace = FALSE} as per default) or
+ a number, \eqn{tr(H)}, the \emph{trace} of \eqn{H}, i.e.,
+ \eqn{\sum_i H_{ii}}{sum(i) H[i,i]}.
+
+ Note that \code{dim(H) == c(n, n)} where \code{n <- length(x)} also in
+ the case where some x values are duplicated (aka \emph{ties}).
+}
+\references{
+ Hastie and Tibshirani (1990).
+ \emph{Generalized Additive Models}.
+ Chapman \& Hall.
+}
+\author{Martin Maechler \email{maechler at stat.math.ethz.ch}}
+\seealso{\code{\link{smooth.spline}}, etc.
+ Note the demo, \code{demo("hatmat-ex")}.
+}
+\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
+
+% pRmean <- function(x,y,...) run.mean(y, ...)
+% pRline <- function(x,y,...) run.line(x,y, ...)$y
+
+## 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)
+
+## ksmooth() :
+Hk <- hatMat(x1, pr = pksm, bandwidth = 2)
+cat(sprintf("df = \%.2f\\n", sum(diag(Hk))))
+image(Hk)
+Matrix::printSpMatrix(as(round(Hk, 2), "sparseMatrix"))
+
+##---> see demo("hatmat-ex") for more (and larger) examples
+%% should test these also for x with ties
+}
+\keyword{smooth}
+\keyword{regression}
diff --git a/man/histBxp.Rd b/man/histBxp.Rd
new file mode 100644
index 0000000..0ee2fcd
--- /dev/null
+++ b/man/histBxp.Rd
@@ -0,0 +1,105 @@
+\name{histBxp}
+\encoding{latin1}
+\alias{histBxp}
+\title{Plot a Histogram and a Boxplot}
+\description{
+ Creates a histogram and a horizontal boxplot on the current graphics
+ device.
+}
+\usage{
+histBxp(x, nclass, breaks, probability=FALSE, include.lowest=TRUE,
+ xlab = deparse(substitute(x)),
+ \dots,
+ width=0.2, boxcol=3, medcol=2, medlwd=5, whisklty=2, staplelty=1)
+}
+\arguments{
+ \item{x}{numeric vector of data for histogram. Missing values
+ (\code{NA}s) are allowed.}
+ \item{nclass}{
+ recommendation for the number of classes (i.e., bars) the histogram should
+ have. The default is a number proportional to the logarithm of the length
+ of \code{x}.
+ }
+ \item{breaks}{
+ vector of the break points for the bars of the histogram. The count in the
+ i-th bar is \code{sum(breaks[i] < x <= breaks[i+1])}
+ except that if \code{include.lowest} is \code{TRUE} (the default),
+ the first bar also includes points equal to \code{breaks[1]}. If
+ omitted, evenly-spaced break points are determined from
+ \code{nclass} and the extremes of the data.
+ }
+ \item{probability}{
+ logical flag: if \code{TRUE}, the histogram will be scaled as a probability
+ density; the sum of the bar heights times bar widths will equal \code{1}. If
+ \code{FALSE}, the heights of the bars will be counts.
+ }
+ \item{include.lowest}{
+ If \code{TRUE} (the default), the lowest bar will include data
+ points equal to the lowest break, otherwise it will act like the
+ other bars (see the description of the \code{breaks} argument).
+ }
+ \item{xlab}{character or expression for x axis labeling.}
+ \item{\dots}{additional arguments to \code{\link{barplot}}. The
+ \code{\link{hist}} function uses the function \code{barplot} to do
+ the actual plotting; consequently, arguments to the \code{barplot}
+ function that control shading, etc., can also be given to
+ \code{hist}. See the \code{barplot} documentation for arguments
+ \code{angle}, \code{density}, \code{col}, and \code{inside}. Do not
+ use the \code{space} or \code{histo} arguments.
+ }
+ \item{width}{
+ width of the box relative to the height of the histogram. DEFAULT is
+ \code{0.2}.}
+ \item{boxcol}{color of filled box. The default is \code{3}.}
+ \item{medcol}{
+ the color of the median line. The special value, \code{NA},
+ indicates the current plotting color (\code{par("col")}). The
+ default is \code{2}. If \code{boxcol=0} and \code{medcol} is not
+ explicitly specified this is set to the current plotting color
+ (\code{par("col")}).
+ }
+ \item{medlwd}{
+ median line width. The special value \code{NA}, is used to indicate
+ the current line width (\code{par("lwd")}). The default is \code{5}.
+ }
+ \item{whisklty}{
+ whisker line type. The special value \code{NA} indicates the
+ current line type (\code{par("lty")}). The default is \code{2}
+ (dotted line).}
+ \item{staplelty}{
+ staple (whisker end cap) line type. The special value \code{NA}
+ indicates the current line type (\code{par("lty")}). The default is
+ \code{1} (solid line).
+
+ Graphical parameters (see \code{\link{par}}) may also
+ be supplied as arguments to this function.
+ In addition, the high-level graphics arguments described under
+ \code{par} and the arguments to \code{title} may be supplied to this
+ function.}
+}
+\details{
+ If \code{include.lowest} is \code{FALSE} the bottom breakpoint must be
+ strictly less than the minimum of the data, otherwise (the default) it
+ must be less than or equal to the minimum of the data. The top
+ breakpoint must be greater than or equal to the maximum of the data.
+
+ This function has been called \code{hist.bxp()} for 17 years; in 2012,
+ the increasingly strong CRAN policies required a new name (which could not
+ be confused with an S3 method name).
+}
+\author{S-Plus: Markus Keller, Christian Keller; port to \R: Martin M�chler.}
+
+\seealso{\code{\link{hist}}, \code{\link{barplot}},
+ \code{\link{boxplot}}, \code{\link{rug}} and
+ \code{\link[Hmisc]{scat1d}} in the \pkg{Hmisc} package.
+}
+\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)
+ }
+}
+\keyword{hplot}
diff --git a/man/integrate.xy.Rd b/man/integrate.xy.Rd
new file mode 100644
index 0000000..d51d023
--- /dev/null
+++ b/man/integrate.xy.Rd
@@ -0,0 +1,44 @@
+\name{integrate.xy}
+\alias{integrate.xy}
+\title{Cheap Numerical Integration through Data points.}
+\description{
+ Given \eqn{(x_i, f_i)} where \eqn{f_i = f(x_i)}, compute a cheap
+ approximation of \eqn{\int_a^b f(x) dx}{integral(a .. b) f(x) dx}.
+}
+\usage{
+integrate.xy(x, fx, a, b, use.spline=TRUE, xtol=2e-08)
+}
+\arguments{
+ \item{x}{abscissa values.}
+ \item{fx}{corresponding values of \eqn{f(x)}.}
+ \item{a,b}{the boundaries of integration; these default to min(x) and
+ max(x) respectively.}
+ \item{use.spline}{logical; if TRUE use an interpolating spline.}
+ \item{xtol}{tolerance factor, typically around
+ \code{sqrt(.Machine$double.eps)} ......(fixme)....}
+}
+\details{
+ Note that this is really not good for noisy \code{fx} values;
+ probably a smoothing spline should be used in that case.
+
+ Also, we are not yet using Romberg in order to improve the trapezoid
+ rule. This would be quite an improvement in equidistant cases.
+}
+\value{
+ the approximate integral.
+}
+\author{Martin Maechler, May 1994 (for S).}
+\seealso{\code{\link{integrate}} for numerical integration of
+ \emph{functions}.}
+\examples{
+ x <- 1:4
+ integrate.xy(x, exp(x))
+ print(exp(4) - exp(1), digits = 10) # the true integral
+
+ 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")
+ }
+}
+\keyword{math}
+\keyword{utilities}
diff --git a/man/inv.seq.Rd b/man/inv.seq.Rd
new file mode 100644
index 0000000..0112daa
--- /dev/null
+++ b/man/inv.seq.Rd
@@ -0,0 +1,38 @@
+\name{inv.seq}
+\alias{inv.seq}
+\title{Inverse seq() -- Short Expression for Index Vector}
+\description{
+ Compute a short expression for a given integer vector, typically
+ an index, that can be expressed shortly, using \code{\link{:}} etc.
+}
+\usage{
+inv.seq(i)
+}
+\arguments{
+ \item{i}{vector of (usually increasing) integers.}
+}
+%%\details{
+%%}
+\value{
+ a \code{\link{call}} (\dQuote{the inside of an
+ \code{\link{expression}}}) to be \code{\link{eval}()}ed to
+ return the original \code{i}.
+}
+\author{Martin Maechler, October 1995; more elegant implementation from Tony Plate.}
+\seealso{\code{\link{rle}} for another kind of integer vector coding.}
+\examples{
+(rr <- inv.seq(i1 <- c(3:12, 20:24, 27, 30:33)))
+eval(rr)
+stopifnot(eval(rr) == i1)
+
+e2 <- expression(c(20:13, 3:12, -1:-4, 27, 30:31))
+(i2 <- eval(e2))
+(r2 <- inv.seq(i2))
+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))))
+}
+\keyword{arith}
+\keyword{utilities}
diff --git a/man/is.whole.Rd b/man/is.whole.Rd
new file mode 100644
index 0000000..3743df1
--- /dev/null
+++ b/man/is.whole.Rd
@@ -0,0 +1,49 @@
+\name{is.whole}
+\alias{is.whole}
+\title{Test Whether a Vector or Array Consists of Whole Numbers}
+\description{
+ This function tests whether a \code{numeric} or \code{complex} vector
+ or array consists of whole numbers. The function \code{\link{is.integer}}
+ is not appropriate for this since it tests whether the vector is of class
+ \code{integer} (see examples).
+}
+\usage{
+is.whole(x, tolerance = sqrt(.Machine$double.eps))
+}
+\arguments{
+ \item{x}{\code{integer}, \code{numeric}, or \code{complex} vector or
+ array to be tested}
+ \item{tolerance}{maximal distance to the next whole number}
+}
+% \details{
+%% ~~ If necessary, more details than the description above ~~
+% }
+\value{
+ The return value has the same dimension as the argument \code{x}: if \code{x}
+ is a vector, the function returns a \code{logical} vector of the same length;
+ if \code{x} is a matrix or array, the function returns a \code{logical} matrix
+ or array of the same dimensions. Each entry in the result indicates whether
+ the corresponding entry in \code{x} is whole.
+}
+\author{Alain Hauser <alain at huschhus.ch>}
+\seealso{\code{\link{is.integer}}}
+\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)
+is.whole(m)
+is.whole(v)
+
+## Numbers of class integer are always whole
+is.whole(dim(a))
+is.whole(length(v))
+}
+\keyword{arith}
diff --git a/man/iterate.lin.recursion.Rd b/man/iterate.lin.recursion.Rd
new file mode 100644
index 0000000..6ac0d78
--- /dev/null
+++ b/man/iterate.lin.recursion.Rd
@@ -0,0 +1,44 @@
+\name{iterate.lin.recursion}
+\alias{iterate.lin.recursion}
+\title{Generate Sequence Iterating a Linear Recursion}
+\description{
+ Generate numeric sequences applying a linear recursion \code{nr.it} times.
+}
+\usage{
+iterate.lin.recursion(x, coeff, delta = 0, nr.it)
+}
+\arguments{
+ \item{x}{numeric vector with \emph{initial values}, i.e., specifying
+ the beginning of the resulting sequence; must be of length (larger
+ or) equal to \code{length(coeff)}.}
+ \item{coeff}{coefficient vector of the linear recursion.}
+ \item{delta}{numeric scalar added to each term; defaults to 0. If not
+ zero, determines the linear drift component.}
+ \item{nr.it}{integer, number of iterations.}
+}
+\value{
+ numeric vector, say \code{r}, of length \code{n + nr.it}, where
+ \code{n = length(x)}. Initialized as \code{r[1:n] = x}, the recursion
+ is \code{r[k+1] = sum(coeff * r[(k-m+1):k])}, where \code{m = length(coeff)}.
+}
+\note{
+ Depending on the zeroes of the characteristic polynomial of \code{coeff},
+ there are three cases, of convergence, oszillation and divergence.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{seq}} can be regarded as a trivial special case.}
+\examples{
+## The Fibonacci sequence:
+iterate.lin.recursion(0:1, c(1,1), nr = 12)
+## 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)
+## slowly decaying :
+plot(ts(iterate.lin.recursion(1:4, c(-0.9, 0.95), nr=150)))
+}
+\keyword{arith}
diff --git a/man/last.Rd b/man/last.Rd
new file mode 100644
index 0000000..e2ca648
--- /dev/null
+++ b/man/last.Rd
@@ -0,0 +1,45 @@
+\name{last}
+\encoding{latin1}
+\alias{last}
+\title{Get Last Elements of a Vector}
+\description{
+ Extract the last elements of a vector.
+}
+\usage{
+last(x, length.out = 1, na.rm = FALSE)
+}
+\arguments{
+ \item{x}{any vector.}
+ \item{length.out}{integer indicating how many element are desired. If
+ positive, return the \code{length.out} last elements of \code{x}; if
+ negative, the last \code{length.out} elements are \emph{dropped}.
+ }
+ \item{na.rm}{logical indicating if the last non-missing value (if any)
+ shall be returned. By default (it is \code{FALSE} and) the last
+ elements (whatever its values) are returned.}
+}
+\value{
+ a vector of length \code{abs(length.out)} of \emph{last} values from \code{x}.
+}
+\author{Werner Stahel (\email{stahel at stat.math.ethz.ch}), and independently,
+ Philippe Grosjean (\email{phgrosjean at sciviews.org}),
+ Fr�d�ric Ibanez (\email{ibanez at obs-vlfr.fr}).}
+\note{
+ This function may eventually be deprecated for the standard \R
+ function \code{\link{tail}()}.
+
+ Useful for the \code{\link[pastecs]{turnogram}()} function in package
+ \pkg{pastecs}.
+}
+
+\seealso{\code{\link[pastecs]{first}}, \code{\link[pastecs]{turnogram}}
+}
+\examples{
+a <- c(NA, 1, 2, NA, 3, 4, NA)
+last(a)
+last(a, na.rm=TRUE)
+
+last(a, length = 2)
+last(a, length = -3)
+}
+\keyword{ manip }
diff --git a/man/linesHyberb.lm.Rd b/man/linesHyberb.lm.Rd
new file mode 100644
index 0000000..f29b538
--- /dev/null
+++ b/man/linesHyberb.lm.Rd
@@ -0,0 +1,39 @@
+\name{linesHyperb.lm}
+\alias{linesHyperb.lm}
+\title{Plot Confidence or Prediction Hyperbolas around a Regression Line}
+\description{
+ Add confidence/prediction hyperbolas for \eqn{y(x_0)}
+ to a plot with data or regression line.
+}
+\usage{
+linesHyperb.lm(object, c.prob=0.95, confidence=FALSE,
+ k=if (confidence) Inf else 1,
+ col=2, lty=2, do.abline=TRUE)
+}
+\arguments{
+ \item{object}{result of \code{\link{lm}(.)}.}
+ \item{c.prob}{coverage probability in \eqn{(0,1)}.}
+ \item{confidence}{logical; if true, do (small) confidence band, else,
+ realistic prediction band for the mean of \code{k} observations.}
+ \item{k}{integer or \code{Inf}; assume \code{k} future observations;
+ \code{k = Inf} corresponds to confidence intervals (for y).}
+ \item{col, lty}{attributes for the \code{\link{lines}} to be drawn.}
+ \item{do.abline}{logical; if true, the regression line is drawn as well.}
+}
+\note{
+ With \code{\link{predict.lm}(*, interval=)} is available,
+ this function \code{linesHyperb.lm} is only slightly more general for
+ its \code{k} argument.
+}
+\author{Martin Maechler, Oct 1995}
+\seealso{\code{\link{predict.lm}(*, interval=)} optionally computes
+ prediction or confidence intervals.}
+\examples{
+data(swiss)
+ plot(Fertility ~ Education, data = swiss) # the data
+(lmS <- lm(Fertility ~ Education, data = swiss))
+linesHyperb.lm(lmS)
+linesHyperb.lm(lmS, conf=TRUE, col="blue")
+}
+\keyword{regression}
+\keyword{aplot}
diff --git a/man/loessDemo.Rd b/man/loessDemo.Rd
new file mode 100644
index 0000000..9226d3a
--- /dev/null
+++ b/man/loessDemo.Rd
@@ -0,0 +1,94 @@
+\name{loessDemo}
+\title{Graphical Interactive Demo of loess()}
+\alias{loessDemo}
+\description{
+ A graphical and interactive demonstration and visualization of how
+ \code{\link{loess}} works. By clicking on the graphic, the user
+ determines the current estimation window which is visualized together
+ with the weights.
+}
+\usage{
+loessDemo(x, y, span = 1/2, degree = 1, family = c("gaussian", "symmetric"),
+ nearest = FALSE, nout = 501,
+ xlim = numeric(0), ylim = numeric(0), strictlim = TRUE, verbose = TRUE,
+ inch.sym = 0.25, pch = 4, shade = TRUE, w.symbols = TRUE,
+ sym.col = "blue", w.col = "light blue", line.col = "steelblue")
+}
+\arguments{
+ \item{x,y}{numeric vectors of the same length; the demo is about
+ \code{\link{loess}(y ~ x)}.}
+ \item{span}{the smoothing parameter \eqn{\alpha}.}
+ \item{degree}{the degree of the polynomials to be used; must be in \eqn{{0,1,2}}.}
+ \item{family}{if \code{"gaussian"} fitting is by least-squares, and if
+ \code{"symmetric"} a re-descending M estimator is used with Tukey's
+ biweight function. Can be abbreviated.}
+ \item{nearest}{logical indicating how \eqn{x_0} should be determined,
+ the value at which \eqn{\hat{f}(x_0)}{f^(x_0)} is computed. If
+ \code{nearest} is true, the closest \emph{data} value is taken.
+ }
+ \item{nout}{the number of points at which to evaluate, i.e,
+ determining \eqn{u_i}, \eqn{i = 1,2, \dots, \mathtt{nout}}, at
+ which \eqn{\hat{f}(u_i)}{f^(u_i)} is computed.}
+ \item{xlim}{x-range; to extend or determine (iff \code{strictlim} is
+ true) the \eqn{x}-range for plotting.}
+ \item{ylim}{y-range; to extend or determine (iff \code{strictlim} is
+ true) the \eqn{y}-range for plotting.}
+ \item{strictlim}{logical determining if \code{xlim} and \code{ylim}
+ should be strict limits (as e.g., in \code{\link{plot.default}}), or
+ just a suggestion to \emph{extend} the data-dependent ranges.}
+ \item{verbose}{logical ......}
+ \item{inch.sym}{symbol size in inches of the maximal weight circle symbol.}
+ \item{pch}{plotting character, see \code{\link{points}}.}
+ \item{shade}{logical; if true, \code{\link{polygon}(.., density=..)}
+ will be used to shade off the regions where the weights are zero.}
+ \item{w.symbols}{logical indicating if the non-zero weights should be
+ visualized by circles with radius proportional to \code{inch.sym}
+ and \eqn{\sqrt{w}} where \eqn{w} are the weights.}
+ \item{sym.col, w.col, line.col}{colors for the symbols, weights and
+ lines, respectively.}
+}
+%% \details{
+%% %% ~~ If necessary, more details than the description above ~~
+%% }
+%% \value{
+%% }
+%% \references{
+%% %% ~put references to the literature/web site here ~
+%% }
+\author{
+ As function \code{loess.demo()}, written and posted to S-news, on 27
+ Sep 2001, by Greg Snow, Brigham Young University, % gls at byu.edu
+ it was modified by Henrik Aa. Nielsen, IMM, DTU, % han at imm.dtu.dk
+ and subsequently spiffed up for \R by Martin Maechler.
+}
+\seealso{
+ \code{\link{loess}}.
+}
+\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
+ }% if (. lattice .)
+
+ ## 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"
+
+}% only if interactive
+}
+\keyword{loess}
+\keyword{dynamic}
+\keyword{hplot}
diff --git a/man/lseq.Rd b/man/lseq.Rd
new file mode 100644
index 0000000..09d3bd6
--- /dev/null
+++ b/man/lseq.Rd
@@ -0,0 +1,26 @@
+\name{lseq}
+\alias{lseq}
+\title{Generate Sequences, Equidistant on Log Scale}
+\description{
+ Generate sequences which are equidistant on a log-scale.
+}
+\usage{
+lseq(from, to, length)
+}
+\arguments{
+ \item{from}{starting value of sequence.}
+ \item{to}{end value of the sequence.}
+ \item{length}{desired length of the sequence.}
+}
+\value{
+ a \code{\link{numeric}} vector of length \code{length}.
+}
+\seealso{\code{\link{seq}}.%% ~/R/D/r-devel/R/src/library/base/man/seq.Rd
+}
+\examples{
+(x <- lseq(1, 990, length= 21))
+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")
+}
+\keyword{manip}
diff --git a/man/mat2tex.Rd b/man/mat2tex.Rd
new file mode 100644
index 0000000..75b954c
--- /dev/null
+++ b/man/mat2tex.Rd
@@ -0,0 +1,119 @@
+%%-- Original from Vincent Carey, see (commented) E-mail at end !
+\name{mat2tex}
+\alias{mat2tex}
+\title{Produce LaTeX commands to print a matrix}
+\usage{
+mat2tex(x, file= "mat.tex", envir = "tabular",
+ nam.center = "l", col.center = "c",
+ append = TRUE, digits = 3, title)
+}
+\arguments{
+ \item{x}{a matrix}
+ \item{file}{names the file to which LaTeX commands should be written}
+ \item{envir}{a string, the LaTeX environment name; default is
+ \code{"tabular"}; useful maybe \code{"array"}, or other versions of
+ tabular environments.}
+ \item{nam.center}{character specifying row names should be center;
+ default \code{"l"}.}
+ \item{col.center}{character (vector) specifying how the columns should
+ be centered; must have values from \code{c("l","c","r")}; defaults
+ to \code{"c"}.}
+ \item{append}{logical; if \code{FALSE}, will destroy the file
+ \code{file} before writing commands to it; otherwise (by default),
+ simply adds commands at the end of file \code{file}.}
+ \item{digits}{integer; setting of \code{\link{options}(digits=..)} for
+ purpose of number representation.}
+ \item{title}{a string, possibly using LaTeX commands, which will span
+ the columns of the LaTeX matrix}
+}
+\description{
+ \dQuote{Translate} an \R matrix (like object) into a LaTeX table,
+ using \code{\\begin{tabular} ...}.
+}
+\value{
+ No value is returned. This function, when used correctly,
+ only writes LaTeX commands to a file.
+}
+\author{For S: Vincent Carey \email{vjcarey at sphunix.sph.jhu.edu}, from a
+ post on Feb.19, 1991 to S-news. Port to \R (and a bit more) by
+ Martin Maechler \email{maechler at stat.math.ethz.ch}.
+}
+\seealso{
+ \code{\link[Hmisc]{latex}} in package \pkg{Hmisc} is more flexible
+ (but may surprise by its auto-printing ..).
+}
+\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, title="$\\\\pi, e$, etc." )% double-esc -> 4 x backslash
+
+## The last command produces the file "mat.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"))
+}
+\keyword{interface} % to latex
+\keyword{utilities}
+%%
+%% From: vjcarey at sphunix.sph.jhu.edu (Vincent J. Carey)
+%% Subject: mat2tex, a report generation aid (LONG)
+%% To: s-news at stat.wisc.edu
+%% Date: Tue, 19 Feb 91 19:25:05 EST
+%%
+%% Has there been any work on "report generation" from S
+%% beyond the tbl() function? I have been manually
+%% transcribing S matrix elements to LaTeX tables
+%% and find this to be a tedious and error-prone process.
+%% Certainly there are ways of cutting and pasting window
+%% contents to reduce the troubles associated with digit
+%% keying, but this is far from foolproof, and is also
+%% pretty dull.
+%%
+%% Therefore I offer this function, mat2tex(), which
+%% produces LaTeX commands to format the entries of
+%% an S matrix. The function will, by default, place
+%% the commands in the file "mat.tex".
+%%
+%% The documentation file included is fairly explicit. The
+%% function does not produce a complete LaTeX program, but
+%% a fragment "containing" a matrix. Column and row labels
+%% (which may include references to special LaTeX symbols,
+%% provided backslash protection is maintained) are propagated
+%% to the LaTeX fragment. There is a provision for a matrix "title".
+%%
+%% Unadulterated output of a simple example (see the doc page
+%% for the input):
+%%
+%% \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}
+%%
+%% Further work needed: digit/decimal-point alignment,
+%% consistent boxing of the title, more arguments to allow
+%% sensible customization -- e.g., the user may not desire
+%% \hline between rows. Comments, criticism and enhancements
+%% are welcome.
+%%
+%% -------------------------------------------------------------------------
+%%
+%% Vincent J. Carey
+%% Department of Biostatistics
+%% Johns Hopkins School of Public Health
+%%
+%% vjcarey at sphunix.sph.jhu.edu
diff --git a/man/missingCh.Rd b/man/missingCh.Rd
new file mode 100644
index 0000000..72759ab
--- /dev/null
+++ b/man/missingCh.Rd
@@ -0,0 +1,54 @@
+\name{missingCh}
+\alias{missingCh}
+\title{Has a Formal Argument been Set or is it Missing?}
+\description{
+ \code{missingCh} can be used to test whether a value was specified
+ as an argument to a function. Very much related to the standard \R
+ function \code{\link{missing}}, here the argument is given by its
+ name, a character string.
+
+ As \code{missingCh()} calls \code{missing()}, do consider the
+ caveats about the latter, see \code{\link{missing}}.
+}
+\usage{
+missingCh(x, envir = parent.frame())
+}
+\arguments{
+ \item{x}{a \code{\link{character}} string.}
+ \item{envir}{a (function evaluation) \code{\link{environment}}, in which
+ the variable named \code{x} is to be \dQuote{missing}.}
+}
+\value{
+ a \code{\link{logical}} indicating if the argument named \code{x} is
+ \code{\link{missing}} in the function \dQuote{above}, typically the
+ caller of \code{missingCh}, but see the use of \code{envir} in the
+ \code{vapply} example.
+}
+\author{Martin Maechler}
+\seealso{
+ \code{\link{missing}}
+}
+\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
+tst1(,3,,3)
+## 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()
+## TRUE ... TRUE -- as all are missing()
+Tst(1,,3)
+## 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
+}
+\keyword{programming}
diff --git a/man/mpl.Rd b/man/mpl.Rd
new file mode 100644
index 0000000..d9c368b
--- /dev/null
+++ b/man/mpl.Rd
@@ -0,0 +1,35 @@
+\name{mpl}
+\alias{mpl}
+\alias{p.m}
+\title{Simple Matrix Plots}
+\description{
+ Do simple matrix plots, providing an easy interface to
+ \code{\link{matplot}} by using a default x variable.
+}
+\usage{
+mpl(mat, \dots)
+p.m(mat, \dots)
+}
+\arguments{
+ \item{mat}{numeric matrix.}
+ \item{\dots}{further arguments passed to \code{\link{matplot}},
+ e.g., \code{type}, \code{xlab}, etc.}
+}
+\details{
+ \code{p.m(m)} use the first column of \code{m} as \eqn{x} variable,
+ whereas \code{mpl(m)} uses the integers 1, 2, \ldots, \code{nrow(m)}
+ as coordinates and \code{rownames(m)} as axis labels if possible.
+}
+\note{These were really created for playing around with curves etc, and
+ probably should be \emph{deprecated} since in concrete examples, using
+ \code{matplot()} directly is more appropriate.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{matplot}},
+ \code{\link{plot.mts}(*, plot.type = "single")}.}
+\examples{
+data(animals, package = "cluster")
+mpl(animals, type = "l")
+}
+\keyword{hplot}
+\keyword{array}
diff --git a/man/mult.fig.Rd b/man/mult.fig.Rd
new file mode 100644
index 0000000..a9a6473
--- /dev/null
+++ b/man/mult.fig.Rd
@@ -0,0 +1,67 @@
+\name{mult.fig}
+\alias{mult.fig}
+\title{Plot Setup for MULTiple FIGures, incl. Main Title}
+\description{
+ Easy Setup for plotting multiple figures (in a rectangular layout) on
+ one page. It allows to specify a main title and uses \emph{smart}
+ defaults for several \code{\link{par}} calls.
+}
+\usage{
+mult.fig(nr.plots, mfrow, mfcol, marP = rep(0, 4),
+ mgp = c(if(par("las") != 0) 2. else 1.5, 0.6, 0),
+ mar = marP + 0.1 + c(4,4,2,1), oma = c(0,0, tit.wid, 0),
+ main = NULL,
+ tit.wid = if (is.null(main)) 0 else 1 + 1.5*cex.main,
+ cex.main = par("cex.main"), line.main = cex.main - 1/2,
+ col.main = par("col.main"), font.main = par("font.main"), \dots)
+}
+\arguments{
+ \item{nr.plots}{integer; the number of plot figures you'll want to draw.}
+ \item{mfrow, mfcol}{\emph{instead} of \code{nr.plots}: integer(2) vectors
+ giving the rectangular figure layout for \code{\link{par}(mfrow = *)},
+ or \code{\link{par}(mfcol=*)}, respectively. The default is to use
+ \code{mfrow = \link{n2mfrow}(nr.plots)}.}
+ \item{marP}{numeric(4) vector of figure margins to \emph{add}
+ (\dQuote{\bold{P}lus}) to default \code{mar}, see below.}
+ \item{mgp}{argument for \code{\link{par}(mpg= .)} with a smaller
+ default than usual.}
+ \item{mar}{argument for \code{\link{par}(mar= .)} with a smaller
+ default than usual, using the \code{marP} argument, see above.}
+ \item{oma}{argument for \code{\link{par}(oma= .)}, by default for
+ adding space for the \code{main} title if necessary.}
+ \item{main}{character. The main title to be used for the whole graphic.}
+ \item{tit.wid}{numeric specifying the vertical width to be used for the
+ main title; note that this is only used for the default value of
+ \code{oma} (s. above).}
+ \item{cex.main}{numeric; the character size to be used for the main title.}
+ \item{line.main}{numeric; the margin line at which the title is written
+ (via \code{\link{mtext}(main, side=3, outer=TRUE, line = line.main, ....)}).}
+ \item{col.main, font.main}{color and font for main title, passed to
+ \code{\link{mtext}()}, see also \code{\link{par}(*)}.}
+ \item{\dots}{further arguments to \code{\link{mtext}} for the main title.}
+}
+\value{
+ A \code{\link{list}} with two components that are lists themselves, a
+ subset of \code{\link{par}()},
+ \item{new.par}{the current \code{par} settings.}
+ \item{old.par}{the \code{par} \emph{before} the call.}
+}
+\author{Martin Maechler, UW Seattle, 1990 (for \command{S}).}
+\seealso{\code{\link{par}}, \code{\link{layout}}.}
+\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)
+par(rr$old.par)
+## The *restored* par settings:
+str(do.call("par", as.list(names(rr$new.par))))
+}
+\keyword{hplot}
diff --git a/man/n.code.Rd b/man/n.code.Rd
new file mode 100644
index 0000000..7c501c3
--- /dev/null
+++ b/man/n.code.Rd
@@ -0,0 +1,42 @@
+\name{n.code}
+\alias{n.code}
+\alias{code2n}
+\title{Convert "Round" Integers to Short Strings and Back}
+\description{
+ \code{n.code} convert \dQuote{round integers} to short character strings.
+ This is useful to build up variable names in simulations, e.g.
+
+ \code{code2n} is the \emph{inverse} function of \code{n.code()}.
+}
+\usage{
+n.code(n, ndig = 1, dec.codes = c("", "d", "c", "k"))
+code2n(ncod, ndig = 1, dec.codes = c("", "d", "c", "k"))
+}
+\arguments{
+ \item{n}{integer vector.}
+ \item{ncod}{character vector, typically resulting from
+ \code{n.code}.}
+ \item{ndig}{integer giving number of digits before the coding character.}
+ \item{dec.codes}{character code for 1, 10, 100, 1000 (etc).}
+}
+% \details{
+% ~~ If necessary, more details than the __description__ above ~~
+% }
+\value{
+ \code{n.code(n)} returns a \code{\link{character}} vector of the same
+ length as \code{n}.
+
+ \code{code2n(ncod)} returns a \code{\link{integer}} vector of the same
+ length as \code{ncod}.
+
+ Usually, \code{code2n(n.code(n)) == n}.
+}
+\author{Martin Maechler}
+%\seealso{ ..}
+\examples{
+n10 <- c(10,20,90, 100,500, 2000,10000)
+(c10 <- n.code(n10))#-> "1d" "2d" "9d" "1c" ..
+stopifnot(code2n(c10) == n10)
+}
+\keyword{utilities}
+
diff --git a/man/n.plot.Rd b/man/n.plot.Rd
new file mode 100644
index 0000000..78fb1a2
--- /dev/null
+++ b/man/n.plot.Rd
@@ -0,0 +1,43 @@
+\name{n.plot}
+\alias{n.plot}
+\title{Name Plot: Names or Numbers instead of Points in Plot}
+\description{
+ A utility function which basically calls \code{\link{plot}(*, type="n")}
+ and \code{\link{text}}. To have names or numbers instead of points
+ in a plot is useful for identifaction, e.g., in a residual plot, see
+ also \code{\link{TA.plot}}.
+}
+\usage{
+n.plot(x, y = NULL, nam = NULL, abbr = n >= 20 || max(nchar(nam))>=8,
+ xlab = NULL, ylab = NULL, log = "",
+ cex = par("cex"), col = par("col"), \dots)
+}
+\arguments{
+ \item{x,y}{coordinates at which to plot. If \code{y} is missing,
+ \code{x} is used for both, if it's a \code{\link{data.frame},
+ \link{list}}, 2-column matrix etc -- via \code{\link{xy.coords}};
+ formula do \bold{not} work.}
+ \item{nam}{the labels to plot at each (x,y). Per default, these
+ taken from the data \code{x} and \code{y}; case numbers \code{1:n}
+ are taken if no names are available.}
+ \item{abbr}{logical indicating if the \code{nam} labels should be
+ abbreviated -- with a sensible default.}
+ \item{xlab,ylab}{labels for the x- and y- axis, the latter being empty
+ by default.}
+ \item{log}{character specifying if log scaled axes should be used, see
+ \code{\link{plot.default}}.}
+ \item{cex}{plotting character expansion, see \code{\link{par}}.}
+ \item{col}{color to use for \code{\link{text}()}.}
+ \item{\dots}{further arguments to be passed to the \code{\link{plot}} call.}
+}
+\value{
+ invisibly, a character vector with the labels used.
+}
+\author{Martin Maechler, since 1992}
+\seealso{\code{\link{plot.default}}, \code{\link{text}}.}
+\examples{
+ n.plot(1:20, cumsum(rnorm(20)))
+ data(cars)
+ with(cars, n.plot(speed, dist, cex = 0.8, col = "forest green"))
+}
+\keyword{hplot}
diff --git a/man/nearcor.Rd b/man/nearcor.Rd
new file mode 100644
index 0000000..597823e
--- /dev/null
+++ b/man/nearcor.Rd
@@ -0,0 +1,128 @@
+% Copyright (2007) Jens Oehlschl�gel
+% GPL licence, no warranty, use at your own risk
+% Copyright (2007-2010) Martin Maechler
+\name{nearcor}
+\alias{nearcor}
+\encoding{latin1}
+\title{Find the Nearest Proper Correlation Matrix}
+\description{
+ This function \dQuote{smoothes} an improper correlation matrix as it can result
+ from \code{\link{cor}} with \code{use="pairwise.complete.obs"} or
+ \code{\link[polycor]{hetcor}}.
+
+ It is \emph{deprecated} now, in favor of
+ \code{\link[Matrix]{nearPD}()} from package \pkg{Matrix}.% 2013-01-16
+}
+\usage{
+nearcor(R, eig.tol = 1e-06, conv.tol = 1e-07, posd.tol = 1e-08,
+ maxits = 100, verbose = FALSE)
+}
+\arguments{
+ \item{R}{a square symmetric approximate correlation matrix}
+ \item{eig.tol}{defines relative positiveness of eigenvalues compared
+ to largest, default=1.0e-6.}
+ \item{conv.tol}{convergence tolerance for algorithm, default=1.0e-7 }
+ \item{posd.tol}{tolerance for enforcing positive definiteness, default=1.0e-8}
+ \item{maxits}{maximum number of iterations}
+ \item{verbose}{logical specifying if convergence monitoring should be
+ verbose.}
+}
+\details{
+ This implements the algorithm of Higham (2002), then forces symmetry,
+ then forces positive definiteness using code from
+ \code{\link[sfsmisc]{posdefify}}. This implementation does not make
+ use of direct LAPACK access for tuning purposes as in the MATLAB code
+ of Lucas (2001). The algorithm of Knol DL and ten Berge (1989) (not
+ implemented here) is more general in (1) that it allows contraints to
+ fix some rows (and columns) of the matrix and (2) to force the
+ smallest eigenvalue to have a certain value.
+}
+\value{
+ A \code{\link{list}}, with components
+ \item{cor}{resulting correlation matrix}
+ \item{fnorm}{Froebenius norm of difference of input and output}
+ \item{iterations}{number of iterations used}
+ \item{converged}{logical}
+}
+\references{See those in \code{\link[sfsmisc]{posdefify}}.
+}
+\author{ Jens Oehlschl�gel }
+\seealso{the slightly more flexible \code{\link[Matrix]{nearPD}} which also
+ returns a \emph{classed} matrix (class \code{dpoMatrix}).
+ For new code, \code{nearPD()} is really preferred to \code{nearcor()},
+ which hence is considered deprecated.
+
+ \code{\link[polycor]{hetcor}}, \code{\link{eigen}};
+ \code{\link[sfsmisc]{posdefify}} for a simpler algorithm.
+}
+\examples{
+ cat("pr is the example matrix used in Knol DL, ten Berge (1989)\n")
+ 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
+ \dontshow{
+ 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)))
+ }
+ plot(pr[lower.tri(pr)],
+ nr[lower.tri(nr)]); abline(0,1, lty=2)
+ round(cbind(eigen(pr)$values, eigen(nr)$values), 8)
+
+ cat("The following will fail:\n")
+ try(factanal(cov=pr, factors=2))
+ cat("and this should work\n")
+ try(factanal(cov=nr, factors=2))
+
+ 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))
+ }
+}
+\keyword{algebra}
+\keyword{array}
diff --git a/man/nr.sign.chg.Rd b/man/nr.sign.chg.Rd
new file mode 100644
index 0000000..7c306c9
--- /dev/null
+++ b/man/nr.sign.chg.Rd
@@ -0,0 +1,22 @@
+\name{nr.sign.chg}
+\alias{nr.sign.chg}
+\title{Number of Sign Changes in Sequence}
+\description{
+ Compute the number of sign changes in the sequence \code{y}.
+}
+\usage{
+nr.sign.chg(y)
+}
+\arguments{
+ \item{y}{numeric vector.}
+}
+\value{
+ an integer giving the number of sign changes in sequence \code{y}.
+ Note that going from positive to 0 to positive is \emph{not} a sign change.
+}
+\author{Martin Maechler, 17 Feb 1993.}
+\examples{
+(y <- c(1:2,1:-1,0:-2))
+nr.sign.chg(y)## = 1
+}
+\keyword{arith}
diff --git a/man/p.arrows.Rd b/man/p.arrows.Rd
new file mode 100644
index 0000000..908f3db
--- /dev/null
+++ b/man/p.arrows.Rd
@@ -0,0 +1,27 @@
+\name{p.arrows}
+\alias{p.arrows}
+\title{Prettified Arrows Plots}
+\description{
+ Draws arrows, like the \code{\link{arrows}} function, but with
+ \dQuote{nice} \emph{filled} arrow heads.
+}
+\usage{
+p.arrows(x1, y1, x2, y2, size = 1, width, fill = 2, ...)
+}
+\arguments{
+ \item{x1, y1}{coordinates of points \bold{from} which to draw.}
+ \item{x2, y2}{coordinates of points \bold{to} which to draw.}
+ \item{size}{symbol size as a fraction of a character height; default 1.}
+ \item{width}{width of the arrow head; defaults to ....}%fixme (code => ??)
+ \item{fill}{color for filling the arrow head.}
+ \item{\dots}{further arguments passed to \code{\link{segments}()}.}
+}
+\author{Andreas Ruckstuhl, 19 May 1994; (cosmetic by MM).}
+\seealso{\code{\link{arrows}}.}
+\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")
+}
+\keyword{aplot}
+
diff --git a/man/p.datum.Rd b/man/p.datum.Rd
new file mode 100644
index 0000000..a5afafd
--- /dev/null
+++ b/man/p.datum.Rd
@@ -0,0 +1,21 @@
+\name{p.datum}
+\alias{p.datum}
+\title{Plot 'Datum' (deutsch!) unten rechts}
+\description{
+ Plot the date (and time, if required) in German, at the lower right hand
+ margin of your plot.date
+}
+\usage{
+p.datum(outer = FALSE, cex = 0.75, ...)
+}
+\arguments{
+ \item{outer}{logical; passed to \code{\link{mtext}}.}
+ \item{cex}{non-negative; passed to \code{\link{mtext}}.}
+ \item{\dots}{any arguments to \code{\link{u.Datumvonheute}}.}
+}
+\seealso{\code{\link{u.date}}, \code{\link{date}}.}
+\examples{
+plot(1)
+p.datum()
+}
+\keyword{hplot}%-- one or more ...
diff --git a/man/p.dnorm.Rd b/man/p.dnorm.Rd
new file mode 100644
index 0000000..8fc0e8b
--- /dev/null
+++ b/man/p.dnorm.Rd
@@ -0,0 +1,47 @@
+\name{p.dnorm}
+\alias{p.dnorm}
+\alias{p.dchisq}
+\alias{p.dgamma}
+\title{Plot Parametric Density Functions}
+\description{
+ These are utilities for pretty plotting of often used parametric
+ densities.
+}
+\usage{
+p.dnorm (mu = 0, s = 1, h0.col = "light gray",
+ ms.lines = TRUE, ms.col = "gray", ...)
+p.dchisq(nu, h0.col = "light gray", ...)
+p.dgamma(shape, h0.col = "light gray", ...)
+}
+\arguments{
+ \item{mu,s}{numbers, the mean and standard deviation of the normal
+ distribution.}
+ \item{nu}{positive number, the degrees of freedom \code{df} argument
+ for the \eqn{\chi^2}{chi^2}-density function \code{\link{dchisq}}.}
+ \item{shape}{number, the \code{shape} parameter for the Gamma
+ distribution.}
+ \item{h0.col}{color specification for the line \eqn{y = 0}.}
+ \item{ms.lines}{logical, used for the normal only: should lines be
+ drawn at the mean and \eqn{\pm}{+-} 1 standard deviation.}
+ \item{ms.col}{color for the \code{ms} lines if \code{ms.lines} is TRUE.}
+ \item{\dots}{further parameter passed to \code{\link{curve}()}, e.g.,
+ \code{add = TRUE} for adding to current plot.}
+}
+\author{Werner Stahel et al.}
+\seealso{the underlying density functions,
+ \code{\link{dnorm}}, \code{\link{dchisq}}, \code{\link{dgamma}}.}
+\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)
+}
+\keyword{hplot}
+\keyword{utilities}
diff --git a/man/p.hboxp.Rd b/man/p.hboxp.Rd
new file mode 100644
index 0000000..6e5d0b9
--- /dev/null
+++ b/man/p.hboxp.Rd
@@ -0,0 +1,33 @@
+\name{p.hboxp}
+\alias{p.hboxp}
+\title{Add a Horizontal Boxplot to the Current Plot}
+\description{
+ Add a horizontal boxplot to the current plot. This is mainly an
+ auxiliary function for \code{\link{histBxp}}, since
+ \code{\link{boxplot}(*, horizontal = TRUE, add = TRUE)} is usually
+ much preferable to this.
+}
+\usage{
+p.hboxp(x, y.lo, y.hi, boxcol = 3,
+ medcol = 2, medlwd = 5, whisklty = 2, staplelty = 1)
+}
+\arguments{
+ \item{x}{univariate data set.}
+ \item{y.lo, y.hi}{minimal and maximal \emph{user} coordinates
+ \bold{or} \code{y.lo = c(ylo,hyi)}.}
+ \item{boxcol, medcol}{color of the box and the median line.}
+ \item{medlwd}{line width of median line.}
+ \item{whisklty, staplelty}{line types of the whisker and the staple,
+ the latter being used for the outmost non-outliers.}
+}
+\details{
+....
+}
+\author{Martin Maechler building on code from Markus and Christian Keller.}
+\seealso{\code{\link{boxplot}(**, horizontal = TRUE, add= TRUE)}.}
+\examples{
+%% FIXME: add!
+ ## ==> See code in 'histBxp' (.) and example(histBxp) !
+ ##
+}
+\keyword{aplot}
diff --git a/man/p.profileTraces.Rd b/man/p.profileTraces.Rd
new file mode 100644
index 0000000..47e51a8
--- /dev/null
+++ b/man/p.profileTraces.Rd
@@ -0,0 +1,48 @@
+\name{p.profileTraces}
+\encoding{latin1}
+\alias{p.profileTraces}
+\title{Plot a profile.nls Object With Profile Traces}
+\description{
+ Displays a series of plots of the profile t function and the likelihood
+ profile traces for the parameters in a nonlinear regression model that
+ has been fitted with \code{\link{nls}} and profiled with
+ \code{\link{profile.nls}}.
+}
+\usage{
+p.profileTraces(x, cex = 1,
+ subtitle = paste("t-Profiles and traces of ",
+ deparse(attr(x,"summary")$formula)))
+}
+\arguments{
+ \item{x}{an object of class \code{"profile.nls"}, typically resulting from
+ \code{profile(\link[stats]{nls}(.))}, see
+ \code{\link[stats]{profile.nls}}.}
+ \item{cex}{character expansion, see \code{\link{par}(cex =)}.}
+ \item{subtitle}{a subtitle to set for the plot. The default now
+ includes the \code{\link{nls}()} formula used.}
+}
+%- \details{
+% .........
+%- }
+\author{Andreas Ruckstuhl, \R port by Isabelle Fl�ckiger and Marcel Wolbers}
+\note{the \pkg{stats}-internal \code{stats:::plot.profile.nls} plot
+ method just does \dQuote{the diagonals}.
+}
+\seealso{\code{\link{profile}}, and \code{\link{nls}} (which has
+ unexported \code{profile} and \code{stats:::plot.profile.nls} methods).
+}
+\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..
+op <- par(mfcol=1:2)
+plot(pr) # -> 2 'standard' plots
+par(op)
+## ours:
+p.profileTraces(pr)
+}
+\keyword{hplot}
+\keyword{nonlinear}
diff --git a/man/p.res.2fact.Rd b/man/p.res.2fact.Rd
new file mode 100644
index 0000000..8215fdd
--- /dev/null
+++ b/man/p.res.2fact.Rd
@@ -0,0 +1,56 @@
+\name{p.res.2fact}
+\alias{p.res.2fact}
+\title{Plot Numeric (e.g. Residuals) vs 2 Factors Using Boxplots}
+\description{
+ Plots a numeric \dQuote{residual like} variable against two factor
+ covariates, using boxplots.
+}
+\usage{
+p.res.2fact(x, y, z, restricted, notch = FALSE,
+ xlab = NULL, ylab = NULL, main = NULL)
+}
+\arguments{
+ \item{x,y}{two factors or numeric vectors giving the levels of factors.}
+ \item{z}{numeric vector of same length as \code{x} and \code{y},
+ typically residuals.}
+ \item{restricted}{positive value which truncates the size. The
+ corresponding symbols are marked by stars.}
+ \item{notch}{logical indicating if the boxplots should be notched, see
+ \code{\link{boxplot}(*,notch)}.}
+ \item{xlab,ylab}{axis labels, see \code{\link{plot.default}}, per
+ default the actual argument expressions.}
+ \item{main}{main title passed to \code{plot}, defaulting to the
+ deparsed \code{z} argument.}
+}
+\details{
+ if values \emph{are} restricted, this make use of the auxiliar
+ function \code{\link{u.boxplot.x}}.
+}
+\author{Lorenz Gygax \email{logyg at wild.unizh.ch} and Martin Maechler, Jan.95;
+ starting from \code{\link{p.res.2x}()}.
+}
+\seealso{\code{\link{p.res.2x}}, \code{\link{boxplot}},
+ \code{\link{plot.lm}}, \code{\link{TA.plot}}.
+}
+\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")
+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 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)
+}
+\keyword{hplot}
+\keyword{regression}
diff --git a/man/p.res.2x.Rd b/man/p.res.2x.Rd
new file mode 100644
index 0000000..9b053b2
--- /dev/null
+++ b/man/p.res.2x.Rd
@@ -0,0 +1,83 @@
+\name{p.res.2x}
+\title{Stahel's Residual Plot against 2 X's}
+\alias{p.res.2x}
+\alias{p.res.2x.default}
+\alias{p.res.2x.formula}
+\description{
+ Plot Residuals (e.g., of a multiple linear regression) against two
+ (predictor) variables. This is now a (S3) \emph{generic} function
+ with a \code{default} and a \code{\link{formula}} method.
+}
+\usage{
+p.res.2x(x, \dots)
+
+\S3method{p.res.2x}{default}(x, y, z, restricted, size = 1, slwd = 1, scol = 2:3,
+ xlab = NULL, ylab = NULL, main = NULL,
+ xlim = range(x), ylim = range(y), \dots)
+
+\S3method{p.res.2x}{formula}(x = ~., data, main = deparse(substitute(data)),
+ xlab = NULL, ylab = NULL, \dots)
+}
+\arguments{
+ \item{x, y}{numeric vectors of the same length specifying 2
+ covariates. For the \code{formula} method, \code{x} is a \code{\link{formula}}.}
+ \item{z}{numeric vector of same length as \code{x} and \code{y},
+ typically residuals.}
+ \item{restricted}{positive value which truncates the size. The
+ corresponding symbols are marked by stars.}
+ \item{size}{the symbols are scaled so that \code{size} is the size of
+ the largest symbol in cm.}
+ \item{slwd, scol}{line width and color(s) for the residual
+ \code{\link{segments}}. If \code{scol} has length 2 as per default,
+ the two colors are used for positive and negative \code{z} values,
+ respectively.}
+ \item{xlab, ylab, main}{axis labels, and title see \code{\link{title}},
+ each with a sensible default. To suppress, use, e.g., \code{main = ""}.}
+ \item{xlim, ylim}{the basic x- and y- axis extents, see
+ \code{\link{plot.default}}. Note that these will be slightly
+ extended such that segments are not cut off.}
+ \item{\dots}{further arguments passed to \code{plot}, or
+ \code{p.res.2x.default()}, respectively.}
+
+ \item{data}{(for the \code{\link{formula}} method:) a data frame or a fitted
+ \code{"\link{lm}"} object.}
+}
+\details{
+ The formula interface will call \code{\link{p.res.2fact}()} when
+ \emph{both} \code{x} and \code{y} are \code{\link{factor}}s.
+
+ ...........
+ ..........
+}
+\references{Stahel, W. (1996) ........}
+\author{Andreas Ruckstuhl in June 1991 and
+ Martin Maechler, in 1992, '94, 2003-4.}
+\seealso{\code{\link{p.res.2fact}},
+ \code{\link{plot.lm}},
+ \code{\link{TA.plot}}.
+}
+\examples{
+xx <- rep(1:10,7)
+yy <- rep(1:7, rep(10,7))
+zz <- rnorm(70)
+p.res.2x(xx,yy,zz, restr = 2, main = "i.i.d. N(0,1) random residuals")
+\dontshow{
+ p.res.2x(xx,yy,zz, restr = 2, main = "p.res.2x(*, xlim, ylim)",
+ xlim = c(2,8), ylim = c(1,4))
+}
+example(lm.influence, echo = FALSE)
+
+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
+}
+\keyword{hplot}
+\keyword{regression}
diff --git a/man/p.scales.Rd b/man/p.scales.Rd
new file mode 100644
index 0000000..82082b5
--- /dev/null
+++ b/man/p.scales.Rd
@@ -0,0 +1,27 @@
+\name{p.scales}
+\alias{p.scales}
+\title{Conversion between plotting scales: usr, cm, symbol}
+\description{
+ Give scale conversion factors of three coordinate systems in use for
+ traditional R graphics: use, cm, symbol.
+}
+\usage{
+p.scales(unit = relsysize * 2.54 * min(pin), relsysize = 0.05)
+}
+\arguments{
+ \item{unit}{length of unit (or x and y units) of symbol coordinates in cm.}
+ \item{relsysize}{same, as a proportion of the plotting area.}
+}
+\value{
+ A numeric 2x2 matrix, with rows named \code{x} and \code{y}, and
+ columns, named \code{"sy2usr"} and \code{"usr2cm"} which give the
+ scale conversion factors from \sQuote{symbol} (as given) to
+ \sQuote{usr} coordinates and from these to \sQuote{cm}, respectively.
+}
+\author{Werner Stahel, 1990; simplification: M.Maechler, 1993, 2004}
+\seealso{\code{\link{par}("usr")}, of also \code{("pin")} on which this
+ is based.}
+\examples{
+p.scales()
+}
+\keyword{dplot}
diff --git a/man/p.tachoPlot.Rd b/man/p.tachoPlot.Rd
new file mode 100644
index 0000000..833f32e
--- /dev/null
+++ b/man/p.tachoPlot.Rd
@@ -0,0 +1,66 @@
+\name{p.tachoPlot}
+\alias{p.tachoPlot}
+\title{Draw Symbol on a Plot}
+\description{
+Puts a symbol (pointer) on a plot at each of the specified locations.
+}
+\usage{
+p.tachoPlot(x, y, z, angle=c(pi/4,3*pi/4), size,
+ method = c("robust", "sensitive", "rank"),
+ legend = TRUE, show.method = legend,
+ xlab = deparse(substitute(x)), ylab = deparse(substitute(y)),
+ xlim, ylim, \dots)
+}
+\arguments{
+ \item{x,y,z}{coordinates of points. Numeric vectors of the same length.
+ Missing values (\code{NA}s) are allowed.}
+ \item{angle}{numeric vector whose elements give the angles between the
+ horizontal baseline and the minimum and maximum direction of the
+ pointer measured clockwise in radians.}
+ \item{size}{length of the pointers in cm.}
+ \item{method}{string specifying the method to calculate the angle of
+ the pointer. One of \code{"sensitive"}, \code{"robust"} or
+ \code{"rank"}. Only the first two characters are necessary.
+
+ The minimum and maximum direction of the pointer corresponds to
+ min(z) and max(z) if method is \code{"sensitive"} or \code{"rank"}
+ and to the upper and lower extreme of z if method is \code{"robust"}
+ (see \code{boxplot} or \code{rrange} for details). The angle is
+ proportional to z or rank(z) in case of \code{method="rank"}.
+ }
+ \item{legend}{logical flag: if \code{TRUE} (default), a legend giving
+ the values of the minimum and maximum direction of the pointer is drawn.}
+ \item{show.method}{logical flag, defaulting to \code{legend}; if true,
+ the method name is printed.}
+ \item{xlab,ylab}{labels for x and y axis; defaults to the
+ \sQuote{expression} used in the function call.}
+ \item{xlim,ylim}{numeric of length 2, the limits for the x and y axis,
+ respectively; see \code{\link{plot.default}}.}
+ \item{\dots}{further arguments to \code{\link{plot}}. Graphical
+ parameters (see \code{\link{par}}) may also be supplied as arguments
+ to this function.}
+}
+\section{Side Effects}{
+ A plot is created on the current graphics device.
+}
+\details{
+ A scatter plot of the variables x and y is plotted. The value of the third
+ variable z is given by the direction of a pointer (similar to a
+ tachometer). Observations whose z-coordinate is missing are marked by a dot.
+}
+\author{Christian Keller, June 1995}
+\seealso{\code{\link{symbols}}}
+\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!)
+%% hence, IMPROVE the example !
+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")
+}
+\keyword{hplot}
diff --git a/man/p.ts.Rd b/man/p.ts.Rd
new file mode 100644
index 0000000..6bea671
--- /dev/null
+++ b/man/p.ts.Rd
@@ -0,0 +1,73 @@
+\name{p.ts}
+\alias{p.ts}
+\title{plot.ts with multi-plots and Auto-Title -- on 1 page}
+\description{
+ For longer time-series, it is sometimes important to spread the
+ time-series plots over several subplots.
+ p.ts(.) does this both automatically, and under manual control.
+
+ Actually, this is a generalization of \code{\link{plot.ts}}
+ (with different defaults).
+}
+\usage{
+p.ts(x, nrplots = max(1, min(8, n \%/\% 400)), overlap = nk \%/\% 16,
+ date.x = NULL, do.x.axis = !is.null(date.x), do.x.rug = FALSE,
+ ax.format, main.tit = NULL, ylim = NULL, ylab = "", xlab = "Time",
+ quiet = FALSE, mgp = c(1.25, .5, 0), \dots)
+}
+\arguments{
+ \item{x}{timeseries (possibly multivariate) or numeric vector.}
+ \item{nrplots}{number of sub-plots. Default: in \{1..8\},
+ approximately \code{n/400} if possible.}
+ \item{overlap}{by how much should subsequent plots overlap. Defaults
+ to about 1/16 of sub-length on each side.}
+ \item{date.x}{a time \dQuote{vector} of the same length as \code{x}
+ and coercable to class \code{"POSIXct"} (see \link{DateTimeClasses}).}
+ \item{do.x.axis}{logical specifying if an x axis should be drawn
+ (i.e., tick marks and labels).}
+ \item{do.x.rug}{logical specifying if \code{\link{rug}} of
+ \code{date.x} values should drawn along the x axis.}
+ \item{ax.format}{when \code{do.x.axis} is true, specify the
+ \code{format} to be used in the call to \code{\link{axis.POSIXct}}.}
+ \item{main.tit}{\bold{Main} title (over all plots). Defaults to name
+ of \code{x}.}
+ \item{ylim}{numeric(2) or NULL; if the former, specifying the y-range
+ for the plots. Defaults to a common pretty range.}
+ \item{ylab, xlab}{labels for y- and x-axis respectively, see
+ description in \code{\link{plot.default}}.}
+ \item{quiet}{logical; if \code{TRUE}, there's no reporting on each subplot.}
+ \item{mgp}{numeric(3) to be passed to \code{\link{mult.fig}()}, see
+ \code{\link{par}(mgp = .)}.}
+ \item{\dots}{further graphic parameters for each \code{\link{plot.ts}(..)}.}
+}
+\section{Side Effects}{
+ A page of \code{nrplots} subplots is drawn on the current
+ graphics device.
+}
+\author{Martin Maechler, \email{maechler at stat.math.ethz.ch}; July 1994 (for S).}
+\seealso{\code{p.ts()} calls \code{\link{mult.fig}()} for setup.
+ Further, \code{\link{plot.ts}} and \code{\link{plot}}.
+}
+\examples{
+stopifnot(require(stats))
+## stopifnot(require(datasets))
+
+data(sunspots)
+p.ts(sunspots, nr=1) # == usual plot.ts(..)
+p.ts(sunspots)
+p.ts(sunspots, nr=3, col=2)
+
+data(EuStockMarkets)
+p.ts(EuStockMarkets[,"SMI"])
+## multivariate :
+p.ts(log10(EuStockMarkets), col = 2:5)
+
+## 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)
+p.ts(z, 6, date.x = x, ax.format = "\%b \%Y", do.x.rug = TRUE)
+}
+\keyword{hplot}
+\keyword{ts}
diff --git a/man/paste.vec.Rd b/man/paste.vec.Rd
new file mode 100644
index 0000000..66802dd
--- /dev/null
+++ b/man/paste.vec.Rd
@@ -0,0 +1,25 @@
+\name{paste.vec}
+\alias{paste.vec}
+\title{Utility for 'Showing' S vectors}
+\description{
+ A simple utility for displaying simple S vectors;
+ can be used as debugging utility.
+}
+\usage{
+paste.vec(name, digits = options()$digits)
+}
+\arguments{
+ \item{name}{string with an variable name which must exist in the
+ current environment (\R session).}
+ \item{digits}{how many decimal digits to be used; passed to
+ \code{\link{format}}.}
+}
+\value{
+ a string of the form "NAME = x1 x2 ..."
+}
+\author{Martin Maechler, about 1992.}
+\examples{
+ x <- 1:4
+ paste.vec(x) ##-> "x = 1 2 3 4"
+}
+\keyword{utilities}
diff --git a/man/plotDS.Rd b/man/plotDS.Rd
new file mode 100644
index 0000000..7e739de
--- /dev/null
+++ b/man/plotDS.Rd
@@ -0,0 +1,81 @@
+\name{plotDS}
+\alias{plotDS}
+\title{Plot Data and Smoother / Fitted Values}
+\description{
+ For one-dimensional nonparametric regression, plot the data and fitted
+ values, typically a smooth function, and optionally use segments to
+ visualize the residuals.
+}
+\usage{
+plotDS(x, yd, ys, xlab = "", ylab = "", ylim = rrange(c(yd, ys)),
+ xpd = TRUE, do.seg = TRUE, seg.p = 0.95,
+ segP = list(lty = 2, lwd = 1, col = 2),
+ linP = list(lty = 1, lwd = 2.5, col = 3),
+ \dots)
+}
+\arguments{
+ \item{x, yd, ys}{numeric vectors all of the same length, representing
+ \eqn{(x_i, y_i)} and fitted (smooth) values \eqn{\hat{y}_i}{y^_i}.
+ \code{x} will be sorted increasingly if necessary, and \code{yd} and
+ \code{ys} accordingly.
+
+ Alternatively, \code{ys} can be an x-y list (as resulting from
+ \code{\link[grDevices]{xy.coords}}) containing fitted values on a
+ finer grid than the observations \code{x}. In that case, the
+ observational values \code{x[]} \bold{must} be part of the larger
+ set; \code{\link{seqXtend}()} may be applied to construct such a set
+ of abscissa values.
+ }
+ \item{xlab, ylab}{x- and y- axis labels, as in \code{\link{plot.default}}.}
+ \item{ylim}{limits of y-axis to be used; defaults to a \emph{robust}
+ range of the values.}
+ \item{xpd}{see \code{\link{par}(xpd=.)}; by default do allow to draw
+ outside the plot region.}
+ \item{do.seg}{logical indicating if residual segments should be drawn,
+ at \code{x[i]}, from \code{yd[i]} to \code{ys[i]} (approximately,
+ see \code{seg.p}).}
+ \item{seg.p}{segment percentage of segments to be drawn, from
+ \code{yd} to \code{seg.p*ys + (1-seg.p)*yd}.}
+ \item{segP}{list with named components \code{lty, lwd, col} specifying
+ line type, width and color for the residual segments,
+ used only when \code{do.seg} is true.}
+ \item{linP}{list with named components \code{lty, lwd, col} specifying
+ line type, width and color for \dQuote{smooth curve lines}.}
+ \item{\dots}{further arguments passed to \code{\link{plot}}.}
+}
+\author{Martin Maechler, since 1990}
+\note{Non-existing components in the lists \code{segP} or \code{linP}
+ will result in the \code{\link{par}} defaults to be used.
+
+ \code{plotDS()} used to be called \code{pl.ds} up to November 2007.
+}
+\seealso{\code{\link{seqXtend}()} to construct more smooth \code{ys}
+ \dQuote{objects}.
+}
+\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)))
+ plotDS(Th4$Time, Th4$conc, ys = list(x=xsm, y=ysm),
+ sub = "Theophylline data - Subject 4 only",
+ segP = list(lwd=2), las = 1)
+}
+\keyword{hplot}
diff --git a/man/plotStep.Rd b/man/plotStep.Rd
new file mode 100644
index 0000000..ddfc8a0
--- /dev/null
+++ b/man/plotStep.Rd
@@ -0,0 +1,72 @@
+% Originally /u/maechler/S/GRAPHICS/plot.step.d,v 1.2 1997/05/27 10:17:27
+% Copyright (c), 1991, 1997 Martin Maechler, Statistik, ETH Zurich
+% Martin Maechler <maechler at stat.math.ethz.ch>
+\name{plotStep}
+\encoding{latin1}
+\alias{plotStep}
+\title{Plot a Step Function}
+\description{
+ Plots a step function
+ f(x)= \eqn{\sum_i y_i 1_[ t_{i-1}, t_i ](x) }{sum(i; y[i] *
+ Ind[t[i-1], t[i])(x))}, i.e., a piecewise constant function of one variable.
+ With one argument, plots \bold{the} empirical cumulative distribution
+ function.
+}
+\usage{
+plotStep(ti, y,
+ cad.lag = TRUE,
+ verticals = !cad.lag,
+ left.points= cad.lag, right.points= FALSE, end.points= FALSE,
+ add = FALSE,
+ pch = par('pch'),
+ xlab=deparse(substitute(ti)), ylab=deparse(substitute(y)),
+ main=NULL, \dots)
+}
+\arguments{
+ \item{ti}{numeric vector = \code{X[1:N]} or \code{t[0:n]}.}
+ \item{y}{numeric vector \code{y[1:n]}; if omitted take y = k/N
+ for empirical CDF.}
+ \item{cad.lag}{logical: Draw 'cad.lag', i.e., \dQuote{\emph{continue �
+ droite, limite � gauche}}. Default = TRUE.}
+ \item{verticals}{logical: Draw vertical lines? Default= \code{! cad.lag}}
+ \item{left.points}{logical: Draw left points? Default= \code{cad.lag}}
+ \item{right.points}{logical: Draw right points? Default= \code{FALSE}}
+ \item{end.points}{logical: Draw 2 end points? Default= \code{FALSE}}
+ \item{add}{logical: Add to existing plot? Default= \code{FALSE}}
+ \item{pch}{plotting character for points, see \code{\link{par}()}.}
+ \item{xlab,ylab}{labels of x- and y-axis}
+ \item{main}{main title; defaults to the call' if you do not want a title,
+ use \code{main = ""}.}
+ \item{\dots}{Any valid argument to \code{\link{plot}(..)}.}
+}
+\value{
+ \bold{invisibly}: List with components \code{t} and \code{y}.
+}
+\section{Side Effects}{
+ Calls plot(..), points(..), segments(..) appropriately
+ and plots on current graphics device.
+}
+\author{Martin Maechler, Seminar for Statistics, ETH Zurich,
+ \email{maechler at stat.math.ethz.ch}, 1991 ff.
+}
+\seealso{
+ The \code{\link{plot}} methods \code{\link{plot.ecdf}} and
+ \code{\link{plot.stepfun}} in \R which are conceptually nicer.
+
+ \code{\link{segments}(\dots, method = "constant")}.
+}
+\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
+}
+\keyword{nonparametric}
+\keyword{hplot}
diff --git a/man/polyn.eval.Rd b/man/polyn.eval.Rd
new file mode 100644
index 0000000..77c5108
--- /dev/null
+++ b/man/polyn.eval.Rd
@@ -0,0 +1,38 @@
+\name{polyn.eval}
+\alias{polyn.eval}
+\title{Evaluate Polynomials}
+\description{
+ Evaluate one or several univariate polynomials at several locations,
+ i.e. compute \code{coef[1] + coef[2]*x + ... + coef[p+1]* x^p}
+ (in the simplest case where \code{x} is scalar and \code{coef} a vector).
+}
+\usage{
+polyn.eval(coef, x)
+}
+\arguments{
+ \item{coef}{numeric vector or matrix. If a vector, \code{x} can be an
+ array and the result matches \code{x}.\cr
+ If \code{coef} is a matrix it specifies several polynomials of the
+ same degree as rows, \code{x} must be a vector, \code{coef[,k]} is
+ for \eqn{x^{k-1}}{x^(k-1)} and the result
+ is a matrix of dimension \code{length(x) * nrow(coef)}.}
+ \item{x}{numeric vector or array. Either \code{x} or \code{coef} must
+ be a vector.}
+}
+\details{
+ The stable \dQuote{Horner rule} is used for evaluation in any case.
+}
+\value{
+ numeric vector or array, depending on input dimensionalities, see above.
+}
+\author{Martin Maechler, ages ago.}
+\seealso{For much more sophisticated handling of polynomials, use the
+ \code{polynom} package, e.g. \code{\link[polynom]{predict.polynomial}}.
+}
+\examples{
+polyn.eval(c(1,-2,1), x = 0:3)# (x - 1)^2
+polyn.eval(c(0, 24, -50, 35, -10, 1), x = matrix(0:5, 2,3))# 5 zeros!
+(cf <- rbind(diag(3), c(1,-2,1)))
+polyn.eval(cf, 0:5)
+}
+\keyword{arith}
diff --git a/man/posdefify.Rd b/man/posdefify.Rd
new file mode 100644
index 0000000..92adcb9
--- /dev/null
+++ b/man/posdefify.Rd
@@ -0,0 +1,84 @@
+\name{posdefify}
+\alias{posdefify}
+\title{Find a Close Positive Definite Matrix}
+\description{
+ From a matrix \code{m}, construct a \emph{"close"} positive definite
+ one.
+}
+\usage{
+posdefify(m, method = c("someEVadd", "allEVadd"),
+ symmetric = TRUE, eigen.m = eigen(m, symmetric= symmetric),
+ eps.ev = 1e-07)
+}
+\arguments{
+ \item{m}{a numeric (square) matrix.}
+ \item{method}{a string specifying the method to apply; can be abbreviated.}
+ \item{symmetric}{logical, simply passed to \code{\link{eigen}} (unless
+ \code{eigen.m} is specified); currently, we do not see any reason
+ for \emph{not} using \code{TRUE}.}
+ \item{eigen.m}{the \code{\link{eigen}} value decomposition of
+ \code{m}, can be specified in case it is already available.}
+ \item{eps.ev}{number specifying the tolerance to use, see Details
+ below.}
+}
+\details{
+ We form the eigen decomposition
+ \deqn{m = V \Lambda V'}{m = V L V'} where \eqn{\Lambda}{L} is the
+ diagonal matrix of eigenvalues, \eqn{\Lambda_{j,j} = \lambda_j}{L[j,j]
+ = l[j]}, with \emph{decreasing} eigenvalues \eqn{\lambda_1 \ge
+ \lambda_2 \ge \ldots \ge \lambda_n}{l[1] >= l[2] >= ... >= l[n]}.
+
+ When the smallest eigenvalue \eqn{\lambda_n}{l[n]} are less than
+ \code{Eps <- eps.ev * abs(lambda[1])}, i.e., negative or \dQuote{almost
+ zero}, some or all eigenvalues are replaced by \emph{positive}
+ (\code{>= Eps}) values,
+ \eqn{\tilde\Lambda_{j,j} = \tilde\lambda_j}{L~[j,j] = l~[j]}.
+ Then, \eqn{\tilde m = V \tilde\Lambda V'}{m~ = V L~ V'} is computed
+ and rescaled in order to keep the original diagonal (where that is
+ \code{>= Eps}).
+}
+\value{
+ a matrix of the same dimensions and the \dQuote{same} diagonal
+ (i.e. \code{\link{diag}}) as \code{m} but with the property to
+ be positive definite.
+}
+\author{Martin Maechler, July 2004}
+\note{As we found out, there are more sophisticated algorithms to solve
+ this and related problems. See the references and the
+ \code{\link[Matrix]{nearPD}()} function in the \pkg{Matrix} package.
+}
+\references{
+ Section 4.4.2 of
+ Gill, P.~E., Murray, W. and Wright, M.~H. (1981)
+ \emph{Practical Optimization}, Academic Press.
+
+ Cheng, Sheung Hun and Higham, Nick (1998)
+ A Modified Cholesky Algorithm Based on a Symmetric Indefinite Factorization;
+ \emph{SIAM J. Matrix Anal.\ Appl.}, \bold{19}, 1097--1110.
+
+ Knol DL, ten Berge JMF (1989)
+ Least-squares approximation of an improper correlation matrix by a
+ proper one.
+ \emph{Psychometrika} \bold{54}, 53--61.
+
+ Highham (2002)
+ Computing the nearest correlation matrix - a problem from finance;
+ \emph{IMA Journal of Numerical Analysis} \bold{22}, 329--343.
+
+ Lucas (2001)
+ Computing nearest covariance and correlation matrices. A thesis
+ submitted to the University of Manchester for the degree of Master of
+ Science in the Faculty of Science and Engeneering.
+}
+\seealso{\code{\link{eigen}} on which the current methods rely.
+ \code{\link[Matrix]{nearPD}()} in the \pkg{Matrix} package.
+}
+\examples{
+ set.seed(12)
+ m <- matrix(round(rnorm(25),2), 5, 5); m <- 1+ m + t(m); diag(m) <- diag(m) + 4
+ m
+ posdefify(m)
+ 1000 * zapsmall(m - posdefify(m))
+}
+\keyword{algebra}
+\keyword{array}
diff --git a/man/potatoes.Rd b/man/potatoes.Rd
new file mode 100644
index 0000000..1f4680c
--- /dev/null
+++ b/man/potatoes.Rd
@@ -0,0 +1,63 @@
+\name{potatoes}
+\alias{potatoes}
+\docType{data}
+\title{Fisher's Potato Crop Data}
+\description{
+ Fisher's potato crop data set is of historical interest as an early
+ example of a multi-factor block design.
+}
+\usage{data(potatoes)}
+\format{
+ A data frame with 64 observations on the following 5 variables.
+ \describe{
+ \item{pos}{a factor with levels \code{1:4}.}
+ \item{treat}{a factor with 16 levels \code{A} to \code{H} and
+ \code{J} to \code{Q}, i.e., \code{LETTERS[1:17][-9]}.}
+ \item{nitrogen}{a factor specifying the amount of nitrogen
+ sulfate (\eqn{NH_4}), with the four levels \code{0,1,2,4}.}
+ \item{potash}{a factor specifying the amount of potassium (K,
+ \sQuote{kalium}) sulfate, with the four levels \code{0,1,2,4}.}
+ \item{yield}{a numeric vector giving the yield of potatoes in ...}% << FIXME
+ }
+}
+% \details{
+% FIXME %% more details than the __description__ above ~~
+% } %% ----
+\source{
+ Bennett, J. H. (1972)
+ \emph{Collected Papers of R. A. Fischer} vol.~II, 1925-31;
+ The University of Adelaide.
+ %% One of the blocks, in the book
+ %% Stahel "Statist. Datenanalyse" Beisp.Kartoffelertrag (2nd ed. 251 a, 253 h)
+}
+\references{
+ T.Eden and R. A. Fisher (1929)
+ Studies in Crop Variation. VI. Experiments on the Response of the
+ Potato to Potash and Nitrogen.
+ \emph{J. Agricultural Science} \bold{19}, 201--213.
+ Accessible from Bennett (1972), see above.
+}
+\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)
+ })
+## First plot:
+with(potatoes, interaction.plot(potash,nitrogen, response=yield))
+
+## ANOVAs:
+summary(aov(yield ~ nitrogen * potash + Error(pos), data = potatoes))
+ # "==>" can use simply
+summary(aov(yield ~ nitrogen + potash + pos, data = potatoes))
+ # and
+summary(aov(yield ~ nitrogen + potash, data = potatoes))
+}
+\keyword{datasets}
diff --git a/man/pretty10exp.Rd b/man/pretty10exp.Rd
new file mode 100644
index 0000000..6d5c492
--- /dev/null
+++ b/man/pretty10exp.Rd
@@ -0,0 +1,101 @@
+\name{pretty10exp}
+\alias{pretty10exp}
+\title{Nice 10 ** k Label Expressions}
+\description{
+ Produce nice \eqn{a \times 10^k}{a * 10^k} expressions to be used
+ instead of the scientific notation \code{"a E<k>"}.
+}
+\usage{
+pretty10exp(x, drop.1 = FALSE, sub10 = FALSE, digits = 7, digits.fuzz,
+ lab.type = c("plotmath","latex"),
+ lab.sep = c("cdot", "times"))
+}
+\arguments{
+ \item{x}{numeric vector (e.g. axis tick locations)}
+ \item{drop.1}{logical indicating if \eqn{1 \times}{1 *} should be
+ dropped from the resulting expressions.}
+ \item{sub10}{logical, \code{"10"}, a non-negative integer number or
+ an integer vector of length two, say \eqn{(k_1,k_2)}{(k1,k2)}, indicating if some
+ \eqn{10^j} expressions for \eqn{j \in J}{j in J} should be formatted
+ traditionally, notably e.g., \eqn{10^0 \equiv 1}{10^0 == 1}.
+ \cr
+ When a (non-negative) number, say \eqn{k}, \eqn{J = \{j; j \le k\}}{%
+ J = {j; j \le k}} are all simplified, when a length--2 vector,
+ \eqn{J = \{j; k_1 \le j \le k_2\}}{J = {j; k1 \le j \le k2}} are.
+
+ Special cases: \code{sub10 = TRUE} means to use
+ \eqn{1} instead of \eqn{10^0} and \code{sub10 = "10"} uses both
+ \eqn{1} for \eqn{10^0} and \eqn{10} for \eqn{10^1}; these are short
+ forms of \code{sub10 = c(0,0)} and \code{sub10 = c(0,1)} respectively.
+ }
+ \item{digits}{number of digits for mantissa (\eqn{a}) construction;
+ the number of \emph{significant} digits, see \code{\link{signif}}.}
+ \item{digits.fuzz}{the old deprecated name for \code{digits}.}
+ \item{lab.type}{a string indicating how the result should look like.
+ By default, (\code{\link{plotmath}}-compatible)
+ \code{\link{expression}}s are returned. Alternatively,
+ \code{lab.type = "plotmath"} returns LaTeX formatted strings for
+ labels. (The latter is useful, e.g., when using the \pkg{tikzDevice}
+ package to generate LaTeX-processed figures.)}
+ \item{lab.sep}{character separator between mantissa and exponent for
+ LaTeX labels; it will be prepended with a backslash,
+ i.e., \sQuote{"cdot"} will use \sQuote{"\\cdot"}}
+}
+\value{
+ For the default \code{lab.type = "plotmath"},
+ an expression of the same length as \code{x}, typically with elements
+ of the form \code{a \%*\% 10 ^ k}.
+ Exceptions are \code{0} which is kept simple, if \code{drop.1} is
+ true and \eqn{a = 1}, \code{10 ^ k} is used, and if \code{sub10}
+ is not false, \code{a \%*\% 10 ^ 0} as \code{a}, and \code{a \%*\% 10 ^ k} as
+ as the corresponding formatted number \code{a * 10^k} independently of
+ \code{drop.1}.
+
+ Otherwise, a \code{\link{character}} vector of the same length as
+ \code{x}. For \code{lab.type = "latex"}, currently the only
+ alternative to the default, these strings are LaTeX (math mode)
+ compatible strings.
+}
+\note{
+ If \code{sub10} is set, it will typically be a small number such as 0,
+ 1, or 2. Setting \code{sub10 = TRUE} will be interpreted as
+ \code{sub10 =1} where resulting exponents \eqn{k} will either be
+ negative or \eqn{k \ge 2}{k >= 2}.
+}
+\author{Martin Maechler; Ben Bolker contributed \code{lab.type = "latex"}
+ and \code{lab.sep}.}
+\seealso{\code{\link{axTexpr}} and \code{\link{eaxis}()} which build on
+ \code{pretty10exp()}, notably the \code{eaxis()} example plots.
+
+ The new \code{\link{toLatex.numeric}} method which gives very similar
+ results with option \code{scientific = TRUE}.
+ \cr Further, \code{\link{axis}}, \code{\link{axTicks}}.
+}
+\examples{
+pretty10exp(-1:3 * 1000)
+pretty10exp(-1:3 * 1000, drop.1 = TRUE)
+pretty10exp(c(1,2,5,10,20,50,100,200) * 1e3)
+pretty10exp(c(1,2,5,10,20,50,100,200) * 1e3, drop.1 = TRUE)
+
+set.seed(17); lx <- rlnorm(10, m=8, s=6)
+pretty10exp(lx, digits = 3)
+pretty10exp(lx, digits = 3, sub10 = 2)
+
+unlist(pretty10exp(lx, digits = 3, lab.type="latex"))
+unlist(pretty10exp(lx, digits = 3, lab.type="latex",
+ lab.sep="times", sub10=2))
+
+\dontshow{
+stopifnot(identical(pretty10exp(numeric(0)), expression()))
+}
+ax <- 10^(-6:0) - 2e-16
+pretty10exp(ax, drop.1=TRUE) # nice for plotting
+pretty10exp(ax, drop.1=TRUE, sub10=TRUE)
+pretty10exp(ax, drop.1=TRUE, sub10=c(-2,2))
+
+## in sfsmisc version <= 1.0-16, no 'digits',
+## i.e., implicitly had digits := #{double precision digits} ==
+(dig. <- .Machine$double.digits * log10(2)) # 15.95
+pretty10exp(ax, drop.1=TRUE, digits= dig.) # ''ugly''
+}
+\keyword{dplot}
diff --git a/man/primes.Rd b/man/primes.Rd
new file mode 100644
index 0000000..505e916
--- /dev/null
+++ b/man/primes.Rd
@@ -0,0 +1,73 @@
+\name{primes}
+\alias{primes}
+\title{Find all Primes Less Than n}
+\description{
+ Find all prime numbers aka \sQuote{primes} less than \eqn{n}.
+
+ Uses an obvious sieve method (and some care), working with
+ \code{\link{logical}} and and \code{\link{integer}}s to be quite fast.
+}
+\usage{
+primes(n, pSeq = NULL)
+}
+\arguments{
+ \item{n}{a (typically positive integer) number.}
+ \item{pSeq}{optionally a vector of primes (2,3,5,...) as if from a
+ \code{primes()} call; \bold{must} be correct.
+ The goal is a speedup, but currently we have not found one single
+ case, where using a non-NULL \code{pSeq} is faster.}
+}
+\details{
+ As the function only uses \code{\link{max}(n)}, \code{n} can also be a
+ \emph{vector} of numbers.
+
+ The famous prime number theorem states that \eqn{\pi(n)}, the
+ \emph{number} of primes below \eqn{n} is asymptotically \eqn{n /
+ \log(n)} in the sense that \eqn{\lim_{n \to \infty}{\pi(n) \cdot \log(n) /
+ n \sim 1}}{lim[n -> Inf] \pi(n) * log(n) / n ~ 1}.
+
+ Equivalently, the inverse of \eqn{pi()}, the \eqn{n}-th prime number
+ \eqn{p_n} is around \eqn{n \log n}; recent results (Pierre Dusart, 1999),
+ prove that
+ \deqn{\log n + \log\log n - 1 < \frac{p_n}{n} < \log n + \log \log n
+ \quad\mathrm{for } n \ge 6.}{%
+ log n + log log n - 1 < p_n / n < log n + log log n for n >= 6.}
+}
+\value{
+ numeric vector of all prime numbers \eqn{\le n}{<= n}.
+}
+\author{Bill Venables (<= 2001); Martin Maechler gained another 40\% speed,
+ carefully working with logicals and integers.
+}
+\seealso{
+ \code{\link{factorize}}. For large \eqn{n}, use the \pkg{gmp} package
+ and its \code{\link[gmp]{isprime}} and \code{\link[gmp]{nextprime}}
+ functions.
+}
+\examples{
+ (p1 <- primes(100))
+ system.time(p1k <- primes(1000)) # still lightning fast
+ stopifnot(length(p1k) == 168)
+\donttest{
+ system.time(p.e7 <- primes(1e7)) # still only 0.3 sec (2015 (i7))
+ stopifnot(length(p.e7) == 664579)
+ ## The famous pi(n) := number of primes <= n:
+ pi.n <- approxfun(p.e7, seq_along(p.e7), method = "constant")
+ pi.n(c(10, 100, 1000)) # 4 25 168
+ plot(pi.n, 2, 1e7, n = 1024, log="xy", axes = FALSE,
+ xlab = "n", ylab = quote(pi(n)),
+ main = quote("The prime number function " ~ pi(n)))
+ eaxis(1); eaxis(2)
+}
+## Exploring p(n) := the n-th prime number :
+## 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))))
+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))
+}
+\keyword{math}
+\keyword{arithmetic}
diff --git a/man/printTable2.Rd b/man/printTable2.Rd
new file mode 100644
index 0000000..31ef43b
--- /dev/null
+++ b/man/printTable2.Rd
@@ -0,0 +1,61 @@
+\name{printTable2}
+\encoding{latin1}
+% source in ../R/printTable.R
+\alias{printTable2}
+\alias{margin2table}
+\alias{print.margin2table}
+\title{Add and Print Marginals for 2-way Contingency Tables}
+%\title{Berechne und Drucke Randtotale etc f�r 2-weg Kontingenz Tafeln}
+\description{
+ \code{printTable2()} prints a 2-way contingency table \dQuote{with all
+ bells and whistles} (currently using German labeling).
+
+ \code{margin2table()} computes marginals, adds them to the table and
+ returns a \code{margin2table} object the print method for which adds
+ text decorations (using \code{"-"} and \code{"|"}).
+}
+\usage{
+printTable2(table2, digits = 3)
+margin2table(x, totName = "sum", name.if.empty=FALSE)
+\method{print}{margin2table}(x, digits = 3, quote = FALSE, right = TRUE, \dots)
+}
+\arguments{
+ \item{table2}{a matrix with non-negative integer entries, i.e. the
+ contingency table.}%Matrix mit Anzahlen, die Kontingenztafel.
+ \item{x}{a matrix; for \code{print()}, the result of \code{margin2table}.}
+ \item{digits}{Anzahl Dezimalstellen, auf die die H�ufigkeiten gerundet
+ werden sollen.}
+ \item{quote, right}{logicals passed to \code{\link{print.default}()},
+ but with different default values.}
+ \item{totName}{string to use as row- and column- name if \code{x} has
+ corresponding \code{\link{dimnames}}.}
+ \item{name.if.empty}{logical indicating if the margin \dQuote{totals}
+ should be named in any case.}
+ \item{\dots}{further potential arguments, unused currently.}
+}
+% \details{
+% .........
+% }
+\value{
+ \code{margin2table} returns a matrix with \emph{added marginals},
+ i.e., an extra row and column, and is of class \code{"margin2table"}
+ (and \code{"\link{table}"} still) which has a nice print method.
+
+ \code{printTable2} is just producing output.
+}
+\author{Martin Maechler, Feb.1993; then Dec 2003}
+\seealso{\code{\link{table}}, \code{\link{ftable}}.}
+
+\examples{
+margin2table(diag(4),,TRUE)
+m <- diag(3); colnames(m) <- letters[1:3]
+margin2table(m)
+margin2table(m / sum(m))
+
+data(HairEyeColor)
+margin2table(HairEyeColor[,, "Male"])
+printTable2(HairEyeColor[,, "Male"])
+printTable2(HairEyeColor[,, "Female"])
+}
+\keyword{utilities}
+
diff --git a/man/prt.DEBUG.Rd b/man/prt.DEBUG.Rd
new file mode 100644
index 0000000..8979f1e
--- /dev/null
+++ b/man/prt.DEBUG.Rd
@@ -0,0 +1,28 @@
+\name{prt.DEBUG}
+\alias{prt.DEBUG}
+\title{Utility Printing in DEBUG mode}
+\description{
+ This is \bold{defunct} now:
+ The global \code{DEBUG} has been a cheap precursor to \R's
+ \code{\link{options}(verbose= .)} (or a \code{verbose} function argument).
+
+ This function prints out its arguments as \code{\link{cat}()} does,
+ additionally printing the name of function in which it's been called ---
+ only when a global variable \code{DEBUG} exists and is
+ \code{\link{TRUE}}.\cr
+}
+\usage{
+prt.DEBUG(\dots, LEVEL = 1)
+}
+\arguments{
+ \item{\dots}{arguments to be passed to \code{\link{cat}(\dots)} for
+ printing.}
+ \item{LEVEL}{integer (or logical) indicating a debugging level for printing.}
+}
+\author{Martin Maechler, originally for S-PLUS.}
+%% \note{This is mainly kept for historical reasons (and old code
+%% fragments), but sometimes I still consider renaming it and have it
+%% work using \code{getOption("verbose")} alone.
+%% }
+\keyword{debugging}
+
diff --git a/man/ps.end.Rd b/man/ps.end.Rd
new file mode 100644
index 0000000..20c6bf9
--- /dev/null
+++ b/man/ps.end.Rd
@@ -0,0 +1,55 @@
+\name{ps.end}
+\alias{ps.end}
+\alias{pdf.end}
+\title{Close PostScript or Acrobat Graphics Device opened by 'ps.do' / 'pdf.do'}
+\usage{
+ps.end(call.gv= NULL, command = getOption("eps_view"),
+ debug = getOption("verbose"))
+pdf.end(call.viewer= NULL, command = getOption("pdfviewer"),
+ debug = getOption("verbose"))
+}
+\arguments{
+ \item{call.gv,call.viewer}{logical, indicating if the postscript or
+ acrobat reader (e.g., ghostview or \code{acroread} or the command
+ given by \code{command}) should be called. By default, find out if
+ the viewer is already runing on this file and only call it if needed.}
+ \item{command}{character, giving a system command for PostScript previewing.
+ By default, \code{getOption("eps_view")} is set to\cr
+ \code{gv -watch -geometry -0+0 -magstep -2 -media BBox -noantialias}
+ which assumes \code{gv} (aka \emph{ghostview}) to be in your OS path.}
+ \item{debug}{logical; if \code{TRUE} print information during execution.}
+}
+\description{
+ Closes the PostScript or PDF file
+ (\code{\link{postscript}},\code{\link{pdf}}), openend by a previous
+ \code{\link{ps.do}} (or \code{\link{pdf.latex}}, or \dots) call, using
+ \code{\link{dev.off}}, and additionally opens a previewer for that
+ file, \emph{unless} the previewer is already up. This almost provides
+ an \sQuote{interactive} device (like \code{\link{x11}}) for
+ \code{\link{postscript}} or \code{\link{pdf}}.
+}
+\details{
+ Depends on Unix tools, such as \command{ps}.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{postscript}}, \code{\link{postscript}}
+ \code{\link{pdf.do}}, \code{\link{ps.do}}, %--> ./ps.latex.Rd
+ \dots
+}
+\examples{
+if(interactive() \dontshow{ || Sys.getenv("USER") == "maechler" }
+ ) {
+ ps.do("ex.ps")
+ data(sunspots)
+ plot(sunspots)
+ ps.end()
+
+ pdf.latex("ex-sun.pdf")
+ plot(sunspots)
+ pdf.end(call. = FALSE) # basically the same as dev.off()
+ }
+ ps.latex("ex2.eps")
+ plot(sunspots)
+ ps.end(call.gv = FALSE) # basically the same as dev.off()
+}
+\keyword{device}
diff --git a/man/ps.latex.Rd b/man/ps.latex.Rd
new file mode 100644
index 0000000..efd9532
--- /dev/null
+++ b/man/ps.latex.Rd
@@ -0,0 +1,118 @@
+\name{ps.latex}
+\alias{pdf.do}
+\alias{pdf.latex}
+\alias{ps.do}
+\alias{ps.latex}
+\title{PostScript/PDF Preview Device with Optional \sQuote{LaTeX} Touch}
+\usage{
+pdf.do(file, paper = "default", width = -1, height = -1, onefile = FALSE,
+ title = NULL, version = "1.4", quiet = FALSE, \dots)
+
+pdf.latex(file, height = 5 + main.space * 1.25, width = 9.5,
+ main.space=FALSE, lab.space = main.space,
+ paper = "special", title = NULL,
+ lab=c(10, 10, 7), mgp.lab=c(1.6, 0.7, 0), mar=c(4, 4, 0.9, 1.1), \dots)
+
+ps.do(file, width=-1, height=-1, onefile=FALSE, horizontal=FALSE,
+ title = NULL, \dots)
+
+ps.latex(file, height = 5 + main.space * 1.25, width = 9.5,
+ main.space=FALSE, lab.space = main.space,
+ paper = "special", title = NULL,
+ lab=c(10, 10, 7), mgp.lab=c(1.6, 0.7, 0), mar=c(4, 4, 0.9, 1.1), \dots)
+}
+\arguments{
+ \item{file}{character giving the PostScript/PDF file name to be written.}
+ \item{height}{device height in \emph{inches}, \code{height * 2.54} are
+ \emph{cm}. The default is 5 plus 1.25 iff \code{main.space}.}
+ \item{width}{device width in \emph{inches}; for this and
+ \code{height}, see \code{\link{postscript}}.}
+ \item{onefile, horizontal}{logicals passed to
+ \code{\link{postscript}(..)} or \code{\link{pdf}(..)}, most probably
+ to be left alone.}
+ \item{title}{PostScript/PDF (not plot!) title passed to
+ \code{\link{postscript}()} or \code{\link{pdf}()}; by default use a
+ title with \R version and \code{file} in it.}
+ \item{version}{a string describing the PDF version that will be
+ required to view the output, see \code{\link{pdf}}; our (high)
+ default ensures alpha-transparency.}
+ \item{quiet}{logical specifying that some (informative/warning)
+ messages should not be issued.}
+ \item{main.space}{logical; if true, leave space for a main title
+ (unusual for LaTeX figures!).}
+ \item{lab.space}{logical; if true, leave space for x- and y- labels
+ (by \emph{not} subtracting from \code{mar}).}
+ \item{paper}{character (or missing), typically \code{"a4"} or
+ \code{"a4r"} in non-America, see \code{\link{postscript}}. Only
+ if this is \code{"special"} (or missing) are your choices of \code{width}
+ and \code{height} completely honored (and this may lead to files that
+ cannot print on A4) with resizing.}
+ \item{lab}{integer of length 3, \code{lab[1:2]} are desired number of
+ tick marks on x- and y- axis, see \code{\link{par}(lab=)}.}
+ \item{mgp.lab}{three decreasing numbers determining space for axis
+ labeling, see \code{\link{par}(mgp=)}, the default is here smaller
+ than usual.}
+ \item{mar}{four numbers, indicating marginal space, see
+ \code{\link{par}(mar=)}, the default is here smaller than usual.}
+ \item{\dots}{arguments passed to \code{\link{ps.do}()} or
+ \code{\link{pdf.do}()} from
+ \code{ps.latex} / \code{pdf.latex} and to \code{\link{ps.options}}
+ from \code{ps.do}/\code{pdf.do}.}
+}
+\description{
+ All functions start a pseudo PostScript or Acrobat preview device, using
+ \code{\link{postscript}} or \code{\link{pdf}}, and further registering
+ the file name for subsequent calls to \code{\link{pdf.end}()} or
+ \code{ps.end()}.
+}
+\details{
+ \code{ps.latex} and \code{pdf.latex} have an additional
+ LaTeX %\iftex{\LaTeX}{LaTeX}
+ flavor,
+ and just differ by some extra \code{\link{par}} settings from the
+ \code{*.do} siblings: E.g., after \code{\link{ps.do}(..)}
+ is called, the graphical parameters \code{c("mar", "mgp", "lab")} are
+ reset (to values that typically are better than the defaults for LaTeX
+ figures).
+
+ Whereas the defaults for \code{paper}, \code{width}, and \code{height}
+ \emph{differ} between \code{\link{pdf}} and \code{\link{postscript}},
+ they are set such as to provide very similar functionality, for
+ the functions \code{ps.do()} and \code{pdf.do()}; e.g., by default,
+ both use a full plot on portrait-oriented page of the default paper,
+ as per \code{\link{getOption}("papersize")}.\cr
+ \code{\link{pdf.do}()} sets the default \code{paper} to \code{"special"}
+ when both \code{width} and \code{height} are specified.
+}
+\value{
+ A list with components
+ \item{old.par}{containing the old \code{par} values}
+ \item{new.par}{containing the newly set \code{par} values}
+}
+\author{Martin Maechler}
+\seealso{\code{\link{ps.end}}, \code{\link{pdf}}, \code{\link{postscript}},
+ \code{\link{dev.print}}.
+}
+\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()
+}
+}
+\keyword{device}
diff --git a/man/quadrant.Rd b/man/quadrant.Rd
new file mode 100644
index 0000000..9b1a1cf
--- /dev/null
+++ b/man/quadrant.Rd
@@ -0,0 +1,30 @@
+\name{quadrant}
+\alias{quadrant}
+\title{Give the Quadrant Number of Planar Points}
+\description{
+ Determine the quadrant of planar points, i.e. in which of the four
+ parts cut by the x- and y- axis the points lie. Zero values
+ (i.e. points on the axes) are treated as if \emph{positive}.
+}
+\usage{
+quadrant(x, y=NULL)
+}
+\arguments{
+ \item{x,y}{numeric vectors of the same length, or \code{x} is an \eqn{x-y}
+ structure and \code{y=NULL}, see \code{\link{xy.coords}}.}
+}
+\value{
+ numeric vector of same length as \code{x} (if that's a vector) with
+ values in \code{1:4} indicating the quadrant number of the
+ corresponding point.
+}
+%%\seealso{ ~~objects to See Also as \code{\link{~~fun~~}}, ~~~ }
+\examples{
+xy <- as.matrix(expand.grid(x= -7:7, y= -7:7)); rownames(xy) <- NULL
+(qu <- quadrant(xy))
+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))
+}
+\keyword{utilities}
+
diff --git a/man/read.org.table.Rd b/man/read.org.table.Rd
new file mode 100644
index 0000000..b0747cf
--- /dev/null
+++ b/man/read.org.table.Rd
@@ -0,0 +1,59 @@
+\name{read.org.table}
+\title{Read.table for an Emacs Org Table}
+\alias{read.org.table}
+\description{
+ Read an emacs \dQuote{Org} table (in \code{file} or \code{text}) by
+ \code{\link{read.table}()}. % FIXME: Should be easy to made to work for some of the
+ %% Markdown formats for tables.
+}
+\usage{
+read.org.table(file, header = TRUE, skip = 0, fileEncoding = "", text, \dots)
+}
+\arguments{
+ \item{file}{a file name, a \code{\link{file}} or other connection.}
+ \item{header}{logical indicating if the org table has header line (in
+ the usual \code{"|"}-separated org table format).}
+ \item{skip}{integer number of initial lines to skip.}
+ \item{fileEncoding}{see \code{\link{read.table}}}
+ \item{text}{instead of \code{file}, a \code{\link{character}} or
+ string (of a few lines, typically).}
+ \item{\dots}{further arguments passed to \code{\link{read.table}}.
+ You should \emph{not} use \code{encoding} (but possibly
+ \code{fileEncoding}!) here, as we do not call
+ \code{\link{read.table}} on \code{file} (but on a
+ \code{\link{textConnection}}).}
+}
+\value{
+ a \code{\link{data.frame}}
+}
+\note{TODO: It should be easy to extend \code{read.org.table()} to also
+ work for some of the proposed Markdown formats for tables.
+ Please write to \code{\link{maintainer}("sfsmisc")} or open a
+ github issue if you are interested.
+}
+\references{
+ Org-Mode \emph{Manual} on tables, \url{http://orgmode.org/manual/Tables.html}
+
+ Org \emph{tutorial} for tables, \url{http://orgmode.org/worg/org-tutorials/tables.html}
+}
+\seealso{
+ CRAN package \pkg{ascii} % \CRANpkg{ascii} % <- needs R >= 3.2.0
+ can \emph{write} org tables.
+ \code{\link{read.table}}
+}
+\examples{
+t1 <-
+"
+| a | var2 | C |
+|---+------+-----|
+| 2 | may | 3.4 |
+| 7 | feb | 4.7 |
+"
+d <- read.org.table(text = t1)
+d
+stopifnot(dim(d) == c(2, 3),
+ identical(names(d), c("a", "var2", "C")),
+ d[,"a"] == c(2,7))
+}
+\keyword{file}
+\keyword{utilities}
diff --git a/man/repChar.Rd b/man/repChar.Rd
new file mode 100644
index 0000000..4cbf55d
--- /dev/null
+++ b/man/repChar.Rd
@@ -0,0 +1,39 @@
+\name{repChar}
+\alias{repChar}
+\alias{bl.string}
+\title{Make Simple String from Repeating a Character, e.g. Blank String}
+\description{
+ Simple constructors of a constant character string from one character,
+ notably a \dQuote{blank} string of given string length.
+
+ M.M. is now \sQuote{\emph{mentally deprecating}} \code{bl.string} in
+ favor of using \code{repChar()} in all cases.
+}
+\usage{
+repChar(char, no)
+bl.string(no)
+}
+\arguments{
+ \item{char}{single character (or arbitrary string).}
+ \item{no}{non-negative integer.}
+}
+\value{
+ One string, i.e., \code{\link{character}(1)}), for \code{bl.string} a
+ blank string, fulfilling \code{n == nchar(bl.string(n))}.
+}
+\author{Martin Maechler, early 1990's (for \code{bl.string}).}
+\seealso{\code{\link{paste}}, \code{\link{character}}, \code{\link{nchar}}.}
+\examples{
+r <- sapply(0:8, function(n) ccat(repChar(" ",n), n))
+cbind(r)
+
+repChar("-", 4)
+repChar("_", 6)
+## it may make sense to a string of more than one character:
+repChar("-=- ", 6)
+
+## show the very simple function definitions:
+repChar
+bl.string
+}
+\keyword{character}
diff --git a/man/rot13.Rd b/man/rot13.Rd
new file mode 100644
index 0000000..1de1b7b
--- /dev/null
+++ b/man/rot13.Rd
@@ -0,0 +1,47 @@
+\name{rotn}
+\alias{rotn}
+\title{Generalized Rot13 Character Translation (Rotation)}
+\description{
+ Compute generalized \sQuote{rot13} character translations or
+ \dQuote{rotations}
+
+ In the distant past, considered as poor man's encryption, such
+ rotations are way too poor nowadays and provided mainly for didactical
+ reasons.
+}
+\usage{
+rotn(ch, n = 13)
+}
+\arguments{
+ \item{ch}{a \code{\link{character}} vector; often a string (of length 1).}
+ \item{n}{an integer in \eqn{\{1\dots26\}}{{1...26}}; the default is
+ particularly useful.}
+}
+\value{
+ a character as \code{ch}, but with each character (which
+ belongs to \code{\link{letters}} or \code{\link{LETTERS}}
+ \dQuote{rotated} by \code{n} (positions in the alphabet).
+}
+\author{Martin Maechler}
+\details{
+ Note that the default \code{n = 13} makes \code{rotn} into
+ a function that is its own inverse.
+
+ Written after having searched for it and found
+ \code{seqinr::rot13()} which was generalized and rendered more
+ transparently to my eyes.
+}
+\seealso{
+ \code{\link{rot2}}, a completely different rotation (namely in the
+ plane aka \eqn{R^2}).
+}
+\examples{
+rotn(c("ABC", "a","b","c"), 1)
+rotn(c("ABC", "a","b","c"), 2)
+rotn(c("ABC", "a","b","c"), 26) # rotation by 26 does not change much
+
+(ch <- paste("Hello", c("World!", "you too")))
+rotn(ch)
+rotn( rotn(ch ) ) # rotn(*, 13) is its own inverse
+}
+\keyword{manip}
\ No newline at end of file
diff --git a/man/rot2.Rd b/man/rot2.Rd
new file mode 100644
index 0000000..f97d5d1
--- /dev/null
+++ b/man/rot2.Rd
@@ -0,0 +1,40 @@
+\name{rot2}
+\encoding{latin1}% "^o" (degree) below
+\alias{rot2}
+\title{Rotate Planar Points by Angle}
+\description{
+ Rotate planar (xy) points by angle \code{phi} (in radians).
+}
+\usage{
+rot2(xy, phi)
+}
+\arguments{
+ \item{xy}{numeric 2-column matrix, or coercable to one.}
+ \item{phi}{numeric scalar, the angle in radians (i.e., \code{phi=pi}
+ corresponds to 180 degrees) by which to rotate the points.}
+}
+\value{
+ A two column matrix as \code{xy}, containing the rotated points.
+}
+\author{Martin Maechler, Oct.1994}
+\examples{
+## Rotate three points by 60 degrees :
+(xy0 <- rbind(c(1,0.5), c(1,1), c(0,1)))
+(Txy <- rot2(xy0, phi = 60 * pi/180))
+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")
+}
+\keyword{manip}
+\keyword{math}
diff --git a/man/roundfixS.Rd b/man/roundfixS.Rd
new file mode 100644
index 0000000..7479c68
--- /dev/null
+++ b/man/roundfixS.Rd
@@ -0,0 +1,103 @@
+\name{roundfixS}
+\alias{roundfixS}
+\concept{apportionment}
+\title{Round to Integer Keeping the Sum Fixed}
+\description{
+ Given a real numbers \eqn{y_i} with the particular property that
+ \eqn{\sum_i y_i} is integer, find \emph{integer} numbers \eqn{x_i}
+ which are close to \eqn{y_i} (\eqn{\left|x_i - y_i\right| < 1 \forall i}{%
+ |x[i] - y[i]| < 1 for all i}), and have identical \dQuote{marginal}
+ sum, \code{sum(x) == sum(y)}.
+
+ As I found later, the problem is known as \dQuote{Apportionment Problem}
+ and it is quite an old problem with several solution methods proposed
+ historically, but only in 1982, Balinski and Young proved that there
+ is no method that fulfills three natural desiderata.
+
+ Note that the (first) three methods currently available here were all
+ (re?)-invented by M.Maechler, without any knowledge of the
+ litterature. At the time of writing, I have not even checked to which
+ (if any) of the historical methods they match.
+}
+\usage{
+roundfixS(x, method = c("offset-round", "round+fix", "1greedy"))
+}
+\arguments{
+ \item{x}{a numeric vector which \bold{must} sum to an integer}
+ \item{method}{character string specifying the algorithm to be used.}
+% \item{trace}{logical or integer, enabling algorithm tracing.}
+}
+\details{
+ Without hindsight, it may be surprising that all three methods give
+ identical results (in all situations and simulations considered),
+ notably that the idea of \sQuote{mass shifting} employed in the
+ iterative \code{"1greedy"} algorithm seems equivalent to the much simpler
+ idea used in \code{"offset-round"}.
+
+ I am pretty sure that these algorithms solve the \eqn{L_p}
+ optimization problem, \eqn{\min_x \left\|y - x\right\|_p}{min_x ||y - x||_p},
+ typically for all \eqn{p \in [1,\infty]}{p in [1,Inf]}
+ \emph{simultaneously}, but have not bothered to find a formal proof.
+}
+\value{
+ a numeric vector, say \code{r}, of the same length as \code{x}, but
+ with integer values and fulfulling \code{sum(r) == sum(x)}.
+}
+\author{Martin Maechler, November 2007}
+\references{
+ Michel Balinski and H. Peyton Young (1982)
+ \bold{Fair Representation: Meeting the Ideal of One Man, One Vote};
+
+ \url{https://en.wikipedia.org/wiki/Apportionment_paradox}
+
+ \url{https://www.ams.org/samplings/feature-column/fcarc-apportionii3}
+}
+\seealso{\code{\link{round}} etc
+}
+\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
+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|"]))))
+
+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)
+
+## 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)
+
+\dontrun{
+for(i in 1:1000)
+ stopifnot(chk(makeIntSum(rpois(100, 10) +
+ c(runif(75, min= 0, max=.2),
+ runif(25, min=.5, max=.9)))))
+}
+}
+\keyword{arith}
+\keyword{manip}
diff --git a/man/rrange.Rd b/man/rrange.Rd
new file mode 100644
index 0000000..9fb4468
--- /dev/null
+++ b/man/rrange.Rd
@@ -0,0 +1,44 @@
+\name{rrange}
+\alias{rrange}
+\title{Robust Range using Boxplot 'Quartiles'}
+\description{
+ Compute a robust range, i.e. the usual \code{\link{range}()} as long
+ as there are no outliers, using the \dQuote{whisker boundaries} of
+ \code{\link{boxplot}}, i.e., \code{\link{boxplot.stats}}.
+}
+\usage{
+rrange(x, range=1, coef = 1.5, na.rm = TRUE)
+}
+\arguments{
+ \item{x}{numeric vector the robust range of which shall be computed.}
+ \item{range}{number for S compatibility; \code{1.5 * range} is
+ equivalent to \code{coef}.}
+ \item{coef}{numeric multiplication factor definying the outlier
+ boundary, see \sQuote{Details} below.}
+ \item{na.rm}{logical indicating how \code{\link{NA}} values should be
+ handled; they are simply dropped when \code{na.rm = TRUE} as by default.}
+}
+\details{
+ The robust range is really just what \code{\link{boxplot.stats}(x,
+ coef=coef)} returns as the whisker boundaries.
+ This is the most extreme values \code{x[j]} still inside median
+ plus/minus \code{coef * IQR}.
+}
+\value{
+ numeric vector \code{c(m,M)} with \eqn{m \le M}{m <= M} which is (not
+ strictly) inside \code{range(x) = c(min(x),max(x))}.
+}
+\author{Martin Maechler, 1990.}
+\seealso{\code{\link{range}}, \code{\link{fivenum}},
+ \code{\link{boxplot}} and \code{\link{boxplot.stats}}.
+
+ A more sophisticated robust range for (strongly) asymmetric data can
+ be derived from the skewness adjusted boxplot statistics
+ \code{\link[robustbase]{adjboxStats}} which is a generalization of
+ \code{\link{boxplot.stats}}.
+}
+\examples{
+stopifnot(rrange(c(1:10,1000)) == c(1,10))
+}
+\keyword{univar}
+\keyword{robust}
diff --git a/man/seqXtend.Rd b/man/seqXtend.Rd
new file mode 100644
index 0000000..6fadbf6
--- /dev/null
+++ b/man/seqXtend.Rd
@@ -0,0 +1,80 @@
+\name{seqXtend}
+\alias{seqXtend}
+\title{Sequence Covering the Range of X, including X}
+\description{
+ Produce a sequence of unique values (sorted increasingly),
+ \emph{containing} the initial set of values \code{x}.
+ This can be useful for setting prediction e.g. ranges in nonparametric
+ regression.
+}
+\usage{
+seqXtend(x, length., method = c("simple", "aim", "interpolate"),
+ from = NULL, to = NULL)
+}
+\arguments{
+ \item{x}{numeric vector.}
+ \item{length.}{integer specifying \emph{approximately} the desired
+ \code{\link{length}()} of the result.}
+ \item{method}{string specifying the method to be used. The default,
+ \code{"simple"} uses \code{\link{seq}(*, length.out = length.)} where
+ \code{"aim"} aims a bit better towards the desired final length,
+ and \code{"interpolate"} interpolates evenly \emph{inside}
+ each interval \eqn{[x_i, x_{i+1}]}{(x[i], x[i+1])} in a way to
+ make all the new intervalls of approximately the same length.}
+ \item{from, to}{numbers to be passed to (the default method for)
+ \code{\link{seq}()}, defaulting to the minimal and maximal \code{x}
+ value, respectively.}
+}
+\note{
+ \code{method = "interpolate"} typically gives the best results. Calling
+ \code{\link{roundfixS}}, it also need more computational resources
+ than the other methods.
+}
+\value{
+ numeric vector of increasing values, of approximate length
+ \code{length.}
+ (unless \code{length. < length(unique(x))} in which case, the result
+ is simply \code{sort(\link{unique}(x))}),
+ containing the original values of \code{x}.
+
+ From, \code{r <- seqXtend(x, *)}, the original values are at
+ indices \code{ix <- match(x,r)}, i.e., \code{identical(x, r[ix])}.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{seq}}; \code{\link{plotDS}} can make particularly
+ good use of \code{seqXtend()}
+}
+\examples{
+a <- c(1,2,10,12)
+seqXtend(a, 12)# --> simply 1:12
+seqXtend(a, 12, "interp")# ditto
+seqXtend(a, 12, "aim")# really worse
+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
+length(print(seqXtend(x, 12, "aim"))) # 12
+length(print(seqXtend(x, 12, "int"))) # 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
+## say, a finer grid, for ticks -- should be almost equidistant
+n3 <- 3*length(px)
+summary(as.numeric(diff(seqXtend(px, n3)))) # wildly varying
+summary(as.numeric(diff(seqXtend(px, n3, "aim")))) # (ditto)
+summary(as.numeric(diff(seqXtend(px, n3, "int")))) # around 30
+}
+\keyword{manip}
+\keyword{utilities}
diff --git a/man/sessionInfoX.Rd b/man/sessionInfoX.Rd
new file mode 100644
index 0000000..dd850cf
--- /dev/null
+++ b/man/sessionInfoX.Rd
@@ -0,0 +1,75 @@
+\name{sessionInfoX}% sessionInfo help is ~/R/D/r-devel/R/src/library/utils/man/sessionInfo.Rd
+\title{Extended Information About the Current R Session}
+\alias{sessionInfoX}
+\alias{print.sessionInfoX}
+\description{
+ Collect (and print) information about the current \R session and
+ environment, using \code{\link{sessionInfo}()} and more mostly
+ low-level and platform dependent information.
+}
+\usage{
+sessionInfoX(pkgs = NULL, list.libP = FALSE, extraR.env = TRUE)
+
+\method{print}{sessionInfoX}(x, locale = TRUE, RLIBS = TRUE, Renv = TRUE, \dots)
+}
+\arguments{
+ \item{pkgs}{an optional \code{\link{character}} vector of \R packages,
+ whose \code{\link{packageDescription}()}s are wanted.}
+ \item{list.libP}{a logical indicating if for all
+ \code{\link{.libPaths}} entries, the files should be listed via
+ \code{\link{list.files}}.}
+ \item{extraR.env}{logical indicating if \emph{all} environment
+ variables should be recorded which start with \code{"R_"} or
+ \code{"_R_"}.}
+%% print():
+ \item{x}{typically the result of \code{sessionInfoX()}.}
+ \item{locale}{logical, passed to \code{\link{print.sessionInfo}()}
+ indicating if the locale information should be printed.}
+ \item{RLIBS}{logical indicating if the information about R_LIBS should
+ be printed.}
+ \item{Renv}{logical indicating if the information about R environment
+ variables should be printed.}
+ \item{\dots}{passed to \code{\link{print}} methods.}
+}
+%% \details{
+%% }
+\value{an object of S3 class \code{"sessionInfoX"}, a \code{\link{list}}
+ with components (there may be more, experimental and not yet listed here):
+ \item{sInfo}{simply the value of \code{\link{sessionInfo}()}.}
+ \item{sysInf}{the value of \code{\link{Sys.info}()}.}
+ \item{capabilities}{the value of \code{\link{capabilities}()}.}
+ \item{extSoft}{for \R 3.2.0 and newer, the value of \code{\link{extSoftVersion}()}.}
+ \item{LAPACK}{for \R 3.0.3 and newer, the value of \code{\link{La_version}()}.}
+ \item{pcre}{for \R 3.1.3 and newer, the value of \code{\link{pcre_config}()}.}
+ \item{pkgDescr}{If \code{pkgs} was non-empty, a named
+ \code{\link{list}} of \code{\link{packageDescription}()}s for each
+ entry in \code{pkgs}.}
+ \item{libPath}{the value of \code{\link{.libPaths}()}.}
+ \item{RLIBS}{a \code{\link{character}} vector of entries from
+ \code{\link{Sys.getenv}("R_LIBS")}, typically very similar to the
+ \code{libPaths} component.}
+ \item{n.RLIBS}{simply a \code{\link{normalizePath}()}ed version of \code{RLIBS}.}
+ \item{R.env}{a named character vector with the \dQuote{important} \R
+ environment variables \code{R_ENVIRON}, \code{R_PROFILE},
+ \code{R_CHECK_ENVIRON}.}
+ \item{xR.env}{if \code{extraR.env} was true, a named character vector
+ of \dQuote{all R related} environment variables, as specified in
+ \code{extraR.env}'s description above.}
+
+%% FIXME: unfinished
+
+}
+\author{Martin Maechler, December 2015}
+\seealso{
+ \code{\link{sessionInfo}},
+ \code{\link{.libPaths}}, \code{\link{R.version}}, \code{\link{Sys.getenv}}.
+}
+\examples{
+six0 <- sessionInfoX()
+sixN <- sessionInfoX("nlme", list.libP = TRUE)
+sixN # -> print() method for "sessionInfoX"
+names(sixN)
+str(sixN, max = 1)# outline of lower-level structure
+str(sixN$pkgDescr) # list with one component "nlme"
+}
+\keyword{misc}
diff --git a/man/sfsmisc-defunct.Rd b/man/sfsmisc-defunct.Rd
new file mode 100644
index 0000000..a7aca36
--- /dev/null
+++ b/man/sfsmisc-defunct.Rd
@@ -0,0 +1,38 @@
+\name{sfsmisc-defunct}
+\title{Defunct Functions in Package \pkg{sfsmisc}}
+%------ NOTE: ../R/Defunct.R must be synchronized with this!
+% ~~~~~~~~~~~
+\alias{sfsmisc-defunct}
+%------ PLEASE: put \alias{.} here for EACH !
+% Move things from here to ../Old_Defunct/
+% ~~~~~~~~~~~~~~~
+\alias{list2mat}
+\alias{pl.ds}
+\alias{p.pllines}
+\description{
+ The functions or variables listed here are no longer part of package
+ \pkg{sfsmisc} as they are not needed (any more).
+}
+\usage{
+## Defunct in 2016-12 --> to be sfsmisc 1.1-1
+list2mat(x, check = TRUE)
+
+p.pllines(x,y,group,lty=c(1,3,2,4),\dots)
+
+## deprecated from 2007 to 2013; defunct since 2014-01:
+pl.ds() ##-- is replaced by plotDS()
+}
+\details{
+ \code{list2mat(x)} was usually the same as \code{sapply(x, c)} (where
+ the latter does not construct column names where \code{x} has no names).
+
+ \code{p.pllines} is now defunct because basic \R graphics (but not
+ S-PLUS) provide its functionality directly: Use \code{plot(x,y, lty
+ = group, type = 'l', ...)}.
+
+ \code{pl.ds} has been renamed to \code{\link{plotDS}()} in 2007.
+}
+\seealso{
+ \code{\link{Defunct}}
+}
+\keyword{internal}
diff --git a/man/signi.Rd b/man/signi.Rd
new file mode 100644
index 0000000..fc15c17
--- /dev/null
+++ b/man/signi.Rd
@@ -0,0 +1,30 @@
+\name{signi}
+\alias{signi}
+\title{Rounding to Significant Digits}
+\description{
+ Rounds to significant digits similarly to \code{\link{signif}}.
+}
+\usage{
+signi(x, digits = 6)
+}
+\arguments{
+ \item{x}{numeric vector to be rounded.}
+ \item{digits}{number of significant digits required.}
+}
+\value{
+ numeric vector \dQuote{close} to \code{x}, i.e. by at least \code{digits}
+ significant digits.
+}
+\author{Martin Maechler, in prehistoric times (i.e. before 1990).}
+\note{
+ This is really just \code{round(x, digits - trunc(log10(abs(x))))} and
+ hence mainly of didactical use. Rather use \code{signif()} otherwise.
+}
+\seealso{\code{\link{signif}}, \code{\link{round}}.}
+\examples{
+(x1 <- seq(-2, 4, by = 0.5))
+identical(x1, signi(x1))# since 0.5 is exact in binary arithmetic
+(x2 <- pi - 3 + c(-5,-1,0, .1, .2, 1, 10,100))
+signi(x2, 3)
+}
+\keyword{arith}
diff --git a/man/sourceAttach.Rd b/man/sourceAttach.Rd
new file mode 100644
index 0000000..de4dd21
--- /dev/null
+++ b/man/sourceAttach.Rd
@@ -0,0 +1,37 @@
+\name{sourceAttach}
+\alias{sourceAttach}
+\title{Source and Attach an R source file}
+\description{
+ Source (via \code{\link{sys.source}()}) and attach
+ (\code{\link{attach}}) an \R source file.
+}
+\usage{
+sourceAttach(file, pos=2,
+ name = paste(abbreviate(gsub(fsep,"", dirname(file)),
+ 12, method="both.sides"),
+ basename(file), sep=fsep),
+ keep.source = getOption("keep.source.pkgs"),
+ warn.conflicts = TRUE)
+}
+\arguments{
+ \item{file}{file name}
+ \item{pos}{passed to \code{\link{attach}()}}
+ \item{name}{character, with a smart default, passed to \code{attach()}.}
+ \item{keep.source}{logical, see \code{\link{sys.source}()}.}
+ \item{warn.conflicts}{logical, see \code{\link{attach}}.}
+}
+\value{
+ the return value of \code{\link{attach}()}.
+}
+\author{Martin Maechler, 29 Jul 2011}
+\seealso{
+ \code{\link{attach}}, \code{\link{sys.source}}, \code{\link{source}}
+}
+\examples{
+ sourceAttach(system.file("test-tools-1.R", package="Matrix", mustWork=TRUE))
+ search() # shows the new "data base" at position 2
+ ## look what it contains:
+ ls.str(pos = 2)
+}
+\keyword{file}
+\keyword{utilities}
diff --git a/man/str_data.Rd b/man/str_data.Rd
new file mode 100644
index 0000000..30cc962
--- /dev/null
+++ b/man/str_data.Rd
@@ -0,0 +1,50 @@
+\name{str_data}
+\alias{str_data}
+\title{Overview on All Datasets in an R Package}
+\description{
+ Provide an overview over all datasets available by
+ \code{\link{data}()} in a (list of) given \R packages.
+}
+\usage{
+str_data(pkgs, filterFUN, \dots)
+}
+\arguments{
+ \item{pkgs}{character vector of names of \R packages.}
+ \item{filterFUN}{optionally a \code{\link{logical}}
+ \code{\link{function}} for filtering the \R objects.}
+ \item{\dots}{potentical further arguments to be passed to
+ \code{\link{str}}; \code{str(utils:::str.default)} gives useful list.}
+}
+\value{
+ invisibly (see \code{\link{invisible}}) a \code{\link{list}} with
+ named components matching the \code{pkgs} argument. Each of these
+ components is a named list with one entry per \code{data(.)} argument
+ name. Each entry is a \code{\link{character}} vector of the names
+ of all objects, typically only one.
+
+ The side effect is, as with \code{\link{str}()}, to print
+ everything (via \code{\link{cat}}) to the console.
+}
+\author{Martin Maechler}
+\seealso{\code{\link[utils]{str}}, \code{\link[utils]{data}}.
+}
+\examples{
+str_data("cluster")
+
+str_data("datasets", max=0, give.attr = FALSE)
+
+## Filtering (and return value)
+dfl <- str_data("datasets", filterFUN=is.data.frame)
+str(df.d <- dfl$datasets)
+## dim() of all those data frames:
+t(sapply(unlist(df.d), function(.) dim(get(.))))
+
+### Data sets in all attached packages but "datasets" (and stubs):
+s <- search()
+(Apkgs <- sub("^package:", '', s[grep("^package:", s)]))
+str_data(Apkgs[!Apkgs \%in\% c("datasets", "stats", "base")])
+}
+\keyword{datasets}
+\keyword{utilities}
+\keyword{documentation}
+
diff --git a/man/tapplySimpl.Rd b/man/tapplySimpl.Rd
new file mode 100644
index 0000000..12e4990
--- /dev/null
+++ b/man/tapplySimpl.Rd
@@ -0,0 +1,45 @@
+\name{tapplySimpl}
+\alias{tapplySimpl}
+\title{More simplification in tapply() result}
+\description{
+ For the case of more than two categories or indices (in \code{INDEX}),
+ traditional \code{\link{tapply}(*, simplify = TRUE)} still returns a
+ list when an array may seem more useful and natural. This is provided
+ by \code{tapplySimpl()} if the function \code{FUN()} is defined such
+ as to return a vector of the same length in all cases.
+}
+\usage{
+tapplySimpl(X, INDEX, FUN, \dots)
+}
+\arguments{
+ \item{X}{an atomic object, typically a vector. All these arguments
+ are as in \code{\link{tapply}()} and are passed to \code{tapply(..)}.}
+ \item{INDEX}{list of (typically more than one) factors, each of same
+ length as \code{X}.}
+ \item{FUN}{the function to be applied. For the result to be
+ simplifiable, \code{FUN()} must return a vector of always the same
+ length.}
+ \item{\dots}{optional arguments to \code{FUN}.}
+}
+\value{
+ If the above conditions are satisfied, the list returned from
+ \code{r <- tapply(X, INDEX, FUN, \dots)} is simplified into an
+ \code{\link{array}} of rank \eqn{1 + \#\{indices\}}, i.e.,
+ \code{1+length(INDEX)}; otherwise, \code{tapplySimpl()} returns the list
+ \code{r}, i.e., the same as \code{tapply()}.
+}
+\author{Martin Maechler, 14 Jun 1993 (for S-plus).}
+\seealso{\code{\link{tapply}(*, simplify=TRUE)}.}
+\examples{
+ ## Using tapply() would give a list (with dim() of a matrix);
+ ## here we get 3-array:
+
+ data(esoph)
+ with(esoph, {
+ mima <<- tapplySimpl(ncases/ncontrols, list(agegp, alcgp), range)
+ stopifnot(dim(mima) == c(2, nlevels(agegp), nlevels(alcgp)))
+ })
+ aperm(mima)
+}
+\keyword{iteration}
+\keyword{category}
diff --git a/man/tkdensity.Rd b/man/tkdensity.Rd
new file mode 100644
index 0000000..4d6d180
--- /dev/null
+++ b/man/tkdensity.Rd
@@ -0,0 +1,60 @@
+\name{tkdensity}
+\alias{tkdensity}
+\title{GUI Density Estimation using Tcl/Tk}
+\description{
+ This is graphical user interface (GUI) to \code{\link{density}},
+ allowing for dynamic bandwidth choice and a simple kind of zooming,
+ relying on \code{library(tcltk)}.
+}
+\usage{
+tkdensity(y, n = 1024, log.bw = TRUE, showvalue = TRUE,
+ xlim = NULL, do.rug = size < 1000, kernels = NULL,
+ from.f = if (log.bw) -2 else 1/1000,
+ to.f = if (log.bw) +2.2 else 2,
+ col = 2)
+}
+\arguments{
+ \item{y}{numeric; the data the density of which we want.}
+ \item{n}{integer; the number of abscissa values for
+ \code{\link{density}} evaluation (and plotting).}
+ \item{log.bw}{logical; if true (default), the gui scrollbar is on a
+ \emph{log} bandwidth scale, otherwise, simple interval.}
+ \item{showvalue}{logical; if true, the value of the current (log)
+ bandwidth is shown on top of the scrollbar.}
+ \item{xlim}{initial \code{xlim} for plotting, see \code{\link{plot.default}}.}
+ \item{do.rug}{logical indicating if \code{\link{rug}(y)} should be
+ added to each plot. This is too slow for really large sample sizes.}
+ \item{kernels}{character vector of kernel names as allowable for the
+ \code{kernels} argument of the standard \code{\link{density}} function.}
+ \item{from.f, to.f}{numeric giving the left and right limit of the
+ bandwidth scrollbar.}
+ \item{col}{color to be used for the density curve.}
+}
+\details{
+ \code{library(tcltk)} must be working, i.e., Tcl/Tk must have been
+ installed on your platform, and must have been visible during \R's
+ configuration and/or installation.
+
+ You can not only choose the bandwidth (the most important parameter),
+ but also the kernel, and you can zoom in and out (in x-range only).
+}
+\value{
+ none.\cr
+ (How could this be done? \code{tcltk} widgets run as separate processes!)
+}
+\author{Martin Maechler, building on \code{demo(tkdensity)}.}
+
+\examples{
+if (dev.interactive(TRUE)) ## does really not make sense otherwise
+ if(try(require("tcltk"))) { ## sometimes (rarely) there, but broken
+
+ data(faithful)
+ tkdensity(faithful $ eruptions)
+
+ set.seed(7)
+ if(require("nor1mix"))
+ tkdensity(rnorMix(1000, MW.nm9), kernels = c("gaussian", "epanechnikov"))
+ }
+}
+\keyword{hplot}
+\keyword{dynamic}
diff --git a/man/toLatex.numeric.Rd b/man/toLatex.numeric.Rd
new file mode 100644
index 0000000..914bd1c
--- /dev/null
+++ b/man/toLatex.numeric.Rd
@@ -0,0 +1,56 @@
+\name{toLatex.numeric}
+\alias{toLatex.numeric}
+\title{LaTeX or Sweave friendly Formatting of Numbers}
+\description{
+ Formats real numbers, possibly in scientific notation, with a given
+ number of digits after the decimal point. Output can be used in LaTeX
+ math mode, e.g., for printing numbers in a table, where each number
+ has to be printed with the same number of digits after the decimal
+ point, even if the last digits are zeros.
+}
+\usage{
+\method{toLatex}{numeric}(object, digits = format.info(object)[2],
+ scientific = format.info(object)[3] > 0, times = "\\\\cdot", \dots)
+}
+\arguments{
+ \item{object}{a numeric vector.}
+ \item{digits}{number of digits \emph{after the decimal point} (for the
+ mantissa if \code{scientific}). The default behaves the same as \R's
+ \code{\link{format}()}.}
+ \item{scientific}{logical indicating if scientific notation \code{a *
+ 10^k} should be used. The default behaves the same as \R's
+ \code{\link{format}()}.}
+ \item{times}{character string indicating the LaTeX symbol to be used for
+ the \sQuote{times} sign.}
+ \item{\dots}{unused; for compatibility with \code{\link{toLatex}}.}
+}
+\note{We use \code{digits} for \code{\link{round}}, i.e., round after
+ the decimal point on purpose, rather than \code{\link{signif}()}icant
+ digit rounding as used by \code{\link{print}()} or
+ \code{\link{format}()}.
+}
+\value{
+ a \code{\link{character}} vector of the same length as \code{object},
+ containing the formatted numbers.
+}
+\author{
+ Alain Hauser% and Martin -- E-mail ? for harvesters
+}
+\seealso{
+ \code{\link{pretty10exp}} which gives \code{\link{expression}}s
+ similar to our \code{scientific=TRUE}.
+ \code{\link{toLatex}} with other methods.
+}
+\examples{
+xx <- pi * 10^(-9:9)
+
+format(xx)
+formatC(xx)
+
+toLatex(xx) #-> scientific = TRUE is chosen
+toLatex(xx, scientific=FALSE)
+
+sapply(xx, toLatex)
+sapply(xx, toLatex, digits = 2)
+}
+\keyword{misc}
diff --git a/man/u.Datumvonheute.Rd b/man/u.Datumvonheute.Rd
new file mode 100644
index 0000000..332fb3f
--- /dev/null
+++ b/man/u.Datumvonheute.Rd
@@ -0,0 +1,44 @@
+\name{u.Datumvonheute}
+\alias{u.Datumvonheute}
+\alias{C.Monatsname}
+\alias{C.Wochentag}
+\alias{C.Wochentagkurz}
+\alias{C.weekday}
+\title{Datum und Uhrzeit (auf deutsch)}
+\description{
+ Return current date and time as a string, possibly including day of
+ the week in \emph{German}.
+}
+\usage{
+u.Datumvonheute(W.tag=2, Zeit=FALSE)
+
+C.Monatsname
+C.Wochentag
+C.Wochentagkurz
+C.weekday
+}
+\arguments{
+ \item{W.tag}{logical or integer specifying you want weekday (\sQuote{Wochentag}).
+ \code{0} or \code{FALSE} gives no, \code{1} or \code{TRUE} gives a
+ short and \code{2} the long version of the day of the week.}
+ \item{Zeit}{logical or integer specifying if time ("Zeit") is desired.
+ \code{0} or \code{FALSE} gives no, \code{1} or \code{TRUE} gives a
+ hours only and \code{2} hours and minutes.}
+}
+\value{
+ A string with the current date/time, in the form specified by the arguments.
+
+ The \code{C.*} are \code{\link{character}} vector \dQuote{constants},
+ the German ones actually used by \code{u.Datumvonheute}.
+}
+\author{Caterina Savi, Martin Maechler}
+\seealso{\code{\link{u.date}} for a similar English version, and
+ \code{\link{p.datum}} which plots.
+ For English month names, etc \code{\link{month.name}}.
+}
+\examples{
+u.Datumvonheute()
+u.Datumvonheute(W.tag=1, Zeit=TRUE)
+u.Datumvonheute(W.tag= FALSE, Zeit=2)
+}
+\keyword{utilities}
diff --git a/man/u.assign0.Rd b/man/u.assign0.Rd
new file mode 100644
index 0000000..6d9dc87
--- /dev/null
+++ b/man/u.assign0.Rd
@@ -0,0 +1,27 @@
+\name{u.assign0}
+\alias{u.assign0}
+\alias{u.get0}
+\title{'Portable' assign / get functions (R / S-plus) for 'Frame 0'}
+\description{
+ \R does not have S' concept of \code{frame = 0}, aka \sQuote{session
+ frame}. These two function were an attempt to provide a portable
+ way for working with frame 0, particularly when porting code
+ \emph{from} S.
+
+ They have been \bold{deprecated} since August 2013.
+}
+\usage{
+u.assign0(x, value, immediate = FALSE)
+u.get0(x)
+}
+\arguments{
+ \item{x}{character string giving the \emph{name} of the object.}
+ \item{value}{any \R object which is to be assigned.}
+ \item{immediate}{logical, for S compatibility. No use in \R.}
+}
+\author{Martin Maechler}
+\note{Really don't use these anymore...}
+\seealso{\code{\link{get}}, \code{\link{assign}}.}
+%
+\keyword{utilities}
+\keyword{environment}% System, not R
diff --git a/man/u.boxplot.x.Rd b/man/u.boxplot.x.Rd
new file mode 100644
index 0000000..3277094
--- /dev/null
+++ b/man/u.boxplot.x.Rd
@@ -0,0 +1,28 @@
+\name{u.boxplot.x}
+\alias{u.boxplot.x}
+\title{Utility Returning x-Coordinates of Boxplot}
+\description{
+ Return the x-coordinates in an \sQuote{n-way} side-by-side boxplot.
+ This is an auxiliary function and exists mainly for backcompatibility
+ with S-plus.
+}
+\usage{
+u.boxplot.x(n, j = 1:n, fullrange = 100)
+}
+\arguments{
+ \item{n}{number of boxplots.}
+ \item{j}{indices of boxplots.}
+ \item{fullrange}{x-coords as 'uniform' in \eqn{[0,fullrange]};
+ (f.=100, corresponds to Splus 3.x (x = 1,2)).}
+}
+\value{
+ a numeric vector of length \code{n}, with values inside \eqn{(0,M)} where
+ \eqn{M = } \code{fullrange}.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{boxplot}}.}
+\examples{
+ u.boxplot.x(7) # == 8.93 22.62 36.3 ... 91.07
+}
+\keyword{dplot}
+\keyword{utilities}
diff --git a/man/u.date.Rd b/man/u.date.Rd
new file mode 100644
index 0000000..36ce1a6
--- /dev/null
+++ b/man/u.date.Rd
@@ -0,0 +1,22 @@
+\name{u.date}
+\alias{u.date}
+\title{Return Date[-Time] String in 'European' Format}
+\description{
+ Return one string of the form "day/month/year", plus "hour:minutes",
+ optionally.
+}
+\usage{
+u.date(short=FALSE)
+}
+\arguments{\item{short}{logical; if \code{TRUE}, no time is given.}
+}
+\value{String with current date (and time).
+}
+\author{Martin Maechler, ca. 1992}
+\seealso{\code{\link{u.Datumvonheute}}.}
+\examples{
+u.date()
+u.date(short = TRUE)
+}
+\keyword{utilities}
+
diff --git a/man/u.datumdecode.Rd b/man/u.datumdecode.Rd
new file mode 100644
index 0000000..3e71c7f
--- /dev/null
+++ b/man/u.datumdecode.Rd
@@ -0,0 +1,40 @@
+\name{u.datumdecode}
+\alias{u.datumdecode}
+\title{Convert \dQuote{Numeric} Dates}
+\description{
+ Daten der Form 8710230920 aufspalten in Jahr, Monat, Tag, Std, Min
+}
+\usage{
+u.datumdecode(d, YMDHMnames = c("Jahr", "Monat", "Tag", "Std", "Min"))
+}
+\arguments{
+ \item{d}{numeric dates in the form YYMMDDHHMM.}
+ \item{YMDHMnames}{(column) names to be used for the result.}
+}
+% \details{
+% ~~ If necessary, more details than the __description__ above ~~
+% }
+\value{
+ a numeric matrix (or vector) with 5 columns containing the year,
+ month, etc.
+}
+\author{?? (someone at SfS ETH)}
+\note{
+ MM: This is a wrong concept, and also suffers from the \dQuote{millenium bug}
+ (by using only 2 digits for the year).
+}
+\seealso{\R's \emph{proper} date-time coding: \code{\link{DateTimeClasses}};
+ \code{\link{u.date}} etc.
+}
+\examples{
+u.datumdecode(8710230920)
+## Jahr Monat Tag Std Min
+## 87 10 23 9 20
+
+u.datumdecode(c(8710230900, 9710230920, 0210230920))
+## Jahr Monat Tag Std Min
+## [1,] 87 10 23 9 00
+## [2,] 97 10 23 9 20
+## [3,] 2 10 23 9 20
+}
+\keyword{utilities}
diff --git a/man/u.log.Rd b/man/u.log.Rd
new file mode 100644
index 0000000..f7f7258
--- /dev/null
+++ b/man/u.log.Rd
@@ -0,0 +1,34 @@
+\name{u.log}
+\alias{u.log}
+\title{(Anti)Symmetric Log High-Transform}
+\description{
+ Compute \eqn{log()} only for high values and keep low ones --
+ antisymmetrically such that \code{u.log(x)} is (once) continuously
+ differentiable, it computes
+%Fails \deqn{f(x) = \left\{\begin{array}{ll}
+%Fails x & for |x| \leq c \\
+%Fails sign(x) c (1 + \log(|x|/c)) & for |x| > c \end{array}}{%
+%Fails f(x) = x for |x| <= c and sign(x)*c*(1 + log(|x|/c)) for |x| >= c.}
+ \eqn{f(x) = x} for \eqn{|x| \le c}{|x| <= c} and
+ \eqn{sign(x) c\cdot(1 + log(|x|/c))}{sign(x)*c*(1 + log(|x|/c))}
+ for \eqn{|x| \ge c}{|x| >= c}.
+}
+\usage{
+u.log(x, c = 1)
+}
+\arguments{
+ \item{x}{numeric vector to be transformed.}
+ \item{c}{scalar, > 0}
+}
+\value{
+ numeric vector of same length as \code{x}.
+}
+\author{Martin Maechler, 24 Jan 1995}
+%\seealso{ ~~objects to SEE ALSO as \code{\link{~~fun~~}}, ~~~ }
+\examples{
+curve(u.log, -3, 10); abline(h=0, v=0, col = "gray20", lty = 3)
+curve(1 + log(x), .01, add = TRUE, col= "brown") # simple log
+curve(u.log(x, 2), add = TRUE, col=2)
+curve(u.log(x, c= 0.4), add = TRUE, col=4)
+}
+\keyword{arith}
diff --git a/man/u.sys.Rd b/man/u.sys.Rd
new file mode 100644
index 0000000..e798401
--- /dev/null
+++ b/man/u.sys.Rd
@@ -0,0 +1,41 @@
+\name{u.sys}
+\title{'Portable' System function (R / S-plus)}
+\alias{u.sys}
+\alias{Sys.ps.cmd}% was in unix/Sys.ps.Rd
+\description{
+ \code{u.sys()} is a convenient wrapper (of \code{system()}) to call to
+ the underlying operating system. The main purpose has been to provide
+ a function with identical UI both in S-PLUS and \R.
+ MM thinks you shouldn't use this anymore, usually.
+
+ \code{Sys.ps.cmd()} returns the \samp{ps} (\sQuote{\bold{p}rocess \bold{s}tatus})
+ OS command name (as \code{\link{character}} string), and is typically
+ usable on unix alikes only.% Windows with 'Rtools' installed ??
+}
+\usage{
+u.sys(\dots, intern = TRUE)
+
+Sys.ps.cmd()
+}
+\arguments{
+ \item{\dots}{any number of strings -- which will be
+ \code{\link{paste}()}d together and passed to \code{system}.}
+ \item{intern}{logical -- note that the default is \emph{reversed} from
+ the one in \code{\link{system}()}.}
+}
+\author{Martin Maechler}
+\seealso{\code{\link{system}}, really!;
+ on non-Windows, \code{Sys.ps()} which makes use of \code{Sys.ps.cmd()}.
+}
+\examples{
+u.sys # shows how simply the function is defined :
+\dontrun{
+ function (..., intern = TRUE)
+ system(paste(..., sep = ""), intern = intern)
+}
+
+# All *running* processes of user [sometimes only R]:
+try ( u.sys(Sys.ps.cmd(), "ur") )
+}
+\keyword{utilities}
+\keyword{environment}% System, not R
diff --git a/man/unif.Rd b/man/unif.Rd
new file mode 100644
index 0000000..11a4bd1
--- /dev/null
+++ b/man/unif.Rd
@@ -0,0 +1,33 @@
+\name{unif}
+\alias{unif}
+\title{Nice Uniform Points in Interval}
+\description{
+ Give regularly spaced points on interval \eqn{[-c,c]} with mean 0
+ (exactly) and variance about 1 (very close for \bold{even} \code{n}
+ and larger \code{round.dig}). Note that \eqn{c} depends on \code{n}.
+}
+\usage{
+unif(n, round.dig = 1 + trunc(log10(n)))
+}
+\arguments{
+ \item{n}{positive integer specifying the number of points desired.}
+ \item{round.dig}{integer indicating to how many digits the result is
+ rounded.}
+}
+\value{
+ numeric vector of length \code{n}, symmetric around 0, hence
+ with exact mean \code{0}, and variance approximately 1.
+}
+\note{It relies on the fact that \eqn{Var(1,2,...,n) = n(n+1)/12}.
+}
+\author{Martin Maechler, ca 1990}
+\seealso{\code{\link{runif}} for producing uniform \emph{random} numbers.}
+\examples{
+(u <- unif(8))
+var(u)
+
+(u. <- unif(8, 12))# more digits in result, hence precision for Var :
+var(u.)
+}
+\keyword{arith}
+\keyword{utilities}
diff --git a/man/uniqueL.Rd b/man/uniqueL.Rd
new file mode 100644
index 0000000..6aabc27
--- /dev/null
+++ b/man/uniqueL.Rd
@@ -0,0 +1,44 @@
+\name{uniqueL}
+\alias{uniqueL}
+\title{A Reversable Version of unique()}
+\description{
+ A version of \code{\link{unique}} keeping enough information to
+ reverse (or \emph{invert}) to the original data.
+}
+\usage{
+uniqueL(x, isuniq = !duplicated(x), need.sort = is.unsorted(x))
+}
+\arguments{
+ \item{x}{numeric vector, of length \code{n}, say.}
+ \item{isuniq}{logical vector of the same length as \code{x}. For the
+ reversion to work this should select at least all unique values of
+ \code{x}.}
+ \item{need.sort}{logical indicating if \code{x} is not yet sorted.
+ Note that this argument exists only for speedup possibility when it
+ is known, and that it \emph{must be set correctly}.}
+}
+\value{
+ list of two components,
+ \item{ix}{integer vector of indices}
+ \item{xU}{vector of values from \code{x}}
+ such that both \code{x[isuniq] === xU} and \code{xU[ix] === x}.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{Duplicated}} from the \pkg{sfsmisc} package in
+ addition to the standard \code{\link{unique}} and
+ \code{\link{duplicated}}.
+}
+\examples{
+ x0 <- c(1:3,2:7,8:4)
+ str(r0 <- uniqueL(x0))
+ with(r0, xU[ix]) ## == x0 !
+\dontshow{
+ for(n in 1:100) {
+ x0 <- round((1+rpois(1,lam=1))*rnorm(40))
+ r0 <- uniqueL(x0)
+ stopifnot(sort(unique(x0)) == r0$xU,
+ with(r0, xU[ix]) == x0)
+ }
+}
+}
+\keyword{utilities}
diff --git a/man/unix/Sys.cpuinfo.Rd b/man/unix/Sys.cpuinfo.Rd
new file mode 100644
index 0000000..2118a30
--- /dev/null
+++ b/man/unix/Sys.cpuinfo.Rd
@@ -0,0 +1,77 @@
+\name{Sys.cpuinfo}
+\alias{Sys.procinfo}
+\alias{Sys.cpuinfo}
+\alias{Sys.meminfo}
+\alias{Sys.memGB}
+\alias{Sys.MIPS}
+\title{Provide Information about the Linux Hardware (CPU, Memory, etc)}
+\description{
+ Return information about the Linux hardware, notably
+ the CPU (the central processor unit) and memory of the
+ computer \R is running on.
+ This is currently \bold{only available for Linux}.
+
+ These functions exist on other unix-alike platforms, but produce an
+ error when called.
+}
+\usage{
+Sys.procinfo(procfile)
+Sys.cpuinfo()
+Sys.meminfo()
+Sys.memGB(kind = "MemTotal")
+Sys.MIPS()
+}
+\arguments{
+ \item{procfile}{name of file the lines of which give the CPU info ``as
+ on Linux''}
+ \item{kind}{a \code{\link{character}} string specifying which
+ \emph{kind} of memory is desired.}
+}
+\value{
+ The \code{Sys.*info()} functions return a \code{"simple.list"},
+ here basically a named character vector,
+ (where the names have been filtered through \code{\link{make.names}(*,
+ unique=TRUE)} which is of importance for multi-processor or multi-core
+ CPUs, such that vector can easily be indexed.
+
+ \code{Sys.memGB()} returns available memory in giga bytes [GB];\cr
+ \code{Sys.MIPS()} returns a number giving an approximation of
+ the \bold{M}illion \bold{I}instructions \bold{P}er \bold{S}econd that
+ the CPU processes (using \dQuote{bogomips}). This is a performance
+ measure of the basic \emph{non-numeric} processing capabilities.
+ For single-core Linux systems, often about twice the basic clock rate
+ in ``MHz'' (as available by \code{Sys.cpuinfo()["cpu.MHz"]}); now,
+ with multicore systems, the result is often around (but smaller than)
+ \code{2 * #\{cores\} * clock.rate}.
+}
+\author{Martin Maechler}
+\note{These currently do rely on the Linux \file{/proc/} file system, and may not
+ easily be portable to non-Linux environments.
+
+ On multi-processor machines, \code{Sys.cpuinfo()} contains each field
+ for each processor (i.e., \code{names(Sys.cpuinfo())} has
+ \code{\link{duplicated}} entries).
+
+ Conceivably, the bogoMIPS source code is open and available and could
+ be built into \R.
+}
+\seealso{\code{\link{Sys.ps}}, etc.}
+
+\examples{
+(n.cores <- parallel::detectCores())
+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")
+}
+}
+\keyword{utilities}
diff --git a/man/unix/Sys.ps.Rd b/man/unix/Sys.ps.Rd
new file mode 100644
index 0000000..91b0e1c
--- /dev/null
+++ b/man/unix/Sys.ps.Rd
@@ -0,0 +1,475 @@
+\name{Sys.ps}
+\title{Return Process Status (Unix 'ps') Information}
+\alias{Sys.ps}
+%\alias{Sys.ps.cmd}-> now in ../u.sys.Rd
+\alias{Sys.sizes}
+\description{
+ These functions return process id and status information, typically
+ about the running \R process.
+}
+\usage{
+Sys.ps(process= Sys.getpid(),
+ fields = c("pid", "pcpu", "time", "vsz", "comm"),
+ usefile = length(fields) > 10,
+ ps.cmd = Sys.ps.cmd(),
+ verbose = getOption("verbose"),
+ warn.multi = verbose || any(fields != "ALL"))
+
+Sys.sizes(process = Sys.getpid(), ps.cmd = Sys.ps.cmd())
+}
+\arguments{
+ \item{process}{the process id, an integer.}
+ \item{fields}{character strings of \code{"ALL"}, specifying which
+ process status fields are desired.}
+ \item{usefile}{logical; if true, \code{\link{system}} writes to a
+ temporary file and that is \code{\link{scan}}ed subsequently.}
+ \item{ps.cmd}{character string, giving the ``ps'' command name to be used.}
+ \item{verbose}{logical ...}
+ \item{warn.multi}{logical ...}
+}
+\details{
+ Use \code{man ps} on your respective Unix system, to see what fields are
+ supported exactly. Unix dialects \emph{do} differ here, and,
+ SunOS-Solaris even has more than one ps command\dots
+%%---- Solaris 2.5.1 man ps has :
+
+%% DISPLAY FORMATS
+%% Under the -f option, ps tries to determine the command name
+%% and arguments given when the process was created by examin-
+%% ing the user block. Failing this, the command name is
+%% printed, as it would have appeared without the -f option, in
+%% square brackets.
+%%
+%% The column headings and the meaning of the columns in a ps
+%% listing are given below; the letters f and l indicate the
+%% option (full or long, respectively) that causes the
+%% corresponding heading to appear; all means that the heading
+%% always appears. Note: These two options determine only
+%% what information is provided for a process; they do not
+%% determine which processes will be listed.
+%%
+%% F (l) Flags (hexadecimal and additive) associ-
+%% ated with the process. These flags are
+%% available for historical purposes; no
+%% meaning should be currently ascribed to
+%% them.
+%%
+%% S (l) The state of the process:
+%%
+%% O Process is running on a processor.
+%% S Sleeping: process is waiting for an
+%% event to complete.
+%% R Runnable: process is on run queue.
+%% Z Zombie state: process terminated
+%% and parent not waiting.
+%% T Process is stopped, either by a job
+%% control signal or because it is
+%% being traced.
+%%
+%% UID (f,l) The effective user ID number of the pro-
+%% cess (the login name is printed under
+%% the -f option).
+%%
+%% PID (all) The process ID of the process (this
+%% datum is necessary in order to kill a
+%% process).
+%%
+%% PPID (f,l) The process ID of the parent process.
+%%
+%% C (f,l) Processor utilization for scheduling
+%% (obsolete). Not printed when the -c
+%% option is used.
+%%
+%% CLS (f,l) Scheduling class. Printed only when the
+%% -c option is used.
+%%
+%% PRI (l) The priority of the process. Without
+%% the -c option, higher numbers mean lower
+%% priority. With the -c option, higher
+%% numbers mean higher priority.
+%%
+%% NI (l) Nice value, used in priority computa-
+%% tion. Not printed when the -c option is
+%% used. Only processes in the certain
+%% scheduling classes have a nice value.
+%%
+%% ADDR (l) The memory address of the process.
+%%
+%% SZ (l) The size (in pages) of the swappable
+%% process's image in main memory.
+%%
+%% WCHAN (l) The address of an event for which the
+%% process is sleeping (if blank, the pro-
+%% cess is running).
+%%
+%% STIME (f) The starting time of the process, given
+%% in hours, minutes, and seconds. (A pro-
+%% cess begun more than twenty-four hours
+%% before the ps inquiry is executed is
+%% given in months and days.)
+%%
+%% TTY (all) The controlling terminal for the process
+%% (the message, ?, is printed when there
+%% is no controlling terminal).
+%%
+%% TIME (all) The cumulative execution time for the
+%% process.
+%%
+%% CMD (all) The command name (the full command name
+%% and its arguments, up to a limit of 80
+%% characters, are printed under the -f
+%% option).
+%%
+%% The following two additional columns are printed when the -j
+%% option is specified:
+%%
+%% PGID The process ID of the process group
+%% leader.
+%%
+%% SID The process ID of the session leader.
+%%
+%% A process that has exited and has a parent, but has not yet
+%% been waited for by the parent, is marked <defunct>.
+%%
+%% -o format
+%% The -o option allows the output format to be specified under
+%% user control.
+%%
+%% The format specification must be a list of names presented
+%% as a single argument, blank- or comma-separated. Each vari-
+%% able has a default header. The default header can be over-
+%% ridden by appending an equals sign and the new text of the
+%% header. The rest of the characters in the argument will be
+%% used as the header text. The fields specified will be writ-
+%% ten in the order specified on the command line, and should
+%% be arranged in columns in the output. The field widths will
+%% be selected by the system to be at least as wide as the
+%% header text (default or overridden value). If the header
+%% text is null, such as -o user=, the field width will be at
+%% least as wide as the default header text. If all header
+%% text fields are null, no header line will be written.
+%%
+%% The following names are recognized in the POSIX locale:
+%%
+%% user The effective user ID of the process. This will
+%% be the textual user ID, if it can be obtained
+%% and the field width permits, or a decimal
+%% representation otherwise.
+%%
+%% ruser The real user ID of the process. This will be
+%% the textual user ID, if it can be obtained and
+%% the field width permits, or a decimal represen-
+%% tation otherwise.
+%%
+%% group The effective group ID of the process. This
+%% will be the textual group ID, if it can be
+%% obtained and the field width permits, or a
+%% decimal representation otherwise.
+%%
+%% rgroup The real group ID of the process. This will be
+%% the textual group ID, if it can be obtained and
+%% the field width permits, or a decimal represen-
+%% tation otherwise.
+%%
+%% pid The decimal value of the process ID.
+%%
+%% ppid The decimal value of the parent process ID.
+%%
+%% pgid The decimal value of the process group ID.
+%%
+%% pcpu The ratio of CPU time used recently to CPU time
+%% available in the same period, expressed as a
+%% percentage. The meaning of ``recently'' in this
+%% context is unspecified. The CPU time available
+%% is determined in an unspecified manner.
+%%
+%% vsz The size of the process in (virtual) memory in
+%% kilobytes as a decimal integer.
+%%
+%% nice The decimal value of the system scheduling
+%%
+%% priority of the process. See nice(1).
+%%
+%% etime In the POSIX locale, the elapsed time since the
+%% process was started, in the form:
+%% [[dd-]hh:]mm:ss
+%%
+%% where
+%%
+%% dd will represent the number of days,
+%% hh the number of hours,
+%% mm the number of minutes, and
+%% ss the number of seconds.
+%%
+%% The dd field will be a decimal integer. The hh,
+%% mm and ss fields will be two-digit decimal
+%% integers padded on the left with zeros.
+%%
+%% time In the POSIX locale, the cumulative CPU time of
+%% the process in the form:
+%% [dd-]hh:mm:ss
+%%
+%% The dd, hh, mm, and ss fields will be as
+%% described in the etime specifier.
+%%
+%% tty The name of the controlling terminal of the pro-
+%% cess (if any) in the same format used by the
+%% who(1) command.
+%%
+%% comm The name of the command being executed (argv[0]
+%% value) as a string.
+%%
+%% args The command with all its arguments as a string.
+%% The implementation may truncate this value to
+%% the field width; it is implementation-dependent
+%% whether any further truncation occurs. It is
+%% unspecified whether the string represented is a
+%% version of the argument list as it was passed to
+%% the command when it started, or is a version of
+%% the arguments as they may have been modified by
+%% the application. Applications cannot depend on
+%% being able to modify their argument list and
+%% having that modification be reflected in the
+%% output of ps. The Solaris implementation limits
+%% the string to 80 bytes; the string is the ver-
+%% sion of the argument list as it was passed to
+%% the command when it started.
+%%
+%% The following names are recognized in the Solaris implemen-
+%% tation:
+%%
+%% f Flags (hexadecimal and additive) associated with
+%% the process.
+%%
+%% s The state of the process.
+%%
+%% c Processor utilization for scheduling (obsolete).
+%%
+%% uid The effective user ID number of the process as a
+%% decimal integer.
+%%
+%% ruid The real user ID number of the process as a
+%% decimal integer.
+%%
+%% gid The effective group ID number of the process as
+%% a decimal integer.
+%%
+%% rgid The real group ID number of the process as a
+%% decimal integer.
+%%
+%% sid The process ID of the session leader.
+%%
+%% class The scheduling class of the process.
+%%
+%% pri The priority of the process. Higher numbers
+%% mean higher priority.
+%%
+%% opri The obsolete priority of the process. Lower
+%% numbers mean higher priority.
+%%
+%% addr The memory address of the process.
+%%
+%% osz The size (in pages) of the swappable process's
+%% image in main memory.
+%%
+%% wchan The address of an event for which the process is
+%% sleeping (if -, the process is running).
+%%
+%% stime The starting time or date of the process,
+%% printed with no blanks.
+%%
+%% rss The resident set size of the process, in kilo-
+%% bytes as a decimal integer.
+%%
+%% pmem The ratio of the process's resident set size to
+%% the physical memory on the machine, expressed as
+%% a percentage.
+%%
+%% fname The first 8 bytes of the base name of the
+%% process's executable file.
+%%
+%% Only comm and args are allowed to contain blank characters;
+%% all others, including the Solaris implementation variables,
+%% are not.
+%%
+%% The following table specifies the default header to be used
+%% in the POSIX locale corresponding to each format specifier.
+%%
+%% _______________________________________________________________________
+%% | Format Specifier Default Header| Format Specifier Default Header|
+%% |__________________________________|___________________________________|
+%% | args COMMAND | ppid PPID |
+%% | comm COMMAND | rgroup RGROUP |
+%% | etime ELAPSED | ruser RUSER |
+%% | group GROUP | time TIME |
+%% | nice NI | tty TT |
+%% | pcpu %CPU | user USER |
+%% | pgid PGID | vsz VSZ |
+%% | pid PID | |
+%% |__________________________________|___________________________________|
+%%
+%% The following table lists the Solaris implementation format
+%% specifiers and the default header used with each.
+%%
+%% _______________________________________________________________________
+%% | Format Specifier Default Header| Format Specifier Default Header|
+%% |__________________________________|___________________________________|
+%% | addr ADDR | pri PRI |
+%% | c C | rgid RGID |
+%% | class CLS | rss RSS |
+%% | f F | ruid RUID |
+%% | fname COMMAND | s S |
+%% | gid GID | sid SID |
+%% | opri PRI | stime STIME |
+%% | osz SZ | uid UID |
+%% | pmem %MEM | wchan WCHAN |
+%% |__________________________________|___________________________________|
+%%
+
+
+%%--- Linux man ps has :
+
+%% STANDARD FORMAT SPECIFIERS
+%% These may be used to control both output format and sorting.
+%% For example:
+%% ps -eo pid,user,args --sort user
+%%
+%% CODE HEADER
+%% ---- ---------
+%% %cpu %CPU
+%% %mem %MEM
+%% alarm ALARM
+%% args COMMAND
+%% blocked BLOCKED
+%% bsdstart START
+%% bsdtime TIME
+%% c C
+%% caught CAUGHT
+%% cmd CMD
+%% comm COMMAND
+%% command COMMAND
+%% cputime TIME
+%% drs DRS
+%% dsiz DSIZ
+%% egid EGID
+%% egroup EGROUP
+%% eip EIP
+%% esp ESP
+%% etime ELAPSED
+%% euid EUID
+%% euser EUSER
+%% f F
+%% fgid FGID
+%% fgroup FGROUP
+%% flag F
+%% flags F
+%% fname COMMAND
+%% fsgid FSGID
+%% fsgroup FSGROUP
+%% fsuid FSUID
+%% fsuser FSUSER
+%% fuid FUID
+%% fuser FUSER
+%% gid GID
+%% group GROUP
+%% ignored IGNORED
+%% intpri PRI
+%% lim LIM
+%% longtname TTY
+%% lstart STARTED
+%% m_drs DRS
+%% m_trs TRS
+%% maj_flt MAJFL
+%% majflt MAJFLT
+%% min_flt MINFL
+%% minflt MINFLT
+%% ni NI
+%% nice NI
+%% nwchan WCHAN
+%% opri PRI
+%% pagein PAGEIN
+%% pcpu %CPU
+%% pending PENDING
+%% pgid PGID
+%% pgrp PGRP
+%% pid PID
+%% pmem %MEM
+%% ppid PPID
+%% pri PRI
+%% rgid RGID
+%% rgroup RGROUP
+%% rss RSS
+%% rssize RSS
+%% rsz RSZ
+%% ruid RUID
+%% ruser RUSER
+%% s S
+%% sess SESS
+%% session SESS
+%% sgi_p P
+%% sgi_rss RSS
+%% sgid SGID
+%% sgroup SGROUP
+%% sid SID
+%% sig PENDING
+%% sig_block BLOCKED
+%% sig_catch CATCHED
+%% sig_ignore IGNORED
+%% sig_pend SIGNAL
+%% sigcatch CAUGHT
+%% sigignore IGNORED
+%% sigmask BLOCKED
+%% stackp STACKP
+%% start STARTED
+%% start_stack STACKP
+%% start_time START
+%% stat STAT
+%% state S
+%% stime STIME
+%% suid SUID
+%% suser SUSER
+%% svgid SVGID
+%% svgroup SVGROUP
+%% svuid SVUID
+%% svuser SVUSER
+%% sz SZ
+%% time TIME
+%% timeout TMOUT
+%% tmout TMOUT
+%% tname TTY
+%% tpgid TPGID
+%% trs TRS
+%% trss TRSS
+%% tsiz TSIZ
+%% tt TT
+%% tty TT
+%% tty4 TTY
+%% tty8 TTY
+%% ucomm COMMAND
+%% uid UID
+%% uid_hack UID
+%% uname USER
+%% user USER
+%% vsize VSZ
+%% vsz VSZ
+%% wchan WCHAN
+
+%%------------------------------------
+%%
+}
+\value{
+ Note, that \code{Sys.sizes()} currently returns two integers which are
+ ``common'' to Solaris and Linux.
+}
+\author{Martin Maechler}
+\seealso{\code{\link{Sys.info}}, \code{\link{Sys.getpid}},
+ \code{\link{proc.time}}.
+}
+\examples{
+(.pid <- Sys.getpid()) ## process ID of current process
+Sys.sizes(.pid)
+
+## The default process statistics about the running R process
+try( Sys.ps() )
+}
+\keyword{utilities}
diff --git a/man/vcat.Rd b/man/vcat.Rd
new file mode 100644
index 0000000..afdb9a5
--- /dev/null
+++ b/man/vcat.Rd
@@ -0,0 +1,39 @@
+\name{vcat}
+\alias{vcat}
+\alias{ccat}
+\title{Paste Utilities -- Concatenate Strings}
+\description{
+ Con\bold{cat}enate vector elements or anything using
+ \code{\link{paste}(*, collapse = .)}.
+ These are simple short abbreviations I have been using in my own codes
+ in many places.
+}
+\usage{
+vcat(vec, sep = " ")
+ccat(...)
+}
+\arguments{
+ \item{vec, \dots}{any vector and other arguments to be pasted to together.}
+ \item{sep}{the separator to use, see the \emph{Details} section.}
+}
+\details{The functions are really just defined as\cr
+ vcat := \code{function(vec, sep = " ") paste(vec, collapse = sep)}
+
+ ccat := \code{function(...) paste(..., collapse = "", sep = "")}
+}
+\value{
+ a character string (of length 1) with the concatenated arguments.
+}
+\author{Martin Maechler, early 1990's.}
+\seealso{\code{\link{paste}}, \code{\link{as.character}},
+ \code{\link{format}}. \code{\link{cat}()} is really for printing.
+}
+\examples{
+ch <- "is"
+ccat("This ", ch, " it: ", 100, "\%")
+vv <- c(1,pi, 20.4)
+vcat(vv)
+vcat(vv, sep = ", ")
+}
+\keyword{print}
+\keyword{utilities}
diff --git a/man/wrapFormula.Rd b/man/wrapFormula.Rd
new file mode 100644
index 0000000..9b5812b
--- /dev/null
+++ b/man/wrapFormula.Rd
@@ -0,0 +1,50 @@
+\name{wrapFormula}
+\alias{wrapFormula}
+\title{Enhance Formula by Wrapping each Term, e.g., by "s(.)"}
+\description{
+ The main motivation for this function has been the easy construction
+ of a \dQuote{full GAM formula} from something as simple as
+ \code{Y ~ .}. \cr
+ The potential use is slightly more general.
+}
+\usage{
+wrapFormula(f, data, wrapString = "s(*)")
+}
+\arguments{
+ \item{f}{the initial \code{\link{formula}}; typically something like
+ \code{Y ~ .}.}
+ \item{data}{\code{\link{data.frame}} to which the formula applies;
+ see, \code{\link{formula}} or also \code{\link[mgcv]{gam}} or
+ \code{\link{lm}}.}
+ \item{wrapString}{\code{\link{character}} string, containing
+ \code{"*"}, specifying the wrapping expression to use.}
+}
+\value{
+ a \code{\link{formula}} very similar to \code{f}; just replacing each
+ \emph{additive} term by its wrapped version.
+}
+\note{
+ There are limits for this to work correctly; notably the right hand
+ side of the formula \code{f} should not be nested or otherwise
+ complicated, rather typically just \code{ . } as in the examples.
+}
+\author{Martin Maechler, May 2007.}
+\seealso{\code{\link{formula}};
+ \code{\link[mgcv]{gam}} from package \pkg{mgcv} (or also from
+ package \pkg{gam}).
+}
+\examples{
+myF <- wrapFormula(Fertility ~ . , data = swiss)
+myF # Fertility ~ s(Agriculture) + s(....) + ...
+
+if(require("mgcv")) {
+ m1 <- gam(myF, data = swiss)
+ print( summary(m1) )
+ plot(m1, pages = 1) ; title(format(m1$call), line= 2.5)
+}
+
+## other wrappers:
+wrapFormula(Fertility ~ . , data = swiss, wrap = "lo(*)")
+wrapFormula(Fertility ~ . , data = swiss, wrap = "poly(*, 4)")
+}
+\keyword{models}
diff --git a/man/xy.grid.Rd b/man/xy.grid.Rd
new file mode 100644
index 0000000..728cd31
--- /dev/null
+++ b/man/xy.grid.Rd
@@ -0,0 +1,33 @@
+\name{xy.grid}
+\alias{xy.grid}
+\title{Produce regular grid matrix.}
+\description{
+ Produce the grid used by \code{\link{persp}}, \link{contour}, etc, as
+ an \code{N x 2} matrix.
+ This is really outdated by \code{\link{expand.grid}()} nowadays.
+}
+\usage{
+xy.grid(x, y)
+}
+\arguments{
+ \item{x,y}{any vectors of same mode.}
+}
+\value{
+ a 2-column matrix of \dQuote{points} for each combination of \code{x} and
+ \code{y}, i.e. with \code{length(x) * length(y)} rows.
+}
+\author{Martin Maechler, 26 Oct 1994.}
+\seealso{\code{\link{expand.grid}} which didn't exist when
+ \code{xy.grid} was first devised.}
+\examples{
+plot(xy.grid(1:7, 10*(0:4)))
+
+x <- 1:3 ; y <- 10*(0:4)
+xyg <- xy.grid(x,y)
+
+## Compare with expand.grid() :
+m2 <- as.matrix(expand.grid(y,x)[, 2:1])
+dimnames(m2) <- NULL
+stopifnot(identical(xyg, m2))
+}
+\keyword{array}
diff --git a/man/xy.unique.x.Rd b/man/xy.unique.x.Rd
new file mode 100644
index 0000000..47f4a9b
--- /dev/null
+++ b/man/xy.unique.x.Rd
@@ -0,0 +1,42 @@
+\name{xy.unique.x}
+\alias{xy.unique.x}
+\title{Uniqify (X,Y) Values using Weights}
+\description{
+ Given \emph{smoother} data \eqn{(x_i, y_i)} and maybe weights \eqn{w_i},
+ with multiple \eqn{x_i}, use the unique x values, replacing the
+ \eqn{y}'s by their (weighted) mean and updating the weights
+ accordingly.
+}
+\usage{
+xy.unique.x(x, y, w, fun.mean = mean, \dots)
+}
+\arguments{
+ \item{x,y}{numeric vectors of same length. Alternatively, \code{x}
+ can be a \sQuote{xy} like structure, see \code{\link{xy.coords}}.}
+ \item{w}{numeric vector of non-negative weights -- or missing which
+ corresponds to all weights equal.}
+ \item{fun.mean}{the mean \code{\link{function}} to use.}
+ \item{\dots}{optional arguments all passed to \code{\link{unique}}.}
+}
+\value{
+ Numeric matrix with three columns, named
+ \code{x}, \code{y} and \code{w} with unique \code{x} values and
+ corresponding \code{y} and weights \code{w}.
+}
+\author{Martin Maechler, 8 Mar 1993.}
+\seealso{e.g., \code{\link{smooth.spline}} uses something like
+ this internally.}
+\examples{
+## simple example:
+x <- c(1,1,2,4,3,1)
+y <- 1:6
+rbind(x, y)
+xy.unique.x(x, y)
+# x y w
+# 1 1 3 3
+# 2 2 3 1
+# 3 4 4 1
+# 4 3 5 1
+xy.unique.x(x, y, fromLast = TRUE)
+}
+\keyword{utilities}
diff --git a/tests/dDA.R b/tests/dDA.R
new file mode 100644
index 0000000..8a92df3
--- /dev/null
+++ b/tests/dDA.R
@@ -0,0 +1,76 @@
+library(sfsmisc)
+
+###--------------- "Iris Example for ever" ----------------------------
+data(iris)
+cl.true <- as.integer(iris[,"Species"])
+n <- length(cl.true)
+stopifnot(cl.true == rep(1:3, each = 50))
+m.iris <- data.matrix(iris[, 1:4])
+
+.proctime00 <- proc.time()
+
+## Self Prediction: Not too good (2+4 and 3+3 misclass.)
+table(diagDA(m.iris, cl.true, m.iris), cl.true)
+table(diagDA(m.iris, cl.true, m.iris, pool=FALSE), cl.true)
+
+## Crossvalidation: The same example as knn() & knn1() from "class" :
+data(iris3)
+train <- rbind(iris3[1:25,,1], iris3[1:25,,2], iris3[1:25,,3])
+test <- rbind(iris3[26:50,,1], iris3[26:50,,2], iris3[26:50,,3])
+cl <- rep(1:3, each = 25)
+
+pcl <- diagDA(train, cl, test)
+table(pcl, cl)## 0 + 1 + 2 misclassified
+## knn ( k=1) has 0 + 1 + 3
+## knn ( *, k=3) has 0 + 2 + 3 ==> ``diagDA() is best ..''
+
+stopifnot(pcl == diagDA(train,cl, test, pool = FALSE))
+ # i.e. quadratic identical here
+
+### Test 'NA' in predict dat.fr
+set.seed(753)
+itr <- sample(n, 0.9 * n)
+lrn <- m.iris[ itr,]
+tst <- m.iris[-itr,]
+dd <- dDA(lrn, cl.true[itr])
+pd0 <- predict(dd, tst)
+
+i.NA <- c(3:5,7,11)
+j.NA <- sample(1:ncol(tst), size=length(i.NA), replace=TRUE)
+tst[cbind(i.NA, j.NA)] <- NA
+pdd <- predict(dd, tst)
+pcl <- diagDA(lrn, cl.true[itr], tst)
+stopifnot(length(pdd) == nrow(tst),
+ identical(pdd, pcl),
+ pdd[-i.NA] == pd0[-i.NA],
+ which(is.na(pdd)) == i.NA)
+
+## Now do some (randomized) CV :
+## for each observation, count how often it's misclassified
+M <- 200
+set.seed(234)
+missCl <- integer(n)
+for(m in 1:M) {
+ itr <- sample(n, 0.9 * n)
+ lrn <- m.iris[ itr,]
+ tst <- m.iris[-itr,]
+ pcl <- diagDA(lrn, cl.true[itr], tst)
+ stopifnot(pcl == predict(dDA(lrn, cl.true[itr]), tst))
+ missCl <- missCl + as.integer(pcl != cl.true[ - itr])
+}
+missCl ; mean(missCl) / M
+
+## The "same" with 'pool=FALSE' :
+missCl <- integer(n)
+for(m in 1:M) {
+ itr <- sample(n, 0.9 * n)
+ lrn <- m.iris[ itr,]
+ tst <- m.iris[-itr,]
+ pcl <- diagDA(lrn, cl.true[itr], tst, pool=FALSE)
+ stopifnot(pcl == predict(dDA(lrn, cl.true[itr], pool=FALSE), tst))
+ missCl <- missCl + as.integer(pcl != cl.true[ - itr])
+}
+missCl ; mean(missCl) / M ## here somewhat worse than linear
+
+cat('Time elapsed: ', proc.time() - .proctime00,'\n')
+
diff --git a/tests/dDA.Rout.save b/tests/dDA.Rout.save
new file mode 100644
index 0000000..2d17775
--- /dev/null
+++ b/tests/dDA.Rout.save
@@ -0,0 +1,123 @@
+
+R : Copyright 2004, The R Foundation for Statistical Computing
+Version 2.1.0 Under development (unstable) (2004-12-09), ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for a HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(sfsmisc)
+>
+> ###--------------- "Iris Example for ever" ----------------------------
+> data(iris)
+> cl.true <- as.integer(iris[,"Species"])
+> n <- length(cl.true)
+> stopifnot(cl.true == rep(1:3, each = 50))
+> m.iris <- data.matrix(iris[, 1:4])
+>
+> .proctime00 <- proc.time()
+>
+> ## Self Prediction: Not too good (2+4 and 3+3 misclass.)
+> table(diagDA(m.iris, cl.true, m.iris), cl.true)
+ cl.true
+ 1 2 3
+ 1 50 0 0
+ 2 0 48 4
+ 3 0 2 46
+> table(diagDA(m.iris, cl.true, m.iris, pool=FALSE), cl.true)
+ cl.true
+ 1 2 3
+ 1 50 0 0
+ 2 0 47 3
+ 3 0 3 47
+>
+> ## Crossvalidation: The same example as knn() & knn1() from "class" :
+> data(iris3)
+> train <- rbind(iris3[1:25,,1], iris3[1:25,,2], iris3[1:25,,3])
+> test <- rbind(iris3[26:50,,1], iris3[26:50,,2], iris3[26:50,,3])
+> cl <- rep(1:3, each = 25)
+>
+> pcl <- diagDA(train, cl, test)
+> table(pcl, cl)## 0 + 1 + 2 misclassified
+ cl
+pcl 1 2 3
+ 1 25 0 0
+ 2 0 24 2
+ 3 0 1 23
+> ## knn ( k=1) has 0 + 1 + 3
+> ## knn ( *, k=3) has 0 + 2 + 3 ==> ``diagDA() is best ..''
+>
+> stopifnot(pcl == diagDA(train,cl, test, pool = FALSE))
+> # i.e. quadratic identical here
+>
+> ### Test 'NA' in predict dat.fr
+> set.seed(753)
+> itr <- sample(n, 0.9 * n)
+> lrn <- m.iris[ itr,]
+> tst <- m.iris[-itr,]
+> dd <- dDA(lrn, cl.true[itr])
+> pd0 <- predict(dd, tst)
+>
+> i.NA <- c(3:5,7,11)
+> j.NA <- sample(1:ncol(tst), size=length(i.NA), replace=TRUE)
+> tst[cbind(i.NA, j.NA)] <- NA
+> pdd <- predict(dd, tst)
+> pcl <- diagDA(lrn, cl.true[itr], tst)
+> stopifnot(length(pdd) == nrow(tst),
++ identical(pdd, pcl),
++ pdd[-i.NA] == pd0[-i.NA],
++ which(is.na(pdd)) == i.NA)
+>
+> ## Now do some (randomized) CV :
+> ## for each observation, count how often it's misclassified
+> M <- 200
+> set.seed(234)
+> missCl <- integer(n)
+> for(m in 1:M) {
++ itr <- sample(n, 0.9 * n)
++ lrn <- m.iris[ itr,]
++ tst <- m.iris[-itr,]
++ pcl <- diagDA(lrn, cl.true[itr], tst)
++ stopifnot(pcl == predict(dDA(lrn, cl.true[itr]), tst))
++ missCl <- missCl + as.integer(pcl != cl.true[ - itr])
++ }
+> missCl ; mean(missCl) / M
+ [1] 0 0 2 1 2 3 7 15 12 13 5 16 18 14 5 0 0 2 1 2 3 7 15 12 13
+ [26] 5 16 18 14 5 0 0 2 1 2 3 7 15 12 13 5 16 18 14 5 0 0 2 1 2
+ [51] 3 7 15 12 13 5 16 18 14 5 0 0 2 1 2 3 7 15 12 13 5 16 18 14 5
+ [76] 0 0 2 1 2 3 7 15 12 13 5 16 18 14 5 0 0 2 1 2 3 7 15 12 13
+[101] 5 16 18 14 5 0 0 2 1 2 3 7 15 12 13 5 16 18 14 5 0 0 2 1 2
+[126] 3 7 15 12 13 5 16 18 14 5 0 0 2 1 2 3 7 15 12 13 5 16 18 14 5
+[1] 0.03766667
+>
+> ## The "same" with 'pool=FALSE' :
+> missCl <- integer(n)
+> for(m in 1:M) {
++ itr <- sample(n, 0.9 * n)
++ lrn <- m.iris[ itr,]
++ tst <- m.iris[-itr,]
++ pcl <- diagDA(lrn, cl.true[itr], tst, pool=FALSE)
++ stopifnot(pcl == predict(dDA(lrn, cl.true[itr], pool=FALSE), tst))
++ missCl <- missCl + as.integer(pcl != cl.true[ - itr])
++ }
+> missCl ; mean(missCl) / M ## here somewhat worse than linear
+ [1] 1 2 1 3 9 11 13 8 14 12 12 11 14 15 7 1 2 1 3 9 11 13 8 14 12
+ [26] 12 11 14 15 7 1 2 1 3 9 11 13 8 14 12 12 11 14 15 7 1 2 1 3 9
+ [51] 11 13 8 14 12 12 11 14 15 7 1 2 1 3 9 11 13 8 14 12 12 11 14 15 7
+ [76] 1 2 1 3 9 11 13 8 14 12 12 11 14 15 7 1 2 1 3 9 11 13 8 14 12
+[101] 12 11 14 15 7 1 2 1 3 9 11 13 8 14 12 12 11 14 15 7 1 2 1 3 9
+[126] 11 13 8 14 12 12 11 14 15 7 1 2 1 3 9 11 13 8 14 12 12 11 14 15 7
+[1] 0.04433333
+>
+> cat('Time elapsed: ', proc.time() - .proctime00,'\n')
+Time elapsed: 2.32 0.01 2.91 0 0
+>
+>
diff --git a/tests/misc.R b/tests/misc.R
new file mode 100644
index 0000000..3c8c5b7
--- /dev/null
+++ b/tests/misc.R
@@ -0,0 +1,45 @@
+require("sfsmisc")
+
+options(warn=2)
+AsciiToInt(LETTERS) # gave '.. embedded nul ..' warning
+
+## just for fun -- typically shows "iso-latin1 charset
+cat(chars8bit(1:255),"\"\n")
+
+## Checking the new 'ndigits' default argument for digitsBase():
+ee <- 0:30
+for(base in 2:64)
+ stopifnot((be <- base^ee) > 0, any(ok <- be < 2^52),
+ ee == floor(1e-9+ log(be, base)),
+ be[ok] == as.integer(digitsBase(be[ok], base=base)))
+## failed, e.g. for 3^5, in sfsmisc <= 1.0-22
+
+## Tests for is.whole (taken from the examples)
+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
+stopifnot(identical(is.whole(a), a == round(a)),
+ identical(is.whole(m), m == round(m)),
+ which(is.whole(v)) == 6)
+
+## Numbers of class integer are always whole
+stopifnot(is.whole(dim(a)), is.whole(length(v)), is.whole(-1L))
+
+
+## From: Liping Seng <rainey_tree at yahoo.com.sg>
+## Subject: Bug with integrate.xy()?
+## Date: Wed, 7 Jun 2017 12:24:12 +0000
+## MM simplified
+set.seed(1776)
+y <- rnorm(200)
+fit <- density(y, bw = 0.3773427, n=1024, kernel="epanechnikov")
+integrate.xy(fit$x, fit$y, min(fit$x), 1.7927854, xtol=3.16228e-7)
+## Fixed (2017-06-08)
+## Error in seq.default(a, length = max(0, b - a - 1)) :
+## 'length.out' must be a non-negative number
diff --git a/tests/p.R b/tests/p.R
new file mode 100644
index 0000000..41b2684
--- /dev/null
+++ b/tests/p.R
@@ -0,0 +1,8 @@
+#### Plots etc
+library(sfsmisc)
+
+## A time-series with start and end *not* at year boundary:
+data(EuStockMarkets)
+SMI <- EuStockMarkets[, "SMI"]
+
+p.ts(SMI)# gave warning (and was 'wrong' but "only" visually)
diff --git a/tests/p.Rout.save b/tests/p.Rout.save
new file mode 100644
index 0000000..b9a4459
--- /dev/null
+++ b/tests/p.Rout.save
@@ -0,0 +1,29 @@
+
+R : Copyright 2004, The R Foundation for Statistical Computing
+Version 2.0.0 beta (2004-09-27), ISBN 3-900051-07-0
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for a HTML browser interface to help.
+Type 'q()' to quit R.
+
+> #### Plots etc
+> library(sfsmisc)
+>
+> ## A time-series with start and end *not* at year boundary:
+> data(EuStockMarkets)
+> SMI <- EuStockMarkets[, "SMI"]
+>
+> p.ts(SMI)# gave warning (and was 'wrong' but "only" visually)
+ 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)
+>
diff --git a/tests/posdef.R b/tests/posdef.R
new file mode 100644
index 0000000..05f20fc
--- /dev/null
+++ b/tests/posdef.R
@@ -0,0 +1,38 @@
+library(sfsmisc)
+
+options(digits=9)
+
+set.seed(12)
+m <- matrix(round(rnorm(25),2), 5, 5); m <- 1+ m + t(m); diag(m) <- diag(m) + 4
+(mp <- posdefify(m))
+(mp. <- posdefify(m, method = "allEV"))
+
+stopifnot(eigen(mp, only.val=TRUE)$values > 0,
+ eigen(mp., only.val=TRUE)$values > 0,
+ all.equal(diag(m), diag(mp), tol= 1e-15),
+ all.equal(diag(m), diag(mp.),tol= 1e-15),
+ T)
+
+## nearcor()
+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)
+
+nc. <- nearcor(pr, conv.tol = 1e-7) # default
+nc.$iterations # 11
+str(ncr <- nearcor(pr, conv.tol = 1e-15))# 27 iterations (because of conv.tol)!
+nr <- ncr$cor
+ncr0 <- nearcor(pr, conv.tol = 1e-15, posd.tol = 0)# -> no posdefify step
+nr0 <- ncr0$cor
+
+stopifnot(
+ all.equal(nr[lower.tri(nr)],
+ c(0.48796803265083, 0.64265188295401, 0.49063868812228, 0.64409905497094,
+ 0.80871120142824, 0.51411473401472, 0.25066882763262, 0.67235131534931,
+ 0.72583206922437, 0.59682778611131, 0.58219178154582, 0.7449631866236,
+ 0.72988206459063, 0.77215024062758, 0.81319175546212), tol = 1e-12))
+
diff --git a/tests/posdef.Rout.save b/tests/posdef.Rout.save
new file mode 100644
index 0000000..a897835
--- /dev/null
+++ b/tests/posdef.Rout.save
@@ -0,0 +1,79 @@
+
+R version 2.15.2 beta (2012-10-16 r60951) -- "Trick or Treat"
+Copyright (C) 2012 The R Foundation for Statistical Computing
+ISBN 3-900051-07-0
+Platform: x86_64-unknown-linux-gnu (64-bit)
+
+R is free software and comes with ABSOLUTELY NO WARRANTY.
+You are welcome to redistribute it under certain conditions.
+Type 'license()' or 'licence()' for distribution details.
+
+R is a collaborative project with many contributors.
+Type 'contributors()' for more information and
+'citation()' on how to cite R or R packages in publications.
+
+Type 'demo()' for some demos, 'help()' for on-line help, or
+'help.start()' for an HTML browser interface to help.
+Type 'q()' to quit R.
+
+> library(sfsmisc)
+>
+> options(digits=9)
+>
+> set.seed(12)
+> m <- matrix(round(rnorm(25),2), 5, 5); m <- 1+ m + t(m); diag(m) <- diag(m) + 4
+> (mp <- posdefify(m))
+ [,1] [,2] [,3] [,4] [,5]
+[1,] 2.040000000 1.559508625 -0.887340889 -0.408171836 -0.245682172
+[2,] 1.559508625 4.360000000 -0.533157355 1.705637933 2.344838314
+[3,] -0.887340889 -0.533157355 3.440000000 1.195027865 1.353283301
+[4,] -0.408171836 1.705637933 1.195027865 6.020000000 0.577514304
+[5,] -0.245682172 2.344838314 1.353283301 0.577514304 2.940000000
+> (mp. <- posdefify(m, method = "allEV"))
+ [,1] [,2] [,3] [,4] [,5]
+[1,] 2.040000000 1.378740895 -0.424598775 -0.386773282 -0.434470464
+[2,] 1.378740895 4.360000000 -0.613091776 1.507019105 2.225434128
+[3,] -0.424598775 -0.613091776 3.440000000 0.940298040 1.156766185
+[4,] -0.386773282 1.507019105 0.940298040 6.020000000 0.277226191
+[5,] -0.434470464 2.225434128 1.156766185 0.277226191 2.940000000
+>
+> stopifnot(eigen(mp, only.val=TRUE)$values > 0,
++ eigen(mp., only.val=TRUE)$values > 0,
++ all.equal(diag(m), diag(mp), tol= 1e-15),
++ all.equal(diag(m), diag(mp.),tol= 1e-15),
++ T)
+>
+> ## nearcor()
+> 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)
+>
+> nc. <- nearcor(pr, conv.tol = 1e-7) # default
+> nc.$iterations # 11
+[1] 11
+> str(ncr <- nearcor(pr, conv.tol = 1e-15))# 27 iterations (because of conv.tol)!
+List of 4
+ $ cor : num [1:6, 1:6] 1 0.488 0.643 0.491 0.644 ...
+ $ fnorm : num 0.0744
+ $ iterations: num 28
+ $ converged : logi TRUE
+ - attr(*, "class")= chr "nearcor"
+> nr <- ncr$cor
+> ncr0 <- nearcor(pr, conv.tol = 1e-15, posd.tol = 0)# -> no posdefify step
+> nr0 <- ncr0$cor
+>
+> stopifnot(
++ all.equal(nr[lower.tri(nr)],
++ c(0.48796803265083, 0.64265188295401, 0.49063868812228, 0.64409905497094,
++ 0.80871120142824, 0.51411473401472, 0.25066882763262, 0.67235131534931,
++ 0.72583206922437, 0.59682778611131, 0.58219178154582, 0.7449631866236,
++ 0.72988206459063, 0.77215024062758, 0.81319175546212), tol = 1e-12))
+>
+>
+> proc.time()
+ user system elapsed
+ 0.180 0.032 0.205
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-sfsmisc.git
More information about the debian-science-commits
mailing list