tests/testthat/test-er-plot-api.R

In erplots: Model-Agnostic Exposure-Response Plots

test_that("er_plot creates an er_plot (minimal)", {
  expect_no_error(er_plot(er_test_data, aucss, ae1))
  plt <- er_plot(er_test_data, aucss, ae1)
  expect_s3_class(plt, "er_plot")
})

test_that("er_plot errors clearly when exposure/response/stratify_by name nonexistent columns", {
  expect_error(er_plot(er_test_data, not_a_col, ae1), "not_a_col")
  expect_error(er_plot(er_test_data, aucss, not_a_col), "not_a_col")
  expect_error(er_plot(er_test_data, aucss, ae1, stratify_by = not_a_col), "not_a_col")

  # multiple missing columns are all named in one error
  expect_error(er_plot(er_test_data, not_a_col1, not_a_col2), "not_a_col1.*not_a_col2")
})

test_that("er_plot errors clearly when stratify_by is numeric, rather than silently mismapping it", {
  # previously silent: a numeric stratify_by mapped straight to a
  # continuous colour scale (`color = .data[[strata$name]]`), breaking
  # every stratified builder's discrete-groups assumption, with no error
  # and no `object$strata$type` field even existing to detect it
  expect_error(er_plot(er_test_data, aucss, ae1, stratify_by = weight), "must be discrete")
})

test_that("er_plot errors clearly when exposure is not numeric", {
  df_factor <- er_test_data
  df_factor$aucss <- factor(round(df_factor$aucss / 50))
  expect_error(er_plot(df_factor, aucss, ae1), "must be numeric")

  df_char <- er_test_data
  df_char$aucss <- as.character(df_char$aucss)
  expect_error(er_plot(df_char, aucss, ae1), "must be numeric")

  df_logical <- er_test_data
  df_logical$aucss <- df_logical$aucss > 20
  expect_error(er_plot(df_logical, aucss, ae1), "must be numeric")

  # response is unaffected by this check -- a logical/binary response
  # remains valid
  expect_no_error(er_plot(er_test_data, aucss, ae1))
})

test_that("er_plot warns when a declared binary response has values outside {0, 1}", {
  df_bad <- er_test_data
  df_bad$ae1[1:3] <- 2

  expect_warning(
    er_plot(df_bad, aucss, ae1, response_type = "binary"),
    "outside \\{0, 1\\}"
  )
  expect_warning(
    er_plot(df_bad, aucss, ae1, response_type = "binary"),
    "3 values"
  )

  # `response_type = "auto"` never triggers this warning -- it wouldn't
  # have resolved to "binary" in the first place if values fell outside
  # {0, 1}
  expect_no_warning(er_plot(df_bad, aucss, ae1))
  plt_auto <- er_plot(df_bad, aucss, ae1)
  expect_equal(plt_auto$response$type, "continuous")

  # a clean binary response (0/1 or logical) never warns
  expect_no_warning(er_plot(er_test_data, aucss, ae1, response_type = "binary"))
  df_logical <- er_test_data
  df_logical$ae1 <- as.logical(df_logical$ae1)
  expect_no_warning(er_plot(df_logical, aucss, ae1, response_type = "binary"))
})

test_that("er_plot errors when a declared count response has negative values", {
  df_neg <- er_test_data
  df_neg$ae_count[1:3] <- df_neg$ae_count[1:3] - 100  # force negative

  expect_error(
    er_plot(df_neg, aucss, ae_count, response_type = "count"),
    "3 values"
  )
  expect_error(
    er_plot(df_neg, aucss, ae_count, response_type = "count"),
    "negative"
  )

  # a clean, non-negative count response never errors
  expect_no_error(er_plot(er_test_data, aucss, ae_count, response_type = "count"))

  # response_type = "continuous"/"auto" are unaffected by this check --
  # it only applies to an explicitly declared "count" response
  expect_no_error(er_plot(df_neg, aucss, ae_count, response_type = "continuous"))
  expect_no_error(er_plot(df_neg, aucss, ae_count))
})

test_that("er_plot resolves response_type = 'auto' correctly", {
  plt_binary <- er_plot(er_test_data, aucss, ae1)
  expect_equal(plt_binary$response$type, "binary")
  expect_equal(plt_binary$response$limits, c(0, 1))

  plt_continuous <- er_plot(er_test_data, aucss, biomarker_change)
  expect_equal(plt_continuous$response$type, "continuous")
  expect_equal(
    plt_continuous$response$limits,
    range(er_test_data$biomarker_change, na.rm = TRUE)
  )
})

test_that("er_plot's response_type argument overrides auto-detection", {
  # a 0/1 response explicitly declared continuous
  plt <- er_plot(er_test_data, aucss, ae1, response_type = "continuous")
  expect_equal(plt$response$type, "continuous")
  expect_equal(plt$response$limits, range(er_test_data$ae1, na.rm = TRUE))

  expect_error(er_plot(er_test_data, aucss, ae1, response_type = "nope"))
})

