R/convert_tier.R

In ConverTier2: Conversion of Tiered Assessment Responses to Polytomous Scores

#' Convert Tiered Responses to Scores
#'
#' Converts binary responses from a tiered assessment
#' into item scores using user-defined scoring rules.
#'
#' @param data A data frame containing binary tier responses.
#' @param rules A named numeric vector containing scoring rules.
#' @param n_tier Number of tiers in each item.
#'
#' @return A data frame containing item scores.
#'
#' @export
convert_tier <- function(data, rules, n_tier) {

  if (!is.data.frame(data)) {
    stop("data must be a data.frame.")
  }

  if (!is.numeric(n_tier) || length(n_tier) != 1) {
    stop("n_tier must be a single number.")
  }

  if (ncol(data) %% n_tier != 0) {
    stop(
      "Number of columns (", ncol(data),
      ") not divisible by the number of tiers (", n_tier, ")."
    )
  }

  n_items <- ncol(data) / n_tier

  result <- data.frame(
    matrix(
      NA_real_,
      nrow = nrow(data),
      ncol = n_items
    )
  )

  names(result) <- paste0(
    "Score_Item_",
    seq_len(n_items)
  )

  for (item in seq_len(n_items)) {

    col_start <- (item - 1) * n_tier + 1
    col_end <- item * n_tier

    chunk <- data[, col_start:col_end, drop = FALSE]

    patterns <- apply(
      chunk,
      1,
      function(x) {
        paste(as.integer(x), collapse = "")
      }
    )

    result[, item] <- vapply(
      patterns,
      function(pattern) {

        if (pattern %in% names(rules)) {
          rules[[pattern]]
        } else {
          NA_real_
        }

      },
      numeric(1)
    )
  }

  result
}