test_that("sensitivity_grid returns correct structure", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 4, 1), beta = seq(2, 8, 2)),
    target       = c("posterior_mean", "prob_efficacy"),
    threshold    = 0.30
  )

  expect_s3_class(sa, "bayprior_sensitivity")
  expect_true(is.data.frame(sa$grid))
  expect_true(is.numeric(sa$influence_scores))
  expect_named(sa$influence_scores,
               c("posterior_mean", "prob_efficacy"),
               ignore.order = TRUE)

  # Influence scores are non-negative
  expect_true(all(sa$influence_scores >= 0))

  # Grid has rows for all combinations
  expect_equal(nrow(sa$grid), 4 * 4)

  # Posterior means are in (0, 1)
  expect_true(all(sa$grid$posterior_mean > 0 & sa$grid$posterior_mean < 1))
})

test_that("sensitivity_grid works for normal prior", {
  prior <- elicit_normal(mean = 0.0, sd = 0.3, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "continuous", x = 0.4, sd = 0.3, n = 60),
    param_grid   = list(mu = c(-0.5, 0, 0.5), sigma = c(0.1, 0.3, 0.5)),
    target       = c("posterior_mean", "posterior_sd")
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_equal(nrow(sa$grid), 9)
})

test_that("sensitivity_cri returns correct structure", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  cri <- sensitivity_cri(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 4, 1), beta = seq(2, 8, 2)),
    cri_level    = 0.95,
    threshold    = 0.30
  )

  expect_s3_class(cri, "bayprior_sensitivity")
  expect_true("cri_width" %in% names(cri$influence_scores))
  expect_true("cri_lower" %in% colnames(cri$grid))
  expect_true("cri_upper" %in% colnames(cri$grid))

  # CrI widths are positive
  expect_true(all(cri$grid$cri_width > 0))
  # Lower < upper for all rows
  expect_true(all(cri$grid$cri_lower < cri$grid$cri_upper))
})

test_that("plot_tornado returns a ggplot", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 4, 1), beta = seq(2, 8, 2)),
    target       = c("posterior_mean", "prob_efficacy"),
    threshold    = 0.30
  )
  gp <- plot_tornado(sa)
  expect_s3_class(gp, "gg")
})

test_that("plot_sensitivity returns a ggplot", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 4, 1), beta = seq(2, 8, 2)),
    target       = "posterior_mean",
    threshold    = 0.30
  )
  gp <- plot_sensitivity(sa, target = "posterior_mean")
  expect_s3_class(gp, "gg")
})

test_that("sensitivity_grid errors on bad prior", {
  expect_error(
    sensitivity_grid(
      prior        = list(not = "a bayprior"),
      data_summary = list(type = "binary", x = 14, n = 40),
      param_grid   = list(alpha = 1:3, beta = 2:4)
    )
  )
})

test_that("reference row is within the grid", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 6, 1), beta = seq(2, 12, 2))
  )
  expect_gte(sa$reference_row, 1L)
  expect_lte(sa$reference_row, nrow(sa$grid))
})


# -- Additional coverage ------------------------------------------------------

test_that("print.bayprior_sensitivity does not error", {
  prior <- elicit_beta(mean=0.30, sd=0.10, method="moments")
  sa <- sensitivity_grid(
    prior, list(type="binary", x=14, n=40),
    list(alpha=1:3, beta=2:4), target="posterior_mean"
  )
  expect_error(print(sa), NA)
})

test_that("plot_sensitivity works with prob_efficacy target", {
  prior <- elicit_beta(mean=0.30, sd=0.10, method="moments")
  sa <- sensitivity_grid(
    prior, list(type="binary", x=14, n=40),
    list(alpha=1:3, beta=2:4),
    target="prob_efficacy", threshold=0.30
  )
  gp <- plot_sensitivity(sa, target="prob_efficacy")
  expect_s3_class(gp, "gg")
})

test_that("sensitivity_cri plot works", {
  prior <- elicit_beta(mean=0.30, sd=0.10, method="moments")
  cri <- sensitivity_cri(
    prior, list(type="binary", x=14, n=40),
    list(alpha=1:3, beta=2:4), cri_level=0.95
  )
  gp <- plot_sensitivity(cri, target="cri_width")
  expect_s3_class(gp, "gg")
})

# -- Conflict sensitivity edge cases ------------------------------------------

