R/bdi.R

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

#' @title {Scoring the Beck Depression Inventory (BDI and BDI-II)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {21}
#' \item \code{Item range:} {0 to 3}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 63}
#' \item \code{Cut-off-values:}
#' \itemize{
#' \item \code{BDI:} {\eqn{\le} 10 = "minimal"; 11 to 18 = "mild"; 19 to 29 = "moderate"; \eqn{\ge} 30 = "severe"}
#' \item \code{BDI-II:} {\eqn{\le} 8 = "none", 9 to 13 = "minimal"; 14 to 19 = "mild"; 20 to 28 = "moderate"; \eqn{\ge} 29 = "severe"}
#' }
#' \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
#' Beck et al. 1961 (\url{https://doi.org/10.1001\%2Farchpsyc.1961.01710120031004})
#'
#' Beck et al. 1996 (\url{https://doi.org/10.1207\%2Fs15327752jpa6703_13})
#' @return The function returns 4 variables:
#' \itemize{
#'  \item \code{nvalid.bdi:} {Number of valid values (MAX=21)}
#'  \item \code{score.bdi:} {BDI score}
#'  \item \code{cutoff.bdi:} {BDI as categorical variable}
#'  \item \code{cutoff.bdi2:} {BDI-II as categorical variable}
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.bdi <- paste0("bdi_", seq(1, 21, 1))
#' scoring_bdi(mydata, items = items.bdi, version = 'BDI-I')
#' }
#' @param data a \code{\link{data.frame}} containing the BDI items
#' orderd from 1 to 21
#' @param items A character vector with the BDI item names ordered from 1 to 21,
#' or a numeric vector indicating the column numbers of the BDI 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 17.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @param version A character vector with the BDI version, either "BDI-I" or "BDI-II" (default)
#' @export
scoring_bdi <- function(data, items = 1:21, keep = TRUE, nvalid = 17, digits = NULL, version = "BDI-II") {
  library(dplyr, warn.conflicts = FALSE)
  # check whether item values are within the defined range
  if (min(data[, items], na.rm = T) < 0) {
    stop("Minimum possible value for BDI items is 0")
  } else if (max(data[, items], na.rm = T) > 3) {
    stop("Maximum possible value for BDI items is 3")
  }
  # check for number of specified items
  if (length(items) != 21) {
    stop("Number of items must be 21!")
  }
  # check for specified number of valid values
  if (!(nvalid %in% 1:21)) {
    stop("Number of valid items must be between 1 and 21!")
  }
  # check for specified BDI version
  if (!(version %in% c('BDI-I', 'BDI-II'))) {
    stop("BDI version must be either 'BDI-I' or 'BDI-II'!")
  }

  keepnot <- ifelse(version == "BDI-II", "cutoff.bdi", "cutoff.bdi2")
  items <- items

  data <- data %>%
    mutate(
      nvalid.bdi = rowSums(!is.na(select(., items))),
      mean.temp = rowSums(select(., items), na.rm = TRUE) / nvalid.bdi
    ) %>%
    mutate_at(
      vars(items),
      list(~ifelse(is.na(.), mean.temp, .))
    ) %>%
    mutate(
      score.temp = rowSums(select(., items), na.rm = TRUE),
      score.bdi = ifelse(nvalid.bdi >= nvalid, score.temp, NA),
      cutoff.bdi = case_when(
        score.bdi >= 30 ~ "Severe",
        score.bdi >= 19 ~ "Moderate",
        score.bdi >= 10 ~ "Mild",
        score.bdi < 10 ~ "Minimal",
        TRUE ~ as.character(NA)
      ),
      cutoff.bdi = factor(cutoff.bdi, levels = c(
        "Minimal",
        "Mild",
        "Moderate",
        "Severe"
      )),
      cutoff.bdi2 = case_when(
        score.bdi >= 29 ~ "Severe",
        score.bdi >= 20 ~ "Moderate",
        score.bdi >= 14 ~ "Mild",
        score.bdi < 14 ~ "Minimal",
        TRUE ~ as.character(NA)
      ),
      cutoff.bdi2 = factor(cutoff.bdi2, levels = c(
        "Minimal",
        "Mild",
        "Moderate",
        "Severe"
      ))
    ) %>%
    select(-ends_with("temp"), -contains(keepnot))
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -starts_with('nvalid.'))
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(vars(starts_with('score')), list(~ round(., digits)))
  } else {
    data <- data
  }
  data
}
NULL