R/score.R

In maxheld83/pensieve: Tools for the Scientific Study of Operant Subjectivity

# CALCULATION ====
#' @title Factor scores.
#'
#' @description Calculates the factor scores as loadings-weighted averages of raw Q-Sorts (regression scores).
#'
#' @export
#'
#' @inheritParams QLoas
#'
#' @inheritParams psClosedSorts
#'
#' @family analysis functions
#' @family scoring functions
#'
#' @examples
#' csorts <- civicon_2014$qData$sorts[,,"before"]  # preparatory step
#' cors <- correlate(csorts = csorts)  # preparatory step
#' loas <- extract(cors = cors, nfactors = 3, fa_type = "pca")  # preparatory step
#' scores <- score(loas = loas, csorts = csorts)
score <- function(loas, csorts) {
  # Input validation ====
  loas <- QLoas(loas = loas, validate = TRUE)
  csorts <- psClosedSorts(csorts = csorts)

  # Calculation ====
  scores <- apply(X = loas, MARGIN = 2, FUN = function(x) {
    allweighted <- sweep(x = csorts, MARGIN = 2, STATS = x, FUN = "*")
    scores <- apply(X = allweighted, MARGIN = 1, FUN = function(x) {
      mean(x, na.rm = TRUE)
    })
    scores <- scale(scores)
    return(scores)
  })
  colnames(scores) <- colnames(loas)
  rownames(scores) <- rownames(csorts)

  # Return ====
  scores <- QScores(scores = scores, validate = TRUE)
  return(scores)
}

# CLASS CONSTRUCTION ====
#' @rdname score
#'
#' @export
#'
#' @template construct
#'
#' @param scores A numerical matrix with factor scores.
#'
#' @examples
#' # this just assigns the class, without validation (not recommended)
#' scores <- QScores(scores = scores, validate = FALSE)
QScores <- produce_class_constructor(classname = "QScores", fun = function(scores) {
  return(scores)
})


#' @describeIn score validation
#'
#' @export
#'
#' @template check
#'
#' @examples
#' # this validates the class
#' check(x = scores)
check.QScores <- function(x) {
  res <- NULL

  res$matrix <- check_matrix(x = x,
                             mode = "numeric",
                             any.missing = TRUE,
                             all.missing = FALSE,
                             row.names = "unique")
  #TODO this needs more, such as the range of the raw data etc.

  return(report_checks(res = res, info = "QScores"))
}