test_that("sensitivity_grid with posterior_sd target works", {
  prior <- elicit_beta(mean=0.30, sd=0.10, method="moments")
  sa <- sensitivity_grid(
    prior, list(type="binary", x=14, n=40),
    list(alpha=1:3, beta=2:4),
    target = "posterior_sd"
  )
  expect_true("posterior_sd" %in% names(sa$influence_scores))
  expect_true(all(sa$grid$posterior_sd > 0))
})
# -- Additional data types -----------------------------------------------------

test_that("sensitivity_grid: normal-normal conjugate works", {
  prior <- elicit_normal(mean = 0.0, sd = 1.0, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "continuous", x = 0.5, n = 30, sd = 1.0),
    param_grid   = list(mu = seq(-1, 1, by = 0.5), sigma = seq(0.5, 2, by = 0.5)),
    target       = "posterior_mean",
    threshold    = 0.0
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_true(nrow(sa$grid) > 0)
})

test_that("sensitivity_grid: gamma-poisson conjugate works", {
  prior <- elicit_gamma(mean = 2.0, sd = 1.0, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "poisson", x = 3, n = 10),
    param_grid   = list(shape = seq(1, 4, by = 1), rate = seq(0.5, 2, by = 0.5)),
    target       = "posterior_mean",
    threshold    = 2.0
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_false(all(is.na(sa$grid$posterior_mean)))
})

test_that("sensitivity_grid works with Poisson data", {
  prior <- elicit_gamma(mean = 0.15, sd = 0.05, method = "moments")
  sa <- sensitivity_grid(
    prior,
    data_summary = list(type = "poisson", x = 12, n = 100),
    param_grid   = list(shape = seq(2, 8, 1), rate = seq(10, 50, 5)),
    target       = c("posterior_mean", "prob_efficacy"),
    threshold    = 0.10
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_false(all(is.na(sa$grid$posterior_mean)))
})

test_that("sensitivity_cri: tracks credible interval width", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  cri_sa <- sensitivity_cri(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 5, by = 1), beta = seq(2, 10, by = 2)),
    cri_level    = 0.95,
    threshold    = 0.30
  )
  expect_s3_class(cri_sa, "bayprior_sensitivity")
  expect_true("cri_width" %in% names(cri_sa$grid))
  expect_true(all(cri_sa$grid$cri_width > 0, na.rm = TRUE))
})

test_that("sensitivity_cri: normal data type works", {
  prior <- elicit_normal(mean = 0.0, sd = 1.0, method = "moments")
  cri_sa <- sensitivity_cri(
    prior        = prior,
    data_summary = list(type = "continuous", x = 0.5, n = 20, sd = 1.0),
    param_grid   = list(mu = seq(-1, 1, by = 0.5), sigma = seq(0.5, 1.5, by = 0.5))
  )
  expect_s3_class(cri_sa, "bayprior_sensitivity")
})

test_that("sensitivity_cri with survival data", {
  prior <- elicit_gamma(mean = 0.05, sd = 0.02, method = "moments")
  sa <- sensitivity_cri(
    prior,
    data_summary = list(type = "survival", x = 20, n = 400),
    param_grid   = list(shape = seq(1, 6, 1), rate = seq(10, 40, 5)),
    cri_level    = 0.95
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_false(all(is.na(sa$grid$cri_width)))
})

test_that("sensitivity_cri with 80% CrI gives narrower intervals than 95%", {
  prior    <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  data_obs <- list(type = "binary", x = 14, n = 40)
  grid     <- list(alpha = seq(1, 4, 1), beta = seq(2, 8, 2))
  cri80 <- sensitivity_cri(prior, data_obs, grid, cri_level = 0.80)
  cri95 <- sensitivity_cri(prior, data_obs, grid, cri_level = 0.95)
  expect_lt(mean(cri80$grid$cri_width), mean(cri95$grid$cri_width))
})

test_that("sensitivity_grid handles single-row param combinations", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = 3, beta = 7),
    target       = "posterior_mean"
  )
  expect_equal(nrow(sa$grid), 1)
})

# -- Lognormal conjugate update paths -----------------------------------------

