# Past the trained size hull the absolute-moment surface continues along its own
# boundary slope in log-size rather than freezing at the hull edge. These tests
# pin the three properties the extension has to have: it is continuous with the
# hull edge, it keeps moving as the component grows, and a downward fitted edge
# slope degenerates to the old freeze and is counted rather than deployed.
#
# The accuracy gate that chose this rule over freezing and over the fitted
# quadratic continued as its own extrapolant is the weekly certification gate at
# the end of this file (T2, BGMS_RUN_CERTIFICATION): it scores the extension
# against block-Gibbs gold, which is oracle machinery rather than a heartbeat.

# A one-component common-neighbour block: endpoints 1 and 2, k nodes adjacent to
# both and complete among themselves.
cn_block = function(k) {
  q = k + 2L
  G = matrix(0L, q, q)
  for(v in 3:q) G[1, v] = G[v, 1] = G[2, v] = G[v, 2] = 1L
  for(a in 3:(q - 1)) for(b in (a + 1):q) G[a, b] = G[b, a] = 1L
  G
}

# Hand-built surface: log-moment linear in log-size with slope `slope`, flat in
# density. Lets the extension be checked against a value known in closed form
# instead of against another fit.
flat_surface = function(slope, size_hi = 20, i0 = -1, i0_2 = -5) {
  fam = function(intercept) {
    list(
      c1 = c(intercept, slope, 0, 0, 0, 0, 0, 0, 0),
      c2 = c(intercept - 4, slope, 0, 0, 0, 0, 0, 0, 0),
      size_lo = 3, size_hi = size_hi, dens_lo = 0, dens_hi = 1,
      l1_lo = -50, l1_hi = 50, l2_lo = -50, l2_hi = 50, size_min = 3
    )
  }
  list(cn = fam(i0), bip = fam(i0_2))
}

eval_at = function(surf, k) {
  zc = bgms:::zratio_constants(0.5 * log(12), 3)
  bgms:::zratio_test_surface_eval(
    cn_block(k), 1, 2, zc$addc, zc$tg, zc$ihat, zc$ghat, zc$wt, zc$psi0,
    surf, zc$delta, zc$eta, FALSE, 1
  )
}

test_that("the extension is continuous with the hull edge", {
  surf = flat_surface(slope = 0.6, size_hi = 20)
  at_hull = eval_at(surf, 20L)
  # One node below the hull the surface is evaluated directly; at the hull the
  # extension term is exactly zero, so the two agree by construction and the
  # sequence has no step in it.
  expect_equal(eval_at(surf, 19L)$comp$s1[1] < at_hull$comp$s1[1], TRUE)
  expect_equal(at_hull$n_slope_floor, 0)
})

test_that("the extension keeps moving past the hull instead of freezing", {
  surf = flat_surface(slope = 0.6, size_hi = 20)
  s_hull = eval_at(surf, 20L)$comp$s1[1]
  s_out = eval_at(surf, 40L)$comp$s1[1]
  # log-moment linear in log-size with slope 0.6: doubling the size multiplies
  # the moment by 2^0.6, which the frozen clamp could not produce.
  expect_equal(s_out / s_hull, 2^0.6, tolerance = 1e-6)
  expect_gt(s_out, s_hull)
})

test_that("a downward fitted edge slope degenerates to the freeze and is counted", {
  # Absolute moments grow with component size, so a negative fitted slope at the
  # hull edge is a fit pathology. The extension must not deploy it.
  surf = flat_surface(slope = -0.4, size_hi = 20)
  s_hull = eval_at(surf, 20L)$comp$s1[1]
  out = eval_at(surf, 40L)
  expect_equal(out$comp$s1[1], s_hull, tolerance = 1e-12)
  expect_gt(out$n_slope_floor, 0)
  # Inside the hull nothing is extended, so nothing is floored.
  expect_equal(eval_at(surf, 12L)$n_slope_floor, 0)
})

test_that("the extension beats the freeze against block-Gibbs gold", {
  skip_on_cran()
  skip_unless_certification()
  withr::local_options(
    bgms.zratio_surface_cache = FALSE,
    bgms.correction_table_cache = FALSE
  )
  zc = bgms:::zratio_constants(0.5 * log(12), 2)
  # A deliberately small hull so a cheap block size lands in the extension zone.
  surf = bgms:::zratio_build_surfaces(zc, max_size = 20L, cores = 2L)
  expect_false(is.null(surf))
  k = 34L
  G = cn_block(k)
  gold = bgms:::zratio_test_gold_moments(
    G, 1, 2, zc$addc, zc$tg, zc$ihat, zc$ghat, zc$wt, zc$psi0,
    zc$delta, zc$eta, 2000L, 500L, 11L, FALSE, 1
  )
  expect_true(gold$valid)

  ext = bgms:::zratio_test_surface_eval(
    G, 1, 2, zc$addc, zc$tg, zc$ihat, zc$ghat, zc$wt, zc$psi0,
    surf, zc$delta, zc$eta, FALSE, 1
  )
  # The frozen arm: the same surface with the size hull pushed out of reach is
  # not available, so reproduce the freeze by evaluating at the hull edge.
  frozen = bgms:::zratio_test_surface_eval(
    cn_block(as.integer(surf$cn$size_hi)), 1, 2,
    zc$addc, zc$tg, zc$ihat, zc$ghat, zc$wt, zc$psi0,
    surf, zc$delta, zc$eta, FALSE, 1
  )
  err_ext = abs(ext$logR - gold$logR)
  err_frozen = abs(frozen$logR - gold$logR)
  # Measured over sizes 90-150 against a size-80 hull the extension holds
  # 0.0003-0.0007 nats where the freeze grows past 0.05; this gate uses a much
  # smaller hull and a nearer block, so it asserts the ordering and a loose
  # bound rather than the deployed numbers.
  expect_lt(err_ext, 0.01)
  expect_lt(err_ext, 0.5 * err_frozen)
  expect_equal(ext$n_slope_floor, 0)
})