R/run3bo.R

run3bo <-
function(x,y,fr=1,est=tmean,theta = 50, phi = 25,nmin=0,
pyhat=FALSE,eout=FALSE,outfun=out,plotit=TRUE,xout=FALSE,nboot=40,SEED=TRUE,STAND=TRUE,
expand=.5,scale=FALSE,xlab="X",ylab="Y",zlab="",ticktype="simple",...){
#
# running mean using interval method
#
# fr controls amount of smoothing
# tr is the amount of trimming
#
# Missing values are automatically removed.
#
library(MASS)
library(akima)
if(SEED)set.seed(2)
temp<-cbind(x,y)
x<-as.matrix(x)
p<-ncol(x)
p1<-p+1
if(p>2)plotit<-F
temp<-elimna(temp) # Eliminate any rows with missing values.
x<-temp[,1:p]
x<-as.matrix(x)
y<-temp[,p1]
if(xout){
keepit<-rep(T,nrow(x))
flag<-outfun(x,plotit=FALSE,STAND=STAND,...)$out.id
keepit[flag]<-F
x<-x[keepit,]
y<-y[keepit]
}
mat<-matrix(NA,nrow=nboot,ncol=length(y))
vals<-NA
for(it in 1:nboot){
idat<-sample(c(1:length(y)),replace=TRUE)
xx<-temp[idat,1:p]
yy<-temp[idat,p1]
tmy<-rung3hat(xx,yy,pts=x,est=est,fr=fr,...)$rmd
mat[it,]<-tmy
}
rmd<-apply(mat,2,mean,na.rm=TRUE)
flag<-!is.na(rmd)
rmd<-elimna(rmd)
x<-x[flag,]
y<-y[flag]
nval<-NA
m<-cov.mve(x)
for(i in 1:nrow(x))nval[i]<-length(y[near3d(x,x[i,],fr,m)])
if(plotit && ncol(x)==2){
#if(ncol(x)!=2)stop("When plotting, x must be an n by 2 matrix")
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
mkeep<-x[iout>=1,]
fit<-interp(mkeep[,1],mkeep[,2],fitr)
persp(fit,theta=theta,phi=phi,xlab=xlab,ylab=ylab,zlab=zlab,expand=expand,
scale=scale,ticktype=ticktype)
}
last<-"Done"
if(pyhat)last<-rmd
list(output=last)
}
musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.