test_that("sensitivity_grid: lognormal prior covered via prior_conflict", {
  # sensitivity_grid conjugate update for lognormal is not supported directly.
  # Coverage of lognormal .conjugate_update is achieved via prior_conflict instead.
  prior <- elicit_lognormal(mean = 1.5, sd = 0.4, method = "moments")
  cd <- prior_conflict(prior, list(type = "continuous", x = 1.6, n = 25, sd = 0.3))
  expect_s3_class(cd, "bayprior_conflict")
})

test_that("sensitivity_cri: normal prior with prob_efficacy threshold works", {
  prior <- elicit_normal(mean = 0.0, sd = 0.5, method = "moments")
  cri_sa <- sensitivity_cri(
    prior        = prior,
    data_summary = list(type = "continuous", x = 0.3, n = 30, sd = 0.4),
    param_grid   = list(
      mu    = seq(-0.5, 0.5, by = 0.25),
      sigma = seq(0.3, 0.7, by = 0.2)
    ),
    cri_level    = 0.95,
    threshold    = 0.0
  )
  expect_s3_class(cri_sa, "bayprior_sensitivity")
  expect_true("prob_efficacy" %in% names(cri_sa$grid))
})

test_that("sensitivity_grid: exponential prior with poisson data works", {
  prior <- elicit_exponential(mean = 2.0, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "poisson", x = 8, n = 20),
    param_grid   = list(rate = seq(0.2, 1.0, by = 0.2)),
    target       = "posterior_mean",
    threshold    = 0.5
  )
  expect_s3_class(sa, "bayprior_sensitivity")
})

# -- plot_sensitivity: 1D param grid (heatmap vs tornado) ---------------------

test_that("plot_sensitivity: posterior_mean heatmap with fine grid produces ggplot", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(2, 8, by = 2), beta = seq(4, 16, by = 4)),
    target       = "posterior_mean"
  )
  gp <- plot_sensitivity(sa, target = "posterior_mean")
  expect_true(inherits(gp, "gg") || inherits(gp, "patchwork"))
})

test_that("plot_sensitivity: posterior_sd target heatmap works", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  sa <- sensitivity_grid(
    prior        = prior,
    data_summary = list(type = "binary", x = 14, n = 40),
    param_grid   = list(alpha = seq(1, 4, 1), beta = seq(2, 8, 2)),
    target       = "posterior_sd"
  )
  gp <- plot_sensitivity(sa, target = "posterior_sd")
  expect_true(inherits(gp, "gg") || inherits(gp, "patchwork"))
})

test_that("sensitivity_grid moment-matches a linearly pooled mixture prior", {
  e1 <- elicit_beta(mean = 0.30, sd = 0.08, method = "moments",
                    expert_id = "E1")
  e2 <- elicit_beta(mean = 0.42, sd = 0.10, method = "moments",
                    expert_id = "E2")
  pool <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                            method = "linear")

  # Ties in which.max(c(0.5, 0.5)) resolve to the first component; if the
  # old dominant-component-only fallback were still in effect, the grid
  # would silently reflect E1 alone (mean 0.30) rather than the pool's
  # actual blended mean (~0.36-0.37). Confirm the working prior instead
  # reflects the pooled mean by checking that a grid centred on the
  # pooled mean does not raise all its mass at the low end typical of E1.
  expect_message(
    sa <- sensitivity_grid(
      prior        = pool,
      data_summary = list(type = "binary", x = 18, n = 40),
      param_grid   = list(alpha = seq(5, 15, by = 1),
                          beta  = seq(15, 30, by = 1)),
      target       = "posterior_mean"
    ),
    "moment-matched working prior"
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_true(nrow(sa$grid) > 0)
})

test_that("sensitivity_grid falls back to dominant component and warns
           when a mixture family cannot be moment-matched", {
  e1 <- elicit_exponential(rate = 2, method = "rate", expert_id = "E1")
  e2 <- elicit_exponential(rate = 3, method = "rate", expert_id = "E2")
  pool <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                            method = "linear")

  expect_warning(
    sa <- sensitivity_grid(
      prior        = pool,
      data_summary = list(type = "survival", x = 12, n = 40),
      param_grid   = list(rate = seq(1, 5, by = 0.5)),
      target       = "posterior_mean"
    ),
    "Falling back to the dominant component"
  )
  expect_s3_class(sa, "bayprior_sensitivity")
})

