test-Helper_functions.R
In LTFHPlus: Implementation of LT-FH++

################################################################################
# Testing truncated_normal_cdf
################################################################################

# Positive Tests
test_that("truncated_normal_cdf works with default parameters", {
  liability <- 0.5
  test <- truncated_normal_cdf(liability)
  expected <- -0.2585375387
  expect_equal(test, expected)
})

test_that("truncated_normal_cdf works with non-default parameters", {
  liability <- 0.5
  lower <- 1.0
  upper <- 2.0
  test <- truncated_normal_cdf(liability, lower, upper)
  expected <- -0.1498822848
  expect_equal(test, expected)
})

test_that("truncated_normal_cdf works with swapped lower and upper values", {
  liability <- 0.5
  test <- truncated_normal_cdf(0.5, lower = Inf, upper = 1.644853627)
  expected <- -0.2585375387
  expect_equal(test, expected)
})

# Negative Tests

test_that("truncated_normal_cdf rejects non-numeric arguments", {
  expect_error(truncated_normal_cdf("liability"), "liability must be numeric")
  expect_error(truncated_normal_cdf(0.5, lower = "lower"), "lower cutoff point must be numeric")
  expect_error(truncated_normal_cdf(0.5, upper = "upper"), "upper cutoff point must be numeric")
})


################################################################################
# Testing convert_age_to_cir
################################################################################

# Positive Tests
test_that("convert_age_to_cir works with default parameters", {
  age <- 40
  expected_cir <- 0.007585818
  test <- convert_age_to_cir(age)
expect_equal(test, expected_cir)
})

test_that("convert_age_to_cir works with non-default parameters", {
  age <- 50
  pop_prev <- 0.2
  mid_point <- 70
  slope <- 1/10
  expected_cir <- 0.02384058
  test <- convert_age_to_cir(age, pop_prev, mid_point, slope)
  expect_equal(test, expected_cir)
})

test_that("convert_age_to_cir works with boundary values", {
  age_boundary <- 0
  pop_prev_boundary <- 1
  mid_point_boundary <- 1
  slope_boundary <- 0
  expected_cir_boundary <- 0.5
  test <- convert_age_to_cir(age_boundary, pop_prev_boundary, mid_point_boundary, slope_boundary)
  expect_equal(test, expected_cir_boundary)
})

test_that("convert_age_to_cir works with negative slope", {
  test <- convert_age_to_cir(age = 40, slope = -1/12)
  expect_equal(test, 0.0841131)
})

# Negative Tests
test_that("convert_age_to_cir rejects negative age", {
  expect_error(convert_age_to_cir(-1), "age must be non-negative")
})

test_that("convert_age_to_cir warns of unrealistic age", {
  expect_warning(convert_age_to_cir(150), "it is unrealistic to be of age 150 or older")
})

test_that("convert_age_to_cir rejects invalid pop_prev", {
  expect_error(convert_age_to_cir(30, pop_prev = -0.1), "pop_prev must be positive")
  expect_error(convert_age_to_cir(30, pop_prev = 1.1), "pop_prev must be smaller or equal to 1")
})

test_that("convert_age_to_cir rejects non-positive mid_point", {
  expect_error(convert_age_to_cir(30, mid_point = 0), "mid_point must be positive")
})

test_that("convert_age_to_cir rejects non-numeric arguments", {
  expect_error(convert_age_to_cir("age"), "age must be numeric")
  expect_error(convert_age_to_cir(30, pop_prev = "pop_prev"), "pop_prev must be numeric")
  expect_error(convert_age_to_cir(30, mid_point = "mid_point"), "mid_point must be numeric")
  expect_error(convert_age_to_cir(30, slope = "slope"), "slope must be numeric")
})

################################################################################
# Testing convert_age_to_thresh
################################################################################

# Positive Tests
test_that("convert_age_to_thresh works with default parameters in logistic mode", {
  age <- 40
  expected_value <- 2.428255857
  test <- convert_age_to_thresh(age)
  expect_equal(test, expected_value)
})

test_that("convert_age_to_thresh defaults to logistic with invalid dist", {
  age <- 40
  expected_value <- 2.428255857
  test <- convert_age_to_thresh(age, dist = "invalid")
  expect_equal(test, expected_value)
})

test_that("convert_age_to_thresh uses first valid dist", {
  age <- 40
  expected_value <- 2.1280452341849840359
  test <- convert_age_to_thresh(age, dist = c("invalid", "normal", "logistic"))
  expect_equal(test, expected_value)
})

test_that("convert_age_to_thresh works with default parameters in normal mode", {
  age <- 40
  expected_value <- 2.1280452341849840359
  test <- convert_age_to_thresh(age, dist = "normal")
  expect_equal(test, expected_value)
})

