tests/testthat/test-helpers-data.R

In bmm: Easy and Accessible Bayesian Measurement Models Using 'brms'

test_that("check_data() produces expected errors and warnings", {
  expect_error(
    check_data(.model_mixture2p(resp_error = "y")),
    "Data must be specified using the 'data' argument."
  )
  expect_error(
    check_data(.model_mixture2p(resp_error = "y"), data.frame(), bmf(kappa ~ 1)),
    "Argument 'data' does not contain observations."
  )
  expect_error(
    check_data(.model_mixture2p(resp_error = "y"), data.frame(x = 1), bmf(kappa ~ 1)),
    "The response variable 'y' is not present in the data."
  )
  expect_error(
    check_data(.model_mixture2p(resp_error = "y"), y ~ 1),
    "Argument 'data' must be coercible to a data.frame."
  )

  mls <- lapply(c("mixture2p", "mixture3p", "imm"), get_model)
  for (ml in mls) {
    model <- ml(resp_error = "y", nt_features = "x", set_size = 2, nt_distances = "z")
    expect_warning(
      check_data(model, data.frame(y = 12, x = 1, z = 2), bmf(kappa ~ 1)),
      "It appears your response variable is in degrees.\n"
    )
    model <- ml(resp_error = "y", nt_features = "x", set_size = 2, nt_distances = "z")
    expect_silent(check_data(model, data.frame(y = 1, x = 1, z = 2), bmf(y ~ 1)))
  }

  mls <- lapply(c("mixture3p", "imm"), get_model)
  for (ml in mls) {
    model <- ml(resp_error = "y", nt_features = "x", set_size = 5, nt_distances = "z")
    expect_error(
      check_data(model, data.frame(y = 1, x = 1, z = 2), bmf(kappa ~ 1)),
      "'nt_features' should equal max\\(set_size\\)-1"
    )

    model <- ml(resp_error = "y", nt_features = "x", set_size = 2, nt_distances = "z")
    expect_warning(
      check_data(model, data.frame(y = 1, x = 2 * pi + 1, z = 2), bmf(kappa ~ 1)),
      "at least one of your non_target variables are in degrees"
    )
  }

  for (version in c("bsc", "full")) {
    ml <- imm(
      resp_error = "y", nt_features = paste0("x", 1:3), set_size = 4,
      nt_distances = "z", version = version
    )
    expect_error(
      check_data(ml, data.frame(y = 1, x1 = 1, x2 = 2, x3 = 3, z = 2), bmf(kappa ~ 1)),
      "'nt_distances' should equal max\\(set_size\\)-1"
    )
  }
})

test_that("check_var_set_size accepts valid input", {
  # Simple numeric vector is valid
  dat <- data.frame(y = rep(c(1, 2, 3), each = 3))
  expect_silent(check_var_set_size("y", dat))
  expect_equal(names(check_var_set_size("y", dat)), c("max_set_size", "ss_numeric"))
  expect_equal(check_var_set_size("y", dat)$max_set_size, 3)
  all(is.numeric(check_var_set_size("y", dat)$ss_numeric), na.rm = T)

  # Factor with numeric levels is valid
  dat <- data.frame(y = factor(rep(c(1, 2, 3), each = 3)))
  expect_silent(check_var_set_size("y", dat))
  expect_equal(check_var_set_size("y", dat)$max_set_size, 3)
  all(is.numeric(check_var_set_size("y", dat)$ss_numeric), na.rm = T)

  # Character vector representing numbers is valid
  dat <- data.frame(y = rep(c("1", "2", "3"), each = 3))
  expect_silent(check_var_set_size("y", dat))
  expect_equal(check_var_set_size("y", dat)$max_set_size, 3)
  all(is.numeric(check_var_set_size("y", dat)$ss_numeric), na.rm = T)

  # Numeric vector with NA values is valid (assuming NA is treated correctly)
  dat <- data.frame(y = rep(c(1, 5, NA), each = 3))
  expect_silent(check_var_set_size("y", dat))
  expect_equal(check_var_set_size("y", dat)$max_set_size, 5)
  all(is.numeric(check_var_set_size("y", dat)$ss_numeric), na.rm = T)

  # Factor with NA and numeric levels is valid
  dat <- data.frame(y = factor(rep(c(1, 5, NA), each = 3)))
  expect_silent(check_var_set_size("y", dat))
  expect_equal(check_var_set_size("y", dat)$max_set_size, 5)
  all(is.numeric(check_var_set_size("y", dat)$ss_numeric), na.rm = T)
})

test_that("check_var_set_size rejects invalid input", {
  # Factor with non-numeric levels is invalid
  dat <- data.frame(y = factor(rep(c("A", "B", "C"), each = 3)))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Character vector with non-numeric values is invalid
  dat <- data.frame(y = rep(c("A", "B", "C"), each = 3))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Character vector with NA and non-numeric values is invalid
  dat <- data.frame(y = rep(c("A", NA, "C"), each = 3))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Factor with NA and non-numeric levels is invalid
  dat <- data.frame(y = factor(rep(c("A", NA, "C"), each = 3)))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Character vector with numeric and non-numeric values is invalid
  dat <- data.frame(y = rep(c("A", 5, "C"), each = 3))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Factor with numeric and non-numeric levels is invalid
  dat <- data.frame(y = factor(rep(c("A", 5, "C"), each = 3)))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Numeric vector with invalid set sizes (less than 1) is invalid
  dat <- data.frame(y = rep(c(0, 1, 5), each = 3))
  expect_error(check_var_set_size("y", dat), "must be positive whole numbers")

  # Factor with levels less than 1 are invalid
  dat <- data.frame(y = factor(rep(c(0, 4, 5), each = 3)))
  expect_error(check_var_set_size("y", dat), "must be positive whole numbers")

  # Character vector representing set sizes with text is invalid
  dat <- data.frame(y = rep(paste0("set_size ", c(2, 3, 8)), each = 3))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Factor representing set sizes with text is invalid
  dat <- data.frame(y = factor(rep(paste0("set_size ", c(2, 3, 8)), each = 3)))
  expect_error(check_var_set_size("y", dat), "must be coercible to a numeric vector")

  # Numeric vector with decimals is invalid
  dat <- data.frame(y = c(1:8, 1.3))
  expect_error(check_var_set_size("y", dat), "must be positive whole numbers")

  # Setsize must be of length 1
  dat <- data.frame(y = c(1, 2, 3), z = c(1, 2, 3))
  expect_error(check_var_set_size(c("z", "y"), dat), "You provided a vector")
  expect_error(check_var_set_size(list("z", "y"), dat), "You provided a vector")
  expect_error(
    check_var_set_size(set_size = TRUE, dat),
    "must be either a variable in your data or a single numeric value"
  )
})

test_that("check_data() returns a data.frame()", {
  mls <- lapply(supported_models(print_call = FALSE), get_model)
  # test data includes variables for all model types:
  # - y, x, z, w, l, s for circular/mixture models
  # - mean_rt, var_rt, n_upper, n_trials for ezdm 3par
  # - mean_rt_upper/lower, var_rt_upper/lower for ezdm 4par
  # Use 50 rows to avoid small sample size warnings from cswald
  test_data <- data.frame(
    y = rep(1, 50), x = rep(1, 50), z = rep(2, 50), w = rep(1, 50), 
    s = rep(2, 50), l = rep(1, 50),
    mean_rt = rep(0.5, 50), var_rt = rep(0.02, 50), 
    n_upper = rep(80, 50), n_trials = rep(100, 50),
    mean_rt_upper = rep(0.45, 50), mean_rt_lower = rep(0.55, 50),
    var_rt_upper = rep(0.018, 50), var_rt_lower = rep(0.025, 50),
    rt = rep(0.6, 50), response = rep(1, 50)
  )
  for (ml in mls) {
    model <- ml(
      resp_error = "y", nt_features = "x", set_size = 2,
      nt_distances = "z", resp_cats = c("w", "l"), num_options = c(1, 1),
      mean_rt = "mean_rt", var_rt = "var_rt", n_upper = "n_upper",
      n_trials = "n_trials", rt = "rt", response = "response"
    )
    expect_s3_class(
      check_data(model, test_data, bmf(kappa ~ 1)),
      "data.frame"
    )
  }
})

test_that("wrap(x) returns the same for values between -pi and pi", {
  x <- runif(100, -pi, pi)
  expect_equal(wrap(x), x)
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("wrap(x) returns the correct value for values between (pi, 2*pi)", {
  x <- pi + 1
  expect_equal(wrap(x), -(pi - 1))
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("wrap(x) returns the correct value for values between (-2*pi, -pi)", {
  x <- -pi - 1
  expect_equal(wrap(x), pi - 1)
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("wrap(x) returns the correct value for values over 2*pi", {
  x <- 2 * pi + 1
  expect_equal(wrap(x), 1)
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("wrap(x) returns the correct value for values between (3*pi,4*pi)", {
  x <- 3 * pi + 1
  expect_equal(wrap(x), -(pi - 1))
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("deg2rad returns the correct values for 0, 180, 360", {
  x <- c(0, 90, 180)
  expect_equal(round(deg2rad(x), 2), c(0.00, 1.57, 3.14))
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("rad2deg returns the correct values for 0, pi/2, 2*pi", {
  x <- c(0, pi / 2, 2 * pi)
  expect_equal(round(rad2deg(x), 2), c(0, 90, 360))
  expect_equal(wrap(rad2deg(x), radians = F), rad2deg(wrap(x)))
})

test_that("standata() works with brmsformula", {
  ff <- brms::bf(count ~ zAge + zBase * Trt + (1 | patient))
  sd <- standata(ff, data = brms::epilepsy, family = poisson())
  expect_equal(class(sd)[1], "standata")
})

test_that("standata() works with formula", {
  ff <- count ~ zAge + zBase * Trt + (1 | patient)
  sd <- standata(ff, data = brms::epilepsy, family = poisson())
  expect_equal(class(sd)[1], "standata")
})

test_that("standata() works with bmf", {
  ff <- bmf(kappa ~ 1, thetat ~ 1, thetant ~ 1)
  dat <- oberauer_lin_2017
  sd <- standata(ff, dat, mixture3p(
    resp_error = "dev_rad",
    nt_features = "col_nt",
    set_size = "set_size", regex = T
  ))
  expect_equal(class(sd)[1], "standata")
})

test_that("standata() returns a standata class", {
  ff <- bmf(kappa ~ 1, thetat ~ 1, thetant ~ 1)
  dat <- data.frame(y = rmixture3p(n = 3), nt1_loc = 2, nt2_loc = -1.5)

  standata <- standata(ff, dat, mixture3p(
    resp_error = "y",
    nt_features = paste0("nt", 1, "_loc"),
    set_size = 2
  ))
  expect_equal(class(standata)[1], "standata")
})

# first draft of tests was written by ChatGPT4
test_that("has_nonconsecutive_duplicates works", {
  expect_false(has_nonconsecutive_duplicates(c("a", "a", "b", "b", "c", "c")))
  expect_true(has_nonconsecutive_duplicates(c("a", "b", "a", "c", "c", "b")))
  expect_false(has_nonconsecutive_duplicates(rep("a", 5)))
  expect_false(has_nonconsecutive_duplicates(letters[1:5]))
  expect_true(has_nonconsecutive_duplicates(c("a", "a", "b", "a", "b", "b")))
  expect_true(has_nonconsecutive_duplicates(c(1, 2, 3, 1, 4, 2)))
  expect_false(has_nonconsecutive_duplicates(numeric(0)))
  expect_false(has_nonconsecutive_duplicates(c("a")))
  expect_true(has_nonconsecutive_duplicates(c("a", "b", "b", "a")))
  expect_false(has_nonconsecutive_duplicates(c(NA, NA, NA)))
  expect_false(has_nonconsecutive_duplicates(c(NA, 1, NA)))
  expect_true(has_nonconsecutive_duplicates(c(1, "a", 2, "b", 1, NA, "a")))
  expect_true(has_nonconsecutive_duplicates(c("1", 2, "2", 1)))
})

test_that("is_data_ordered works", {
  # Test with a data frame that is ordered
  data1 <- expand.grid(y = 1:3, B = 1:3, C = 1:3)
  formula1 <- bmf(y ~ B + C)
  expect_true(is_data_ordered(data1, formula1))

  # Test with a data frame that is not ordered
  data2 <- rbind(data1, data1[1, ])
  expect_false(is_data_ordered(data2, formula1))

  # Test when irrelevant variables are not ordered but predictors are
  data3 <- data1
  data3$A <- c(3, 2, 2, 1, 2, 1, 3, 1, 3, 3, 1, 2, 2, 1, 1, 1, 3, 3, 1, 3, 2, 3, 1, 2, 3, 2, 2)
  formula2 <- bmf(y ~ A + B + C)
  expect_true(is_data_ordered(data3, formula1))
  expect_false(is_data_ordered(data3, formula2))

  # test with a complex formula with shared covariance structure across parameters
  data <- oberauer_lin_2017
  formula <- bmf(
    c ~ 0 + set_size + (0 + set_size | p1 | ID),
    kappa ~ 0 + set_size + (0 + set_size | p1 | ID)
  )
  expect_false(is_data_ordered(data, formula))

  data <- dplyr::arrange(data, set_size, ID)
  expect_true(is_data_ordered(data, formula))
})

test_that("is_data_ordered works when there is only one predictor", {
  # Test with a data frame that is ordered
  data <- data.frame(
    y = rep(1:3, each = 2),
    B = rep(1:3, each = 2),
    C = factor(rep(1:3, each = 2)),
    D = rep(1:3, times = 2),
    E = factor(rep(1:3, times = 2))
  )
  expect_true(is_data_ordered(data, y ~ B))

  # Test with a data frame that is not ordered
  expect_false(is_data_ordered(data, y ~ D))

  # Test with a data frame that is ordered and predictor is a factor
  expect_true(is_data_ordered(data, y ~ C))

  # Test with a data frame that is not ordered and predictor is a factor
  expect_false(is_data_ordered(data, y ~ E))
})

test_that("is_data_ordered works when there are no predictors", {
  # Test with a data frame that is ordered
  data <- data.frame(y = 1:3)
  expect_true(is_data_ordered(data, y ~ 1))
})

test_that("is_data_ordered works when there are non-linear predictors", {
  data <- data.frame(
    y = rep(1:3, each = 2),
    B = rep(1:3, each = 2),
    C = rep(1:3, times = 2)
  )
  # Test with a data frame that is ordered
  formula1 <- bmf(y ~ nlD, nlD ~ B)
  expect_true(is_data_ordered(data, formula1))

  # Test with a data frame that is not ordered
  formula2 <- bmf(y ~ nlD, nlD ~ C)
  expect_false(is_data_ordered(data, formula2))
})

############################################################################# !
# ezdm_summary_stats TESTS                                                ####
############################################################################# !

test_that("ezdm_summary_stats() returns 1-row data.frame for 3par version", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  result <- ezdm_summary_stats(rt, response, method = "simple")

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 1)
  expect_true(all(c(
    "mean_rt", "var_rt", "n_upper",
    "n_trials", "contaminant_prop"
  ) %in% names(result)))
  expect_type(result$mean_rt, "double")
  expect_type(result$var_rt, "double")
})

test_that("ezdm_summary_stats() returns 1-row data.frame for 4par version", {
  set.seed(123)
  rt <- rgamma(200, shape = 5, rate = 10) + 0.3
  response <- rbinom(200, 1, 0.7)

  result <- ezdm_summary_stats(rt, response, version = "4par", method = "simple")

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 1)
  expect_true(all(c(
    "mean_rt_upper", "mean_rt_lower",
    "var_rt_upper", "var_rt_lower", "n_upper", "n_trials",
    "contaminant_prop_upper", "contaminant_prop_lower"
  ) %in% names(result)))
})

test_that("ezdm_summary_stats() validates required arguments", {
  expect_error(
    ezdm_summary_stats(response = rbinom(10, 1, 0.5)),
    "required arguments are missing"
  )
  expect_error(
    ezdm_summary_stats(rt = rgamma(10, 5, 10)),
    "required arguments are missing"
  )
})

test_that("ezdm_summary_stats() validates rt is numeric", {
  expect_error(
    ezdm_summary_stats(rt = "not_numeric", response = c(1, 0)),
    "must be a numeric vector"
  )
  expect_error(
    ezdm_summary_stats(rt = numeric(0), response = numeric(0)),
    "has length 0"
  )
})

test_that("ezdm_summary_stats() validates rt and response have same length", {
  expect_error(
    ezdm_summary_stats(rt = c(0.5, 0.6), response = c(1, 0, 1)),
    "must have the same length"
  )
})

test_that("ezdm_summary_stats() validates parameter options", {
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  expect_error(ezdm_summary_stats(rt, response, version = "5par"), "should be one of")
  expect_error(ezdm_summary_stats(rt, response, distribution = "normal"), "should be one of")
  expect_error(ezdm_summary_stats(rt, response, method = "invalid"), "should be one of")
  expect_error(
    ezdm_summary_stats(rt, response, method = "robust", robust_scale = "invalid"),
    "should be one of"
  )
})

test_that("ezdm_summary_stats() warns for potential data issues", {
  rt_ms <- rgamma(100, shape = 5, rate = 10) * 1000
  response <- rbinom(100, 1, 0.8)

  expect_warning(
    ezdm_summary_stats(rt_ms, response, method = "simple"),
    "Some RT values > 10. Ensure RTs are in seconds"
  )
})

test_that("ezdm_summary_stats() errors for non-positive RT values", {
  rt <- c(-0.1, 0, rgamma(98, shape = 5, rate = 10) + 0.3)
  response <- rbinom(100, 1, 0.8)

  expect_error(
    ezdm_summary_stats(rt, response, method = "simple"),
    "Non-positive RT values found"
  )
})

test_that("ezdm_summary_stats() handles too few trials", {
  set.seed(123)
  rt <- rgamma(5, shape = 5, rate = 10) + 0.3
  response <- rbinom(5, 1, 0.8)

  result <- ezdm_summary_stats(rt, response, method = "simple", min_trials = 10)

  expect_true(is.na(result$mean_rt))
  expect_true(is.na(result$var_rt))
  expect_equal(result$n_trials, 5)
})

test_that("ezdm_summary_stats() simple method matches mean() and var()", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  result <- ezdm_summary_stats(rt, response, method = "simple")

  expect_equal(result$mean_rt, mean(rt), tolerance = 1e-10)
  expect_equal(result$var_rt, var(rt), tolerance = 1e-10)
  expect_equal(result$n_trials, 100L)
  expect_equal(result$n_upper, sum(response == 1))
})

test_that("ezdm_summary_stats() robust method uses median and IQR/MAD", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  result_iqr <- ezdm_summary_stats(rt, response,
    method = "robust", robust_scale = "iqr"
  )
  expect_equal(result_iqr$mean_rt, median(rt), tolerance = 1e-10)
  expect_equal(result_iqr$var_rt, (IQR(rt) / 1.349)^2, tolerance = 1e-10)
  expect_true(is.na(result_iqr$contaminant_prop))

  result_mad <- ezdm_summary_stats(rt, response,
    method = "robust", robust_scale = "mad"
  )
  expect_equal(result_mad$mean_rt, median(rt), tolerance = 1e-10)
  expect_equal(result_mad$var_rt, mad(rt)^2, tolerance = 1e-10)
})

test_that("ezdm_summary_stats() robust method is resistant to outliers", {
  # Fixed data: 90 values tightly around 0.5 + 10 extreme outliers
  clean_rt <- seq(0.4, 0.6, length.out = 90)
  outliers <- c(0.05, 0.08, 2.5, 3.0, 3.5, 4.0, 5.0, 6.0, 7.0, 8.0)
  rt <- c(clean_rt, outliers)
  response <- c(rep(1, 80), rep(0, 20))

  result_simple <- ezdm_summary_stats(rt, response, method = "simple")
  result_robust <- ezdm_summary_stats(rt, response, method = "robust")

  true_median_clean <- median(clean_rt)
  expect_true(
    abs(result_robust$mean_rt - true_median_clean) <
      abs(result_simple$mean_rt - true_median_clean)
  )
})

test_that("ezdm_summary_stats() mixture method works with different distributions", {
  set.seed(123)
  rt <- rgamma(200, shape = 5, rate = 10) + 0.3
  response <- rbinom(200, 1, 0.8)

  for (dist in c("exgaussian", "lognormal", "invgaussian")) {
    result <- ezdm_summary_stats(rt, response,
      distribution = dist, method = "mixture"
    )
    expect_s3_class(result, "data.frame")
    expect_true(is.numeric(result$mean_rt))
    expect_true(is.numeric(result$var_rt))
    expect_true(is.numeric(result$contaminant_prop))
  }
})

test_that("ezdm_summary_stats() 4par handles all correct or all errors", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3

  result <- ezdm_summary_stats(rt, rep(1, 100),
    version = "4par", method = "simple", min_trials = 10
  )
  expect_false(is.na(result$mean_rt_upper))
  expect_true(is.na(result$mean_rt_lower))

  result2 <- ezdm_summary_stats(rt, rep(0, 100),
    version = "4par", method = "simple", min_trials = 10
  )
  expect_true(is.na(result2$mean_rt_upper))
  expect_false(is.na(result2$mean_rt_lower))
})

test_that("ezdm_summary_stats() validates contaminant_bound", {
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  expect_error(
    ezdm_summary_stats(rt, response, contaminant_bound = c(3.0, 0.1)),
    "contaminant_bound\\[1\\] must be less than"
  )
  expect_error(
    ezdm_summary_stats(rt, response, contaminant_bound = c(0.1)),
    "contaminant_bound must be a vector of length 2"
  )
  expect_error(
    ezdm_summary_stats(rt, response, contaminant_bound = c("invalid", 3.0)),
    "contaminant_bound elements must be numeric or"
  )
})

test_that("ezdm_summary_stats() accepts 'min' and 'max' for contaminant_bound", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  expect_no_error(result <- ezdm_summary_stats(rt, response,
    contaminant_bound = c("min", "max")
  ))
  expect_true(is.data.frame(result))

  expect_no_error(ezdm_summary_stats(rt, response,
    contaminant_bound = c(0.1, "max")
  ))
  expect_no_error(ezdm_summary_stats(rt, response,
    contaminant_bound = c("min", 3.0)
  ))
  expect_no_error(ezdm_summary_stats(rt, response,
    contaminant_bound = c("MIN", "MAX")
  ))
})

test_that("ezdm_summary_stats() validates init_contaminant", {
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  expect_error(
    ezdm_summary_stats(rt, response, init_contaminant = 0),
    "init_contaminant must be between 0 and 1"
  )
  expect_error(
    ezdm_summary_stats(rt, response, init_contaminant = 1),
    "init_contaminant must be between 0 and 1"
  )
})

test_that("ezdm_summary_stats() validates max_contaminant", {
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  expect_error(ezdm_summary_stats(rt, response, max_contaminant = 0),
    "max_contaminant must be between 0")
  expect_error(ezdm_summary_stats(rt, response, max_contaminant = 1.5),
    "max_contaminant must be between 0")
  expect_error(ezdm_summary_stats(rt, response, max_contaminant = -0.1),
    "max_contaminant must be between 0")
  expect_no_error(ezdm_summary_stats(rt, response,
    max_contaminant = 1, method = "simple"
  ))
})

test_that("ezdm_summary_stats() validates init < max contaminant", {
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- rbinom(100, 1, 0.8)

  expect_error(
    ezdm_summary_stats(rt, response, init_contaminant = 0.3, max_contaminant = 0.2),
    "init_contaminant must be less than max_contaminant"
  )
  expect_error(
    ezdm_summary_stats(rt, response, init_contaminant = 0.5, max_contaminant = 0.5),
    "init_contaminant must be less than max_contaminant"
  )
})

test_that("ezdm_summary_stats() clips contaminant proportion to max", {
  # Fixed data: 50 legitimate RTs tightly clustered + 50 uniform contaminants
  # ensures the EM finds a large contaminant proportion that must be clipped
  rt <- c(rep(0.5, 25), rep(0.6, 25), seq(0.1, 5.0, length.out = 50))
  response <- rep(c(1, 0), 50)

  result <- suppressWarnings(
    ezdm_summary_stats(rt, response, max_contaminant = 0.3)
  )
  expect_true(result$contaminant_prop <= 0.3)

  result_strict <- suppressWarnings(
    ezdm_summary_stats(rt, response, max_contaminant = 0.1)
  )
  expect_true(result_strict$contaminant_prop <= 0.1)
})

test_that("ezdm_summary_stats() warns when contaminant proportion is clipped", {
  # Fixed data: tight cluster + spread-out values forces clipping at 0.1
  rt <- c(rep(0.5, 25), rep(0.6, 25), seq(0.1, 5.0, length.out = 50))
  response <- rep(c(1, 0), 50)

  expect_warning(
    ezdm_summary_stats(rt, response, max_contaminant = 0.1),
    "clipped to max_contaminant"
  )
})

test_that("ezdm_summary_stats() max_contaminant works with 4par version", {
  # Fixed data: tight clusters + spread-out contaminants per response group
  rt <- c(
    rep(0.5, 30), rep(0.6, 30), seq(0.1, 5.0, length.out = 20),
    rep(0.5, 30), rep(0.6, 30), seq(0.1, 5.0, length.out = 20)
  )
  response <- c(rep(1, 80), rep(0, 80))

  result <- suppressWarnings(
    ezdm_summary_stats(rt, response, version = "4par", max_contaminant = 0.2)
  )

  expect_true(is.na(result$contaminant_prop_upper) ||
    result$contaminant_prop_upper <= 0.2)
  expect_true(is.na(result$contaminant_prop_lower) ||
    result$contaminant_prop_lower <= 0.2)
})

test_that("ezdm_summary_stats() handles character responses", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- sample(c("upper", "lower"), 100, replace = TRUE, prob = c(0.8, 0.2))

  result <- ezdm_summary_stats(rt, response, method = "simple")

  expect_equal(result$n_upper, sum(response == "upper"))
  expect_equal(result$n_trials, 100L)
})

test_that("ezdm_summary_stats() handles factor responses", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- factor(sample(c("upper", "lower"), 100, replace = TRUE, prob = c(0.8, 0.2)))

  result <- ezdm_summary_stats(rt, response, method = "simple")
  expect_equal(result$n_upper, sum(response == "upper"))
})

test_that("ezdm_summary_stats() handles correct/error and logical responses", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3

  response_ce <- sample(c("correct", "error"), 100, replace = TRUE, prob = c(0.8, 0.2))
  result_ce <- ezdm_summary_stats(rt, response_ce, method = "simple")
  expect_equal(result_ce$n_upper, sum(response_ce == "correct"))

  response_lgl <- sample(c(TRUE, FALSE), 100, replace = TRUE, prob = c(0.8, 0.2))
  result_lgl <- ezdm_summary_stats(rt, response_lgl, method = "simple")
  expect_equal(result_lgl$n_upper, sum(response_lgl))
})

test_that("ezdm_summary_stats() handles case-insensitive responses", {
  set.seed(123)
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- sample(c("UPPER", "Lower", "UpPeR", "LOWER"), 100, replace = TRUE)

  result <- ezdm_summary_stats(rt, response, method = "simple")
  expect_equal(result$n_upper, sum(tolower(response) == "upper"))
})

test_that("ezdm_summary_stats() errors on unrecognized response values", {
  rt <- rgamma(100, shape = 5, rate = 10) + 0.3
  response <- sample(c("fast", "slow"), 100, replace = TRUE)

  expect_error(
    ezdm_summary_stats(rt, response),
    "Unrecognized response values"
  )
})

test_that("ezdm_summary_stats() 4par version works with character responses", {
  set.seed(123)
  rt <- rgamma(200, shape = 5, rate = 10) + 0.3
  response <- sample(c("upper", "lower"), 200, replace = TRUE, prob = c(0.7, 0.3))

  result <- ezdm_summary_stats(rt, response, version = "4par", method = "simple")

  expect_true(all(c(
    "mean_rt_upper", "mean_rt_lower", "var_rt_upper", "var_rt_lower"
  ) %in% names(result)))
  expect_equal(result$n_upper, sum(response == "upper"))
  expect_false(is.na(result$mean_rt_upper))
  expect_false(is.na(result$mean_rt_lower))
})

test_that("ezdm_summary_stats() handles NAs in rt", {
  set.seed(123)
  rt <- c(rgamma(90, shape = 5, rate = 10) + 0.3, rep(NA, 10))
  response <- rbinom(100, 1, 0.8)

  result <- ezdm_summary_stats(rt, response, method = "simple")

  expect_equal(result$n_trials, 90L)
  expect_equal(result$mean_rt, mean(rt, na.rm = TRUE), tolerance = 1e-10)
})

test_that("ezdm_summary_stats() works with dplyr::reframe()", {
  skip_if_not_installed("dplyr")
  set.seed(123)
  test_data <- data.frame(
    subject = rep(1:3, each = 50),
    rt = rgamma(150, shape = 5, rate = 10) + 0.3,
    correct = rbinom(150, 1, 0.8)
  )

  result <- dplyr::group_by(test_data, subject) |>
    dplyr::reframe(ezdm_summary_stats(rt, correct, method = "simple"))

  expect_equal(nrow(result), 3)
  expect_true(all(c("subject", "mean_rt", "var_rt", "n_upper", "n_trials") %in%
    names(result)))
})

############################################################################# !
# adjust_ezdm_accuracy TESTS                                              ####
############################################################################# !

test_that("adjust_ezdm_accuracy() returns 1-row data.frame", {
  set.seed(42)
  result <- adjust_ezdm_accuracy(80, 100, 0.1)

  expect_s3_class(result, "data.frame")
  expect_equal(nrow(result), 1)
  expect_true(all(c("n_upper_adj", "n_trials_adj") %in% names(result)))
})

test_that("adjust_ezdm_accuracy() returns integer values", {
  set.seed(42)
  result <- adjust_ezdm_accuracy(80, 100, 0.1)

  expect_type(result$n_upper_adj, "integer")
  expect_type(result$n_trials_adj, "integer")
  expect_true(result$n_upper_adj >= 0)
  expect_true(result$n_upper_adj <= result$n_trials_adj)
  expect_true(result$n_trials_adj <= 100)
})

test_that("adjust_ezdm_accuracy() handles NA contaminant_prop", {
  result <- adjust_ezdm_accuracy(80, 100, NA)

  expect_equal(result$n_upper_adj, 80L)
  expect_equal(result$n_trials_adj, 100L)
})

test_that("adjust_ezdm_accuracy() handles zero contaminant_prop", {
  result <- adjust_ezdm_accuracy(80, 100, 0)

  expect_equal(result$n_upper_adj, 80L)
  expect_equal(result$n_trials_adj, 100L)
})

test_that("adjust_ezdm_accuracy() validates inputs", {
  expect_error(adjust_ezdm_accuracy("a", 100, 0.1), "n_upper must be numeric")
  expect_error(adjust_ezdm_accuracy(80, "b", 0.1), "n_trials must be numeric")
  expect_error(adjust_ezdm_accuracy(80, 100, 0.1, guess_rate = -0.1),
    "guess_rate must be between 0 and 1")
  expect_error(adjust_ezdm_accuracy(80, 100, 0.1, guess_rate = 1.5),
    "guess_rate must be between 0 and 1")
})

############################################################################# !
# FLAG_CONTAMINANT_RTS TESTS                                              ####
############################################################################# !

# Helper to create test RT vector with known contaminants (deterministic)
.create_test_rt_vec <- function(n = 100, add_contaminants = TRUE, prop_contam = 0.1) {
  if (add_contaminants) {
    n_legit <- floor((1 - prop_contam) * n)
    n_contam <- n - n_legit
    c(seq(0.3, 1.5, length.out = n_legit), seq(0.05, 0.15, length.out = n_contam))
  } else {
    seq(0.2, 1.5, length.out = n)
  }
}

# Section 1: Return Structure Tests ------------------------------------------

test_that("flag_contaminant_rts() returns numeric vector", {
  rt <- .create_test_rt_vec(n = 100)

  result <- flag_contaminant_rts(rt)

  expect_type(result, "double")
  expect_equal(length(result), 100)
})

test_that("flag_contaminant_rts() attaches diagnostics attribute", {
  rt <- .create_test_rt_vec(n = 100)

  result <- flag_contaminant_rts(rt)
  diag <- attr(result, "diagnostics")

  expect_s3_class(diag, "data.frame")
  expect_equal(nrow(diag), 1)
  expect_true(all(
    c("mixture_params", "contaminant_prop", "converged") %in% names(diag)
  ))
  expect_type(diag$contaminant_prop, "double")
  expect_type(diag$converged, "logical")
})

# Section 2: Argument Validation Tests ---------------------------------------

test_that("flag_contaminant_rts() validates rt is numeric", {
  expect_error(
    flag_contaminant_rts(rt = "not_numeric"),
    "must be a numeric vector"
  )
})

test_that("flag_contaminant_rts() validates rt is non-empty", {
  expect_error(
    flag_contaminant_rts(rt = numeric(0)),
    "has length 0"
  )
})

test_that("flag_contaminant_rts() warns for RTs > 10", {
  rt <- c(15, 20, 25, 0.5, 0.6, 0.7, 0.8, 0.9)

  expect_warning(
    expect_warning(
      flag_contaminant_rts(rt),
      "Some RT values > 10"
    ),
    "clipped to max_contaminant"
  )
})

test_that("flag_contaminant_rts() warns when lower bound > min RT", {
  rt <- c(0.1, 0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0)

  expect_warning(
    flag_contaminant_rts(rt, contaminant_bound = c(0.3, "max")),
    "Lower contaminant bound.*greater than the minimum observed RT"
  )
})

test_that("flag_contaminant_rts() warns when upper bound < max RT", {
  rt <- c(0.3, 0.4, 0.5, 0.6, 0.7, 0.8, 0.9, 1.0, 1.5, 2.0)

  expect_warning(
    expect_warning(
      flag_contaminant_rts(rt, contaminant_bound = c("min", 1.0)),
      "Upper contaminant bound.*less than the maximum observed RT"
    ),
    "EM did not converge"
  )
})

test_that("flag_contaminant_rts() errors for non-positive RTs", {
  rt <- c(-0.1, -0.2, 0.3, 0.5, 0.6, 0.7, 0.8, 0.9)

  expect_error(
    flag_contaminant_rts(rt),
    "Non-positive RT values found"
  )
})

# Section 3: NA Handling Tests ------------------------------------------------

test_that("flag_contaminant_rts() preserves NAs in output", {
  rt <- c(0.3, 0.4, NA, 0.5, 0.6, NA, 0.7, 0.8, 0.9, 1.0,
          0.35, 0.45, 0.55, 0.65, 0.75, 0.85, 0.95, 1.1, 1.2, 1.3)

  result <- flag_contaminant_rts(rt)

  expect_equal(length(result), length(rt))
  expect_true(is.na(result[3]))
  expect_true(is.na(result[6]))
  expect_true(all(!is.na(result[!is.na(rt)])))
})

# Section 4: Distribution Tests -----------------------------------------------

test_that("flag_contaminant_rts() works with different distributions", {
  rt <- .create_test_rt_vec()

  result_exg <- flag_contaminant_rts(rt, distribution = "exgaussian")
  result_lnorm <- flag_contaminant_rts(rt, distribution = "lognormal")
  result_invg <- flag_contaminant_rts(rt, distribution = "invgaussian")

  diag_exg <- attr(result_exg, "diagnostics")
  diag_lnorm <- attr(result_lnorm, "diagnostics")
  diag_invg <- attr(result_invg, "diagnostics")

  expect_equal(diag_exg$distribution, "exgaussian")
  expect_equal(diag_lnorm$distribution, "lognormal")
  expect_equal(diag_invg$distribution, "invgaussian")

  expect_true(diag_exg$converged)
  expect_true(diag_lnorm$converged)
  expect_true(diag_invg$converged)
})

# Section 5: Detection Quality Tests ------------------------------------------

test_that("flag_contaminant_rts() detects simulated contaminants", {
  # Fixed data: tight legitimate cluster around 0.5-1.0, contaminants at 5-10
  # The separation is large enough that the mixture model must assign higher
  # contamination probability to the extreme values
  rt_legit <- seq(0.4, 1.2, length.out = 80)
  rt_contam <- seq(5, 10, length.out = 20)
  rt <- c(rt_legit, rt_contam)
  is_contam <- c(rep(FALSE, 80), rep(TRUE, 20))

  result <- flag_contaminant_rts(rt)

  mean_prob_contam <- mean(result[is_contam])
  mean_prob_legit <- mean(result[!is_contam])

  expect_true(mean_prob_contam > mean_prob_legit)
})

test_that("flag_contaminant_rts() contamination probabilities are in valid range", {
  rt <- .create_test_rt_vec()

  result <- flag_contaminant_rts(rt)

  expect_true(all(result >= 0 & result <= 1, na.rm = TRUE))
})

# Section 6: Diagnostics Content Tests ----------------------------------------

test_that("flag_contaminant_rts() diagnostics contain mixture parameters", {
  rt <- .create_test_rt_vec()

  result <- flag_contaminant_rts(rt)
  diag <- attr(result, "diagnostics")

  expect_true("mixture_params" %in% names(diag))
  expect_type(diag$mixture_params, "list")

  params <- diag$mixture_params[[1]]
  expect_true(all(c("mu", "sigma", "tau") %in% names(params)))
})

test_that("flag_contaminant_rts() diagnostics report convergence correctly", {
  rt <- .create_test_rt_vec()

  result <- flag_contaminant_rts(rt)
  diag <- attr(result, "diagnostics")

  expect_true("converged" %in% names(diag))
  expect_type(diag$converged, "logical")
  expect_true("iterations" %in% names(diag))
  expect_type(diag$iterations, "integer")

  if (diag$converged) {
    expect_true("loglik" %in% names(diag))
    expect_false(is.na(diag$loglik))
  }
})

test_that("flag_contaminant_rts() diagnostics track trial counts", {
  rt <- .create_test_rt_vec(n = 150)

  result <- flag_contaminant_rts(rt)
  diag <- attr(result, "diagnostics")

  expect_equal(diag$n_trials, 150)
})

# Section 7: Small Input Tests ------------------------------------------------

test_that("flag_contaminant_rts() handles small inputs gracefully", {
  rt <- c(0.5, 0.6, 0.7)

  result <- suppressWarnings(flag_contaminant_rts(rt))

  expect_type(result, "double")
  expect_equal(length(result), 3)
})