R/sass.R

In nrkoehler/qscorer: Procedures for Scoring Health-related Questionnaires

#' @title {Scoring the Social Adaptation Self-evaluation Scale (SASS)}
#' @description {
#' The SASS is a 21-item instrument for the evaluation of patient social motivation
#' and behaviour in depression. Each answer is scored from 0 (minimal adjustment)
#' to 3 (maximal adjustment), with a total score range of 0 to 60. [...]
#' Questions 1 and 2 are preceded by a specification on the existence of an occupation;
#' these questions were considered mutually exclusive,
#' but pooled into a single answer/item (Q1/2, work interest) in the analysis.
#' After pooling question 1A an 1B into question 1, 20 items must be used for calculating the score.
#' Items 16, 17, and 19 must either be coded or scored reversely.
#' }
#' @details
#' \itemize{
#' \item \code{Number of items:} {21 (20 for score calculation)}
#' \item \code{Item range:} {0 to 3}
#' \item \code{Reverse items:} {16, 17, 19}
#' \item \code{Score range:} {0 to 60}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:}
#' {Questionnaires with up to four missing values are scored,
#' replacing any missing values with the average score of the completed items.}
#' }
#' @references
#' Bosc et al. 1997 (\url{https://dx.doi.org/10.1016/S0924-977X(97)00420-3})
#' @return The function returns 2 variables:
#' \itemize{
#'  \item \code{nvalid.sass:} Number of valid values (MAX=20)
#'  \item \code{score.sass:} SASS Total Score
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.sass <- paste0("SASS_", seq(1, 20, 1))
#' scoring_sass(mydata, items = items.sass, reverse = c(16, 17, 19))
#' }
#' @param data a \code{\link{data.frame}} containing the SASS items
#' orderd from 1 to 20
#' @param items A character vector with the SASS item names ordered from 1 to 10,
#' or a numeric vector indicating the column numbers of the SASS items in \code{data}.
#' @param keep Logical, whether to keep the single items and  whether to return variables containing
#' the number of non-missing items on each scale for each respondent. The default is TRUE.
#' @param nvalid A numeric value indicating the number of non-missing items required for score
#' calculations. The default is 16.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @param reverse items to be scored reversely. These items can be specified either by name or by index.
#' Default: 16, 17, 19
#' @export
scoring_sass <- function(data, items = 1:20, keep = TRUE, nvalid = 16,
                         digits = NULL, reverse = c(16, 17, 19)) {
  library(dplyr, warn.conflicts = FALSE)
  if (min(data[, items], na.rm = T) < 0) {
    stop("Minimum possible value for SASS items is 0")
  } else if (max(data[, items], na.rm = T) > 3) {
    stop("Maximum possible value for SASS items is 3")
  }
  # check for number of specified items
  if (length(items) != 20) {
    stop("Number of items must be 20!")
  }
  items <- items
  items.rev <- items[reverse]
  data <- data %>%
    mutate_at(vars(items.rev), list(~ 3 - .)) %>%
    mutate(
      nvalid.sass = rowSums(!is.na(select(., items))),
      mean.temp = round(rowSums(select(., items), na.rm = TRUE) / nvalid.sass)
    ) %>%
    mutate_at(
      vars(items),
      list(~ ifelse(is.na(.), mean.temp, .))
    ) %>%
    mutate(
      score.temp = rowSums(select(., items), na.rm = TRUE),
      score.sass = ifelse(nvalid.sass >= nvalid, score.temp, NA)
    ) %>%
    select(-mean.temp, -score.temp)
  data
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.sass)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(vars(score.sass), list(~ round(., digits)))
  } else {
    data <- data
  }
  data
}
NULL