R/ancmppb.R

ancmppb <-
function(x1,y1,x2,y2,fr1=1,fr2=1,alpha=.05,pts=NA,est=tmean,nboot=NA,
bhop=TRUE,SEED=TRUE,cov.fun=skip,cop=NULL,pr=TRUE,...){
#
# Compare two independent  groups using the ancova method
# with multiple covariates.
# No parametric assumption is made about the form of
# the regression lines--a running interval smoother is used.
# Design points are chosen based on depth of points in x1 if pts=NA
#  Assume data are in x1 y1 x2 and y2
#
#  cov.fun determines the location and
#  scatter matrix used to find closest points to
#  a design point. It is used by ancdes.
#
#  Choices for cov.fun include
#  cov.mve
#  cov.mcd
#  rmba
#  skip
#  tbs
#
#if(pr)print("For the old version of this function, use ancmpbpb")
x1=as.matrix(x1)
y1=as.matrix(y1)
if(ncol(x1)==1)stop("Use a function designed for one covariate only")
x2=as.matrix(x2)
y2=as.matrix(y2)
if(ncol(x1)!=ncol(x2))
stop("Number of covariates must be the same for each group")
xy=elimna(cbind(x1,y1))
p=ncol(x1)
p1=p+1
x1=xy[,1:p]
y1=xy[,p1]
xy=elimna(cbind(x2,y2))
x2=xy[,1:p]
y2=xy[,p1]
x1=as.matrix(x1)
x2=as.matrix(x2)
mval1=cov.fun(x1)
mval2=cov.fun(x2)
if(is.na(pts[1])){
x1<-as.matrix(x1)
if(!is.null(cop))pts<-ancdes(x1,cop=cop)
if(is.null(cop))pts=ancdes(x1,center=mval1$center)
}
pts<-as.matrix(pts)
if(nrow(pts)>=29){
print("WARNING: More than 28 design points")
print("Only first 28 are used.")
pts<-pts[1:28,]
}
n1<-1
n2<-1
vecn<-1
for(i in 1:nrow(pts)){
n1[i]<-length(y1[near3d(x1,pts[i,],fr1,mval1)])
n2[i]<-length(y2[near3d(x2,pts[i,],fr2,mval2)])
}
flag<-rep(T,nrow(pts))
for(i in 1:nrow(pts))if(n1[i]<10 || n2[i]<10)flag[i]<-F
flag=as.logical(flag)
pts<-pts[flag,]
if(sum(flag)==1)pts<-t(as.matrix(pts))
if(sum(flag)==0)stop("No comparable design points found, might increase span.")
mat<-matrix(NA,nrow(pts),7)
dimnames(mat)<-list(NULL,c("n1","n2","DIF","TEST","se","ci.low","ci.hi"))
g1<-list()
ip<-nrow(pts)
ncom<-0
nc2<-ip
con<-matrix(0,nrow=2*ip,ncol=nrow(pts))
for (i in 1:nrow(pts)){
ip<-ip+1
ncom<-ncom+1
nc2<-nc2+1
con[ncom,i]<-1
con[nc2,i]<-0-1
temp<-y1[near3d(x1,pts[i,],fr1,mval1)]
g1[[i]]<-temp[!is.na(temp)]
temp<-y2[near3d(x2,pts[i,],fr2,mval2)]
g1[[ip]]<-temp[!is.na(temp)]
}
flag.est=FALSE
if(identical(est,onestep))flag.est=TRUE
if(identical(est,mom))flag.est=TRUE
if(flag.est)mat<-pbmcp(g1,alpha=alpha,nboot=nboot,est=est,con=con,bhop=bhop,SEED=SEED,...)
if(!flag.est)mat<-linconpb(g1,alpha=alpha,nboot=nboot,est=est,con=con,bhop=bhop,SEED=SEED,...)
list(points=pts,output=mat)
}
musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.