support ranger (and therefore random forests)

DESCRIPTION

@@ -16,7 +16,7 @@ URL: https://openair-project.github.io/deweather/,
     https://github.com/openair-project/deweather
 BugReports: https://github.com/openair-project/deweather/issues
 Depends: 
-    parsnip,
+    parsnip (>= 1.4.1),
     R (>= 4.1.0)
 Imports: 
     carrier,
@@ -42,6 +42,7 @@ Suggests:
     bonsai,
     knitr,
     lightgbm,
+    ranger,
     rmarkdown,
     testthat (>= 3.0.0),
     xgboost

NEWS.md

@@ -4,7 +4,7 @@
 
 Version 1.0.0 of deweather is a complete re-write of the `deweather` package. This new version:
 
-- Uses the `tidymodels` framework, allowing for more flexibility in plotting engines. `deweather` 1.0.0 launches with both `xgboost` and `lightgbm` engines available.
+- Uses the `tidymodels` framework, allowing for more flexibility in model engines. `deweather` 1.0.0 launches with `xgboost`, `lightgbm` and `ranger` engines available.
 
 - Provides much more flexible partial dependency calculations, including grouped PDs.
 

R/build_dw_model.R

@@ -1,9 +1,13 @@
 #' Build a Deweather Model
 #'
-#' This function builds a boosted decision tree machine learning model with
-#' useful methods for interrogating it in an air quality and meteorological
-#' context. Currently, only the [xgboost][xgboost::xgboost()] engine is
-#' supported.
+#' This function builds a 'deweathering' machine learning model with useful
+#' methods for interrogating it in an air quality and meteorological context. It
+#' uses any number of variables (most usefully meteorological variables like
+#' wind speed and wind direction and temporal variables defined in
+#' [append_dw_vars()]) to fit a model predicting a given `pollutant`. While
+#' these models are useful for 'removing' the effects of meteorology from an air
+#' quality time series (e.g., through [simulate_dw_met()]), they are also useful
+#' for explanatory analysis (e.g., through [plot_dw_partial_1d()]).
 #'
 #' @param data An input `data.frame` containing one pollutant column (defined
 #'   using `pollutant`) and a collection of feature columns (defined using
@@ -18,14 +22,107 @@
 #'   `"yday"`, `"week"`, and `"month"` are special terms and will be passed to
 #'   [append_dw_vars()] if not present in `names(data)`.
 #'
+#' @param mtry Number of Randomly Selected Predictors
+#'   `<xgboost|lightgbm|ranger>`
+#'
+#'   A number for the number (or proportion) of predictors that will be randomly
+#'   sampled at each split when creating the tree models.
+#'
+#' @param trees Number of Trees `<xgboost|lightgbm|ranger>`
+#'
+#'   An integer for the number of trees contained in the ensemble.
+#'
+#' @param min_n Minimal Node Size `<xgboost|lightgbm|ranger>`
+#'
+#'   An integer for the minimum number of data points in a node that is required
+#'   for the node to be split further.
+#'
+#' @param tree_depth Tree Depth `<xgboost|lightgbm>`
+#'
+#'   An integer for the maximum depth of the tree (i.e., number of splits).
+#'
+#' @param learn_rate Learning Rate `<xgboost|lightgbm>`
+#'
+#'   A number for the rate at which the boosting algorithm adapts from
+#'   iteration-to-iteration. This is sometimes referred to as the shrinkage
+#'   parameter.
+#'
+#' @param loss_reduction Minimum Loss Reduction `<xgboost|lightgbm>`
+#'
+#'   A number for the reduction in the loss function required to split further.
+#'
+#' @param sample_size Proportion Observations Sampled `<xgboost>`
+#'
+#'   A number for the number (or proportion) of data that is exposed to the
+#'   fitting routine.
+#'
+#' @param stop_iter Number of Iterations Before Stopping `<xgboost>`
+#'
+#'   The number of iterations without improvement before stopping.
+#'
+#' @param engine A single character string specifying what computational engine
+#'   to use for fitting. Can be `"xgboost"`, `"lightgbm"` (boosted trees) or
+#'   `"ranger"` (random forest). See the documentation below for more
+#'   information.
+#'
 #' @param ... Not current used.
 #'
 #' @param .date The name of the 'date' column which defines the air quality
 #'   timeseries. Passed to [append_dw_vars()] if needed. Also used to extract
 #'   the time zone of the data for later restoration if `trend` is used as a
 #'   variable.
 #'
