Add code examples for wrapper functions

R/stackgbm.R

@@ -35,7 +35,7 @@ stackgbm <- function(x, y, params, n_folds = 5L, seed = 42, verbose = TRUE) {
   x_glm <- matrix(NA, nrow = nrow_x, ncol = 3L)
   colnames(x_glm) <- c("xgb", "lgb", "cat")
 
-  # xgboost
+  # xgboost ----
   pb <- progress_bar$new(
     format = "  fitting xgboost model [:bar] :percent in :elapsed",
     total = n_folds, clear = FALSE, width = 60
@@ -68,7 +68,7 @@ stackgbm <- function(x, y, params, n_folds = 5L, seed = 42, verbose = TRUE) {
     x_glm[index_xgb == i, "xgb"] <- predict(fit, xtest)
   }
 
-  # lightgbm
+  # lightgbm ----
   pb <- progress_bar$new(
     format = "  fitting lightgbm model [:bar] :percent in :elapsed",
     total = n_folds, clear = FALSE, width = 60
@@ -100,7 +100,7 @@ stackgbm <- function(x, y, params, n_folds = 5L, seed = 42, verbose = TRUE) {
     x_glm[index_lgb == i, "lgb"] <- predict(fit, xtest)
   }
 
-  # catboost
+  # catboost ----
   pb <- progress_bar$new(
     format = "  fitting catboost model [:bar] :percent in :elapsed",
     total = n_folds, clear = FALSE, width = 60
@@ -130,17 +130,18 @@ stackgbm <- function(x, y, params, n_folds = 5L, seed = 42, verbose = TRUE) {
     x_glm[index_cat == i, "cat"] <- catboost_predict(fit, pool = test_pool, prediction_type = "Probability")
   }
 
-  # logistic regression
+  # Logistic regression ----
   df <- as.data.frame(cbind(y, x_glm))
   names(df)[1] <- "y"
   model_glm <- glm(y ~ ., data = df, family = binomial())
 
-  lst <- list(
-    "model_xgb" = model_xgb,
-    "model_lgb" = model_lgb,
-    "model_cat" = model_cat,
-    "model_glm" = model_glm
+  structure(
+    list(
+      "model_xgb" = model_xgb,
+      "model_lgb" = model_lgb,
+      "model_cat" = model_cat,
+      "model_glm" = model_glm
+    ),
+    class = "stackgbm"
   )
-  class(lst) <- "stackgbm"
-  lst
 }

R/wrappers_lightgbm.R

@@ -10,7 +10,33 @@
 #' @export
 #'
 #' @examplesIf is_installed_lightgbm()
-#' # Example code
+#' sim_data <- msaenet::msaenet.sim.binomial(
+#'   n = 100,
+#'   p = 10,
+#'   rho = 0.6,
+#'   coef = rnorm(5, mean = 0, sd = 10),
+#'   snr = 1,
+#'   p.train = 0.8,
+#'   seed = 42
+#' )
+#'
+#' fit <- suppressWarnings(
+#'   lightgbm_train(
+#'     data = sim_data$x.tr,
+#'     label = sim_data$y.tr,
+#'     params = list(
+#'       objective = "binary",
+#'       learning_rate = 0.1,
+#'       num_iterations = 100,
+#'       max_depth = 3,
+#'       num_leaves = 2^3 - 1,
+#'       num_threads = 1
+#'     ),
+#'     verbose = -1
+#'   )
+#' )
+#'
+#' fit
 lightgbm_train <- function(data, label, params, ...) {
   rlang::check_installed("lightgbm", reason = "to train the model")
   cl <- rlang::call2(

R/wrappers_xgboost.R

@@ -9,7 +9,20 @@
 #' @export
 #'
 #' @examplesIf is_installed_xgboost()
-#' # Example code
+#' sim_data <- msaenet::msaenet.sim.binomial(
+#'   n = 100,
+#'   p = 10,
+#'   rho = 0.6,
+#'   coef = rnorm(5, mean = 0, sd = 10),
+#'   snr = 1,
+#'   p.train = 0.8,
+#'   seed = 42
+#' )
+#'
+#' x_train <- xgboost_dmatrix(sim_data$x.tr, label = sim_data$y.tr)
+#' x_train
+#' x_test <- xgboost_dmatrix(sim_data$x.te)
+#' x_test
 xgboost_dmatrix <- function(data, label = NULL, ...) {
   rlang::check_installed("xgboost", reason = "to create a dataset")
   cl <- if (is.null(label)) {
@@ -32,7 +45,31 @@ xgboost_dmatrix <- function(data, label = NULL, ...) {
 #' @export
 #'
 #' @examplesIf is_installed_xgboost()
-#' # Example code
+#' sim_data <- msaenet::msaenet.sim.binomial(
+#'   n = 100,
+#'   p = 10,
+#'   rho = 0.6,
+#'   coef = rnorm(5, mean = 0, sd = 10),
+#'   snr = 1,
+#'   p.train = 0.8,
+#'   seed = 42
+#' )
+#'
+#' x_train <- xgboost_dmatrix(sim_data$x.tr, label = sim_data$y.tr)
+#'
+#' fit <- xgboost_train(
+#'   params = list(
+#'     objective = "binary:logistic",
+#'     eval_metric = "auc",
+#'     max_depth = 3,
+#'     eta = 0.1
+#'   ),
+#'   data = x_train,
+#'   nrounds = 100,
+#'   nthread = 1
+#' )
+#'
+#' fit
 xgboost_train <- function(params, data, nrounds, ...) {
   rlang::check_installed("xgboost", reason = "to train the model")
   cl <- rlang::call2(