R/disband.R

disband <-
function(x,sm=TRUE,op=1,grp=c(1:4),xlab="First Group",
ylab="Delta"){
#
# A shift-type plot aimed at helping see any disordinal interactions
# in a  2 by 2 design.
#
#  x is assumed to be a matrix with columns corresponding to groups
#  or x and have list mode.
#
#  four groups are analyzed,
#
# grp indicates the groups to be compared. By default grp=c(1,2,3,4)
# meaning that the first four groups are used with the difference between
# the first two compared to the difference between the second two.
#
# For four variables stored in x,
# this function plots the shift function for the first two
# variables as well as the second two.
#
#  No disordinal interaction corresponds to the two shift functions being
#  identical. That is, the difference between the quantiles is always the same
#
#  When plotting, the median of x is marked with a + and the two
#  quaratiles are marked with o.
#
#  sm=T, shift function is smoothed using:
#  op!=1, running interval smoother,
#  otherwise use lowess.
#
if(is.matrix(x))x=listm(x)
if(length(grp)!=4)stop("The argument grp must have 4 values")
x=x[grp]
for(j in 1:4)x[[j]]=elimna(x[[j]])
pc<-NA
crit= 1.36 * sqrt((length(x[[1]]) + length(x[[2]]))/(length(x[[1]]) *
    length(x[[2]])))
remx=x
for(iloop in 1:2){
if(iloop==1){
x=remx[[1]]
y=remx[[2]]
}
if(iloop==2){
x=remx[[3]]
y=remx[[4]]
}
xsort<-sort(x)
ysort<-c(NA,sort(y))
l<-0
u<-0
ysort[length(y)+1+1]<-NA
for(ivec in 1:length(x))
{
isub<-max(0,ceiling(length(y)*(ivec/length(x)-crit)))
l[ivec]<-ysort[isub+1]-xsort[ivec]
isub<-min(length(y)+1,floor(length(y)*(ivec/length(x)+crit))+1)
u[ivec]<-ysort[isub+1]-xsort[ivec]
}
num<-length(l[l>0 & !is.na(l)])+length(u[u<0 & !is.na(u)])
qhat<-c(1:length(x))/length(x)
m<-matrix(c(qhat,l,u),length(x),3)
dimnames(m)<-list(NULL,c("qhat","lower","upper"))
xsort<-sort(x)
ysort<-sort(y)
del<-0
for (i in 1:length(x)){
ival<-round(length(y)*i/length(x))
if(ival<=0)ival<-1
if(ival>length(y))ival<-length(y)
del[i]<-ysort[ival]-xsort[i]
}
if(iloop==1){
allx<-c(xsort,xsort,xsort)
ally<-c(del,m[,2],m[,3])
}
if(iloop==2){
allx<-c(allx,xsort,xsort,xsort)
ally<-c(ally,del,m[,2],m[,3])
plot(allx,ally,type="n",ylab=ylab,xlab=xlab)
}
ik<-rep(F,length(xsort))
if(sm){
if(op==1){
ik<-duplicated(xsort)
del<-lowess(xsort,del)$y
}
if(op!=1)del<-runmean(xsort,del,pyhat=TRUE)
}
if(iloop==1){
xsort1=xsort[!ik]
del1=del[!ik]
}
if(iloop==2){
lines(xsort1,del1,lty=iloop)
lines(xsort[!ik],del[!ik],lty=iloop)
}}
done="Done"
done
}
musto101/wilcox_R documentation built on May 23, 2019, 10:52 a.m.