R/runpd.R

runpd <-
function(x,y,pts=x,est=tmean,fr=.8,plotit=TRUE,pyhat=FALSE,nmin=0,scale=TRUE,
expand=.5,xout=FALSE,outfun=out,pr=TRUE,xlab="X1",ylab="X2",zlab="",LP=TRUE,
theta=50,phi=25,duplicate="error",MC=FALSE,ticktype="simple",...){
#
# running mean using interval method
# Distances from a point are determined using a projection method
# see function pdclose
#
# fr controls amount of smoothing
# tr is the amount of trimming
# x is an n by p matrix of predictors.
#
if(is.list(x))stop("Data should  not stored be stored in list mode")
x<-as.matrix(x)
pval<-ncol(x)
xx<-cbind(x,y)
xx<-elimna(xx)
x<-xx[,1:pval]
x<-as.matrix(x)
y<-xx[,pval+1]
if(xout){
keepit<-outfun(x,plotit=FALSE)$keep
x<-x[keepit,]
y<-y[keepit]
}
plotit<-as.logical(plotit)
iout<-c(1:nrow(x))
rmd<-1 # Initialize rmd
nval<-1
nmat<-pdclose(x,pts,fr=fr,MC=MC)
for(i in 1:nrow(pts))rmd[i]<-est(y[nmat[i,]],...)
for(i in 1:nrow(pts))nval[i]<-sum(nmat[i,])
if(ncol(x)==2){
if(plotit){
library(akima)
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
}
if(plotit){
if(pr){
if(!scale)print("With dependence, suggest using scale=T")
}
fitr<-rmd[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
mkeep<-x[iout>=1,]
if(LP)fitr=lplot(x[iout>=1,],fitr,pyhat=TRUE,pr=FALSE,plotit=FALSE)$yhat
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.