Finding habituators

habituators.R

# relies on zoo package

# function to find the baseline value
baseline_looking <- function (lts) {
  # select lts > 12s
  lts_12 <- lts[lts > 12 & !is.na(lts)]
 
  # sum the first three
  baseline <- sum(lts_12[1:3], na.rm=TRUE)
 
  return(baseline)
}

# function to decide whether looking time decreased by half
habituated <- function(lts) {
  # get baseline
  baseline <- baseline_looking(lts)
 
  # cumulative sum less than baseline
  three_trial_window <- zoo::rollsum(lts, 3, align = "left", fill = NA)
 
  # if there's no baseline then habituation is false
  if (is.na(baseline)) {
    habituated <- FALSE
  } else {
    habituated <- any(three_trial_window < baseline/2)
  }
 
  return(habituated)
}

habituators <- d |>
  group_by(lab_id, subj_num) |>
  summarise(habituated = habituated(lts))

d <- left_join(d, habituators)