R/debq.R

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

#' @title {Scoring the Dutch Eating Behavior Questionnaire, German Version (DEBQ)}
#' @description {\emph{The Dutch Eating Behavior Questionnaire is an internationally widely used instrument
#' assessing different eating styles that may contribute to weight gain and overweight:
#' emotional eating, external eating, and restraint eating. [...]
#' The German version incorporates two important modifications from the original Dutch and the English versions:
#' \enumerate{
#' \item {three items from the emotional eating subscale were removed resulting in a total number of 30 items [...],}
#' \item {while the items in the Dutch original and English version were formulated as questions,
#' items in the German version were formulated as statements.}}} (Nagl et al. 2016)}
#' @note {The calculation of the DEBQ global score is not defined in the scoring manual
#' and must be considered highly experimental.}
#' @details
#' \itemize{
#' \item \code{Number of items:} {30}
#' \item \code{Item range:} {1 to 5}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {1 to 5 for each score}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {not reported;
#' by default \eqn{\ge} 8/10 questions of the sub-scores must be answered}
#' }
#' @references
#'  Grunert SC (1989) Ein Inventar zur Erfassung von Selbstaussagen zum Ernaehrungsverhalten, Diagnostica 35(2): 167-179
#'
#'  Nagl et al. 2016 (\doi{10.1371/journal.pone.0162510})
#' @return The function returns 7 variables:
#' \itemize{
#'  \item \code{nvalid.debq.emo:} {Number of valid values of Emotional Scale (MAX=10)}
#'  \item \code{nvalid.debq.ext:} {Number of valid values of External Scale (MAX=10)}
#'  \item \code{nvalid.debq.res:} {Number of valid values of Restrained Scale (MAX=10)}
#'  \item \code{score.debq.emo:} {DEBQ Emotional Eating Score}
#'  \item \code{score.debq.ext:} {DEBQ External Eating Score}
#'  \item \code{score.debq.res:} {DEBQ Restrained Eating Score}
#'  \item \code{score.debq.tot:} {DEBQ Global Score}
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' scoring_debq(qscorer::df.test.debq, items = c(3:32), keep = TRUE, nvalid = 8, digits = NULL)
#' }
#' @param data a \code{\link{data.frame}} containing the DEBQ items orderd from 1 to 30.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the DEBQ item names ordered from 1 to 30,
#' or a numeric vector indicating the column numbers of the DEBQ 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 8.
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_debq <- function(data, items = 1:30, keep = TRUE, nvalid = 8, digits = NULL) {
  library(dplyr, warn.conflicts = FALSE)
  # check whether item values are within the defined range
  if (min(data[, items], na.rm = T) < 1) {
    stop("Minimum possible value for DEBQ items is 1")
  } else if (max(data[, items], na.rm = T) > 5) {
    stop("Maximum possible value for DEBQ items is 5")
  }
  # check for number of specified items
  if (length(items) != 30) {
    stop("Number of items must be 30!")
  }
  # check for specified number of valid values
  if (!(nvalid %in% 1:10)) {
    stop("Number of valid items must be between 1 and 10!")
  }

  items.emo <- items[c(1, 4, 6, 8, 9, 11, 14, 17, 22, 30)]
  items.ext <- items[c(2, 3, 16, 18, 20, 23, 25, 26, 28, 29)]
  items.res <- items[c(5, 7, 10, 12, 13, 15, 19, 21, 24, 27)]
  data <- data %>%
    mutate(
      nvalid.debq.emo = rowSums(!is.na(select(., items.emo))),
      nvalid.debq.ext = rowSums(!is.na(select(., items.ext))),
      nvalid.debq.res = rowSums(!is.na(select(., items.res))),
      score.debq.emo = ifelse(nvalid.debq.emo >= nvalid, rowSums(select(., items.emo), na.rm = TRUE) / nvalid.debq.emo, NA),
      score.debq.ext = ifelse(nvalid.debq.ext >= nvalid, rowSums(select(., items.ext), na.rm = TRUE) / nvalid.debq.ext, NA),
      score.debq.res = ifelse(nvalid.debq.res >= nvalid, rowSums(select(., items.res), na.rm = TRUE) / nvalid.debq.res, NA)
    ) %>%
    mutate(score.debq.tot = rowMeans(select(., score.debq.emo:score.debq.res), na.rm = FALSE))
  # Keep single items and nvalid variables
  if (keep == FALSE) {
    data <- data %>% select(-items, -nvalid.debq.emo, -nvalid.debq.ext, -nvalid.debq.res)
  } else {
    data <- data
  }
  # Rounding
  if (is.numeric(digits) == TRUE) {
    data <- data %>% mutate_at(
      vars(
        score.debq.emo, score.debq.ext,
        score.debq.res, score.debq.tot
      ),
      list(~ round(., digits))
    )
  } else {
    data <- data
  }
  data
}
NULL