test_that("er_plot_add_quantiles supports both binary and continuous responses", {
  # continuous response: bin means with t-interval CIs
  plt <- er_test_data |> er_plot(aucss, biomarker_change)
  expect_no_error(er_plot_add_quantiles(plt))

  smm <- (plt |> er_plot_add_quantiles())$layer$quantile$config$summary
  expect_named(smm, c(
    "exposure_bins", "strata", "x_mid", "y_mid", "y_mid_lbl",
    "ci_lower", "ci_upper", "y_lwr_lbl", "y_upr_lbl", "y_lbl"
  ))
  expect_true(all(smm$ci_lower <= smm$y_mid & smm$y_mid <= smm$ci_upper))

  # binary response still works, unchanged
  plt_binary <- er_test_data |> er_plot(aucss, ae1)
  expect_no_error(er_plot_add_quantiles(plt_binary))
})

test_that("er_plot_add_quantiles() warns instead of crashing when n_quantiles exceeds the exposure column's resolution", {
  df_skew <- data.frame(
    aucss = c(rep(1, 18), 2, 3),
    ae1 = rbinom(20, 1, 0.4)
  )
  plt <- er_plot(df_skew, aucss, ae1)

  expect_warning(
    plt_q <- er_plot_add_quantiles(plt, n_quantiles = 4),
    "only 1 are distinguishable"
  )
  expect_equal(levels(plt_q$layer$quantile$config$summary$exposure_bins), c("Placebo", "Q1"))

  # a well-resolved exposure column doesn't warn
  df_ok <- data.frame(aucss = 1:100, ae1 = rbinom(100, 1, 0.4))
  expect_no_warning(er_plot(df_ok, aucss, ae1) |> er_plot_add_quantiles(n_quantiles = 4))
})

test_that("er_plot_add_data's panel layout supports a continuous response (single color-encoded panel)", {
  # there's no built-in "panel"-layout style for a continuous/count response, but
  # `.layer_data()`'s response-type dispatch is still general-purpose and
  # exercised here via a minimal custom style.
  stub_panel_builder <- er_style_tag(
    function(data, config, stratify, exposure, response, strata, theme) list(),
    layout = "panel"
  )

  plt <- er_test_data |> er_plot(aucss, biomarker_change)
  expect_no_error(er_plot_add_data(plt, style = stub_panel_builder))

  plt <- er_plot_add_data(plt, style = stub_panel_builder)
  expect_equal(plt$layer$data$config$color_role, "response")
  expect_equal(plt$layer$data$config$panels, "data")

  # binary response still works, with er_style_data_boxjitter
  plt_binary <- er_test_data |> er_plot(aucss, ae1)
  expect_no_error(er_plot_add_data(plt_binary, style = er_style_data_boxjitter))
  expect_equal((plt_binary |> er_plot_add_data(style = er_style_data_boxjitter))$layer$data$config$color_role, "strata")
})

test_that("er_plot_add_data supports a declared count response", {
  stub_panel_builder <- er_style_tag(
    function(data, config, stratify, exposure, response, strata, theme) list(),
    layout = "panel"
  )

  plt <- er_test_data |> er_plot(aucss, ae_count, response_type = "count")
  expect_no_error(er_plot_add_data(plt, style = stub_panel_builder))
  expect_equal((plt |> er_plot_add_data(style = stub_panel_builder))$layer$data$config$color_role, "response")
})

test_that("er_plot_add_data's default style is er_style_data_overlay, replacing data/overlay on re-call", {
  plt <- er_test_data |> er_plot(aucss, ae1)

  plt_overlay <- plt |> er_plot_add_data()
  expect_false(is.null(plt_overlay$layer$overlay))
  expect_null(plt_overlay$layer$data)

  plt_jitter <- plt_overlay |> er_plot_add_data(style = er_style_data_boxjitter)
  expect_false(is.null(plt_jitter$layer$data))
  expect_null(plt_jitter$layer$overlay)

  plt_back <- plt_jitter |> er_plot_add_data()
  expect_false(is.null(plt_back$layer$overlay))
  expect_null(plt_back$layer$data)

  expect_error(er_plot_add_data(plt, style = "not a function"))
})

test_that("er_plot_add_data errors when panel != 'both'", {
  stub_panel_builder <- er_style_tag(
    function(data, config, stratify, exposure, response, strata, theme) list(),
    layout = "panel"
  )

  plt_continuous <- er_test_data |> er_plot(aucss, biomarker_change)
  expect_error(
    er_plot_add_data(plt_continuous, style = stub_panel_builder, panel = "upper"),
    regexp = "must be \"both\""
  )

  plt_count <- er_test_data |> er_plot(aucss, ae_count, response_type = "count")
  expect_error(
    er_plot_add_data(plt_count, style = stub_panel_builder, panel = "lower"),
    regexp = "must be \"both\""
  )

  # `er_style_data_overlay` (the default) has no upper/lower partition for
  # any response type, unlike `er_style_data_boxjitter` on a binary response
  plt_binary <- er_test_data |> er_plot(aucss, ae1)
  expect_error(
    er_plot_add_data(plt_binary, panel = "upper"),
    regexp = "must be \"both\""
  )

  # default ("both") and binary + er_style_data_boxjitter are unaffected
  expect_no_error(er_plot_add_data(plt_continuous))
  expect_no_error(er_plot_add_data(plt_binary, style = er_style_data_boxjitter, panel = "upper"))
})

