R/wssq.R

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

#' @title {Scoring the Weight Self-Stigma Questionnaire (WSSQ)}
#' @description {\emph{
#' The WSSQ is a 12-item Likert-type measure of weight-related self-stigma. WSSQ items are rated
#' on a scale of 1 (completely disagree) to 5 (completely agree). Sum scores are calculated for the
#' full scale and each subscale. Items 1–6 constitute the self-devaluation subscale, and items 7–12
#' constitute the fear of enacted stigma subscale} (Lillis et al. 2010).}
#' @details
#' \itemize{
#' \item \code{Number of items:} {12}
#' \item \code{Item range:} {1 to 5}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {5 to 30 for each score}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {Summary scores are calculated
#' as long as at least 5 questions from the sub-score have been answered.}
#' }
#' @references
#' Link to Questionnaire (\url{https://www.usucbs.com/uploads/5/1/3/4/51340265/wssq__weight_self_stigma_.docx})
#'
#' Lillis et al. 2010 (\url{https://doi.org/10.1038/oby.2009.353})
#' @return The function returns 5 variables:
#' \itemize{
#'  \item \code{nvalid.wssq.ena:} Number of valid values of Fear of enacted stigma Scale (MAX=6)
#'  \item \code{nvalid.wssq.sel:} Number of valid values of Self‐devaluation Scale (MAX=6)
#'  \item \code{score.wssq.ena:} WSSQ Fear of enacted stigma Score
#'  \item \code{score.wssq.sel:} WSSQ Self‐devaluation Score
#'  \item \code{score.wssq.glo:} WSSQ Global Score
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.wssq <- paste0("wssq_", seq(1, 12, 1))
#' scoring_wssq(mydata, items = items.wssq)
#' }
#' @param data a \code{\link{data.frame}} containing the WSSQ items orderd from 1 to 12.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the WSSQ item names ordered from 1 to 12,
#' or a numeric vector indicating the column numbers of the WSSQ 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 5.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_wssq <- function(data, items = 1:12, keep = TRUE, nvalid = 5, digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  if (min(data[, items], na.rm = T) < 1) {
    stop("Minimum possible value for WSSQ items is 1")
  } else if (max(data[, items], na.rm = T) > 5) {
    stop("Maximum possible value for WSSQ items is 5")
  }
  # check for number of specified items
  if (length(items) != 12) {
    stop("Number of items must be 12!")
  }
  items <- items
  data <- data %>%
    mutate(
      nvalid.wssq.ena = rowSums(!is.na(select(., items[1:6]))),
      nvalid.wssq.sel = rowSums(!is.na(select(., items[7:12]))),
      ena.temp = rowSums(select(., items[1:6]), na.rm = TRUE) / nvalid.wssq.ena,
      sel.temp = rowSums(select(., items[7:12]), na.rm = TRUE) / nvalid.wssq.sel
    ) %>%
    mutate_at(
      vars(items[1:6]), list(~ ifelse(is.na(.), round(ena.temp), .))
    ) %>%
    mutate_at(
      vars(items[7:12]), list(~ ifelse(is.na(.), round(sel.temp), .))
    ) %>%
    mutate(
      score.wssq.ena = ifelse(nvalid.wssq.ena >= nvalid, rowSums(select(., items[1:6]), na.rm = TRUE), NA),
      score.wssq.sel = ifelse(nvalid.wssq.sel >= nvalid, rowSums(select(., items[7:12]), na.rm = TRUE), NA),
      score.wssq.glo = score.wssq.ena + score.wssq.sel
      ) %>%
    select(-ends_with('temp'))
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.wssq.ena, -nvalid.wssq.sel)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(
      vars(
        score.wssq.ena, score.wssq.sel,
        score.wssq.glo
      ),
      list(~ round(., digits))
    )
  } else {
    data <- data
  }
  data
}
NULL