x <- array(round(runif(241*20, 1, 5)), dim=c(241,20),
dimnames=list(1:241, c('A1','A2','A3','A4','A5','A6','A7','A8','A9','A10',
'A11','A12','A13','A14','A15','A16','A17','A18','A19','A20')))
par1 = '1 2 3 4 5'
docor <- function(x,y,method) {
r <- cor.test(x,y,method=method)
paste(round(r$estimate,3),' (',round(r$p.value,3),')',sep='')
}
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 pos (Ps)',
'Sum of neg (Ns)',
'(Ps-Ns)/(Ps+Ns)',
'Count of pos (Pc)',
'Count of neg (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)
}
print(myresult)
cat("\nPearson correlations of survey scores\n")
cor(myresult[,c(1,4,7)], method = "pearson")
cat("\nKendall rank correlations of survey scores\n")
cor(myresult[,c(1,4,7)], method = "kendall") mean Sum of pos (Ps) Sum of neg (Ns) (Ps-Ns)/(Ps+Ns) Count of pos (Pc)
Q1 -0.02 112 116 -0.02 83
Q2 -0.15 103 140 -0.15 80
Q3 -0.08 123 142 -0.07 91
Q4 -0.04 110 120 -0.04 87
Q5 -0.13 105 136 -0.13 75
Q6 0.13 146 114 0.12 103
Q7 -0.06 118 132 -0.06 91
Q8 0.05 123 111 0.05 93
Q9 0.04 118 109 0.04 95
Q10 -0.07 112 129 -0.07 83
Q11 0.12 131 101 0.13 95
Q12 0.07 134 117 0.07 103
Q13 0.16 141 102 0.16 99
Q14 0.10 132 107 0.10 100
Q15 0.00 115 116 0.00 82
Q16 -0.06 110 125 -0.06 87
Q17 -0.02 111 117 -0.03 86
Q18 -0.11 96 122 -0.12 72
Q19 -0.11 114 140 -0.10 82
Q20 0.00 124 124 0.00 94
Count of neg (Nc) (Pc-Nc)/(Pc+Nc)
Q1 90 -0.04
Q2 107 -0.14
Q3 101 -0.05
Q4 93 -0.03
Q5 103 -0.16
Q6 86 0.09
Q7 98 -0.04
Q8 86 0.04
Q9 82 0.07
Q10 103 -0.11
Q11 84 0.06
Q12 87 0.08
Q13 81 0.10
Q14 83 0.09
Q15 92 -0.06
Q16 95 -0.04
Q17 93 -0.04
Q18 95 -0.14
Q19 102 -0.11
Q20 95 -0.01
Pearson correlations of survey scores
mean (Ps-Ns)/(Ps+Ns) (Pc-Nc)/(Pc+Nc)
mean 1.0000000 0.9981090 0.9471695
(Ps-Ns)/(Ps+Ns) 0.9981090 1.0000000 0.9488812
(Pc-Nc)/(Pc+Nc) 0.9471695 0.9488812 1.0000000
Kendall rank correlations of survey scores
mean (Ps-Ns)/(Ps+Ns) (Pc-Nc)/(Pc+Nc)
mean 1.0000000 0.9812368 0.8229647
(Ps-Ns)/(Ps+Ns) 0.9812368 1.0000000 0.8207613
(Pc-Nc)/(Pc+Nc) 0.8229647 0.8207613 1.0000000