• QR Code (size=2)
• QR Code (size=3)
• QR Code (size=4)
• QR Code (size=5)
• QR Code (size=6)

546.5	531	519	557.5
992.5	1033.5	922	996.5
730	698	640.5	669
1546	1712.5	1637	1691.5
466.5	450.5	462.5	475
596.5	573	572.5	551.5
699	810.5	733	736.5
564.5	525	573.5	600.5
452	466.5	445.5	484
633	651	693	713
603	549	571	575.5
891	641	804	1285
1004.5	1043	1033	1018
881	971	891.5	968
457	462.5	480	459
785.5	755.5	765.5	756
515.5	553	542	533.5
835	925	825	988
494	521	523	489.5
808	807.5	814.5	879.5
496.5	510.5	455.5	504
463	505.5	453.5	483.5
604	560.5	628	710
456	468	462	452
389.5	389.5	377	342.5

rm2mcp<-function(J,K,x,est=tmean,alpha=.05,grp=NA,dif=T,nboot=NA,
plotit=FALSE,BA=F,hoch=F,...){
JK <- J * K
if(is.matrix(x))
x <- listm(x)
if(!is.na(grp[1])) {
yy <- x
for(j in 1:length(grp))
x[[j]] <- yy[[grp[j]]]
}
if(!is.list(x))
stop('Data must be stored in list mode or a matrix.')
for(j in 1:JK) {
xx <- x[[j]]
x[[j]] <- xx[!is.na(xx)]
}
temp<-con2way(J,K)
conA<-temp$conA
conB<-temp$conB
conAB<-temp$conAB
ncon <- max(nrow(conA), nrow(conB), nrow(conAB))
FacA<-rmmcppb(x,con=conA,est=est,plotit=plotit,dif=dif,grp=grp,
nboot=nboot,BA=T,hoch=F,...)
FacB<-rmmcppb(x,con=conB,est=est,plotit=plotit,dif=dif,grp=grp,
nboot=nboot,BA=T,hoch=F,...)
FacAB<-rmmcppb(x,con=conAB,est=est,plotit=plotit,dif=dif,grp=grp,
nboot=nboot,BA=T,hoch=F,...)
list(Factor.A=FacA,Factor.B=FacB,Factor.AB=FacAB)
}
listm<-function(x){
if(is.null(dim(x)))stop('The argument x must be a matrix or data frame')
y<-list()
for(j in 1:ncol(x))y[[j]]<-x[,j]
y
}
con2way<-function(J,K){
JK <- J * K
Ja<-(J^2-J)/2
Ka<-(K^2-K)/2
JK<-J*K
conA<-matrix(0,nrow=JK,ncol=Ja)
ic<-0
for(j in 1:J){
for(jj in 1:J){
if(j < jj){
ic<-ic+1
mat<-matrix(0,nrow=J,ncol=K)
mat[j,]<-1
mat[jj,]<-0-1
conA[,ic]<-t(mat)
}}}
conB<-matrix(0,nrow=JK,ncol=Ka)
ic<-0
for(k in 1:K){
for(kk in 1:K){
if(kic<-ic+1
mat<-matrix(0,nrow=J,ncol=K)
mat[,k]<-1
mat[,kk]<-0-1
conB[,ic]<-t(mat)
}}}
conAB<-matrix(0,nrow=JK,ncol=Ka*Ja)
ic<-0
for(j in 1:J){
for(jj in 1:J){
if(j < jj){
for(k in 1:K){
for(kk in 1:K){
if(kic<-ic+1
mat<-matrix(0,nrow=J,ncol=K)
mat[j,k]<-1
mat[j,kk]<-0-1
mat[jj,k]<-0-1
mat[jj,kk]<-1
}
conAB[,ic]<-t(mat)
}}}}}
list(conA=conA,conB=conB,conAB=conAB)
}
rmmcppbd<-function(x,y=NULL,alpha=.05,con=0,est=onestep,plotit=TRUE,grp=NA,nboot=NA,
hoch=T,SEED=TRUE,...){
if(!is.null(y[1]))x<-cbind(x,y)
if(!is.list(x) && !is.matrix(x))stop('Data must be stored in a matrix or in list mode.')
if(is.list(x)){
if(is.matrix(con)){
if(length(x)!=nrow(con))stop('The number of rows in con is not equal to the number of groups.')
}}
if(is.list(x)){
mat<-matl(x)
}
if(is.matrix(x) && is.matrix(con)){
if(ncol(x)!=nrow(con))stop('The number of rows in con is not equal to the number of groups.')
mat<-x
}
if(is.matrix(x))mat<-x
if(!is.na(sum(grp)))mat<-mat[,grp]
x<-mat
mat<-elimna(mat) # Remove rows with missing values.
x<-mat
J<-ncol(mat)
n=nrow(mat)
if(n>=80)hoch=T
Jm<-J-1
if(sum(con^2)==0){
d<-(J^2-J)/2
con<-matrix(0,J,d)
id<-0
for (j in 1:Jm){
jp<-j+1
for (k in jp:J){
id<-id+1
con[j,id]<-1
con[k,id]<-0-1
}}}
d<-ncol(con)
if(is.na(nboot)){
nboot<-5000
if(d<=10)nboot<-3000
if(d<=6)nboot<-2000
if(d<=4)nboot<-1000
}
n<-nrow(mat)
crit.vec<-alpha/c(1:d)
connum<-ncol(con)
xx<-x%*%con
xx<-as.matrix(xx)
if(SEED)set.seed(2) # set seed of random number generator so that
psihat<-matrix(0,connum,nboot)
bvec<-matrix(NA,ncol=connum,nrow=nboot)
data<-matrix(sample(n,size=n*nboot,replace=T),nrow=nboot)
if(ncol(xx)==1){
for(ib in 1:nboot)psihat[1,ib]<-est(xx[data[ib,]],...)
}
if(ncol(xx)>1){
for(ib in 1:nboot)psihat[,ib]<-apply(xx[data[ib,],],2,est,...)
}
test<-1
for (ic in 1:connum){
test[ic]<-(sum(psihat[ic,]>0)+.5*sum(psihat[ic,]==0))/nboot
test[ic]<-min(test[ic],1-test[ic])
}
test<-2*test
ncon<-ncol(con)
if(alpha==.05){
dvec<-c(.025,.025,.0169,.0127,.0102,.00851,.0073,.00639,.00568,.00511)
if(ncon > 10){
avec<-.05/c(11:ncon)
dvec<-c(dvec,avec)
}}
if(alpha==.01){
dvec<-c(.005,.005,.00334,.00251,.00201,.00167,.00143,.00126,.00112,.00101)
if(ncon > 10){
avec<-.01/c(11:ncon)
dvec<-c(dvec,avec)
}}
if(alpha != .05 && alpha != .01){
dvec<-alpha/c(1:ncon)
dvec[2]<-alpha/2
}
if(hoch)dvec<-alpha/(2*c(1:ncon))
dvec<-2*dvec
if(plotit && connum==1){
plot(c(psihat[1,],0),xlab='',ylab='Est. Difference')
points(psihat[1,])
abline(0,0)
}
temp2<-order(0-test)
ncon<-ncol(con)
zvec<-dvec[1:ncon]
sigvec<-(test[temp2]>=zvec)
output<-matrix(0,connum,6)
dimnames(output)<-list(NULL,c('con.num','psihat','p.value','p.crit','ci.lower','ci.upper'))
tmeans<-apply(xx,2,est,...)
psi<-1
icl<-round(dvec[ncon]*nboot/2)+1
icu<-nboot-icl-1
for (ic in 1:ncol(con)){
output[ic,2]<-tmeans[ic]
output[ic,1]<-ic
output[ic,3]<-test[ic]
output[temp2,4]<-zvec
temp<-sort(psihat[ic,])
output[ic,5]<-temp[icl]
output[ic,6]<-temp[icu]
}
num.sig<-sum(output[,3]<=output[,4])
list(output=output,con=con,num.sig=num.sig)
}
rmmcppb<-function(x,y=NULL,alpha=.05,con=0,est=onestep,plotit=TRUE,dif=T,grp=NA,nboot=NA,BA=F,hoch=F,xlab='Group 1',ylab='Group 2',pr=TRUE,SEED=TRUE,...){
if(dif){
if(pr)print('dif=T, so analysis is done on difference scores')
temp<-rmmcppbd(x,y=y,alpha=.05,con=con,est,plotit=plotit,grp=grp,nboot=nboot,
hoch=T,...)
output<-temp$output
con<-temp$con
}
if(!dif){
if(pr){
print('dif=F, so analysis is done on marginal distributions')
if(!BA)print('With M-estimator or MOM, suggest using BA=T and hoch=T')
}
if(!is.null(y[1]))x<-cbind(x,y)
if(!is.list(x) && !is.matrix(x))stop('Data must be stored in a matrix or in list mode.')
if(is.list(x)){
if(is.matrix(con)){
if(length(x)!=nrow(con))stop('The number of rows in con is not equal to the number of groups.')
}}
if(is.list(x)){
mat<-matl(x)
}
if(is.matrix(x) && is.matrix(con)){
if(ncol(x)!=nrow(con))stop('The number of rows in con is not equal to the number of groups.')
mat<-x
}
if(is.matrix(x))mat<-x
if(!is.na(sum(grp)))mat<-mat[,grp]
mat<-elimna(mat) # Remove rows with missing values.
x<-mat
J<-ncol(mat)
xcen<-x
for(j in 1:J)xcen[,j]<-x[,j]-est(x[,j])
Jm<-J-1
if(sum(con^2)==0){
d<-(J^2-J)/2
con<-matrix(0,J,d)
id<-0
for (j in 1:Jm){
jp<-j+1
for (k in jp:J){
id<-id+1
con[j,id]<-1
con[k,id]<-0-1
}}}
d<-ncol(con)
if(is.na(nboot)){
if(d<=4)nboot<-1000
if(d>4)nboot<-5000
}
n<-nrow(mat)
crit.vec<-alpha/c(1:d)
connum<-ncol(con)
if(SEED)set.seed(2) # set seed of random number generator so that
xbars<-apply(mat,2,est)
psidat<-NA
for (ic in 1:connum)psidat[ic]<-sum(con[,ic]*xbars)
psihat<-matrix(0,connum,nboot)
psihatcen<-matrix(0,connum,nboot)
bvec<-matrix(NA,ncol=J,nrow=nboot)
bveccen<-matrix(NA,ncol=J,nrow=nboot)
if(pr)print('Taking bootstrap samples. Please wait.')
data<-matrix(sample(n,size=n*nboot,replace=T),nrow=nboot)
for(ib in 1:nboot){
bvec[ib,]<-apply(x[data[ib,],],2,est,...)
bveccen[ib,]<-apply(xcen[data[ib,],],2,est,...)
}
test<-1
bias<-NA
for (ic in 1:connum){
psihat[ic,]<-apply(bvec,1,bptdpsi,con[,ic])
psihatcen[ic,]<-apply(bveccen,1,bptdpsi,con[,ic])
bias[ic]<-sum((psihatcen[ic,]>0))/nboot-.5
ptemp<-(sum(psihat[ic,]>0)+.5*sum(psihat[ic,]==0))/nboot
if(BA)test[ic]<-ptemp-.1*bias[ic]
if(!BA)test[ic]<-ptemp
test[ic]<-min(test[ic],1-test[ic])
test[ic]<-max(test[ic],0)
}
test<-2*test
ncon<-ncol(con)
if(alpha==.05){
dvec<-c(.025,.025,.0169,.0127,.0102,.00851,.0073,.00639,.00568,.00511)
dvecba<-c(.05,.025,.0169,.0127,.0102,.00851,.0073,.00639,.00568,.00511)
if(ncon > 10){
avec<-.05/c(11:ncon)
dvec<-c(dvec,avec)
}}
if(alpha==.01){
dvec<-c(.005,.005,.00334,.00251,.00201,.00167,.00143,.00126,.00112,.00101)
dvecba<-c(.01,.005,.00334,.00251,.00201,.00167,.00143,.00126,.00112,.00101)
if(ncon > 10){
avec<-.01/c(11:ncon)
dvec<-c(dvec,avec)
}}
if(alpha != .05 && alpha != .01){
dvec<-alpha/c(1:ncon)
dvecba<-dvec
dvec[2]<-alpha
}
if(hoch)dvec<-alpha/c(1:ncon)
dvec<-2*dvec
dvecba<-dvec
if(plotit && ncol(bvec)==2){
z<-c(0,0)
one<-c(1,1)
plot(rbind(bvec,z,one),xlab=xlab,ylab=ylab,type='n')
points(bvec)
totv<-apply(x,2,est,...)
cmat<-var(bvec)
dis<-mahalanobis(bvec,totv,cmat)
temp.dis<-order(dis)
ic<-round((1-alpha)*nboot)
xx<-bvec[temp.dis[1:ic],]
xord<-order(xx[,1])
xx<-xx[xord,]
temp<-chull(xx)
lines(xx[temp,])
lines(xx[c(temp[1],temp[length(temp)]),])
abline(0,1)
}
temp2<-order(0-test)
ncon<-ncol(con)
zvec<-dvec[1:ncon]
if(BA)zvec<-dvecba[1:ncon]
sigvec<-(test[temp2]>=zvec)
output<-matrix(0,connum,6)
dimnames(output)<-list(NULL,c('con.num','psihat','p.value','p.sig','ci.lower','ci.upper'))
tmeans<-apply(mat,2,est,...)
psi<-1
output[temp2,4]<-zvec
for (ic in 1:ncol(con)){
output[ic,2]<-sum(con[,ic]*tmeans)
output[ic,1]<-ic
output[ic,3]<-test[ic]
temp<-sort(psihat[ic,])
icl<-round(output[ic,4]*nboot/2)+1
icu<-nboot-(icl-1)
output[ic,5]<-temp[icl]
output[ic,6]<-temp[icu]
}
}
num.sig<-sum(output[,3]<=output[,4])
list(output=output,con=con,num.sig=num.sig)
}
matl<-function(x){
J=length(x)
nval=NA
for(j in 1:J)nval[j]=length(x[[j]])
temp<-matrix(NA,ncol=J,nrow=max(nval))
for(j in 1:J)temp[1:nval[j],j]<-x[[j]]
temp
}
Aband<-function(x,alpha=.05,plotit=TRUE,sm=T,SEED=TRUE,nboot=500,grp=c(1:4),
xlab='X (First Factor)',ylab='Delta',crit=NA,print.all=F,plot.op=F){
if(!is.list(x) && !is.matrix(x))stop('store data in list mode or a matrix')
if(SEED)set.seed(2)
if(is.matrix(x))x<-listm(x)
for(j in 1:length(x))x[[j]]=elimna(x[[j]])/2
if(length(grp)<4)stop('There must be at least 4 groups')
if(length(x)!=4)stop('The argument grp must have 4 values')
x<-x[grp]
n<-c(length(x[[1]]),length(x[[2]]),length(x[[3]]),length(x[[4]]))
vals<-NA
y<-list()
if(is.na(crit)){
print('Approximating critical value. Please wait.')
for(i in 1:nboot){
for(j in 1:4)
y[[j]]<-rnorm(n[j])
temp<-ks.test(outer(y[[1]],y[[2]],FUN='+'),outer(y[[3]],y[[4]],FUN='+'))
vals[i]<-temp[1]$statistic
}
vals<-sort(vals)
ic<-(1-alpha)*nboot
crit<-vals[ic]
}
if(plot.op){
plotit<-F
g2plot(v1,v2)
}
output<-sband(outer(x[[1]],x[[2]],FUN='+'),outer(x[[3]],x[[4]],FUN='+'),
plotit=plotit,crit=crit,flag=F,sm=sm,xlab=xlab,ylab=ylab)
if(!print.all){
numsig<-output$numsig
ks.test.stat<-ks.test(outer(x[[1]],x[[2]],FUN='+'),
outer(x[[3]],x[[4]],FUN='+'))$statistic
output<-matrix(c(numsig,crit,ks.test.stat),ncol=1)
dimnames(output)<-list(c('number sig','critical value','KS test statistics'),
NULL)
}
output
}
elimna<-function(m){
if(is.null(dim(m)))m<-as.matrix(m)
ikeep<-c(1:nrow(m))
for(i in 1:nrow(m))if(sum(is.na(m[i,])>=1))ikeep[i]<-0
elimna<-m[ikeep[ikeep>=1],]
elimna
}
tmean<-function(x,tr=.2,na.rm=FALSE){
if(na.rm)x<-x[!is.na(x)]
val<-mean(x,tr)
val
}
bptdpsi<-function(x,con){
bptdpsi<-sum(con*x)
bptdpsi
}
bptdsub<-function(isub,x,tr,con){
h1 <- nrow(x) - 2 * floor(tr * nrow(x))
se<-0
for(j in 1:ncol(x)){
for(k in 1:ncol(x)){
djk<-(nrow(x) - 1) * wincor(x[isub,j],x[isub,k], tr)$cov
se<-se+con[j]*con[k]*djk
}
}
se/(h1*(h1-1))
}
y<-t(y)
head(y)
dimnames(y)
bitmap(file='test1.png')
boxplot(y)
dev.off()
bitmap(file='test2.png')
layout(matrix(c(1,2,3,4), 2, 2))
(rmout<-rm2mcp(2,2,y, plotit=TRUE) )
dev.off()
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Information on data table  format.',3,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'For this repeated measures design you must')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'have only one participant /subject on each row.')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'The order of factors is also constrained so that')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'for factors A B each with two levels the column order is.')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'A1B1 A1B2 A2B1 A2B2 as given in the default example.')
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='myinfo1.tab')
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,names(rmout)[1],3,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.A$output)[[2]][1],header=TRUE)
a<-table.element(a,rmout$Factor.A$output[1])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.A$output)[[2]][2],header=TRUE)
a<-table.element(a,rmout$Factor.A$output[2])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.A$output)[[2]][3],header=TRUE)
a<-table.element(a,rmout$Factor.A$output[3])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.A$output)[[2]][4],header=TRUE)
a<-table.element(a,rmout$Factor.A$output[4])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.A$output)[[2]][5],header=TRUE)
a<-table.element(a,rmout$Factor.A$output[5])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.A$output)[[2]][6],header=TRUE)
a<-table.element(a,rmout$Factor.A$output[6])
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable1.tab')
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,names(rmout)[2],3,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.B$output)[[2]][1],header=TRUE)
a<-table.element(a,rmout$Factor.B$output[1])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.B$output)[[2]][2],header=TRUE)
a<-table.element(a,rmout$Factor.B$output[2])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.B$output)[[2]][3],header=TRUE)
a<-table.element(a,rmout$Factor.B$output[3])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.B$output)[[2]][4],header=TRUE)
a<-table.element(a,rmout$Factor.B$output[4])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.B$output)[[2]][5],header=TRUE)
a<-table.element(a,rmout$Factor.B$output[5])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.B$output)[[2]][6],header=TRUE)
a<-table.element(a,rmout$Factor.B$output[6])
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable2.tab')
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,names(rmout)[3],3,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.AB$output)[[2]][1],header=TRUE)
a<-table.element(a,rmout$Factor.AB$output[1])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.AB$output)[[2]][2],header=TRUE)
a<-table.element(a,rmout$Factor.AB$output[2])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.AB$output)[[2]][3],header=TRUE)
a<-table.element(a,rmout$Factor.AB$output[3])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.AB$output)[[2]][4],header=TRUE)
a<-table.element(a,rmout$Factor.AB$output[4])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.AB$output)[[2]][5],header=TRUE)
a<-table.element(a,rmout$Factor.AB$output[5])
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,dimnames(rmout$Factor.AB$output)[[2]][6],header=TRUE)
a<-table.element(a,rmout$Factor.AB$output[6])
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file='mytable3.tab')