test_that("Px matches Chapter 9 whole life premium identity", {
  x <- 40
  i <- 0.05

  expect_equal(
    Px(x, i = i, model = "uniform", omega = 100),
    Ax(x, i = i, model = "uniform", omega = 100) /
      adotx(x, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  d <- i / (1 + i)

  expect_equal(
    Px(x, i = i, model = "uniform", omega = 100),
    1 / adotx(x, i = i, model = "uniform", omega = 100) - d,
    tolerance = 1e-10
  )
})

test_that("Pxn1, PnEx, and Pxn match Chapter 9 temporary formulas", {
  x <- 40
  n <- 20
  i <- 0.05

  p_term <- Pxn1(x, n, i = i, model = "uniform", omega = 100)
  p_pe   <- PnEx(x, n, i = i, model = "uniform", omega = 100)
  p_end  <- Pxn(x, n, i = i, model = "uniform", omega = 100)

  expect_equal(
    p_term,
    Axn1(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    p_pe,
    nEx(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    p_end,
    Axn(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(p_end, p_term + p_pe, tolerance = 1e-10)
})

test_that("limited-payment premiums use temporary premium annuity denominator", {
  x <- 35
  n <- 20
  t <- 10
  i <- 0.05

  expect_equal(
    tPx(x, t, i = i, model = "uniform", omega = 100),
    Ax(x, i = i, model = "uniform", omega = 100) /
      adotxn(x, t, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    tPxn1(x, n, t, i = i, model = "uniform", omega = 100),
    Axn1(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, t, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    tPnEx(x, n, t, i = i, model = "uniform", omega = 100),
    nEx(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, t, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    tPxn(x, n, t, i = i, model = "uniform", omega = 100),
    Axn(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, t, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )
})

test_that("deferred insurance premium functions match Chapter 9 identities", {
  x <- 40
  n <- 15
  t <- 10
  i <- 0.05

  expect_equal(
    PnAx(x, n, i = i, model = "uniform", omega = 100),
    nAx(x, n, i = i, model = "uniform", omega = 100) /
      adotx(x, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    tPnAx(x, n, t, i = i, model = "uniform", omega = 100),
    nAx(x, n, i = i, model = "uniform", omega = 100) /
      adotxn(x, t, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )
})

test_that("continuous payment premium functions match formulas", {
  x <- 40
  n <- 20
  i <- 0.05

  expect_equal(
    Pbarx(x, i = i, model = "uniform", omega = 100),
    Ax(x, i = i, model = "uniform", omega = 100) /
      abarx(x, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )

  expect_equal(
    Pbarxn1(x, n, i = i, model = "uniform", omega = 100),
    Axn1(x, n, i = i, model = "uniform", omega = 100) /
      abarxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )

  expect_equal(
    Pbarxn(x, n, i = i, model = "uniform", omega = 100),
    Axn(x, n, i = i, model = "uniform", omega = 100) /
      abarxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )
})

test_that("fully continuous premium functions match formulas and identity", {
  x <- 40
  n <- 20
  i <- 0.05
  delta <- log(1 + i)

  expect_equal(
    PbarAbarx(x, i = i, model = "uniform", omega = 100),
    Abarx(x, i = i, model = "uniform", omega = 100) /
      abarx(x, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )

  expect_equal(
    PbarAbarx(x, i = i, model = "uniform", omega = 100),
    1 / abarx(x, i = i, model = "uniform", omega = 100) - delta,
    tolerance = 1e-9
  )

  expect_equal(
    PbarAbarxn1(x, n, i = i, model = "uniform", omega = 100),
    Abarxn1(x, n, i = i, model = "uniform", omega = 100) /
      abarxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )

  expect_equal(
    PbarAbarxn(x, n, i = i, model = "uniform", omega = 100),
    Abarxn(x, n, i = i, model = "uniform", omega = 100) /
      abarxn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )
})

test_that("true fractional premiums match Chapter 9 formulas", {
  x <- 40
  n <- 20
  i <- 0.05
  m <- 12

  expect_equal(
    Px_m(x, m = m, i = i, model = "uniform", omega = 100),
    Ax(x, i = i, model = "uniform", omega = 100) /
      adotx_m(x, m = m, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    Pxn1_m(x, n, m = m, i = i, model = "uniform", omega = 100),
    Axn1(x, n, i = i, model = "uniform", omega = 100) /
      adotxn_m(x, n, m = m, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    Pxn_m(x, n, m = m, i = i, model = "uniform", omega = 100),
    Axn(x, n, i = i, model = "uniform", omega = 100) /
      adotxn_m(x, n, m = m, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    PnAx_m(x, n, m = m, i = i, model = "uniform", omega = 100),
    nAx(x, n, i = i, model = "uniform", omega = 100) /
      adotx_m(x, m = m, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )
})

test_that("expected loss is zero under equivalence-principle premium", {
  x <- 40
  n <- 20
  i <- 0.05

  expect_equal(
    EL0x(x, P = Px(x, i = i, model = "uniform", omega = 100),
         i = i, model = "uniform", omega = 100),
    0,
    tolerance = 1e-10
  )

  expect_equal(
    EL0xn1(x, n, P = Pxn1(x, n, i = i, model = "uniform", omega = 100),
           i = i, model = "uniform", omega = 100),
    0,
    tolerance = 1e-10
  )

  expect_equal(
    EL0xn(x, n, P = Pxn(x, n, i = i, model = "uniform", omega = 100),
          i = i, model = "uniform", omega = 100),
    0,
    tolerance = 1e-10
  )

  expect_equal(
    EL0barAbarx(x, P = PbarAbarx(x, i = i, model = "uniform", omega = 100),
                i = i, model = "uniform", omega = 100),
    0,
    tolerance = 1e-9
  )
})

test_that("loss variances match Chapter 9 formulas", {
  x <- 40
  n <- 20
  i <- 0.05
  d <- i / (1 + i)
  delta <- log(1 + i)

  P_wl <- Px(x, i = i, model = "uniform", omega = 100)
  P_term <- Pxn1(x, n, i = i, model = "uniform", omega = 100)
  P_end <- Pxn(x, n, i = i, model = "uniform", omega = 100)
  P_cont <- PbarAbarx(x, i = i, model = "uniform", omega = 100)

  expect_equal(
    varL0x(x, P = P_wl, i = i, model = "uniform", omega = 100),
    (1 + P_wl / d)^2 * var_Ax(x, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    varL0xn1(x, n, P = P_term, i = i, model = "uniform", omega = 100),
    (1 + P_term / d)^2 * var_Axn1(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    varL0xn(x, n, P = P_end, i = i, model = "uniform", omega = 100),
    (1 + P_end / d)^2 * var_Axn(x, n, i = i, model = "uniform", omega = 100),
    tolerance = 1e-10
  )

  expect_equal(
    varL0barAbarx(x, P = P_cont, i = i, model = "uniform", omega = 100),
    (1 + P_cont / delta)^2 * var_Abarx(x, i = i, model = "uniform", omega = 100),
    tolerance = 1e-9
  )
})

test_that("gross premium whole life matches Example 9.10 formula structure", {
  x <- 40
  i <- 0.05

  Ax_val <- Ax(x, i = i, model = "uniform", omega = 100)
  ax_val <- ax(x, i = i, model = "uniform", omega = 100)
  adotx_val <- adotx(x, i = i, model = "uniform", omega = 100)

  G_manual <- ((1000 + 20) * Ax_val + 10 + 2 * ax_val) /
    (adotx_val - 0.75 - 0.10 * ax_val)

  G_pkg <- Gx(
    x = x,
    i = i,
    benefit = 1000,
    first_premium_pct = 0.75,
    renewal_premium_pct = 0.10,
    first_policy_exp = 10,
    renewal_policy_exp = 2,
    settlement_exp = 20,
    model = "uniform",
    omega = 100
  )

  expect_equal(G_pkg, G_manual, tolerance = 1e-10)
})

test_that("premium functions vectorize over x and n", {
  x <- c(30, 40, 50)
  n <- c(10, 15, 20)
  t <- c(5, 10, 10)
  i <- 0.05

  expect_length(Px(x, i = i, model = "uniform", omega = 100), 3)
  expect_length(Pxn1(x, n, i = i, model = "uniform", omega = 100), 3)
  expect_length(PnEx(x, n, i = i, model = "uniform", omega = 100), 3)
  expect_length(Pxn(x, n, i = i, model = "uniform", omega = 100), 3)
  expect_length(tPxn1(x, n, t, i = i, model = "uniform", omega = 100), 3)
  expect_length(PnAx(x, n, i = i, model = "uniform", omega = 100), 3)
})

test_that("functions reject invalid t-pay structures", {
  expect_error(
    tPxn1(40, n = 10, t = 12, i = 0.05, model = "uniform", omega = 100),
    "t must satisfy t <= n"
  )

  expect_error(
    tPnAx(40, n = 10, t = 12, i = 0.05, model = "uniform", omega = 100),
    "t must satisfy t <= n"
  )
})

test_that("premium functions return finite values in standard cases", {
  i <- 0.05

  vals <- c(
    Px(40, i = i, model = "uniform", omega = 100),
    Pxn1(40, 20, i = i, model = "uniform", omega = 100),
    PnEx(40, 20, i = i, model = "uniform", omega = 100),
    Pxn(40, 20, i = i, model = "uniform", omega = 100),
    PbarAbarx(40, i = i, model = "uniform", omega = 100),
    Px_m(40, m = 12, i = i, model = "uniform", omega = 100)
  )

  expect_true(all(is.finite(vals)))
  expect_true(all(vals > 0))
})




test_that("annual premium functions vectorize over interest rates", {
  out <- Px(
    x = 40,
    i = c(0.03, 0.05),
    model = "uniform",
    omega = 100
  )

  expect_length(out, 2)
  expect_true(all(is.finite(out)))
})

test_that("term premium functions vectorize over x, n, and i", {
  out <- Pxn1(
    x = c(40, 45),
    n = c(10, 15),
    i = c(0.04, 0.05),
    model = "uniform",
    omega = 100
  )

  expect_length(out, 2)
  expect_true(all(is.finite(out)))
})

test_that("limited-payment premium functions vectorize over t", {
  out <- tPxn(
    x = 40,
    n = c(10, 20),
    t = c(5, 10),
    i = 0.05,
    model = "uniform",
    omega = 100
  )

  expect_length(out, 2)
  expect_true(all(is.finite(out)))
})

test_that("limited-payment premiums require t not to exceed n", {
  expect_error(
    tPxn1(
      x = 40,
      n = 10,
      t = 15,
      i = 0.05,
      model = "uniform",
      omega = 100
    ),
    "t must satisfy t <= n"
  )
})

test_that("premium functions reject incompatible vector lengths", {
  expect_error(
    Pxn(
      x = c(40, 45),
      n = c(10, 15, 20),
      i = 0.05,
      model = "uniform",
      omega = 100
    ),
    "compatible lengths"
  )

  expect_error(
    EL0xn(
      x = c(40, 45),
      n = c(10, 15),
      P = c(0.01, 0.02, 0.03),
      i = 0.05,
      model = "uniform",
      omega = 100
    ),
    "compatible lengths"
  )
})

test_that("loss functions vectorize over premium amounts", {
  out <- EL0x(
    x = 40,
    P = c(0.01, 0.02),
    i = 0.05,
    model = "uniform",
    omega = 100
  )

  expect_length(out, 2)
  expect_true(all(is.finite(out)))
})

test_that("gross premium function vectorizes expense inputs", {
  out <- Gx(
    x = c(40, 45),
    i = 0.05,
    benefit = c(100000, 150000),
    first_premium_pct = 0.5,
    renewal_premium_pct = 0.05,
    first_policy_exp = c(100, 125),
    renewal_policy_exp = 25,
    settlement_exp = 200,
    model = "uniform",
    omega = 100
  )

  expect_length(out, 2)
  expect_true(all(is.finite(out)))
  expect_true(all(out > 0))
})

test_that("premium functions work with a finite life table", {
  tbl <- life_table(
    x = 0:3,
    lx = c(100000, 80000, 50000, 0)
  )

  out <- Px(
    x = 0,
    i = 0.05,
    tbl = tbl
  )

  expect_length(out, 1)
  expect_true(is.finite(out))
  expect_true(out > 0)
})

test_that("scalar premium calls preserve scalar behavior", {
  out <- Px(
    x = 40,
    i = 0.05,
    model = "uniform",
    omega = 100
  )

  expect_length(out, 1)
  expect_true(is.numeric(out))
  expect_true(is.finite(out))
})
