}}\preformatted{## Warning: `orsf_control_custom()` was deprecated in aorsf 0.1.2.
+## i Please use the appropriate survival, classification, or regression control
+## function instead. E.g., `orsf_control_survival(method = your_function)`
+## This warning is displayed once every 8 hours.
+## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
+## generated.
+}\if{html}{\out{
}}
-fit_rando
+\if{html}{\out{}}\preformatted{## ---------- Oblique random survival forest
@@ -157,6 +166,7 @@ The PCA ORSF does quite well! (higher IPA is better)
linear combination control functions
\code{\link{orsf_control_cph}()},
\code{\link{orsf_control_fast}()},
-\code{\link{orsf_control_net}()}
+\code{\link{orsf_control_net}()},
+\code{\link{orsf_control}()}
}
\concept{orsf_control}
diff --git a/man/orsf_control_fast.Rd b/man/orsf_control_fast.Rd
index 7d92ed11..9440bb97 100644
--- a/man/orsf_control_fast.Rd
+++ b/man/orsf_control_fast.Rd
@@ -47,6 +47,7 @@ orsf(data = pbc_orsf,
linear combination control functions
\code{\link{orsf_control_cph}()},
\code{\link{orsf_control_custom}()},
-\code{\link{orsf_control_net}()}
+\code{\link{orsf_control_net}()},
+\code{\link{orsf_control}()}
}
\concept{orsf_control}
diff --git a/man/orsf_control_net.Rd b/man/orsf_control_net.Rd
index 1bc70865..427c7ad7 100644
--- a/man/orsf_control_net.Rd
+++ b/man/orsf_control_net.Rd
@@ -25,6 +25,8 @@ Use regularized Cox proportional hazard models to identify linear
combinations of input variables while fitting an \link{orsf} model.
}
\details{
+\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}}
+
\code{df_target} has to be less than \code{mtry}, which is a separate argument in
\link{orsf} that indicates the number of variables chosen at random prior to
finding a linear combination of those variables.
@@ -47,6 +49,7 @@ Simon N, Friedman J, Hastie T, Tibshirani R. Regularization paths for Cox's prop
linear combination control functions
\code{\link{orsf_control_cph}()},
\code{\link{orsf_control_custom}()},
-\code{\link{orsf_control_fast}()}
+\code{\link{orsf_control_fast}()},
+\code{\link{orsf_control}()}
}
\concept{orsf_control}
diff --git a/man/orsf_ice_oob.Rd b/man/orsf_ice_oob.Rd
index ad2a1968..e7788b77 100644
--- a/man/orsf_ice_oob.Rd
+++ b/man/orsf_ice_oob.Rd
@@ -112,60 +112,3 @@ You can compute individual conditional expectations three ways using a random fo
See examples for more details
}
-\section{Examples}{
-Begin by fitting an ORSF ensemble
-
-\if{html}{\out{
}}\preformatted{library(aorsf)
-
-set.seed(329)
-
-fit <- orsf(data = pbc_orsf, formula = Surv(time, status) ~ . - id)
-
-fit
-}\if{html}{\out{
}}
-
-\if{html}{\out{
}}\preformatted{## ---------- Oblique random survival forest
-##
-## Linear combinations: Accelerated Cox regression
-## N observations: 276
-## N events: 111
-## N trees: 500
-## N predictors total: 17
-## N predictors per node: 5
-## Average leaves per tree: 21.026
-## Min observations in leaf: 5
-## Min events in leaf: 1
-## OOB stat value: 0.84
-## OOB stat type: Harrell's C-index
-## Variable importance: anova
-##
-## -----------------------------------------
-}\if{html}{\out{
}}
-
-Use the ensemble to compute ICE values using out-of-bag predictions:
-
-\if{html}{\out{
}}\preformatted{pred_spec <- list(bili = seq(1, 10, length.out = 25))
-
-ice_oob <- orsf_ice_oob(fit, pred_spec, boundary_checks = FALSE)
-
-ice_oob
-}\if{html}{\out{
}}
-
-\if{html}{\out{
}}\preformatted{## id_variable id_row pred_horizon bili pred
-## 1: 1 1 1 1 1
-## 2: 1 2 1 1 1
-## 3: 1 3 1 1 1
-## 4: 1 4 1 1 1
-## 5: 1 5 1 1 1
-## ---
-## 6896: 25 272 1 10 1
-## 6897: 25 273 1 10 1
-## 6898: 25 274 1 10 1
-## 6899: 25 275 1 10 1
-## 6900: 25 276 1 10 1
-}\if{html}{\out{
}}
-
-Much more detailed examples are given in the
-\href{https://docs.ropensci.org/aorsf/articles/pd.html#individual-conditional-expectations-ice}{vignette}
-}
-
diff --git a/man/orsf_pd_oob.Rd b/man/orsf_pd_oob.Rd
index 854b7bfb..f5a4672c 100644
--- a/man/orsf_pd_oob.Rd
+++ b/man/orsf_pd_oob.Rd
@@ -133,85 +133,6 @@ See examples for more details
\details{
Partial dependence has a number of \href{https://christophm.github.io/interpretable-ml-book/pdp.html#disadvantages-5}{known limitations and assumptions} that users should be aware of (see Hooker, 2021). In particular, partial dependence is less intuitive when >2 predictors are examined jointly, and it is assumed that the feature(s) for which the partial dependence is computed are not correlated with other features (this is likely not true in many cases). Accumulated local effect plots can be used (see \href{https://christophm.github.io/interpretable-ml-book/ale.html}{here}) in the case where feature independence is not a valid assumption.
}
-\section{Examples}{
-Begin by fitting an ORSF ensemble:
-
-\if{html}{\out{
}}\preformatted{library(aorsf)
-
-set.seed(329730)
-
-index_train <- sample(nrow(pbc_orsf), 150)
-
-pbc_orsf_train <- pbc_orsf[index_train, ]
-pbc_orsf_test <- pbc_orsf[-index_train, ]
-
-fit <- orsf(data = pbc_orsf_train,
- formula = Surv(time, status) ~ . - id,
- oobag_pred_horizon = 365.25 * 5)
-}\if{html}{\out{
}}
-\subsection{Three ways to compute PD and ICE}{
-
-You can compute partial dependence and ICE three ways with \code{aorsf}:
-\itemize{
-\item using in-bag predictions for the training data
-
-\if{html}{\out{
}}\preformatted{pd_train <- orsf_pd_inb(fit, pred_spec = list(bili = 1:5))
-
-pd_train
-}\if{html}{\out{
}}
-
-\if{html}{\out{
}}\preformatted{## pred_horizon bili mean lwr medn upr
-## 1: 1 1 1 1 1 1
-## 2: 1 2 1 1 1 1
-## 3: 1 3 1 1 1 1
-## 4: 1 4 1 1 1 1
-## 5: 1 5 1 1 1 1
-}\if{html}{\out{
}}
-\item using out-of-bag predictions for the training data
-
-\if{html}{\out{
}}\preformatted{pd_train <- orsf_pd_oob(fit, pred_spec = list(bili = 1:5))
-
-pd_train
-}\if{html}{\out{
}}
-
-\if{html}{\out{
}}\preformatted{## pred_horizon bili mean lwr medn upr
-## 1: 1 1 1 1 1 1
-## 2: 1 2 1 1 1 1
-## 3: 1 3 1 1 1 1
-## 4: 1 4 1 1 1 1
-## 5: 1 5 1 1 1 1
-}\if{html}{\out{
}}
-\item using predictions for a new set of data
-
-\if{html}{\out{
}}\preformatted{pd_test <- orsf_pd_new(fit,
- new_data = pbc_orsf_test,
- pred_spec = list(bili = 1:5))
-
-pd_test
-}\if{html}{\out{
}}
-
-\if{html}{\out{
}}\preformatted{## pred_horizon bili mean lwr medn upr
-## 1: 1 1 1 1 1 1
-## 2: 1 2 1 1 1 1
-## 3: 1 3 1 1 1 1
-## 4: 1 4 1 1 1 1
-## 5: 1 5 1 1 1 1
-}\if{html}{\out{
}}
-\item in-bag partial dependence indicates relationships that the model has
-learned during training. This is helpful if your goal is to interpret
-the model.
-\item out-of-bag partial dependence indicates relationships that the model
-has learned during training but using the out-of-bag data simulates
-application of the model to new data. if you want to test your model’s
-reliability or fairness in new data but you don’t have access to a
-large testing set.
-\item new data partial dependence shows how the model predicts outcomes for
-observations it has not seen. This is helpful if you want to test your
-model’s reliability or fairness.
-}
-}
-}
-
\references{
Giles Hooker, Lucas Mentch, Siyu Zhou. Unrestricted Permutation forces Extrapolation: Variable Importance Requires at least One More Model, or There Is No Free Variable Importance. \emph{arXiv e-prints} 2021 Oct; arXiv-1905. URL: https://doi.org/10.48550/arXiv.1905.03151
}
diff --git a/src/TreeClassification.cpp b/src/TreeClassification.cpp
index 3fe5644f..351bcdf9 100644
--- a/src/TreeClassification.cpp
+++ b/src/TreeClassification.cpp
@@ -186,7 +186,8 @@
double safer_mtry = mtry;
- if(lincomb_type == LC_GLM){
+ if(lincomb_type == LC_GLM ||
+ lincomb_type == LC_GLMNET){
// conditions to split a column:
// >= 3 events per predictor
@@ -234,15 +235,23 @@
}
}
- for (auto& i : splittable_y_cols){
+ // glmnet can handle higher dimension x,
+ // but regular glm cannot.
+ if(lincomb_type == LC_GLM){
+
+ for (auto& i : splittable_y_cols){
+
+ while (y_sum_cases[i] / safer_mtry < 3 ||
+ y_sum_ctrls[i] / safer_mtry < 3){
+ --safer_mtry;
+ }
- while (y_sum_cases[i] / safer_mtry < 3 ||
- y_sum_ctrls[i] / safer_mtry < 3){
- --safer_mtry;
}
}
+
+
}
uword out = safer_mtry;
diff --git a/tests/testthat.R b/tests/testthat.R
index 362d118b..8d22ab86 100644
--- a/tests/testthat.R
+++ b/tests/testthat.R
@@ -1,12 +1,4 @@
library(testthat)
library(aorsf)
-## force tests to be executed if in dev release which we define as
-## having a sub-release, eg 0.9.15.5 is one whereas 0.9.16 is not
-if (length(strsplit(packageDescription("aorsf")$Version, "\\.")[[1]]) > 3) {
- Sys.setenv("run_all_aorsf_tests" = "yes")
-} else {
-
-}
-
test_check("aorsf")
diff --git a/tests/testthat/helper-orsf.R b/tests/testthat/helper-orsf.R
index b4c921c8..c3515781 100644
--- a/tests/testthat/helper-orsf.R
+++ b/tests/testthat/helper-orsf.R
@@ -272,11 +272,17 @@ prep_test_matrices <- function(data, outcomes = c("time", "status")){
cc <- stats::complete.cases(data[, names_x_data])
data <- data[cc, ]
- y <- prep_y_surv(data, names_y_data)
+ if(length(outcomes) > 1){
+ y <- prep_y_surv(data, names_y_data)
+ sorted <- collapse::radixorder(y[, 1], -y[, 2])
+ } else {
+ y <- prep_y_clsf(data, names_y_data)
+ sorted <- collapse::seq_row(data)
+ }
+
x <- prep_x(data, fi, names_x_data, means, standard_deviations)
w <- sample(1:3, nrow(y), replace = TRUE)
- sorted <- collapse::radixorder(y[, 1], -y[, 2])
return(
list(
diff --git a/tests/testthat/setup.R b/tests/testthat/setup.R
index 1807403f..5f5b1ee6 100644
--- a/tests/testthat/setup.R
+++ b/tests/testthat/setup.R
@@ -57,6 +57,32 @@ data_list_pbc <- list(pbc_standard = pbc,
pbc_scaled = pbc_scale,
pbc_noised = pbc_noise)
+# penguins ----
+
+penguins <- penguins_orsf
+
+penguins_scale <- penguins_noise <- penguins
+
+
+vars <- c("bill_length_mm",
+ "bill_depth_mm",
+ "flipper_length_mm",
+ "body_mass_g")
+
+for(i in vars){
+ penguins_noise[[i]] <- add_noise(penguins_noise[[i]])
+ penguins_scale[[i]] <- change_scale(penguins_scale[[i]])
+}
+
+# make sorted x and y matrices for testing internal cpp functions
+penguins_mats <- prep_test_matrices(penguins, outcomes = c("species"))
+
+# data lists ----
+
+data_list_penguins <- list(penguins_standard = penguins,
+ penguins_scaled = penguins_scale,
+ penguins_noised = penguins_noise)
+
# matric lists ----
mat_list_surv <- list(pbc = pbc_mats,
@@ -72,9 +98,8 @@ n_tree_test <- 5
controls <- list(
fast = orsf_control_fast(),
- cph = orsf_control_cph(),
- net = orsf_control_net(),
- custom = orsf_control_custom(beta_fun = f_pca)
+ net = orsf_control_survival(method = 'net'),
+ custom = orsf_control_survival(method = f_pca)
)
fit_standard_pbc <- lapply(
diff --git a/tests/testthat/test-lincomb_logreg.R b/tests/testthat/test-lincomb_logreg.R
index b3701396..112a6e65 100644
--- a/tests/testthat/test-lincomb_logreg.R
+++ b/tests/testthat/test-lincomb_logreg.R
@@ -73,3 +73,14 @@ test_that(
}
)
+
+# benchmark
+
+# microbenchmark::microbenchmark(
+# cpp = logreg_fit_exported(X, Y, W, do_scale = FALSE,
+# epsilon = control$epsilon,
+# iter_max = control$maxit),
+# fglm = fastglm::fastglmPure(X, Y, family = binomial(), weights = W),
+# nmr = RcppNumerical::fastLR(cbind(1, X), Y)
+# )
+
diff --git a/tests/testthat/test-orsf.R b/tests/testthat/test-orsf.R
index ea4b6361..bd79a7aa 100644
--- a/tests/testthat/test-orsf.R
+++ b/tests/testthat/test-orsf.R
@@ -29,21 +29,24 @@ test_that(
desc = 'target_df too high is caught',
code = {
- cntrl <- orsf_control_net(df_target = 10)
+ cntrl <- orsf_control_survival(method = 'net', target_df = 10)
expect_error(orsf(pbc_orsf, formula = f, control = cntrl), 'should be <=')
}
)
test_that(
- desc = 'orsf runs with data.table and with net control',
+ desc = 'orsf runs the same with data.table vs. data.frame',
code = {
- expect_s3_class(orsf(as.data.table(pbc_orsf), f, n_tree = 1), 'ObliqueForest')
+ fit_dt <- orsf(as.data.table(pbc),
+ formula = time + status ~ .,
+ n_tree = n_tree_test,
+ control = controls$fast,
+ tree_seed = seeds_standard)
+
+ expect_equal_leaf_summary(fit_dt, fit_standard_pbc$fast)
- expect_s3_class(orsf(as.data.table(pbc_orsf), f,
- control = orsf_control_net(),
- n_tree = 1), 'ObliqueForest')
}
)
@@ -52,7 +55,7 @@ test_that(
desc = "blank and non-standard names trigger an error",
code = {
- pbc_temp <- pbc_orsf
+ pbc_temp <- pbc
pbc_temp$x1 <- rnorm(nrow(pbc_temp))
pbc_temp$x2 <- rnorm(nrow(pbc_temp))
@@ -64,7 +67,7 @@ test_that(
)
- pbc_temp <- pbc_orsf
+ pbc_temp <- pbc
pbc_temp$x1 <- rnorm(nrow(pbc_temp))
pbc_temp$x2 <- rnorm(nrow(pbc_temp))
@@ -79,44 +82,6 @@ test_that(
)
-# just run locally. units seems to have memory leaks.
-# test_that(
-# 'orsf tracks meta data for units class variables',
-# code = {
-#
-# # units may have memory leaks
-# skip_on_cran()
-#
-# suppressMessages(library(units))
-# pbc_units <- pbc_orsf
-#
-#
-# units(pbc_units$time) <- 'days'
-# units(pbc_units$age) <- 'years'
-# units(pbc_units$bili) <- 'mg/dl'
-#
-# fit_units <- orsf(pbc_units, Surv(time, status) ~ . - id, n_tree=1)
-#
-# expect_equal(
-# fit_units$get_var_unit('time'),
-# list( numerator = "d", denominator = character(0), label = "d")
-# )
-#
-# expect_equal(
-# fit_units$get_var_unit('age'),
-# list(numerator = "years", denominator = character(0), label = "years")
-# )
-#
-# expect_equal(
-# fit_units$get_var_unit('bili'),
-# list(numerator = "mg", denominator = "dl", label = "mg/dl")
-# )
-#
-# }
-#
-# )
-
-
test_that(
desc = "algorithm grows more accurate with higher number of iterations",
code = {
@@ -491,9 +456,9 @@ test_that(
'3' = c(1000, 2000, 3000))
control <- switch(inputs$orsf_control[i],
- 'cph' = orsf_control_cph(),
- 'net' = orsf_control_net(),
- 'custom' = orsf_control_custom(beta_fun = f_pca))
+ 'cph' = orsf_control_survival(method = 'glm'),
+ 'net' = orsf_control_survival(method = 'net'),
+ 'custom' = orsf_control_survival(method = f_pca))
if(inputs$sample_with_replacement[i]){
sample_fraction <- 0.632
diff --git a/tests/testthat/test-orsf_control.R b/tests/testthat/test-orsf_control.R
index c7e3dcd0..a0c931e6 100644
--- a/tests/testthat/test-orsf_control.R
+++ b/tests/testthat/test-orsf_control.R
@@ -10,9 +10,9 @@ test_that(
#' @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_survival(ties = 'oh no'), "breslow or efron")
- expect_error(orsf_control_net(alpha = 32), 'should be <= 1')
+ expect_error(orsf_control_survival(net_mix = 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 }
@@ -33,18 +33,18 @@ test_that(
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')
+ expect_error(orsf_control_survival(method = f_bad_1), 'x_node')
+ expect_error(orsf_control_survival(method = f_bad_2), 'y_node')
+ expect_error(orsf_control_survival(method = f_bad_3), 'w_node')
+ expect_error(orsf_control_survival(method = f_bad_4), 'should have 3')
+ expect_error(orsf_control_survival(method = f_bad_5), 'encountered an error')
+ expect_error(orsf_control_survival(method = f_bad_6), 'with 1 column')
+ expect_error(orsf_control_survival(method = f_bad_7), 'with 1 row for each')
+ expect_error(orsf_control_survival(method = 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')
+ expect_s3_class(orsf_control_survival(method = f_rando), 'orsf_control')
}
@@ -58,7 +58,7 @@ test_that(
fit_pca = orsf(pbc,
Surv(time, status) ~ .,
tree_seeds = seeds_standard,
- control = orsf_control_custom(beta_fun = f_pca),
+ control = orsf_control_survival(method = f_pca),
n_tree = n_tree_test)
expect_gt(fit_pca$eval_oobag$stat_values, .65)
diff --git a/tests/testthat/test-unit_info.R b/tests/testthat/test-unit_info.R
index 51429bf3..ba9a0f72 100644
--- a/tests/testthat/test-unit_info.R
+++ b/tests/testthat/test-unit_info.R
@@ -4,6 +4,43 @@
# on CRAN because for some reason when I load and use the
# units package it makes valgrind detect possible memory leaks.
+test_that(
+ 'orsf tracks meta data for units class variables',
+ code = {
+
+ # units may have memory leaks
+ skip_on_cran()
+
+ suppressMessages(library(units))
+
+ pbc_units <- pbc_orsf
+
+ units(pbc_units$time) <- 'days'
+ units(pbc_units$age) <- 'years'
+ units(pbc_units$bili) <- 'mg/dl'
+
+ fit_units <- orsf(pbc_units, Surv(time, status) ~ . - id, n_tree=1)
+
+ expect_equal(
+ fit_units$get_var_unit('time'),
+ list( numerator = "d", denominator = character(0), label = "d")
+ )
+
+ expect_equal(
+ fit_units$get_var_unit('age'),
+ list(numerator = "years", denominator = character(0), label = "years")
+ )
+
+ expect_equal(
+ fit_units$get_var_unit('bili'),
+ list(numerator = "mg", denominator = "dl", label = "mg/dl")
+ )
+
+ }
+
+)
+
+
test_that("output has expected items", {
skip_on_cran()
diff --git a/vignettes/fast.Rmd b/vignettes/fast.Rmd
index ff65f4d3..8684d18e 100644
--- a/vignettes/fast.Rmd
+++ b/vignettes/fast.Rmd
@@ -39,7 +39,7 @@ time_fast <- system.time(
time_net <- system.time(
expr = orsf(pbc_orsf,
formula = time+status~. -id,
- control = orsf_control_net(),
+ control = orsf_control_survival(method = 'net'),
n_tree = 5)
)