test_that("er_plot_add_data produces N stratum panels, each with a response colorbar", {
  # there's no built-in "panel"-layout style for a continuous response; this custom
  # style recreates its color-encoded-panel behaviour to check that
  # `.layer_data()`/`.polish_labels()`'s per-stratum-panel machinery still
  # works for a response type with no shipped built-in.
  custom_color_panel_builder <- er_style_tag(
    function(data, config, stratify, exposure, response, strata, theme) {
      dat <- if (stratify) data |> dplyr::filter(.data[[strata$name]] == config$panel) else data
      list(
        ggplot2::geom_jitter(
          data = dat,
          mapping = ggplot2::aes(x = .data[[exposure$name]], y = 0, color = .data[[response$name]]),
          height = 0.1
        )
      )
    },
    layout = "panel"
  )

  mod3 <- er_test_toy_model(biomarker_change ~ aucss + sex, er_test_data, family = gaussian())
  plt <- er_test_data |>
    er_plot(aucss, biomarker_change, sex) |>
    er_plot_add_model(mod3) |>
    er_plot_add_data(style = custom_color_panel_builder)

  expect_no_error(er_plot_build(plt))
  built <- er_plot_build(plt)

  strata_levels <- sort(as.character(unique(er_test_data$sex)))
  expect_equal(sort(names(built$plot$data)), strata_levels)

  # the response label -- not the strata label -- should be on the color legend
  labs_by_panel <- purrr::map(built$plot$data, ggplot2::get_labs)
  purrr::walk(labs_by_panel, function(l) {
    expect_equal(l$colour, plt$response$label)
  })
})

test_that("er_plot creates an er_plot (all parts)", {
  expect_no_error(
    er_test_data |>
      dplyr::mutate(dose = factor(dose)) |>
      er_plot(aucss, ae1) |>
      er_plot_add_model(er_test_mod1) |>
      er_plot_add_quantiles()  |>
      er_plot_add_data()  |>
      er_plot_add_groups(c(treatment, dose))
  )
  plt <- er_test_data |>
    dplyr::mutate(dose = factor(dose)) |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data()  |>
    er_plot_add_groups(c(treatment, dose))
  expect_s3_class(plt, "er_plot")
})

test_that("er_plot creates an er_plot (all parts, all strata)", {
  mod <- er_test_toy_model(ae1 ~ aucss + sex, er_test_data, family = binomial())
  expect_no_error(
    er_test_data |>
      dplyr::mutate(dose = factor(dose)) |>
      er_plot(aucss, ae1, sex) |>
      er_plot_add_model(mod) |>
      er_plot_add_quantiles()  |>
      er_plot_add_data()  |>
      er_plot_add_groups(c(treatment, dose))
  )
  plt <- er_test_data |>
    dplyr::mutate(dose = factor(dose)) |>
    er_plot(aucss, ae1, sex) |>
    er_plot_add_model(mod) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data()  |>
    er_plot_add_groups(c(treatment, dose))
  expect_s3_class(plt, "er_plot")
})

test_that("er_plot_add_model() fills in covariates missing from the prediction grid", {
  # regression test: a model fit with a covariate beyond exposure/strata
  # (here, `sex`) used to crash inside the model's own `predict()` call
  # whenever that covariate wasn't in `newdata` -- i.e. whenever
  # `keep_strata = FALSE`, or `stratify_by` wasn't set in `er_plot()` at
  # all -- because `.get_model_predictions()` built `newdata` from only
  # the exposure (and, if stratified, strata) grid. 
  mod2 <- er_test_toy_model(ae1 ~ aucss + sex, er_test_data, family = binomial())

  # no `stratify_by` at all
  expect_no_error(
    er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(mod2)
  )

  # `stratify_by` set, but this layer opts out via `keep_strata = FALSE`
  expect_no_error(
    er_test_data |>
      er_plot(aucss, ae1, sex) |>
      er_plot_add_model(mod2, keep_strata = FALSE)
  )

  # the filled-in reference value for a factor covariate is its first
  # level, not (e.g.) NA or a value outside the training levels
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(mod2)
  expect_identical(
    unique(plt$layer$model$config$predictions$sex),
    factor(levels(er_test_data$sex)[1], levels = levels(er_test_data$sex))
  )

  # a numeric covariate is filled with its mean, not (e.g.) its first
  # observed value
  mod3 <- er_test_toy_model(ae1 ~ sex + dose, er_test_data, family = binomial())
  plt3 <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(mod3)
  expect_equal(
    unique(plt3$layer$model$config$predictions$dose),
    mean(er_test_data$dose, na.rm = TRUE)
  )
})

test_that("er_plot_add_groups errors when grouping by the stratification variable with keep_strata = TRUE", {
  # regression test: grouping by the same variable used for
  # stratification while keeping strata bakes that column name into
  # `config$groupings` twice, which used to surface as an opaque
  # "Join columns in `x` must be unique" error from dplyr::left_join()
  plt <- er_test_data |>
    er_plot(aucss, ae1, treatment) |>
    er_plot_add_model(er_test_mod1)

  expect_error(
    er_plot_add_groups(plt, treatment, keep_strata = TRUE),
    "stratification variable"
  )

  # keep_strata = FALSE for that same variable is fine
  expect_no_error(er_plot_add_groups(plt, treatment, keep_strata = FALSE))

  # grouping by a *different* variable with keep_strata = TRUE is unaffected
  expect_no_error(er_plot_add_groups(plt, aucss, keep_strata = TRUE))
})

test_that("er_plot_add_groups() errors clearly when grouping by a constant continuous variable", {
  df_const <- er_test_data
  df_const$biomarker_change <- 3

  plt <- er_plot(df_const, aucss, ae1)
  expect_error(
    er_plot_add_groups(plt, biomarker_change),
    "Cannot compute quantiles"
  )
})

