| waddmod {spgam} | R Documentation |
~~ A concise (1-5 lines) description of what the function does. ~~
waddmod(formul, data, pts, g2, z, w, hopt0 = NA, hvals = NA, ngrid = 0, region = NA, sameh = F)
formul |
~~Describe formul here~~ |
data |
~~Describe data here~~ |
pts |
~~Describe pts here~~ |
g2 |
~~Describe g2 here~~ |
z |
~~Describe z here~~ |
w |
~~Describe w here~~ |
hopt0 |
~~Describe hopt0 here~~ |
hvals |
~~Describe hvals here~~ |
ngrid |
~~Describe ngrid here~~ |
region |
~~Describe region here~~ |
sameh |
~~Describe sameh here~~ |
~~ If necessary, more details than the description above ~~
~Describe the value returned If it is a LIST, use
comp1 |
Description of 'comp1' |
comp2 |
Description of 'comp2' |
...
....
~~further notes~~
~Make other sections like Warning with section{Warning }{....} ~
~~who you are~~
~put references to the literature/web site here ~
~~objects to See Also as help, ~~~
##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function(formul,data,pts,g2,z,w,hopt0=NA,hvals=NA,ngrid=0,region=NA,sameh=F){
# FITTING WEIGHTED ADDITIVE MODEL:
# g1 is linear part, g2 is spatial nonparam part, z is adj dep var, w weights.
# sameh=T means we want to use the value in hopt0 as the smoothing parameter.
# sameh=F means we want to choose a new value of smoothing parameter,
# using hopt0 as a starting point to help choose.
# if hopt=NA, then a smoothing parameter is chosen from scratch from
# the ones specified in hvals.
# ngrid is the approximate number of grid points in the polygon at which
# the surface is calculated. It takes longer the more grid points used.
# get surface with log base 2 so comparable with non gam method.
# If specify ngrid=0, then don't get estimate over grid,
# just at data points.
i=0
brk=0
if(is.na(hopt0)){hopt=0}else{hopt=hopt0}
k=1
formul=formula(form)
termos<-terms(formul)
at<-as.character(attr(termos,"variables"))[-1]
why<-data[,at[1]]
if(sameh){
cat('\n\n\n WEIGHTED ADDITIVE MODEL ITERATION',k,'\n');k=k+1
cat('\n Keeping fixed h... \n')
yvar <- z-g2
data[,at[1]]<-yvar
data$w<-w
data<-as.data.frame(as.matrix(data))
temp <- lm(formul,weights=w,data=data)
g1 <- fitted(temp)
beta=summary(temp)$coeff;
cat('\n Beta is ',beta[,1],'\n')
yvar <- z-g1
smooth <- kerreg2d(hopt,pts,yvar,w)
g2 <- smooth$vals-mean(smooth$vals)
}else{
repeat{
if(brk==1){break}
if(i==10)stop('\n Too many iterations (done 10) \n')
i=i+1
cat('\n\n\n WEIGHTED ADDITIVE MODEL ITERATION',k,'\n');k=k+1
yvar <- z-g2
data[,at[1]]<-yvar
data$w<-w
data<-as.data.frame(as.matrix(data))
temp <- lm(formul,weights=w,data=data)
g1 <- fitted(temp)
beta=summary(temp)$coeff;
cat('\n Beta is ',beta[,1],'\n')
yvar <- z-g1
cat('\n Choosing h value...\n')
if(hopt==0){
hopt.new <- hch2d( hvals, pts, yvar, w )
}
else{
pos=(1:length(hvals))[hvals==hopt]
if(pos<=2){hs=hvals[1:5]}
if((pos>2)&(pos<(length(hvals)-1))){hs=hvals[(pos-2):(pos+2)]}
if(pos>=(length(hvals)-1)){
hs=hvals[(length(hvals)-4):(length(hvals))]}
hopt.new <- hch2d( hs, pts, yvar, w)
}
cat('\n chosen hopt =',hopt.new,'\n')
hopt.old=hopt
smooth <- kerreg2d(hopt.new,pts,yvar,w)
g2 <- smooth$vals-mean(smooth$vals)
if((hopt.new==hopt.old)&(!is.na(hopt.new==hopt.old))){brk=1}
hopt=hopt.new
}
}
cat('\n WEIGHTED ADDITIVE MODEL ITERATION',k,'\n');k=k+1
yvar <- z-g2
data[,at[1]]<-yvar
data$w<-w
data<-as.data.frame(as.matrix(data))
temp <- lm(formul,weights=w,data=data)
g1 <- fitted(temp)
beta=summary(temp)$coeff
cat('\n',beta[,1],'\n')
yvar <- z-g1
smooth <- kerreg2d(hopt,pts,yvar,w)
g2 <- smooth$vals-mean(smooth$vals)
cat('\n WEIGHTED ADDITIVE MODEL ITERATION',k,'\n');k=k+1
yvar <- z-g2
data[,at[1]]<-yvar
data$w<-w
data<-as.data.frame(as.matrix(data))
temp <- lm(formul,weights=w,data=data)
g1 <- fitted(temp)
beta=summary(temp)$coeff
cat('\n',beta[,1],'\n')
yvar <- z-g1
smooth <- kerreg2d(hopt,pts,yvar,w)
g2 <- smooth$vals-mean(smooth$vals)
# [More iterations can be added from above if you want...]
fhat <- g1 + g2
phat <- exp(fhat)/(1+exp(fhat))
w <- phat*(1-phat)
z <- fhat + (why-phat)/w
if(ngrid>0){
gsmooth <- kerreg2d(hopt,pts,yvar,w,poly=region, grid=T,ngrid=ngrid)
ans <- list(g1=g1,g2=g2,z=z,w=w,beta=beta, h=hopt,
g2est=list(x=gsmooth$x, y=gsmooth$y,
z=(gsmooth$z-mean(gsmooth$z,na.rm=T))/log(2)))
}else{
ans <- list(g1=g1,g2=g2,z=z,w=w,beta=beta, h=hopt)
}
ans
}