test_that("convert_age_to_thresh works in normal mode with min and max age swapped", {
  age <- 40
  min_age <- 90
  max_age <- 10
  expected_value <- 2.1280452341849840359
  test <- convert_age_to_thresh(age, dist = "normal", min_age = min_age, max_age = max_age)
  expect_equal(test, expected_value)
})

test_that("convert_age_to_thresh works in normal mode with lower and upper swapped", {
  age <- 40
  lower <- Inf
  upper <- 1.644853626951472636
  expected_value <- 2.1280452341849840359
  test <- convert_age_to_thresh(age, dist = "normal", lower = lower, upper = upper)
  expect_equal(test, expected_value)
})

test_that("convert_age_to_thresh works with non-default parameters", {
  age <- 50
  pop_prev <- 0.2
  mid_point <- 70
  slope <- 1/10
  min_age <- 20
  max_age <- 80
  lower <- 1.96
  upper <- 3
  expected_value_logistic <- 1.98019903
  expected_value_normal <- 2.318248972
  test_logistic <- convert_age_to_thresh(age, dist = "logistic", pop_prev = pop_prev, mid_point = mid_point, slope = slope)
  test_normal <- convert_age_to_thresh(age, dist = "normal", min_age = min_age, max_age = max_age, lower = lower, upper = upper)
  expect_equal(test_logistic, expected_value_logistic)
  expect_equal(test_normal, expected_value_normal)
})

# Negative Tests
test_that("convert_age_to_thresh rejects non-positive age", {
  expect_error(convert_age_to_thresh(-1), "age must be non-negative")
})

test_that("convert_age_to_thresh rejects invalid logistic parameters", {
  expect_error(convert_age_to_thresh(30, dist = "logistic", pop_prev = -0.1), "pop_prev must be positive")
  expect_error(convert_age_to_thresh(30, dist = "logistic", pop_prev = 1.1), "pop_prev must be smaller or equal to 1")
  expect_error(convert_age_to_thresh(30, dist = "logistic", mid_point = -60), "mid_point must be positive")
  
})

test_that("convert_age_to_thresh rejects invalid normal parameters", {
  expect_error(convert_age_to_thresh(30, dist = "normal", min_age = -10), "min_age must be positive")
  expect_error(convert_age_to_thresh(30, dist = "normal", max_age = -10), "max_age must be positive")
})

test_that("convert_age_to_thresh rejects invalid dist", {
  expect_error(convert_age_to_thresh(30, dist = 123), "dist must be a string")
})

test_that("convert_age_to_thresh rejects non-numeric arguments", {
  expect_error(convert_age_to_thresh("age"), "age must be numeric")
  expect_error(convert_age_to_thresh(30, pop_prev = "pop_prev"), "pop_prev must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "normal", min_age = "min_age"), "min_age must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "normal", max_age = "max_age"), "max_age must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "normal", lower = "lower"), "lower cutoff point must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "normal", upper = "upper"), "upper cutoff point must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "logistic", slope = "invalid_slope"), "slope must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "logistic", mid_point = "invalid_mid_point"), "mid_point must be numeric")
  expect_error(convert_age_to_thresh(30, dist = "logistic", pop_prev = "invalid_pop_prev"), "pop_prev must be numeric")
  })

################################################################################
# Testing convert_cir_to_age
################################################################################

# Positive Tests
test_that("convert_cir_to_age works with default parameters", {
  cir <- 0.08
  expected_age <- 71.09035489
  test <- convert_cir_to_age(cir)
  expect_equal(test, expected_age)
})

test_that("convert_cir_to_age works with non-default parameters", {
  cir <- 0.08
  pop_prev <- 0.2
  mid_point <- 70
  slope <- 1/10
  expected_age <- 65.94534892
  test <- convert_cir_to_age(cir, pop_prev, mid_point, slope)
  expect_equal(test, expected_age)
})

test_that("convert_cir_to_age works with boundary values", {
  cir <- 0.0001
  pop_prev <- 1
  mid_point <- 0.0001
  slope <- -1/8
  expected_age <- 73.68202294
  test <- convert_cir_to_age(cir, pop_prev, mid_point, slope)
  expect_equal(test, expected_age)
})

test_that("convert_cir_to_age returns 0 instead of negative value", {
  cir <- 0.1
  mid_point <- 1
  pop_prev <- 1
  test <- convert_cir_to_age(cir, pop_prev, mid_point)
  expect_equal(test, 0)
})

# Negative Tests
test_that("convert_cir_to_age rejects non-positive cir", {
  expect_error(convert_cir_to_age(0), "cir must be positive")
  expect_error(convert_cir_to_age(-1), "cir must be positive")
})

