[r-cran-gam] 06/20: Imported Upstream version 1.09
Andreas Tille
tille at debian.org
Fri Dec 16 14:32:10 UTC 2016
This is an automated email from the git hooks/post-receive script.
tille pushed a commit to branch master
in repository r-cran-gam.
commit 5e98df8b04e4401649902795519aa81434f84f8d
Author: Andreas Tille <tille at debian.org>
Date: Fri Dec 16 13:32:21 2016 +0100
Imported Upstream version 1.09
---
ChangeLog | 8 +++
DESCRIPTION | 16 ++---
MD5 | 29 +++++----
NAMESPACE | 1 +
R/preplot.gam.R | 5 +-
R/print.stepanova.R | 25 ++++++++
R/print.summary.gam.R | 7 ++-
R/step.gam.R | 165 ++++++++++++++++++++++++--------------------------
R/summary.gam.R | 91 ++++++++++++++--------------
inst/ratfor/splsm.r | 2 +-
man/anova.gam.Rd | 4 +-
man/gam-internal.Rd | 1 -
man/gam.Rd | 4 +-
man/gam.scope.Rd | 72 ++++++++++++++++++++++
man/step.gam.Rd | 38 ++++++++++--
src/splsm.f | 2 +-
src/sslvrg.f | 2 +-
17 files changed, 303 insertions(+), 169 deletions(-)
diff --git a/ChangeLog b/ChangeLog
new file mode 100644
index 0000000..b9612e0
--- /dev/null
+++ b/ChangeLog
@@ -0,0 +1,8 @@
+2013-08-02 Trevor Hastie <hastie at stanford.edu> version 1.09
+ * improved step.gam significantly (it works now for eg, the spam data); added parallel option
+ * man/step.gam updated
+ * R/scope.gam added; an aid for creating a scope object
+ * man/scope.gam added
+ * R/summary.gam split up the anova to two anovas - one for the parametric, and one for nonparametric
+### Note that this starts from gam 1.09
+
diff --git a/DESCRIPTION b/DESCRIPTION
index 805b7f4..5ab7eb5 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -1,18 +1,18 @@
Package: gam
Type: Package
Title: Generalized Additive Models
-Date: 2013-04-23
-Version: 1.08
+Date: 2013-08-11
+Version: 1.09
Author: Trevor Hastie
Description: Functions for fitting and working with generalized
- additive models, as described in chapter 7 of "Statistical
- Models in S" (Chambers and Hastie (eds), 1991), and
- "Generalized Additive Models" (Hastie and Tibshirani, 1990).
+ additive models, as described in chapter 7 of "Statistical Models in
+ S" (Chambers and Hastie (eds), 1991), and "Generalized Additive
+ Models" (Hastie and Tibshirani, 1990).
Maintainer: Trevor Hastie <hastie at stanford.edu>
Depends: stats, splines
-Suggests: akima
+Suggests: akima, foreach
License: GPL-2
-Packaged: 2013-04-24 02:02:27 UTC; hastie
+Packaged: 2013-08-12 17:21:53 UTC; hastie
NeedsCompilation: yes
Repository: CRAN
-Date/Publication: 2013-04-24 09:46:10
+Date/Publication: 2013-08-13 08:00:00
diff --git a/MD5 b/MD5
index 6610c5a..31a54d1 100644
--- a/MD5
+++ b/MD5
@@ -1,6 +1,7 @@
-0d66a823f3136a9c9fbdbdff74965935 *DESCRIPTION
+c95bed4e0f0a9c7ce468d8b0c3b86c99 *ChangeLog
+3b3051d46d5cf4f05e25710d208e68a6 *DESCRIPTION
af77f82fb0aa5e383808c5f36aa47066 *INDEX
-105cd87b9c243fbe33aabf84cf2b3271 *NAMESPACE
+79c3de2f467638359b6523bce15d127e *NAMESPACE
3f56ee7eddd13ec792f7c2150b1e1eca *R/all.wam.R
8cc1439da83368b103fe32e3f659d7c2 *R/anova.gam.R
650f5fcfc4615d93f8743f2a93e0204b *R/anova.gamlist.R
@@ -40,16 +41,17 @@ a82abbfbf9d226c04290dd721e1d8b51 *R/newdata.predict.gam.R
07745ab717cea5503a96ccfbd3d66529 *R/plot.preplot.gam.R
b0b4e3ea29649f25919a9b3b9a01886f *R/polylo.R
23706ce18cdf6313374bbf40e1161a48 *R/predict.gam.R
-4314caf8a4bc9da21bd847ea1322146c *R/preplot.gam.R
+4ed7d1494967664d174ddcacaaec8259 *R/preplot.gam.R
87477db085b0209bab1a5fc82cca43be *R/print.gam.R
ca3a618d4376069f1d43a2aabaea5e4c *R/print.gamex.R
-671e6f217888df1fb52aa3f5828c22e7 *R/print.summary.gam.R
+6ad823ecd940526c459b48ddf85b27be *R/print.stepanova.R
+8dbfd56254f091f7d219f5caaeefecc9 *R/print.summary.gam.R
c318b1f9d34fda3e660a9af01b86c830 *R/random.R
1478722abc4269fede0d572840c0cfbe *R/s.R
596d38e0f6ec11d3921b0ee8bd3590a4 *R/s.wam.R
-addd48040c8374e5a9ed5d587cfe77e7 *R/step.gam.R
+79eaf99c6a30f60cdb8d32ad76f24970 *R/step.gam.R
9c1302d138d07b10f17c27765bd87955 *R/subset.smooth.R
-6dec63db9138e124e7535b79e82558ab *R/summary.gam.R
+8f2f390526bda6e2c9049d602f348a7e *R/summary.gam.R
5cc7658080bc925bb5fc11172d78fb41 *R/ylim.scale.R
ba66638e3de17b868b4d98dffe95009d *data/gam.data.RData
83529cbff37939aff8d96d32d6458f12 *data/gam.newdata.RData
@@ -58,20 +60,21 @@ a42dba5f95d8760e06a78389d780b170 *inst/ratfor/backfit.r
a009bd4d2232ec7cc19b9d7d10280ffb *inst/ratfor/backlo.r
1ca924fd62063613d16c1cf607abb6b2 *inst/ratfor/linear.r
4e0b184dc647e3abac7fb7f023ed4a69 *inst/ratfor/lo.r
-90ae42a7500cb1b749601e2d4f5656cc *inst/ratfor/splsm.r
-ddba04cdcf5d2044919c08bcf71c7786 *man/anova.gam.Rd
-d39a839642a1ee2b71d93df9a41c62c5 *man/gam-internal.Rd
-ffbb793ebf7414ea69df18b384e40534 *man/gam.Rd
+58295734adaaee3561f298e7c0b93eee *inst/ratfor/splsm.r
+b86dc231f80eb84973ab3ab5f179e423 *man/anova.gam.Rd
+eb542f4c26145749d984010e1dd24213 *man/gam-internal.Rd
+41aa55d9768c1f1fd22c3b1a27b277a6 *man/gam.Rd
5167ecd9baaea501d766f87b4e22cf20 *man/gam.control.Rd
d3c27998fb1cdce4cb00703557f1138d *man/gam.data.Rd
d39920b918d9a57b3ad4090658750e45 *man/gam.exact.Rd
+fc57a2513d84056abd88a39ac9bc352d *man/gam.scope.Rd
dd3553bd8578858873bd1384b000273a *man/kyphosis.Rd
800542a98f81e40c0930605f288c9ca4 *man/lo.Rd
5068084693ec99de54e0531a53d4e637 *man/na.gam.replace.Rd
a79905d34d4d93cb9939329b7cc8f507 *man/plot.gam.Rd
7de080b0a4e684b2a2b4e26e17fe38d8 *man/predict.gam.Rd
7f2b4a226c564121816e2594f7fd61c3 *man/s.Rd
-03718b63cb73f8be1d573ecca2c9a48f *man/step.gam.Rd
+824118d9e6900ee9ed48800b17903830 *man/step.gam.Rd
f80de2889856cba0512e5377926af1aa *src/Makevars
1c81cbb8cbdd19a2e909dc5f802ddb07 *src/Makevars.win
45061d1eb26bda41c4c458126dd303da *src/backfit.f
@@ -88,6 +91,6 @@ e1c0a8ef61f04b6239ff2ea6874be92d *src/qsbart.f
876032799d52ef84fb846af58939a318 *src/sbart.c
82da999d24034505301e31c78d1e58cc *src/sgram.f
d277bb97eef775673f5fa2da911d81de *src/sinerp.f
-65db5d599cdd5a5d81110cff681d374a *src/splsm.f
-39a0d0a34a95130be92b075a49feac36 *src/sslvrg.f
+82e478f6d0dc2c2a61484d5009427eb6 *src/splsm.f
+7d7b6fb9e86d3ea8d8a8ed57af178372 *src/sslvrg.f
4f6275039d4731d4f2920fc3de5f61e7 *src/stxwx.f
diff --git a/NAMESPACE b/NAMESPACE
index f4163fc..ee547a3 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -9,6 +9,7 @@ S3method(summary,gam)
S3method(print,summary.gam)
S3method(print,gamex)
S3method(print,gam)
+S3method(print,stepanova)
S3method(predict,gam)
S3method(plot,preplot.gam)
S3method(plot,gam)
diff --git a/R/preplot.gam.R b/R/preplot.gam.R
index 8dc96b4..0e0f644 100644
--- a/R/preplot.gam.R
+++ b/R/preplot.gam.R
@@ -57,7 +57,10 @@
x))
mode(Mcall) <- "call"
Mcall$data <- Call$data
- xvars <- eval(xvars, eval(Mcall))
+ env <- environment(Terms)##added 7/28/13
+ if (is.null(env)) ##
+ env <- parent.frame()##
+ xvars <- eval(xvars, eval(Mcall,env))
}
else {
ecall <- substitute(eval(expression(xvars)))
diff --git a/R/print.stepanova.R b/R/print.stepanova.R
new file mode 100644
index 0000000..03f5523
--- /dev/null
+++ b/R/print.stepanova.R
@@ -0,0 +1,25 @@
+"print.stepanova"<-
+function(x, digits = .Options$digits, quote = F, drop = F, ...)
+{
+ heading <- attr(x, "heading")
+ if(!is.null(heading))
+ cat(heading, sep = "\n")
+ attr(x, "heading") <- NULL
+ d <- dim(x)
+ for(i in 1:d[2]) {
+ xx <- x[[i]]
+ if(!length(levels(xx)) && is.numeric(xx)) {
+ xna <- is.na(xx)
+ xx <- format(zapsmall(xx, digits))
+ xx[xna] <- ""
+ x[[i]] <- xx
+ }
+ }
+ if(d[1] == 1 && drop) {
+ x <- t(as.matrix(x))
+ dn <- dimnames(x)
+ dn <- paste(dn[[1]], ":", sep = "")
+ dimnames(x) <- list(dn, "")
+ }
+ NextMethod("print")
+}
diff --git a/R/print.summary.gam.R b/R/print.summary.gam.R
index 1ed8e1b..65a2f96 100644
--- a/R/print.summary.gam.R
+++ b/R/print.summary.gam.R
@@ -29,5 +29,10 @@
cat(naprint(x$na.action), "\n")
cat("\nNumber of Local Scoring Iterations:", format(trunc(x$iter)),
"\n")
- print(x$anova)
+ aod=x$parametric.anova
+ cat("\n")
+ if(!is.null(aod)) print(aod)
+ aod=x$anova
+ cat("\n")
+ if(!is.null(aod)) print(aod)
}
diff --git a/R/step.gam.R b/R/step.gam.R
index 3853e61..061a9fb 100644
--- a/R/step.gam.R
+++ b/R/step.gam.R
@@ -1,17 +1,20 @@
-`step.gam` <-
-function (object, scope, scale, direction = c("both", "backward",
- "forward"), trace = TRUE, keep = NULL, steps = 1000, ...)
+step.gam <-
+ function (object, scope, scale, direction = c("both", "backward",
+ "forward"), trace = TRUE, keep = NULL, steps = 1000, parallel=FALSE,...)
{
-scope.char <-
- function(formula) {
- formula=update(formula,~-1+.)
+ trace=as.numeric(trace)
+ get.visit <- function(trial, visited){
+ match(paste(trial,collapse=""),apply(visited,2,paste,collapse=""),FALSE)
+ }
+ scope.char <- function(formula) {
+ formula = update(formula, ~-1 + .)
tt <- terms(formula)
tl <- attr(tt, "term.labels")
if (attr(tt, "intercept"))
c("1", tl)
else tl
}
-re.arrange <- function(keep) {
+ re.arrange <- function(keep) {
namr <- names(k1 <- keep[[1]])
namc <- names(keep)
nc <- length(keep)
@@ -56,6 +59,7 @@ re.arrange <- function(keep) {
chfrom <- sapply(models, "[[", "from")
chfrom[chfrom == "1"] <- ""
chto <- sapply(models, "[[", "to")
+ chto[1]="<start>"
chto[chto == "1"] <- ""
dev <- sapply(models, "[[", "deviance")
df <- sapply(models, "[[", "df.resid")
@@ -66,10 +70,15 @@ re.arrange <- function(keep) {
"\nInitial Model:", deparse(as.vector(formula(object))),
"\nFinal Model:", deparse(as.vector(formula(fit))),
paste("\nScale: ", format(scale), "\n", sep = ""))
- aod <- data.frame(From = chfrom, To = chto, Df = ddf,
- Deviance = ddev, "Resid. Df" = df, "Resid. Dev" = dev,
+# rowns=paste(chfrom,chto,sep=" -> ")
+# rowns[1]="<start>"
+# rowns=paste(seq(rowns)-1,rowns,sep=": ")
+ aod <- data.frame(From=chfrom,To=chto, Df = ddf,
+ Deviance = ddev, `Resid. Df` = df, `Resid. Dev` = dev,
AIC = AIC, check.names = FALSE)
- fit$anova <- as.anova(aod, heading)
+ aod <- as.anova(aod, heading)
+ class(aod)=c("stepanova","data.frame")
+ fit$anova=aod
fit
}
direction <- match.arg(direction)
@@ -86,18 +95,11 @@ re.arrange <- function(keep) {
Call <- object$call
term.lengths <- sapply(scope, length)
n.items <- length(items)
- visited <- array(FALSE, term.lengths)
- visited[array(items, c(1, n.items))] <- TRUE
- if (!is.null(keep)) {
- keep.list <- vector("list", length(visited))
- nv <- 1
- }
- models <- vector("list", length(visited))
- nm <- 2
+ visited <- matrix(items)
form.vector <- character(n.items)
for (i in seq(n.items)) form.vector[i] <- scope[[i]][items[i]]
form <- deparse(object$formula)
- if (trace)
+ if (trace>0)
cat("Start: ", form)
fit <- object
n <- length(fit$fitted)
@@ -108,99 +110,88 @@ re.arrange <- function(keep) {
else if (scale == 0)
scale <- deviance.lm(fit)/fit$df.resid
bAIC <- fit$aic
- if (trace)
+ if (trace>0)
cat("; AIC=", format(round(bAIC, 4)), "\n")
- models[[1]] <- list(deviance = deviance(fit), df.resid = fit$df.resid,
+ models <- list(
+ list(deviance = deviance(fit), df.resid = fit$df.resid,
AIC = bAIC, from = "", to = "")
- if (!is.null(keep)) {
- keep.list[[nv]] <- keep(fit, bAIC)
- nv <- nv + 1
- }
+ )
+ if (!is.null(keep)) {
+ keep.list <- list(keep(fit,...))
+ keep.it=TRUE}
+ else keep.it=FALSE
AIC <- bAIC + 1
+ stepnum=0
while (bAIC < AIC & steps > 0) {
steps <- steps - 1
+ stepnum=stepnum+1
AIC <- bAIC
- bitems <- items
- bfit <- fit
+ form.list=NULL
+###First some prelimenaries to see what formulas to try
for (i in seq(n.items)) {
if (backward) {
trial <- items
trial[i] <- trial[i] - 1
- if (trial[i] > 0 && !visited[array(trial, c(1,
- n.items))]) {
- visited[array(trial, c(1, n.items))] <- TRUE
+ if (trial[i] > 0 && !get.visit(trial,visited)) {
+ visited<-cbind(visited,trial)
tform.vector <- form.vector
tform.vector[i] <- scope[[i]][trial[i]]
- form <- paste(form.y, paste(tform.vector, collapse = " + "))
- if (trace)
- cat("Trial: ", form)
- tfit <- update(object, eval(parse(text = form)),
- trace = FALSE, ...)
- tAIC <- tfit$aic
- if (!is.null(keep)) {
- keep.list[[nv]] <- keep(tfit, tAIC)
- nv <- nv + 1
- }
- if (tAIC < bAIC) {
- bAIC <- tAIC
- bitems <- trial
- bfit <- tfit
- bform.vector <- tform.vector
- bfrom <- form.vector[i]
- bto <- tform.vector[i]
- }
- if (trace)
- cat("; AIC=", format(round(tAIC, 4)), "\n")
+ form.list=c(form.list,list(list(trial=trial, form.vector=tform.vector, which=i)))
}
}
if (forward) {
trial <- items
trial[i] <- trial[i] + 1
- if (trial[i] <= term.lengths[i] && !visited[array(trial,
- c(1, n.items))]) {
- visited[array(trial, c(1, n.items))] <- TRUE
+ if (trial[i] <= term.lengths[i] && !get.visit(trial,visited)){
+ visited<-cbind(visited,trial)
tform.vector <- form.vector
tform.vector[i] <- scope[[i]][trial[i]]
- form <- paste(form.y, paste(tform.vector, collapse = " + "))
- if (trace)
- cat("Trial: ", form)
- tfit <- update(object, eval(parse(text = form)),
- trace = FALSE, ...)
- tAIC <- tfit$aic
- if (!is.null(keep)) {
- keep.list[[nv]] <- keep(tfit, tAIC)
- nv <- nv + 1
- }
- if (tAIC < bAIC) {
- bAIC <- tAIC
- bitems <- trial
- bfit <- tfit
- bform.vector <- tform.vector
- bfrom <- form.vector[i]
- bto <- tform.vector[i]
- }
- if (trace)
- cat("; AIC=", format(round(tAIC, 4)), "\n")
+ form.list=c(form.list,list(list(trial=trial, form.vector=tform.vector, which=i)))
}
}
}
+ if(is.null(form.list))break
+### Now we are ready for the expensive loop
+### Parallel is set up
+if(parallel&&require(foreach)){
+# step.list=foreach(i=1:length(form.list),.inorder=FALSE,.packages="gam",.verbose=trace>1)%dopar%
+ step.list=foreach(i=1:length(form.list),.inorder=FALSE,.verbose=trace>1)%dopar%
+ {
+ tform=paste(form.y, paste(form.list[[i]]$form.vector, collapse = " + "))
+ update(object, eval(parse(text = tform)),trace = FALSE, ...)
+ }
+ }
+### No parallel
+ else {
+ step.list=as.list(sequence(length(form.list)))
+ for(i in 1:length(form.list)){
+ tform=paste(form.y, paste(form.list[[i]]$form.vector, collapse = " + "))
+ step.list[[i]]=update(object, eval(parse(text = tform)),trace = FALSE, ...)
+ if(trace>1)cat("Trial: ", tform,"; AIC=", format(round(step.list[[i]]$aic, 4)), "\n")
+ }
+}
+### end expensive loop
+ taic.vec=sapply(step.list,"[[","aic")
+ if(keep.it) keep.list=c(keep.list, lapply(step.list,keep,...))
+ bAIC=min(taic.vec)
if (bAIC >= AIC | steps == 0) {
- if (!is.null(keep))
- fit$keep <- re.arrange(keep.list[seq(nv - 1)])
- return(make.step(models[seq(nm - 1)], fit, scale,
- object))
+ if (keep.it) fit$keep <- re.arrange(keep.list)
+ return(make.step(models, fit, scale, object))
}
else {
- if (trace)
- cat("Step : ", deparse(bfit$formula), "; AIC=",
- format(round(bAIC, 4)), "\n\n")
- items <- bitems
- models[[nm]] <- list(deviance = deviance(bfit), df.resid = bfit$df.resid,
- AIC = bAIC, from = bfrom, to = bto)
- nm <- nm + 1
- fit <- bfit
- form.vector <- bform.vector
+ o1=order(taic.vec)[1]
+ fit=step.list[[o1]]
+ form.list=form.list[[o1]]
+ bwhich=form.list$which
+ bfrom=form.vector[bwhich]
+ form.vector=form.list$form.vector #this is the new one
+ bto=form.vector[bwhich]
+ if (trace>0)
+ cat(paste("Step:",stepnum,sep=""), deparse(fit$formula), "; AIC=",
+ format(round(bAIC, 4)), "\n")
+ items <- form.list$trial
+ models <- c(models,list(list(deviance = deviance(fit), df.resid = fit$df.resid,
+ AIC = bAIC, from = bfrom, to = bto)))
}
}
}
-
diff --git a/R/summary.gam.R b/R/summary.gam.R
index 01062aa..fb2e2ca 100644
--- a/R/summary.gam.R
+++ b/R/summary.gam.R
@@ -1,10 +1,12 @@
"summary.gam" <-
- function(object, dispersion = NULL,...)
+ function (object, dispersion = NULL, ...)
{
+ paod=anova.lm(object,...)
+ attr(paod,"heading")="Anova for Parametric Effects"
+
save.na.action <- object$na.action
object$na.action <- NULL
- fun <- function(assign, coeff)
- sum(!is.na(coeff[assign]))
+ fun <- function(assign, coeff) sum(!is.na(coeff[assign]))
wt <- object$weights
coef <- object$coef
dresid <- residuals(object, "deviance")
@@ -13,87 +15,84 @@
s <- object$s
nl.chisq <- object$nl.chisq
assg <- object$assign
- if(is.null(assg))
+ if (is.null(assg))
assg <- attributes(object$terms)$assign
- df<-rep(1,length(assg))
- df[is.na(object$coef)]<-0
- df<-tapply(df,assg,sum)
- dfnames<-attr(object$terms,"term.labels")
- if(attr(object$terms,"intercept"))dfnames<-c("(Intercept)",dfnames)
- names(df)<-dfnames
- df<-unlist(df)
+ df <- rep(1, length(assg))
+ df[is.na(object$coef)] <- 0
+ df <- tapply(df, assg, sum)
+ dfnames <- attr(object$terms, "term.labels")
+ if (attr(object$terms, "intercept"))
+ dfnames <- c("(Intercept)", dfnames)
+ names(df) <- dfnames
+ df <- unlist(df)
nldf <- object$nl.df
n <- length(object$residuals)
- if(is.null(rdf <- object$df.resid)) {
+ if (is.null(rdf <- object$df.resid)) {
rdf <- n - sum(df)
- if(!is.null(nldf))
+ if (!is.null(nldf))
rdf <- rdf - sum(nldf)
}
- if(!is.null(wt)) {
+ if (!is.null(wt)) {
wt <- wt^0.5
resid <- resid * wt
excl <- wt == 0
- if(any(excl)) {
- warning(paste(sum(excl),
- "rows with zero weights not counted"))
+ if (any(excl)) {
+ warning(paste(sum(excl), "rows with zero weights not counted"))
resid <- resid[!excl]
dresid <- dresid[!excl]
- if(is.null(object$df.residual))
+ if (is.null(object$df.residual))
rdf <- rdf - sum(excl)
}
}
- if(rdf > 0)
+ if (rdf > 0)
phihat <- sum(resid^2)/rdf
else {
phihat <- Inf
- warning("Residual degrees of freedom are negative or zero. This occurs when the sum of the parametric and nonparametric degrees of freedom exceeds the number of observations. The model is probably too complex for the amount of data available."
- )
+ warning("Residual degrees of freedom are negative or zero. This occurs when the sum of the parametric and nonparametric degrees of freedom exceeds the number of observations. The model is probably too complex for the amount of data available.")
}
famname <- object$family[["family"]]
- if(is.null(famname))
+ if (is.null(famname))
famname <- "gaussian"
chiorf <- TRUE
- if(!is.null(dispersion) && dispersion == 0)
+ if (!is.null(dispersion) && dispersion == 0)
dispersion <- phihat
- if(is.null(dispersion))
- dispersion <- switch(famname,
- poisson = 1,
- binomial = 1,
+ if (is.null(dispersion))
+ dispersion <- switch(famname, poisson = 1, binomial = 1,
{
chiorf <- FALSE
phihat
- }
- )
+ })
names(dispersion) <- famname
- if(length(df)) {
+ if (length(nldf)) {
aod <- as.matrix(round(df, 1))
dimnames(aod) <- list(names(df), "Df")
- if(!is.null(nl.chisq)) {
+ if (!is.null(nl.chisq)) {
aod <- cbind(aod, NA, NA, NA)
nl.chisq <- nl.chisq/dispersion
snames <- names(nldf)
aod[snames, 2] <- round(nldf, 1)
- aod[snames, 3] <- if(!chiorf) nl.chisq/nldf else
- nl.chisq
- aod[snames, 4] <- if(chiorf) 1 - pchisq(nl.chisq, nldf)
- else if(rdf > 0)
+ aod[snames, 3] <- if (!chiorf)
+ nl.chisq/nldf
+ else nl.chisq
+ aod[snames, 4] <- if (chiorf)
+ 1 - pchisq(nl.chisq, nldf)
+ else if (rdf > 0)
1 - pf(nl.chisq/nldf, nldf, rdf)
else NA
rnames <- c("Df", "Npar Df", "Npar Chisq", "P(Chi)")
- if(!chiorf)
+ if (!chiorf)
rnames[3:4] <- c("Npar F", "Pr(F)")
dimnames(aod) <- list(names(df), rnames)
- heading <- if(chiorf)
- "\nDF for Terms and Chi-squares for Nonparametric Effects\n"
- else "\nDF for Terms and F-values for Nonparametric Effects\n"
+ heading <- "Anova for Nonparametric Effects"
}
- else heading <- "DF for Terms\n\n"
- aod <- as.anova(data.frame(aod, check.names = FALSE), heading)
+ else heading <- "DF for Nonparametric Terms"
+ aod <- as.anova(data.frame(aod[,-1], check.names = FALSE),
+ heading)
}
else aod <- NULL
- structure(list(call = object$call, terms = object$terms, anova = aod,
- dispersion = dispersion, df = c(sum(df) + sum(nldf), rdf),
- deviance.resid = dresid, deviance = deviance(object),
- null.deviance = object$null.deviance, aic=object$aic,iter = object$iter,
- na.action = save.na.action), class = "summary.gam")
+ structure(list(call = object$call, terms = object$terms,
+ anova = aod, parametric.anova=paod, dispersion = dispersion, df = c(sum(df) +
+ sum(nldf), rdf), deviance.resid = dresid, deviance = deviance(object),
+ null.deviance = object$null.deviance, aic = object$aic,
+ iter = object$iter, na.action = save.na.action), class = "summary.gam")
}
diff --git a/inst/ratfor/splsm.r b/inst/ratfor/splsm.r
index bb5d241..f2c9993 100644
--- a/inst/ratfor/splsm.r
+++ b/inst/ratfor/splsm.r
@@ -172,7 +172,7 @@ isetup=0
ier=1
penalt=1d0
lspar= -1.5
-uspar= 1.5
+uspar= 2.0
tol=1d-4
eps=2d-8
maxit=200
diff --git a/man/anova.gam.Rd b/man/anova.gam.Rd
index d3676a0..9654b32 100644
--- a/man/anova.gam.Rd
+++ b/man/anova.gam.Rd
@@ -23,10 +23,10 @@ See \code{\link{anova}} for the general behavior of this function
and for the interpretation of `test'.
-When called with a single `gam' object, a special anova table for `gam'
+When called with a single `gam' object, a special pair of anova tables for `gam'
models is returned. This gives a breakdown of the degrees of freedom for
all the terms in the model, separating the projection part and
-nonparametric part of each. For example, a term specified by `s()' is
+nonparametric part of each, and returned as a list of two anova objects. For example, a term specified by `s()' is
broken down into a single degree of freedom for its linear component,
and the remainder for the nonparametric component. In addition, a type
of score test is performed for each of the nonparametric terms. The
diff --git a/man/gam-internal.Rd b/man/gam-internal.Rd
index 3d6dc2a..6f89ca5 100644
--- a/man/gam-internal.Rd
+++ b/man/gam-internal.Rd
@@ -14,7 +14,6 @@
\alias{gam.match}
\alias{gam.nlchisq}
\alias{gam.random}
-\alias{gam.scope}
\alias{gam.slist}
\alias{gam.sp}
\alias{gam.wlist}
diff --git a/man/gam.Rd b/man/gam.Rd
index 2906746..462c647 100644
--- a/man/gam.Rd
+++ b/man/gam.Rd
@@ -219,7 +219,9 @@ others involving the numerical fit. See \code{lm.object}.
with
the same name in the R library \code{mgcv}, which uses only smoothing
splines with a focus on automatic smoothing parameter selection via
- GCV.
+ GCV. Some of the functions in package \code{gam} will not work if
+ package \code{mgcv} is loaded (and detaching it is not enough; you
+ will need to restart the session).
}
\references{
diff --git a/man/gam.scope.Rd b/man/gam.scope.Rd
new file mode 100644
index 0000000..5b03d17
--- /dev/null
+++ b/man/gam.scope.Rd
@@ -0,0 +1,72 @@
+\name{gam.scope}
+\alias{gam.scope}
+\title{
+Generate a scope for step.gam
+}
+\description{Given a data.frame as an argument, generate a scope list
+ for use in step.gam, each element of which gives the candidates for
+ that term.
+}
+\usage{
+gam.scope(frame, response=1, smoother = "s", arg = NULL, form = TRUE)
+}
+\arguments{
+ \item{frame}{
+a data.frame to be used in \code{step.gam}. Apart from the response
+column, all other columns will be used.
+}
+\item{response}{
+The column in \code{frame} used as the response. Default is 1.
+}
+ \item{smoother}{
+which smoother to use for the nonlinear terms; i.e. "s" or "lo", or any
+other supplied smoother. Default is "s".
+}
+ \item{arg}{a character (vector), which is the
+argument to \code{smoother}. For example, \code{arg="df=6"} would
+result in the expression \code{s(x,df=6)} for a column named "x".
+This can be a vector, for example \code{arg=c("df=4","df=6")}, which
+would result two smooth terms.
+}
+ \item{form}{
+if \code{TRUE}, each term is a formula, else a character vector.
+}
+}
+\details{
+This function creates a similar scope formula for each variable in the
+frame. A column named "x" by default will generate a scope term
+\code{~1+x+s(x)}. With \code{arg=c("df=4","df=6")} we get \code{~1+x+s(x,df=4)+s(x,df=6)}.
+With form=FALSE, we would get the character vector \code{c("1","x","s(x,df=4)","s(x,df=6")}.
+}
+\value{
+a scope list is returned, with either a formula or a character vector
+for each term, whcih describes the candidates for that term in the gam.
+}
+\references{
+ Hastie, T. J. (1991)
+ \emph{Generalized additive models.}
+ Chapter 7 of \emph{Statistical Models in S}
+ eds J. M. Chambers and T. J. Hastie, Wadsworth \& Brooks/Cole.
+}
+\author{
+ Written by Trevor Hastie, following closely the design in the
+ "Generalized Additive Models" chapter (Hastie, 1992) in Chambers and
+ Hastie (1992).
+ This version of \code{gam.scope} is adapted from the S
+ version.
+}
+\seealso{\code{\link{step.gam}}
+}
+\examples{
+data(gam.data)
+gdata=gam.data[,1:3]
+gam.scope(gdata,2)
+gam.scope(gdata,2,arg="df=5")
+gam.scope(gdata,2,arg="df=5",form=FALSE)
+gam.scope(gdata,2,arg=c("df=4","df=6"))
+}
+\keyword{models}
+\keyword{regression}
+\keyword{nonparametric}
+\keyword{smooth}
+
diff --git a/man/step.gam.Rd b/man/step.gam.Rd
index c7d12c1..6c466c3 100644
--- a/man/step.gam.Rd
+++ b/man/step.gam.Rd
@@ -6,7 +6,7 @@
these in a greedy fashion. Note: this is NOT a method for \code{step},
which used to be a generic, so must be invoked with the full name.}
\usage{
-step.gam(object, scope, scale, direction, trace = TRUE, keep, steps, \ldots)
+step.gam(object, scope, scale, direction, trace, keep, steps, parallel, \ldots)
}
\arguments{
\item{object}{
@@ -14,14 +14,21 @@ An object of class \code{gam} or any of it's inheritants.
}
\item{scope}{
defines the range of models examined in the step-wise search. It is a list of formulas, with each formula corresponding to a term in the model. Each of these formulas specifies a "regimen" of candidate forms in which the particular term may enter the model. For example, a term formula might be
-~1+ Income + log(Income) + s(Income)
+\code{~1+ Income + log(Income) + s(Income)}.
This means that \code{Income} could either appear not at all, linearly, linearly in its logarithm, or as a smooth function estimated nonparametrically. A \code{1} in the formula allows the additional option of leaving the term out of the model entirely.
Every term in the model is described by such a term formula, and the
final model is built up by selecting a component from each
formula.
-The supplied model \code{object} is used as the starting model, and hence there is the requirement that one term from each of the term formulas be present in \code{formula(object)}. This also implies that any terms in \code{formula(object)} not contained in any of the term formulas will be
+As an alternative more convenient for big models, each list can have
+instead of a formula a
+character vector corresponding to the candidates for that term. Thus we
+could have \code{c("1","x","s(x,df=5")} rather than \code{~1+x+s(x,df=5)}.
+
+The supplied model \code{object} is used as the starting model, and hence there is the requirement that one term from each of the term formulas be present in \code{formula(object)}. This also implies that any terms in \code{formula(object)} \emph{not} contained in any of the term formulas will be forced
to be present in every model considered.
+The function \code{gam.scope} is helpful for generating the scope
+argument for a large model.
}
\item{scale}{
an optional argument used in the definition of the AIC statistic used to evaluate models for selection. By default, the scaled Chi-squared statistic for the initial model is used, but if forward selection is to be performed, this is not necessarily a sound choice.
@@ -30,15 +37,27 @@ an optional argument used in the definition of the AIC statistic used to evaluat
The mode of step-wise search, can be one of \code{"both"}, \code{"backward"}, or \code{"forward"}, with a default of \code{"both"}. If \code{scope} is missing, the default for \code{direction} is "backward".
}
\item{trace}{
-If \code{TRUE}, information is printed during the running of \code{step.gam()}. This is an encouraging choice in general, since \code{step.gam()} can take some time to compute either for large models or when called with an an extensive \code{scope=} argument. A simple one line model summary is printed for each model visited in the search, and the selected model is noted at each step.
+If \code{TRUE} (the default), information is printed during the running
+of \code{step.gam()}. This is an encouraging choice in general, since
+\code{step.gam()} can take some time to compute either for large models
+or when called with an an extensive \code{scope=} argument. A simple one
+line model summary is printed for each model selected. This argument can
+also be given as the binary \code{0} or \code{1}. A value \code{trace=2}
+gives a more verbose trace.
}
\item{keep}{
-A filter function whose input is a fitted \code{gam} object and the associated "AIC" statistic, and whose output is arbitrary. Typically \code{keep()} will select a subset of the components of the object and return them. The default is not to keep anything.
+A filter function whose input is a fitted \code{gam} object, and
+anything else passed via \dots, and whose output is arbitrary. Typically \code{keep()} will select a subset of the components of the object and return them. The default is not to keep anything.
}
\item{steps}{
The maximum number of steps to be considered. The default is 1000 (essentially as
many as required). It is typically used to stop the process early.
}
+\item{parallel}{If \code{TRUE}, use parallel \code{foreach} to fit each
+ trial run.
+ Must register parallel before hand, such as \code{doMC} or others.
+ See the example below.}
+
\item{\dots}{Additional arguments to be passed on to \code{keep}}
}
\value{
@@ -57,7 +76,7 @@ in terms of the AIC statistic is selected and defines the step.
The entire process is repeated until either the maximum number of steps has been used, or until the AIC criterion can not be decreased by any of the eligible steps.
}
\seealso{
-\code{\link{step}},\code{\link{glm}}, \code{\link{gam}}, \code{\link{drop1}}, \code{\link{add1}}, \code{\link{anova.gam}}
+\code{\link{gam.scope}},\code{\link{step}},\code{\link{glm}}, \code{\link{gam}}, \code{\link{drop1}}, \code{\link{add1}}, \code{\link{anova.gam}}
}
\author{
Written by Trevor Hastie, following closely the design in the
@@ -78,6 +97,13 @@ The entire process is repeated until either the maximum number of steps has been
data(gam.data)
gam.object <- gam(y~x+z, data=gam.data)
step.object <-step.gam(gam.object, scope=list("x"=~1+x+s(x,4)+s(x,6)+s(x,12),"z"=~1+z+s(z,4)))
+\dontrun{
+# Parallel
+require(doMC)
+registerDoMC(cores=2)
+step.gam(gam.object, scope=list("x"=~1+x+s(x,4)+s(x,6)+s(x,12),"z"=~1+z+s(z,4)),parallel=TRUE)
+}
+
}
\keyword{models}
\keyword{regression}
diff --git a/src/splsm.f b/src/splsm.f
index eb9ceb0..0fd3b80 100644
--- a/src/splsm.f
+++ b/src/splsm.f
@@ -113,7 +113,7 @@ C Output from Public domain Ratfor, version 1.0
ier=1
penalt=1d0
lspar= -1.5
- uspar= 1.5
+ uspar= 2.0
tol=1d-4
eps=2d-8
maxit=200
diff --git a/src/sslvrg.f b/src/sslvrg.f
index 6646b33..d221e25 100644
--- a/src/sslvrg.f
+++ b/src/sslvrg.f
@@ -128,7 +128,7 @@ C df matching
crit = 0d0
do 32 i=1,n
32 crit = crit+lev(i)
- crit = 3 + (dofoff-crit)**2
+ crit = 3d0 + (dofoff-crit)**2
endif
return
endif
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/debian-science/packages/r-cran-gam.git
More information about the debian-science-commits
mailing list