par1 <- as.numeric(par1)
y <- t(y)
nr <- length(y[,1])
nc <- length(y[1,])
ncm1 <- nc-1
if(par1==0) {
nc2 <- (nc*nc - nc) / 2
ncpnc2 <- nc + nc2
} else {
nc2 <- (ncm1*ncm1 - ncm1) / 2
ncpnc2 <- ncm1 + nc2
}
mr.freq <- as.data.frame(array(NA, dim=c(4,ncpnc2)))
if(par1>0) {
ctabout <- list()
z <- xx <- t(x[-par1,])
z[is.na(xx)] = 'NA'
for(i in 1:ncm1) z[!is.na(xx[,i]),i] = colnames(xx)[i]
single.response <- as.factor(as.character(x[par1,]))
jjj <- 0
for(i in 1:ncm1) {
jjj = jjj + 1
multiple.response <- as.factor(as.character(z[,i]))
ctabout[[jjj]] <- table(single.response, multiple.response)
jjj = jjj + 1
ctabout[[jjj]] <- chisq.test(single.response, multiple.response, simulate.p.value=T)
}
}
if(par1>0) x <- y[,-par1] else x <- y
x[is.na(x)] = 0
tab <- crossprod(as.matrix(x))
res2 <- round(crossprod(as.matrix(x)) / nrow(x), 4)
sum.responses <- length(as.vector(y)[!is.na(y)])
mr.freq[2,] <- c(as.vector(diag(tab)), tab[lower.tri(tab)])
mr.freq[1,] <- nr - mr.freq[2,]
mr.freq[3,] <- c(as.vector(diag(res2)), res2[lower.tri(res2)])
mr.freq[4,] <- c(as.vector(diag(tab)), rep(NA, nc2) ) / sum.responses #mr.freq[2,] / sum.responses
rownames(mr.freq) <- c('NA', 'Abs.Freq.', 'Rel.Freq.Cases', 'Rel.Freq.Responses')
if(par1 > 0) nc <- ncm1
myindex <- nc
for(i in 1:nc) {
colnames(mr.freq)[i] = colnames(x)[i]
ip1 <- i+1
if(ip1<=nc){
for(j in ip1:nc) {
myindex = myindex + 1
colnames(mr.freq)[myindex] = paste(colnames(x)[i], ':', colnames(x)[j], sep='')
}
}
}
t(mr.freq)
chisq.test(tab,simulate.p.value=T)
load(file='createtable')
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Frequency Table of Multiple Response Items',1,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,paste('',RC.texteval('t(mr.freq); chisq.test(tab,simulate.p.value=T)'),'',sep=''))
a<-table.row.end(a)
if (par1 > 0) {
a<-table.row.start(a)
a<-table.element(a,paste('',RC.texteval('ctabout'),'',sep=''))
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file='mytable.tab')
|