test_that("sensitivity_grid does not error on a logarithmically pooled
           prior, whose fit_summary$sd is NULL", {
  e1 <- elicit_beta(mean = 0.30, sd = 0.08, method = "moments",
                    expert_id = "E1")
  e2 <- elicit_beta(mean = 0.42, sd = 0.10, method = "moments",
                    expert_id = "E2")
  pool_log <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                                method = "logarithmic")
  expect_true(is.null(pool_log$fit_summary$sd))

  # This previously crashed with "argument is of length zero" because
  # is.na(NULL) inside the working_prior if() condition returns a
  # zero-length logical rather than FALSE.
  expect_no_error(
    suppressWarnings(suppressMessages(
      sensitivity_grid(
        prior        = pool_log,
        data_summary = list(type = "binary", x = 18, n = 40),
        param_grid   = list(alpha = seq(5, 15, by = 1),
                            beta  = seq(15, 30, by = 1)),
        target       = "posterior_mean"
      )
    ))
  )
})

test_that("sensitivity_cri moment-matches a linearly pooled mixture prior
           (previously discarded non-dominant components, matching the
           sensitivity_grid bug found and fixed separately)", {
  e1 <- elicit_beta(mean = 0.30, sd = 0.08, method = "moments", expert_id = "E1")
  e2 <- elicit_beta(mean = 0.42, sd = 0.10, method = "moments", expert_id = "E2")
  pool <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                            method = "linear")

  expect_message(
    cri_sa <- sensitivity_cri(
      prior        = pool,
      data_summary = list(type = "binary", x = 18, n = 40),
      param_grid   = list(alpha = seq(3, 12, by = 1), beta = seq(6, 20, by = 1)),
      cri_level    = 0.95
    ),
    "moment-matched working prior"
  )
  expect_s3_class(cri_sa, "bayprior_sensitivity")
  expect_true("cri_width" %in% names(cri_sa$grid))
})

# -- .conjugate_update() Normal-approximation fallback ------------------------
# Previously aborted for any prior/data-type pairing with no exact conjugate
# formula (e.g. Beta with continuous data), contradicting the compatibility
# warning shown elsewhere in the package, which promises a Normal
# approximation. Now falls back to one instead of erroring.

test_that(".conjugate_update falls back to a Normal-approximation posterior
           for an unsupported family/type pairing, with a message", {
  beta_prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  expect_message(
    post <- .conjugate_update(beta_prior,
                              list(type = "continuous", x = 0.45, sd = 0.18, n = 50)),
    "approximated the posterior as Normal"
  )
  expect_equal(post$dist, "normal")
  expect_true(is.finite(post$params$mu))
  expect_true(is.finite(post$params$sigma) && post$params$sigma > 0)
})

test_that(".conjugate_update mixture branch keeps components that only
           succeed via the Normal-approximation fallback, instead of
           dropping all of them and aborting", {
  e1 <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments", expert_id = "E1")
  e2 <- elicit_beta(mean = 0.42, sd = 0.12, method = "moments", expert_id = "E2")
  pool <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                            method = "linear")
  # Beta + continuous has no exact conjugate update; previously this meant
  # every component failed and the mixture branch aborted with "Could not
  # update any mixture component with the supplied data."
  expect_no_error(
    suppressMessages(
      post <- .conjugate_update(pool,
                                list(type = "continuous", x = 0.45, sd = 0.18, n = 50))
    )
  )
  expect_equal(post$dist, "mixture")
  expect_equal(length(post$components), 2)
})

test_that("plot_prior_likelihood renders a posterior curve end to end for a
           pooled Beta mixture against continuous data (the exact scenario
           from the reported app crash)", {
  e1 <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments", expert_id = "E1")
  e2 <- elicit_beta(mean = 0.42, sd = 0.12, method = "moments", expert_id = "E2")
  pool <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                            method = "linear")
  expect_no_error(
    suppressMessages(
      p <- plot_prior_likelihood(pool,
                                 list(type = "continuous", x = 0.45, sd = 0.18, n = 50),
                                 show_posterior = TRUE)
    )
  )
  expect_true(inherits(p, "gg") || inherits(p, "ggplot"))
})

