import.q.feedback <- function(q.feedback.dir, q.sorts, q.set, manual.lookup=NULL) {
# Input validation
if (!is.matrix(q.set)) {
stop("The q.set specified is not a matrix.")
}
if (!(is.matrix(q.sorts) | is.array(q.sorts))) {
stop("The q.sorts specified are neither a matrix nor an array.")
}
if (!is.null(manual.lookup) & !is.matrix(manual.lookup)) {
stop("The manual.lookup specified is not a matrix.")
}
q.feedback.dir <- normalizePath(q.feedback.dir, mustWork = FALSE) # just to be safe
# Set up empty array ==========================================================
q.feedback <- q.sorts # copy data structure from q.sorts
q.feedback[ ] <- NA # make NA for now
# Take care of one-condition case
if (length(dim(q.feedback))==2) { # if only one-condition
conditions <- "only.one" # assign this dummy
} else { # if more than one
conditions <- unlist(dimnames(q.feedback)[3]) # assign dimname
}
participants <- unlist(dimnames(q.feedback)[2]) # extract participants
# Create lookup table =======================================================
if (is.null(manual.lookup)) { # automatic hashing, same as in make cards
lookup.table <- apply( # replace every language field with its hash
X = q.set,
MARGIN = c(1,2),
digest,
algo = "crc32",
serialize = FALSE
)
} else { # manually entered lookup table
lookup.table <- manual.lookup
}
if (any(duplicated(lookup.table))) { # test lookup table
stop ("There are duplicate IDs in the lookup table.")
}
# Import Loops ==============================================================
for (cond in conditions) { # loop over the conditions (such as before, after)
for (part in participants) { # loop over participants
path <- paste( # establish path
q.feedback.dir,
if (length(conditions) > 1) { #if more than 1 cond
paste(
"/",
cond, # add condition to path
"/",
sep = ""
)
}, # otherwise, keep path simple
"/",
part,
".csv",
sep = ""
)
path <- normalizePath(path, mustWork = FALSE) # just to be safe
if (file.exists(path)) { # not everyone comments
current.feedback <- read.csv(
path,
header = TRUE, # these do have names
stringsAsFactors = FALSE, # would only add confusion
row.names = 1,
colClasses = c("character","character","logical"),
na.strings = "" # empty cells become NAs
)
if (ncol(current.feedback) > 1) { # if a drop correction column is included
current.feedback <- current.feedback[!(current.feedback[,2]),] # drop corrections
}
for (id in rownames(current.feedback)) { # loops over ids
if (any(lookup.table == id)) { # do we know the id in the current feedback?
row <- which(lookup.table == id, arr.ind=TRUE)[,1] # where is it in the table?
handle <- rownames(lookup.table)[row] # what is the short handle?
# Gathering data into array
if (cond == "only.one") {
q.feedback[handle,part] <- current.feedback[id,1]
} else {
q.feedback[handle,part,cond] <- current.feedback[id,1]
}
} else {
warning(
paste(
"Feedback in",
path,
"under id",
id,
"is not defined as per manual.lookup and was ignored.",
"Check whether you defined manual.lookup argument as intended."
)
)
}
}
}
}
}
return(q.feedback)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.