Commit 3ad22b97 authored by Dirk Eddelbuettel's avatar Dirk Eddelbuettel

Import Upstream version 1.7-5

parent 207dfa0a
Package: mgcv
Version: 1.7-4
Version: 1.7-5
Author: Simon Wood <simon.wood@r-project.org>
Maintainer: Simon Wood <simon.wood@r-project.org>
Title: GAMs with GCV/AIC/REML smoothness estimation and GAMMs by PQL
......@@ -12,6 +12,6 @@ Imports: graphics, stats, nlme, Matrix
Suggests: nlme (>= 3.1-64), splines, Matrix
LazyLoad: yes
License: GPL (>= 2)
Packaged: 2011-03-09 11:26:29 UTC; simon
Packaged: 2011-03-25 18:12:14 UTC; simon
Repository: CRAN
Date/Publication: 2011-03-09 15:04:01
Date/Publication: 2011-03-26 15:44:25
......@@ -405,7 +405,7 @@ bam.fit <- function(G,mf,chunk.size,gp,scale,gamma,method,rho=0)
bam <- function(formula,family=gaussian(),data=list(),weights=NULL,subset=NULL,na.action=na.omit,
offset=NULL,method="REML",control=list(...),scale=0,gamma=1,knots=NULL,
offset=NULL,method="REML",control=list(),scale=0,gamma=1,knots=NULL,
sp=NULL,min.sp=NULL,paraPen=NULL,chunk.size=10000,rho=0,...)
## Routine to fit an additive model to a large dataset. The model is stated in the formula,
......
This diff is collapsed.
......@@ -1163,17 +1163,19 @@ gamm <- function(formula,random=NULL,correlation=NULL,family=gaussian(),data=lis
if (G$nsdf>0) term.names<-colnames(G$X)[1:G$nsdf] else term.names<-array("",0)
n.smooth<-length(G$smooth)
if (n.smooth)
for (i in 1:n.smooth)
{ k<-1
for (j in object$smooth[[i]]$first.para:object$smooth[[i]]$last.para)
{ term.names[j]<-paste(object$smooth[[i]]$label,".",as.character(k),sep="")
k<-k+1
if (n.smooth) {
for (i in 1:n.smooth)
{ k<-1
for (j in object$smooth[[i]]$first.para:object$smooth[[i]]$last.para)
{ term.names[j]<-paste(object$smooth[[i]]$label,".",as.character(k),sep="")
k<-k+1
}
}
names(object$sp) <- names(G$sp)
}
names(object$coefficients) <- term.names # note - won't work on matrices!!
names(object$edf) <- term.names
names(object$sp) <- names(G$sp)
if (is.null(weights))
object$prior.weights <- object$y*0+1
else if (inherits(weights,"varFunc"))
......
......@@ -1528,8 +1528,11 @@ variable.summary <- function(pf,dl,n) {
vs
}
## don't be tempted to change to control=list(...) --- messes up passing on other stuff via ...
gam <- function(formula,family=gaussian(),data=list(),weights=NULL,subset=NULL,na.action,offset=NULL,
method="GCV.Cp",optimizer=c("outer","newton"),control=list(...),#gam.control(),
method="GCV.Cp",optimizer=c("outer","newton"),control=list(),#gam.control(),
scale=0,select=FALSE,knots=NULL,sp=NULL,min.sp=NULL,H=NULL,gamma=1,fit=TRUE,
paraPen=NULL,G=NULL,in.out=NULL,...)
......
......@@ -589,7 +589,7 @@ plot.mgcv.smooth <- function(x,P=NULL,data=NULL,label="",se1.mult=1,se2.mult=2,
}
if (!is.null(ylim)) ylimit <- ylim
plot(P$x,trans(P$fit+shift),type="l",xlab=P$xlab,
ylab=P$ylab,ylim=trans(ylimit+shift),xlim=P$xlim,main=main,...)
ylab=P$ylab,ylim=trans(ylimit+shift),xlim=P$xlim,main=P$main,...)
if (rug) {
if (jit) rug(jitter(as.numeric(P$raw)),...)
else rug(as.numeric(P$raw),...)
......@@ -707,7 +707,7 @@ plot.gam <- function(x,residuals=FALSE,rug=TRUE,se=TRUE,pages=0,select=NULL,scal
edf <- sum(x$edf[first:last]) ## Effective DoF for this term
term.lab <- sub.edf(x$smooth[[i]]$label,edf)
P <- plot(x$smooth[[i]],P=NULL,data=x$model,n=n,n2=n2,xlab=xlab,ylab=ylab,too.far=too.far,label=term.lab,
se1.mult=se1.mult,se2.mult=se2.mult,xlim=xlim,ylim=ylim,...)
se1.mult=se1.mult,se2.mult=se2.mult,xlim=xlim,ylim=ylim,main=main,...)
if (is.null(P)) pd[[i]] <- list(plot.me=FALSE) else {
p <- x$coefficients[first:last] ## relevent coefficients
offset <- attr(P$X,"offset") ## any term specific offset
......
......@@ -2220,11 +2220,15 @@ smooth.construct.ds.smooth.spec<-function(object,data,knots)
}
if (nk>n) { ## more knots than data - silly.
nk <- 0
warning("more knots than data in an sos term: knots ignored.")
warning("more knots than data in a ds term: knots ignored.")
}
xu <- uniquecombs(matrix(x,n,object$dim)) ## find the unique `locations'
if (nrow(xu)<object$bs.dim) stop(
"A term has fewer unique covariate combinations than specified maximum degrees of freedom")
## deal with possibility of large data set
if (nk==0) { ## need to create knots
xu <- uniquecombs(matrix(x,n,object$dim)) ## find the unique `locations'
## xu <- uniquecombs(matrix(x,n,object$dim)) ## find the unique `locations'
nu <- nrow(xu) ## number of unique locations
if (n > xtra$max.knots) { ## then there *may* be too many data
if (nu>xtra$max.knots) { ## then there is really a problem
......@@ -2247,6 +2251,8 @@ smooth.construct.ds.smooth.spec<-function(object,data,knots)
} else { knt <- xu;nk <- nu } ## just set knots to data
}
if (object$bs.dim[1]<0) object$bs.dim <- 10*3^(object$dim[1]-1) # auto-initialize basis dimension
## Check the conditions on Duchon's m, s and n (p.order[1], p.order[2] and dim)...
......@@ -2356,8 +2362,8 @@ Predict.matrix.duchon.spline <- function(object,data)
if (n > ind[nk]) { ## still some left over
ind <- (ind[nk]+1):n ## last chunk
Xc <- DuchonE(x=x[ind,],xk=object$knt,m=object$p.order[1],s=object$p.order[2],n=object$dim)
Xc <- cbind(Xc%*%object$UZ,DuchonT(x=x[ind,],m=object$p.order[1],n=object$dim))
Xc <- DuchonE(x=x[ind,,drop=FALSE],xk=object$knt,m=object$p.order[1],s=object$p.order[2],n=object$dim)
Xc <- cbind(Xc%*%object$UZ,DuchonT(x=x[ind,,drop=FALSE],m=object$p.order[1],n=object$dim))
X <- rbind(X,Xc);rm(Xc)
}
} else {
......
......@@ -2,6 +2,31 @@
*** denotes really big changes
ISSUES:
1.7-5
* gam.fit3 modified to converge more reliably with links that don't guarantee
feasible mu (e.g poisson(link="identity")). One vulnerability removed + a
new approach taken, which restarts the iteration from null model
coefficients if the original start values lead to an infinite deviance.
* Duchon spline bug fix (could fail to create model matrix if
number of data was one greateer than number of unique data).
* fix so that 'main' is not ignored by plot.gam (got broken in 1.7-0
object orientation of smooth plotting)
* Duchon spline constructor now catches k > number of data errors.
* fix of a gamm bug whereby a model with no smooths would fail after
fitting because of a missing smoothing parameter vector.
* fix to bug introduced to gam/bam in 1.7-3, whereby '...' were passed to
gam.control, instead of passing on to fitting routines.
* fix of some compiler warnings in matrix.c
* fix to indexing bug in monotonic additive model example in ?pcls.
1.7-4
* Fix for single letter typo bug in C code called by slanczos, could
......
......@@ -15,7 +15,7 @@ for large datasets.
}
\usage{
bam(formula,family=gaussian(),data=list(),weights=NULL,subset=NULL,
na.action=na.omit, offset=NULL,method="REML",control=list(...),
na.action=na.omit, offset=NULL,method="REML",control=list(),
scale=0,gamma=1,knots=NULL,sp=NULL,min.sp=NULL,paraPen=NULL,
chunk.size=10000,rho=0,...)
}
......
......@@ -40,7 +40,7 @@ For very large datasets see \code{\link{bam}}, for mixed GAM see \code{\link{gam
gam(formula,family=gaussian(),data=list(),weights=NULL,subset=NULL,
na.action,offset=NULL,method="GCV.Cp",
optimizer=c("outer","newton"),control=list(...),scale=0,
optimizer=c("outer","newton"),control=list(),scale=0,
select=FALSE,knots=NULL,sp=NULL,min.sp=NULL,H=NULL,gamma=1,
fit=TRUE,paraPen=NULL,G=NULL,in.out,...)
}
......
......@@ -187,6 +187,7 @@ G$Ain <- rbind(Xx,Xz) ## inequality constraint matrix
G$bin <- rep(0,nrow(G$Ain))
G$sp <- b$sp
G$p <- coef(b)
G$off <- G$off-1 ## to match what pcls is expecting
## force inital parameters to meet constraint
G$p[11:18] <- G$p[2:9]<- 0
p <- pcls(G) ## constrained fit
......
......@@ -48,7 +48,7 @@ smooth class documented under \code{\link{smooth.construct}}, this object will c
avoid any co-linearity problems that might otehrwise occur in the penalty null space basis of the term. }
\item{Xu}{A matrix of the unique covariate combinations for this smooth (the basis is constructed by first stripping
out duplicate locations).}
\item{UZ}{The matrix mapping the t.p.r.s. parameters back to the parameters of a full thin plate spline.}
\item{UZ}{The matrix mapping the smoother parameters back to the parameters of a full Duchon spline.}
\item{null.space.dimension}{The dimension of the space of functions that have zero wiggliness according to the
wiggliness penalty for this term.}
}
......@@ -74,7 +74,7 @@ approach by supplying a reduced set of covariate values from which to obtain th
typically the number of covariate values used will be substantially
smaller than the number of data, and substantially larger than the basis dimension, \code{k}. This approach is
the one taken automatically if the number of unique covariate values (combinations) exceeds \code{max.knots}.
The second possibility is to avoid the eigen-decomposition used to find the t.p.r.s. basis altogether and simply use
The second possibility is to avoid the eigen-decomposition used to find the spline basis altogether and simply use
the basis implied by the chosen knots: this will happen if the number of knots supplied matches the
basis dimension, \code{k}. For a given basis dimension the second option is
faster, but gives poorer results (and the user must be quite careful in choosing knot locations).
......
......@@ -251,15 +251,16 @@ void dumpmat(M,filename) matrix M;char *filename;
void readmat(M,filename) matrix *M;char *filename;
{ FILE *in;long i,j,k;char str[200];
size_t kr;
in=fopen(filename,"rb");
if (in==NULL)
{ sprintf(str,_("\n%s not found, nothing read!"),filename);
ErrorMessage(str,1);}
fread(&i,sizeof(long),1,in);
fread(&j,sizeof(long),1,in);
kr = fread(&i,sizeof(long),1,in);
kr = fread(&j,sizeof(long),1,in);
(*M)=initmat(i,j);
for (k=0L;k<M->r;k++)
{ fread((*M).M[k],sizeof(double),(size_t)M->c,in);
{ kr = fread((*M).M[k],sizeof(double),(size_t)M->c,in);
}
fclose(in);
}
......@@ -1962,7 +1963,7 @@ void gettextmatrix(M,name) matrix M;char *name;
/* reads a text file with M.r rows and M.c columns into matrix M */
{ FILE *f;
long i,j;
long i,j,k;
char c,str[200];
f=fopen(name,"rt");
if (!f)
......@@ -1970,7 +1971,7 @@ void gettextmatrix(M,name) matrix M;char *name;
ErrorMessage(str,1);}
for (i=0;i<M.r;i++)
{ for (j=0;j<M.c;j++)
{ fscanf(f,"%lf",M.M[i]+j);
{ k = fscanf(f,"%lf",M.M[i]+j);
}
c=' ';while ((c!='\n')&&(!feof(f))) c=(char)fgetc(f);
}
......
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