tests/testthat/test-kemna-vorst.R

In AsianOption: Asian Option Pricing with Price Impact

# Test suite for Kemna-Vorst implementation

test_that("Kemna-Vorst geometric average gives positive prices", {
  price <- price_kemna_vorst_geometric(
    S0 = 100, K = 100, r = 0.05, sigma = 0.2,
    T0 = 0, T_mat = 1, option_type = "call"
  )

  expect_true(is.numeric(price))
  expect_true(price > 0)
  expect_true(is.finite(price))
})

test_that("Kemna-Vorst geometric: call price increases with volatility", {
  price_low_vol <- price_kemna_vorst_geometric(
    100, 100, 0.05, 0.1, 0, 1, "call"
  )
  price_high_vol <- price_kemna_vorst_geometric(
    100, 100, 0.05, 0.3, 0, 1, "call"
  )

  expect_true(price_high_vol > price_low_vol)
})

test_that("Kemna-Vorst geometric: call price decreases with strike", {
  price_low_K <- price_kemna_vorst_geometric(
    100, 90, 0.05, 0.2, 0, 1, "call"
  )
  price_high_K <- price_kemna_vorst_geometric(
    100, 110, 0.05, 0.2, 0, 1, "call"
  )

  expect_true(price_low_K > price_high_K)
})

test_that("Kemna-Vorst geometric: put price increases with strike", {
  price_low_K <- price_kemna_vorst_geometric(
    100, 90, 0.05, 0.2, 0, 1, "put"
  )
  price_high_K <- price_kemna_vorst_geometric(
    100, 110, 0.05, 0.2, 0, 1, "put"
  )

  expect_true(price_high_K > price_low_K)
})

test_that("Kemna-Vorst geometric: zero volatility gives intrinsic value", {

  price_call <- price_kemna_vorst_geometric(
    100, 100, 0.05, 0, 0, 1, "call"
  )
  price_put <- price_kemna_vorst_geometric(
    100, 100, 0.05, 0, 0, 1, "put"
  )

  G_T <- 100 * exp(0.05 * 1 / 2)
  expected_call <- max(0, G_T - 100) * exp(-0.05)
  expected_put <- max(0, 100 - G_T) * exp(-0.05)

  expect_equal(price_call, expected_call, tolerance = 1e-6)
  expect_equal(price_put, expected_put, tolerance = 1e-6)
})

test_that("Kemna-Vorst geometric: deep ITM call approaches forward price", {

  price <- price_kemna_vorst_geometric(
    100, 50, 0.05, 0.2, 0, 1, "call"
  )

  expect_true(price > 40)
})

test_that("Kemna-Vorst geometric: input validation", {
  expect_error(
    price_kemna_vorst_geometric(-100, 100, 0.05, 0.2, 0, 1, "call"),
    "S0 must be a positive number"
  )
  expect_error(
    price_kemna_vorst_geometric(100, -100, 0.05, 0.2, 0, 1, "call"),
    "K must be a positive number"
  )
  expect_error(
    price_kemna_vorst_geometric(100, 100, 0.05, -0.2, 0, 1, "call"),
    "sigma must be a non-negative number"
  )
  expect_error(
    price_kemna_vorst_geometric(100, 100, 0.05, 0.2, 1, 0, "call"),
    "T_mat must be greater than T0"
  )
  expect_error(
    price_kemna_vorst_geometric(100, 100, 0.05, 0.2, 0, 1, "invalid"),
    "'arg' should be one of"
  )
})

test_that("Kemna-Vorst geometric binomial version works", {
  price <- price_kemna_vorst_geometric_binomial(
    S0 = 100, K = 100, r = 1.05,
    u = 1.2, d = 0.8, n = 10
  )

  expect_true(is.numeric(price))
  expect_true(price > 0)
  expect_true(is.finite(price))
})

test_that("Kemna-Vorst geometric binomial: validation", {
  expect_error(
    price_kemna_vorst_geometric_binomial(100, 100, 1.05, 0.9, 0.8, 10),
    "u must be greater than 1"
  )
  expect_error(
    price_kemna_vorst_geometric_binomial(100, 100, 1.05, 1.2, 1.1, 10),
    "d must be less than 1"
  )
})

test_that("Kemna-Vorst arithmetic Monte Carlo works", {
  result <- price_kemna_vorst_arithmetic(
    S0 = 100, K = 100, r = 0.05, sigma = 0.2,
    T0 = 0, T_mat = 1, n = 10, M = 1000,
    seed = 123
  )

  expect_true(is.numeric(result))
  expect_true(result > 0)
  expect_true(is.finite(result))
})

test_that("Kemna-Vorst arithmetic with diagnostics returns list", {
  result <- price_kemna_vorst_arithmetic(
    S0 = 100, K = 100, r = 0.05, sigma = 0.2,
    T0 = 0, T_mat = 1, n = 10, M = 1000,
    seed = 123, return_diagnostics = TRUE
  )

  expect_type(result, "list")
  expect_true("price" %in% names(result))
  expect_true("std_error" %in% names(result))
  expect_true("lower_ci" %in% names(result))
  expect_true("upper_ci" %in% names(result))
  expect_true("geometric_price" %in% names(result))
  expect_true("correlation" %in% names(result))
  expect_true("variance_reduction_factor" %in% names(result))
})

