Skip to content

Commit

Permalink
fixup for cran check
Browse files Browse the repository at this point in the history
  • Loading branch information
@bcjaeger
bcjaeger committed Nov 13, 2023
1 parent bdfa0cc commit 233e4fa
Show file tree
Hide file tree
Showing 7 changed files with 86 additions and 111 deletions.
20 changes: 0 additions & 20 deletions R/orsf_control.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -36,11 +36,6 @@
#' on the scale of your data, which is why the default value is `TRUE`.
#'
#'
#' @examples
#'
#' orsf(data = pbc_orsf,
#' formula = Surv(time, status) ~ . - id,
#' control = orsf_control_fast())
#'
orsf_control_fast <- function(method = 'efron',
do_scale = TRUE,
Expand Down Expand Up @@ -115,11 +110,6 @@ orsf_control_fast <- function(method = 'efron',
#' Data: Extending the Cox Model. Statistics for Biology and Health.
#' Springer, New York, NY. DOI: 10.1007/978-1-4757-3294-8_3
#'
#' @examples
#'
#' orsf(data = pbc_orsf,
#' formula = Surv(time, status) ~ . - id,
#' control = orsf_control_cph())
#'
orsf_control_cph <- function(method = 'efron',
eps = 1e-9,
Expand Down Expand Up @@ -186,16 +176,6 @@ orsf_control_cph <- function(method = 'efron',
#'
#' `r roxy_cite_simon_2011()`
#'
#' @examples
#'
#' # orsf_control_net() is considerably slower than orsf_control_cph(),
#' # The example uses n_tree = 25 so that my examples run faster,
#' # but you should use at least 500 trees in applied settings.
#'
#' orsf(data = pbc_orsf,
#' formula = Surv(time, status) ~ . - id,
#' n_tree = 25,
#' control = orsf_control_net())

orsf_control_net <- function(alpha = 1/2,
df_target = NULL,
Expand Down
24 changes: 17 additions & 7 deletions Rmd/orsf_examples.Rmd
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,7 +50,7 @@ The accelerated ORSF ensemble is the default because it has a nice balance of co
```{r}
fit_accel <- orsf(pbc_orsf,
control = orsf_control_fast(),
control = orsf_control_survival(),
formula = Surv(time, status) ~ . - id,
tree_seeds = 329)
Expand All @@ -62,8 +62,12 @@ fit_accel <- orsf(pbc_orsf,

```{r}
control_cph <- orsf_control_survival(method = 'glm',
scale_x = TRUE,
max_iter = 20)
fit_cph <- orsf(pbc_orsf,
control = orsf_control_cph(),
control = control_cph,
formula = Surv(time, status) ~ . - id,
tree_seeds = 329)
Expand All @@ -77,8 +81,11 @@ fit_cph <- orsf(pbc_orsf,
# select 3 predictors out of 5 to be used in
# each linear combination of predictors.
control_net <- orsf_control_survival(method = 'net', target_df = 3)
fit_net <- orsf(pbc_orsf,
control = orsf_control_net(df_target = 3),
control = control_net,
formula = Surv(time, status) ~ . - id,
tree_seeds = 329)
Expand Down Expand Up @@ -157,16 +164,16 @@ We can plug these functions into `orsf_control_custom()`, and then pass the resu
fit_rando <- orsf(pbc_orsf,
Surv(time, status) ~ . - id,
control = orsf_control_custom(beta_fun = f_rando),
control = orsf_control_survival(method = f_rando),
tree_seeds = 329)
fit_pca <- orsf(pbc_orsf,
Surv(time, status) ~ . - id,
control = orsf_control_custom(beta_fun = f_pca),
control = orsf_control_survival(method = f_pca),
tree_seeds = 329)
fit_rlt <- orsf(pbc_orsf, time + status ~ . - id,
control = orsf_control_custom(beta_fun = f_aorsf),
control = orsf_control_survival(method = f_aorsf),
tree_seeds = 329)
```
Expand Down Expand Up @@ -221,6 +228,7 @@ Start with a recipe to pre-process data
```{r}
imputer <- recipe(pbc_orsf, formula = time + status ~ .) %>%
step_rm(id) %>%
step_impute_mean(all_numeric_predictors()) %>%
step_impute_mode(all_nominal_predictors())
Expand Down Expand Up @@ -268,7 +276,9 @@ aorsf_wf <- function(train, test, pred_horizon){
train %>%
orsf(Surv(time, status) ~ .,) %>%
predict(new_data = test, pred_horizon = pred_horizon) %>%
predict(new_data = test,
pred_type = 'risk',
pred_horizon = pred_horizon) %>%
as.numeric()
}
Expand Down
26 changes: 18 additions & 8 deletions man/orsf.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 0 additions & 7 deletions man/orsf_control_cph.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

7 changes: 0 additions & 7 deletions man/orsf_control_fast.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

11 changes: 0 additions & 11 deletions man/orsf_control_net.Rd
View file

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

102 changes: 51 additions & 51 deletions tests/testthat/test-orsf.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -110,18 +110,18 @@ test_that(
pbc_list_bad$trt <- pbc_list_bad$trt[1:3]
pbc_list_bad$age <- pbc_list_bad$age[1:5]

skip_on_cran() # I don't want to list recipes in suggests

recipe <- recipes::recipe(pbc_orsf, formula = time + status ~ .) %>%
recipes::step_rm(id)

recipe_prepped <- recipes::prep(recipe)

fit_recipe <- orsf(recipe_prepped, Surv(time, status) ~ .,
n_tree = n_tree_test,
tree_seeds = seeds_standard)

expect_equal_leaf_summary(fit_recipe, fit_standard_pbc$fast)
# skip() # I don't want to list recipes in suggests
#
# recipe <- recipes::recipe(pbc_orsf, formula = time + status ~ .) %>%
# recipes::step_rm(id)
#
# recipe_prepped <- recipes::prep(recipe)
#
# fit_recipe <- orsf(recipe_prepped, Surv(time, status) ~ .,
# n_tree = n_tree_test,
# tree_seeds = seeds_standard)
#
# expect_equal_leaf_summary(fit_recipe, fit_standard_pbc$fast)

fit_list <- orsf(pbc_list,
Surv(time, status) ~ . - id,
Expand Down Expand Up @@ -388,45 +388,45 @@ test_that(
as.numeric(fit$eval_oobag$stat_values)
)

skip_on_cran() # don't want to suggest yardstick or Hmisc

oobag_rsq_eval <- function(y_mat, w_vec, s_vec){

yardstick::rsq_trad_vec(truth = as.numeric(y_mat),
estimate = as.numeric(s_vec),
case_weights = as.numeric(w_vec))
}

fit <- orsf(data = mtcars,
formula = mpg ~ .,
n_tree = n_tree_test,
oobag_fun = oobag_rsq_eval,
tree_seeds = seeds_standard)

expect_equal(
fit$eval_oobag$stat_values[1,1],
yardstick::rsq_trad_vec(truth = as.numeric(mtcars$mpg),
estimate = as.numeric(fit$pred_oobag),
case_weights = rep(1, nrow(mtcars)))
)

oobag_cstat_clsf <- function(y_mat, w_vec, s_vec){

y_vec = as.numeric(y_mat)
cstat <- Hmisc::somers2(x = s_vec,
y = y_vec,
weights = w_vec)['C']
cstat

}

fit <- orsf(data = penguins,
formula = species ~ .,
n_tree = n_tree_test,
oobag_fun = oobag_cstat_clsf,
tree_seeds = seeds_standard)

expect_equal_oobag_eval(fit, fit_standard_penguins$fast)
# skip() # don't want to suggest yardstick or Hmisc
#
# oobag_rsq_eval <- function(y_mat, w_vec, s_vec){
#
# yardstick::rsq_trad_vec(truth = as.numeric(y_mat),
# estimate = as.numeric(s_vec),
# case_weights = as.numeric(w_vec))
# }
#
# fit <- orsf(data = mtcars,
# formula = mpg ~ .,
# n_tree = n_tree_test,
# oobag_fun = oobag_rsq_eval,
# tree_seeds = seeds_standard)
#
# expect_equal(
# fit$eval_oobag$stat_values[1,1],
# yardstick::rsq_trad_vec(truth = as.numeric(mtcars$mpg),
# estimate = as.numeric(fit$pred_oobag),
# case_weights = rep(1, nrow(mtcars)))
# )
#
# oobag_cstat_clsf <- function(y_mat, w_vec, s_vec){
#
# y_vec = as.numeric(y_mat)
# cstat <- Hmisc::somers2(x = s_vec,
# y = y_vec,
# weights = w_vec)['C']
# cstat
#
# }
#
# fit <- orsf(data = penguins,
# formula = species ~ .,
# n_tree = n_tree_test,
# oobag_fun = oobag_cstat_clsf,
# tree_seeds = seeds_standard)
#
# expect_equal_oobag_eval(fit, fit_standard_penguins$fast)


}
Expand Down

0 comments on commit 233e4fa

Please sign in to comment.