R/rung3d.R

rung3d <-
function(x,y,est=onestep,fr=1,plotit=TRUE,theta=50,phi=25,pyhat=FALSE,LP=FALSE,
expand=.5,scale=FALSE,zscale=TRUE,
nmin=0,xout=FALSE,eout=FALSE,outfun=out,SEED=TRUE,STAND=TRUE,
xlab="X",ylab="Y",zlab="",pr=TRUE,duplicate="error",ticktype="simple",...){
#
# running mean using interval method
#

# fr (the span) controls amount of smoothing
# est is the measure of location.
# (Goal is to determine est(y) given x.)
# x is an n by p matrix of predictors.
#
# pyhat=T, predicted values are returned.
#
library(MASS)
library(akima)
if(SEED)set.seed(12) # set seed for cov.mve
if(eout && xout)stop("Not allowed to have eout=xout=T")
if(!is.matrix(x))stop("Data are not stored in a matrix.")
if(nrow(x) != length(y))stop("Number of rows in x does not match length of y")
temp<-cbind(x,y)
p<-ncol(x)
p1<-p+1
temp<-elimna(temp) # Eliminate any rows with missing values.
if(eout){
keepit<-outfun(temp,plotit=FALSE)$keep
x<-x[keepit,]
y<-y[keepit]
}
if(xout){
keepit<-outfun(x,plotit=FALSE,STAND=STAND,...)$keep
x<-x[keepit,]
y<-y[keepit]
}
if(zscale){
for(j in 1:p1){
temp[,j]<-(temp[,j]-median(temp[,j]))/mad(temp[,j])
}}
x<-temp[,1:p]
y<-temp[,p1]
m<-cov.mve(x)
iout<-c(1:nrow(x))
rmd<-1 # Initialize rmd
nval<-1
for(i in 1:nrow(x))rmd[i]<-est(y[near3d(x,x[i,],fr,m)],...)
for(i in 1:nrow(x))nval[i]<-length(y[near3d(x,x[i,],fr,m)])
if(ncol(x)==2){
if(plotit){
if(pr){
if(!scale)print("With dependence, suggest using scale=T")
}
fitr<-rmd[nval>nmin]
y<-y[nval>nmin]
x<-x[nval>nmin,]
iout<-c(1:length(fitr))
nm1<-length(fitr)-1
for(i in 1:nm1){
ip1<-i+1
for(k in ip1:length(fitr))if(sum(x[i,]==x[k,])==2)iout[k]<-0
}
fitr<-fitr[iout>=1] # Eliminate duplicate points in the x-y plane
#                 This is necessary when doing three dimensional plots
#                 with the R function interp
if(LP)fitr=lplot(x[iout>=1,],fitr,pyhat=TRUE,pr=FALSE,plotit=FALSE)$yhat
mkeep<-x[iout>=1,]
fit<-interp(mkeep[,1],mkeep[,2],fitr,duplicate=duplicate)
persp(fit,theta=theta,phi=phi,expand=expand,
scale=scale,xlab=xlab,ylab=ylab,zlab=zlab,ticktype=ticktype)
}}
if(pyhat)last<-rmd
if(!pyhat)last <- "Done"
        last
}
musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.