test_that("Kemna-Vorst arithmetic: control variate reduces variance", {
  set.seed(123)
  result_with <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 10, 5000,
    use_control_variate = TRUE, return_diagnostics = TRUE, seed = 123
  )

  set.seed(123)
  result_without <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 10, 5000,
    use_control_variate = FALSE, return_diagnostics = TRUE, seed = 123
  )

  expect_true(result_with$std_error < result_without$std_error)

  expect_true(result_with$variance_reduction_factor < 1)
  expect_true(result_with$variance_reduction_factor > 0)
})

test_that("Kemna-Vorst arithmetic: correlation is high", {
  result <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 50, 10000,
    return_diagnostics = TRUE, seed = 123
  )

  expect_true(result$correlation > 0.9)
})

test_that("Kemna-Vorst arithmetic: bounded by geometric", {

  geom_price <- price_kemna_vorst_geometric(
    100, 100, 0.05, 0.2, 0, 1, "call"
  )

  arith_price <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 50, 10000, seed = 123
  )

  expect_true(arith_price >= geom_price - 0.5)
})

test_that("Kemna-Vorst arithmetic: prices increase with volatility", {
  price_low <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.1, 0, 1, 20, 5000, seed = 123
  )

  price_high <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.3, 0, 1, 20, 5000, seed = 123
  )

  expect_true(price_high > price_low)
})

test_that("Kemna-Vorst arithmetic: call decreases with strike", {
  price_low_K <- price_kemna_vorst_arithmetic(
    100, 90, 0.05, 0.2, 0, 1, 20, 5000, seed = 123
  )

  price_high_K <- price_kemna_vorst_arithmetic(
    100, 110, 0.05, 0.2, 0, 1, 20, 5000, seed = 123
  )

  expect_true(price_low_K > price_high_K)
})

test_that("Kemna-Vorst arithmetic: put increases with strike", {
  price_low_K <- price_kemna_vorst_arithmetic(
    100, 90, 0.05, 0.2, 0, 1, 20, 5000,
    option_type = "put", seed = 123
  )

  price_high_K <- price_kemna_vorst_arithmetic(
    100, 110, 0.05, 0.2, 0, 1, 20, 5000,
    option_type = "put", seed = 123
  )

  expect_true(price_high_K > price_low_K)
})

test_that("Kemna-Vorst arithmetic: input validation", {
  expect_error(
    price_kemna_vorst_arithmetic(-100, 100, 0.05, 0.2, 0, 1, 10, 1000),
    "S0 must be a positive number"
  )
  expect_error(
    price_kemna_vorst_arithmetic(100, -100, 0.05, 0.2, 0, 1, 10, 1000),
    "K must be a positive number"
  )
  expect_error(
    price_kemna_vorst_arithmetic(100, 100, 0.05, -0.2, 0, 1, 10, 1000),
    "sigma must be a non-negative number"
  )
  expect_error(
    price_kemna_vorst_arithmetic(100, 100, 0.05, 0.2, 1, 0, 10, 1000),
    "T_mat must be greater than T0"
  )
  expect_error(
    price_kemna_vorst_arithmetic(100, 100, 0.05, 0.2, 0, 1, -5, 1000),
    "n must be a positive integer"
  )
  expect_error(
    price_kemna_vorst_arithmetic(100, 100, 0.05, 0.2, 0, 1, 10, -100),
    "M must be a positive integer"
  )
})

test_that("Kemna-Vorst arithmetic: warns for small M", {
  expect_warning(
    price_kemna_vorst_arithmetic(100, 100, 0.05, 0.2, 0, 1, 10, 500),
    "M = 500 is very small"
  )
})

test_that("Kemna-Vorst arithmetic binomial version works", {
  result <- price_kemna_vorst_arithmetic_binomial(
    S0 = 100, K = 100, r = 1.05,
    u = 1.2, d = 0.8, n = 10, M = 1000,
    seed = 123
  )

  expect_true(is.numeric(result))
  expect_true(result > 0)
  expect_true(is.finite(result))
})

test_that("Kemna-Vorst arithmetic binomial: validation", {
  expect_error(
    price_kemna_vorst_arithmetic_binomial(100, 100, 1.05, 0.9, 0.8, 10, 1000),
    "u must be greater than 1"
  )
  expect_error(
    price_kemna_vorst_arithmetic_binomial(100, 100, 1.05, 1.2, 1.1, 10, 1000),
    "d must be less than 1"
  )
})

test_that("Kemna-Vorst print and summary methods work", {
  result <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 10, 1000,
    return_diagnostics = TRUE, seed = 123
  )

  expect_output(print(result), "Kemna-Vorst Arithmetic Asian Option")
  expect_output(print(result), "Estimated Price")
  expect_output(print(result), "Standard Error")
  expect_output(print(result), "95% CI")

  expect_output(summary(result), "Kemna-Vorst Arithmetic Asian Option")
})

test_that("Kemna-Vorst: reproducibility with seed", {
  result1 <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 10, 1000, seed = 456
  )

  result2 <- price_kemna_vorst_arithmetic(
    100, 100, 0.05, 0.2, 0, 1, 10, 1000, seed = 456
  )

  expect_equal(result1, result2)
})

test_that("Kemna-Vorst: comparison with example from paper", {

  S0 <- 40
  K <- 40
  r_continuous <- log(1.05)
  sigma <- 0.2
  T0 <- 0
  T_mat <- 88 / 365

  geom_price <- price_kemna_vorst_geometric(
    S0, K, r_continuous, sigma, T0, T_mat, "call"
  )

  expect_true(geom_price > 1.0)
  expect_true(geom_price < 2.0)
})