test_that("plot_prior_likelihood does not silently clip the likelihood curve
           when it falls far from the prior's own range -- same class of fix
           as plot.bayprior_conflict, applied here since this is the
           function the Shiny app actually calls for its overlay panel", {
  prior <- elicit_gamma(mean = 20, sd = 5, method = "moments",
                        label = "Survival time")
  expect_no_warning(
    suppressMessages(
      p <- plot_prior_likelihood(prior, list(type = "survival", x = 12, n = 40),
                                 show_posterior = TRUE)
    )
  )
  built   <- ggplot2::ggplot_build(p)
  x_range <- built$layout$panel_params[[1]]$x.range
  # Grid must reach down near the likelihood's location (hazard rate ~0.3),
  # not stop at the prior's own lower bound (~8, per qgamma(0.001,...)).
  expect_lt(x_range[1], 1)
})

# -- param_grid name-remapping: positional remap and hard abort ---------------

test_that("sensitivity_grid remaps generic param_grid names positionally
           when counts match but names don't", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  expect_message(
    sa <- sensitivity_grid(
      prior, list(type = "binary", x = 14, n = 40),
      list(param1 = seq(1, 4, 1), param2 = seq(2, 8, 2)),
      target = "posterior_mean"
    ),
    "remapping param_grid names positionally"
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_equal(nrow(sa$grid), 16)
})

test_that("sensitivity_grid aborts when param_grid names don't match and
           counts also differ", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  expect_error(
    sensitivity_grid(
      prior, list(type = "binary", x = 14, n = 40),
      list(param1 = seq(1, 4, 1)),  # beta has 2 hyperparameters, not 1
      target = "posterior_mean"
    ),
    "names don't match and counts differ"
  )
})

test_that("sensitivity_cri remaps generic param_grid names positionally
           when counts match but names don't", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  expect_message(
    cri_sa <- sensitivity_cri(
      prior, list(type = "binary", x = 14, n = 40),
      list(param1 = seq(1, 4, 1), param2 = seq(2, 8, 2))
    ),
    "remapping param_grid names positionally"
  )
  expect_s3_class(cri_sa, "bayprior_sensitivity")
})

test_that("sensitivity_cri aborts when param_grid names don't match and
           counts also differ", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  expect_error(
    sensitivity_cri(
      prior, list(type = "binary", x = 14, n = 40),
      list(param1 = seq(1, 4, 1))
    ),
    "Names don't match and counts differ"
  )
})

# -- sensitivity_cri input validation -----------------------------------------

test_that("sensitivity_cri aborts on a non-bayprior `prior`", {
  expect_error(
    sensitivity_cri(
      list(not = "a bayprior"), list(type = "binary", x = 14, n = 40),
      list(alpha = 1:3, beta = 2:4)
    ),
    "must be a bayprior object"
  )
})

test_that("sensitivity_cri aborts on an out-of-range cri_level", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  expect_error(
    sensitivity_cri(
      prior, list(type = "binary", x = 14, n = 40),
      list(alpha = 1:3, beta = 2:4), cri_level = 1.5
    ),
    "strictly between 0 and 1"
  )
})

# -- .conjugate_update(): Weibull branch, both data-type sub-paths -----------

test_that(".conjugate_update Weibull Normal-approximation works for binary
           data (obs_mean_w/obs_se_w computed as a proportion)", {
  wp <- elicit_weibull(shape = 2, scale = 5, method = "params")
  post <- .conjugate_update(wp, list(type = "binary", x = 14, n = 40))
  expect_equal(post$dist, "normal")
  expect_true(is.finite(post$params$mu))
  expect_true(is.finite(post$params$sigma) && post$params$sigma > 0)
})

test_that(".conjugate_update Weibull Normal-approximation works for
           continuous data (obs_mean_w/obs_se_w taken from data_summary)", {
  wp <- elicit_weibull(shape = 2, scale = 5, method = "params")
  post <- .conjugate_update(wp, list(type = "continuous", x = 4, sd = 1.2, n = 30))
  expect_equal(post$dist, "normal")
  expect_true(is.finite(post$params$mu))
  expect_true(is.finite(post$params$sigma) && post$params$sigma > 0)
})