test_that("er_plot_add_groups is additive across repeated calls", {
  # regression test: er_plot_add_groups() used to overwrite
  # object$layer$group on each call instead of merging into it, so a
  # second call silently dropped the first group panel
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_groups(aucss) |>
    er_plot_add_groups(treatment)

  expect_named(plt$layer$group$config, c(".aucss_quantile", "treatment"))

  built <- er_plot_build(plt)
  expect_named(built$plot$group, c(".aucss_quantile", "treatment"))
  expect_no_error(plot(plt))

  # re-adding the same grouping variable replaces just that one panel,
  # in place, rather than duplicating it
  plt2 <- plt |> er_plot_add_groups(aucss, style = er_style_group_violin)
  expect_named(plt2$layer$group$config, c(".aucss_quantile", "treatment"))
  expect_identical(plt2$layer$group$config[[".aucss_quantile"]]$style, er_style_group_violin)
})

test_that("er_plot_add_groups honours per-call keep_strata when mixed", {
  # regression test: `stratify` used to be stored once for the whole
  # `layer$group` and shared by every panel at build time, so mixing
  # `keep_strata = TRUE`/`FALSE` across calls applied the wrong flag to
  # at least one panel (and could error if a panel built without a
  # strata column was then asked to map `fill`/`colour` to it)
  plt <- er_test_data |>
    dplyr::mutate(dose = factor(dose)) |>
    er_plot(aucss, ae1, sex) |>
    er_plot_add_model(er_test_mod2) |>
    er_plot_add_groups(aucss, keep_strata = FALSE) |>
    er_plot_add_groups(dose, keep_strata = TRUE)

  expect_false(plt$layer$group$config[[".aucss_quantile"]]$stratify)
  expect_true(plt$layer$group$config[["dose"]]$stratify)

  # the unstratified panel's data/groupings should have no strata column
  expect_identical(plt$layer$group$config[[".aucss_quantile"]]$groupings, ".aucss_quantile")
  expect_false("sex" %in% names(plt$layer$group$config[[".aucss_quantile"]]$data))

  # the stratified panel's data/groupings should include the strata column
  expect_identical(plt$layer$group$config[["dose"]]$groupings, c("dose", "sex"))
  expect_true("sex" %in% names(plt$layer$group$config[["dose"]]$data))

  # top-level flag (used only for cross-panel strata-legend dedup) is
  # TRUE because at least one panel is stratified
  expect_true(plt$layer$group$stratify)

  expect_no_error(er_plot_build(plt))
  built <- er_plot_build(plt)

  # the unstratified panel has no fill/colour legend; the stratified one does
  unstratified_labs <- ggplot2::get_labs(built$plot$group[[".aucss_quantile"]])
  stratified_labs   <- ggplot2::get_labs(built$plot$group[["dose"]])
  expect_null(unstratified_labs$fill)
  expect_equal(stratified_labs$fill, plt$strata$label)

  expect_no_error(plot(plt))
})

test_that("er_plot_build does not error", {
  plt1 <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1)

  plt2 <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data()

  plt3 <- er_test_data |>
    dplyr::mutate(dose = factor(dose)) |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data()  |>
    er_plot_add_groups(c(treatment, dose))

  expect_no_error(er_plot_build(plt1))
  expect_no_error(er_plot_build(plt2))
  expect_no_error(er_plot_build(plt3))
})

test_that("er_plot_build warns when the quantile and group layers bin the exposure variable differently", {
  mismatched_bins <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_quantiles(n_bins = 4) |>
    er_plot_add_groups(aucss, n_bins = 6)
  expect_warning(er_plot_build(mismatched_bins), "bin `aucss` differently")

  mismatched_ties <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_quantiles(n_bins = 4, ties = "upward") |>
    er_plot_add_groups(aucss, n_bins = 4, ties = "downward")
  expect_warning(er_plot_build(mismatched_ties), "bin `aucss` differently")

  # order shouldn't matter
  mismatched_bins_reordered <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_groups(aucss, n_bins = 6) |>
    er_plot_add_quantiles(n_bins = 4)
  expect_warning(er_plot_build(mismatched_bins_reordered), "bin `aucss` differently")
})

test_that("er_plot_build doesn't warn when exposure binning agrees, or when the group layer bins something else", {
  matching <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_quantiles(n_bins = 4, ties = "upward") |>
    er_plot_add_groups(aucss, n_bins = 4, ties = "upward")
  expect_no_warning(er_plot_build(matching))

  non_exposure_group <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_quantiles(n_bins = 4) |>
    er_plot_add_groups(weight, n_bins = 8)
  expect_no_warning(er_plot_build(non_exposure_group))

  quantile_only <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_quantiles(n_bins = 4)
  expect_no_warning(er_plot_build(quantile_only))

  group_only <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_groups(aucss, n_bins = 6)
  expect_no_warning(er_plot_build(group_only))
})