-#' @inheritParams parsnip::boost_tree
+#' @section Modelling Approaches and Parameters:
+#'
+#'   ## Types of Model
+#'
+#'   There are two modelling approaches available to [build_dw_model()]:
+#'
+#'   - Boosted Trees (`xgboost`, `lightgbm`)
+#'
+#'   - Random Forest (`ranger`)
+#'
+#'   Each of these approaches take different parameters.
+#'
+#'   ## Boosted Trees
+#'
+#'   Two engines are available for boosted tree models:
+#'
+#'   - `"xgboost"`
+#'
+#'   - `"lightgbm"`
+#'
+#'   The following parameters apply:
+#'
+#'   - `tree_depth`: Tree Depth
+#'
+#'   - `trees`: # Trees
+#'
+#'   - `learn_rate`: Learning Rate
+#'
+#'   - `mtry`: # Randomly Selected Predictors
+#'
+#'   - `min_n`: Minimal Node Size
+#'
+#'   - `loss_reduction`: Minimum Loss Reduction
+#'
+#'   - `sample_size`: Proportion Observations Sampled (`xgboost` only)
+#'
+#'   - `stop_iter`: # Iterations Before Stopping (`xgboost` only)
+#'
+#'   ## Random Forest
+#'
+#'   One engine is available for random forest models:
+#'
+#'   - `"ranger"`
+#'
+#'   The following parameters apply:
+#'
+#'   - `mtry`: # Randomly Selected Predictors
+#'
+#'   - `trees`: # Trees
+#'
+#'   - `min_n`: Minimal Node Size
 #'
 #' @return a 'Deweather' object for further analysis
 #'