test_that("convert_cir_to_age rejects invalid pop_prev", {
  expect_error(convert_cir_to_age(0.05, pop_prev = 0), "pop_prev must be positive")
  expect_error(convert_cir_to_age(0.05, pop_prev = -0.1), "pop_prev must be positive")
  expect_error(convert_cir_to_age(0.05, pop_prev = 1.1), "pop_prev must be smaller or equal to 1")
})

test_that("convert_cir_to_age returns NA when cir is greater than pop_prev", {
  expect_equal(convert_cir_to_age(0.5, pop_prev = 0.1), NA)
})

test_that("convert_cir_to_age rejects non-positive mid_point", {
  expect_error(convert_cir_to_age(0.05, mid_point = 0), "mid_point must be positive")
  expect_error(convert_cir_to_age(0.05, mid_point = -60), "mid_point must be positive")
})

test_that("convert_cir_to_age rejects non-numeric arguments", {
  expect_error(convert_cir_to_age("a"), "cir must be numeric")
  expect_error(convert_cir_to_age(0.05, pop_prev = "a"), "pop_prev must be numeric")
  expect_error(convert_cir_to_age(0.05, mid_point = "a"), "mid_point must be numeric")
  expect_error(convert_cir_to_age(0.05, slope = "a"), "slope must be numeric")
})

################################################################################
# Testing convert_liability_to_aoo
################################################################################

# Positive Tests
test_that("convert_liability_to_aoo works with default parameters in logistic mode", {
  liability <- 2
  expected_age <- 50.2202059
  test <- convert_liability_to_aoo(liability)
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo works with default parameters in normal mode", {
  liability <- 2
  expected_age <- 97.547511875336127218
  test <- convert_liability_to_aoo(liability, dist = "normal")
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo works with non-default parameters", {
  liability <- 2
  pop_prev <- 0.2
  mid_point <- 70
  slope <- 1/10
  min_aoo <- 20
  max_aoo <- 80
  lower <- 1.96
  upper <- 3
  
  expected_age_logistic <- 49.47010524
  expected_age_normal <- 99.82017894
  
  test_logistic <- convert_liability_to_aoo(liability, dist = "logistic", pop_prev = pop_prev, mid_point = mid_point, slope = slope)
  test_normal <- convert_liability_to_aoo(liability, dist = "normal", min_aoo = min_aoo, max_aoo = max_aoo, lower = lower, upper = upper)
  expect_equal(test_logistic, expected_age_logistic)
  expect_equal(test_normal, expected_age_normal)
})

test_that("convert_liability_to_aoo works with boundary values in logistic mode", {
  liability <- 2
  pop_prev <- 1
  expected_age <- 29.91862861
  test <- convert_liability_to_aoo(liability, pop_prev = pop_prev)
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo defaults to logistic with invalid dist", {
  liability <- 2
  expected_age <- 50.2202059
  test <- convert_liability_to_aoo(liability, dist = "invalid")
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo uses first valid dist", {
  liability <- 2
  expected_age <- 97.54751188
  test <- convert_liability_to_aoo(liability, dist = c("invalid", "normal", "logistic"))
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo can swap lower and upper in normal mode", {
  liability <- 2
  expected_age <- 97.547511875336127218
  test <- convert_liability_to_aoo(liability, dist = "normal", lower = Inf, upper = 1.644853626951472636)
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo can swap min_aoo and max_aoo in normal mode", {
  liability <- 2
  expected_age <- 97.547511875336127218
  test <- convert_liability_to_aoo(liability, dist = "normal", min_aoo = 90, max_aoo = 10)
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo returns 0 instead of negative values in logistic mode", {
  liability <- 10
  expected_age <- 0
  test <- convert_liability_to_aoo(liability)
  expect_equal(test, expected_age)
})

test_that("convert_liability_to_aoo returns 0 instead of negative values in normal mode", {
  liability <- 10
  expected_age <- 0
  test <- convert_liability_to_aoo(liability)
  expect_equal(test, expected_age)
})

# Negative Tests
test_that("convert_liability_to_aoo defaults to logistic when given invalid dist value", {
  expect_equal(convert_liability_to_aoo(2, dist = "invalid_dist"), 50.2202059)
})

test_that("convert_liability_to_aoo returns NA when liability is too low in logistic mode", {
  liability <- 1
  test <- convert_liability_to_aoo(liability)
  expect_equal(test, NA)
})