test_that("er_plot_build constructs ggplot2 objects", {
  plt1 <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1)

  plt2 <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data(style = er_style_data_boxjitter)

  plt3 <- er_test_data |>
    dplyr::mutate(dose = factor(dose)) |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data(style = er_style_data_boxjitter)  |>
    er_plot_add_groups(c(treatment, dose))

  plt1_built <- er_plot_build(plt1)
  plt2_built <- er_plot_build(plt2)
  plt3_built <- er_plot_build(plt3)

  plt1_built_gg <- plt1_built$plot |> purrr::list_flatten() |> purrr::map_lgl(ggplot2::is_ggplot)
  plt2_built_gg <- plt2_built$plot |> purrr::list_flatten() |> purrr::map_lgl(ggplot2::is_ggplot)
  plt3_built_gg <- plt3_built$plot |> purrr::list_flatten() |> purrr::map_lgl(ggplot2::is_ggplot)

  expect_equal(
    plt1_built_gg,
    c(base = TRUE, data = FALSE, group = FALSE)
  )
  expect_equal(
    plt2_built_gg,
    c(base = TRUE, data_upper = TRUE, data_lower = TRUE, group = FALSE)
  )
  expect_equal(
    plt3_built_gg,
    c(base = TRUE, data_upper = TRUE, data_lower = TRUE, group_treatment = TRUE, group_dose = TRUE)
  )
})

test_that("er_plot_build/plot() handle a plot with no layers at all (empty canvas)", {
  plt <- er_test_data |>
    er_plot(aucss, ae1)

  expect_null(plt$layer$model)
  expect_null(plt$layer$summary)
  expect_null(plt$layer$quantile)
  expect_null(plt$layer$overlay)
  expect_null(plt$layer$data)
  expect_null(plt$layer$group)

  expect_no_error(built <- er_plot_build(plt))
  expect_true(ggplot2::is_ggplot(built$plot$base))
  expect_length(built$output$layers, 0)
  expect_no_error(plot(plt))
})

test_that("er_plot_build/plot() handle a group-only plot (no base layer)", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_groups(aucss) |>
    er_plot_add_groups(treatment)

  expect_null(plt$layer$model)
  expect_null(plt$layer$summary)
  expect_null(plt$layer$quantile)
  expect_null(plt$layer$overlay)

  expect_no_error(built <- er_plot_build(plt))
  expect_null(built$plot$base)
  expect_no_error(plot(plt))
})

test_that("er_plot_build/plot() handle a panel-layout data-only plot (no base layer)", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_data(style = er_style_data_boxjitter)

  expect_null(plt$layer$model)
  expect_null(plt$layer$summary)
  expect_null(plt$layer$quantile)
  expect_null(plt$layer$overlay)

  expect_no_error(built <- er_plot_build(plt))
  expect_null(built$plot$base)
  expect_no_error(plot(plt))
})

test_that("print method works as expected", {
  plt1 <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1)

  plt2 <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data(style = er_style_data_boxjitter)

  plt3 <- er_test_data |>
    dplyr::mutate(dose = factor(dose)) |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles()  |>
    er_plot_add_data(style = er_style_data_boxjitter)  |>
    er_plot_add_groups(c(treatment, dose))

  print_quiet <- purrr::quietly(print.er_plot)

  expect_no_error(print_quiet(plt1))
  expect_no_error(print_quiet(plt2))
  expect_no_error(print_quiet(plt3))

  printout1 <- print_quiet(plt1)
  printout2 <- print_quiet(plt2)
  printout3 <- print_quiet(plt3)

  expect_equal(printout1$result, plt1)
  expect_equal(printout2$result, plt2)
  expect_equal(printout3$result, plt3)

  expect_equal(printout1$warnings, character())
  expect_equal(printout2$warnings, character())
  expect_equal(printout3$warnings, character())

  expect_equal(printout1$messages, character())
  expect_equal(printout2$messages, character())
  expect_equal(printout3$messages, character())

  outlines1 <- strsplit(printout1$output, split = "\n")[[1]]
  outlines2 <- strsplit(printout2$output, split = "\n")[[1]]
  outlines3 <- strsplit(printout3$output, split = "\n")[[1]]

  expect_length(outlines1, 9)
  expect_length(outlines2, 11)
  expect_length(outlines3, 12)
})

test_that("er_plot_add_data() with the default er_style_data_overlay merges into the base plot", {
  # overlay as the *only* layer: the base plot must still get built (for
  # its coord/scale), with no separate object$plot$data panels
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_data()
  expect_no_error(er_plot_build(plt))
  built <- er_plot_build(plt)

  expect_true(ggplot2::is_ggplot(built$plot$base))
  expect_null(built$plot$data)
  expect_equal(length(built$output$layers), 1)

  # stratified overlay shares one legend with a stratified model curve,
  # both living on the same base plot
  mod2 <- er_test_toy_model(ae1 ~ aucss + sex, er_test_data, family = binomial())
  plt_strat <- er_test_data |>
    er_plot(aucss, ae1, sex) |>
    er_plot_add_model(mod2) |>
    er_plot_add_data()

  expect_no_error(er_plot_build(plt_strat))
  built_strat <- er_plot_build(plt_strat)

  expect_true(ggplot2::is_ggplot(built_strat$output))
  expect_equal(ggplot2::get_labs(built_strat$output)$colour, plt_strat$strata$label)
})

test_that(".polish_legends() doesn't crash when an overlay/summary layer is the only stratified layer", {
  # regression test: `.polish_legends()` used to look up legend-bearing
  # plots via a `dplyr::case_when()` that only mapped the "quantile" and
  # "model" layers onto the shared "base" panel -- an "overlay"-layout
  # data builder or the summary layer, stratified with nothing else
  # stratified alongside it, produced a `stratified_plots` value with no
  # match in `composition$info`, leaving `has_legend` empty and crashing
  # the old `for (ind in 2:length(has_legend))` loop on `2:0`.
  plt_strat <- er_test_data |> er_plot(aucss, ae1, sex)

  expect_no_error(plt_strat |> er_plot_add_data() |> er_plot_build())
  expect_no_error(plt_strat |> er_plot_add_summary() |> er_plot_build())

  skip_if_not_installed("hexbin")
  expect_no_error(plt_strat |> er_plot_add_data(style = er_style_data_hex) |> er_plot_build())
})


