|
| 1 | +# gen_additive_mod() - General Interface to Linear GAM Models |
| 2 | +# - backend: gam |
| 3 | +# - prediction: |
| 4 | +# - mode = "regression" (default) uses |
| 5 | +# - mode = "classification" |
| 6 | + |
| 7 | +#' Generalized additive models (GAMs) |
| 8 | +#' |
| 9 | +#' `gen_additive_mod()` defines a model that can use smoothed functions of |
| 10 | +#' numeric predictors in a generalized linear model. |
| 11 | +#' |
| 12 | +#' There are different ways to fit this model. See the engine-specific pages |
| 13 | +#' for more details |
| 14 | +#' |
| 15 | +#' More information on how `parsnip` is used for modeling is at |
| 16 | +#' \url{https://www.tidymodels.org}. |
| 17 | +#' |
| 18 | +#' @inheritParams boost_tree |
| 19 | +#' @param select_features TRUE or FALSE. If this is TRUE then can add an |
| 20 | +#' extra penalty to each term so that it can be penalized to zero. |
| 21 | +#' This means that the smoothing parameter estimation that is part of |
| 22 | +#' fitting can completely remove terms from the model. If the corresponding |
| 23 | +#' smoothing parameter is estimated as zero then the extra penalty has no effect. |
| 24 | +#' Use `adjust_deg_free` to increase level of penalization. |
| 25 | +#' @param adjust_deg_free If `select_features = TRUE`, then acts as a multiplier for smoothness. |
| 26 | +#' Increase this beyond 1 to produce smoother models. |
| 27 | +#' |
| 28 | +#' |
| 29 | +#' @return |
| 30 | +#' A `parsnip` model specification |
| 31 | +#' |
| 32 | +#' @details |
| 33 | +#' |
| 34 | +#' This function only defines what _type_ of model is being fit. Once an engine |
| 35 | +#' is specified, the _method_ to fit the model is also defined. |
| 36 | +#' |
| 37 | +#' The model is not trained or fit until the [fit.model_spec()] function is used |
| 38 | +#' with the data. |
| 39 | +#' |
| 40 | +#' __gam__ |
| 41 | +#' |
| 42 | +#' This engine uses [mgcv::gam()] and has the following parameters, |
| 43 | +#' which can be modified through the [set_engine()] function. |
| 44 | +#' |
| 45 | +#' ``` {r echo=F} |
| 46 | +#' str(mgcv::gam) |
| 47 | +#' ``` |
| 48 | +#' |
| 49 | +#' @section Fit Details: |
| 50 | +#' |
| 51 | +#' __MGCV Formula Interface__ |
| 52 | +#' |
| 53 | +#' Fitting GAMs is accomplished using parameters including: |
| 54 | +#' |
| 55 | +#' - [mgcv::s()]: GAM spline smooths |
| 56 | +#' - [mgcv::te()]: GAM tensor product smooths |
| 57 | +#' |
| 58 | +#' These are applied in the `fit()` function: |
| 59 | +#' |
| 60 | +#' ``` r |
| 61 | +#' fit(value ~ s(date_mon, k = 12) + s(date_num), data = df) |
| 62 | +#' ``` |
| 63 | +#' |
| 64 | +#' @references \url{https://www.tidymodels.org}, |
| 65 | +#' [_Tidy Models with R_](https://tmwr.org) |
| 66 | +#' @examples |
| 67 | +#' |
| 68 | +#' #show_engines("gen_additive_mod") |
| 69 | +#' |
| 70 | +#' #gen_additive_mod() |
| 71 | +#' |
| 72 | +#' |
| 73 | +#' @export |
| 74 | +gen_additive_mod <- function(mode = "unknown", |
| 75 | + select_features = NULL, |
| 76 | + adjust_deg_free = NULL) { |
| 77 | + |
| 78 | + args <- list( |
| 79 | + select_features = rlang::enquo(select_features), |
| 80 | + adjust_deg_free = rlang::enquo(adjust_deg_free) |
| 81 | + ) |
| 82 | + |
| 83 | + new_model_spec( |
| 84 | + "gen_additive_mod", |
| 85 | + args = args, |
| 86 | + eng_args = NULL, |
| 87 | + mode = mode, |
| 88 | + method = NULL, |
| 89 | + engine = NULL |
| 90 | + ) |
| 91 | + |
| 92 | +} |
| 93 | + |
| 94 | +#' @export |
| 95 | +print.gen_additive_mod <- function(x, ...) { |
| 96 | + cat("GAM Specification (", x$mode, ")\n\n", sep = "") |
| 97 | + model_printer(x, ...) |
| 98 | + |
| 99 | + if(!is.null(x$method$fit$args)) { |
| 100 | + cat("Model fit template:\n") |
| 101 | + print(show_call(x)) |
| 102 | + } |
| 103 | + |
| 104 | + invisible(x) |
| 105 | +} |
| 106 | + |
| 107 | +#' @export |
| 108 | +#' @rdname parsnip_update |
| 109 | +#' @importFrom stats update |
| 110 | +#' @inheritParams gen_additive_mod |
| 111 | +update.gen_additive_mod <- function(object, |
| 112 | + select_features = NULL, |
| 113 | + adjust_deg_free = NULL, |
| 114 | + parameters = NULL, |
| 115 | + fresh = FALSE, ...) { |
| 116 | + |
| 117 | + update_dot_check(...) |
| 118 | + |
| 119 | + if (!is.null(parameters)) { |
| 120 | + parameters <- check_final_param(parameters) |
| 121 | + } |
| 122 | + |
| 123 | + args <- list( |
| 124 | + select_features = rlang::enquo(select_features), |
| 125 | + adjust_deg_free = rlang::enquo(adjust_deg_free) |
| 126 | + ) |
| 127 | + |
| 128 | + args <- update_main_parameters(args, parameters) |
| 129 | + |
| 130 | + if (fresh) { |
| 131 | + object$args <- args |
| 132 | + } else { |
| 133 | + null_args <- purrr::map_lgl(args, null_value) |
| 134 | + if (any(null_args)) |
| 135 | + args <- args[!null_args] |
| 136 | + if (length(args) > 0) |
| 137 | + object$args[names(args)] <- args |
| 138 | + } |
| 139 | + |
| 140 | + new_model_spec( |
| 141 | + "gen_additive_mod", |
| 142 | + args = object$args, |
| 143 | + eng_args = object$eng_args, |
| 144 | + mode = object$mode, |
| 145 | + method = NULL, |
| 146 | + engine = object$engine |
| 147 | + ) |
| 148 | +} |
| 149 | + |
| 150 | + |
| 151 | +#' @export |
| 152 | +translate.gen_additive_mod <- function(x, engine = x$engine, ...) { |
| 153 | + if (is.null(engine)) { |
| 154 | + message("Used `engine = 'mgcv'` for translation.") |
| 155 | + engine <- "gam" |
| 156 | + } |
| 157 | + x <- translate.default(x, engine, ...) |
| 158 | + |
| 159 | + x |
| 160 | +} |
| 161 | + |
| 162 | +#' @export |
| 163 | +#' @keywords internal |
| 164 | +fit_xy.gen_additive_mod <- function(object, ...) { |
| 165 | + rlang::abort("`fit()` must be used with GAM models (due to its use of formulas).") |
| 166 | +} |
0 commit comments