Commit 2b1bc647 authored by Dirk Eddelbuettel's avatar Dirk Eddelbuettel

Import Upstream version 1.8-16

parent b90a627e
...@@ -5,6 +5,53 @@ Currently deprecated and liable to be removed: ...@@ -5,6 +5,53 @@ Currently deprecated and liable to be removed:
- single penalty tensor product smooths. - single penalty tensor product smooths.
- p.type!=0 in summary.gam. - p.type!=0 in summary.gam.
1.8-16
* slightly improved intial value heuristics for overlapping penalties in
general family case.
* 'ocat' checks that response is numeric.
* plot.gam(...,scale=-1) now changes scale according to 'trans' and 'shift'.
* newton optimizer made slightly more cautious: contracts step if reduction
in true objective too far different from reduction predicted by quadratic
approximation underlying Newton step. Also leaves parameters unchanged
in Newton step while their grad is less than 1% of max grad.
* Fix to Fisher weight computation in gam.fit4. Previously a weight could
(rarely) evaluate as negative machine prec instead of zero, get passed to
gdi2 in C code, generate a NaN when square rooted, resulting in a NaN passed
to the LAPACK dgeqp3 routine, which then hung in a non-interuptable way.
* Fix of 'sp' argument handling with multiple formulae. Allocation to terms
could be incorrect.
* Option 'edge.correct' added to 'gam.control' to allow better correction
of edge of smoothing parameter space effects with 'gam' when RE/ML used.
* Fix to setting of penalty rank in smooth.construct.mrf.smooth.spec.
Previously this was wrong, which could cause failure with gamm if the
penalty was rank deficient. Thanks Paul Buerkner.
* Fix to Vb.corr call from gam.fit3.post.proc to ensure that sp not
dropped (wrongly treated as scale estimate) when P-REML or P-ML used.
Could cause failure depending on BLAS. Thanks Matteo Fasiolo.
* Fix in gam.outer that caused failure with "efs" optimizer and fixed sps.
* Fix to `get.var' to drop matrix attributes of 1 column matrix variables.
* Extra argument added to `uniquecombs' to allow result to have same row
ordering regardless of input data ordering. Now used by smooth constructors
that subsample unique covariate values during basis setup to ensure
invariance to data re-ordering.
* Correction of scaling error in spherical correlation structure GP smooth.
* qf and rd functions for binomial family fixed for zero n case.
1.8-15 1.8-15
* Fix of survival function prediction in cox.ph family. Code used expression * Fix of survival function prediction in cox.ph family. Code used expression
......
Package: mgcv Package: mgcv
Version: 1.8-15 Version: 1.8-16
Author: Simon Wood <simon.wood@r-project.org> Author: Simon Wood <simon.wood@r-project.org>
Maintainer: Simon Wood <simon.wood@r-project.org> Maintainer: Simon Wood <simon.wood@r-project.org>
Title: Mixed GAM Computation Vehicle with GCV/AIC/REML Smoothness Title: Mixed GAM Computation Vehicle with GCV/AIC/REML Smoothness
...@@ -16,6 +16,6 @@ LazyLoad: yes ...@@ -16,6 +16,6 @@ LazyLoad: yes
ByteCompile: yes ByteCompile: yes
License: GPL (>= 2) License: GPL (>= 2)
NeedsCompilation: yes NeedsCompilation: yes
Packaged: 2016-09-13 10:00:39 UTC; sw283 Packaged: 2016-11-07 10:22:00 UTC; sw283
Repository: CRAN Repository: CRAN
Date/Publication: 2016-09-14 18:51:00 Date/Publication: 2016-11-07 19:28:16
0d9b05a5c3954f23ca64d831c45daf89 *ChangeLog a38e3e6c9f0ae98bdcf3d14127347fde *ChangeLog
992b7d6af50703c1753fe3dd458a9df3 *DESCRIPTION e051228d6327e0b3d640616d4fa510c3 *DESCRIPTION
eb723b61539feef013de476e68b5c50a *GPL-2 eb723b61539feef013de476e68b5c50a *GPL-2
595f7fa74dd678ae4be1f6968e174555 *NAMESPACE 595f7fa74dd678ae4be1f6968e174555 *NAMESPACE
41b51c0155f4cb0b9d746d896108c160 *R/bam.r 1aee82e17a9feb6166dbe107659029c9 *R/bam.r
87933a9e2845f871334d96f537ee11e9 *R/coxph.r 87933a9e2845f871334d96f537ee11e9 *R/coxph.r
fdb1dd621eb177107bbfb5f5c11777b2 *R/efam.r a25f5a55d9d8b4ada56ac0df3ec99a18 *R/efam.r
4b370253beb1eda19d389132ade30212 *R/fast-REML.r 4b370253beb1eda19d389132ade30212 *R/fast-REML.r
dea8bcbb4668ad0a6dfe3420bebebf48 *R/gam.fit3.r cb165a0a11de9686910fb27b0d6450ec *R/gam.fit3.r
6f57e0f2cb348d07754b0e41a374e76c *R/gam.fit4.r 7734ba62022328a50b771e721df98a72 *R/gam.fit4.r
1b620b840ca67c9759639bd6e53824e3 *R/gam.sim.r 1b620b840ca67c9759639bd6e53824e3 *R/gam.sim.r
66257913c556f135657b7c12b6ed733d *R/gamlss.r 66257913c556f135657b7c12b6ed733d *R/gamlss.r
cceac26b3d01513f8f87eacae91ddae0 *R/gamm.r cceac26b3d01513f8f87eacae91ddae0 *R/gamm.r
4a0ce642d904d7f871b5b766c04a2af4 *R/jagam.r 10facb791e4cfd123d183f05660119c6 *R/jagam.r
71d23c1ee219ca4242d5f49ccd164970 *R/mgcv.r 8cebce4d68d4c45d661073756ca7b202 *R/mgcv.r
2feca0dc9d354de7bc707c67a5891364 *R/misc.r 2feca0dc9d354de7bc707c67a5891364 *R/misc.r
03772998ab05887f2eeae10dd6efe983 *R/mvam.r 03772998ab05887f2eeae10dd6efe983 *R/mvam.r
586b0b4447aeb73b28fac9bdfefd3e21 *R/plots.r 5d07d6e4f75a64b6d04cda9e23278d70 *R/plots.r
38a7e6b503af65a76ffe999ac66049bb *R/smooth.r cf3543d1d4b7fe6fb8576f681b345722 *R/smooth.r
666d7fd36fda68b928993d5388b0d7fc *R/soap.r 666d7fd36fda68b928993d5388b0d7fc *R/soap.r
76cc875719bf0ef9eab45ea5bfeccda6 *R/sparse.r 76cc875719bf0ef9eab45ea5bfeccda6 *R/sparse.r
e468195a83fab90da8e760c2c3884bd3 *data/columb.polys.rda e468195a83fab90da8e760c2c3884bd3 *data/columb.polys.rda
...@@ -58,9 +58,9 @@ e75719779e18c723ee1fd17e44e7901b *man/formXtViX.Rd ...@@ -58,9 +58,9 @@ e75719779e18c723ee1fd17e44e7901b *man/formXtViX.Rd
88888e966394c9f9792d9537341d053c *man/formula.gam.Rd 88888e966394c9f9792d9537341d053c *man/formula.gam.Rd
4da4d585b329769eb44f0c7a6e7dd554 *man/fs.test.Rd 4da4d585b329769eb44f0c7a6e7dd554 *man/fs.test.Rd
6f405acde2d7b6f464cf45f5395113ba *man/full.score.Rd 6f405acde2d7b6f464cf45f5395113ba *man/full.score.Rd
912f575e1a6a7c9b1b94b2130fdfb38b *man/gam.Rd 0c075e9e58df199d59e77d94b712fde6 *man/gam.Rd
adaf0bd8e82d9472823cf3f3fa05e111 *man/gam.check.Rd adaf0bd8e82d9472823cf3f3fa05e111 *man/gam.check.Rd
49de68e2abeb557b994032e4d7b5407a *man/gam.control.Rd 8931cd75ddec14d91ec94dec6ba69362 *man/gam.control.Rd
44db24b66ce63bc16d2c8bc3f5b42ac5 *man/gam.convergence.Rd 44db24b66ce63bc16d2c8bc3f5b42ac5 *man/gam.convergence.Rd
1cf5145859af2263f4e3459f40e1ab23 *man/gam.fit.Rd 1cf5145859af2263f4e3459f40e1ab23 *man/gam.fit.Rd
4728be401da6eceb8b0c257377dc5d01 *man/gam.fit3.Rd 4728be401da6eceb8b0c257377dc5d01 *man/gam.fit3.Rd
...@@ -97,8 +97,8 @@ df702cea24d0f92044a973b66a57e21f *man/missing.data.Rd ...@@ -97,8 +97,8 @@ df702cea24d0f92044a973b66a57e21f *man/missing.data.Rd
00ccf213c31910cd14f1df65a300eb33 *man/model.matrix.gam.Rd 00ccf213c31910cd14f1df65a300eb33 *man/model.matrix.gam.Rd
2f2fdc722c5e9e58664da9378451cd4a *man/mono.con.Rd 2f2fdc722c5e9e58664da9378451cd4a *man/mono.con.Rd
d33914a328f645af13f5a42914ca0f35 *man/mroot.Rd d33914a328f645af13f5a42914ca0f35 *man/mroot.Rd
0748a44497317a19857f81bd76d162db *man/multinom.Rd f624f3afcf4e2192e8f724d45257d983 *man/multinom.Rd
d70954045abda626a357951da5e2cbca *man/mvn.Rd 8fa6cf27db7192bbad6a2d41d2780937 *man/mvn.Rd
1064099913e539a75bf763c764bc72a1 *man/negbin.Rd 1064099913e539a75bf763c764bc72a1 *man/negbin.Rd
8a6a1926188511235f1e7406120c791e *man/new.name.Rd 8a6a1926188511235f1e7406120c791e *man/new.name.Rd
00e39f302ab5efbe3b14265fffc16c18 *man/notExp.Rd 00e39f302ab5efbe3b14265fffc16c18 *man/notExp.Rd
...@@ -114,7 +114,7 @@ ee9352ba4c531a8def16deddcab9a9fd *man/pdIdnot.Rd ...@@ -114,7 +114,7 @@ ee9352ba4c531a8def16deddcab9a9fd *man/pdIdnot.Rd
b903ebcf31703db156e033fdfa527d73 *man/plot.gam.Rd b903ebcf31703db156e033fdfa527d73 *man/plot.gam.Rd
c27a6b886929b1dc83bf4b90cae848f9 *man/polys.plot.Rd c27a6b886929b1dc83bf4b90cae848f9 *man/polys.plot.Rd
1a9d83c9fc67e5f0fc85d66d3112f4ef *man/predict.bam.Rd 1a9d83c9fc67e5f0fc85d66d3112f4ef *man/predict.bam.Rd
2892714c395537c0cca29914989b1d50 *man/predict.gam.Rd 93f41380f769dff6a21394d80508c565 *man/predict.gam.Rd
cf14ce6cf8e4147f0f5c6e5b93b2af73 *man/print.gam.Rd cf14ce6cf8e4147f0f5c6e5b93b2af73 *man/print.gam.Rd
6d0ce4e574fabceffdbedd46c91364cb *man/qq.gam.Rd 6d0ce4e574fabceffdbedd46c91364cb *man/qq.gam.Rd
22b7dcbc8ff4096365fa98ce56b957c9 *man/rTweedie.Rd 22b7dcbc8ff4096365fa98ce56b957c9 *man/rTweedie.Rd
...@@ -122,7 +122,7 @@ fc1985e7dd5222182c4a8a939963b965 *man/random.effects.Rd ...@@ -122,7 +122,7 @@ fc1985e7dd5222182c4a8a939963b965 *man/random.effects.Rd
c523210ae95cb9aaa0aaa1c37da1a4c5 *man/residuals.gam.Rd c523210ae95cb9aaa0aaa1c37da1a4c5 *man/residuals.gam.Rd
3c747a8066bcc28ae706ccf74f903d3e *man/rig.Rd 3c747a8066bcc28ae706ccf74f903d3e *man/rig.Rd
9f6f46f5c5da080bc82f9aa4685d364a *man/rmvn.Rd 9f6f46f5c5da080bc82f9aa4685d364a *man/rmvn.Rd
845ec29324583d18c8dc150625e153e3 *man/s.Rd c4be33830dfeb9e0dc766f8e5498931d *man/s.Rd
d515e51ec98d73af6166f7b31aeaba9b *man/scat.Rd d515e51ec98d73af6166f7b31aeaba9b *man/scat.Rd
898e7cc2def2ee234475e68d0b904b29 *man/sdiag.Rd 898e7cc2def2ee234475e68d0b904b29 *man/sdiag.Rd
8e968226c2b65ee89c8de2fd9869b086 *man/single.index.Rd 8e968226c2b65ee89c8de2fd9869b086 *man/single.index.Rd
...@@ -149,11 +149,11 @@ b55a396da77559dac553613146633f97 *man/sp.vcov.Rd ...@@ -149,11 +149,11 @@ b55a396da77559dac553613146633f97 *man/sp.vcov.Rd
83bd8e097711bf5bd0fff09822743d43 *man/spasm.construct.Rd 83bd8e097711bf5bd0fff09822743d43 *man/spasm.construct.Rd
b9394812e5398ec95787c65c1325a027 *man/step.gam.Rd b9394812e5398ec95787c65c1325a027 *man/step.gam.Rd
f0791d830687d6155efb8a73db787401 *man/summary.gam.Rd f0791d830687d6155efb8a73db787401 *man/summary.gam.Rd
9ee8b9bd71f1b777ceb638fa21143cb9 *man/t2.Rd a0b0988dba55cca5b4b970e035e3c749 *man/t2.Rd
36db3873e3e810ab6ee481f177d2535c *man/te.Rd a27690f33b9a7bd56d9c1779c64896cc *man/te.Rd
6eebb6ef90374ee09453d6da6449ed79 *man/tensor.prod.model.matrix.Rd 6eebb6ef90374ee09453d6da6449ed79 *man/tensor.prod.model.matrix.Rd
f22f1cee0ff2b70628846d1d0f8e9a66 *man/trichol.Rd f22f1cee0ff2b70628846d1d0f8e9a66 *man/trichol.Rd
c6c5fe7f6bfe07b63080248020dab331 *man/uniquecombs.Rd 94154ff18af819a7bb83919ee10db0de *man/uniquecombs.Rd
a16b3a5a4d13c705dcab8d1cd1b3347e *man/vcov.gam.Rd a16b3a5a4d13c705dcab8d1cd1b3347e *man/vcov.gam.Rd
281e73658c726997196727a99a4a1f9e *man/vis.gam.Rd 281e73658c726997196727a99a4a1f9e *man/vis.gam.Rd
07a73758156dfa580c6e92edd34b0654 *man/ziP.Rd 07a73758156dfa580c6e92edd34b0654 *man/ziP.Rd
......
...@@ -129,7 +129,7 @@ compress.df <- function(dat,m=NULL) { ...@@ -129,7 +129,7 @@ compress.df <- function(dat,m=NULL) {
names(dat0) <- names(dat) names(dat0) <- names(dat)
dat <- dat0;rm(dat0) dat <- dat0;rm(dat0)
} }
xu <- uniquecombs(dat) xu <- uniquecombs(dat,TRUE)
if (nrow(xu)>mm*mf) { ## too many unique rows to use only unique if (nrow(xu)>mm*mf) { ## too many unique rows to use only unique
for (i in 1:d) if (!is.factor(dat[,i])) { ## round the metric variables for (i in 1:d) if (!is.factor(dat[,i])) { ## round the metric variables
xl <- range(dat[,i]) xl <- range(dat[,i])
...@@ -138,7 +138,7 @@ compress.df <- function(dat,m=NULL) { ...@@ -138,7 +138,7 @@ compress.df <- function(dat,m=NULL) {
kx <- round((dat[,i]-xl[1])/dx)+1 kx <- round((dat[,i]-xl[1])/dx)+1
dat[,i] <- xu[kx] ## rounding the metric variables dat[,i] <- xu[kx] ## rounding the metric variables
} }
xu <- uniquecombs(dat) xu <- uniquecombs(dat,TRUE)
} }
k <- attr(xu,"index") k <- attr(xu,"index")
## shuffle rows in order to avoid induced dependencies between discretized ## shuffle rows in order to avoid induced dependencies between discretized
......
...@@ -450,6 +450,7 @@ ocat <- function(theta=NULL,link="identity",R=NULL) { ...@@ -450,6 +450,7 @@ ocat <- function(theta=NULL,link="identity",R=NULL) {
theta <- log(theta) theta <- log(theta)
} }
R3 <- length(G$family$getTheta())+2 R3 <- length(G$family$getTheta())+2
if (!is.numeric(G$y)) stop("Response should be integer class labels")
if (R3>2&&G$family$n.theta>0) { if (R3>2&&G$family$n.theta>0) {
Theta <- ocat.ini(R3,G$y) Theta <- ocat.ini(R3,G$y)
G$family$putTheta(Theta) G$family$putTheta(Theta)
......
This diff is collapsed.
This diff is collapsed.
...@@ -165,7 +165,7 @@ sp.prior = "gamma",diagonalize=FALSE) { ...@@ -165,7 +165,7 @@ sp.prior = "gamma",diagonalize=FALSE) {
## get initial values, for use by JAGS, and to guess suitable values for ## get initial values, for use by JAGS, and to guess suitable values for
## uninformative priors... ## uninformative priors...
lambda <- initial.spg(G$X,G$y,G$w,family,G$S,G$off,offset=G$offset,L=G$L) ## initial sp values lambda <- initial.spg(G$X,G$y,G$w,family,G$S,G$rank,G$off,offset=G$offset,L=G$L) ## initial sp values
jags.ini <- list() jags.ini <- list()
lam <- if (is.null(G$L)) lambda else G$L%*%lambda lam <- if (is.null(G$L)) lambda else G$L%*%lambda
jin <- jini(G,lam) jin <- jini(G,lam)
......
...@@ -792,7 +792,8 @@ gam.setup.list <- function(formula,pterms, ...@@ -792,7 +792,8 @@ gam.setup.list <- function(formula,pterms,
#G$contrasts <- list(G$contrasts) #G$contrasts <- list(G$contrasts)
G$xlevels <- list(G$xlevels) G$xlevels <- list(G$xlevels)
G$assign <- list(G$assign) G$assign <- list(G$assign)
if (!is.null(sp)&&length(G$sp)>0) sp <- sp[-(1:length(G$sp))] ## need to strip off already used sp's used.sp <- length(G$lsp0)
if (!is.null(sp)&&used.sp>0) sp <- sp[-(1:used.sp)] ## need to strip off already used sp's
if (!is.null(min.sp)&&nrow(G$L)>0) min.sp <- min.sp[-(1:nrow(G$L))] if (!is.null(min.sp)&&nrow(G$L)>0) min.sp <- min.sp[-(1:nrow(G$L))]
## formula[[1]] always relates to the base formula of the first linear predictor... ## formula[[1]] always relates to the base formula of the first linear predictor...
...@@ -810,12 +811,14 @@ gam.setup.list <- function(formula,pterms, ...@@ -810,12 +811,14 @@ gam.setup.list <- function(formula,pterms,
formula[[i]]$response <- formula$response formula[[i]]$response <- formula$response
mv.response <- FALSE mv.response <- FALSE
} else mv.response <- TRUE } else mv.response <- TRUE
spind <- if (is.null(sp)) 1 else (length(G$S)+1):length(sp) #spind <- if (is.null(sp)) 1 else (length(G$S)+1):length(sp)
formula[[i]]$pfok <- 1 ## empty formulae OK here! formula[[i]]$pfok <- 1 ## empty formulae OK here!
um <- gam.setup(formula[[i]],pterms[[i]], um <- gam.setup(formula[[i]],pterms[[i]],
data,knots,sp[spind],min.sp[spind],H,absorb.cons,sparse.cons,select, data,knots,sp,min.sp,#sp[spind],min.sp[spind],
H,absorb.cons,sparse.cons,select,
idLinksBases,scale.penalty,paraPen,gamm.call,drop.intercept[i],list.call=TRUE) idLinksBases,scale.penalty,paraPen,gamm.call,drop.intercept[i],list.call=TRUE)
if (!is.null(sp)&&length(um$sp)>0) sp <- sp[-(1:length(um$sp))] ## need to strip off already used sp's used.sp <- length(um$lsp0)
if (!is.null(sp)&&used.sp>0) sp <- sp[-(1:used.sp)] ## need to strip off already used sp's
if (!is.null(min.sp)&&nrow(um$L)>0) min.sp <- min.sp[-(1:nrow(um$L))] if (!is.null(min.sp)&&nrow(um$L)>0) min.sp <- min.sp[-(1:nrow(um$L))]
flpi[[i]] <- formula[[i]]$lpi flpi[[i]] <- formula[[i]]$lpi
...@@ -1445,7 +1448,7 @@ gam.outer <- function(lsp,fscale,family,control,method,optimizer,criterion,scale ...@@ -1445,7 +1448,7 @@ gam.outer <- function(lsp,fscale,family,control,method,optimizer,criterion,scale
family <- fix.family.var(family) family <- fix.family.var(family)
if (method%in%c("REML","ML","P-REML","P-ML")) family <- fix.family.ls(family) if (method%in%c("REML","ML","P-REML","P-ML")) family <- fix.family.ls(family)
if (optimizer[1]=="efs") { ## experimental extended efs if (optimizer[1]=="efs"&& optimizer[2] != "no.sps" ) { ## experimental extended efs
##warning("efs is still experimental!") ##warning("efs is still experimental!")
object <- efsud(x=G$X,y=G$y,lsp=lsp,Sl=G$Sl,weights=G$w,offset=G$offxset,family=family, object <- efsud(x=G$X,y=G$y,lsp=lsp,Sl=G$Sl,weights=G$w,offset=G$offxset,family=family,
control=control,Mp=G$Mp,start=start) control=control,Mp=G$Mp,start=start)
...@@ -1461,7 +1464,8 @@ gam.outer <- function(lsp,fscale,family,control,method,optimizer,criterion,scale ...@@ -1461,7 +1464,8 @@ gam.outer <- function(lsp,fscale,family,control,method,optimizer,criterion,scale
family=family,weights=G$w,control=control,gamma=gamma,scale=scale,conv.tol=control$newton$conv.tol, family=family,weights=G$w,control=control,gamma=gamma,scale=scale,conv.tol=control$newton$conv.tol,
maxNstep= control$newton$maxNstep,maxSstep=control$newton$maxSstep,maxHalf=control$newton$maxHalf, maxNstep= control$newton$maxNstep,maxSstep=control$newton$maxSstep,maxHalf=control$newton$maxHalf,
printWarn=FALSE,scoreType=criterion,null.coef=G$null.coef,start=start, printWarn=FALSE,scoreType=criterion,null.coef=G$null.coef,start=start,
pearson.extra=G$pearson.extra,dev.extra=G$dev.extra,n.true=G$n.true,Sl=G$Sl,...) pearson.extra=G$pearson.extra,dev.extra=G$dev.extra,n.true=G$n.true,Sl=G$Sl,
edge.correct=control$edge.correct,...)
object <- b$object object <- b$object
object$REML <- object$REML1 <- object$REML2 <- object$REML <- object$REML1 <- object$REML2 <-
...@@ -1504,6 +1508,7 @@ gam.outer <- function(lsp,fscale,family,control,method,optimizer,criterion,scale ...@@ -1504,6 +1508,7 @@ gam.outer <- function(lsp,fscale,family,control,method,optimizer,criterion,scale
} }
object$control <- control object$control <- control
object$method <- method
if (inherits(family,"general.family")) { if (inherits(family,"general.family")) {
mv <- gam.fit5.post.proc(object,G$Sl,G$L,G$lsp0,G$S,G$off) mv <- gam.fit5.post.proc(object,G$Sl,G$L,G$lsp0,G$S,G$off)
## object$coefficients <- Sl.initial.repara(G$Sl,object$coefficients,inverse=TRUE) ## object$coefficients <- Sl.initial.repara(G$Sl,object$coefficients,inverse=TRUE)
...@@ -1662,7 +1667,7 @@ estimate.gam <- function (G,method,optimizer,control,in.out,scale,gamma,start=NU ...@@ -1662,7 +1667,7 @@ estimate.gam <- function (G,method,optimizer,control,in.out,scale,gamma,start=NU
if (!is.null(G$family$preinitialize)) eval(G$family$preinitialize) if (!is.null(G$family$preinitialize)) eval(G$family$preinitialize)
if (length(G$sp)>0) lsp2 <- log(initial.spg(G$X,G$y,G$w,G$family,G$S,G$off, if (length(G$sp)>0) lsp2 <- log(initial.spg(G$X,G$y,G$w,G$family,G$S,G$rank,G$off,
offset=G$offset,L=G$L,lsp0=G$lsp0,E=G$Eb,...)) offset=G$offset,L=G$L,lsp0=G$lsp0,E=G$Eb,...))
else lsp2 <- rep(0,0) else lsp2 <- rep(0,0)
...@@ -2052,7 +2057,7 @@ gam.control <- function (nthreads=1,irls.reg=0.0,epsilon = 1e-7, maxit = 200, ...@@ -2052,7 +2057,7 @@ gam.control <- function (nthreads=1,irls.reg=0.0,epsilon = 1e-7, maxit = 200,
rank.tol=.Machine$double.eps^0.5, rank.tol=.Machine$double.eps^0.5,
nlm=list(),optim=list(),newton=list(),outerPIsteps=0, nlm=list(),optim=list(),newton=list(),outerPIsteps=0,
idLinksBases=TRUE,scalePenalty=TRUE, idLinksBases=TRUE,scalePenalty=TRUE,
keepData=FALSE,scale.est="fletcher") keepData=FALSE,scale.est="fletcher",edge.correct=FALSE)
# Control structure for a gam. # Control structure for a gam.
# irls.reg is the regularization parameter to use in the GAM fitting IRLS loop. # irls.reg is the regularization parameter to use in the GAM fitting IRLS loop.
# epsilon is the tolerance to use in the IRLS MLE loop. maxit is the number # epsilon is the tolerance to use in the IRLS MLE loop. maxit is the number
...@@ -2063,6 +2068,8 @@ gam.control <- function (nthreads=1,irls.reg=0.0,epsilon = 1e-7, maxit = 200, ...@@ -2063,6 +2068,8 @@ gam.control <- function (nthreads=1,irls.reg=0.0,epsilon = 1e-7, maxit = 200,
# outerPIsteps is the number of performance iteration steps used to intialize # outerPIsteps is the number of performance iteration steps used to intialize
# outer iteration # outer iteration
{ scale.est <- match.arg(scale.est,c("fletcher","pearson","deviance")) { scale.est <- match.arg(scale.est,c("fletcher","pearson","deviance"))
if (!is.logical(edge.correct)&&(!is.numeric(edge.correct)||edge.correct<0)) stop(
"edge.correct must be logical or a positive number")
if (!is.numeric(nthreads) || nthreads <1) stop("nthreads must be a positive integer") if (!is.numeric(nthreads) || nthreads <1) stop("nthreads must be a positive integer")
if (!is.numeric(irls.reg) || irls.reg <0.0) stop("IRLS regularizing parameter must be a non-negative number.") if (!is.numeric(irls.reg) || irls.reg <0.0) stop("IRLS regularizing parameter must be a non-negative number.")
if (!is.numeric(epsilon) || epsilon <= 0) if (!is.numeric(epsilon) || epsilon <= 0)
...@@ -2108,7 +2115,7 @@ gam.control <- function (nthreads=1,irls.reg=0.0,epsilon = 1e-7, maxit = 200, ...@@ -2108,7 +2115,7 @@ gam.control <- function (nthreads=1,irls.reg=0.0,epsilon = 1e-7, maxit = 200,
rank.tol=rank.tol,nlm=nlm, rank.tol=rank.tol,nlm=nlm,
optim=optim,newton=newton,outerPIsteps=outerPIsteps, optim=optim,newton=newton,outerPIsteps=outerPIsteps,
idLinksBases=idLinksBases,scalePenalty=scalePenalty, idLinksBases=idLinksBases,scalePenalty=scalePenalty,
keepData=as.logical(keepData[1]),scale.est=scale.est) keepData=as.logical(keepData[1]),scale.est=scale.est,edge.correct=edge.correct)
} }
...@@ -4112,7 +4119,7 @@ single.sp <- function(X,S,target=.5,tol=.Machine$double.eps*100) ...@@ -4112,7 +4119,7 @@ single.sp <- function(X,S,target=.5,tol=.Machine$double.eps*100)
} }
initial.spg <- function(x,y,weights,family,S,off,offset=NULL,L=NULL,lsp0=NULL,type=1, initial.spg <- function(x,y,weights,family,S,rank,off,offset=NULL,L=NULL,lsp0=NULL,type=1,
start=NULL,mustart=NULL,etastart=NULL,E=NULL,...) { start=NULL,mustart=NULL,etastart=NULL,E=NULL,...) {
## initial smoothing parameter values based on approximate matching ## initial smoothing parameter values based on approximate matching
## of Frob norm of XWX and S. If L is non null then it is assumed ## of Frob norm of XWX and S. If L is non null then it is assumed
...@@ -4127,6 +4134,16 @@ initial.spg <- function(x,y,weights,family,S,off,offset=NULL,L=NULL,lsp0=NULL,ty ...@@ -4127,6 +4134,16 @@ initial.spg <- function(x,y,weights,family,S,off,offset=NULL,L=NULL,lsp0=NULL,ty
eval(family$initialize) eval(family$initialize)
if (inherits(family,"general.family")) { ## Cox, gamlss etc... if (inherits(family,"general.family")) { ## Cox, gamlss etc...
lbb <- family$ll(y,x,start,weights,family,offset=offset,deriv=1)$lbb ## initial Hessian lbb <- family$ll(y,x,start,weights,family,offset=offset,deriv=1)$lbb ## initial Hessian
## initially work out the number of times that each coefficient is penalized
pcount <- rep(0,ncol(lbb))
for (i in 1:length(S)) {
ind <- off[i]:(off[i]+ncol(S[[i]])-1)
dlb <- -diag(lbb[ind,ind])
indp <- rowSums(abs(S[[i]]))>max(S[[i]])*.Machine$double.eps^.75 & dlb!=0
ind <- ind[indp] ## drop indices of unpenalized
pcount[ind] <- pcount[ind] + 1 ## add up times penalized
}
lambda <- rep(0,length(S)) lambda <- rep(0,length(S))
## choose lambda so that corresponding elements of lbb and S[[i]] ## choose lambda so that corresponding elements of lbb and S[[i]]
## are roughly in balance... ## are roughly in balance...
...@@ -4134,12 +4151,17 @@ initial.spg <- function(x,y,weights,family,S,off,offset=NULL,L=NULL,lsp0=NULL,ty ...@@ -4134,12 +4151,17 @@ initial.spg <- function(x,y,weights,family,S,off,offset=NULL,L=NULL,lsp0=NULL,ty
ind <- off[i]:(off[i]+ncol(S[[i]])-1) ind <- off[i]:(off[i]+ncol(S[[i]])-1)
lami <- 1 lami <- 1
dlb <- -diag(lbb[ind,ind]);dS <- diag(S[[i]]) dlb <- -diag(lbb[ind,ind]);dS <- diag(S[[i]])
pc <- pcount[ind]
## get index of elements doing any actual penalization... ## get index of elements doing any actual penalization...
ind <- rowSums(abs(S[[i]]))>max(S[[i]])*.Machine$double.eps^.75 & dlb!=0 ## dlb > 0 ind <- rowSums(abs(S[[i]]))>max(S[[i]])*.Machine$double.eps^.75 & dlb!=0 ## dlb > 0
## drop elements that are not penalizing ## drop elements that are not penalizing
dlb <- dlb[ind];dS <- dS[ind] dlb <- dlb[ind]/pc[ind] ## idea is to share out between penalties
while (mean(dlb/(dlb + lami * dS)) > 0.4) lami <- lami*5 dS <- dS[ind]
while (mean(dlb/(dlb + lami * dS)) < 0.4) lami <- lami/5 rm <- max(length(dS)/rank[i],1) ## rough correction for rank deficiency in penalty
#while (mean(dlb/(dlb + lami * dS * rm)) > 0.4) lami <- lami*5
#while (mean(dlb/(dlb + lami * dS * rm )) < 0.4) lami <- lami/5
while (sqrt(mean(dlb/(dlb + lami * dS * rm))*mean(dlb)/mean(dlb+lami*dS*rm)) > 0.4) lami <- lami*5
while (sqrt(mean(dlb/(dlb + lami * dS * rm))*mean(dlb)/mean(dlb+lami*dS*rm)) < 0.4) lami <- lami/5
lambda[i] <- lami lambda[i] <- lami
## norm(lbb[ind,ind])/norm(S[[i]]) ## norm(lbb[ind,ind])/norm(S[[i]])
} }
......
...@@ -32,7 +32,7 @@ fix.family.qf <- function(fam) { ...@@ -32,7 +32,7 @@ fix.family.qf <- function(fam) {
} }
} else if (family=="binomial") { } else if (family=="binomial") {
fam$qf <- function(p,mu,wt,scale) { fam$qf <- function(p,mu,wt,scale) {
qbinom(p,wt,mu)/wt qbinom(p,wt,mu)/(wt + as.numeric(wt==0))
} }
} else if (family=="Gamma") { } else if (family=="Gamma") {
fam$qf <- function(p,mu,wt,scale) { fam$qf <- function(p,mu,wt,scale) {
...@@ -59,7 +59,7 @@ fix.family.rd <- function(fam) { ...@@ -59,7 +59,7 @@ fix.family.rd <- function(fam) {
} }
} else if (family=="binomial") { } else if (family=="binomial") {
fam$rd <- function(mu,wt,scale) { fam$rd <- function(mu,wt,scale) {
rbinom(mu,wt,mu)/wt rbinom(mu,wt,mu)/(wt + as.numeric(wt==0))
} }
} else if (family=="Gamma") { } else if (family=="Gamma") {
fam$rd <- function(mu,wt,scale) { fam$rd <- function(mu,wt,scale) {
...@@ -1196,6 +1196,7 @@ plot.gam <- function(x,residuals=FALSE,rug=TRUE,se=TRUE,pages=0,select=NULL,scal ...@@ -1196,6 +1196,7 @@ plot.gam <- function(x,residuals=FALSE,rug=TRUE,se=TRUE,pages=0,select=NULL,scal
if (ll < ylim[1]) ylim[1] <- ll if (ll < ylim[1]) ylim[1] <- ll
} ## partial resids done } ## partial resids done
} ## loop end } ## loop end
ylim <- trans(ylim+shift)
} ## end of common scale computation } ## end of common scale computation
############################################################## ##############################################################
......
This diff is collapsed.
...@@ -172,10 +172,11 @@ Otherwise the function returns an object of class \code{"gam"} as described in \ ...@@ -172,10 +172,11 @@ Otherwise the function returns an object of class \code{"gam"} as described in \
A generalized additive model (GAM) is a generalized linear model (GLM) in which the linear A generalized additive model (GAM) is a generalized linear model (GLM) in which the linear
predictor is given by a user specified sum of smooth functions of the covariates plus a predictor is given by a user specified sum of smooth functions of the covariates plus a
conventional parametric component of the linear predictor. A simple example is: conventional parametric component of the linear predictor. A simple example is:
\deqn{\log(E(y_i)) = f_1(x_{1i})+f_2(x_{2i})}{log(E(y_i))=f_1(x_1i)+f_2(x_2i)} \deqn{\log(E(y_i)) = \alpha + f_1(x_{1i})+f_2(x_{2i})}{log(E(y_i))= a + f_1(x_1i)+f_2(x_2i)}
where the (independent) response variables \eqn{y_i \sim {\rm Poi }}{y_i~Poi}, and where the (independent) response variables \eqn{y_i \sim {\rm Poi }}{y_i~Poi}, and
\eqn{f_1}{f_1} and \eqn{f_2}{f_2} are smooth functions of covariates \eqn{x_1}{x_1} and \eqn{f_1}{f_1} and \eqn{f_2}{f_2} are smooth functions of covariates \eqn{x_1}{x_1} and
\eqn{x_2}{x_2}. The log is an example of a link function. \eqn{x_2}{x_2}. The log is an example of a link function. Note that to be identifiable the model
requires constraints on the smooth functions. By default these are imposed automatically and require that the function sums to zero over the observed covariate values (the presence of a metric \code{by} variable is the only case which usually suppresses this).
If absolutely any smooth functions were allowed in model fitting then maximum likelihood If absolutely any smooth functions were allowed in model fitting then maximum likelihood
estimation of such models would invariably result in complex overfitting estimates of estimation of such models would invariably result in complex overfitting estimates of
...@@ -215,7 +216,7 @@ Broadly \code{gam} works by first constructing basis functions and one or more q ...@@ -215,7 +216,7 @@ Broadly \code{gam} works by first constructing basis functions and one or more q
coefficient matrices for each smooth term in the model formula, obtaining a model matrix for coefficient matrices for each smooth term in the model formula, obtaining a model matrix for
the strictly parametric part of the model formula, and combining these to obtain a the strictly parametric part of the model formula, and combining these to obtain a
complete model matrix (/design matrix) and a set of penalty matrices for the smooth terms. complete model matrix (/design matrix) and a set of penalty matrices for the smooth terms.
Some linear identifiability constraints are also obtained at this point. The model is The linear identifiability constraints are also obtained at this point. The model is
fit using \code{\link{gam.fit}}, \code{\link{gam.fit3}} or varaints, which are modifications fit using \code{\link{gam.fit}}, \code{\link{gam.fit3}} or varaints, which are modifications
of \code{\link{glm.fit}}. The GAM of \code{\link{glm.fit}}. The GAM
penalized likelihood maximization problem is solved by Penalized Iteratively penalized likelihood maximization problem is solved by Penalized Iteratively
......
...@@ -15,7 +15,7 @@ gam.control(nthreads=1,irls.reg=0.0,epsilon = 1e-07, maxit = 200, ...@@ -15,7 +15,7 @@ gam.control(nthreads=1,irls.reg=0.0,epsilon = 1e-07, maxit = 200,
rank.tol=.Machine$double.eps^0.5, rank.tol=.Machine$double.eps^0.5,
nlm=list(),optim=list(),newton=list(), nlm=list(),optim=list(),newton=list(),
outerPIsteps=0,idLinksBases=TRUE,scalePenalty=TRUE, outerPIsteps=0,idLinksBases=TRUE,scalePenalty=TRUE,
keepData=FALSE,scale.est="fletcher") keepData=FALSE,scale.est="fletcher",edge.correct=FALSE)
} }
\arguments{ \arguments{
\item{nthreads}{Some parts of some smoothing parameter selection methods (e.g. REML) can use some \item{nthreads}{Some parts of some smoothing parameter selection methods (e.g. REML) can use some
...@@ -78,6 +78,10 @@ do so. } ...@@ -78,6 +78,10 @@ do so. }
\item{scale.est}{How to estimate the scale parameter for exponential family models estimated \item{scale.est}{How to estimate the scale parameter for exponential family models estimated
by outer iteration. See \code{\link{gam.scale}}.} by outer iteration. See \code{\link{gam.scale}}.}
\item{edge.correct}{With RE/ML smoothing parameter selection in \code{gam} using the default Newton RE/ML optimizer, it is possible to improve inference at the
`completely smooth' edge of the smoothing parameter space, by decreasing
smoothing parameters until there is a small increase in the negative RE/ML (e.g. 0.02). Set to \code{TRUE} or to a number representing the target increase to use. Only changes the corrected smoothing parameter matrix, \code{Vc}.}
} }
\details{ \details{
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
\alias{multinom} \alias{multinom}
%- Also NEED an `\alias' for EACH other topic documented here. %- Also NEED an `\alias' for EACH other topic documented here.
\title{GAM multinomial logistic regression} \title{GAM multinomial logistic regression}
\description{Family for use with \code{\link{gam}}, implementing regression for categorical response data. Categories must be coded 0 to K, where K is a positive integer. \code{\link{gam}} should be called with a list of K formulae, one for each category except category zero (extra formulae for shared terms may also be supplied). The first formula also specifies the response variable. \description{Family for use with \code{\link{gam}}, implementing regression for categorical response data. Categories must be coded 0 to K, where K is a positive integer. \code{\link{gam}} should be called with a list of K formulae, one for each category except category zero (extra formulae for shared terms may also be supplied: see \code{\link{formula.gam}}). The first formula also specifies the response variable.
} }
\usage{ \usage{
......
...@@ -3,8 +3,7 @@ ...@@ -3,8 +3,7 @@
%- Also NEED an `\alias' for EACH other topic documented here. %- Also NEED an `\alias' for EACH other topic documented here.
\title{Multivariate normal additive models} \title{Multivariate normal additive models}
\description{Family for use with \code{\link{gam}} implementing smooth multivariate Gaussian regression. \description{Family for use with \code{\link{gam}} implementing smooth multivariate Gaussian regression.
The means for each dimension are given by a separate linear predictor, which may contain smooth components. The The means for each dimension are given by a separate linear predictor, which may contain smooth components. Extra linear predictors may also be specified giving terms which are shared between components (see \code{\link{formula.gam}}). The Choleski factor of the response precision matrix is estimated as part of fitting.
Choleski factor of the response precision matrix is estimated as part of fitting.
} }
\usage{ \usage{
......
...@@ -200,13 +200,15 @@ res <- colSums(log(abs(Xp \%*\% t(br)))) ...@@ -200,13 +200,15 @@ res <- colSums(log(abs(Xp \%*\% t(br))))
# illustration of unsafe scale dependent transforms in smooths.... # illustration of unsafe scale dependent transforms in smooths....
################################################################## ##################################################################
b0 <- gam(y~s(x0)+s(x1)+s(x2)+scale(x3),data=dat) ## safe b0 <- gam(y~s(x0)+s(x1)+s(x2)+x3,data=dat) ## safe
b1 <- gam(y~s(x0)+s(I(x1/2))+s(x2)+scale(x3),data=dat) ## safe b1 <- gam(y~s(x0)+s(I(x1/2))+s(x2)+scale(x3),data=dat) ## safe
b2 <- gam(y~s(x0)+s(scale(x1))+s(x2)+scale(x3),data=dat) ## unsafe b2 <- gam(y~s(x0)+s(scale(x1))+s(x2)+scale(x3),data=dat) ## unsafe
pd <- dat; pd$x1 <- pd$x1/2; pd$x3 <- pd$x3/2 pd <- dat; pd$x1 <- pd$x1/2; pd$x3 <- pd$x3/2
par(mfrow=c(1,2)) par(mfrow=c(1,2))
plot(predict(b0,pd),predict(b1,pd),main="b0 and b1 predictions match");abline(0,1,col=2) plot(predict(b0,pd),predict(b1,pd),main="b0 and b1 predictions match")
plot(predict(b0,pd),predict(b2,pd),main="b2 unsafe, doesn't match");abline(0,1,col=2) abline(0,1,col=2)
plot(predict(b0,pd),predict(b2,pd),main="b2 unsafe, doesn't match")
abline(0,1,col=2)
################################################################## ##################################################################
......
...@@ -12,7 +12,9 @@ ...@@ -12,7 +12,9 @@
%- maybe also `usage' for other objects documented here. %- maybe also `usage' for other objects documented here.
\arguments{ \arguments{
\item{...}{ a list of variables that are the covariates that this \item{...}{ a list of variables that are the covariates that this
smooth is a function of.} smooth is a function of. Transformations whose form depends on
the values of the data are best avoided here: e.g. \code{s(log(x))}
is fine, but \code{s(I(x/sd(x)))} is not (see \code{\link{predict.gam}}).}
\item{k}{ the dimension of the basis used to represent the smooth term. \item{k}{ the dimension of the basis used to represent the smooth term.
The default depends on the number of variables that the smooth is a The default depends on the number of variables that the smooth is a
......
...@@ -16,7 +16,9 @@ is that it is useable with \code{gamm4} from package \code{gamm4}. ...@@ -16,7 +16,9 @@ is that it is useable with \code{gamm4} from package \code{gamm4}.
%- maybe also `usage' for other objects documented here. %- maybe also `usage' for other objects documented here.
\arguments{ \arguments{
\item{...}{ a list of variables that are the covariates that this \item{...}{ a list of variables that are the covariates that this
smooth is a function of.} smooth is a function of. Transformations whose form depends on
the values of the data are best avoided here: e.g. \code{t2(log(x),z)}
is fine, but \code{t2(I(x/sd(x)),z)} is not (see \code{\link{predict.gam}}).}
\item{k}{ the dimension(s) of the bases used to represent the smooth term. \item{k}{ the dimension(s) of the bases used to represent the smooth term.
If not supplied then set to \code{5^d}. If supplied as a single number then this If not supplied then set to \code{5^d}. If supplied as a single number then this
......
...@@ -22,7 +22,9 @@ ti(..., k=NA,bs="cr",m=NA,d=NA,by=NA,fx=FALSE, ...@@ -22,7 +22,9 @@ ti(..., k=NA,bs="cr",m=NA,d=NA,by=NA,fx=FALSE,
%- maybe also `usage' for other objects documented here. %- maybe also `usage' for other objects documented here.
\arguments{ \arguments{
\item{...}{ a list of variables that are the covariates that this \item{...}{ a list of variables that are the covariates that this
smooth is a function of.} smooth is a function of. Transformations whose form depends on
the values of the data are best avoided here: e.g. \code{te(log(x),z)}
is fine, but \code{te(I(x/sd(x)),z)} is not (see \code{\link{predict.gam}}). }
\item{k}{ the dimension(s) of the bases used to represent the smooth term. \item{k}{ the dimension(s) of the bases used to represent the smooth term.
If not supplied then set to \code{5^d}. If supplied as a single number then this If not supplied then set to \code{5^d}. If supplied as a single number then this
......
...@@ -10,11 +10,12 @@ as on entry. It also returns an index attribute for relating the result back ...@@ -10,11 +10,12 @@ as on entry. It also returns an index attribute for relating the result back
to the original matrix. to the original matrix.
} }
\usage{ \usage{
uniquecombs(x) uniquecombs(x,ordered=FALSE)
} }
%- maybe also `usage' for other objects documented here. %- maybe also `usage' for other objects documented here.
\arguments{ \arguments{
\item{x}{ is an \R matrix (numeric), or data frame. } \item{x}{ is an \R matrix (numeric), or data frame. }
\item{ordered}{ set to \code{TRUE} to have the rows of the returned object in the same order regardless of input ordering.}
} }
\details{ Models with more parameters than unique combinations of \details{ Models with more parameters than unique combinations of
covariates are not identifiable. This routine provides a means of covariates are not identifiable. This routine provides a means of
...@@ -60,6 +61,13 @@ ind <- attr(Xu,"index") ...@@ -60,6 +61,13 @@ ind <- attr(Xu,"index")
## find the value for row 3 of the original from Xu ## find the value for row 3 of the original from Xu
Xu[ind[3],];X[3,] Xu[ind[3],];X[3,]
## same with fixed output ordering
Xu <- uniquecombs(X,TRUE);Xu
ind <- attr(Xu,"index")
## find the value for row 3 of the original from Xu
Xu[ind[3],];X[3,]
## data frame example... ## data frame example...
df <- data.frame(f=factor(c("er",3,"b","er",3,3,1,2,"b")), df <- data.frame(f=factor(c("er",3,"b","er",3,3,1,2,"b")),
x=c(.5,1,1.4,.5,1,.6,4,3,1.7)) x=c(.5,1,1.4,.5,1,.6,4,3,1.7))
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment