tests/testthat/test-public-api-cleanup.R

In dyadMLM: Tools for Dyadic Multilevel Models

collision_test_data <- function() {
  data <- expand.grid(
    time = 1:2,
    member_id = c("a", "b"),
    dyad_id = 1:2,
    KEEP.OUT.ATTRS = FALSE
  )
  data$role <- ifelse(data$member_id == "a", "first", "second")
  data$x <- seq_len(nrow(data))
  data$x_cwp <- data$x + 10
  data$x_cbp <- data$x + 20
  data$x_actor <- data$x + 30
  data
}

test_that("the public API and metadata use only the cleaned names", {
  expect_setequal(
    getNamespaceExports("dyadMLM"),
    c(
      "prepare_dyad_data",
      "compare_nested_models",
      "recover_exchangeable_covariance",
      "simulate_dyad_responses",
      "check_partner_dependence",
      "check_dyad_residuals",
      "check_dyad_outcomes"
    )
  )
  expect_false(exists(
    "compare_nested_glmmTMB_models",
    envir = asNamespace("dyadMLM"),
    inherits = FALSE
  ))

  prepare_arguments <- names(formals(prepare_dyad_data))
  expect_true(all(c(
    "dyad", "lag1_predictors", "model_types", "temporal_decomposition",
    "keep_compositions", "include_arbitrary_member_contrast"
  ) %in% prepare_arguments))
  expect_false(any(c(
    "group", "lag_predictors", "model_type",
    "temporal_predictor_decomposition", "include_compositions"
  ) %in% prepare_arguments))

  covariance_arguments <- names(formals(recover_exchangeable_covariance))
  expect_true(all(c("block_pairings", "posterior") %in% covariance_arguments))
  expect_false("pairs" %in% covariance_arguments)

  print_arguments <- names(formals(print.exchangeable_covariance))
  expect_true("representation" %in% print_arguments)
  expect_false("what" %in% print_arguments)

  data <- collision_test_data()
  prepared <- prepare_dyad_data(
    data,
    dyad = dyad_id,
    member = member_id,
    time = time,
    predictors = x,
    lag1_predictors = x,
    model_types = "apim",
    temporal_decomposition = "2l",
    seed = 1
  )
  meta <- attr(prepared, "dyadMLM")
  expect_true(all(c(
    "dyad", "lag1_predictors", "model_types", "temporal_decomposition",
    "temporal_decompositions"
  ) %in% names(meta)))
  expect_false(any(c(
    "group", "lag_predictors", "model_type",
    "temporal_predictor_decomposition", "temporal_predictor_decompositions"
  ) %in% names(meta)))
  expect_true("temporal_decomposition" %in% names(meta$temporal_decompositions))
})

test_that("APIM collision preflight is complete and predictor-order independent", {
  data <- collision_test_data()

  for (selected in list(c("x", "x_cwp"), c("x_cwp", "x"),
                        c("x", "x_cbp"), c("x_cbp", "x"))) {
    expect_error(
      prepare_dyad_data(
        data,
        dyad = dyad_id,
        member = member_id,
        time = time,
        predictors = tidyselect::all_of(selected),
        model_types = "apim"
      ),
      "Generated-column collision.*predictor.*temporal component.*lag 0.*model family `apim`.*column role",
      fixed = FALSE
    )
  }
})

test_that("DIM and DSM collision preflights cover suffixes and predictor order", {
  data <- collision_test_data()

  collision_cases <- list(
    list(
      predictors = c("x", "x_cwp"),
      target = ".x_cwp_within_dyad_dev"
    ),
    list(
      predictors = c("x_cwp", "x"),
      target = ".x_cwp_within_dyad_dev"
    ),
    list(
      predictors = c("x", "x_cbp"),
      target = ".x_cbp_within_dyad_dev"
    ),
    list(
      predictors = c("x_cbp", "x"),
      target = ".x_cbp_within_dyad_dev"
    )
  )

  for (collision_case in collision_cases) {
    selected <- collision_case$predictors
    error <- tryCatch(
      prepare_dyad_data(
        data,
        dyad = dyad_id,
        member = member_id,
        time = time,
        predictors = tidyselect::all_of(selected),
        model_types = "dim"
      ),
      error = identity
    )
    message <- conditionMessage(error)
    expect_match(message, collision_case$target, fixed = TRUE)
    expect_match(message, "model family `dim`", fixed = TRUE)
    for (predictor in unique(selected)) {
      expect_match(message, paste0("predictor `", predictor, "`"), fixed = TRUE)
    }
  }

  for (collision_case in collision_cases) {
    selected <- collision_case$predictors
    error <- tryCatch(
      prepare_dyad_data(
        data,
        dyad = dyad_id,
        member = member_id,
        role = role,
        time = time,
        predictors = tidyselect::all_of(selected),
        model_types = "dsm",
        dsm_role_order = c("first", "second")
      ),
      error = identity
    )
    message <- conditionMessage(error)
    expect_match(message, collision_case$target, fixed = TRUE)
    expect_match(message, "model family `dsm`", fixed = TRUE)
    for (predictor in unique(selected)) {
      expect_match(message, paste0("predictor `", predictor, "`"), fixed = TRUE)
    }
  }
})

test_that("lag collisions with earlier generated columns are rejected", {
  data <- collision_test_data()
  expect_error(
    prepare_dyad_data(
      data,
      dyad = dyad_id,
      member = member_id,
      time = time,
      predictors = c(x, x_actor),
      lag1_predictors = c(x, x_actor),
      model_types = "apim"
    ),
    paste0(
      "`.x_actor_lag1`.*predictor `x`.*lag 1.*model family `apim`.*",
      "predictor `x_actor`.*lag 1.*model family `temporal`"
    ),
    fixed = FALSE
  )
})

test_that("generated names must be syntactically valid in formulas", {
  data <- collision_test_data()
  names(data)[names(data) == "x"] <- "1x"

  expect_error(
    prepare_dyad_data(
      data,
      dyad = dyad_id,
      member = member_id,
      time = time,
      predictors = tidyselect::all_of("1x"),
      model_types = "apim",
      temporal_decomposition = "none"
    ),
    "Generated column name `.1x_actor` is not syntactically valid in R.*Rename",
    fixed = FALSE
  )
})

test_that("collision ownership uses the registry, not a name prefix", {
  data <- tibble::tibble(
    x = 1,
    generated_short = 1,
    original_short = 1
  )

  generated_plan <- tibble::tibble(
    target = "generated_short",
    predictor = "x",
    temporal_component = "raw",
    lag = 0L,
    model_family = "apim",
    column_role = "actor",
    variable_role = "predictor",
    source_column = "x"
  )
  data <- record_generated_columns(data, generated_plan)

  proposed_plan <- generated_plan
  proposed_plan$model_family <- "temporal"
  proposed_plan$column_role <- "temporal_component"

  expect_error(
    validate_generated_column_plan(data, proposed_plan),
    paste0(
      "`generated_short`.*model family `temporal`.*",
      "model family `apim`.*column role `actor`"
    )
  )

  proposed_plan$target <- "original_short"
  expect_error(
    validate_generated_column_plan(data, proposed_plan),
    paste0(
      "`original_short`.*model family `temporal`.*",
      "model family `input`.*column role `original`"
    )
  )
})

test_that("composition columns cannot overwrite input columns", {
  original_data <- data.frame(
    dyad_id = c(1, 1, 2, 2),
    member_id = c("a", "b", "c", "d")
  )

  for (column_name in c(".composition", ".composition_role")) {
    data <- original_data
    data[[column_name]] <- "original"

    expect_error(
      prepare_dyad_data(
        data,
        dyad = dyad_id,
        member = member_id,
        model_types = "none"
      ),
      paste0(
        "Generated-column collision for `", column_name, "`.*",
        "model family `composition`.*model family `input`"
      ),
      fixed = FALSE
    )
  }
})

test_that("predictor columns cannot overwrite composition columns", {
  data <- data.frame(
    dyad_id = rep(1:2, each = 2),
    member_id = rep(c("a", "b"), 2),
    role = rep(c("actor", "f"), 2),
    is = 1:4
  )
  collision_name <- paste0(dyad_retained_prefix, "is_actor")

  expect_error(
    prepare_dyad_data(
      data,
      dyad = dyad_id,
      member = member_id,
      role = role,
      predictors = is,
      model_types = "apim"
    ),
    paste0(
      "`", collision_name, "`.*predictor `is`.*",
      "model family `apim`.*model family `composition`"
    ),
    fixed = FALSE
  )
})