x <- array(list(7
,1
,4
,5
,5
,3
,5
,4
,5
,4
,4
,5
,5
,5
,5
,6
,5
,5
,5
,5
,7
,7
,7
,7
,7
,1
,4
,7
,5
,5
,6
,6
,3
,2
,4
,7
,6
,3
,3
,6
,7
,6
,5
,7
,6
,4
,2
,5
,5
,3
,3
,3
,3
,3
,3
,2
,7
,6
,7
,7
,5
,5
,5
,5
,7
,5
,5
,5
,7
,5
,4
,6
,7
,1
,6
,7
,6
,5
,6
,6
,5
,3
,4
,5
,7
,4
,6
,7
,4
,2
,3
,5
,7
,3
,2
,5
,7
,5
,5
,6
,7
,5
,5
,7
,7
,5
,5
,7
,3
,2
,1
,2
,7
,4
,5
,6
,5
,6
,6
,6
,7
,6
,5
,7
,5
,4
,6
,6
,5
,6
,7
,6
,4
,3
,4
,4
,5
,6
,5
,6
,6
,3
,6
,6
,7
,4
,7
,7
,5
,4
,2
,5
,7
,7
,7
,7
,7
,5
,5
,6
,6
,5
,5
,5
,6
,4
,5
,6
,7
,6
,6
,7
,7
,4
,5
,6
,6
,4
,5
,6
,6
,2
,4
,6
,4
,3
,2
,3
,7
,6
,6
,6
,5
,4
,4
,4
,6
,6
,6
,6
,5
,3
,3
,4
,3
,4
,3
,3
,7
,5
,7
,7
,6
,2
,4
,4
,6
,7
,4
,7
,5
,6
,5
,5
,5
,5
,5
,5
,7
,1
,2
,4
,7
,6
,6
,6
,7
,6
,6
,6
,6
,2
,5
,7
,6
,5
,6
,5
,7
,5
,4
,4
,7
,6
,6
,7
,5
,5
,4
,4
,7
,4
,4
,7
,6
,6
,6
,6
,5
,2
,4
,6
,6
,6
,6
,6
,5
,5
,5
,5
,5
,4
,5
,5
,6
,2
,6
,6
,6
,2
,2
,5
,6
,5
,6
,6
,7
,6
,7
,6
,6
,6
,5
,5
,5
,5
,5
,5
,7
,5
,6
,6
,7
,5
,7
,7
,6
,5
,5
,5
,7
,5
,6
,7
,6
,3
,2
,2
,6
,4
,5
,5
,7
,3
,6
,6
,6
,4
,6
,7
,7
,7
,7
,7
,7
,5
,5
,5
,5
,5
,5
,5
,3
,1
,1
,1
,6
,4
,5
,6
,6
,4
,5
,5
,5
,3
,4
,6
,6
,5
,5
,7
,6
,5
,3
,6
,6
,6
,6
,6
,7
,5
,5
,5
,6
,3
,6
,6
,6
,3
,4
,5
,6
,4
,5
,6
,7
,5
,5
,6
,6
,5
,6
,6
,5
,3
,2
,5
,5
,5
,6
,5
,6
,6
,6
,6
,6
,6
,5
,6
,6
,5
,5
,5
,5
,4
,6
,6
,6
,4
,4
,6
,4
,2
,4
,1
,6
,3
,6
,7
,7
,6
,7
,7
,7
,6
,6
,6
,5
,6
,3
,4
,5
,5
,5
,5
,7
,6
,5
,6
,3
,2
,2
,3
,7
,6
,7
,7
,5
,5
,5
,6
,7
,3
,5
,6
,5
,5
,2
,6
,3
,4
,3
,5
,6
,6
,6
,6
,5
,5
,6
,6
,4
,4
,3
,3
,7
,7
,7
,7
,6
,2
,5
,5
,7
,6
,7
,6
,2
,6
,4
,5
,5
,4
,5
,5
,6
,4
,6
,6
,6
,3
,4
,5
,6
,6
,6
,6
,2
,5
,3
,5
,6
,6
,3
,3
,7
,6
,6
,7
,4
,1
,3
,3
,7
,5
,7
,7
,7
,4
,5
,5
,6
,6
,5
,6
,6
,6
,5
,6
,2
,5
,4
,4
,7
,4
,5
,6
,7
,5
,7
,7
,5
,4
,3
,4
,5
,3
,6
,6
,6
,3
,4
,5
,5
,6
,5
,6
,6
,2
,4
,4
,6
,4
,4
,5
,6
,4
,5
,5
,5
,4
,5
,5
,6
,5
,6
,6
,7
,3
,7
,7
,7
,5
,6
,7
,6
,4
,5
,6
,6
,4
,5
,6
,6
,6
,6
,5
,7
,7
,6
,7
,6
,5
,5
,7
,5
,4
,3
,6
,5
,3
,4
,4
,5
,1
,5
,5)
,dim=c(4
,162)
,dimnames=list(c('Q7'
,'Q14'
,'Q21'
,'Q28')
,1:162))
 y <- array(NA,dim=c(4,162),dimnames=list(c('Q7','Q14','Q21','Q28'),1:162))
 for (i in 1:dim(x)[1])
 {
 	for (j in 1:dim(x)[2])
 	{
 		y[i,j] <- as.numeric(x[i,j])
 	}
 }
