R/cdss_lo_sa2af.R

In CDSS: Course-Dependent Skill Structures

recurseList <- function(skills, hmat, tgt) {
  if ((is.null(skills)) || (length(skills) == 0)) return(hmat)
  if (length(skills) > 1) {
    currSkill <- skills[1]
    restskills <- skills[2:length(skills)]
  } else {
    currSkill <- skills
    restskills = NULL
  }
  LOs <- rownames(tgt)[which(tgt[,currSkill]==1)]
  if (length(LOs) == 0) {
    warning(sprintf("I found no LO teaching skill %s", currSkill))
    return(hmat)
  } else if (length(LOs) == 1) LOs <- list(LOs)
  result = matrix(, ncol = dim(hmat)[2], nrow = 0)
  colnames(result) <- colnames(hmat)
  sapply(LOs, function(x) {
    bmat <- hmat
    bmat[,x] <- 1
    # bmat <- recurseList(restskills, bmat, tgt)
    result <<- rbind(result, bmat)
  })
  result <- recurseList(restskills, result, tgt)
  return(result)
}

#' Determine Attribution function for LOs from a skill assignment
#' 
#' \code{cdss_lo_sa2af} expects a skill assignment and derives an attribution
#' function on the set of learning objects.
#' 
#' @param sa Skill assignment object
#'
#' @return Object of class \code{cdss_af} (attribution function).
#'
#' @family functions building skill (multi) assignment matrices
#'
#' @export
cdss_lo_sa2af <- function(sa) {
  if (!(inherits(sa, "cdss_sa"))) {
    stop(sprintf("%s must be of class %s.",
                 dQuote("sa"),
                 dQuote("cdss_sa")))
  }
  req <- sa$required
  tgt <- sa$taught
  countLines <- dim(req)[1]
  countLO <- length(unique(c(rownames(tgt), rownames(req))))
  af <- data.frame("xyz", t(1:countLO)) # We will delete this row later
  colnames(af) <- c("LO", unique(c(rownames(tgt), rownames(req))))
  sapply((1:countLO), function(x) {
    currLO <- rownames(req)[x]
    reqSkills <- colnames(req)[which(req[x,]==1)]
    hmat <- matrix(rep(0, countLO), nrow = 1)
    colnames(hmat) <- unique(c(rownames(tgt), rownames(req)))
    hmat[1,x] <- 1
    hmat <- recurseList(reqSkills, hmat, tgt)
    hmatlen <- dim(hmat)[1]
    los <- data.frame(matrix(rep(currLO, hmatlen), ncol=1))
    colnames(los) <- c("LO")
    af <<- rbind(af, cbind(los, data.frame(hmat)))
  })
  af <- af[-1,]
  colnames(af) <- c("LO", unique(c(rownames(tgt), rownames(req))))
  class(af) <- unique(c("kmattributionfunction", "cdss_af", class(af)))
  return(af)
}