tests/testthat/test-get_risk.R

In healthiar: Quantifying and Monetizing Health Impacts Attributable to Exposure

# QUANTITATIVE TEST ############################################################
testthat::test_that("linear rescaling correct", {

  ## exp = 10, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 10,
      cutoff = 5,
      rr = 1.1,
      rr_increment = 10,
      erf_shape = "linear"
    ),
    expected = 1.05
    )

  ## exp = 15, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 15,
      cutoff = 5,
      rr = 1.1,
      rr_increment = 10,
      erf_shape = "linear"
    ),
    expected = 1.1
  )

  ## exp = 0, cutoff = 0
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 0,
      cutoff = 0,
      rr = 1.1,
      rr_increment = 10,
      erf_shape = "linear"
    ),
    expected = 1
  )

  ## exp = 0, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 0,
      cutoff = 5,
      rr = 1.1,
      rr_increment = 10,
      erf_shape = "linear"
    ),
    expected = 1
  )

}
)

testthat::test_that("log-linear rescaling the same", {

  ## exp = 20, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 20,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_linear"
    ) |> base::round(x = _, digits = 4),
    expected =
      1.1224
  )

  ## exp = 15, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 15,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_linear"
    ) |> base::round(x = _, digits = 4),
    expected =
      1.08
  )

  ## exp = 5, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 5,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_linear"
    ) |> base::round(x = _, digits = 4),
    expected =
      1
  )

  ## exp = 0, cutoff = 0
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 0,
      cutoff = 0,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_linear"
    ) |> base::round(x = _, digits = 4),
    expected =
      1
  )

  ## exp = 0, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 0,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_linear"
    ) |> base::round(x = _, digits = 4),
    expected =
      1
  )

}
)

## NOTE 2025-08-08: This example uses the log-log curve initially proposed by ChatGPT, which is not defined for exp = 0 or exp <= cutoff (that's why it's commented out); once we've settled on these new ERFs remove these error messages
# testthat::test_that("linear-log rescaling the same", {
#   testthat::expect_equal(
#     object = healthiar::get_risk(
#       exp = 20,
#       cutoff = 5,
#       rr = 1.08,
#       rr_increment = 10,
#       erf_shape = "log_log"
#       ) |> base::round(x = _, digits = 4),
#     expected =
#       1.0941 # Results on 06 August 2024 (ChatGPT); no comparison study
#   )
# }
# )

## This example uses the adapted lin-log curve (adapted based on the on the Pozzer 2022 (http://doi.org/10.1029/2022GH000711) log-log ERF)
testthat::test_that("linear-log rescaling the same", {

  ## exp = 20, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 20,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "linear_log"
      ),
    expected =
      1.102179903 # Results on 08 August 2024 (ChatGPT); no comparison study
  )

  ## exp = 15, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 15,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "linear_log"
    ),
    expected =
      1.08
  )

  ## exp = 5, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 5,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "linear_log"
    ),
    expected =
      1
  )

  ## exp = 0, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 5,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "linear_log"
    ),
    expected =
      1
  )

  ## exp = 0, cutoff = 0
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 5,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "linear_log"
    ),
    expected =
      1
  )

}
)


## This example uses the log-log curve based on Pozzer 2022 (http://doi.org/10.1029/2022GH000711)
testthat::test_that("log-log rescaling the same", {

  ## exp = 15
  ### because exp - cutoff = 15 - 5 = 10, the result matches exactly the rr value from the literature
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 15,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_log"
    ),
    expected =
      1.08 # Results on 08 August 2024 (ChatGPT); no comparison study
  )

  ## exp = cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 5,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_log"
    ),
    expected =
      1 # Results on 08 August 2024 (ChatGPT); no comparison study
  )

  ## exp = 0, cutoff = 5
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 5,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_log"
    ),
    expected =
      1 # Results on 08 August 2024 (ChatGPT); no comparison study
  )

  ## exp = 20
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 20,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_log"
    ),
    expected =
      1.103291954 # Results on 08 August 2024 (ChatGPT); no comparison study
  )

  ## exp = 10
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 10,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_log"
    ),
    expected =
      1.048709767 # Results on 08 August 2024 (ChatGPT); no comparison study
  )

  ## exp = 30
  testthat::expect_equal(
    object = healthiar::get_risk(
      exp = 30,
      cutoff = 5,
      rr = 1.08,
      rr_increment = 10,
      erf_shape = "log_log"
    ),
    expected =
      1.13752842 # Results on 08 August 2024 (ChatGPT); no comparison study
  )
}
)

## NOTE 2025-08-08: This example uses the log-log curve initially proposed by ChatGPT, which is not defined for exp = 0 or exp <= cutoff (that's why it's commented out); once we've settled on these new ERFs remove these error messages
# testthat::test_that("log-log rescaling the same", {
#   testthat::expect_equal(
#     object = healthiar::get_risk(
#       exp = 20,
#       cutoff = 5,
#       rr = 1.08,
#       rr_increment = 10,
#       erf_shape = "log_log"
#     ) |> base::round(x = _, digits = 4),
#     expected =
#       1.0947 # Results on 06 August 2024 (ChatGPT); no comparison study
#   )
# }
# )

testthat::test_that("log-log rescaling the same based on Lehtomäki et al.", {


data <- read.csv(testthat::test_path("data","HeliLog-logcurve.csv")) #Lehtomäki et al. 2024

testthat::expect_equal(
  signif(healthiar::get_risk(
  exp = rep(data$exposure, each = 3),
  cutoff = 0,
  rr = c(1.08,1.06,1.09), #actual-cause mortality was 1.08 (95%CI 1.06, 1.09) per 10 µg/m3 (Chen and Hoek 2020).
  rr_increment = c(10),
  erf_shape = "log_log"),5),
  expected = c(matrix(c(data$RRcentral,data$RR.lower,data$RRupper), nrow = 3, byrow = TRUE)))

})


# ERROR OR WARNING ########
## ERROR #########
## WARNING #########