tests/testthat/test-calc-phase-pairs.R

In jepusto/SingleCaseES: A Calculator for Single-Case Effect Sizes

context("calc_phase_pairs() works properly.")

suppressWarnings(library(dplyr))
suppressWarnings(library(tidyr))

test_that("calc_phase_pairs() returns a vector the same length as the input.", {
  
  n_phases <- 20
  x <- rep(sample(LETTERS[1:2], size = n_phases, replace = TRUE), 1L + rpois(n_phases, lambda = 5))  
  phase_pairs <- calc_phase_pairs(x)
  
  expect_identical(length(x), length(phase_pairs))
  
  phase_reps <- table(rle(x)$values)
  expect_identical(as.vector(tapply(phase_pairs, x, max)), as.vector(phase_reps))
  
  p <- rep(sample(LETTERS[1:3], size = n_phases, replace = TRUE), 1L + rpois(n_phases, lambda = 5))  
  phase_pairs <- calc_phase_pairs(p)
  
  session <- sample(seq_along(p))
  p_scrambled <- p[session]
  phase_pairs_scrambled = calc_phase_pairs(p_scrambled, session = session)
  expect_identical(phase_pairs, phase_pairs_scrambled[order(session)])
  
})


test_that("calc_phase_pairs() replicates Schmidt (2007), Thorne (2008) phase pairs.", {
  
  data("Schmidt2007")
  
  Schmidt2007 <- 
    Schmidt2007 %>%
    group_by(Behavior_type, Case_pseudonym) %>%
    mutate(phase_pair = calc_phase_pairs(Condition))
  
  expect_identical(Schmidt2007$Phase_num, Schmidt2007$phase_pair)
  
  # shuffle Schmidt2007 by rows
  set.seed(12345)
  
  dat_shuffled <- 
    Schmidt2007 %>% 
    slice_sample(prop = 1) %>% 
    group_by(Behavior_type, Case_pseudonym) %>% 
    mutate(
      phase_pair_wrong = calc_phase_pairs(Condition),
      phase_pair_session = calc_phase_pairs(Condition, session = Session_number)
    ) %>%
    arrange(Behavior_type, Case_pseudonym, Session_number) %>% 
    mutate(
      phase_pair_right = calc_phase_pairs(Condition),
      compare_false = if_else(Phase_num == phase_pair_wrong, 0, 1)
    )
  
  expect_equal(dat_shuffled$Phase_num, dat_shuffled$phase_pair_session)
  expect_equal(dat_shuffled$Phase_num, dat_shuffled$phase_pair_right)
  expect_true(sum(dat_shuffled$compare_false) > 0)
  
  data("Schmidt2012")
  
  Thorne_pairs <- 
    Thorne %>%
    group_by(Measure, Case) %>%
    mutate(phase_pair = calc_phase_pairs(Trt)) %>%
    group_by(Measure, Case, phase_pair) %>%
    count() %>%
    spread(phase_pair, n, fill = 0L)
  
  expect_identical(nrow(Thorne_pairs), 24L)
  expect_true(all(Thorne_pairs$`1` > 0))
  expect_true(all(Thorne_pairs$`2` > 0))
  
  trt_counts <- 
    Thorne_pairs %>%
    ungroup() %>%
    summarise_at(vars(`1`, `2`), sum)
  
  expect_identical(trt_counts$`1`, 384L)
  expect_identical(trt_counts$`2`, 392L)
  expect_identical(trt_counts$`1` + trt_counts$`2`, nrow(Thorne))
})