tests/testthat/test-orsf_control.R

In aorsf: Accelerated Oblique Random Survival Forests

f <- Surv(time, status) ~ . - id


#' @srrstats {G5.2} *Appropriate error behaviour is explicitly demonstrated through tests.*
test_that(
 desc = "inputs are vetted",
 code = {

 #' @srrstats {G5.2b} *Tests demonstrate conditions which trigger error messages.*

 expect_error(orsf_control_cph(method = 'oh no'), "breslow or efron")

 expect_error(orsf_control_net(alpha = 32), 'should be <= 1')

 f_bad_1 <- function(a_node, y_node, w_node){ 1 }
 f_bad_2 <- function(x_node, a_node, w_node){ 1 }
 f_bad_3 <- function(x_node, y_node, a_node){ 1 }
 f_bad_4 <- function(x_node, y_node){ 1 }

 f_bad_5 <- function(x_node, y_node, w_node) {
  stop("an expected error occurred")
 }

 f_bad_6 <- function(x_node, y_node, w_node){
  return(matrix(0, ncol = 2, nrow = ncol(x_node)))
 }

 f_bad_7 <- function(x_node, y_node, w_node){
  return(matrix(0, ncol = 1, nrow = 2))
 }

 f_bad_8 <- function(x_node, y_node, w_node) {runif(n = ncol(x_node))}

 expect_error(orsf_control_custom(f_bad_1), 'x_node')
 expect_error(orsf_control_custom(f_bad_2), 'y_node')
 expect_error(orsf_control_custom(f_bad_3), 'w_node')
 expect_error(orsf_control_custom(f_bad_4), 'should have 3')
 expect_error(orsf_control_custom(f_bad_5), 'encountered an error')
 expect_error(orsf_control_custom(f_bad_6), 'with 1 column')
 expect_error(orsf_control_custom(f_bad_7), 'with 1 row for each')
 expect_error(orsf_control_custom(f_bad_8), 'matrix output')

 f_rando <- function(x_node, y_node, w_node) { matrix(runif(ncol(x_node)), ncol=1) }

 expect_s3_class(orsf_control_custom(f_rando), 'orsf_control')


}
)


test_that(
 desc = 'custom orsf_control predictions are good',
 code = {

  fit_pca = orsf(pbc,
                 Surv(time, status) ~ .,
                 tree_seeds = seeds_standard,
                 control = orsf_control_custom(beta_fun = f_pca),
                 n_tree = n_tree_test)

  expect_gt(fit_pca$eval_oobag$stat_values, .65)

 }
)