tests/testthat/test-utils.R

In AsianOption: Asian Option Pricing with Price Impact

test_that("compute_p_adj returns valid probability", {
  p_adj <- compute_p_adj(1.05, 1.2, 0.8, 0.1, 1, 1)

  expect_true(is.numeric(p_adj))
  expect_length(p_adj, 1)
  expect_true(p_adj >= 0 && p_adj <= 1)
  expect_false(is.na(p_adj))
})

test_that("compute_p_adj handles zero price impact", {

  p_adj <- compute_p_adj(1.05, 1.2, 0.8, 0, 0, 0)

  p_standard <- (1.05 - 0.8)/(1.2 - 0.8)

  expect_equal(p_adj, p_standard, tolerance = 1e-10)
})

test_that("compute_p_adj changes with price impact", {
  p_adj_no_impact <- compute_p_adj(1.05, 1.2, 0.8, 0, 0, 0)
  p_adj_with_impact <- compute_p_adj(1.05, 1.2, 0.8, 0.1, 1, 1)

  expect_false(p_adj_no_impact == p_adj_with_impact)
})

test_that("compute_adjusted_factors returns correct structure", {
  factors <- compute_adjusted_factors(1.2, 0.8, 0.1, 1, 1)

  expect_type(factors, "list")
  expect_named(factors, c("u_tilde", "d_tilde"))
  expect_length(factors$u_tilde, 1)
  expect_length(factors$d_tilde, 1)
  expect_true(is.numeric(factors$u_tilde))
  expect_true(is.numeric(factors$d_tilde))
})

test_that("Adjusted factors satisfy ordering", {
  factors <- compute_adjusted_factors(1.2, 0.8, 0.1, 1, 1)

  expect_true(factors$u_tilde > factors$d_tilde)
})

test_that("Adjusted up factor increases with price impact", {
  factors_no_impact <- compute_adjusted_factors(1.2, 0.8, 0, 0, 0)
  factors_with_impact <- compute_adjusted_factors(1.2, 0.8, 0.1, 1, 1)

  expect_true(factors_with_impact$u_tilde > factors_no_impact$u_tilde)
  expect_equal(factors_no_impact$u_tilde, 1.2, tolerance = 1e-10)
})

test_that("Adjusted down factor decreases with price impact", {
  factors_no_impact <- compute_adjusted_factors(1.2, 0.8, 0, 0, 0)
  factors_with_impact <- compute_adjusted_factors(1.2, 0.8, 0.1, 1, 1)

  expect_true(factors_with_impact$d_tilde < factors_no_impact$d_tilde)
  expect_equal(factors_no_impact$d_tilde, 0.8, tolerance = 1e-10)
})

test_that("Adjusted factors match formula", {
  u <- 1.2
  d <- 0.8
  lambda <- 0.1
  v_u <- 1
  v_d <- 1

  factors <- compute_adjusted_factors(u, d, lambda, v_u, v_d)

  u_tilde_expected <- u * exp(lambda * v_u)
  d_tilde_expected <- d * exp(-lambda * v_d)

  expect_equal(factors$u_tilde, u_tilde_expected, tolerance = 1e-10)
  expect_equal(factors$d_tilde, d_tilde_expected, tolerance = 1e-10)
})

test_that("check_no_arbitrage correctly identifies valid cases", {

  result <- check_no_arbitrage(1.05, 1.2, 0.8, 0.1, 1, 1)

  expect_true(is.logical(result))
  expect_length(result, 1)
  expect_true(result)
})

test_that("check_no_arbitrage detects r too high", {

  result <- check_no_arbitrage(2.0, 1.2, 0.8, 0.1, 1, 1)

  expect_false(result)
})

test_that("check_no_arbitrage detects r too low", {

  result <- check_no_arbitrage(0.5, 1.2, 0.8, 0.1, 1, 1)

  expect_false(result)
})

test_that("check_no_arbitrage works with zero price impact", {

  result <- check_no_arbitrage(1.05, 1.2, 0.8, 0, 0, 0)

  expect_true(result)
})

test_that("check_no_arbitrage handles edge cases", {

  u_tilde <- 1.2 * exp(0.1 * 1)

  result <- check_no_arbitrage(u_tilde, 1.2, 0.8, 0.1, 1, 1)

  expect_false(result)
})

test_that("Utility functions work together consistently", {
  r <- 1.05
  u <- 1.2
  d <- 0.8
  lambda <- 0.1
  v_u <- 1
  v_d <- 1

  factors <- compute_adjusted_factors(u, d, lambda, v_u, v_d)

  p_adj <- compute_p_adj(r, u, d, lambda, v_u, v_d)

  p_adj_manual <- (r - factors$d_tilde) / (factors$u_tilde - factors$d_tilde)

  expect_equal(p_adj, p_adj_manual, tolerance = 1e-10)

  no_arb <- check_no_arbitrage(r, u, d, lambda, v_u, v_d)

  expect_true(no_arb)

  expect_true(p_adj >= 0)
  expect_true(p_adj <= 1)
})

test_that("Increasing lambda affects factors appropriately", {
  lambdas <- c(0, 0.1, 0.2, 0.3)
  u_tildes <- numeric(length(lambdas))
  d_tildes <- numeric(length(lambdas))

  for (i in seq_along(lambdas)) {
    factors <- compute_adjusted_factors(1.2, 0.8, lambdas[i], 1, 1)
    u_tildes[i] <- factors$u_tilde
    d_tildes[i] <- factors$d_tilde
  }

  expect_true(all(diff(u_tildes) > 0))

  expect_true(all(diff(d_tildes) < 0))
})

test_that("Asymmetric volumes handled correctly", {

  factors <- compute_adjusted_factors(1.2, 0.8, 0.1, 0.5, 1.5)

  expect_true(is.numeric(factors$u_tilde))
  expect_true(is.numeric(factors$d_tilde))
  expect_true(factors$u_tilde > factors$d_tilde)
})

test_that("Very small price impact behaves correctly", {

  factors <- compute_adjusted_factors(1.2, 0.8, 0.001, 1, 1)

  expect_equal(factors$u_tilde, 1.2, tolerance = 0.01)
  expect_equal(factors$d_tilde, 0.8, tolerance = 0.01)
})

test_that("compute_p_adj is consistent with manual calculation", {
  r <- 1.05
  u <- 1.2
  d <- 0.8
  lambda <- 0.15
  v_u <- 0.8
  v_d <- 1.2

  p_adj_func <- compute_p_adj(r, u, d, lambda, v_u, v_d)

  u_tilde <- u * exp(lambda * v_u)
  d_tilde <- d * exp(-lambda * v_d)
  p_adj_manual <- (r - d_tilde) / (u_tilde - d_tilde)

  expect_equal(p_adj_func, p_adj_manual, tolerance = 1e-12)
})

test_that("Results are reproducible", {

  p1 <- compute_p_adj(1.05, 1.2, 0.8, 0.1, 1, 1)
  p2 <- compute_p_adj(1.05, 1.2, 0.8, 0.1, 1, 1)
  expect_equal(p1, p2)

  f1 <- compute_adjusted_factors(1.2, 0.8, 0.1, 1, 1)
  f2 <- compute_adjusted_factors(1.2, 0.8, 0.1, 1, 1)
  expect_equal(f1, f2)

  c1 <- check_no_arbitrage(1.05, 1.2, 0.8, 0.1, 1, 1)
  c2 <- check_no_arbitrage(1.05, 1.2, 0.8, 0.1, 1, 1)
  expect_equal(c1, c2)
})