# style escape hatch ---------------------------------------------------------

test_that("er_plot_add_model() accepts a custom style", {
  custom_model_builder <- function(data, config, stratify, exposure, response, strata, theme) {
    ggplot2::geom_line(
      data = config$predictions,
      mapping = ggplot2::aes(x = .data[[exposure$name]], y = fit_resp),
      linetype = "dashed"
    )
  }

  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1, style = custom_model_builder)

  expect_identical(plt$layer$model$config$style, custom_model_builder)
  expect_no_error(er_plot_build(plt))
})

test_that("er_plot_add_summary() accepts a custom style", {
  custom_summary_builder <- function(data, config, stratify, exposure, response, strata, theme) {
    list()
  }

  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_summary(model = er_test_mod1, style = custom_summary_builder)

  expect_identical(plt$layer$summary$config$style, custom_summary_builder)
  expect_no_error(er_plot_build(plt))
})

test_that("er_plot_add_summary() works without a model at all", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_summary(style = er_style_summary_n)

  expect_null(plt$layer$summary$config$model)
  expect_null(plt$layer$summary$config$p_value)
  expect_no_error(er_plot_build(plt))

  built <- er_plot_build(plt)
  expect_true(ggplot2::is_ggplot(built$output))
})

test_that("er_plot_add_summary() accepts a registered label string in place of style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_summary(style = "n")
  expect_identical(plt$layer$summary$config$style, er_style_summary_n)
})

test_that("er_plot_add_summary() computes p_value regardless of stratify, but er_style_summary_pvalue() suppresses it when stratified", {
  plt_strat <- er_test_data |>
    er_plot(aucss, ae1, stratify_by = sex) |>
    er_plot_add_model(er_test_mod2) |>
    er_plot_add_summary(model = er_test_mod2, keep_strata = TRUE)

  expect_false(is.null(plt_strat$layer$summary$config$p_value))
  expect_true(plt_strat$layer$summary$stratify)

  geoms <- er_style_summary_pvalue(
    data = plt_strat$data,
    config = plt_strat$layer$summary$config,
    stratify = plt_strat$layer$summary$stratify,
    exposure = plt_strat$exposure,
    response = plt_strat$response,
    strata = plt_strat$strata,
    theme = plt_strat$theme
  )
  expect_identical(geoms, list())
})

test_that("er_plot_add_model() rejects a non-function, non-string style", {
  plt <- er_test_data |> er_plot(aucss, ae1)
  expect_error(er_plot_add_model(plt, er_test_mod1, style = 42), "must be a function")
})

test_that("er_plot_add_model() errors informatively for an unregistered style label", {
  plt <- er_test_data |> er_plot(aucss, ae1)
  expect_error(er_plot_add_model(plt, er_test_mod1, style = "not a function"), "not a function")
})

test_that("er_plot_add_model() accepts a registered label string in place of style", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1, style = "line")
  expect_identical(plt$layer$model$config$style, er_style_model_line)
})

test_that("er_plot_add_quantiles() accepts a custom style", {
  custom_quantile_builder <- function(data, config, stratify, exposure, response, strata, theme) {
    ggplot2::geom_pointrange(
      data = config$summary,
      mapping = ggplot2::aes(x = x_mid, y = y_mid, ymin = ci_lower, ymax = ci_upper),
      inherit.aes = FALSE
    )
  }

  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles(style = custom_quantile_builder)

  expect_identical(plt$layer$quantile$config$style, custom_quantile_builder)
  expect_no_error(er_plot_build(plt))
})

test_that("er_plot_add_quantiles() rejects a non-function style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)
  expect_error(er_plot_add_quantiles(plt, style = "not a function"))
})

test_that("er_plot_add_quantiles() accepts a registered label string in place of style", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_quantiles(style = "pointrange")
  expect_identical(plt$layer$quantile$config$style, er_style_quantile_pointrange)
})

test_that("er_plot_add_data() accepts a registered label string in place of style, for both structural families", {
  plt_overlay <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_data(style = "overlay")
  expect_identical(plt_overlay$layer$overlay$config$style, er_style_data_overlay)

  plt_panel <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_data(style = "boxjitter")
  expect_identical(plt_panel$layer$data$config$style, er_style_data_boxjitter)
})

test_that("er_plot_add_data() accepts a custom style for both the overlay and panel structural families", {
  custom_overlay_builder <- er_style_tag(function(data, config, stratify, exposure, response, strata, theme) {
    ggplot2::geom_point(
      data = data,
      mapping = ggplot2::aes(x = .data[[exposure$name]], y = .data[[response$name]]),
      shape = 4
    )
  }, layout = "overlay")
  custom_panel_builder <- er_style_tag(function(data, config, stratify, exposure, response, strata, theme) {
    ggplot2::geom_histogram(
      data = data,
      mapping = ggplot2::aes(x = .data[[exposure$name]])
    )
  }, layout = "panel")

  plt_overlay <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_data(style = custom_overlay_builder)

  expect_identical(plt_overlay$layer$overlay$config$style, custom_overlay_builder)
  expect_null(plt_overlay$layer$data)
  expect_no_error(er_plot_build(plt_overlay))

  plt_jitter <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_data(style = custom_panel_builder)

  expect_identical(plt_jitter$layer$data$config$style, custom_panel_builder)
  expect_null(plt_jitter$layer$overlay)
  expect_no_error(er_plot_build(plt_jitter))
})

