tests/testthat/test-get_treatment_rate.R

In sutsabs/rwToT2: Real World Time on Treatment R Package

# function to extract numbers from string
get_numeric_vals <- function(data){
  pattern <- gregexpr("[[:digit:]]+\\.*[[:digit:]]*",data)
  numeric_val <- as.numeric(unlist(regmatches(data, pattern )))
  return(numeric_val)
}


test_that("get_treatment_rate() returns estimated treatment rate at time t", {
  fit_km <- survfit(Surv(DD, STATUS) ~ 1, data = rwToT_aml)
  # Treatment rate based on the aml lifetime table - https://en.wikipedia.org/wiki/File:Life_table_for_the_aml_data.png


  # test when t=0
  u1 <- get_treatment_rate(fit_km, 0)
  test_result <- get_numeric_vals(u1)
  expected_result <- c(23, 100, 100, 100)
  expect_equal(test_result, expected_result)

  u2 <- get_treatment_rate(fit_km, 18)
  test_result <- get_numeric_vals(u2)
  expected_result <- c(14, 64.6, 47.5, 87.8)
  expect_equal(test_result, expected_result)

  u3 <- get_treatment_rate(fit_km, 48)
  test_result <- get_numeric_vals(u3)
  expected_result <- c(2, 8.3, 1.5, 46.2)
  expect_equal(test_result, expected_result)

  # test when t is high and no output is returned
  test_result <- get_treatment_rate(fit_km, 200)
  expected_result <- "Not Available"

  expect_equal(test_result, expected_result)
})