test_that("sensitivity_grid: Weibull prior with binary data works end to end", {
  wp <- elicit_weibull(shape = 2, scale = 5, method = "params")
  sa <- sensitivity_grid(
    wp, list(type = "binary", x = 14, n = 40),
    list(shape = seq(1, 3, 0.5), scale = seq(3, 7, 1)),
    target = "posterior_mean"
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_false(all(is.na(sa$grid$posterior_mean)))
})

# -- .conjugate_update(): Gamma + continuous data -----------------------------

test_that(".conjugate_update Gamma + continuous data recovers the total via
           x_sum (falling back to x * n when x_sum is absent)", {
  gp <- elicit_gamma(mean = 2, sd = 1, method = "moments")
  post <- .conjugate_update(gp, list(type = "continuous", x = 1.8, n = 25))
  expect_equal(post$dist, "gamma")
  expect_equal(post$params$shape, gp$params$shape + 1.8 * 25)
  expect_equal(post$params$rate,  gp$params$rate  + 25)
})

test_that("sensitivity_grid: Gamma prior with continuous data works end to end", {
  gp <- elicit_gamma(mean = 2, sd = 1, method = "moments")
  sa <- sensitivity_grid(
    gp, list(type = "continuous", x = 1.8, n = 25),
    list(shape = seq(1, 4, 1), rate = seq(0.5, 2, 0.5)),
    target = "posterior_mean"
  )
  expect_s3_class(sa, "bayprior_sensitivity")
  expect_false(all(is.na(sa$grid$posterior_mean)))
})

# -- .conjugate_update(): defensive branches, exercised directly -------------
# These two branches guard against a prior/component that cannot be updated
# at all; reaching them through sensitivity_grid()/sensitivity_cri() would
# require a prior that fails validation earlier, so they're exercised
# directly against .conjugate_update() with synthetic inputs instead.

test_that(".conjugate_update aborts with a clear message when no conjugate
           formula applies and no fit_summary mean/SD exists for a Normal
           fallback", {
  bad_prior <- structure(
    list(dist = "lognormal", params = list(meanlog = 0, sdlog = 1),
         method = "moments", expert_id = "E", label = "x", input = list(),
         fit_summary = list(mean = NA_real_, sd = NA_real_)),
    class = "bayprior"
  )
  expect_error(
    .conjugate_update(bad_prior, list(type = "continuous", x = 1, sd = 1, n = 10)),
    "no fit_summary mean/SD is available"
  )
})

test_that(".conjugate_update aborts when every component of a mixture prior
           fails to update", {
  e1 <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments", expert_id = "E1")
  e2 <- elicit_beta(mean = 0.42, sd = 0.10, method = "moments", expert_id = "E2")
  pool <- aggregate_experts(list(E1 = e1, E2 = e2), weights = c(0.5, 0.5),
                            method = "linear")
  real_update <- .conjugate_update
  failing_update <- function(prior, data_summary) {
    if (!identical(prior$dist, "mixture")) stop("simulated component failure")
    real_update(prior, data_summary)
  }
  testthat::local_mocked_bindings(.conjugate_update = failing_update,
                                  .package = "bayprior")
  expect_error(
    .conjugate_update(pool, list(type = "binary", x = 14, n = 40)),
    "Could not update any mixture component"
  )
})

# -- sensitivity_grid()/sensitivity_cri(): per-grid-point construction or
# update failures degrade to NA for that row rather than aborting the whole
# call (a full-grid failure is covered separately by the all-NA abort test
# below). A real numeric trigger for .make_bayprior()/.conjugate_update()
# throwing on a single grid point is hard to construct (the underlying stats
# functions degrade to NaN with a warning rather than erroring), so this
# mocks a construction/update failure for one specific grid point -- the
# same defensive path a malformed or pathological input would take.

test_that("sensitivity_grid degrades a single failed grid point to NA rather
           than aborting, when prior construction fails only at that point", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  real_make <- .make_bayprior
  testthat::local_mocked_bindings(
    .make_bayprior = function(dist, params, ...) {
      if (identical(params$alpha, 2)) stop("simulated construction failure")
      real_make(dist, params, ...)
    },
    .package = "bayprior"
  )
  sa <- sensitivity_grid(
    prior, list(type = "binary", x = 14, n = 40),
    list(alpha = c(1, 2, 3), beta = c(2, 4)),
    target = "posterior_mean"
  )
  expect_equal(sum(is.na(sa$grid$posterior_mean)), 2L)
  expect_true(any(!is.na(sa$grid$posterior_mean)))
})