test_that("er_plot_add_data() rejects a style with no declared layout", {
  untagged_builder <- function(data, config, stratify, exposure, response, strata, theme) list()
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)
  expect_error(er_plot_add_data(plt, style = untagged_builder))
})

test_that("er_plot_add_groups() accepts a registered label string, applied to every grouping variable", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_groups(c(aucss, sex), style = "violin")

  expect_true(all(purrr::map_lgl(plt$layer$group$config, \(cfg) identical(cfg$style, er_style_group_violin))))
})

test_that("er_plot_add_groups() accepts a custom style, applied to every grouping variable", {
  custom_group_builder <- function(data, config, stratify, exposure, response, strata, theme) {
    ggplot2::geom_violin(
      data = config$data,
      mapping = ggplot2::aes(x = .data[[exposure$name]], y = .data[[config$groupings[1]]])
    )
  }

  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_groups(c(aucss, sex), style = custom_group_builder)

  expect_true(all(purrr::map_lgl(plt$layer$group$config, \(cfg) identical(cfg$style, custom_group_builder))))
  expect_no_error(er_plot_build(plt))
})

test_that("er_plot_add_groups() rejects a non-function style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)
  expect_error(er_plot_add_groups(plt, aucss, style = "not a function"))
})

test_that("er_style_tag() attaches a layer attribute, validated against a fixed set", {
  fn <- function(data, config, stratify, exposure, response, strata, theme) list()

  tagged <- er_style_tag(fn, layer = "plot_quantile")
  expect_identical(attr(tagged, "er_style_layer"), "plot_quantile")

  expect_error(er_style_tag(fn, layer = "not_a_layer"))
})

test_that("er_style_tag() attaches a draw_order attribute, validated against a fixed set", {
  fn <- function(data, config, stratify, exposure, response, strata, theme) list()

  tagged <- er_style_tag(fn, draw_order = "background")
  expect_identical(attr(tagged, "er_style_draw_order"), "background")

  expect_error(er_style_tag(fn, draw_order = "not_a_draw_order"))

  # an untagged builder has no attribute set...
  expect_null(attr(fn, "er_style_draw_order"))
  # ...but `.style_draw_order()` defaults it to "foreground"
  expect_identical(erplots:::.style_draw_order(fn), "foreground")
  expect_identical(erplots:::.style_draw_order(tagged), "background")
})

test_that("er_style_data_hex() is tagged draw_order = \"background\"", {
  expect_identical(attr(er_style_data_hex, "er_style_draw_order"), "background")
})

test_that("a draw_order = \"background\" overlay style draws before model/summary/quantile geoms", {
  skip_if_not_installed("hexbin")

  background_builder <- er_style_tag(
    function(data, config, stratify, exposure, response, strata, theme, ...) {
      ggplot2::geom_point(
        data = data,
        mapping = ggplot2::aes(x = .data[[exposure$name]], y = .data[[response$name]]),
        shape = 4
      )
    },
    layout = "overlay",
    draw_order = "background"
  )

  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_summary(model = er_test_mod1) |>
    er_plot_add_data(style = background_builder) |>
    er_plot_build()

  geom_classes <- purrr::map_chr(plt$plot$base$layers, \(l) class(l$geom)[1])
  overlay_position <- which(geom_classes == "GeomPoint")
  model_position <- which(geom_classes == "GeomPath")

  expect_true(length(overlay_position) > 0 && length(model_position) > 0)
  expect_true(min(overlay_position) < min(model_position))
})

test_that("the default (foreground) overlay style still draws after model/summary/quantile geoms", {
  plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_data(style = er_style_data_overlay) |>
    er_plot_build()

  geom_classes <- purrr::map_chr(plt$plot$base$layers, \(l) class(l$geom)[1])
  overlay_position <- which(geom_classes == "GeomPoint")
  model_position <- which(geom_classes == "GeomPath")

  expect_true(length(overlay_position) > 0 && length(model_position) > 0)
  expect_true(min(overlay_position) > min(model_position))
})

test_that("built-in builders are tagged with their layer", {
  expect_identical(attr(er_style_model_ribbonline, "er_style_layer"), "plot_model")
  expect_identical(attr(er_style_model_line, "er_style_layer"), "plot_model")
  expect_identical(attr(er_style_model_spaghetti, "er_style_layer"), "plot_model")
  expect_identical(attr(er_style_summary_pvalue, "er_style_layer"), "plot_summary")
  expect_identical(attr(er_style_quantile_errorbar, "er_style_layer"), "plot_quantile")
  expect_identical(attr(er_style_quantile_errorbar_vlines, "er_style_layer"), "plot_quantile")
  expect_identical(attr(er_style_quantile_pointrange, "er_style_layer"), "plot_quantile")
  expect_identical(attr(er_style_quantile_pointrange_vlines, "er_style_layer"), "plot_quantile")
  expect_identical(attr(er_style_data_overlay, "er_style_layer"), "plot_data")
  expect_identical(attr(er_style_data_boxjitter, "er_style_layer"), "plot_data")
  expect_identical(attr(er_style_data_hex, "er_style_layer"), "plot_data")
  expect_identical(attr(er_style_group_boxplot, "er_style_layer"), "plot_group")
  expect_identical(attr(er_style_group_violin, "er_style_layer"), "plot_group")
  expect_identical(attr(er_style_group_histogram, "er_style_layer"), "plot_group")
})

