181 lines
6.2 KiB
R
181 lines
6.2 KiB
R
|
gen.usability.matrix <- function(dsa, survey.str){
|
||
|
|
#define special values to detect
|
||
|
|
#order of this values is important:
|
||
|
|
# in case of conflicts @ chk.t types of questions the order sets the priporty of which values to keep
|
||
|
|
special.v <- c(-1, -3, -5, -96, -97, -98, -99, -4, -2)
|
||
|
|
|
||
|
|
#define which variables belong to checkbox-like* questions
|
||
|
|
#(* i.e.: check for special values @ ANY variable per question/item ID)
|
||
|
|
# 2: normal checkbox
|
||
|
|
# 16: multicheckbox
|
||
|
|
# 17: ranking
|
||
|
|
chkbox.t <- c(2, 16, 17)
|
||
|
|
|
||
|
|
##all other variables belong to normal** questions
|
||
|
|
#(** i.e.: check for special values @ each variable per question/item ID)
|
||
|
|
#if there are no normal questions, create 0 matrix, otherwise...
|
||
|
|
if(nrow(survey.str[!(tip %in% chkbox.t),])==0){
|
||
|
|
m.n <- matrix(0, nrow = nrow(dsa), ncol=length(special.v)+1)
|
||
|
|
}else{
|
||
|
|
#create list of all normal questions
|
||
|
|
c.n <- colnames(dsa)[which(colnames(dsa) %in% survey.str[!(tip %in% chkbox.t), variable])]
|
||
|
|
|
||
|
|
#...count all non-special values for each variable
|
||
|
|
#... + count each special value for each variable
|
||
|
|
m.n <- cbind(rowSums(sapply(dsa[, c.n, with=FALSE], function(x){!(x %in% special.v)})),
|
||
|
|
sapply(special.v, function(x){as.integer(rowSums(dsa[, c.n, with=FALSE]==x, na.rm=TRUE))}))
|
||
|
|
}
|
||
|
|
|
||
|
|
##procedure for tip:2
|
||
|
|
#only run if there is an at least one tip:2 variable
|
||
|
|
if(survey.str[, any(tip==2)]){
|
||
|
|
#get list of all unique tip:2 question ids
|
||
|
|
q.2 <- unique(survey.str[tip==2, question.id])
|
||
|
|
#get list of all corresponding variables for each q.2 id
|
||
|
|
c.2 <- lapply(q.2, function(x){colnames(dsa)[which(colnames(dsa) %in% survey.str[question.id==x & tip==2, variable])]})
|
||
|
|
|
||
|
|
#(do this for each instance in c.2):
|
||
|
|
#for each set of variables:
|
||
|
|
# check if any variable contains at least one non-special value
|
||
|
|
# + (for each special value) check if any variable contains at least special value
|
||
|
|
m.2 <- lapply(c.2, function(x){
|
||
|
|
cbind(apply(dsa[, x, with=FALSE], 1, function(q){any(!(q %in% special.v))}),
|
||
|
|
sapply(special.v, function(y){
|
||
|
|
apply(dsa[, x, with=FALSE], 1, function(q){any(q==y)})
|
||
|
|
})
|
||
|
|
)
|
||
|
|
})
|
||
|
|
|
||
|
|
# (do this for each instance in c.2)
|
||
|
|
# if multiple special values per respondent exist, keep only the first one
|
||
|
|
m.2 <- lapply(m.2, function(x){
|
||
|
|
if(any(rowSums(x)>1)){
|
||
|
|
p <- x[rowSums(x)>1,]
|
||
|
|
for(i in 1:nrow(p)){
|
||
|
|
a <- p[i,]
|
||
|
|
f <- TRUE
|
||
|
|
for(j in 1:length(a)){
|
||
|
|
print(j)
|
||
|
|
if(a[j] & f){
|
||
|
|
f <- FALSE
|
||
|
|
}else if(a[j] & !f){
|
||
|
|
a[j] <- FALSE
|
||
|
|
}
|
||
|
|
}
|
||
|
|
p[i,] <- a
|
||
|
|
}
|
||
|
|
x[rowSums(x)>1,] <- p
|
||
|
|
}else{x}
|
||
|
|
})
|
||
|
|
|
||
|
|
|
||
|
|
#add to m.n
|
||
|
|
m.n <- m.n + Reduce('+', m.2)
|
||
|
|
}
|
||
|
|
|
||
|
|
##procedure for tip:16
|
||
|
|
#only run if there is an at least one tip:16 variable
|
||
|
|
if(survey.str[, any(tip==16)]){
|
||
|
|
#get list of all unique tip:16 item ids
|
||
|
|
q.16 <- unique(survey.str[tip==16, item.id])
|
||
|
|
|
||
|
|
#get list of all corresponding variables for each q.16 id
|
||
|
|
c.16 <- lapply(q.16, function(x){colnames(dsa)[which(colnames(dsa) %in% survey.str[item.id==x & tip==16, variable])]})
|
||
|
|
#(do this for each special value):
|
||
|
|
#for each set of variables, check if any variable contains at least one special value
|
||
|
|
# m.16 <- sapply(special.v, function(x){
|
||
|
|
# rowSums(sapply(c.16, function(y){
|
||
|
|
# apply(dsa[, y, with=FALSE], 1, function(q){any(q==x)})
|
||
|
|
# }))
|
||
|
|
# })
|
||
|
|
|
||
|
|
#(do this for each instance in c.16):
|
||
|
|
#for each set of variables:
|
||
|
|
# check if any variable contains at least one non-special value
|
||
|
|
# + (for each special value) check if any variable contains at least special value
|
||
|
|
m.16 <- lapply(c.16, function(x){
|
||
|
|
cbind(apply(dsa[, x, with=FALSE], 1, function(q){any(!(q %in% special.v))}),
|
||
|
|
sapply(special.v, function(y){
|
||
|
|
apply(dsa[, x, with=FALSE], 1, function(q){any(q==y)})
|
||
|
|
})
|
||
|
|
)
|
||
|
|
})
|
||
|
|
|
||
|
|
# (do this for each instance in c.16)
|
||
|
|
# if multiple special values per respondent exist, keep only the first one
|
||
|
|
m.16 <- lapply(m.16, function(x){
|
||
|
|
if(any(rowSums(x)>1)){
|
||
|
|
p <- x[rowSums(x)>1,]
|
||
|
|
for(i in 1:nrow(p)){
|
||
|
|
a <- p[i,]
|
||
|
|
f <- TRUE
|
||
|
|
for(j in 1:length(a)){
|
||
|
|
print(j)
|
||
|
|
if(a[j] & f){
|
||
|
|
f <- FALSE
|
||
|
|
}else if(a[j] & !f){
|
||
|
|
a[j] <- FALSE
|
||
|
|
}
|
||
|
|
}
|
||
|
|
p[i,] <- a
|
||
|
|
}
|
||
|
|
x[rowSums(x)>1,] <- p
|
||
|
|
}else{x}
|
||
|
|
})
|
||
|
|
|
||
|
|
m.n <- m.n + Reduce('+', m.16)
|
||
|
|
}
|
||
|
|
|
||
|
|
##procedure for tip:17
|
||
|
|
#only run if there is an at least one tip:17 variable
|
||
|
|
if(survey.str[, any(tip==17)]){
|
||
|
|
#get list of all unique tip:17 question ids
|
||
|
|
q.17 <- unique(survey.str[tip==17, question.id])
|
||
|
|
|
||
|
|
#get list of all corresponding variables for each q.17 id
|
||
|
|
c.17 <- lapply(q.17, function(x){colnames(dsa)[which(colnames(dsa) %in% survey.str[question.id==x & tip==17, variable])]})
|
||
|
|
|
||
|
|
#similiar procedure as for tip:2 and tip:16....
|
||
|
|
m.17 <- lapply(c.17, function(x){
|
||
|
|
cbind(apply(dsa[, x, with=FALSE], 1, function(q){any(!(q %in% special.v))}),
|
||
|
|
sapply(special.v, function(y){
|
||
|
|
apply(dsa[, x, with=FALSE], 1, function(q){any(q==y)})
|
||
|
|
})
|
||
|
|
)
|
||
|
|
})
|
||
|
|
|
||
|
|
#... the only difference is that we are checking for all rowsums > 0, not > 1
|
||
|
|
m.17 <- lapply(m.17, function(x){
|
||
|
|
if(any(rowSums(x)>1)){
|
||
|
|
p <- x[rowSums(x)>0,]
|
||
|
|
for(i in 1:nrow(p)){
|
||
|
|
a <- p[i,]
|
||
|
|
f <- TRUE
|
||
|
|
for(j in 1:length(a)){
|
||
|
|
if(a[j] & f){
|
||
|
|
f <- FALSE
|
||
|
|
}else if(a[j] & !f){
|
||
|
|
a[j] <- FALSE
|
||
|
|
}
|
||
|
|
}
|
||
|
|
p[i,] <- a
|
||
|
|
}
|
||
|
|
x[rowSums(x)>0,] <- p
|
||
|
|
}else{x}
|
||
|
|
})
|
||
|
|
|
||
|
|
m.n <- m.n + Reduce('+', m.17)
|
||
|
|
}
|
||
|
|
|
||
|
|
m.n <- cbind(m.n, rowSums(m.n))
|
||
|
|
|
||
|
|
if(all(m.n[, ncol(m.n)][1]==m.n[, ncol(m.n)])){
|
||
|
|
m.n <- as.data.table(m.n)
|
||
|
|
m.n[, recnum:=dsa$recnum]
|
||
|
|
setnames(m.n, colnames(m.n)[-length(colnames(m.n))], c("va", "v1", "v3", "v5", "v96", "v97", "v98", "v99", "v4", "v2", "allqs"))
|
||
|
|
setcolorder(m.n, c("recnum", colnames(m.n)[-length(colnames(m.n))]))
|
||
|
|
return(m.n)
|
||
|
|
}else{
|
||
|
|
print("not all rowsums equal!")
|
||
|
|
}
|
||
|
|
}
|