par1 = '1 2 3 4 5 6 7'
#'GNU S' R Code compiled by R2WASP v. 1.0.44 ()
#Author: Dr. Ian E. Holliday
#To cite this work: Ian E. Holliday, 2009, YOUR SOFTWARE TITLE (vNUMBER) in Free Statistics Software (v$_version), Office for Research Development and Education, URL http://www.wessa.net/rwasp_YOURPAGE.wasp/
#Source of accompanying publication: 
#Technical description: 
docor <- function(x,y,method) {
r <- cor.test(x,y,method=method)
paste(round(r$estimate,3),' (',round(r$p.value,3),')',sep='')
}
x <- t(x)
nx <- length(x[,1])
cx <- length(x[1,])
mymedian <- median(as.numeric(strsplit(par1,' ')[[1]]))
myresult <- array(NA, dim = c(cx,7))
rownames(myresult) <- paste('Q',1:cx,sep='')
colnames(myresult) <- c('mean','Sum of<br />positives (Ps)','Sum of<br />negatives (Ns)', '(Ps-Ns)/(Ps+Ns)', 'Count of<br />positives (Pc)', 'Count of<br />negatives (Nc)', '(Pc-Nc)/(Pc+Nc)')
for (i in 1:cx) {
spos <- 0
sneg <- 0
cpos <- 0
cneg <- 0
for (j in 1:nx) {
if (!is.na(x[j,i])) {
myx <- as.numeric(x[j,i]) - mymedian
if (myx > 0) {
spos = spos + myx
cpos = cpos + 1
}
if (myx < 0) {
sneg = sneg + abs(myx)
cneg = cneg + 1
}
}
}
myresult[i,1] <- round(mean(as.numeric(x[,i]),na.rm=T)-mymedian,2)
myresult[i,2] <- spos
myresult[i,3] <- sneg
myresult[i,4] <- round((spos - sneg) / (spos + sneg),2)
myresult[i,5] <- cpos
myresult[i,6] <- cneg
myresult[i,7] <- round((cpos - cneg) / (cpos + cneg),2)
}
myresult

#Note: the /var/www/html/freestat/rcomp/createtable file can be downloaded at http://www.wessa.net/cretab
load(file="/var/www/html/freestat/rcomp/createtable")

a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Summary of survey scores (median of Likert score was subtracted)',8,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'Question',header=TRUE)
for (i in 1:7) {
a<-table.element(a,colnames(myresult)[i],header=TRUE)
}
a<-table.row.end(a)
for (i in 1:cx) {
a<-table.row.start(a)
a<-table.element(a,i,header=TRUE)
for (j in 1:7) {
a<-table.element(a,myresult[i,j],align='right')
}
a<-table.row.end(a)
}
a<-table.end(a)
table.save(a,file="/var/www/html/freestat/rcomp/tmp/1d1h21287487579.tab") 
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Pearson correlations of survey scores (and p-values)',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'',header=TRUE)
a<-table.element(a,'mean',header=TRUE)
a<-table.element(a,'(Ps-Ns)/(Ps+Ns)',header=TRUE)
a<-table.element(a,'(Pc-Nc)/(Pc+Nc)',header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'mean',header=TRUE)
a<-table.element(a,docor(myresult[,1],myresult[,1],method='pearson'),align='right')
a<-table.element(a,docor(myresult[,1],myresult[,4],method='pearson'),align='right')
a<-table.element(a,docor(myresult[,1],myresult[,7],method='pearson'),align='right')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'(Ps-Ns)/(Ps+Ns)',header=TRUE)
a<-table.element(a,docor(myresult[,4],myresult[,1],method='pearson'),align='right')
a<-table.element(a,docor(myresult[,4],myresult[,4],method='pearson'),align='right')
a<-table.element(a,docor(myresult[,4],myresult[,7],method='pearson'),align='right')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'(Pc-Nc)/(Pc+Nc)',header=TRUE)
a<-table.element(a,docor(myresult[,7],myresult[,1],method='pearson'),align='right')
a<-table.element(a,docor(myresult[,7],myresult[,4],method='pearson'),align='right')
a<-table.element(a,docor(myresult[,7],myresult[,7],method='pearson'),align='right')
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file="/var/www/html/freestat/rcomp/tmp/2y1y81287487579.tab") 
a<-table.start()
a<-table.row.start(a)
a<-table.element(a,'Kendall tau rank correlations of survey scores (and p-values)',4,TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'',header=TRUE)
a<-table.element(a,'mean',header=TRUE)
a<-table.element(a,'(Ps-Ns)/(Ps+Ns)',header=TRUE)
a<-table.element(a,'(Pc-Nc)/(Pc+Nc)',header=TRUE)
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'mean',header=TRUE)
a<-table.element(a,docor(myresult[,1],myresult[,1],method='kendall'),align='right')
a<-table.element(a,docor(myresult[,1],myresult[,4],method='kendall'),align='right')
a<-table.element(a,docor(myresult[,1],myresult[,7],method='kendall'),align='right')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'(Ps-Ns)/(Ps+Ns)',header=TRUE)
a<-table.element(a,docor(myresult[,4],myresult[,1],method='kendall'),align='right')
a<-table.element(a,docor(myresult[,4],myresult[,4],method='kendall'),align='right')
a<-table.element(a,docor(myresult[,4],myresult[,7],method='kendall'),align='right')
a<-table.row.end(a)
a<-table.row.start(a)
a<-table.element(a,'(Pc-Nc)/(Pc+Nc)',header=TRUE)
a<-table.element(a,docor(myresult[,7],myresult[,1],method='kendall'),align='right')
a<-table.element(a,docor(myresult[,7],myresult[,4],method='kendall'),align='right')
a<-table.element(a,docor(myresult[,7],myresult[,7],method='kendall'),align='right')
a<-table.row.end(a)
a<-table.end(a)
table.save(a,file="/var/www/html/freestat/rcomp/tmp/3utvh1287487579.tab")