tests/testthat/test-roxytest-tests-surv_flexsurv.r

In PolicyAnalysisInc/herosurv: A Grammar of Survival Operations for CE Models

# Generated by roxytest: Do not edit by hand!

# File R/surv_flexsurv.r: @tests

test_that("Function surv_prob.flexsurvreg() @ L38", {
  surv_dist1 <- flexsurvreg(Surv(rectime, censrec)~1, data = flexsurv::bc, dist = 'weibull')
  surv_dist2 <- define_surv_param('weibull', shape = 1.271519, scale = 2259.852523)
  expect_equal(
   surv_prob(surv_dist1, seq_len(100)),
   surv_prob(surv_dist2, seq_len(100))
  )
  
  surv_dist3 <- flexsurvreg(Surv(rectime, censrec)~group, data = flexsurv::bc, dist = 'weibull')
  surv_dist4 <- define_surv_param('weibull', shape = 1.3796518, scale = 4169.3445656)
  surv_dist5 <- define_surv_param('weibull', shape = 1.3796518, scale = 2257.301)
  surv_dist6 <- define_surv_param('weibull', shape = 1.3796518, scale = 1240.538)
  expect_equal(
   surv_prob(surv_dist3, seq_len(100), covar = data.frame(group = 'Good')),
   surv_prob(surv_dist4, seq_len(100)),
   tolerance = 0.00001
  )
  expect_equal(
   surv_prob(surv_dist3, seq_len(100), covar = data.frame(group = 'Medium')),
   surv_prob(surv_dist5, seq_len(100)),
   tolerance = 0.00001
  )
  expect_equal(
   suppressWarnings(surv_prob(surv_dist3, seq_len(100))),
   surv_prob(surv_dist4, seq_len(100)) * 0.334 + 
       surv_prob(surv_dist5, seq_len(100)) * 0.334 + 
       surv_prob(surv_dist6, seq_len(100)) * 0.332,
   tolerance = 0.00001
  )
  
  expect_warning(
   surv_prob(surv_dist3, seq_len(100)),
   'Predictions will reflect weighted average of predictions for subjects used to fit model.',
   fixed = T
  )
})


test_that("Function extract_flexsurv_params() @ L133", {
  fs1 <- flexsurvreg(Surv(rectime, censrec)~group, data = flexsurv::bc, dist = 'weibull')
  params_no_data <- extract_flexsurv_params(fs1)
  expect_equal(
   distinct(params_no_data),
   data.frame(shape = c(1.379652, 1.379652, 1.379652), scale = c(4169.345, 2257.301, 1240.538)),
   tolerance = 0.0001
  )
  expect_equal(
    nrow(params_no_data),
    nrow(flexsurv::bc)
  )
  params_w_data <- extract_flexsurv_params(
   fs1,
   data.frame(group = c('Good', 'Medium', 'Poor'))
  )
  expect_equal(
   distinct(params_no_data),
   params_w_data,
   tolerance = 0.0001
  )
})