test_that("sensitivity_grid degrades a single failed grid point to NA rather
           than aborting, when the conjugate update fails only at that
           point", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  real_update <- .conjugate_update
  testthat::local_mocked_bindings(
    .conjugate_update = function(prior, data_summary) {
      if (identical(prior$params$alpha, 2)) stop("simulated update failure")
      real_update(prior, data_summary)
    },
    .package = "bayprior"
  )
  sa <- sensitivity_grid(
    prior, list(type = "binary", x = 14, n = 40),
    list(alpha = c(1, 2, 3), beta = c(2, 4)),
    target = "posterior_mean"
  )
  expect_equal(sum(is.na(sa$grid$posterior_mean)), 2L)
  expect_true(any(!is.na(sa$grid$posterior_mean)))
})

test_that("sensitivity_grid aborts with a clear message when every grid
           point fails to produce a value for a target", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  testthat::local_mocked_bindings(
    .make_bayprior = function(...) stop("simulated total failure"),
    .package = "bayprior"
  )
  expect_error(
    sensitivity_grid(
      prior, list(type = "binary", x = 14, n = 40),
      list(alpha = 1:2, beta = 2:3), target = "posterior_mean"
    ),
    "All grid evaluations returned NA"
  )
})

test_that("sensitivity_cri degrades a single failed grid point to NA rather
           than aborting, when prior construction fails only at that point", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  real_make <- .make_bayprior
  testthat::local_mocked_bindings(
    .make_bayprior = function(dist, params, ...) {
      if (identical(params$alpha, 2)) stop("simulated construction failure")
      real_make(dist, params, ...)
    },
    .package = "bayprior"
  )
  cri_sa <- sensitivity_cri(
    prior, list(type = "binary", x = 14, n = 40),
    list(alpha = c(1, 2, 3), beta = c(2, 4))
  )
  expect_equal(sum(is.na(cri_sa$grid$cri_width)), 2L)
  expect_true(any(!is.na(cri_sa$grid$cri_width)))
})

test_that("sensitivity_cri degrades a single failed grid point to NA rather
           than aborting, when the conjugate update fails only at that
           point", {
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  real_update <- .conjugate_update
  testthat::local_mocked_bindings(
    .conjugate_update = function(prior, data_summary) {
      if (identical(prior$params$alpha, 2)) stop("simulated update failure")
      real_update(prior, data_summary)
    },
    .package = "bayprior"
  )
  cri_sa <- sensitivity_cri(
    prior, list(type = "binary", x = 14, n = 40),
    list(alpha = c(1, 2, 3), beta = c(2, 4))
  )
  expect_equal(sum(is.na(cri_sa$grid$cri_width)), 2L)
  expect_true(any(!is.na(cri_sa$grid$cri_width)))
})

# -- sensitivity_cri(): Gamma prob_efficacy branch, and the CrI-bounds
# "else" (Normal-approximation) branch for a non-beta/normal/gamma posterior

test_that("sensitivity_cri computes prob_efficacy via the Gamma branch", {
  gp <- elicit_gamma(mean = 2, sd = 1, method = "moments")
  cri_sa <- sensitivity_cri(
    gp, list(type = "poisson", x = 3, n = 10),
    list(shape = seq(1, 4, 1), rate = seq(0.5, 2, 0.5)),
    cri_level = 0.95, threshold = 2
  )
  expect_true("prob_efficacy" %in% names(cri_sa$grid))
  expect_false(all(is.na(cri_sa$grid$prob_efficacy)))
})

# -- Sensitivity plots ---------------------------------------------------------

.sens_fixture <- function(n_params = 2) {
  if (n_params == 1) {
    prior <- elicit_exponential(mean = 2.0, method = "moments")
    return(suppressMessages(sensitivity_grid(
      prior, list(type = "poisson", x = 8, n = 20),
      list(rate = seq(0.2, 1.0, by = 0.2)),
      target = "posterior_mean", threshold = 0.5
    )))
  }
  prior <- elicit_beta(mean = 0.30, sd = 0.10, method = "moments")
  suppressMessages(sensitivity_grid(
    prior, list(type = "binary", x = 15, n = 50),
    list(alpha = seq(2, 6, length.out = 6), beta = seq(4, 12, length.out = 6)),
    target = c("posterior_mean", "prob_efficacy")
  ))
}

.hover_text <- function(p) {
  b <- plotly::plotly_build(p)
  unlist(lapply(b$x$data, function(tr) tr$text), use.names = FALSE)
}

