object <- orsf(pbc_orsf, Surv(time, status) ~ . - id, n_tree = 100) n_variables <- 3 smry_1 <- orsf_summarize_uni(object, n_variables = n_variables, pred_type = 'surv') smry_2 <- orsf_summarize_uni(object, pred_horizon = 1000, n_variables = NULL, pred_type = 'surv') smry_3 <- orsf_summarize_uni(object, pred_type = 'chf') dt_smry_1 <- as.data.table(smry_1) dt_smry_2 <- as.data.table(smry_2) dt_smry_3 <- as.data.table(smry_3) test_that( desc = 'standard summaries run and can be cast to data tables', code = { expect_true(inherits(dt_smry_1, 'data.table')) expect_true(inherits(dt_smry_2, 'data.table')) expect_true(inherits(dt_smry_3, 'data.table')) expect_gt(nrow(dt_smry_2), nrow(dt_smry_1)) } ) no_miss_list <- function(l){ sapply(l, function(x){ if(is.list(x)) {return(no_miss_list(x))} any(is.na(x)) | any(is.nan(x)) | any(is.infinite(x)) }) } fi <- get_fctr_info(object) #' @srrstats {G5.2} *Appropriate error behaviour is explicitly demonstrated through tests.* #' @srrstats {G5.2b} *Tests demonstrate conditions which trigger error messages.* test_that("output is normal", { expect_s3_class(smry_1, class = 'orsf_summary_uni') expect_true(length(unique(smry_1$dt$variable)) == n_variables) expect_true(smry_1$pred_horizon == object$pred_horizon) expect_true(smry_1$pred_type == 'surv') rows_categorical_variables <- smry_1$dt$variable %in% fi$cols rows_numeric_variables <- !rows_categorical_variables # level should be NA when the variable is numeric expect_true(all(is.na(smry_1$dt$level[rows_numeric_variables]))) # level should not be NA when the variable is categorical expect_false(any(is.na(smry_1$dt$level[rows_categorical_variables]))) rows_categorical_variables <- smry_2$dt$variable %in% fi$cols rows_numeric_variables <- !rows_categorical_variables # level should be NA when the variable is numeric expect_true(all(is.na(smry_2$dt$level[rows_numeric_variables]))) # level should not be NA when the variable is categorical expect_false(any(is.na(smry_2$dt$level[rows_categorical_variables]))) #' @srrstats {G5.3} *Test that objects returned contain no missing (`NA`) or undefined (`NaN`, `Inf`) values.* # only one thing should have missing values (level) expect_equal(Reduce(f = sum, x = no_miss_list(smry_1)), 1) expect_equal(Reduce(f = sum, x = no_miss_list(smry_2)), 1) expect_true(smry_2$pred_horizon == 1000) }) test_that( desc = "print doesn't cause an error", code = { # we don't need this printing out on the testthat report. expect_invisible(p <- capture.output(print(smry_1))) } ) test_that("bad inputs caught", { expect_error( orsf_summarize_uni(object, n_variables = 50, pred_type = 'risk'), "total number of predictors" ) }) # high pred horizon test_that( desc = 'higher pred horizon is not allowed for summary', code = { fit_bad_oob_horizon <- orsf(pbc, time + status ~ ., n_tree = 1, oobag_pred_horizon = 7000) expect_error(orsf_summarize_uni(fit_bad_oob_horizon), regexp = 'prediction horizon') } )