R/sri.R

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

#' @title {Scoring the Severe Respiratory Insufficiency Questionnaire (SRI)}
#' @description {\emph{The SRI is a disease specific HRQL measurement [...]
#' designed for patients with severe respiratory insufficiency due to various conditions
#' receiving home mechanical ventilation.} (Windisch et al. 2003)}
#' @details
#' \itemize{
#' \item \code{Number of items:} {49}
#' \item \code{Item range:} {1 to 5}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {0 to 100}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {"At least 50\% of the items per scale must be
#' correctly addressed". (Scoring Manual)}
#' }
#' @references
#' \itemize{
#'  \item{Scoring Manual (\url{https://www.pneumologie.de/fileadmin/user_upload/SRI/Scoring_Dutch1a60.pdf})}
#'  \item{Struik et al. 2013 (\url{https://doi.org/10.1016/j.jclinepi.2013.04.013})}
#'  \item{Windisch et al. 2003 (\url{https://doi.org/10.1016/S0895-4356(03)00088-X})}
#' }
#' @return The function returns 15 variables:
#' \itemize{
#'  \item \code{nvalid.sri.rc:} Number of valid values of Respiratory Complains (MAX=8)
#'  \item \code{nvalid.sri.pf:} Number of valid values of Physical Functioning (MAX=6)
#'  \item \code{nvalid.sri.as:} Number of valid values of Attendant Symptoms and Sleep (MAX=7)
#'  \item \code{nvalid.sri.sr:} Number of valid values of Social Relationships (MAX=6)
#'  \item \code{nvalid.sri.ax:} Number of valid values of Anxiety (MAX=5)
#'  \item \code{nvalid.sri.wb:} Number of valid values of Psychological Well-Being (MAX=9)
#'  \item \code{nvalid.sri.sf:} Number of valid values of Social Functioning (MAX=8)
#'  \item \code{score.sri.rc:} Respiratory Complains Score
#'  \item \code{score.sri.pf:} Physical Functioning Score
#'  \item \code{score.sri.as:} Attendant Symptoms and Sleep Score
#'  \item \code{score.sri.sr:} Social Relationships Score
#'  \item \code{score.sri.ax:} Anxiety Score
#'  \item \code{score.sri.wb:} Psychological Well-Being Score
#'  \item \code{score.sri.sf:} Social Functioning Score
#'  \item \code{score.sri.gs:} Global Summary Score
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.sri <- paste0("sri.", seq(1, 49, 1))
#' scoring_sri(mydata, items = items.sri)
#' }
#' @param data a \code{\link{data.frame}} containing the SRI items orderd from 1 to 49.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the SRI item names ordered from 1 to 49,
#' or a numeric vector indicating the column numbers of the SRI 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 named list indicating the number of non-missing items required for score
#' calculations. The defaults are:
#' \itemize{
#'  \item \code{rc = 5} {(Respiratory Complains Score)}
#'  \item \code{pf = 4} {(Physical Functioning Score)}
#'  \item \code{as = 4} {(Attendant Symptoms and Sleep Score)}
#'  \item \code{sr = 4} {(Social Relationships Score)}
#'  \item \code{ax = 3} {(Anxiety Score)}
#'  \item \code{wb = 5} {(Psychological Well-Being Score)}
#'  \item \code{sf = 5} {(Social Functioning Score)}
#' }
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @export
scoring_sri <- function(data, items = 1:49, keep = TRUE,
                        nvalid = list(rc = 5, pf = 4, as = 4,
                                      sr = 4, ax = 3, wb = 5, sf = 5),
                        digits = NULL,
                        reverse = c(
                          1, 2, 4, 5, 6, 11, 13, 14, 15, 16, 17,
                          19, 21, 22, 23, 24, 25, 26, 28, 29, 30,
                          31, 34, 35, 38, 39, 40, 42, 43, 45, 46,
                          47, 48
                        )) {
  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 SRI items is 1")
  } else if (max(data[, items], na.rm = T) > 5) {
    stop("Maximum possible value for SRI items is 5")
  }
  # check for number of specified items
  if (length(items) != 49) {
    stop("Number of items must be 49!")
  }
  items <- items
  items.rev <- items[reverse]
  items.rc <- items[c(2, 5, 12, 19, 22, 24, 25, 29)]
  items.pf <- items[c(1, 16, 32, 33, 41, 45)]
  items.as <- items[c(6, 9, 11, 14, 17, 18, 42)]
  items.sr <- items[c(7, 10, 21, 27, 43, 46)]
  items.ax <- items[c(8, 13, 26, 28, 39)]
  items.wb <- items[c(4, 20, 30, 34, 36, 38, 40, 44, 49)]
  items.sf <- items[c(3, 15, 23, 31, 35, 37, 47, 48)]

  data <- data %>%
    mutate_at(vars(items.rev), list(~6 - .)) %>%
    mutate(
      nvalid.sri.rc = rowSums(!is.na(select(., items.rc))),
      nvalid.sri.pf = rowSums(!is.na(select(., items.pf))),
      nvalid.sri.as = rowSums(!is.na(select(., items.as))),
      nvalid.sri.sr = rowSums(!is.na(select(., items.sr))),
      nvalid.sri.ax = rowSums(!is.na(select(., items.ax))),
      nvalid.sri.wb = rowSums(!is.na(select(., items.wb))),
      nvalid.sri.sf = rowSums(!is.na(select(., items.sf))),
      score.sri.rc = ifelse(nvalid.sri.rc >= nvalid[['rc']], rowSums(select(., items.rc), na.rm = TRUE) / nvalid.sri.rc, NA),
      score.sri.pf = ifelse(nvalid.sri.pf >= nvalid[['pf']], rowSums(select(., items.pf), na.rm = TRUE) / nvalid.sri.pf, NA),
      score.sri.as = ifelse(nvalid.sri.as >= nvalid[['as']], rowSums(select(., items.as), na.rm = TRUE) / nvalid.sri.as, NA),
      score.sri.sr = ifelse(nvalid.sri.sr >= nvalid[['sr']], rowSums(select(., items.sr), na.rm = TRUE) / nvalid.sri.sr, NA),
      score.sri.ax = ifelse(nvalid.sri.ax >= nvalid[['ax']], rowSums(select(., items.ax), na.rm = TRUE) / nvalid.sri.ax, NA),
      score.sri.wb = ifelse(nvalid.sri.wb >= nvalid[['wb']], rowSums(select(., items.wb), na.rm = TRUE) / nvalid.sri.wb, NA),
      score.sri.sf = ifelse(nvalid.sri.sf >= nvalid[['sf']], rowSums(select(., items.sf), na.rm = TRUE) / nvalid.sri.sf, NA)
    ) %>%
    mutate_at(vars(starts_with('score.sri.')), list(~(. - 1 ) / 4 * 100)) %>%
    mutate(score.sri.gs = rowMeans(select(., score.sri.rc:score.sri.sf), na.rm = FALSE))
  # 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.sri.')
      ),
      list(~ round(., digits))
    )
  } else {
    data <- data
  }
  data
}
NULL