[med-svn] [r-cran-locfit] 01/03: Imported Upstream version 1.5-9.1
Michael Crusoe
misterc-guest at moszumanska.debian.org
Mon Jun 27 22:00:21 UTC 2016
This is an automated email from the git hooks/post-receive script.
misterc-guest pushed a commit to branch master
in repository r-cran-locfit.
commit 970b493f8ea07b374ee4d4578210d0b055329e5d
Author: Michael R. Crusoe <crusoe at ucdavis.edu>
Date: Fri Jan 15 07:46:58 2016 -0800
Imported Upstream version 1.5-9.1
---
DESCRIPTION | 15 +
MD5 | 197 ++++
NAMESPACE | 48 +
NEWS | 27 +
R/firstlib.r | 5 +
R/locfit.r | 2042 +++++++++++++++++++++++++++++++++++++++++
data/ais.rda | Bin 0 -> 5958 bytes
data/bad.rda | Bin 0 -> 1818 bytes
data/border.rda | Bin 0 -> 2632 bytes
data/chemdiab.tab.gz | Bin 0 -> 1639 bytes
data/claw54.rda | Bin 0 -> 508 bytes
data/cldem.tab.gz | Bin 0 -> 623 bytes
data/cltest.rda | Bin 0 -> 3884 bytes
data/cltrain.rda | Bin 0 -> 3881 bytes
data/co2.rda | Bin 0 -> 2448 bytes
data/diab.tab.gz | Bin 0 -> 312 bytes
data/ethanol.rda | Bin 0 -> 1259 bytes
data/geyser.rda | Bin 0 -> 390 bytes
data/geyser.round.tab.gz | Bin 0 -> 305 bytes
data/heart.rda | Bin 0 -> 1457 bytes
data/insect.tab.gz | Bin 0 -> 68 bytes
data/iris.rda | Bin 0 -> 1068 bytes
data/kangaroo.rda | Bin 0 -> 4405 bytes
data/livmet.rda | Bin 0 -> 6936 bytes
data/mcyc.tab.gz | Bin 0 -> 1029 bytes
data/mine.rda | Bin 0 -> 604 bytes
data/mmsamp.tab.gz | Bin 0 -> 419 bytes
data/morths.rda | Bin 0 -> 526 bytes
data/penny.tab.gz | Bin 0 -> 296 bytes
data/spencer.rda | Bin 0 -> 502 bytes
data/stamp.rda | Bin 0 -> 908 bytes
data/trimod.tab.gz | Bin 0 -> 2575 bytes
man/aic.Rd | 38 +
man/aicplot.Rd | 47 +
man/ais.Rd | 20 +
man/ang.Rd | 50 +
man/bad.Rd | 15 +
man/border.Rd | 18 +
man/chemdiab.Rd | 21 +
man/claw54.Rd | 21 +
man/cldem.Rd | 14 +
man/cltest.Rd | 20 +
man/cltrain.Rd | 20 +
man/co2.Rd | 20 +
man/cp.Rd | 39 +
man/cpar.Rd | 37 +
man/cpplot.Rd | 50 +
man/crit.Rd | 57 ++
man/dat.Rd | 20 +
man/density.lf.Rd | 56 ++
man/diab.Rd | 22 +
man/ethanol.Rd | 22 +
man/expit.Rd | 19 +
man/fitted.locfit.Rd | 65 ++
man/formula.locfit.Rd | 21 +
man/gam.lf.Rd | 29 +
man/gam.slist.Rd | 17 +
man/gcv.Rd | 37 +
man/gcvplot.Rd | 49 +
man/geyser.Rd | 21 +
man/geyser.round.Rd | 23 +
man/hatmatrix.Rd | 31 +
man/heart.Rd | 22 +
man/insect.Rd | 22 +
man/iris.Rd | 24 +
man/kangaroo.Rd | 21 +
man/kappa0.Rd | 69 ++
man/kdeb.Rd | 40 +
man/km.mrl.Rd | 55 ++
man/lcv.Rd | 31 +
man/lcvplot.Rd | 47 +
man/left.Rd | 47 +
man/lf.Rd | 46 +
man/lfeval.Rd | 28 +
man/lfgrid.Rd | 36 +
man/lfknots.Rd | 36 +
man/lflim.Rd | 30 +
man/lfmarg.Rd | 29 +
man/lines.locfit.Rd | 26 +
man/livmet.Rd | 24 +
man/locfit.Rd | 80 ++
man/locfit.censor.Rd | 73 ++
man/locfit.matrix.Rd | 32 +
man/locfit.quasi.Rd | 45 +
man/locfit.raw.Rd | 184 ++++
man/locfit.robust.Rd | 49 +
man/lp.Rd | 59 ++
man/lscv.Rd | 47 +
man/lscv.exact.Rd | 37 +
man/lscvplot.Rd | 42 +
man/mcyc.Rd | 19 +
man/mine.Rd | 20 +
man/mmsamp.Rd | 14 +
man/morths.Rd | 18 +
man/none.Rd | 23 +
man/panel.locfit.Rd | 40 +
man/panel.xyplot.lf.Rd | 18 +
man/penny.Rd | 19 +
man/plot.eval.Rd | 29 +
man/plot.gcvplot.Rd | 36 +
man/plot.lfeval.Rd | 32 +
man/plot.locfit.1d.Rd | 27 +
man/plot.locfit.2d.Rd | 28 +
man/plot.locfit.3d.Rd | 40 +
man/plot.locfit.Rd | 87 ++
man/plot.preplot.locfit.Rd | 28 +
man/plot.scb.Rd | 31 +
man/plotbyfactor.Rd | 54 ++
man/points.locfit.Rd | 26 +
man/predict.locfit.Rd | 44 +
man/preplot.locfit.Rd | 65 ++
man/preplot.locfit.raw.Rd | 39 +
man/print.gcvplot.Rd | 23 +
man/print.lfeval.Rd | 28 +
man/print.locfit.Rd | 18 +
man/print.preplot.locfit.Rd | 21 +
man/print.scb.Rd | 21 +
man/print.summary.locfit.Rd | 19 +
man/rbox.Rd | 48 +
man/regband.Rd | 29 +
man/residuals.locfit.Rd | 29 +
man/right.Rd | 47 +
man/rv.Rd | 35 +
man/rva.Rd | 22 +
man/scb.Rd | 59 ++
man/sjpi.Rd | 57 ++
man/smooth.lf.Rd | 56 ++
man/spence.15.Rd | 43 +
man/spence.21.Rd | 43 +
man/spencer.Rd | 20 +
man/stamp.Rd | 20 +
man/store.Rd | 16 +
man/summary.gcvplot.Rd | 37 +
man/summary.locfit.Rd | 23 +
man/summary.preplot.locfit.Rd | 24 +
man/trimod.Rd | 21 +
man/xbar.Rd | 15 +
src/S_enter.c | 621 +++++++++++++
src/band.c | 347 +++++++
src/cversion.h | 134 +++
src/dbinom.c | 353 +++++++
src/dens_haz.c | 193 ++++
src/dens_int.c | 227 +++++
src/dens_odi.c | 512 +++++++++++
src/density.c | 508 ++++++++++
src/design.h | 36 +
src/ev_atree.c | 215 +++++
src/ev_interp.c | 267 ++++++
src/ev_kdtre.c | 341 +++++++
src/ev_main.c | 235 +++++
src/ev_sphere.c | 114 +++
src/ev_trian.c | 488 ++++++++++
src/family.c | 625 +++++++++++++
src/fitted.c | 102 ++
src/frend.c | 152 +++
src/imatlb.h | 36 +
src/lf_adap.c | 232 +++++
src/lf_dercor.c | 52 ++
src/lf_fitfun.c | 263 ++++++
src/lf_nbhd.c | 275 ++++++
src/lf_robust.c | 137 +++
src/lf_vari.c | 168 ++++
src/lf_wdiag.c | 235 +++++
src/lfcons.h | 305 ++++++
src/lffuns.h | 150 +++
src/lfstr.c | 150 +++
src/lfstruc.h | 107 +++
src/lfwin.h | 117 +++
src/local.h | 145 +++
src/locfit.c | 385 ++++++++
src/m_chol.c | 76 ++
src/m_eigen.c | 146 +++
src/m_icirc.c | 113 +++
src/m_imont.c | 41 +
src/m_isimp.c | 159 ++++
src/m_isphr.c | 208 +++++
src/m_jacob.c | 119 +++
src/m_max.c | 216 +++++
src/m_qr.c | 99 ++
src/m_solve.c | 122 +++
src/m_svd.c | 130 +++
src/m_vector.c | 93 ++
src/math.c | 167 ++++
src/minmax.c | 299 ++++++
src/mutil.h | 103 +++
src/pcomp.c | 194 ++++
src/preplot.c | 138 +++
src/prob.c | 143 +++
src/procv.c | 227 +++++
src/scb.c | 294 ++++++
src/scb_cons.c | 518 +++++++++++
src/scb_crit.c | 184 ++++
src/scb_iface.c | 78 ++
src/simul.c | 226 +++++
src/smisc.c | 34 +
src/startlf.c | 174 ++++
src/tube.h | 49 +
src/weight.c | 463 ++++++++++
198 files changed, 19085 insertions(+)
diff --git a/DESCRIPTION b/DESCRIPTION
new file mode 100755
index 0000000..4e85dab
--- /dev/null
+++ b/DESCRIPTION
@@ -0,0 +1,15 @@
+Package: locfit
+Version: 1.5-9.1
+Title: Local Regression, Likelihood and Density Estimation.
+Date: 2013-03-22
+Author: Catherine Loader
+Maintainer: Andy Liaw <andy_liaw at merck.com>
+Description: Local regression, likelihood and density estimation.
+Depends: R (>= 2.0.1)
+Imports: lattice
+Suggests: akima, gam
+License: GPL (>= 2)
+Packaged: 2013-04-20 06:56:26 UTC; ripley
+Repository: CRAN
+Date/Publication: 2013-04-20 09:01:16
+NeedsCompilation: yes
diff --git a/MD5 b/MD5
new file mode 100644
index 0000000..03436c4
--- /dev/null
+++ b/MD5
@@ -0,0 +1,197 @@
+069c74bb920c5b8852ffbab8298838df *DESCRIPTION
+145615a3c01c2f5e7c87c7e4affd4b90 *NAMESPACE
+cfb753adc26c57e1a349ba5a0ce83938 *NEWS
+c69fccb19975aaf5f91b8a35f5761819 *R/firstlib.r
+e93a46c91fb4df078d38d053b8c8a475 *R/locfit.r
+b401b88bd87bf18f03dd1bfe4cb0f544 *data/ais.rda
+0e01701b1a2baf4035fa5ee2a40a5115 *data/bad.rda
+4d5540425583246fcdb9c7713dc98147 *data/border.rda
+78fae8ff7fdb08a6dbd6424791e6b0f4 *data/chemdiab.tab.gz
+3576b10fda18fda073e1d12308c5b561 *data/claw54.rda
+f96f0aa6b0e3fb819f1fbb9f2fb349a9 *data/cldem.tab.gz
+bdc4bb78d8195eaa3d43dd9fd8deacb3 *data/cltest.rda
+39bdb06a8bbd7bdfd9a7b5e091e4e895 *data/cltrain.rda
+d10e3aa9623f50de74b9eaf68c4a8fc2 *data/co2.rda
+ae992d05caede34a7ade68e66b9f2985 *data/diab.tab.gz
+db80279a53d30f298cddf218c8d11765 *data/ethanol.rda
+d1ac1b4a04a644bb3e8e947a70c8022c *data/geyser.rda
+2cc4f4b666121501f90ac9ed037feb9b *data/geyser.round.tab.gz
+779863c4e14b64c83f559d95f4102a84 *data/heart.rda
+d8172619746fcdafe2e4dfb7302d8796 *data/insect.tab.gz
+6faefe2b6973faa2f0ee4648acc30ec4 *data/iris.rda
+58efd88dde65f956dbd31e494006bb72 *data/kangaroo.rda
+124f014a5c246612ada98ccc6aa2beb8 *data/livmet.rda
+a7c089ef50abcc4f5a6a0193560db5ff *data/mcyc.tab.gz
+719fcbfe1c2b06cb6abd948e84573162 *data/mine.rda
+313c0c35e65c97e6223845064bcda53b *data/mmsamp.tab.gz
+a5a75a58203023b2418061c54c9156e1 *data/morths.rda
+6f097baf489800c858ff3e080fa4999b *data/penny.tab.gz
+dbbc7d95a7dc9325b33374328327e3f3 *data/spencer.rda
+89542898fce618ea54521119b431033a *data/stamp.rda
+814c2e8cdba028f0d6081d35e50612b5 *data/trimod.tab.gz
+5cf8d15b6c46d57690553a737236d03f *man/aic.Rd
+5dab5a6e6365d919ec08492e7faf648d *man/aicplot.Rd
+954f29ff1bf17286c18fe79c4d4f5d9f *man/ais.Rd
+2789e611a8a5df326057c63e447a0f5b *man/ang.Rd
+0caea3418dc21ea27027ed1a13c8b8df *man/bad.Rd
+bc0ceada223e520dd3fbf18771c20ea2 *man/border.Rd
+310b76d87bc13ff514e1fc5bac2cb0fb *man/chemdiab.Rd
+918ebffe60cf1c0415ad1a9b85fed809 *man/claw54.Rd
+60cc9b47b805d370e39f518dd19205ad *man/cldem.Rd
+21c6dc9f3759ed8484fb2dbd01f584ad *man/cltest.Rd
+1ce68b975b1210cdfe20d21bf4264b30 *man/cltrain.Rd
+470f7796bfeb47d6d245f14dcdfa1362 *man/co2.Rd
+823e78796709b909d1b1befbb30c4dce *man/cp.Rd
+05f2a0e9f0b81eb31121d79856944b26 *man/cpar.Rd
+f474b740ced38a360b1c0acb8a9e2351 *man/cpplot.Rd
+ef45cddcddf448c1a4a033401edfd8bc *man/crit.Rd
+23a4309995fd9dd0ced50945511813fa *man/dat.Rd
+aa7d39e0819a1c6cae9ee7bd1b681cdc *man/density.lf.Rd
+0c38114c896e38406924a70c6775bb12 *man/diab.Rd
+8af2c41c0995904721b93efb07631c88 *man/ethanol.Rd
+707e6e02cf3606f48feae25dc1be73a8 *man/expit.Rd
+fdd51fad86d1e29dc661339bf59b1472 *man/fitted.locfit.Rd
+432191f49dfe798456fa9e56c8330479 *man/formula.locfit.Rd
+2e317782016985f49007975d4c024437 *man/gam.lf.Rd
+296b84c449c3d791310cdb18e836b28c *man/gam.slist.Rd
+f131db9d1599dbe8121afd786013d2ed *man/gcv.Rd
+4222feca217d6655ab7c1a480e7fe083 *man/gcvplot.Rd
+acd55d510b22c69b08e2dd4760f9d402 *man/geyser.Rd
+e5fc50f31c44859555f9102c35298432 *man/geyser.round.Rd
+8cc1bb722a5a21ef0f640074b396d661 *man/hatmatrix.Rd
+e341e4ffc43f9d6986514df4358a20f4 *man/heart.Rd
+248d51e226e6fc4fdd674369196162fe *man/insect.Rd
+96301d68bac849f992732e32c762d360 *man/iris.Rd
+199232da51ae89813ab39cc981d7d809 *man/kangaroo.Rd
+65bba0f79f42887f58fc9a7298f5ba03 *man/kappa0.Rd
+16c623260bf7cdf5d83fd95ebc0c3384 *man/kdeb.Rd
+8e9bd1be75632d0eea238e948c3048e4 *man/km.mrl.Rd
+8107521265d13841bc1c01e09008a717 *man/lcv.Rd
+8e66b4d57784d66d0b293d2b7489bc59 *man/lcvplot.Rd
+1db2cefb09fc34162068501bb9d8d2e5 *man/left.Rd
+2b3c473671208ab27611f3b328bb57c4 *man/lf.Rd
+9aff1782414e5ea27e3c8699c67428a5 *man/lfeval.Rd
+b59099e635e0fc955669fb6cf9be0ea2 *man/lfgrid.Rd
+b78f066f54d8fc870e224d9a93744d24 *man/lfknots.Rd
+18ee87a3368a87547b21f48effe1f44c *man/lflim.Rd
+81f13d1921e99b376eac592a424ed893 *man/lfmarg.Rd
+845d6c03e50557254cacfd8f8aa2c8c1 *man/lines.locfit.Rd
+7d77538d7ea3256b6c24370236991e90 *man/livmet.Rd
+527c29c0873e5d783ff0d4deaca1eaa6 *man/locfit.Rd
+cc8fbf6c052275d8b3604cc70c509f9e *man/locfit.censor.Rd
+0014077c83b12dead053f70cbf50767a *man/locfit.matrix.Rd
+527f5f81644050bc642ce11fb5a014fd *man/locfit.quasi.Rd
+3e00ad1fcfc78158952f9d3aa6b400fe *man/locfit.raw.Rd
+73581436fec2d93a666c6c3b43be3b41 *man/locfit.robust.Rd
+3fd27a82384556dfec015f21f50d39b4 *man/lp.Rd
+9342bb1e57ee297e72f5934a090893aa *man/lscv.Rd
+6b50ee2cc908c116fbfa43d7960db146 *man/lscv.exact.Rd
+6eb960057e2b3eb8babc44cd0d733fab *man/lscvplot.Rd
+e7ab6ab5040238ccabfe117a3adbb9d5 *man/mcyc.Rd
+e6ae9d9ffe06cdf0179938b6d9121351 *man/mine.Rd
+e20eaf737499119779622dd32da95b71 *man/mmsamp.Rd
+56e929091794f325b01ea028e46c48d2 *man/morths.Rd
+77fb7265f9cd2455450714e528b7a4a6 *man/none.Rd
+2e3678d05c283ae51192a28783bf75ba *man/panel.locfit.Rd
+fe700b7b9b12338ff9a673f21c302617 *man/panel.xyplot.lf.Rd
+73cf6adf73d81884e805b187e78367bb *man/penny.Rd
+b3fc993ca221d1f8889e6fae4a7b034e *man/plot.eval.Rd
+abaad4805a246f0eab1829925e8533f1 *man/plot.gcvplot.Rd
+7f76752803ce84ec8ef86585e6de1a8a *man/plot.lfeval.Rd
+1d23b35648d976047e5c27adf5b35786 *man/plot.locfit.1d.Rd
+a3e14a6c1cd14207f6ec7ebf842be3cc *man/plot.locfit.2d.Rd
+ceb6594274f4a0cd2dffec6ddd51288f *man/plot.locfit.3d.Rd
+028241043c76ec38ff84c2f4a403c041 *man/plot.locfit.Rd
+6a49423a780c81e78c7025e16be3bae3 *man/plot.preplot.locfit.Rd
+ad305a3de59f6b8408e894599924e22a *man/plot.scb.Rd
+18ab8b61a2600413173b1c25b3bd359f *man/plotbyfactor.Rd
+3d6f0b014dff6d69d316e50b28d9d727 *man/points.locfit.Rd
+20894697139bac13aa9271168de10f71 *man/predict.locfit.Rd
+32d9271a6e7ae5611a9e1656819bc2f3 *man/preplot.locfit.Rd
+252ce4a6289a45818a27b1ff8daabb40 *man/preplot.locfit.raw.Rd
+4b54bfb7a2558e151fcbfbcc85842757 *man/print.gcvplot.Rd
+eae256cdfb3886c41962387441c3e708 *man/print.lfeval.Rd
+de08437d80c2f2a4ab8d60157adac649 *man/print.locfit.Rd
+7fe0b9770301085afe2f5aeb1f1cb8d5 *man/print.preplot.locfit.Rd
+72d7f9c7b5a14315aefe13e1cc6bd5c1 *man/print.scb.Rd
+ff83c07fc2fad449383b36a2d018e80c *man/print.summary.locfit.Rd
+26ff201ba1102321ad24b910a03ae9e0 *man/rbox.Rd
+0f1bd575d1ead0dd28b709dc1c0ffb10 *man/regband.Rd
+d7ee4b04d7ae1359101c97b64b6f5f9e *man/residuals.locfit.Rd
+8515f17ca547b649044a4ef0db4689e0 *man/right.Rd
+6a37aa14781c85085a3e05177e5ab781 *man/rv.Rd
+cc087351c25a5208294428bf4cbab83a *man/rva.Rd
+e003b0d803716f5b3cbce55f283f22d8 *man/scb.Rd
+44854f7b9cc0786b8a492d0bdc710ecd *man/sjpi.Rd
+e3008feda0ec6d440fd4ca51ed7139b2 *man/smooth.lf.Rd
+9db26bf9d04493b22b55caa9494a25fa *man/spence.15.Rd
+a9a88509b23612f29caa34e886e4a150 *man/spence.21.Rd
+0a596ce9d8cb9a82597c938a2cc5f499 *man/spencer.Rd
+8afaf2477e3487943d6aaa8506e4d087 *man/stamp.Rd
+78df873f7b86341cd5690ddad54fd2bc *man/store.Rd
+2ea137ef8fabc79df198723d5cd7530b *man/summary.gcvplot.Rd
+14685a6b9e1dccd31bce53e1a37d9cdb *man/summary.locfit.Rd
+150eef77617e93a5ace416cf45e95c3b *man/summary.preplot.locfit.Rd
+ab11750329cf323f3959ab63d66dbce8 *man/trimod.Rd
+d25c8818c2acab0ef7881aa3f4ffefa2 *man/xbar.Rd
+33bf71c7b8eff94ff08a43ccfde408ab *src/S_enter.c
+73f9e3dedc5868a3f900dfddd9073ed8 *src/band.c
+b778507185712ab4a3b04fb39a349b0f *src/cversion.h
+b3844fe5fba4aeba1797c514d140d24e *src/dbinom.c
+430cf10ab12a1a04b088645529ff51f5 *src/dens_haz.c
+0a756fb13f8e45aa450491665b9b6c74 *src/dens_int.c
+f4bdd6c8b9fa2ba17aa746e75b00b425 *src/dens_odi.c
+5ff73769856a64d9466426493ead0e03 *src/density.c
+eeb959df9748e76edf7b1b8835bf92e6 *src/design.h
+49fc647771f5c01c94647754f439e9bc *src/ev_atree.c
+fa570a19d2767c8fa76014724ae81591 *src/ev_interp.c
+0a6fc5adc1998f212a134e5840dafb79 *src/ev_kdtre.c
+8d0fa530daa48dd300b5d453a40fe599 *src/ev_main.c
+956fbd0f8120518966ed56c3b65b9077 *src/ev_sphere.c
+2661a1d8683ca4d11c046227a629f42c *src/ev_trian.c
+eab0babbeff9c5d0688be747d2c26225 *src/family.c
+352bd89a01bf775b8d4eca28d3ec772c *src/fitted.c
+8bd6019523eca51c7aab589e0e902fb3 *src/frend.c
+af75dc440edd6a4f7479a4a62f642b45 *src/imatlb.h
+397851c03ad46a1126da4131d0acd86f *src/lf_adap.c
+15c7b3617e11650b3d24c4e71d5402c5 *src/lf_dercor.c
+1ad3b2172b8727808b74a4fcd6986104 *src/lf_fitfun.c
+f71a319a64bb55e4a8c7d410b59b2dda *src/lf_nbhd.c
+aaa9900a031393f306de193bdebbb808 *src/lf_robust.c
+a5a176a66ab14efe34e6754d05bec8c1 *src/lf_vari.c
+e64b7546bb49ff263a535317a0b23177 *src/lf_wdiag.c
+fdf9f44ed36e6c1cd5f8993795182c87 *src/lfcons.h
+abe1a5d3bc096d237c4b26f9ab919322 *src/lffuns.h
+879df350e0568e2c5eac74470bc089a4 *src/lfstr.c
+d0e5d8d81c29d2519013e1c43ddd966d *src/lfstruc.h
+067a41c90a1bf5bf358674fc1cee4977 *src/lfwin.h
+c64fcf7484eb8e2dcc75e2e4f6b75c55 *src/local.h
+183a9e78fd88e7bdb536fddc51ce1439 *src/locfit.c
+cb441b0bc0886034e92f57a4ae4f37c1 *src/m_chol.c
+a15fee4f2e35e48bb6553afe929f2857 *src/m_eigen.c
+abc396e3c9ccea9d1b267b4f54416a66 *src/m_icirc.c
+fb224cc62f8e81140483c6a766485874 *src/m_imont.c
+992fab5af13b00d6fc4e9ae7c01874fb *src/m_isimp.c
+f4f6531382adcd1f84b790272a6d130d *src/m_isphr.c
+16126fac15165b4766a691f97ef14b19 *src/m_jacob.c
+6cc7652b303cc32f0e892887c98d01c7 *src/m_max.c
+0284b151da66048e2b0181b9018c0446 *src/m_qr.c
+04a259905cc46b5a71133186099a60a7 *src/m_solve.c
+74c27b58eabe2ad302a3224a7996e52c *src/m_svd.c
+6d009b715fb0e669f93149a7a20bfb4e *src/m_vector.c
+c530dcb243b57b756cd18aadd69ea754 *src/math.c
+2f9ff8bd302dd0f493273954529bc132 *src/minmax.c
+961fad8f1dfc4d8b122e7d31158ea828 *src/mutil.h
+163e8f5dfc6707f36a7845d7964e235d *src/pcomp.c
+383057377e058172640f14a7f7deb376 *src/preplot.c
+bc7c6a83e8486b45618f2ed5ff9a22eb *src/prob.c
+d92e11bdc1e3e9fa4b7bffaa14fab4a1 *src/procv.c
+1597b9eeb3d1479fcdf3388c5558f3a9 *src/scb.c
+0275cae19b6eca069c2039382ae479d9 *src/scb_cons.c
+87a69e56337b2f44095b10bb1a8581d1 *src/scb_crit.c
+4b6faaf5efa9d5f0f50d10c441a5c4a8 *src/scb_iface.c
+c7aad1e9d87354097e6b7d54c744ad60 *src/simul.c
+e0f0b935934619cb851f174f8058b0c8 *src/smisc.c
+0e30ec44b40fce08af203da48f347b6a *src/startlf.c
+2c08d573d0f9ca194a82f0e77626a176 *src/tube.h
+10991395bb537a8e77a446d457d34fd8 *src/weight.c
diff --git a/NAMESPACE b/NAMESPACE
new file mode 100755
index 0000000..6e51e52
--- /dev/null
+++ b/NAMESPACE
@@ -0,0 +1,48 @@
+useDynLib("locfit")
+
+importFrom(graphics, points, plot)
+importFrom(stats, fitted, formula, preplot, residuals)
+#import(lattice)
+importFrom(lattice, contourplot, levelplot, llines, panel.xyplot,
+ strip.default, wireframe, xyplot)
+
+## density.lf and plot.eval are not methods.
+export(aic, aicplot, ang, cp, cpar, cpplot, crit, "crit<-", dat,
+ density.lf, expit, gam.lf, gam.slist, gcv, gcvplot, hatmatrix,
+ kappa0, kdeb, km.mrl, lcv, lcvplot, left, lf, lfeval,
+ lfgrid, lfknots, lflim, lfmarg, locfit, locfit.censor,
+ locfit.matrix, locfit.quasi, locfit.raw, locfit.robust, lp,
+ lscv, lscv.exact, lscvplot, none, panel.locfit,
+ panel.xyplot.lf, plot.eval, plotbyfactor, rbox, regband, right,
+ rv, "rv<-", scb, sjpi, smooth.lf, spence.15, spence.21, store,
+ xbar)
+
+S3method(fitted, locfit)
+S3method(formula, locfit)
+S3method(lines, locfit)
+S3method(llines, locfit)
+S3method(plot, gcvplot)
+S3method(plot, lfeval)
+S3method(plot, locfit)
+S3method(plot, locfit.1d)
+S3method(plot, locfit.2d)
+S3method(plot, locfit.3d)
+S3method(plot, preplot.locfit)
+S3method(plot, scb)
+S3method(plot, scb.1d)
+S3method(plot, scb.2d)
+S3method(points, locfit)
+S3method(predict, locfit)
+S3method(preplot, locfit)
+S3method(preplot, locfit.raw)
+S3method(print, gcvplot)
+S3method(print, lfeval)
+S3method(print, locfit)
+S3method(print, preplot.locfit)
+S3method(print, scb)
+S3method(print, summary.locfit)
+S3method(residuals, locfit)
+S3method(summary, gcvplot)
+S3method(summary, locfit)
+S3method(summary, preplot.locfit)
+S3method("[", lp)
diff --git a/NEWS b/NEWS
new file mode 100755
index 0000000..072ea7c
--- /dev/null
+++ b/NEWS
@@ -0,0 +1,27 @@
+1.5-9:
+
+o Support for user-supplied basis function has been withdrawn until further notice.
+
+o Changed akima from Import to Suggest. The interp() function from akima is used
+ conditionally in preplot.locfit(). Anyone who needs it will have to install
+ akima, whose license is more restrictive than locfit's. If it's needed but
+ not available, an error message is given with a note regarding the license.
+
+1.5-8:
+
+o Added a subset method for the "lp" class to resolve the problem that in a locfit()
+ call, if "subset" is given then any optional argument to lp() are ignored.
+
+1.5-7:
+
+o Patches by Brian Ripley (added NAMESPACE, changed Call_S(), etc.)
+
+1.5-6:
+
+o Added check for 0-row data so locfit() won't segfault.
+
+
+1.5-5:
+
+o Patches provided by Brian Ripley to clean up some function arguments and
+ documentations.
diff --git a/R/firstlib.r b/R/firstlib.r
new file mode 100755
index 0000000..4b4a954
--- /dev/null
+++ b/R/firstlib.r
@@ -0,0 +1,5 @@
+.onAttach <- function(libname, pkgname) {
+ ver <- utils::packageDescription(pkgname, libname,
+ fields = c("Version", "Date"))
+ packageStartupMessage(paste(pkgname, ver[1], "\t", ver[2]))
+}
diff --git a/R/locfit.r b/R/locfit.r
new file mode 100755
index 0000000..c7f4b45
--- /dev/null
+++ b/R/locfit.r
@@ -0,0 +1,2042 @@
+"locfit"<-
+function(formula, data = sys.frame(sys.parent()), weights = 1, cens = 0, base = 0, subset,
+ geth = FALSE, ..., lfproc = locfit.raw)
+{
+ Terms <- terms(formula, data = data)
+ attr(Terms, "intercept") <- 0
+ m <- match.call()
+ m[[1]] <- as.name("model.frame")
+ z <- pmatch(names(m), c("formula", "data", "weights", "cens", "base",
+ "subset"))
+ for(i in length(z):2)
+ if(is.na(z[i])) m[[i]] <- NULL
+ frm <- eval(m, sys.frame(sys.parent()))
+ if (nrow(frm) < 1) stop("fewer than one row in the data")
+ vnames <- as.character(attributes(Terms)$variables)[-1]
+ if(attr(Terms, "response")) {
+ y <- model.extract(frm, "response")
+ yname <- deparse(formula[[2]])
+ vnames <- vnames[-1]
+ }
+ else {
+ y <- yname <- NULL
+ }
+ x <- as.matrix(frm[, vnames])
+ if(!inherits(x, "lp")) {
+ if(length(vnames) == dim(x)[2]) {
+ dimnames(x) <- list(NULL, vnames)
+ }
+ }
+ if(!missing(weights))
+ weights <- model.extract(frm, weights)
+ if(!missing(cens))
+ cens <- model.extract(frm, cens)
+ if(!missing(base))
+ base <- model.extract(frm, base)
+ ret <- lfproc(x, y, weights = weights, cens = cens, base = base, geth = geth,
+ ...)
+ if(geth == 0) {
+ ret$terms <- Terms
+ ret$call <- match.call()
+ if(!is.null(yname))
+ ret$yname <- yname
+ ret$frame <- sys.frame(sys.parent())
+ }
+ ret
+}
+
+"locfit.raw"<-
+function(x, y, weights = 1, cens = 0, base = 0, scale = FALSE, alpha = 0.7,
+ deg = 2, kern = "tricube", kt = "sph", acri = "none",
+ basis = list(NULL), deriv = numeric(0), dc = FALSE, family,
+ link = "default", xlim, renorm = FALSE, ev = rbox(),
+ maxk = 100, itype = "default", mint = 20, maxit = 20, debug = 0,
+ geth = FALSE, sty = "none")
+{
+ if(inherits(x, "lp")) {
+ alpha <- attr(x, "alpha")
+ deg <- attr(x, "deg")
+ sty <- attr(x, "style")
+ acri <- attr(x, "acri")
+ scale <- attr(x, "scale")
+ }
+ if(!is.matrix(x)) {
+ vnames <- deparse(substitute(x))
+ x <- matrix(x, ncol = 1)
+ d <- 1
+ }
+ else {
+ d <- ncol(x)
+ if(is.null(dimnames(x)))
+ vnames <- paste("x", 1:d, sep = "")
+ else vnames <- dimnames(x)[[2]]
+ }
+ n <- nrow(x)
+ if((!missing(y)) && (!is.null(y))) {
+ yname <- deparse(substitute(y))
+ if(missing(family))
+ family <- if(is.logical(y)) "binomial" else "qgaussian"
+ }
+ else {
+ if(missing(family))
+ family <- "density"
+ y <- 0
+ yname <- family
+ }
+ if(!missing(basis)) {
+ ## assign("basis", basis, 1)
+ deg0 <- deg <- length(basis(matrix(0, nrow = 1, ncol = d), rep(0, d)))
+ }
+ if(length(deg) == 1)
+ deg = c(deg, deg)
+
+ xl <- rep(0, 2 * d)
+ lset <- 0
+ if(!missing(xlim)) {
+ xl <- lflim(xlim, vnames, xl)
+ lset <- 1
+ }
+ if(is.character(ev)) {
+ stop("Character ev argument no longer used.")
+ }
+ if(is.numeric(ev)) {
+ xev <- ev
+ mg <- length(xev)/d
+ ev <- list(type = "pres", xev = xev, mg = mg, cut = 0, ll = 0, ur = 0)
+ if(mg == 0)
+ stop("Invalid ev argument")
+ }
+ fl <- c(rep(ev$ll,length.out=d), rep(ev$ur,length.out=d))
+ mi <- c(n, 0, deg, d, 0, 0, 0, 0, mint, maxit, renorm, 0, 0, 0, dc, maxk,
+ debug, geth, 0, !missing(basis))
+ if(any(is.na(mi)))
+ print(mi)
+ if(is.logical(scale))
+ scale <- 1 - as.numeric(scale)
+ if(length(scale) == 1)
+ scale <- rep(scale, d)
+ if(is.character(deriv))
+ deriv <- match(deriv, vnames)
+ alpha <- c(alpha, 0, 0, 0)[1:3]
+ style <- pmatch(sty, c("none", "z1", "z2", "angle", "left", "right", "cpar"))
+ if(length(style) == 1)
+ style <- rep(style, d)
+ dp <- c(alpha, ev$cut, 0, 0, 0, 0, 0, 0)
+ size <- .C("guessnv",
+ lw = integer(7),
+ evt = as.character(c(ev$type, kt)),
+ dp = as.numeric(dp),
+ mi = as.integer(mi),
+ nvc = integer(5),
+ mg = as.integer(ev$mg), PACKAGE="locfit")
+ nvc <- size$nvc
+ lw <- size$lw
+ z <- .C("slocfit",
+ x = as.numeric(x),
+ y = as.numeric(rep(y, length.out = n)),
+ cens = as.numeric(rep(cens, length.out = n)),
+ w = as.numeric(rep(weights, length.out = n)),
+ base = as.numeric(rep(base, length.out = n)),
+ lim = as.numeric(c(xl, fl)),
+ mi = as.integer(size$mi),
+ dp = as.numeric(size$dp),
+ strings = c(kern, family, link, itype, acri, kt),
+ scale = as.numeric(scale),
+ xev = if(ev$type == "pres") as.numeric(xev) else numeric(d * nvc[1]),
+ wdes = numeric(lw[1]),
+ wtre = numeric(lw[2]),
+ wpc = numeric(lw[4]),
+ nvc = as.integer(size$nvc),
+ iwk1 = integer(lw[3]),
+ iwk2 = integer(lw[7]),
+ lw = as.integer(lw),
+ mg = as.integer(ev$mg),
+ L = numeric(lw[5]),
+ kap = numeric(lw[6]),
+ deriv = as.integer(deriv),
+ nd = as.integer(length(deriv)),
+ sty = as.integer(style),
+ basis = list(basis, lfbas), PACKAGE="locfit")
+ nvc <- z$nvc
+ names(nvc) <- c("nvm", "ncm", "vc", "nv", "nc")
+ nvm <- nvc["nvm"]
+ ncm <- nvc["ncm"]
+ nv <- max(nvc["nv"], 1)
+ nc <- nvc["nc"]
+ if(geth == 1)
+ return(matrix(z$L[1:(nv * n)], ncol = nv))
+ if(geth == 2)
+ return(list(const = z$kap, d = d))
+ if(geth == 3)
+ return(z$kap)
+ dp <- z$dp
+ mi <- z$mi
+ names(mi) <- c("n", "p", "deg0", "deg", "d", "acri", "ker", "kt", "it",
+ "mint", "mxit", "renorm", "ev", "tg", "link", "dc", "mk", "debug", "geth",
+ "pc", "ubas")
+ names(dp) <- c("nnalph", "fixh", "adpen", "cut", "lk", "df1", "df2", "rv",
+ "swt", "rsc")
+ if(geth == 4) {
+ p <- mi["p"]
+ return(list(residuals = z$y, var = z$wdes[n * (p + 2) + p * p + (1:n)],
+ nl.df = dp["df1"] - 2))
+ }
+ if(geth == 6)
+ return(z$L)
+ if(length(deriv) > 0)
+ trans <- function(x)
+ x
+ else trans <- switch(mi["link"] - 2,
+ function(x)
+ x,
+ exp,
+ expit,
+ function(x)
+ 1/x,
+ function(x)
+ pmax(x, 0)^2,
+ function(x)
+ pmax(sin(x), 0)^2)
+ t1 <- z$wtre
+ t2 <- z$iwk1
+ xev <- z$xev[1:(d * nv)]
+ if(geth == 7)
+ return(list(x = xev, y = trans(t1[1:nv])))
+ coef <- matrix(t1[1:((3 * d + 8) * nvm)], nrow = nvm)[1:nv, ]
+ if(nv == 1)
+ coef <- matrix(coef, nrow = 1)
+ if(geth >= 70) {
+ data <- list(x = x, y = y, cens = cens, base = base, w = weights)
+ return(list(xev = matrix(xev, ncol = d, byrow = TRUE), coef = coef[, 1], sd =
+ coef[, d + 2], lower = z$L[1:nv], upper = z$L[nvm + (1:nv)], trans =
+ trans, d = d, vnames = vnames, kap = z$kap, data = data, mi = mi))
+ }
+ eva <- list(ev = ev, xev = xev, coef = coef, scale = z$scale, pc = z$wpc)
+ class(eva) <- "lfeval"
+ if(nc == 0) {
+ cell <- list(sv = integer(0), ce = integer(0), s = integer(0), lo =
+ as.integer(rep(0, nv)), hi = as.integer(rep(0, nv)))
+ }
+ else {
+ mvc <- max(nv, nc)
+ mvcm <- max(nvm, ncm)
+ vc <- nvc["vc"]
+ cell <- list(sv = t1[nvm * (3 * d + 8) + 1:nc], ce = t2[1:(vc * nc)], s =
+ t2[vc * ncm + 1:mvc], lo = t2[vc * ncm + mvcm + 1:mvc], hi = t2[vc * ncm +
+ 2 * mvcm + 1:mvc])
+ }
+ ret <- list(eva = eva, cell = cell, terms = NULL, nvc = nvc, box = z$lim[2 *
+ d + 1:(2 * d)], sty = style, deriv = deriv, mi = mi, dp = dp, trans = trans,
+ critval = crit(const = c(rep(0, d), 1), d = d), vnames = vnames, yname =
+ yname, call = match.call(), frame = sys.frame(sys.parent()))
+ class(ret) <- "locfit"
+ ret
+}
+
+"ang" <-
+function(x, ...)
+{
+ ret <- lp(x, ..., style = "angle")
+ dimnames(ret) <- list(NULL, deparse(substitute(x)))
+ ret
+}
+
+"gam.lf"<-
+function(x, y, w, xeval, ...)
+{
+ if(!missing(xeval)) {
+ fit <- locfit.raw(x, y, weights = w, geth = 5, ...)
+ return(predict(fit, xeval))
+ }
+ ret <- locfit.raw(x, y, weights = w, geth = 4, ...)
+ names(ret) <- c("residuals", "var", "nl.df")
+ ret
+}
+
+"gam.slist"<-
+c("s", "lo", "random", "lf")
+
+"lf"<-
+function(..., alpha = 0.7, deg = 2, scale = 1, kern = "tcub", ev = rbox(), maxk
+ = 100)
+{
+ if(!any(gam.slist == "lf"))
+ warning("gam.slist does not include \"lf\" -- fit will be incorrect")
+ x <- cbind(...)
+ scall <- deparse(sys.call())
+ attr(x, "alpha") <- alpha
+ attr(x, "deg") <- deg
+ attr(x, "scale") <- scale
+ attr(x, "kern") <- kern
+ attr(x, "ev") <- ev
+ attr(x, "maxk") <- maxk
+ attr(x, "call") <- substitute(gam.lf(data[[scall]], z, w, alpha = alpha, deg
+ = deg, scale = scale, kern = kern, ev = ev, maxk = maxk))
+ attr(x, "class") <- "smooth"
+ x
+}
+
+"lfbas" <-
+function(dim, indices, tt, ...)
+{
+ indices <- indices + 1
+ # C starts at 0, S at 1
+ x <- cbind(...)[indices, ]
+ res <- basis(x, tt)
+ as.numeric(t(res))
+}
+
+"left"<-
+function(x, ...)
+{
+ ret <- lp(x, ..., style = "left")
+ dimnames(ret) <- list(NULL, deparse(substitute(x)))
+ ret
+}
+
+"right"<-
+function(x, ...)
+{
+ ret <- lp(x, ..., style = "right")
+ dimnames(ret) <- list(NULL, deparse(substitute(x)))
+ ret
+}
+
+"cpar"<-
+function(x, ...)
+{
+ ret <- lp(x, ..., style = "cpar")
+ dimnames(ret) <- list(NULL, deparse(substitute(x)))
+ ret
+}
+
+"lp"<-
+function(..., nn = 0, h = 0, adpen = 0, deg = 2, acri = "none", scale = FALSE,
+ style = "none")
+{
+ x <- cbind(...)
+ z <- as.list(match.call())
+ z[[1]] <- z$nn <- z$h <- z$adpen <- z$deg <- z$acri <- z$scale <- z$style <-
+ NULL
+ dimnames(x) <- list(NULL, z)
+ if(missing(nn) & missing(h) & missing(adpen))
+ nn <- 0.7
+ attr(x, "alpha") <- c(nn, h, adpen)
+ attr(x, "deg") <- deg
+ attr(x, "acri") <- acri
+ attr(x, "style") <- style
+ attr(x, "scale") <- scale
+ class(x) <- c("lp", class(x))
+ x
+}
+
+
+"[.lp" <- function (x, ..., drop = FALSE) {
+ cl <- oldClass(x)
+ oldClass(x) <- NULL
+ ats <- attributes(x)
+ ats$dimnames <- NULL
+ ats$dim <- NULL
+ ats$names <- NULL
+ y <- x[..., drop = drop]
+ attributes(y) <- c(attributes(y), ats)
+ oldClass(y) <- cl
+ y
+}
+
+"fitted.locfit"<-
+function(object, data = NULL, what = "coef", cv = FALSE, studentize = FALSE,
+ type = "fit", tr, ...)
+{
+ if(missing(data)) {
+ data <- if(is.null(object$call$data)) sys.frame(sys.parent()) else eval(object$call$
+ data)
+ }
+ if(missing(tr))
+ tr <- if((what == "coef") & (type == "fit")) object$trans else function(x)
+ x
+ mm <- locfit.matrix(object, data = data)
+ n <- object$mi["n"]
+ pred <- .C("sfitted",
+ x = as.numeric(mm$x),
+ y = as.numeric(rep(mm$y, length.out = n)),
+ w = as.numeric(rep(mm$w, length.out = n)),
+ ce = as.numeric(rep(mm$ce, length.out = n)),
+ ba = as.numeric(rep(mm$base, length.out = n)),
+ fit = numeric(n),
+ cv = as.integer(cv),
+ st = as.integer(studentize),
+ xev = as.numeric(object$eva$xev),
+ coef = as.numeric(object$eva$coef),
+ sv = as.numeric(object$cell$sv),
+ ce = as.integer(c(object$cell$ce, object$cell$s, object$cell$lo, object$
+ cell$hi)),
+ wpc = as.numeric(object$eva$pc),
+ scale = as.numeric(object$eva$scale),
+ nvc = as.integer(object$nvc),
+ mi = as.integer(object$mi),
+ dp = as.numeric(object$dp),
+ mg = as.integer(object$eva$ev$mg),
+ deriv = as.integer(object$deriv),
+ nd = as.integer(length(object$deriv)),
+ sty = as.integer(object$sty),
+ what = as.character(c(what, type)),
+ basis = list(eval(object$call$basis)), PACKAGE="locfit")
+ tr(pred$fit)
+}
+
+"formula.locfit"<-
+function(x, ...)
+x$call$formula
+
+"predict.locfit"<-
+function(object, newdata = NULL, where = "fitp", se.fit = FALSE, band = "none",
+ what = "coef", ...)
+{
+ if((se.fit) && (band == "none"))
+ band <- "global"
+ for(i in 1:length(what)) {
+ pred <- preplot.locfit(object, newdata, where = where, band = band, what =
+ what[i], ...)
+ fit <- pred$trans(pred$fit)
+ if(i == 1)
+ res <- fit
+ else res <- cbind(res, fit)
+ }
+ if(band == "none")
+ return(res)
+ return(list(fit = res, se.fit = pred$se.fit, residual.scale = pred$
+ residual.scale))
+}
+
+"lines.locfit"<-
+function(x, m = 100, tr = x$trans, ...)
+{
+ newx <- lfmarg(x, m = m)[[1]]
+ y <- predict(x, newx, tr = tr)
+ lines(newx, y, ...)
+}
+
+"points.locfit"<-
+function(x, tr, ...)
+{
+ d <- x$mi["d"]
+ p <- x$mi["p"]
+ nv <- x$nvc["nv"]
+ if(d == 1) {
+ if(missing(tr))
+ tr <- x$trans
+ x1 <- x$eva$xev
+ x2 <- x$eva$coef[, 1]
+ points(x1, tr(x2), ...)
+ }
+ if(d == 2) {
+ xx <- lfknots(x, what = "x")
+ points(xx[, 1], xx[, 2], ...)
+ }
+}
+
+"print.locfit"<-
+function(x, ...)
+{
+ if(!is.null(cl <- x$call)) {
+ cat("Call:\n")
+ dput(cl)
+ }
+ cat("\n")
+ cat("Number of observations: ", x$mi["n"], "\n")
+ cat("Family: ", c("Density", "PP Rate", "Hazard", "Gaussian", "Logistic",
+ "Poisson", "Gamma", "Geometric", "Circular", "Huber", "Robust Binomial",
+ "Weibull", "Cauchy")[x$mi["tg"] %% 64], "\n")
+ cat("Fitted Degrees of freedom: ", round(x$dp["df2"], 3), "\n")
+ cat("Residual scale: ", signif(sqrt(x$dp["rv"]), 3), "\n")
+ invisible(x)
+}
+
+"residuals.locfit"<-
+function(object, data = NULL, type = "deviance", ...)
+{
+ if(missing(data)) {
+ data <- if(is.null(object$call$data)) sys.frame(sys.parent()) else eval(object$call$
+ data)
+ }
+ fitted.locfit(object, data, ..., type = type)
+}
+
+"summary.locfit"<-
+function(object, ...)
+{
+ mi <- object$mi
+ fam <- c("Density Estimation", "Poisson process rate estimation",
+ "Hazard Rate Estimation", "Local Regression", "Local Likelihood - Binomial",
+ "Local Likelihood - Poisson", "Local Likelihood - Gamma",
+ "Local Likelihood - Geometric", "Local Robust Regression")[mi["tg"] %% 64]
+ estr <- c("Rectangular Tree", "Triangulation", "Data", "Rectangular Grid",
+ "k-d tree", "k-d centres", "Cross Validation", "User-provided")[mi["ev"]]
+ ret <- list(call = object$call, fam = fam, n = mi["n"], d = mi["d"], estr =
+ estr, nv = object$nvc["nv"], deg = mi["deg"], dp = object$dp, vnames =
+ object$vnames)
+ class(ret) <- "summary.locfit"
+ ret
+}
+
+"print.summary.locfit"<-
+function(x, ...)
+{
+ cat("Estimation type:", x$fam, "\n")
+ cat("\nCall:\n")
+ print(x$call)
+ cat("\nNumber of data points: ", x$n, "\n")
+ cat("Independent variables: ", x$vnames, "\n")
+ cat("Evaluation structure:", x$estr, "\n")
+ cat("Number of evaluation points: ", x$nv, "\n")
+ cat("Degree of fit: ", x$deg, "\n")
+ cat("Fitted Degrees of Freedom: ", round(x$dp["df2"], 3), "\n")
+ invisible(x)
+}
+
+"rbox"<-
+function(cut = 0.8, type = "tree", ll = rep(0, 10), ur = rep(0, 10))
+{
+ if(!any(type == c("tree", "kdtree", "kdcenter", "phull")))
+ stop("Invalid type argument")
+ ret <- list(type = type, xev = 0, mg = 0, cut = as.numeric(cut), ll =
+ as.numeric(ll), ur = as.numeric(ur))
+ class(ret) <- "lf_evs"
+ ret
+}
+
+"lfgrid"<-
+function(mg = 10, ll = rep(0, 10), ur = rep(0, 10))
+{
+ if(length(mg) == 1)
+ mg <- rep(mg, 10)
+ ret <- list(type = "grid", xev = 0, mg = as.integer(mg), cut = 0, ll =
+ as.numeric(ll), ur = as.numeric(ur))
+ class(ret) <- "lf_evs"
+ ret
+}
+
+"dat"<-
+function(cv = FALSE)
+{
+ type <- if(cv) "crossval" else "data"
+ ret <- list(type = type, xev = 0, mg = 0, cut = 0, ll = 0, ur = 0)
+ class(ret) <- "lf_evs"
+ ret
+}
+
+"xbar"<-
+function()
+{
+ ret <- list(type = "xbar", xev = 0, mg = 0, cut = 0, ll = 0, ur = 0)
+ class(ret) <- "lf_evs"
+ ret
+}
+
+"none"<-
+function()
+{
+ ret <- list(type = "none", xev = 0, mg = 0, cut = 0, ll = 0, ur = 0)
+ class(ret) <- "lf_evs"
+ ret
+}
+
+"plot.locfit"<-
+function(x, xlim, pv, tv, m, mtv = 6, band = "none", tr = NULL, what = "coef",
+ get.data = FALSE, f3d = (d == 2) && (length(tv) > 0), ...)
+{
+ d <- x$mi["d"]
+ ev <- x$mi["ev"]
+ where <- "grid"
+ if(missing(pv))
+ pv <- if(d == 1) 1 else c(1, 2)
+ if(is.character(pv))
+ pv <- match(pv, x$vnames)
+ if(missing(tv))
+ tv <- (1:d)[ - pv]
+ if(is.character(tv))
+ tv <- match(tv, x$vnames)
+ vrs <- c(pv, tv)
+ if(any(duplicated(vrs)))
+ warning("Duplicated variables in pv, tv")
+ if(any((vrs <= 0) | (vrs > d)))
+ stop("Invalid variable numbers in pv, tv")
+ if(missing(m))
+ m <- if(d == 1) 100 else 40
+ m <- rep(m, d)
+ m[tv] <- mtv
+ xl <- x$box
+ if(!missing(xlim))
+ xl <- lflim(xlim, x$vnames, xl)
+ if((d != 2) & (any(ev == c(3, 7, 8))))
+ pred <- preplot.locfit(x, where = "fitp", band = band, tr = tr, what = what,
+ get.data = get.data, f3d = f3d)
+ else {
+ marg <- lfmarg(xl, m)
+ pred <- preplot.locfit(x, marg, band = band, tr = tr, what = what, get.data
+ = get.data, f3d = f3d)
+ }
+ plot(pred, pv = pv, tv = tv, ...)
+}
+
+"preplot.locfit"<-
+function(object, newdata = NULL, where, tr = NULL, what = "coef", band = "none",
+ get.data = FALSE, f3d = FALSE, ...)
+{
+ mi <- object$mi
+ dim <- mi["d"]
+ ev <- mi["ev"]
+ nointerp <- any(ev == c(3, 7, 8))
+ wh <- 1
+ n <- 1
+ if(is.null(newdata)) {
+ if(missing(where))
+ where <- if(nointerp) "fitp" else "grid"
+ if(where == "grid")
+ newdata <- lfmarg(object)
+ if(any(where == c("fitp", "ev", "fitpoints"))) {
+ where <- "fitp"
+ newdata <- lfknots(object, what = "x", delete.pv = FALSE)
+ }
+ if(where == "data")
+ newdata <- locfit.matrix(object)$x
+ if(where == "vect")
+ stop("you must give the vector points")
+ }
+ else {
+ where <- "vect"
+ if(is.data.frame(newdata))
+ newdata <- as.matrix(model.frame(delete.response(object$terms), newdata))
+ else if(is.list(newdata))
+ where <- "grid"
+ else newdata <- as.matrix(newdata)
+ }
+ if(is.null(tr)) {
+ if(what == "coef")
+ tr <- object$trans
+ else tr <- function(x)
+ x
+ }
+ if((nointerp) && (where == "grid") && (dim == 2)) {
+ nv <- object$nvc["nv"]
+ x <- object$eva$xev[2 * (1:nv) - 1]
+ y <- object$eva$xev[2 * (1:nv)]
+ z <- preplot.locfit.raw(object, 0, "fitp", what, band)$y
+ haveAkima <- require(akima)
+ if (! haveAkima) stop("The akima package is needed for the interp() function. Please note its no-compercial-use license.")
+ fhat <- akima::interp(x, y, z, newdata[[1]], newdata[[2]], ncp = 2)$z
+ }
+ else {
+ z <- preplot.locfit.raw(object, newdata, where, what, band)
+ fhat <- z$y
+ }
+ fhat[fhat == 0.1278433] <- NA
+ band <- pmatch(band, c("none", "global", "local", "prediction"))
+ if(band > 1)
+ sse <- z$se
+ else sse <- numeric(0)
+ if(where != "grid")
+ newdata <- list(xev = newdata, where = where)
+ else newdata$where <- where
+ data <- if(get.data) locfit.matrix(object) else list()
+ if((f3d) | (dim > 3))
+ dim <- 3
+ ret <- list(xev = newdata, fit = fhat, se.fit = sse, residual.scale = sqrt(
+ object$dp["rv"]), critval = object$critval, trans = tr, vnames = object$
+ vnames, yname = object$yname, dim = as.integer(dim), data = data)
+ class(ret) <- "preplot.locfit"
+ ret
+}
+
+"preplot.locfit.raw"<-
+function(object, newdata, where, what, band, ...)
+{
+ wh <- pmatch(where, c("vect", "grid", "data", "fitp"))
+ switch(wh,
+ {
+ mg <- n <- nrow(newdata)
+ xev <- newdata
+ }
+ ,
+ {
+ xev <- unlist(newdata)
+ mg <- sapply(newdata, length)
+ n <- prod(mg)
+ }
+ ,
+ {
+ mg <- n <- object$mi["n"]
+ xev <- newdata
+ }
+ ,
+ {
+ mg <- n <- object$nvc["nv"]
+ xev <- newdata
+ }
+ )
+ .C("spreplot",
+ xev = as.numeric(object$eva$xev),
+ coef = as.numeric(object$eva$coef),
+ sv = as.numeric(object$cell$sv),
+ ce = as.integer(c(object$cell$ce, object$cell$s, object$cell$lo, object$
+ cell$hi)),
+ x = as.numeric(xev),
+ y = numeric(n),
+ se = numeric(n),
+ wpc = as.numeric(object$eva$pc),
+ scale = as.numeric(object$eva$scale),
+ m = as.integer(mg),
+ nvc = as.integer(object$nvc),
+ mi = as.integer(object$mi),
+ dp = as.numeric(object$dp),
+ mg = as.integer(object$eva$ev$mg),
+ deriv = as.integer(object$deriv),
+ nd = as.integer(length(object$deriv)),
+ sty = as.integer(object$sty),
+ wh = as.integer(wh),
+ what = c(what, band),
+ bs = list(eval(object$call$basis)), PACKAGE="locfit")
+}
+
+"print.preplot.locfit"<-
+function(x, ...)
+{
+ print(x$trans(x$fit))
+ invisible(x)
+}
+
+"plot.locfit.1d"<-
+function(x, add=FALSE, main="", xlab="default", ylab=x$yname, type="l",
+ ylim, lty = 1, col = 1, ...) {
+ y <- x$fit
+ nos <- !is.na(y)
+ xev <- x$xev[[1]][nos]
+ y <- y[nos]
+ ord <- order(xev)
+ if(xlab == "default")
+ xlab <- x$vnames
+ tr <- x$trans
+ yy <- tr(y)
+ if(length(x$se.fit) > 0) {
+ crit <- x$critval$crit.val
+ cup <- tr((y + crit * x$se.fit))[ord]
+ clo <- tr((y - crit * x$se.fit))[ord]
+ }
+ ndat <- 0
+ if(length(x$data) > 0) {
+ ndat <- nrow(x$data$x)
+ xdsc <- rep(x$data$sc, length.out = ndat)
+ xdyy <- rep(x$data$y, length.out = ndat)
+ dok <- xdsc > 0
+ }
+ if(missing(ylim)) {
+ if(length(x$se.fit) > 0)
+ ylim <- c(min(clo), max(cup))
+ else ylim <- range(yy)
+ if(ndat > 0)
+ ylim <- range(c(ylim, xdyy[dok]/xdsc[dok]))
+ }
+ if(!add) {
+ plot(xev[ord], yy[ord], type = "n", xlab = xlab, ylab = ylab, main = main,
+ xlim = range(x$xev[[1]]), ylim = ylim, ...)
+ }
+ lines(xev[ord], yy[ord], type = type, lty = lty, col = col)
+ if(length(x$se.fit) > 0) {
+ lines(xev[ord], cup, lty = 2)
+ lines(xev[ord], clo, lty = 2)
+ }
+ if(ndat > 0) {
+ xd <- x$data$x[dok]
+ yd <- xdyy[dok]/xdsc[dok]
+ cd <- rep(x$data$ce, length.out = ndat)[dok]
+ if(length(x$data$y) < 2) {
+ rug(xd[cd == 0])
+ if(any(cd == 1))
+ rug(xd[cd == 1], ticksize = 0.015)
+ }
+ else {
+ plotbyfactor(xd, yd, cd, col = col, pch = c("o", "+"), add = TRUE)
+ }
+ }
+ invisible(NULL)
+}
+
+"plot.locfit.2d"<-
+function(x, type="contour", main, xlab, ylab, zlab=x$yname, ...)
+{
+ if(x$xev$where != "grid")
+ stop("Can only plot from grids")
+ if(missing(xlab))
+ xlab <- x$vnames[1]
+ if(missing(ylab))
+ ylab <- x$vnames[2]
+ tr <- x$trans
+ m1 <- x$xev[[1]]
+ m2 <- x$xev[[2]]
+ y <- matrix(tr(x$fit))
+ if(type == "contour")
+ contour(m1, m2, matrix(y, nrow = length(m1)), ...)
+ if(type == "image")
+ image(m1, m2, matrix(y, nrow = length(m1)), ...)
+ if((length(x$data) > 0) && any(type == c("contour", "image"))) {
+ xd <- x$data$x
+ ce <- rep(x$data$ce, length.out = nrow(xd))
+ points(xd[ce == 0, 1], xd[ce == 0, 2], pch = "o")
+ if(any(ce == 1))
+ points(xd[ce == 1, 1], xd[ce == 1, 2], pch = "+")
+ }
+ if(type == "persp") {
+ nos <- is.na(y)
+ y[nos] <- min(y[!nos])
+ persp(m1, m2, matrix(y, nrow = length(m1)), zlab=zlab, ...)
+ }
+ if(!missing(main))
+ title(main = main)
+ invisible(NULL)
+}
+
+"plot.locfit.3d"<-
+function(x, main = "", pv, tv, type = "level", pred.lab = x$vnames, resp.lab =
+ x$yname, crit = 1.96, ...)
+{
+ xev <- x$xev
+ if(xev$where != "grid")
+ stop("Can only plot from grids")
+ xev$where <- NULL
+ newx <- as.matrix(expand.grid(xev))
+ newy <- x$trans(x$fit)
+ wh <- rep("f", length(newy))
+ if(length(x$data) > 0) {
+ dat <- x$data
+ for(i in tv) {
+ m <- xev[[i]]
+ dat$x[, i] <- m[1 + round((dat$x[, i] - m[1])/(m[2] - m[1]))]
+ }
+ newx <- rbind(newx, dat$x)
+ if(is.null(dat$y))
+ newy <- c(newy, rep(NA, nrow(dat$x)))
+ else {
+ newy <- c(newy, dat$y/dat$sc)
+ newy[is.na(newy)] <- 0
+ }
+ wh <- c(wh, rep("d", nrow(dat$x)))
+ }
+ if(length(tv) == 0) {
+ newdat <- data.frame(newy, newx[, pv])
+ names(newdat) <- c("y", paste("pv", 1:length(pv), sep = ""))
+ }
+ else {
+ newdat <- data.frame(newx[, tv], newx[, pv], newy)
+ names(newdat) <- c(paste("tv", 1:length(tv), sep = ""), paste("pv", 1:
+ length(pv), sep = ""), "y")
+ for(i in 1:length(tv))
+ newdat[, i] <- as.factor(signif(newdat[, i], 5))
+ }
+ loc.strip <- function(...)
+ strip.default(..., strip.names = c(TRUE, TRUE), style = 1)
+ if(length(pv) == 1) {
+ clo <- cup <- numeric(0)
+ if(length(x$se.fit) > 0) {
+ if((!is.null(class(crit))) && (class(crit) == "kappa"))
+ crit <- crit$crit.val
+ cup <- x$trans((x$fit + crit * x$se.fit))
+ clo <- x$trans((x$fit - crit * x$se.fit))
+ }
+ formula <- switch(1 + length(tv),
+ y ~ pv1,
+ y ~ pv1 | tv1,
+ y ~ pv1 | tv1 * tv2,
+ y ~ pv1 | tv1 * tv2 * tv3)
+ pl <- xyplot(formula, xlab = pred.lab[pv], ylab = resp.lab, main = main,
+ type = "l", cup = cup, wh = wh, panel = panel.xyplot.lf, data
+ = newdat, strip = loc.strip, ...)
+ }
+ if(length(pv) == 2) {
+ formula <- switch(1 + length(tv),
+ y ~ pv1 * pv2,
+ y ~ pv1 * pv2 | tv1,
+ y ~ pv1 * pv2 | tv1 * tv2,
+ y ~ pv1 * pv2 | tv1 * tv2 * tv3)
+ if(type == "contour")
+ pl <- contourplot(formula, xlab = pred.lab[pv[1]], ylab = pred.lab[pv[2]],
+ main = main, data = newdat, strip = loc.strip, ...)
+ if(type == "level")
+ pl <- levelplot(formula, xlab = pred.lab[pv[1]], ylab = pred.lab[pv[2]],
+ main = main, data = newdat, strip = loc.strip, ...)
+ if((type == "persp") | (type == "wireframe"))
+ pl <- wireframe(formula, xlab = pred.lab[pv[1]], ylab = pred.lab[pv[2]],
+ zlab = resp.lab, data = newdat, strip = loc.strip, ...)
+ }
+ if(length(tv) > 0) {
+ if(exists("is.R") && is.function(is.R) && is.R())
+ names(pl$cond) <- pred.lab[tv]
+ else names(attr(pl$glist, "endpts")) <- attr(pl$glist, "names") <- names(
+ attr(pl$glist, "index")) <- pred.lab[tv]
+ }
+ pl
+}
+
+"panel.xyplot.lf"<-
+function(x, y, subscripts, clo, cup, wh, type = "l", ...)
+{
+ wh <- wh[subscripts]
+ panel.xyplot(x[wh == "f"], y[wh == "f"], type = type, ...)
+ if(length(clo) > 0) {
+ panel.xyplot(x[wh == "f"], clo[subscripts][wh == "f"], type = "l", lty = 2,
+ ...)
+ panel.xyplot(x[wh == "f"], cup[subscripts][wh == "f"], type = "l", lty = 2,
+ ...)
+ }
+ if(any(wh == "d")) {
+ yy <- y[wh == "d"]
+ if(any(is.na(yy)))
+ rug(x[wh == "d"])
+ else panel.xyplot(x[wh == "d"], yy)
+ }
+}
+
+"plot.preplot.locfit"<-
+function(x, pv, tv, ...)
+{
+ if(x$dim == 1)
+ plot.locfit.1d(x, ...)
+ if(x$dim == 2)
+ plot.locfit.2d(x, ...)
+ if(x$dim >= 3)
+ print(plot.locfit.3d(x, pv=pv, tv=tv, ...))
+ invisible(NULL)
+}
+
+"summary.preplot.locfit"<-
+function(object, ...)
+object$trans(object$fit)
+
+
+## Deepayan Sarkar's patched version:
+"panel.locfit"<-
+ function(x, y, subscripts, z,
+ xyz.labs, xyz.axes, xyz.mid, xyz.minmax, xyz.range,
+ col.regions, at, drape, contour, region, groups,
+ ...)
+{
+ if(!missing(z)) {
+ zs <- z[subscripts]
+ fit <- locfit.raw(cbind(x, y), zs, ...)
+ marg <- lfmarg(fit, m = 10)
+ zp <- predict(fit, marg)
+ if(!missing(contour)) {
+ print("contour")
+ print(range(zp))
+ lattice::render.contour.trellis(marg[[1]], marg[[2]], zp, at = at)
+ }
+ else {
+ loc.dat <-
+ cbind(as.matrix(expand.grid(x = marg[[1]],
+ y = marg[[1]])),
+ z = zp)
+ lattice::render.3d.trellis(cbind(x = x, y = y, z = z[subscripts]),
+ type = "cloud",
+ xyz.labs = xyz.labs,
+ xyz.axes = xyz.axes,
+ xyz.mid = xyz.mid,
+ xyz.minmax = xyz.minmax,
+ xyz.range = xyz.range,
+ col.regions = col.regions,
+ at = at,
+ drape = drape)
+ }
+ }
+ else {
+ panel.xyplot(x, y, ...)
+ args <- list(x = x, y = y, ...)
+ ok <- names(formals(locfit.raw))
+ llines.locfit(do.call("locfit.raw",
+ args[ok[ok %in% names(args)]]))
+ }
+}
+
+llines.locfit <-
+function (x, m = 100, tr = x$trans, ...)
+{
+ newx <- lfmarg(x, m = m)[[1]]
+ y <- predict(x, newx, tr = tr)
+ llines(newx, y, ...)
+}
+
+## "panel.locfit"<-
+# function(x, y, subscripts, z, xyz.labs, xyz.axes, xyz.mid, xyz.minmax,
+# xyz.range, col.regions, at, drape, contour, region, groups, ...)
+# {
+# if(!missing(z)) {
+# zs <- z[subscripts]
+# fit <- locfit.raw(cbind(x, y), zs, ...)
+# marg <- lfmarg(fit, m = 10)
+# zp <- predict(fit, marg)
+# if(!missing(contour)) {
+# print("contour")
+# print(range(zp))
+# render.contour.trellis(marg[[1]], marg[[2]], zp, at = at)
+# }
+# else {
+# loc.dat <- cbind(as.matrix(expand.grid(x = marg[[1]], y = marg[[1]])), z
+# = zp)
+# render.3d.trellis(cbind(x = x, y = y, z = z[subscripts]), type = "cloud",
+# xyz.labs = xyz.labs, xyz.axes = xyz.axes, xyz.mid = xyz.mid, xyz.minmax
+# = xyz.minmax, xyz.range = xyz.range, col.regions = col.regions, at =
+# at, drape = drape)
+# }
+# }
+# else {
+# panel.xyplot(x, y)
+# lines(locfit.raw(x, y, ...))
+# }
+# }
+
+"lfmarg"<-
+function(xlim, m = 40)
+{
+ if(!is.numeric(xlim)) {
+ d <- xlim$mi["d"]
+ xlim <- xlim$box
+ }
+ else d <- length(m)
+ marg <- vector("list", d)
+ m <- rep(m, length.out = d)
+ for(i in 1:d)
+ marg[[i]] <- seq(xlim[i], xlim[i + d], length.out = m[i])
+ marg
+}
+
+"lfeval"<-
+function(object)
+object$eva
+
+"plot.lfeval"<-
+function(x, add = FALSE, txt = FALSE, ...)
+{
+ if(class(x) == "locfit")
+ x <- x$eva
+ d <- length(x$scale)
+ v <- matrix(x$xev, nrow = d)
+ if(d == 1) {
+ xx <- v[1, ]
+ y <- x$coef[, 1]
+ }
+ if(d == 2) {
+ xx <- v[1, ]
+ y <- v[2, ]
+ }
+ if(!add) {
+ plot(xx, y, type = "n", ...)
+ }
+ points(xx, y, ...)
+ if(txt)
+ text(xx, y, (1:length(xx)) - 1)
+ invisible(x)
+}
+
+"print.lfeval"<-
+function(x, ...)
+{
+ if(class(x) == "locfit")
+ x <- x$eva
+ d <- length(x$scale)
+ ret <- matrix(x$xev, ncol = d, byrow = TRUE)
+ print(ret)
+}
+
+"lflim"<-
+function(limits, nm, ret)
+{
+ d <- length(nm)
+ if(is.numeric(limits))
+ ret <- limits
+ else {
+ z <- match(nm, names(limits))
+ for(i in 1:d)
+ if(!is.na(z[i])) ret[c(i, i + d)] <- limits[[z[i]]]
+ }
+ as.numeric(ret)
+}
+
+"plot.eval"<-
+function(x, add = FALSE, text = FALSE, ...)
+{
+ d <- x$mi["d"]
+ v <- matrix(x$eva$xev, nrow = d)
+ ev <- x$mi["ev"]
+ pv <- if(any(ev == c(1, 2))) as.logical(x$cell$s) else rep(FALSE, ncol(v))
+ if(!add) {
+ plot(v[1, ], v[2, ], type = "n", xlab = x$vnames[1], ylab = x$vnames[2])
+ }
+ if(text)
+ text(v[1, ], v[2, ], (1:x$nvc["nv"]) - 1)
+ else {
+ if(any(!pv))
+ points(v[1, !pv], v[2, !pv], ...)
+ if(any(pv))
+ points(v[1, pv], v[2, pv], pch = "*", ...)
+ }
+ if(any(x$mi["ev"] == c(1, 2))) {
+ zz <- .C("triterm",
+ as.numeric(v),
+ h = as.numeric(lfknots(x, what = "h", delete.pv = FALSE)),
+ as.integer(x$cell$ce),
+ lo = as.integer(x$cell$lo),
+ hi = as.integer(x$cell$hi),
+ as.numeric(x$eva$scale),
+ as.integer(x$nvc),
+ as.integer(x$mi),
+ as.numeric(x$dp),
+ nt = integer(1),
+ term = integer(600),
+ box = x$box, PACKAGE="locfit")
+ ce <- zz$term + 1
+ }
+ else ce <- x$cell$ce + 1
+ if(any(x$mi["ev"] == c(1, 5, 7))) {
+ vc <- 2^d
+ ce <- matrix(ce, nrow = vc)
+ segments(v[1, ce[1, ]], v[2, ce[1, ]], v[1, ce[2, ]], v[2, ce[2, ]],
+ ...)
+ segments(v[1, ce[1, ]], v[2, ce[1, ]], v[1, ce[3, ]], v[2, ce[3, ]],
+ ...)
+ segments(v[1, ce[2, ]], v[2, ce[2, ]], v[1, ce[4, ]], v[2, ce[4, ]],
+ ...)
+ segments(v[1, ce[3, ]], v[2, ce[3, ]], v[1, ce[4, ]], v[2, ce[4, ]],
+ ...)
+ }
+ if(any(x$mi["ev"] == c(2, 8))) {
+ vc <- d + 1
+ m <- matrix(ce, nrow = 3)
+ segments(v[1, m[1, ]], v[2, m[1, ]], v[1, m[2, ]], v[2, m[2, ]], ...)
+ segments(v[1, m[1, ]], v[2, m[1, ]], v[1, m[3, ]], v[2, m[3, ]], ...)
+ segments(v[1, m[2, ]], v[2, m[2, ]], v[1, m[3, ]], v[2, m[3, ]], ...)
+ }
+ invisible(NULL)
+}
+
+"rv"<-
+function(fit)
+fit$dp["rv"]
+
+"rv<-"<-
+function(fit, value)
+{
+ fit$dp["rv"] <- value
+ fit
+}
+
+"regband"<-
+function(formula, what = c("CP", "GCV", "GKK", "RSW"), deg = 1, ...)
+{
+ m <- match.call()
+ m$geth <- 3
+ m$deg <- c(deg, 4)
+ m$what <- NULL
+ m$deriv <- match(what, c("CP", "GCV", "GKK", "RSW"))
+ m[[1]] <- as.name("locfit")
+ z <- eval(m, sys.frame(sys.parent()))
+ names(z) <- what
+ z[1:length(what)]
+}
+
+"kdeb"<-
+function(x, h0 = 0.01 * sd, h1 = sd, meth = c("AIC", "LCV", "LSCV", "BCV",
+ "SJPI", "GKK"), kern = "gauss", gf = 2.5)
+{
+ n <- length(x)
+ sd <- sqrt(var(x))
+ z <- .C("kdeb",
+ x = as.numeric(x),
+ mi = as.integer(n),
+ band = numeric(length(meth)),
+ ind = integer(n),
+ h0 = as.numeric(gf * h0),
+ h1 = as.numeric(gf * h1),
+ meth = as.integer(match(meth, c("AIC", "LCV", "LSCV", "BCV", "SJPI", "GKK")
+ )),
+ nmeth = as.integer(length(meth)),
+ kern = pmatch(kern, c("rect", "epan", "bisq", "tcub", "trwt", "gauss")),
+ PACKAGE="locfit")
+ band <- z$band
+ names(band) <- meth
+ band
+}
+
+"lfknots"<-
+function(x, tr, what = c("x", "coef", "h", "nlx"), delete.pv = TRUE)
+{
+ nv <- x$nvc["nv"]
+ d <- x$mi["d"]
+ p <- x$mi["p"]
+ z <- 0:(nv - 1)
+ ret <- matrix(0, nrow = nv, ncol = 1)
+ rname <- character(0)
+ if(missing(tr))
+ tr <- x$trans
+ coef <- x$eva$coef
+ for(wh in what) {
+ if(wh == "x") {
+ ret <- cbind(ret, matrix(x$eva$xev, ncol = d, byrow = TRUE))
+ rname <- c(rname, x$vnames)
+ }
+ if(wh == "coef") {
+ d0 <- coef[, 1]
+ d0[d0 == 0.1278433] <- NA
+ ret <- cbind(ret, tr(d0))
+ rname <- c(rname, "mu hat")
+ }
+ if(wh == "f1") {
+ ret <- cbind(ret, coef[, 1 + (1:d)])
+ rname <- c(rname, paste("d", 1:d, sep = ""))
+ }
+ if(wh == "nlx") {
+ ret <- cbind(ret, coef[, d + 2])
+ rname <- c(rname, "||l(x)||")
+ }
+ if(wh == "nlx1") {
+ ret <- cbind(ret, coef[, d + 2 + (1:d)])
+ rname <- c(rname, paste("nlx-d", 1:d, sep = ""))
+ }
+ if(wh == "se") {
+ ret <- cbind(ret, sqrt(x$dp["rv"]) * coef[, d + 2])
+ rname <- c(rname, "StdErr")
+ }
+ if(wh == "infl") {
+ z <- coef[, 2 * d + 3]
+ ret <- cbind(ret, z * z)
+ rname <- c(rname, "Influence")
+ }
+ if(wh == "infla") {
+ ret <- cbind(ret, coef[, 2 * d + 3 + (1:d)])
+ rname <- c(rname, paste("inf-d", 1:d, sep = ""))
+ }
+ if(wh == "lik") {
+ ret <- cbind(ret, coef[, 3 * d + 3 + (1:3)])
+ rname <- c(rname, c("LocLike", "fit.df", "res.df"))
+ }
+ if(wh == "h") {
+ ret <- cbind(ret, coef[, 3 * d + 7])
+ rname <- c(rname, "h")
+ }
+ if(wh == "deg") {
+ ret <- cbind(ret, coef[, 3 * d + 8])
+ rname <- c(rname, "deg")
+ }
+ }
+ ret <- as.matrix(ret[, -1])
+ if(nv == 1)
+ ret <- t(ret)
+ dimnames(ret) <- list(NULL, rname)
+ if((delete.pv) && (any(x$mi["ev"] == c(1, 2))))
+ ret <- ret[!as.logical(x$cell$s), ]
+ ret
+}
+
+"locfit.matrix"<-
+function(fit, data)
+{
+ m <- fit$call
+ n <- fit$mi["n"]
+ y <- ce <- base <- 0
+ w <- 1
+ if(m[[1]] == "locfit.raw") {
+ x <- as.matrix(eval(m$x, fit$frame))
+ if(!is.null(m$y))
+ y <- eval(m$y, fit$frame)
+ if(!is.null(m$weights))
+ w <- eval(m$weights, fit$frame)
+ if(!is.null(m$cens))
+ ce <- eval(m$cens, fit$frame)
+ if(!is.null(m$base))
+ base <- eval(m$base, fit$frame)
+ }
+ else {
+ Terms <- terms(as.formula(m$formula))
+ attr(Terms, "intercept") <- 0
+ m[[1]] <- as.name("model.frame")
+ z <- pmatch(names(m), c("formula", "data", "weights", "cens", "base",
+ "subset"))
+ for(i in length(z):2)
+ if(is.na(z[i])) m[[i]] <- NULL
+ frm <- eval(m, fit$frame)
+ vnames <- as.character(attributes(Terms)$variables)[-1]
+ if(attr(Terms, "response")) {
+ y <- model.extract(frm, "response")
+ vnames <- vnames[-1]
+ }
+ x <- as.matrix(frm[, vnames])
+ if(any(names(m) == "weights"))
+ w <- model.extract(frm, weights)
+ if(any(names(m) == "cens"))
+ ce <- model.extract(frm, "cens")
+ if(any(names(m) == "base"))
+ base <- model.extract(frm, base)
+ }
+ sc <- if(any((fit$mi["tg"] %% 64) == c(5:8, 11, 12))) w else 1
+ list(x = x, y = y, w = w, sc = sc, ce = ce, base = base)
+}
+
+"expit"<-
+function(x)
+{
+ y <- x
+ ix <- (x < 0)
+ y[ix] <- exp(x[ix])/(1 + exp(x[ix]))
+ y[!ix] <- 1/(1 + exp( - x[!ix]))
+ y
+}
+
+"plotbyfactor"<-
+function(x, y, f, data, col = 1:10, pch = "O", add = FALSE, lg, xlab = deparse(
+ substitute(x)), ylab = deparse(substitute(y)), log = "", ...)
+{
+ if(!missing(data)) {
+ x <- eval(substitute(x), data)
+ y <- eval(substitute(y), data)
+ f <- eval(substitute(f), data)
+ }
+ f <- as.factor(f)
+ if(!add)
+ plot(x, y, type = "n", xlab = xlab, ylab = ylab, log = log, ...)
+ lv <- levels(f)
+ col <- rep(col, length.out = length(lv))
+ pch <- rep(pch, length.out = length(lv))
+ for(i in 1:length(lv)) {
+ ss <- f == lv[i]
+ if(any(ss))
+ points(x[ss], y[ss], col = col[i], pch = pch[i])
+ }
+ if(!missing(lg))
+ legend(lg[1], lg[2], legend = levels(f), col = col, pch = paste(pch,
+ collapse = ""))
+}
+
+"hatmatrix"<-
+function(formula, dc = TRUE, ...)
+{
+ m <- match.call()
+ m$geth <- 1
+ m[[1]] <- as.name("locfit")
+ z <- eval(m, sys.frame(sys.parent()))
+ nvc <- z[[2]]
+ nvm <- nvc[1]
+ nv <- nvc[4]
+ matrix(z[[1]], ncol = nvm)[, 1:nv]
+}
+
+"locfit.robust"<-
+function(x, y, weights, ..., iter = 3)
+{
+ m <- match.call()
+ if((!is.numeric(x)) && (class(x) == "formula")) {
+ m1 <- m[[1]]
+ m[[1]] <- as.name("locfit")
+ m$lfproc <- m1
+ names(m)[[2]] <- "formula"
+ return(eval(m, sys.frame(sys.parent())))
+ }
+ n <- length(y)
+ lfr.wt <- rep(1, n)
+ m[[1]] <- as.name("locfit.raw")
+ for(i in 0:iter) {
+ m$weights <- lfr.wt
+ fit <- eval(m, sys.frame(sys.parent()))
+ res <- residuals(fit, type = "raw")
+ s <- median(abs(res))
+ lfr.wt <- pmax(1 - (res/(6 * s))^2, 0)^2
+ }
+ fit
+}
+
+"locfit.censor"<-
+function(x, y, cens, ..., iter = 3, km = FALSE)
+{
+ m <- match.call()
+ if((!is.numeric(x)) && (class(x) == "formula")) {
+ m1 <- m[[1]]
+ m[[1]] <- as.name("locfit")
+ m$lfproc <- m1
+ names(m)[[2]] <- "formula"
+ return(eval(m, sys.frame(sys.parent())))
+ }
+ lfc.y <- y
+ cens <- as.logical(cens)
+ m$cens <- m$iter <- m$km <- NULL
+ m[[1]] <- as.name("locfit.raw")
+ for (i in 0:iter) {
+ m$y <- lfc.y
+ fit <- eval(m, sys.frame(sys.parent()))
+ fh <- fitted(fit)
+ if(km) {
+ sr <- y - fh
+ lfc.y <- y + km.mrl(sr, cens)
+ }
+ else {
+ rdf <- sum(1 - cens) - 2 * fit$dp["df1"] + fit$dp["df2"]
+ sigma <- sqrt(sum((y - fh) * (lfc.y - fh))/rdf)
+ sr <- (y - fh)/sigma
+ lfc.y <- fh + (sigma * dnorm(sr))/pnorm( - sr)
+ }
+ lfc.y[!cens] <- y[!cens]
+ }
+ m$cens <- substitute(cens)
+ m$y <- substitute(y)
+ fit$call <- m
+ fit
+}
+
+"km.mrl"<-
+function(times, cens)
+{
+ n <- length(times)
+ if(length(cens) != length(times))
+ stop("times and cens must have equal length")
+ ord <- order(times)
+ times <- times[ord]
+ cens <- cens[ord]
+ n.alive <- n:1
+ haz.km <- (1 - cens)/n.alive
+ surv.km <- exp(cumsum(log(1 - haz.km[ - n])))
+ int.surv <- c(diff(times) * surv.km)
+ mrl.km <- c(rev(cumsum(rev(int.surv)))/surv.km, 0)
+ mrl.km[!cens] <- 0
+ mrl.km.ord <- numeric(n)
+ mrl.km.ord[ord] <- mrl.km
+ mrl.km.ord
+}
+
+"locfit.quasi"<-
+function(x, y, weights, ..., iter = 3, var = abs)
+{
+ m <- match.call()
+ if((!is.numeric(x)) && (class(x) == "formula")) {
+ m1 <- m[[1]]
+ m[[1]] <- as.name("locfit")
+ m$lfproc <- m1
+ names(m)[[2]] <- "formula"
+ return(eval(m, sys.frame(sys.parent())))
+ }
+ n <- length(y)
+ w0 <- lfq.wt <- if(missing(weights)) rep(1, n) else weights
+ m[[1]] <- as.name("locfit.raw")
+ for(i in 0:iter) {
+ m$weights <- lfq.wt
+ fit <- eval(m, sys.frame(sys.parent()))
+ fh <- fitted(fit)
+ lfq.wt <- w0/var(fh)
+ }
+ fit
+}
+
+"density.lf"<-
+function(x, n=50, window="gaussian", width, from, to, cut=if(iwindow == 4)
+ 0.75 else 0.5, ev=lfgrid(mg=n, ll=from, ur=to), deg=0,
+ family="density", link="ident", ...)
+{
+ if(!exists("logb"))
+ logb <- log
+ # for R
+ x <- sort(x)
+ r <- range(x)
+ iwindow <- pmatch(window, c("rectangular", "triangular", "cosine", "gaussian"
+ ), -1.)
+ if(iwindow < 0.)
+ kern <- window
+ else kern <- c("rect", "tria", NA, "gauss")[iwindow]
+ if(missing(width)) {
+ nbar <- logb(length(x), base = 2.) + 1.
+ width <- diff(r)/nbar * 0.5
+ }
+ if(missing(from))
+ from <- r[1.] - width * cut
+ if(missing(to))
+ to <- r[2.] + width * cut
+ if(to <= from)
+ stop("Invalid from/to values")
+ h <- width/2
+ if(kern == "gauss")
+ h <- h * 1.25
+ fit <- locfit.raw(lp(x, h = h, deg = deg), ev = ev, kern = kern, link = link,
+ family = family, ...)
+ list(x = fit$eva$xev, y = fit$eva$coef[, 1])
+}
+
+"smooth.lf"<-
+function(x, y, xev = x, direct = FALSE, ...)
+{
+ # just a simple smooth with (x,y) input, mu-hat output.
+ # locfit.raw options are valid.
+ if(missing(y)) {
+ y <- x
+ x <- 1:length(y)
+ }
+ if(direct) {
+ fit <- locfit.raw(x, y, ev = xev, geth = 7, ...)
+ fv <- fit$y
+ xev <- fit$x
+ if(is.matrix(x))
+ xev <- matrix(xev, ncol = ncol(x), byrow = TRUE)
+ }
+ else {
+ fit <- locfit.raw(x, y, ...)
+ fv <- predict(fit, xev)
+ }
+ list(x = xev, y = fv, call = match.call())
+}
+
+"gcv"<-
+function(x, ...)
+{
+ m <- match.call()
+ if(is.numeric(x))
+ m[[1]] <- as.name("locfit.raw")
+ else {
+ m[[1]] <- as.name("locfit")
+ names(m)[2] <- "formula"
+ }
+ fit <- eval(m, sys.frame(sys.parent()))
+ z <- fit$dp[c("lk", "df1", "df2")]
+ n <- fit$mi["n"]
+ z <- c(z, (-2 * n * z[1])/(n - z[2])^2)
+ names(z) <- c("lik", "infl", "vari", "gcv")
+ z
+}
+
+"gcvplot"<-
+function(..., alpha, df = 2)
+{
+ m <- match.call()
+ m[[1]] <- as.name("gcv")
+ m$df <- NULL
+ if(!is.matrix(alpha))
+ alpha <- matrix(alpha, ncol = 1)
+ k <- nrow(alpha)
+ z <- matrix(nrow = k, ncol = 4)
+ for(i in 1:k) {
+ m$alpha <- alpha[i, ]
+ z[i, ] <- eval(m, sys.frame(sys.parent()))
+ }
+ ret <- list(alpha = alpha, cri = "GCV", df = z[, df], values = z[, 4])
+ class(ret) <- "gcvplot"
+ ret
+}
+
+"plot.gcvplot"<-
+function(x, xlab = "Fitted DF", ylab = x$cri, ...)
+{
+ plot(x$df, x$values, xlab = xlab, ylab = ylab, ...)
+}
+
+"print.gcvplot"<-
+function(x, ...)
+plot.gcvplot(x = x, ...)
+
+"summary.gcvplot"<-
+function(object, ...)
+{
+ z <- cbind(object$df, object$values)
+ dimnames(z) <- list(NULL, c("df", object$cri))
+ z
+}
+
+"aic"<-
+function(x, ..., pen = 2)
+{
+ m <- match.call()
+ if(is.numeric(x))
+ m[[1]] <- as.name("locfit.raw")
+ else {
+ m[[1]] <- as.name("locfit")
+ names(m)[2] <- "formula"
+ }
+ m$pen <- NULL
+ fit <- eval(m, sys.frame(sys.parent()))
+ dp <- fit$dp
+ z <- dp[c("lk", "df1", "df2")]
+ z <- c(z, -2 * z[1] + pen * z[2])
+ names(z) <- c("lik", "infl", "vari", "aic")
+ z
+}
+
+"aicplot"<-
+function(..., alpha)
+{
+ m <- match.call()
+ m[[1]] <- as.name("aic")
+ if(!is.matrix(alpha))
+ alpha <- matrix(alpha, ncol = 1)
+ k <- nrow(alpha)
+ z <- matrix(nrow = k, ncol = 4)
+ for(i in 1:k) {
+ m$alpha <- alpha[i, ]
+ z[i, ] <- eval(m, sys.frame(sys.parent()))
+ }
+ ret <- list(alpha = alpha, cri = "AIC", df = z[, 2], values = z[, 4])
+ class(ret) <- "gcvplot"
+ ret
+}
+
+"cp"<-
+function(x, ..., sig2 = 1)
+{
+ m <- match.call()
+ if(is.numeric(x))
+ m[[1]] <- as.name("locfit.raw")
+ else {
+ m[[1]] <- as.name("locfit")
+ names(m)[2] <- "formula"
+ }
+ m$sig2 <- NULL
+ fit <- eval(m, sys.frame(sys.parent()))
+ z <- c(fit$dp[c("lk", "df1", "df2")], fit$mi["n"])
+ z <- c(z, (-2 * z[1])/sig2 - z[4] + 2 * z[2])
+ names(z) <- c("lik", "infl", "vari", "n", "cp")
+ z
+}
+
+"cpplot"<-
+function(..., alpha, sig2)
+{
+ m <- match.call()
+ m[[1]] <- as.name("cp")
+ m$sig2 <- NULL
+ if(!is.matrix(alpha))
+ alpha <- matrix(alpha, ncol = 1)
+ k <- nrow(alpha)
+ z <- matrix(nrow = k, ncol = 5)
+ for(i in 1:k) {
+ m$alpha <- alpha[i, ]
+ z[i, ] <- eval(m, sys.frame(sys.parent()))
+ }
+ if(missing(sig2)) {
+ s <- (1:k)[z[, 3] == max(z[, 3])][1]
+ sig2 <- (-2 * z[s, 1])/(z[s, 4] - 2 * z[s, 2] + z[s, 3])
+ }
+ ret <- list(alpha = alpha, cri = "CP", df = z[, 3], values = (-2 * z[, 1])/
+ sig2 - z[, 4] + 2 * z[, 2])
+ class(ret) <- "gcvplot"
+ ret
+}
+
+"lcv"<-
+function(x, ...)
+{
+ m <- match.call()
+ if(is.numeric(x))
+ m[[1]] <- as.name("locfit.raw")
+ else {
+ m[[1]] <- as.name("locfit")
+ names(m)[2] <- "formula"
+ }
+ fit <- eval(m, sys.frame(sys.parent()))
+ z <- fit$dp[c("lk", "df1", "df2")]
+ res <- residuals(fit, type = "d2", cv = TRUE)
+ z <- c(z, sum(res))
+ names(z) <- c("lik", "infl", "vari", "cv")
+ z
+}
+
+"lcvplot"<-
+function(..., alpha)
+{
+ m <- match.call()
+ m[[1]] <- as.name("lcv")
+ if(!is.matrix(alpha))
+ alpha <- matrix(alpha, ncol = 1)
+ k <- nrow(alpha)
+ z <- matrix(nrow = k, ncol = 4)
+ for(i in 1:k) {
+ m$alpha <- alpha[i, ]
+ z[i, ] <- eval(m, sys.frame(sys.parent()))
+ }
+ ret <- list(alpha = alpha, cri = "LCV", df = z[, 2], values = z[, 4])
+ class(ret) <- "gcvplot"
+ ret
+}
+
+"lscv"<-
+function(x, ..., exact = FALSE)
+{
+ if(exact) {
+ ret <- lscv.exact(x, ...)
+ }
+ else {
+ m <- match.call()
+ m$exact <- NULL
+ if(is.numeric(x))
+ m[[1]] <- as.name("locfit.raw")
+ else {
+ m[[1]] <- as.name("locfit")
+ names(m)[2] <- "formula"
+ }
+ m$geth <- 6
+ ret <- eval(m, sys.frame(sys.parent()))
+ }
+ ret
+}
+
+"lscv.exact"<-
+function(x, h = 0)
+{
+ if(!is.null(attr(x, "alpha")))
+ h <- attr(x, "alpha")[2]
+ if(h <= 0)
+ stop("lscv.exact: h must be positive.")
+ ret <- .C("slscv",
+ x = as.numeric(x),
+ n = as.integer(length(x)),
+ h = as.numeric(h),
+ ret = numeric(2), PACKAGE="locfit")$ret
+ ret
+}
+
+"lscvplot"<-
+function(..., alpha)
+{
+ m <- match.call()
+ m[[1]] <- as.name("lscv")
+ if(!is.matrix(alpha))
+ alpha <- matrix(alpha, ncol = 1)
+ k <- nrow(alpha)
+ z <- matrix(nrow = k, ncol = 2)
+ for(i in 1:k) {
+ m$alpha <- alpha[i, ]
+ z[i, ] <- eval(m, sys.frame(sys.parent()))
+ }
+ ret <- list(alpha = alpha, cri = "LSCV", df = z[, 2], values = z[, 1])
+ class(ret) <- "gcvplot"
+ ret
+}
+
+"sjpi"<-
+function(x, a)
+{
+ dnorms <- function(x, k)
+ {
+ if(k == 0)
+ return(dnorm(x))
+ if(k == 1)
+ return( - x * dnorm(x))
+ if(k == 2)
+ return((x * x - 1) * dnorm(x))
+ if(k == 3)
+ return(x * (3 - x * x) * dnorm(x))
+ if(k == 4)
+ return((3 - x * x * (6 - x * x)) * dnorm(x))
+ if(k == 6)
+ return((-15 + x * x * (45 - x * x * (15 - x * x))) * dnorm(x))
+ stop("k too large in dnorms")
+ }
+ alpha <- a * sqrt(2)
+ n <- length(x)
+ M <- outer(x, x, "-")
+ s <- numeric(length(alpha))
+ for(i in 1:length(alpha)) {
+ s[i] <- sum(dnorms(M/alpha[i], 4))
+ }
+ s <- s/(n * (n - 1) * alpha^5)
+ h <- (s * 2 * sqrt(pi) * n)^(-0.2)
+ lambda <- diff(summary(x)[c(2, 5)])
+ A <- 0.92 * lambda * n^(-1/7)
+ B <- 0.912 * lambda * n^(-1/9)
+ tb <- - sum(dnorms(M/B, 6))/(n * (n - 1) * B^7)
+ sa <- sum(dnorms(M/A, 4))/(n * (n - 1) * A^5)
+ ah <- 1.357 * (sa/tb * h^5)^(1/7)
+ cbind(h, a, ah/sqrt(2), s)
+}
+
+"scb"<-
+function(x, ..., ev = lfgrid(20), simul = TRUE, type = 1)
+{
+ oc <- m <- match.call()
+ if(is.numeric(x))
+ m[[1]] <- as.name("locfit.raw")
+ else {
+ m[[1]] <- as.name("locfit")
+ names(m)[2] <- "formula"
+ }
+ m$type <- m$simul <- NULL
+ m$geth <- 70 + type + 10 * simul
+ m$ev <- substitute(ev)
+ fit <- eval(m, sys.frame(sys.parent()))
+ fit$call <- oc
+ class(fit) <- "scb"
+ fit
+}
+
+"plot.scb"<-
+function(x, add = FALSE, ...)
+{
+ fit <- x$trans(x$coef)
+ lower <- x$trans(x$lower)
+ upper <- x$trans(x$upper)
+ d <- x$d
+ if(d == 1)
+ plot.scb.1d(x, fit, lower, upper, add, ...)
+ if(d == 2)
+ plot.scb.2d(x, fit = fit, lower = lower, upper = upper, ...)
+ if(!any(d == c(1, 2)))
+ stop("Can't plot this scb")
+}
+
+"plot.scb.1d"<-
+function(x, fit, lower, upper, add = FALSE, style = "band", ...)
+{
+ if(style == "test") {
+ lower <- lower - fit
+ upper <- upper - fit
+ }
+ if(!add) {
+ yl <- range(c(lower, fit, upper))
+ plot(x$xev, fit, type = "l", ylim = yl, xlab = x$vnames[1])
+ }
+ lines(x$xev, lower, lty = 2)
+ lines(x$xev, upper, lty = 2)
+ if(is.null(x$call$deriv)) {
+ dx <- x$data$x
+ sc <- if(any((x$mi["tg"] %% 64) == c(5:8, 11, 12))) x$data$w else 1
+ dy <- x$data$y/sc
+ points(dx, dy)
+ }
+ if(style == "test")
+ abline(h = 0, lty = 3)
+}
+
+"plot.scb.2d" <- function(x, fit, lower, upper, style = "tl", ylim, ...) {
+ plot.tl <- function(x, y, z, nint = c(16, 15), v1, v2,
+ xlab=deparse(substitute(x)),
+ ylab=deparse(substitute(y)),
+ legend=FALSE, pch="", ...) {
+ xl <- range(x)
+ if (legend) {
+ mar <- par()$mar
+ if (mar[4] < 6.1)
+ par(mar = c(mar[1:3], 6.1))
+ on.exit(par(mar = mar))
+ dlt <- diff(xl)
+ xl[2] <- xl[2] + 0.02 * dlt
+ }
+ plot(1, 1, type = "n", xlim = xl, ylim = range(y), xlab = xlab,
+ ylab = ylab, ...)
+ nx <- length(x)
+ ny <- length(y)
+ if (missing(v)) {
+ v <- seq(min(z) - 0.0001, max(z), length.out = nint + 1)
+ } else {
+ nint <- length(v) - 1
+ }
+ ix <- rep(1:nx, ny)
+ iy <- rep(1:ny, rep(nx, ny))
+ r1 <- range(z[, 1])
+ r2 <- range(z[, 2])
+ hue <- if (missing(v1)) {
+ floor((nint[1] * (z[, 1] - r1[1]))/(r1[2] - r1[1]) * 0.999999999)
+ } else cut(z[, 1], v1) - 1
+ sat <- if (missing(v2)) {
+ floor((nint[2] * (z[, 2] - r2[1]))/(r2[2] - r2[1]) * 0.999999999)
+ } else cut(z[, 2], v2) - 1
+ col <- hue + nint[1] * sat + 1
+ x <- c(2 * x[1] - x[2], x, 2 * x[nx] - x[nx - 1])
+ y <- c(2 * y[1] - y[2], y, 2 * y[ny] - y[ny - 1])
+ x <- (x[1:(nx + 1)] + x[2:(nx + 2)])/2
+ y <- (y[1:(ny + 1)] + y[2:(ny + 2)])/2
+ for (i in unique(col)) {
+ u <- col == i
+ if(pch == "") {
+ xx <- rbind(x[ix[u]], x[ix[u] + 1], x[ix[u] + 1], x[ix[u]], NA)
+ yy <- rbind(y[iy[u]], y[iy[u]], y[iy[u] + 1], y[iy[u] + 1], NA)
+ polygon(xx, yy, col = i, border = 0)
+ }
+ else points(x[ix[u]], y[iy[u]], col = i, pch = pch)
+ }
+ if(legend) {
+ yv <- seq(min(y), max(y), length = length(v))
+ x1 <- max(x) + 0.02 * dlt
+ x2 <- max(x) + 0.06 * dlt
+ for(i in 1:nint) {
+ polygon(c(x1, x2, x2, x1), rep(yv[i:(i + 1)], c(2, 2)),
+ col = i, border = 0)
+ }
+ axis(side = 4, at = yv, labels = v, adj = 0)
+ }
+ }
+
+ if(style == "trell") {
+ if(missing(ylim))
+ ylim <- range(c(fit, lower, upper))
+ loc.dat = data.frame(x1 = x$xev[, 1], x2 = x$xev[, 2], y = fit)
+ pl <- xyplot(y ~ x1 | as.factor(x2), data = loc.dat,
+ panel = panel.xyplot.lf, clo=lower, cup=upper,
+ wh=rep("f", nrow(loc.dat)))
+ plot(pl)
+ }
+ if(style == "tl") {
+ ux <- unique(x$xev[, 1])
+ uy <- unique(x$xev[, 2])
+ sig <- abs(x$coef/x$sd)
+ rv1 <- max(abs(fit)) * 1.0001
+ v1 <- seq( - rv1, rv1, length.out = 17)
+ v2 <- - c(-1e-100, crit(const = x$kap, cov = c(0.5, 0.7, 0.8, 0.85,
+ 0.9, 0.95, 0.98, 0.99, 0.995,
+ 0.999, 0.9999))$crit.val,
+ 1e+300)
+ plot.tl(ux, uy, cbind(fit, - sig), v1 = v1, v2 = v2,
+ xlab = x$vnames[1], ylab = x$vnames[2])
+ }
+}
+
+"print.scb"<-
+function(x, ...)
+{
+ m <- cbind(x$xev, x$trans(x$coef), x$trans(x$lower), x$trans(x$upper))
+ dimnames(m) <- list(NULL, c(x$vnames, "fit", "lower", "upper"))
+ print(m)
+}
+
+"kappa0"<-
+ function(formula, cov=0.95, ev=lfgrid(20), ...)
+{
+ if(class(formula) == "locfit") {
+ m <- formula$call
+ }
+ else {
+ m <- match.call()
+ m$cov <- NULL
+ }
+ m$dc <- TRUE
+ m$geth <- 2
+ m$ev <- substitute(ev)
+ m[[1]] <- as.name("locfit")
+ z <- eval(m, sys.frame(sys.parent()))
+ crit(const = z$const, d = z$d, cov = cov)
+}
+
+"crit"<-
+function(fit, const = c(0, 1), d = 1, cov = 0.95, rdf = 0)
+{
+ if(!missing(fit)) {
+ z <- fit$critval
+ if(missing(const) & missing(d) & missing(cov))
+ return(z)
+ if(!missing(const))
+ z$const <- const
+ if(!missing(d))
+ z$d <- d
+ if(!missing(cov))
+ z$cov <- cov
+ if(!missing(rdf))
+ z$rdf <- rdf
+ }
+ else {
+ z <- list(const = const, d = d, cov = cov, rdf = rdf, crit.val = 0)
+ class(z) <- "kappa"
+ }
+ z$crit.val <- .C("scritval",
+ k0 = as.numeric(z$const),
+ d = as.integer(z$d),
+ cov = as.numeric(z$cov),
+ m = as.integer(length(z$const)),
+ rdf = as.numeric(z$rdf),
+ x = numeric(1),
+ k = as.integer(1), PACKAGE="locfit")$x
+ z
+}
+
+"crit<-"<-
+function(fit, value)
+{
+ if(is.numeric(value))
+ fit$critval$crit.val <- value[1]
+ else {
+ if(class(value) != "kappa")
+ stop("crit<-: value must be numeric or class kappa")
+ fit$critval <- value
+ }
+ fit
+}
+
+
+"spence.15"<-
+function(y)
+{
+ n <- length(y)
+ y <- c(rep(y[1], 7), y, rep(y[n], 7))
+ n <- length(y)
+ k <- 3:(n - 2)
+ a3 <- y[k - 1] + y[k] + y[k + 1]
+ a2 <- y[k - 2] + y[k + 2]
+ y1 <- y[k] + 3 * (a3 - a2)
+ n <- length(y1)
+ k <- 1:(n - 3)
+ y2 <- y1[k] + y1[k + 1] + y1[k + 2] + y1[k + 3]
+ n <- length(y2)
+ k <- 1:(n - 3)
+ y3 <- y2[k] + y2[k + 1] + y2[k + 2] + y2[k + 3]
+ n <- length(y3)
+ k <- 1:(n - 4)
+ y4 <- y3[k] + y3[k + 1] + y3[k + 2] + y3[k + 3] + y3[k + 4]
+ y4/320
+}
+
+"spence.21"<-
+function(y)
+{
+ n <- length(y)
+ y <- c(rep(y[1], 10), y, rep(y[n], 10))
+ n <- length(y)
+ k <- 4:(n - 3)
+ y1 <- - y[k - 3] + y[k - 1] + 2 * y[k] + y[k + 1] - y[k + 3]
+ n <- length(y1)
+ k <- 4:(n - 3)
+ y2 <- y1[k - 3] + y1[k - 2] + y1[k - 1] + y1[k] + y1[k + 1] + y1[k + 2] + y1[
+ k + 3]
+ n <- length(y2)
+ k <- 3:(n - 2)
+ y3 <- y2[k - 2] + y2[k - 1] + y2[k] + y2[k + 1] + y2[k + 2]
+ n <- length(y3)
+ k <- 3:(n - 2)
+ y4 <- y3[k - 2] + y3[k - 1] + y3[k] + y3[k + 1] + y3[k + 2]
+ y4/350
+}
+
+"store"<-
+function(data = FALSE, grand = FALSE)
+{
+ lfmod <- c("ang", "gam.lf", "gam.slist", "lf", "lfbas", "left", "right",
+ "cpar", "lp")
+ lfmeth <- c("fitted.locfit", "formula.locfit", "predict.locfit",
+ "lines.locfit", "points.locfit", "print.locfit", "residuals.locfit",
+ "summary.locfit", "print.summary.locfit")
+ lfev <- c("rbox", "gr", "dat", "xbar", "none")
+ lfplo <- c("plot.locfit", "preplot.locfit", "preplot.locfit.raw",
+ "print.preplot.locfit", "plot.locfit.1d", "plot.locfit.2d",
+ "plot.locfit.3d", "panel.xyplot.lf", "plot.preplot.locfit",
+ "summary.preplot.locfit", "panel.locfit", "lfmarg")
+ lffre <- c("hatmatrix", "locfit.robust", "locfit.censor", "km.mrl",
+ "locfit.quasi", "density.lf", "smooth.lf")
+ lfscb <- c("scb", "plot.scb", "plot.scb.1d", "plot.scb.2d", "print.scb",
+ "kappa0", "crit", "crit<-", "plot.tl")
+ lfgcv <- c("gcv", "gcvplot", "plot.gcvplot", "print.gcvplot",
+ "summary.gcvplot", "aic", "aicplot", "cp", "cpplot", "lcv", "lcvplot",
+ "lscv", "lscv.exact", "lscvplot", "sjpi")
+ lfspen <- c("spence.15", "spence.21")
+ lffuns <- c("locfit", "locfit.raw", lfmod, lfmeth, lfev, lfplo, "lfeval",
+ "plot.lfeval", "print.lfeval", "lflim", "plot.eval", "rv", "rv<-",
+ "regband", "kdeb", "lfknots", "locfit.matrix", "expit", "plotbyfactor",
+ lffre, lfgcv, lfscb, lfspen, "store")
+ lfdata <- c("bad", "cltest", "cltrain", "co2", "diab", "geyser", "ethanol",
+ "mcyc", "morths", "border", "heart", "trimod", "insect", "iris", "spencer",
+ "stamp")
+ lfgrand <- c("locfit.raw", "crit", "predict.locfit", "preplot.locfit",
+ "preplot.locfit.raw", "lfbas", "expit", "rv", "rv<-", "knots")
+ dump(lffuns, "S/locfit.s")
+ if(data)
+ dump(lfdata, "S/locfit.dat")
+ if(grand)
+ dump(lfgrand, "src-gr/lfgrand.s")
+ dump(lffuns, "R/locfit.s")
+}
+
diff --git a/data/ais.rda b/data/ais.rda
new file mode 100755
index 0000000..d11382d
Binary files /dev/null and b/data/ais.rda differ
diff --git a/data/bad.rda b/data/bad.rda
new file mode 100755
index 0000000..add51b1
Binary files /dev/null and b/data/bad.rda differ
diff --git a/data/border.rda b/data/border.rda
new file mode 100755
index 0000000..ed9c759
Binary files /dev/null and b/data/border.rda differ
diff --git a/data/chemdiab.tab.gz b/data/chemdiab.tab.gz
new file mode 100755
index 0000000..4de0d6f
Binary files /dev/null and b/data/chemdiab.tab.gz differ
diff --git a/data/claw54.rda b/data/claw54.rda
new file mode 100755
index 0000000..87a950c
Binary files /dev/null and b/data/claw54.rda differ
diff --git a/data/cldem.tab.gz b/data/cldem.tab.gz
new file mode 100755
index 0000000..918ffb0
Binary files /dev/null and b/data/cldem.tab.gz differ
diff --git a/data/cltest.rda b/data/cltest.rda
new file mode 100755
index 0000000..7b824ab
Binary files /dev/null and b/data/cltest.rda differ
diff --git a/data/cltrain.rda b/data/cltrain.rda
new file mode 100755
index 0000000..e41e7cb
Binary files /dev/null and b/data/cltrain.rda differ
diff --git a/data/co2.rda b/data/co2.rda
new file mode 100755
index 0000000..0ad65cb
Binary files /dev/null and b/data/co2.rda differ
diff --git a/data/diab.tab.gz b/data/diab.tab.gz
new file mode 100755
index 0000000..bab3476
Binary files /dev/null and b/data/diab.tab.gz differ
diff --git a/data/ethanol.rda b/data/ethanol.rda
new file mode 100755
index 0000000..05ead6c
Binary files /dev/null and b/data/ethanol.rda differ
diff --git a/data/geyser.rda b/data/geyser.rda
new file mode 100755
index 0000000..3160244
Binary files /dev/null and b/data/geyser.rda differ
diff --git a/data/geyser.round.tab.gz b/data/geyser.round.tab.gz
new file mode 100755
index 0000000..9cffbe8
Binary files /dev/null and b/data/geyser.round.tab.gz differ
diff --git a/data/heart.rda b/data/heart.rda
new file mode 100755
index 0000000..485e62b
Binary files /dev/null and b/data/heart.rda differ
diff --git a/data/insect.tab.gz b/data/insect.tab.gz
new file mode 100755
index 0000000..187ac55
Binary files /dev/null and b/data/insect.tab.gz differ
diff --git a/data/iris.rda b/data/iris.rda
new file mode 100755
index 0000000..7cf42b1
Binary files /dev/null and b/data/iris.rda differ
diff --git a/data/kangaroo.rda b/data/kangaroo.rda
new file mode 100755
index 0000000..7f5d1ec
Binary files /dev/null and b/data/kangaroo.rda differ
diff --git a/data/livmet.rda b/data/livmet.rda
new file mode 100755
index 0000000..e24dac2
Binary files /dev/null and b/data/livmet.rda differ
diff --git a/data/mcyc.tab.gz b/data/mcyc.tab.gz
new file mode 100755
index 0000000..cf77afe
Binary files /dev/null and b/data/mcyc.tab.gz differ
diff --git a/data/mine.rda b/data/mine.rda
new file mode 100755
index 0000000..61edc03
Binary files /dev/null and b/data/mine.rda differ
diff --git a/data/mmsamp.tab.gz b/data/mmsamp.tab.gz
new file mode 100755
index 0000000..64cadee
Binary files /dev/null and b/data/mmsamp.tab.gz differ
diff --git a/data/morths.rda b/data/morths.rda
new file mode 100755
index 0000000..7e9e114
Binary files /dev/null and b/data/morths.rda differ
diff --git a/data/penny.tab.gz b/data/penny.tab.gz
new file mode 100755
index 0000000..92cadf4
Binary files /dev/null and b/data/penny.tab.gz differ
diff --git a/data/spencer.rda b/data/spencer.rda
new file mode 100755
index 0000000..af71ab0
Binary files /dev/null and b/data/spencer.rda differ
diff --git a/data/stamp.rda b/data/stamp.rda
new file mode 100755
index 0000000..63c87d0
Binary files /dev/null and b/data/stamp.rda differ
diff --git a/data/trimod.tab.gz b/data/trimod.tab.gz
new file mode 100755
index 0000000..fa72a0b
Binary files /dev/null and b/data/trimod.tab.gz differ
diff --git a/man/aic.Rd b/man/aic.Rd
new file mode 100755
index 0000000..ef7c1ed
--- /dev/null
+++ b/man/aic.Rd
@@ -0,0 +1,38 @@
+\name{aic}
+\alias{aic}
+\title{
+Compute Akaike's Information Criterion.
+}
+\usage{
+aic(x, \dots, pen=2)
+}
+\description{
+ The calling sequence for \code{aic} matches those for the
+ \code{\link{locfit}} or \code{\link{locfit.raw}} functions.
+ The fit is not returned; instead, the returned object contains
+ Akaike's information criterion for the fit.
+
+ The definition of AIC used here is -2*log-likelihood + pen*(fitted d.f.).
+ For quasi-likelihood, and local regression, this assumes the scale
+ parameter is one. Other scale parameters can effectively be used
+ by changing the penalty.
+
+ The AIC score is exact (up to numerical roundoff) if the
+ \code{ev="data"} argument is provided. Otherwise, the residual
+ sum-of-squares and degrees of freedom are computed using locfit's
+ standard interpolation based approximations.
+}
+\arguments{
+ \item{x}{model formula}
+ \item{...}{other arguments to locfit}
+ \item{pen}{penalty for the degrees of freedom term}
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{aicplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/aicplot.Rd b/man/aicplot.Rd
new file mode 100755
index 0000000..220df9c
--- /dev/null
+++ b/man/aicplot.Rd
@@ -0,0 +1,47 @@
+\name{aicplot}
+\alias{aicplot}
+\title{
+Compute an AIC plot.
+}
+\description{
+ The \code{aicplot} function loops through calls to the \code{\link{aic}}
+function (and hence to \code{\link{locfit}}), using a different
+smoothing parameter for each call.
+The returned structure contains the AIC statistic for each fit, and can
+be used to produce an AIC plot.
+}
+\usage{
+aicplot(..., alpha)
+}
+\arguments{
+ \item{...}{ arguments to the \code{\link{aic}}, \code{\link{locfit}}
+ functions.}
+ \item{alpha}{ Matrix of smoothing parameters. The \code{aicplot} function
+ loops through calls to \code{\link{aic}}, using each row of
+ \code{alpha} as the smoothing parameter in turn. If \code{alpha}
+ is provided as a vector, it will be converted to a one-column
+ matrix, thus interpreting each component as a nearest neighbor
+ smoothing parameter.}
+}
+
+\value{
+ An object with class \code{"gcvplot"}, containing the smoothing
+ parameters and AIC scores. The actual plot is produced using
+ \code{\link{plot.gcvplot}}.
+}
+
+\examples{
+data(morths)
+plot(aicplot(deaths~age,weights=n,data=morths,family="binomial",
+ alpha=seq(0.2,1.0,by=0.05)))
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcv}},
+ \code{\link{aic}},
+ \code{\link{plot.gcvplot}}
+}
+
+\keyword{htest}
diff --git a/man/ais.Rd b/man/ais.Rd
new file mode 100755
index 0000000..984b817
--- /dev/null
+++ b/man/ais.Rd
@@ -0,0 +1,20 @@
+\name{ais}
+\alias{ais}
+\title{Australian Institute of Sport Dataset}
+\usage{data(ais)}
+\format{
+ A dataframe.
+}
+\description{
+ The first two columns are the gender of the athlete
+ and their sport. The remaining 11 columns are various measurements
+ made on the athletes.
+}
+\source{
+ Cook and Weisberg (1994).
+}
+\references{
+ Cook and Weisberg (1994). An Introduction to Regression Graphics.
+ Wiley, New York.
+}
+\keyword{datasets}
diff --git a/man/ang.Rd b/man/ang.Rd
new file mode 100755
index 0000000..48b5103
--- /dev/null
+++ b/man/ang.Rd
@@ -0,0 +1,50 @@
+\name{ang}
+\alias{ang}
+\title{
+Angular Term for a Locfit model.
+}
+\usage{
+ang(x,...)
+}
+\description{
+ The \code{ang()} function is used in a locfit model formula
+ to specify that a variable should be treated as an angular
+ or periodic term. The \code{scale} argument is used to
+ set the period.
+
+ \code{ang(x)} is equivalent to \code{lp(x,style="ang")}.
+}
+
+\arguments{
+ \item{x}{numeric variable to be treated periodically.}
+ \item{...}{Other arguments to \code{\link{lp}}.}
+% \item{scale}{Use to specify
+% the period divided by \eqn{2\pi} of the term. The default is
+% \code{scale=1}, giving a period of \eqn{2\pi}.}
+}
+
+\examples{
+# generate an x variable, and a response with period 0.2
+x <- seq(0,1,length=200)
+y <- sin(10*pi*x)+rnorm(200)/5
+
+# compute the periodic local fit. Note the scale argument is period/(2pi)
+fit <- locfit(y~ang(x,scale=0.2/(2*pi)))
+
+# plot the fit over a single period
+plot(fit)
+
+# plot the fit over the full range of the data
+plot(fit,xlim=c(0,1))
+}
+
+\references{
+Loader, C. (1999). Local Regression and Likelihood. Springer, NY (Section 6.2).
+}
+
+\seealso{
+ \code{\link{locfit}}.
+}
+
+\keyword{models}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/bad.Rd b/man/bad.Rd
new file mode 100755
index 0000000..10338da
--- /dev/null
+++ b/man/bad.Rd
@@ -0,0 +1,15 @@
+\name{bad}
+\alias{bad}
+\title{Example dataset for bandwidth selection}
+\usage{data(bad)}
+\format{
+Data Frame with x and y variables.
+}
+\description{
+Example dataset from Loader (1999).
+}
+\references{
+ Loader, C. (1999). Bandwidth Selection: Classical or Plug-in?
+ Annals of Statistics 27.
+}
+\keyword{datasets}
diff --git a/man/border.Rd b/man/border.Rd
new file mode 100755
index 0000000..baedeb0
--- /dev/null
+++ b/man/border.Rd
@@ -0,0 +1,18 @@
+\name{border}
+\alias{border}
+\title{Cricket Batting Dataset}
+\usage{data(border)}
+\format{
+ A dataframe with day (decimalized); not out indicator and score.
+ The not out indicator should be used as a censoring variable.
+}
+\description{
+ Scores in 265 innings for Australian batsman Allan Border.
+}
+\source{
+ Compiled from the Cricinfo archives.
+}
+\references{CricInfo: The Home of Cricket on the Internet.
+ \url{http://www.cricinfo.com/}
+}
+\keyword{datasets}
diff --git a/man/chemdiab.Rd b/man/chemdiab.Rd
new file mode 100755
index 0000000..713e969
--- /dev/null
+++ b/man/chemdiab.Rd
@@ -0,0 +1,21 @@
+\name{chemdiab}
+\alias{chemdiab}
+\title{Chemical Diabetes Dataset}
+\usage{data(chemdiab)}
+\format{
+ Data frame with five numeric measurements and categroical response.
+}
+\description{
+ Numeric variables are \code{rw}, \code{fpg},
+ \code{ga}, \code{ina} and \code{sspg}. Classifier \code{cc} is the Diabetic
+ type.
+}
+\source{
+ Reaven and Miller (1979).
+}
+\references{
+ Reaven, G. M. and Miller, R. G. (1979).
+ An attempt to define the nature of chemical diabetes using a multidimensional
+ analysis. Diabetologia 16, 17-24.
+}
+\keyword{datasets}
diff --git a/man/claw54.Rd b/man/claw54.Rd
new file mode 100755
index 0000000..9a78d73
--- /dev/null
+++ b/man/claw54.Rd
@@ -0,0 +1,21 @@
+\name{claw54}
+\alias{claw54}
+\title{Claw Dataset}
+\usage{data(claw54)}
+\format{
+ Numeric vector with length 54.
+}
+\description{
+ A random sample of size 54 from the claw density of Marron and Wand
+ (1992), as used in Figure 10.5 of Loader (1999).
+}
+\source{
+ Randomly generated.
+}
+\references{
+ Loader, C. (1999). Local Regression and Likelihood. Springer, New York.
+
+ Marron, J. S. and Wand, M. P. (1992). Exact mean integrated squared error.
+ Annals of Statistics 20, 712-736.
+}
+\keyword{datasets}
diff --git a/man/cldem.Rd b/man/cldem.Rd
new file mode 100755
index 0000000..d0b4276
--- /dev/null
+++ b/man/cldem.Rd
@@ -0,0 +1,14 @@
+\name{cldem}
+\alias{cldem}
+\title{Example data set for classification}
+\usage{data(cldem)}
+\format{
+Data Frame with x and y variables.
+}
+\description{
+Observations from Figure 8.7 of Loader (1999).
+}
+\references{
+ Loader, C. (1999). Local Regression and Likelihood. Springer, New York.
+}
+\keyword{datasets}
diff --git a/man/cltest.Rd b/man/cltest.Rd
new file mode 100755
index 0000000..43a8e44
--- /dev/null
+++ b/man/cltest.Rd
@@ -0,0 +1,20 @@
+\name{cltest}
+\alias{cltest}
+\title{Test dataset for classification}
+\usage{data(cltest)}
+\format{
+Data Frame. Three variables x1, x2 and y. The latter indicates
+class membership.
+}
+\description{
+200 observations from a 2 population model. Under population 0,
+\eqn{x_{1,i}} has a standard normal distribution, and
+\eqn{x_{2,i} = (2-x_{1,i}^2+z_i)/3}, where \eqn{z_i} is also standard normal.
+Under population 1, \eqn{x_{2,i} = -(2-x_{1,i}^2+z_i)/3}.
+The optimal classification regions form a checkerboard pattern,
+with horizontal boundary at \eqn{x_2=0}, vertical boundaries at
+\eqn{x_1 = \pm \sqrt{2}}.
+
+This is the same model as the cltrain dataset.
+}
+\keyword{datasets}
diff --git a/man/cltrain.Rd b/man/cltrain.Rd
new file mode 100755
index 0000000..28f931e
--- /dev/null
+++ b/man/cltrain.Rd
@@ -0,0 +1,20 @@
+\name{cltrain}
+\alias{cltrain}
+\title{Training dataset for classification}
+\usage{data(cltrain)}
+\format{
+Data Frame. Three variables x1, x2 and y. The latter indicates
+class membership.
+}
+\description{
+200 observations from a 2 population model. Under population 0,
+\eqn{x_{1,i}} has a standard normal distribution, and
+\eqn{x_{2,i} = (2-x_{1,i}^2+z_i)/3}, where \eqn{z_i} is also standard normal.
+Under population 1, \eqn{x_{2,i} = -(2-x_{1,i}^2+z_i)/3}.
+The optimal classification regions form a checkerboard pattern,
+with horizontal boundary at \eqn{x_2=0}, vertical boundaries at
+\eqn{x_1 = \pm \sqrt{2}}.
+
+This is the same model as the cltest dataset.
+}
+\keyword{datasets}
diff --git a/man/co2.Rd b/man/co2.Rd
new file mode 100755
index 0000000..4b11376
--- /dev/null
+++ b/man/co2.Rd
@@ -0,0 +1,20 @@
+\name{co2}
+\alias{co2}
+\title{Carbon Dioxide Dataset}
+\usage{data(co2)}
+\format{
+ Data frame with \code{year}, \code{month} and \code{co2} variables.
+}
+\description{
+ Monthly time series of carbon dioxide measurements at Mauna Loa,
+ Hawaii from 1959 to 1990.
+}
+\source{
+ Boden, Sepanski and Stoss (1992).
+}
+\references{
+ Boden, Sepanski and Stoss (1992).
+ Trends '91: A compedium of data on global change - Highlights.
+ Carbon Dioxide Information Analysis Center, Oak Ridge National Laboratory.
+}
+\keyword{datasets}
diff --git a/man/cp.Rd b/man/cp.Rd
new file mode 100755
index 0000000..eb2c9fe
--- /dev/null
+++ b/man/cp.Rd
@@ -0,0 +1,39 @@
+\name{cp}
+\alias{cp}
+\title{
+Compute Mallows' Cp for local regression models.
+}
+\usage{
+cp(x, \dots, sig2=1)
+}
+\description{
+ The calling sequence for \code{cp} matches those for the
+ \code{\link{locfit}} or \code{\link{locfit.raw}} functions.
+ The fit is not returned; instead, the returned object contains
+ Cp criterion for the fit.
+
+ Cp is usually computed using a variance estimate from the largest
+ model under consideration, rather than
+ \eqn{\sigma^2=1}. This will be done
+ automatically when the \code{\link{cpplot}} function is used.
+
+ The Cp score is exact (up to numerical roundoff) if the
+ \code{ev="data"} argument is provided. Otherwise, the residual
+ sum-of-squares and degrees of freedom are computed using locfit's
+ standard interpolation based approximations.
+}
+\arguments{
+ \item{x}{model formula or numeric vector of the independent variable.}
+ \item{...}{other arguments to \code{\link{locfit}} and/or
+ \code{\link{locfit.raw}}.}
+ \item{sig2}{residual variance estimate.}
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{cpplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/cpar.Rd b/man/cpar.Rd
new file mode 100755
index 0000000..3909033
--- /dev/null
+++ b/man/cpar.Rd
@@ -0,0 +1,37 @@
+\name{cpar}
+\alias{cpar}
+\title{
+Conditionally parametric term for a Locfit model.
+}
+\usage{
+cpar(x,...)
+}
+\description{
+ A term entered in a \code{\link{locfit}} model formula using
+ \code{cpar} will result in a fit that is conditionally parametric.
+ Equivalent to \code{lp(x,style="cpar")}.
+
+ This function is presently almost deprecated. Specifying a conditionally
+ parametric fit as \code{y~x1+cpar(x2)} wil no longer work; instead, the
+ model is specified as \code{y~lp(x1,x2,style=c("n","cpar"))}.
+}
+
+\arguments{
+ \item{x}{numeric variable.}
+ \item{...}{Other arguments to \code{link{lp}()}.}
+}
+
+\examples{
+data(ethanol, package="locfit")
+# fit a conditionally parametric model
+fit <- locfit(NOx ~ lp(E, C, style=c("n","cpar")), data=ethanol)
+plot(fit)
+# one way to force a parametric fit with locfit
+fit <- locfit(NOx ~ cpar(E), data=ethanol)
+}
+
+\seealso{
+ \code{\link{locfit}}
+}
+
+\keyword{models}
diff --git a/man/cpplot.Rd b/man/cpplot.Rd
new file mode 100755
index 0000000..71cc501
--- /dev/null
+++ b/man/cpplot.Rd
@@ -0,0 +1,50 @@
+\name{cpplot}
+\alias{cpplot}
+\title{
+Compute a Cp plot.
+}
+\usage{
+cpplot(..., alpha, sig2)
+}
+\description{
+ The \code{cpplot} function loops through calls to the \code{\link{cp}}
+function (and hence to \code{link{locfit}}), using a different
+smoothing parameter for each call.
+The returned structure contains the Cp statistic for each fit, and can
+be used to produce an AIC plot.
+}
+\arguments{
+ \item{...}{ arguments to the \code{\link{cp}}, \code{\link{locfit}}
+ functions.}
+ \item{alpha}{ Matrix of smoothing parameters. The \code{cpplot} function
+ loops through calls to \code{\link{cp}}, using each row of
+ \code{alpha} as the smoothing parameter in turn. If \code{alpha}
+ is provided as a vector, it will be converted to a one-column
+ matrix, thus interpreting each component as a nearest neighbor
+ smoothing parameter.}
+ \item{sig2}{ Residual variance. If not specified, the residual variance
+ is computed using the fitted model with the fewest residual degrees
+ of freedom.}
+}
+
+\value{
+ An object with class \code{"gcvplot"}, containing the smoothing
+ parameters and CP scores. The actual plot is produced using
+ \code{\link{plot.gcvplot}}.
+}
+
+\examples{
+data(ethanol)
+plot(cpplot(NOx~E,data=ethanol,alpha=seq(0.2,1.0,by=0.05)))
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcv}},
+ \code{\link{aic}},
+ \code{\link{plot.gcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/crit.Rd b/man/crit.Rd
new file mode 100755
index 0000000..2758490
--- /dev/null
+++ b/man/crit.Rd
@@ -0,0 +1,57 @@
+\name{crit}
+\alias{crit}
+\alias{crit<-}
+\title{
+Compute critical values for confidence intervals.
+}
+\usage{
+crit(fit, const=c(0, 1), d=1, cov=0.95, rdf=0)
+crit(fit) <- value
+}
+\arguments{
+\item{fit}{\code{"locfit"} object. This is optional; if a fit is
+ provided, defaults for the other arguments are taken from the critical
+ value currently stored on this fit, rather than the usual values above.
+ \code{crit(fit)} with no other arguments will just return the current
+ critical value.}
+\item{const}{Tube formula constants for simultaneous bands (the default,
+ \code{c(0,1)}, produces pointwise coverage). Usually this is generated
+ by the \code{\link{kappa0}} function and should not be provided by the
+ user.}
+\item{d}{Dimension of the fit. Again, users shouldn't usually provide
+ it.}
+\item{cov}{Coverage Probability for critical values.}
+\item{rdf}{Residual degrees of freedom. If non-zero, the critical values
+ are based on the Student's t distribution. When \code{rdf=0}, the
+ normal distribution is used.}
+\item{value}{Critical value object generated by \code{\link{crit}} or
+ \code{\link{kappa0}}.}
+}
+\description{
+ Every \code{"locfit"} object contains a critical value object to be used in
+ computing and ploting confidence intervals. By default, a 95\% pointwise
+ confidence level is used. To change the confidence level, the critical
+ value object must be substituted using \code{\link{crit}} and
+ \code{\link{crit<-}}.
+}
+\value{
+ Critical value object.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}},
+\code{\link{kappa0}}, \code{\link{crit<-}}.
+}
+\examples{
+# compute and plot 99\% confidence intervals, with local variance estimate.
+data(ethanol)
+fit <- locfit(NOx~E,data=ethanol)
+crit(fit) <- crit(fit,cov=0.99)
+plot(fit,band="local")
+
+# compute and plot 99\% simultaneous bands
+crit(fit) <- kappa0(NOx~E,data=ethanol,cov=0.99)
+plot(fit,band="local")
+}
+%\keyword{locfit}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/dat.Rd b/man/dat.Rd
new file mode 100755
index 0000000..cd45d0e
--- /dev/null
+++ b/man/dat.Rd
@@ -0,0 +1,20 @@
+\name{dat}
+\alias{dat}
+\title{
+Locfit - data evaluation structure.
+}
+\usage{
+dat(cv=FALSE)
+}
+\description{
+ \code{dat} is used to specify evaluation on the given data points
+ for \code{\link{locfit.raw}()}.
+}
+\arguments{
+\item{cv}{Whether cross-validation should be done.}
+}
+%\examples{
+%data(ethanol, package="locfit")
+%plot.eval(locfit(NOx~E+C, data=ethanol, scale=0, ev=dat()))
+%}
+\keyword{smooth}
diff --git a/man/density.lf.Rd b/man/density.lf.Rd
new file mode 100755
index 0000000..ee3e137
--- /dev/null
+++ b/man/density.lf.Rd
@@ -0,0 +1,56 @@
+\name{density.lf}
+\alias{density.lf}
+\title{
+Density estimation using Locfit
+}
+\usage{
+density.lf(x, n = 50, window = "gaussian", width, from, to,
+ cut = if(iwindow == 4.) 0.75 else 0.5,
+ ev = lfgrid(mg = n, ll = from, ur = to),
+ deg = 0, family = "density", link = "ident", ...)
+}
+\description{
+ This function provides an interface to Locfit, in the syntax of
+ (a now old version of) the S-Plus \code{density} function. This can reproduce
+ \code{density} results, but allows additional
+ \code{\link{locfit.raw}} arguments, such as the degree of fit, to be given.
+
+ It also works in double precision, whereas \code{density} only works
+ in single precision.
+}
+\arguments{
+\item{x}{numeric vector of observations whose density is to be estimated.}
+\item{n}{number of evaluation points.
+ Equivalent to the \code{\link{locfit.raw} mg} argument.}
+\item{window}{Window type to use for estimation.
+ Equivalent to the \code{\link{locfit.raw} kern} argument. This includes
+ all the \code{density} windows except \code{cosine}.}
+\item{width}{Window width. Following \code{density}, this is the full
+ width; not the half-width usually used by Locfit and
+ many other smoothers.}
+\item{from}{Lower limit for estimation domain.}
+\item{to}{Upper limit for estimation domain.}
+\item{cut}{Controls default expansion of the domain.}
+\item{ev}{Locfit evaluation structure -- default \code{\link{lfgrid}()}.}
+\item{deg}{Fitting degree -- default 0 for kernel estimation.}
+\item{family}{Fitting family -- default is \code{"density"}.}
+\item{link}{Link function -- default is the \code{"identity"}.}
+\item{...}{Additional arguments to \code{\link{locfit.raw}}, with standard
+ defaults.}
+}
+\value{
+ A list with components \code{x} (evaluation points) and \code{y}
+ (estimated density).
+}
+\seealso{
+\code{density},
+\code{\link{locfit}},
+\code{\link{locfit.raw}}
+}
+\examples{
+data(geyser)
+density.lf(geyser, window="tria")
+# the same result with density, except less precision.
+density(geyser, window="tria")
+}
+\keyword{smooth}
diff --git a/man/diab.Rd b/man/diab.Rd
new file mode 100755
index 0000000..3b0bfaf
--- /dev/null
+++ b/man/diab.Rd
@@ -0,0 +1,22 @@
+\name{diab}
+\alias{diab}
+\title{Exhaust emissions}
+\usage{data(ethanol)}
+\format{
+ Data frame with NOx, E and C variables.
+}
+\description{
+ NOx exhaust emissions from a single cylinder engine. Two predictor
+ variables are E (the engine's equivalence ratio) and C (Compression
+ ratio).
+}
+\source{
+ Brinkman (1981). Also studied extensively by Cleveland (1993).
+}
+\references{
+ Brinkman, N. D. (1981). Ethanol fuel - a single-cylinder engine study
+ of efficiency and exhaust emissions. SAE transactions 90, 1414-1424.
+
+ Cleveland, W. S. (1993). Visualizing data. Hobart Press, Summit, NJ.
+}
+\keyword{datasets}
diff --git a/man/ethanol.Rd b/man/ethanol.Rd
new file mode 100755
index 0000000..3193396
--- /dev/null
+++ b/man/ethanol.Rd
@@ -0,0 +1,22 @@
+\name{ethanol}
+\alias{ethanol}
+\title{Exhaust emissions}
+\usage{data(ethanol)}
+\format{
+ Data frame with NOx, E and C variables.
+}
+\description{
+ NOx exhaust emissions from a single cylinder engine. Two predictor
+ variables are E (the engine's equivalence ratio) and C (Compression
+ ratio).
+}
+\source{
+ Brinkman (1981). Also studied extensively by Cleveland (1993).
+}
+\references{
+ Brinkman, N. D. (1981). Ethanol fuel - a single-cylinder engine study
+ of efficiency and exhaust emissions. SAE transactions 90, 1414-1424.
+
+ Cleveland, W. S. (1993). Visualizing data. Hobart Press, Summit, NJ.
+}
+\keyword{datasets}
diff --git a/man/expit.Rd b/man/expit.Rd
new file mode 100755
index 0000000..b3dd6d2
--- /dev/null
+++ b/man/expit.Rd
@@ -0,0 +1,19 @@
+\name{expit}
+\alias{expit}
+\title{
+Inverse logistic link function
+}
+\usage{
+expit(x)
+}
+\description{
+ Computes \eqn{e^x/(1+e^x)}{\exp(x)/(1+\exp(x))}.
+ This is the inverse of the logistic link function,
+ \eqn{\log(p/(1-p))}.
+}
+\arguments{
+ \item{x}{numeric vector}
+}
+
+\keyword{math}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/fitted.locfit.Rd b/man/fitted.locfit.Rd
new file mode 100755
index 0000000..b28247c
--- /dev/null
+++ b/man/fitted.locfit.Rd
@@ -0,0 +1,65 @@
+\name{fitted.locfit}
+\alias{fitted.locfit}
+\title{
+Fitted values for a `"locfit"' object.
+}
+\usage{
+\method{fitted}{locfit}(object, data=NULL, what="coef", cv=FALSE,
+studentize=FALSE, type="fit", tr, ...)
+}
+\description{Evaluates the fitted values (i.e. evaluates the surface
+ at the original data points) for a Locfit object. This function works
+ by reconstructing the model matrix from the original formula, and
+ predicting at those points. The function may be fooled; for example,
+ if the original data frame has changed since the fit, or if the
+ model formula includes calls to random number generators.}
+\arguments{
+\item{object}{
+\code{"locfit"} object.
+}
+\item{data}{
+The data frame for the original fit. Usually, this shouldn't be needed,
+especially when the function is called directly. It may be needed
+when called inside another function.
+}
+\item{what}{
+What to compute fitted values of. The default, \code{what="coef"}, works
+ with the fitted curve itself. Other choices include \code{"nlx"} for the
+ length of the weight diagram; \code{"infl"} for the influence function;
+ \code{"band"} for the bandwidth; \code{"degr"} for the local polynomial
+ degree; \code{"lik"} for the maximized local likelihood; \code{"rdf"}
+ for the local residual degrees of freedom and \code{"vari"} for the
+ variance function. The interpolation algorithm for some of these quantities
+ is questionable.
+}
+\item{cv}{
+If \code{TRUE}, leave-one-out cross validated fitted values are approximated.
+Won't make much sense, unless \code{what="coef"}.
+}
+\item{studentize}{
+If \code{TRUE}, residuals are studentized.
+}
+\item{type}{
+ Type of fit or residuals to compute. The default is \code{"fit"} for
+ \code{fitted.locfit}, and \code{"dev"} for \code{\link{residuals.locfit}}.
+ Other choices include \code{"pear"} for Pearson residuals; \code{"raw"}
+ for raw residuals, \code{"ldot"} for likelihood derivative;
+ \code{"d2"} for the deviance residual squared; \code{lddot} for the
+ likelihood second derivative. Generally, \code{type} should only be
+ used when \code{what="coef"}.
+}
+\item{tr}{
+Back transformation for likelihood models.
+}
+\item{...}{arguments passed to and from methods.}
+}
+\value{
+A numeric vector of the fitted values.
+}
+\seealso{
+ \code{locfit},
+ \code{predict.locfit},
+ \code{residuals.locfit}
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/formula.locfit.Rd b/man/formula.locfit.Rd
new file mode 100755
index 0000000..1bd3ba0
--- /dev/null
+++ b/man/formula.locfit.Rd
@@ -0,0 +1,21 @@
+\name{formula.locfit}
+\alias{formula.locfit}
+\title{
+Formula from a Locfit object.
+}
+\usage{
+\method{formula}{locfit}(x, ...)
+}
+\description{Extract the model formula from a locfit object.}
+\arguments{
+ \item{x}{ \code{locfit} object.}
+ \item{...}{Arguments passed to and from other methods.}
+}
+\value{
+Returns the formula from the locfit object.
+}
+\seealso{
+\code{\link{locfit}}
+}
+\keyword{models}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/gam.lf.Rd b/man/gam.lf.Rd
new file mode 100755
index 0000000..e34baa5
--- /dev/null
+++ b/man/gam.lf.Rd
@@ -0,0 +1,29 @@
+\name{gam.lf}
+\alias{gam.lf}
+\title{
+Locfit call for Generalized Additive Models
+}
+\usage{
+gam.lf(x, y, w, xeval, ...)
+}
+\description{
+ This is a locfit calling function used by
+ \code{\link{lf}()} terms in additive models. It is
+ not normally called directly by users.
+}
+\arguments{
+ \item{x}{numeric predictor}
+ \item{y}{numeric response}
+ \item{w}{prior weights}
+ \item{xeval}{evaluation points}
+ \item{...}{other arguments to \code{\link{locfit.raw}()}}
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{lf}},
+ \code{gam}
+}
+
+\keyword{models}
diff --git a/man/gam.slist.Rd b/man/gam.slist.Rd
new file mode 100755
index 0000000..5fa6d93
--- /dev/null
+++ b/man/gam.slist.Rd
@@ -0,0 +1,17 @@
+\name{gam.slist}
+\alias{gam.slist}
+\title{Vector of GAM special terms}
+\format{
+ Character vector.
+}
+\description{
+ This vector adds \code{"lf"} to the default vector of special
+ terms recognized by a \code{gam()} model formula.
+ To ensure this is recognized, attach the Locfit library with
+ \code{library(locfit,first=T)}.
+}
+\seealso{
+ \code{\link{lf}},
+ \code{gam}
+}
+\keyword{datasets}
diff --git a/man/gcv.Rd b/man/gcv.Rd
new file mode 100755
index 0000000..032e160
--- /dev/null
+++ b/man/gcv.Rd
@@ -0,0 +1,37 @@
+\name{gcv}
+\alias{gcv}
+\title{
+Compute generalized cross-validation statistic.
+}
+\usage{
+gcv(x, \dots)
+}
+\arguments{
+ \item{x, \dots}{Arguments passed on to \code{\link{locfit}} or
+ \code{\link{locfit.raw}}.}
+}
+\description{
+ The calling sequence for \code{gcv} matches those for the
+ \code{\link{locfit}} or \code{\link{locfit.raw}} functions.
+ The fit is not returned; instead, the returned object contains
+ Wahba's generalized cross-validation score for the fit.
+
+ The GCV score is exact (up to numerical roundoff) if the
+ \code{ev="data"} argument is provided. Otherwise, the residual
+ sum-of-squares and degrees of freedom are computed using locfit's
+ standard interpolation based approximations.
+
+ For likelihood models, GCV is computed uses the deviance
+ in place of the residual sum of squares. This produces useful
+ results but I do not know of any theory validating
+ this extension.
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/gcvplot.Rd b/man/gcvplot.Rd
new file mode 100755
index 0000000..7eef482
--- /dev/null
+++ b/man/gcvplot.Rd
@@ -0,0 +1,49 @@
+\name{gcvplot}
+\alias{gcvplot}
+\title{
+Compute a generalized cross-validation plot.
+}
+\usage{
+gcvplot(..., alpha, df=2)
+}
+\description{
+ The \code{gcvplot} function loops through calls to the \code{\link{gcv}}
+function (and hence to \code{link{locfit}}), using a different
+smoothing parameter for each call.
+The returned structure contains the GCV statistic for each fit, and can
+be used to produce an GCV plot.
+}
+\arguments{
+ \item{...}{ arguments to the \code{\link{gcv}}, \code{\link{locfit}}
+ functions.}
+ \item{alpha}{ Matrix of smoothing parameters. The \code{gcvplot} function
+ loops through calls to \code{\link{gcv}}, using each row of
+ \code{alpha} as the smoothing parameter in turn. If \code{alpha}
+ is provided as a vector, it will be converted to a one-column
+ matrix, thus interpreting each component as a nearest neighbor
+ smoothing parameter.}
+ \item{df}{ Degrees of freedom to use as the x-axis. 2=trace(L),
+ 3=trace(L'L).}
+}
+
+\value{
+ An object with class \code{"gcvplot"}, containing the smoothing
+ parameters and GCV scores. The actual plot is produced using
+ \code{\link{plot.gcvplot}}.
+}
+
+\examples{
+data(ethanol)
+plot(gcvplot(NOx~E,data=ethanol,alpha=seq(0.2,1.0,by=0.05)))
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcv}},
+ \code{\link{plot.gcvplot}},
+ \code{\link{summary.gcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/geyser.Rd b/man/geyser.Rd
new file mode 100755
index 0000000..e080e35
--- /dev/null
+++ b/man/geyser.Rd
@@ -0,0 +1,21 @@
+\name{geyser}
+\alias{geyser}
+\title{Old Faithful Geyser Dataset}
+\usage{data(geyser)}
+\format{
+ A numeric vector of length 107.
+}
+\description{
+ The durations of 107 eruptions of the Old Faithful Geyser.
+}
+\source{
+ Scott (1992). Note that several different Old Faithful Geyser datasets
+ (including the faithful dataset in R's base library) have been used
+ in various places in the statistics literature. The version provided
+ here has been used in density estimation and bandwidth selection work.
+}
+\references{
+ Scott, D. W. (1992). Multivariate Density Estimation: Theory,
+ Practice and Visualization. Wiley.
+}
+\keyword{datasets}
diff --git a/man/geyser.round.Rd b/man/geyser.round.Rd
new file mode 100755
index 0000000..37431ad
--- /dev/null
+++ b/man/geyser.round.Rd
@@ -0,0 +1,23 @@
+\name{geyser.round}
+\alias{geyser.round}
+\title{Discrete Old Faithful Geyser Dataset}
+\usage{data(geyser.round)}
+\format{
+ Data Frame with variables \code{duration} and \code{count}.
+}
+\description{
+ This is a variant of the \code{\link{geyser}} dataset, where
+ each observation is rounded to the nearest 0.05 minutes, and the
+ counts tallied.
+}
+\source{
+ Scott (1992). Note that several different Old Faithful Geyser datasets
+ (including the faithful dataset in R's base library) have been used
+ in various places in the statistics literature. The version provided
+ here has been used in density estimation and bandwidth selection work.
+}
+\references{
+ Scott, D. W. (1992). Multivariate Density Estimation: Theory,
+ Practice and Visualization. Wiley.
+}
+\keyword{datasets}
diff --git a/man/hatmatrix.Rd b/man/hatmatrix.Rd
new file mode 100755
index 0000000..d4216a5
--- /dev/null
+++ b/man/hatmatrix.Rd
@@ -0,0 +1,31 @@
+\name{hatmatrix}
+\alias{hatmatrix}
+\title{
+Weight diagrams and the hat matrix for a local regression model.
+}
+\usage{
+hatmatrix(formula, dc=TRUE, \dots)
+}
+\arguments{
+ \item{formula}{model formula.}
+ \item{dc}{derivative adjustment (see \code{\link{locfit.raw}})}
+ \item{...}{Other arguments to \code{\link{locfit}} and
+\code{\link{locfit.raw}}.
+}}
+\description{
+\code{hatmatrix()} computes the weight diagrams (also known as
+equivalent or effective kernels) for a local regression smooth.
+Essentially, \code{hatmatrix()} is a front-end to \code{\link{locfit}()},
+setting a flag to compute and return weight diagrams, rather than the
+fit.
+}
+\value{
+A matrix with n rows and p columns; each column being the
+weight diagram for the corresponding \code{locfit} fit point.
+If \code{ev="data"}, this is the transpose of the hat matrix.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit.1d}}, \code{\link{plot.locfit.2d}},
+\code{\link{plot.locfit.3d}}, \code{\link{lines.locfit}}, \code{\link{predict.locfit}}
+}
+\keyword{smooth}
diff --git a/man/heart.Rd b/man/heart.Rd
new file mode 100755
index 0000000..d7a8e6c
--- /dev/null
+++ b/man/heart.Rd
@@ -0,0 +1,22 @@
+\name{heart}
+\alias{heart}
+\title{Survival Times of Heart Transplant Recipients}
+\usage{data(heart)}
+\format{
+ Data frame with surv, cens and age variables.
+}
+\description{
+ The survival times of 184 participants in the Stanford heart
+ transplant program.
+}
+\source{
+ Miller and Halperin (1982).
+ The original dataset includes information on additional patients who
+ never received a transplant. Other authors reported earlier versions
+ of the data.
+}
+\references{
+ Miller, R. G. and Halperin, J. (1982). Regression with censored data.
+ Biometrika 69, 521-531.
+}
+\keyword{datasets}
diff --git a/man/insect.Rd b/man/insect.Rd
new file mode 100755
index 0000000..17058e4
--- /dev/null
+++ b/man/insect.Rd
@@ -0,0 +1,22 @@
+\name{insect}
+\alias{insect}
+\title{Insect Dataset}
+\usage{data(insect)}
+\format{
+ Data frame with \code{lconc} (dosage), \code{deaths}
+ (number of deaths) and \code{nins}
+ (number of insects) variables.
+}
+\description{
+ An experiment measuring death rates for insects, with 30 insects at
+ each of five treatment levels.
+}
+\source{
+ Bliss (1935).
+}
+\references{
+ Bliss (1935).
+ The calculation of the dosage-mortality curve.
+ \emph{Annals of Applied Biology} 22, 134-167.
+}
+\keyword{datasets}
diff --git a/man/iris.Rd b/man/iris.Rd
new file mode 100755
index 0000000..4dd5d05
--- /dev/null
+++ b/man/iris.Rd
@@ -0,0 +1,24 @@
+\name{iris}
+\alias{iris}
+\title{Fisher's Iris Data (subset)}
+\usage{data(iris)}
+\format{
+ Data frame with species, petal.wid, petal.len, sepal.wid, sepal.len.
+}
+\description{
+ Four measurements on each of fifty flowers of two species of iris
+ (Versicolor and Virginica) -- A classification dataset. Fisher's
+ original dataset contained a third species (Setosa) which is trivially
+ seperable.
+}
+\source{
+ Fisher (1936). Reproduced in Andrews and Herzberg (1985) Chapter 1.
+
+}
+\references{
+ Andrews, D. F. and Herzberg, A. M. (1985). Data. Springer-Verlag.
+
+ Fisher, R. A. (1936). The Use of Multiple Measurements in Taxonomic
+ Problems. Annals of Eugenics 7, Part II. 179-188.
+}
+\keyword{datasets}
diff --git a/man/kangaroo.Rd b/man/kangaroo.Rd
new file mode 100755
index 0000000..671e8cb
--- /dev/null
+++ b/man/kangaroo.Rd
@@ -0,0 +1,21 @@
+\name{kangaroo}
+\alias{kangaroo}
+\title{Kangaroo skull measurements dataset}
+\usage{data(kangaroo)}
+\format{
+ Data frame with measurements on the skulls of 101 kangaroos.
+ (number of insects) variables.
+}
+\description{
+ Variables are \code{sex} (m/f), \code{spec} (giganteus, melanops,
+ fuliginosus) and 18 numeric measurements.
+}
+\source{
+ Andrews and Herzberg (1985) Chapter 53.
+}
+\references{
+ Andrews, D. F. and Herzberg, A. M. (1985).
+ Data.
+ Springer-Verlag, New York.
+}
+\keyword{datasets}
diff --git a/man/kappa0.Rd b/man/kappa0.Rd
new file mode 100755
index 0000000..0a8ffbd
--- /dev/null
+++ b/man/kappa0.Rd
@@ -0,0 +1,69 @@
+\name{kappa0}
+\alias{kappa0}
+\title{
+Critical Values for Simultaneous Confidence Bands.
+}
+\usage{
+kappa0(formula, cov=0.95, ev=lfgrid(20), \dots)
+}
+\arguments{
+\item{formula}{
+ Local regression model formula. A \code{"locfit"} object can also
+ be provided; in this case the formula and other arguments are extracted
+ from this object.
+}
+\item{cov}{ Coverage Probability for critical values. }
+\item{ev}{ Locfit evaluation structure. Should usually be a grid --
+ this specifies the integration rule. }
+\item{\dots}{Other arguments to \code{\link{locfit}}. Important arguments
+ include \code{flim} and \code{alpha}. }
+}
+\description{
+ The geometric constants for simultaneous confidence bands are computed,
+ as described in Sun and Loader (1994) (bias adjustment is not implemented
+ here). These are then passed to the \code{\link{crit}} function, which
+ computes the critical value for the confidence bands.
+
+ The method requires both the weight diagrams l(x), the
+ derivative l'(x) and (in 2 or more dimensions) the second
+ derivatives l''(x).
+ These are implemented exactly for a constant bandwidth.
+ For nearest
+ neighbor bandwidths, the computations are approximate and a warning
+ is produced.
+
+ The theoretical justification for the bands uses normality of
+ the random errors \eqn{e_1,\dots,e_n} in the regression model,
+ and in particular the spherical symmetry of the error vector.
+ For non-normal distributions, and likelihood models, one relies
+ on central limit and related theorems.
+
+ Computation uses the product Simpson's rule to evaluate the
+ multidimensional integrals (The domain of integration, and
+ hence the region of simultaneous coverage, is determined by
+ the \code{flim} argument). Expect the integration to be slow in more
+ than one dimension. The \code{mint} argument controls the
+ precision.
+}
+\value{
+ A list with components for the critical value, geometric constants,
+ e.t.c. Can be passed directly to \code{\link{plot.locfit}} as the
+ \code{crit} argument.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}},
+\code{\link{crit}}, \code{\link{crit<-}}.
+}
+\examples{
+# compute and plot simultaneous confidence bands
+data(ethanol)
+fit <- locfit(NOx~E,data=ethanol)
+crit(fit) <- kappa0(NOx~E,data=ethanol)
+plot(fit,crit=crit,band="local")
+}
+\references{
+Sun, J. and Loader, C. (1994). Simultaneous confidence bands for linear
+ regression and smoothing. Annals of Statistics 22, 1328-1345.
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/kdeb.Rd b/man/kdeb.Rd
new file mode 100755
index 0000000..5b9325b
--- /dev/null
+++ b/man/kdeb.Rd
@@ -0,0 +1,40 @@
+\name{kdeb}
+\alias{kdeb}
+\title{
+Bandwidth selectors for kernel density estimation.
+}
+\usage{
+kdeb(x, h0 = 0.01 * sd, h1 = sd, meth = c("AIC", "LCV", "LSCV", "BCV",
+ "SJPI", "GKK"), kern = "gauss", gf = 2.5)
+
+}
+\description{
+Function to compute kernel density estimate bandwidths, as used in the
+simulation results in Chapter 10 of Loader (1999).
+
+ This function is included for comparative purposes only. Plug-in
+selectors are based on flawed logic, make unreasonable and restrictive
+assumptions
+and do not use the full power of the estimates available in Locfit.
+Any relation between the results produced by this function and
+desirable estimates are entirely coincidental.
+}
+\arguments{
+\item{x}{One dimensional data vector.}
+\item{h0}{Lower limit for bandwidth selection. Can be fairly small,
+ but h0=0 would cause problems.}
+\item{h1}{Upper limit.}
+\item{meth}{Required selection method(s).}
+\item{kern}{Kernel. Most methods require \code{kern="gauss"}, the default
+ for this function only.}
+\item{gf}{Standard deviation for the gaussian kernel. Default 2.5, as
+ Locfit's standard. Most papers use 1.
+}
+}
+\value{
+Vector of selected bandwidths.
+}
+\references{
+Loader, C. (1999). Local Regression and Likelihood. Springer, New York.
+}
+\keyword{htest}
diff --git a/man/km.mrl.Rd b/man/km.mrl.Rd
new file mode 100755
index 0000000..d56f6e1
--- /dev/null
+++ b/man/km.mrl.Rd
@@ -0,0 +1,55 @@
+\name{km.mrl}
+\alias{km.mrl}
+\title{
+Mean Residual Life using Kaplan-Meier estimate
+}
+\usage{
+km.mrl(times, cens)
+}
+\description{
+ This function computes the mean residual life for censored data
+ using the Kaplan-Meier estimate of the survival function. If
+ \eqn{S(t)} is the K-M estimate, the MRL for a censored observation
+ is computed as \eqn{(\int_t^{\infty} S(u)du)/S(t)}. We take
+ \eqn{S(t)=0} when \eqn{t} is greater than the largest observation,
+ regardless of whether that observation was censored.
+
+ When there are ties between censored and uncensored observations,
+ for definiteness our ordering places the censored observations
+ before uncensored.
+
+ This function is used by \code{\link{locfit.censor}} to compute
+ censored regression estimates.
+}
+\arguments{
+\item{times}{
+ Obsereved survival times.
+}
+\item{cens}{
+ Logical variable indicating censoring. The coding is \code{1}
+ or \code{TRUE} for censored; \code{0} or \code{FALSE} for uncensored.
+}
+}
+\value{
+A vector of the estimated mean residual life. For uncensored observations,
+the corresponding estimate is 0.
+}
+\examples{
+# censored regression using the Kaplan-Meier estimate.
+data(heart, package="locfit")
+fit <- locfit.censor(log10(surv+0.5)~age, cens=cens, data=heart, km=TRUE)
+plotbyfactor(heart$age, 0.5+heart$surv, heart$cens, ylim=c(0.5,16000), log="y")
+lines(fit, tr=function(x)10^x)
+}
+\references{
+Buckley, J. and James, I. (1979). Linear Regression with censored data.
+ Biometrika 66, 429-436.
+
+Loader, C. (1999). Local Regression and Likelihood. Springer, NY (Section 7.2).
+}
+\seealso{
+\code{\link{locfit.censor}}
+}
+%\keyword{locfit}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/lcv.Rd b/man/lcv.Rd
new file mode 100755
index 0000000..766e965
--- /dev/null
+++ b/man/lcv.Rd
@@ -0,0 +1,31 @@
+\name{lcv}
+\alias{lcv}
+\title{Compute Likelihood Cross Validation Statistic.}
+\usage{
+lcv(x, \dots)
+}
+\description{
+ The calling sequence for \code{lcv} matches those for the
+ \code{\link{locfit}} or \code{\link{locfit.raw}} functions.
+ The fit is not returned; instead, the returned object contains
+ likelihood cross validation score for the fit.
+
+ The LCV score is exact (up to numerical roundoff) if the
+ \code{ev="cross"} argument is provided. Otherwise, the influence
+ and cross validated residuals
+ are computed using locfit's
+ standard interpolation based approximations.
+}
+\arguments{
+ \item{x}{model formula}
+ \item{...}{other arguments to locfit}
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{lcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/lcvplot.Rd b/man/lcvplot.Rd
new file mode 100755
index 0000000..ddde608
--- /dev/null
+++ b/man/lcvplot.Rd
@@ -0,0 +1,47 @@
+\name{lcvplot}
+\alias{lcvplot}
+\title{
+Compute the likelihood cross-validation plot.
+}
+\usage{
+lcvplot(..., alpha)
+}
+\description{
+ The \code{lcvplot} function loops through calls to the \code{\link{lcv}}
+function (and hence to \code{link{locfit}}), using a different
+smoothing parameter for each call.
+The returned structure contains the likelihood cross validation statistic
+for each fit, and can be used to produce an LCV plot.
+}
+\arguments{
+ \item{...}{ arguments to the \code{\link{lcv}}, \code{\link{locfit}}
+ functions.}
+ \item{alpha}{ Matrix of smoothing parameters. The \code{aicplot} function
+ loops through calls to \code{\link{lcv}}, using each row of
+ \code{alpha} as the smoothing parameter in turn. If \code{alpha}
+ is provided as a vector, it will be converted to a one-column
+ matrix, thus interpreting each component as a nearest neighbor
+ smoothing parameter.}
+}
+
+\value{
+ An object with class \code{"gcvplot"}, containing the smoothing
+ parameters and LCV scores. The actual plot is produced using
+ \code{\link{plot.gcvplot}}.
+}
+
+\examples{
+data(ethanol)
+plot(lcvplot(NOx~E,data=ethanol,alpha=seq(0.2,1.0,by=0.05)))
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcv}},
+ \code{\link{lcv}},
+ \code{\link{plot.gcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/left.Rd b/man/left.Rd
new file mode 100755
index 0000000..9d8710f
--- /dev/null
+++ b/man/left.Rd
@@ -0,0 +1,47 @@
+\name{left}
+\alias{left}
+\title{
+One-sided left smooth for a Locfit model.
+}
+\usage{
+left(x,...)
+}
+\description{
+ The \code{left()} function is used in a locfit model formula
+ to specify a one-sided smooth: when fitting at a point \eqn{x},
+ only data points with \eqn{x_i \le x} should be used.
+ This can be useful in estimating points of discontinuity,
+ and in cross-validation for forecasting a time series.
+ \code{left(x)} is equivalent to \code{lp(x,style="left")}.
+
+ When using this function, it will usually be necessary to specify an
+ evaluation structure, since the fit is not smooth and locfit's
+ interpolation methods are unreliable. Also, it is usually best
+ to use \code{deg=0} or \code{deg=1}, otherwise the fits may be too
+ variable. If nearest neighbor bandwidth specification is used,
+ it does not recognize \code{left()}.
+
+}
+
+\arguments{
+ \item{x}{numeric variable.}
+ \item{...}{Other arguments to \code{\link{lp}()}.}
+}
+
+\examples{
+# compute left and right smooths
+data(penny)
+xev <- (1945:1988)+0.5
+fitl <- locfit(thickness~left(year,h=10,deg=1), ev=xev, data=penny)
+fitr <- locfit(thickness~right(year,h=10,deg=1),ev=xev, data=penny)
+# plot the squared difference, to show the change points.
+plot( xev, (predict(fitr,where="ev") - predict(fitl,where="ev"))^2 )
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{lp}},
+ \code{\link{right}}
+}
+
+\keyword{models}
diff --git a/man/lf.Rd b/man/lf.Rd
new file mode 100755
index 0000000..e4ad756
--- /dev/null
+++ b/man/lf.Rd
@@ -0,0 +1,46 @@
+\name{lf}
+\alias{lf}
+\title{
+Locfit term in Additive Model formula
+}
+\usage{
+lf(..., alpha=0.7, deg=2, scale=1, kern="tcub", ev=rbox(), maxk=100)
+}
+\description{
+ This function is used to specify a smooth term in a \code{gam()}
+ model formula.
+
+ This function is designed to be used with the S-Plus
+ \code{gam()} function. For R users, there are at least two different
+ \code{gam()} functions available. Most current distributions of R
+ will include the \code{mgcv} library by Simon Wood; \code{lf()}
+ is not compatable with this function.
+
+ On CRAN, there is a \code{gam} package by Trevor Hastie, similar to
+ the S-Plus version. \code{lf()} should be compatable with this, although
+ it's untested.
+}
+\arguments{
+ \item{...}{numeric predictor variable(s)}
+ \item{alpha, deg, scale, kern, ev, maxk}{these are as in
+ \code{\link{locfit.raw}}.}
+}
+\examples{
+# fit an additive semiparametric model to the ethanol data.
+stopifnot(require(gam))
+# The `gam' package must be attached _before_ `locfit', otherwise
+# the following will not work.
+data(ethanol, package = "lattice")
+fit <- gam(NOx ~ lf(E) + C, data=ethanol)
+op <- par(mfrow=c(2, 1))
+plot(fit)
+par(op)
+}
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gam.lf}},
+ \code{gam}
+}
+
+\keyword{models}
diff --git a/man/lfeval.Rd b/man/lfeval.Rd
new file mode 100755
index 0000000..742257d
--- /dev/null
+++ b/man/lfeval.Rd
@@ -0,0 +1,28 @@
+\name{lfeval}
+\alias{lfeval}
+\title{
+Extract Locfit Evaluation Structure.
+}
+\usage{
+lfeval(object)
+}
+\description{
+ Extracts the evaluation structure from a \code{"locfit"} object.
+ This object has the class \code{"lfeval"}, and has its own set of
+ methods for plotting e.t.c.
+}
+\arguments{
+ \item{object}{\code{"locfit"} object}
+}
+
+\value{
+ \code{"lfeval"} object.
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{plot.lfeval}},
+ \code{\link{print.lfeval}}
+}
+
+\keyword{smooth}
diff --git a/man/lfgrid.Rd b/man/lfgrid.Rd
new file mode 100755
index 0000000..2ca617a
--- /dev/null
+++ b/man/lfgrid.Rd
@@ -0,0 +1,36 @@
+\name{lfgrid}
+\alias{lfgrid}
+\title{
+Locfit - grid evaluation structure.
+}
+\usage{
+lfgrid(mg=10, ll, ur)
+}
+\description{
+ \code{lfgrid()} is used to specify evaluation on a grid of points
+ for \code{\link{locfit.raw}()}. The structure computes
+ a bounding box for the data, and divides that into a grid with
+ specified margins.
+}
+\arguments{
+\item{mg}{
+Number of grid points along each margin. Can be a single number (which
+is applied in each dimension), or a vector specifying a value for
+each dimension.
+}
+\item{ll}{
+Lower left limits for the grid. Length should be the number
+of dimensions of the data provided to \code{\link{locfit.raw}()}.
+}
+\item{ur}{
+Upper right limits for the grid. By default, \code{ll} and
+\code{ur} are generated as the bounding box for the data.
+}
+}
+
+\examples{
+data(ethanol, package="locfit")
+plot.eval(locfit(NOx ~ lp(E, C, scale=TRUE), data=ethanol, ev=lfgrid()))
+}
+
+\keyword{smooth}
diff --git a/man/lfknots.Rd b/man/lfknots.Rd
new file mode 100755
index 0000000..78d9a32
--- /dev/null
+++ b/man/lfknots.Rd
@@ -0,0 +1,36 @@
+\name{lfknots}
+\alias{lfknots}
+\title{
+Extraction of fit-point information from a Locfit object.
+}
+\usage{
+lfknots(x, tr, what = c("x", "coef", "h", "nlx"), delete.pv = TRUE)
+}
+\description{
+ Extracts information, such as fitted values, influence functions
+ from a \code{"locfit"} object.
+}
+\arguments{
+\item{x}{
+Fitted object from \code{\link{locfit}()}.
+}
+\item{tr}{
+Back transformation. Default is the invers link function from the Locfit
+object.
+}
+\item{what}{
+What to return; default is \code{c("x","coef","h","nlx")}.
+Allowed fields are \code{x} (fit points); \code{coef} (fitted values);
+\code{f1} (local slope); \code{nlx} (length of the weight diagram);
+\code{nlx1} (estimated derivative of \code{nlx}); \code{se} (standard errors);
+\code{infl} (influence function); \code{infla} (slope of influence function);
+\code{lik} (maximixed local log-likelihood and local degrees of freedom);
+\code{h} (bandwidth) and \code{deg} (degree of fit).
+}
+\item{delete.pv}{If \code{T}, pseudo-vertices are deleted.}
+}
+\value{
+A matrix with one row for each fit point. Columns correspond to
+the specified \code{what} vector; some fields contribute multiple columns.
+}
+\keyword{smooth}
diff --git a/man/lflim.Rd b/man/lflim.Rd
new file mode 100755
index 0000000..f5f6a4c
--- /dev/null
+++ b/man/lflim.Rd
@@ -0,0 +1,30 @@
+\name{lflim}
+\alias{lflim}
+\title{
+Construct Limit Vectors for Locfit fits.
+}
+\usage{
+lflim(limits, nm, ret)
+}
+\description{
+ This function is used internally to interpret \code{xlim} and \code{flim}
+ arguments. It should not be called directly.
+}
+\arguments{
+\item{limits}{
+Limit argument.
+}
+\item{nm}{
+Variable names.
+}
+\item{ret}{
+Initial return vector.
+}
+}
+\value{
+Vector with length 2*dim.
+}
+\seealso{
+\code{\link{locfit}}
+}
+\keyword{smooth}
diff --git a/man/lfmarg.Rd b/man/lfmarg.Rd
new file mode 100755
index 0000000..012968e
--- /dev/null
+++ b/man/lfmarg.Rd
@@ -0,0 +1,29 @@
+\name{lfmarg}
+\alias{lfmarg}
+\title{
+Generate grid margins.
+}
+\usage{
+lfmarg(xlim, m = 40)
+}
+\arguments{
+\item{xlim}{
+Vector of limits for the grid. Should be of length 2*d;
+the first d components represent the lower left corner,
+and the next d components the upper right corner.
+Can also be a \code{"locfit"} object.
+}
+\item{m}{
+Number of points for each grid margin. Can be a vector of length d.
+}
+}
+\value{
+A list, whose components are the d grid margins.
+}
+\description{
+This function is usually called by \code{\link{plot.locfit}}.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}}
+}
+\keyword{smooth}
diff --git a/man/lines.locfit.Rd b/man/lines.locfit.Rd
new file mode 100755
index 0000000..980646b
--- /dev/null
+++ b/man/lines.locfit.Rd
@@ -0,0 +1,26 @@
+\name{lines.locfit}
+\alias{lines.locfit}
+\alias{llines.locfit}
+\title{
+Add locfit line to existing plot
+}
+\usage{
+\method{lines}{locfit}(x, m=100, tr=x$trans, \dots)
+\method{llines}{locfit}(x, m=100, tr=x$trans, \dots)
+}
+\description{
+ Adds a Locfit line to an existing plot. \code{llines} is for use
+ within a panel function for Lattice.
+}
+\arguments{
+\item{x}{\code{locfit} object. Should be a model with one predictor.}
+\item{m}{Number of points to evaluate the line at.}
+\item{tr}{Transformation function to use for plotting. Default is the
+ inverse link function, or the identity function if derivatives are
+ required.}
+\item{...}{Other arguments to the default \code{\link{lines}} function.}
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}}, \code{\link{lines}}
+}
+\keyword{smooth}
diff --git a/man/livmet.Rd b/man/livmet.Rd
new file mode 100755
index 0000000..6d00e63
--- /dev/null
+++ b/man/livmet.Rd
@@ -0,0 +1,24 @@
+\name{livmet}
+\alias{livmet}
+\title{liver Metastases dataset}
+\usage{data(livmet)}
+\format{
+ Data frame with survival times (\code{t}), censoring indicator
+ (\code{z}) and a number of covariates.
+}
+\description{
+ Survival times for 622 patients diagnosed with Liver Metastases.
+
+ Beware, the censoring variable
+ is coded as 1 = uncensored, so use \code{cens=1-z} in
+ \code{\link{locfit}()} calls.
+}
+\source{
+ Haupt and Mansmann (1995)
+}
+\references{
+ Haupt, G. and Mansmann, U. (1995)
+ CART for Survival Data.
+ Statlib Archive, \url{http://lib.stat.cmu.edu/S/survcart}.
+}
+\keyword{datasets}
diff --git a/man/locfit.Rd b/man/locfit.Rd
new file mode 100755
index 0000000..935195b
--- /dev/null
+++ b/man/locfit.Rd
@@ -0,0 +1,80 @@
+\name{locfit}
+\alias{locfit}
+\title{
+Local Regression, Likelihood and Density Estimation.
+}
+\usage{
+locfit(formula, data=sys.frame(sys.parent()), weights=1, cens=0, base=0,
+ subset, geth=FALSE, \dots, lfproc=locfit.raw)
+}
+\description{
+ \code{locfit} is the model formula-based interface to the Locfit
+ library for fitting local regression and likelihood models.
+
+ \code{locfit} is implemented as a front-end to \code{\link{locfit.raw}}.
+ See that function for options to control smoothing parameters,
+ fitting family and other aspects of the fit.
+}
+\arguments{
+\item{formula}{
+Model Formula; e.g. \code{y~lp(x)} for a regression model; \code{~lp(x)} for a
+density estimation model. Use of \code{lp()} on the RHS is recommended, especially
+when non-default smoothing parameters are used.
+}
+\item{data}{
+Data Frame.
+}
+\item{weights}{
+Prior weights (or sample sizes) for individual observations. This is
+typically used where observations have unequal variance.
+}
+\item{cens}{
+Censoring indicator. \code{1} (or \code{TRUE}) denotes a censored observation.
+\code{0} (or \code{FALSE}) denotes uncensored.
+}
+\item{base}{
+Baseline for local fitting. For local regression models, specifying
+a \code{base} is equivalent to using \code{y-base} as the reponse. But \code{base}
+also works for local likelihood.
+}
+\item{subset}{
+Subset observations in the data frame.
+}
+\item{geth}{
+Don't use.
+}
+\item{...}{
+Other arguments to \code{\link{locfit.raw}()} (or the \code{lfproc}).
+}
+\item{lfproc}{
+A processing function to compute the local fit. Default is
+\code{locfit.raw()}. Other choices include \code{locfit.robust()},
+\code{locfit.censor()} and \code{locfit.quasi()}.
+}}
+\value{
+An object with class \code{"locfit"}. A standard set of methods for printing,
+ploting, etc. these objects is provided.
+}
+\seealso{
+\code{\link{locfit.raw}}
+}
+\examples{
+# fit and plot a univariate local regression
+data(ethanol, package="locfit")
+fit <- locfit(NOx ~ E, data=ethanol)
+plot(fit, get.data=TRUE)
+
+# a bivariate local regression with smaller smoothing parameter
+fit <- locfit(NOx~lp(E,C,nn=0.5,scale=0), data=ethanol)
+plot(fit)
+
+# density estimation
+data(geyser, package="locfit")
+fit <- locfit( ~ lp(geyser, nn=0.1, h=0.8))
+plot(fit,get.data=TRUE)
+}
+\references{
+Loader, C. (1999). Local Regression and Likelihood. Springer, New York.
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/locfit.censor.Rd b/man/locfit.censor.Rd
new file mode 100755
index 0000000..d53d79b
--- /dev/null
+++ b/man/locfit.censor.Rd
@@ -0,0 +1,73 @@
+\name{locfit.censor}
+\alias{locfit.censor}
+
+\title{
+Censored Local Regression
+}
+\usage{
+locfit.censor(x, y, cens, ..., iter=3, km=FALSE)
+}
+\description{
+ \code{locfit.censor} produces local regression estimates for censored
+ data. The basic idea is to use an EM style algorithm, where one
+ alternates between estimating the regression and the true values
+ of censored observations.
+
+ \code{locfit.censor} is designed as a front end
+ to \code{\link{locfit.raw}} with data vectors, or as an intemediary
+ between \code{\link{locfit}} and \code{\link{locfit.raw}} with a
+ model formula. If you can stand the syntax, the second calling
+ sequence above will be slightly more efficient than the third.
+}
+\arguments{
+\item{x}{
+ Either a \code{\link{locfit}} model formula or a numeric vector
+ of the predictor variable.
+}
+\item{y}{
+ If \code{x} is numeric, \code{y} gives the response variable.
+}
+\item{cens}{
+ Logical variable indicating censoring. The coding is \code{1}
+ or \code{TRUE} for censored; \code{0} or \code{FALSE} for uncensored.
+}
+\item{...}{
+ Other arguments to \code{\link{locfit.raw}}
+}
+\item{iter}{Number of EM iterations to perform}
+\item{km}{
+ If \code{km=TRUE}, the estimation of censored observations uses
+ the Kaplan-Meier estimate, leading to a local version of the
+ Buckley-James estimate. If \code{km=F}, the estimation is based
+ on a normal model (Schmee and Hahn). Beware of claims that B-J
+ is nonparametric; it makes stronger assumptions on the upper tail
+ of survival distributions than most authors care to admit.
+}
+}
+\value{
+\code{locfit} object.
+}
+\seealso{
+\code{\link{km.mrl}},
+\code{\link{locfit}},
+\code{\link{locfit.raw}}
+}
+\examples{
+data(heart, package="locfit")
+fit <- locfit.censor(log10(surv+0.5) ~ age, cens=cens, data=heart)
+## Can also be written as:
+\dontrun{fit <- locfit(log10(surv + 0.5) ~ age, cens=cens, data=heart, lfproc=locfit.censor)}
+with(heart, plotbyfactor(age, 0.5 + surv, cens, ylim=c(0.5, 16000), log="y"))
+lines(fit, tr=function(x) 10^x)
+}
+\references{
+Buckley, J. and James, I. (1979). Linear Regression with censored data.
+ Biometrika 66, 429-436.
+
+Loader, C. (1999). Local Regression and Likelihood. Springer, NY (Section 7.2).
+
+Schmee, J. and Hahn, G. J. (1979). A simple method for linear regression
+ analysis with censored data (with discussion). Technometrics 21, 417-434.
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/locfit.matrix.Rd b/man/locfit.matrix.Rd
new file mode 100755
index 0000000..5d107a7
--- /dev/null
+++ b/man/locfit.matrix.Rd
@@ -0,0 +1,32 @@
+\name{locfit.matrix}
+\alias{locfit.matrix}
+\title{
+Reconstruct a Locfit model matrix.
+}
+\usage{
+locfit.matrix(fit, data)
+}
+\description{
+ Reconstructs the model matrix, and associated variables such as
+ the response, prior weights and censoring indicators, from a
+ \code{locfit} object. This is used by functions such as
+ \code{\link{fitted.locfit}}; it is not normally called directly.
+ The function will only work properly if the data frame has not been
+ changed since the fit was constructed.
+}
+\arguments{
+\item{fit}{Locfit object}
+\item{data}{ Data Frame.}
+}
+%\item{...}{
+%Other arguments to \code{\link{locfit.raw}()} (or the \code{lfproc}).
+%}
+\value{
+A list with variables \code{x} (the model matrix); \code{y} (the response);
+\code{w} (prior weights); \code{sc} (scales); \code{ce} (censoring indicator)
+and \code{base} (baseline fit).
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{fitted.locfit}}, \code{\link{residuals.locfit}}
+}
+\keyword{models}
diff --git a/man/locfit.quasi.Rd b/man/locfit.quasi.Rd
new file mode 100755
index 0000000..f3cb0bc
--- /dev/null
+++ b/man/locfit.quasi.Rd
@@ -0,0 +1,45 @@
+\name{locfit.quasi}
+\alias{locfit.quasi}
+\title{
+Local Quasi-Likelihood with global reweighting.
+}
+\usage{
+locfit.quasi(x, y, weights, ..., iter=3, var=abs)
+}
+\description{
+ \code{locfit.quasi} assumes a specified mean-variance relation,
+ and performs iterartive reweighted local regression under this
+ assumption. This is appropriate for local quasi-likelihood models,
+ and is an alternative to specifying a family such as \code{"qpoisson"}.
+
+ \code{locfit.quasi} is designed as a front end
+ to \code{\link{locfit.raw}} with data vectors, or as an intemediary
+ between \code{\link{locfit}} and \code{\link{locfit.raw}} with a
+ model formula. If you can stand the syntax, the second calling
+ sequence above will be slightly more efficient than the third.
+}
+\arguments{
+\item{x}{
+ Either a \code{\link{locfit}} model formula or a numeric vector
+ of the predictor variable.
+}
+\item{y}{
+ If \code{x} is numeric, \code{y} gives the response variable.
+}
+\item{weights}{Case weights to use in the fitting.}
+\item{...}{
+ Other arguments to \code{\link{locfit.raw}}
+}
+\item{iter}{Number of EM iterations to perform}
+\item{var}{
+ Function specifying the assumed relation between the mean and variance.
+}
+}
+\value{
+\code{"locfit"} object.
+}
+\seealso{
+\code{\link{locfit}},
+\code{\link{locfit.raw}}
+}
+\keyword{smooth}
diff --git a/man/locfit.raw.Rd b/man/locfit.raw.Rd
new file mode 100755
index 0000000..f0a767c
--- /dev/null
+++ b/man/locfit.raw.Rd
@@ -0,0 +1,184 @@
+\name{locfit.raw}
+\alias{locfit.raw}
+\title{
+Local Regression, Likelihood and Density Estimation.
+}
+\usage{
+locfit.raw(x, y, weights=1, cens=0, base=0,
+ scale=FALSE, alpha=0.7, deg=2, kern="tricube", kt="sph",
+ acri="none", basis=list(NULL),
+ deriv=numeric(0), dc=FALSE,
+ family, link="default",
+ xlim, renorm=FALSE,
+ ev=rbox(),
+ maxk=100, itype="default", mint=20, maxit=20, debug=0,
+ geth=FALSE, sty="none")
+}
+\description{
+ \code{locfit.raw} is an interface to Locfit using numeric vectors
+ (for a model-formula based interface, use \code{\link{locfit}}).
+ Although this function has a large number of arguments, most users
+ are likely to need only a small subset.
+
+ The first set of arguments (\code{x}, \code{y}, \code{weights},
+ \code{cens}, and \code{base}) specify the regression
+ variables and associated quantities.
+
+ Another set (\code{scale}, \code{alpha}, \code{deg}, \code{kern},
+ \code{kt}, \code{acri} and \code{basis}) control the amount of smoothing:
+ bandwidth, smoothing weights and the local model. Most of these arguments
+ are deprecated - they'll currently still work, but should be provided through
+ the \code{lp()} model term instead.
+
+ \code{deriv} and \code{dc} relate to derivative (or local slope)
+ estimation.
+
+ \code{family} and \code{link} specify the likelihood family.
+
+ \code{xlim} and \code{renorm} may be used in density estimation.
+
+ \code{ev} specifies the evaluation structure or set of evaluation points.
+
+ \code{maxk}, \code{itype}, \code{mint}, \code{maxit} and \code{debug}
+ control the Locfit algorithms, and will be rarely used.
+
+ \code{geth} and \code{sty} are used by other functions calling
+ \code{locfit.raw}, and should not be used directly.
+}
+\arguments{
+\item{x}{
+Vector (or matrix) of the independent variable(s). Can be constructed using the
+\code{lp()} function.
+}
+\item{y}{
+Response variable for regression models. For density families,
+\code{y} can be omitted.
+}
+\item{weights}{
+Prior weights for observations (reciprocal of variance, or sample size).
+}
+\item{cens}{
+Censoring indicators for hazard rate or censored regression. The coding
+is \code{1} (or \code{TRUE}) for a censored observation, and
+\code{0} (or \code{FALSE}) for uncensored observations.
+}
+\item{base}{
+Baseline parameter estimate. If provided, the local regression model is
+fitted as \eqn{Y_i = b_i + m(x_i) + \epsilon_i}, with Locfit estimating
+the \eqn{m(x)} term. For regression models, this effectively subtracts
+\eqn{b_i} from \eqn{Y_i}. The advantage of the \code{base} formulation
+is that it extends to likelihood regression models.
+}
+
+\item{scale}{ Deprecated - see \code{\link{lp}()}. }
+\item{alpha}{Deprecated - see \code{\link{lp}()}.
+A single number (e.g. \code{alpha=0.7})
+is interpreted as a nearest neighbor fraction. With two
+componentes (e.g. \code{alpha=c(0.7,1.2)}), the first component
+is a nearest neighbor fraction, and the second component is
+a fixed component. A third component is the penalty term in locally
+adaptive smoothing.
+}
+\item{deg}{
+ Degree of local polynomial. Deprecated - see \code{\link{lp}()}.
+}
+\item{kern}{
+ Weight function, default = \code{"tcub"}.
+ Other choices are \code{"rect"}, \code{"trwt"}, \code{"tria"},
+ \code{"epan"}, \code{"bisq"} and \code{"gauss"}. Choices may be restricted
+ when derivatives are required; e.g. for confidence bands and some
+ bandwidth selectors.
+}
+\item{kt}{
+ Kernel type, \code{"sph"} (default); \code{"prod"}.
+ In multivariate problems, \code{"prod"} uses a
+ simplified product model which speeds up computations.
+}
+\item{acri}{Deprecated - see \code{\link{lp}().}}
+\item{basis}{User-specified basis functions.}
+%See \code{\link{lfbas}} for more details on this argument.}
+
+\item{deriv}{
+ Derivative estimation. If \code{deriv=1}, the returned fit will be
+ estimating the derivative (or more correctly, an estimate of the
+ local slope). If \code{deriv=c(1,1)} the second order derivative
+ is estimated. \code{deriv=2} is for the partial derivative, with
+ respect to the second variable, in multivariate settings. }
+\item{dc}{ Derivative adjustment. }
+
+\item{family}{
+ Local likelihood family; \code{"gaussian"};
+ \code{"binomial"}; \code{"poisson"}; \code{"gamma"} and \code{"geom"}.
+ Density and rate estimation families are \code{"dens"}, \code{"rate"} and
+ \code{"hazard"} (hazard rate). If the family is preceded by a \code{'q'}
+ (for example, \code{family="qbinomial"}), quasi-likelihood variance
+ estimates are used. Otherwise, the residual variance (\code{\link{rv}})
+ is fixed at 1. The default family is \code{"qgauss"} if a response
+ \code{y} is provided; \code{"density"} if no response is provided.
+}
+\item{link}{
+ Link function for local likelihood fitting. Depending on the family,
+ choices may be \code{"ident"}, \code{"log"}, \code{"logit"},
+ \code{"inverse"}, \code{"sqrt"} and \code{"arcsin"}.
+}
+
+\item{xlim}{
+ For density estimation, Locfit allows the density to be supported on
+ a bounded interval (or rectangle, in more than one dimension).
+ The format should be \code{c(ll,ul)} where \code{ll} is a vector of
+ the lower bounds and \code{ur} the upper bounds. Bounds such as
+ \eqn{[0,\infty)} are not supported, but can be effectively
+ implemented by specifying a very large upper bound.
+}
+\item{renorm}{Local likelihood density estimates may not integrate
+ exactly to 1. If \code{renorm=T}, the integral will be estimated
+ numerically and the estimate rescaled. Presently this is implemented
+ only in one dimension.
+}
+
+\item{ev}{
+ The evaluation structure,
+ \code{\link{rbox}()} for tree structures;
+ \code{\link{lfgrid}()} for grids;
+ \code{\link{dat}()} for data points;
+ \code{\link{none}()} for none.
+ A vector or matrix of evaluation points can also be provided,
+ although in this case you may prefer to use the
+ \code{\link{smooth.lf}()} interface to Locfit.
+ Note that arguments \code{flim}, \code{mg} and \code{cut} are now
+ given as arguments to the evaluation structure function, rather
+ than to \code{locfit.raw()} directly (change effective 12/2001).
+}
+
+\item{maxk}{
+ Controls space assignment for evaluation structures.
+ For the adaptive evaluation structures, it is impossible to be sure
+ in advance how many vertices will be generated. If you get
+ warnings about `Insufficient vertex space', Locfit's default assigment
+ can be increased by increasing \code{maxk}. The default is \code{maxk=100}.
+}
+\item{itype}{
+ Integration type for density estimation. Available methods include
+ \code{"prod"}, \code{"mult"} and \code{"mlin"}; and \code{"haz"} for
+ hazard rate estimation problems. The available integration methods
+ depend on model specification (e.g. dimension, degree of fit). By
+ default, the best available method is used.
+}
+\item{mint}{
+ Points for numerical integration rules. Default 20.
+}
+\item{maxit}{
+ Maximum iterations for local likelihood estimation. Default 20.
+}
+\item{debug}{If > 0; prints out some debugging information.}
+
+\item{geth}{Don't use!}
+\item{sty}{ Deprecated - see \code{\link{lp}()}. }
+}
+\value{
+An object with class "locfit". A standard set of methods for printing, ploting, etc. these objects is provided.
+}
+\references{
+Consult the Web page \url{http://www.locfit.info/}.
+}
+\keyword{smooth}
diff --git a/man/locfit.robust.Rd b/man/locfit.robust.Rd
new file mode 100755
index 0000000..d515537
--- /dev/null
+++ b/man/locfit.robust.Rd
@@ -0,0 +1,49 @@
+\name{locfit.robust}
+\alias{locfit.robust}
+\title{
+Robust Local Regression
+}
+\usage{
+locfit.robust(x, y, weights, ..., iter=3)
+}
+\description{
+ \code{locfit.robust} implements a robust local regression where
+ outliers are iteratively identified and downweighted, similarly
+ to the lowess method (Cleveland, 1979). The iterations and scale
+ estimation are performed on a global basis.
+
+ The scale estimate is 6 times the median absolute residual, while
+ the robust downweighting uses the bisquare function. These are
+ performed in the S code so easily changed.
+
+ This can be interpreted as an extension of M estimation to local
+ regression. An alternative extension (implemented in locfit via
+ \code{family="qrgauss"}) performs the iteration and scale estimation
+ on a local basis.
+}
+\arguments{
+\item{x}{
+ Either a \code{\link{locfit}} model formula or a numeric vector
+ of the predictor variable.
+}
+\item{y}{
+ If \code{x} is numeric, \code{y} gives the response variable.
+}
+\item{weights}{weights to use in the fitting.}
+\item{...}{Other arguments to \code{\link{locfit.raw}}.}
+\item{iter}{Number of iterations to perform}
+}
+\value{
+\code{"locfit"} object.
+}
+\seealso{
+\code{\link{locfit}},
+\code{\link{locfit.raw}}
+}
+\references{
+Cleveland, W. S. (1979).
+ Robust locally weighted regression and smoothing scatterplots.
+ J. Amer. Statist. Assn. 74, 829-836.
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/lp.Rd b/man/lp.Rd
new file mode 100755
index 0000000..e3941b8
--- /dev/null
+++ b/man/lp.Rd
@@ -0,0 +1,59 @@
+\name{lp}
+\alias{lp}
+\title{
+Local Polynomial Model Term
+}
+\usage{
+lp(..., nn, h, adpen, deg, acri, scale, style)
+}
+\description{
+ \code{lp} is a local polynomial model term for Locfit models.
+ Usually, it will be the only term on the RHS of the model formula.
+
+ Smoothing parameters should be provided as arguments to \code{lp()},
+ rather than to \code{\link{locfit}()}.
+}
+\arguments{
+\item{...}{Predictor variables for the local regression model.
+}
+\item{nn}{
+Nearest neighbor component of the smoothing parameter.
+Default value is 0.7, unless either \code{h} or \code{adpen} are
+provided, in which case the default is 0.
+}
+\item{h}{
+The constant component of the smoothing parameter. Default: 0.
+}
+\item{adpen}{Penalty parameter for adaptive fitting.}
+\item{deg}{Degree of polynomial to use.}
+\item{acri}{Criterion for adaptive bandwidth selection.}
+\item{style}{Style for special terms (\code{\link{left}},
+ \code{\link{ang}} e.t.c.). Do not try to set this directly;
+ call \code{\link{locfit}} instead. }
+\item{scale}{
+A scale to apply to each variable. This is especially important for
+multivariate fitting, where variables may be measured in
+non-comparable units. It is also used to specify the frequency
+for \code{\link{ang}} terms. If \code{scale=F} (the default) no scaling
+is performed. If \code{scale=T}, marginal standard deviations are used.
+Alternatively, a numeric vector can provide scales for the
+individual variables.
+}
+}
+
+\seealso{
+\code{\link{locfit}},
+\code{\link{locfit.raw}}
+}
+\examples{
+data(ethanol, package="locfit")
+# fit with 50% nearest neighbor bandwidth.
+fit <- locfit(NOx~lp(E,nn=0.5),data=ethanol)
+# bivariate fit.
+fit <- locfit(NOx~lp(E,C,scale=TRUE),data=ethanol)
+
+# density estimation
+data(geyser, package="locfit")
+fit <- locfit.raw(lp(geyser,nn=0.1,h=0.8))
+}
+\keyword{models}
diff --git a/man/lscv.Rd b/man/lscv.Rd
new file mode 100755
index 0000000..58ac166
--- /dev/null
+++ b/man/lscv.Rd
@@ -0,0 +1,47 @@
+\name{lscv}
+\alias{lscv}
+\title{
+Least Squares Cross Validation Statistic.
+}
+\usage{
+lscv(x, \dots, exact=FALSE)
+}
+\description{
+ The calling sequence for \code{lscv} matches those for the
+ \code{\link{locfit}} or \code{\link{locfit.raw}} functions.
+ Note that this function is only designed for density estimation
+ in one dimension. The returned object contains the
+ least squares cross validation score for the fit.
+
+ The computation of \eqn{\int \hat f(x)^2 dx} is performed numerically.
+ For kernel density estimation, this is unlikely to agree exactly
+ with other LSCV routines, which may perform the integration analytically.
+}
+\arguments{
+ \item{x}{model formula (or numeric vector, if \code{exact=T})}
+ \item{...}{other arguments to \code{\link{locfit}} or
+ \code{\link{lscv.exact}} }
+ \item{exact}{By default, the computation is approximate.
+ If \code{exact=TRUE}, exact computation using
+ \code{\link{lscv.exact}} is performed. This uses kernel density estimation
+ with a constant bandwidth.}
+}
+\value{
+ A vector consisting of the LSCV statistic and fitted degrees of freedom.
+}
+\examples{
+# approximate calculation for a kernel density estimate
+data(geyser, package="locfit")
+lscv(~lp(geyser,h=1,deg=0), ev=lfgrid(100,ll=1,ur=6), kern="gauss")
+# same computation, exact
+lscv(lp(geyser,h=1),exact=TRUE)
+}
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{lscv.exact}}
+ \code{\link{lscvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/lscv.exact.Rd b/man/lscv.exact.Rd
new file mode 100755
index 0000000..88daa49
--- /dev/null
+++ b/man/lscv.exact.Rd
@@ -0,0 +1,37 @@
+\name{lscv.exact}
+\alias{lscv.exact}
+\title{
+Exact LSCV Calculation
+}
+\usage{
+lscv.exact(x, h=0)
+}
+\description{
+ This function performs the exact computation of the least squares
+ cross validation statistic for one-dimensional kernel density estimation
+ and a constant bandwidth.
+
+ At the time of writing, it is implemented only for the Gaussian
+ kernel (with the standard deviation of 0.4; Locfit's standard).
+}
+\arguments{
+ \item{x}{Numeric data vector.}
+ \item{h}{The bandwidth. If \code{x} is constructed with
+ \code{\link{lp}()}, the bandwidth should be given there instead.}
+}
+\value{
+ A vector of the LSCV statistic and the fitted degrees of freedom.
+}
+\examples{
+data(geyser, package="locfit")
+lscv.exact(lp(geyser,h=0.25))
+# equivalent form using lscv
+lscv(lp(geyser, h=0.25), exact=TRUE)
+}
+\seealso{
+ \code{\link{lscv}},
+ \code{\link{lscvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/lscvplot.Rd b/man/lscvplot.Rd
new file mode 100755
index 0000000..f393425
--- /dev/null
+++ b/man/lscvplot.Rd
@@ -0,0 +1,42 @@
+\name{lscvplot}
+\alias{lscvplot}
+\title{
+Compute the LSCV plot.
+}
+\usage{
+lscvplot(..., alpha)
+}
+\description{
+ The \code{lscvplot} function loops through calls to the \code{\link{lscv}}
+function (and hence to \code{link{locfit}}), using a different
+smoothing parameter for each call.
+The returned structure contains the LSCV statistic for each density
+estimate, and can be used to produce an LSCV plot.
+}
+\arguments{
+ \item{...}{ arguments to the \code{\link{lscv}}, \code{\link{locfit}}
+ functions.}
+ \item{alpha}{ Matrix of smoothing parameters. The \code{lscvplot} function
+ loops through calls to \code{\link{lscv}}, using each row of
+ \code{alpha} as the smoothing parameter in turn. If \code{alpha}
+ is provided as a vector, it will be converted to a one-column
+ matrix, thus interpreting each component as a nearest neighbor
+ smoothing parameter.}
+}
+
+\value{
+ An object with class \code{"gcvplot"}, containing the smoothing
+ parameters and LSCV scores. The actual plot is produced using
+ \code{\link{plot.gcvplot}}.
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcv}},
+ \code{\link{lscv}},
+ \code{\link{plot.gcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/mcyc.Rd b/man/mcyc.Rd
new file mode 100755
index 0000000..da97848
--- /dev/null
+++ b/man/mcyc.Rd
@@ -0,0 +1,19 @@
+\name{mcyc}
+\alias{mcyc}
+\title{Acc(De?)celeration of a Motorcycle Hitting a Wall}
+\usage{data(mcyc)}
+\format{
+ Data frame with time and accel variables.
+}
+\description{
+ Measurements of the acceleration of a motorcycle as it hits a wall.
+ Actually, rumored to be a concatenation of several such datasets.
+}
+\source{
+ H\"ardle (1990).
+}
+\references{
+ H\"ardle, W. (1990). Applied Nonparametric Regression.
+ Cambridge University Press.
+}
+\keyword{datasets}
diff --git a/man/mine.Rd b/man/mine.Rd
new file mode 100755
index 0000000..95a821e
--- /dev/null
+++ b/man/mine.Rd
@@ -0,0 +1,20 @@
+\name{mine}
+\alias{mine}
+\title{Fracture Counts in Coal Mines}
+\usage{data(mine)}
+\format{
+A dataframe with the response frac, and predictor variables
+extrp, time, seamh and inb.
+}
+\description{
+The number of fractures in the upper seam of coal mines, and four
+predictor variables. This dataset can be modeled using Poisson regression.
+}
+\source{
+Myers (1990).
+}
+\references{
+Myers, R. H. (1990). Classical and Modern Regression with Applications
+(Second edition). PWS-Kent Publishing, Boston.
+}
+\keyword{datasets}
diff --git a/man/mmsamp.Rd b/man/mmsamp.Rd
new file mode 100755
index 0000000..e321a97
--- /dev/null
+++ b/man/mmsamp.Rd
@@ -0,0 +1,14 @@
+\name{mmsamp}
+\alias{mmsamp}
+\title{Test dataset for minimax Local Regression}
+\usage{data(cltest)}
+\format{
+Data Frame with x and y variables.
+}
+\description{
+50 observations, as used in Figure 13.1 of Loader (1999).
+}
+\references{
+ Loader, C. (1999). Local Regression and Likelihood. Springer, New York.
+}
+\keyword{datasets}
diff --git a/man/morths.Rd b/man/morths.Rd
new file mode 100755
index 0000000..cf800ab
--- /dev/null
+++ b/man/morths.Rd
@@ -0,0 +1,18 @@
+\name{morths}
+\alias{morths}
+\title{Henderson and Sheppard Mortality Dataset}
+\usage{data(morths)}
+\format{
+ Data frame with age, n and number of deaths.
+}
+\description{
+ Observed mortality for 55 to 99.
+}
+\source{
+ Henderson and Sheppard (1919).
+}
+\references{
+ Henderson, R. and Sheppard, H. N. (1919). Graduation of mortality and
+ other tables. Actuarial Society of America, New York.
+}
+\keyword{datasets}
diff --git a/man/none.Rd b/man/none.Rd
new file mode 100755
index 0000000..0e02181
--- /dev/null
+++ b/man/none.Rd
@@ -0,0 +1,23 @@
+\name{none}
+\alias{none}
+\title{
+Locfit Evaluation Structure
+}
+\usage{
+none()
+}
+\description{
+ \code{none()} is an evaluation structure for \code{\link{locfit.raw}()},
+ specifying no evaluation points. Only the initial parametric fit is
+ computed - this is the easiest and most efficient way to coerce
+ Locfit into producing a parametric regression fit.
+}
+
+\examples{
+data(ethanol, package="locfit")
+# fit a fourth degree polynomial using locfit
+fit <- locfit(NOx~E,data=ethanol,deg=4,ev=none())
+plot(fit,get.data=TRUE)
+}
+
+\keyword{smooth}
diff --git a/man/panel.locfit.Rd b/man/panel.locfit.Rd
new file mode 100755
index 0000000..d49a416
--- /dev/null
+++ b/man/panel.locfit.Rd
@@ -0,0 +1,40 @@
+\name{panel.locfit}
+\alias{panel.locfit}
+\title{
+Locfit panel function
+}
+\usage{
+panel.locfit(x, y, subscripts, z, xyz.labs, xyz.axes, xyz.mid, xyz.minmax,
+ xyz.range, col.regions, at, drape, contour, region, groups, ...)
+}
+\description{
+This panel function can be used to add locfit fits to plots generated
+by trellis.
+
+Currently it works with \code{xyplot} for 1-d fits
+and crudely with \code{wireframe} for 2-d fits.
+}
+\arguments{
+ \item{...}{Most Locfit arguments can be passed through \code{xyplot}.}
+}
+\examples{
+stopifnot(require(lattice))
+
+# a simple multi-panel display
+data(ethanol, package="locfit")
+xyplot(NOx ~ E | C, data=ethanol, panel=panel.locfit)
+
+# The second example uses some Locfit optional arguments.
+# Note we can pass the alpha (bandwidth) and family arguments directly to
+# xyplot. The cens argument must be given in full; not as a data frame variable.
+# The resulting plot does not (yet) distinguish the censored points, but
+# the fit will correctly apply censoring.
+data(border, package="locfit")
+xyplot(runs ~ day, data=border, panel=panel.locfit, family="poisson",
+ alpha=0.3, cens=border$no)
+}
+\seealso{
+ \code{\link{locfit}}, \code{\link{plot.locfit.3d}}, \code{xyplot}.
+}
+
+\keyword{internal}
diff --git a/man/panel.xyplot.lf.Rd b/man/panel.xyplot.lf.Rd
new file mode 100755
index 0000000..f8ff4cf
--- /dev/null
+++ b/man/panel.xyplot.lf.Rd
@@ -0,0 +1,18 @@
+\name{panel.xyplot.lf}
+\alias{panel.xyplot.lf}
+\title{
+Locfit panel function
+}
+\usage{
+panel.xyplot.lf(x, y, subscripts, clo, cup, wh, type="l", ...)
+
+}
+\description{
+Panel function used by \code{\link{plot.locfit.3d}} for one dimensional
+plots.
+}
+\seealso{
+ \code{\link{plot.locfit.3d}}
+}
+
+\keyword{internal}
diff --git a/man/penny.Rd b/man/penny.Rd
new file mode 100755
index 0000000..50c1c17
--- /dev/null
+++ b/man/penny.Rd
@@ -0,0 +1,19 @@
+\name{penny}
+\alias{penny}
+\title{Penny Thickness Dataset}
+\usage{data(penny)}
+\format{
+ A dataframe.
+}
+\description{
+ For each year, 1945 to 1989, the thickness of two U.S. pennies
+ was recorded.
+}
+\source{
+ Scott (1992).
+}
+\references{
+ Scott (1992). Multivariate Density Estimation.
+ Wiley, New York.
+}
+\keyword{datasets}
diff --git a/man/plot.eval.Rd b/man/plot.eval.Rd
new file mode 100755
index 0000000..30f92e3
--- /dev/null
+++ b/man/plot.eval.Rd
@@ -0,0 +1,29 @@
+\name{plot.eval}
+\alias{plot.eval}
+\title{
+Plot evaluation points from a 2-d locfit object.
+}
+\usage{
+plot.eval(x, add=FALSE, text=FALSE, ...)
+}
+\description{
+This function is used to plot the evaluation structure generated by
+Locfit for a two dimensional fit. Vertices of the tree structure are
+displayed as \code{O}; pseudo-vertices as \code{*}.
+}
+\arguments{
+\item{x}{\code{"locfit"} object. }
+\item{add}{If \code{TRUE}, add to existing plot.}
+\item{text}{If \code{TRUE}, numbers will be added indicating the order points
+ were added.}
+\item{...}{Arguments passed to and from other methods.}
+}
+\examples{
+data(ethanol, package="locfit")
+fit <- locfit(NOx ~ E + C, data=ethanol, scale=0)
+plot.eval(fit)
+}
+\seealso{
+\code{\link{locfit}}.
+}
+\keyword{smooth}
diff --git a/man/plot.gcvplot.Rd b/man/plot.gcvplot.Rd
new file mode 100755
index 0000000..25505c0
--- /dev/null
+++ b/man/plot.gcvplot.Rd
@@ -0,0 +1,36 @@
+\name{plot.gcvplot}
+\alias{plot.gcvplot}
+\title{
+Produce a cross-validation plot.
+}
+\usage{
+\method{plot}{gcvplot}(x, xlab = "Fitted DF", ylab = x$cri, ...)
+}
+\description{
+Plots the value of the GCV (or other statistic) in a \code{gcvplot} object
+against the degrees of freedom of the fit.
+}
+\arguments{
+ \item{x}{ A \code{gcvplot} object, produced by \code{\link{gcvplot}},
+ \code{\link{aicplot}} etc.}
+ \item{xlab}{Text label for the x axis.}
+ \item{ylab}{Text label for the y axis.}
+ \item{...}{ Other arguments to \code{\link{plot}} .}
+}
+
+\examples{
+data(ethanol)
+plot(gcvplot(NOx~E,data=ethanol,alpha=seq(0.2,1.0,by=0.05)))
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{gcv}},
+ \code{\link{aicplot}},
+ \code{\link{cpplot}},
+ \code{\link{gcvplot}},
+ \code{\link{lcvplot}}
+}
+
+\keyword{methods}
diff --git a/man/plot.lfeval.Rd b/man/plot.lfeval.Rd
new file mode 100755
index 0000000..9d49e95
--- /dev/null
+++ b/man/plot.lfeval.Rd
@@ -0,0 +1,32 @@
+\name{plot.lfeval}
+\alias{plot.lfeval}
+\title{
+Plot a Locfit Evaluation Structure.
+}
+\usage{
+\method{plot}{lfeval}(x, add=FALSE, txt=FALSE, ...)
+}
+\description{
+ Plots the evaluation points from a \code{locfit} or \code{lfeval}
+ structure, for one- or two-dimensional fits.
+}
+\arguments{
+ \item{x}{A \code{lfeval} or \code{locfit} object}
+ \item{add}{If \code{TRUE}, the points will be added to the existing plot.
+ Otherwise, a new plot is created.}
+ \item{txt}{If \code{TRUE}, the points are annotated with numbers in the
+ order they were entered into the fit.}
+ \item{...}{Additional graphical parameters.}
+}
+
+\value{
+ \code{"lfeval"} object.
+}
+
+\seealso{
+ \code{\link{lfeval}},
+ \code{\link{locfit}},
+ \code{\link{print.lfeval}}
+}
+
+\keyword{smooth}
diff --git a/man/plot.locfit.1d.Rd b/man/plot.locfit.1d.Rd
new file mode 100755
index 0000000..4758efa
--- /dev/null
+++ b/man/plot.locfit.1d.Rd
@@ -0,0 +1,27 @@
+\name{plot.locfit.1d}
+\alias{plot.locfit.1d}
+\title{
+Plot a one dimensional preplot.locfit object.
+}
+\usage{
+\method{plot}{locfit.1d}(x, add=FALSE, main="", xlab="default", ylab=x$yname,
+ type="l", ylim, lty=1, col=1, \dots)
+}
+\arguments{
+ \item{x}{One dimensional \code{preplot.locfit} object.}
+ \item{add}{If \code{TRUE}, the plot will be added to the existing
+ plot.}
+ \item{main, xlab, ylab, type, ylim, lty, col}{Graphical parameters
+ passed on to \code{\link{plot}} (only if \code{add=FALSE}).}
+ \item{...}{Additional graphical parameters to the \code{plot} function
+ (only if \code{add=FALSE}).}
+}
+\description{
+This function is not usually called directly. It will be called automatically
+when plotting a one-dimensional \code{locfit} or \code{preplot.locfit}
+object.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}}, \code{\link{preplot.locfit}}
+}
+\keyword{methods}
diff --git a/man/plot.locfit.2d.Rd b/man/plot.locfit.2d.Rd
new file mode 100755
index 0000000..eb27e79
--- /dev/null
+++ b/man/plot.locfit.2d.Rd
@@ -0,0 +1,28 @@
+\name{plot.locfit.2d}
+\alias{plot.locfit.2d}
+\title{
+Plot a two-dimensional "preplot.locfit" object.
+}
+\usage{
+\method{plot}{locfit.2d}(x, type="contour", main, xlab, ylab, zlab=x$yname, ...)
+}
+\arguments{
+ \item{x}{Two dimensional \code{preplot.locfit} object.}
+ \item{type}{one of \code{"contour"}, \code{"persp"}, or \code{"image"}.}
+ \item{main}{title for the plot.}
+ \item{xlab, ylab}{text labels for the x- and y-axes.}
+ \item{zlab}{if \code{type="persp"}, the label for the z-axis.}
+ \item{...}{Additional arguments to the \code{contour}, \code{persp} or
+ \code{image} functions.}
+}
+
+\description{
+This function is not usually called directly. It will be called automatically
+when plotting one-dimensional \code{locfit} or \code{preplot.locfit}
+objects.
+}
+
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}}, \code{\link{preplot.locfit}}
+}
+\keyword{methods}
diff --git a/man/plot.locfit.3d.Rd b/man/plot.locfit.3d.Rd
new file mode 100755
index 0000000..ea9148c
--- /dev/null
+++ b/man/plot.locfit.3d.Rd
@@ -0,0 +1,40 @@
+\name{plot.locfit.3d}
+\alias{plot.locfit.3d}
+\title{
+Plot a high-dimensional "preplot.locfit" object using trellis displays.
+}
+\usage{
+\method{plot}{locfit.3d}(x, main="", pv, tv, type = "level", pred.lab = x$vnames,
+ resp.lab=x$yname, crit = 1.96, ...)
+}
+\description{
+This function plots cross-sections of a Locfit model (usually in three
+or more dimensions) using trellis displays. It is not usually called
+directly, but is invoked by \code{\link{plot.locfit}}.
+
+The R libraries \code{lattice} and \code{grid} provide a partial
+(at time of writing) implementation of trellis. Currently, this works
+with one panel variable.
+}
+\arguments{
+ \item{x}{\code{"preplot.locfit"} object.}
+ \item{main}{title for the plot.}
+ \item{pv}{Panel variables. These are the variables (either one or two)
+ that are varied within each panel of the display.}
+ \item{tv}{Trellis variables. These are varied from panel to panel
+ of the display.}
+ \item{type}{Type of display. When there are two panel variables,
+ the choices are \code{"contour"}, \code{"level"} and
+ \code{"persp"}.}
+ \item{pred.lab}{label for the predictor variable.}
+ \item{resp.lab}{label for the response variable.}
+ \item{crit}{critical value for the confidence level.}
+ \item{...}{graphical parameters passed to \code{xyplot} or
+ \code{contourplot}.}
+}
+\seealso{
+ \code{plot.locfit},
+ \code{preplot.locfit}
+}
+
+\keyword{methods}
diff --git a/man/plot.locfit.Rd b/man/plot.locfit.Rd
new file mode 100755
index 0000000..f88e9d2
--- /dev/null
+++ b/man/plot.locfit.Rd
@@ -0,0 +1,87 @@
+\name{plot.locfit}
+\alias{plot.locfit}
+\title{
+Plot an object of class locfit.
+}
+\usage{
+\method{plot}{locfit}(x, xlim, pv, tv, m, mtv=6, band="none", tr=NULL,
+ what = "coef", get.data=FALSE, f3d=(d == 2) && (length(tv) > 0), ...)
+}
+\arguments{
+\item{x}{
+locfit object.
+}
+\item{xlim}{
+Plotting limits. Eg. \code{xlim=c(0,0,1,1)} plots over the unit square in
+two dimensions. Default is bounding box of the data.
+}
+\item{pv}{
+Panel variables, to be varied within each panel of a plot. May be
+ specified as a character vector, or variable numbers. There must be
+ one or two panel variables; default is all variables in one or two
+ dimensions; Variable 1 in three or more dimensions.
+May by specified using either variable numbers or names.
+}
+\item{tv}{
+Trellis variables, to be varied from panel to panel of the plot.
+}
+\item{m}{
+Controls the plot resolution (within panels, for trellis displays).
+Default is 100 points in one dimension; 40 points (per dimension)
+in two or more dimensions.
+}
+\item{mtv}{
+Number of points for trellis variables; default 6.
+}
+\item{band}{
+ Type of confidence bands to add to the plot. Default is \code{"none"}. Other
+ choices include \code{"global"} for bands using a global variance estimate;
+ \code{"local"} for bands using a local variance estimate and \code{"pred"}
+ for prediction bands (at present, using a global variance estimate).
+ To obtain the global variance estimate for a fit, use \code{\link{rv}}.
+ This can be changed with \code{\link{rv<-}}. Confidence bands, by default,
+ are 95\%, based on normal approximations and neglecting bias.
+ To change the critical value or confidence level, or to obtain
+ simultaneous instead of pointwise confidence,
+ the critical value stored on the fit must be changed. See the
+ \code{\link{kappa0}} and \code{\link{crit}} functions.
+}
+\item{tr}{
+Transformation function to use for plotting. Default is the inverse
+link function, or the identity function if derivatives are requested.
+}
+\item{what}{
+What to plot. See \code{\link{predict.locfit}}.
+}
+\item{get.data}{
+If \code{TRUE}, original data is added to the plot. Default: \code{FALSE}.
+}
+\item{f3d}{
+Force the \code{locfit.3d} class on the prediction object, thereby generating
+a trellis style plot. Default: \code{FALSE}, unless a \code{tv} argument is'
+provided. Not available in R.
+}
+\item{...}{
+Other arguments to \code{plot.locfit.1d}, \code{plot.locfit.2d} or
+\code{plot.locfit.3d} as appropriate.
+}}
+\description{
+The \code{plot.locfit} function generates grids of ploting points, followed
+by a call to \code{\link{preplot.locfit}}. The returned object is then
+passed to \code{\link{plot.locfit.1d}}, \code{\link{plot.locfit.2d}} or
+\code{\link{plot.locfit.3d}} as appropriate.
+}
+\examples{
+x <- rnorm(100)
+y <- dnorm(x) + rnorm(100) / 5
+plot(locfit(y~x), band="global")
+x <- cbind(rnorm(100), rnorm(100))
+plot(locfit(~x), type="persp")
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit.1d}},
+\code{\link{plot.locfit.2d}}, \code{\link{plot.locfit.3d}},
+\code{\link{lines.locfit}}, \code{\link{predict.locfit}},
+\code{\link{preplot.locfit}}
+}
+\keyword{methods}
diff --git a/man/plot.preplot.locfit.Rd b/man/plot.preplot.locfit.Rd
new file mode 100755
index 0000000..761420f
--- /dev/null
+++ b/man/plot.preplot.locfit.Rd
@@ -0,0 +1,28 @@
+\name{plot.preplot.locfit}
+\alias{plot.preplot.locfit}
+\title{
+Plot a "preplot.locfit" object.
+}
+\usage{
+\method{plot}{preplot.locfit}(x, pv, tv, ...)
+}
+\arguments{
+\item{x}{A \code{preplot.locfit} object, produced by
+\code{\link{preplot.locfit}()}.
+}
+\item{pv, tv, ...}{
+Other arguments to \code{plot.locfit.1d}, \code{plot.locfit.2d} or
+\code{plot.locfit.3d} as appropriate.
+}}
+\description{
+The \code{\link{plot.locfit}()} function is implemented, roughly, as
+a call to \code{\link{preplot.locfit}()}, followed by a call to
+\code{plot.locfitpred()}. For most users, there will be little
+need to call \code{plot.locfitpred()} directly.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}},
+\code{\link{preplot.locfit}}, \code{\link{plot.locfit.1d}},
+\code{\link{plot.locfit.2d}}, \code{\link{plot.locfit.3d}}.
+}
+\keyword{smooth}
diff --git a/man/plot.scb.Rd b/man/plot.scb.Rd
new file mode 100755
index 0000000..04c14c3
--- /dev/null
+++ b/man/plot.scb.Rd
@@ -0,0 +1,31 @@
+\name{plot.scb}
+\alias{plot.scb}
+\alias{plot.scb.1d}
+\alias{plot.scb.2d}
+\title{
+Plot method for simultaneous confidence bands
+}
+\usage{
+\method{plot}{scb}(x, add=FALSE, ...)
+}
+\description{
+ Plot method for simultaneous confidence bands created by the
+ \code{\link{scb}} function.
+}
+\arguments{
+ \item{x}{ \code{scb} object created by \code{\link{scb}}. }
+ \item{add}{If \code{TRUE}, bands will be added to the existing plot.}
+ \item{...}{Arguments passed to and from other methods.}
+
+}
+\examples{
+# corrected confidence bands for a linear logistic model
+data(insect)
+fit <- scb(deaths ~ lconc, type=4, w=nins, data=insect,
+ deg=1, family="binomial", kern="parm")
+plot(fit)
+}
+\seealso{
+\code{\link{scb}}
+}
+\keyword{methods}
diff --git a/man/plotbyfactor.Rd b/man/plotbyfactor.Rd
new file mode 100755
index 0000000..2d4bb5b
--- /dev/null
+++ b/man/plotbyfactor.Rd
@@ -0,0 +1,54 @@
+\name{plotbyfactor}
+\alias{plotbyfactor}
+\title{
+x-y scatterplot, colored by levels of a factor.
+}
+\usage{
+plotbyfactor(x, y, f, data, col = 1:10, pch = "O", add = FALSE, lg,
+ xlab = deparse(substitute(x)), ylab = deparse(substitute(y)),
+ log = "", ...)
+}
+\description{
+ Produces a scatter plot of x-y data, with different classes given
+ by a factor f. The different classes are identified by different
+ colours and/or symbols.
+}
+\arguments{
+\item{x}{
+Variable for x axis.
+}
+\item{y}{
+Variable for y axis.
+}
+\item{f}{
+Factor (or variable for which as.factor() works).
+}
+\item{data}{
+data frame for variables x, y, f. Default: sys.parent().
+}
+\item{col}{
+Color numbers to use in plot. Will be replicated if shorter than the
+number of levels of the factor f. Default: 1:10.
+}
+\item{pch}{
+Vector of plot characters. Replicated if necessary.
+Default: "O".
+}
+\item{add}{
+If \code{TRUE}, add to existing plot. Otherwise, create new plot.
+}
+\item{lg}{
+Coordinates to place a legend. Default: Missing (no legend).
+}
+\item{xlab, ylab}{Axes labels.}
+\item{log}{Should the axes be in log scale? Use \code{"x"}, \code{"y"},
+ or \code{"xy"} to specify which axis to be in log scale.}
+\item{...}{
+Other graphical parameters, labels, titles e.t.c.
+}}
+\examples{
+data(iris)
+plotbyfactor(petal.wid, petal.len, species, data=iris)
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a3.
diff --git a/man/points.locfit.Rd b/man/points.locfit.Rd
new file mode 100755
index 0000000..9f5c7eb
--- /dev/null
+++ b/man/points.locfit.Rd
@@ -0,0 +1,26 @@
+\name{points.locfit}
+\alias{points.locfit}
+\title{
+Add `locfit' points to existing plot
+}
+\usage{
+\method{points}{locfit}(x, tr, ...)
+}
+\arguments{
+\item{x}{
+\code{"locfit"} object. Should be a model with one predictor.
+}
+\item{tr}{
+Back transformation.
+}
+\item{...}{
+Other arguments to the default \code{\link{points}} function.
+}}
+\description{This function shows the points at which the local fit
+ was computed directly, rather than being interpolated. This can
+ be useful if one is unsure of the validity of interpolation.}
+\seealso{
+\code{\link{locfit}}, \code{\link{plot.locfit}}, \code{\link{points}}
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/predict.locfit.Rd b/man/predict.locfit.Rd
new file mode 100755
index 0000000..5380d8c
--- /dev/null
+++ b/man/predict.locfit.Rd
@@ -0,0 +1,44 @@
+\name{predict.locfit}
+\alias{predict.locfit}
+\title{
+Prediction from a Locfit object.
+}
+\usage{
+\method{predict}{locfit}(object, newdata=NULL, where = "fitp",
+ se.fit=FALSE, band="none", what="coef", \dots)
+}
+\description{
+ The \code{\link{locfit}} function computes a local fit at a selected set
+of points (as defined by the \code{ev} argument). The \code{predict.locfit}
+function is used to interpolate from these points to any other points.
+The method is based on cubic hermite polynomial interpolation, using the
+estimates and local slopes at each fit point.
+
+ The motivation for this two-step procedure is computational speed.
+Depending on the sample size, dimension and fitting procedure, the
+local fitting method can be expensive, and it is desirable to keep the
+number of points at which the direct fit is computed to a minimum.
+The interpolation method used by \code{predict.locfit()} is usually
+much faster, and can be computed at larger numbers of points.
+}
+\arguments{
+ \item{object}{Fitted object from \code{\link{locfit}()}.}
+ \item{newdata}{Points to predict at. Can be given in several forms:
+ vector/matrix; list, data frame.}
+ \item{se.fit}{If \code{TRUE}, standard errors are computed along with
+ the fitted values.}
+ \item{where, what, band}{arguments passed on to
+ \code{\link{preplot.locfit}}.}
+ \item{...}{Additional arguments to \code{\link{preplot.locfit}}.}
+}
+\value{
+If \code{se.fit=F}, a numeric vector of predictors.
+If \code{se.fit=T}, a list with components \code{fit}, \code{se.fit} and
+\code{residual.scale}.
+}
+\examples{
+data(ethanol, package="locfit")
+fit <- locfit(NOx ~ E, data=ethanol)
+predict(fit,c(0.6,0.8,1.0))
+}
+\keyword{smooth}
diff --git a/man/preplot.locfit.Rd b/man/preplot.locfit.Rd
new file mode 100755
index 0000000..683fd00
--- /dev/null
+++ b/man/preplot.locfit.Rd
@@ -0,0 +1,65 @@
+\name{preplot.locfit}
+\alias{preplot.locfit}
+\title{
+Prediction from a Locfit object.
+}
+\usage{
+\method{preplot}{locfit}(object, newdata=NULL, where, tr=NULL, what="coef",
+ band="none", get.data=FALSE, f3d=FALSE, \dots)
+}
+\arguments{
+ \item{object}{Fitted object from \code{\link{locfit}()}.}
+ \item{newdata}{Points to predict at. Can be given in several forms:
+ vector/matrix; list, data frame.}
+ \item{where}{An alternative to \code{newdata}. Choices include
+ \code{"grid"} for the grid \code{\link{lfmarg}(object)};
+ \code{"data"} for the original data points and \code{"fitp"} for the
+ direct fitting points (ie. no interpolation).}
+ \item{tr}{Transformation for likelihood models. Default is the inverse
+ of the link function.}
+ \item{what}{What to compute predicted values of. The default,
+ \code{what="coef"}, works with the fitted curve itself. Other
+ choices include \code{"nlx"} for the length of the weight diagram;
+ \code{"infl"} for the influence function; \code{"band"} for the
+ bandwidth; \code{"degr"} for the local polynomial degree;
+ \code{"lik"} for the maximized local likelihood; \code{"rdf"} for
+ the local residual degrees of freedom and \code{"vari"} for the
+ variance function. The interpolation algorithm for some of these
+ quantities is questionable.}
+ \item{band}{Compute standard errors for the fit and include confidence
+ bands on the returned object. Default is \code{"none"}. Other
+ choices include \code{"global"} for bands using a global variance
+ estimate; \code{"local"} for bands using a local variance estimate
+ and \code{"pred"} for prediction bands (at present, using a global
+ variance estimate). To obtain the global variance estimate for a
+ fit, use \code{\link{rv}}. This can be changed with
+ \code{\link{rv<-}}. Confidence bands, by default, are 95\%, based on
+ normal approximations and neglecting bias. To change the critical
+ value or confidence level, or to obtain simultaneous instead of
+ pointwise confidence, the critical value stored on the fit must be
+ changed. See the \code{\link{kappa0}} and \code{\link{crit}}
+ functions.}
+ \item{get.data}{If \code{TRUE}, the original data is attached to the
+ returned object, and added to the plot.}
+ \item{f3d}{If \code{TRUE}, sets a flag that forces ploting using the
+ trellis style. Not available in R.}
+ \item{\dots}{arguments passed to and from other methods.}
+}
+\value{
+An object with class \code{"preplot.locfit"}, containing the predicted
+values and additional information used to construct the plot.
+}
+\description{
+ \code{preplot.locfit} can be called directly, although it is more usual
+ to call \code{\link{plot.locfit}} or \code{\link{predict.locfit}}.
+ The advantage of \code{preplot.locfit} is in S-Plus 5, where arithmetic
+ and transformations can be performed on the \code{"preplot.locfit"}
+ object.
+
+ \code{plot(preplot(fit))} is essentially synonymous with \code{plot(fit)}.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{predict.locfit}}, \code{\link{plot.locfit}}.
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/preplot.locfit.raw.Rd b/man/preplot.locfit.raw.Rd
new file mode 100755
index 0000000..8e48f51
--- /dev/null
+++ b/man/preplot.locfit.raw.Rd
@@ -0,0 +1,39 @@
+\name{preplot.locfit.raw}
+\alias{preplot.locfit.raw}
+\title{
+Prediction from a Locfit object.
+}
+\usage{
+\method{preplot}{locfit.raw}(object, newdata, where, what, band, ...)
+}
+\arguments{
+\item{object}{
+Fitted object from \code{\link{locfit}()}.
+}
+\item{newdata}{
+New data points.
+}
+\item{where}{
+Type of data provided in \code{newdata}.
+}
+\item{what}{
+What to compute predicted values of.
+}
+\item{band}{
+ Compute standard errors for the fit and include confidence bands on
+ the returned object.}
+\item{...}{Arguments passed to and from other methods.}
+}
+\value{
+A list containing raw output from the internal prediction routines.
+}
+\description{
+ \code{preplot.locfit.raw} is an internal function used by
+ \code{\link{predict.locfit}} and \code{\link{preplot.locfit}}.
+ It should not normally be called directly.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{predict.locfit}}, \code{\link{preplot.locfit}}.
+}
+\keyword{methods}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/print.gcvplot.Rd b/man/print.gcvplot.Rd
new file mode 100755
index 0000000..13832ff
--- /dev/null
+++ b/man/print.gcvplot.Rd
@@ -0,0 +1,23 @@
+\name{print.gcvplot}
+\alias{print.gcvplot}
+\title{
+Print method for gcvplot objects
+}
+\usage{
+\method{print}{gcvplot}(x, ...)
+}
+\description{
+ Print method for \code{"gcvplot"} objects. Actually, equivalent to
+ \code{\link{plot.gcvplot}()}.
+ \code{\link{scb}} function.
+}
+\arguments{
+\item{x}{ \code{gcvplot} object. }
+ \item{...}{Arguments passed to and from other methods.}
+}
+\seealso{
+\code{\link{gcvplot}},
+\code{\link{plot.gcvplot}}
+\code{\link{summary.gcvplot}}
+}
+\keyword{methods}
diff --git a/man/print.lfeval.Rd b/man/print.lfeval.Rd
new file mode 100755
index 0000000..608df23
--- /dev/null
+++ b/man/print.lfeval.Rd
@@ -0,0 +1,28 @@
+\name{print.lfeval}
+\alias{print.lfeval}
+\title{
+Print the Locfit Evaluation Points.
+}
+\usage{
+\method{print}{lfeval}(x, ...)
+}
+\description{
+ Prints a matrix of the evaluation points from a \code{locfit}
+ or \code{lfeval} structure.
+}
+\arguments{
+ \item{x}{A \code{lfeval} or \code{locfit} object}
+ \item{...}{Arguments passed to and from other methods.}
+}
+
+\value{
+ Matrix of the fit points.
+}
+
+\seealso{
+ \code{\link{lfeval}},
+ \code{\link{locfit}},
+ \code{\link{plot.lfeval}}
+}
+
+\keyword{smooth}
diff --git a/man/print.locfit.Rd b/man/print.locfit.Rd
new file mode 100755
index 0000000..f789068
--- /dev/null
+++ b/man/print.locfit.Rd
@@ -0,0 +1,18 @@
+\name{print.locfit}
+\alias{print.locfit}
+\title{
+Print method for "locfit" object.
+}
+\usage{
+\method{print}{locfit}(x, \dots)
+}
+\description{
+Prints a short summary of a \code{"locfit"} object.
+}
+\arguments{
+\item{x}{\code{locfit} object.}
+ \item{...}{Arguments passed to and from other methods.}
+}
+\seealso{\code{\link{locfit}}}
+\keyword{methods}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/print.preplot.locfit.Rd b/man/print.preplot.locfit.Rd
new file mode 100755
index 0000000..d7e7aa8
--- /dev/null
+++ b/man/print.preplot.locfit.Rd
@@ -0,0 +1,21 @@
+\name{print.preplot.locfit}
+\alias{print.preplot.locfit}
+\title{
+Print method for preplot.locfit objects.
+}
+\usage{
+\method{print}{preplot.locfit}(x, ...)
+}
+\description{
+ Print method for objects created by the
+ \code{\link{preplot.locfit}} function.
+}
+\arguments{
+ \item{x}{ \code{"preplot.locfit"} object. }
+ \item{...}{Arguments passed to and from other methods.}
+}
+\seealso{
+\code{\link{preplot.locfit}},
+\code{\link{predict.locfit}}
+}
+\keyword{methods}
diff --git a/man/print.scb.Rd b/man/print.scb.Rd
new file mode 100755
index 0000000..21cbc3a
--- /dev/null
+++ b/man/print.scb.Rd
@@ -0,0 +1,21 @@
+\name{print.scb}
+\alias{print.scb}
+\title{
+Print method for simultaneous confidence bands
+}
+\usage{
+\method{print}{scb}(x, ...)
+}
+\description{
+ Print method for simultaneous confidence bands created by the
+ \code{\link{scb}} function.
+}
+\arguments{
+ \item{x}{ \code{"scb"} object created by \code{\link{scb}}.}
+ \item{...}{Arguments passed to and from other methods.}
+
+}
+\seealso{
+\code{\link{scb}}
+}
+\keyword{methods}
diff --git a/man/print.summary.locfit.Rd b/man/print.summary.locfit.Rd
new file mode 100755
index 0000000..6edb3de
--- /dev/null
+++ b/man/print.summary.locfit.Rd
@@ -0,0 +1,19 @@
+\name{print.summary.locfit}
+\alias{print.summary.locfit}
+\title{
+Print a Locfit summary object.
+}
+\usage{
+\method{print}{summary.locfit}(x, ...)
+}
+\description{
+ Print method for \code{"summary.locfit"} objects.
+}
+\arguments{
+ \item{x}{Object from \code{\link{summary.locfit}}.}
+ \item{...}{Arguments passed to and from methods.}
+}
+\seealso{
+\code{\link{summary.locfit}()}
+}
+\keyword{methods}
diff --git a/man/rbox.Rd b/man/rbox.Rd
new file mode 100755
index 0000000..55360a0
--- /dev/null
+++ b/man/rbox.Rd
@@ -0,0 +1,48 @@
+\name{rbox}
+\alias{rbox}
+\title{
+Local Regression, Likelihood and Density Estimation.
+}
+\usage{
+rbox(cut=0.8, type="tree", ll, ur)
+}
+\description{
+ \code{rbox()} is used to specify a rectangular box evaluation
+ structure for \code{\link{locfit.raw}()}. The structure begins
+ by generating a bounding box for the data, then recursively divides
+ the box to a desired precision.
+}
+\arguments{
+\item{type}{
+If \code{type="tree"}, the cells are recursively divided according to
+the bandwidths at each corner of the cell; see Chapter 11 of Loader (1999).
+If \code{type="kdtree"}, the K-D tree structure used in Loess
+(Cleveland and Grosse, 1991) is used.
+}
+\item{cut}{
+Precision of the tree; a smaller value of \code{cut} results in a
+larger tree with more nodes being generated.
+}
+\item{ll}{
+Lower left corner of the initial cell. Length should be the number
+of dimensions of the data provided to \code{\link{locfit.raw}()}.
+}
+\item{ur}{
+Upper right corner of the initial cell. By default, \code{ll} and
+\code{ur} are generated as the bounding box for the data.
+}
+}
+
+\examples{
+data(ethanol, package="locfit")
+plot.eval(locfit(NOx~E+C,data=ethanol,scale=0,ev=rbox(cut=0.8)))
+plot.eval(locfit(NOx~E+C,data=ethanol,scale=0,ev=rbox(cut=0.3)))
+}
+
+\references{
+Loader, C. (1999). Local Regression and Likelihood. Springer, New York.
+
+Cleveland, W. and Grosse, E. (1991). Computational Methods for Local
+ Regression. Statistics and Computing 1.
+}
+\keyword{smooth}
diff --git a/man/regband.Rd b/man/regband.Rd
new file mode 100755
index 0000000..01d2bd3
--- /dev/null
+++ b/man/regband.Rd
@@ -0,0 +1,29 @@
+\name{regband}
+\alias{regband}
+\title{
+Bandwidth selectors for local regression.
+}
+\usage{
+regband(formula, what = c("CP", "GCV", "GKK", "RSW"), deg=1, ...)
+}
+\description{
+Function to compute local regression bandwidths for local linear regression,
+implemented as a front end to \code{\link{locfit}()}.
+
+ This function is included for comparative purposes only. Plug-in
+selectors are based on flawed logic, make unreasonable and restrictive
+assumptions
+and do not use the full power of the estimates available in Locfit.
+Any relation between the results produced by this function and
+desirable estimates are entirely coincidental.
+}
+\arguments{
+\item{formula}{Model Formula (one predictor).}
+\item{what}{Methods to use.}
+\item{deg}{Degree of fit.}
+\item{...}{Other Locfit options.}
+}
+\value{
+Vector of selected bandwidths.
+}
+\keyword{htest}
diff --git a/man/residuals.locfit.Rd b/man/residuals.locfit.Rd
new file mode 100755
index 0000000..78929f3
--- /dev/null
+++ b/man/residuals.locfit.Rd
@@ -0,0 +1,29 @@
+\name{residuals.locfit}
+\alias{residuals.locfit}
+\title{
+ Fitted values and residuals for a Locfit object.
+}
+\usage{
+\method{residuals}{locfit}(object, data=NULL, type="deviance", ...)
+}
+\arguments{
+ \item{object}{\code{locfit} object.}
+ \item{data}{The data frame for the original fit. Usually, shouldn't be
+ needed.}
+ \item{type}{Type of fit or residuals to compute. The default is
+ \code{"fit"} for \code{fitted.locfit}, and \code{"dev"} for
+ \code{\link{residuals.locfit}}. Other choices include \code{"pear"}
+ for Pearson residuals; \code{"raw"} for raw residuals, \code{"ldot"}
+ for likelihood derivative; \code{"d2"} for the deviance residual
+ squared; \code{lddot} for the likelihood second derivative.
+ Generally, \code{type} should only be used when \code{what="coef"}.}
+ \item{...}{arguments passed to and from other methods.}
+}
+\description{\code{residuals.locfit} is implemented as a front-end to
+ \code{\link{fitted.locfit}}, with the \code{type} argument set.
+}
+\value{
+A numeric vector of the residuals.
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/right.Rd b/man/right.Rd
new file mode 100755
index 0000000..e558828
--- /dev/null
+++ b/man/right.Rd
@@ -0,0 +1,47 @@
+\name{right}
+\alias{right}
+\title{
+One-sided right smooth for a Locfit model.
+}
+\usage{
+right(x,...)
+}
+\description{
+ The \code{right()} function is used in a locfit model formula
+ to specify a one-sided smooth: when fitting at a point \eqn{x},
+ only data points with \eqn{x_i \le x} should be used.
+ This can be useful in estimating points of discontinuity,
+ and in cross-validation for forecasting a time series.
+ \code{right(x)} is equivalent to \code{lp(x,style="right")}.
+
+ When using this function, it will usually be necessary to specify an
+ evaluation structure, since the fit is not smooth and locfit's
+ interpolation methods are unreliable. Also, it is usually best
+ to use \code{deg=0} or \code{deg=1}, otherwise the fits may be too
+ variable. If nearest neighbor bandwidth specification is used,
+ it does not recognize \code{right()}.
+
+}
+
+\arguments{
+ \item{x}{numeric variable.}
+ \item{...}{Other arguments to \code{\link{lp}()}.}
+}
+
+\examples{
+# compute left and right smooths
+data(penny)
+xev <- (1945:1988)+0.5
+fitl <- locfit(thickness~left(year,h=10,deg=1), ev=xev, data=penny)
+fitr <- locfit(thickness~right(year, h=10, deg=1), ev=xev, data=penny)
+# plot the squared difference, to show the change points.
+plot( xev, (predict(fitr, where="ev") - predict(fitl, where="ev"))^2 )
+}
+
+\seealso{
+ %\code{\link{lfbas}},
+ \code{\link{locfit}},
+ \code{\link{left}}
+}
+
+\keyword{models}
diff --git a/man/rv.Rd b/man/rv.Rd
new file mode 100755
index 0000000..a6ec299
--- /dev/null
+++ b/man/rv.Rd
@@ -0,0 +1,35 @@
+\name{rv}
+\alias{rv}
+\title{
+Residual variance from a locfit object.
+}
+\usage{
+rv(fit)
+}
+\description{
+ As part of the \code{\link{locfit}} fitting procedure, an estimate
+of the residual variance is computed; the \code{rv} function extracts
+the variance from the \code{"locfit"} object.
+The estimate used is the residual sum of squares
+(or residual deviance, for quasi-likelihood models),
+divided by the residual degrees of freedom.
+
+For likelihood (not quasi-likelihood) models, the estimate is 1.0.
+}
+\arguments{
+\item{fit}{
+\code{"locfit"} object.
+}}
+\value{
+ Returns the residual variance estimate from the \code{"locfit"} object.
+}
+\examples{
+data(ethanol)
+fit <- locfit(NOx~E,data=ethanol)
+rv(fit)
+}
+\seealso{
+\link{locfit}, \link{rv<-}
+}
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/rva.Rd b/man/rva.Rd
new file mode 100755
index 0000000..46d53b4
--- /dev/null
+++ b/man/rva.Rd
@@ -0,0 +1,22 @@
+\name{rva}
+\alias{rv<-}
+\title{
+Substitute variance estimate on a locfit object.
+}
+\description{
+By default, Locfit uses the normalized residual sum of squares as the
+variance estimate when constructing confidence intervals.
+In some cases, the user may like to use alternative variance
+estimates; this function allows the default value to be changed.
+}
+\usage{
+rv(fit) <- value
+}
+\arguments{
+ \item{fit}{\code{"locfit"} object.}
+ \item{value}{numeric replacement value.}
+}
+\seealso{
+\link{locfit}(), \link{rv}(), \link{plot.locfit}()
+}
+\keyword{smooth}
diff --git a/man/scb.Rd b/man/scb.Rd
new file mode 100755
index 0000000..8e14e6b
--- /dev/null
+++ b/man/scb.Rd
@@ -0,0 +1,59 @@
+\name{scb}
+\alias{scb}
+\title{
+Simultaneous Confidence Bands
+}
+\usage{
+scb(x, ..., ev = lfgrid(20), simul = TRUE, type = 1)
+}
+\description{
+ \code{scb} is implemented as a front-end to \code{\link{locfit}},
+ to compute simultaneous confidence bands using the tube formula
+ method and extensions, based on Sun and Loader (1994).
+}
+\arguments{
+\item{x}{A numeric vector or matrix of predictors (as in
+ \code{\link{locfit.raw}}), or a model formula (as in
+ \code{\link{locfit}}).}
+\item{...}{Additional arguments to \code{\link{locfit.raw}}.}
+\item{ev}{The evaluation structure to use. See \code{\link{locfit.raw}}.}
+%\item{mg}{
+% The \code{scb()} function evaluates the confidence bands on a grid
+% of points, rather than the default structures used by \code{\link{locfit}}.
+% \code{mg} controls the number of grid points. Default 10.
+%}
+%\item{flim}{As in \code{\link{locfit.raw}}, this defaults to the
+% interval (or bounding box, in more than one dimension) covering
+% the data. The confidence bands are simultaneous over this interval.}
+\item{simul}{Should the coverage be simultaneous or pointwise?}
+\item{type}{Type of confidence bands. \code{type=0} computes pointwise
+ 95\% bands. \code{type=1} computes basic simultaneous bands with no
+ corrections. \code{type=2,3,4} are the centered and corrected bands
+ for parametric regression models listed in Table 3 of Sun, Loader and
+ McCormick (2000).}
+}
+\value{
+A list containing the evaluation points, fit, standard deviations and upper
+and lower confidence bounds. The class is \code{"scb"}; methods for
+printing and ploting are provided.
+}
+\seealso{
+\code{\link{locfit}}, \code{\link{print.scb}}, \code{\link{plot.scb}}.
+}
+\examples{
+# corrected confidence bands for a linear logistic model
+data(insect)
+fit <- scb(deaths~lp(lconc,deg=1), type=4, w=nins,
+ data=insect,family="binomial",kern="parm")
+plot(fit)
+}
+\references{
+Sun J. and Loader, C. (1994).
+ Simultaneous confidence bands in linear regression and smoothing.
+ \emph{The Annals of Statistics} 22, 1328-1345.
+
+Sun, J., Loader, C. and McCormick, W. (2000).
+ Confidence bands in generalized linear models.
+ \emph{The Annals of Statistics} 28, 429-460.
+}
+\keyword{smooth}
diff --git a/man/sjpi.Rd b/man/sjpi.Rd
new file mode 100755
index 0000000..2d43060
--- /dev/null
+++ b/man/sjpi.Rd
@@ -0,0 +1,57 @@
+\name{sjpi}
+\alias{sjpi}
+\title{
+Sheather-Jones Plug-in bandwidth criterion.
+}
+\usage{
+sjpi(x, a)
+}
+\description{
+ Given a dataset and set of pilot bandwidths, this function
+ computes a bandwidth via the plug-in method, and the assumed
+ `pilot' relationship of Sheather and Jones (1991).
+ The S-J method chooses the bandwidth at which the two intersect.
+
+ The purpose of this function is to demonstrate the sensitivity of
+ plug-in methods to pilot bandwidths and assumptions. This function
+ does not provide a reliable method of bandwidth selection.
+}
+\arguments{
+ \item{x}{data vector}
+ \item{a}{vector of pilot bandwidths}
+}
+\value{
+ A matrix with four columns; the number of rows equals the length of \code{a}.
+ The first column is the plug-in selected bandwidth. The second column
+ is the pilot bandwidths \code{a}. The third column is the pilot bandwidth
+ according to the assumed relationship of Sheather and Jones. The fourth
+ column is an intermediate calculation.
+}
+\examples{
+# Fig 10.2 (S-J parts) from Loader (1999).
+data(geyser, package="locfit")
+gf <- 2.5
+a <- seq(0.05, 0.7, length=100)
+z <- sjpi(geyser, a)
+
+# the plug-in curve. Multiplying by gf=2.5 corresponds to Locfit's standard
+# scaling for the Gaussian kernel.
+plot(gf*z[, 2], gf*z[, 1], type = "l", xlab = "Pilot Bandwidth k", ylab
+ = "Bandwidth h")
+
+# Add the assumed curve.
+lines(gf * z[, 3], gf * z[, 1], lty = 2)
+legend(gf*0.05, gf*0.4, lty = 1:2, legend = c("Plug-in", "SJ assumed"))
+}
+\references{
+ Sheather, S. J. and Jones, M. C. (1991). A reliable data-based bandwidth
+ selection method for kernel density estimation. JRSS-B 53, 683-690.
+}
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{locfit.raw}},
+ \code{\link{lcvplot}}
+}
+
+\keyword{htest}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/smooth.lf.Rd b/man/smooth.lf.Rd
new file mode 100755
index 0000000..0887948
--- /dev/null
+++ b/man/smooth.lf.Rd
@@ -0,0 +1,56 @@
+\name{smooth.lf}
+\alias{smooth.lf}
+\title{
+Local Regression, Likelihood and Density Estimation.
+}
+\usage{
+smooth.lf(x, y, xev=x, direct=FALSE, ...)
+}
+\description{
+ \code{smooth.lf} is a simple interface to the Locfit library.
+ The input consists of a predictor vector (or matrix) and response.
+ The output is a list with vectors of fitting points and fitted values.
+ Most \code{\link{locfit.raw}} options are valid.
+}
+\arguments{
+\item{x}{
+Vector (or matrix) of the independent variable(s).
+}
+\item{y}{
+Response variable. If omitted, \code{x} is treated as the response and
+the predictor variable is \code{1:n}.
+}
+\item{xev}{
+Fitting Points. Default is the data vector \code{x}.
+}
+\item{direct}{
+Logical variable. If \code{T}, local regression is performed directly
+at each fitting point. If \code{F}, the standard Locfit method combining
+fitting and interpolation is used.
+}
+\item{...}{
+ Other arguments to \code{\link{locfit.raw}()}.
+}
+}
+\value{
+A list with components \code{x} (fitting points) and \code{y} (fitted values).
+Also has a \code{call} component, so \code{update()} will work.
+}
+\examples{
+# using smooth.lf() to fit a local likelihood model.
+data(morths)
+fit <- smooth.lf(morths$age, morths$deaths, weights=morths$n,
+ family="binomial")
+plot(fit,type="l")
+
+# update with the direct fit
+fit1 <- update(fit, direct=TRUE)
+lines(fit1,col=2)
+print(max(abs(fit$y-fit1$y)))
+}
+\seealso{
+ \code{\link{locfit}()},
+ \code{\link{locfit.raw}()},
+ \code{\link{density.lf}()}.
+}
+\keyword{smooth}
diff --git a/man/spence.15.Rd b/man/spence.15.Rd
new file mode 100755
index 0000000..3078fb0
--- /dev/null
+++ b/man/spence.15.Rd
@@ -0,0 +1,43 @@
+\name{spence.15}
+\alias{spence.15}
+\title{
+Spencer's 15 point graduation rule.
+}
+\usage{
+spence.15(y)
+}
+\description{
+ Spencer's 15 point rule is a weighted moving average operation
+ for a sequence of observations equally spaced in time. The
+ average at time t depends on the observations at times t-7,...,t+7.
+
+ Except for boundary effects, the function will reproduce
+ polynomials up to degree 3.
+}
+\arguments{
+ \item{y}{Data vector of observations at equally spaced points.}
+}
+\value{
+ A vector with the same length as the input vector, representing
+ the graduated (smoothed) values.
+}
+\examples{
+data(spencer)
+yy <- spence.15(spencer$mortality)
+plot(spencer$age, spencer$mortality)
+lines(spencer$age, yy)
+}
+
+\seealso{
+ \code{\link{spence.21}},
+ \code{\link{spencer}},
+}
+
+\references{
+ Spencer, J. (1904).
+ On the graduation of rates of sickness and mortality.
+ Journal of the Institute of Actuaries 38, 334-343.
+}
+
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/spence.21.Rd b/man/spence.21.Rd
new file mode 100755
index 0000000..fb66475
--- /dev/null
+++ b/man/spence.21.Rd
@@ -0,0 +1,43 @@
+\name{spence.21}
+\alias{spence.21}
+\title{
+Spencer's 21 point graduation rule.
+}
+\usage{
+spence.21(y)
+}
+\description{
+ Spencer's 21 point rule is a weighted moving average operation
+ for a sequence of observations equally spaced in time. The
+ average at time t depends on the observations at times t-11,...,t+11.
+
+ Except for boundary effects, the function will reproduce
+ polynomials up to degree 3.
+}
+\arguments{
+ \item{y}{Data vector of observations at equally spaced points.}
+}
+\value{
+ A vector with the same length as the input vector, representing
+ the graduated (smoothed) values.
+}
+\examples{
+ data(spencer)
+yy <- spence.21(spencer$mortality)
+plot(spencer$age, spencer$mortality)
+lines(spencer$age, yy)
+}
+
+\seealso{
+ \code{\link{spence.15}},
+ \code{\link{spencer}},
+}
+
+\references{
+ Spencer, J. (1904).
+ On the graduation of rates of sickness and mortality.
+ Journal of the Institute of Actuaries 38, 334-343.
+}
+
+\keyword{smooth}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/spencer.Rd b/man/spencer.Rd
new file mode 100755
index 0000000..1985b67
--- /dev/null
+++ b/man/spencer.Rd
@@ -0,0 +1,20 @@
+\name{spencer}
+\alias{spencer}
+\title{Spencer's Mortality Dataset}
+\usage{data(spencer)}
+\alias{spencer}
+\format{
+ Data frame with age and mortality variables.
+}
+\description{
+ Observed mortality rates for ages 20 to 45.
+}
+\source{
+ Spencer (1904).
+}
+\references{
+ Spencer, J. (1904).
+ On the graduation of rates of sickness and mortality.
+ Journal of the Institute of Actuaries 38, 334-343.
+}
+\keyword{datasets}
diff --git a/man/stamp.Rd b/man/stamp.Rd
new file mode 100755
index 0000000..0ce5838
--- /dev/null
+++ b/man/stamp.Rd
@@ -0,0 +1,20 @@
+\name{stamp}
+\alias{stamp}
+\title{Stamp Thickness Dataset}
+\usage{data(stamp)}
+\format{
+ Data frame with \code{thick} (stamp thickness) and \code{count}
+ (number of stamps) variables.
+}
+\description{
+ Thicknesses of 482 postage stamps of the 1872 Hidalgo issue of Mexico.
+}
+\source{
+ Izenman and Sommer (1988).
+}
+\references{
+ Izenman, A. J. and Sommer, C. J. (1988).
+ Philatelic mixtures and multimodal densities.
+ Journal of the American Statistical Association 73, 602-606.
+}
+\keyword{datasets}
diff --git a/man/store.Rd b/man/store.Rd
new file mode 100755
index 0000000..2c61bda
--- /dev/null
+++ b/man/store.Rd
@@ -0,0 +1,16 @@
+\name{store}
+\alias{store}
+\title{
+Save S functions.
+}
+\usage{
+store(data=FALSE, grand=FALSE)
+}
+\description{
+ I've gotta keep track of this mess somehow!
+}
+\arguments{
+ \item{data}{whether data objects are to be saved.}
+ \item{grand}{whether everything is to be saved.}
+}
+\keyword{smooth}
diff --git a/man/summary.gcvplot.Rd b/man/summary.gcvplot.Rd
new file mode 100755
index 0000000..da88005
--- /dev/null
+++ b/man/summary.gcvplot.Rd
@@ -0,0 +1,37 @@
+\name{summary.gcvplot}
+\alias{summary.gcvplot}
+\title{
+Summary method for a gcvplot structure.
+}
+\usage{
+\method{summary}{gcvplot}(object, ...)
+}
+\description{
+ Computes a short summary for a generalized cross-validation plot structure
+}
+\arguments{
+ \item{object}{A \code{gcvplot} structure produced by a call to
+ \code{\link{gcvplot}}, \code{\link{cpplot}} e.t.c.}
+ \item{...}{arugments to and from other methods.}
+}
+
+\value{
+ A matrix with two columns; one row for each fit computed in the
+ \code{\link{gcvplot}} call.
+ The first column is the fitted degrees
+ of freedom; the second is the GCV or other criterion computed.
+}
+
+\examples{
+data(ethanol)
+summary(gcvplot(NOx~E,data=ethanol,alpha=seq(0.2,1.0,by=0.05)))
+}
+
+\seealso{
+ \code{\link{locfit}},
+ \code{\link{gcv}},
+ \code{\link{gcvplot}}
+}
+
+\keyword{methods}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/summary.locfit.Rd b/man/summary.locfit.Rd
new file mode 100755
index 0000000..114b5b3
--- /dev/null
+++ b/man/summary.locfit.Rd
@@ -0,0 +1,23 @@
+\name{summary.locfit}
+\alias{summary.locfit}
+\title{
+Print method for a locfit object.
+}
+\usage{
+\method{summary}{locfit}(object, \dots)
+}
+\description{
+Prints a short summary of a \code{"locfit"} object.
+}
+\arguments{
+ \item{object}{\code{locfit} object.}
+ \item{\dots}{arguments passed to and from methods.}
+}
+
+\value{
+A \code{summary.locfit} object, containg a short summary of the
+\code{locfit} object.
+}
+
+\keyword{methods}
+% Converted by Sd2Rd version 0.2-a5.
diff --git a/man/summary.preplot.locfit.Rd b/man/summary.preplot.locfit.Rd
new file mode 100755
index 0000000..61dd555
--- /dev/null
+++ b/man/summary.preplot.locfit.Rd
@@ -0,0 +1,24 @@
+\name{summary.preplot.locfit}
+\alias{summary.preplot.locfit}
+\title{
+Summary method for a preplot.locfit object.
+}
+\usage{
+\method{summary}{preplot.locfit}(object, ...)
+}
+\description{
+Prints a short summary of a \code{"preplot.locfit"} object.
+}
+\arguments{
+\item{object}{
+\code{preplot.locfit} object.
+}
+\item{...}{arguments passed to and from methods.}
+}
+
+\value{
+The fitted values from a
+\code{preplot.locfit} object.
+}
+
+\keyword{methods}
diff --git a/man/trimod.Rd b/man/trimod.Rd
new file mode 100755
index 0000000..a198e93
--- /dev/null
+++ b/man/trimod.Rd
@@ -0,0 +1,21 @@
+\name{trimod}
+\alias{trimod}
+\title{Generated sample from a bivariate trimodal normal mixture}
+%\usage{data(trimod)}
+\format{
+ Data frame with 225 observations and variables x0, x1.
+}
+\description{
+ This is a random sample from a mixture of three bivariate standard
+ normal components;
+ the sample was used for the examples in Loader (1996).
+}
+\source{
+ Randomly generated in S.
+}
+\references{
+ Loader, C. R. (1996).
+ Local Likelihood Density Estimation.
+ Annals of Statistics 24, 1602-1618.
+}
+\keyword{datasets}
diff --git a/man/xbar.Rd b/man/xbar.Rd
new file mode 100755
index 0000000..9608589
--- /dev/null
+++ b/man/xbar.Rd
@@ -0,0 +1,15 @@
+\name{xbar}
+\alias{xbar}
+\title{
+Locfit Evaluation Structure
+}
+\usage{
+xbar()
+}
+\description{
+ \code{xbar()} is an evaluation structure for \code{\link{locfit.raw}()},
+ evaluating the fit at a single point, namely, the average of each predictor
+ variable.
+}
+
+\keyword{smooth}
diff --git a/src/S_enter.c b/src/S_enter.c
new file mode 100755
index 0000000..eb347d4
--- /dev/null
+++ b/src/S_enter.c
@@ -0,0 +1,621 @@
+/*
+ * Copyright (c) 1996-2000 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "S.h"
+#undef WARN
+#undef ERROR
+
+#include <Rinternals.h>
+
+#include "local.h"
+extern int deitype(char *); /* in lfstr.c */
+
+
+static design des;
+static lfit lf;
+
+int lf_error;
+
+#ifdef RVERSION
+typedef char * CALL_S_FUNC;
+typedef void * CALL_S_ARGS;
+#else
+typedef void * CALL_S_FUNC;
+typedef char * CALL_S_ARGS;
+#endif
+typedef long int CALL_S_LEN;
+typedef long int CALL_S_NARG;
+typedef char * CALL_S_MODE;
+typedef long int CALL_S_NRES;
+typedef char * CALL_S_VALS;
+
+static CALL_S_FUNC bsfunc, bsf2;
+
+#ifdef OLD
+void basis(x,t,f,dim,p)
+double *x, *t, *f;
+Sint dim, p;
+{
+ CALL_S_ARGS args[2];
+ CALL_S_LEN length[2];
+ CALL_S_NARG nargs;
+ CALL_S_MODE mode[2];
+ CALL_S_NRES nres;
+ CALL_S_VALS values[1];
+ /* double z0[1], z1[1], *vptr; */
+ double *vptr;
+ int i;
+
+ args[0] = (CALL_S_ARGS)x;
+ mode[0] = "double";
+ length[0] = dim;
+
+ args[1] = (CALL_S_ARGS)t;
+ mode[1] = "double";
+ length[1] = dim;
+
+ nargs = 2;
+ nres = 1;
+
+ call_S(bsfunc,nargs,args,mode,length,(char **)NULL,nres,values);
+
+ vptr = (double *)values[0];
+ for (i=0; i<p; i++) f[i] = vptr[i];
+}
+
+void vbasis(x,t,n,d,ind,m,p,X)
+double **x, *t, *X;
+int n, d, m, p, *ind;
+{
+ CALL_S_ARGS args[MXDIM+3];
+ CALL_S_LEN length[MXDIM+3];
+ CALL_S_NARG nargs;
+ CALL_S_MODE mode[MXDIM+3];
+ CALL_S_NRES nres;
+ CALL_S_VALS values[1];
+ double *vptr;
+ int i;
+
+ args[0] = (CALL_S_ARGS)(&d);
+ mode[0] = "integer";
+ length[0] = 1;
+
+ args[1] = (CALL_S_ARGS)ind;
+ mode[1] = "integer";
+ length[1] = m;
+
+ args[2] = (CALL_S_ARGS)t;
+ mode[2] = "double";
+ length[2] = d;
+
+ for (i=0; i<d; i++)
+ { args[3+i] = (CALL_S_ARGS)x[i];
+ mode[3+i] = "double";
+ length[3+i] = n;
+ }
+
+ nargs = d+3;
+ nres = 1;
+
+ call_S(bsf2,nargs,args,mode,length,0,nres,values);
+ vptr = (double *)values[0];
+ for (i=0; i<m*p; i++) X[i] = vptr[i];
+}
+#else
+#ifdef UNUSED
+static void basis(double *x, double *t, double *f, int dim, int p)
+{
+ SEXP call, pcall, s;
+
+ PROTECT(pcall = call = allocList(3));
+ SET_TYPEOF(call, LANGSXP);
+ SETCAR(pcall, (SEXP) bsfunc);
+ pcall = CDR(pcall);
+ SETCAR(pcall, allocVector(REALSXP, dim));
+ memmove(REAL(CAR(pcall)), x, dim * sizeof(double));
+ pcall = CDR(pcall);
+ SETCAR(pcall, allocVector(REALSXP, dim));
+ memmove(REAL(CAR(pcall)), t, dim * sizeof(double));
+
+ PROTECT(s = eval(call, R_GlobalEnv));
+ memmove(f, REAL(s), p * sizeof(double));
+ UNPROTECT(2);
+}
+#endif
+
+static void
+vbasis(double **x, double *t, int n, int d, int *ind, int m, int p, double *X)
+{
+ SEXP call, pcall, s;
+
+ /* two integer args, then 1+d double args */
+ PROTECT(pcall = call = allocList(d + 5));
+ SET_TYPEOF(call, LANGSXP);
+ SETCAR(pcall, (SEXP) bsf2);
+ pcall = CDR(pcall);
+ SETCAR(pcall, ScalarInteger(d));
+ pcall = CDR(pcall);
+ SETCAR(pcall, allocVector(INTSXP, m));
+ memmove(INTEGER(CAR(pcall)), ind, m * sizeof(int));
+ pcall = CDR(pcall);
+ SETCAR(pcall, allocVector(REALSXP, d));
+ memmove(REAL(CAR(pcall)), t, d * sizeof(double));
+ for (int i = 0 ; i < d ; i++) {
+ pcall = CDR(pcall);
+ SETCAR(pcall, allocVector(REALSXP, n));
+ memmove(REAL(CAR(pcall)), x[i], n * sizeof(double));
+ }
+ PROTECT(s = eval(call, R_GlobalEnv));
+ memmove(X, REAL(s), m * p * sizeof(double));
+ UNPROTECT(2);
+}
+#endif
+
+static void setevs(evs,mi,cut,mg,flim)
+evstruc *evs;
+int *mg;
+Sint *mi;
+double cut, *flim;
+{ double *ll, *ur;
+ int i, d;
+
+ ev(evs) = mi[MEV];
+ mk(evs) = mi[MK];
+ d = mi[MDIM];
+
+ if (flim != NULL)
+ { ll = flim;
+ ur = &flim[d];
+ memmove(evs->fl,ll,d*sizeof(double));
+ memmove(&evs->fl[d],ur,d*sizeof(double));
+ }
+
+ switch(ev(evs))
+ { case ETREE:
+ case EKDTR:
+ case EKDCE:
+ case EPHULL:
+ cut(evs) = cut;
+ return;
+ case EGRID:
+ for (i=0; i<d; i++)
+ evs->mg[i] = mg[i];
+ return;
+ case ESPHR:
+ for (i=0; i<2; i++) evs->mg[i] = mg[i];
+ return;
+ case EDATA:
+ case ECROS:
+ case EPRES:
+ case EXBAR:
+ case ENONE:
+ return;
+ default:
+ printf("setevs: %2d not defined.\n",ev(evs));
+ }
+}
+
+static void setdata(lfd,x,y,c,w,b,n,d,sca,sty)
+lfdata *lfd;
+double *x, *y, *c, *w, *b, *sca;
+Sint n, d, *sty;
+{ int i;
+ for (i=0; i<d; i++)
+ { dvari(lfd,i) = &x[i*n];
+ lfd->sca[i] = sca[i];
+ lfd->sty[i] = sty[i];
+ }
+ lfd->y = y;
+ lfd->w = w;
+ lfd->b = b;
+ lfd->c = c;
+ lfd->n = n;
+ lfd->d = d;
+ lfd->ord = 0;
+}
+
+static void setsmpar(sp,dp,mi)
+smpar *sp;
+double *dp;
+Sint *mi;
+{ nn(sp) = dp[DALP];
+ fixh(sp)= dp[DFXH];
+ pen(sp) = dp[DADP];
+ ker(sp) = mi[MKER];
+ kt(sp) = mi[MKT];
+ acri(sp)= mi[MACRI];
+ deg(sp) = mi[MDEG];
+ deg0(sp) = mi[MDEG0];
+ fam(sp) = mi[MTG];
+ link(sp) = mi[MLINK];
+ ubas(sp) = mi[MUBAS];
+ npar(sp) = mi[MP];
+ lf.sp.vbasis = vbasis;
+}
+
+static void slocfit(x,y,c,w,b,lim,mi,dp,str,sca,xev,wdes,wtre,wpc,nvc,
+ iwk1, iwk2,lw,mg,L,kap,dv,nd,sty,bs)
+double *x, *y, *c, *w, *b, *lim, *dp, *sca, *xev, *L, *kap, *wdes, *wtre, *wpc;
+Sint *mi, *nvc, *iwk1, *iwk2, *lw, *mg, *dv, *nd, *sty;
+char **str;
+CALL_S_FUNC *bs;
+{ Sint n, d, i;
+
+ mi[MKER] = lfkernel(str[0]);
+ mi[MTG] = lffamily(str[1]);
+ mi[MLINK]= lflink(str[2]);
+ mi[MIT] = deitype(str[3]);
+ mi[MACRI]= lfacri(str[4]);
+ mi[MKT] = lfketype(str[5]);
+
+ if (mi[MUBAS])
+ { bsfunc = bs[0];
+ bsf2 = bs[1];
+ }
+ lf_error = 0;
+ n = mi[MN]; d = mi[MDIM];
+
+ lfit_alloc(&lf);
+ setdata(&lf.lfd,x,y,c,w,b,n,d,sca,sty);
+
+ setsmpar(&lf.sp,dp,mi);
+ setevs(&lf.evs,mi,dp[DCUT],mg,&lim[2*d]);
+
+ lf_maxit = mi[MMXIT];
+ lf_debug = mi[MDEB];
+ de_mint = mi[MMINT];
+ de_itype = mi[MIT];
+ de_renorm= mi[MREN];
+ dc(&lf.fp) = mi[MDC];
+ geth(&lf.fp)=mi[MGETH];
+
+ des.wk = wdes; des.lwk = lw[0];
+ des.ind= iwk2; des.lind = lw[6];
+ des.des_init_id = DES_INIT_ID;
+
+ lf.fp.xev = xev; lf.fp.lev = d*nvc[0];
+ lf.fp.coef= wtre; lf.fp.lwk = lw[1];
+ lf.pc.wk = wpc; lf.pc.lwk = lw[3];
+
+ lf.evs.iwk = iwk1; lf.evs.liw = lw[2];
+
+ lf.fp.L = L; lf.fp.ll = lw[4];
+
+ lf.fp.nvm = nvc[0];
+
+ lf.dv.nd = *nd;
+ for (i=0; i<lf.dv.nd; i++) lf.dv.deriv[i] = dv[i]-1;
+ if (lf_error) return;
+
+ memmove(lf.lfd.xl ,lim,2*d*sizeof(double));
+
+ if (mi[MGETH] >= 70)
+ scb(&des,&lf);
+ else switch(mi[MGETH])
+ { case GSTD: /* the standard fit */
+ case GAMF: /* for gam.lf, return residuals */
+ case GAMP: /* for gam.lf prediction */
+ if (mi[MDEG0]==mi[MDEG])
+ { startlf(&des,&lf,procv,0);
+ if (!lf_error) ressumm(&lf,&des);
+ }
+ else startlf(&des,&lf,procvvord,0);
+ break;
+ case GSMP:
+ startlf(&des,&lf,procvraw,0);
+ break;
+ case GHAT:
+ startlf(&des,&lf,procvhatm,(int)mi[MKER]!=WPARM);
+ break;
+ case GKAP:
+ constants(&des,&lf);
+ for(i=0; i<lw[5]; i++) kap[i] = lf.fp.kap[i];
+ return;
+ case GRBD:
+ rband(&des,&lf,kap,lf.dv.deriv,lf.dv.nd);
+ return;
+ case GLSC:
+ startlf(&des,&lf,procv,1);
+ dens_lscv(&des,&lf);
+ return;
+ }
+
+ nvc[0] = lf.fp.nvm;
+ nvc[1] = lf.evs.ncm;
+ nvc[3] = lf.fp.nv;
+ nvc[4] = lf.evs.nce;
+ mi[MEV]= ev(&lf.evs);
+ mi[MP] = npar(&lf.sp);
+ mi[MLINK] = link(&lf.sp);
+ mi[MPC] = haspc(&lf.pc);
+ dp[DLK] = llk(&lf.fp);
+ dp[DT0] = df0(&lf.fp);
+ dp[DT1] = df1(&lf.fp);
+ dp[DRV] = rv(&lf.fp);
+ dp[DRSC]= rsc(&lf.fp);
+ memmove(sca,lf.lfd.sca,d*sizeof(double));
+ memmove(&lim[2*d],lf.evs.fl,2*d*sizeof(double));
+ for(i=0; i<lw[5]; i++) kap[i] = lf.fp.kap[i];
+}
+
+static void recoef(xev,coef,cell,nvc,mi,dp)
+double *xev, *coef, *dp;
+Sint *cell, *nvc, *mi;
+{ int d, vc=0;
+
+ d = mi[MDIM];
+ lf.fp.nv = lf.fp.nvm = nvc[3];
+ lf.fp.xev = xev;
+ lf.fp.d = d;
+ lf.fp.coef = coef; coef += lf.fp.nv*(d+1);
+ lf.fp.nlx = coef; coef += lf.fp.nv*(d+1);
+ lf.fp.t0 = coef; coef += lf.fp.nv*(d+1);
+ lf.fp.lik = coef; coef += lf.fp.nv*3;
+ lf.fp.h = coef; coef += lf.fp.nv;
+ lf.fp.deg = coef; coef += lf.fp.nv;
+ rv(&lf.fp) = dp[DRV];
+ rsc(&lf.fp)= dp[DRSC];
+ dc(&lf.fp) = mi[MDC];
+ lf.fp.hasd = (mi[MDEG]>0) | dc(&lf.fp);
+
+ switch(mi[MEV])
+ { case ETREE:
+ case EKDTR:
+ case EGRID:
+ case ESPHR: vc = 1<<d; break;
+ case EPHULL: vc = d+1; break;
+ case EXBAR:
+ case ECROS:
+ case EDATA:
+ case EPRES:
+ case ENONE: vc=0; break;
+ default: ERROR(("spreplot: Invalid ev"));
+ }
+
+ lf.evs.ce = cell; cell += nvc[4]*vc;
+ lf.evs.s = cell; cell += MAX(nvc[3],nvc[4]);
+ lf.evs.lo = cell; cell += MAX(nvc[3],nvc[4]);
+ lf.evs.hi = cell; cell += MAX(nvc[3],nvc[4]);
+}
+
+static void spreplot(xev,coef,sv,cell,x,res,se,wpc,sca,m,nvc,mi,dp,
+ mg,dv,nd,sty,where,what,bs)
+double *xev, *coef, *sv, *x, *res, *se, *wpc, *sca, *dp;
+Sint *cell, *m, *nvc, *mi, *mg, *dv, *nd, *sty, *where;
+char **what;
+void **bs;
+{ Sint i, p;
+ double *xx[MXDIM];
+
+ for (i=0; i<mi[MDIM]; i++)
+ { lf.lfd.sty[i] = sty[i];
+ lf.lfd.sca[i] = sca[i];
+ }
+ lf.lfd.d = mi[MDIM];
+
+ setsmpar(&lf.sp,dp,mi);
+ setevs(&lf.evs,mi,dp[DCUT],mg,NULL);
+
+ if (mi[MUBAS]) bsfunc = bs[0];
+
+ lf_error = 0; p = mi[MP];
+ lf.evs.ncm = nvc[1]; lf.evs.nce = nvc[4];
+
+ recoef(xev,coef,cell,nvc,mi,dp);
+ lf.evs.sv = sv;
+
+ lf.pc.wk = wpc;
+ lf.pc.lwk = pc_reqd(mi[MDIM],p);
+ pcchk(&lf.pc,(int)mi[MDIM],p,0);
+ haspc(&lf.pc) = mi[MPC];
+ lf.pc.xtwx.st = JAC_EIGD;
+
+ /* set up the data structures right */
+ switch (*where)
+ { case 2: /* grid */
+ for (i=0; i<mi[MDIM]; i++)
+ { xx[i] = x;
+ x += m[i];
+ }
+ break;
+ case 1: /* vector */
+ case 3: /* data */
+ for (i=0; i<mi[MDIM]; i++) dvari(&(lf.lfd),i) = xx[i] = &x[i**m];
+ break;
+ case 4: /* fit points, need nothing! */
+ break;
+ default:
+ ERROR(("unknown where in spreplot"));
+ }
+
+ lf.dv.nd = *nd;
+ for (i=0; i<*nd; i++) lf.dv.deriv[i] = dv[i]-1;
+
+ if (lf_error) return;
+ preplot(&lf,xx,res,se,what[1][0],m,*where,ppwhat(what[0]));
+}
+
+static void sfitted(x,y,w,c,ba,fit,cv,st,xev,coef,sv,cell,wpc,sca,nvc,mi,dp,mg,dv,nd,sty,what,bs)
+double *x, *y, *w, *c, *ba, *fit, *xev, *coef, *sv, *wpc, *sca, *dp;
+Sint *cv, *st, *cell, *nvc, *mi, *mg, *dv, *nd, *sty;
+char **what;
+void **bs;
+{ Sint i, n;
+
+ recoef(xev,coef,cell,nvc,mi,dp);
+ setsmpar(&lf.sp,dp,mi);
+ setevs(&lf.evs,mi,dp[DCUT],mg,NULL);
+
+ if (mi[MUBAS]) bsfunc = bs[0];
+ n = mi[MN];
+ lf_error = 0;
+ lf.evs.ncm = nvc[1]; lf.evs.nce = nvc[4];
+
+ setdata(&lf.lfd,x,y,c,w,ba,mi[MN],mi[MDIM],sca,sty);
+
+ lf.evs.sv = sv;
+
+ lf.pc.wk = wpc;
+ lf.pc.lwk= pc_reqd(mi[MDIM],mi[MP],0);
+ pcchk(&lf.pc,mi[MDIM],mi[MP],0);
+ haspc(&lf.pc) = mi[MPC];
+ lf.pc.xtwx.st = JAC_EIGD;
+
+ lf.dv.nd = *nd;
+ for (i=0; i<*nd; i++) lf.dv.deriv[i] = dv[i]-1;
+
+ fitted(&lf,fit,ppwhat(what[0]),*cv,*st,restyp(what[1]));
+}
+
+static void triterm(xev,h,ce,lo,hi,sca,nvc,mi,dp,nt,term,box)
+double *xev, *h, *sca, *dp, *box;
+Sint *ce, *lo, *hi, *nvc, *mi, *nt, *term;
+{ int i, d, vc;
+ Sint mg;
+
+ lf_error = 0;
+ d = mi[MDIM];
+
+ lf.fp.xev = xev;
+ lf.fp.h = h;
+ lf.fp.d = d;
+ lf.fp.nv = lf.fp.nvm = nvc[3];
+
+ memmove(lf.lfd.sca,sca,d*sizeof(double));
+ setevs(&lf.evs,mi,dp[DCUT],&mg,NULL);
+
+ lf.evs.ce = ce;
+ lf.evs.lo = lo;
+ lf.evs.hi = hi;
+ *nt = 0;
+
+ if (mi[MEV]==ETREE)
+ atree_grow(NULL, &lf, lf.evs.ce, nt, term, box, &box[d]);
+ else
+ { vc = d+1;
+ for (i=0; i<nvc[4]; i++)
+ triang_grow(NULL,&lf,&lf.evs.ce[i*vc],nt,term);
+ }
+}
+
+void guessnv(lw,evt,dp,mi,nvc,mg)
+double *dp;
+char **evt;
+int *lw, *mi, *nvc, *mg;
+{ int n, d, i, nvm, ncm, vc;
+ smpar sp;
+ evstruc evs;
+
+ mi[MEV] = ev(&evs) = lfevstr(evt[0]);
+ mi[MKT] = lfketype(evt[1]);
+ mk(&evs) = mi[MK];
+ d = mi[MDIM];
+ n = mi[MN];
+
+ switch(mi[MEV])
+ { case ETREE:
+ cut(&evs) = dp[DCUT];
+ atree_guessnv(&evs,&nvm,&ncm,&vc,d,dp[DALP]);
+ break;
+ case EPHULL:
+ nvm = ncm = mi[MK]*mi[MDIM];
+ vc = mi[MDIM]+1;
+ break;
+ case EDATA:
+ case ECROS:
+ nvm = mi[MN];
+ ncm = vc = 0;
+ break;
+ case EKDTR:
+ case EKDCE:
+ cut(&evs) = dp[DCUT];
+ kdtre_guessnv(&evs,&nvm,&ncm,&vc,n,d,dp[DALP]);
+ break;
+ case EGRID:
+ nvm = 1;
+ for (i=0; i<d; i++) nvm *= mg[i];
+ ncm = 0;
+ vc = 1<<d;
+ break;
+ case EXBAR:
+ case ENONE:
+ nvm = 1;
+ ncm = vc = 0;
+ break;
+ case EPRES:
+ nvm = mg[0];
+ ncm = vc = 0;
+ break;
+ default:
+ ERROR(("guessnv: I don't know this evaluation structure."));
+ }
+
+ ubas(&sp)= mi[MUBAS];
+ deg(&sp) = mi[MDEG];
+ kt(&sp) = mi[MKT];
+ npar(&sp)= mi[MDEG]; /* for user basis */
+ mi[MP] = calcp(&sp,d);
+ lw[0] = des_reqd(n,(int)mi[MP]);
+ lw[1] = lfit_reqd(d,nvm,ncm,(int)mi[MGETH]);
+ lw[2] = lfit_reqi(nvm,ncm,vc);
+ lw[6] = des_reqi(n,(int)mi[MP]);
+ lw[3] = pc_reqd(d,(int)mi[MP]);
+ lw[5] = 1;
+
+ if (mi[MGETH] >= 70)
+ { lw[4] = k0_reqd(d,n,0);
+ if (lw[4]<2*nvm) lw[4] = 2*nvm;
+ lw[5] = d+1;
+ }
+ else switch(mi[MGETH])
+ { case GSTD: lw[4] = 1; break; /* standard fit */
+ case GSMP: lw[4] = 1; break; /* simple fit */
+ case GHAT: lw[4] = nvm*n; break; /* hat matrix */
+ case GKAP: lw[4] = k0_reqd(d,n,0); /* kappa0 */
+ lw[5] = 1+d;
+ break;
+ case GRBD: lw[5] = 10; /* regband */
+ case GAMF: /* gam.lf fit */
+ case GAMP: lw[4] = 1; break; /* gam.lf pred */
+ case GLSC: lw[4] = 2; break; /* lscv */
+ default:
+ printf("sguessnv: invalid geth\n");
+ lw[4] = 0;
+ }
+
+ nvc[0] = nvm;
+ nvc[1] = ncm;
+ nvc[2] = vc;
+ nvc[3] = nvc[4] = 0;
+
+}
+
+/* Registration added Mar 2012 */
+#include <R_ext/Rdynload.h>
+
+/* From smisc.c */
+void kdeb(double *x, int *mi, double*band, int *ind, double *h0, double *h1,
+ int *meth, int *nmeth, int *ker);
+void scritval(double *k0, int *d, double *cov, int *m, double *rdf,
+ double *z, int *k);
+void slscv(double *x, int *n, double *h, double *z);
+
+static const R_CMethodDef CEntries[] = {
+ {"guessnv", (DL_FUNC) &guessnv, 6},
+ {"slocfit", (DL_FUNC) &slocfit, 25},
+ {"sfitted", (DL_FUNC) &sfitted, 23},
+ {"spreplot", (DL_FUNC) &spreplot, 20},
+ {"triterm", (DL_FUNC) &triterm, 12},
+ {"kdeb", (DL_FUNC) &kdeb, 9},
+ {"slscv", (DL_FUNC) &slscv, 4},
+ {"scritval", (DL_FUNC) &scritval, 7},
+ {NULL, NULL, 0}
+};
+
+void R_init_locfit(DllInfo *dll)
+{
+ R_registerRoutines(dll, CEntries, NULL, NULL, NULL);
+ R_useDynamicSymbols(dll, FALSE);
+}
diff --git a/src/band.c b/src/band.c
new file mode 100755
index 0000000..7966b4a
--- /dev/null
+++ b/src/band.c
@@ -0,0 +1,347 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+extern void fitoptions();
+
+static double hmin, gmin, sig2, pen, vr, tb;
+static lfit *blf;
+static design *bdes;
+
+int procvbind(des,lf,v)
+design *des;
+lfit *lf;
+int v;
+{ double s0, s1, bi;
+ int i, ii, k;
+ k = procvraw(des,lf,v);
+ wdiag(&lf->lfd, &lf->sp, des,des->wd,&lf->dv,0,1,0);
+ s0 = s1 = 0.0;
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ s0+= prwt(&lf->lfd,ii)*des->wd[i]*des->wd[i];
+ bi = prwt(&lf->lfd,ii)*fabs(des->wd[i]*ipower(des->di[ii],deg(&lf->sp)+1));
+ s1+= bi*bi;
+ }
+ vr += s0;
+ tb += s1;
+ return(k);
+}
+
+double bcri(h,c,cri)
+double h;
+int c, cri;
+{ double num, den;
+ int (*pv)();
+ if (c==DALP)
+ blf->sp.nn = h;
+ else
+ blf->sp.fixh = h;
+ if ((cri&63)==BIND)
+ { pv = procvbind;
+ vr = tb = 0.0;
+ }
+ else pv = procv;
+ if (cri<64) startlf(bdes,blf,pv,0);
+ switch(cri&63)
+ { case BGCV:
+ ressumm(blf,bdes);
+ num = -2*blf->lfd.n*llk(&blf->fp);
+ den = blf->lfd.n-df0(&blf->fp);
+ return(num/(den*den));
+ case BCP:
+ ressumm(blf,bdes);
+ return(-2*llk(&blf->fp)/sig2-blf->lfd.n+pen*df0(&blf->fp));
+ case BIND:
+ return(vr+pen*pen*tb);
+ }
+ ERROR(("bcri: unknown criterion"));
+ return(0.0);
+}
+
+void bsel2(h0,g0,ifact,c,cri)
+double h0, g0, ifact;
+int c, cri;
+{ int done, inc;
+ double h1, g1;
+ h1 = h0; g1 = g0;
+ done = inc = 0;
+ while (!done)
+ { h1 *= 1+ifact;
+ g0 = g1;
+ g1 = bcri(h1,c,cri);
+ if (g1<gmin) { hmin = h1; gmin = g1; }
+ if (g1>g0) inc++; else inc = 0;
+ switch(cri)
+ { case BIND:
+ done = (inc>=4) & (vr<blf->fp.nv);
+ break;
+ default:
+ done = (inc>=4);
+ }
+ }
+}
+
+void bsel3(h0,g0,ifact,c,cri)
+double h0, g0, ifact;
+int c, cri;
+{ double h1, g1;
+ int i;
+ hmin = h0; gmin = g0;
+ for (i=-1; i<=1; i++) if (i!=0)
+ { h1 = h0*(1+i*ifact);
+ g1 = bcri(h1,c,cri);
+ if (g1<gmin) { hmin = h1; gmin = g1; }
+ }
+ return;
+}
+
+void bselect(lf,des,c,cri,pn)
+lfit *lf;
+design *des;
+int c, cri;
+double pn;
+{ double h0, g0, ifact;
+ int i;
+ pen = pn;
+ blf = lf;
+ bdes = des;
+ if (cri==BIND) pen /= factorial(deg(&lf->sp)+1);
+ hmin = h0 = (c==DFXH) ? fixh(&lf->sp) : nn(&lf->sp);
+ if (h0==0) ERROR(("bselect: initial bandwidth is 0"));
+ if (lf_error) return;
+ sig2 = 1.0;
+
+ gmin = g0 = bcri(h0,c,cri);
+ if (cri==BCP)
+ { sig2 = rv(&lf->fp);
+ g0 = gmin = bcri(h0,c,cri+64);
+ }
+
+ ifact = 0.3;
+ bsel2(h0,g0,ifact,c,cri);
+
+ for (i=0; i<5; i++)
+ { ifact = ifact/2;
+ bsel3(hmin,gmin,ifact,c,cri);
+ }
+ if (c==DFXH)
+ fixh(&lf->sp) = hmin;
+ else
+ nn(&lf->sp) = hmin;
+ startlf(des,lf,procv,0);
+ ressumm(lf,des);
+}
+
+double compsda(x,h,n)
+double *x, h;
+int n;
+/* n/(n-1) * int( fhat''(x)^2 dx ); bandwidth h */
+{ int i, j;
+ double ik, sd, z;
+ ik = wint(1,NULL,0,WGAUS);
+ sd = 0;
+
+ for (i=0; i<n; i++)
+ for (j=i; j<n; j++)
+ { z = (x[i]-x[j])/h;
+ sd += (2-(i==j))*Wconv4(z,WGAUS)/(ik*ik);
+ }
+ sd = sd/(n*(n-1)*h*h*h*h*h);
+ return(sd);
+}
+
+double widthsj(x,lambda,n)
+double *x, lambda;
+int n;
+{ double ik, a, b, td, sa, z, c, c1, c2, c3;
+ int i, j;
+ a = GFACT*0.920*lambda*exp(-log((double)n)/7)/SQRT2;
+ b = GFACT*0.912*lambda*exp(-log((double)n)/9)/SQRT2;
+ ik = wint(1,NULL,0,WGAUS);
+
+ td = 0;
+ for (i=0; i<n; i++)
+ for (j=i; j<n; j++)
+ { z = (x[i]-x[j])/b;
+ td += (2-(i==j))*Wconv6(z,WGAUS)/(ik*ik);
+ }
+
+ td = -td/(n*(n-1));
+ j = 2.0;
+ c1 = Wconv4(0.0,WGAUS);
+ c2 = wint(1,&j,1,WGAUS);
+ c3 = Wconv(0.0,WGAUS); /* (2*c1/(c2*c3))^(1/7)=1.357 */
+ sa = compsda(x,a,n);
+ c = b*exp(log(c1*ik/(c2*c3*GFACT*GFACT*GFACT*GFACT)*sa/td)/7)*SQRT2;
+ return(c);
+}
+
+void kdecri(x,h,res,c,k,ker,n)
+double *x, h, *res, c;
+int k, ker, n;
+{ int i, j;
+ double degfree, dfd, pen, s, r0, r1, d0, d1, ik, wij;
+
+ if (h<=0) WARN(("kdecri, h = %6.4f",h));
+
+ res[0] = res[1] = 0.0;
+ ik = wint(1,NULL,0,ker);
+ switch(k)
+ { case 1: /* aic */
+ pen = 2.0;
+ for (i=0; i<n; i++)
+ { r0 = d0 = 0.0;
+ for (j=0; j<n; j++)
+ { s = (x[i]-x[j])/h;
+ r0 += W(s,ker);
+ d0 += s*s*Wd(s,ker);
+ }
+ d0 = -(d0+r0)/(n*h*h*ik); /* d0 = d/dh fhat(xi) */
+ r0 /= n*h*ik; /* r0 = fhat(xi) */
+ res[0] += -2*log(r0)+pen*W(0.0,ker)/(n*h*ik*r0);
+ res[1] += -2*d0/r0-pen*W(0.0,ker)/(n*h*ik*r0)*(d0/r0+1.0/h);
+ }
+ return;
+ case 2: /* ocv */
+ for (i=0; i<n; i++)
+ { r0 = 0.0; d0 = 0.0;
+ for (j=0; j<n; j++) if (i!=j)
+ { s = (x[i]-x[j])/h;
+ r0 += W(s,ker);
+ d0 += s*s*Wd(s,ker);
+ }
+ d0 = -(d0+r0)/((n-1)*h*h);
+ r0 = r0/((n-1)*h);
+ res[0] -= log(r0);
+ res[1] -= d0/r0;
+ }
+ return;
+ case 3: /* lscv */
+ r0 = r1 = d0 = d1 = degfree = 0.0;
+ for (i=0; i<n; i++)
+ { dfd = 0.0;
+ for (j=0; j<n; j++)
+ { s = (x[i]-x[j])/h;
+ wij = W(s,ker);
+ dfd += wij;
+/*
+ * r0 = \int fhat * fhat = sum_{i,j} W*W( (Xi-Xj)/h ) / n^2 h.
+ * d0 is it's derivative wrt h.
+ *
+ * r1 = 1/n sum( f_{-i}(X_i) ).
+ * d1 is it's derivative wrt h.
+ *
+ * degfree = sum_i ( W_0 / sum_j W( (Xi-Xj)/h ) ) is fitted d.f.
+ */
+ r0 += Wconv(s,ker);
+ d0 += -s*s*Wconv1(s,ker);
+ if (i != j)
+ { r1 += wij;
+ d1 += -s*s*Wd(s,ker);
+ }
+ }
+ degfree += 1.0/dfd;
+ }
+ d1 -= r1;
+ d0 -= r0;
+ res[0] = r0/(n*n*h*ik*ik) - 2*r1/(n*(n-1)*h*ik);
+ res[1] = d0/(n*n*h*h*ik*ik) - 2*d1/(n*(n-1)*h*h*ik);
+ res[2] = degfree;
+ return;
+ case 4: /* bcv */
+ r0 = d0 = 0.0;
+ for (i=0; i<n; i++)
+ for (j=i+1; j<n; j++)
+ { s = (x[i]-x[j])/h;
+ r0 += 2*Wconv4(s,ker);
+ d0 += 2*s*Wconv5(s,ker);
+ }
+ d0 = (-d0-r0)/(n*n*h*h*ik*ik);
+ r0 = r0/(n*n*h*ik*ik);
+ j = 2.0;
+ d1 = wint(1,&j,1,ker);
+ r1 = Wconv(0.0,ker);
+ res[0] = (d1*d1*r0/4+r1/(n*h))/(ik*ik);
+ res[1] = (d1*d1*d0/4-r1/(n*h*h))/(ik*ik);
+ return;
+ case 5: /* sjpi */
+ s = c*exp(5*log(h)/7)/SQRT2;
+ d0 = compsda(x,s,n);
+ res[0] = d0; /* this is S(alpha) in SJ */
+ res[1] = exp(log(Wikk(WGAUS,0)/(d0*n))/5)-h;
+ return;
+ case 6: /* gas-k-k */
+ s = exp(log(1.0*n)/10)*h;
+ d0 = compsda(x,s,n);
+ res[0] = d0;
+ res[1] = exp(log(Wikk(WGAUS,0)/(d0*n))/5)-h;
+ return;
+ }
+ ERROR(("kdecri: what???"));
+ return;
+}
+
+double esolve(x,j,h0,h1,k,c,ker,n)
+double *x, h0, h1, c;
+int j, k, ker, n;
+{ double h[7], d[7], r[7], res[4], min, minh, fact;
+ int i, nc;
+ for ( i = 0; i < 7; ++i) {
+ h[i] = 0.0;
+ d[i] = 0.0;
+ r[i] = 0.0;
+ }
+ for ( i = 0; i < 4; ++i) res[i] = 0.0;
+ min = 1.0e30; minh = 0.0;
+ fact = 1.00001;
+ h[6] = h0; kdecri(x,h[6],res,c,j,ker,n);
+ r[6] = res[0]; d[6] = res[1];
+ if (lf_error) return(0.0);
+ nc = 0;
+ for (i=0; i<k; i++)
+ { h[5] = h[6]; r[5] = r[6]; d[5] = d[6];
+ h[6] = h0*exp((i+1)*log(h1/h0)/k);
+ kdecri(x,h[6],res,c,j,ker,n);
+ r[6] = res[0]; d[6] = res[1];
+ if (lf_error) return(0.0);
+ if (d[5]*d[6]<0)
+ { h[2] = h[0] = h[5]; d[2] = d[0] = d[5]; r[2] = r[0] = r[5];
+ h[3] = h[1] = h[6]; d[3] = d[1] = d[6]; r[3] = r[1] = r[6];
+ while ((h[3]>fact*h[2])|(h[2]>fact*h[3]))
+ { h[4] = h[3]-d[3]*(h[3]-h[2])/(d[3]-d[2]);
+ if ((h[4]<h[0]) | (h[4]>h[1])) h[4] = (h[0]+h[1])/2;
+ kdecri(x,h[4],res,c,j,ker,n);
+ r[4] = res[0]; d[4] = res[1];
+ if (lf_error) return(0.0);
+ h[2] = h[3]; h[3] = h[4];
+ d[2] = d[3]; d[3] = d[4];
+ r[2] = r[3]; r[3] = r[4];
+ if (d[4]*d[0]>0) { h[0] = h[4]; d[0] = d[4]; r[0] = r[4]; }
+ else { h[1] = h[4]; d[1] = d[4]; r[1] = r[4]; }
+ }
+ if (j>=4) return(h[4]); /* first min for BCV etc */
+ if (r[4]<=min) { min = r[4]; minh = h[4]; }
+ nc++;
+ }
+ }
+ if (nc==0) minh = (r[5]<r[6]) ? h0 : h1;
+ return(minh);
+}
+
+void kdeselect(band,x,ind,h0,h1,meth,nm,ker,n)
+double h0, h1, *band, *x;
+Sint *ind;
+int nm, ker, n, *meth;
+{ double scale, c;
+ int i, k;
+ k = n/4;
+ for (i=0; i<n; i++) ind[i] = i;
+ scale = kordstat(x,n+1-k,n,ind) - kordstat(x,k,n,ind);
+ c = widthsj(x,scale,n);
+ for (i=0; i<nm; i++)
+ band[i] = esolve(x,meth[i],h0,h1,10,c,ker,n);
+}
diff --git a/src/cversion.h b/src/cversion.h
new file mode 100755
index 0000000..5f5c661
--- /dev/null
+++ b/src/cversion.h
@@ -0,0 +1,134 @@
+/*
+ * Copyright (c) 1998-2000 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Structures and function definitions for the C version interface.
+ */
+
+/* typedef char varname[15]; */
+
+/*
+ * Define the vari type for locfit variables and related macros.
+ */
+
+typedef struct {
+ varname name;
+ int n, bytes, mode, stat;
+ double *dpr; } vari;
+
+#define checkvarlen(v,n,name,mode) (createvar(name,STSYSTEM,n,mode))
+#define vmode(v) ((v)->mode)
+#define vlength(v) ((v)->n)
+
+typedef struct {
+ char *arg, *val;
+ vari *result;
+ int used; } carg;
+
+typedef struct {
+ void (*AddColor)(), (*SetColor)(), (*ClearScreen)(), (*TextDim)(), (*DoText)();
+ void (*DrawPoint)(), (*DrawLine)(), (*DrawPatch)(), (*wrapup)();
+ int (*makewin)(), ticklength, defth, deftw;
+} device;
+
+typedef struct {
+ vari *data[MXDIM], *fit, *se;
+ int d, wh, gr;
+} pplot;
+
+typedef struct {
+ char cmd;
+ double x, *v, (*f)();
+ int m, nx[3];
+ vari *vv; } arstruct;
+
+typedef struct {
+ vari *x, *y, *z;
+ char type;
+ int id, t, n, nx, ny, pch; } plxyz;
+
+typedef struct {
+ double theta, phi, xl[2], yl[2], zl[2], sl[10];
+ int id, ty, nsl;
+ char main[50], xlab[50], ylab[50], zlab[50];
+ vari *track, *xyzs; } plots;
+
+#define PLNONE 0
+#define PLDATA 1
+#define PLFIT 2
+#define PLTRK 4
+
+struct lfcol {
+ char name[10];
+ int n, r, g, b;
+};
+
+
+/* FILES IN THE src-c DIRECTORY */
+
+/* arith.c */
+extern int arvect(), intitem();
+extern double areval(), arith(), darith(), dareval();
+extern vari *varith(), *saveresult(), *arbuild();
+
+/* c_args.c */
+#define argused(v,i) (((carg *)viptr(v,i))->used)
+#define setused(v,i) { ((carg *)viptr(v,i))->used = 1; }
+#define setunused(v,i) { ((carg *)viptr(v,i))->used = 0; }
+#define argarg(v,i) (((carg *)viptr(v,i))->arg)
+#define argvalis(v,i,z) (strcmp(argval(v,i),z)==0)
+extern char *argval(), *getargval();
+extern int getarg(), readilist(), getlogic();
+
+/* cmd.c */
+extern int dispatch();
+extern void setuplf(), recondat(), cmdint();
+extern double backtr(), docrit();
+
+/* c_lf.c */
+extern vari *vfitted();
+extern void cfitted(), cwdiag();
+
+/* c_plot.c */
+extern void plotdata(), plotfit(), plottrack(), plotopt(), setplot();
+
+/* help.c */
+extern void example();
+
+/* lfd.c */
+extern void doreaddata(), dosavedata(), dosavefit();
+extern int setfilename();
+
+/* main.c */
+extern void SetWinDev();
+
+/* makecmd.c */
+extern vari *getcmd();
+extern void makecmd(), del_lines(), inc_forvar(), dec_forvar();
+
+/* post.c */
+extern void SetPSDev();
+
+/* pout.c */
+extern int pretty();
+extern void displayplot();
+extern void plotmaple(), plotmathe(), plotmatlb(), plotgnup(), plotxwin();
+
+/* random.c */
+extern double rnorm(), rexp(), runif(), rpois();
+extern void rseed();
+
+/* readfile.c */
+extern void readfile();
+
+/* scbmax.c */
+extern void cscbmax();
+
+/* vari.c */
+extern int vbytes();
+extern vari *createvar(), *findvar(), *growvar();
+extern void initdb(), deletevar(), deletename(), deleteifhidden(), setvarname();
+extern void *viptr(), vassn();
+extern double *vdptr(), vitem();
diff --git a/src/dbinom.c b/src/dbinom.c
new file mode 100755
index 0000000..7fb83be
--- /dev/null
+++ b/src/dbinom.c
@@ -0,0 +1,353 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include <math.h>
+#include "mutil.h"
+
+/* stirlerr(n) = log(n!) - log( sqrt(2*pi*n)*(n/e)^n ) */
+
+#define S0 0.083333333333333333333 /* 1/12 */
+#define S1 0.00277777777777777777778 /* 1/360 */
+#define S2 0.00079365079365079365079365 /* 1/1260 */
+#define S3 0.000595238095238095238095238 /* 1/1680 */
+#define S4 0.0008417508417508417508417508 /* 1/1188 */
+
+/*
+ error for 0, 0.5, 1.0, 1.5, ..., 14.5, 15.0.
+*/
+static double sferr_halves[31] = {
+0.0, /* n=0 - wrong, place holder only */
+0.1534264097200273452913848, /* 0.5 */
+0.0810614667953272582196702, /* 1.0 */
+0.0548141210519176538961390, /* 1.5 */
+0.0413406959554092940938221, /* 2.0 */
+0.03316287351993628748511048, /* 2.5 */
+0.02767792568499833914878929, /* 3.0 */
+0.02374616365629749597132920, /* 3.5 */
+0.02079067210376509311152277, /* 4.0 */
+0.01848845053267318523077934, /* 4.5 */
+0.01664469118982119216319487, /* 5.0 */
+0.01513497322191737887351255, /* 5.5 */
+0.01387612882307074799874573, /* 6.0 */
+0.01281046524292022692424986, /* 6.5 */
+0.01189670994589177009505572, /* 7.0 */
+0.01110455975820691732662991, /* 7.5 */
+0.010411265261972096497478567, /* 8.0 */
+0.009799416126158803298389475, /* 8.5 */
+0.009255462182712732917728637, /* 9.0 */
+0.008768700134139385462952823, /* 9.5 */
+0.008330563433362871256469318, /* 10.0 */
+0.007934114564314020547248100, /* 10.5 */
+0.007573675487951840794972024, /* 11.0 */
+0.007244554301320383179543912, /* 11.5 */
+0.006942840107209529865664152, /* 12.0 */
+0.006665247032707682442354394, /* 12.5 */
+0.006408994188004207068439631, /* 13.0 */
+0.006171712263039457647532867, /* 13.5 */
+0.005951370112758847735624416, /* 14.0 */
+0.005746216513010115682023589, /* 14.5 */
+0.005554733551962801371038690 /* 15.0 */
+};
+
+double stirlerr(n)
+double n;
+{ double nn;
+
+ if (n<15.0)
+ { nn = 2.0*n;
+ if (nn==(int)nn) return(sferr_halves[(int)nn]);
+ return(lgamma(n+1.0) - (n+0.5)*log((double)n)+n - HF_LG_PIx2);
+ }
+
+ nn = (double)n;
+ nn = nn*nn;
+ if (n>500) return((S0-S1/nn)/n);
+ if (n>80) return((S0-(S1-S2/nn)/nn)/n);
+ if (n>35) return((S0-(S1-(S2-S3/nn)/nn)/nn)/n);
+ return((S0-(S1-(S2-(S3-S4/nn)/nn)/nn)/nn)/n);
+}
+
+double bd0(x,np)
+double x, np;
+{ double ej, s, s1, v;
+ int j;
+ if (fabs(x-np)<0.1*(x+np))
+ {
+ s = (x-np)*(x-np)/(x+np);
+ v = (x-np)/(x+np);
+ ej = 2*x*v; v = v*v;
+ for (j=1; ;++j)
+ { ej *= v;
+ s1 = s+ej/((j<<1)+1);
+ if (s1==s) return(s1);
+ s = s1;
+ }
+ }
+ return(x*log(x/np)+np-x);
+}
+
+/*
+ Raw binomial probability calculation.
+ (1) This has both p and q arguments, when one may be represented
+ more accurately than the other (in particular, in df()).
+ (2) This should NOT check that inputs x and n are integers. This
+ should be done in the calling function, where necessary.
+ (3) Does not check for 0<=p<=1 and 0<=q<=1 or NaN's. Do this in
+ the calling function.
+*/
+double dbinom_raw(x,n,p,q,give_log)
+double x, n, p, q;
+int give_log;
+{ double f, lc;
+
+ if (p==0.0) return((x==0) ? D_1 : D_0);
+ if (q==0.0) return((x==n) ? D_1 : D_0);
+
+ if (x==0)
+ { lc = (p<0.1) ? -bd0(n,n*q) - n*p : n*log(q);
+ return( DEXP(lc) );
+ }
+
+ if (x==n)
+ { lc = (q<0.1) ? -bd0(n,n*p) - n*q : n*log(p);
+ return( DEXP(lc) );
+ }
+
+ if ((x<0) | (x>n)) return( D_0 );
+
+ lc = stirlerr(n) - stirlerr(x) - stirlerr(n-x)
+ - bd0(x,n*p) - bd0(n-x,n*q);
+ f = (PIx2*x*(n-x))/n;
+
+ return( FEXP(f,lc) );
+}
+
+double dbinom(x,n,p,give_log)
+int x, n;
+double p;
+int give_log;
+{
+ if ((p<0) | (p>1) | (n<0)) return(INVALID_PARAMS);
+ if (x<0) return( D_0 );
+
+ return( dbinom_raw((double)x,(double)n,p,1-p,give_log) );
+}
+
+/*
+ Poisson probability lb^x exp(-lb) / x!.
+ I don't check that x is an integer, since other functions
+ that call dpois_raw() (i.e. dgamma) may use a fractional
+ x argument.
+*/
+double dpois_raw(x,lambda,give_log)
+int give_log;
+double x, lambda;
+{
+ if (lambda==0) return( (x==0) ? D_1 : D_0 );
+ if (x==0) return( DEXP(-lambda) );
+ if (x<0) return( D_0 );
+
+ return(FEXP( PIx2*x, -stirlerr(x)-bd0(x,lambda) ));
+}
+
+double dpois(x,lambda,give_log)
+int x, give_log;
+double lambda;
+{
+ if (lambda<0) return(INVALID_PARAMS);
+ if (x<0) return( D_0 );
+
+ return( dpois_raw((double)x,lambda,give_log) );
+}
+
+double dbeta(x,a,b,give_log)
+double x, a, b;
+int give_log;
+{ double f, p;
+
+ if ((a<=0) | (b<=0)) return(INVALID_PARAMS);
+ if ((x<=0) | (x>=1)) return(D_0);
+
+ if (a<1)
+ { if (b<1) /* a<1, b<1 */
+ { f = a*b/((a+b)*x*(1-x));
+ p = dbinom_raw(a,a+b,x,1-x,give_log);
+ }
+ else /* a<1, b>=1 */
+ { f = a/x;
+ p = dbinom_raw(a,a+b-1,x,1-x,give_log);
+ }
+ }
+ else
+ { if (b<1) /* a>=1, b<1 */
+ { f = b/(1-x);
+ p = dbinom_raw(a-1,a+b-1,x,1-x,give_log);
+ }
+ else /* a>=1, b>=1 */
+ { f = a+b-1;
+ p = dbinom_raw(a-1,(a-1)+(b-1),x,1-x,give_log);
+ }
+ }
+
+ return( (give_log) ? p + log(f) : p*f );
+}
+
+/*
+ * To evaluate the F density, write it as a Binomial probability
+ * with p = x*m/(n+x*m). For m>=2, use the simplest conversion.
+ * For m<2, (m-2)/2<0 so the conversion will not work, and we must use
+ * a second conversion. Note the division by p; this seems unavoidable
+ * for m < 2, since the F density has a singularity as x (or p) -> 0.
+ */
+double df(x,m,n,give_log)
+double x, m, n;
+int give_log;
+{ double p, q, f, dens;
+
+ if ((m<=0) | (n<=0)) return(INVALID_PARAMS);
+ if (x <= 0.0) return(D_0);
+
+ f = 1.0/(n+x*m);
+ q = n*f;
+ p = x*m*f;
+
+ if (m>=2)
+ { f = m*q/2;
+ dens = dbinom_raw((m-2)/2.0, (m+n-2)/2.0, p, q, give_log);
+ }
+ else
+ { f = m*m*q / (2*p*(m+n));
+ dens = dbinom_raw(m/2.0, (m+n)/2.0, p, q, give_log);
+ }
+
+ return((give_log) ? log(f)+dens : f*dens);
+}
+
+/*
+ * Gamma density,
+ * lb^r x^{r-1} exp(-lb*x)
+ * p(x;r,lb) = -----------------------
+ * (r-1)!
+ *
+ * If USE_SCALE is defined below, the lb argument will be interpreted
+ * as a scale parameter (i.e. replace lb by 1/lb above). Otherwise,
+ * it is interpreted as a rate parameter, as above.
+ */
+
+/* #define USE_SCALE */
+
+double dgamma(x,r,lambda,give_log)
+int give_log;
+double x, r, lambda;
+{ double pr;
+
+ if ((r<=0) | (lambda<0)) return(INVALID_PARAMS);
+ if (x<=0.0) return( D_0 );
+
+#ifdef USE_SCALE
+ lambda = 1.0/lambda;
+#endif
+
+ if (r<1)
+ { pr = dpois_raw(r,lambda*x,give_log);
+ return( (give_log) ? pr + log(r/x) : pr*r/x );
+ }
+
+ pr = dpois_raw(r-1.0,lambda*x,give_log);
+ return( (give_log) ? pr + log(lambda) : lambda*pr);
+}
+
+double dchisq(x, df, give_log)
+double x, df;
+int give_log;
+{
+ return(dgamma(x, df/2.0,
+ 0.5
+ ,give_log));
+/*
+#ifdef USE_SCALE
+ 2.0
+#else
+ 0.5
+#endif
+ ,give_log));
+*/
+}
+
+/*
+ * Given a sequence of r successes and b failures, we sample n (\le b+r)
+ * items without replacement. The hypergeometric probability is the
+ * probability of x successes:
+ *
+ * dbinom(x,r,p) * dbinom(n-x,b,p)
+ * p(x;r,b,n) = ---------------------------------
+ * dbinom(n,r+b,p)
+ *
+ * for any p. For numerical stability, we take p=n/(r+b); with this choice,
+ * the denominator is not exponentially small.
+ */
+double dhyper(x,r,b,n,give_log)
+int x, r, b, n, give_log;
+{ double p, q, p1, p2, p3;
+
+ if ((r<0) | (b<0) | (n<0) | (n>r+b))
+ return( INVALID_PARAMS );
+
+ if (x<0) return(D_0);
+
+ if (n==0) return((x==0) ? D_1 : D_0);
+
+ p = ((double)n)/((double)(r+b));
+ q = ((double)(r+b-n))/((double)(r+b));
+
+ p1 = dbinom_raw((double)x,(double)r,p,q,give_log);
+ p2 = dbinom_raw((double)(n-x),(double)b,p,q,give_log);
+ p3 = dbinom_raw((double)n,(double)(r+b),p,q,give_log);
+
+ return( (give_log) ? p1 + p2 - p3 : p1*p2/p3 );
+}
+
+/*
+ probability of x failures before the nth success.
+*/
+double dnbinom(x,n,p,give_log)
+double n, p;
+int x, give_log;
+{ double prob, f;
+
+ if ((p<0) | (p>1) | (n<=0)) return(INVALID_PARAMS);
+
+ if (x<0) return( D_0 );
+
+ prob = dbinom_raw(n,x+n,p,1-p,give_log);
+ f = n/(n+x);
+
+ return((give_log) ? log(f) + prob : f*prob);
+}
+
+double dt(x, df, give_log)
+double x, df;
+int give_log;
+{ double t, u, f;
+
+ if (df<=0.0) return(INVALID_PARAMS);
+
+ /*
+ exp(t) = Gamma((df+1)/2) /{ sqrt(df/2) * Gamma(df/2) }
+ = sqrt(df/2) / ((df+1)/2) * Gamma((df+3)/2) / Gamma((df+2)/2).
+ This form leads to a computation that should be stable for all
+ values of df, including df -> 0 and df -> infinity.
+ */
+ t = -bd0(df/2.0,(df+1)/2.0) + stirlerr((df+1)/2.0) - stirlerr(df/2.0);
+
+ if (x*x>df)
+ u = log( 1+ x*x/df ) * df/2;
+ else
+ u = -bd0(df/2.0,(df+x*x)/2.0) + x*x/2.0;
+
+ f = PIx2*(1+x*x/df);
+
+ return( FEXP(f,t-u) );
+}
diff --git a/src/dens_haz.c b/src/dens_haz.c
new file mode 100755
index 0000000..b719217
--- /dev/null
+++ b/src/dens_haz.c
@@ -0,0 +1,193 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Integration for hazard rate estimation. The functions in this
+ * file are used to evaluate
+ * sum int_0^{Ti} W_i(t,x) A()A()' exp( P() ) dt
+ * for hazard rate models.
+ *
+ * These routines assume the weight function is supported on [-1,1].
+ * hasint_sph multiplies by exp(base(lf,i)), which allows estimating
+ * the baseline in a proportional hazards model, when the covariate
+ * effect base(lf,i) is known.
+ *
+ * TODO:
+ * hazint_sph, should be able to reduce mint in some cases with
+ * small integration range. onedint could be used for beta-family
+ * (RECT,EPAN,BISQ,TRWT) kernels.
+ * hazint_prod, restrict terms from the sum based on x values.
+ * I should count obs >= max, and only do that integration once.
+ */
+
+#include "local.h"
+
+static double ilim[2*MXDIM], *ff, tmax;
+static lfdata *haz_lfd;
+static smpar *haz_sp;
+
+/*
+ * hrao returns 0 if integration region is empty.
+ * 1 otherwise.
+ */
+int haz_sph_int(dfx,cf,h,r1)
+double *dfx, *cf, h, *r1;
+{ double s, t0, t1, wt, th;
+ int j, dim, p;
+ s = 0; p = npar(haz_sp);
+ dim = haz_lfd->d;
+ for (j=1; j<dim; j++) s += SQR(dfx[j]/(h*haz_lfd->sca[j]));
+ if (s>1) return(0);
+
+ setzero(r1,p*p);
+ t1 = sqrt(1-s)*h*haz_lfd->sca[0];
+ t0 = -t1;
+ if (t0<ilim[0]) t0 = ilim[0];
+ if (t1>ilim[dim]) t1 = ilim[dim];
+ if (t1>dfx[0]) t1 = dfx[0];
+ if (t1<t0) return(0);
+
+/* Numerical integration by Simpson's rule.
+ */
+ for (j=0; j<=de_mint; j++)
+ { dfx[0] = t0+(t1-t0)*j/de_mint;
+ wt = weight(haz_lfd, haz_sp, dfx, NULL, h, 0, 0.0);
+ fitfun(haz_lfd, haz_sp, dfx,NULL,ff,NULL);
+ th = innerprod(cf,ff,p);
+ if (link(haz_sp)==LLOG) th = exp(th);
+ wt *= 2+2*(j&1)-(j==0)-(j==de_mint);
+ addouter(r1,ff,ff,p,wt*th);
+ }
+ multmatscal(r1,(t1-t0)/(3*de_mint),p*p);
+
+ return(1);
+}
+
+int hazint_sph(t,resp,r1,cf,h)
+double *t, *resp, *r1, *cf, h;
+{ int i, j, n, p, st;
+ double dfx[MXDIM], eb, sb;
+ p = npar(haz_sp);
+ setzero(resp,p*p);
+ sb = 0.0;
+
+ n = haz_lfd->n;
+ for (i=0; i<=n; i++)
+ {
+ if (i==n)
+ { dfx[0] = tmax-t[0];
+ for (j=1; j<haz_lfd->d; j++) dfx[j] = 0.0;
+ eb = exp(sb/n);
+ }
+ else
+ { eb = exp(base(haz_lfd,i)); sb += base(haz_lfd,i);
+ for (j=0; j<haz_lfd->d; j++) dfx[j] = datum(haz_lfd,j,i)-t[j];
+ }
+
+ st = haz_sph_int(dfx,cf,h,r1);
+ if (st)
+ for (j=0; j<p*p; j++) resp[j] += eb*r1[j];
+ }
+ return(LF_OK);
+}
+
+int hazint_prod(t,resp,x,cf,h)
+double *t, *resp, *x, *cf, h;
+{ int d, p, i, j, k, st;
+ double dfx[MXDIM], t_prev,
+ hj, hs, ncf[MXDEG], ef, il1;
+ double prod_wk[MXDIM][2*MXDEG+1], eb, sb;
+
+ p = npar(haz_sp);
+ d = haz_lfd->d;
+ setzero(resp,p*p);
+ hj = hs = h*haz_lfd->sca[0];
+
+ ncf[0] = cf[0];
+ for (i=1; i<=deg(haz_sp); i++)
+ { ncf[i] = hj*cf[(i-1)*d+1]; hj *= hs;
+ }
+
+/* for i=0..n....
+ * First we compute prod_wk[j], j=0..d.
+ * For j=0, this is int_0^T_i (u-t)^k W((u-t)/h) exp(b0*(u-t)) du
+ * For remaining j, (x(i,j)-x(j))^k Wj exp(bj*(x..-x.))
+ *
+ * Second, we add to the integration (exp(a) incl. in integral)
+ * with the right factorial denominators.
+ */
+ t_prev = ilim[0]; sb = 0.0;
+ for (i=0; i<=haz_lfd->n; i++)
+ { if (i==haz_lfd->n)
+ { dfx[0] = tmax-t[0];
+ for (j=1; j<d; j++) dfx[j] = 0.0;
+ eb = exp(sb/haz_lfd->n);
+ }
+ else
+ { eb = exp(base(haz_lfd,i)); sb += base(haz_lfd,i);
+ for (j=0; j<d; j++) dfx[j] = datum(haz_lfd,j,i)-t[j];
+ }
+
+ if (dfx[0]>ilim[0]) /* else it doesn't contribute */
+ {
+/* time integral */
+ il1 = (dfx[0]>ilim[d]) ? ilim[d] : dfx[0];
+ if (il1 != t_prev) /* don't repeat! */
+ { st = onedint(haz_sp,ncf,ilim[0]/hs,il1/hs,prod_wk[0]);
+ if (st>0) return(st);
+ hj = eb;
+ for (j=0; j<=2*deg(haz_sp); j++)
+ { hj *= hs;
+ prod_wk[0][j] *= hj;
+ }
+ t_prev = il1;
+ }
+
+/* covariate terms */
+ for (j=1; j<d; j++)
+ {
+ ef = 0.0;
+ for (k=deg(haz_sp); k>0; k--) ef = (ef+dfx[j])*cf[1+(k-1)*d+j];
+ ef = exp(ef);
+ prod_wk[j][0] = ef * W(dfx[j]/(h*haz_lfd->sca[j]),ker(haz_sp));
+ for (k=1; k<=2*deg(haz_sp); k++)
+ prod_wk[j][k] = prod_wk[j][k-1] * dfx[j];
+ }
+
+/* add to the integration. */
+ prodintresp(resp,prod_wk,d,deg(haz_sp),p);
+ } /* if dfx0 > ilim0 */
+ } /* n loop */
+
+/* symmetrize */
+ for (k=0; k<p; k++)
+ for (j=k; j<p; j++)
+ resp[j*p+k] = resp[k*p+j];
+ return(LF_OK);
+}
+
+int hazint(t,resp,resp1,cf,h)
+double *t, *resp, *resp1, *cf, h;
+{ if (haz_lfd->d==1) return(hazint_prod(t,resp,resp1,cf,h));
+ if (kt(haz_sp)==KPROD) return(hazint_prod(t,resp,resp1,cf,h));
+
+ return(hazint_sph(t,resp,resp1,cf,h));
+}
+
+void haz_init(lfd,des,sp,il)
+lfdata *lfd;
+design *des;
+smpar *sp;
+double *il;
+{ int i;
+
+ haz_lfd = lfd;
+ haz_sp = sp;
+
+ tmax = datum(lfd,0,0);
+ for (i=1; i<lfd->n; i++) tmax = MAX(tmax,datum(lfd,0,i));
+ ff = des->xtwx.wk;
+ for (i=0; i<2*lfd->d; i++) ilim[i] = il[i];
+}
diff --git a/src/dens_int.c b/src/dens_int.c
new file mode 100755
index 0000000..6c5b2ba
--- /dev/null
+++ b/src/dens_int.c
@@ -0,0 +1,227 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * The function dens_integrate(lf,des,z) is used to integrate a density
+ * estimate (z=1) or the density squared (z=2). This is used to renormalize
+ * the estimate (function dens_renorm) or in the computation of LSCV
+ * (function dnes_lscv). The implementation is presently for d=1.
+ *
+ * The computation orders the fit points selected by locfit, and
+ * integrates analytically over each interval. For the log-link,
+ * the interpolant used is peicewise quadratic (with one knot in
+ * the middle of each interval); this differs from the cubic interpolant
+ * used elsewhere in Locfit.
+ *
+ * TODO: allow for xlim. What can be done simply in >=2 dimensions?
+ * fix df computation (in lscv) for link=IDENT.
+ */
+
+#include "local.h"
+
+/*
+ * Finds the order of observations in the array x, and
+ * stores in integer array ind.
+ * At input, lset l=0 and r=length(x)-1.
+ * At output, x[ind[0]] <= x[ind[1]] <= ...
+ */
+void lforder(ind,x,l,r)
+Sint *ind;
+int l, r;
+double *x;
+{ double piv;
+ int i, i0, i1;
+ piv = (x[ind[l]]+x[ind[r]])/2;
+ i0 = l; i1 = r;
+ while (i0<=i1)
+ { while ((i0<=i1) && (x[ind[i0]]<=piv)) i0++;
+ while ((i0<=i1) && (x[ind[i1]]>piv)) i1--;
+ if (i0<i1)
+ { ISWAP(ind[i0],ind[i1]);
+ i0++; i1--;
+ }
+ }
+ /* now, x[ind[l..i1]] <= piv < x[ind[i0..r]].
+ put the ties in the middle */
+ while ((i1>=l) && (x[ind[i1]]==piv)) i1--;
+ for (i=l; i<=i1; i++)
+ if (x[ind[i]]==piv)
+ { ISWAP(ind[i],ind[i1]);
+ while (x[ind[i1]]==piv) i1--;
+ }
+
+ if (l<i1) lforder(ind,x,l,i1);
+ if (i0<r) lforder(ind,x,i0,r);
+}
+
+/*
+ * estdiv integrates the density between fit points x0 and x1.
+ * f0, f1 are function values, d0, d1 are derivatives.
+ */
+double estdiv(x0,x1,f0,f1,d0,d1,lin)
+double x0, x1, f0, f1, d0, d1;
+int lin;
+{ double cf[4], I[2], dlt, e0, e1;
+
+ if (x0==x1) return(0.0);
+
+ if (lin==LIDENT)
+ {
+/* cf are integrals of hermite polynomials.
+ * Then adjust for x1-x0.
+ */
+ cf[0] = cf[1] = 0.5;
+ cf[2] = 1.0/12.0; cf[3] = -cf[2];
+ return( (cf[0]*f0+cf[1]*f1)*(x1-x0)
+ + (cf[2]*d0+cf[3]*d1)*(x1-x0)*(x1-x0) );
+ }
+
+/*
+ * this is for LLOG
+ */
+
+ dlt = (x1-x0)/2;
+ cf[0] = f0;
+ cf[1] = d0;
+ cf[2] = ( 2*(f1-f0) - dlt*(d1+3*d0) )/(4*dlt*dlt);
+ recurint(0.0,dlt,cf,I,0,WRECT);
+ e0 = I[0];
+
+ cf[0] = f1;
+ cf[1] = -d1;
+ cf[2] = ( 2*(f0-f1) + dlt*(d0+3*d1) )/( 4*dlt*dlt );
+ recurint(0.0,dlt,cf,I,0,WRECT);
+ e1 = I[0];
+
+ return(e0+e1);
+}
+
+/*
+ * Evaluate the integral of the density estimate to the power z.
+ * This would be severely messed up, if I ever implement parcomp
+ * for densities.
+ */
+double dens_integrate(lf,des,z)
+lfit *lf;
+design *des;
+int z;
+{ int has_deriv, i, i0, i1, nv;
+ Sint *ind;
+ double *xev, *fit, *deriv=NULL, sum, term;
+ double d0, d1, f0, f1;
+ fitpt *fp;
+
+ fp = &lf->fp;
+
+ if (fp->d >= 2)
+ { WARN(("dens_integrate requires d=1"));
+ return(0.0);
+ }
+
+ has_deriv = (deg(&lf->sp) > 0); /* not right? */
+ fit = fp->coef;
+ if (has_deriv)
+ deriv = &fit[fp->nvm];
+ xev = evp(fp);
+
+ /*
+ * order the vertices
+ */
+ nv = fp->nv;
+ if (lf->lfd.n<nv) return(0.0);
+ ind = des->ind;
+ for (i=0; i<nv; i++) ind[i] = i;
+ lforder(ind,xev,0,nv-1);
+ sum = 0.0;
+
+ /*
+ * Estimate the contribution of the boundaries.
+ * should really check flim here.
+ */
+ i0 = ind[0]; i1 = ind[1];
+ f1 = fit[i0];
+ d1 = (has_deriv) ? deriv[i0] :
+ (fit[i1]-fit[i0])/(xev[i1]-xev[i0]);
+ if (d1 <= 0) WARN(("dens_integrate - ouch!"));
+ if (z==2)
+ { if (link(&lf->sp)==LLOG)
+ { f1 *= 2; d1 *= 2; }
+ else
+ { d1 = 2*d1*f1; f1 = f1*f1; }
+ }
+ term = (link(&lf->sp)==LIDENT) ? f1*f1/(2*d1) : exp(f1)/d1;
+ sum += term;
+
+ i0 = ind[nv-2]; i1 = ind[nv-1];
+ f0 = fit[i1];
+ d0 = (has_deriv) ? deriv[i1] :
+ (fit[i1]-fit[i0])/(xev[i1]-xev[i0]);
+ if (d0 >= 0) WARN(("dens_integrate - ouch!"));
+ if (z==2)
+ { if (link(&lf->sp)==LLOG)
+ { f0 *= 2; d0 *= 2; }
+ else
+ { d0 = 2*d0*f0; f0 = f0*f0; }
+ }
+ term = (link(&lf->sp)==LIDENT) ? -f0*f0/(2*d0) : exp(f0)/d0;
+ sum += term;
+
+ for (i=1; i<nv; i++)
+ { i0 = ind[i-1]; i1 = ind[i];
+ f0 = fit[i0]; f1 = fit[i1];
+ d0 = (has_deriv) ? deriv[i0] :
+ (f1-f0)/(xev[i1]-xev[i0]);
+ d1 = (has_deriv) ? deriv[i1] : d0;
+ if (z==2)
+ { if (link(&lf->sp)==LLOG)
+ { f0 *= 2; f1 *= 2; d0 *= 2; d1 *= 2; }
+ else
+ { d0 *= 2*f0; d1 *= 2*f1; f0 = f0*f0; f1 = f1*f1; }
+ }
+ term = estdiv(xev[i0],xev[i1],f0,f1,d0,d1,link(&lf->sp));
+ sum += term;
+ }
+
+ return(sum);
+}
+
+void dens_renorm(lf,des)
+lfit *lf;
+design *des;
+{ int i;
+ double sum;
+ sum = dens_integrate(lf,des,1);
+ if (sum==0.0) return;
+ sum = log(sum);
+ for (i=0; i<lf->fp.nv; i++) lf->fp.coef[i] -= sum;
+}
+
+void dens_lscv(des,lf)
+lfit *lf;
+design *des;
+{ double df, fh, fh_cv, infl, z0, z1, x[MXDIM];
+ int i, n, j, evo;
+ z1 = df = 0.0;
+ evo = ev(&lf->evs);
+ n = lf->lfd.n;
+ if ((evo==EDATA) | (evo==ECROS)) evo = EFITP;
+
+ z0 = dens_integrate(lf,des,2);
+
+ for (i=0; i<n; i++)
+ { for (j=0; j<lf->lfd.d; j++) x[j] = datum(&lf->lfd,j,i);
+ fh = base(&lf->lfd,i)+dointpoint(lf,x,PCOEF,evo,i);
+ if (link(&lf->sp)==LLOG) fh = exp(fh);
+ infl = dointpoint(lf,x,PT0,evo,i);
+ infl = infl * infl;
+ if (infl>1) infl = 1;
+ fh_cv = (link(&lf->sp) == LIDENT) ?
+ (n*fh - infl) / (n-1.0) : fh*(1-infl)*n/(n-1.0);
+ z1 += fh_cv;
+ df += infl;
+ }
+
+ lf->fp.L[0] = z0-2*z1/n;
+ lf->fp.L[1] = df;
+}
diff --git a/src/dens_odi.c b/src/dens_odi.c
new file mode 100755
index 0000000..044073c
--- /dev/null
+++ b/src/dens_odi.c
@@ -0,0 +1,512 @@
+/*
+ * Copyright (c) 1996-200 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Routines for one-dimensional numerical integration
+ * in density estimation. The entry point is
+ *
+ * onedint(cf,mi,l0,l1,resp)
+ *
+ * which evaluates int W(u)u^j exp( P(u) ), j=0..2*deg.
+ * P(u) = cf[0] + cf[1]u + cf[2]u^2/2 + ... + cf[deg]u^deg/deg!
+ * l0 and l1 are the integration limits.
+ * The results are returned through the vector resp.
+ *
+ */
+
+#include "local.h"
+
+static int debug;
+
+int exbctay(b,c,n,z) /* n-term taylor series of e^(bx+cx^2) */
+double b, c, *z;
+int n;
+{ double ec[20];
+ int i, j;
+ z[0] = 1;
+ for (i=1; i<=n; i++) z[i] = z[i-1]*b/i;
+ if (c==0.0) return(n);
+ if (n>=40)
+ { WARN(("exbctay limit to n<40"));
+ n = 39;
+ }
+ ec[0] = 1;
+ for (i=1; 2*i<=n; i++) ec[i] = ec[i-1]*c/i;
+ for (i=n; i>1; i--)
+ for (j=1; 2*j<=i; j++)
+ z[i] += ec[j]*z[i-2*j];
+ return(n);
+}
+
+double explinjtay(l0,l1,j,cf)
+/* int_l0^l1 x^j e^(a+bx+cx^2); exbctay aroud l1 */
+double l0, l1, *cf;
+int j;
+{ double tc[40], f, s;
+ int k, n;
+ if ((l0!=0.0) | (l1!=1.0)) WARN(("explinjtay: invalid l0, l1"));
+ n = exbctay(cf[1]+2*cf[2]*l1,cf[2],20,tc);
+ s = tc[0]/(j+1);
+ f = 1/(j+1);
+ for (k=1; k<=n; k++)
+ { f *= -k/(j+k+1.0);
+ s += tc[k]*f;
+ }
+ return(f);
+}
+
+void explint1(l0,l1,cf,I,p) /* int x^j exp(a+bx); j=0..p-1 */
+double l0, l1, *cf, *I;
+int p;
+{ double y0, y1, f;
+ int j, k, k1;
+ y0 = lf_exp(cf[0]+l0*cf[1]);
+ y1 = lf_exp(cf[0]+l1*cf[1]);
+ if (p<2*fabs(cf[1])) k = p; else k = (int)fabs(cf[1]);
+
+ if (k>0)
+ { I[0] = (y1-y0)/cf[1];
+ for (j=1; j<k; j++) /* forward steps for small j */
+ { y1 *= l1; y0 *= l0;
+ I[j] = (y1-y0-j*I[j-1])/cf[1];
+ }
+ if (k==p) return;
+ y1 *= l1; y0 *= l0;
+ }
+
+ f = 1; k1 = k;
+ while ((k<50) && (f>1.0e-8)) /* initially Ik = diff(x^{k+1}e^{a+bx}) */
+ { y1 *= l1; y0 *= l0;
+ I[k] = y1-y0;
+ if (k>=p) f *= fabs(cf[1])/(k+1);
+ k++;
+ }
+ if (k==50) WARN(("explint1: want k>50"));
+ I[k] = 0.0;
+ for (j=k-1; j>=k1; j--) /* now do back step recursion */
+ I[j] = (I[j]-cf[1]*I[j+1])/(j+1);
+}
+
+void explintyl(l0,l1,cf,I,p) /* small c, use taylor series and explint1 */
+double l0, l1, *cf, *I;
+int p;
+{ int i;
+ double c;
+ explint1(l0,l1,cf,I,p+8);
+ c = cf[2];
+ for (i=0; i<p; i++)
+ I[i] = (((I[i+8]*c/4+I[i+6])*c/3+I[i+4])*c/2+I[i+2])*c+I[i];
+}
+
+void solvetrid(X,y,m)
+double *X, *y;
+int m;
+{ int i;
+ double s;
+ for (i=1; i<m; i++)
+ { s = X[3*i]/X[3*i-2];
+ X[3*i] = 0; X[3*i+1] -= s*X[3*i-1];
+ y[i] -= s*y[i-1];
+ }
+ for (i=m-2; i>=0; i--)
+ { s = X[3*i+2]/X[3*i+4];
+ X[3*i+2] = 0;
+ y[i] -= s*y[i+1];
+ }
+ for (i=0; i<m; i++) y[i] /= X[3*i+1];
+}
+
+void initi0i1(I,cf,y0,y1,l0,l1)
+double *I, *cf, y0, y1, l0, l1;
+{ double a0, a1, c, d, bi;
+ d = -cf[1]/(2*cf[2]); c = sqrt(2*fabs(cf[2]));
+ a0 = c*(l0-d); a1 = c*(l1-d);
+ if (cf[2]<0)
+ { bi = lf_exp(cf[0]+cf[1]*d+cf[2]*d*d)/c;
+ if (a0>0)
+ { if (a0>6) I[0] = (y0*ptail(-a0)-y1*ptail(-a1))/c;
+ else I[0] = S2PI*(mut_pnorm(-a0,0.0,1.0)-mut_pnorm(-a1,0.0,1.0))*bi;
+ }
+ else
+ { if (a1< -6) I[0] = (y1*ptail(a1)-y0*ptail(a0))/c;
+ else I[0] = S2PI*(mut_pnorm(a1,0.0,1.0)-mut_pnorm(a0,0.0,1.0))*bi;
+ }
+ }
+ else
+ I[0] = (y1*daws(a1)-y0*daws(a0))/c;
+ I[1] = (y1-y0)/(2*cf[2])+d*I[0];
+}
+
+void explinsid(l0,l1,cf,I,p) /* large b; don't use fwd recursion */
+double l0, l1, *cf, *I;
+int p;
+{ int k, k0, k1, k2;
+ double y0, y1, Z[150];
+if (debug) printf("side: %8.5f %8.5f %8.5f limt %8.5f %8.5f p %2d\n",cf[0],cf[1],cf[2],l0,l1,p);
+
+ k0 = 2;
+ k1 = (int)(fabs(cf[1])+fabs(2*cf[2]));
+ if (k1<2) k1 = 2;
+ if (k1>p+20) k1 = p+20;
+ k2 = p+20;
+
+ if (debug) printf("k0 %2d k1 %2d k2 %2d p %2d\n",k0,k1,k2,p);
+
+ y0 = lf_exp(cf[0]+l0*(cf[1]+l0*cf[2]));
+ y1 = lf_exp(cf[0]+l1*(cf[1]+l1*cf[2]));
+ initi0i1(I,cf,y0,y1,l0,l1);
+if (debug) printf("i0 %8.5f i1 %8.5f\n",I[0],I[1]);
+
+ y1 *= l1; y0 *= l0; /* should be x^(k1)*exp(..) */
+ if (k0<k1) /* center steps; initially x^k*exp(...) */
+ for (k=k0; k<k1; k++)
+ { y1 *= l1; y0 *= l0;
+ I[k] = y1-y0;
+ Z[3*k] = k; Z[3*k+1] = cf[1]; Z[3*k+2] = 2*cf[2];
+ }
+
+ y1 *= l1; y0 *= l0; /* should be x^(k1)*exp(..) */
+if (debug) printf("k1 %2d y0 %8.5f y1 %8.5f\n",k1,y0,y1);
+ for (k=k1; k<k2; k++)
+ { y1 *= l1; y0 *= l0;
+ I[k] = y1-y0;
+ }
+ I[k2] = I[k2+1] = 0.0;
+ for (k=k2-1; k>=k1; k--)
+ I[k] = (I[k]-cf[1]*I[k+1]-2*cf[2]*I[k+2])/(k+1);
+
+ if (k0<k1)
+ { I[k0] -= k0*I[k0-1];
+ I[k1-1] -= 2*cf[2]*I[k1];
+ Z[3*k0] = Z[3*k1-1] = 0;
+ solvetrid(&Z[3*k0],&I[k0],k1-k0);
+ }
+if (debug)
+{ printf("explinsid:\n");
+ for (k=0; k<p; k++) printf(" %8.5f\n",I[k]);
+}
+}
+
+void explinbkr(l0,l1,cf,I,p) /* small b,c; use back recursion */
+double l0, l1, *cf, *I;
+int p;
+{ int k, km;
+ double y0, y1;
+ y0 = lf_exp(cf[0]+l0*(cf[1]+cf[2]*l0));
+ y1 = lf_exp(cf[0]+l1*(cf[1]+cf[2]*l1));
+ km = p+10;
+ for (k=0; k<=km; k++)
+ { y1 *= l1; y0 *= l0;
+ I[k] = y1-y0;
+ }
+ I[km+1] = I[km+2] = 0;
+ for (k=km; k>=0; k--)
+ I[k] = (I[k]-cf[1]*I[k+1]-2*cf[2]*I[k+2])/(k+1);
+}
+
+void explinfbk0(l0,l1,cf,I,p) /* fwd and bac recur; b=0; c<0 */
+double l0, l1, *cf, *I;
+int p;
+{ double y0, y1, f1, f2, f, ml2;
+ int k, ks;
+
+ y0 = lf_exp(cf[0]+l0*l0*cf[2]);
+ y1 = lf_exp(cf[0]+l1*l1*cf[2]);
+ initi0i1(I,cf,y0,y1,l0,l1);
+
+ ml2 = MAX(l0*l0,l1*l1);
+ ks = 1+(int)(2*fabs(cf[2])*ml2);
+ if (ks<2) ks = 2;
+ if (ks>p-3) ks = p;
+
+ /* forward recursion for k < ks */
+ for (k=2; k<ks; k++)
+ { y1 *= l1; y0 *= l0;
+ I[k] = (y1-y0-(k-1)*I[k-2])/(2*cf[2]);
+ }
+ if (ks==p) return;
+
+ y1 *= l1*l1; y0 *= l0*l0;
+ for (k=ks; k<p; k++) /* set I[k] = x^{k+1}e^(a+cx^2) | {l0,l1} */
+ { y1 *= l1; y0 *= l0;
+ I[k] = y1-y0;
+ }
+
+ /* initialize I[p-2] and I[p-1] */
+ f1 = 1.0/p; f2 = 1.0/(p-1);
+ I[p-1] *= f1; I[p-2] *= f2;
+ k = p; f = 1.0;
+ while (f>1.0e-8)
+ { y1 *= l1; y0 *= l0;
+ if ((k-p)%2==0) /* add to I[p-2] */
+ { f2 *= -2*cf[2]/(k+1);
+ I[p-2] += (y1-y0)*f2;
+ }
+ else /* add to I[p-1] */
+ { f1 *= -2*cf[2]/(k+1);
+ I[p-1] += (y1-y0)*f1;
+ f *= 2*fabs(cf[2])*ml2/(k+1);
+ }
+ k++;
+ }
+
+ /* use back recursion for I[ks..(p-3)] */
+ for (k=p-3; k>=ks; k--)
+ I[k] = (I[k]-2*cf[2]*I[k+2])/(k+1);
+}
+
+void explinfbk(l0,l1,cf,I,p) /* fwd and bac recur; b not too large */
+double l0, l1, *cf, *I;
+int p;
+{ double y0, y1;
+ int k, ks, km;
+
+ y0 = lf_exp(cf[0]+l0*(cf[1]+l0*cf[2]));
+ y1 = lf_exp(cf[0]+l1*(cf[1]+l1*cf[2]));
+ initi0i1(I,cf,y0,y1,l0,l1);
+
+ ks = (int)(3*fabs(cf[2]));
+ if (ks<3) ks = 3;
+ if (ks>0.75*p) ks = p; /* stretch the forward recurs as far as poss. */
+ /* forward recursion for k < ks */
+ for (k=2; k<ks; k++)
+ { y1 *= l1; y0 *= l0;
+ I[k] = (y1-y0-cf[1]*I[k-1]-(k-1)*I[k-2])/(2*cf[2]);
+ }
+ if (ks==p) return;
+
+ km = p+15;
+ y1 *= l1*l1; y0 *= l0*l0;
+ for (k=ks; k<=km; k++)
+ { y1 *= l1; y0 *= l0;
+ I[k] = y1-y0;
+ }
+ I[km+1] = I[km+2] = 0.0;
+ for (k=km; k>=ks; k--)
+ I[k] = (I[k]-cf[1]*I[k+1]-2*cf[2]*I[k+2])/(k+1);
+}
+
+void recent(I,resp,wt,p,s,x)
+double *I, *resp, *wt, x;
+int p, s;
+{ int i, j;
+
+ /* first, use W taylor series I -> resp */
+ for (i=0; i<=p; i++)
+ { resp[i] = 0.0;
+ for (j=0; j<s; j++) resp[i] += wt[j]*I[i+j];
+ }
+
+ /* now, recenter x -> 0 */
+ if (x==0) return;
+ for (j=0; j<=p; j++) for (i=p; i>j; i--) resp[i] += x*resp[i-1];
+}
+
+void recurint(l0,l2,cf,resp,p,ker)
+double l0, l2, *cf, *resp;
+int p, ker;
+{ int i, s;
+ double l1, d0, d1, d2, dl, z0, z1, z2, wt[20], ncf[3], I[50], r1[5], r2[5];
+if (debug) printf("\nrecurint: %8.5f %8.5f %8.5f %8.5f %8.5f\n",cf[0],cf[1],cf[2],l0,l2);
+
+ if (cf[2]==0) /* go straight to explint1 */
+ { s = wtaylor(wt,0.0,ker);
+if (debug) printf("case 1\n");
+ explint1(l0,l2,cf,I,p+s);
+ recent(I,resp,wt,p,s,0.0);
+ return;
+ }
+
+ dl = l2-l0;
+ d0 = cf[1]+2*l0*cf[2];
+ d2 = cf[1]+2*l2*cf[2];
+ z0 = cf[0]+l0*(cf[1]+l0*cf[2]);
+ z2 = cf[0]+l2*(cf[1]+l2*cf[2]);
+
+ if ((fabs(cf[1]*dl)<1) && (fabs(cf[2]*dl*dl)<1))
+ { ncf[0] = z0; ncf[1] = d0; ncf[2] = cf[2];
+if (debug) printf("case 2\n");
+ s = wtaylor(wt,l0,ker);
+ explinbkr(0.0,dl,ncf,I,p+s);
+ recent(I,resp,wt,p,s,l0);
+ return;
+ }
+
+ if (fabs(cf[2]*dl*dl)<0.001) /* small c, use explint1+tay.ser */
+ { ncf[0] = z0; ncf[1] = d0; ncf[2] = cf[2];
+if (debug) printf("case small c\n");
+ s = wtaylor(wt,l0,ker);
+ explintyl(0.0,l2-l0,ncf,I,p+s);
+ recent(I,resp,wt,p,s,l0);
+ return;
+ }
+
+ if (d0*d2<=0) /* max/min in [l0,l2] */
+ { l1 = -cf[1]/(2*cf[2]);
+ z1 = cf[0]+l1*(cf[1]+l1*cf[2]);
+ d1 = 0.0;
+ if (cf[2]<0) /* peak, integrate around l1 */
+ { s = wtaylor(wt,l1,ker);
+ ncf[0] = z1; ncf[1] = 0.0; ncf[2] = cf[2];
+if (debug) printf("case peak p %2d s %2d\n",p,s);
+ explinfbk0(l0-l1,l2-l1,ncf,I,p+s);
+ recent(I,resp,wt,p,s,l1);
+ return;
+ }
+ }
+
+ if ((d0-2*cf[2]*dl)*(d2+2*cf[2]*dl)<0) /* max/min is close to [l0,l2] */
+ { l1 = -cf[1]/(2*cf[2]);
+ z1 = cf[0]+l1*(cf[1]+l1*cf[2]);
+ if (l1<l0) { l1 = l0; z1 = z0; }
+ if (l1>l2) { l1 = l2; z1 = z2; }
+
+ if ((z1>=z0) & (z1>=z2)) /* peak; integrate around l1 */
+ { s = wtaylor(wt,l1,ker);
+if (debug) printf("case 4\n");
+ d1 = cf[1]+2*l1*cf[2];
+ ncf[0] = z1; ncf[1] = d1; ncf[2] = cf[2];
+ explinfbk(l0-l1,l2-l1,ncf,I,p+s);
+ recent(I,resp,wt,p,s,l1);
+ return;
+ }
+
+ /* trough; integrate [l0,l1] and [l1,l2] */
+ for (i=0; i<=p; i++) r1[i] = r2[i] = 0.0;
+ if (l0<l1)
+ { s = wtaylor(wt,l0,ker);
+if (debug) printf("case 5\n");
+ ncf[0] = z0; ncf[1] = d0; ncf[2] = cf[2];
+ explinfbk(0.0,l1-l0,ncf,I,p+s);
+ recent(I,r1,wt,p,s,l0);
+ }
+ if (l1<l2)
+ { s = wtaylor(wt,l2,ker);
+if (debug) printf("case 6\n");
+ ncf[0] = z2; ncf[1] = d2; ncf[2] = cf[2];
+ explinfbk(l1-l2,0.0,ncf,I,p+s);
+ recent(I,r2,wt,p,s,l2);
+ }
+ for (i=0; i<=p; i++) resp[i] = r1[i]+r2[i];
+ return;
+ }
+
+ /* Now, quadratic is monotone on [l0,l2]; big b; moderate c */
+ if (z2>z0+3) /* steep increase, expand around l2 */
+ { s = wtaylor(wt,l2,ker);
+if (debug) printf("case 7\n");
+
+
+ ncf[0] = z2; ncf[1] = d2; ncf[2] = cf[2];
+ explinsid(l0-l2,0.0,ncf,I,p+s);
+ recent(I,resp,wt,p,s,l2);
+if (debug) printf("7 resp: %8.5f %8.5f %8.5f %8.5f\n",resp[0],resp[1],resp[2],resp[3]);
+ return;
+ }
+
+ /* bias towards expansion around l0, because it's often 0 */
+if (debug) printf("case 8\n");
+ s = wtaylor(wt,l0,ker);
+ ncf[0] = z0; ncf[1] = d0; ncf[2] = cf[2];
+ explinsid(0.0,l2-l0,ncf,I,p+s);
+ recent(I,resp,wt,p,s,l0);
+ return;
+}
+
+int onedexpl(cf,deg,resp)
+double *cf, *resp;
+int deg;
+{ int i;
+ double f0, fr, fl;
+ if (deg>=2) ERROR(("onedexpl only valid for deg=0,1"));
+ if (fabs(cf[1])>=EFACT) return(LF_BADP);
+
+ f0 = exp(cf[0]); fl = fr = 1.0;
+ for (i=0; i<=2*deg; i++)
+ { f0 *= i+1;
+ fl /=-(EFACT+cf[1]);
+ fr /= EFACT-cf[1];
+ resp[i] = f0*(fr-fl);
+ }
+ return(LF_OK);
+}
+
+int onedgaus(cf,deg,resp)
+double *cf, *resp;
+int deg;
+{ int i;
+ double f0, mu, s2;
+ if (deg==3)
+ { ERROR(("onedgaus only valid for deg=0,1,2"));
+ return(LF_ERR);
+ }
+ if (2*cf[2]>=GFACT*GFACT) return(LF_BADP);
+
+ s2 = 1/(GFACT*GFACT-2*cf[2]);
+ mu = cf[1]*s2;
+ resp[0] = 1.0;
+ if (deg>=1)
+ { resp[1] = mu;
+ resp[2] = s2+mu*mu;
+ if (deg==2)
+ { resp[3] = mu*(3*s2+mu*mu);
+ resp[4] = 3*s2*s2 + mu*mu*(6*s2+mu*mu);
+ }
+ }
+ f0 = S2PI * exp(cf[0]+mu*mu/(2*s2))*sqrt(s2);
+ for (i=0; i<=2*deg; i++) resp[i] *= f0;
+ return(LF_OK);
+}
+
+int onedint(sp,cf,l0,l1,resp) /* int W(u)u^j exp(..), j=0..2*deg */
+smpar *sp;
+double *cf, l0, l1, *resp;
+{ double u, uj, y, ncf[4], rr[5];
+ int i, j;
+if (debug) printf("onedint: %f %f %f %f %f\n",cf[0],cf[1],cf[2],l0,l1);
+
+ if (deg(sp)<=2)
+ { for (i=0; i<3; i++) ncf[i] = (i>deg(sp)) ? 0.0 : cf[i];
+ ncf[2] /= 2;
+
+ if (ker(sp)==WEXPL) return(onedexpl(ncf,deg(sp),resp));
+ if (ker(sp)==WGAUS) return(onedgaus(ncf,deg(sp),resp));
+
+ if (l1>0)
+ recurint(MAX(l0,0.0),l1,ncf,resp,2*deg(sp),ker(sp));
+ else for (i=0; i<=2*deg(sp); i++) resp[i] = 0;
+
+ if (l0<0)
+ { ncf[1] = -ncf[1];
+ l0 = -l0; l1 = -l1;
+ recurint(MAX(l1,0.0),l0,ncf,rr,2*deg(sp),ker(sp));
+ }
+ else for (i=0; i<=2*deg(sp); i++) rr[i] = 0.0;
+
+ for (i=0; i<=2*deg(sp); i++)
+ resp[i] += (i%2==0) ? rr[i] : -rr[i];
+
+ return(LF_OK);
+ }
+
+ /* For degree >= 3, we use Simpson's rule. */
+ for (j=0; j<=2*deg(sp); j++) resp[j] = 0.0;
+ for (i=0; i<=de_mint; i++)
+ { u = l0+(l1-l0)*i/de_mint;
+ y = cf[0]; uj = 1;
+ for (j=1; j<=deg(sp); j++)
+ { uj *= u;
+ y += cf[j]*uj/fact[j];
+ }
+ y = (4-2*(i%2==0)-(i==0)-(i==de_mint)) *
+ W(fabs(u),ker(sp))*exp(MIN(y,300.0));
+ for (j=0; j<=2*deg(sp); j++)
+ { resp[j] += y;
+ y *= u;
+ }
+ }
+ for (j=0; j<=2*deg(sp); j++) resp[j] = resp[j]*(l1-l0)/(3*de_mint);
+ return(LF_OK);
+}
diff --git a/src/density.c b/src/density.c
new file mode 100755
index 0000000..6a239ce
--- /dev/null
+++ b/src/density.c
@@ -0,0 +1,508 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+extern int lf_status;
+static double u[MXDIM], ilim[2*MXDIM], *ff, hh, *cff;
+static lfdata *den_lfd;
+static design *den_des;
+static smpar *den_sp;
+int fact[] = {1, 1, 2, 6, 24, 120, 720, 5040, 40320, 362880, 3628800};
+int de_mint = 20;
+int de_itype = IDEFA;
+int de_renorm= 0;
+
+int multint(), prodint(), gausint(), mlinint();
+
+void prresp(coef,resp,p)
+double *coef, *resp;
+int p;
+{ int i, j;
+ printf("Coefficients:\n");
+ for (i=0; i<p; i++) printf("%8.5f ",coef[i]);
+ printf("\n");
+ printf("Response matrix:\n");
+ for (i=0; i<p; i++)
+ { for (j=0; j<p; j++) printf("%9.6f, ",resp[i+j*p]);
+ printf("\n");
+ }
+}
+
+int mif(u,d,resp,M)
+double *u, *resp, *M;
+int d;
+{ double wt;
+ int i, j, p;
+
+ p = den_des->p;
+ wt = weight(den_lfd, den_sp, u, NULL, hh, 0, 0.0);
+ if (wt==0)
+ { setzero(resp,p*p);
+ return(p*p);
+ }
+
+ fitfun(den_lfd, den_sp, u,NULL,ff,NULL);
+ if (link(den_sp)==LLOG)
+ wt *= lf_exp(innerprod(ff,cff,p));
+ for (i=0; i<p; i++)
+ for (j=0; j<p; j++)
+ resp[i*p+j] = wt*ff[i]*ff[j];
+ return(p*p);
+}
+
+int multint(t,resp1,resp2,cf,h)
+double *t, *resp1, *resp2, *cf, h;
+{ int d, i, mg[MXDIM];
+
+ if (ker(den_sp)==WGAUS) return(gausint(t,resp1,resp2,cf,h,den_lfd->sca));
+
+ d = den_lfd->d;
+ for (i=0; i<d; i++) mg[i] = de_mint;
+
+ hh = h;
+ cff= cf;
+ simpsonm(mif,ilim,&ilim[d],d,resp1,mg,resp2);
+ return(LF_OK);
+}
+
+int mlinint(t,resp1,resp2,cf,h)
+double *t, *resp1, *resp2, *cf, h;
+{
+ double hd, nb, wt, wu, g[4], w0, w1, v, *sca;
+ int d, p, i, j, jmax, k, l, z, jj[2];
+
+ d = den_lfd->d; p = den_des->p; sca = den_lfd->sca;
+ hd = 1;
+ for (i=0; i<d; i++) hd *= h*sca[i];
+
+ if (link(den_sp)==LIDENT)
+ { setzero(resp1,p*p);
+ resp1[0] = wint(d,NULL,0,ker(den_sp))*hd;
+ if (deg(den_sp)==0) return(LF_OK);
+ jj[0] = 2; w0 = wint(d,jj,1,ker(den_sp))*hd*h*h;
+ for (i=0; i<d; i++) resp1[(i+1)*p+i+1] = w0*sca[i]*sca[i];
+ if (deg(den_sp)==1) return(LF_OK);
+ for (i=0; i<d; i++)
+ { j = p-(d-i)*(d-i+1)/2;
+ resp1[j] = resp1[p*j] = w0*sca[i]*sca[i]/2;
+ }
+ if (d>1)
+ { jj[1] = 2;
+ w0 = wint(d,jj,2,ker(den_sp)) * hd*h*h*h*h;
+ }
+ jj[0] = 4;
+ w1 = wint(d,jj,1,ker(den_sp)) * hd*h*h*h*h/4;
+ z = d+1;
+ for (i=0; i<d; i++)
+ { k = p-(d-i)*(d-i+1)/2;
+ for (j=i; j<d; j++)
+ { l = p-(d-j)*(d-j+1)/2;
+ if (i==j) resp1[z*p+z] = w1*SQR(sca[i])*SQR(sca[i]);
+ else
+ { resp1[z*p+z] = w0*SQR(sca[i])*SQR(sca[j]);
+ resp1[k*p+l] = resp1[k+p*l] = w0/4*SQR(sca[i])*SQR(sca[j]);
+ }
+ z++;
+ } }
+ return(LF_OK);
+ }
+ switch(deg(den_sp))
+ { case 0:
+ resp1[0] = lf_exp(cf[0])*wint(d,NULL,0,ker(den_sp))*hd;
+ return(LF_OK);
+ case 1:
+ nb = 0.0;
+ for (i=1; i<=d; i++)
+ { v = h*cf[i]*sca[i-1];
+ nb += v*v;
+ }
+ if (ker(den_sp)==WGAUS)
+ { w0 = 1/(GFACT*GFACT);
+ g[0] = lf_exp(cf[0]+w0*nb/2+d*log(S2PI/2.5));
+ g[1] = g[3] = g[0]*w0;
+ g[2] = g[0]*w0*w0;
+ }
+ else
+ { wt = wu = lf_exp(cf[0]);
+ w0 = wint(d,NULL,0,ker(den_sp)); g[0] = wt*w0;
+ g[1] = g[2] = g[3] = 0.0;
+ j = 0; jmax = (d+2)*de_mint;
+ while ((j<jmax) && (wt*w0/g[0]>1.0e-8))
+ { j++;
+ jj[0] = 2*j; w0 = wint(d,jj,1,ker(den_sp));
+ if (d==1) g[3] += wt * w0;
+ else
+ { jj[0] = 2; jj[1] = 2*j-2; w1 = wint(d,jj,2,ker(den_sp));
+ g[3] += wt*w1;
+ g[2] += wu*(w0-w1);
+ }
+ wt /= (2*j-1.0); g[1] += wt*w0;
+ wt *= nb/(2*j); g[0] += wt*w0;
+ wu /= (2*j-1.0)*(2*j);
+ if (j>1) wu *= nb;
+ }
+ if (j==jmax) WARN(("mlinint: series not converged"));
+ }
+ g[0] *= hd; g[1] *= hd;
+ g[2] *= hd; g[3] *= hd;
+ resp1[0] = g[0];
+ for (i=1; i<=d; i++)
+ { resp1[i] = resp1[(d+1)*i] = cf[i]*SQR(h*sca[i-1])*g[1];
+ for (j=1; j<=d; j++)
+ { resp1[(d+1)*i+j] = (i==j) ? g[3]*SQR(h*sca[i-1]) : 0;
+ resp1[(d+1)*i+j] += g[2]*SQR(h*h*sca[i-1]*sca[j-1])*cf[i]*cf[j];
+ }
+ }
+ return(LF_OK);
+ }
+ ERROR(("mlinint: deg=0,1 only"));
+ return(LF_ERR);
+}
+
+void prodintresp(resp,prod_wk,dim,deg,p)
+double *resp, prod_wk[MXDIM][2*MXDEG+1];
+int dim, deg, p;
+{ double prod;
+ int i, j, k, j1, k1;
+
+ prod = 1.0;
+ for (i=0; i<dim; i++) prod *= prod_wk[i][0];
+ resp[0] += prod;
+ if (deg==0) return;
+
+ for (j1=1; j1<=deg; j1++)
+ { for (j=0; j<dim; j++)
+ { prod = 1.0;
+ for (i=0; i<dim; i++) prod *= prod_wk[i][j1*(j==i)];
+ prod /= fact[j1];
+ resp[1 + (j1-1)*dim +j] += prod;
+ }
+ }
+
+ for (k1=1; k1<=deg; k1++)
+ for (j1=k1; j1<=deg; j1++)
+ { for (k=0; k<dim; k++)
+ for (j=0; j<dim; j++)
+ { prod = 1.0;
+ for (i=0; i<dim; i++) prod *= prod_wk[i][k1*(k==i) + j1*(j==i)];
+ prod /= fact[k1]*fact[j1];
+ resp[ (1+(k1-1)*dim+k)*p + 1+(j1-1)*dim+j] += prod;
+ }
+ }
+}
+
+int prodint(t,resp,resp2,coef,h)
+double *t, *resp, *resp2, *coef, h;
+{ int dim, p, i, j, k, st=0;
+ double cf[MXDEG+1], hj, hs, prod_wk[MXDIM][2*MXDEG+1];
+
+ dim = den_lfd->d;
+ p = den_des->p;
+ for (i=0; i<p*p; i++) resp[i] = 0.0;
+ cf[0] = coef[0];
+
+/* compute the one dimensional terms
+ */
+ for (i=0; i<dim; i++)
+ { hj = 1; hs = h*den_lfd->sca[i];
+ for (j=0; j<deg(den_sp); j++)
+ { hj *= hs;
+ cf[j+1] = hj*coef[ j*dim+i+1 ];
+ }
+ st = onedint(den_sp,cf,ilim[i]/hs,ilim[i+dim]/hs,prod_wk[i]);
+ if (st==LF_BADP) return(st);
+ hj = 1;
+ for (j=0; j<=2*deg(den_sp); j++)
+ { hj *= hs;
+ prod_wk[i][j] *= hj;
+ }
+ cf[0] = 0.0; /* so we only include it once, when d>=2 */
+ }
+
+/* transfer to the resp array
+ */
+ prodintresp(resp,prod_wk,dim,deg(den_sp),p);
+
+/* Symmetrize.
+*/
+ for (k=0; k<p; k++)
+ for (j=k; j<p; j++)
+ resp[j*p+k] = resp[k*p+j];
+
+ return(st);
+}
+
+int gausint(t,resp,C,cf,h,sca)
+double *t, *resp, *C, *cf, h, *sca;
+{ double nb, det, z, *P;
+ int d, p, i, j, k, l, m1, m2, f;
+ d = den_lfd->d; p = den_des->p;
+ m1 = d+1; nb = 0;
+ P = &C[d*d];
+ resp[0] = 1;
+ for (i=0; i<d; i++)
+ { C[i*d+i] = SQR(GFACT/(h*sca[i]))-cf[m1++];
+ for (j=i+1; j<d; j++) C[i*d+j] = C[j*d+i] = -cf[m1++];
+ }
+ eig_dec(C,P,d);
+ det = 1;
+ for (i=1; i<=d; i++)
+ { det *= C[(i-1)*(d+1)];
+ if (det <= 0) return(LF_BADP);
+ resp[i] = cf[i];
+ for (j=1; j<=d; j++) resp[j+i*p] = 0;
+ resp[i+i*p] = 1;
+ svdsolve(&resp[i*p+1],u,P,C,P,d,0.0);
+ }
+ svdsolve(&resp[1],u,P,C,P,d,0.0);
+ det = sqrt(det);
+ for (i=1; i<=d; i++)
+ { nb += cf[i]*resp[i];
+ resp[i*p] = resp[i];
+ for (j=1; j<=d; j++)
+ resp[i+p*j] += resp[i]*resp[j];
+ }
+ m1 = d;
+ for (i=1; i<=d; i++)
+ for (j=i; j<=d; j++)
+ { m1++; f = 1+(i==j);
+ resp[m1] = resp[m1*p] = resp[i*p+j]/f;
+ m2 = d;
+ for (k=1; k<=d; k++)
+ { resp[m1+k*p] = resp[k+m1*p] =
+ ( resp[i]*resp[j*p+k] + resp[j]*resp[i*p+k]
+ + resp[k]*resp[i*p+j] - 2*resp[i]*resp[j]*resp[k] )/f;
+ for (l=k; l<=d; l++)
+ { m2++; f = (1+(i==j))*(1+(k==l));
+ resp[m1+m2*p] = resp[m2+m1*p] = ( resp[i+j*p]*resp[k+l*p]
+ + resp[i+k*p]*resp[j+l*p] + resp[i+l*p]*resp[j+k*p]
+ - 2*resp[i]*resp[j]*resp[k]*resp[l] )/f;
+ } } }
+ z = lf_exp(d*0.918938533+cf[0]+nb/2)/det;
+ multmatscal(resp,z,p*p);
+ return(LF_OK);
+}
+
+int likeden(coef, lk0, f1, A)
+double *coef, *lk0, *f1, *A;
+{ double lk=0.0, r;
+ int i, j, p, rstat;
+
+ lf_status = LF_OK;
+ p = den_des->p;
+ if ((link(den_sp)==LIDENT) && (coef[0] != 0.0)) return(NR_BREAK);
+ lf_status = (den_des->itype)(den_des->xev,A,den_des->xtwx.Q,coef,den_des->h);
+ if (lf_error) lf_status = LF_ERR;
+ if (lf_status==LF_BADP)
+ { *lk0 = -1.0e300;
+ return(NR_REDUCE);
+ }
+ if (lf_status!=LF_OK) return(NR_BREAK);
+ if (lf_debug>2) prresp(coef,A,p);
+
+ den_des->xtwx.p = p;
+ rstat = NR_OK;
+ switch(link(den_sp))
+ { case LLOG:
+ r = den_des->ss[0]/A[0];
+ coef[0] += log(r);
+ multmatscal(A,r,p*p);
+ A[0] = den_des->ss[0];
+ lk = -A[0];
+ if (fabs(coef[0]) > 700)
+ { lf_status = LF_OOB;
+ rstat = NR_REDUCE;
+ }
+ for (i=0; i<p; i++)
+ { lk += coef[i]*den_des->ss[i];
+ f1[i] = den_des->ss[i]-A[i];
+ }
+ break;
+ case LIDENT:
+ lk = 0.0;
+ for (i=0; i<p; i++)
+ { f1[i] = den_des->ss[i];
+ for (j=0; j<p; j++)
+ den_des->res[i] -= A[i*p+j]*coef[j];
+ }
+ break;
+ }
+ *lk0 = den_des->llk = lk;
+
+ return(rstat);
+}
+
+int inre(x,bound,d)
+double *x, *bound;
+int d;
+{ int i, z;
+ z = 1;
+ for (i=0; i<d; i++)
+ if (bound[i]<bound[i+d])
+ z &= (x[i]>=bound[i]) & (x[i]<=bound[i+d]);
+ return(z);
+}
+
+int setintlimits(lfd, x, h, ang, lset)
+lfdata *lfd;
+int *ang, *lset;
+double *x, h;
+{ int d, i;
+ d = lfd->d;
+ *ang = *lset = 0;
+ for (i=0; i<d; i++)
+ { if (lfd->sty[i]==STANGL)
+ { ilim[i+d] = ((h<2) ? 2*asin(h/2) : PI)*lfd->sca[i];
+ ilim[i] = -ilim[i+d];
+ *ang = 1;
+ }
+ else
+ { ilim[i+d] = h*lfd->sca[i];
+ ilim[i] = -ilim[i+d];
+
+ if (lfd->sty[i]==STLEFT) { ilim[i+d] = 0; *lset = 1; }
+ if (lfd->sty[i]==STRIGH) { ilim[i] = 0; *lset = 1; }
+
+ if (lfd->xl[i]<lfd->xl[i+d]) /* user limits for this variable */
+ { if (lfd->xl[i]-x[i]> ilim[i])
+ { ilim[i] = lfd->xl[i]-x[i]; *lset=1; }
+ if (lfd->xl[i+d]-x[i]< ilim[i+d])
+ { ilim[i+d] = lfd->xl[i+d]-x[i]; *lset=1; }
+ }
+ }
+ if (ilim[i]==ilim[i+d]) return(LF_DEMP); /* empty integration */
+ }
+ return(LF_OK);
+}
+
+int selectintmeth(itype,lset,ang)
+int itype, lset, ang;
+{
+ if (itype==IDEFA) /* select the default method */
+ { if (fam(den_sp)==THAZ)
+ { if (ang) return(IDEFA);
+ return( IHAZD );
+ }
+
+ if (ubas(den_sp)) return(IMULT);
+
+ if (ang) return(IMULT);
+
+ if (iscompact(ker(den_sp)))
+ { if (kt(den_sp)==KPROD) return(IPROD);
+ if (lset)
+ return( (den_lfd->d==1) ? IPROD : IMULT );
+ if (deg(den_sp)<=1) return(IMLIN);
+ if (den_lfd->d==1) return(IPROD);
+ return(IMULT);
+ }
+
+ if (ker(den_sp)==WGAUS)
+ { if (lset) WARN(("Integration for Gaussian weights ignores limits"));
+ if ((den_lfd->d==1)|(kt(den_sp)==KPROD)) return(IPROD);
+ if (deg(den_sp)<=1) return(IMLIN);
+ if (deg(den_sp)==2) return(IMULT);
+ }
+
+ return(IDEFA);
+ }
+
+ /* user provided an integration method, check it is valid */
+
+ if (fam(den_sp)==THAZ)
+ { if (ang) return(INVLD);
+ if (!iscompact(ker(den_sp))) return(INVLD);
+ return( ((kt(den_sp)==KPROD) | (kt(den_sp)==KSPH)) ? IHAZD : INVLD );
+ }
+
+ if ((ang) && (itype != IMULT)) return(INVLD);
+
+ switch(itype)
+ { case IMULT:
+ if (ker(den_sp)==WGAUS) return(deg(den_sp)==2);
+ return( iscompact(ker(den_sp)) ? IMULT : INVLD );
+ case IPROD: return( ((den_lfd->d==1) | (kt(den_sp)==KPROD)) ? IPROD : INVLD );
+ case IMLIN: return( ((kt(den_sp)==KSPH) && (!lset) &&
+ (deg(den_sp)<=1)) ? IMLIN : INVLD );
+ }
+
+ return(INVLD);
+}
+
+int densinit(lfd,des,sp,cf)
+lfdata *lfd;
+design *des;
+smpar *sp;
+double *cf;
+{ int p, i, ii, j, nnz, rnz, ang, lset, status;
+ double w;
+
+ den_lfd = lfd;
+ den_des = des;
+ den_sp = sp;
+
+ p = des->p;
+ ff = des->xtwx.wk;
+ cf[0] = NOSLN;
+ for (i=1; i<p; i++) cf[i] = 0.0;
+
+ if (!inre(des->xev,lfd->xl,lfd->d)) return(LF_XOOR);
+
+ status = setintlimits(lfd,des->xev,des->h,&ang,&lset);
+ if (status != LF_OK) return(status);
+
+ switch(selectintmeth(de_itype,lset,ang))
+ { case IMULT: des->itype = multint; break;
+ case IPROD: des->itype = prodint; break;
+ case IMLIN: des->itype = mlinint; break;
+ case IHAZD: des->itype = hazint; break;
+ case INVLD: ERROR(("Invalid integration method %d",de_itype));
+ break;
+ case IDEFA: ERROR(("No integration type available for this model"));
+ break;
+ default: ERROR(("densinit: unknown integral type"));
+ }
+
+ switch(deg(den_sp))
+ { case 0: rnz = 1; break;
+ case 1: rnz = 1; break;
+ case 2: rnz = lfd->d+1; break;
+ case 3: rnz = lfd->d+2; break;
+ default: ERROR(("densinit: invalid degree %d",deg(den_sp)));
+ }
+ if (lf_error) return(LF_ERR);
+
+ setzero(des->ss,p);
+ nnz = 0;
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ if (!cens(lfd,ii))
+ { w = des->w[i]*prwt(lfd,ii);
+ for (j=0; j<p; j++) des->ss[j] += d_xij(des,i,j)*w;
+ if (des->w[i]>0.00001) nnz++;
+ } }
+
+ if (fam(den_sp)==THAZ) haz_init(lfd,des,sp,ilim);
+
+ if (lf_debug>2)
+ { printf(" LHS: ");
+ for (i=0; i<p; i++) printf(" %8.5f",des->ss[i]);
+ printf("\n");
+ }
+
+ switch(link(den_sp))
+ { case LIDENT:
+ cf[0] = 0.0;
+ return(LF_OK);
+ case LLOG:
+ if (nnz<rnz) { cf[0] = -1000; return(LF_DNOP); }
+ cf[0] = 0.0;
+ return(LF_OK);
+ default:
+ ERROR(("unknown link in densinit"));
+ return(LF_ERR);
+ }
+}
diff --git a/src/design.h b/src/design.h
new file mode 100755
index 0000000..2087a9c
--- /dev/null
+++ b/src/design.h
@@ -0,0 +1,36 @@
+/*
+ * Copyright (c) 1998-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * The design structure used in Locfit, and associated macro definitions.
+ */
+
+typedef struct {
+ int des_init_id;
+ double *wk;
+ Sint *ind;
+ int lwk, lind;
+
+ double *xev; /* fitting point, length p */
+ double *X; /* design matrix, length n*p */
+ double *w, *di, *res, *th, *wd, h;
+ double *V, *P; /* matrices with length p*p */
+ double *f1, *ss, *oc, *cf; /* work vectors, length p */
+ double llk, smwt;
+ jacobian xtwx; /* to store X'WVX and decomposition */
+ int cfn[1+MXDIM], ncoef;
+ Sint *fix; /* integer vector for fixed coefficients. */
+ int (*itype)(); /* density integration function */
+ int n, p;
+ int (*vfun)(); /* pointer to the vertex processing function. */
+} design;
+
+#define cfn(des,i) (des->cfn[i])
+#define d_x(des) ((des)->X)
+#define d_xi(des,i) (&(des)->X[i*((des)->p)])
+#define d_xij(des,i,j) ((des)->X[i*((des)->p)+j])
+#define is_fixed(des,i) ((des)->fix[i]==1)
+#define DES_INIT_ID 34988372
+
+extern int des_reqd(), des_reqi();
diff --git a/src/ev_atree.c b/src/ev_atree.c
new file mode 100755
index 0000000..bdcc251
--- /dev/null
+++ b/src/ev_atree.c
@@ -0,0 +1,215 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ * This file contains functions for constructing and
+ * interpolating the adaptive tree structure. This is
+ * the default evaluation structure used by Locfit.
+ */
+
+#include "local.h"
+
+/*
+ Guess the number of fitting points.
+ Needs improving!
+*/
+void atree_guessnv(evs,nvm,ncm,vc,d,alp)
+evstruc *evs;
+double alp;
+int *nvm, *ncm, *vc, d;
+{ double a0, cu, ifl;
+ int i, nv, nc;
+
+ *ncm = 1<<30; *nvm = 1<<30;
+ *vc = 1 << d;
+
+ if (alp>0)
+ { a0 = (alp > 1) ? 1 : 1/alp;
+ if (cut(evs)<0.01)
+ { WARN(("guessnv: cut too small."));
+ cut(evs) = 0.01;
+ }
+ cu = 1;
+ for (i=0; i<d; i++) cu *= MIN(1.0,cut(evs));
+ nv = (int)((5*a0/cu+1)**vc); /* this allows 10*a0/cu splits */
+ nc = (int)(10*a0/cu+1); /* and 10*a0/cu cells */
+ if (nv<*nvm) *nvm = nv;
+ if (nc<*ncm) *ncm = nc;
+ }
+
+ if (*nvm == 1<<30) /* by default, allow 100 splits */
+ { *nvm = 102**vc;
+ *ncm = 201;
+ }
+
+ /* inflation based on mk */
+ ifl = mk(evs)/100.0;
+ *nvm = (int)(ifl**nvm);
+ *ncm = (int)(ifl**ncm);
+
+}
+
+/*
+ Determine whether a cell in the tree needs splitting.
+ If so, return the split variable (0..d-1).
+ Otherwise, return -1.
+*/
+int atree_split(lf,ce,le,ll,ur)
+lfit *lf;
+Sint *ce;
+double *le, *ll, *ur;
+{ int d, vc, i, is;
+ double h, hmin, score[MXDIM];
+ d = lf->fp.d; vc = 1<<d;
+
+ hmin = 0.0;
+ for (i=0; i<vc; i++)
+ { h = lf->fp.h[ce[i]];
+ if ((h>0) && ((hmin==0)|(h<hmin))) hmin = h;
+ }
+
+ is = 0;
+ for (i=0; i<d; i++)
+ { le[i] = (ur[i]-ll[i])/lf->lfd.sca[i];
+ if ((lf->lfd.sty[i]==STCPAR) || (hmin==0))
+ score[i] = 2*(ur[i]-ll[i])/(lf->evs.fl[i+d]-lf->evs.fl[i]);
+ else
+ score[i] = le[i]/hmin;
+ if (score[i]>score[is]) is = i;
+ }
+ if (cut(&lf->evs)<score[is]) return(is);
+ return(-1);
+}
+
+/*
+ recursively grow the tree structure, begining with the parent cell.
+*/
+void atree_grow(des,lf,ce,ct,term,ll,ur)
+design *des;
+lfit *lf;
+Sint *ce, *ct, *term;
+double *ll, *ur;
+{ Sint nce[1<<MXDIM];
+ int i, i0, i1, d, vc, pv, tk, ns;
+ double le[MXDIM], z;
+ d = lf->fp.d; vc = 1<<d;
+
+ /* does this cell need splitting?
+ If not, wrap up and return.
+ */
+ ns = atree_split(lf,ce,le,ll,ur);
+ if (ns==-1)
+ { if (ct != NULL) /* reconstructing terminal cells */
+ { for (i=0; i<vc; i++) term[*ct*vc+i] = ce[i];
+ (*ct)++;
+ }
+ return;
+ }
+
+ /* split the cell at the midpoint on side ns */
+ tk = 1<<ns;
+ for (i=0; i<vc; i++)
+ { if ((i&tk)==0) nce[i] = ce[i];
+ else
+ { i0 = ce[i];
+ i1 = ce[i-tk];
+ pv = (lf->lfd.sty[i]!=STCPAR) &&
+ (le[ns] < (cut(&lf->evs)*MIN(lf->fp.h[i0],lf->fp.h[i1])));
+ nce[i] = newsplit(des,lf,i0,i1,pv);
+ if (lf_error) return;
+ }
+ }
+ z = ur[ns]; ur[ns] = (z+ll[ns])/2;
+ atree_grow(des,lf,nce,ct,term,ll,ur);
+ if (lf_error) return;
+ ur[ns] = z;
+ for (i=0; i<vc; i++)
+ nce[i] = ((i&tk)== 0) ? nce[i+tk] : ce[i];
+ z = ll[ns]; ll[ns] = (z+ur[ns])/2;
+ atree_grow(des,lf,nce,ct,term,ll,ur);
+ ll[ns] = z;
+}
+
+void atree_start(des,lf)
+design *des;
+lfit *lf;
+{ int d, i, j, k, vc, ncm, nvm;
+ double ll[MXDIM], ur[MXDIM];
+
+ if (lf_debug>1) printf(" In atree_start\n");
+ d = lf->fp.d;
+ atree_guessnv(&lf->evs,&nvm,&ncm,&vc,d,nn(&lf->sp));
+ if (lf_debug>2) printf(" atree_start: nvm %d ncm %d\n",nvm,ncm);
+ trchck(lf,nvm,ncm,vc);
+
+ /* Set the lower left, upper right limits. */
+ for (j=0; j<d; j++)
+ { ll[j] = lf->evs.fl[j];
+ ur[j] = lf->evs.fl[j+d];
+ }
+
+ /* Set the initial cell; fit at the vertices. */
+ for (i=0; i<vc; i++)
+ { j = i;
+ for (k=0; k<d; ++k)
+ { evptx(&lf->fp,i,k) = (j%2) ? ur[k] : ll[k];
+ j >>= 1;
+ }
+ lf->evs.ce[i] = i;
+ des->vfun(des,lf,i);
+ if (lf_error) return;
+ lf->evs.s[i] = 0;
+ }
+ lf->fp.nv = vc;
+
+ /* build the tree */
+ atree_grow(des,lf,lf->evs.ce,NULL,NULL,ll,ur);
+ lf->evs.nce = 1;
+}
+
+double atree_int(lf,x,what)
+lfit *lf;
+double *x;
+int what;
+{ double vv[64][64], *ll, *ur, h, xx[MXDIM];
+ int lo, tk, ns, nv, nc=0, d, i, vc;
+ Sint ce[64];
+
+fitpt *fp;
+evstruc *evs;
+fp = &lf->fp;
+evs= &lf->evs;
+
+ d = fp->d;
+ vc = 1<<d;
+ for (i=0; i<vc; i++)
+ { setzero(vv[i],vc);
+ nc = exvval(fp,vv[i],i,d,what,1);
+ ce[i] = evs->ce[i];
+ }
+ ns = 0;
+ while(ns!=-1)
+ { ll = evpt(fp,ce[0]); ur = evpt(fp,ce[vc-1]);
+ ns = atree_split(lf,ce,xx,ll,ur);
+ if (ns!=-1)
+ { tk = 1<<ns;
+ h = ur[ns]-ll[ns];
+ lo = (2*(x[ns]-ll[ns])) < h;
+ for (i=0; i<vc; i++) if ((tk&i)==0)
+ { nv = findpt(fp,evs,(int)ce[i],(int)ce[i+tk]);
+ if (nv==-1) ERROR(("Descend tree problem"));
+ if (lf_error) return(0.0);
+ if (lo)
+ { ce[i+tk] = nv;
+ if (evs->s[nv]) exvvalpv(vv[i+tk],vv[i],vv[i+tk],d,ns,h,nc);
+ else exvval(fp,vv[i+tk],nv,d,what,1);
+ }
+ else
+ { ce[i] = nv;
+ if (evs->s[nv]) exvvalpv(vv[i],vv[i],vv[i+tk],d,ns,h,nc);
+ else exvval(fp,vv[i],nv,d,what,1);
+ } }
+ } }
+ ll = evpt(fp,ce[0]); ur = evpt(fp,ce[vc-1]);
+ return(rectcell_interp(x,vv,ll,ur,d,nc));
+}
diff --git a/src/ev_interp.c b/src/ev_interp.c
new file mode 100755
index 0000000..30aac2d
--- /dev/null
+++ b/src/ev_interp.c
@@ -0,0 +1,267 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+double linear_interp(h,d,f0,f1)
+double h, d, f0, f1;
+{ if (d==0) return(f0);
+ return( ( (d-h)*f0 + h*f1 ) / d );
+}
+
+void hermite2(x,z,phi)
+double x, z, *phi;
+{ double h;
+ if (z==0)
+ { phi[0] = 1.0; phi[1] = phi[2] = phi[3] = 0.0;
+ return;
+ }
+ h = x/z;
+ if (h<0)
+ { phi[0] = 1; phi[1] = 0;
+ phi[2] = h; phi[3] = 0;
+ return;
+ }
+ if (h>1)
+ { phi[0] = 0; phi[1] = 1;
+ phi[2] = 0; phi[3] = h-1;
+ return;
+ }
+ phi[1] = h*h*(3-2*h);
+ phi[0] = 1-phi[1];
+ phi[2] = h*(1-h)*(1-h);
+ phi[3] = h*h*(h - 1);
+}
+
+double cubic_interp(h,f0,f1,d0,d1)
+double h, f0, f1, d0, d1;
+{ double phi[4];
+ hermite2(h,1.0,phi);
+ return(phi[0]*f0+phi[1]*f1+phi[2]*d0+phi[3]*d1);
+}
+
+double cubintd(h,f0,f1,d0,d1)
+double h, f0, f1, d0, d1;
+{ double phi[4];
+ phi[1] = 6*h*(1-h);
+ phi[0] = -phi[1];
+ phi[2] = (1-h)*(1-3*h);
+ phi[3] = h*(3*h-2);
+ return(phi[0]*f0+phi[1]*f1+phi[2]*d0+phi[3]*d1);
+}
+
+/*
+ interpolate over a rectangular cell.
+ x = interpolation point.
+ vv = array of vertex values.
+ ll = lower left corner.
+ ur = upper right corner.
+ d = dimension.
+ nc = no of coefficients.
+*/
+double rectcell_interp(x,vv,ll,ur,d,nc)
+double *x, vv[64][64], *ll, *ur;
+int d, nc;
+{ double phi[4];
+ int i, j, k, tk;
+
+ tk = 1<<d;
+ for (i=0; i<tk; i++) if (vv[i][0]==NOSLN) return(NOSLN);
+
+ /* no derivatives - use multilinear interpolation */
+ if (nc==1)
+ { for (i=d-1; i>=0; i--)
+ { tk = 1<<i;
+ for (j=0; j<tk; j++)
+ vv[j][0] = linear_interp(x[i]-ll[i],ur[i]-ll[i],vv[j][0],vv[j+tk][0]);
+ }
+ return(vv[0][0]);
+ }
+
+ /* with derivatives -- use cubic */
+ if (nc==d+1)
+ { for (i=d-1; i>=0; i--)
+ { hermite2(x[i]-ll[i],ur[i]-ll[i],phi);
+ tk = 1<<i;
+ phi[2] *= ur[i]-ll[i];
+ phi[3] *= ur[i]-ll[i];
+ for (j=0; j<tk; j++)
+ { vv[j][0] = phi[0]*vv[j][0] + phi[1]*vv[j+tk][0]
+ + phi[2]*vv[j][i+1] + phi[3]*vv[j+tk][i+1];
+ for (k=1; k<=i; k++)
+ vv[j][k] = phi[0]*vv[j][k] + phi[1]*vv[j+tk][k];
+ }
+ }
+ return(vv[0][0]);
+ }
+
+ /* with all coefs -- use multicubic */
+ for (i=d-1; i>=0; i--)
+ { hermite2(x[i]-ll[i],ur[i]-ll[i],phi);
+ tk = 1<<i;
+ phi[2] *= ur[i]-ll[i];
+ phi[3] *= ur[i]-ll[i];
+ for (j=0; j<tk; j++)
+ for (k=0; k<tk; k++)
+ vv[j][k] = phi[0]*vv[j][k] + phi[1]*vv[j+tk][k]
+ + phi[2]*vv[j][k+tk] + phi[3]*vv[j+tk][k+tk];
+ }
+ return(vv[0][0]);
+}
+
+int exvval(fp,vv,nv,d,what,z)
+fitpt *fp;
+double *vv;
+int nv, d, z, what;
+{ int i, k;
+ double *values;
+
+ k = (z) ? 1<<d : d+1;
+ for (i=1; i<k; i++) vv[i] = 0.0;
+ switch(what)
+ { case PCOEF:
+ values = fp->coef;
+ break;
+ case PVARI:
+ case PNLX:
+ values = fp->nlx;
+ break;
+ case PT0:
+ values = fp->t0;
+ break;
+ case PBAND:
+ vv[0] = fp->h[nv];
+ return(1);
+ case PDEGR:
+ vv[0] = fp->deg[nv];
+ return(1);
+ case PLIK:
+ vv[0] = fp->lik[nv];
+ return(1);
+ case PRDF:
+ vv[0] = fp->lik[2*fp->nvm+nv];
+ return(1);
+ default:
+ ERROR(("Invalid what in exvval"));
+ return(0);
+ }
+ vv[0] = values[nv];
+ if (!fp->hasd) return(1);
+ if (z)
+ { for (i=0; i<d; i++) vv[1<<i] = values[(i+1)*fp->nvm+nv];
+ return(1<<d);
+ }
+ else
+ { for (i=1; i<=d; i++) vv[i] = values[i*fp->nvm+nv];
+ return(d+1);
+ }
+}
+
+void exvvalpv(vv,vl,vr,d,k,dl,nc)
+double *vv, *vl, *vr, dl;
+int d, k, nc;
+{ int i, tk, td;
+ double f0, f1;
+ if (nc==1)
+ { vv[0] = (vl[0]+vr[0])/2;
+ return;
+ }
+ tk = 1<<k;
+ td = 1<<d;
+ for (i=0; i<td; i++) if ((i&tk)==0)
+ { f0 = (vl[i]+vr[i])/2 + dl*(vl[i+tk]-vr[i+tk])/8;
+ f1 = 1.5*(vr[i]-vl[i])/dl - (vl[i+tk]+vr[i+tk])/4;
+ vv[i] = f0;
+ vv[i+tk] = f1;
+ }
+}
+
+double grid_int(fp,evs,x,what)
+fitpt *fp;
+evstruc *evs;
+double *x;
+int what;
+{ int d, i, j, jj, nc=0, sk, v[MXDIM], vc, z0, nce[1<<MXDIM], *mg;
+ double *ll, *ur, vv[64][64], z;
+
+ d = fp->d;
+ ll = evpt(fp,0); ur = evpt(fp,fp->nv-1);
+ mg = mg(evs);
+
+ z0 = 0; vc = 1<<d;
+ for (j=d-1; j>=0; j--)
+ { v[j] = (int)((mg[j]-1)*(x[j]-ll[j])/(ur[j]-ll[j]));
+ if (v[j]<0) v[j]=0;
+ if (v[j]>=mg[j]-1) v[j] = mg[j]-2;
+ z0 = z0*mg[j]+v[j];
+ }
+ nce[0] = z0; nce[1] = z0+1; sk = jj = 1;
+ for (i=1; i<d; i++)
+ { sk *= mg[i-1];
+ jj<<=1;
+ for (j=0; j<jj; j++)
+ nce[j+jj] = nce[j]+sk;
+ }
+ for (i=0; i<vc; i++)
+ nc = exvval(fp,vv[i],nce[i],d,what,1);
+ ll = evpt(fp,nce[0]);
+ ur = evpt(fp,nce[vc-1]);
+ z = rectcell_interp(x,vv,ll,ur,d,nc);
+ return(z);
+}
+
+double fitp_int(fp,x,what,i)
+fitpt *fp;
+double *x;
+int what, i;
+{ double vv[1+MXDIM];
+ exvval(fp,vv,i,fp->d,what,0);
+ return(vv[0]);
+}
+
+double xbar_int(fp,x,what)
+fitpt *fp;
+double *x;
+int what;
+{ int i, nc;
+ double vv[1+MXDIM], f;
+ nc = exvval(fp,vv,0,fp->d,what,0);
+ f = vv[0];
+ if (nc>1)
+ for (i=0; i<fp->d; i++)
+ f += vv[i+1]*(x[i]-evptx(fp,0,i));
+ return(f);
+}
+
+double dointpoint(lf,x,what,ev,j)
+lfit *lf;
+double *x;
+int what, ev, j;
+{ double xf, f=0.0;
+ int i;
+ fitpt *fp;
+ evstruc *evs;
+
+ fp = &lf->fp; evs = &lf->evs;
+ for (i=0; i<fp->d; i++) if (lf->lfd.sty[i]==STANGL)
+ { xf = floor(x[i]/(2*PI*lf->lfd.sca[i]));
+ x[i] -= xf*2*PI*lf->lfd.sca[i];
+ }
+
+ switch(ev)
+ { case EGRID: f = grid_int(fp,evs,x,what); break;
+ case EKDTR: f = kdtre_int(fp,evs,x,what); break;
+ case ETREE: f = atree_int(lf,x,what); break;
+ case EPHULL: f = triang_int(lf,x,what); break;
+ case EFITP: f = fitp_int(fp,x,what,j); break;
+ case EXBAR: f = xbar_int(fp,x,what); break;
+ case ENONE: f = 0; break;
+ case ESPHR: f = sphere_int(lf,x,what); break;
+ default: ERROR(("dointpoint: cannot interpolate structure %d",ev));
+ }
+ if (((what==PT0)|(what==PNLX)) && (f<0)) f = 0.0;
+ f += addparcomp(lf,x,what);
+ return(f);
+}
diff --git a/src/ev_kdtre.c b/src/ev_kdtre.c
new file mode 100755
index 0000000..0d5860e
--- /dev/null
+++ b/src/ev_kdtre.c
@@ -0,0 +1,341 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ * Routines for building and interpolating the kd tree.
+ * Initially, this started from the loess code.
+ *
+ * Todo: EKDCE isn't working.
+ */
+
+#include "local.h"
+
+void newcell();
+static int nterm;
+
+void kdtre_guessnv(evs,nvm,ncm,vc,n,d,alp)
+evstruc *evs;
+double alp;
+int *nvm, *ncm, *vc, n, d;
+{ int k;
+ if (ev(evs) == EKDTR)
+ { nterm = (int)(cut(evs)/4 * n * MIN(alp,1.0) );
+ k = 2*n/nterm;
+ *vc = 1<<d;
+ *ncm = 2*k+1;
+ *nvm = (k+2)**vc/2;
+ return;
+ }
+ if (ev(evs) == EKDCE)
+ { nterm = (int)(n * alp);
+ *vc = 1;
+ *nvm = 1+(int)(2*n/nterm);
+ *ncm = 2**nvm+1;
+ return;
+ }
+ *nvm = *ncm = *vc = 0;
+ return;
+}
+
+/*
+ Split x[pi[l..r]] into two equal sized sets.
+
+ Let m=(l+r)/2.
+ At return,
+ x[pi[l..m]] < x[pi[m+1..r]].
+ Assuming no ties:
+ If l+r is odd, the sets have the same size.
+ If l+r is even, the low set is larger by 1.
+ If there are ties, all ties go in the low set.
+*/
+int ksmall(l, r, m, x, pi)
+Sint *pi;
+int l, r, m;
+double *x;
+{
+ int il, ir, jl, jr;
+ double t;
+
+
+ while(l<r)
+ { t = x[pi[m]];
+
+ /*
+ permute the observations so that
+ x[pi[l..il]] < t <= x[pi[ir..r]].
+ */
+ ir = l; il = r;
+ while (ir<il)
+ { while ((ir<=r) && (x[pi[ir]] < t)) ir++;
+ while ((il>=l) && (x[pi[il]]>= t)) il--;
+ if (ir<il) ISWAP(pi[ir],pi[il]);
+ }
+
+ /*
+ move = t to the middle:
+ x[pi[l..il]] < t
+ x[pi[jl..jr]] = t
+ x[pi[ir..r]] > t
+ */
+ jl = ir; jr = r;
+ while (ir<jr)
+ { while ((ir<=r) && (x[pi[ir]]== t)) ir++;
+ while ((jr>=jl) && (x[pi[jr]] > t)) jr--;
+ if (ir<jr) ISWAP(pi[ir],pi[jr]);
+ }
+
+ /*
+ we're done if m is in the middle, jl <= m <= jr.
+ */
+ if ((jl<=m) & (jr>=m)) return(jr);
+
+ /*
+ update l or r.
+ */
+ if (m>=ir) l = ir;
+ if (m<=il) r = il;
+ }
+ if (l==r) return(l);
+ ERROR(("ksmall failure"));
+ return(0);
+}
+
+int terminal(lf,p,pi,fc,d,m,split_val)
+lfit *lf;
+Sint *pi;
+int p, d, fc, *m;
+double *split_val;
+{ int i, k, lo, hi, split_var;
+ double max, min, score, max_score, t;
+
+ /*
+ if there are fewer than fc points in the cell, this cell
+ is terminal.
+ */
+ lo = lf->evs.lo[p]; hi = lf->evs.hi[p];
+ if (hi-lo < fc) return(-1);
+
+ /* determine the split variable */
+ max_score = 0.0; split_var = 0;
+ for (k=0; k<d; k++)
+ { max = min = datum(&lf->lfd, k, pi[lo]);
+ for (i=lo+1; i<=hi; i++)
+ { t = datum(&lf->lfd,k,pi[i]);
+ if (t<min) min = t;
+ if (t>max) max = t;
+ }
+ score = (max-min) / lf->lfd.sca[k];
+ if (score > max_score)
+ { max_score = score;
+ split_var = k;
+ }
+ }
+ if (max_score==0) /* all points in the cell are equal */
+ return(-1);
+
+ *m = ksmall(lo,hi,(lo+hi)/2, dvari(&lf->lfd,split_var), pi);
+ *split_val = datum(&lf->lfd, split_var, pi[*m]);
+
+ if (*m==hi) /* all observations go lo */
+ return(-1);
+ return(split_var);
+}
+
+void kdtre_start(des,lf)
+design *des;
+lfit *lf;
+{ Sint *pi;
+ int i, j, vc, d, nc, nv, ncm, nvm, k, m, n, p;
+ double sv;
+ d = lf->lfd.d; n = lf->lfd.n; pi = des->ind;
+ kdtre_guessnv(&lf->evs,&nvm,&ncm,&vc,n,d,nn(&lf->sp));
+ trchck(lf,nvm,ncm,vc);
+
+ nv = 0;
+ if (ev(&lf->evs) != EKDCE)
+ { for (i=0; i<vc; i++)
+ { j = i;
+ for (k=0; k<d; ++k)
+ { evptx(&lf->fp,i,k) = lf->evs.fl[d*(j%2)+k];
+ j >>= 1;
+ }
+ }
+ nv = vc;
+ for (j=0; j<vc; j++) lf->evs.ce[j] = j;
+ }
+
+ for (i=0; i<n; i++) pi[i] = i;
+ p = 0; nc = 1;
+ lf->evs.lo[p] = 0; lf->evs.hi[p] = n-1;
+ lf->evs.s[p] = -1;
+ while (p<nc)
+ { k = terminal(lf,p,pi,nterm,d,&m,&sv);
+ if (k>=0)
+ {
+ if ((ncm<nc+2) | (2*nvm<2*nv+vc))
+ { WARN(("Insufficient space for full tree"));
+ lf->evs.nce = nc; lf->fp.nv = nv;
+ return;
+ }
+
+ /* new lo cell has obsn's lo[p]..m */
+ lf->evs.lo[nc] = lf->evs.lo[p];
+ lf->evs.hi[nc] = m;
+ lf->evs.s[nc] = -1;
+
+ /* new hi cell has obsn's m+1..hi[p] */
+ lf->evs.lo[nc+1] = m+1;
+ lf->evs.hi[nc+1] = lf->evs.hi[p];
+ lf->evs.s[nc+1] = -1;
+
+ /* cell p is split on variable k, value sv */
+ lf->evs.s[p] = k;
+ lf->evs.sv[p] = sv;
+ lf->evs.lo[p] = nc; lf->evs.hi[p] = nc+1;
+
+ nc=nc+2; i = nv;
+
+ /* now compute the new vertices. */
+ if (ev(&lf->evs) != EKDCE)
+ newcell(&nv,vc,evp(&lf->fp), d, k, sv,
+ &lf->evs.ce[p*vc], &lf->evs.ce[(nc-2)*vc], &lf->evs.ce[(nc-1)*vc]);
+
+ }
+ else if (ev(&lf->evs)==EKDCE) /* new vertex at cell center */
+ { sv = 0;
+ for (i=0; i<d; i++) evptx(&lf->fp,nv,i) = 0;
+ for (j=lf->evs.lo[p]; j<=lf->evs.hi[p]; j++)
+ { sv += prwt(&lf->lfd,(int)pi[j]);
+ for (i=0; i<d; i++)
+ evptx(&lf->fp,nv,i) += datum(&lf->lfd,i,pi[j])*prwt(&lf->lfd,(int)pi[j]);
+ }
+ for (i=0; i<d; i++) evptx(&lf->fp,nv,i) /= sv;
+ lf->lfd.n = lf->evs.hi[p] - lf->evs.lo[p] + 1;
+ des->ind = &pi[lf->evs.lo[p]]; /* why? */
+ des->vfun(des,lf,nv);
+ lf->lfd.n = n; des->ind = pi;
+ nv++;
+ }
+ p++;
+ }
+
+ /* We've built the tree. Now do the fitting. */
+ if (ev(&lf->evs)==EKDTR)
+ for (i=0; i<nv; i++) des->vfun(des,lf,i);
+
+ lf->evs.nce = nc; lf->fp.nv = nv;
+ return;
+}
+
+void newcell(nv,vc,xev, d, k, split_val, cpar, clef, crig)
+double *xev, split_val;
+Sint *cpar, *clef, *crig;
+int *nv, vc, d, k;
+{ int i, ii, j, j2, tk, match;
+ tk = 1<<k;
+ for (i=0; i<vc; i++)
+ { if ((i&tk) == 0)
+ { for (j=0; j<d; j++) xev[*nv*d+j] = xev[d*cpar[i]+j];
+ xev[*nv*d+k] = split_val;
+ match = 0; j = vc; /* no matches in first vc points */
+ while ((j<*nv) && (!match))
+ { j2 = 0;
+ while ((j2<d) && (xev[*nv*d+j2] == xev[j*d+j2])) j2++;
+ match = (j2==d);
+ if (!match) j++;
+ }
+ ii = i+tk;
+ clef[i] = cpar[i];
+ clef[ii]= crig[i] = j;
+ crig[ii]= cpar[ii];
+ if (!match) (*nv)++;
+ }
+ }
+ return;
+}
+
+extern void hermite2();
+
+double blend(fp,evs,s,x,ll,ur,j,nt,t,what)
+fitpt *fp;
+evstruc *evs;
+double s, *x, *ll, *ur;
+int j, nt, *t, what;
+{ Sint *ce;
+ int k, k1, m, nc, j0, j1;
+ double v0, v1, xibar, g0[3], g1[3], gg[4], gp[4], phi[4];
+ ce = evs->ce;
+ for (k=0; k<4; k++) /* North South East West */
+ { k1 = (k>1);
+ v0 = ll[k1]; v1 = ur[k1];
+ j0 = ce[j+2*(k==0)+(k==2)];
+ j1 = ce[j+3-2*(k==1)-(k==3)];
+ xibar = (k%2==0) ? ur[k<2] : ll[k<2];
+ m = nt;
+ while ((m>=0) && ((evs->s[t[m]] != (k<=1)) | (evs->sv[t[m]] != xibar))) m--;
+ if (m >= 0)
+ { m = (k%2==1) ? evs->lo[t[m]] : evs->hi[t[m]];
+ while (evs->s[m] != -1)
+ m = (x[evs->s[m]] < evs->sv[m]) ? evs->lo[m] : evs->hi[m];
+ if (v0 < evptx(fp,ce[4*m+2*(k==1)+(k==3)],k1))
+ { j0 = ce[4*m+2*(k==1)+(k==3)];
+ v0 = evptx(fp,j0,k1);
+ }
+ if (evptx(fp,ce[4*m+3-2*(k==0)-(k==2)],k1) < v1)
+ { j1 = ce[4*m+3-2*(k==0)-(k==2)];
+ v1 = evptx(fp,j1,k1);
+ }
+ }
+ nc = exvval(fp,g0,j0,2,what,0);
+ nc = exvval(fp,g1,j1,2,what,0);
+ if (nc==1)
+ gg[k] = linear_interp((x[(k>1)]-v0),v1-v0,g0[0],g1[0]);
+ else
+ { hermite2(x[(k>1)]-v0,v1-v0,phi);
+ gg[k] = phi[0]*g0[0]+phi[1]*g1[0]+(phi[2]*g0[1+k1]+phi[3]*g1[1+k1])*(v1-v0);
+ gp[k] = phi[0]*g0[2-k1] + phi[1]*g1[2-k1];
+ }
+ }
+ s = -s;
+ if (nc==1)
+ for (k=0; k<2; k++)
+ s += linear_interp(x[k]-ll[k],ur[k]-ll[k],gg[3-2*k],gg[2-2*k]);
+ else
+ for (k=0; k<2; k++) /* EW NS */
+ { hermite2(x[k]-ll[k],ur[k]-ll[k],phi);
+ s += phi[0]*gg[3-2*k] + phi[1]*gg[2-2*k]
+ +(phi[2]*gp[3-2*k] + phi[3]*gp[2-2*k]) * (ur[k]-ll[k]);
+ }
+ return(s);
+}
+
+double kdtre_int(fp,evs,x,what)
+fitpt *fp;
+evstruc *evs;
+double *x;
+int what;
+{ Sint *ce;
+ int k, vc, t[20], nt, nc, j, d;
+ double *ll, *ur, ff, vv[64][64];
+ d = fp->d;
+ vc = 1<<d;
+ if (d > 6) ERROR(("d too large in kdint"));
+
+ /* descend the tree to find the terminal cell */
+ nt = 0; t[nt] = 0; k = 0;
+ while (evs->s[k] != -1)
+ { nt++;
+ if (nt>=20) { ERROR(("Too many levels in kdint")); return(NOSLN); }
+ k = t[nt] = (x[evs->s[k]] < evs->sv[k]) ? evs->lo[k] : evs->hi[k];
+ }
+
+ ce = &evs->ce[k*vc];
+ ll = evpt(fp,ce[0]);
+ ur = evpt(fp,ce[vc-1]);
+ nc = 0;
+ for (j=0; j<vc; j++) nc = exvval(fp,vv[j],(int)ce[j],d,what,0);
+ ff = rectcell_interp(x,vv,ll,ur,d,nc);
+
+ if (d==2) ff = blend(fp,evs,ff,x,ll,ur,k*vc,nt,t,what);
+ return(ff);
+}
diff --git a/src/ev_main.c b/src/ev_main.c
new file mode 100755
index 0000000..8f993ab
--- /dev/null
+++ b/src/ev_main.c
@@ -0,0 +1,235 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+/*
+ * trchck checks the working space on the lfit structure
+ * has space for nvm vertices and ncm cells.
+ */
+void lfit_alloc(lf)
+lfit *lf;
+{ lf->fp.lwk = lf->fp.lev = lf->fp.ll = lf->evs.liw = lf->pc.lwk = 0;
+ lf->lf_init_id = LF_INIT_ID;
+}
+int lfit_reqd(d,nvm,ncm,geth)
+int d, nvm, ncm, geth;
+{ int z;
+ z = (geth==GSMP) ? d+3 : 3*d+8;
+ return(nvm*z+ncm);
+}
+int lfit_reqi(nvm,ncm,vc)
+int nvm, ncm, vc;
+{ return(ncm*vc+3*MAX(ncm,nvm));
+}
+
+void trchck(lf,nvm,ncm,vc)
+lfit *lf;
+int nvm, ncm, vc;
+{ int rw, d;
+ Sint *k;
+ double *z;
+
+ if (lf->lf_init_id != LF_INIT_ID) lfit_alloc(lf);
+
+ d = lf->lfd.d;
+
+ if (lf->fp.lev < d*nvm)
+ { lf->fp.xev = (double *)calloc(d*nvm,sizeof(double));
+ lf->fp.lev = d*nvm;
+ }
+
+ rw = lfit_reqd(d,nvm,ncm,geth(&lf->fp));
+ if (lf->fp.lwk < rw)
+ { lf->fp.coef = (double *)calloc(rw,sizeof(double));
+ lf->fp.lwk = rw;
+ }
+ z = lf->fp.coef;
+
+ lf->fp.coef= z; z += nvm*(d+1);
+ if (geth(&lf->fp) != GSMP)
+ { lf->fp.nlx = z; z += nvm*(d+1);
+ lf->fp.t0 = z; z += nvm*(d+1);
+ lf->fp.lik = z; z += 3*nvm;
+ }
+ lf->fp.h = z; z += nvm;
+ lf->fp.deg = z; z += nvm;
+ lf->evs.sv = z; z += ncm;
+
+ rw = lfit_reqi(nvm,ncm,vc);
+ if (lf->evs.liw<rw)
+ { lf->evs.iwk = (Sint *)calloc(rw,sizeof(Sint));
+ lf->evs.liw = rw;
+ }
+ k = lf->evs.iwk;
+ lf->evs.ce = k; k += vc*ncm;
+ lf->evs.s = k; k += MAX(ncm,nvm);
+ lf->evs.lo = k; k += MAX(ncm,nvm);
+ lf->evs.hi = k; k += MAX(ncm,nvm);
+
+ lf->fp.nvm = nvm; lf->evs.ncm = ncm;
+}
+
+void data_guessnv(nvm,ncm,vc,n)
+int *nvm, *ncm, *vc, n;
+{ *nvm = n;
+ *ncm = *vc = 0;
+}
+
+void dataf(des,lf)
+design *des;
+lfit *lf;
+{
+ int d, i, j, ncm, nv, vc;
+
+ d = lf->lfd.d;
+ data_guessnv(&nv,&ncm,&vc,lf->lfd.n);
+ trchck(lf,nv,ncm,vc);
+
+ for (i=0; i<nv; i++)
+ for (j=0; j<d; j++) evptx(&lf->fp,i,j) = datum(&lf->lfd,j,i);
+ for (i=0; i<nv; i++)
+ { des->vfun(des,lf,i);
+ lf->evs.s[i] = 0;
+ }
+ lf->fp.nv = lf->fp.nvm = nv; lf->evs.nce = 0;
+}
+
+void xbar_guessnv(nvm,ncm,vc)
+int *nvm, *ncm, *vc;
+{ *nvm = 1;
+ *ncm = *vc = 0;
+ return;
+}
+
+void xbarf(des,lf)
+design *des;
+lfit *lf;
+{ int i, d, nvm, ncm, vc;
+ d = lf->lfd.d;
+ xbar_guessnv(&nvm,&ncm,&vc);
+ trchck(lf,1,0,0);
+ for (i=0; i<d; i++) evptx(&lf->fp,0,i) = lf->pc.xbar[i];
+ des->vfun(des,lf,0);
+ lf->evs.s[0] = 0;
+ lf->fp.nv = 1; lf->evs.nce = 0;
+}
+
+void preset(des,lf)
+design *des;
+lfit *lf;
+{ int i, nv;
+
+ nv = lf->fp.nvm;
+ trchck(lf,nv,0,0);
+ for (i=0; i<nv; i++)
+ {
+ des->vfun(des,lf,i);
+ lf->evs.s[i] = 0;
+ }
+ lf->fp.nv = nv; lf->evs.nce = 0;
+}
+
+void crossf(des,lf)
+design *des;
+lfit *lf;
+{ int d, i, j, n, nv, ncm, vc;
+ double w;
+
+ n = lf->lfd.n; d = lf->lfd.d;
+ data_guessnv(&nv,&ncm,&vc,n);
+ trchck(lf,nv,ncm,vc);
+
+ if (lf->lfd.w==NULL) ERROR(("crossf() needs prior weights"));
+ for (i=0; i<n; i++)
+ for (j=0; j<d; j++) evptx(&lf->fp,i,j) = datum(&lf->lfd,j,i);
+ for (i=0; i<n; i++)
+ { lf->evs.s[i] = 0;
+ w = prwt(&lf->lfd,i);
+ lf->lfd.w[i] = 0;
+ des->vfun(des,lf,i);
+ lf->lfd.w[i] = w;
+ }
+ lf->fp.nv = n; lf->evs.nce = 0;
+}
+
+void gridf(des,lf)
+design *des;
+lfit *lf;
+{ int d, i, j, nv, u0, u1, z;
+ nv = 1; d = lf->lfd.d;
+ for (i=0; i<d; i++)
+ { if (lf->evs.mg[i]==0)
+ lf->evs.mg[i] = 2+(int)((lf->evs.fl[i+d]-lf->evs.fl[i])/(lf->lfd.sca[i]*cut(&lf->evs)));
+ nv *= lf->evs.mg[i];
+ }
+ trchck(lf,nv,0,1<<d);
+ for (i=0; i<nv; i++)
+ { z = i;
+ for (j=0; j<d; j++)
+ { u0 = z%lf->evs.mg[j];
+ u1 = lf->evs.mg[j]-1-u0;
+ evptx(&lf->fp,i,j) = (lf->evs.mg[j]==1) ? lf->evs.fl[j] :
+ (u1*lf->evs.fl[j]+u0*lf->evs.fl[j+d])/(lf->evs.mg[j]-1);
+ z = z/lf->evs.mg[j];
+ }
+ lf->evs.s[i] = 0;
+ des->vfun(des,lf,i);
+ }
+ lf->fp.nv = nv; lf->evs.nce = 0;
+}
+
+int findpt(fp,evs,i0,i1)
+fitpt *fp;
+evstruc *evs;
+int i0, i1;
+{ int i;
+ if (i0>i1) ISWAP(i0,i1);
+ for (i=i1+1; i<fp->nv; i++)
+ if ((evs->lo[i]==i0) && (evs->hi[i]==i1)) return(i);
+ return(-1);
+}
+
+/*
+ add a new vertex at the midpoint of (x[i0],x[i1]).
+ return the vertex number.
+*/
+int newsplit(des,lf,i0,i1,pv)
+design *des;
+lfit *lf;
+int i0, i1, pv;
+{ int i, nv;
+
+ i = findpt(&lf->fp,&lf->evs,i0,i1);
+ if (i>=0) return(i);
+
+ if (i0>i1) ISWAP(i0,i1);
+ nv = lf->fp.nv;
+
+ /* the point is new. Now check we have space for the new point. */
+ if (nv==lf->fp.nvm)
+ {
+ ERROR(("newsplit: out of vertex space"));
+ return(-1);
+ }
+
+ /* compute the new point, and evaluate the fit */
+ lf->evs.lo[nv] = i0;
+ lf->evs.hi[nv] = i1;
+ for (i=0; i<lf->fp.d; i++)
+ evptx(&lf->fp,nv,i) = (evptx(&lf->fp,i0,i)+evptx(&lf->fp,i1,i))/2;
+ if (pv) /* pseudo vertex */
+ { lf->fp.h[nv] = (lf->fp.h[i0]+lf->fp.h[i1])/2;
+ lf->evs.s[nv] = 1; /* pseudo-vertex */
+ }
+ else /* real vertex */
+ {
+ des->vfun(des,lf,nv);
+ lf->evs.s[nv] = 0;
+ }
+ lf->fp.nv++;
+
+ return(nv);
+}
diff --git a/src/ev_sphere.c b/src/ev_sphere.c
new file mode 100755
index 0000000..4221483
--- /dev/null
+++ b/src/ev_sphere.c
@@ -0,0 +1,114 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ * Functions for constructing the fit and
+ * interpolating on the circle/sphere. d=2 only.
+ */
+
+#include "local.h"
+
+/*
+ * Guess the number of fitting points.
+ */
+void sphere_guessnv(nvm,ncm,vc,mg)
+int *nvm, *ncm, *vc, *mg;
+{ *nvm = mg[1]*(mg[0]+1);
+ *ncm = 0;
+ *vc = 0;
+}
+
+void sphere_start(des,lf)
+design *des;
+lfit *lf;
+{ int d, i, j, ct, nv, ncm, vc, *mg;
+ double rmin, rmax, *orig, r, th, c, s;
+
+ mg = mg(&lf->evs);
+ sphere_guessnv(&nv,&ncm,&vc,mg);
+ trchck(lf,nv,0,0);
+ d = lf->lfd.d;
+
+ rmin = lf->evs.fl[0];
+ rmax = lf->evs.fl[1];
+ orig = &lf->evs.fl[2];
+rmin = 0; rmax = 1; orig[0] = orig[1] = 0.0;
+
+ ct = 0;
+ for (i=0; i<mg[1]; i++)
+ { th = 2*PI*i/mg[1];
+ c = cos(th);
+ s = sin(th);
+ for (j=0; j<=mg[0]; j++)
+ { r = rmin + (rmax-rmin)*j/mg[0];
+ evptx(&lf->fp,ct,0) = orig[0] + r*c;
+ evptx(&lf->fp,ct,1) = orig[1] + r*s;
+ des->vfun(des,lf,ct);
+ ct++;
+ }
+ }
+ lf->fp.nv = ct;
+ lf->evs.nce = 0;
+}
+
+double sphere_int(lf,x,what)
+lfit *lf;
+double *x;
+int what;
+{ double rmin, rmax, *orig, dx, dy, r, th, th0, th1;
+ double v[64][64], c0, c1, s0, s1, r0, r1, d0, d1;
+ double ll[2], ur[2], xx[2];
+ int i0, j0, i1, j1, *mg, nc, ce[4];
+
+ rmin = lf->evs.fl[0];
+ rmax = lf->evs.fl[1];
+ orig = &lf->evs.fl[2];
+rmin = 0; rmax = 1; orig[0] = orig[1] = 0.0;
+ mg = mg(&lf->evs);
+
+ dx = x[0] - orig[0];
+ dy = x[1] - orig[1];
+ r = sqrt(dx*dx+dy*dy);
+ th = atan2(dy,dx); /* between -pi and pi */
+
+ i0 = (int)floor(mg[1]*th/(2*PI)) % mg[1];
+ j0 = (int)(mg[0]*(r-rmin)/(rmax-rmin));
+
+ i1 = (i0+1) % mg[1];
+ j1 = j0+1; if (j1>mg[0]) { j0 = mg[0]-1; j1 = mg[0]; }
+
+ ce[0] = i0*(mg[0]+1)+j0;
+ ce[1] = i0*(mg[0]+1)+j1;
+ ce[2] = i1*(mg[0]+1)+j0;
+ ce[3] = i1*(mg[0]+1)+j1;
+ nc = exvval(&lf->fp,v[0],ce[0],2,what,1);
+ nc = exvval(&lf->fp,v[1],ce[1],2,what,1);
+ nc = exvval(&lf->fp,v[2],ce[2],2,what,1);
+ nc = exvval(&lf->fp,v[3],ce[3],2,what,1);
+
+ th0 = 2*PI*i0/mg[1]; c0 = cos(th0); s0 = sin(th0);
+ th1 = 2*PI*i1/mg[1]; c1 = cos(th1); s1 = sin(th1);
+ r0 = rmin + j0*(rmax-rmin)/mg[0];
+ r1 = rmin + j1*(rmax-rmin)/mg[0];
+
+ d0 = c0*v[0][1] + s0*v[0][2];
+ d1 = r0*(c0*v[0][2]-s0*v[0][1]);
+ v[0][1] = d0; v[0][2] = d1;
+
+ d0 = c0*v[1][1] + s0*v[1][2];
+ d1 = r1*(c0*v[1][2]-s0*v[1][1]);
+ v[1][1] = d0; v[1][2] = d1;
+
+ d0 = c1*v[2][1] + s1*v[2][2];
+ d1 = r0*(c1*v[2][2]-s1*v[2][1]);
+ v[2][1] = d0; v[2][2] = d1;
+
+ d0 = c1*v[3][1] + s1*v[3][2];
+ d1 = r1*(c1*v[3][2]-s1*v[3][1]);
+ v[3][1] = d0; v[3][2] = d1;
+
+ xx[0] = r; xx[1] = th;
+ ll[0] = r0; ll[1] = th0;
+ ur[0] = r1; ur[1] = th1;
+ return(rectcell_interp(xx,v,ll,ur,2,nc));
+}
diff --git a/src/ev_trian.c b/src/ev_trian.c
new file mode 100755
index 0000000..59685f7
--- /dev/null
+++ b/src/ev_trian.c
@@ -0,0 +1,488 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+void solve(A,b,d) /* this is crude! A organized by column. */
+double *A, *b;
+int d;
+{ int i, j, k;
+ double piv;
+ for (i=0; i<d; i++)
+ { piv = A[(d+1)*i];
+ for (j=i; j<d; j++) A[j*d+i] /= piv;
+ b[i] /= piv;
+ for (j=0; j<d; j++) if (j != i)
+ { piv = A[i*d+j];
+ A[i*d+j] = 0;
+ for (k=i+1; k<d; k++)
+ A[k*d+j] -= piv*A[k*d+i];
+ b[j] -= piv*b[i];
+ }
+ }
+}
+
+void triang_guessnv(nvm,ncm,vc,d,mk)
+int *nvm, *ncm, *vc, d, mk;
+{ *nvm = *ncm = mk*d;
+ *vc = d+1;
+ return;
+}
+
+int triang_split(lf,ce,le)
+lfit *lf;
+double *le;
+Sint *ce;
+{ int d, i, j, k, nts, vc;
+ double di, dfx[MXDIM];
+ nts = 0; d = lf->fp.d; vc = d+1;
+ for (i=0; i<d; i++)
+ for (j=i+1; j<=d; j++)
+ { for (k=0; k<d; k++)
+ dfx[k] = evptx(&lf->fp,ce[i],k)-evptx(&lf->fp,ce[j],k);
+ di = rho(dfx,lf->lfd.sca,d,KSPH,NULL);
+ le[i*vc+j] = le[j*vc+i] = di/MIN(lf->fp.h[ce[i]],lf->fp.h[ce[j]]);
+ nts = nts || le[i*vc+j]>cut(&lf->evs);
+ }
+ return(nts);
+}
+
+void resort(pv,xev,dig)
+double *xev;
+int *pv, *dig;
+{ double d0, d1, d2;
+ int i;
+ d0 = d1 = d2 = 0;
+ for (i=0; i<3; i++)
+ { d0 += (xev[3*pv[11]+i]-xev[3*pv[1]+i])*(xev[3*pv[11]+i]-xev[3*pv[1]+i]);
+ d1 += (xev[3*pv[ 7]+i]-xev[3*pv[2]+i])*(xev[3*pv[ 7]+i]-xev[3*pv[2]+i]);
+ d2 += (xev[3*pv[ 6]+i]-xev[3*pv[3]+i])*(xev[3*pv[ 6]+i]-xev[3*pv[3]+i]);
+ }
+ if ((d0<=d1) & (d0<=d2))
+ { dig[0] = pv[1]; dig[1] = pv[11];
+ dig[2] = pv[2]; dig[3] = pv[7];
+ dig[4] = pv[3]; dig[5] = pv[6];
+ }
+ else if (d1<=d2)
+ { dig[0] = pv[2]; dig[1] = pv[7];
+ dig[2] = pv[1]; dig[3] = pv[11];
+ dig[4] = pv[3]; dig[5] = pv[6];
+ }
+ else
+ { dig[0] = pv[3]; dig[1] = pv[6];
+ dig[2] = pv[2]; dig[3] = pv[7];
+ dig[4] = pv[1]; dig[5] = pv[11];
+ }
+}
+
+void triang_grow(des,lf,ce,ct,term)
+design *des;
+lfit *lf;
+Sint *ce, *ct, *term;
+{ double le[(1+MXDIM)*(1+MXDIM)], ml;
+ int d, i, j, im=0, jm=0, vc, pv[(1+MXDIM)*(1+MXDIM)], dig[6];
+ Sint nce[1+MXDIM];
+ if (lf_error) return;
+ d = lf->fp.d; vc = d+1;
+ if (!triang_split(lf,ce,le))
+ { if (ct != NULL)
+ { for (i=0; i<vc; i++) term[*ct*vc+i] = ce[i];
+ (*ct)++;
+ }
+ return;
+ }
+ if (d>3)
+ { ml = 0;
+ for (i=0; i<d; i++)
+ for (j=i+1; j<vc; j++)
+ if (le[i*vc+j]>ml) { ml = le[i*vc+j]; im = i; jm = j; }
+ pv[0] = newsplit(des,lf,(int)ce[im],(int)ce[jm],0);
+ for (i=0; i<vc; i++) nce[i] = ce[i];
+ nce[im] = pv[0]; triang_grow(des,lf,nce,ct,term); nce[im] = ce[im];
+ nce[jm] = pv[0]; triang_grow(des,lf,nce,ct,term);
+ return;
+ }
+
+ for (i=0; i<d; i++)
+ for (j=i+1; j<=d; j++)
+ pv[i*vc+j] = pv[j*vc+i]
+ = newsplit(des,lf,(int)ce[i],(int)ce[j],le[i*vc+j]<=cut(&lf->evs));
+ for (i=0; i<=d; i++) /* corners */
+ { for (j=0; j<=d; j++) nce[j] = (j==i) ? ce[i] : pv[i*vc+j];
+ triang_grow(des,lf,nce,ct,term);
+ }
+
+ if (d==2) /* center for d=2 */
+ { nce[0] = pv[5]; nce[1] = pv[2]; nce[2] = pv[1];
+ triang_grow(des,lf,nce,ct,term);
+ }
+ if (d==3) /* center for d=3 */
+ { resort(pv,evp(&lf->fp),dig);
+ nce[0] = dig[0]; nce[1] = dig[1];
+ nce[2] = dig[2]; nce[3] = dig[4]; triang_grow(des,lf,nce,ct,term);
+ nce[2] = dig[5]; nce[3] = dig[3]; triang_grow(des,lf,nce,ct,term);
+ nce[2] = dig[2]; nce[3] = dig[5]; triang_grow(des,lf,nce,ct,term);
+ nce[2] = dig[4]; nce[3] = dig[3]; triang_grow(des,lf,nce,ct,term);
+ }
+}
+
+void triang_descend(tr,xa,ce)
+lfit *tr;
+double *xa;
+Sint *ce;
+{ double le[(1+MXDIM)*(1+MXDIM)], ml;
+ int d, vc, i, j, im=0, jm=0, pv[(1+MXDIM)*(1+MXDIM)];
+ design *des;
+ des = NULL;
+ if (!triang_split(tr,ce,le)) return;
+ d = tr->fp.d; vc = d+1;
+
+ if (d>3) /* split longest edge */
+ { ml = 0;
+ for (i=0; i<d; i++)
+ for (j=i+1; j<vc; j++)
+ if (le[i*vc+j]>ml) { ml = le[i*vc+j]; im = i; jm = j; }
+ pv[0] = newsplit(des,tr,(int)ce[im],(int)ce[jm],0);
+ if (xa[im]>xa[jm])
+ { xa[im] -= xa[jm]; xa[jm] *= 2; ce[jm] = pv[0]; }
+ else
+ { xa[jm] -= xa[im]; xa[im] *= 2; ce[im] = pv[0]; }
+ triang_descend(tr,xa,ce);
+ return;
+ }
+
+ for (i=0; i<d; i++)
+ for (j=i+1; j<=d; j++)
+ pv[i*vc+j] = pv[j*vc+i]
+ = newsplit(des,tr,(int)ce[i],(int)ce[j],le[i*d+j]<=cut(&tr->evs));
+ for (i=0; i<=d; i++) if (xa[i]>=0.5) /* in corner */
+ { for (j=0; j<=d; j++)
+ { if (i!=j) ce[j] = pv[i*vc+j];
+ xa[j] = 2*xa[j];
+ }
+ xa[i] -= 1;
+ triang_descend(tr,xa,ce);
+ return;
+ }
+ if (d==1) { ERROR(("weights sum to < 1")); }
+ if (d==2) /* center */
+ { ce[0] = pv[5]; xa[0] = 1-2*xa[0];
+ ce[1] = pv[2]; xa[1] = 1-2*xa[1];
+ ce[2] = pv[1]; xa[2] = 1-2*xa[2];
+ triang_descend(tr,xa,ce);
+ }
+ if (d==3) /* center */
+ { double z; int dig[6];
+ resort(pv,evp(&tr->fp),dig);
+ ce[0] = dig[0]; ce[1] = dig[1];
+ xa[0] *= 2; xa[1] *= 2; xa[2] *= 2; xa[3] *= 2;
+ if (xa[0]+xa[2]>=1)
+ { if (xa[0]+xa[3]>=1)
+ { ce[2] = dig[2]; ce[3] = dig[4];
+ z = xa[0];
+ xa[3] += z-1; xa[2] += z-1; xa[0] = xa[1]; xa[1] = 1-z;
+ }
+ else
+ { ce[2] = dig[2]; ce[3] = dig[5];
+ z = xa[3]; xa[3] = xa[1]+xa[2]-1; xa[1] = z;
+ z = xa[2]; xa[2] += xa[0]-1; xa[0] = 1-z;
+ } }
+ else
+ { if (xa[1]+xa[2]>=1)
+ { ce[2] = dig[5]; ce[3] = dig[3];
+ xa[1] = 1-xa[1]; xa[2] -= xa[1]; xa[3] -= xa[1];
+ }
+ else
+ { ce[2] = dig[4]; ce[3] = dig[3];
+ z = xa[3]; xa[3] += xa[1]-1; xa[1] = xa[2];
+ xa[2] = z+xa[0]-1; xa[0] = 1-z;
+ } }
+ triang_descend(tr,xa,ce);
+} }
+
+void covrofdata(lfd,V,mn) /* covar of data; mean in mn */
+lfdata *lfd;
+double *V, *mn;
+{ int d, i, j, k;
+ double s;
+ s = 0; d = lfd->d;
+ for (i=0; i<d*d; i++) V[i] = 0;
+ for (i=0; i<lfd->n; i++)
+ { s += prwt(lfd,i);
+ for (j=0; j<d; j++)
+ for (k=0; k<d; k++)
+ V[j*d+k] += prwt(lfd,i)*(datum(lfd,j,i)-mn[j])*(datum(lfd,k,i)-mn[k]);
+ }
+ for (i=0; i<d*d; i++) V[i] /= s;
+}
+
+int intri(x,w,xev,xa,d) /* is x in triangle bounded by xd[0..d-1]? */
+double *x, *xev, *xa;
+Sint *w;
+int d;
+{ int i, j;
+ double eps, *r, xd[MXDIM*MXDIM];
+ eps = 1.0e-10;
+ r = &xev[w[d]*d];
+ for (i=0; i<d; i++)
+ { xa[i] = x[i]-r[i];
+ for (j=0; j<d; j++) xd[i*d+j] = xev[w[i]*d+j]-r[j];
+ }
+ solve(xd,xa,d);
+ xa[d] = 1.0;
+ for (i=0; i<d; i++) xa[d] -= xa[i];
+ for (i=0; i<=d; i++) if ((xa[i]<-eps) | (xa[i]>1+eps)) return(0);
+ return(1);
+}
+
+void triang_start(des,lf) /* Triangulation with polyhedral start */
+design *des;
+lfit *lf;
+{
+ int i, j, k, n, d, nc, nvm, ncm, vc;
+ Sint *ce, ed[1+MXDIM];
+ double V[MXDIM*MXDIM], P[MXDIM*MXDIM], sigma, z[MXDIM], xa[1+MXDIM], *xev;
+ xev = evp(&lf->fp);
+ d = lf->lfd.d; n = lf->lfd.n;
+ lf->fp.nv = nc = 0;
+
+ triang_guessnv(&nvm,&ncm,&vc,d,mk(&lf->evs));
+ trchck(lf,nvm,ncm,vc);
+
+ ce = lf->evs.ce;
+ for (j=0; j<d; j++) xev[j] = lf->pc.xbar[j];
+ lf->fp.nv = 1;
+ covrofdata(&lf->lfd,V,xev); /* fix this with scaling */
+ eig_dec(V,P,d);
+
+ for (i=0; i<d; i++) /* add vertices +- 2sigma*eigenvect */
+ { sigma = sqrt(V[i*(d+1)]);
+ for (j=0; j<d; j++)
+ xev[lf->fp.nv*d+j] = xev[j]-2*sigma*P[j*d+i];
+ lf->fp.nv++;
+ for (j=0; j<d; j++)
+ xev[lf->fp.nv*d+j] = xev[j]+2*sigma*P[j*d+i];
+ lf->fp.nv++;
+ }
+
+ for (i=0; i<n; i++) /* is point i inside? */
+ { ed[0] = 0;
+ for (j=0; j<d; j++)
+ { z[j] = 0;
+ for (k=0; k<d; k++) z[j] += P[k*d+j]*(datum(&lf->lfd,k,i)-xev[k]);
+ ed[j+1] = 2*j+1+(z[j]>0);
+ for (k=0; k<d; k++) z[j] = datum(&lf->lfd,j,i);
+ }
+ k = intri(z,ed,xev,xa,d);
+ if (xa[0]<0)
+ { for (j=1; j<=d; j++)
+ for (k=0; k<d; k++)
+ xev[ed[j]*d+k] = xa[0]*xev[k]+(1-xa[0])*xev[ed[j]*d+k];
+ }
+ }
+
+ nc = 1<<d; /* create initial cells */
+ for (i=0; i<nc; i++)
+ { ce[i*vc] = 0; k = i;
+ for (j=0; j<d; j++)
+ { ce[i*vc+j+1] = 2*j+(k%2)+1;
+ k>>=1;
+ }
+ }
+
+ for (i=0; i<lf->fp.nv; i++)
+ { des->vfun(des,lf,i);
+ if (lf_error) return;
+ lf->evs.s[i] = 0;
+ }
+ for (i=0; i<nc; i++)
+ triang_grow(des,lf,&ce[i*vc],NULL,NULL);
+ lf->evs.nce = nc;
+}
+
+double triang_cubicint(v,vv,w,d,nc,xxa)
+double *v, *vv, *xxa;
+int d, nc;
+Sint *w;
+{ double sa, lb, *vert0, *vert1, *vals0=NULL, *vals1, deriv0, deriv1;
+ int i, j, k;
+ if (nc==1) /* linear interpolate */
+ { sa = 0;
+ for (i=0; i<=d; i++) sa += xxa[i]*vv[i];
+ return(sa);
+ }
+ sa = 1.0;
+ for (j=d; j>0; j--) /* eliminate v[w[j]] */
+ { lb = xxa[j]/sa;
+ for (k=0; k<j; k++) /* Interpolate edge v[w[k]],v[w[j]] */
+ { vert0 = &v[w[k]*d];
+ vert1 = &v[w[j]*d];
+ vals0 = &vv[k*nc];
+ vals1 = &vv[j*nc];
+ deriv0 = deriv1 = 0;
+ for (i=0; i<d; i++)
+ { deriv0 += (vert1[i]-vert0[i])*vals0[i+1];
+ deriv1 += (vert1[i]-vert0[i])*vals1[i+1];
+ }
+ vals0[0] = cubic_interp(lb,vals0[0],vals1[0],deriv0,deriv1);
+ for (i=1; i<=d; i++)
+ vals0[i] = (1-lb)*((1-lb)*vals0[i]+lb*vals1[i]);
+ }
+ sa -= xxa[j];
+ if (sa<=0) j = 0;
+ }
+ return(vals0[0]);
+}
+
+double triang_clotoch(xev,vv,ce,p,xxa)
+double *xev, *vv, *xxa;
+int p;
+Sint *ce;
+{ double cfo[3], cfe[3], cg[9], *va, *vb, *vc,
+ l0, nm[3], na, nb, nc, *xl, *xr, *xz, d0, d1, lb, dlt, gam;
+ int i, w[3], cfl, cfr;
+ if (p==1)
+ return(xxa[0]*vv[0]+xxa[1]*vv[1]+xxa[2]*vv[2]);
+ if (xxa[2]<=MIN(xxa[0],xxa[1]))
+ { va = &xev[2*ce[0]]; vb = &xev[2*ce[1]]; vc = &xev[2*ce[2]];
+ w[0] = 0; w[1] = 3; w[2] = 6;
+ }
+ else
+ if (xxa[1]<xxa[0])
+ { w[0] = 0; w[1] = 6; w[2] = 3;
+ va = &xev[2*ce[0]]; vb = &xev[2*ce[2]]; vc = &xev[2*ce[1]];
+ lb = xxa[1]; xxa[1] = xxa[2]; xxa[2] = lb;
+ }
+ else
+ { w[0] = 6; w[1] = 3; w[2] = 0;
+ va = &xev[2*ce[2]]; vb = &xev[2*ce[1]]; vc = &xev[2*ce[0]];
+ lb = xxa[0]; xxa[0] = xxa[2]; xxa[2] = lb;
+ }
+
+/* set cg to values and derivatives on standard triangle */
+ for (i=0; i<3; i++)
+ { cg[3*i] = vv[w[i]];
+ cg[3*i+1] = ((vb[0]-va[0])*vv[w[i]+1]
+ +(vb[1]-va[1])*vv[w[i]+2])/2; /* df/dx */
+ cg[3*i+2] = ((2*vc[0]-vb[0]-va[0])*vv[w[i]+1]
+ +(2*vc[1]-vb[1]-va[1])*vv[w[i]+2])/2.0; /* sqrt{3} df/dy */
+ }
+ dlt = (vb[0]-va[0])*(vc[1]-va[1])-(vc[0]-va[0])*(vb[1]-va[1]);
+ /* Twice area; +ve if abc antic.wise -ve is abc c.wise */
+ cfo[0] = (cg[0]+cg[3]+cg[6])/3;
+ cfo[1] = (2*cg[0]-cg[3]-cg[6])/4;
+ cfo[2] = (2*cg[3]-cg[0]-cg[6])/4;
+ na = -cg[1]+cg[2]; /* perp. deriv, rel. length 2 */
+ nb = -cg[4]-cg[5];
+ nc = 2*cg[7];
+ cfo[1] += (nb-nc)/16;
+ cfo[2] += (nc-na)/16;
+ na = -cg[1]-cg[2]/3.0; /* derivatives back to origin */
+ nb = cg[4]-cg[5]/3.0;
+ nc = cg[8]/1.5;
+ cfo[0] -= (na+nb+nc)*7/54;
+ cfo[1] += 13*(nb+nc-2*na)/144;
+ cfo[2] += 13*(na+nc-2*nb)/144;
+ for (i=0; i<3; i++)
+ { /* Outward normals by linear interpolation on original triangle.
+ Convert to outward normals on standard triangle.
+ Actually, computed to opposite corner */
+ switch(i)
+ { case 0: xl = vc; xr = vb; xz = va; cfl = w[2]; cfr = w[1];
+ break;
+ case 1: xl = va; xr = vc; xz = vb; cfl = w[0]; cfr = w[2];
+ break;
+ case 2: xl = vb; xr = va; xz = vc; cfl = w[1]; cfr = w[0];
+ break;
+ }
+ na = xr[0]-xl[0]; nb = xr[1]-xl[1];
+ lb = na*na+nb*nb;
+ d0 = 1.5*(vv[cfr]-vv[cfl]) - 0.25*(na*(vv[cfl+1]+vv[cfr+1])
+ +nb*(vv[cfl+2]+vv[cfr+2]));
+ d1 = 0.5*( na*(vv[cfl+2]+vv[cfr+2])-nb*(vv[cfl+1]+vv[cfr+1]) );
+ l0 = (xz[0]-xl[0])*na+(xz[1]-xl[1])*nb-lb/2;
+ nm[i] = (d1*dlt-l0*d0)/lb;
+ }
+ cfo[0] -= (nm[0]+nm[1]+nm[2])*4/81;
+ cfo[1] += (2*nm[0]-nm[1]-nm[2])/27;
+ cfo[2] += (2*nm[1]-nm[0]-nm[2])/27;
+
+ gam = xxa[0]+xxa[1]-2*xxa[2];
+ if (gam==0) return(cfo[0]);
+ lb = (xxa[0]-xxa[2])/gam;
+ d0 = -2*cg[4]; d1 = -2*cg[1];
+ cfe[0] = cubic_interp(lb,cg[3],cg[0],d0,d1);
+ cfe[1] = cubintd(lb,cg[3],cg[0],d0,d1);
+ cfe[2] = -(1-lb)*(1-2*lb)*cg[5] + 4*lb*(1-lb)*nm[2] - lb*(2*lb-1)*cg[2];
+ d0 = 2*(lb*cfo[1]+(1-lb)*cfo[2]);
+ d1 = (lb-0.5)*cfe[1]+cfe[2]/3.0;
+ return(cubic_interp(gam,cfo[0],cfe[0],d0,d1));
+}
+
+int triang_getvertexvals(fp,evs,vv,i,what)
+fitpt *fp;
+evstruc *evs;
+double *vv;
+int i, what;
+{ double dx, P, le, vl[1+MXDIM], vh[1+MXDIM];
+ int d, il, ih, j, nc;
+ d = fp->d;
+ if (evs->s[i]==0) return(exvval(fp,vv,i,d,what,0));
+
+ il = evs->lo[i]; nc = triang_getvertexvals(fp,evs,vl,il,what);
+ ih = evs->hi[i]; nc = triang_getvertexvals(fp,evs,vh,ih,what);
+ vv[0] = (vl[0]+vh[0])/2;
+ if (nc==1) return(nc);
+ P = 1.5*(vh[0]-vl[0]);
+ le = 0.0;
+ for (j=0; j<d; j++)
+ { dx = evptx(fp,ih,j)-evptx(fp,il,j);
+ vv[0] += dx*(vl[j+1]-vh[j+1])/8;
+ vv[j+1] = (vl[j+1]+vh[j+1])/2;
+ P -= 1.5*dx*vv[j+1];
+ le += dx*dx;
+ }
+ for (j=0; j<d; j++)
+ vv[j+1] += P*(evptx(fp,ih,j)-evptx(fp,il,j))/le;
+ return(nc);
+}
+
+double triang_int(lf,x,what)
+lfit *lf;
+double *x;
+int what;
+{
+ int d, i, j, k, vc, nc;
+ Sint *ce, nce[1+MXDIM];
+ double xa[1+MXDIM], vv[(1+MXDIM)*(1+MXDIM)], lb;
+fitpt *fp;
+evstruc *evs;
+fp = &lf->fp;
+evs= &lf->evs;
+
+ d = fp->d; vc = d+1;
+ ce = evs->ce;
+ i = 0;
+ while ((i<evs->nce) && (!intri(x,&ce[i*vc],evp(fp),xa,d))) i++;
+ if (i==evs->nce) return(NOSLN);
+ i *= vc;
+ for (j=0; j<vc; j++) nce[j] = ce[i+j];
+ triang_descend(lf,xa,nce);
+
+ /* order the vertices -- needed for asymmetric interptr */
+ do
+ { k=0;
+ for (i=0; i<d; i++)
+ if (nce[i]>nce[i+1])
+ { j=nce[i]; nce[i]=nce[i+1]; nce[i+1]=j; k=1;
+ lb = xa[i]; xa[i] = xa[i+1]; xa[i+1] = lb;
+ }
+ } while(k);
+ nc = 0;
+ for (i=0; i<vc; i++)
+ nc = triang_getvertexvals(fp,evs,&vv[i*nc],nce[i],what);
+ return((d==2) ? triang_clotoch(evp(fp),vv,nce,nc,xa) :
+ triang_cubicint(evp(fp),vv,nce,d,nc,xa));
+}
diff --git a/src/family.c b/src/family.c
new file mode 100755
index 0000000..361dd9b
--- /dev/null
+++ b/src/family.c
@@ -0,0 +1,625 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+#define HUBERC 2.0
+
+extern double rs, log();
+
+int defaultlink(link,family)
+int link, family;
+{ if (link==LDEFAU)
+ switch(family&63)
+ { case TDEN:
+ case TRAT:
+ case THAZ:
+ case TGAMM:
+ case TGEOM:
+ case TPROB:
+ case TPOIS: return(LLOG);
+ case TCIRC:
+ case TGAUS:
+ case TCAUC:
+ case TROBT: return(LIDENT);
+ case TRBIN:
+ case TLOGT: return(LLOGIT);
+ }
+ if (link==LCANON)
+ switch(family&63)
+ { case TDEN:
+ case TRAT:
+ case THAZ:
+ case TPROB:
+ case TPOIS: return(LLOG);
+ case TGEOM:
+ WARN(("Canonical link unavaialable for geometric family; using inverse"));
+ case TGAMM: return(LINVER);
+ case TCIRC:
+ case TGAUS:
+ case TCAUC:
+ case TROBT: return(LIDENT);
+ case TRBIN:
+ case TLOGT: return(LLOGIT);
+ }
+ return(link);
+}
+
+int validlinks(link,family)
+int link, family;
+{ switch(family&63)
+ { case TDEN:
+ case TRAT:
+ case THAZ:
+ return((link==LLOG) | (link==LIDENT));
+ case TGAUS:
+ return((link==LIDENT) | (link==LLOG) | (link==LLOGIT));
+ case TROBT:
+ case TCAUC:
+ case TCIRC:
+ return(link==LIDENT);
+ case TLOGT:
+ return((link==LLOGIT) | (link==LIDENT) | (link==LASIN));
+ case TRBIN:
+ return(link==LLOGIT);
+ case TGAMM:
+ return((link==LLOG) | (link==LINVER) | (link==LIDENT));
+ case TGEOM:
+ return((link==LLOG) | (link==LIDENT));
+ case TPOIS:
+ case TPROB:
+ return((link==LLOG) | (link==LSQRT) | (link==LIDENT));
+ }
+ ERROR(("Unknown family %d in validlinks",family));
+ return(0);
+}
+
+int famdens(mean,th,link,res,cens,w)
+double mean, th, *res, w;
+int link, cens;
+{ if (cens)
+ res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0.0;
+ else
+ { res[ZLIK] = w*th;
+ res[ZDLL] = res[ZDDLL] = w;
+ }
+ return(LF_OK);
+}
+
+int famgaus(y,mean,th,link,res,cens,w)
+double y, mean, th, *res, w;
+int link, cens;
+{ double z, pz, dp;
+ if (link==LINIT)
+ { res[ZDLL] = w*y;
+ return(LF_OK);
+ }
+ z = y-mean;
+ if (cens)
+ { if (link!=LIDENT)
+ { ERROR(("Link invalid for censored Gaussian family"));
+ return(LF_LNK);
+ }
+ pz = mut_pnorm(-z,0.0,1.0);
+ dp = ((z>6) ? ptail(-z) : exp(-z*z/2)/pz)/2.5066283;
+ res[ZLIK] = w*log(pz);
+ res[ZDLL] = w*dp;
+ res[ZDDLL]= w*dp*(dp-z);
+ return(LF_OK);
+ }
+ res[ZLIK] = -w*z*z/2;
+ switch(link)
+ { case LIDENT:
+ res[ZDLL] = w*z;
+ res[ZDDLL]= w;
+ break;
+ case LLOG:
+ res[ZDLL] = w*z*mean;
+ res[ZDDLL]= w*mean*mean;
+ break;
+ case LLOGIT:
+ res[ZDLL] = w*z*mean*(1-mean);
+ res[ZDDLL]= w*mean*mean*(1-mean)*(1-mean);
+ break;
+ default:
+ ERROR(("Invalid link for Gaussian family"));
+ return(LF_LNK);
+ }
+ return(LF_OK);
+}
+
+int famrobu(y,mean,th,link,res,cens,w,rs)
+double y, mean, th, *res, w, rs;
+int link, cens;
+{ double z, sw;
+ if (link==LINIT)
+ { res[ZDLL] = w*y;
+ return(LF_OK);
+ }
+ sw = (w==1.0) ? 1.0 : sqrt(w); /* don't want unnecess. sqrt! */
+ z = sw*(y-mean)/rs;
+ res[ZLIK] = (fabs(z)<HUBERC) ? -z*z/2 : HUBERC*(HUBERC/2.0-fabs(z));
+ if (z< -HUBERC)
+ { res[ZDLL] = -sw*HUBERC/rs;
+ res[ZDDLL]= 0.0;
+ return(LF_OK);
+ }
+ if (z> HUBERC)
+ { res[ZDLL] = sw*HUBERC/rs;
+ res[ZDDLL]= 0.0;
+ return(LF_OK);
+ }
+ res[ZDLL] = sw*z/rs;
+ res[ZDDLL] = w/(rs*rs);
+ return(LF_OK);
+}
+
+int famcauc(y,p,th,link,res,cens,w,rs)
+double y, p, th, *res, w, rs;
+int link, cens;
+{ double z;
+ if (link!=LIDENT)
+ { ERROR(("Invalid link in famcauc"));
+ return(LF_LNK);
+ }
+ z = w*(y-th)/rs;
+ res[ZLIK] = -log(1+z*z);
+ res[ZDLL] = 2*w*z/(rs*(1+z*z));
+ res[ZDDLL] = 2*w*w*(1-z*z)/(rs*rs*(1+z*z)*(1+z*z));
+ return(LF_OK);
+}
+
+int famrbin(y,p,th,link,res,cens,w)
+double y, p, th, *res, w;
+int link, cens;
+{ double s2y;
+ if (link==LINIT)
+ { res[ZDLL] = y;
+ return(LF_OK);
+ }
+ if ((y<0) | (y>w)) /* goon observation; delete it */
+ { res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0.0;
+ return(LF_OK);
+ }
+ res[ZLIK] = (th<0) ? th*y-w*log(1+exp(th)) : th*(y-w)-w*log(1+exp(-th));
+ if (y>0) res[ZLIK] -= y*log(y/w);
+ if (y<w) res[ZLIK] -= (w-y)*log(1-y/w);
+ res[ZDLL] = (y-w*p);
+ res[ZDDLL]= w*p*(1-p);
+ if (-res[ZLIK]>HUBERC*HUBERC/2.0)
+ { s2y = sqrt(-2*res[ZLIK]);
+ res[ZLIK] = HUBERC*(HUBERC/2.0-s2y);
+ res[ZDLL] *= HUBERC/s2y;
+ res[ZDDLL] = HUBERC/s2y*(res[ZDDLL]-1/(s2y*s2y)*w*p*(1-p));
+ }
+ return(LF_OK);
+}
+
+int fambino(y,p,th,link,res,cens,w)
+double y, p, th, *res, w;
+int link, cens;
+{ double wp;
+ if (link==LINIT)
+ { if (y<0) y = 0;
+ if (y>w) y = w;
+ res[ZDLL] = y;
+ return(LF_OK);
+ }
+ wp = w*p;
+ if (link==LIDENT)
+ { if ((p<=0) && (y>0)) return(LF_BADP);
+ if ((p>=1) && (y<w)) return(LF_BADP);
+ res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0.0;
+ if (y>0)
+ { res[ZLIK] += y*log(wp/y);
+ res[ZDLL] += y/p;
+ res[ZDDLL]+= y/(p*p);
+ }
+ if (y<w)
+ { res[ZLIK] += (w-y)*log((w-wp)/(w-y));
+ res[ZDLL] -= (w-y)/(1-p);
+ res[ZDDLL]+= (w-y)/SQR(1-p);
+ }
+ return(LF_OK);
+ }
+ if (link==LLOGIT)
+ { if ((y<0) | (y>w)) /* goon observation; delete it */
+ { res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0.0;
+ return(LF_OK);
+ }
+ res[ZLIK] = (th<0) ? th*y-w*log(1+exp(th)) : th*(y-w)-w*log(1+exp(-th));
+ if (y>0) res[ZLIK] -= y*log(y/w);
+ if (y<w) res[ZLIK] -= (w-y)*log(1-y/w);
+ res[ZDLL] = (y-wp);
+ res[ZDDLL]= wp*(1-p);
+ return(LF_OK);
+ }
+ if (link==LASIN)
+ { if ((p<=0) && (y>0)) return(LF_BADP);
+ if ((p>=1) && (y<w)) return(LF_BADP);
+ if ((th<0) | (th>PI/2)) return(LF_BADP);
+ res[ZDLL] = res[ZDDLL] = res[ZLIK] = 0;
+ if (y>0)
+ { res[ZDLL] += 2*y*sqrt((1-p)/p);
+ res[ZLIK] += y*log(wp/y);
+ }
+ if (y<w)
+ { res[ZDLL] -= 2*(w-y)*sqrt(p/(1-p));
+ res[ZLIK] += (w-y)*log((w-wp)/(w-y));
+ }
+ res[ZDDLL] = 4*w;
+ return(LF_OK);
+ }
+ ERROR(("link %d invalid for binomial family",link));
+ return(LF_LNK);
+}
+
+int fampois(y,mean,th,link,res,cens,w)
+double y, mean, th, *res, w;
+int link, cens;
+{ double wmu, pt, dp, dq;
+ if (link==LINIT)
+ { res[ZDLL] = MAX(y,0.0);
+ return(LF_OK);
+ }
+ wmu = w*mean;
+ if (cens)
+ { if (y<=0)
+ { res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0.0;
+ return(LF_OK);
+ }
+ pt = igamma(wmu,y);
+ dp = exp((y-1)*log(wmu)-wmu-LGAMMA(y))/pt;
+ dq = dp*((y-1)/wmu-1);
+ res[ZLIK] = log(pt);
+ if (link==LLOG)
+ { res[ZDLL] = dp*wmu;
+ res[ZDDLL]= -(dq-dp*dp)*wmu*wmu-dp*wmu;
+ return(LF_OK);
+ }
+ if (link==LIDENT)
+ { res[ZDLL] = dp*w;
+ res[ZDDLL]= -(dq-dp*dp)*w*w;
+ return(LF_OK);
+ }
+ if (link==LSQRT)
+ { res[ZDLL] = dp*2*w*th;
+ res[ZDDLL]= -(dq-dp*dp)*(4*w*w*mean)-2*dp*w;
+ return(LF_OK);
+ } }
+ if (link==LLOG)
+ { if (y<0) /* goon observation - delete it */
+ { res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0;
+ return(LF_OK);
+ }
+ res[ZLIK] = res[ZDLL] = y-wmu;
+ if (y>0) res[ZLIK] += y*(th-log(y/w));
+ res[ZDDLL] = wmu;
+ return(LF_OK);
+ }
+ if (link==LIDENT)
+ { if ((mean<=0) && (y>0)) return(LF_BADP);
+ res[ZLIK] = y-wmu;
+ res[ZDLL] = -w;
+ res[ZDDLL] = 0;
+ if (y>0)
+ { res[ZLIK] += y*log(wmu/y);
+ res[ZDLL] += y/mean;
+ res[ZDDLL]= y/(mean*mean);
+ }
+ return(LF_OK);
+ }
+ if (link==LSQRT)
+ { if ((mean<=0) && (y>0)) return(LF_BADP);
+ res[ZLIK] = y-wmu;
+ res[ZDLL] = -2*w*th;
+ res[ZDDLL]= 2*w;
+ if (y>0)
+ { res[ZLIK] += y*log(wmu/y);
+ res[ZDLL] += 2*y/th;
+ res[ZDDLL]+= 2*y/mean;
+ }
+ return(LF_OK);
+ }
+ ERROR(("link %d invalid for Poisson family",link));
+ return(LF_LNK);
+}
+
+int famgamm(y,mean,th,link,res,cens,w)
+double y, mean, th, *res, w;
+int link, cens;
+{ double pt, dg;
+ if (link==LINIT)
+ { res[ZDLL] = MAX(y,0.0);
+ return(LF_OK);
+ }
+ if ((mean<=0) & (y>0)) return(LF_BADP);
+ if (cens)
+ { if (y<=0)
+ { res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0.0;
+ return(LF_OK);
+ }
+ if (link==LLOG)
+ { pt = 1-igamma(y/mean,w);
+ dg = exp((w-1)*log(y/mean)-y/mean-LGAMMA(w));
+ res[ZLIK] = log(pt);
+ res[ZDLL] = y*dg/(mean*pt);
+ res[ZDDLL]= dg*(w*y/mean-y*y/(mean*mean))/pt+SQR(res[ZDLL]);
+ return(LF_OK);
+ }
+ if (link==LINVER)
+ { pt = 1-igamma(th*y,w);
+ dg = exp((w-1)*log(th*y)-th*y-LGAMMA(w));
+ res[ZLIK] = log(pt);
+ res[ZDLL] = -y*dg/pt;
+ res[ZDDLL]= dg*y*((w-1)*mean-y)/pt+SQR(res[ZDLL]);
+ return(LF_OK);
+ }
+ }
+ else
+ { if (y<0) WARN(("Negative Gamma observation"));
+ if (link==LLOG)
+ { res[ZLIK] = -y/mean+w*(1-th);
+ if (y>0) res[ZLIK] += w*log(y/w);
+ res[ZDLL] = y/mean-w;
+ res[ZDDLL]= y/mean;
+ return(LF_OK);
+ }
+ if (link==LINVER)
+ { res[ZLIK] = -y/mean+w-w*log(mean);
+ if (y>0) res[ZLIK] += w*log(y/w);
+ res[ZDLL] = -y+w*mean;
+ res[ZDDLL]= w*mean*mean;
+ return(LF_OK);
+ }
+ if (link==LIDENT)
+ { res[ZLIK] = -y/mean+w-w*log(mean);
+ if (y>0) res[ZLIK] += w*log(y/w);
+ res[ZDLL] = (y-mean)/(mean*mean);
+ res[ZDDLL]= w/(mean*mean);
+ return(LF_OK);
+ }
+ }
+ ERROR(("link %d invalid for Gamma family",link));
+ return(LF_LNK);
+}
+
+int famgeom(y,mean,th,link,res,cens,w)
+double y, mean, th, *res, w;
+int link, cens;
+{ double p, pt, dp, dq;
+ if (link==LINIT)
+ { res[ZDLL] = MAX(y,0.0);
+ return(LF_OK);
+ }
+ p = 1/(1+mean);
+ if (cens) /* censored observation */
+ { if (y<=0)
+ { res[ZLIK] = res[ZDLL] = res[ZDDLL] = 0;
+ return(LF_OK);
+ }
+ pt = 1-ibeta(p,w,y);
+ dp = -exp(LGAMMA(w+y)-LGAMMA(w)-LGAMMA(y)+(y-1)*th+(w+y-2)*log(p))/pt;
+ dq = ((w-1)/p-(y-1)/(1-p))*dp;
+ res[ZLIK] = log(pt);
+ res[ZDLL] = -dp*p*(1-p);
+ res[ZDDLL]= (dq-dp*dp)*p*p*(1-p)*(1-p)+dp*(1-2*p)*p*(1-p);
+ res[ZDDLL]= -res[ZDDLL];
+ return(LF_OK);
+ }
+ else
+ { res[ZLIK] = (y+w)*log((y/w+1)/(mean+1));
+ if (y>0) res[ZLIK] += y*log(w*mean/y);
+ if (link==LLOG)
+ { res[ZDLL] = (y-w*mean)*p;
+ res[ZDDLL]= (y+w)*p*(1-p);
+ return(LF_OK);
+ }
+ if (link==LIDENT)
+ { res[ZDLL] = (y-w*mean)/(mean*(1+mean));
+ res[ZDDLL]= w/(mean*(1+mean));
+ return(LF_OK);
+ }
+ }
+ ERROR(("link %d invalid for geometric family",link));
+ return(LF_LNK);
+}
+
+int famweib(y,mean,th,link,res,cens,w)
+double y, mean, th, *res, w;
+int link, cens;
+{ double yy;
+ yy = pow(y,w);
+ if (link==LINIT)
+ { res[ZDLL] = MAX(yy,0.0);
+ return(LF_OK);
+ }
+ if (cens)
+ { res[ZLIK] = -yy/mean;
+ res[ZDLL] = res[ZDDLL] = yy/mean;
+ return(LF_OK);
+ }
+ res[ZLIK] = 1-yy/mean-th;
+ if (yy>0) res[ZLIK] += log(w*yy);
+ res[ZDLL] = -1+yy/mean;
+ res[ZDDLL]= yy/mean;
+ return(LF_OK);
+}
+
+int famcirc(y,mean,th,link,res,cens,w)
+double y, mean, th, *res, w;
+int link, cens;
+{ if (link==LINIT)
+ { res[ZDLL] = w*sin(y);
+ res[ZLIK] = w*cos(y);
+ return(LF_OK);
+ }
+ res[ZDLL] = w*sin(y-mean);
+ res[ZDDLL]= w*cos(y-mean);
+ res[ZLIK] = res[ZDDLL]-w;
+ return(LF_OK);
+}
+
+/*
+void robustify(res,rs)
+double *res, rs;
+{ double sc, z;
+ sc = rs*HUBERC;
+ if (res[ZLIK] > -sc*sc/2) return;
+ z = sqrt(-2*res[ZLIK]);
+ res[ZDDLL]= -sc*res[ZDLL]*res[ZDLL]/(z*z*z)+sc*res[ZDDLL]/z;
+ res[ZDLL]*= sc/z;
+ res[ZLIK] = sc*sc/2-sc*z;
+}
+*/
+void robustify(res,rs)
+double *res, rs;
+{ double sc, z;
+ sc = rs*HUBERC;
+ if (res[ZLIK] > -sc*sc/2)
+ { res[ZLIK] /= sc*sc;
+ res[ZDLL] /= sc*sc;
+ res[ZDDLL] /= sc*sc;
+ return;
+ }
+ z = sqrt(-2*res[ZLIK]);
+ res[ZDDLL]= (-sc*res[ZDLL]*res[ZDLL]/(z*z*z)+sc*res[ZDDLL]/z)/(sc*sc);
+ res[ZDLL]*= 1.0/(z*sc);
+ res[ZLIK] = 0.5-z/sc;
+}
+
+double lf_link(y,lin)
+double y;
+int lin;
+{ switch(lin)
+ { case LIDENT: return(y);
+ case LLOG: return(log(y));
+ case LLOGIT: return(logit(y));
+ case LINVER: return(1/y);
+ case LSQRT: return(sqrt(fabs(y)));
+ case LASIN: return(asin(sqrt(y)));
+ }
+ ERROR(("link: unknown link %d",lin));
+ return(0.0);
+}
+
+double invlink(th,lin)
+double th;
+int lin;
+{ switch(lin)
+ { case LIDENT: return(th);
+ case LLOG: return(lf_exp(th));
+ case LLOGIT: return(expit(th));
+ case LINVER: return(1/th);
+ case LSQRT: return(th*fabs(th));
+ case LASIN: return(sin(th)*sin(th));
+ case LINIT: return(0.0);
+ }
+ ERROR(("invlink: unknown link %d",lin));
+ return(0.0);
+}
+
+/* the link and various related functions */
+int links(th,y,fam,link,res,c,w,rs)
+double th, y, *res, w, rs;
+int fam, link, c;
+{ double mean;
+ int st;
+
+ mean = res[ZMEAN] = invlink(th,link);
+ if (lf_error) return(LF_LNK);
+
+ switch(fam&63)
+ { case THAZ:
+ case TDEN:
+ case TRAT: return(famdens(mean,th,link,res,c,w));
+ case TGAUS: st = famgaus(y,mean,th,link,res,c,w);
+ break;
+ case TLOGT: st = fambino(y,mean,th,link,res,c,w);
+ break;
+ case TRBIN: return(famrbin(y,mean,th,link,res,c,w));
+ case TPROB:
+ case TPOIS: st = fampois(y,mean,th,link,res,c,w);
+ break;
+ case TGAMM: st = famgamm(y,mean,th,link,res,c,w);
+ break;
+ case TGEOM: st = famgeom(y,mean,th,link,res,c,w);
+ break;
+ case TWEIB: return(famweib(y,mean,th,link,res,c,w));
+ case TCIRC: st = famcirc(y,mean,th,link,res,c,w);
+ break;
+ case TROBT: return(famrobu(y,mean,th,link,res,c,w,rs));
+ case TCAUC: return(famcauc(y,mean,th,link,res,c,w,rs));
+ default:
+ ERROR(("links: invalid family %d",fam));
+ return(LF_FAM);
+ }
+ if (st!=LF_OK) return(st);
+ if (link==LINIT) return(st);
+ if ((fam&128)==128) robustify(res,rs);
+ return(st);
+}
+
+/*
+ stdlinks is a version of links when family, link, response e.t.c
+ all come from the standard places.
+*/
+int stdlinks(res,lfd,sp,i,th,rs)
+lfdata *lfd;
+smpar *sp;
+double th, rs, *res;
+int i;
+{ return(links(th,resp(lfd,i),fam(sp),link(sp),res,cens(lfd,i),prwt(lfd,i),rs));
+}
+
+/*
+ * functions used in variance, skewness, kurtosis calculations
+ * in scb corrections.
+ */
+
+double b2(th,tg,w)
+double th, w;
+int tg;
+{ double y;
+ switch(tg&63)
+ { case TGAUS: return(w);
+ case TPOIS: return(w*lf_exp(th));
+ case TLOGT:
+ y = expit(th);
+ return(w*y*(1-y));
+ }
+ ERROR(("b2: invalid family %d",tg));
+ return(0.0);
+}
+
+double b3(th,tg,w)
+double th, w;
+int tg;
+{ double y;
+ switch(tg&63)
+ { case TGAUS: return(0.0);
+ case TPOIS: return(w*lf_exp(th));
+ case TLOGT:
+ y = expit(th);
+ return(w*y*(1-y)*(1-2*y));
+ }
+ ERROR(("b3: invalid family %d",tg));
+ return(0.0);
+}
+
+double b4(th,tg,w)
+double th, w;
+int tg;
+{ double y;
+ switch(tg&63)
+ { case TGAUS: return(0.0);
+ case TPOIS: return(w*lf_exp(th));
+ case TLOGT:
+ y = expit(th); y = y*(1-y);
+ return(w*y*(1-6*y));
+ }
+ ERROR(("b4: invalid family %d",tg));
+ return(0.0);
+}
diff --git a/src/fitted.c b/src/fitted.c
new file mode 100755
index 0000000..e25d65b
--- /dev/null
+++ b/src/fitted.c
@@ -0,0 +1,102 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+/*
+ Functions for computing residuals and fitted values from
+ the locfit object.
+
+ fitted(lf,fit,what,cv,ty) computes fitted values from the
+ fit structure in lf.
+ resid(y,c,w,th,mi,ty) converts fitted values to residuals
+*/
+
+#include "local.h"
+
+double resid(y,w,th,fam,ty,res)
+int fam, ty;
+double y, w, th, *res;
+{ double raw;
+
+ fam = fam & 63;
+ if ((fam==TGAUS) | (fam==TROBT) | (fam==TCAUC))
+ raw = y-res[ZMEAN];
+ else
+ raw = y-w*res[ZMEAN];
+ switch(ty)
+ { case RDEV:
+ if (res[ZDLL]>0) return(sqrt(-2*res[ZLIK]));
+ else return(-sqrt(-2*res[ZLIK]));
+ case RPEAR:
+ if (res[ZDDLL]<=0)
+ { if (res[ZDLL]==0) return(0);
+ return(NOSLN);
+ }
+ return(res[ZDLL]/sqrt(res[ZDDLL]));
+ case RRAW: return(raw);
+ case RLDOT: return(res[ZDLL]);
+ case RDEV2: return(-2*res[ZLIK]);
+ case RLDDT: return(res[ZDDLL]);
+ case RFIT: return(th);
+ case RMEAN: return(res[ZMEAN]);
+ default: ERROR(("resid: unknown residual type %d",ty));
+ }
+ return(0.0);
+}
+
+double studentize(res,inl,var,ty,link)
+double res, inl, var, *link;
+int ty;
+{ double den;
+ inl *= link[ZDDLL];
+ var = var*var*link[ZDDLL];
+ if (inl>1) inl = 1;
+ if (var>inl) var = inl;
+ den = 1-2*inl+var;
+ if (den<0) return(0.0);
+ switch(ty)
+ { case RDEV:
+ case RPEAR:
+ case RRAW:
+ case RLDOT:
+ return(res/sqrt(den));
+ case RDEV2:
+ return(res/den);
+ default: return(res);
+ }
+}
+
+void fitted(lf,fit,what,cv,st,ty)
+lfit *lf;
+double *fit;
+int what, cv, st, ty;
+{ int i, j, d, n, evo;
+ double xx[MXDIM], th, inl=0.0, var, link[LLEN];
+ n = lf->lfd.n;
+ d = lf->lfd.d;
+ evo = ev(&lf->evs);
+ cv &= (evo!=ECROS);
+ if ((evo==EDATA)|(evo==ECROS)) evo = EFITP;
+ for (i=0; i<n; i++)
+ { for (j=0; j<d; j++) xx[j] = datum(&lf->lfd,j,i);
+ th = dointpoint(lf,xx,what,evo,i);
+ if ((what==PT0)|(what==PVARI)) th = th*th;
+ if (what==PCOEF)
+ { th += base(&lf->lfd,i);
+ stdlinks(link,&lf->lfd,&lf->sp,i,th,rsc(&lf->fp));
+ if ((cv)|(st))
+ { inl = dointpoint(lf,xx,PT0,evo,i);
+ inl = inl*inl;
+ if (cv)
+ { th -= inl*link[ZDLL];
+ stdlinks(link,&lf->lfd,&lf->sp,i,th,rsc(&lf->fp));
+ }
+ if (st) var = dointpoint(lf,xx,PNLX,evo,i);
+ }
+ fit[i] = resid(resp(&lf->lfd,i),prwt(&lf->lfd,i),th,fam(&lf->sp),ty,link);
+ if (st) fit[i] = studentize(fit[i],inl,var,ty,link);
+ } else fit[i] = th;
+ if (lf_error) return;
+ }
+}
diff --git a/src/frend.c b/src/frend.c
new file mode 100755
index 0000000..66945ca
--- /dev/null
+++ b/src/frend.c
@@ -0,0 +1,152 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+extern double robscale;
+
+/* special version of ressumm to estimate sigma^2, with derivative estimation */
+void ressummd(lf)
+lfit *lf;
+{ int i;
+ double s0, s1;
+ s0 = s1 = 0.0;
+ if ((fam(&lf->sp)&64)==0)
+ { rv(&lf->fp) = 1.0;
+ return;
+ }
+ for (i=0; i<lf->fp.nv; i++)
+ { s0 += lf->fp.lik[2*lf->fp.nvm+i];
+ s1 += lf->fp.lik[i];
+ }
+ if (s0==0.0)
+ rv(&lf->fp) = 0.0;
+ else
+ rv(&lf->fp) = -2*s1/s0;
+}
+
+void ressumm(lf,des)
+lfit *lf;
+design *des;
+{ int i, j, evo, tg, orth;
+ double *oy, pw, r1, r2, rdf, t0, t1, u[MXDIM], link[LLEN];
+ fitpt *fp;
+
+ fp = &lf->fp;
+ llk(fp) = df0(fp) = df1(fp) = 0.0;
+
+ evo = ev(&lf->evs);
+ if ((evo==EKDCE) | (evo==EPRES))
+ { rv(fp) = 1.0;
+ return;
+ }
+ if (lf->dv.nd>0)
+ { ressummd(lf);
+ return;
+ }
+ r1 = r2 = 0.0;
+ if ((evo==EDATA) | (evo==ECROS)) evo = EFITP;
+ orth = (geth(&lf->fp)==GAMF) | (geth(&lf->fp)==GAMP);
+ for (i=0; i<lf->lfd.n; i++)
+ { for (j=0; j<lf->lfd.d; j++) u[j] = datum(&lf->lfd,j,i);
+ des->th[i] = base(&lf->lfd,i)+dointpoint(lf,u,PCOEF,evo,i);
+ des->wd[i] = resp(&lf->lfd,i) - des->th[i];
+ des->w[i] = 1.0;
+ des->ind[i] = i;
+ }
+
+ tg = fam(&lf->sp);
+ rsc(&lf->fp) = 1.0;
+ if ((tg==TROBT+64) | (tg==TCAUC+64)) /* global robust scale */
+ { oy = lf->lfd.y; lf->lfd.y = des->wd;
+ des->xev = lf->pc.xbar;
+ locfit(&lf->lfd,des,&lf->sp,1,0);
+ lf->lfd.y = oy;
+ rsc(fp) = robscale;
+ }
+
+ if (orth) /* orthog. residuals */
+ { int od, op;
+ des->n = lf->lfd.n;
+ od = deg(&lf->sp); op = npar(&lf->sp);
+ deg(&lf->sp) = 1;
+ npar(&lf->sp) = des->p = 1+lf->lfd.d;
+ oy = lf->lfd.y; lf->lfd.y = des->wd;
+ des->xev = lf->pc.xbar;
+ locfit(&lf->lfd,des,&lf->sp,1,0);
+ for (i=0; i<lf->lfd.n; i++) oy[i] = resp(&lf->lfd,i) - des->th[i];
+ lf->lfd.y = oy;
+ deg(&lf->sp) = od; npar(&lf->sp) = op;
+ }
+
+ for (i=0; i<lf->lfd.n; i++)
+ { for (j=0; j<lf->lfd.d; j++) u[j] = datum(&lf->lfd,j,i);
+ t0 = dointpoint(lf,u,PT0,evo,i);
+ t1 = dointpoint(lf,u,PNLX,evo,i);
+ stdlinks(link,&lf->lfd,&lf->sp,i,des->th[i],rsc(fp));
+ t1 = t1*t1*link[ZDDLL];
+ t0 = t0*t0*link[ZDDLL];
+ if (t1>1) t1 = 1;
+ if (t0>1) t0 = 1; /* no observation gives >1 deg.free */
+ llk(fp) += link[ZLIK];
+ df0(fp) += t0;
+ df1(fp) += t1;
+ pw = prwt(&lf->lfd,i);
+ if (pw>0)
+ { r1 += link[ZDLL]*link[ZDLL]/pw;
+ r2 += link[ZDDLL]/pw;
+ }
+ if (orth) des->di[i] = t1;
+ }
+
+ if (orth) return;
+
+ rv(fp) = 1.0;
+ if ((fam(&lf->sp)&64)==64) /* quasi family */
+ { rdf = lf->lfd.n-2*df0(fp)+df1(fp);
+ if (rdf<1.0)
+ { WARN(("Estimated rdf < 1.0; not estimating variance"));
+ }
+ else
+ rv(fp) = r1/r2 * lf->lfd.n / rdf;
+ }
+
+ /* try to ensure consistency for family="circ"! */
+ if (((fam(&lf->sp)&63)==TCIRC) & (lf->lfd.d==1))
+ { Sint *ind;
+ int nv;
+ double dlt, th0, th1;
+ ind = des->ind;
+ nv = fp->nv;
+ for (i=0; i<nv; i++) ind[i] = i;
+ lforder(ind,evp(fp),0,nv-1);
+ for (i=1; i<nv; i++)
+ { dlt = evptx(fp,ind[i],0)-evptx(fp,ind[i-1],0);
+ th0 = fp->coef[ind[i]]-dlt*fp->coef[ind[i]+nv]-fp->coef[ind[i-1]];
+ th1 = fp->coef[ind[i]]-dlt*fp->coef[ind[i-1]+nv]-fp->coef[ind[i-1]];
+ if ((th0>PI)&(th1>PI))
+ { for (j=0; j<i; j++)
+ fp->coef[ind[j]] += 2*PI;
+ i--;
+ }
+ if ((th0<(-PI))&(th1<(-PI)))
+ { for (j=0; j<i; j++)
+ fp->coef[ind[j]] -= 2*PI;
+ i--;
+ }
+ }
+ }
+}
+
+double rss(lf,des,df)
+lfit *lf;
+design *des;
+double *df;
+{ double ss;
+ ss = 0;
+ ressumm(lf,des);
+ *df = lf->lfd.n - 2*df0(&lf->fp) + df1(&lf->fp);
+ return(-2*llk(&lf->fp));
+}
diff --git a/src/imatlb.h b/src/imatlb.h
new file mode 100755
index 0000000..73331f3
--- /dev/null
+++ b/src/imatlb.h
@@ -0,0 +1,36 @@
+typedef struct {
+ int n;
+ double *dpr;
+} vari;
+
+typedef struct {
+ double *Z, *Q, *dg, *f2;
+ int p, sm; } xtwxstruc;
+
+typedef struct {
+ vari *wk;
+ double *coef, *xbar, *f;
+ xtwxstruc xtwx; } paramcomp;
+
+typedef struct {
+ vari *dw, *index;
+ double *xev, *X, *w, *di, *res, *th, *wd, h, xb[15];
+ double *V, *P, *f1, *ss, *oc, *cf, llk;
+ xtwxstruc xtwx;
+ int *ind, n, p, pref, (*itype)();
+ int (*vfun)(); } design;
+
+typedef struct {
+ vari *tw, *L, *iw, *xxev;
+ double *x[15], *y, *w, *base, *c, *xl;
+ double *coef, *nlx, *t0, *lik, *h, *deg;
+ double *sv, *fl, *sca, *dp, kap[3];
+ int *ce, *s, *lo, *hi, sty[15];
+ int *mg, nvm, ncm, vc;
+ int nl, nv, nnl, nce, nk, nn, *mi, ord, deriv[9], nd;
+ paramcomp pc;
+ varname yname, xname[15], wname, bname, cname; } lfit;
+
+extern void mlbcall(
+ double *x, double *y,
+ double *xx, double *ff, int n);
diff --git a/src/lf_adap.c b/src/lf_adap.c
new file mode 100755
index 0000000..6ccb71e
--- /dev/null
+++ b/src/lf_adap.c
@@ -0,0 +1,232 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+/*
+ Functions implementing the adaptive bandwidth selection.
+ Will make the final call to nbhd() to set smoothing weights
+ for selected bandwidth, But will **not** make the
+ final call to locfit().
+*/
+
+#include "local.h"
+
+static double hmin;
+
+double adcri(lk,t0,t2,pen)
+double lk, t0, t2, pen;
+{ double y;
+/* return(-2*lk/(t0*exp(pen*log(1-t2/t0)))); */
+ /* return((-2*lk+pen*t2)/t0); */
+ y = (MAX(-2*lk,t0-t2)+pen*t2)/t0;
+ return(y);
+}
+
+double mmse(lfd,sp,dv,des)
+lfdata *lfd;
+smpar *sp;
+deriv *dv;
+design *des;
+{ int i, ii, j, p, p1;
+ double sv, sb, *l, dp;
+
+ l = des->wd;
+ wdiag(lfd, sp, des,l,dv,0,1,0);
+ sv = sb = 0;
+ p = npar(sp);
+ for (i=0; i<des->n; i++)
+ { sv += l[i]*l[i];
+ ii = des->ind[i];
+ dp = des->di[ii];
+ for (j=0; j<deg(sp); j++) dp *= des->di[ii];
+ sb += fabs(l[i])*dp;
+ }
+ p1 = factorial(deg(sp)+1);
+ return(sv+sb*sb*pen(sp)*pen(sp)/(p1*p1));
+}
+
+static double mcp, clo, cup;
+
+/*
+ Initial bandwidth will be (by default)
+ k-nearest neighbors for k small, just large enough to
+ get defined estimate (unless user provided nonzero nn or fix-h components)
+*/
+
+int ainitband(lfd,sp,dv,des)
+lfdata *lfd;
+smpar *sp;
+deriv *dv;
+design *des;
+{ int lf_status=0, p, z, cri, noit, redo;
+ double ho, t[6];
+
+ if (lf_debug >= 2) printf("ainitband:\n");
+ p = des->p;
+ cri = acri(sp);
+ noit = (cri!=AOK);
+ z = (int)(lfd->n*nn(sp));
+ if ((noit) && (z<p+2)) z = p+2;
+ redo = 0; ho = -1;
+ do
+ {
+ nbhd(lfd,des,z,redo,sp);
+ if (z<des->n) z = des->n;
+ if (des->h>ho) lf_status = locfit(lfd,des,sp,noit,0,0);
+ z++;
+ redo = 1;
+ } while ((z<=lfd->n) && ((des->h==0)||(lf_status!=LF_OK)));
+ hmin = des->h;
+
+ switch(cri)
+ { case ACP:
+ local_df(lfd,sp,des,t);
+ mcp = adcri(des->llk,t[0],t[2],pen(sp));
+ return(lf_status);
+ case AKAT:
+ local_df(lfd,sp,des,t);
+ clo = des->cf[0]-pen(sp)*t[5];
+ cup = des->cf[0]+pen(sp)*t[5];
+ return(lf_status);
+ case AMDI:
+ mcp = mmse(lfd,sp,dv,des);
+ return(lf_status);
+ case AOK: return(lf_status);
+ }
+ ERROR(("aband1: unknown criterion"));
+ return(LF_ERR);
+}
+
+/*
+ aband2 increases the initial bandwidth until lack of fit results,
+ or the fit is close to a global fit. Increase h by 1+0.3/d at
+ each iteration.
+*/
+
+double aband2(lfd,sp,dv,des,h0)
+lfdata *lfd;
+smpar *sp;
+deriv *dv;
+design *des;
+double h0;
+{ double t[6], h1, nu1, cp, ncp, tlo, tup;
+ int d, inc, n, p, done;
+
+ if (lf_debug >= 2) printf("aband2:\n");
+ d = lfd->d; n = lfd->n; p = npar(sp);
+ h1 = des->h = h0;
+ done = 0; nu1 = 0.0;
+ inc = 0; ncp = 0.0;
+ while ((!done) & (nu1<(n-p)*0.95))
+ { fixh(sp) = (1+0.3/d)*des->h;
+ nbhd(lfd,des,0,1,sp);
+ if (locfit(lfd,des,sp,1,0,0) > 0) WARN(("aband2: failed fit"));
+ local_df(lfd,sp,des,t);
+ nu1 = t[0]-t[2]; /* tr(A) */
+ switch(acri(sp))
+ { case AKAT:
+ tlo = des->cf[0]-pen(sp)*t[5];
+ tup = des->cf[0]+pen(sp)*t[5];
+/* printf("h %8.5f tlo %8.5f tup %8.5f\n",des->h,tlo,tup); */
+ done = ((tlo>cup) | (tup<clo));
+ if (!done)
+ { clo = MAX(clo,tlo);
+ cup = MIN(cup,tup);
+ h1 = des->h;
+ }
+ break;
+ case ACP:
+ cp = adcri(des->llk,t[0],t[2],pen(sp));
+/* printf("h %8.5f lk %8.5f t0 %8.5f t2 %8.5f cp %8.5f\n",des->h,des->llk,t[0],t[2],cp); */
+ if (cp<mcp) { mcp = cp; h1 = des->h; }
+ if (cp>=ncp) inc++; else inc = 0;
+ ncp = cp;
+ done = (inc>=10) | ((inc>=3) & ((t[0]-t[2])>=10) & (cp>1.5*mcp));
+ break;
+ case AMDI:
+ cp = mmse(lfd,sp,dv,des);
+ if (cp<mcp) { mcp = cp; h1 = des->h; }
+ if (cp>ncp) inc++; else inc = 0;
+ ncp = cp;
+ done = (inc>=3);
+ break;
+ }
+ }
+ return(h1);
+}
+
+/*
+ aband3 does a finer search around best h so far. Try
+ h*(1-0.2/d), h/(1-0.1/d), h*(1+0.1/d), h*(1+0.2/d)
+*/
+double aband3(lfd,sp,dv,des,h0)
+lfdata *lfd;
+smpar *sp;
+deriv *dv;
+design *des;
+double h0;
+{ double t[6], h1, cp, tlo, tup;
+ int i, i0, d, n;
+
+ if (lf_debug >= 2) printf("aband3:\n");
+ d = lfd->d; n = lfd->n;
+ h1 = h0;
+ i0 = (acri(sp)==AKAT) ? 1 : -2;
+ if (h0==hmin) i0 = 1;
+
+ for (i=i0; i<=2; i++)
+ { if (i==0) i++;
+ fixh(sp) = h0*(1+0.1*i/d);
+ nbhd(lfd,des,0,1,sp);
+ if (locfit(lfd,des,sp,1,0,0) > 0) WARN(("aband3: failed fit"));
+ local_df(lfd,sp,des,t);
+ switch (acri(sp))
+ { case AKAT:
+ tlo = des->cf[0]-pen(sp)*t[5];
+ tup = des->cf[0]+pen(sp)*t[5];
+ if ((tlo>cup) | (tup<clo)) /* done */
+ i = 2;
+ else
+ { h1 = des->h;
+ clo = MAX(clo,tlo);
+ cup = MIN(cup,tup);
+ }
+ break;
+ case ACP:
+ cp = adcri(des->llk,t[0],t[2],pen(sp));
+ if (cp<mcp) { mcp = cp; h1 = des->h; }
+ else
+ { if (i>0) i = 2; }
+ break;
+ case AMDI:
+ cp = mmse(lfd,sp,dv,des);
+ if (cp<mcp) { mcp = cp; h1 = des->h; }
+ else
+ { if (i>0) i = 2; }
+ }
+ }
+ return(h1);
+}
+
+int alocfit(lfd,sp,dv,des)
+lfdata *lfd;
+smpar *sp;
+deriv *dv;
+design *des;
+{ int lf_status;
+ double h0;
+
+ lf_status = ainitband(lfd,sp,dv,des);
+ if (lf_error) return(lf_status);
+ if (acri(sp) == AOK) return(lf_status);
+
+ h0 = fixh(sp);
+ fixh(sp) = aband2(lfd,sp,dv,des,des->h);
+ fixh(sp) = aband3(lfd,sp,dv,des,fixh(sp));
+ nbhd(lfd,des,0,1,sp);
+ lf_status = locfit(lfd,des,sp,0,0,0);
+ fixh(sp) = h0;
+
+ return(lf_status);
+}
diff --git a/src/lf_dercor.c b/src/lf_dercor.c
new file mode 100755
index 0000000..7f9a511
--- /dev/null
+++ b/src/lf_dercor.c
@@ -0,0 +1,52 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Derivative corrections. The local slopes are not the derivatives
+ * of the local likelihood estimate; the function dercor() computes
+ * the adjustment to get the correct derivatives under the assumption
+ * that h is constant.
+ *
+ * By differentiating the local likelihood equations, one obtains
+ *
+ * d ^ ^ T -1 T d . ^
+ * -- a = a - (X W V X) X -- W l( Y, X a)
+ * dx 0 1 dx
+ */
+
+#include "local.h"
+extern double robscale;
+
+void dercor(lfd,sp,des,coef)
+lfdata *lfd;
+smpar *sp;
+design *des;
+double *coef;
+{ double s1, dc[MXDIM], wd, link[LLEN];
+ int i, ii, j, m, d, p;
+ if (fam(sp)<=THAZ) return;
+ if (ker(sp)==WPARM) return;
+
+ d = lfd->d;
+ p = des->p; m = des->n;
+
+ if (lf_debug>1) printf(" Correcting derivatives\n");
+ fitfun(lfd, sp, des->xev,des->xev,des->f1,NULL);
+ jacob_solve(&des->xtwx,des->f1);
+ setzero(dc,d);
+
+ /* correction term is e1^T (XTWVX)^{-1} XTW' ldot. */
+ for (i=0; i<m; i++)
+ { s1 = innerprod(des->f1,&des->X[i*p],p);
+ ii = des->ind[i];
+ stdlinks(link,lfd,sp,ii,des->th[i],robscale);
+ for (j=0; j<d; j++)
+ { wd = des->w[i]*weightd(datum(lfd,j,ii)-des->xev[j],lfd->sca[j],
+ d,ker(sp),kt(sp),des->h,lfd->sty[j],des->di[ii]);
+ dc[j] += s1*wd*link[ZDLL];
+ }
+
+ }
+ for (j=0; j<d; j++) coef[j+1] += dc[j];
+}
diff --git a/src/lf_fitfun.c b/src/lf_fitfun.c
new file mode 100755
index 0000000..a069aa7
--- /dev/null
+++ b/src/lf_fitfun.c
@@ -0,0 +1,263 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Evaluate the locfit fitting functions.
+ * calcp(sp,d)
+ * calculates the number of fitting functions.
+ * makecfn(sp,des,dv,d)
+ * makes the coef.number vector.
+ * fitfun(lfd, sp, x,t,f,dv)
+ * lfd is the local fit structure.
+ * sp smoothing parameter structure.
+ * x is the data point.
+ * t is the fitting point.
+ * f is a vector to return the results.
+ * dv derivative structure.
+ * designmatrix(lfd, sp, des)
+ * is a wrapper for fitfun to build the design matrix.
+ *
+ */
+
+#include "local.h"
+
+int calcp(sp,d)
+smpar *sp;
+int d;
+{ int i, k;
+
+ if (ubas(sp))
+{ printf("calcp-ubas\n");
+ return(npar(sp));
+}
+
+ switch (kt(sp))
+ { case KSPH:
+ case KCE:
+ k = 1;
+ for (i=1; i<=deg(sp); i++) k = k*(d+i)/i;
+ return(k);
+ case KPROD: return(d*deg(sp)+1);
+ case KLM: return(d);
+ case KZEON: return(1);
+ }
+ ERROR(("calcp: invalid kt %d",kt(sp)));
+ return(0);
+}
+
+int coefnumber(dv,kt,d,deg)
+int kt, d, deg;
+deriv *dv;
+{ int d0, d1, t;
+
+ if (d==1)
+ { if (dv->nd<=deg) return(dv->nd);
+ return(-1);
+ }
+
+ if (dv->nd==0) return(0);
+ if (deg==0) return(-1);
+ if (dv->nd==1) return(1+dv->deriv[0]);
+ if (deg==1) return(-1);
+ if (kt==KPROD) return(-1);
+
+ if (dv->nd==2)
+ { d0 = dv->deriv[0]; d1 = dv->deriv[1];
+ if (d0<d1) { t = d0; d0 = d1; d1 = t; }
+ return((d+1)*(d0+1)-d0*(d0+3)/2+d1);
+ }
+ if (deg==2) return(-1);
+
+ ERROR(("coefnumber not programmed for nd>=3"));
+ return(-1);
+}
+
+void makecfn(sp,des,dv,d)
+smpar *sp;
+design *des;
+deriv *dv;
+int d;
+{ int i, nd;
+
+ nd = dv->nd;
+
+ des->cfn[0] = coefnumber(dv,kt(sp),d,deg(sp));
+ des->ncoef = 1;
+ if (nd >= deg(sp)) return;
+ if (kt(sp)==KZEON) return;
+
+ if (d>1)
+ { if (nd>=2) return;
+ if ((nd>=1) && (kt(sp)==KPROD)) return;
+ }
+
+ dv->nd = nd+1;
+ for (i=0; i<d; i++)
+ { dv->deriv[nd] = i;
+ des->cfn[i+1] = coefnumber(dv,kt(sp),d,deg(sp));
+ }
+ dv->nd = nd;
+
+ des->ncoef = 1+d;
+}
+
+void fitfunangl(dx,ff,sca,cd,deg)
+double dx, *ff, sca;
+int deg, cd;
+{
+ if (deg>=3) WARN(("Can't handle angular model with deg>=3"));
+
+ switch(cd)
+ { case 0:
+ ff[0] = 1;
+ ff[1] = sin(dx/sca)*sca;
+ ff[2] = (1-cos(dx/sca))*sca*sca;
+ return;
+ case 1:
+ ff[0] = 0;
+ ff[1] = cos(dx/sca);
+ ff[2] = sin(dx/sca)*sca;
+ return;
+ case 2:
+ ff[0] = 0;
+ ff[1] = -sin(dx/sca)/sca;
+ ff[2] = cos(dx/sca);
+ return;
+ default: WARN(("Can't handle angular model with >2 derivs"));
+ }
+}
+
+void fitfun(lfd,sp,x,t,f,dv)
+lfdata *lfd;
+smpar *sp;
+double *x, *t, *f;
+deriv *dv;
+{ int d, deg, nd, m, i, j, k, ct_deriv[MXDIM];
+ double ff[MXDIM][1+MXDEG], dx[MXDIM], *xx[MXDIM];
+
+ if (ubas(sp))
+ { for (i=0; i<lfd->d; i++) xx[i] = &x[i];
+ i = 0;
+ sp->vbasis(xx,t,1,lfd->d,&i,1,npar(sp),f);
+ return;
+ }
+
+ d = lfd->d;
+ deg = deg(sp);
+ m = 0;
+ nd = (dv==NULL) ? 0 : dv->nd;
+
+ if (kt(sp)==KZEON)
+ { f[0] = 1.0;
+ return;
+ }
+
+ if (kt(sp)==KLM)
+ { for (i=0; i<d; i++) f[m++] = x[i];
+ return;
+ }
+
+ f[m++] = (nd==0);
+ if (deg==0) return;
+
+ for (i=0; i<d; i++)
+ { ct_deriv[i] = 0;
+ dx[i] = (t==NULL) ? x[i] : x[i]-t[i];
+ }
+ for (i=0; i<nd; i++) ct_deriv[dv->deriv[i]]++;
+
+ for (i=0; i<d; i++)
+ { switch(lfd->sty[i])
+ {
+ case STANGL:
+ fitfunangl(dx[i],ff[i],lfd->sca[i],ct_deriv[i],deg(sp));
+ break;
+ default:
+ for (j=0; j<ct_deriv[i]; j++) ff[i][j] = 0.0;
+ ff[i][ct_deriv[i]] = 1.0;
+ for (j=ct_deriv[i]+1; j<=deg; j++)
+ ff[i][j] = ff[i][j-1]*dx[i]/(j-ct_deriv[i]);
+ }
+ }
+
+/*
+ * Product kernels. Note that if ct_deriv[i] != nd, that implies
+ * there is differentiation wrt another variable, and all components
+ * involving x[i] are 0.
+ */
+ if ((d==1) || (kt(sp)==KPROD))
+ { for (j=1; j<=deg; j++)
+ for (i=0; i<d; i++)
+ f[m++] = (ct_deriv[i]==nd) ? ff[i][j] : 0.0;
+ return;
+ }
+
+/*
+ * Spherical kernels with the full polynomial basis.
+ * Presently implemented up to deg=3.
+ */
+ for (i=0; i<d; i++)
+ f[m++] = (ct_deriv[i]==nd) ? ff[i][1] : 0.0;
+ if (deg==1) return;
+
+ for (i=0; i<d; i++)
+ {
+ /* xi^2/2 terms. */
+ f[m++] = (ct_deriv[i]==nd) ? ff[i][2] : 0.0;
+
+ /* xi xj terms */
+ for (j=i+1; j<d; j++)
+ f[m++] = (ct_deriv[i]+ct_deriv[j]==nd) ? ff[i][1]*ff[j][1] : 0.0;
+ }
+ if (deg==2) return;
+
+ for (i=0; i<d; i++)
+ {
+ /* xi^3/6 terms */
+ f[m++] = (ct_deriv[i]==nd) ? ff[i][3] : 0.0;
+
+ /* xi^2/2 xk terms */
+ for (k=i+1; k<d; k++)
+ f[m++] = (ct_deriv[i]+ct_deriv[k]==nd) ? ff[i][2]*ff[k][1] : 0.0;
+
+ /* xi xj xk terms */
+ for (j=i+1; j<d; j++)
+ { f[m++] = (ct_deriv[i]+ct_deriv[j]==nd) ? ff[i][1]*ff[j][2] : 0.0;
+ for (k=j+1; k<d; k++)
+ f[m++] = (ct_deriv[i]+ct_deriv[j]+ct_deriv[k]==nd) ?
+ ff[i][1]*ff[j][1]*ff[k][1] : 0.0;
+ }
+ }
+ if (deg==3) return;
+
+ ERROR(("fitfun: can't handle deg=%d for spherical kernels",deg));
+}
+
+/*
+ * Build the design matrix. Assumes des->ind contains the indices of
+ * the required data points; des->n the number of points; des->xev
+ * the fitting point.
+ */
+void designmatrix(lfd,sp,des)
+lfdata *lfd;
+smpar *sp;
+design *des;
+{ int i, ii, j, p;
+ double *X, u[MXDIM];
+
+ X = d_x(des);
+ p = des->p;
+
+ if (ubas(sp))
+ {
+ sp->vbasis(lfd->x,des->xev,lfd->n,lfd->d,des->ind,des->n,p,X);
+ return;
+ }
+
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ for (j=0; j<lfd->d; j++) u[j] = datum(lfd,j,ii);
+ fitfun(lfd,sp,u,des->xev,&X[i*p],NULL);
+ }
+}
diff --git a/src/lf_nbhd.c b/src/lf_nbhd.c
new file mode 100755
index 0000000..25b6324
--- /dev/null
+++ b/src/lf_nbhd.c
@@ -0,0 +1,275 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Functions for determining bandwidth; smoothing neighborhood
+ * and smoothing weights.
+ */
+
+#include "local.h"
+
+double rho(x,sc,d,kt,sty) /* ||x|| for appropriate distance metric */
+double *x, *sc;
+int d, kt, *sty;
+{ double rhoi[MXDIM], s;
+ int i;
+ for (i=0; i<d; i++)
+ { if (sty!=NULL)
+ { switch(sty[i])
+ { case STANGL: rhoi[i] = 2*sin(x[i]/(2*sc[i])); break;
+ case STCPAR: rhoi[i] = 0; break;
+ default: rhoi[i] = x[i]/sc[i];
+ } }
+ else rhoi[i] = x[i]/sc[i];
+ }
+
+ if (d==1) return(fabs(rhoi[0]));
+
+ s = 0;
+ if (kt==KPROD)
+ { for (i=0; i<d; i++)
+ { rhoi[i] = fabs(rhoi[i]);
+ if (rhoi[i]>s) s = rhoi[i];
+ }
+ return(s);
+ }
+
+ if (kt==KSPH)
+ { for (i=0; i<d; i++)
+ s += rhoi[i]*rhoi[i];
+ return(sqrt(s));
+ }
+
+ ERROR(("rho: invalid kt"));
+ return(0.0);
+}
+
+double kordstat(x,k,n,ind)
+double *x;
+int k, n;
+Sint *ind;
+{ int i, i0, i1, l, r;
+ double piv;
+ if (k<1) return(0.0);
+ i0 = 0; i1 = n-1;
+ while (1)
+ { piv = x[ind[(i0+i1)/2]];
+ l = i0; r = i1;
+ while (l<=r)
+ { while ((l<=i1) && (x[ind[l]]<=piv)) l++;
+ while ((r>=i0) && (x[ind[r]]>piv)) r--;
+ if (l<=r) ISWAP(ind[l],ind[r]);
+ } /* now, x[ind[i0..r]] <= piv < x[ind[l..i1]] */
+ if (r<k-1) i0 = l; /* go right */
+ else /* put pivots in middle */
+ { for (i=i0; i<=r; )
+ if (x[ind[i]]==piv) { ISWAP(ind[i],ind[r]); r--; }
+ else i++;
+ if (r<k-1) return(piv);
+ i1 = r;
+ }
+ }
+}
+
+/* check if i'th data point is in limits */
+int inlim(lfd,i)
+lfdata *lfd;
+int i;
+{ int d, j, k;
+ double *xlim;
+
+ xlim = lfd->xl;
+ d = lfd->d;
+ k = 1;
+ for (j=0; j<d; j++)
+ { if (xlim[j]<xlim[j+d])
+ k &= ((datum(lfd,j,i)>=xlim[j]) & (datum(lfd,j,i)<=xlim[j+d]));
+ }
+ return(k);
+}
+
+double compbandwid(di,ind,x,n,d,nn,fxh)
+double *di, *x, fxh;
+Sint *ind;
+int n, d, nn;
+{ int i;
+ double nnh;
+
+ if (nn==0) return(fxh);
+
+ if (nn<n)
+ nnh = kordstat(di,nn,n,ind);
+ else
+ { nnh = 0;
+ for (i=0; i<n; i++) nnh = MAX(nnh,di[i]);
+ nnh = nnh*exp(log(1.0*nn/n)/d);
+ }
+ return(MAX(fxh,nnh));
+}
+
+/*
+ fast version of nbhd for ordered 1-d data
+*/
+void nbhd1(lfd,sp,des,k)
+lfdata *lfd;
+smpar *sp;
+design *des;
+int k;
+{ double x, h, *xd, sc;
+ int i, l, r, m, n, z;
+
+ n = lfd->n;
+ x = des->xev[0];
+ xd = dvari(lfd,0);
+ sc = lfd->sca[0];
+
+ /* find closest data point to x */
+ if (x<=xd[0]) z = 0;
+ else
+ if (x>=xd[n-1]) z = n-1;
+ else
+ { l = 0; r = n-1;
+ while (r-l>1)
+ { z = (r+l)/2;
+ if (xd[z]>x) r = z;
+ else l = z;
+ }
+ /* now, xd[0..l] <= x < x[r..n-1] */
+ if ((x-xd[l])>(xd[r]-x)) z = r; else z = l;
+ }
+ /* closest point to x is xd[z] */
+
+ if (nn(sp)<0) /* user bandwidth */
+ h = sp->vb(des->xev);
+ else
+ { if (k>0) /* set h to nearest neighbor bandwidth */
+ { l = r = z;
+ if (l==0) r = k-1;
+ if (r==n-1) l = n-k;
+ while (r-l<k-1)
+ { if ((x-xd[l-1])<(xd[r+1]-x)) l--; else r++;
+ if (l==0) r = k-1;
+ if (r==n-1) l = n-k;
+ }
+ h = x-xd[l];
+ if (h<xd[r]-x) h = xd[r]-x;
+ }
+ else h = 0;
+ h /= sc;
+ if (h<fixh(sp)) h = fixh(sp);
+ }
+
+ m = 0;
+ if (xd[z]>x) z--; /* so xd[z]<=x */
+ /* look left */
+ for (i=z; i>=0; i--) if (inlim(lfd,i))
+ { des->di[i] = (x-xd[i])/sc;
+ des->w[m] = weight(lfd, sp, &xd[i], &x, h, 1, des->di[i]);
+ if (des->w[m]>0)
+ { des->ind[m] = i;
+ m++;
+ } else i = 0;
+ }
+ /* look right */
+ for (i=z+1; i<n; i++) if (inlim(lfd,i))
+ { des->di[i] = (xd[i]-x)/sc;
+ des->w[m] = weight(lfd, sp, &xd[i], &x, h, 1, des->di[i]);
+ if (des->w[m]>0)
+ { des->ind[m] = i;
+ m++;
+ } else i = n;
+ }
+
+ des->n = m;
+ des->h = h;
+}
+
+void nbhd_zeon(lfd,des)
+lfdata *lfd;
+design *des;
+{ int i, j, m, eq;
+
+ m = 0;
+ for (i=0; i<lfd->n; i++)
+ { eq = 1;
+ for (j=0; j<lfd->d; j++) eq = eq && (des->xev[j] == datum(lfd,j,i));
+ if (eq)
+ { des->w[m] = 1;
+ des->ind[m] = i;
+ m++;
+ }
+ }
+ des->n = m;
+ des->h = 1.0;
+}
+
+void nbhd(lfd,des,nn,redo,sp)
+lfdata *lfd;
+design *des;
+int redo, nn;
+smpar *sp;
+{ int d, i, j, m, n;
+ double h, u[MXDIM];
+
+ if (lf_debug>1) printf("nbhd: nn %d fixh %8.5f\n",nn,fixh(sp));
+
+ d = lfd->d; n = lfd->n;
+
+ if (ker(sp)==WPARM)
+ { for (i=0; i<n; i++)
+ { des->w[i] = 1.0;
+ des->ind[i] = i;
+ }
+ des->n = n;
+ return;
+ }
+
+ if (kt(sp)==KZEON)
+ { nbhd_zeon(lfd,des);
+ return;
+ }
+
+ if (kt(sp)==KCE)
+ { des->h = 0.0;
+ return;
+ }
+
+ /* ordered 1-dim; use fast searches */
+ if ((nn<=n) & (lfd->ord) & (ker(sp)!=WMINM) & (lfd->sty[0]!=STANGL))
+ { nbhd1(lfd,sp,des,nn);
+ return;
+ }
+
+ if (!redo)
+ { for (i=0; i<n; i++)
+ { for (j=0; j<d; j++) u[j] = datum(lfd,j,i)-des->xev[j];
+ des->di[i] = rho(u,lfd->sca,d,kt(sp),lfd->sty);
+ des->ind[i] = i;
+ }
+ }
+ else
+ for (i=0; i<n; i++) des->ind[i] = i;
+
+ if (ker(sp)==WMINM)
+ { des->h = minmax(lfd,des,sp);
+ return;
+ }
+
+ if (nn<0)
+ h = sp->vb(des->xev);
+ else
+ h = compbandwid(des->di,des->ind,des->xev,n,lfd->d,nn,fixh(sp));
+ m = 0;
+ for (i=0; i<n; i++) if (inlim(lfd,i))
+ { for (j=0; j<d; j++) u[j] = datum(lfd,j,i);
+ des->w[m] = weight(lfd, sp, u, des->xev, h, 1, des->di[i]);
+ if (des->w[m]>0)
+ { des->ind[m] = i;
+ m++;
+ }
+ }
+ des->n = m;
+ des->h = h;
+}
diff --git a/src/lf_robust.c b/src/lf_robust.c
new file mode 100755
index 0000000..e86a2a1
--- /dev/null
+++ b/src/lf_robust.c
@@ -0,0 +1,137 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * This file includes functions to solve for the scale estimate in
+ * local robust regression and likelihood. The main entry point is
+ * lf_robust(lfd,sp,des,mxit),
+ * called from the locfit() function.
+ *
+ * The update_rs(x) accepts a residual scale x as the argument (actually,
+ * it works on the log-scale). The function computes the local fit
+ * assuming this residual scale, and re-estimates the scale from this
+ * new fit. The final solution satisfies the fixed point equation
+ * update_rs(x)=x. The function lf_robust() automatically calls
+ * update_rs() through the fixed point iterations.
+ *
+ * The estimation of the scale from the fit is based on the sqrt of
+ * the median deviance of observations with non-zero weights (in the
+ * gaussian case, this is the median absolute residual).
+ *
+ * TODO:
+ * Should use smoothing weights in the median.
+ */
+
+#include "local.h"
+
+extern int lf_status;
+double robscale;
+
+static lfdata *rob_lfd;
+static smpar *rob_sp;
+static design *rob_des;
+static int rob_mxit;
+
+double median(x,n)
+double *x;
+int n;
+{ int i, j, lt, eq, gt;
+ double lo, hi, s;
+ lo = hi = x[0];
+ for (i=0; i<n; i++)
+ { lo = MIN(lo,x[i]);
+ hi = MAX(hi,x[i]);
+ }
+ if (lo==hi) return(lo);
+ lo -= (hi-lo);
+ hi += (hi-lo);
+ for (i=0; i<n; i++)
+ { if ((x[i]>lo) & (x[i]<hi))
+ { s = x[i]; lt = eq = gt = 0;
+ for (j=0; j<n; j++)
+ { lt += (x[j]<s);
+ eq += (x[j]==s);
+ gt += (x[j]>s);
+ }
+ if ((2*(lt+eq)>n) && (2*(gt+eq)>n)) return(s);
+ if (2*(lt+eq)<=n) lo = s;
+ if (2*(gt+eq)<=n) hi = s;
+ }
+ }
+ return((hi+lo)/2);
+}
+
+double nrobustscale(lfd,sp,des,rs)
+lfdata *lfd;
+smpar *sp;
+design *des;
+double rs;
+{ int i, ii, p;
+ double link[LLEN], sc, sd, sw, e;
+ p = des->p; sc = sd = sw = 0.0;
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ des->th[i] = base(lfd,ii)+innerprod(des->cf,d_xi(des,i),p);
+ e = resp(lfd,ii)-des->th[i];
+ stdlinks(link,lfd,sp,ii,des->th[i],rs);
+ sc += des->w[i]*e*link[ZDLL];
+ sd += des->w[i]*e*e*link[ZDDLL];
+ sw += des->w[i];
+ }
+
+ /* newton-raphson iteration for log(s)
+ -psi(ei/s) - log(s); s = e^{-th}
+ */
+ rs *= exp((sc-sw)/(sd+sc));
+ return(rs);
+}
+
+double robustscale(lfd,sp,des)
+lfdata *lfd;
+smpar *sp;
+design *des;
+{ int i, ii, p, fam, lin;
+ double rs, link[LLEN];
+ p = des->p;
+ fam = fam(sp);
+ lin = link(sp);
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ des->th[i] = base(lfd,ii) + innerprod(des->cf,d_xi(des,i),p);
+ links(des->th[i],resp(lfd,ii),fam&127,lin,link,cens(lfd,ii),prwt(lfd,ii),1.0);
+ des->res[i] = -2*link[ZLIK];
+ }
+ rs = sqrt(median(des->res,des->n));
+ if (rs==0.0) rs = 1.0;
+ return(rs);
+}
+
+double update_rs(x)
+double x;
+{ double nx;
+ if (lf_status != LF_OK) return(x);
+ robscale = exp(x);
+ lfiter(rob_des,rob_mxit);
+ if (lf_status != LF_OK) return(x);
+
+ nx = log(robustscale(rob_lfd,rob_sp,rob_des));
+ if (nx<x-0.2) nx = x-0.2;
+ return(nx);
+}
+
+void lf_robust(lfd,sp,des,mxit)
+lfdata *lfd;
+design *des;
+smpar *sp;
+int mxit;
+{ double x;
+ rob_lfd = lfd;
+ rob_des = des;
+ rob_sp = sp;
+ rob_mxit = mxit;
+ lf_status = LF_OK;
+
+ x = log(robustscale(lfd,sp,des));
+ solve_fp(update_rs, x, 1.0e-6, mxit);
+}
diff --git a/src/lf_vari.c b/src/lf_vari.c
new file mode 100755
index 0000000..35360c8
--- /dev/null
+++ b/src/lf_vari.c
@@ -0,0 +1,168 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Post-fitting functions to compute the local variance and
+ * influence functions. Also the local degrees of freedom
+ * calculations for adaptive smoothing.
+ */
+
+#include "local.h"
+
+extern double robscale;
+static double tr0, tr1, tr2;
+
+/*
+ vmat() computes (after the local fit..) the matrix
+ M2 = X^T W^2 V X.
+ M12 = (X^T W V X)^{-1} M2
+ Also, for convenience, tr[0] = sum(wi) tr[1] = sum(wi^2).
+*/
+void vmat(lfd, sp, des, M12, M2)
+lfdata *lfd;
+smpar *sp;
+design *des;
+double *M12, *M2;
+{ int i, p, nk, ok;
+ double link[LLEN], h, ww;
+ p = des->p;
+ setzero(M2,p*p);
+
+ nk = -1;
+
+ /* for density estimation, use integral rather than
+ sum form, if W^2 is programmed...
+ */
+ if ((fam(sp)<=THAZ) && (link(sp)==LLOG))
+ { switch(ker(sp))
+ { case WGAUS: nk = WGAUS; h = des->h/SQRT2; break;
+ case WRECT: nk = WRECT; h = des->h; break;
+ case WEPAN: nk = WBISQ; h = des->h; break;
+ case WBISQ: nk = WQUQU; h = des->h; break;
+ case WTCUB: nk = W6CUB; h = des->h; break;
+ case WEXPL: nk = WEXPL; h = des->h/2; break;
+ }
+ }
+
+ tr0 = tr1 = 0.0;
+ if (nk != -1)
+ { ok = ker(sp); ker(sp) = nk;
+/* compute M2 using integration. Use M12 as work matrix. */
+ (des->itype)(des->xev, M2, M12, des->cf, h);
+ ker(sp) = ok;
+ if (fam(sp)==TDEN) multmatscal(M2,des->smwt,p*p);
+ tr0 = des->ss[0];
+ tr1 = M2[0]; /* n int W e^<a,A> */
+ }
+ else
+ { for (i=0; i<des->n; i++)
+ { stdlinks(link,lfd,sp,(int)des->ind[i],des->th[i],robscale);
+ ww = SQR(des->w[i])*link[ZDDLL];
+ tr0 += des->w[i];
+ tr1 += SQR(des->w[i]);
+ addouter(M2,d_xi(des,i),d_xi(des,i),p,ww);
+ }
+ }
+
+ memmove(M12,M2,p*p*sizeof(double));
+ for (i=0; i<p; i++)
+ jacob_solve(&des->xtwx,&M12[i*p]);
+}
+
+void lf_vcov(lfd,sp,des)
+lfdata *lfd;
+smpar *sp;
+design *des;
+{ int i, j, k, p;
+ double *M12, *M2;
+ M12 = des->V; M2 = des->P; p = des->p;
+ vmat(lfd,sp,des,M12,M2); /* M2 = X^T W^2 V X tr0=sum(W) tr1=sum(W*W) */
+ tr2 = m_trace(M12,p); /* tr (XTWVX)^{-1}(XTW^2VX) */
+
+/*
+ * Covariance matrix is M1^{-1} * M2 * M1^{-1}
+ * We compute this using the cholesky decomposition of
+ * M2; premultiplying by M1^{-1} and squaring. This
+ * is more stable than direct computation in near-singular cases.
+ */
+ chol_dec(M2,p,p);
+ for (i=0; i<p; i++)
+ for (j=0; j<i; j++)
+ { M2[j*p+i] = M2[i*p+j];
+ M2[i*p+j] = 0.0;
+ }
+ for (i=0; i<p; i++) jacob_solve(&des->xtwx,&M2[i*p]);
+ for (i=0; i<p; i++)
+ { for (j=0; j<p; j++)
+ { M12[i*p+j] = 0;
+ for (k=0; k<p; k++)
+ M12[i*p+j] += M2[k*p+i]*M2[k*p+j]; /* ith column of covariance */
+ }
+ }
+ if ((fam(sp)==TDEN) && (link(sp)==LIDENT))
+ multmatscal(M12,1/SQR(des->smwt),p*p);
+}
+
+void comp_vari(lfd,sp,des,tr,t0)
+lfdata *lfd;
+smpar *sp;
+design *des;
+double *tr, *t0;
+{ int i;
+ lf_vcov(lfd,sp,des);
+ tr[0] = tr0;
+ tr[1] = tr1;
+ tr[2] = tr2;
+ /* influence components */
+ unitvec(des->f1,0,des->p);
+ jacob_solve(&des->xtwx,des->f1);
+ for (i=0; i<=lfd->d; i++) t0[i] = des->f1[i];
+}
+
+/* local_df computes:
+ * tr[0] = trace(W)
+ * tr[1] = trace(W*W)
+ * tr[2] = trace( M1^{-1} M2 )
+ * tr[3] = trace( M1^{-1} M3 )
+ * tr[4] = trace( (M1^{-1} M2)^2 )
+ * tr[5] = var(theta-hat).
+ */
+void local_df(lfd,sp,des,tr)
+lfdata *lfd;
+smpar *sp;
+design *des;
+double *tr;
+{ int i, j, p;
+ double *m2, *V, ww, link[LLEN];
+
+ tr[0] = tr[1] = tr[2] = tr[3] = tr[4] = tr[5] = 0.0;
+ m2 = des->V; V = des->P; p = des->p;
+
+ vmat(lfd,sp,des,m2,V); /* M = X^T W^2 V X tr0=sum(W) tr1=sum(W*W) */
+ tr[0] = tr1;
+ tr[1] = tr1;
+ tr[2] = m_trace(m2,p); /* tr (XTWVX)^{-1}(XTW^2VX) */
+
+ unitvec(des->f1,0,p);
+ jacob_solve(&des->xtwx,des->f1);
+ for (i=0; i<p; i++)
+ for (j=0; j<p; j++)
+ { tr[4] += m2[i*p+j]*m2[j*p+i]; /* tr(M^2) */
+ tr[5] += des->f1[i]*V[i*p+j]*des->f1[j]; /* var(thetahat) */
+ }
+ tr[5] = sqrt(tr[5]);
+
+ setzero(m2,p*p);
+ for (i=0; i<des->n; i++)
+ { stdlinks(link,lfd,sp,(int)des->ind[i],des->th[i],robscale);
+ ww = SQR(des->w[i])*des->w[i]*link[ZDDLL];
+ addouter(m2,d_xi(des,i),d_xi(des,i),p,ww);
+ }
+ for (i=0; i<p; i++)
+ { jacob_solve(&des->xtwx,&m2[i*p]);
+ tr[3] += m2[i*(p+1)];
+ }
+
+ return;
+}
diff --git a/src/lf_wdiag.c b/src/lf_wdiag.c
new file mode 100755
index 0000000..c0e8ea6
--- /dev/null
+++ b/src/lf_wdiag.c
@@ -0,0 +1,235 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Routines for computing weight diagrams.
+ * wdiag(lf,des,lx,deg,ty,exp)
+ * Must locfit() first, unless ker==WPARM and has par. comp.
+ *
+ */
+
+#include "local.h"
+
+static double *wd;
+extern double robscale;
+void nnresproj(lfd,sp,des,u,m,p)
+lfdata *lfd;
+smpar *sp;
+design *des;
+double *u;
+int m, p;
+{ int i, j;
+ double link[LLEN];
+ setzero(des->f1,p);
+ for (j=0; j<m; j++)
+ { stdlinks(link,lfd,sp,(int)des->ind[j],des->th[j],robscale);
+ for (i=0; i<p; i++) des->f1[i] += link[ZDDLL]*d_xij(des,j,i)*u[j];
+ }
+ jacob_solve(&des->xtwx,des->f1);
+ for (i=0; i<m; i++)
+ u[i] -= innerprod(des->f1,d_xi(des,i),p)*des->w[i];
+}
+
+void wdexpand(l,n,ind,m)
+double *l;
+Sint *ind;
+int n, m;
+{ int i, j, t;
+ double z;
+ for (j=m; j<n; j++) { l[j] = 0.0; ind[j] = -1; }
+ j = m-1;
+ while (j>=0)
+ { if (ind[j]==j) j--;
+ else
+ { i = ind[j];
+ z = l[j]; l[j] = l[i]; l[i] = z;
+ t = ind[j]; ind[j] = ind[i]; ind[i] = t;
+ if (ind[j]==-1) j--;
+ }
+ }
+
+/* for (i=n-1; i>=0; i--)
+ { l[i] = ((j>=0) && (ind[j]==i)) ? l[j--] : 0.0; } */
+}
+
+int wdiagp(lfd,sp,des,lx,pc,dv,deg,ty,exp)
+lfdata *lfd;
+smpar *sp;
+design *des;
+paramcomp *pc;
+deriv *dv;
+double *lx;
+int deg, ty, exp;
+{ int i, j, p, nd;
+ double *l1;
+
+ p = des->p;
+
+ fitfun(lfd,sp,des->xev,pc->xbar,des->f1,dv);
+ if (exp)
+ { jacob_solve(&pc->xtwx,des->f1);
+ for (i=0; i<lfd->n; i++)
+ lx[i] = innerprod(des->f1,d_xi(des,i),p);
+ return(lfd->n);
+ }
+ jacob_hsolve(&pc->xtwx,des->f1);
+ for (i=0; i<p; i++) lx[i] = des->f1[i];
+
+ nd = dv->nd;
+ dv->nd = nd+1;
+ if (deg>=1)
+ for (i=0; i<lfd->d; i++)
+ { dv->deriv[nd] = i;
+ l1 = &lx[(i+1)*p];
+ fitfun(lfd,sp,des->xev,pc->xbar,l1,dv);
+ jacob_hsolve(&pc->xtwx,l1);
+ }
+
+ dv->nd = nd+2;
+ if (deg>=2)
+ for (i=0; i<lfd->d; i++)
+ { dv->deriv[nd] = i;
+ for (j=0; j<lfd->d; j++)
+ { dv->deriv[nd+1] = j;
+ l1 = &lx[(i*lfd->d+j+lfd->d+1)*p];
+ fitfun(lfd,sp,des->xev,pc->xbar,l1,dv);
+ jacob_hsolve(&pc->xtwx,l1);
+ } }
+ dv->nd = nd;
+ return(p);
+}
+
+int wdiag(lfd,sp,des,lx,dv,deg,ty,exp)
+lfdata *lfd;
+smpar *sp;
+design *des;
+deriv *dv;
+double *lx;
+int deg, ty, exp;
+/* deg=0: l(x) only.
+ deg=1: l(x), l'(x)
+ deg=2: l(x), l'(x), l''(x)
+ ty = 1: e1 (X^T WVX)^{-1} X^T W -- hat matrix
+ ty = 2: e1 (X^T WVX)^{-1} X^T WV^{1/2} -- scb's
+*/
+{ double w, *X, *lxd=NULL, *lxdd=NULL, wdd, wdw, *ulx, link[LLEN], h;
+ double dfx[MXDIM], hs[MXDIM];
+ int i, ii, j, k, l, m, d, p, nd;
+
+ h = des->h;
+ nd = dv->nd;
+ wd = des->wd;
+ d = lfd->d; p = des->p; X = d_x(des);
+ ulx = des->res;
+ m = des->n;
+ for (i=0; i<d; i++) hs[i] = h*lfd->sca[i];
+ if (deg>0)
+ { lxd = &lx[m];
+ setzero(lxd,m*d);
+ if (deg>1)
+ { lxdd = &lxd[d*m];
+ setzero(lxdd,m*d*d);
+ } }
+
+ if (nd>0) fitfun(lfd,sp,des->xev,des->xev,des->f1,dv); /* c(0) */
+ else unitvec(des->f1,0,p);
+ jacob_solve(&des->xtwx,des->f1); /* c(0) (X^TWX)^{-1} */
+ for (i=0; i<m; i++)
+ { ii = des->ind[i];
+ lx[i] = innerprod(des->f1,&X[i*p],p); /* c(0)(XTWX)^{-1}X^T */
+ if (deg>0)
+ { wd[i] = Wd(des->di[ii]/h,ker(sp));
+ for (j=0; j<d; j++)
+ { dfx[j] = datum(lfd,j,ii)-des->xev[j];
+ lxd[j*m+i] = lx[i]*des->w[i]*weightd(dfx[j],lfd->sca[j],
+ d,ker(sp),kt(sp),h,lfd->sty[j],des->di[ii]);
+ /* c(0) (XTWX)^{-1}XTW' */
+ }
+ if (deg>1)
+ { wdd = Wdd(des->di[ii]/h,ker(sp));
+ for (j=0; j<d; j++)
+ for (k=0; k<d; k++)
+ { w = (des->di[ii]==0) ? 0 : h/des->di[ii];
+ w = wdd * (des->xev[k]-datum(lfd,k,ii)) * (des->xev[j]-datum(lfd,j,ii))
+ * w*w / (hs[k]*hs[k]*hs[j]*hs[j]);
+ if (j==k) w += wd[i]/(hs[j]*hs[j]);
+ lxdd[(j*d+k)*m+i] = lx[i]*w;
+ /* c(0)(XTWX)^{-1}XTW'' */
+ }
+ }
+ }
+ lx[i] *= des->w[i];
+ }
+
+ dv->nd = nd+1;
+ if (deg==2)
+ { for (i=0; i<d; i++)
+ { dv->deriv[nd] = i;
+ fitfun(lfd,sp,des->xev,des->xev,des->f1,dv);
+ for (k=0; k<m; k++)
+ { stdlinks(link,lfd,sp,(int)des->ind[k],des->th[k],robscale);
+ for (j=0; j<p; j++)
+ des->f1[j] -= link[ZDDLL]*lxd[i*m+k]*X[k*p+j];
+ /* c'(x)-c(x)(XTWX)^{-1}XTW'X */
+ }
+ jacob_solve(&des->xtwx,des->f1); /* (...)(XTWX)^{-1} */
+ for (j=0; j<m; j++)
+ ulx[j] = innerprod(des->f1,&X[j*p],p); /* (...)XT */
+ for (j=0; j<d; j++)
+ for (k=0; k<m; k++)
+ { ii = des->ind[k];
+ dfx[j] = datum(lfd,j,ii)-des->xev[j];
+ wdw = des->w[k]*weightd(dfx[j],lfd->sca[j],d,ker(sp),
+ kt(sp),h,lfd->sty[j],des->di[ii]);
+ lxdd[(i*d+j)*m+k] += ulx[k]*wdw;
+ lxdd[(j*d+i)*m+k] += ulx[k]*wdw;
+ }
+ /* + 2(c'-c(XTWX)^{-1}XTW'X)(XTWX)^{-1}XTW' */
+ }
+ for (j=0; j<d*d; j++) nnresproj(lfd,sp,des,&lxdd[j*m],m,p);
+ /* * (I-X(XTWX)^{-1} XTW */
+ }
+ if (deg>0)
+ { for (j=0; j<d; j++) nnresproj(lfd,sp,des,&lxd[j*m],m,p);
+ /* c(0)(XTWX)^{-1}XTW'(I-X(XTWX)^{-1}XTW) */
+ for (i=0; i<d; i++)
+ { dv->deriv[nd]=i;
+ fitfun(lfd,sp,des->xev,des->xev,des->f1,dv);
+ jacob_solve(&des->xtwx,des->f1);
+ for (k=0; k<m; k++)
+ for (l=0; l<p; l++)
+ lxd[i*m+k] += des->f1[l]*X[k*p+l]*des->w[k];
+ /* add c'(0)(XTWX)^{-1}XTW */
+ }
+ }
+
+ dv->nd = nd+2;
+ if (deg==2)
+ { for (i=0; i<d; i++)
+ { dv->deriv[nd]=i;
+ for (j=0; j<d; j++)
+ { dv->deriv[nd+1]=j;
+ fitfun(lfd,sp,des->xev,des->xev,des->f1,dv);
+ jacob_solve(&des->xtwx,des->f1);
+ for (k=0; k<m; k++)
+ for (l=0; l<p; l++)
+ lxdd[(i*d+j)*m+k] += des->f1[l]*X[k*p+l]*des->w[k];
+ /* + c''(x)(XTWX)^{-1}XTW */
+ }
+ }
+ }
+ dv->nd = nd;
+
+ k = 1+d*(deg>0)+d*d*(deg==2);
+
+ if (exp) wdexpand(lx,lfd->n,des->ind,m);
+
+ if (ty==1) return(m);
+ for (i=0; i<m; i++)
+ { stdlinks(link,lfd,sp,(int)des->ind[i],des->th[i],robscale);
+ link[ZDDLL] = sqrt(fabs(link[ZDDLL]));
+ for (j=0; j<k; j++) lx[j*m+i] *= link[ZDDLL];
+ }
+ return(m);
+}
diff --git a/src/lfcons.h b/src/lfcons.h
new file mode 100755
index 0000000..77ff19a
--- /dev/null
+++ b/src/lfcons.h
@@ -0,0 +1,305 @@
+/*
+ * Copyright (c) 1998-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ * Numeric values for constants used in locfit
+ */
+
+/*
+ MXDIM and MXDEG are maximum dimension and local polynomial
+ degree for Locfit. Note that some parts of the code may be
+ more restrictive.
+*/
+#define MXDIM 15
+#define MXDEG 7
+
+/*
+ floating point constants
+*/
+#ifndef PI
+#define PI 3.141592653589793238462643
+#endif
+#define S2PI 2.506628274631000502415765
+#define SQRT2 1.4142135623730950488
+#define LOGPI 1.144729885849400174143427
+#define GOLDEN 0.61803398874989484820
+#define HL2PI 0.91893853320467267 /* log(2pi)/2 */
+#define SQRPI 1.77245385090552 /* sqrt(pi) */
+
+/*
+ Criteria for adaptive local fitting mi[MACRI]
+ 1: localized CP; 2: ICI (katkovnik); 3: curvature model index
+ 4: Increase bandwidth until locfit returns LF_OK
+*/
+#define ANONE 0
+#define ACP 1
+#define AKAT 2
+#define AMDI 3
+#define AOK 4
+
+/*
+ vector of double precision parameters.
+ 0, 1, 2 are the three components of the smoothing parameter.
+ 3 cut parameter for adaptive evaluation structures.
+ 4-8 are likelihood, degrees of freedom and residual variance,
+ computed as part of the fit.
+ Stored as the lf.dp vector.
+*/
+#define DALP 0
+#define DFXH 1
+#define DADP 2
+#define DCUT 3
+#define DLK 4
+#define DT0 5
+#define DT1 6
+#define DRV 7
+#define DSWT 8
+#define DRSC 9
+#define LEND 10
+
+/*
+ Evaluation structures mi[MEV]
+ EFITP special for `interpolation' at fit points
+*/
+#define ENULL 0
+#define ETREE 1
+#define EPHULL 2
+#define EDATA 3
+#define EGRID 4
+#define EKDTR 5
+#define EKDCE 6
+#define ECROS 7
+#define EPRES 8
+#define EXBAR 9
+#define ENONE 10
+#define ESPHR 11
+#define EFITP 50
+#define ESPEC 100
+
+/*
+ integer parameters: sample size; dimension; number of local parameters etc.
+ stored as the lf.mi vector.
+*/
+#define MN 0
+#define MP 1
+#define MDEG0 2
+#define MDEG 3
+#define MDIM 4
+#define MACRI 5
+#define MKER 6
+#define MKT 7
+#define MIT 8
+#define MMINT 9
+#define MMXIT 10
+#define MREN 11
+#define MEV 12
+#define MTG 13
+#define MLINK 14
+#define MDC 15
+#define MK 16
+#define MDEB 17
+#define MGETH 18
+#define MPC 19
+#define MUBAS 20
+#define LENM 21
+
+/*
+ Link functions mi[MLINK].
+ Mostly as in table 4.1 of the book.
+ LDEFAU and LCANON are used to select default and canonical
+ links respectively. LINIT shouldn't be selected by user...
+*/
+#define LINIT 0
+#define LDEFAU 1
+#define LCANON 2
+#define LIDENT 3
+#define LLOG 4
+#define LLOGIT 5
+#define LINVER 6
+#define LSQRT 7
+#define LASIN 8
+
+/*
+ components of vector returned by the links() function
+ in family.c. ZLIK the likelihood; ZMEAN = estimated mean;
+ ZDLL = derivative of log-likelihood; ZDDLL = - second derivative
+*/
+#define LLEN 4
+#define ZLIK 0
+#define ZMEAN 1
+#define ZDLL 2
+#define ZDDLL 3
+
+/*
+ weight functions mi[MKER].
+ see Table 3.1 or the function W() in weights.c for definitions.
+*/
+#define WRECT 1
+#define WEPAN 2
+#define WBISQ 3
+#define WTCUB 4
+#define WTRWT 5
+#define WGAUS 6
+#define WTRIA 7
+#define WQUQU 8
+#define W6CUB 9
+#define WMINM 10
+#define WEXPL 11
+#define WMACL 12
+#define WPARM 13
+
+/*
+ type of multivariate weight function mi[MKT]
+ KSPH (spherical) KPROD (product)
+ others shouldn't be used at present.
+*/
+#define KSPH 1
+#define KPROD 2
+#define KCE 3
+#define KLM 4
+#define KZEON 5
+
+#define STANGL 4
+#define STLEFT 5
+#define STRIGH 6
+#define STCPAR 7
+
+/*
+ Local likelihood family mi[MTG]
+ for quasi-likelihood, add 64.
+*/
+#define TNUL 0
+#define TDEN 1
+#define TRAT 2
+#define THAZ 3
+#define TGAUS 4
+#define TLOGT 5
+#define TPOIS 6
+#define TGAMM 7
+#define TGEOM 8
+#define TCIRC 9
+#define TROBT 10
+#define TRBIN 11
+#define TWEIB 12
+#define TCAUC 13
+#define TPROB 14
+
+/*
+ Integration type mi[MIT] for integration in
+ density estimation.
+*/
+#define INVLD 0
+#define IDEFA 1
+#define IMULT 2
+#define IPROD 3
+#define IMLIN 4
+#define IHAZD 5
+#define ISPHR 6
+#define IMONT 7
+
+/*
+ For prediction functions, what to predict?
+ PCOEF -- coefficients PT0 -- influence function
+ PNLX -- ||l(x)|| PBAND -- bandwidth h(x)
+ PDEGR -- local poly. degree PLIK -- max. local likelihood
+ PRDF -- local res. d.f. PVARI -- ||l(x)||^2
+*/
+#define PCOEF 1
+#define PT0 2
+#define PNLX 3
+#define PBAND 4
+#define PDEGR 5
+#define PLIK 6
+#define PRDF 7
+#define PVARI 8
+
+/*
+ Residual Types
+*/
+#define RDEV 1
+#define RPEAR 2
+#define RRAW 3
+#define RLDOT 4
+#define RDEV2 5
+#define RLDDT 6
+#define RFIT 7
+#define RMEAN 8
+
+/*
+ components of the colour vector
+*/
+#define CBAK 0
+#define CAXI 1
+#define CTEX 2
+#define CLIN 3
+#define CPOI 4
+#define CCON 5
+#define CCLA 6
+#define CSEG 7
+#define CPA1 8
+#define CPA2 9
+
+/*
+ variable types: double, int, char, argument list
+*/
+#define VDOUBLE 0
+#define VINT 1
+#define VCHAR 2
+#define VARGL 3
+#define VPREP 4
+#define VARC 5
+#define VVARI 6
+#define VXYZ 7
+
+/*
+ variable status
+*/
+#define STEMPTY 0
+#define STREGULAR 1
+#define STHIDDEN 3
+#define STPLOTVAR 4
+#define STSYSTEM 5
+#define STSYSPEC 6
+#define STREADFI 7
+
+/*
+ return status for the locfit() function
+*/
+#define LF_OK 0
+#define LF_OOB 2 /* out of bounds, or large unstable parameter */
+#define LF_PF 3 /* perfect fit; interpolation; deviance=0 */
+#define LF_NCON 4 /* not converged */
+#define LF_NOPT 6 /* no or insufficient points with non-zero wt */
+#define LF_INFA 7 /* initial failure e.g. log(0) */
+#define LF_DEMP 10 /* density -- empty integration region */
+#define LF_XOOR 11 /* density -- fit point outside xlim region */
+#define LF_DNOP 12 /* density version of 6 */
+#define LF_FPROB 80
+#define LF_BADP 81 /* bad parameters e.g. neg prob for binomial */
+#define LF_LNK 82 /* invalid link */
+#define LF_FAM 83 /* invalid family */
+#define LF_ERR 99 /* error */
+
+/*
+ * mi[MGETH] codes
+ * scb(), pointwise codes are 71,...,75.
+ * add 10 for simultaneous codes.
+ */
+#define GSTD 0
+#define GHAT 1
+#define GKAP 2
+#define GRBD 3
+#define GAMF 4
+#define GAMP 5
+#define GLSC 6
+#define GSMP 7
+#define GLM1 71
+#define GLM2 72
+#define GLM3 73
+#define GLM4 74
+#define GLDN 75
+
+/* bandwidth criteria */
+#define BGCV 1
+#define BCP 2
+#define BIND 3
diff --git a/src/lffuns.h b/src/lffuns.h
new file mode 100755
index 0000000..db35461
--- /dev/null
+++ b/src/lffuns.h
@@ -0,0 +1,150 @@
+/*
+ * Copyright (c) 1998-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Function definitions for Locfit.
+ */
+
+/* FILES IN THE src DIRECTORY */
+
+/* adap.c */
+extern int alocfit();
+
+/* band.c */
+extern void band(), kdeselect(), kdecri();
+
+/* density.c */
+extern int densinit(), likeden();
+extern int fact[];
+extern void prodintresp(), prresp();
+extern int de_mint, de_itype, de_renorm;
+
+/* dens_haz.c */
+extern void haz_init();
+extern int hazint();
+
+/* dens_int.c */
+extern double dens_integrate();
+extern void dens_renorm(), dens_lscv(), lforder();
+
+/* ev_atree.c */
+extern void atree_start(), atree_grow(), atree_guessnv();
+extern double atree_int();
+
+/* ev_interp.c */
+extern double dointpoint(), cubintd();
+extern double linear_interp(), cubic_interp(), rectcell_interp();
+extern int exvval();
+extern void exvvalpv(), hermite2();
+
+/* ev_kdtre.c */
+extern void kdtre_start(), kdtre_guessnv();
+extern double kdtre_int();
+
+/* ev_sphere.c */
+extern void sphere_start(), sphere_guessnv();
+extern double sphere_int();
+
+/* ev_main.c */
+extern void trchck(), guessnv(), lfit_alloc();
+extern void dataf(), gridf(), crossf(), xbarf(), preset();
+extern int findpt(), newsplit(), lfit_reqd(), lfit_reqi();
+
+/* ev_trian.c */
+extern void triang_start(), triang_grow(), triang_guessnv();
+extern double triang_int();
+
+/* family.c */
+extern int links(), stdlinks(), defaultlink(), validlinks();
+extern double b2(), b3(), b4(), lf_link(), invlink();
+
+/* fitted.c */
+extern void fitted();
+
+/* frend.c */
+extern void ressumm();
+extern double rss();
+
+/* lf_dercor.c */
+extern void dercor();
+
+/* lf_fitfun.c */
+extern void fitfun(), makecfn(), designmatrix();
+extern int calcp(), coefnumber();
+
+/* lf_nbhd.c */
+extern double kordstat(), rho();
+extern void nbhd();
+
+/* lf_robust.c */
+extern double median();
+extern void lf_robust();
+
+/* lfstr.c */
+extern int lffamily(), lfkernel(), lfketype(), lflink();
+extern int deitye(), lfevstr(), lfacri();
+extern int ppwhat(), restyp();
+
+/* lf_vari.c */
+extern void lf_vcov(), comp_vari(), local_df();
+
+/* locfit.c */
+extern int locfit(), des_reqd(), des_reqi();
+extern void lfdata_init(), smpar_init(), deriv_init(), des_init(), lfiter();
+extern int lf_maxit, lf_debug;
+
+/* math.c */
+extern double lflgamma(), lferf(), lferfc(), lfdaws(), lf_exp();
+extern double ptail(), logit(), expit();
+extern double lgamma(), erf(), erfc();
+extern int factorial();
+
+/* minmax.c */
+extern double ipower(), minmax();
+
+/* odint.c */
+extern int onedint();
+extern void recurint();
+
+/* pcomp.c */
+extern double addparcomp();
+extern void compparcomp(), subparcomp(), subparcomp2(), pcchk();
+extern int pc_reqd(), noparcomp();
+
+/* preplot.c */
+extern void preplot(), cpreplot();
+extern int setpppoints();
+
+/* procv.c */
+extern int procvhatm(), procv(), procvraw(), procvvord(), calcp();
+
+/* resid.c */
+extern double resid();
+
+/* scb.c */
+extern void scb(), cscbsim();
+
+/* scb_iface.c */
+extern int constants();
+
+/* simul.c */
+extern void liksim(), scbsim(), scbmax(), regband(), rband();
+
+/* startlf.c */
+extern void set_flim(), set_scales(), startlf(), lfit_init();
+extern void fitoptions(), clocfit(), endfit();
+extern int nofit();
+
+/* strings.c */
+extern int stm(), pmatch(), matchlf(), matchrt(), checkltor(), checkrtol();
+extern void strip();
+
+/* wdiag.c */
+extern int wdiag(), wdiagp();
+
+/* weight.c */
+extern double W(), weight(), weightd(), Wd(), Wdd(), wint();
+extern double Wconv(), Wconv1(), Wconv4(), Wconv5(), Wconv6(), Wikk();
+extern int iscompact(), wtaylor();
diff --git a/src/lfstr.c b/src/lfstr.c
new file mode 100755
index 0000000..9d008ba
--- /dev/null
+++ b/src/lfstr.c
@@ -0,0 +1,150 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Functions for converting string arguments to Locfit's numeric values.
+ * Typically, these will be assigned to appopriate place on one of locfit's structures:
+ * fam(sp) = lffamily(z)
+ * ker(sp) = lfkernel(z)
+ * kt(sp) = lfketype(z)
+ * link(sp)= lflink(z)
+ * de_itype= deitype(z)
+ * ev(evs) = lfevstr(z)
+ * acri(sp)= lfacri(z)
+ * sp is a pointer to the smpar structure, &lf->sp.
+ * evs is a pointer to the evaluation structure, &lf->evs.
+ * int ppwhat(str) interprets the preplot what argument.
+ * int restyp(str) interprets the residual type argument.
+ *
+ * return values of -1 indicate failure/unknown string.
+ */
+
+#include "local.h"
+
+int ct_match(z1, z2)
+char *z1, *z2;
+{ int ct = 0;
+ while (z1[ct]==z2[ct])
+ { if (z1[ct]=='\0') return(ct+1);
+ ct++;
+ }
+ return(ct);
+}
+
+int pmatch(z, strings, vals, n, def)
+char *z, **strings;
+int *vals, n, def;
+{ int i, ct, best, best_ct;
+ best = -1;
+ best_ct = 0;
+
+ for (i=0; i<n; i++)
+ { ct = ct_match(z,strings[i]);
+ if (ct==strlen(z)+1) return(vals[i]);
+ if (ct>best_ct) { best = i; best_ct = ct; }
+ }
+ if (best==-1) return(def);
+ return(vals[best]);
+}
+
+static char *famil[17] =
+ { "density", "ate", "hazard", "gaussian", "binomial",
+ "poisson", "gamma", "geometric", "circular", "obust", "huber",
+ "weibull", "cauchy","probab", "logistic", "nbinomial", "vonmises" };
+static int fvals[17] =
+ { TDEN, TRAT, THAZ, TGAUS, TLOGT,
+ TPOIS, TGAMM, TGEOM, TCIRC, TROBT, TROBT,
+ TWEIB, TCAUC, TPROB, TLOGT, TGEOM, TCIRC };
+int lffamily(z)
+char *z;
+{ int quasi, robu, f;
+ quasi = robu = 0;
+ while ((z[0]=='q') | (z[0]=='r'))
+ { quasi |= (z[0]=='q');
+ robu |= (z[0]=='r');
+ z++;
+ }
+ f = pmatch(z,famil,fvals,16,-1);
+ if ((z[0]=='o') | (z[0]=='a')) robu = 0;
+ if (f==-1)
+ { WARN(("unknown family %s",z));
+ f = TGAUS;
+ }
+ if (quasi) f += 64;
+ if (robu) f += 128;
+ return(f);
+}
+
+static char *wfuns[13] = {
+ "rectangular", "epanechnikov", "bisquare", "tricube",
+ "triweight", "gaussian", "triangular", "ququ",
+ "6cub", "minimax", "exponential", "maclean", "parametric" };
+static int wvals[13] = { WRECT, WEPAN, WBISQ, WTCUB,
+ WTRWT, WGAUS, WTRIA, WQUQU, W6CUB, WMINM, WEXPL, WMACL, WPARM };
+int lfkernel(char *z)
+{ return(pmatch(z, wfuns, wvals, 13, WTCUB));
+}
+
+static char *ktype[5] = { "spherical", "product", "center", "lm", "zeon" };
+static int kvals[5] = { KSPH, KPROD, KCE, KLM, KZEON };
+int lfketype(char *z)
+{ return(pmatch(z, ktype, kvals, 5, KSPH));
+}
+
+static char *ltype[8] = { "default", "canonical", "identity", "log",
+ "logi", "inverse", "sqrt", "arcsin" };
+static int lvals[8] = { LDEFAU, LCANON, LIDENT, LLOG,
+ LLOGIT, LINVER, LSQRT, LASIN };
+int lflink(char *z)
+{ return(pmatch(z, ltype, lvals, 8, LDEFAU));
+}
+
+static char *etype[11]= { "tree", "phull", "data", "grid", "kdtree",
+ "kdcenter", "cross", "preset", "xbar", "none",
+ "sphere" };
+static int evals[11]= { ETREE, EPHULL, EDATA, EGRID, EKDTR,
+ EKDCE, ECROS, EPRES, EXBAR, ENONE, ESPHR };
+int lfevstr(char *z)
+{ return(pmatch(z, etype, evals, 11, ETREE));
+}
+
+static char *itype[7] = { "default", "multi", "product", "mlinear",
+ "hazard", "sphere", "monte" };
+static int ivals[7] = { IDEFA, IMULT, IPROD, IMLIN, IHAZD, ISPHR, IMONT };
+int deitype(char *z)
+{ return(pmatch(z, itype, ivals, 6, IDEFA));
+}
+
+static char *atype[5] = { "none", "cp", "ici", "mindex", "ok" };
+static int avals[5] = { ANONE, ACP, AKAT, AMDI, AOK };
+int lfacri(char *z)
+{ return(pmatch(z, atype, avals, 5, ANONE));
+}
+
+static char *rtype[8] = { "deviance", "d2", "pearson", "raw",
+ "ldot", "lddot", "fit", "mean" };
+static int rvals[8] = { RDEV, RDEV2, RPEAR, RRAW, RLDOT, RLDDT, RFIT, RMEAN};
+
+static char *whtyp[8] = { "coef", "nlx", "infl", "band",
+ "degr", "like", "rdf", "vari" };
+static int whval[8] = { PCOEF, PNLX, PT0, PBAND, PDEGR, PLIK, PRDF, PVARI };
+
+int restyp(z)
+char *z;
+{ int val;
+
+ val = pmatch(z, rtype, rvals, 8, -1);
+ if (val==-1) ERROR(("Unknown type = %s",z));
+ return(val);
+}
+
+int ppwhat(z)
+char *z;
+{ int val;
+
+ val = pmatch(z, whtyp, whval, 8, -1);
+ if (val==-1) ERROR(("Unknown what = %s",z));
+ return(val);
+}
diff --git a/src/lfstruc.h b/src/lfstruc.h
new file mode 100755
index 0000000..074b3e1
--- /dev/null
+++ b/src/lfstruc.h
@@ -0,0 +1,107 @@
+/*
+ * Copyright (c) 1998-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ * Structures, typedefs etc used in Locfit
+ */
+
+typedef struct {
+ double *wk, *coef, *xbar, *f;
+ jacobian xtwx;
+ int lwk, haspc;
+} paramcomp;
+#define haspc(pc) ((pc)->haspc)
+
+typedef struct {
+ double *x[MXDIM];
+ double *y;
+ double *w;
+ double *b;
+ double *c;
+ double sca[MXDIM];
+ double xl[2*MXDIM];
+ int n, d, ord;
+ int sty[MXDIM];
+ varname yname, xname[MXDIM], wname, bname, cname;
+} lfdata;
+#define resp(lfd,i) (((lfd)->y==NULL) ? 0.0 : (lfd)->y[i])
+#define base(lfd,i) (((lfd)->b==NULL) ? 0.0 : (lfd)->b[i])
+#define prwt(lfd,i) (((lfd)->w==NULL) ? 1.0 : (lfd)->w[i])
+#define cens(lfd,i) (((lfd)->c==NULL) ? 0 : (int)(lfd)->c[i])
+#define datum(lfd,i,j) ((lfd)->x[i][j])
+#define dvari(lfd,i) ((lfd)->x[i])
+
+typedef struct {
+ double nn, fixh, adpen;
+ int ker, kt;
+ int deg, deg0, p;
+ int acri;
+ int fam, lin;
+ int ubas;
+ double (*vb)();
+ void (*vbasis)();
+} smpar;
+#define nn(sp) ((sp)->nn)
+#define fixh(sp) ((sp)->fixh)
+#define pen(sp) ((sp)->adpen)
+#define ker(sp) ((sp)->ker)
+#define kt(sp) ((sp)->kt)
+#define deg(sp) ((sp)->deg)
+#define deg0(sp) ((sp)->deg0)
+#define npar(sp) ((sp)->p)
+#define acri(sp) ((sp)->acri)
+#define ubas(sp) ((sp)->ubas)
+#define fam(sp) ((sp)->fam)
+#define link(sp) ((sp)->lin)
+
+typedef struct {
+ int deriv[MXDEG+2];
+ int nd;
+} deriv;
+
+typedef struct {
+ int ev;
+ double *sv;
+ double cut;
+ double fl[2*MXDIM];
+ Sint *iwk, *ce, *s, *lo, *hi;
+ int liw, nce, ncm, maxk;
+ int mg[MXDIM];
+ void (*espec)();
+} evstruc;
+#define ev(evs) ((evs)->ev)
+#define cut(evs) ((evs)->cut)
+#define mk(evs) ((evs)->maxk)
+#define mg(evs) ((evs)->mg)
+
+typedef struct {
+ double *xev, *coef, *nlx, *t0, *lik, *h, *deg, *L;
+ int lev, lwk, ll;
+ int d, dcor, geth, hasd;
+ int nv, nvm;
+ double df0, df1, llk, rv, rsc;
+ double kap[10];
+} fitpt;
+#define evp(fp) ((fp)->xev)
+#define evpt(fp,i) (&(fp)->xev[(i)*(fp)->d])
+#define evptx(fp,i,k) ((fp)->xev[(i)*(fp)->d+(k)])
+#define df0(fp) ((fp)->df0)
+#define df1(fp) ((fp)->df1)
+#define llk(fp) ((fp)->llk)
+#define dc(fp) ((fp)->dcor)
+#define geth(fp) ((fp)->geth)
+#define rv(fp) ((fp)->rv)
+#define rsc(fp) ((fp)->rsc)
+
+typedef struct {
+ int lf_init_id;
+ lfdata lfd;
+ smpar sp;
+ evstruc evs;
+ fitpt fp;
+ deriv dv;
+ paramcomp pc;
+ } lfit;
+#define LF_INIT_ID 34897239
diff --git a/src/lfwin.h b/src/lfwin.h
new file mode 100755
index 0000000..7a96c13
--- /dev/null
+++ b/src/lfwin.h
@@ -0,0 +1,117 @@
+#define LFM_EXIT 0
+#define LFM_COPY 1
+#define LFM_PASTE 2
+#define LFM_RUN 3
+
+#define LFM_READA 10
+#define LFM_SAVED 11
+#define LFM_READD 12
+#define LFM_SUMD 13
+#define LFM_PLOTD 18
+
+#define LFM_LOCF 20
+#define LFM_READF 22
+#define LFM_SUMF 23
+#define LFM_PRFIT 24
+
+#define LFM_ALPH 70
+#define LFM_FIXH 71
+#define LFM_APEN 72
+#define LFM_DEG0 75
+#define LFM_DEG1 76
+#define LFM_DEG2 77
+#define LFM_DEG3 78
+
+#define LFM_ABOUT 81
+#define LFM_INDEX 82
+#define LFM_READM 83
+#define LFM_WWW 84
+
+#define LFP_ROT 10
+#define LFP_STY 11
+#define LFP_PS 42
+#define LFP_COL 13
+
+#define LFP_XLAB 20
+#define LFP_YLAB 21
+#define LFP_ZLAB 22
+#define LFP_MAIN 23
+
+#define AB_WWW 10
+
+#define CM_LINE 1
+#define CM_OK 99
+
+#define RL_ALP 0
+#define RL_ALPV 1
+#define RL_H 2
+#define RL_HV 3
+#define RL_PEN 4
+#define RL_PENV 5
+#define RL_DEG 10
+#define RL_FORM 20
+#define RL_FAMY 21
+#define RL_QUAS 22
+#define RL_ROBU 23
+#define RL_FIT 98
+#define RL_OK 99
+
+#define RP_VS 1
+#define RP_HS 2
+#define RP_AUT 3
+#define RP_DRAW 98
+#define RP_OK 99
+
+#define PD_X 1
+#define PD_Y 2
+#define PD_Z 3
+#define PD_DRAW 10
+#define PD_ADD 11
+#define PD_WIN 12
+
+#define PS_FIL 1
+#define PS_DR 8
+#define PS_CA 9
+#define PS_H 10
+#define PS_W 11
+
+#define SC_COL 1
+#define SC_SCO 2
+#define SC_DR 8
+#define SC_OK 9
+
+#define VN_VN 1
+#define VN_SA 2
+#define VN_RF 98
+#define VN_CA 99
+
+#define BP_ALP 1
+#define BP_ALV 2
+#define BP_AUT 3
+#define BP_FIT 4
+#define BP_EX 99
+
+#define GR_CM 10
+#define GR_ST 11
+
+#define LB_LAB 10
+#define LB_DRAW 11
+
+#define LD_QUIT 99
+
+/* about.c */
+extern void AboutDlg();
+
+/* devwin.c */
+extern void getwinsize(), GetFontInfo();
+
+/* dlgraph.c */
+extern void GStyleDlg(), LabelDlg(), PostDlg(), RotateDlg(), SetColDlg();
+
+/* winfile.c */
+extern void ReadFileDlg(), ReadDataDlg(), SaveDataDlg(), RunDlg();
+extern void ReadFitDlg();
+
+/* windlg.c */
+extern void BandDlg(), LocfitDlg(), PlotDataDlg(), wdispatch();
+extern int LFDefDlgProc();
diff --git a/src/local.h b/src/local.h
new file mode 100755
index 0000000..66015fb
--- /dev/null
+++ b/src/local.h
@@ -0,0 +1,145 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Most of the changes formerly needed here are handled through
+ * the Makefiles and #ifdef's.
+ */
+
+#ifndef I_LF_H
+#define I_LF_H
+#include <R.h>
+
+/*
+ * DIRSEP: '/' for unix; '\\' for DOS
+ */
+#ifdef DOS
+#define DIRSEP '\\'
+#else
+#define DIRSEP '/'
+#endif
+
+/*
+ Some older math libraries have no lgamma() function, and gamma(arg)
+ actually returns log(gamma(arg)). If so, you need to change
+ LGAMMA macro below.
+
+ If all else fails, you can also use lflgamma().
+
+ Use the definitions for erf, erfc and daws only if your
+ math libraries don't include these functions.
+ */
+#ifdef DOS
+#define LGAMMA(arg) lflgamma(arg)
+#define erf(x) lferf(x)
+#define erfc(x) lferfc(x)
+#else
+#define LGAMMA(arg) lgamma(arg)
+#endif
+#define daws(x) lfdaws(x)
+
+/******** NOTHING BELOW HERE NEEDS CHANGING **********/
+
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include <math.h>
+
+#define RVERSION
+
+#ifdef SWINVERSION
+#define SVERSION
+#include "newredef.h"
+#endif
+
+#ifdef RVERSION
+
+/* #typedef int Sint is defined in R.h */
+#include <R.h>
+#include <Rdefines.h>
+#include <Rinternals.h>
+#define list_elt(ev,i) VECTOR_PTR(ev)[i]
+#define dval2(ev,i,j) NUMERIC_POINTER(list_elt(ev,i))[j]
+#define dvec2(ev,i) NUMERIC_POINTER(list_elt(ev,i))
+#define ivec2(ev,i) INTEGER_POINTER(list_elt(ev,i))
+#undef pmatch
+#define printf Rprintf
+#define printe REprintf
+
+#else
+
+#ifdef SVERSION
+#include <S.h>
+typedef long int Sint;
+typedef s_object * SEXP;
+#define list_elt(ev,i) LIST_POINTER(ev)[i]
+#define dval2(ev,i,j) NUMERIC_POINTER(list_elt(ev,i))[j]
+#define dvec2(ev,i) NUMERIC_POINTER(list_elt(ev,i))
+#define ivec2(ev,i) INTEGER_POINTER(list_elt(ev,i))
+#else
+typedef int Sint;
+#endif
+
+#endif
+
+#ifdef RVERSION
+#undef LGAMMA
+#define LGAMMA(arg) Rf_lgammafn(arg)
+extern double Rf_lgammafn();
+#define SVERSION
+#endif
+
+#include "mutil.h"
+#include "tube.h"
+
+#include "lfcons.h"
+
+typedef char varname[15];
+
+#ifdef CVERSION
+#include "cversion.h"
+#endif
+
+#include "lfstruc.h"
+#include "design.h"
+#include "lffuns.h"
+
+#ifdef CVERSION
+#undef printf
+#define printf lfprintf
+extern int lfprintf(const char *format, ...);
+extern int printe(const char *format, ...);
+/* #else
+ #define printe printf */
+#endif
+
+#ifdef ERROR
+#undef ERROR
+#endif
+
+#ifdef WARN
+#undef WARN
+#endif
+
+/* #define ERROR(args) {printe("Error: "); printe args; printe("\n"); lf_error=
+1;} */
+#define ERROR(args) {error args; lf_error=1;}
+/* #define WARN(args) {printe("Warning: "); printe args; printe("\n"); } */
+#define WARN(args) warning args;
+
+#define MAX(a,b) (((a)>(b)) ? (a) : (b))
+#define MIN(a,b) (((a)<(b)) ? (a) : (b))
+#define SGN(x) (((x)>0) ? 1 : -1)
+#define SQR(x) ((x)*(x))
+#define NOSLN 0.1278433
+#define GFACT 2.5
+#define EFACT 3.0
+
+#define MAXCOLOR 20
+#define MAXWIN 5
+
+#define ISWAP(a,b) { int zz; zz = a; a = b; b = zz; }
+extern int lf_error;
+
+#endif /* I_LF_H */
diff --git a/src/locfit.c b/src/locfit.c
new file mode 100755
index 0000000..a029781
--- /dev/null
+++ b/src/locfit.c
@@ -0,0 +1,385 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+int lf_maxit = 20;
+int lf_debug = 0;
+
+static double s0, s1, tol;
+static lfdata *lf_lfd;
+static design *lf_des;
+static smpar *lf_sp;
+int lf_status;
+int ident=0;
+int (*like)();
+extern double robscale;
+
+void lfdata_init(lfd)
+lfdata *lfd;
+{ int i;
+ for (i=0; i<MXDIM; i++)
+ { lfd->sty[i] = 0;
+ lfd->sca[i] = 1.0;
+ lfd->xl[i] = lfd->xl[i+MXDIM] = 0.0;
+ }
+ lfd->y = lfd->w = lfd->c = lfd->b = NULL;
+ lfd->d = lfd->n = 0;
+}
+
+void smpar_init(sp,lfd)
+smpar *sp;
+lfdata *lfd;
+{ nn(sp) = 0.7;
+ fixh(sp)= 0.0;
+ pen(sp) = 0.0;
+ acri(sp)= ANONE;
+ deg(sp) = deg0(sp) = 2;
+ ubas(sp) = 0;
+ kt(sp) = KSPH;
+ ker(sp) = WTCUB;
+ fam(sp) = 64+TGAUS;
+ link(sp)= LDEFAU;
+ npar(sp) = calcp(sp,lfd->d);
+}
+
+void deriv_init(dv)
+deriv *dv;
+{ dv->nd = 0;
+}
+
+int des_reqd(n,p)
+int n, p;
+{
+ return(n*(p+5)+2*p*p+4*p + jac_reqd(p));
+}
+int des_reqi(n,p)
+int n, p;
+{ return(n+p);
+}
+
+void des_init(des,n,p)
+design *des;
+int n, p;
+{ double *z;
+ int k;
+
+ if (n<=0) WARN(("des_init: n <= 0"));
+ if (p<=0) WARN(("des_init: p <= 0"));
+
+ if (des->des_init_id != DES_INIT_ID)
+ { des->lwk = des->lind = 0;
+ des->des_init_id = DES_INIT_ID;
+ }
+
+ k = des_reqd(n,p);
+ if (k>des->lwk)
+ { des->wk = (double *)calloc(k,sizeof(double));
+ des->lwk = k;
+ }
+ z = des->wk;
+
+ des->X = z; z += n*p;
+ des->w = z; z += n;
+ des->res=z; z += n;
+ des->di =z; z += n;
+ des->th =z; z += n;
+ des->wd =z; z += n;
+ des->V =z; z += p*p;
+ des->P =z; z += p*p;
+ des->f1 =z; z += p;
+ des->ss =z; z += p;
+ des->oc =z; z += p;
+ des->cf =z; z += p;
+
+ z = jac_alloc(&des->xtwx,p,z);
+
+ k = des_reqi(n,p);
+ if (k>des->lind)
+ {
+ des->ind = (Sint *)calloc(k,sizeof(Sint));
+ des->lind = k;
+ }
+ des->fix = &des->ind[n];
+ for (k=0; k<p; k++) des->fix[k] = 0;
+
+ des->n = n; des->p = p;
+ des->smwt = n;
+ des->xtwx.p = p;
+}
+
+void deschk(des,n,p)
+design *des;
+int n, p;
+{ WARN(("deschk deprecated - use des_init()"));
+ des_init(des,n,p);
+}
+
+int likereg(coef, lk0, f1, Z)
+double *coef, *lk0, *f1, *Z;
+{ int i, ii, j, p;
+ double lk, ww, link[LLEN], *X;
+
+ if (lf_debug>2) printf(" likereg: %8.5f\n",coef[0]);
+ lf_status = LF_OK;
+ lk = 0.0; p = lf_des->p;
+ setzero(Z,p*p);
+ setzero(f1,p);
+ for (i=0; i<lf_des->n; i++)
+ {
+ ii = lf_des->ind[i];
+ X = d_xi(lf_des,i);
+ lf_des->th[i] = base(lf_lfd,ii)+innerprod(coef,X,p);
+ lf_status = stdlinks(link,lf_lfd,lf_sp,ii,lf_des->th[i],robscale);
+ if (lf_status == LF_BADP)
+ { *lk0 = -1.0e300;
+ return(NR_REDUCE);
+ }
+ if (lf_error) lf_status = LF_ERR;
+ if (lf_status != LF_OK) return(NR_BREAK);
+
+ ww = lf_des->w[i];
+ lk += ww*link[ZLIK];
+ for (j=0; j<p; j++)
+ f1[j] += X[j]*ww*link[ZDLL];
+ addouter(Z, X, X, p, ww*link[ZDDLL]);
+ }
+ for (i=0; i<p; i++) if (lf_des->fix[i])
+ { for (j=0; j<p; j++) Z[i*p+j] = Z[j*p+i] = 0.0;
+ Z[i*p+i] = 1.0;
+ f1[i] = 0.0;
+ }
+
+ if (lf_debug>4) prresp(coef,Z,p);
+ if (lf_debug>3) printf(" likelihood: %8.5f\n",lk);
+ *lk0 = lf_des->llk = lk;
+
+ switch (fam(lf_sp)&63) /* parameter checks */
+ { case TGAUS: /* prevent iterations! */
+ if ((link(lf_sp)==LIDENT)&((fam(lf_sp)&128)==0)) return(NR_BREAK);
+ break;
+ case TPOIS:
+ case TGEOM:
+ case TWEIB:
+ case TGAMM:
+ if ((link(lf_sp)==LLOG) && (fabs(coef[0])>700))
+ { lf_status = LF_OOB;
+ return(NR_REDUCE);
+ }
+ if (lk > -1.0e-5*s0)
+ { lf_status = LF_PF;
+ return(NR_REDUCE);
+ }
+ break;
+ case TRBIN:
+ case TLOGT:
+ if (lk > -1.0e-5*s0)
+ { lf_status = LF_PF;
+ return(NR_REDUCE);
+ }
+ if (fabs(coef[0])>700)
+ { lf_status = LF_OOB;
+ return(NR_REDUCE);
+ }
+ break;
+ }
+ return(NR_OK);
+}
+
+int robustinit(lfd,des)
+lfdata *lfd;
+design *des;
+{ int i;
+ for (i=0; i<des->n; i++)
+ des->res[i] = resp(lfd,(int)des->ind[i]) - base(lfd,(int)des->ind[i]);
+ des->cf[0] = median(des->res,des->n);
+ for (i=1; i<des->p; i++) des->cf[i] = 0.0;
+ tol = 1.0e-6;
+ return(LF_OK);
+}
+
+int circinit(lfd,des)
+lfdata *lfd;
+design *des;
+{ int i, ii;
+ double s0, s1;
+ s0 = s1 = 0.0;
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ s0 += des->w[i]*prwt(lfd,ii)*sin(resp(lfd,ii)-base(lfd,ii));
+ s1 += des->w[i]*prwt(lfd,ii)*cos(resp(lfd,ii)-base(lfd,ii));
+ }
+ des->cf[0] = atan2(s0,s1);
+ for (i=1; i<des->p; i++) des->cf[i] = 0.0;
+ tol = 1.0e-6;
+ return(LF_OK);
+}
+
+int reginit(lfd,des)
+lfdata *lfd;
+design *des;
+{ int i, ii;
+ double sb, link[LLEN];
+ s0 = s1 = sb = 0;
+ for (i=0; i<des->n; i++)
+ { ii = des->ind[i];
+ links(base(lfd,ii),resp(lfd,ii),fam(lf_sp),LINIT,link,cens(lfd,ii),prwt(lfd,ii),1.0);
+ s1 += des->w[i]*link[ZDLL];
+ s0 += des->w[i]*prwt(lfd,ii);
+ sb += des->w[i]*prwt(lfd,ii)*base(lfd,ii);
+ }
+ if (s0==0) return(LF_NOPT); /* no observations with W>0 */
+ setzero(des->cf,des->p);
+ tol = 1.0e-6*s0;
+ switch(link(lf_sp))
+ { case LIDENT:
+ des->cf[0] = (s1-sb)/s0;
+ return(LF_OK);
+ case LLOG:
+ if (s1<=0.0)
+ { des->cf[0] = -1000;
+ return(LF_INFA);
+ }
+ des->cf[0] = log(s1/s0) - sb/s0;
+ return(LF_OK);
+ case LLOGIT:
+ if (s1<=0.0)
+ { des->cf[0] = -1000;
+ return(LF_INFA);
+ }
+ if (s1>=s0)
+ { des->cf[0] = 1000;
+ return(LF_INFA);
+ }
+ des->cf[0] = logit(s1/s0)-sb/s0;
+ return(LF_OK);
+ case LINVER:
+ if (s1<=0.0)
+ { des->cf[0] = 1000;
+ return(LF_INFA);
+ }
+ des->cf[0] = s0/s1-sb/s0;
+ return(LF_OK);
+ case LSQRT:
+ des->cf[0] = sqrt(s1/s0)-sb/s0;
+ return(LF_OK);
+ case LASIN:
+ des->cf[0] = asin(sqrt(s1/s0))-sb/s0;
+ return(LF_OK);
+ default:
+ ERROR(("reginit: invalid link %d",link(lf_sp)));
+ return(LF_ERR);
+ }
+}
+
+int lfinit(lfd,sp,des)
+lfdata *lfd;
+smpar *sp;
+design *des;
+{
+ des->xtwx.sm = (deg0(sp)<deg(sp)) ? JAC_CHOL : JAC_EIGD;
+
+ designmatrix(lfd,sp,des);
+
+ like = likereg;
+ link(sp) = defaultlink(link(sp),fam(sp));
+
+ switch(fam(sp)&63)
+ { case TDEN:
+ case TRAT:
+ case THAZ:
+ like = likeden;
+ tol = (link(sp)==LLOG) ? 1.0e-6 : 0.0;
+ return(densinit(lfd,des,sp,des->cf));
+ case TCAUC:
+ case TROBT:
+ return(robustinit(lfd,des));
+ case TCIRC:
+ return(circinit(lfd,des));
+ default:
+ return(reginit(lfd,des));
+ }
+}
+
+void lfiter(des,maxit)
+design *des;
+int maxit;
+{ int err;
+ if (lf_debug>1) printf(" lfiter: %8.5f\n",des->cf[0]);
+ max_nr(like, des->cf, des->oc, des->res, des->f1,
+ &des->xtwx, des->p, maxit, tol, &err);
+ switch(err)
+ { case NR_OK: return;
+ case NR_NCON:
+ WARN(("max_nr not converged"));
+ return;
+ case NR_NDIV:
+ WARN(("max_nr reduction problem"));
+ return;
+ }
+ WARN(("max_nr return status %d",err));
+}
+
+int use_robust_scale(int tg)
+{ if ((tg&64)==0) return(0); /* not quasi - no scale */
+ if (((tg&128)==0) & (((tg&63)!=TROBT) & ((tg&63)!=TCAUC))) return(0);
+ return(1);
+}
+
+int locfit(lfd,des,sp,noit,nb,cv)
+lfdata *lfd;
+design *des;
+smpar *sp;
+int noit, nb, cv;
+{ int i;
+
+ if (des->xev==NULL)
+ { ERROR(("locfit: NULL evaluation point?"));
+ return(246);
+ }
+
+ if (lf_debug>0)
+ { printf("locfit: ");
+ for (i=0; i<lfd->d; i++) printf(" %10.6f",des->xev[i]);
+ printf("\n");
+ }
+
+ lf_des = des;
+ lf_lfd = lfd;
+ lf_sp = sp;
+
+/* the 1e-12 avoids problems that can occur with roundoff */
+ if (nb) nbhd(lfd,des,(int)(lfd->n*nn(sp)+1e-12),0,sp);
+
+ lf_status = lfinit(lfd,sp,des);
+ if (lf_status != LF_OK) return(lf_status);
+
+ if (use_robust_scale(fam(sp)))
+ lf_robust(lfd,sp,des,lf_maxit);
+ else
+ { robscale = 1.0;
+ lfiter(des,lf_maxit);
+ }
+
+ if (lf_status == LF_OOB) setzero(des->cf,des->p);
+
+ if ((fam(sp)&63)==TDEN) /* convert from rate to density */
+ { switch(link(sp))
+ { case LLOG:
+ des->cf[0] -= log(des->smwt);
+ break;
+ case LIDENT:
+ multmatscal(des->cf,1.0/des->smwt,des->p);
+ break;
+ default: ERROR(("Density adjustment; invalid link"));
+ }
+ }
+
+ /* variance calculations, if requested */
+ if (cv)
+ lf_vcov(lfd,sp,des);
+
+ return(lf_status);
+}
diff --git a/src/m_chol.c b/src/m_chol.c
new file mode 100755
index 0000000..25f0093
--- /dev/null
+++ b/src/m_chol.c
@@ -0,0 +1,76 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include <math.h>
+#include "mutil.h"
+
+/* A is a n*p matrix, find the cholesky decomposition
+ * of the first p rows. In most applications, will want n=p.
+ */
+void chol_dec(A,n,p)
+double *A;
+int n, p;
+{ int i, j, k;
+
+ for (j=0; j<p; j++)
+ { k = n*j+j;
+ for (i=0; i<j; i++) A[k] -= A[n*j+i]*A[n*j+i];
+ if (A[k]<=0)
+ { for (i=j; i<p; i++) A[n*i+j] = 0.0; }
+ else
+ { A[k] = sqrt(A[k]);
+ for (i=j+1; i<p; i++)
+ { for (k=0; k<j; k++)
+ A[n*i+j] -= A[n*i+k]*A[n*j+k];
+ A[n*i+j] /= A[n*j+j];
+ }
+ }
+ }
+ for (j=0; j<p; j++)
+ for (i=j+1; i<p; i++) A[n*j+i] = 0.0;
+}
+
+int chol_solve(A,v,n,p)
+double *A, *v;
+int n, p;
+{ int i, j;
+
+ for (i=0; i<p; i++)
+ { for (j=0; j<i; j++) v[i] -= A[i*n+j]*v[j];
+ v[i] /= A[i*n+i];
+ }
+ for (i=p-1; i>=0; i--)
+ { for (j=i+1; j<p; j++) v[i] -= A[j*n+i]*v[j];
+ v[i] /= A[i*n+i];
+ }
+ return(p);
+}
+
+int chol_hsolve(A,v,n,p)
+double *A, *v;
+int n, p;
+{ int i, j;
+
+ for (i=0; i<p; i++)
+ { for (j=0; j<i; j++) v[i] -= A[i*n+j]*v[j];
+ v[i] /= A[i*n+i];
+ }
+ return(p);
+}
+
+double chol_qf(A,v,n,p)
+double *A, *v;
+int n, p;
+{ int i, j;
+ double sum;
+
+ sum = 0.0;
+ for (i=0; i<p; i++)
+ { for (j=0; j<i; j++) v[i] -= A[i*n+j]*v[j];
+ v[i] /= A[i*n+i];
+ sum += v[i]*v[i];
+ }
+ return(sum);
+}
diff --git a/src/m_eigen.c b/src/m_eigen.c
new file mode 100755
index 0000000..2fe83e3
--- /dev/null
+++ b/src/m_eigen.c
@@ -0,0 +1,146 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include <R.h>
+
+#include <stdio.h>
+#include <math.h>
+#include "mutil.h"
+#define E_MAXIT 20
+#define E_TOL 1.0e-8
+#define SQR(x) ((x)*(x))
+
+double e_tol(D,p)
+double *D;
+int p;
+{ double mx;
+ int i;
+ if (E_TOL <= 0.0) return(0.0);
+ mx = D[0];
+ for (i=1; i<p; i++) if (D[i*(p+1)]>mx) mx = D[i*(p+1)];
+ return(E_TOL*mx);
+}
+
+void eig_dec(X,P,d)
+double *X, *P;
+int d;
+{ int i, j, k, iter, ms;
+ double c, s, r, u, v;
+
+ for (i=0; i<d; i++)
+ for (j=0; j<d; j++) P[i*d+j] = (i==j);
+
+ for (iter=0; iter<E_MAXIT; iter++)
+ { ms = 0;
+ for (i=0; i<d; i++)
+ for (j=i+1; j<d; j++)
+ if (SQR(X[i*d+j]) > 1.0e-15*fabs(X[i*d+i]*X[j*d+j]))
+ { c = (X[j*d+j]-X[i*d+i])/2;
+ s = -X[i*d+j];
+ r = sqrt(c*c+s*s);
+ c /= r;
+ s = sqrt((1-c)/2)*(2*(s>0)-1);
+ c = sqrt((1+c)/2);
+ for (k=0; k<d; k++)
+ { u = X[i*d+k]; v = X[j*d+k];
+ X[i*d+k] = u*c+v*s;
+ X[j*d+k] = v*c-u*s;
+ }
+ for (k=0; k<d; k++)
+ { u = X[k*d+i]; v = X[k*d+j];
+ X[k*d+i] = u*c+v*s;
+ X[k*d+j] = v*c-u*s;
+ }
+ X[i*d+j] = X[j*d+i] = 0.0;
+ for (k=0; k<d; k++)
+ { u = P[k*d+i]; v = P[k*d+j];
+ P[k*d+i] = u*c+v*s;
+ P[k*d+j] = v*c-u*s;
+ }
+ ms = 1;
+ }
+ if (ms==0) return;
+ }
+ Rprintf("eig_dec not converged\n");
+}
+
+int eig_solve(J,x)
+jacobian *J;
+double *x;
+{ int d, i, j, rank;
+ double *D, *P, *Q, *w;
+ double tol;
+
+ D = J->Z;
+ P = Q = J->Q;
+ d = J->p;
+ w = J->wk;
+
+ tol = e_tol(D,d);
+
+ rank = 0;
+ for (i=0; i<d; i++)
+ { w[i] = 0.0;
+ for (j=0; j<d; j++) w[i] += P[j*d+i]*x[j];
+ }
+ for (i=0; i<d; i++)
+ if (D[i*d+i]>tol)
+ { w[i] /= D[i*(d+1)];
+ rank++;
+ }
+ for (i=0; i<d; i++)
+ { x[i] = 0.0;
+ for (j=0; j<d; j++) x[i] += Q[i*d+j]*w[j];
+ }
+ return(rank);
+}
+
+int eig_hsolve(J,v)
+jacobian *J;
+double *v;
+{ int i, j, p, rank;
+ double *D, *Q, *w;
+ double tol;
+
+ D = J->Z;
+ Q = J->Q;
+ p = J->p;
+ w = J->wk;
+
+ tol = e_tol(D,p);
+ rank = 0;
+
+ for (i=0; i<p; i++)
+ { w[i] = 0.0;
+ for (j=0; j<p; j++) w[i] += Q[j*p+i]*v[j];
+ }
+ for (i=0; i<p; i++)
+ { if (D[i*p+i]>tol)
+ { v[i] = w[i]/sqrt(D[i*(p+1)]);
+ rank++;
+ }
+ else v[i] = 0.0;
+ }
+ return(rank);
+}
+
+double eig_qf(J,v)
+jacobian *J;
+double *v;
+{ int i, j, p;
+ double sum, tol;
+
+ p = J->p;
+ sum = 0.0;
+ tol = e_tol(J->Z,p);
+
+ for (i=0; i<p; i++)
+ if (J->Z[i*p+i]>tol)
+ { J->wk[i] = 0.0;
+ for (j=0; j<p; j++) J->wk[i] += J->Q[j*p+i]*v[j];
+ sum += J->wk[i]*J->wk[i]/J->Z[i*p+i];
+ }
+ return(sum);
+}
diff --git a/src/m_icirc.c b/src/m_icirc.c
new file mode 100755
index 0000000..8fa4977
--- /dev/null
+++ b/src/m_icirc.c
@@ -0,0 +1,113 @@
+/*
+ * Integrate a function f over a circle or disc.
+ */
+
+#include "mutil.h"
+#include <stdio.h>
+#ifndef PI
+#define PI 3.141592653589793238462643
+#endif
+
+void setM(M,r,s,c,b)
+double *M, r, s, c;
+int b;
+{ M[0] =-r*s; M[1] = r*c;
+ M[2] = b*c; M[3] = b*s;
+ M[4] =-r*c; M[5] = -s;
+ M[6] = -s; M[7] = 0.0;
+ M[8] =-r*s; M[9] = c;
+ M[10]= c; M[11]= 0.0;
+}
+
+void integ_circ(f,r,orig,res,mint,b)
+int (*f)(), mint, b;
+double r, *orig, *res;
+{ double y, x[2], theta, tres[MXRESULT], M[12], c, s;
+ int i, j, nr=0;
+
+ y = 0;
+ for (i=0; i<mint; i++)
+ { theta = 2*PI*(double)i/(double)mint;
+ c = cos(theta); s = sin(theta);
+ x[0] = orig[0]+r*c;
+ x[1] = orig[1]+r*s;
+
+ if (b!=0)
+ { M[0] =-r*s; M[1] = r*c;
+ M[2] = b*c; M[3] = b*s;
+ M[4] =-r*c; M[5] = -s;
+ M[6] = -s; M[7] = 0.0;
+ M[8] =-r*s; M[9] = c;
+ M[10]= c; M[11]= 0.0;
+ }
+
+ nr = f(x,2,tres,M);
+ if (i==0) setzero(res,nr);
+ for (j=0; j<nr; j++) res[j] += tres[j];
+ }
+ y = 2 * PI * ((b==0)?r:1.0) / mint;
+ for (j=0; j<nr; j++) res[j] *= y;
+}
+
+void integ_disc(f,fb,fl,res,resb,mg)
+int (*f)(), (*fb)(), *mg;
+double *fl, *res, *resb;
+{ double x[2], y, r, tres[MXRESULT], *orig, rmin, rmax, theta, c, s, M[12];
+ int ct, ctb, i, j, k, nr, nrb=0, w;
+
+ orig = &fl[2];
+ rmax = fl[1];
+ rmin = fl[0];
+ y = 0.0;
+ ct = ctb = 0;
+
+ for (j=0; j<mg[1]; j++)
+ { theta = 2*PI*(double)j/(double)mg[1];
+ c = cos(theta); s = sin(theta);
+ for (i= (rmin>0) ? 0 : 1; i<=mg[0]; i++)
+ { r = rmin + (rmax-rmin)*i/mg[0];
+ w = (2+2*(i&1)-(i==0)-(i==mg[0]));
+ x[0] = orig[0] + r*c;
+ x[1] = orig[1] + r*s;
+ nr = f(x,2,tres,NULL);
+ if (ct==0) setzero(res,nr);
+ for (k=0; k<nr; k++) res[k] += w*r*tres[k];
+ ct++;
+ if (((i==0) | (i==mg[0])) && (fb!=NULL))
+ { setM(M,r,s,c,1-2*(i==0));
+ nrb = fb(x,2,tres,M);
+ if (ctb==0) setzero(resb,nrb);
+ ctb++;
+ for (k=0; k<nrb; k++) resb[k] += tres[k];
+ }
+ }
+ }
+
+
+/* for (i= (rmin>0) ? 0 : 1; i<=mg[0]; i++)
+ {
+ r = rmin + (rmax-rmin)*i/mg[0];
+ w = (2+2*(i&1)-(i==0)-(i==mg[0]));
+
+ for (j=0; j<mg[1]; j++)
+ { theta = 2*PI*(double)j/(double)mg[1];
+ c = cos(theta); s = sin(theta);
+ x[0] = orig[0] + r*c;
+ x[1] = orig[1] + r*s;
+ nr = f(x,2,tres,NULL);
+ if (ct==0) setzero(res,nr);
+ ct++;
+ for (k=0; k<nr; k++) res[k] += w*r*tres[k];
+
+ if (((i==0) | (i==mg[0])) && (fb!=NULL))
+ { setM(M,r,s,c,1-2*(i==0));
+ nrb = fb(x,2,tres,M);
+ if (ctb==0) setzero(resb,nrb);
+ ctb++;
+ for (k=0; k<nrb; k++) resb[k] += tres[k];
+ }
+ }
+ } */
+ for (j=0; j<nr; j++) res[j] *= 2*PI*(rmax-rmin)/(3*mg[0]*mg[1]);
+ for (j=0; j<nrb; j++) resb[j] *= 2*PI/mg[1];
+}
diff --git a/src/m_imont.c b/src/m_imont.c
new file mode 100755
index 0000000..793d62c
--- /dev/null
+++ b/src/m_imont.c
@@ -0,0 +1,41 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Multivariate integration of a vector-valued function
+ * using Monte-Carlo method.
+ *
+ * uses drand48() random number generator. Does not seed.
+ */
+
+#include <stdlib.h>
+#include "R.h"
+#include "mutil.h"
+extern void setzero();
+
+/* static int lfindex[MXIDIM];
+ static double M[(1+MXIDIM)*MXIDIM*MXIDIM]; */
+
+void monte(f,ll,ur,d,res,n)
+int (*f)(), d, n;
+double *ll, *ur, *res;
+{ int i, j, nr=0;
+ double z, x[MXIDIM], tres[MXRESULT];
+
+/* srand48(234L); */
+ GetRNGstate(); /* Use R's RNG */
+
+ for (i=0; i<n; i++)
+ { for (j=0; j<d; j++) x[j] = ll[j] + (ur[j]-ll[j])*unif_rand(); /* drand48();*/
+ nr = f(x,d,tres,NULL);
+ if (i==0) setzero(res,nr);
+ for (j=0; j<nr; j++) res[j] += tres[j];
+ }
+
+ z = 1;
+ for (i=0; i<d; i++) z *= (ur[i]-ll[i]);
+ for (i=0; i<nr; i++) res[i] *= z/n;
+
+ PutRNGstate();
+}
diff --git a/src/m_isimp.c b/src/m_isimp.c
new file mode 100755
index 0000000..6580201
--- /dev/null
+++ b/src/m_isimp.c
@@ -0,0 +1,159 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Multivariate integration of a vector-valued function
+ * using Simpson's rule.
+ */
+
+#include <math.h>
+#include <stdio.h>
+#include "mutil.h"
+extern void setzero();
+
+static double M[(1+MXIDIM)*MXIDIM*MXIDIM];
+
+/* third order corners */
+void simp3(fd,x,d,resd,delta,wt,i0,i1,mg,ct,res2,lfindex)
+int (*fd)(), d, wt, i0, i1, *mg, ct, *lfindex;
+double *x, *resd, *delta, *res2;
+{ int k, l, m, nrd;
+ double zb;
+
+ for (k=i1+1; k<d; k++) if ((lfindex[k]==0) | (lfindex[k]==mg[k]))
+ {
+ setzero(M,d*d);
+ m = 0; zb = 1.0;
+ for (l=0; l<d; l++)
+ if ((l!=i0) & (l!=i1) & (l!=k))
+ { M[m*d+l] = 1.0;
+ m++;
+ zb *= delta[l];
+ }
+ M[(d-3)*d+i0] = (lfindex[i0]==0) ? -1 : 1;
+ M[(d-2)*d+i1] = (lfindex[i1]==0) ? -1 : 1;
+ M[(d-1)*d+k] = (lfindex[k]==0) ? -1 : 1;
+ nrd = fd(x,d,res2,M);
+ if ((ct==0) & (i0==0) & (i1==1) & (k==2)) setzero(resd,nrd);
+ for (l=0; l<nrd; l++)
+ resd[l] += wt*zb*res2[l];
+ }
+}
+
+/* second order corners */
+void simp2(fc,fd,x,d,resc,resd,delta,wt,i0,mg,ct,res2,lfindex)
+int (*fc)(), (*fd)(), d, wt, i0, *mg, ct, *lfindex;
+double *x, *resc, *resd, *delta, *res2;
+{ int j, k, l, nrc;
+ double zb;
+ for (j=i0+1; j<d; j++) if ((lfindex[j]==0) | (lfindex[j]==mg[j]))
+ { setzero(M,d*d);
+ l = 0; zb = 1;
+ for (k=0; k<d; k++) if ((k!=i0) & (k!=j))
+ { M[l*d+k] = 1.0;
+ l++;
+ zb *= delta[k];
+ }
+ M[(d-2)*d+i0] = (lfindex[i0]==0) ? -1 : 1;
+ M[(d-1)*d+j] = (lfindex[j]==0) ? -1 : 1;
+ nrc = fc(x,d,res2,M);
+ if ((ct==0) & (i0==0) & (j==1)) setzero(resc,nrc);
+ for (k=0; k<nrc; k++) resc[k] += wt*zb*res2[k];
+
+ if (fd!=NULL)
+ simp3(fd,x,d,resd,delta,wt,i0,j,mg,ct,res2);
+ }
+}
+
+/* first order boundary */
+void simp1(fb,fc,fd,x,d,resb,resc,resd,delta,wt,mg,ct,res2,lfindex)
+int (*fb)(), (*fc)(), (*fd)(), d, wt, *mg, ct, *lfindex;
+double *x, *resb, *resc, *resd, *delta, *res2;
+{ int i, j, k, nrb;
+ double zb;
+ for (i=0; i<d; i++) if ((lfindex[i]==0) | (lfindex[i]==mg[i]))
+ { setzero(M,(1+d)*d*d);
+ k = 0;
+ for (j=0; j<d; j++) if (j!=i)
+ { M[k*d+j] = 1;
+ k++;
+ }
+ M[(d-1)*d+i] = (lfindex[i]==0) ? -1 : 1;
+ nrb = fb(x,d,res2,M);
+ zb = 1;
+ for (j=0; j<d; j++) if (i!=j) zb *= delta[j];
+ if ((ct==0) && (i==0))
+ for (j=0; j<nrb; j++) resb[j] = 0.0;
+ for (j=0; j<nrb; j++) resb[j] += wt*zb*res2[j];
+
+ if (fc!=NULL)
+ simp2(fc,fd,x,d,resc,resd,delta,wt,i,mg,ct,res2,lfindex);
+ }
+}
+
+void simpson4(f,fb,fc,fd,ll,ur,d,res,resb,resc,resd,mg,res2)
+int (*f)(), (*fb)(), (*fc)(), (*fd)(), d, *mg;
+double *ll, *ur, *res, *resb, *resc, *resd, *res2;
+{ int ct, i, j, nr, wt, lfindex[MXIDIM];
+ double x[MXIDIM], delta[MXIDIM], z;
+
+ for (i=0; i<d; i++)
+ { lfindex[i] = 0;
+ x[i] = ll[i];
+ if (mg[i]&1) mg[i]++;
+ delta[i] = (ur[i]-ll[i])/(3*mg[i]);
+ }
+ ct = 0;
+
+ while(1)
+ { wt = 1;
+ for (i=0; i<d; i++)
+ wt *= (4-2*(lfindex[i]%2==0)-(lfindex[i]==0)-(lfindex[i]==mg[i]));
+ nr = f(x,d,res2,NULL);
+ if (ct==0) setzero(res,nr);
+ for (i=0; i<nr; i++) res[i] += wt*res2[i];
+
+ if (fb!=NULL)
+ simp1(fb,fc,fd,x,d,resb,resc,resd,delta,wt,mg,ct,res2,lfindex);
+
+ /* compute next grid point */
+ for (i=0; i<d; i++)
+ { lfindex[i]++;
+ if (lfindex[i]>mg[i])
+ { lfindex[i] = 0;
+ x[i] = ll[i];
+ if (i==d-1) /* done */
+ { z = 1.0;
+ for (j=0; j<d; j++) z *= delta[j];
+ for (j=0; j<nr; j++) res[j] *= z;
+ return;
+ }
+ }
+ else
+ { x[i] = ll[i] + 3*delta[i]*lfindex[i];
+ i = d;
+ }
+ }
+ ct++;
+ }
+}
+
+void simpsonm(f,ll,ur,d,res,mg,res2)
+int (*f)(), d, *mg;
+double *ll, *ur, *res, *res2;
+{ simpson4(f,NULL,NULL,NULL,ll,ur,d,res,NULL,NULL,NULL,mg,res2);
+}
+
+double simpson(f,l0,l1,m)
+double (*f)(), l0, l1;
+int m;
+{ double x, sum;
+ int i;
+ sum = 0;
+ for (i=0; i<=m; i++)
+ { x = ((m-i)*l0 + i*l1)/m;
+ sum += (2+2*(i&1)-(i==0)-(i==m)) * f(x);
+ }
+ return( (l1-l0) * sum / (3*m) );
+}
diff --git a/src/m_isphr.c b/src/m_isphr.c
new file mode 100755
index 0000000..4f13c48
--- /dev/null
+++ b/src/m_isphr.c
@@ -0,0 +1,208 @@
+#include "mutil.h"
+#include <stdio.h>
+
+static double *res, *resb, *orig, rmin, rmax;
+static int ct0;
+
+void sphM(M,r,u)
+double *M, r, *u;
+{ double h, u1[3], u2[3];
+
+ /* set the orthogonal unit vectors. */
+ h = sqrt(u[0]*u[0]+u[1]*u[1]);
+ if (h<=0)
+ { u1[0] = u2[1] = 1.0;
+ u1[1] = u1[2] = u2[0] = u2[2] = 0.0;
+ }
+ else
+ { u1[0] = u[1]/h; u1[1] = -u[0]/h; u1[2] = 0.0;
+ u2[0] = u[2]*u[0]/h; u2[1] = u[2]*u[1]/h; u2[2] = -h;
+ }
+
+ /* parameterize the sphere as r(cos(t)cos(v)u + sin(t)u1 + cos(t)sin(v)u2).
+ * first layer of M is (dx/dt, dx/dv, dx/dr) at t=v=0.
+ */
+ M[0] = r*u1[0]; M[1] = r*u1[1]; M[2] = r*u1[2];
+ M[3] = r*u2[0]; M[4] = r*u2[1]; M[5] = r*u2[2];
+ M[6] = u[0]; M[7] = u[1]; M[8] = u[2];
+
+ /* next layers are second derivative matrix of components of x(r,t,v).
+ * d^2x/dt^2 = d^2x/dv^2 = -ru; d^2x/dtdv = 0;
+ * d^2x/drdt = u1; d^2x/drdv = u2; d^2x/dr^2 = 0.
+ */
+
+ M[9] = M[13] = -r*u[0];
+ M[11]= M[15] = u1[0];
+ M[14]= M[16] = u2[0];
+ M[10]= M[12] = M[17] = 0.0;
+
+ M[18]= M[22] = -r*u[1];
+ M[20]= M[24] = u1[1];
+ M[23]= M[25] = u2[1];
+ M[19]= M[21] = M[26] = 0.0;
+
+ M[27]= M[31] = -r*u[1];
+ M[29]= M[33] = u1[1];
+ M[32]= M[34] = u2[1];
+ M[28]= M[30] = M[35] = 0.0;
+
+}
+
+double ip3(a,b)
+double *a, *b;
+{ return(a[0]*b[0] + a[1]*b[1] + a[2]*b[2]);
+}
+
+void rn3(a)
+double *a;
+{ double s;
+ s = sqrt(ip3(a,a));
+ a[0] /= s; a[1] /= s; a[2] /= s;
+}
+
+double sptarea(a,b,c)
+double *a, *b, *c;
+{ double ea, eb, ec, yab, yac, ybc, sab, sac, sbc;
+ double ab[3], ac[3], bc[3], x1[3], x2[3];
+
+ ab[0] = a[0]-b[0]; ab[1] = a[1]-b[1]; ab[2] = a[2]-b[2];
+ ac[0] = a[0]-c[0]; ac[1] = a[1]-c[1]; ac[2] = a[2]-c[2];
+ bc[0] = b[0]-c[0]; bc[1] = b[1]-c[1]; bc[2] = b[2]-c[2];
+
+ yab = ip3(ab,a); yac = ip3(ac,a); ybc = ip3(bc,b);
+
+ x1[0] = ab[0] - yab*a[0]; x2[0] = ac[0] - yac*a[0];
+ x1[1] = ab[1] - yab*a[1]; x2[1] = ac[1] - yac*a[1];
+ x1[2] = ab[2] - yab*a[2]; x2[2] = ac[2] - yac*a[2];
+ sab = ip3(x1,x1); sac = ip3(x2,x2);
+ ea = acos(ip3(x1,x2)/sqrt(sab*sac));
+
+ x1[0] = ab[0] + yab*b[0]; x2[0] = bc[0] - ybc*b[0];
+ x1[1] = ab[1] + yab*b[1]; x2[1] = bc[1] - ybc*b[1];
+ x1[2] = ab[2] + yab*b[2]; x2[2] = bc[2] - ybc*b[2];
+ sbc = ip3(x2,x2);
+ eb = acos(ip3(x1,x2)/sqrt(sab*sbc));
+
+ x1[0] = ac[0] + yac*c[0]; x2[0] = bc[0] + ybc*c[0];
+ x1[1] = ac[1] + yac*c[1]; x2[1] = bc[1] + ybc*c[1];
+ x1[2] = ac[2] + yac*c[2]; x2[2] = bc[2] + ybc*c[2];
+ ec = acos(ip3(x1,x2)/sqrt(sac*sbc));
+
+/*
+ * Euler's formula is a+b+c-PI, except I've cheated...
+ * a=ea, c=ec, b=PI-eb, which is more stable.
+ */
+ return(ea+ec-eb);
+}
+
+void li(x,f,fb,mint,ar)
+double *x, ar;
+int (*f)(), (*fb)(), mint;
+{ int i, j, nr=0, nrb, ct1, w;
+ double u[3], r, M[36];
+ double sres[MXRESULT], tres[MXRESULT];
+
+/* divide mint by 2, and force to even (Simpson's rule...)
+ * to make comparable with rectangular interpretation of mint
+ */
+ mint <<= 1;
+ if (mint&1) mint++;
+
+ ct1 = 0;
+ for (i= (rmin==0) ? 1 : 0; i<=mint; i++)
+ {
+ r = rmin + (rmax-rmin)*i/mint;
+ w = 2+2*(i&1)-(i==0)-(i==mint);
+ u[0] = orig[0]+x[0]*r;
+ u[1] = orig[1]+x[1]*r;
+ u[2] = orig[2]+x[2]*r;
+ nr = f(u,3,tres,NULL);
+ if (ct1==0) setzero(sres,nr);
+ for (j=0; j<nr; j++)
+ sres[j] += w*r*r*tres[j];
+ ct1++;
+
+ if ((fb!=NULL) && (i==mint)) /* boundary */
+ { sphM(M,rmax,x);
+ nrb = fb(u,3,tres,M);
+ if (ct0==0) for (j=0; j<nrb; j++) resb[j] = 0.0;
+ for (j=0; j<nrb; j++)
+ resb[j] += tres[j]*ar;
+ }
+ }
+
+ if (ct0==0) for (j=0; j<nr; j++) res[j] = 0.0;
+ ct0++;
+
+ for (j=0; j<nr; j++)
+ res[j] += sres[j] * ar * (rmax-rmin)/(3*mint);
+}
+
+void sphint(f,fb,a,b,c,lev,mint,cent)
+double *a, *b, *c;
+int (*f)(), (*fb)(), lev, mint, cent;
+{ double x[3], ab[3], ac[3], bc[3], ar;
+ int i;
+
+ if (lev>1)
+ { ab[0] = a[0]+b[0]; ab[1] = a[1]+b[1]; ab[2] = a[2]+b[2]; rn3(ab);
+ ac[0] = a[0]+c[0]; ac[1] = a[1]+c[1]; ac[2] = a[2]+c[2]; rn3(ac);
+ bc[0] = b[0]+c[0]; bc[1] = b[1]+c[1]; bc[2] = b[2]+c[2]; rn3(bc);
+ lev >>= 1;
+ if (cent==0)
+ { sphint(f,fb,a,ab,ac,lev,mint,1);
+ sphint(f,fb,ab,bc,ac,lev,mint,0);
+ }
+ else
+ { sphint(f,fb,a,ab,ac,lev,mint,1);
+ sphint(f,fb,b,ab,bc,lev,mint,1);
+ sphint(f,fb,c,ac,bc,lev,mint,1);
+ sphint(f,fb,ab,bc,ac,lev,mint,1);
+ }
+ return;
+ }
+
+ x[0] = a[0]+b[0]+c[0];
+ x[1] = a[1]+b[1]+c[1];
+ x[2] = a[2]+b[2]+c[2];
+ rn3(x);
+ ar = sptarea(a,b,c);
+
+ for (i=0; i<8; i++)
+ { if (i>0)
+ { x[0] = -x[0];
+ if (i%2 == 0) x[1] = -x[1];
+ if (i==4) x[2] = -x[2];
+ }
+ switch(cent)
+ { case 2: /* the reflection and its 120', 240' rotations */
+ ab[0] = x[0]; ab[1] = x[2]; ab[2] = x[1]; li(ab,f,fb,mint,ar);
+ ab[0] = x[2]; ab[1] = x[1]; ab[2] = x[0]; li(ab,f,fb,mint,ar);
+ ab[0] = x[1]; ab[1] = x[0]; ab[2] = x[2]; li(ab,f,fb,mint,ar);
+ case 1: /* and the 120' and 240' rotations */
+ ab[0] = x[1]; ab[1] = x[2]; ab[2] = x[0]; li(ab,f,fb,mint,ar);
+ ac[0] = x[2]; ac[1] = x[0]; ac[2] = x[1]; li(ac,f,fb,mint,ar);
+ case 0: /* and the triangle itself. */
+ li( x,f,fb,mint,ar);
+ }
+ }
+}
+
+void integ_sphere(f,fb,fl,Res,Resb,mg)
+double *fl, *Res, *Resb;
+int (*f)(), (*fb)(), *mg;
+{ double a[3], b[3], c[3];
+
+ a[0] = 1; a[1] = a[2] = 0;
+ b[1] = 1; b[0] = b[2] = 0;
+ c[2] = 1; c[0] = c[1] = 0;
+
+ res = Res;
+ resb=Resb;
+ orig = &fl[2];
+ rmin = fl[0];
+ rmax = fl[1];
+
+ ct0 = 0;
+ sphint(f,fb,a,b,c,mg[1],mg[0],0);
+}
diff --git a/src/m_jacob.c b/src/m_jacob.c
new file mode 100755
index 0000000..36aa805
--- /dev/null
+++ b/src/m_jacob.c
@@ -0,0 +1,119 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include <R.h>
+#include "math.h"
+#include "stdio.h"
+#include "stdlib.h"
+#include "mutil.h"
+
+#define DEF_METH JAC_EIGD
+
+int jac_reqd(int p) { return(2*p*(p+1)); }
+
+double *jac_alloc(J,p,wk)
+jacobian *J;
+int p;
+double *wk;
+{ if (wk==NULL)
+ wk = (double *)calloc(2*p*(p+1),sizeof(double));
+ J->Z = wk; wk += p*p;
+ J->Q = wk; wk += p*p;
+ J->wk= wk; wk += p;
+ J->dg= wk; wk += p;
+ return(wk);
+}
+
+void jacob_dec(J, meth)
+jacobian *J;
+int meth;
+{ int i, j, p;
+
+ if (J->st != JAC_RAW) return;
+
+ J->sm = J->st = meth;
+ switch(meth)
+ { case JAC_EIG:
+ eig_dec(J->Z,J->Q,J->p);
+ return;
+ case JAC_EIGD:
+ p = J->p;
+ for (i=0; i<p; i++)
+ J->dg[i] = (J->Z[i*(p+1)]<=0) ? 0.0 : 1/sqrt(J->Z[i*(p+1)]);
+ for (i=0; i<p; i++)
+ for (j=0; j<p; j++)
+ J->Z[i*p+j] *= J->dg[i]*J->dg[j];
+ eig_dec(J->Z,J->Q,J->p);
+ J->st = JAC_EIGD;
+ return;
+ case JAC_CHOL:
+ chol_dec(J->Z,J->p,J->p);
+ return;
+ default: Rprintf("jacob_dec: unknown method %d",meth);
+ }
+}
+
+int jacob_solve(J,v) /* (X^T W X)^{-1} v */
+jacobian *J;
+double *v;
+{ int i, rank;
+
+ if (J->st == JAC_RAW) jacob_dec(J,DEF_METH);
+
+ switch(J->st)
+ { case JAC_EIG:
+ return(eig_solve(J,v));
+ case JAC_EIGD:
+ for (i=0; i<J->p; i++) v[i] *= J->dg[i];
+ rank = eig_solve(J,v);
+ for (i=0; i<J->p; i++) v[i] *= J->dg[i];
+ return(rank);
+ case JAC_CHOL:
+ return(chol_solve(J->Z,v,J->p,J->p));
+ }
+ Rprintf("jacob_solve: unknown method %d",J->st);
+ return(0);
+}
+
+int jacob_hsolve(J,v) /* J^{-1/2} v */
+jacobian *J;
+double *v;
+{ int i;
+
+ if (J->st == JAC_RAW) jacob_dec(J,DEF_METH);
+
+ switch(J->st)
+ { case JAC_EIG:
+ return(eig_hsolve(J,v));
+ case JAC_EIGD: /* eigenvalues on corr matrix */
+ for (i=0; i<J->p; i++) v[i] *= J->dg[i];
+ return(eig_hsolve(J,v));
+ case JAC_CHOL:
+ return(chol_hsolve(J->Z,v,J->p,J->p));
+ }
+ Rprintf("jacob_hsolve: unknown method %d",J->st);
+ return(0);
+}
+
+double jacob_qf(J,v) /* vT J^{-1} v */
+jacobian *J;
+double *v;
+{ int i;
+
+ if (J->st == JAC_RAW) jacob_dec(J,DEF_METH);
+
+ switch (J->st)
+ { case JAC_EIG:
+ return(eig_qf(J,v));
+ case JAC_EIGD:
+ for (i=0; i<J->p; i++) v[i] *= J->dg[i];
+ return(eig_qf(J,v));
+ case JAC_CHOL:
+ return(chol_qf(J->Z,v,J->p,J->p));
+ default:
+ Rprintf("jacob_qf: invalid method\n");
+ return(0.0);
+ }
+}
diff --git a/src/m_max.c b/src/m_max.c
new file mode 100755
index 0000000..a099305
--- /dev/null
+++ b/src/m_max.c
@@ -0,0 +1,216 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Routines for maximization of a one dimensional function f()
+ * over an interval [xlo,xhi]. In all cases. the flag argument
+ * controls the return:
+ * flag='x', the maximizer xmax is returned.
+ * otherwise, maximum f(xmax) is returned.
+ *
+ * max_grid(f,xlo,xhi,n,flag)
+ * grid maximization of f() over [xlo,xhi] with n intervals.
+ *
+ * max_golden(f,xlo,xhi,n,tol,err,flag)
+ * golden section maximization.
+ * If n>2, an initial grid search is performed with n intervals
+ * (this helps deal with local maxima).
+ * convergence criterion is |x-xmax| < tol.
+ * err is an error flag.
+ * if flag='x', return value is xmax.
+ * otherwise, return value is f(xmax).
+ *
+ * max_quad(f,xlo,xhi,n,tol,err,flag)
+ * quadratic maximization.
+ *
+ * max_nr()
+ * newton-raphson, handles multivariate case.
+ *
+ * TODO: additional error checking, non-convergence stop.
+ */
+
+#include <math.h>
+#include <stdlib.h>
+#include <stdio.h>
+#include <string.h>
+#include "mutil.h"
+
+#define gold_rat 0.6180339887498948482045870
+#define max_val(a,b) ((flag=='x') ? a : b)
+
+double max_grid(f,xlo,xhi,n,flag)
+double (*f)(), xlo, xhi;
+int n;
+char flag;
+{ int i, mi=0;
+ double x, y, mx=0.0, my=0.0;
+ for (i=0; i<=n; i++)
+ { x = xlo + (xhi-xlo)*i/n;
+ y = f(x);
+ if ((i==0) || (y>my))
+ { mx = x;
+ my = y;
+ mi = i;
+ }
+ }
+ if (mi==0) return(max_val(xlo,my));
+ if (mi==n) return(max_val(xhi,my));
+ return(max_val(mx,my));
+}
+
+double max_golden(f,xlo,xhi,n,tol,err,flag)
+double (*f)(), xhi, xlo, tol;
+int n, *err;
+char flag;
+{ double dlt, x0, x1, x2, x3, y0, y1, y2, y3;
+ *err = 0;
+
+ if (n>2)
+ { dlt = (xhi-xlo)/n;
+ x0 = max_grid(f,xlo,xhi,n,'x');
+ if (xlo<x0) xlo = x0-dlt;
+ if (xhi>x0) xhi = x0+dlt;
+ }
+
+ x0 = xlo; y0 = f(xlo);
+ x3 = xhi; y3 = f(xhi);
+ x1 = gold_rat*x0 + (1-gold_rat)*x3; y1 = f(x1);
+ x2 = gold_rat*x3 + (1-gold_rat)*x1; y2 = f(x2);
+
+ while (fabs(x3-x0)>tol)
+ { if ((y1>=y0) && (y1>=y2))
+ { x3 = x2; y3 = y2;
+ x2 = x1; y2 = y1;
+ x1 = gold_rat*x0 + (1-gold_rat)*x3; y1 = f(x1);
+ }
+ else if ((y2>=y3) && (y2>=y1))
+ { x0 = x1; y0 = y1;
+ x1 = x2; y1 = y2;
+ x2 = gold_rat*x3 + (1-gold_rat)*x1; y2 = f(x2);
+ }
+ else
+ { if (y3>y0) { x0 = x2; y0 = y2; }
+ else { x3 = x1; y3 = y1; }
+ x1 = gold_rat*x0 + (1-gold_rat)*x3; y1 = f(x1);
+ x2 = gold_rat*x3 + (1-gold_rat)*x1; y2 = f(x2);
+ }
+ }
+ if (y0>=y1) return(max_val(x0,y0));
+ if (y3>=y2) return(max_val(x3,y3));
+ return((y1>y2) ? max_val(x1,y1) : max_val(x2,y2));
+}
+
+double max_quad(f,xlo,xhi,n,tol,err,flag)
+double (*f)(), xhi, xlo, tol;
+int n, *err;
+char flag;
+{ double x0, x1, x2, xnew, y0, y1, y2, ynew, a, b;
+ *err = 0;
+
+ if (n>2)
+ { x0 = max_grid(f,xlo,xhi,n,'x');
+ if (xlo<x0) xlo = x0-1.0/n;
+ if (xhi>x0) xhi = x0+1.0/n;
+ }
+
+ x0 = xlo; y0 = f(x0);
+ x2 = xhi; y2 = f(x2);
+ x1 = (x0+x2)/2; y1 = f(x1);
+
+ while (x2-x0>tol)
+ {
+ /* first, check (y0,y1,y2) is a peak. If not,
+ * next interval is the halve with larger of (y0,y2).
+ */
+ if ((y0>y1) | (y2>y1))
+ {
+ if (y0>y2) { x2 = x1; y2 = y1; }
+ else { x0 = x1; y0 = y1; }
+ x1 = (x0+x2)/2;
+ y1 = f(x1);
+ }
+ else /* peak */
+ { a = (y1-y0)*(x2-x1) + (y1-y2)*(x1-x0);
+ b = ((y1-y0)*(x2-x1)*(x2+x1) + (y1-y2)*(x1-x0)*(x1+x0))/2;
+ /* quadratic maximizer is b/a. But first check if a's too
+ * small, since we may be close to constant.
+ */
+ if ((a<=0) | (b<x0*a) | (b>x2*a))
+ { /* split the larger halve */
+ xnew = ((x2-x1) > (x1-x0)) ? (x1+x2)/2 : (x0+x1)/2;
+ }
+ else
+ { xnew = b/a;
+ if (10*xnew < (9*x0+x1)) xnew = (9*x0+x1)/10;
+ if (10*xnew > (9*x2+x1)) xnew = (9*x2+x1)/10;
+ if (fabs(xnew-x1) < 0.001*(x2-x0))
+ {
+ if ((x2-x1) > (x1-x0))
+ xnew = (99*x1+x2)/100;
+ else
+ xnew = (99*x1+x0)/100;
+ }
+ }
+ ynew = f(xnew);
+ if (xnew>x1)
+ { if (ynew >= y1) { x0 = x1; y0 = y1; x1 = xnew; y1 = ynew; }
+ else { x2 = xnew; y2 = ynew; }
+ }
+ else
+ { if (ynew >= y1) { x2 = x1; y2 = y1; x1 = xnew; y1 = ynew; }
+ else { x0 = xnew; y0 = ynew; }
+ }
+ }
+ }
+ return(max_val(x1,y1));
+}
+
+double max_nr(F, coef, old_coef, f1, delta, J, p, maxit, tol, err)
+double *coef, *old_coef, *f1, *delta, tol;
+int (*F)(), p, maxit, *err;
+jacobian *J;
+{ double old_f, f, lambda;
+ int i, j, fr;
+ double nc, nd, cut;
+ int rank;
+
+ *err = NR_OK;
+ J->p = p;
+ fr = F(coef, &f, f1, J->Z); J->st = JAC_RAW;
+
+ for (i=0; i<maxit; i++)
+ { memmove(old_coef,coef,p*sizeof(double));
+ old_f = f;
+ rank = jacob_solve(J,f1);
+ memmove(delta,f1,p*sizeof(double));
+
+
+ if (rank==0) /* NR won't move! */
+ delta[0] = -f/f1[0];
+
+ lambda = 1.0;
+
+ nc = innerprod(old_coef,old_coef,p);
+ nd = innerprod(delta, delta, p);
+ cut = sqrt(nc/nd);
+ if (cut>1.0) cut = 1.0;
+ cut *= 0.0001;
+ do
+ { for (j=0; j<p; j++) coef[j] = old_coef[j] + lambda*delta[j];
+ f = old_f - 1.0;
+ fr = F(coef, &f, f1, J->Z); J->st = JAC_RAW;
+ if (fr==NR_BREAK) return(old_f);
+
+ lambda = (fr==NR_REDUCE) ? lambda/2 : lambda/10.0;
+ } while ((lambda>cut) & (f <= old_f - 1.0e-3));
+
+ if (f < old_f - 1.0e-3) { *err = NR_NDIV; return(f); }
+ if (fr==NR_REDUCE) return(f);
+
+ if (fabs(f-old_f) < tol) return(f);
+
+ }
+ *err = NR_NCON;
+ return(f);
+}
diff --git a/src/m_qr.c b/src/m_qr.c
new file mode 100755
index 0000000..5c7f3b8
--- /dev/null
+++ b/src/m_qr.c
@@ -0,0 +1,99 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include <math.h>
+#include <stdio.h>
+#include "mutil.h"
+
+/* qr decomposition of X (n*p organized by column).
+ * Take w for the ride, if not NULL.
+ */
+void qr(X,n,p,w)
+double *X, *w;
+int n, p;
+{ int i, j, k, mi;
+ double c, s, mx, nx, t;
+
+ for (j=0; j<p; j++)
+ { mi = j;
+ mx = fabs(X[(n+1)*j]);
+ nx = mx*mx;
+
+ /* find the largest remaining element in j'th column, row mi.
+ * flip that row with row j.
+ */
+ for (i=j+1; i<n; i++)
+ { nx += X[j*n+i]*X[j*n+i];
+ if (fabs(X[j*n+i])>mx)
+ { mi = i;
+ mx = fabs(X[j*n+i]);
+ }
+ }
+ for (i=j; i<p; i++)
+ { t = X[i*n+j];
+ X[i*n+j] = X[i*n+mi];
+ X[i*n+mi] = t;
+ }
+ if (w!=NULL) { t = w[j]; w[j] = w[mi]; w[mi] = t; }
+
+ /* want the diag. element -ve, so we do the `good' Householder reflect.
+ */
+ if (X[(n+1)*j]>0)
+ { for (i=j; i<p; i++) X[i*n+j] = -X[i*n+j];
+ if (w!=NULL) w[j] = -w[j];
+ }
+
+ nx = sqrt(nx);
+ c = nx*(nx-X[(n+1)*j]);
+ if (c!=0)
+ { for (i=j+1; i<p; i++)
+ { s = 0;
+ for (k=j; k<n; k++)
+ s += X[i*n+k]*X[j*n+k];
+ s = (s-nx*X[i*n+j])/c;
+ for (k=j; k<n; k++)
+ X[i*n+k] -= s*X[j*n+k];
+ X[i*n+j] += s*nx;
+ }
+ if (w != NULL)
+ { s = 0;
+ for (k=j; k<n; k++)
+ s += w[k]*X[n*j+k];
+ s = (s-nx*w[j])/c;
+ for (k=j; k<n; k++)
+ w[k] -= s*X[n*j+k];
+ w[j] += s*nx;
+ }
+ X[j*n+j] = nx;
+ }
+ }
+}
+
+void qrinvx(R,x,n,p)
+double *R, *x;
+int n, p;
+{ int i, j;
+ for (i=p-1; i>=0; i--)
+ { for (j=i+1; j<p; j++) x[i] -= R[j*n+i]*x[j];
+ x[i] /= R[i*n+i];
+ }
+}
+
+void qrtinvx(R,x,n,p)
+double *R, *x;
+int n, p;
+{ int i, j;
+ for (i=0; i<p; i++)
+ { for (j=0; j<i; j++) x[i] -= R[i*n+j]*x[j];
+ x[i] /= R[i*n+i];
+ }
+}
+
+void qrsolv(R,x,n,p)
+double *R, *x;
+int n, p;
+{ qrtinvx(R,x,n,p);
+ qrinvx(R,x,n,p);
+}
diff --git a/src/m_solve.c b/src/m_solve.c
new file mode 100755
index 0000000..3edba23
--- /dev/null
+++ b/src/m_solve.c
@@ -0,0 +1,122 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * solve f(x)=c by various methods, with varying stability etc...
+ * xlo and xhi should be initial bounds for the solution.
+ * convergence criterion is |f(x)-c| < tol.
+ *
+ * double solve_secant(f,c,xlo,xhi,tol,bd_flag,err)
+ * secant method solution of f(x)=c.
+ * xlo and xhi are starting values and bound for solution.
+ * tol = convergence criterion, |f(x)-c| < tol.
+ * bd_flag = if (xlo,xhi) doesn't bound a solution, what action to take?
+ * BDF_NONE returns error.
+ * BDF_EXPRIGHT increases xhi.
+ * BDF_EXPLEFT decreases xlo.
+ * err = error flag.
+ * The (xlo,xhi) bound is not formally necessary for the secant method.
+ * But having such a bound vastly improves stability; the code performs
+ * a bisection step whenever the iterations run outside the bounds.
+ *
+ * double solve_nr(f,f1,c,x0,tol,err)
+ * Newton-Raphson solution of f(x)=c.
+ * f1 = f'(x).
+ * x0 = starting value.
+ * tol = convergence criteria, |f(x)-c| < tol.
+ * err = error flag.
+ * No stability checks at present.
+ *
+ * double solve_fp(f,x0,tol)
+ * fixed-point iteration to solve f(x)=x.
+ * x0 = starting value.
+ * tol = convergence criteria, stops when |f(x)-x| < tol.
+ * Convergence requires |f'(x)|<1 in neighborhood of true solution;
+ * f'(x) \approx 0 gives the fastest convergence.
+ * No stability checks at present.
+ *
+ * TODO: additional error checking, non-convergence stop.
+ */
+
+#include <R.h>
+#include <math.h>
+#include <stdio.h>
+#include "mutil.h"
+
+double solve_secant(f,c,xlo,xhi,tol,bd_flag,err)
+double (*f)(), c, xhi, xlo, tol;
+int bd_flag, *err;
+{ double ylo, yhi, x1, x2, x, y1, y2, y;
+ *err = 0;
+ ylo = f(xlo)-c;
+ yhi = f(xhi)-c;
+
+ switch(bd_flag)
+ { case BDF_EXPRIGHT:
+ while (yhi*ylo > 0)
+ { x1 = xhi + (xhi-xlo);
+ y1 = f(x1) - c;
+ xlo = xhi; xhi = x1;
+ ylo = yhi; yhi = y1;
+ }
+ break;
+ case BDF_EXPLEFT:
+ while (yhi*ylo > 0)
+ { x1 = xlo - (xhi-xlo);
+ y1 = f(x1) - c;
+ xhi = xlo; xlo = x1;
+ yhi = ylo; ylo = y1;
+ }
+ break;
+ case BDF_NONE:
+ default:
+ if (yhi*ylo > 0)
+ { *err = 1;
+ return((xlo+xhi)/2);
+ }
+ break;
+ }
+
+ x1 = xlo; y1 = ylo;
+ x2 = xhi; y2 = yhi;
+
+ while (1)
+ { x = x2 + (x1-x2)*y2/(y2-y1);
+ if ((x<=xlo) | (x>=xhi)) x = (xlo+xhi)/2;
+ y = f(x)-c;
+ if (fabs(y) < tol) return(x);
+ if (y*ylo>0) { xlo = x; ylo = y; }
+ else { xhi = x; yhi = y; }
+if (y2==y)
+{ Rprintf("secant: y2 %12.9f\n",y2);
+ return(x);
+}
+ x1 = x2; y1 = y2;
+ x2 = x; y2 = y;
+ }
+}
+
+double solve_nr(f,f1,c,x0,tol,err)
+double (*f)(), (*f1)(), c, x0, tol;
+int *err;
+{ double y;
+ do
+ { y = f(x0)-c;
+ x0 -= y/f1(x0);
+ } while (fabs(y)>tol);
+ return(x0);
+}
+
+double solve_fp(f,x0,tol,maxit)
+double (*f)(), x0, tol;
+int maxit;
+{ double x1=0.0;
+ int i;
+ for (i=0; i<maxit; i++)
+ { x1 = f(x0);
+ if (fabs(x1-x0)<tol) return(x1);
+ x0 = x1;
+ }
+ return(x1); /* although it hasn't converged */
+}
diff --git a/src/m_svd.c b/src/m_svd.c
new file mode 100755
index 0000000..6516f90
--- /dev/null
+++ b/src/m_svd.c
@@ -0,0 +1,130 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include <stdlib.h>
+#include "local.h"
+#include "mutil.h"
+
+void svd(x,p,q,d,mxit) /* svd of square matrix */
+double *x, *p, *q;
+int d, mxit;
+{ int i, j, k, iter, ms, zer;
+ double r, u, v, cp, cm, sp, sm, c1, c2, s1, s2, mx;
+ for (i=0; i<d; i++)
+ for (j=0; j<d; j++) p[i*d+j] = q[i*d+j] = (i==j);
+ for (iter=0; iter<mxit; iter++)
+ { ms = 0;
+ for (i=0; i<d; i++)
+ for (j=i+1; j<d; j++)
+ { s1 = fabs(x[i*d+j]);
+ s2 = fabs(x[j*d+i]);
+ mx = (s1>s2) ? s1 : s2;
+ zer = 1;
+ if (mx*mx>1.0e-15*fabs(x[i*d+i]*x[j*d+j]))
+ { if (fabs(x[i*(d+1)])<fabs(x[j*(d+1)]))
+ { for (k=0; k<d; k++)
+ { u = x[i*d+k]; x[i*d+k] = x[j*d+k]; x[j*d+k] = u;
+ u = p[k*d+i]; p[k*d+i] = p[k*d+j]; p[k*d+j] = u;
+ }
+ for (k=0; k<d; k++)
+ { u = x[k*d+i]; x[k*d+i] = x[k*d+j]; x[k*d+j] = u;
+ u = q[k*d+i]; q[k*d+i] = q[k*d+j]; q[k*d+j] = u;
+ }
+ }
+ cp = x[i*(d+1)]+x[j*(d+1)];
+ sp = x[j*d+i]-x[i*d+j];
+ r = sqrt(cp*cp+sp*sp);
+ if (r>0) { cp /= r; sp /= r; }
+ else { cp = 1.0; zer = 0;}
+ cm = x[i*(d+1)]-x[j*(d+1)];
+ sm = x[i*d+j]+x[j*d+i];
+ r = sqrt(cm*cm+sm*sm);
+ if (r>0) { cm /= r; sm /= r; }
+ else { cm = 1.0; zer = 0;}
+ c1 = cm+cp;
+ s1 = sm+sp;
+ r = sqrt(c1*c1+s1*s1);
+ if (r>0) { c1 /= r; s1 /= r; }
+ else { c1 = 1.0; zer = 0;}
+ if (fabs(s1)>ms) ms = fabs(s1);
+ c2 = cm+cp;
+ s2 = sp-sm;
+ r = sqrt(c2*c2+s2*s2);
+ if (r>0) { c2 /= r; s2 /= r; }
+ else { c2 = 1.0; zer = 0;}
+ for (k=0; k<d; k++)
+ { u = x[i*d+k]; v = x[j*d+k];
+ x[i*d+k] = c1*u+s1*v;
+ x[j*d+k] = c1*v-s1*u;
+ u = p[k*d+i]; v = p[k*d+j];
+ p[k*d+i] = c1*u+s1*v;
+ p[k*d+j] = c1*v-s1*u;
+ }
+ for (k=0; k<d; k++)
+ { u = x[k*d+i]; v = x[k*d+j];
+ x[k*d+i] = c2*u-s2*v;
+ x[k*d+j] = s2*u+c2*v;
+ u = q[k*d+i]; v = q[k*d+j];
+ q[k*d+i] = c2*u-s2*v;
+ q[k*d+j] = s2*u+c2*v;
+ }
+ if (zer) x[i*d+j] = x[j*d+i] = 0.0;
+ ms = 1;
+ }
+ }
+ if (ms==0) iter=mxit+10;
+ }
+ if (iter==mxit) WARN(("Warning: svd not converged.\n"));
+ for (i=0; i<d; i++)
+ if (x[i*d+i]<0)
+ { x[i*d+i] = -x[i*d+i];
+ for (j=0; j<d; j++) p[j*d+i] = -p[j*d+i];
+ }
+}
+
+int svdsolve(x,w,P,D,Q,d,tol) /* original X = PDQ^T; comp. QD^{-1}P^T x */
+double *x, *w, *P, *D, *Q, tol;
+int d;
+{ int i, j, rank;
+ double mx;
+ if (tol>0)
+ { mx = D[0];
+ for (i=1; i<d; i++) if (D[i*(d+1)]>mx) mx = D[i*(d+1)];
+ tol *= mx;
+ }
+ rank = 0;
+ for (i=0; i<d; i++)
+ { w[i] = 0.0;
+ for (j=0; j<d; j++) w[i] += P[j*d+i]*x[j];
+ }
+ for (i=0; i<d; i++)
+ if (D[i*d+i]>tol)
+ { w[i] /= D[i*(d+1)];
+ rank++;
+ }
+ for (i=0; i<d; i++)
+ { x[i] = 0.0;
+ for (j=0; j<d; j++) x[i] += Q[i*d+j]*w[j];
+ }
+ return(rank);
+}
+
+void hsvdsolve(x,w,P,D,Q,d,tol) /* original X = PDQ^T; comp. D^{-1/2}P^T x */
+double *x, *w, *P, *D, *Q, tol;
+int d;
+{ int i, j;
+ double mx;
+ if (tol>0)
+ { mx = D[0];
+ for (i=1; i<d; i++) if (D[i*(d+1)]>mx) mx = D[i*(d+1)];
+ tol *= mx;
+ }
+ for (i=0; i<d; i++)
+ { w[i] = 0.0;
+ for (j=0; j<d; j++) w[i] += P[j*d+i]*x[j];
+ }
+ for (i=0; i<d; i++) if (D[i*d+i]>tol) w[i] /= sqrt(D[i*(d+1)]);
+ for (i=0; i<d; i++) x[i] = w[i];
+}
diff --git a/src/m_vector.c b/src/m_vector.c
new file mode 100755
index 0000000..f384638
--- /dev/null
+++ b/src/m_vector.c
@@ -0,0 +1,93 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Includes some miscellaneios vector functions:
+ * setzero(v,p) sets all elements of v to 0.
+ * unitvec(x,k,p) sets x to k'th unit vector e_k.
+ * innerprod(v1,v2,p) inner product.
+ * addouter(A,v1,v2,p,c) A <- A + c * v_1 v2^T
+ * multmatscal(A,z,n) A <- A*z
+ * transpose(x,m,n) inline transpose
+ * m_trace(x,n) trace
+ */
+
+#include "mutil.h"
+
+void setzero(v,p)
+double *v;
+int p;
+{ int i;
+ for (i=0; i<p; i++) v[i] = 0.0;
+}
+
+void unitvec(x,k,p)
+double *x;
+int k, p;
+{ setzero(x,p);
+ x[k] = 1.0;
+}
+
+double innerprod(v1,v2,p)
+double *v1, *v2;
+int p;
+{ int i;
+ double s;
+ s = 0;
+ for (i=0; i<p; i++) s += v1[i]*v2[i];
+ return(s);
+}
+
+void addouter(A,v1,v2,p,c)
+double *A, *v1, *v2, c;
+int p;
+{ int i, j;
+ for (i=0; i<p; i++)
+ for (j=0; j<p; j++)
+ A[i*p+j] += c*v1[i]*v2[j];
+}
+
+void multmatscal(A,z,n)
+double *A, z;
+int n;
+{ int i;
+ for (i=0; i<n; i++) A[i] *= z;
+}
+
+/*
+ * transpose() transposes an m*n matrix in place.
+ * At input, the matrix has n rows, m columns and
+ * x[0..n-1] is the is the first column.
+ * At output, the matrix has m rows, n columns and
+ * x[0..m-1] is the first column.
+ */
+void transpose(x,m,n)
+double *x;
+int m, n;
+{ int t0, t, ti, tj;
+ double z;
+ for (t0=1; t0<m*n-2; t0++)
+ { ti = t0%m; tj = t0/m;
+ do
+ { t = ti*n+tj;
+ ti= t%m;
+ tj= t/m;
+ } while (t<t0);
+ z = x[t];
+ x[t] = x[t0];
+ x[t0] = z;
+ }
+}
+
+/* trace of an n*n square matrix. */
+double m_trace(x,n)
+double *x;
+int n;
+{ int i;
+ double sum;
+ sum = 0;
+ for (i=0; i<n; i++)
+ sum += x[i*(n+1)];
+ return(sum);
+}
diff --git a/src/math.c b/src/math.c
new file mode 100755
index 0000000..931c696
--- /dev/null
+++ b/src/math.c
@@ -0,0 +1,167 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ miscellaneous functions that may not be defined in the math
+ libraries. The implementations are crude.
+ lflgamma(x) -- log(gamma(x))
+ lferf(x) -- erf(x)
+ lferfc(x) -- erfc(x)
+ lfdaws(x) -- dawson's function
+ lf_exp(x) -- exp(x), but it won't overflow.
+
+ where required, these must be #define'd in local.h.
+
+ also includes
+ ptail(x) -- exp(x*x/2)*int_{-\infty}^x exp(-u^2/2)du for x < -6.
+ logit(x) -- logistic function.
+ expit(x) -- inverse of logit.
+ */
+
+#include <math.h>
+
+double lf_exp(x)
+double x;
+{ if (x>700.0) return(1.014232054735004e+304);
+ return(exp(x));
+}
+
+#include "local.h"
+
+double lferfc();
+
+double lferf(x)
+double x;
+{ static double val[] = { 0.0, 0.52049987781304674,
+ 0.84270079294971501, 0.96610514647531076, 0.99532226501895282,
+ 0.99959304798255499, 0.99997790950300125 };
+ double h, xx, y, z, f0, f1, f2;
+ int m, j;
+ if (x<0) return(-lferf(-x));
+ if (x>3.2) return(1-lferfc(x));
+ m = (int) (2*x+0.5);
+ xx= ((double)m)/2;
+ h = x-xx; y = h;
+ f0 = val[m];
+ f1 = 2*exp(-xx*xx)/SQRPI;
+ z = f0+h*f1;
+ j = 0;
+ while (fabs(y)>1.0e-12)
+ { f2 = -2*j*f0-2*xx*f1;
+ f0 = f1; f1 = f2;
+ y *= h/(j+2);
+ z += y*f2;
+ j++;
+ }
+ return(z);
+}
+
+double lferfc(x)
+double x;
+{ if (x<0) return(1+lferf(-x));
+ if (x<2.5) return(1-lferf(x));
+ return(exp(-x*x)/(x*SQRPI));
+}
+
+double lflgamma(x)
+double x;
+{ double x1;
+ static double ilg[] = { 0.0, 0.0, 0.69314718055994529,
+ 1.791759469228055, 3.1780538303479458, 4.7874917427820458, 6.5792512120101012,
+ 8.5251613610654147, 10.604602902745251, 12.801827480081469 };
+ static double hlg[] = { 0.57236494292470008, -0.12078223763524520,
+ 0.28468287047291918, 1.20097360234707430, 2.45373657084244230,
+ 3.95781396761871650, 5.66256205985714270, 7.53436423675873360,
+ 9.54926725730099870, 11.68933342079726900 };
+
+ if (x<=0.0) return(0.0);
+ if (x<10)
+ { if (x==(int)x) return(ilg[(int)x-1]);
+ if ((x-0.5)==(int)(x-0.5)) return(hlg[(int)(x-0.5)]);
+ }
+ if (x<3) return(lflgamma(x+1)-log(x));
+
+ x1 = x-1;
+ return(HL2PI+(x1+0.5)*log(x1)-x1+1/(12*x1));
+}
+
+double lfdaws(x)
+double x;
+{ static double val[] = {
+ 0, 0.24485619356002, 0.46034428261948, 0.62399959848185, 0.72477845900708,
+ 0.76388186132749, 0.75213621001998, 0.70541701910853, 0.63998807456541,
+ 0.56917098836654, 0.50187821196415, 0.44274283060424, 0.39316687916687,
+ 0.35260646480842, 0.31964847250685, 0.29271122077502, 0.27039629581340,
+ 0.25160207761769, 0.23551176224443, 0.22153505358518, 0.20924575719548,
+ 0.19833146819662, 0.18855782729305, 0.17974461154688, 0.17175005072385 };
+ double h, f0, f1, f2, y, z, xx;
+ int j, m;
+ if (x<0) return(-daws(-x));
+ if (x>6)
+ { /* Tail series: 1/x + 1/x^3 + 1.3/x^5 + 1.3.5/x^7 + ... */
+ y = z = 1/x;
+ j = 0;
+ while (((f0=(2*j+1)/(x*x))<1) && (y>1.0e-10*z))
+ { y *= f0;
+ z += y;
+ j++;
+ }
+ return(z);
+ }
+ m = (int) (4*x);
+ h = x-0.25*m;
+ if (h>0.125)
+ { m++;
+ h = h-0.25;
+ }
+ xx = 0.25*m;
+ f0 = val[m];
+ f1 = 1-xx*f0;
+ z = f0+h*f1;
+ y = h;
+ j = 2;
+ while (fabs(y)>z*1.0e-10)
+ { f2 = -(j-1)*f0-xx*f1;
+ y *= h/j;
+ z += y*f2;
+ f0 = f1; f1 = f2;
+ j++;
+ }
+ return(z);
+}
+
+double ptail(x) /* exp(x*x/2)*int_{-\infty}^x exp(-u^2/2)du for x < -6 */
+double x;
+{ double y, z, f0;
+ int j;
+ y = z = -1.0/x;
+ j = 0;
+ while ((fabs(f0= -(2*j+1)/(x*x))<1) && (fabs(y)>1.0e-10*z))
+ { y *= f0;
+ z += y;
+ j++;
+ }
+ return(z);
+}
+
+double logit(x)
+double x;
+{ return(log(x/(1-x)));
+}
+
+double expit(x)
+double x;
+{ double u;
+ if (x<0)
+ { u = exp(x);
+ return(u/(1+u));
+ }
+ return(1/(1+exp(-x)));
+}
+
+int factorial(n)
+int n;
+{ if (n<=1) return(1.0);
+ return(n*factorial(n-1));
+}
diff --git a/src/minmax.c b/src/minmax.c
new file mode 100755
index 0000000..af9bf74
--- /dev/null
+++ b/src/minmax.c
@@ -0,0 +1,299 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Compute minimax weights for local regression.
+ */
+
+#include "local.h"
+
+int mmsm_ct;
+
+static int debug=0;
+#define CONVTOL 1.0e-8
+#define SINGTOL 1.0e-10
+#define NR_SINGULAR 100
+
+static lfdata *mm_lfd;
+static design *mm_des;
+static double mm_gam;
+
+double ipower(x,n) /* use for n not too large!! */
+double x;
+int n;
+{ if (n==0) return(1.0);
+ if (n<0) return(1/ipower(x,-n));
+ return(x*ipower(x,n-1));
+}
+
+double setmmwt(des,a,gam)
+design *des;
+double *a, gam;
+{ double ip, w0, w1, sw, wt;
+ int i;
+ sw = 0.0;
+ for (i=0; i<mm_lfd->n; i++)
+ { ip = innerprod(a,d_xi(des,i),des->p);
+ wt = prwt(mm_lfd,i);
+ w0 = ip - gam*des->wd[i];
+ w1 = ip + gam*des->wd[i];
+ des->w[i] = 0.0;
+ if (w0>0) { des->w[i] = w0; sw += wt*w0*w0; }
+ if (w1<0) { des->w[i] = w1; sw += wt*w1*w1; }
+ }
+ return(sw/2-a[0]);
+}
+
+/* compute sum_{w!=0} AA^T; e1-sum wA */
+int mmsums(coef,f,z,J)
+double *coef, *f, *z;
+jacobian *J;
+{ int i, j, p, sing;
+ double *A;
+
+mmsm_ct++;
+ A = J->Z;
+ *f = setmmwt(mm_des,coef,mm_gam);
+
+ p = mm_des->p;
+ setzero(A,p*p);
+ setzero(z,p);
+ z[0] = 1.0;
+
+ for (i=0; i<mm_lfd->n; i++)
+ if (mm_des->w[i]!=0.0)
+ { addouter(A,d_xi(mm_des,i),d_xi(mm_des,i),p,prwt(mm_lfd,i));
+ for (j=0; j<p; j++) z[j] -= prwt(mm_lfd,i)*mm_des->w[i]*mm_des->X[i*p+j];
+ }
+
+ J->st = JAC_RAW;
+ jacob_dec(J,JAC_EIGD);
+
+ sing = 0;
+ for (i=0; i<p; i++) sing |= (J->Z[i*p+i]<SINGTOL);
+ if ((debug) & (sing)) printf("SINGULAR!!!!\n");
+
+/* printf("%8.5f %8.5f %8.5f f %8.5f z %8.5f %8.5f\n",
+ coef[0],coef[1],mm_gam,*f,z[0],z[1]); */
+ return((sing) ? NR_SINGULAR : NR_OK);
+}
+
+double updatesd(des,z,p,a,a0,sw0,gam)
+design *des;
+int p;
+double *z, *a, *a0, sw0, gam;
+{ double f, sw, c0, c1, tmp[10];
+ int i, j, sd=0;
+
+if (debug) printf("updatesd\n");
+ for (i=0; i<p; i++) if (des->xtwx.Z[i*p+i]<SINGTOL) sd = i;
+ if (des->xtwx.dg[sd]>0)
+ for (i=0; i<p; i++) tmp[i] = des->xtwx.Q[p*i+sd]*des->xtwx.dg[i];
+ else
+ { for (i=0; i<p; i++) tmp[i] = 0.0;
+ tmp[sd] = 1.0;
+ }
+
+ mmsums(a0,&sw,z,&des->xtwx);
+
+ c0 = c1 = 0.0;
+ for (i=0; i<p; i++)
+ { c0 += tmp[i]*z[i];
+ for (j=0; j<p; j++)
+ c1 += tmp[i]*des->xtwx.Z[i*p+j]*tmp[j];
+ }
+if (debug) printf("sdir: c0 %8.5f c1 %8.5f z %8.5f %8.5f tmp %8.5f %8.5f\n",c0,c1,z[0],z[1],tmp[0],tmp[1]);
+ if (c0<0) for (i=0; i<p; i++) tmp[i] = -tmp[i];
+
+ f = 1.0;
+ for (i=0; i<p; i++) a[i] = a0[i]+tmp[i];
+ sw = setmmwt(des,a,gam);
+
+ if (sw<sw0) /* double till we drop */
+ { while(1)
+ { f *= 2;
+ sw0 = sw;
+ for (i=0; i<p; i++) a[i] = a0[i]+f*tmp[i];
+ sw = setmmwt(des,a,gam);
+ if (sw>sw0-CONVTOL) /* go back one step */
+ { f /= 2;
+ for (i=0; i<p; i++) a[i] = a0[i]+f*tmp[i];
+ sw0 = setmmwt(des,a,gam);
+ return(sw0);
+ }
+ }
+ }
+
+ /* halve till success */
+ while (1)
+ { f *= 0.5;
+ for (i=0; i<p; i++) a[i] = a0[i]+f*tmp[i];
+ sw = setmmwt(des,a,gam);
+ if (sw<sw0+CONVTOL) return(sw);
+ }
+}
+
+int mm_initial(des,z,p,coef)
+design *des;
+int p;
+double *z, *coef;
+{ int st;
+ double f;
+
+ setzero(coef,p);
+ coef[0] = 1;
+ while (1)
+ {
+ st = mmsums(coef,&f,z,&des->xtwx);
+ if (st==NR_OK) return(0);
+ coef[0] *= 2;
+ if (coef[0]>1e8) return(1);
+ }
+}
+
+int mmax(coef, old_coef, f1, delta, J, p, maxit, tol, err)
+double *coef, *old_coef, *f1, *delta, tol;
+int p, maxit, *err;
+jacobian *J;
+{ double f, old_f, lambda;
+ int i, j, fr, sing=0;
+
+ *err = NR_OK;
+ J->p = p;
+ J->st = JAC_RAW;
+ fr = mmsums(coef,&f,f1,J);
+
+ for (j=0; j<maxit; j++)
+ { memmove(old_coef,coef,p*sizeof(double));
+ old_f = f;
+
+ /* compute delta = Newton-Raphson increment */
+ /* jacob_dec(J,JAC_EIGD); */
+
+sing = (fr==NR_SINGULAR);
+
+ if (fr == NR_SINGULAR)
+ { J->st = JAC_RAW;
+if (j==0) printf("init singular\n");
+ f = updatesd(mm_des,delta,p,coef,old_coef,f,mm_gam);
+ fr = mmsums(coef,&f,f1,J);
+ }
+ else
+ {
+ jacob_solve(J,f1);
+ memmove(delta,f1,p*sizeof(double));
+/* printf("delta %8.5f %8.5f\n",f1[0],f1[1]); */
+ lambda = 1.0;
+ do
+ {
+ for (i=0; i<p; i++) coef[i] = old_coef[i] + lambda*delta[i];
+ J->st = JAC_RAW;
+ fr = mmsums(coef,&f,f1,J);
+
+ lambda = lambda/2.0;
+/* if (fr==NR_SINGULAR) printf("singular\n"); */
+ } while (((lambda>0.000000001) & (f > old_f+0.001)) /* | (fr==NR_SINGULAR) */ );
+
+ if (f>old_f+0.001) { printf("lambda prob\n"); *err = NR_NDIV; return(f); }
+
+ }
+ if (f==0.0)
+ { if (sing) printf("final singular - conv\n");
+ return(f);
+ }
+
+ if (debug)
+ { for (i=0; i<p; i++) printf("%8.5f ",coef[i]);
+ printf(" f %8.5f\n",f);
+ }
+
+ if ((j>0) & (fabs(f-old_f)<tol)) return(f);
+ }
+if (sing) printf("final singular\n");
+ WARN(("findab not converged"));
+ *err = NR_NCON;
+ return(f);
+}
+
+double findab(gam)
+double gam;
+{ double *coef, sl;
+ int i, p, nr_stat;
+
+ mm_gam = gam;
+ p = mm_des->p;
+
+ /* starting values for nr iteration */
+ coef = mm_des->cf;
+ for (i=0; i<p; i++) coef[i] = 0.0;
+ if (mm_initial(mm_des, mm_des->f1, p, coef))
+ { WARN(("findab: initial value divergence"));
+ return(0.0);
+ }
+ else
+ mmax(coef, mm_des->oc, mm_des->res, mm_des->f1,
+ &mm_des->xtwx, p, lf_maxit, CONVTOL, &nr_stat);
+
+ if (nr_stat != NR_OK) return(0.0);
+
+ sl = 0.0;
+ for (i=0; i<mm_lfd->n; i++) sl += fabs(mm_des->w[i])*mm_des->wd[i];
+
+ return(sl-gam);
+}
+
+double weightmm(coef,di,ff,gam)
+double *coef, di, *ff, gam;
+{ double y1, y2, ip;
+ ip = innerprod(ff,coef,mm_des->p);
+ y1 = ip-gam*di; if (y1>0) return(y1/ip);
+ y2 = ip+gam*di; if (y2<0) return(y2/ip);
+ return(0.0);
+}
+
+double minmax(lfd,des,sp)
+lfdata *lfd;
+design *des;
+smpar *sp;
+{ double h, u[MXDIM], gam;
+ int i, j, m, d1, p1, err_flag;
+
+ mm_lfd = lfd;
+ mm_des = des;
+
+mmsm_ct = 0;
+ d1 = deg(sp)+1;
+ p1 = factorial(d1);
+ for (i=0; i<lfd->n; i++)
+ { for (j=0; j<lfd->d; j++) u[j] = datum(lfd,j,i);
+ des->wd[i] = sp->nn/p1*ipower(des->di[i],d1);
+ des->ind[i] = i;
+ fitfun(lfd, sp, u,des->xev,d_xi(des,i),NULL);
+ }
+ /* designmatrix(lfd,sp,des); */
+
+/* find gamma (i.e. solve eqn 13.17 from book), using the secant method.
+ * As a side effect, this finds the other minimax coefficients.
+ * Note that 13.17 is rewritten as
+ * g2 = sum |l_i(x)| (||xi-x||^(p+1) M/(s*(p+1)!))
+ * where g2 = gamma * s * (p+1)! / M. The gam variable below is g2.
+ * The smoothing parameter is sp->nn == M/s.
+ */
+ gam = solve_secant(findab, 0.0, 0.0,1.0, 0.0000001, BDF_EXPRIGHT, &err_flag);
+
+/*
+ * Set the smoothing weights, in preparation for the actual fit.
+ */
+ h = 0.0; m = 0;
+ for (i=0; i<lfd->n; i++)
+ { des->w[m] = weightmm(des->cf, des->wd[i],d_xi(des,i),gam);
+ if (des->w[m]>0)
+ { if (des->di[i]>h) h = des->di[i];
+ des->ind[m] = i;
+ m++;
+ }
+ }
+ des->n = m;
+ return(h);
+}
diff --git a/src/mutil.h b/src/mutil.h
new file mode 100755
index 0000000..f1f338d
--- /dev/null
+++ b/src/mutil.h
@@ -0,0 +1,103 @@
+/*
+ * Copyright (c) 1998-2000 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Headers for math utility functions.
+ */
+
+#ifndef I_MUT_H
+#define I_MUT_H
+
+#include <math.h>
+
+typedef struct {
+ double *Z; /* jacobian matrix, length p*p */
+ double *Q; /* eigenvalue matrix, length p*p */
+ double *wk; /* work vector in eig_solve, length p */
+ double *dg; /* diag vector in eigd, length p */
+ int p; /* dimension */
+ int st; /* status */
+ int sm; /* requested decomposition */
+} jacobian;
+
+/* m_jacob.c */
+extern int jac_reqd();
+extern double *jac_alloc();
+extern void jacob_dec(), chol_dec(), eig_dec();
+extern int jacob_solve(), chol_solve(), eig_solve();
+extern int jacob_hsolve(),chol_hsolve(),eig_hsolve();
+extern double jacob_qf(), chol_qf(), eig_qf();
+
+/* m_max.c */
+extern double max_grid(), max_golden(), max_quad(), max_nr();
+
+/* m_qr.c */
+extern void qr(), qrinvx(), qrtinvx(), qrsolv();
+
+/* m_svd.c */
+extern void svd(), hsvdsolve();
+extern int svdsolve();
+
+/* m_solve.c */
+extern double solve_secant(), solve_nr(), solve_fp();
+
+/* m_vector.c */
+extern void setzero(), unitvec(), addouter(), multmatscal(), transpose();
+extern double innerprod(), m_trace();
+
+#define BDF_NONE 0
+#define BDF_EXPLEFT 1
+#define BDF_EXPRIGHT 2
+
+/* return codes for functions optimized by max_nr */
+#define NR_OK 0
+#define NR_INVALID 1
+#define NR_BREAK 2
+#define NR_REDUCE 3
+#define NR_NCON 10
+#define NR_NDIV 11
+
+
+/* jacobian status definitions */
+#define JAC_RAW 0
+#define JAC_CHOL 1
+#define JAC_EIG 2
+#define JAC_EIGD 3
+
+/* Numerical Integration Stuff
+ */
+#define MXRESULT 5
+#define MXIDIM 10 /* max. dimension */
+extern void simpsonm(), simpson4(), integ_disc(), integ_circ();
+extern void integ_sphere(), monte(), rn3();
+extern double simpson(), sptarea();
+
+/* Density, distribution stuff
+ */
+
+#ifndef PI
+#define PI 3.141592653589793238462643
+#endif
+#define PIx2 6.283185307179586476925286 /* 2*pi */
+#define HF_LG_PIx2 0.918938533204672741780329736406 /* 0.5*log(2*pi) */
+#define SQRT2 1.4142135623730950488
+
+#define LOG_ZERO -1e100
+#define D_0 ((give_log) ? LOG_ZERO : 0.0)
+#define D_1 ((give_log) ? 0.0 : 1.0)
+#define DEXP(x) ((give_log) ? (x) : exp(x))
+#define FEXP(f,x) ((give_log) ? -0.5*log(f)+(x) : exp(x)/sqrt(f))
+
+#define INVALID_PARAMS 0.0
+
+extern double stirlerr(), bd0();
+extern double dbinom_raw(), dpois_raw();
+extern double dbinom(), dpois(), dnbinom(), dbeta(), dgamma(), dt(), df(), dhyper();
+extern double dchisq();
+
+extern double igamma(), ibeta();
+extern double pf(), pchisq(), mut_pnorm();
+#define pchisq(x,df) igamma((x)/2.0,(df)/2.0)
+
+#endif /* define I_MUT_H */
diff --git a/src/pcomp.c b/src/pcomp.c
new file mode 100755
index 0000000..f919368
--- /dev/null
+++ b/src/pcomp.c
@@ -0,0 +1,194 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * functions for computing and subtracting, adding the
+ * parametric component
+ */
+
+#include "local.h"
+
+int noparcomp(sp,geth)
+smpar *sp;
+int geth;
+{ int tg;
+ if (geth==GSMP) return(1);
+ if (deg0(sp)<deg(sp)) return(1);
+ if (ubas(sp)) return(1);
+ tg = fam(sp) & 63;
+ if (tg<=THAZ) return(1);
+ if (tg==TROBT) return(1);
+ if (tg==TCAUC) return(1);
+ return(0);
+}
+
+int pc_reqd(d,p)
+int d, p;
+{ return(d + 2*p + jac_reqd(p));
+}
+
+void pcchk(pc,d,p,lc)
+paramcomp *pc;
+int d, p, lc;
+{ int rw;
+ double *z;
+
+ rw = pc_reqd(d,p);
+ if (pc->lwk < rw)
+ { pc->wk = (double *)calloc(rw,sizeof(double));
+ pc->lwk= rw;
+ }
+ z = pc->wk;
+
+ pc->xbar = z; z += d;
+ pc->coef = z; z += p;
+ pc->f = z; z += p;
+
+ z = jac_alloc(&pc->xtwx,p,z);
+ pc->xtwx.p = p;
+}
+
+void compparcomp(des,lfd,sp,pc,geth,nopc)
+design *des;
+lfdata *lfd;
+smpar *sp;
+paramcomp *pc;
+int geth;
+int nopc;
+{ int i, j, k, p;
+ double wt, sw;
+
+ if (lf_debug>1) printf(" compparcomp:\n");
+ p = des->p;
+ pcchk(pc,lfd->d,p,1);
+
+ for (i=0; i<lfd->d; i++) pc->xbar[i] = 0.0;
+ sw = 0.0;
+ for (i=0; i<lfd->n; i++)
+ {
+ wt = prwt(lfd,i);
+ sw += wt;
+ for (j=0; j<lfd->d; j++)
+ pc->xbar[j] += datum(lfd,j,i)*wt;
+ des->ind[i] = i;
+ des->w[i] = 1.0;
+ }
+ for (i=0; i<lfd->d; i++) pc->xbar[i] /= sw;
+ if ((nopc) || noparcomp(sp,geth))
+ { haspc(pc) = 0;
+ return;
+ }
+ haspc(pc) = 1;
+ des->xev = pc->xbar;
+ k = locfit(lfd,des,sp,0,0,0);
+ if (lf_error) return;
+ switch(k)
+ { case LF_NOPT:
+ ERROR(("compparcomp: no points in dataset?"));
+ return;
+ case LF_INFA:
+ ERROR(("compparcomp: infinite parameters in param. component"));
+ return;
+ case LF_NCON:
+ ERROR(("compparcom: not converged"));
+ return;
+ case LF_OOB:
+ ERROR(("compparcomp: parameters out of bounds"));
+ return;
+ case LF_PF:
+ WARN(("compparcomp: perfect fit"));
+ case LF_OK:
+ for (i=0; i<p; i++)
+ { pc->coef[i] = des->cf[i];
+ pc->xtwx.dg[i] = des->xtwx.dg[i];
+ pc->xtwx.wk[i] = des->xtwx.wk[i];
+ }
+ for (i=0; i<p*p; i++)
+ { pc->xtwx.Z[i] = des->xtwx.Z[i];
+ pc->xtwx.Q[i] = des->xtwx.Q[i];
+ }
+ pc->xtwx.sm = des->xtwx.sm;
+ pc->xtwx.st = des->xtwx.st;
+ return;
+ default:
+ ERROR(("compparcomp: locfit unknown return status %d",k));
+ return;
+ }
+}
+
+void subparcomp(des,lf,coef)
+design *des;
+lfit *lf;
+double *coef;
+{ int i, nd;
+ deriv *dv;
+ paramcomp *pc;
+
+ pc = &lf->pc;
+ if (!haspc(pc)) return;
+
+ dv = &lf->dv; nd = dv->nd;
+ fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,des->f1,dv);
+ coef[0] -= innerprod(pc->coef,des->f1,pc->xtwx.p);
+ if (des->ncoef == 1) return;
+
+ dv->nd = nd+1;
+ for (i=0; i<lf->lfd.d; i++)
+ { dv->deriv[nd] = i;
+ fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,des->f1,dv);
+ coef[i+1] -= innerprod(pc->coef,des->f1,pc->xtwx.p);
+ }
+ dv->nd = nd;
+}
+
+void subparcomp2(des,lf,vr,il)
+design *des;
+lfit *lf;
+double *vr, *il;
+{ double t0, t1;
+ int i, nd;
+ deriv *dv;
+ paramcomp *pc;
+
+ pc = &lf->pc;
+ if (!haspc(pc)) return;
+
+ dv = &lf->dv; nd = dv->nd;
+
+ fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,des->f1,dv);
+ for (i=0; i<npar(&lf->sp); i++) pc->f[i] = des->f1[i];
+ jacob_solve(&pc->xtwx,des->f1);
+ t0 = sqrt(innerprod(pc->f,des->f1,pc->xtwx.p));
+ vr[0] -= t0;
+ il[0] -= t0;
+ if ((t0==0) | (des->ncoef==1)) return;
+
+ dv->nd = nd+1;
+ for (i=0; i<lf->lfd.d; i++)
+ { dv->deriv[nd] = i;
+ fitfun(&lf->lfd, &lf->sp, des->xev,pc->xbar,pc->f,dv);
+ t1 = innerprod(pc->f,des->f1,pc->xtwx.p)/t0;
+ vr[i+1] -= t1;
+ il[i+1] -= t1;
+ }
+ dv->nd = nd;
+}
+
+double addparcomp(lf,x,c)
+lfit *lf;
+double *x;
+int c;
+{ double y;
+ paramcomp *pc;
+
+ pc = &lf->pc;
+ if (!haspc(pc)) return(0.0);
+ fitfun(&lf->lfd, &lf->sp, x,pc->xbar,pc->f,&lf->dv);
+ if (c==PCOEF) return(innerprod(pc->coef,pc->f,pc->xtwx.p));
+ if ((c==PNLX)|(c==PT0)|(c==PVARI))
+ { y = sqrt(jacob_qf(&pc->xtwx,pc->f));
+ return(y);
+ }
+ return(0.0);
+}
diff --git a/src/preplot.c b/src/preplot.c
new file mode 100755
index 0000000..dba2218
--- /dev/null
+++ b/src/preplot.c
@@ -0,0 +1,138 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+/*
+ preplot(): interpolates the fit to a new set of points.
+ lf -- the fit structure.
+ x -- the points to predict at.
+ f -- vector to return the predictions.
+ se -- vector to return std errors (NULL if not req'd)
+ band-- char for conf band type. ('n'=none, 'g'=global etc.)
+ n -- no of predictions (or vector of margin lengths for grid)
+ where -- where to predict:
+ 1 = points in the array x.
+ 2 = grid defined by margins in x.
+ 3 = data points from lf (ignore x).
+ 4 = fit points from lf (ignore x).
+ what -- what to predict.
+ (PCOEF etc; see lfcons.h file)
+
+*/
+
+static char cb;
+double *sef, *fit, sigmahat;
+
+void predptall(lf,x,what,ev,i)
+lfit *lf;
+double *x;
+int what, ev, i;
+{ double lik, rdf;
+ fit[i] = dointpoint(lf,x,what,ev,i);
+ if (cb=='n') return;
+ sef[i] = dointpoint(lf,x,PNLX,ev,i);
+ if (cb=='g')
+ { sef[i] *= sigmahat;
+ return;
+ }
+ if (cb=='l')
+ { lik = dointpoint(lf,x,PLIK,ev,i);
+ rdf = dointpoint(lf,x,PRDF,ev,i);
+ sef[i] *= sqrt(-2*lik/rdf);
+ return;
+ }
+ if (cb=='p')
+ { sef[i] = sigmahat*sqrt(1+sef[i]*sef[i]);
+ return;
+ }
+}
+
+void prepvector(lf,x,n,what) /* interpolate a vector */
+lfit *lf;
+double **x;
+int n, what;
+{ int i, j;
+ double xx[MXDIM];
+ for (i=0; i<n; i++)
+ { for (j=0; j<lf->fp.d; j++) xx[j] = x[j][i];
+ predptall(lf,xx,what,ev(&lf->evs),i);
+ if (lf_error) return;
+ }
+}
+
+void prepfitp(lf,what)
+lfit *lf;
+int what;
+{ int i;
+ for (i=0; i<lf->fp.nv; i++)
+ { predptall(lf,evpt(&lf->fp,i),what,EFITP,i);
+ if (lf_error) return;
+ }
+}
+
+void prepgrid(lf,x,mg,n,what) /* interpolate a grid given margins */
+lfit *lf;
+double **x;
+Sint *mg;
+int n, what;
+{ int i, ii, j, d;
+ double xv[MXDIM];
+ d = lf->fp.d;
+ for (i=0; i<n; i++)
+ { ii = i;
+ for (j=0; j<d; j++)
+ { xv[j] = x[j][ii%mg[j]];
+ ii /= mg[j];
+ }
+ predptall(lf,xv,what,ev(&lf->evs),i);
+ if (lf_error) return;
+ }
+}
+
+void preplot(lf,x,f,se,band,mg,where,what)
+lfit *lf;
+double **x, *f, *se;
+Sint *mg;
+int where, what;
+char band;
+{ int d, i, n=0;
+ double *xx[MXDIM];
+ d = lf->fp.d;
+ fit = f;
+ sef = se;
+ cb = band;
+ if (cb!='n') sigmahat = sqrt(rv(&lf->fp));
+
+ switch(where)
+ { case 1: /* vector */
+ n = mg[0];
+ prepvector(lf,x,n,what);
+ break;
+ case 2: /* grid */
+ n = 1;
+ for (i=0; i<d; i++) n *= mg[i];
+ prepgrid(lf,x,mg,n,what);
+ break;
+ case 3: /* data */
+ n = lf->lfd.n;
+ if ((ev(&lf->evs)==EDATA) | (ev(&lf->evs)==ECROS))
+ prepfitp(lf,what);
+ else
+ { for (i=0; i<d; i++) xx[i] = dvari(&lf->lfd,i);
+ prepvector(lf,xx,n,what);
+ }
+ break;
+ case 4: /* fit points */
+ n = lf->fp.nv;
+ prepfitp(lf,what);
+ break;
+ default:
+ ERROR(("unknown where in preplot"));
+ }
+
+ if ((what==PT0)|(what==PVARI))
+ for (i=0; i<n; i++) f[i] = f[i]*f[i];
+}
diff --git a/src/prob.c b/src/prob.c
new file mode 100755
index 0000000..d590b8e
--- /dev/null
+++ b/src/prob.c
@@ -0,0 +1,143 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "mutil.h"
+
+#define LOG_2 0.6931471805599453094172321214581765680755
+#define IBETA_LARGE 1.0e30
+#define IBETA_SMALL 1.0e-30
+#define IGAMMA_LARGE 1.0e30
+#define DOUBLE_EP 2.2204460492503131E-16
+
+double ibeta(x, a, b)
+double x, a, b;
+{ int flipped = 0, i, k, count;
+ double I = 0, temp, pn[6], ak, bk, next, prev, factor, val;
+ if (x <= 0) return(0);
+ if (x >= 1) return(1);
+/* use ibeta(x,a,b) = 1-ibeta(1-x,b,z) */
+ if ((a+b+1)*x > (a+1))
+ { flipped = 1;
+ temp = a;
+ a = b;
+ b = temp;
+ x = 1 - x;
+ }
+ pn[0] = 0.0;
+ pn[2] = pn[3] = pn[1] = 1.0;
+ count = 1;
+ val = x/(1.0-x);
+ bk = 1.0;
+ next = 1.0;
+ do
+ { count++;
+ k = count/2;
+ prev = next;
+ if (count%2 == 0)
+ ak = -((a+k-1.0)*(b-k)*val)/((a+2.0*k-2.0)*(a+2.0*k-1.0));
+ else
+ ak = ((a+b+k-1.0)*k*val)/((a+2.0*k)*(a+2.0*k-1.0));
+ pn[4] = bk*pn[2] + ak*pn[0];
+ pn[5] = bk*pn[3] + ak*pn[1];
+ next = pn[4] / pn[5];
+ for (i=0; i<=3; i++)
+ pn[i] = pn[i+2];
+ if (fabs(pn[4]) >= IBETA_LARGE)
+ for (i=0; i<=3; i++)
+ pn[i] /= IBETA_LARGE;
+ if (fabs(pn[4]) <= IBETA_SMALL)
+ for (i=0; i<=3; i++)
+ pn[i] /= IBETA_SMALL;
+ } while (fabs(next-prev) > DOUBLE_EP*prev);
+ /* factor = a*log(x) + (b-1)*log(1-x);
+ factor -= LGAMMA(a+1) + LGAMMA(b) - LGAMMA(a+b); */
+ factor = dbeta(x,a,b,1) + log(x/a);
+ I = exp(factor) * next;
+ return(flipped ? 1-I : I);
+}
+
+/*
+ * Incomplete gamma function.
+ * int_0^x u^{df-1} e^{-u} du / Gamma(df).
+ */
+double igamma(x, df)
+double x, df;
+{ double factor, term, gintegral, pn[6], rn, ak, bk;
+ int i, count, k;
+ if (x <= 0.0) return(0.0);
+
+ if (df < 1.0)
+ return( dgamma(x,df+1.0,1.0,0) + igamma(x,df+1.0) );
+
+ factor = x * dgamma(x,df,1.0,0);
+ /* factor = exp(df*log(x) - x - lgamma(df)); */
+
+ if (x > 1.0 && x >= df)
+ {
+ pn[0] = 0.0;
+ pn[2] = pn[1] = 1.0;
+ pn[3] = x;
+ count = 1;
+ rn = 1.0 / x;
+ do
+ { count++;
+ k = count / 2;
+ gintegral = rn;
+ if (count%2 == 0)
+ { bk = 1.0;
+ ak = (double)k - df;
+ } else
+ { bk = x;
+ ak = (double)k;
+ }
+ pn[4] = bk*pn[2] + ak*pn[0];
+ pn[5] = bk*pn[3] + ak*pn[1];
+ rn = pn[4] / pn[5];
+ for (i=0; i<4; i++)
+ pn[i] = pn[i+2];
+ if (pn[4] > IGAMMA_LARGE)
+ for (i=0; i<4; i++)
+ pn[i] /= IGAMMA_LARGE;
+ } while (fabs(gintegral-rn) > DOUBLE_EP*rn);
+ gintegral = 1.0 - factor*rn;
+ }
+ else
+ { /* For x<df, use the series
+ * dpois(df,x)*( 1 + x/(df+1) + x^2/((df+1)(df+2)) + ... )
+ * This could be slow if df large and x/df is close to 1.
+ */
+ gintegral = term = 1.0;
+ rn = df;
+ do
+ { rn += 1.0;
+ term *= x/rn;
+ gintegral += term;
+ } while (term > DOUBLE_EP*gintegral);
+ gintegral *= factor/df;
+ }
+ return(gintegral);
+}
+
+double pf(q, df1, df2)
+double q, df1, df2;
+{ return(ibeta(q*df1/(df2+q*df1), df1/2, df2/2));
+}
+
+#ifdef RVERSION
+extern double Rf_pnorm5();
+double mut_pnorm(x,mu,s)
+double x, mu, s;
+{ return(Rf_pnorm5(x, mu, s, 1L, 0L));
+}
+#else
+double mut_pnorm(x,mu,s)
+double x, mu, s;
+{ if(x == mu)
+ return(0.5);
+ x = (x-mu)/s;
+ if(x > 0) return((1 + erf(x/SQRT2))/2);
+ return(erfc(-x/SQRT2)/2);
+}
+#endif
diff --git a/src/procv.c b/src/procv.c
new file mode 100755
index 0000000..adcdb48
--- /dev/null
+++ b/src/procv.c
@@ -0,0 +1,227 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+extern double robscale;
+
+double vocri(lk,t0,t2,pen)
+double lk, t0, t2, pen;
+{ if (pen==0) return(-2*t0*lk/((t0-t2)*(t0-t2)));
+ return((-2*lk+pen*t2)/t0);
+}
+
+int procvraw(des,lf,v)
+design *des;
+lfit *lf;
+int v;
+{ int i, lf_status;
+ double coef[1+MXDIM];
+
+ if (lf_debug>1) printf(" procvraw: %d\n",v);
+ des->xev = evpt(&lf->fp,v);
+
+ if (acri(&lf->sp)==ANONE)
+ lf_status = locfit(&lf->lfd,des,&lf->sp,0,1,0);
+ else
+ lf_status = alocfit(&lf->lfd,&lf->sp,&lf->dv,des);
+
+ lf->fp.h[v] = des->h;
+ for (i=0; i<des->ncoef; i++) coef[i] = des->cf[cfn(des,i)];
+
+ if (!lf_error)
+ { if (dc(&lf->fp)) dercor(&lf->lfd,&lf->sp,des,coef);
+ subparcomp(des,lf,coef);
+ for (i=0; i<des->ncoef; i++) lf->fp.coef[i*lf->fp.nvm+v] = coef[i];
+ }
+
+ lf->fp.deg[v] = deg(&lf->sp);
+
+ return(lf_status);
+}
+
+/*
+ * Set default values for the likelihood e.t.c. This
+ * is called in cases where the optimization for the fit
+ * has failed.
+ */
+
+void set_default_like(fp,v)
+fitpt *fp;
+int v;
+{ int i, nvm, d;
+ nvm = fp->nvm;
+ d = fp->d;
+ fp->lik[v] = fp->lik[nvm+v] = 0;
+ fp->lik[2*nvm+v] = 0; /* should use sum of weights here? */
+ for (i=0; i<=d; i++)
+ fp->t0[i*nvm+v] = fp->nlx[i*nvm+v] = 0.0;
+}
+
+int procv(des,lf,v)
+design *des;
+lfit *lf;
+int v;
+{ int d, p, nvm, i, k;
+ double trc[6], t0[1+MXDIM], vari[1+MXDIM];
+ k = procvraw(des,lf,v);
+ if (lf_error) return(k);
+
+ d = lf->lfd.d;
+ p = npar(&lf->sp);
+ nvm = lf->fp.nvm;
+
+ switch(k)
+ { case LF_OK: break;
+ case LF_NCON:
+ WARN(("procv: locfit did not converge"));
+ break;
+ case LF_OOB:
+ WARN(("procv: parameters out of bounds"));
+ break;
+ case LF_PF:
+ if (lf_debug>1) WARN(("procv: perfect fit"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ case LF_NOPT:
+ WARN(("procv: no points with non-zero weight"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ case LF_INFA:
+ if (lf_debug>1) WARN(("procv: initial value problem"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ case LF_DEMP:
+ WARN(("procv: density estimate, empty integration region"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ case LF_XOOR:
+ WARN(("procv: fit point outside xlim region"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ case LF_DNOP:
+ if (lf_debug>1)
+ WARN(("density estimation -- insufficient points in smoothing window"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ case LF_FPROB:
+ WARN(("procv: f problem; likelihood failure"));
+ set_default_like(&lf->fp,v);
+ return(k);
+ default:
+ WARN(("procv: unknown return code %d",k));
+ set_default_like(&lf->fp,v);
+ return(k);
+ }
+
+ comp_vari(&lf->lfd,&lf->sp,des,trc,t0);
+ lf->fp.lik[v] = des->llk;
+ lf->fp.lik[nvm+v] = trc[2];
+ lf->fp.lik[2*nvm+v] = trc[0]-trc[2];
+
+ for (i=0; i<des->ncoef; i++)
+ vari[i] = des->V[p*cfn(des,0) + cfn(des,i)];
+ vari[0] = sqrt(vari[0]);
+ if (vari[0]>0) for (i=1; i<des->ncoef; i++) vari[i] /= vari[0];
+ t0[0] = sqrt(t0[0]);
+ if (t0[0]>0) for (i=1; i<des->ncoef; i++) t0[i] /= t0[0];
+
+ subparcomp2(des,lf,vari,t0);
+ for (i=0; i<des->ncoef; i++)
+ { lf->fp.nlx[i*nvm+v] = vari[i];
+ lf->fp.t0[i*nvm+v] = t0[i];
+ }
+
+ return(k);
+}
+
+double intvo(des,lf,c0,c1,a,p,t0,t20,t21)
+design *des;
+lfit *lf;
+double *c0, *c1, a, t0, t20, t21;
+int p;
+{ double th, lk, link[LLEN];
+ int i;
+ lk = 0;
+ for (i=0; i<des->n; i++)
+ { th = (1-a)*innerprod(c0,&des->X[i*p],p) + a*innerprod(c1,&des->X[i*p],p);
+ stdlinks(link,&lf->lfd,&lf->sp,(int)des->ind[i],th,robscale);
+ lk += des->w[i]*link[ZLIK];
+ }
+ des->llk = lk;
+ return(vocri(des->llk,t0,(1-a)*t20+a*t21,pen(&lf->sp)));
+}
+
+int procvvord(des,lf,v)
+design *des;
+lfit *lf;
+int v;
+{ double tr[6], gcv, g0, ap, coef[4][10], t2[4], th, md=0.0;
+ int i, j, k=0, d1, i0, p1, ip;
+ des->xev = evpt(&lf->fp,v);
+
+ ap = pen(&lf->sp);
+ if ((ap==0) & ((fam(&lf->sp)&63)!=TGAUS)) ap = 2.0;
+ d1 = deg(&lf->sp); p1 = npar(&lf->sp);
+ for (i=0; i<p1; i++) coef[0][i] = coef[1][i] = coef[2][i] = coef[3][i] = 0.0;
+ i0 = 0; g0 = 0;
+ ip = 1;
+
+ for (i=deg0(&lf->sp); i<=d1; i++)
+ { deg(&lf->sp) = i;
+ des->p = npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
+ k = locfit(&lf->lfd,des,&lf->sp,0, i==deg0(&lf->sp),0);
+
+ local_df(&lf->lfd,&lf->sp,des,tr);
+ gcv = vocri(des->llk,tr[0],tr[2],ap);
+ if ((i==deg0(&lf->sp)) || (gcv<g0)) { i0 = i; g0 = gcv; md = i; }
+
+ for (j=0; j<des->p; j++) coef[i][j] = des->cf[j];
+ t2[i] = tr[2];
+
+#ifdef RESEARCH
+printf("variable order\n");
+ if ((ip) && (i>deg0(&lf->sp)))
+ { for (j=1; j<10; j++)
+ { gcv = intvo(des,lf,coef[i-1],coef[i],j/10.0,des->p,tr[0],t2[i-1],t2[i]);
+ if (gcv<g0) { g0 = gcv; md = i-1+j/10.0; }
+ }
+ }
+#endif
+ }
+ lf->fp.h[v] = des->h;
+ if (lf->fp.h[v]<=0) WARN(("zero bandwidth in procvvord"));
+
+ if (i0<d1) /* recompute the best fit */
+ { deg(&lf->sp) = i0;
+ des->p = npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
+ k = locfit(&lf->lfd,des,&lf->sp,0,0,0);
+ for (i=npar(&lf->sp); i<p1; i++) des->cf[i] = 0.0;
+ i0 = md; if (i0==d1) i0--;
+ th = md-i0;
+ for (i=0; i<p1; i++) des->cf[i] = (1-th)*coef[i0][i]+th*coef[i0+1][i];
+ deg(&lf->sp) = d1; npar(&lf->sp) = p1;
+ }
+
+ for (i=0; i<p1; i++) lf->fp.coef[i*lf->fp.nvm+v] = des->cf[i];
+ lf->fp.deg[v] = md;
+ return(k);
+}
+
+int procvhatm(des,lf,v)
+design *des;
+lfit *lf;
+int v;
+{ int k=0;
+ double *l;
+ l = &lf->fp.L[v*lf->lfd.n];
+ if ((ker(&lf->sp)!=WPARM) | (!haspc(&lf->pc)))
+ { k = procvraw(des,lf,v);
+ wdiag(&lf->lfd,&lf->sp,des,l,&lf->dv,0,1,1);
+ }
+ else
+ wdiagp(&lf->lfd,&lf->sp,des,l,&lf->pc,&lf->dv,0,1,1);
+ return(k);
+}
diff --git a/src/scb.c b/src/scb.c
new file mode 100755
index 0000000..dc4dd44
--- /dev/null
+++ b/src/scb.c
@@ -0,0 +1,294 @@
+#include "local.h"
+static double scb_crit, *x, c[10], kap[5], kaq[5], max_p2;
+/* static int side, type; */
+static int type;
+design *scb_des;
+
+double covar_par(lf,des,x1,x2)
+lfit *lf;
+design *des;
+double x1, x2;
+{ double *v1, *v2, *wk;
+ paramcomp *pc;
+ int i, j, p, ispar;
+
+ v1 = des->f1; v2 = des->ss; wk = des->oc;
+ ispar = (ker(&lf->sp)==WPARM) && (haspc(&lf->pc));
+ p = npar(&lf->sp);
+
+/* for parametric models, the covariance is
+ * A(x1)^T (X^T W V X)^{-1} A(x2)
+ * which we can find easily from the parametric component.
+ */
+ if (ispar)
+ { pc = &lf->pc;
+ fitfun(&lf->lfd, &lf->sp, &x1,pc->xbar,v1,NULL);
+ fitfun(&lf->lfd, &lf->sp, &x2,pc->xbar,v2,NULL);
+ jacob_hsolve(&lf->pc.xtwx,v1);
+ jacob_hsolve(&lf->pc.xtwx,v2);
+ }
+
+/* for non-parametric models, we must use the cholseky decomposition
+ * of M2 = X^T W^2 V X. Courtesy of comp_vari, we already have
+ * des->P = M2^{1/2} M1^{-1}.
+ */
+ if (!ispar)
+ { fitfun(&lf->lfd, &lf->sp, &x1,des->xev,wk,NULL);
+ for (i=0; i<p; i++)
+ { v1[i] = 0;
+ for (j=0; j<p; j++) v1[i] += des->P[i*p+j]*wk[j];
+ }
+ fitfun(&lf->lfd, &lf->sp, &x2,des->xev,wk,NULL);
+ for (i=0; i<p; i++)
+ { v2[i] = 0;
+ for (j=0; j<p; j++) v2[i] += des->P[i*p+j]*wk[j];
+ }
+ }
+
+ return(innerprod(v1,v2,p));
+}
+
+void cumulant(lf,des,sd)
+lfit *lf;
+design *des;
+double sd;
+{ double b2i, b3i, b3j, b4i;
+ double ss, si, sj, uii, uij, ujj, k1;
+ int ii, i, j, jj;
+ for (i=1; i<10; i++) c[i] = 0.0;
+ k1 = 0;
+
+ /* ss = sd*sd; */
+ ss = covar_par(lf,des,des->xev[0],des->xev[0]);
+
+/*
+ * this isn't valid for nonparametric models. At a minimum,
+ * the sums would have to include weights. Still have to work
+ * out the right way.
+ */
+ for (i=0; i<lf->lfd.n; i++)
+ { ii = des->ind[i];
+ b2i = b2(des->th[i],fam(&lf->sp),prwt(&lf->lfd,ii));
+ b3i = b3(des->th[i],fam(&lf->sp),prwt(&lf->lfd,ii));
+ b4i = b4(des->th[i],fam(&lf->sp),prwt(&lf->lfd,ii));
+ si = covar_par(lf,des,des->xev[0],datum(&lf->lfd,0,ii));
+ uii= covar_par(lf,des,datum(&lf->lfd,0,ii),datum(&lf->lfd,0,ii));
+ if (lf_error) return;
+
+ c[2] += b4i*si*si*uii;
+ c[6] += b4i*si*si*si*si;
+ c[7] += b3i*si*uii;
+ c[8] += b3i*si*si*si;
+ /* c[9] += b2i*si*si*si*si;
+ c[9] += b2i*b2i*si*si*si*si; */
+ k1 += b3i*si*(si*si/ss-uii);
+
+ /* i=j components */
+ c[1] += b3i*b3i*si*si*uii*uii;
+ c[3] += b3i*b3i*si*si*si*si*uii;
+ c[4] += b3i*b3i*si*si*uii*uii;
+
+ for (j=i+1; j<lf->lfd.n; j++)
+ { jj = des->ind[j];
+ b3j = b3(des->th[j],fam(&lf->sp),prwt(&lf->lfd,jj));
+ sj = covar_par(lf,des,des->xev[0],datum(&lf->lfd,0,jj));
+ uij= covar_par(lf,des,datum(&lf->lfd,0,ii),datum(&lf->lfd,0,jj));
+ ujj= covar_par(lf,des,datum(&lf->lfd,0,jj),datum(&lf->lfd,0,jj));
+
+ c[1] += 2*b3i*b3j*si*sj*uij*uij;
+ c[3] += 2*b3i*b3j*si*si*sj*sj*uij;
+ c[4] += b3i*b3j*uij*(si*si*ujj+sj*sj*uii);
+ if (lf_error) return;
+ }
+ }
+ c[5] = c[1];
+ c[7] = c[7]*c[8];
+ c[8] = c[8]*c[8];
+
+ c[1] /= ss; c[2] /= ss; c[3] /= ss*ss; c[4] /= ss;
+ c[5] /= ss; c[6] /= ss*ss; c[7] /= ss*ss;
+ c[8] /= ss*ss*ss; c[9] /= ss*ss;
+
+/* constants used in p(x,z) computation */
+ kap[1] = k1/(2*sqrt(ss));
+ kap[2] = 1 + 0.5*(c[1]-c[2]+c[4]-c[7]) - 3*c[3] + c[6] + 1.75*c[8];
+ kap[4] = -9*c[3] + 3*c[6] + 6*c[8] + 3*c[9];
+
+/* constants used in q(x,u) computation */
+ kaq[2] = c[3] - 1.5*c[8] - c[5] - c[4] + 0.5*c[7] + c[6] - c[2];
+ kaq[4] = -3*c[3] - 6*c[4] - 6*c[5] + 3*c[6] + 3*c[7] - 3*c[8] + 3*c[9];
+}
+
+/* q2(u) := u+q2(x,u) in paper */
+double q2(u)
+double u;
+{ return(u-u*(36.0*kaq[2] + 3*kaq[4]*(u*u-3) + c[8]*((u*u-10)*u*u+15))/72.0);
+}
+
+/* p2(u) := p2(x,u) in paper */
+double p2(u)
+double u;
+{ return( -u*( 36*(kap[2]-1+kap[1]*kap[1])
+ + 3*(kap[4]+4*kap[1]*sqrt(kap[3]))*(u*u-3)
+ + c[8]*((u*u-10)*u*u+15) ) / 72 );
+}
+
+extern int likereg();
+double gldn_like(a)
+double a;
+{ int err;
+
+ scb_des->fix[0] = 1;
+ scb_des->cf[0] = a;
+ max_nr(likereg, scb_des->cf, scb_des->oc, scb_des->res, scb_des->f1,
+ &scb_des->xtwx, scb_des->p, lf_maxit, 1.0e-6, &err);
+ scb_des->fix[0] = 0;
+
+ return(scb_des->llk);
+}
+
+/* v1/v2 is correct for deg=0 only */
+void get_gldn(fp,des,lo,hi,v)
+fitpt *fp;
+design *des;
+double *lo, *hi;
+int v;
+{ double v1, v2, c, tlk;
+ int err;
+
+ v1 = fp->nlx[v];
+ v2 = fp->t0[v];
+ c = scb_crit * v1 / v2;
+ tlk = des->llk - c*c/2;
+printf("v %8.5f %8.5f c %8.5f tlk %8.5f llk %8.5f\n",v1,v2,c,tlk,des->llk);
+
+ /* want: { a : l(a) >= l(a-hat) - c*c/2 } */
+ lo[v] = fp->coef[v] - scb_crit*v1;
+ hi[v] = fp->coef[v] + scb_crit*v1;
+
+ err = 0;
+
+printf("lo %2d\n",v);
+ lo[v] = solve_secant(gldn_like,tlk,lo[v],fp->coef[v],1e-8,BDF_EXPLEFT,&err);
+ if (err>0) printf("solve_secant error\n");
+printf("hi %2d\n",v);
+ hi[v] = solve_secant(gldn_like,tlk,fp->coef[v],hi[v],1e-8,BDF_EXPRIGHT,&err);
+ if (err>0) printf("solve_secant error\n");
+}
+
+int procvscb2(des,lf,v)
+design *des;
+lfit *lf;
+int v;
+{ double thhat, sd, *lo, *hi, u;
+ int err, st, tmp;
+ x = des->xev = evpt(&lf->fp,v);
+ tmp = haspc(&lf->pc);
+ /* if ((ker(&lf->sp)==WPARM) && (haspc(&lf->pc)))
+ { lf->coef[v] = thhat = addparcomp(lf,des->xev,PCOEF);
+ lf->nlx[v] = lf->t0[v] = sd = addparcomp(lf,des->xev,PNLX);
+ }
+ else */
+ { haspc(&lf->pc) = 0;
+ st = procv(des,lf,v);
+ thhat = lf->fp.coef[v];
+ sd = lf->fp.nlx[v];
+ }
+ if ((type==GLM2) | (type==GLM3) | (type==GLM4))
+ { if (ker(&lf->sp) != WPARM)
+ WARN(("nonparametric fit; correction is invalid"));
+ cumulant(lf,des,sd);
+ }
+ haspc(&lf->pc) = tmp;
+ lo = lf->fp.L;
+ hi = &lo[lf->fp.nvm];
+ switch(type)
+ {
+ case GLM1:
+ return(st);
+ case GLM2: /* centered scr */
+ lo[v] = kap[1];
+ hi[v] = sqrt(kap[2]);
+ return(st);
+ case GLM3: /* corrected 2 */
+ lo[v] = solve_secant(q2,scb_crit,0.0,2*scb_crit,0.000001,BDF_NONE,&err);
+ return(st);
+ case GLM4: /* corrected 2' */
+ u = fabs(p2(scb_crit));
+ max_p2 = MAX(max_p2,u);
+ return(st);
+ case GLDN:
+ get_gldn(&lf->fp,des,lo,hi,v);
+ return(st);
+ }
+ ERROR(("procvscb2: invalid type"));
+ return(st);
+}
+
+void scb(des,lf)
+design *des;
+lfit *lf;
+{ double k1, k2; /* kap[10], */
+ double *lo, *hi, sig, thhat, nlx;
+ int i, nterms;
+
+ scb_des= des;
+
+ npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
+ des_init(des,lf->lfd.n,npar(&lf->sp));
+ link(&lf->sp) = defaultlink(link(&lf->sp),fam(&lf->sp));
+
+ type = geth(&lf->fp);
+
+ if (type >= 80) /* simultaneous */
+ {
+ nterms = constants(des,lf);
+ scb_crit = critval(0.05,lf->fp.kap,nterms,lf->lfd.d,TWO_SIDED,0.0,GAUSS);
+ type -= 10;
+ }
+ else /* pointwise */
+ { lf->fp.kap[0] = 1;
+ scb_crit = critval(0.05,lf->fp.kap,1,lf->lfd.d,TWO_SIDED,0.0,GAUSS);
+ }
+
+ max_p2 = 0.0;
+ startlf(des,lf,procvscb2,0);
+
+ if ((fam(&lf->sp)&64)==64)
+ { i = haspc(&lf->pc); haspc(&lf->pc) = 0;
+ ressumm(lf,des);
+ haspc(&lf->pc) = i;
+ sig = sqrt(rv(&lf->fp));
+ }
+ else sig = 1.0;
+
+ lo = lf->fp.L;
+ hi = &lo[lf->fp.nvm];
+ for (i=0; i<lf->fp.nv; i++)
+ { thhat = lf->fp.coef[i];
+ nlx = lf->fp.nlx[i];
+ switch(type)
+ {
+ case GLM1: /* basic scb */
+ lo[i] = thhat - scb_crit * sig * nlx;
+ hi[i] = thhat + scb_crit * sig * nlx;
+ break;
+ case GLM2:
+ k1 = lo[i];
+ k2 = hi[i];
+ lo[i] = thhat - k1*nlx - scb_crit*nlx*k2;
+ hi[i] = thhat - k1*nlx + scb_crit*nlx*k2;
+ break;
+ case GLM3:
+ k1 = lo[i];
+ lo[i] = thhat - k1*nlx;
+ hi[i] = thhat + k1*nlx;
+ case GLM4: /* corrected 2' */
+ lo[i] = thhat - (scb_crit-max_p2)*lf->fp.nlx[i];
+ hi[i] = thhat + (scb_crit-max_p2)*lf->fp.nlx[i];
+ break;
+ case GLDN:
+ break;
+ }
+ }
+}
diff --git a/src/scb_cons.c b/src/scb_cons.c
new file mode 100755
index 0000000..10cc63a
--- /dev/null
+++ b/src/scb_cons.c
@@ -0,0 +1,518 @@
+/*
+ * Copyright (c) 1996-2004 Catherine Loader.
+ * This file contains functions to compute the constants
+ * appearing in the tube formula.
+ */
+
+#include <R.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <math.h>
+#include "tube.h"
+
+static double *fd, *ft;
+static int globm, (*wdf)(), use_covar, kap_terms;
+
+int k0_reqd(d,n,uc)
+int d, n, uc;
+{ int m;
+ m = d*(d+1)+1;
+ if (uc) return(2*m*m);
+ else return(2*n*m);
+}
+
+void assignk0(z,d,n) /* z should be n*(2*d*d+2*d+2); */
+double *z;
+int d, n;
+{ ft = z; z += n*(d*(d+1)+1);
+ fd = z; z += n*(d*(d+1)+1);
+}
+
+/* Residual projection of y to the columns of A,
+ * (I - A(R^TR)^{-1}A^T)y
+ * R should be from the QR-decomp. of A.
+ */
+void rproject(y,A,R,n,p)
+double *y, *A, *R;
+int n, p;
+{ double v[1+TUBE_MXDIM];
+ int i, j;
+
+ for (i=0; i<p; i++) v[i] = innerprod(&A[i*n],y,n);
+ qrsolv(R,v,n,p);
+ for (i=0; i<n; i++)
+ for (j=0; j<p; j++)
+ y[i] -= A[j*n+i]*v[j];
+}
+
+double k2c(lij,A,m,dd,d)
+double *lij, *A;
+int m, d, dd;
+{ int i, j, k, l;
+ double sum, *bk, v[TUBE_MXDIM];
+
+ for (i=0; i<dd*d; i++)
+ chol_hsolve(fd,&lij[i*m],m,dd+1);
+ for (i=0; i<dd*d; i++)
+ for (j=0; j<dd*d; j++)
+ lij[i*m+j+d+1] -= innerprod(&lij[i*m],&lij[j*m],dd+1);
+
+ sum = 0;
+ for (i=0; i<dd; i++)
+ for (j=0; j<i; j++)
+ { bk = &lij[i*d*m + j*d + d+1];
+ for (k=0; k<dd; k++)
+ { v[0] = 0;
+ for (l=0; l<dd; l++) v[l+1] = bk[k*m+l];
+ chol_solve(fd,v,m,dd+1);
+ for (l=0; l<dd; l++) bk[k*m+l] = v[l+1];
+ }
+ for (k=0; k<dd; k++)
+ { v[0] = 0;
+ for (l=0; l<dd; l++) v[l+1] = bk[l*m+k];
+ chol_solve(fd,v,m,dd+1);
+ for (l=0; l<dd; l++) bk[l*m+k] = v[l+1];
+ }
+ sum += bk[i*m+j] - bk[j*m+i];
+ }
+ return(sum*fd[0]*fd[0]);
+}
+
+double k2x(lij,A,m,d,dd)
+double *lij, *A;
+int m, d, dd;
+{ int i, j, k;
+ double s, v[1+TUBE_MXDIM], *ll;
+
+/* residual projections of lij onto A = [l,l1,...,ld] */
+ for (i=0; i<d; i++)
+ for (j=i; j<d; j++)
+ { ll = &lij[(i*dd+j)*m];
+ rproject(ll,A,fd,m,d+1);
+ if (i!=j) memmove(&lij[(j*dd+i)*m],ll,m*sizeof(double));
+ }
+
+/* compute lij[j][i] = e_i^T (A^T A)^{-1} B_j^T */
+ for (k=0; k<m; k++)
+ for (j=0; j<d; j++)
+ { v[0] = 0;
+ for (i=0; i<d; i++) v[i+1] = lij[(j*dd+i)*m+k];
+ qrsolv(fd,v,m,d+1);
+ for (i=0; i<d; i++) lij[(j*dd+i)*m+k] = v[i+1];
+ }
+
+/* finally, add up to get the kappa2 term */
+ s = 0;
+ for (j=0; j<d; j++)
+ for (k=0; k<j; k++)
+ s += innerprod(&lij[(j*dd+j)*m],&lij[(k*dd+k)*m],m)
+ - innerprod(&lij[(j*dd+k)*m],&lij[(k*dd+j)*m],m);
+
+ return(s*fd[0]*fd[0]);
+}
+
+void d2c(ll,nn,li,ni,lij,nij,M,m,dd,d)
+double *ll, *nn, *li, *ni, *lij, *nij, *M;
+int m, dd, d;
+{ int i, j, k, l, t, u, v, w;
+ double z;
+
+ for (i=0; i<dd; i++)
+ for (j=0; j<dd; j++)
+ { for (k=0; k<d; k++)
+ { for (l=0; l<d; l++)
+ { z = M[i*d+k]*M[j*d+l];
+ if (z != 0.0)
+ { nij[(i*d+j)*m] += z*lij[(k*d+l)*m];
+ for (t=0; t<d; t++) /* need d, not dd here */
+ for (u=0; u<d; u++)
+ nij[(i*d+j)*m+t+1] += z*M[t*d+u]*lij[(k*d+l)*m+u+1];
+ for (t=0; t<dd; t++)
+ for (u=0; u<dd; u++)
+ { for (v=0; v<d; v++)
+ for (w=0; w<d; w++)
+ nij[(i*d+j)*m+(t*d+u)+d+1] +=
+ z*M[t*d+v]*M[u*d+w]*lij[(k*d+l)*m+(v*d+w)+d+1];
+ for (v=0; v<d; v++)
+ nij[(i*d+j)*m+(t*d+u)+d+1] += z*M[(v+1)*d*d+t*d+u]*lij[(k*d+l)*m+v+1];
+ }
+ }
+ }
+
+ z = M[(k+1)*d*d+i*d+j];
+ if (z!=0.0)
+ { nij[(i*d+j)*m] += z*li[k*m];
+ for (t=0; t<d; t++)
+ for (u=0; u<d; u++)
+ nij[(i*d+j)*m+t+1] += z*M[t*d+u]*li[k*m+u+1];
+ for (t=0; t<dd; t++)
+ for (u=0; u<dd; u++)
+ { for (v=0; v<d; v++)
+ for (w=0; w<d; w++)
+ nij[(i*d+j)*m+(t*d+u)+d+1] += z*M[t*d+v]*M[u*d+w]*lij[(v*d+w)*m+k+1];
+ for (v=0; v<d; v++)
+ nij[(i*d+j)*m+(t*d+u)+d+1] += z*M[(v+1)*d*d+t*d+u]*li[k*m+v+1];
+ }
+ }
+ }
+ }
+}
+
+void d2x(li,lij,nij,M,m,dd,d)
+double *li, *lij, *nij, *M;
+int m, dd, d;
+{ int i, j, k, l, z;
+ double t;
+ for (i=0; i<dd; i++)
+ for (j=0; j<dd; j++)
+ { for (k=0; k<d; k++)
+ { for (l=0; l<d; l++)
+ { t = M[i*d+k] * M[j*d+l];
+ if (t != 0.0)
+ { for (z=0; z<m; z++)
+ nij[(i*d+j)*m+z] += t*lij[(k*d+l)*m+z];
+ }
+ }
+ t = M[(k+1)*d*d+i*d+j];
+ if (t!=0.0)
+ for (z=0; z<m; z++)
+ nij[(i*d+j)*m+z] += t*li[k*m+z];
+ }
+ }
+}
+
+int k0x(x,d,kap,M)
+double *x, *kap, *M;
+int d;
+{ double det, *lij, *nij, z;
+ int j, m, r;
+
+ r = 1 + ((d>=2) & (kap_terms >= 3));
+ m = globm = wdf(x,ft,r);
+
+ memmove(fd,ft,m*(d+1)*sizeof(double));
+ if (use_covar) chol_dec(fd,m,d+1);
+ else qr(fd,m,d+1,NULL);
+
+ det = 1;
+ for (j=1; j<=d; j++)
+ det *= fd[j*(m+1)]/fd[0];
+ kap[0] = det;
+ if (kap_terms == 1) return(1);
+ kap[1] = 0.0;
+ if ((kap_terms == 2) | (d<=1)) return(2);
+
+ lij = &ft[(d+1)*m];
+ nij = &fd[(d+1)*m];
+ memmove(nij,lij,m*d*d*sizeof(double));
+ z = (use_covar) ? k2c(nij,ft,m,d,d) : k2x(nij,ft,m,d,d);
+ kap[2] = z*det;
+ if ((kap_terms == 3) | (d==2)) return(3);
+
+ kap[3] = 0;
+ return(4);
+}
+
+void d1c(li,ni,m,d,M)
+double *li, *ni, *M;
+int m, d;
+{ int i, j, k, l;
+ double t;
+
+ fd[0] = ft[0];
+ for (i=0; i<d; i++)
+ { t = 0;
+ for (j=0; j<d; j++) t += M[i*d+j]*li[j*m];
+ fd[i+1] = ni[i*m] = t;
+
+ for (j=0; j<d; j++)
+ { t = 0;
+ for (k=0; k<d; k++)
+ for (l=0; l<d; l++)
+ t += li[k*m+l+1] * M[i*d+k] * M[j*d+l];
+ ni[i*m+j+1] = t;
+ }
+ }
+}
+
+void d1x(li,ni,m,d,M)
+double *li, *ni, *M;
+int m, d;
+{ int i, j, k;
+ memmove(fd,ft,m*sizeof(double));
+ setzero(ni,m*d);
+ for (j=0; j<d; j++)
+ for (k=0; k<d; k++)
+ if (M[j*d+k]!=0)
+ for (i=0; i<m; i++) ni[j*m+i] += M[j*d+k]*li[k*m+i];
+}
+
+int l1x(x,d,lap,M)
+double *x, *lap, *M;
+int d;
+{ double det, sumcj, *u, v[TUBE_MXDIM];
+ double *ll, *li, *lij, *ni, *nij;
+ int i, j, m;
+ if (kap_terms<=1) return(0);
+ m = globm;
+ li = &ft[m]; lij = &ft[(d+1)*m];
+ ni = &fd[m]; nij = &fd[(d+1)*m];
+ setzero(ni,m*d);
+ setzero(nij,m*d*d);
+
+ if (use_covar) d1c(li,ni,m,d,M);
+ else d1x(li,ni,m,d,M);
+
+/* the last (d+1) columns of nij are free, use for an extra copy of ni */
+ ll = &fd[d*d*m];
+ u = &ll[d*m];
+ if (use_covar)
+ memmove(u,&ni[(d-1)*m],d*sizeof(double)); /* cov(ld, (l,l1,...ld-1)) */
+ else
+ memmove(ll,fd,(d+1)*m*sizeof(double));
+
+ if (use_covar) chol_dec(fd,m,d+1);
+ else qr(fd,m,d+1,NULL);
+ det = 1;
+ for (j=1; j<d; j++)
+ det *= fd[(m+1)*j]/fd[0];
+ lap[0] = det;
+ if ((kap_terms==2) | (d<=1)) return(1);
+
+ sumcj = 0.0;
+ if (use_covar)
+ { d2c(ft,fd,li,ni,lij,nij,M,m,d-1,d);
+ chol_solve(fd,u,m,d);
+ for (i=0; i<d-1; i++)
+ { v[0] = 0;
+ for (j=0; j<d-1; j++)
+ v[j+1] = nij[(i*d+j)*m+d] - innerprod(u,&nij[(i*d+j)*m],d);
+ chol_solve(fd,v,m,d);
+ sumcj -= v[i+1];
+ }
+ }
+ else
+ { d2x(li,lij,nij,M,m,d-1,d);
+ rproject(u,ll,fd,m,d);
+ for (i=0; i<d-1; i++)
+ { v[0] = 0;
+ for (j=0; j<d-1; j++) v[j+1] = innerprod(&nij[(i*d+j)*m],u,m);
+ qrsolv(fd,v,m,d);
+ sumcj -= v[i+1];
+ }
+ }
+
+ lap[1] = sumcj*det*fd[0]/fd[(m+1)*d];
+ if ((kap_terms==3) | (d==2)) return(2);
+
+ if (use_covar) lap[2] = k2c(nij,ll,m,d-1,d)*det;
+ else lap[2] = k2x(nij,ll,m,d-1,d)*det;
+ return(3);
+}
+
+int m0x(x,d,m0,M)
+double *x, *m0, *M;
+int d;
+{ double det, *li, *ni, *lij, *nij, *ll, *u1, *u2;
+ double om, so, co, sumcj, v[TUBE_MXDIM];
+ int m, i, j;
+
+ if ((kap_terms<=2) | (d<=1)) return(0);
+
+ m = globm;
+ li = &ft[m]; lij = &ft[(d+1)*m];
+ ni = &fd[m]; nij = &fd[(d+1)*m];
+ setzero(ni,m*d);
+ setzero(nij,m*d*d);
+
+ if (use_covar) d1c(li,ni,m,d,M);
+ else d1x(li,ni,m,d,M);
+
+/* the last (d+1) columns of nij are free, use for an extra copy of ni */
+ ll = &fd[d*d*m];
+ u1 = &ll[d*m];
+ u2 = &ll[(d-1)*m];
+ if (use_covar)
+ { memmove(u1,&ni[(d-1)*m],d*sizeof(double));
+ memmove(u2,&ni[(d-2)*m],d*sizeof(double));
+ }
+ else
+ memmove(ll,fd,(d+1)*m*sizeof(double));
+
+ if (use_covar) chol_dec(fd,m,d+1);
+ else qr(fd,m,d+1,NULL);
+ det = 1;
+ for (j=1; j<d-1; j++)
+ det *= fd[j*(m+1)]/fd[0];
+ om = atan2(fd[d*(m+1)],-fd[d*(m+1)-1]);
+ m0[0] = det*om;
+ if ((kap_terms==3) | (d==2)) return(1);
+
+ so = sin(om)/fd[d*(m+1)];
+ co = (1-cos(om))/fd[(d-1)*(m+1)];
+ sumcj = 0.0;
+ if (use_covar)
+ { d2c(ft,fd,li,ni,lij,nij,M,m,d-2,d);
+ chol_solve(fd,u1,m,d);
+ chol_solve(fd,u2,m,d-1);
+ for (i=0; i<d-2; i++)
+ { v[0] = 0;
+ for (j=0; j<d-2; j++)
+ v[j+1] =
+ so*(nij[(i*d+j)*m+d]-innerprod(u1,&nij[(i*d+j)*m],d))
+ +co*(nij[(i*d+j)*m+d-1]-innerprod(u2,&nij[(i*d+j)*m],d-1));
+ qrsolv(fd,v,m,d-1);
+ sumcj -= v[i+1];
+ }
+ }
+ else
+ { d2x(li,lij,nij,M,m,d-2,d);
+ rproject(u1,ll,fd,m,d);
+ rproject(u2,ll,fd,m,d-1); /* now, u1, u2 are unnormalized n1*, n2* */
+ for (i=0; i<m; i++)
+ u1[i] = so*u1[i] + co*u2[i]; /* for n1*, n2* */
+ for (i=0; i<d-2; i++)
+ { v[0] = 0;
+ for (j=0; j<d-2; j++)
+ v[j+1] = innerprod(&nij[(i*d+j)*m],u1,m);
+ qrsolv(fd,v,m,d-1);
+ sumcj -= v[i+1];
+ }
+ }
+
+ m0[1] = sumcj*det*fd[0];
+ return(2);
+}
+
+int n0x(x,d,n0,M)
+double *x, *n0, *M;
+int d;
+{ double det, *li, *ni, *a0, *a1, *a2;
+ int j, m;
+
+ if ((kap_terms <= 3) | (d <= 2)) return(0);
+
+ m = globm;
+ li = &ft[m];
+ ni = &fd[m];
+
+ if (use_covar) d1c(li,ni,m,d,M);
+ else d1x(li,ni,m,d,M);
+
+ det = 1;
+ if (use_covar) chol_dec(fd,m,d+1);
+ else qr(fd,m,d+1,NULL);
+ for (j=1; j<d-2; j++)
+ det *= fd[j*(m+1)]/fd[0];
+
+ a0 = &ni[(d-3)*m+d-2];
+ a1 = &ni[(d-2)*m+d-2];
+ a2 = &ni[(d-1)*m+d-2];
+
+ a0[0] = a1[1]*a2[2];
+ a0[1] =-a1[0]*a2[2];
+ a0[2] = a1[0]*a2[1]-a1[1]*a2[0];
+ a1[0] = 0;
+ a1[1] = a2[2];
+ a1[2] =-a2[1];
+ a2[0] = a2[1] = 0.0; a2[2] = 1.0;
+ rn3(a0); rn3(a1);
+ n0[0] = det*sptarea(a0,a1,a2);
+ return(1);
+}
+
+int kodf(ll,ur,mg,kap,lap)
+double *ll, *ur, *kap, *lap;
+int *mg;
+{ double x[1], *l0, *l1, t, sum;
+ int i, j, n;
+
+ sum = 0.0;
+ for (i=0; i<=mg[0]; i++)
+ { if (i&1) { l1 = fd; l0 = ft; }
+ else { l1 = ft; l0 = fd; }
+ x[0] = ll[0] + (ur[0]-ll[0])*i/mg[0];
+ n = wdf(x,l0,0);
+
+ t = sqrt(innerprod(l0,l0,n));
+ for (j=0; j<n; j++) l0[j] /= t;
+
+ if (i>0)
+ { t = 0.0;
+ for (j=0; j<n; j++) t += (l1[j]-l0[j])*(l1[j]-l0[j]);
+ sum += 2*asin(sqrt(t)/2);
+ }
+ }
+ kap[0] = sum;
+ if (kap_terms<=1) return(1);
+ kap[1] = 0.0;
+ lap[0] = 2.0;
+ return(2);
+}
+
+int tube_constants(int (*f)(), int d, int m, int ev, int *mg, double *fl,
+ double *kap, double *wk, int terms, int uc) {
+ /* double *fl, *kap, *wk;
+ int d, m, ev, *mg, (*f)(), terms, uc; */
+ int aw, deb=0;
+ double k0[4], l0[3], m0[2], n0[1], z[TUBE_MXDIM];
+
+ wdf = f;
+
+ aw = (int) (wk == NULL);
+ if (aw) wk = (double *) calloc(k0_reqd(d,m,uc), sizeof(double));
+ assignk0(wk,d,m);
+
+ k0[0] = k0[1] = k0[2] = k0[3] = 0.0;
+ l0[0] = l0[1] = l0[2] = 0.0;
+ m0[0] = m0[1] = 0.0;
+ n0[0] = 0.0;
+
+ use_covar = uc;
+ kap_terms = terms;
+ if ((kap_terms <=0) | (kap_terms >= 5))
+ warning("terms = %2d\n", kap_terms);
+
+ switch(ev)
+ {
+ case IMONTE:
+ monte(k0x,fl,&fl[d],d,k0,mg[0]);
+ break;
+ case ISPHERIC:
+ if (d==2) integ_disc(k0x,l1x,fl,k0,l0,mg);
+ if (d==3) integ_sphere(k0x,l1x,fl,k0,l0,mg);
+ break;
+ case ISIMPSON:
+ if (use_covar) simpson4(k0x,l1x,m0x,n0x,fl,&fl[d],d,k0,l0,m0,n0,mg,z);
+ else simpson4(k0x,l1x,m0x,n0x,fl,&fl[d],d,k0,l0,m0,n0,mg,z);
+ break;
+ case IDERFREE:
+ kodf(fl,&fl[d],mg,k0,l0);
+ break;
+ default:
+ Rprintf("Unknown integration type in tube_constants().\n");
+ }
+
+ if (deb>0) {
+ Rprintf("constants:\n");
+ Rprintf(" k0: %8.5f %8.5f %8.5f %8.5f\n",k0[0],k0[1],k0[2],k0[3]);
+ Rprintf(" l0: %8.5f %8.5f %8.5f\n",l0[0],l0[1],l0[2]);
+ Rprintf(" m0: %8.5f %8.5f\n",m0[0],m0[1]);
+ Rprintf(" n0: %8.5f\n",n0[0]);
+ if (d==2) Rprintf(" check: %8.5f\n",(k0[0]+k0[2]+l0[1]+m0[0])/(2*PI));
+ if (d==3) Rprintf(" check: %8.5f\n",(l0[0]+l0[2]+m0[1]+n0[0])/(4*PI));
+ }
+
+ if (aw) free(wk);
+
+ kap[0] = k0[0];
+ if (kap_terms==1) return(1);
+ kap[1] = l0[0]/2;
+ if ((kap_terms==2) | (d==1)) return(2);
+ kap[2] = (k0[2]+l0[1]+m0[0])/(2*PI);
+ if ((kap_terms==3) | (d==2)) return(3);
+ kap[3] = (l0[2]+m0[1]+n0[0])/(4*PI);
+ return(4);
+}
diff --git a/src/scb_crit.c b/src/scb_crit.c
new file mode 100755
index 0000000..2f91bf5
--- /dev/null
+++ b/src/scb_crit.c
@@ -0,0 +1,184 @@
+/*
+ * Copyright (c) 1996-2004 Catherine Loader.
+ *
+ * Computes the critical values from constants kappa0 etc
+ * and significance level.
+ */
+
+#include <math.h>
+#include "local.h"
+#include "tube.h"
+
+/*
+ * some old math libraries choke on lgamma()...
+ */
+/* #define LGAMMA(arg) lgamma(arg) */
+#define LOGPI 1.144729885849400174143427
+
+/* area(d) = 2 pi^(d/2) / Gamma(d/2)
+ * = surface area of unit sphere in R^d
+ */
+static double A[10] =
+ { 1, /* d=0, whatever */
+ 2,
+ 6.2831853071795864770, /* 2*pi */
+ 12.566370614359172954, /* 4*pi */
+ 19.739208802178717238, /* 2*pi^2 */
+ 26.318945069571622985, /* 8/3*pi^2 */
+ 31.006276680299820177, /* pi^3 */
+ 33.073361792319808190, /* 16/15*pi^3 */
+ 32.469697011334145747, /* 1/3*pi^4 */
+ 29.686580124648361825 /* 32/105*pi^4 */
+ };
+
+double area(d)
+int d;
+{ if (d<10) return(A[d]);
+ return(2*exp(d*LOGPI/2.0-LGAMMA(d/2.0)));
+}
+
+double tailp_uniform(c,k0,m,d,s,n)
+double c, *k0, n;
+int m, d, s;
+{ int i;
+ double p;
+ p = 0.0;
+ for (i=0; i<m; i++) if (k0[i] != 0.0)
+ p += k0[i] * ibeta(1-c*c,(n-d+i-1)/2.0,(d+1-i)/2.0) / area(d+1-i);
+ return( (s==TWO_SIDED) ? 2*p : p );
+}
+
+double tailp_gaussian(c,k0,m,d,s,n)
+double c, *k0, n;
+int m, d, s;
+{ int i;
+ double p;
+ p = 0.0;
+ for (i=0; i<m; i++) if (k0[i] != 0.0)
+ p += k0[i] * (1-pchisq(c*c,(double) d+1-i)) / area(d+1-i);
+ return( (s==TWO_SIDED) ? 2*p : p );
+}
+
+double tailp_tprocess(c,k0,m,d,s,n)
+double c, *k0, n;
+int m, d, s;
+{ int i;
+ double p;
+ p = 0.0;
+ for (i=0; i<m; i++) if (k0[i] != 0.0)
+ p += k0[i] * (1-pf(c*c/(d+1-i),(double) d+1-i, n)) / area(d+1-i);
+ return( (s==TWO_SIDED) ? 2*p : p );
+}
+
+double taild_uniform(c,k0,m,d,s,n)
+double c, *k0, n;
+int m, d, s;
+{ int i;
+ double p;
+ p = 0.0;
+ for (i=0; i<m; i++) if (k0[i] != 0.0)
+ p += k0[i] * 2*c*dbeta(1-c*c,(n-d+i-1)/2.0,(d+1-i)/2.0,0) / area(d+1-i);
+ return( (s==TWO_SIDED) ? 2*p : p );
+}
+
+double taild_gaussian(c,k0,m,d,s,n)
+double c, *k0, n;
+int m, d, s;
+{ int i;
+ double p;
+ p = 0.0;
+ for (i=0; i<m; i++) if (k0[i] != 0.0)
+ p += k0[i] * 2*c*dchisq(c*c,(double) d+1-i,0) / area(d+1-i);
+ return( (s==TWO_SIDED) ? 2*p : p );
+}
+
+double taild_tprocess(c,k0,m,d,s,n)
+double c, *k0, n;
+int m, d, s;
+{ int i;
+ double p;
+ p = 0.0;
+ for (i=0; i<m; i++) if (k0[i] != 0.0)
+ p += k0[i] * 2*c*df(c*c/(d+1-i),(double) d+1-i, n,0) / ((d+1-i)*area(d+1-i));
+ return( (s==TWO_SIDED) ? 2*p : p );
+}
+
+double tailp(c,k0,m,d,s,nu, process)
+double c, *k0, nu;
+int m, d, s, process;
+{ switch(process)
+ { case UNIF: return(tailp_uniform(c,k0,m,d,s,nu));
+ case GAUSS: return(tailp_gaussian(c,k0,m,d,s,nu));
+ case TPROC: return(tailp_tprocess(c,k0,m,d,s,nu));
+ }
+ printf("taild: unknown process.\n");
+ return(0.0);
+}
+
+double taild(c,k0,m,d,s,nu, process)
+double c, *k0, nu;
+int m, d, s, process;
+{ switch(process)
+ { case UNIF: return(taild_uniform(c,k0,m,d,s,nu));
+ case GAUSS: return(taild_gaussian(c,k0,m,d,s,nu));
+ case TPROC: return(taild_tprocess(c,k0,m,d,s,nu));
+ }
+ printf("taild: unknown process.\n");
+ return(0.0);
+}
+
+double critval(alpha,k0,m,d,s,nu,process)
+double alpha, *k0, nu;
+int m, d, s, process;
+{ double c, cn, c0, c1, tp, td;
+ int j, maxit;
+ double (*tpf)(), (*tdf)();
+
+ maxit = 20;
+ if (m<0)
+ { printf("critval: no terms?\n");
+ return(2.0);
+ }
+ if (m>d+1) m = d+1;
+ if ((alpha<=0) | (alpha>=1))
+ { printf("critval: invalid alpha %8.5f\n",alpha);
+ return(2.0);
+ }
+ if (alpha>0.5)
+ printf("critval: A mighty large tail probability alpha=%8.5f\n",alpha);
+ if (m==0) { d = 0; k0[0] = 1; m = 1; }
+
+ switch(process)
+ { case UNIF:
+ c = 0.5; c0 = 0.0; c1 = 1.0;
+ tpf = tailp_uniform;
+ tdf = taild_uniform;
+ break;
+ case GAUSS:
+ c = 2.0; c0 = 0.0; c1 = 0.0;
+ tpf = tailp_gaussian;
+ tdf = taild_gaussian;
+ break;
+ case TPROC:
+ c = 2.0; c0 = 0.0; c1 = 0.0;
+ tpf = tailp_tprocess;
+ tdf = taild_tprocess;
+ break;
+ default:
+ printf("critval: unknown process.\n");
+ return(0.0);
+ }
+
+ for (j=0; j<maxit; j++)
+ { tp = tpf(c,k0,m,d,s,nu)-alpha;
+ td = tdf(c,k0,m,d,s,nu);
+ if (tp>0) c0 = c;
+ if (tp<0) c1 = c;
+ cn = c + tp/td;
+ if (cn<c0) cn = (c+c0)/2;
+ if ((c1>0.0) && (cn>c1)) cn = (c+c1)/2;
+ c = cn;
+ if (fabs(tp/alpha)<1.0e-10) return(c);
+ }
+ return(c);
+}
diff --git a/src/scb_iface.c b/src/scb_iface.c
new file mode 100755
index 0000000..24c5c21
--- /dev/null
+++ b/src/scb_iface.c
@@ -0,0 +1,78 @@
+#include "local.h"
+
+static lfit *lf_scb;
+static lfdata *lfd_scb;
+static smpar *scb_sp;
+static design *des_scb;
+
+int scbfitter(x,l,reqd)
+double *x, *l;
+int reqd;
+{
+ int m;
+ des_scb->xev = x;
+ if ((ker(scb_sp)!=WPARM) | (!haspc(&lf_scb->pc)))
+ { locfit(lfd_scb,des_scb,&lf_scb->sp,1,1);
+ m = wdiag(lfd_scb, scb_sp, des_scb,l,&lf_scb->dv,reqd,2,0);
+ }
+ else
+ m = wdiagp(lfd_scb, scb_sp, des_scb,l,&lf_scb->pc,&lf_scb->dv,reqd,2,0);
+ return(m);
+}
+
+/* function to test tube_constants with covariance.
+double ll[5000];
+int scbfitter2(x,l,reqd)
+double *x, *l;
+int reqd;
+{ double h;
+ int d, m, n, i, j;
+
+ m = scbfitter(x,ll,reqd);
+
+ d = lfd_scb->d;
+
+ n = d*d+d+1;
+ for (i=0; i<n; i++)
+ for (j=0; j<n; j++)
+ l[i*n+j] = innerprod(&ll[i*m],&ll[j*m],m);
+
+ return(n);
+}
+*/
+
+int constants(des,lf)
+design *des;
+lfit *lf;
+{
+ int d, m, nt, rw;
+ evstruc *evs;
+
+ lf_scb = lf;
+ des_scb = des;
+ lfd_scb = &lf->lfd;
+ scb_sp = &lf->sp;
+
+ evs = &lf->evs;
+ d = lfd_scb->d;
+ m = lfd_scb->n;
+
+ if (lf_error) return(0);
+ if ((ker(scb_sp) != WPARM) && (lf->sp.nn>0))
+ WARN(("constants are approximate for varying h"));
+ npar(scb_sp) = calcp(scb_sp,lf->lfd.d);
+ des_init(des,m,npar(scb_sp));
+ set_scales(&lf->lfd);
+ set_flim(&lf->lfd,&lf->evs);
+ compparcomp(des,&lf->lfd,&lf->sp,&lf->pc,geth(&lf->fp),ker(scb_sp)!=WPARM);
+
+ rw = k0_reqd(d,m,0);
+ if (lf->fp.ll<rw)
+ { lf->fp.L = (double *)calloc(rw,sizeof(double));
+ lf->fp.ll= rw;
+ }
+
+ nt = tube_constants(scbfitter,d,m,ev(evs),mg(evs),evs->fl,
+ lf->fp.kap,lf->fp.L,(d>3) ? 4 : d+1,0);
+ return(nt);
+}
diff --git a/src/simul.c b/src/simul.c
new file mode 100755
index 0000000..dce296b
--- /dev/null
+++ b/src/simul.c
@@ -0,0 +1,226 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ */
+
+#include "local.h"
+
+static double pen, sig2;
+
+void goldensec(f,des,tr,eps,xm,ym,meth)
+double (*f)(), eps, *xm, *ym;
+int meth;
+design *des;
+lfit *tr;
+{ double x[4], y[4], xx[11], yy[11];
+ int i, im=0;
+ xx[0] = tr->sp.fixh;
+ if (xx[0]<=0)
+ { ERROR(("regband: initialize h>0"));
+ return;
+ }
+ for (i=0; i<=10; i++)
+ { if (i>0) xx[i] = (1+GOLDEN)*xx[i-1];
+ yy[i] = f(xx[i],des,tr,meth);
+ if ((i==0) || (yy[i]<yy[im])) im = i;
+ }
+ if (im==0) im = 1;
+ if (im==10)im = 9;
+ x[0] = xx[im-1]; y[0] = yy[im-1];
+ x[1] = xx[im]; y[1] = yy[im];
+ x[3] = xx[im+1]; y[3] = yy[im+1];
+ x[2] = GOLDEN*x[3]+(1-GOLDEN)*x[0];
+ y[2] = f(x[2],des,tr,meth);
+ while (x[3]-x[0]>eps)
+ { if (y[1]<y[2])
+ { x[3] = x[2]; y[3] = y[2];
+ x[2] = x[1]; y[2] = y[1];
+ x[1] = GOLDEN*x[0]+(1-GOLDEN)*x[3];
+ y[1] = f(x[1],des,tr,meth);
+ }
+ else
+ { x[0] = x[1]; y[0] = y[1];
+ x[1] = x[2]; y[1] = y[2];
+ x[2] = GOLDEN*x[3]+(1-GOLDEN)*x[0];
+ y[2] = f(x[2],des,tr,meth);
+ }
+ }
+ im = 0;
+ for (i=1; i<4; i++) if (y[i]<y[im]) im = i;
+ *xm = x[im]; *ym = y[im];
+}
+
+double dnk(x,k)
+double x;
+int k;
+{ double f;
+ switch(k)
+ { case 0: f = 1; break;
+ case 1: f = -x; break;
+ case 2: f = x*x-1; break;
+ case 3: f = x*(x*x-3); break;
+ case 4: f = 3-x*x*(6-x*x); break;
+ case 5: f = -x*(15-x*x*(10-x*x)); break;
+ case 6: f = -15+x*x*(45-x*x*(15-x*x)); break;
+ default: ERROR(("dnk: k=%d too large",k)); return(0.0);
+ }
+ return(f*exp(-x*x/2)/S2PI);
+}
+
+double locai(h,des,lf)
+double h;
+design *des;
+lfit *lf;
+{ double cp;
+ nn(&lf->sp) = h;
+ startlf(des,lf,procv,0);
+ ressumm(lf,des);
+ cp = -2*llk(&lf->fp) + pen*df0(&lf->fp);
+ return(cp);
+}
+
+double loccp(h,des,lf,m) /* m=1: cp m=2: gcv */
+double h;
+design *des;
+lfit *lf;
+int m;
+{ double cp;
+ int dg, n;
+
+ n = lf->lfd.n;
+ nn(&lf->sp) = 0;
+ fixh(&lf->sp) = h;
+ dg = deg(&lf->sp);
+ deg(&lf->sp) = deg0(&lf->sp);
+ startlf(des,lf,procv,0);
+ ressumm(lf,des);
+ if (m==1)
+ cp = -2*llk(&lf->fp)/sig2 - n + 2*df0(&lf->fp);
+ else
+ cp = -2*n*llk(&lf->fp)/((n-df0(&lf->fp))*(n-df0(&lf->fp)));
+ printf("h %8.5f deg %2d rss %8.5f trl %8.5f cp: %8.5f\n",h,deg(&lf->sp),-2*llk(&lf->fp),df0(&lf->fp),cp);
+ deg0(&lf->sp) = deg(&lf->sp);
+ deg(&lf->sp) = dg;
+ return(cp);
+}
+
+double cp(des,lf,meth)
+design *des;
+lfit *lf;
+int meth;
+{ double hm, ym;
+ goldensec(loccp,des,lf,0.001,&hm,&ym,meth);
+ return(hm);
+}
+
+double gkk(des,lf)
+design *des;
+lfit *lf;
+{ double h, h5, nf, th;
+ int i, j, n, dg0, dg1;
+ ev(&lf->evs)= EDATA;
+ nn(&lf->sp) = 0;
+ n = lf->lfd.n;
+ dg0 = deg0(&lf->sp); /* target degree */
+ dg1 = dg0+1+(dg0%2==0); /* pilot degree */
+ nf = exp(log(1.0*n)/10); /* bandwidth inflation factor */
+ h = lf->sp.fixh; /* start bandwidth */
+ for (i=0; i<=10; i++)
+ { deg(&lf->sp) = dg1;
+ lf->sp.fixh = h*nf;
+ startlf(des,lf,procv,0);
+ th = 0;
+ for (j=10; j<n-10; j++)
+ th += lf->fp.coef[dg1*n+j]*lf->fp.coef[dg1*n+j];
+th *= n/(n-20.0);
+ h5 = sig2 * Wikk(ker(&lf->sp),dg0) / th;
+ h = exp(log(h5)/(2*dg1+1));
+/* printf("pilot %8.5f sel %8.5f\n",lf->sp.fixh,h); */
+ }
+ return(h);
+}
+
+double rsw(des,lf)
+design *des;
+lfit *lf;
+{ int i, j, k, nmax, nvm, n, mk, evo, dg0, dg1;
+ double rss[6], cp[6], th22, dx, d2, hh;
+ nmax = 5;
+ evo = ev(&lf->evs); ev(&lf->evs) = EGRID;
+ mk = ker(&lf->sp); ker(&lf->sp) = WRECT;
+ dg0 = deg0(&lf->sp);
+ dg1 = 1 + dg0 + (dg0%2==0);
+ deg(&lf->sp) = 4;
+ for (k=nmax; k>0; k--)
+ { lf->evs.mg[0] = k;
+ lf->evs.fl[0] = 1.0/(2*k);
+ lf->evs.fl[1] = 1-1.0/(2*k);
+ nn(&lf->sp) = 0;
+ fixh(&lf->sp) = 1.0/(2*k);
+ startlf(des,lf,procv,0);
+ nvm = lf->fp.nvm;
+ rss[k] = 0;
+ for (i=0; i<k; i++) rss[k] += -2*lf->fp.lik[i];
+ }
+ n = lf->lfd.n; k = 1;
+ for (i=1; i<=nmax; i++)
+ { /* cp[i] = (n-5*nmax)*rss[i]/rss[nmax]-(n-10*i); */
+ cp[i] = rss[i]/sig2-(n-10*i);
+ if (cp[i]<cp[k]) k = i;
+ }
+ lf->evs.mg[0] = k;
+ lf->evs.fl[0] = 1.0/(2*k);
+ lf->evs.fl[1] = 1-1.0/(2*k);
+ nn(&lf->sp) = 0;
+ fixh(&lf->sp) = 1.0/(2*k);
+ startlf(des,lf,procv,0);
+ ker(&lf->sp) = mk; ev(&lf->evs) = evo;
+ nvm = lf->fp.nvm;
+ th22 = 0;
+ for (i=10; i<n-10; i++)
+ { j = floor(k*datum(&lf->lfd,0,i));
+ if (j>=k) j = k-1;
+ dx = datum(&lf->lfd,0,i)-evptx(&lf->fp,0,j);
+ if (dg1==2)
+ d2 = lf->fp.coef[2*nvm+j]+dx*lf->fp.coef[3*nvm+j]+dx*dx*lf->fp.coef[4*nvm+j]/2;
+ else d2 = lf->fp.coef[4*nvm+j];
+ th22 += d2*d2;
+ }
+ hh = Wikk(mk,dg0)*sig2/th22*(n-20.0)/n;
+ return(exp(log(hh)/(2*dg1+1)));
+}
+
+void rband(des,lf,hhat,meth,nmeth)
+design *des;
+lfit *lf;
+double *hhat;
+int *meth, nmeth;
+{ int i, dg;
+ double h0;
+
+ /* first, estimate sigma^2 */
+ dg = deg(&lf->sp); deg(&lf->sp) = 2;
+ h0 = lf->sp.fixh; lf->sp.fixh = 0.05;
+printf("alp: %8.5f h: %8.5f deg %2d ev %2d\n",nn(&lf->sp),fixh(&lf->sp),deg(&lf->sp),ev(&lf->evs));
+ startlf(des,lf,procv,0);
+ ressumm(lf,des);
+ deg(&lf->sp) = dg; lf->sp.fixh = h0;
+ sig2 = rv(&lf->fp);
+ printf("sd est: %8.5f\n",sqrt(sig2));
+
+ for (i=0; i<nmeth; i++)
+ { switch(meth[i])
+ { case 1: hhat[i] = cp(des,lf,1);
+ break;
+ case 2: hhat[i] = cp(des,lf,2);
+ break;
+ case 3: hhat[i] = gkk(des,lf);
+ break;
+ case 4: hhat[i] = rsw(des,lf);
+ break;
+ default: hhat[i] = 0;
+ }
+ lf->sp.fixh = h0;
+ deg(&lf->sp) = dg;
+ }
+}
diff --git a/src/smisc.c b/src/smisc.c
new file mode 100755
index 0000000..bd18d54
--- /dev/null
+++ b/src/smisc.c
@@ -0,0 +1,34 @@
+/*
+ * Copyright (c) 1996-2000 Lucent Technologies.
+ * See README file for details.
+ *
+ * some miscellaneous entry points.
+ */
+
+#include "local.h"
+
+void scritval(k0,d,cov,m,rdf,z,k)
+double *k0, *z, *cov, *rdf;
+Sint *d, *m, *k;
+{ int i;
+ lf_error = 0;
+ for (i=0; i<*k; i++)
+ z[i] = critval(1-cov[i], k0, (int)(*m), (int)(*d), TWO_SIDED,*rdf, (*rdf==0) ? GAUSS : TPROC);
+}
+
+void slscv(x,n,h,z)
+double *x, *h, *z;
+int *n;
+{ double res[4];
+ kdecri(x,*h,res,0.0,3,WGAUS,*n);
+ z[0] = res[0];
+ z[1] = res[2];
+}
+
+void kdeb(x,mi,band,ind,h0,h1,meth,nmeth,ker)
+double *x, *band, *h0, *h1;
+Sint *mi, *ind, *meth, *nmeth, *ker;
+{ int i, imeth[10];
+ for (i=0; i<*nmeth; i++) imeth[i] = meth[i];
+ kdeselect(band,x,ind,*h0,*h1,imeth,(int)*nmeth,(int)*ker,(int)mi[MN]);
+}
diff --git a/src/startlf.c b/src/startlf.c
new file mode 100755
index 0000000..f85576c
--- /dev/null
+++ b/src/startlf.c
@@ -0,0 +1,174 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ *
+ startlf(des,lf,vfun,nopc) -- starting point for locfit.
+ des and lf are pointers to the design and fit structures.
+ vfun is the vertex processing function.
+ nopc=1 inhibits computation of parametric component.
+ lfit_init(lf) -- initialize the lfit structure.
+ lf is pointer to fit.
+ preproc() -- fit preprocessing (limits, scales, paramcomp etc.)
+ set_scales()
+ set_flim() -- compute bounding box.
+
+ fitoptions()
+ clocfit() -- start point for CLocfit - interpret cmd line etc.
+ */
+
+#include "local.h"
+
+void evstruc_init(evs)
+evstruc *evs;
+{ int i;
+ ev(evs) = ETREE;
+ mk(evs) = 100;
+ cut(evs) = 0.8;
+ for (i=0; i<MXDIM; i++)
+ { evs->fl[i] = evs->fl[i+MXDIM] = 0.0;
+ evs->mg[i] = 10;
+ }
+ evs->nce = evs->ncm = 0;
+}
+
+void fitpt_init(fp)
+fitpt *fp;
+{
+ dc(fp) = 0;
+ geth(fp) = GSTD;
+ fp->nv = fp->nvm = 0;
+}
+
+void lfit_init(lf)
+lfit *lf;
+{
+ lfdata_init(&lf->lfd);
+ evstruc_init(&lf->evs);
+ smpar_init(&lf->sp,&lf->lfd);
+ deriv_init(&lf->dv);
+ fitpt_init(&lf->fp);
+}
+
+void fitdefault(lf)
+lfit *lf;
+{ WARN(("fitdefault deprecated -- use lfit_init()"));
+ lfit_init(lf);
+}
+
+void set_flim(lfd,evs)
+lfdata *lfd;
+evstruc *evs;
+{ int i, j, d, n;
+ double z, mx, mn, *bx;
+
+ if (ev(evs)==ESPHR) return;
+ d = lfd->d; n = lfd->n;
+ bx = evs->fl;
+ for (i=0; i<d; i++)
+ if (bx[i]==bx[i+d])
+ { if (lfd->sty[i]==STANGL)
+ { bx[i] = 0.0; bx[i+d] = 2*PI*lfd->sca[i];
+ }
+ else
+ { mx = mn = datum(lfd,i,0);
+ for (j=1; j<n; j++)
+ { mx = MAX(mx,datum(lfd,i,j));
+ mn = MIN(mn,datum(lfd,i,j));
+ }
+ if (lfd->xl[i]<lfd->xl[i+d]) /* user set xlim; maybe use them. */
+ { z = mx-mn;
+ if (mn-0.2*z < lfd->xl[i]) mn = lfd->xl[i];
+ if (mx+0.2*z > lfd->xl[i+d]) mx = lfd->xl[i+d];
+ }
+ bx[i] = mn;
+ bx[i+d] = mx;
+ }
+ }
+}
+
+double vecsum(v,n)
+double *v;
+int n;
+{ int i;
+ double sum;
+ sum = 0.0;
+ for (i=0; i<n; i++) sum += v[i];
+ return(sum);
+}
+
+double vvari(v,n)
+double *v;
+int n;
+{ int i;
+ double xb, s2;
+ xb = s2 = 0.0;
+ for (i=0; i<n; i++) xb += v[i];
+ xb /= n;
+ for (i=0; i<n; i++) s2 += SQR(v[i]-xb);
+ return(s2/(n-1));
+}
+
+void set_scales(lfd)
+lfdata *lfd;
+{ int i;
+ for (i=0; i<lfd->d; i++)
+ if (lfd->sca[i]<=0) /* set automatic scales */
+ { if (lfd->sty[i]==STANGL)
+ lfd->sca[i] = 1.0;
+ else lfd->sca[i] = sqrt(vvari(lfd->x[i],lfd->n));
+ }
+}
+
+void startlf(des,lf,vfun,nopc)
+design *des;
+lfit *lf;
+int (*vfun)(), nopc;
+{ int i, d, n;
+
+ if (lf_debug>0) printf("startlf\n");
+ n = lf->lfd.n;
+ d = lf->lfd.d;
+ des->vfun = vfun;
+ npar(&lf->sp) = calcp(&lf->sp,lf->lfd.d);
+
+ des_init(des,n,npar(&lf->sp));
+ des->smwt = (lf->lfd.w==NULL) ? n : vecsum(lf->lfd.w,n);
+ set_scales(&lf->lfd);
+ set_flim(&lf->lfd,&lf->evs);
+ compparcomp(des,&lf->lfd,&lf->sp,&lf->pc,geth(&lf->fp),nopc);
+ makecfn(&lf->sp,des,&lf->dv,lf->lfd.d);
+
+ lf->lfd.ord = 0;
+ if ((d==1) && (lf->lfd.sty[0]!=STANGL))
+ { i = 1;
+ while ((i<n) && (datum(&lf->lfd,0,i)>=datum(&lf->lfd,0,i-1))) i++;
+ lf->lfd.ord = (i==n);
+ }
+ for (i=0; i<npar(&lf->sp); i++) des->fix[i] = 0;
+
+ lf->fp.d = lf->lfd.d;
+ lf->fp.hasd = (des->ncoef==(1+lf->fp.d));
+
+ if (lf_debug>1) printf("call eval structure\n");
+ switch(ev(&lf->evs))
+ { case EPHULL: triang_start(des,lf); break;
+ case EDATA: dataf(des,lf); break;
+ case ECROS: crossf(des,lf); break;
+ case EGRID: gridf(des,lf); break;
+ case ETREE: atree_start(des,lf); break;
+ case EKDCE: kt(&lf->sp) = KCE;
+ case EKDTR: kdtre_start(des,lf); break;
+ case EPRES: preset(des,lf); break;
+ case EXBAR: xbarf(des,lf); break;
+ case ENONE: lf->fp.nv = lf->evs.nce = 0;
+ return;
+ case ESPHR: sphere_start(des,lf); break;
+ case ESPEC: lf->evs.espec(des,lf); break;
+ default: ERROR(("startlf: Invalid evaluation structure %d",ev(&lf->evs)));
+ }
+
+ /* renormalize for family=density */
+ if ((de_renorm) && (fam(&lf->sp)==TDEN)) dens_renorm(lf,des);
+}
diff --git a/src/tube.h b/src/tube.h
new file mode 100755
index 0000000..50fdc06
--- /dev/null
+++ b/src/tube.h
@@ -0,0 +1,49 @@
+/*
+ * Copyright (c) 1998-2001 Catherine Loader, Jiayang Sun
+ * See README file for details.
+ *
+ *
+ * Headers for the tube library.
+ */
+
+#ifndef I_TUBE_H
+#define I_TUBE_H
+
+/*
+ * public functions needed by routines calling the tube library.
+ */
+extern double critval();
+extern double tailp(), taild();
+extern int tube_constants();
+extern int k0_reqd();
+
+/*
+ * stuff used internally.
+ */
+
+#include "mutil.h"
+
+#define TUBE_MXDIM 10
+
+/*
+ * definitions for integration methods.
+ * these match locfit evaluation structures where applicable.
+ */
+
+#define ISIMPSON 4 /* grid */
+#define ISPHERIC 11 /* circle or sphere */
+#define IDERFREE 25 /* derivative free */
+#define IMONTE 30 /* monte carlo */
+
+#ifndef PI
+#define PI 3.141592653589793238462643
+
+#endif
+
+#define ONE_SIDED 1
+#define TWO_SIDED 2
+
+#define UNIF 400
+#define GAUSS 401
+#define TPROC 402
+#endif /* define I_TUBE_H */
diff --git a/src/weight.c b/src/weight.c
new file mode 100755
index 0000000..24cf4fe
--- /dev/null
+++ b/src/weight.c
@@ -0,0 +1,463 @@
+/*
+ * Copyright (c) 1996-2001 Lucent Technologies.
+ * See README file for details.
+ *
+ *
+ * Defines the weight functions and related quantities used
+ * in LOCFIT.
+ */
+
+#include "local.h"
+
+
+/* The weight functions themselves. Used everywhere. */
+double W(u,ker)
+double u;
+int ker;
+{ u = fabs(u);
+ switch(ker)
+ { case WRECT: return((u>1) ? 0.0 : 1.0);
+ case WEPAN: return((u>1) ? 0.0 : 1-u*u);
+ case WBISQ: if (u>1) return(0.0);
+ u = 1-u*u; return(u*u);
+ case WTCUB: if (u>1) return(0.0);
+ u = 1-u*u*u; return(u*u*u);
+ case WTRWT: if (u>1) return(0.0);
+ u = 1-u*u; return(u*u*u);
+ case WQUQU: if (u>1) return(0.0);
+ u = 1-u*u; return(u*u*u*u);
+ case WTRIA: if (u>1) return(0.0);
+ return(1-u);
+ case W6CUB: if (u>1) return(0.0);
+ u = 1-u*u*u; u = u*u*u; return(u*u);
+ case WGAUS: return(exp(-SQR(GFACT*u)/2.0));
+ case WEXPL: return(exp(-EFACT*u));
+ case WMACL: return(1/((u+1.0e-100)*(u+1.0e-100)));
+ case WMINM: ERROR(("WMINM in W"));
+ return(0.0);
+ case WPARM: return(1.0);
+ }
+ ERROR(("W(): Unknown kernel %d\n",ker));
+ return(1.0);
+}
+
+int iscompact(ker)
+int ker;
+{ if ((ker==WEXPL) | (ker==WGAUS) | (ker==WMACL) | (ker==WPARM)) return(0);
+ return(1);
+}
+
+double weightprod(lfd,u,h,ker)
+lfdata *lfd;
+double *u, h;
+int ker;
+{ int i;
+ double sc, w;
+ w = 1.0;
+ for (i=0; i<lfd->d; i++)
+ { sc = lfd->sca[i];
+ switch(lfd->sty[i])
+ { case STLEFT:
+ if (u[i]>0) return(0.0);
+ w *= W(-u[i]/(h*sc),ker);
+ break;
+ case STRIGH:
+ if (u[i]<0) return(0.0);
+ w *= W(u[i]/(h*sc),ker);
+ break;
+ case STANGL:
+ w *= W(2*fabs(sin(u[i]/(2*sc)))/h,ker);
+ break;
+ case STCPAR:
+ break;
+ default:
+ w *= W(fabs(u[i])/(h*sc),ker);
+ }
+ if (w==0.0) return(w);
+ }
+ return(w);
+}
+
+double weightsph(lfd,u,h,ker, hasdi,di)
+lfdata *lfd;
+double *u, h, di;
+int ker, hasdi;
+{ int i;
+
+ if (!hasdi) di = rho(u,lfd->sca,lfd->d,KSPH,lfd->sty);
+
+ for (i=0; i<lfd->d; i++)
+ { if ((lfd->sty[i]==STLEFT) && (u[i]>0.0)) return(0.0);
+ if ((lfd->sty[i]==STRIGH) && (u[i]<0.0)) return(0.0);
+ }
+ if (h==0) return((di==0.0) ? 1.0 : 0.0);
+
+ return(W(di/h,ker));
+}
+
+double weight(lfd,sp,x,t,h, hasdi,di)
+lfdata *lfd;
+smpar *sp;
+double *x, *t, h, di;
+int hasdi;
+{ double u[MXDIM];
+ int i;
+ for (i=0; i<lfd->d; i++) u[i] = (t==NULL) ? x[i] : x[i]-t[i];
+ switch(kt(sp))
+ { case KPROD: return(weightprod(lfd,u,h,ker(sp)));
+ case KSPH: return(weightsph(lfd,u,h,ker(sp), hasdi,di));
+ }
+ ERROR(("weight: unknown kernel type %d",kt(sp)));
+ return(1.0);
+}
+
+double sgn(x)
+double x;
+{ if (x>0) return(1.0);
+ if (x<0) return(-1.0);
+ return(0.0);
+}
+
+double WdW(u,ker) /* W'(u)/W(u) */
+double u;
+int ker;
+{ double eps=1.0e-10;
+ if (ker==WGAUS) return(-GFACT*GFACT*u);
+ if (ker==WPARM) return(0.0);
+ if (fabs(u)>=1) return(0.0);
+ switch(ker)
+ { case WRECT: return(0.0);
+ case WTRIA: return(-sgn(u)/(1-fabs(u)+eps));
+ case WEPAN: return(-2*u/(1-u*u+eps));
+ case WBISQ: return(-4*u/(1-u*u+eps));
+ case WTRWT: return(-6*u/(1-u*u+eps));
+ case WTCUB: return(-9*sgn(u)*u*u/(1-u*u*fabs(u)+eps));
+ case WEXPL: return((u>0) ? -EFACT : EFACT);
+ }
+ ERROR(("WdW: invalid kernel"));
+ return(0.0);
+}
+
+/* deriv. weights .. spherical, product etc
+ u, sc, sty needed only in relevant direction
+ Acutally, returns (d/dx W(||x||/h) ) / W(.)
+*/
+double weightd(u,sc,d,ker,kt,h,sty,di)
+double u, sc, h, di;
+int d, ker, kt, sty;
+{ if (sty==STANGL)
+ { if (kt==KPROD)
+ return(-WdW(2*sin(u/(2*sc)),ker)*cos(u/(2*sc))/(h*sc));
+ if (di==0.0) return(0.0);
+ return(-WdW(di/h,ker)*sin(u/sc)/(h*sc*di));
+ }
+ if (sty==STCPAR) return(0.0);
+ if (kt==KPROD)
+ return(-WdW(u/(h*sc),ker)/(h*sc));
+ if (di==0.0) return(0.0);
+ return(-WdW(di/h,ker)*u/(h*di*sc*sc));
+}
+
+double weightdd(u,sc,d,ker,kt,h,sty,di,i0,i1)
+double *u, *sc, h, di;
+int d, ker, kt, i0, i1, *sty;
+{ double w;
+ w = 1;
+ if (kt==KPROD)
+ {
+ w = WdW(u[i0]/(h*sc[i0]),ker)*WdW(u[i1]/(h*sc[i1]),ker)/(h*h*sc[i0]*sc[i1]);
+ }
+ return(0.0);
+}
+
+/* Derivatives W'(u)/u.
+ Used in simult. conf. band computations,
+ and kernel density bandwidth selectors. */
+double Wd(u,ker)
+double u;
+int ker;
+{ double v;
+ if (ker==WGAUS) return(-SQR(GFACT)*exp(-SQR(GFACT*u)/2));
+ if (ker==WPARM) return(0.0);
+ if (fabs(u)>1) return(0.0);
+ switch(ker)
+ { case WEPAN: return(-2.0);
+ case WBISQ: return(-4*(1-u*u));
+ case WTCUB: v = 1-u*u*u;
+ return(-9*v*v*u);
+ case WTRWT: v = 1-u*u;
+ return(-6*v*v);
+ default: ERROR(("Invalid kernel %d in Wd",ker));
+ }
+ return(0.0);
+}
+
+/* Second derivatives W''(u)-W'(u)/u.
+ used in simult. conf. band computations in >1 dimension. */
+double Wdd(u,ker)
+double u;
+int ker;
+{ double v;
+ if (ker==WGAUS) return(SQR(u*GFACT*GFACT)*exp(-SQR(u*GFACT)/2));
+ if (ker==WPARM) return(0.0);
+ if (u>1) return(0.0);
+ switch(ker)
+ { case WBISQ: return(12*u*u);
+ case WTCUB: v = 1-u*u*u;
+ return(-9*u*v*v+54*u*u*u*u*v);
+ case WTRWT: return(24*u*u*(1-u*u));
+ default: ERROR(("Invalid kernel %d in Wdd",ker));
+ }
+ return(0.0);
+}
+
+/* int u1^j1..ud^jd W(u) du.
+ Used for local log-linear density estimation.
+ Assume all j_i are even.
+ Also in some bandwidth selection.
+*/
+double wint(d,j,nj,ker)
+int d, *j, nj, ker;
+{ double I=0.0, z;
+ int k, dj;
+ dj = d;
+ for (k=0; k<nj; k++) dj += j[k];
+ switch(ker) /* int_0^1 u^(dj-1) W(u)du */
+ { case WRECT: I = 1.0/dj; break;
+ case WEPAN: I = 2.0/(dj*(dj+2)); break;
+ case WBISQ: I = 8.0/(dj*(dj+2)*(dj+4)); break;
+ case WTCUB: I = 162.0/(dj*(dj+3)*(dj+6)*(dj+9)); break;
+ case WTRWT: I = 48.0/(dj*(dj+2)*(dj+4)*(dj+6)); break;
+ case WTRIA: I = 1.0/(dj*(dj+1)); break;
+ case WQUQU: I = 384.0/(dj*(dj+2)*(dj+4)*(dj+6)*(dj+8)); break;
+ case W6CUB: I = 524880.0/(dj*(dj+3)*(dj+6)*(dj+9)*(dj+12)*(dj+15)*(dj+18)); break;
+ case WGAUS: switch(d)
+ { case 1: I = S2PI/GFACT; break;
+ case 2: I = 2*PI/(GFACT*GFACT); break;
+ default: I = exp(d*log(S2PI/GFACT)); /* for nj=0 */
+ }
+ for (k=0; k<nj; k++) /* deliberate drop */
+ switch(j[k])
+ { case 4: I *= 3.0/(GFACT*GFACT);
+ case 2: I /= GFACT*GFACT;
+ }
+ return(I);
+ case WEXPL: I = factorial(dj-1)/ipower(EFACT,dj); break;
+ default: ERROR(("Unknown kernel %d in exacint",ker));
+ }
+ if ((d==1) && (nj==0)) return(2*I); /* common case quick */
+ z = (d-nj)*LOGPI/2-LGAMMA(dj/2.0);
+ for (k=0; k<nj; k++) z += LGAMMA((j[k]+1)/2.0);
+ return(2*I*exp(z));
+}
+
+/* taylor series expansion of weight function around x.
+ 0 and 1 are common arguments, so are worth programming
+ as special cases.
+ Used in density estimation.
+*/
+int wtaylor(f,x,ker)
+double *f, x;
+int ker;
+{ double v;
+ switch(ker)
+ { case WRECT:
+ f[0] = 1.0;
+ return(1);
+ case WEPAN:
+ f[0] = 1-x*x; f[1] = -2*x; f[2] = -1;
+ return(3);
+ case WBISQ:
+ v = 1-x*x;
+ f[0] = v*v; f[1] = -4*x*v; f[2] = 4-6*v;
+ f[3] = 4*x; f[4] = 1;
+ return(5);
+ case WTCUB:
+ if (x==1.0)
+ { f[0] = f[1] = f[2] = 0; f[3] = -27; f[4] = -81; f[5] = -108;
+ f[6] = -81; f[7] = -36; f[8] = -9; f[9] = -1; return(10); }
+ if (x==0.0)
+ { f[1] = f[2] = f[4] = f[5] = f[7] = f[8] = 0;
+ f[0] = 1; f[3] = -3; f[6] = 3; f[9] = -1; return(10); }
+ v = 1-x*x*x;
+ f[0] = v*v*v; f[1] = -9*v*v*x*x; f[2] = x*v*(27-36*v);
+ f[3] = -27+v*(108-84*v); f[4] = -3*x*x*(27-42*v);
+ f[5] = x*(-108+126*v); f[6] = -81+84*v;
+ f[7] = -36*x*x; f[8] = -9*x; f[9] = -1;
+ return(10);
+ case WTRWT:
+ v = 1-x*x;
+ f[0] = v*v*v; f[1] = -6*x*v*v; f[2] = v*(12-15*v);
+ f[3] = x*(20*v-8); f[4] = 15*v-12; f[5] = -6; f[6] = -1;
+ return(7);
+ case WTRIA:
+ f[0] = 1-x; f[1] = -1;
+ return(2);
+ case WQUQU:
+ v = 1-x*x;
+ f[0] = v*v*v*v; f[1] = -8*x*v*v*v; f[2] = v*v*(24-28*v);
+ f[3] = v*x*(56*v-32); f[4] = (70*v-80)*v+16; f[5] = x*(32-56*v);
+ f[6] = 24-28*v; f[7] = 8*x; f[8] = 1;
+ return(9);
+ case W6CUB:
+ v = 1-x*x*x;
+ f[0] = v*v*v*v*v*v;
+ f[1] = -18*x*x*v*v*v*v*v;
+ f[2] = x*v*v*v*v*(135-153*v);
+ f[3] = v*v*v*(-540+v*(1350-816*v));
+ f[4] = x*x*v*v*(1215-v*(4050-v*3060));
+ f[5] = x*v*(-1458+v*(9234+v*(-16254+v*8568)));
+ f[6] = 729-v*(10206-v*(35154-v*(44226-v*18564)));
+ f[7] = x*x*(4374-v*(30132-v*(56862-v*31824)));
+ f[8] = x*(12393-v*(61479-v*(92664-v*43758)));
+ f[9] = 21870-v*(89100-v*(115830-v*48620));
+ f[10]= x*x*(26730-v*(69498-v*43758));
+ f[11]= x*(23814-v*(55458-v*31824));
+ f[12]= 15849-v*(34398-v*18564);
+ f[13]= x*x*(7938-8568*v);
+ f[14]= x*(2970-3060*v);
+ f[15]= 810-816*v;
+ f[16]= 153*x*x;
+ f[17]= 18*x;
+ f[18]= 1;
+ return(19);
+ }
+ ERROR(("Invalid kernel %d in wtaylor",ker));
+ return(0);
+}
+
+/* convolution int W(x)W(x+v)dx.
+ used in kde bandwidth selection.
+*/
+double Wconv(v,ker)
+double v;
+int ker;
+{ double v2;
+ switch(ker)
+ { case WGAUS: return(SQRPI/GFACT*exp(-SQR(GFACT*v)/4));
+ case WRECT:
+ v = fabs(v);
+ if (v>2) return(0.0);
+ return(2-v);
+ case WEPAN:
+ v = fabs(v);
+ if (v>2) return(0.0);
+ return((2-v)*(16+v*(8-v*(16-v*(2+v))))/30);
+ case WBISQ:
+ v = fabs(v);
+ if (v>2) return(0.0);
+ v2 = 2-v;
+ return(v2*v2*v2*v2*v2*(16+v*(40+v*(36+v*(10+v))))/630);
+ }
+ ERROR(("Wconv not implemented for kernel %d",ker));
+ return(0.0);
+}
+
+/* derivative of Wconv.
+ 1/v d/dv int W(x)W(x+v)dx
+ used in kde bandwidth selection.
+*/
+double Wconv1(v,ker)
+double v;
+int ker;
+{ double v2;
+ v = fabs(v);
+ switch(ker)
+ { case WGAUS: return(-0.5*SQRPI*GFACT*exp(-SQR(GFACT*v)/4));
+ case WRECT:
+ if (v>2) return(0.0);
+ return(1.0);
+ case WEPAN:
+ if (v>2) return(0.0);
+ return((-16+v*(12-v*v))/6);
+ case WBISQ:
+ if (v>2) return(0.0);
+ v2 = 2-v;
+ return(-v2*v2*v2*v2*(32+v*(64+v*(24+v*3)))/210);
+ }
+ ERROR(("Wconv1 not implemented for kernel %d",ker));
+ return(0.0);
+}
+
+/* 4th derivative of Wconv.
+ used in kde bandwidth selection (BCV, SJPI, GKK)
+*/
+double Wconv4(v,ker)
+double v;
+int ker;
+{ double gv;
+ switch(ker)
+ { case WGAUS:
+ gv = GFACT*v;
+ return(exp(-SQR(gv)/4)*GFACT*GFACT*GFACT*(12-gv*gv*(12-gv*gv))*SQRPI/16);
+ }
+ ERROR(("Wconv4 not implemented for kernel %d",ker));
+ return(0.0);
+}
+
+/* 5th derivative of Wconv.
+ used in kde bandwidth selection (BCV method only)
+*/
+double Wconv5(v,ker) /* (d/dv)^5 int W(x)W(x+v)dx */
+double v;
+int ker;
+{ double gv;
+ switch(ker)
+ { case WGAUS:
+ gv = GFACT*v;
+ return(-exp(-SQR(gv)/4)*GFACT*GFACT*GFACT*GFACT*gv*(60-gv*gv*(20-gv*gv))*SQRPI/32);
+ }
+ ERROR(("Wconv5 not implemented for kernel %d",ker));
+ return(0.0);
+}
+
+/* 6th derivative of Wconv.
+ used in kde bandwidth selection (SJPI)
+*/
+double Wconv6(v,ker)
+double v;
+int ker;
+{ double gv, z;
+ switch(ker)
+ { case WGAUS:
+ gv = GFACT*v;
+ gv = gv*gv;
+ z = exp(-gv/4)*(-120+gv*(180-gv*(30-gv)))*0.02769459142;
+ gv = GFACT*GFACT;
+ return(z*gv*gv*GFACT);
+ }
+ ERROR(("Wconv6 not implemented for kernel %d",ker));
+ return(0.0);
+}
+
+/* int W(v)^2 dv / (int v^2 W(v) dv)^2
+ used in some bandwidth selectors
+*/
+double Wikk(ker,deg)
+int ker, deg;
+{ switch(deg)
+ { case 0:
+ case 1: /* int W(v)^2 dv / (int v^2 W(v) dv)^2 */
+ switch(ker)
+ { case WRECT: return(4.5);
+ case WEPAN: return(15.0);
+ case WBISQ: return(35.0);
+ case WGAUS: return(0.2820947918*GFACT*GFACT*GFACT*GFACT*GFACT);
+ case WTCUB: return(34.15211105);
+ case WTRWT: return(66.08391608);
+ }
+ case 2:
+ case 3: /* 4!^2/8*int(W1^2)/int(v^4W1)^2
+ W1=W*(n4-v^2n2)/(n0n4-n2n2) */
+ switch(ker)
+ { case WRECT: return(11025.0);
+ case WEPAN: return(39690.0);
+ case WBISQ: return(110346.9231);
+ case WGAUS: return(14527.43412);
+ case WTCUB: return(126500.5904);
+ case WTRWT: return(254371.7647);
+ }
+ }
+ ERROR(("Wikk not implemented for kernel %d",ker));
+ return(0.0);
+}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-med/r-cran-locfit.git
More information about the debian-med-commit
mailing list