test_that("convert_liability_to_aoo rejects invalid logistic parameters", {
  expect_error(convert_liability_to_aoo(0.05, dist = "logistic", pop_prev = -0.1), "pop_prev must be positive")
  expect_error(convert_liability_to_aoo(0.05, dist = "logistic", pop_prev = 0), "pop_prev must be positive")
  expect_error(convert_liability_to_aoo(0.05, dist = "logistic", pop_prev = 1.1), "pop_prev must be smaller or equal to 1")
  expect_error(convert_liability_to_aoo(0.05, dist = "logistic", mid_point = -60), "mid_point must be positive")
  expect_error(convert_liability_to_aoo(0.05, dist = "logistic", mid_point = 0), "mid_point must be positive")
})

test_that("convert_liability_to_aoo rejects invalid normal parameters", {
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", min_aoo = -10), "min_aoo must be positive")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", min_aoo = 0), "min_aoo must be positive")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", max_aoo = -10), "max_aoo must be positive")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", max_aoo = 0), "max_aoo must be positive")
})

test_that("convert_liability_to_aoo rejects non-numeric arguments", {
  expect_error(convert_liability_to_aoo("liability"), "liability must be numeric")
  expect_error(convert_liability_to_aoo(0.05, dist = 123), "dist must be a string")
  expect_error(convert_liability_to_aoo(0.05, mid_point = "mid_point"), "mid_point must be numeric")
  expect_error(convert_liability_to_aoo(0.05, slope = "slope"), "slope must be numeric")
  expect_error(convert_liability_to_aoo(0.05, pop_prev = "pop_prev"), "pop_prev must be numeric")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", min_aoo = "min_aoo"), "min_aoo must be numeric")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", max_aoo = "max_aoo"), "max_aoo must be numeric")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", lower = "lower"), "lower cutoff point must be numeric")
  expect_error(convert_liability_to_aoo(0.05, dist = "normal", upper = "upper"), "upper cutoff point must be numeric")
})

################################################################################
# Testing convert_observed_to_liability_scale
################################################################################

# Positive Tests
test_that("convert_observed_to_liability_scale works with default parameters", {
  test <- convert_observed_to_liability_scale()
  expected <- 0.4242283384
  expect_equal(test, expected)
})

test_that("convert_observed_to_liability_scale works with single non-default parameters", {
  obs_h2 <- 0.6
  pop_prev <- 0.1
  prop_cases <- 0.6
  test <- convert_observed_to_liability_scale(obs_h2, pop_prev, prop_cases)
  expected <- 0.657474694
  expect_equal(test, expected)
})

test_that("convert_observed_to_liability_scale works with vector parameters", {
  obs_h2 <- c(0.6, 0.7)
  pop_prev <- c(0.1, 0.2)
  prop_cases <- c(0.6, 0.7)
  test <- convert_observed_to_liability_scale(obs_h2, pop_prev, prop_cases)
  expected <- c(0.657474694, 1.088731486)
  expect_equal(test, expected)
})

test_that("convert_observed_to_liability_scale works with NULL prop_cases", {
  obs_h2 <- 0.6
  pop_prev <- 0.1
  test <- convert_observed_to_liability_scale(obs_h2, pop_prev, NULL)
  expected <- 1.753265851
  expect_equal(test, expected)
})

# Negative Tests
test_that("convert_observed_to_liability_scale rejects negative inputs", {
  expect_error(convert_observed_to_liability_scale(-0.1, 0.05, 0.5), "observed heritability\\(ies\\) must be non-negative")
  expect_error(convert_observed_to_liability_scale(0.5, -0.1, 0.5), "population prevalence\\(s\\) must be non-negative")
  expect_error(convert_observed_to_liability_scale(0.5, 0.05, -0.1), "proportion\\(s\\) of cases must be non-negative")
})

test_that("convert_observed_to_liability_scale rejects inputs larger than 1", {
  expect_error(convert_observed_to_liability_scale(1.1, 0.05, 0.8), "observed heritability\\(ies\\) must be smaller than or equal to one")
  expect_error(convert_observed_to_liability_scale(0.5, 1.1, 0.8), "population prevalence\\(s\\) must be smaller than or equal to one")
  expect_error(convert_observed_to_liability_scale(0.5, 0.05, 1.1), "proportion\\(s\\) of cases must be smaller than or equal to one")
})

test_that("convert_observed_to_liability_scale rejects non-numeric inputs", {
  expect_error(convert_observed_to_liability_scale("obs_h2", 0.05, 0.5), "observed heritability\\(ies\\) must be numeric")
  expect_error(convert_observed_to_liability_scale(0.5, "pop_prev", 0.5), "population prevalence\\(s\\) must be numeric")
  expect_error(convert_observed_to_liability_scale(0.5, 0.05, "prop_cases"), "proportion\\(s\\) of cases must be numeric")
})