## ----include = FALSE----------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")

## ----setup--------------------------------------------------------------------
library(colleyRstats)

## -----------------------------------------------------------------------------
list_questionnaires()[, c("key", "name", "n_items", "n_subscales", "scale")]

## -----------------------------------------------------------------------------
set.seed(1)
study <- data.frame(participant = factor(1:8))
study[paste0("sus_", 1:10)] <- lapply(1:10, function(i) sample(1:5, 8, TRUE))

score_questionnaire(study, "sus", prefix = "sus_")

## -----------------------------------------------------------------------------
questionnaire_items("ueq_s")

## -----------------------------------------------------------------------------
tlx <- data.frame(
  mental = c(14, 3), physical = c(2, 1), temporal = c(11, 4),
  performance = c(6, 2), effort = c(13, 5), frustration = c(9, 1)
)

# The 21-point NASA-TLX sheet, scored onto the conventional 0-100
score_questionnaire(tlx, "nasa_tlx", scale = c(1, 21))

## -----------------------------------------------------------------------------
scored <- score_questionnaire(study, "sus", prefix = "sus_", append = TRUE)
names(scored)[1:3]
scored$SUS

## -----------------------------------------------------------------------------
invisible(check_questionnaire(study, "sus", prefix = "sus_"))

## -----------------------------------------------------------------------------
# A survey that anchored NASA-TLX performance "Good" at the high end
scores <- score_questionnaire(tlx, "nasa_tlx",
  scale = c(1, 21),
  reverse_items = "performance"
)
scores$Performance

## -----------------------------------------------------------------------------
score_questionnaire(
  tlx, "nasa_tlx",
  scale = c(1, 21),
  items = c(
    mental = "mental", physical = "physical", temporal = "temporal",
    performance = "performance", effort = "effort", frustration = "frustration"
  )
)$RTLX

## -----------------------------------------------------------------------------
gappy <- study
gappy$sus_3[1] <- NA

score_questionnaire(gappy, "sus", prefix = "sus_")$SUS[1]

# Score responses that are at least 80% complete
score_questionnaire(gappy, "sus", prefix = "sus_", min_valid = 0.8)$SUS[1]

## -----------------------------------------------------------------------------
score_reliability(study, "sus", prefix = "sus_")

## -----------------------------------------------------------------------------
define_questionnaire(
  key = "acceptance",
  name = "Van der Laan acceptance scale",
  reference = "Van der Laan, Heino & De Waard (1997), Transp. Res. C 5(1)",
  scale = c(-2, 2),
  label = c(
    "useful - useless", "pleasant - unpleasant", "bad - good",
    "nice - annoying", "effective - superfluous", "irritating - likeable",
    "assisting - worthless", "undesirable - desirable",
    "raising alertness - sleep-inducing"
  ),
  subscale = rep(c("Usefulness", "Satisfying"), length.out = 9),
  reverse = c(1, 2, 4, 5, 7, 9),
  higher = "better"
)

vdl <- as.data.frame(matrix(c(-2, 2, -2, 2, -2, 2, -2, 2, -2), nrow = 1))
names(vdl) <- paste0("item", 1:9)

score_questionnaire(vdl, "acceptance")

## -----------------------------------------------------------------------------
ratings <- data.frame(
  participant = rep(c("p1", "p2"), each = 5),
  minute = rep(0:4, 2),
  fms = c(0, 1, 3, 6, 8, 0, 0, 1, 1, 2)
)

summarize_sickness(ratings,
  value = "fms", id = "participant",
  time = "minute", threshold = 5
)

## -----------------------------------------------------------------------------
misc <- data.frame(misc = c(0, 1, 3, 6, 10, 2, 4, 8))
classify_outcome(score_questionnaire(misc, "misc")$MISC)

## -----------------------------------------------------------------------------
set.seed(7)
trial <- expand.grid(
  participant = factor(1:12),
  condition = factor(c("baseline", "ambient", "explicit"))
)
effect <- c(baseline = 0, ambient = 0.6, explicit = 1.2)[trial$condition]
# Participants differ from one another too, which is what the random intercept
# of the mixed model is there to absorb.
person <- rnorm(12, 0, 0.6)[as.integer(trial$participant)]
for (i in 1:10) {
  raw <- 3 + effect + person + rnorm(nrow(trial), 0, 0.5)
  if (i %% 2 == 0) raw <- 6 - raw   # the even SUS items are negatively worded
  trial[[paste0("sus_", i)]] <- pmin(pmax(round(raw), 1), 5)
}

scored <- score_questionnaire(trial, "sus", prefix = "sus_", append = TRUE)

fit <- fit_recommended(
  scored,
  outcome = "SUS",
  predictors = "condition",
  cluster = "participant",
  verbose = FALSE
)

fit$recommendation$recommendation
fit$text