diff --git a/R/stackgbm.R b/R/stackgbm.R index b6679ae..ff25120 100644 --- a/R/stackgbm.R +++ b/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 } diff --git a/R/wrappers_lightgbm.R b/R/wrappers_lightgbm.R index 9f62c30..f7595b4 100644 --- a/R/wrappers_lightgbm.R +++ b/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( diff --git a/R/wrappers_xgboost.R b/R/wrappers_xgboost.R index 7cf4543..548ecfc 100644 --- a/R/wrappers_xgboost.R +++ b/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( diff --git a/man/lightgbm_train.Rd b/man/lightgbm_train.Rd index 8bb6cd9..e21c7e4 100644 --- a/man/lightgbm_train.Rd +++ b/man/lightgbm_train.Rd @@ -23,6 +23,32 @@ Train lightgbm model } \examples{ \dontshow{if (is_installed_lightgbm()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# 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 \dontshow{\}) # examplesIf} } diff --git a/man/xgboost_dmatrix.Rd b/man/xgboost_dmatrix.Rd index 8fd4880..edb1762 100644 --- a/man/xgboost_dmatrix.Rd +++ b/man/xgboost_dmatrix.Rd @@ -21,6 +21,19 @@ Create xgb.DMatrix object } \examples{ \dontshow{if (is_installed_xgboost()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# 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 \dontshow{\}) # examplesIf} } diff --git a/man/xgboost_train.Rd b/man/xgboost_train.Rd index e3ab51d..69c31c5 100644 --- a/man/xgboost_train.Rd +++ b/man/xgboost_train.Rd @@ -23,6 +23,30 @@ Train xgboost model } \examples{ \dontshow{if (is_installed_xgboost()) (if (getRversion() >= "3.4") withAutoprint else force)(\{ # examplesIf} -# 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 \dontshow{\}) # examplesIf} }