test_that("er_plot_add_model() errors informatively for a wrong-layer style", {
  plt <- er_test_data |> er_plot(aucss, ae1)

  expect_error(
    er_plot_add_model(plt, er_test_mod1, style = er_style_quantile_errorbar),
    "quantile"
  )
  # a style tagged for the right layer (or no layer at all) is unaffected
  expect_no_error(er_plot_add_model(plt, er_test_mod1, style = er_style_model_line))
})

test_that("er_plot_add_summary() errors informatively for a wrong-layer style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)

  expect_error(
    er_plot_add_summary(plt, model = er_test_mod1, style = er_style_group_boxplot),
    "group"
  )
  # a style tagged for the right layer (or no layer at all) is unaffected
  expect_no_error(er_plot_add_summary(plt, model = er_test_mod1, style = er_style_summary_n))
})

test_that("er_plot_add_quantiles() errors informatively for a wrong-layer style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)

  expect_error(
    er_plot_add_quantiles(plt, style = er_style_data_overlay),
    "data"
  )
  expect_no_error(er_plot_add_quantiles(plt, style = er_style_quantile_pointrange))
})

test_that("er_plot_add_data() errors informatively for a wrong-layer style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)

  expect_error(
    er_plot_add_data(plt, style = er_style_group_boxplot),
    "group"
  )
  expect_no_error(er_plot_add_data(plt, style = er_style_data_boxjitter))
})

test_that("er_plot_add_groups() errors informatively for a wrong-layer style", {
  plt <- er_test_data |> er_plot(aucss, ae1) |> er_plot_add_model(er_test_mod1)

  expect_error(
    er_plot_add_groups(plt, aucss, style = er_style_quantile_errorbar),
    "quantile"
  )
  expect_no_error(er_plot_add_groups(plt, aucss, style = er_style_group_violin))
})

test_that("a style with no `layer` tag is never checked, in any layer", {
  untagged <- function(data, config, stratify, exposure, response, strata, theme) list()
  plt <- er_test_data |> er_plot(aucss, ae1)

  expect_no_error(er_plot_add_model(plt, er_test_mod1, style = untagged))
  expect_no_error(er_plot_add_summary(plt, model = er_test_mod1, style = untagged))
  expect_no_error(er_plot_add_quantiles(er_plot_add_model(plt, er_test_mod1), style = untagged))
})

test_that("er_plot() ungroups a grouped tibble, so downstream `.by = ` layers don't error", {
  grouped_data <- er_test_data |> dplyr::group_by(sex)

  plt <- grouped_data |> er_plot(aucss, ae1, stratify_by = sex)
  expect_false(dplyr::is_grouped_df(plt$data))

  # the full pipeline used to fail inside `.layer_quantile()` with
  # "Can't supply `.by` when `.data` is a grouped data frame."
  expect_no_error({
    built <- plt |>
      er_plot_add_model(er_test_mod2) |>
      er_plot_add_summary(model = er_test_mod2) |>
      er_plot_add_quantiles() |>
      er_plot_add_data() |>
      er_plot_add_groups(aucss) |>
      er_plot_build()
  })
  expect_true(inherits(built$output, "patchwork"))
})

test_that("er_plot() ungroups a rowwise tibble, so per-row `dplyr::mutate()` calls aren't run row-by-row", {
  rowwise_data <- er_test_data |> dplyr::rowwise()

  plt <- rowwise_data |> er_plot(aucss, ae1)
  expect_false(inherits(plt$data, "rowwise_df"))

  # a rowwise input used to make `cut_exposure_quantile()` run once per
  # row (each call seeing a length-1 vector), failing with "found only 0
  # distinct non-missing, non-placebo exposure values"
  expect_no_error({
    built <- plt |>
      er_plot_add_model(er_test_mod1) |>
      er_plot_add_quantiles() |>
      er_plot_build()
  })
  expect_true(inherits(built$output, "patchwork"))
})

test_that("er_plot() with grouped/rowwise input produces the same summary-corner placement as ungrouped input", {
  # regression test for the silent-corruption failure mode: with grouped
  # input, `.compute_corner_distance()` used to retain the grouping
  # column and return one row per group instead of one, producing a
  # garbled `corner_distance` vector (mixed character/numeric, duplicated
  # names) rather than erroring -- this surfaced downstream as an opaque
  # "object 'geoms' not found" inside `er_style_summary_pvalue()`.
  plain_plt <- er_test_data |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_summary(model = er_test_mod1)

  grouped_plt <- er_test_data |>
    dplyr::group_by(sex) |>
    er_plot(aucss, ae1) |>
    er_plot_add_model(er_test_mod1) |>
    er_plot_add_summary(model = er_test_mod1)

  expect_no_error(grouped_built <- er_plot_build(grouped_plt))
  plain_built <- er_plot_build(plain_plt)

  expect_identical(
    grouped_built$layer$summary$config$corner_distance,
    plain_built$layer$summary$config$corner_distance
  )
})