waddmod {spgam}R Documentation

~~function to do ... ~~

Description

~~ A concise (1-5 lines) description of what the function does. ~~

Usage

waddmod(formul, data, pts, g2, z, w, hopt0 = NA, hvals = NA, ngrid = 0, region = NA, sameh = F)

Arguments

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~~

Details

~~ If necessary, more details than the description above ~~

Value

~Describe the value returned If it is a LIST, use

comp1 Description of 'comp1'
comp2 Description of 'comp2'

...

Warning

....

Note

~~further notes~~

~Make other sections like Warning with section{Warning }{....} ~

Author(s)

~~who you are~~

References

~put references to the literature/web site here ~

See Also

~~objects to See Also as help, ~~~

Examples

##---- 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
  }

[Package spgam version 1.0 Index]