@@ -35,20 +132,21 @@ build_dw_model <- function(
   pollutant,
   vars = c("trend", "ws", "wd", "hour", "weekday", "air_temp"),
   tree_depth = 5,
-  trees = 200L,
+  trees = 50L,
   learn_rate = 0.1,
   mtry = NULL,
   min_n = 10L,
   loss_reduction = 0,
   sample_size = 1L,
-  stop_iter = 190L,
-  engine = c("xgboost", "lightgbm"),
+  stop_iter = 45L,
+  engine = c("xgboost", "lightgbm", "ranger"),
   ...,
   .date = "date"
 ) {
   # check inputs
   rlang::check_dots_empty()
   engine <- rlang::arg_match(engine, multiple = FALSE)
+  engine_method <- define_engine_method(engine)
   vars <- rlang::arg_match(
     vars,
     unique(c(dwVars, names(data))),
@@ -84,29 +182,91 @@ build_dw_model <- function(
   )
 
   # define model spec
-  model_spec <-
-    parsnip::boost_tree(
-      mode = "regression",
-      engine = engine,
-      tree_depth = !!tree_depth,
-      trees = !!trees,
-      learn_rate = !!learn_rate,
-      mtry = !!mtry,
-      min_n = !!min_n,
-      loss_reduction = !!loss_reduction,
-      sample_size = !!sample_size,
-      stop_iter = !!stop_iter
+  if (engine_method == "boost_tree") {
+    model_spec <-
+      parsnip::boost_tree(
+        mode = "regression",
+        engine = engine,
+        tree_depth = !!tree_depth,
+        trees = !!trees,
+        learn_rate = !!learn_rate,
+        mtry = !!mtry,
+        min_n = !!min_n,
+        loss_reduction = !!loss_reduction,
+        sample_size = !!sample_size,
+        stop_iter = !!stop_iter
+      )
+
+    # list parameters
+    params <- list(
+      tree_depth = tree_depth,
+      trees = trees,
+      learn_rate = learn_rate,
+      mtry = mtry,
+      min_n = min_n,
+      loss_reduction = loss_reduction
     )
 
+    # if xgboost, also include extra 2 params
+    if (engine == "xgboost") {
+      params <- append(
+        params,
+        list(
+          sample_size = sample_size,
+          stop_iter = stop_iter
+        )
+      )
+    }
+  }
+
+  if (engine_method == "rand_forest") {
+    model_spec <-
+      parsnip::rand_forest(
+        mode = "regression",
+        engine = engine,
+        trees = !!trees,
+        mtry = !!mtry,
+        min_n = !!min_n
+      )
+
+    # need a second spec for importance calcs
+    model_spec_importance <-
+      parsnip::rand_forest(
+        mode = "regression",
+        trees = !!trees,
+        mtry = !!mtry,
+        min_n = !!min_n
+      ) |>
+      parsnip::set_engine(
+        engine = engine,
+        importance = "impurity_corrected"
+      )
+
+    # list parameters - only three
+    params <- list(
+      trees = trees,
+      mtry = mtry,
+      min_n = min_n
+    )
+  }
+
   # build a formula object from poll & vars
   formula <- stats::reformulate(vars, pollutant)
 
   # fit the model
   model <- parsnip::fit(model_spec, formula, data = data)
 
-  # get importance
-  importance <- vip::vi(model$fit) |>
-    stats::setNames(c("var", "importance"))
+  if (engine_method == "boost_tree") {
+    # get importance
+    importance <- vip::vi(model$fit) |>
+      stats::setNames(c("var", "importance"))
+  } else {
+    # get importance
+    importance <- parsnip::fit(model_spec_importance, formula, data = data) |>
+      purrr::pluck("fit") |>
+      vip::vi() |>
+      stats::setNames(c("var", "importance"))
+  }
 
   # reverse the factor levels (for plotting mainly)
   importance$var <- factor(importance$var, rev(importance$var))
@@ -118,22 +278,16 @@ build_dw_model <- function(
       names = vars,
       types = as.character(purrr::map(data, class)[vars])
     ),
-    params = list(
-      tree_depth = tree_depth,
-      trees = trees,
-      learn_rate = learn_rate,
-      mtry = mtry,
-      min_n = min_n,
-      loss_reduction = loss_reduction,
-      sample_size = sample_size,
-      stop_iter = stop_iter
-    ),
+    params = params,
     data = list(
       input = data,
       importance = dplyr::tibble(importance)
     ),
     model = model,
-    engine = "xgboost",
+    engine = list(
+      engine = engine,
+      method = engine_method
+    ),
     tz = tz
   )
 

R/deweather-generics.R

@@ -4,14 +4,21 @@
 #' @export
 #' @author Jack Davison
 print.Deweather <- function(x, ...) {
-  labs <-
-    get_dw_importance(x, aggregate_factors = TRUE, sort = TRUE) |>
-    dplyr::arrange(dplyr::desc(.data$importance)) |>
-    dplyr::mutate(
-      importance = paste0(round(.data$importance * 100, 1), "%"),
-      lab = paste0(.data$var, " (", .data$importance, ")")
-    ) |>
-    dplyr::pull("lab")
+  if (x$engine$method == "boost_tree") {
+    labs <-
+      get_dw_importance(x, aggregate_factors = TRUE, sort = TRUE) |>
+      dplyr::arrange(dplyr::desc(.data$importance)) |>
+      dplyr::mutate(
+        importance = scales::label_percent(0.1)(.data$importance),
+        lab = paste0(.data$var, " (", .data$importance, ")")
+      ) |>
+      dplyr::pull("lab")
+  } else {
+    labs <-
+      get_dw_importance(x, aggregate_factors = TRUE, sort = TRUE) |>
+      dplyr::arrange(dplyr::desc(.data$importance)) |>
+      dplyr::pull("var")
+  }
 
   str <- c(
     "*" = "A model for predicting {.strong {get_dw_pollutant(x)}} using {.field {labs}}."

R/get_dw.R

@@ -14,8 +14,8 @@
 #'
 #' @param aggregate_factors Defaults to `FALSE`. If `TRUE`, the importance of
 #'   factor inputs (e.g., Weekday) will be summed into a single variable. This
-#'   only applies to certain engines which report factor importance as
-#'   disaggregate features.
+#'   only applies to certain engines (e.g., `"xgboost"`) which report factor
+#'   importance as disaggregate features.
 #'
 #' @param sort If `TRUE`, the default, features will be sorted by their
 #'   importance. If `FALSE`, they will be sorted alphabetically. In
@@ -81,7 +81,7 @@ get_dw_model <- function(dw) {
 #' @export
 get_dw_engine <- function(dw) {
   check_deweather(dw)
-  dw$engine
+  dw$engine$engine
 }
 
 

R/plot_dw_importance.R

@@ -1,7 +1,8 @@
 #' Visualise deweather model feature importance
 #'
-#' Visualise the feature importance (% Gain for boosted tree models) for each
-#' variable of a deweather model, with some customisation.
+#' Visualise the feature importance (% Gain for boosted tree models, permutation
+#' importance for random forest models) for each variable of a deweather model
+#' as a bar chart, with some customisation.
 #'
 #' @inheritParams get_dw_importance
 #'
@@ -16,16 +17,21 @@ plot_dw_importance <-
     importance <-
       get_dw_importance(dw, aggregate_factors = aggregate_factors, sort = sort)
 
+    scale_fun <- if (dw$engine$method == "boost_tree") {
+      scales::label_percent()
+    } else {
+      scales::label_comma()
+    }
+
     ggplot2::ggplot(
       importance,
       ggplot2::aes(x = .data[["importance"]], y = .data[["var"]])
     ) +
       ggplot2::geom_col(fill = openair::openColours(cols, n = 1L)) +
       ggplot2::scale_x_continuous(
         expand = ggplot2::expansion(c(0, .1)),
-        labels = function(x) {
-          paste0(x * 100, "%")
-        }
+        breaks = scales::pretty_breaks(),
+        labels = scale_fun
       ) +
       ggplot2::scale_y_discrete(
         labels = \(x) sapply(x, openair::quickText)