R/scoring.R

In nrkoehler/srir: Scoring of the Severe Respiratory Insufficiency Questionnaire (SRI)

#' Scoring the SRI questionnaire
#' @param X a \code{\link{data.frame}} of 49
#' columns, containing the questionnaire items. In order from left to right:
#' sri.01 -- sri.49.
#' @param id an id variable.
#'
#' @return Returns an object of class \code{data.frame} containing
#'    the score values of all SRI sub scales and one total summary scale.
#'
#' @examples
#' library(srir)
#' score_sri(df.full, id = "id")
#'
#' @export
scoring_sri <- function(X, id = "" )

{


  # STEP 1: INPUT DATA ------------------------------------------------------



  items = paste0("sri.", 1:49)
  if (length(which(is.element(items, colnames(X)))) < 49) {
    stop("At least one item is missing: items must be named sri.1 to sri.49")
    break
  }
  if (length(which(match(items, colnames(X)) == sort(match(items,
                                                           colnames(X))))) < 49) {
    stop("Items must be named sri.1 to sri.49 and presented on that order in the dataset")
    break
  }
  if (sum(apply(X[, items], 2, is.numeric)) < 49) {
    stop("Items must be numeric")
    break
  }
  if (min(X[, items], na.rm = T) < 1) {
    stop("Minimum possible value for items is 1")
    break
  }
  if (max(X[, items[1:49]], na.rm = T) > 5) {
    stop("Maximum possible value for items is 5")
    break
  }

  if (id != "") {
    Y = matrix(nrow = nrow(X), ncol = 9)
    Y = as.data.frame(Y)
    Y[, 1] = X[, id]
    colnames(Y) = c(id, "sri.rc", "sri.pf", "sri.as", "sri.sr",
                    "sri.ax", "sri.wb", "sri.sf", "sri.ss")
  }

  if (id == "") {
    Y = matrix(nrow = nrow(X), ncol = 8)
    Y = as.data.frame(Y)
    colnames(Y) = c("sri.rc", "sri.pf", "sri.as", "sri.sr",
                    "sri.ax", "sri.wb", "sri.sf", "sri.ss")
  }



  # STEP 2: RECODE DATA -----------------------------------------------------


  items.rec <- c("sri.1", "sri.2", "sri.4", "sri.5", "sri.6", "sri.11", "sri.13", "sri.14",
                 "sri.15", "sri.16", "sri.17", "sri.19", "sri.21","sri.22", "sri.23", "sri.24",
                 "sri.25", "sri.26", "sri.28", "sri.29", "sri.30", "sri.31", "sri.34", "sri.35",
                 "sri.38", "sri.39", "sri.40", "sri.42","sri.43", "sri.45", "sri.46", "sri.47", "sri.48")

  for (i in items.rec){X[i] = 6 - X[i]}


  # STEP 2: SRI SCALE CONSTRUCTION ------------------------------------------

  ## Respiratory Complains (8 items)


  vars <- c("sri.2", "sri.5", "sri.12", "sri.19",
              "sri.22", "sri.24", "sri.25","sri.29")

  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 5) / X$VAL
  X$sri.rc <- ((X$MEAN - 1) / 4) * 100
  Y$sri.rc <- round(X$sri.rc, 1)
  comment(Y$sri.rc) <- "SRI - Respiratory Complains (0-100)"

  ## Physical Functioning (6 items)


  vars <- c("sri.1", "sri.16", "sri.32",
              "sri.33", "sri.41", "sri.45")
  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 4) / X$VAL
  X$sri.pf <- ((X$MEAN - 1) / 4) * 100
  Y$sri.pf <- round(X$sri.pf, 1)
  comment(Y$sri.pf) <- "SRI - Physical Functioning (0-100)"

  ## Attendant Symptoms and Sleep (7 items)


  vars <- c("sri.6", "sri.9", "sri.11",
              "sri.14", "sri.17", "sri.18", "sri.42")
  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 4) / X$VAL
  X$sri.as <- ((X$MEAN - 1) / 4) * 100
  Y$sri.as <- round(X$sri.as, 1)
  comment(Y$sri.as) <- "SRI - Attendant Symptoms and Sleep (0-100)"

  ## Social Relationships (6 items)

  vars <- c("sri.7", "sri.10", "sri.21",
              "sri.27", "sri.43", "sri.46")
  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 4) / X$VAL
  X$sri.sr <- ((X$MEAN - 1) / 4) * 100
  Y$sri.sr <- round(X$sri.sr, 1)
  comment(Y$sri.sr) <- "SRI - Social Relationships (0-100)"


  ## Anxiety (5 items)


  vars <- c("sri.8", "sri.13", "sri.26",
              "sri.28", "sri.39")
  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 3) / X$VAL
  X$sri.ax <- ((X$MEAN - 1) / 4) * 100
  Y$sri.ax <- round(X$sri.ax, 1)
  comment(Y$sri.ax) <- "SRI - Anxiety (0-100)"

  ## Psychological Well-Being (9 items)


  vars <- c("sri.4", "sri.20", "sri.30",
              "sri.34", "sri.36", "sri.38",
              "sri.40", "sri.44", "sri.49")
  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 5) / X$VAL
  X$sri.wb <- ((X$MEAN - 1) / 4) * 100
  Y$sri.wb <- round(X$sri.wb, 1)
  comment(Y$sri.wb) <- "SRI - Psychological Well-Being (0-100)"


  ## Social Functioning (8 items)

  vars <- c("sri.3", "sri.15", "sri.23",
              "sri.31", "sri.35", "sri.37",
              "sri.47", "sri.48")
  X$VAL <- rowSums(!is.na(X[, vars]))
  X$MEAN <- sum.n(X[, vars], 5) / X$VAL
  X$sri.sf <- ((X$MEAN - 1) / 4) * 100
  Y$sri.sf <- round(X$sri.sf, 1)
  comment(Y$sri.sf) <- "SRI - Social Functioning (0-100)"

  ## Summary Scale (7 sub-scales)

  vars <- c("sri.rc", "sri.pf", 'sri.as', 'sri.sr',
              'sri.ax', 'sri.wb', 'sri.sf')
  X$sri.ss <- sum.n(X[, vars], 7) / 7
  Y$sri.ss <- round(X$sri.ss, 1)
  comment(Y$sri.ss) <- "SRI - Summary Scale (0-100)"



# RETURN VARS -------------------------------------------------------------


  Y

}
NULL