test_that("static plots are ggplots; interactive = TRUE returns plotly", {
  skip_if_not_installed("plotly")
  s <- .sens_fixture()
  expect_s3_class(plot_sensitivity(s, target = "posterior_mean"), "ggplot")
  expect_s3_class(plot_tornado(s), "ggplot")
  expect_s3_class(plot_sensitivity(s, target = "posterior_mean",
                                   interactive = TRUE), "plotly")
  expect_s3_class(plot_tornado(s, interactive = TRUE), "plotly")
})

test_that("interactive plots emit no warnings", {
  skip_if_not_installed("plotly")
  s <- .sens_fixture()
  expect_no_warning(plot_sensitivity(s, target = "posterior_mean", interactive = TRUE))
  expect_no_warning(plot_sensitivity(.sens_fixture(1), target = "posterior_mean",
                                     interactive = TRUE))
  expect_no_warning(plot_tornado(s, interactive = TRUE))
})

test_that("static plots carry no tooltip aesthetic", {
  p <- plot_sensitivity(.sens_fixture(), target = "posterior_mean")
  aes_names <- unlist(lapply(p$layers, function(l) names(l$mapping)))
  expect_false("text" %in% aes_names)
})

test_that("heatmap tooltip uses labels and rounded values", {
  skip_if_not_installed("plotly")
  txt <- .hover_text(plot_sensitivity(.sens_fixture(2), target = "posterior_mean",
                                      interactive = TRUE))
  expect_true(any(grepl("Reference prior", txt)))
  expect_true(any(grepl("Posterior mean", txt)))
  expect_false(any(grepl("#[0-9A-Fa-f]{6}", txt)))
  expect_false(any(grepl("posterior_mean", txt)))
  nums <- unlist(regmatches(txt, gregexpr("[0-9]+\\.[0-9]+", txt)))
  expect_true(all(nchar(sub("^[0-9]+\\.", "", nums)) <= 3))
})

test_that("line-plot tooltip works for a single varied parameter", {
  skip_if_not_installed("plotly")
  s <- .sens_fixture(1)
  expect_length(names(s$param_grid), 1L)
  txt <- .hover_text(plot_sensitivity(s, target = "posterior_mean",
                                      interactive = TRUE))
  expect_true(any(grepl("Reference prior", txt)))
  expect_true(any(grepl("rate = ", txt)))
})

test_that("interactive tornado shows reference value, range, title and subtitle", {
  skip_if_not_installed("plotly")
  p   <- plot_tornado(.sens_fixture(2), interactive = TRUE)
  txt <- .hover_text(p)
  expect_true(any(grepl("Reference prior: ", txt)))
  expect_true(any(grepl("Range across grid: .+ to ", txt)))
  title <- plotly::plotly_build(p)$x$layout$title$text
  expect_match(title, "Prior influence on posterior estimates")
  expect_match(title, "<sup>", fixed = TRUE)
})

test_that("plots raise no tidy-eval warnings", {
  for (np in c(2, 1)) {
    s <- .sens_fixture(np)
    w <- character()
    withCallingHandlers(
      {
        plot_sensitivity(s, target = "posterior_mean")
        plot_tornado(s)
        .sensitivity_gg(s, "posterior_mean", TRUE, tooltip = TRUE)
        .tornado_gg(s, NULL, NULL, tooltip = TRUE)
      },
      warning = function(x) {
        w <<- c(w, conditionMessage(x)); invokeRestart("muffleWarning")
      }
    )
    expect_false(any(grepl("discouraged", w)))
  }
})

test_that("plot_sensitivity rejects non-sensitivity input", {
  expect_error(plot_sensitivity(list()), "bayprior_sensitivity")
})

test_that(".plotly_title sets title and subtitle", {
  skip_if_not_installed("plotly")
  mk <- function() plotly::plot_ly(x = 1:3, y = 1:3, type = "scatter", mode = "lines")
  b <- plotly::plotly_build(.plotly_title(mk(), "Main title", "Sub title"))
  expect_match(b$x$layout$title$text, "Main title<br><sup>Sub title</sup>",
               fixed = TRUE)
  b2 <- plotly::plotly_build(.plotly_title(mk(), "Only"))
  expect_identical(b2$x$layout$title$text, "Only")
})