Skip to content

Instantly share code, notes, and snippets.

@aL3xa
Created July 7, 2011 19:31
Show Gist options
  • Save aL3xa/1070337 to your computer and use it in GitHub Desktop.
Save aL3xa/1070337 to your computer and use it in GitHub Desktop.
Questionnaire grading function
grade_questionnaire <- function(dtf, n.items, item.ind = NULL, scale.names, scale.labels = NULL, start = 1:length(scale.names), end = n.items, jump, rev.ind = NULL, rev.fn = NULL, total = FALSE, total.name = NULL, allowed.values = NULL, pre.process.fn = NULL, na.rm = FALSE, ...){
d <- subset(dtf, ...) # create subset if any
nc <- ncol(d) # number of columns
## number of columns sanity check
if (nc != n.items)
stop(sprintf("Incorrect number of items! %d items required, while %d were provided!", n.items, nc))
## check scale labels
if (!is.null(scale.labels))
stopifnot(length(scale.labels) != length(scale.names))
## check allowed values
if (!is.null(allowed.values))
d <- lapply(d, function(x) ifelse(x %in% allowed.values, x, NA))
## check inverted items
if (!is.null(rev.ind) & !is.null(rev))
d[rev.ind] <- lapply(d[rev.ind], rev.fn)
## pre process function (usually for recoding)
if (!is.null(pre.process.fn))
d <- lapply(d, pre.process.fn)
## check item indices
if (is.null(item.ind))
ind <- mapply(seq, from = start, to = end, by = jump, SIMPLIFY = FALSE)
else
ind <- item.ind
## assign list names if any
if (is.null(names(item.ind)))
names(ind) <- scale.names
d <- as.data.frame(d)
res <- as.data.frame(lapply(ind, function(i) rowSums(d[i], na.rm = na.rm)))
## calculate total score if set
if (total) {
res <- cbind(res, total = rowSums(res, na.rm = na.rm))
colnames(res)[ncol(res)] <- ifelse(is.null(total.name), paste("total", deparse(substitute(dtf)), sep = "."), as.character(total.name[1]))
}
return(res)
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment