R/briefa.R

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

#' @title {Scoring the Behavior Rating Inventory of Executuve Function, Adult version (BRIEF-A)}
#' @description {The BRIEF-A is a standardized self-report measure that captures adults' views of their own
#' executive functions, or self-regulation, in their everyday environment.}
#' @details
#' \itemize{
#' \item \code{Number of items:} {75}
#' \item \code{Item range:} {1 to 3}
#' \item \code{Reverse items:} {none}
#' \item \code{Score range:} {T scores provide information about the person's individual scores\cr
#' relative to the scores of other respondents in the standardization sample}
#' \item \code{Cut-off-values:} {none}
#' \item \code{Minimal clinically important difference:} {none}
#' \item \code{Treatment of missing values:} {not reported; default: 80\% valid items}}
#' @references
#' Roth, Isquith, Gioia (1996) BRIEF-A. Behavior Rating Inventory of Executive Function -- Adult version. Professional Manual, Lutz (FL): PAR.
#'
#' Gioia, Isquith (2011) (\url{10.1007/978-0-387-79948-3_1881})
#' @return The function returns 39 variables:
#' \itemize{
#'  \item \code{nvalid.briefa.inhi:} {Inhibit Scale, Number of valid items (MAX=8)}
#'  \item \code{nvalid.briefa.shif:} {Shift Scale, Number of valid items (MAX=6)}
#'  \item \code{nvalid.briefa.emot:} {Emotional Control Scale, Number of valid items (MAX=10)}
#'  \item \code{nvalid.briefa.self:} {Self-Monitor Scale, Number of valid items (MAX=6)}
#'  \item \code{nvalid.briefa.init:} {Initiate Scale, Number of valid items (MAX=8)}
#'  \item \code{nvalid.briefa.work:} {Working Memory Scale, Number of valid items (MAX=8)}
#'  \item \code{nvalid.briefa.plan:} {Plan/ Organize Scale, Number of valid items (MAX=10)}
#'  \item \code{nvalid.briefa.task:} {Task Monitor Scale, Number of valid items (MAX=6)}
#'  \item \code{nvalid.briefa.orga:} {Organization of Materials Scale, Number of valid items (MAX=8)}
#'  \item \code{score.briefa.inhi.r:} {Inhibit Scale, Raw Score}
#'  \item \code{score.briefa.shif.r:} {Shift Scale, Raw Score}
#'  \item \code{score.briefa.emot.r:} {Emotional Control Scale, Raw Score}
#'  \item \code{score.briefa.self.r:} {Self-Monitor Scale, Raw Score}
#'  \item \code{score.briefa.init.r:} {Initiate Scale, Raw Score}
#'  \item \code{score.briefa.work.r:} {Working Memory Scale, Raw Score}
#'  \item \code{score.briefa.plan.r:} {Plan/ Organize Scale, Raw Score}
#'  \item \code{score.briefa.task.r:} {Task Monitor Scale, Raw Score}
#'  \item \code{score.briefa.orga.r:} {Organization of Materials Scale, Raw Score}
#'  \item \code{score.briefa.BRI.r:} {Behavioral Regulation Index, Raw Score}
#'  \item \code{score.briefa.MI.r:} {Metacognition Index, Raw Score}
#'  \item \code{score.briefa.GEC.r} {Global Executive Composite, Raw Score}
#'  \item \code{score.briefa.inhi.t:} {Inhibit Scale, t-Score}
#'  \item \code{score.briefa.shif.t:} {Shift Scale, t-Score}
#'  \item \code{score.briefa.emot.t:} {Emotional Control Scale, t-Score}
#'  \item \code{score.briefa.self.t:} {Self-Monitor Scale, t-Score}
#'  \item \code{score.briefa.init.t:} {Initiate Scale, t-Score}
#'  \item \code{score.briefa.work.t:} {Working Memory Scale, t-Score}
#'  \item \code{score.briefa.plan.t:} {Plan/ Organize Scale, t-Score}
#'  \item \code{score.briefa.task.t:} {Task Monitor Scale, t-Score}
#'  \item \code{score.briefa.orga.t:} {Organization of Materials Scale, t-Score}
#'  \item \code{score.briefa.BRI.t:} {Behavioral Regulation Index, t-Score}
#'  \item \code{score.briefa.MI.t:} {Metacognition Index, t-Score}
#'  \item \code{score.briefa.GEC.t:} {Global Executive Composite, t-Score}
#'  \item \code{score.briefa.NEG:} {Negativity Scale}
#'  \item \code{cutoff.briefa.NEG:} {Negativity Scale, Categorized}
#'  \item \code{score.briefa.INF:} {Infrequency Scale}
#'  \item \code{cutoff.briefa.INF:} {Infrequency Scale, Categorized}
#'  \item \code{score.briefa.INC:} {Inconsistency Scale}
#'  \item \code{cutoff.briefa.INC:} {Inconsistency Scale, Categorized}
#' }
#' @examples
#' \dontrun{
#' library(dplyr)
#' items.briefa <- paste0("BRIEF", seq(1, 75, 1))
#' scoring_briefa(mydata, items = items.briefa, age = 'ALTER')
#' }
#' @param data a \code{\link{data.frame}} containing the BRIEF-A items orderd from 1 to 75.
#' The \code{\link{data.frame}} may contain further variables.
#' @param items A character vector with the BRIEF-A item names ordered from 1 to 75,
#' or a numeric vector indicating the column numbers of the BRIEF-A 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{inhi = 6} {(Inhibit Scale)}
#'  \item \code{shif = 5} {(Shift Scale)}
#'  \item \code{emot = 8} {(Emotional Control Scale)}
#'  \item \code{self = 5} {(Self-Monitor Scale)}
#'  \item \code{init = 6} {(Initiate Scale)}
#'  \item \code{work = 6} {(Working Memory Scale)}
#'  \item \code{plan = 8} {(Plan/ Organize Scale)}
#'  \item \code{task = 5} {(Task Monitor Scale)}
#'  \item \code{orga = 6} {(Organization of Materials Scale)}
#' }
#' @param digits Integer of length one: value to round to. No rounding by default.
#' @param age Character vector with name of age variable (numeric)
#' @export
scoring_briefa <- function(data, items = 1:75, keep = TRUE,
                            nvalid = list(inhi = 6, shif = 5, emot = 8,
                                          self = 5, init = 6, work = 6,
                                          plan = 8, task = 5, orga = 6),
                            digits = NULL, age) {
  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 BRIEF-A items is 1")
  } else if (max(data[, items], na.rm = T) > 3) {
    stop("Maximum possible value for BRIEF-A items is 3")
  }
  # check for number of specified items
  if (length(items) != 75) {
    stop("Number of items must be 75!")
  }
  items <- items
  items.inhi <- items[c(5, 16, 29, 36, 43, 55, 58, 73)]
  items.shif <- items[c(8, 22, 32, 44, 61, 67)]
  items.emot <- items[c(1, 12, 19, 28, 33, 42, 51, 57, 69, 72)]
  items.self <- items[c(13, 23, 37, 50, 64, 70)]
  items.init <- items[c(6, 14, 20, 25, 45, 49, 53, 62)]
  items.work <- items[c(4, 11, 17, 26, 35, 46, 56, 68)]
  items.plan <- items[c(9, 15, 21, 34, 39, 47, 54, 63, 66, 71)]
  items.task <- items[c(2, 18, 24, 41, 52, 75)]
  items.orga <- items[c(3, 7, 30, 31, 41, 60, 65, 74)]
  data <- data %>%
    mutate(
      item.01 = rowSums(select(., items[1])),
      item.02 = rowSums(select(., items[2])),
      item.03 = rowSums(select(., items[3])),
      item.04 = rowSums(select(., items[4])),
      item.05 = rowSums(select(., items[5])),
      item.06 = rowSums(select(., items[6])),
      item.07 = rowSums(select(., items[7])),
      item.08 = rowSums(select(., items[8])),
      item.09 = rowSums(select(., items[9])),
      item.10 = rowSums(select(., items[10])),
      item.11 = rowSums(select(., items[11])),
      item.12 = rowSums(select(., items[12])),
      item.13 = rowSums(select(., items[13])),
      item.14 = rowSums(select(., items[14])),
      item.15 = rowSums(select(., items[15])),
      item.16 = rowSums(select(., items[16])),
      item.17 = rowSums(select(., items[17])),
      item.18 = rowSums(select(., items[18])),
      item.19 = rowSums(select(., items[19])),
      item.20 = rowSums(select(., items[20])),
      item.21 = rowSums(select(., items[21])),
      item.22 = rowSums(select(., items[22])),
      item.23 = rowSums(select(., items[23])),
      item.24 = rowSums(select(., items[24])),
      item.25 = rowSums(select(., items[25])),
      item.26 = rowSums(select(., items[26])),
      item.27 = rowSums(select(., items[27])),
      item.28 = rowSums(select(., items[28])),
      item.29 = rowSums(select(., items[29])),
      item.30 = rowSums(select(., items[30])),
      item.31 = rowSums(select(., items[31])),
      item.32 = rowSums(select(., items[32])),
      item.33 = rowSums(select(., items[33])),
      item.34 = rowSums(select(., items[34])),
      item.35 = rowSums(select(., items[35])),
      item.36 = rowSums(select(., items[36])),
      item.37 = rowSums(select(., items[37])),
      item.38 = rowSums(select(., items[38])),
      item.39 = rowSums(select(., items[39])),
      item.40 = rowSums(select(., items[40])),
      item.41 = rowSums(select(., items[41])),
      item.42 = rowSums(select(., items[42])),
      item.43 = rowSums(select(., items[43])),
      item.44 = rowSums(select(., items[44])),
      item.45 = rowSums(select(., items[45])),
      item.46 = rowSums(select(., items[46])),
      item.47 = rowSums(select(., items[47])),
      item.48 = rowSums(select(., items[48])),
      item.49 = rowSums(select(., items[49])),
      item.50 = rowSums(select(., items[50])),
      item.51 = rowSums(select(., items[51])),
      item.52 = rowSums(select(., items[52])),
      item.53 = rowSums(select(., items[53])),
      item.54 = rowSums(select(., items[54])),
      item.55 = rowSums(select(., items[55])),
      item.56 = rowSums(select(., items[56])),
      item.57 = rowSums(select(., items[57])),
      item.58 = rowSums(select(., items[58])),
      item.59 = rowSums(select(., items[59])),
      item.60 = rowSums(select(., items[60])),
      item.61 = rowSums(select(., items[61])),
      item.62 = rowSums(select(., items[62])),
      item.63 = rowSums(select(., items[63])),
      item.64 = rowSums(select(., items[64])),
      item.65 = rowSums(select(., items[65])),
      item.66 = rowSums(select(., items[66])),
      item.67 = rowSums(select(., items[67])),
      item.68 = rowSums(select(., items[68])),
      item.69 = rowSums(select(., items[69])),
      item.70 = rowSums(select(., items[70])),
      item.71 = rowSums(select(., items[71])),
      item.72 = rowSums(select(., items[72])),
      item.73 = rowSums(select(., items[73])),
      item.74 = rowSums(select(., items[74])),
      item.75 = rowSums(select(., items[75])),
      item.age = rowSums(select(., age))
    ) %>%
    mutate(
      item.age = as.integer(item.age),
      age.group = case_when(
        item.age >= 18 & item.age <= 29 ~ "18-29",
        item.age >= 30 & item.age <= 39 ~ "30-39",
        item.age >= 40 & item.age <= 49 ~ "40-49",
        item.age >= 50 & item.age <= 59 ~ "50-59",
        item.age >= 60 & item.age <= 69 ~ "60-69",
        item.age >= 70 & item.age <= 79 ~ "70-79",
        item.age >= 80 & item.age <= 90 ~ "80-90"
      ),
      nvalid.briefa.inhi = rowSums(!is.na(select(., items.inhi))),
      nvalid.briefa.shif = rowSums(!is.na(select(., items.shif))),
      nvalid.briefa.emot = rowSums(!is.na(select(., items.emot))),
      nvalid.briefa.self = rowSums(!is.na(select(., items.self))),
      nvalid.briefa.init = rowSums(!is.na(select(., items.init))),
      nvalid.briefa.work = rowSums(!is.na(select(., items.work))),
      nvalid.briefa.plan = rowSums(!is.na(select(., items.plan))),
      nvalid.briefa.task = rowSums(!is.na(select(., items.task))),
      nvalid.briefa.orga = rowSums(!is.na(select(., items.orga))),
      score.briefa.inhi.r = ifelse(nvalid.briefa.inhi >= nvalid[["inhi"]], rowSums(select(., items.inhi), na.rm = TRUE), NA),
      score.briefa.shif.r = ifelse(nvalid.briefa.shif >= nvalid[["shif"]], rowSums(select(., items.shif), na.rm = TRUE), NA),
      score.briefa.emot.r = ifelse(nvalid.briefa.emot >= nvalid[["emot"]], rowSums(select(., items.emot), na.rm = TRUE), NA),
      score.briefa.self.r = ifelse(nvalid.briefa.self >= nvalid[["self"]], rowSums(select(., items.self), na.rm = TRUE), NA),
      score.briefa.init.r = ifelse(nvalid.briefa.init >= nvalid[["init"]], rowSums(select(., items.init), na.rm = TRUE), NA),
      score.briefa.work.r = ifelse(nvalid.briefa.work >= nvalid[["work"]], rowSums(select(., items.work), na.rm = TRUE), NA),
      score.briefa.plan.r = ifelse(nvalid.briefa.plan >= nvalid[["plan"]], rowSums(select(., items.plan), na.rm = TRUE), NA),
      score.briefa.task.r = ifelse(nvalid.briefa.task >= nvalid[["task"]], rowSums(select(., items.task), na.rm = TRUE), NA),
      score.briefa.orga.r = ifelse(nvalid.briefa.orga >= nvalid[["orga"]], rowSums(select(., items.orga), na.rm = TRUE), NA),
      score.briefa.BRI.r = score.briefa.inhi.r + score.briefa.shif.r + score.briefa.emot.r + score.briefa.self.r,
      score.briefa.MI.r = score.briefa.init.r + score.briefa.work.r + score.briefa.plan.r + score.briefa.task.r + score.briefa.orga.r,
      score.briefa.GEC.r = score.briefa.BRI.r + score.briefa.MI.r,
      score.briefa.NEG = (item.01 == 3) + (item.08 == 3) + (item.19 == 3) + (item.21 == 3) + (item.22 == 3) +
        (item.23 == 3) + (item.29 == 3) + (item.36 == 3) + (item.39 == 3) + (item.40 == 3),
      cutoff.briefa.NEG = ifelse(score.briefa.NEG >= 6, "elevated", "acceptable"),
      score.briefa.INF = (item.10 == 3) + (item.27 == 1) + (item.38 == 3) + (item.48 == 1) + (item.59 == 1),
      cutoff.briefa.INF = ifelse(score.briefa.INF >= 2, "infrequent", "acceptable"),
      score.briefa.INC = abs(item.02 - item.41) + abs(item.25 - item.49) + abs(item.28 - item.42) +
        abs(item.33 - item.72) + abs(item.34 - item.63) + abs(item.44 - item.61) +
        abs(item.46 - item.56) + abs(item.52 - item.75) + abs(item.60 - item.74) +
        abs(item.64 - item.70),
      cutoff.briefa.INC = ifelse(score.briefa.INC >= 8, "inconsistent", "acceptable")
    ) %>%
    select(-starts_with('item.')) %>%
    left_join(df.norm.briefa.inhi, by = c("age.group", "score.briefa.inhi.r")) %>%
    left_join(df.norm.briefa.shif, by = c("age.group", "score.briefa.shif.r")) %>%
    left_join(df.norm.briefa.emot, by = c("age.group", "score.briefa.emot.r")) %>%
    left_join(df.norm.briefa.self, by = c("age.group", "score.briefa.self.r")) %>%
    left_join(df.norm.briefa.init, by = c("age.group", "score.briefa.init.r")) %>%
    left_join(df.norm.briefa.work, by = c("age.group", "score.briefa.work.r")) %>%
    left_join(df.norm.briefa.plan, by = c("age.group", "score.briefa.plan.r")) %>%
    left_join(df.norm.briefa.task, by = c("age.group", "score.briefa.task.r")) %>%
    left_join(df.norm.briefa.orga, by = c("age.group", "score.briefa.orga.r")) %>%
    left_join(df.norm.briefa.BRI, by = c("age.group", "score.briefa.BRI.r")) %>%
    left_join(df.norm.briefa.MI, by = c("age.group", "score.briefa.MI.r")) %>%
    left_join(df.norm.briefa.GEC, by = c("age.group", "score.briefa.GEC.r"))
  # 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