R/initialize_params.R
In timradtke/heuristika: Robust Probabilistic Forecasts to Tinker With
Defines functions
add_dampening_to_grid
sample_grid
initialize_params_random
initialize_params_naive
initialize_params_grid
Documented in
initialize_params_grid
initialize_params_naive
initialize_params_random
#' Initialize paramaters to optimize over based on a fixed grid
#'
#' Use this function to generate a parameter grid (matrix) that can be provided
#' to the `param_grid` argument of [tulip::tulip()]. The model estimation then
#' reduces to evaluating all provided combinations and choosing the best one.
#' See Details for more. Note that there is nothing special about the matrix
#' generated by this function---you can define a set of possible parameters in
#' any way that suits you.
#'
#' The optimization procedure in [tulip::tulip()] evaluates each combination of
#' parameters provided via `param_grid`. While this is computationally costly,
#' it is also computationally stable. By consciously choosing parameters that
#' are trialled, unstable parameter combinations can be avoided. The prior
#' probability for many parameter combinations can be set to zero this way.
#' If the set of parameters can be restricted very far (for example, because one
#' updates from a previous fit or based on a related time series), it also makes
#' the optimization computationally cheap.
#'
#' The default grid returned does not include any 'alpha', 'beta', or
#' 'gamma' with value of 0.5 or higher. This reduces the set of possible models to
#' ones that adapt relatively slowly to new observations, reducing the impact an
#' outlier can have. Yet, a 'beta' of 0.5 can still lead to explosive jumps
#' depending on the context. This is *very* opinionated, and you
#' might want to deviate from that using the `upper_limit` parameter.
#'
#' This function returns a grid that repeats `n_alpha`, `n_beta`, `n_gamma`
#' values again and again. This means that the space of possible parameters
#' is not covered very well---a known drawback of grid search compared to random
#' search. Consider drawing the set of possible parameter combinations randomly
#' from a space of allowed values instead to avoid this. See also Bergstra and
#' Bengio (2012) referenced below.
#'
#' @param n_alpha Base number of `alpha` candidate values
#' @param n_beta Base number of `beta` candidate values
#' @param n_gamma Base number of `gamma` candidate values
#' @param use_damped Logical (default TRUE); should a damped trends be part of
#' the parameter grid? This is implemented by subtracting value from the
#' `one_minus_beta` parameter such that `beta + one_minus_beta < 1`.
#' @param beta_smaller_than_alpha Logical; should `beta` be constrained to
#' always be smaller than or equal to `alpha`? See, for example,
#' chapter 3.4.2 of Hyndman et al. (2002) referenced below.
#' @param gamma_smaller_than_one_minus_alpha Logical; should `gamma` be
#' constrained to always be smaller than or equal to `(1-alpha)`?
#' See, for example, chapter 3.4.3 of Hyndman et al. (2002) referenced
#' below.
#' @param use_logistic Logical; should the logistic function be used to
#' distribute the base candidate values? This is useful if the boundaries at
#' 0 and 1 should be more closely trialed than values around 0.5. If FALSE,
#' the base candidate values are distributed linearly between 0 and 1.
#' @param logistic_limit Most extreme value provided into the logistic function;
#' if `logistic_limit` is x, then the largest value trialed besides 1 is
#' `1 / (1 + exp(-1 * logistic_limit))`. The default is 5, corresponding to
#' a value of 0.9933.
#' @param upper_limit The largest value that any `alpha`, `beta`, and `gamma`
#' can take on in the returned grid; default is 0.5. Note that this is
#' applied at the very end of the function and therefore is not the most
#' efficient way of limiting the set of possible parameters.
#' @param lower_limit The lowest value that any `alpha`, `beta`, and `gamma`
#' can take on in the returned grid; default is 0. Do not deviate from this
#' unless you know what you're doing as the impact on the possible set of
#' models is large due to the `beta` parameter especially. Note that this is
#' applied at the very end of the function and therefore is not the most
#' efficient way of limiting the set of possible parameters.
#'
#' @return A numeric matrix with six named columns: 'alpha', 'one_minus_alpha',
#' 'beta', 'one_minus_beta', 'gamma', 'one_minus_gamma'. The `alpha`
#' paramaters belong to the model's level component, the `beta` parameters
#' to the model's trend component, and the `gamma` parameters to the model's
#' seasonality component. Each pair usually adds up to 1, however dampening
#' effectively reduces the sum of `beta` and `one_minus_beta` to less than
#' 1. As per assertions on [tulip::tulip()]'s `param_grid`, each row must
#' sum up to a value between 0 and 3, the columns must be named and in
#' order, and each individual value must be between 0 and 1.
#'
#' @seealso [tulip::tulip()], [initialize_params_random()],
#' [initialize_params_naive()]
#'
#' @references
#' \describe{
#' \item{Rob J. Hyndman, Anne B. Koehler, Ralph D. Snyder, and Simone Grose (2002). *A State Space Framework for Automatic Forecasting using Exponential Smoothing Methods*.}{\url{https://doi.org/10.1016/S0169-2070(01)00110-8}}
#' \item{James Bergstra, Yoshua Bengio (2012). *Random Search for Hyper-Parameter Optimization*.}{\url{https://www.jmlr.org/papers/volume13/bergstra12a/bergstra12a.pdf}}
#' }
#'
#' @export
#' @examples
#' head(initialize_params_grid(), 10)
#' tail(initialize_params_grid(), 10)
#'
#' param_grid <- data.frame(initialize_params_grid())
#'
#' library(ggplot2)
#' ggplot(param_grid, aes(x = alpha, y = beta, fill = gamma)) +
#' geom_jitter(pch = 21, color = "white", width = 0.01, height = 0.01)
#'
initialize_params_grid <- function(n_alpha = 15,
n_beta = 15,
n_gamma = 15,
use_damped = TRUE,
beta_smaller_than_alpha = TRUE,
gamma_smaller_than_one_minus_alpha = TRUE,
use_logistic = TRUE,
logistic_limit = 5,
upper_limit = 0.5,
lower_limit = 0) {
checkmate::assert_integerish(
x = n_alpha, lower = 1, any.missing = FALSE, len = 1
)
checkmate::assert_integerish(
x = n_beta, lower = 1, any.missing = FALSE, len = 1
)
checkmate::assert_integerish(
x = n_gamma, lower = 1, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = use_damped, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = beta_smaller_than_alpha, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = gamma_smaller_than_one_minus_alpha, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = use_logistic, any.missing = FALSE, len = 1
)
checkmate::assert_numeric(
x = logistic_limit, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = lower_limit, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = upper_limit, lower = lower_limit, len = 1, any.missing = FALSE
)
if (use_logistic) {
get_params <- function(n) {
c(0, 1, 1 / (1 + exp(- seq(-1 * logistic_limit, logistic_limit,
length.out = n - 2))))
}
} else {
get_params <- function(n) seq(0, 1, length.out = n)
}
param_grid <- expand.grid(
alpha = get_params(n_alpha),
one_minus_alpha = NA,
beta = get_params(n_beta),
one_minus_beta = NA,
gamma = get_params(n_gamma),
one_minus_gamma = NA
)
param_grid$one_minus_alpha <- 1 - param_grid$alpha
param_grid$one_minus_beta <- 1 - param_grid$beta
param_grid$one_minus_gamma <- 1 - param_grid$gamma
if (beta_smaller_than_alpha) {
param_grid <- param_grid[param_grid$beta < param_grid$alpha |
param_grid$beta == 0, ]
}
if (gamma_smaller_than_one_minus_alpha) {
param_grid <- param_grid[param_grid$gamma < param_grid$one_minus_alpha |
param_grid$gamma == 0, ]
}
tmp_grid_no_trend <- param_grid
tmp_grid_no_trend$beta <- 0
tmp_grid_no_trend$one_minus_beta <- 0
tmp_grid_no_season <- param_grid
tmp_grid_no_season$gamma <- 0
tmp_grid_no_season$one_minus_gamma <- 0
tmp_grid_only_level <- param_grid
tmp_grid_only_level$beta <- 0
tmp_grid_only_level$one_minus_beta <- 0
tmp_grid_only_level$gamma <- 0
tmp_grid_only_level$one_minus_gamma <- 0
param_grid <- rbind(
tmp_grid_only_level,
tmp_grid_no_season,
tmp_grid_no_trend,
param_grid
)
if (isTRUE(use_damped)) {
dampening <- 1 - c(0.99, 0.95, 0.9, 0.75, 0.5, 0.25, 0.1)^(1/12)
tmp_grid_with_trend <- param_grid[param_grid$beta != 0 &
param_grid$one_minus_beta != 0, ]
for (i in seq_along(dampening)) {
tmp_grid_with_trend_i <- tmp_grid_with_trend
tmp_grid_with_trend_i$one_minus_beta <- pmax(
0, tmp_grid_with_trend$one_minus_beta - dampening[i]
)
param_grid <- rbind(param_grid, tmp_grid_with_trend_i)
}
}
param_grid <- param_grid[param_grid$alpha >= lower_limit, ]
param_grid <- param_grid[param_grid$beta >= lower_limit, ]
param_grid <- param_grid[param_grid$gamma >= lower_limit, ]
param_grid <- param_grid[param_grid$alpha <= upper_limit, ]
param_grid <- param_grid[param_grid$beta <= upper_limit, ]
param_grid <- param_grid[param_grid$gamma <= upper_limit, ]
param_grid <- unique(as.matrix(param_grid), MARGIN = 1)
return(param_grid)
}
#' Initialize paramaters to optimize over based on a set of naive models
#'
#' Use this function to generate a parameter grid (matrix) that can be provided
#' to the `param_grid` argument of [tulip::tulip()]. The model estimation then
#' reduces to evaluating all provided combinations and choosing the best one.
#' See Details for more. Note that there is nothing special about the matrix
#' generated by this function---you can define a set of possible parameters in
#' any way that suits you.
#'
#' @return A numeric matrix with six named columns: 'alpha', 'one_minus_alpha',
#' 'beta', 'one_minus_beta', 'gamma', 'one_minus_gamma'. The `alpha`
#' paramaters belong to the model's level component, the `beta` parameters
#' to the model's trend component, and the `gamma` parameters to the model's
#' seasonality component. Each pair usually adds up to 1, however dampening
#' effectively reduces the sum of `beta` and `one_minus_beta` to less than
#' 1. As per assertions on [tulip::tulip()]'s `param_grid`, each row must
#' sum up to a value between 0 and 3, the columns must be named and in
#' order, and each individual value must be between 0 and 1.
#'
#' @seealso [tulip::tulip()], [initialize_params_random()],
#' [initialize_params_grid()]
#'
#' @references
#' \describe{
#' \item{Rob J. Hyndman, Anne B. Koehler, Ralph D. Snyder, and Simone Grose (2002). *A State Space Framework for Automatic Forecasting using Exponential Smoothing Methods*.}{\url{https://doi.org/10.1016/S0169-2070(01)00110-8}}
#' }
#'
#' @export
#' @examples
#' initialize_params_naive()
#'
initialize_params_naive <- function() {
grid_only_naive <- data.frame(
alpha = 1,
one_minus_alpha = 0,
beta = 0,
one_minus_beta = 0,
gamma = 0,
one_minus_gamma = 0
)
grid_only_mean <- data.frame(
alpha = 0,
one_minus_alpha = 1,
beta = 0,
one_minus_beta = 0,
gamma = 0,
one_minus_gamma = 0
)
grid_only_smean <- data.frame(
alpha = 0,
one_minus_alpha = 1,
beta = 0,
one_minus_beta = 0,
gamma = 0,
one_minus_gamma = 1
)
grid_only_snaive <- data.frame(
alpha = 0,
one_minus_alpha = 0,
beta = 0,
one_minus_beta = 0,
gamma = 1,
one_minus_gamma = 0
)
grid <- rbind(
grid_only_naive,
grid_only_mean,
grid_only_smean,
grid_only_snaive
)
grid <- as.matrix(grid)
return(grid)
}
#' Initialize paramaters to optimize over randomly
#'
#' Use this function to generate a randomly sampled parameter grid (matrix) that
#' can be provided to the `param_grid` argument of [tulip::tulip()]. The model
#' estimation then reduces to evaluating all provided combinations and choosing
#' the best one. See Details for more. Note that there is nothing special about
#' the matrix generated by this function---you can define a set of possible
#' parameters in any way that suits you.
#'
#' The optimization procedure in [tulip::tulip()] evaluates each combination of
#' parameters provided via `param_grid`. While this is computationally costly,
#' it is also computationally stable. By consciously choosing parameters that
#' are trialled, unstable parameter combinations can be avoided. The prior
#' probability for many parameter combinations can be set to zero this way.
#' If the set of parameters can be restricted very far (for example, because one
#' updates from a previous fit or based on a related time series), it also makes
#' the optimization computationally cheap.
#'
#' In contrast to [initialize_params_grid()], this function draws random
#' combinations of `alpha`, `beta`, and `gamma` from an allowed space of values.
#' This can allow for better overall optimization of the model, as the overall
#' space of possible parameters is covered better. See also Bergstra and Bengio
#' (2012) referenced below for a comparison of grid search and random search.
#'
#' Depending on the set of chosen function arguments, it can be likely that the
#' function generates some duplicate parameter combinations (for example when
#' `oversample_upper` or `oversample_lower` are non-zero). These will be dropped
#' before the final matrix is returned. This means, however, that the function
#' does not guarantee to return
#' `n + n_damped + n_no_trend + n_no_season + n_no_trend_no_season` parameter
#' combinations. It might return less than that.
#'
#' One can also combine a fixed set of parameters *and* randomly drawn
#' parameters, for example to always evaluate parameter combinations known to
#' provide good results for other time series, or to also evaluate parameters
#' that were found at a previous training on the same time series, or to
#' include a set of benchmark models via [initialize_params_naive()], for
#' example. See also the examples below.
#'
#' @param n_damped Number of parameter combinations to sample that include all
#' three states (level, trend, seasonality) and dampening of the trend.
#' **Note**: By default, `n`, `n_no_trend`, `n_no_season`,
#' `n_no_trend_no_season` are functions of the value chosen for `n_damped`.
#' @param n Number of parameter combinations to sample that include all three
#' states (level, trend, seasonality), but no dampening.
#' @param n_no_trend Number of parameter combinations to sample that set the
#' trend parameters to 0, implying models that don't have a trend component;
#' since only two dimensions are sampled (level and seasonality), it usually
#' makes sense to use a smaller `n_no_trend` than `n` (unless you are
#' not interested in models with trend).
#' @param n_no_season Number of parameter combinations to sample that set the
#' seasonality parameters to 0, implying models that don't have a seasonality
#' component; since only two dimensions are sampled (level and trend), it
#' usually makes sense to use a smaller `n_no_season` than `n` (unless you are
#' not interested in models with seasonality).
#' @param n_no_trend_no_season Number of parameter combinations to sample that
#' set the trend and seasonality parameters to 0, implying models that don't
#' have a seasonality component; since only one dimension is sampled (level),
#' it usually makes sense to use a smaller `n_no_trend_no_season` than `n`
#' (unless you are not interested in models with trend and seasonality).
#' @param alpha_lower A scalar value defining the lowest possible value for the
#' `alpha` parameter. Can't be less than 0.
#' @param alpha_upper A scalar value defining the largest possible value for the
#' `alpha` parameter. The default is 1, but values larger than 1 are possible.
#' Can't be less than `alpha_lower`. If `alpha_lower` is equal to
#' `alpha_upper`, all samples for `alpha` will be equal to `alpha_lower` and
#' `alpha_upper` exactly.
#' @param beta_lower A scalar value defining the lowest possible value for the
#' `beta` parameter. Can't be less than 0.
#' @param beta_upper A scalar value defining the largest possible value for the
#' `beta` parameter. The default is 1, but values larger than 1 are possible.
#' Can't be less than `beta_lower`. If `beta_lower` is equal to
#' `beta_upper`, all samples for `beta` will be equal to `beta_lower` and
#' `beta_upper` exactly.
#' @param gamma_lower A scalar value defining the lowest possible value for the
#' `gamma` parameter. Can't be less than 0.
#' @param gamma_upper A scalar value defining the largest possible value for the
#' `gamma` parameter. The default is 1, but values larger than 1 are possible.
#' Can't be less than `gamma_lower`. If `gamma_lower` is equal to
#' `gamma_upper`, all samples for `gamma` will be equal to `gamma_lower` and
#' `gamma_upper` exactly.
#' @param beta_smaller_than_alpha If `TRUE` (default), sampling of `beta` is
#' conditional on the value of the sampled `alpha`, using
#' `pmin(alpha, beta_upper)` as the upper limit for `beta`.
#' @param gamma_smaller_than_one_minus_alpha If `TRUE` (default), sampling of
#' `gamma` is conditional on the value of the sampled `alpha`, using
#' `pmin(1 - alpha, gamma_upper)` as the upper limit for `gamma`.
#' @param oversample_lower Can be used to increase the chances that the lowest
#' allowed value is sampled for the parameters `alpha`, `beta`, and `gamma`.
#' This can be useful to find parameter combinations in which a component is
#' not smoothed at all and thus some constant average across all combinations.
#' For example, an ETS model with only a `level` component and `alpha = 0`
#' would be equivalent to the mean forecast.
#' @param oversample_upper Can be used to increase the chances that the largest
#' allowed value is sampled for the parameters `alpha`, and `gamma`.
#' This can be useful to find parameter combinations in which a component is
#' heavily smoothed (ajdusting to the latest observation). This turns the
#' level component into behavior similar to a random walk forecast (if
#' `alpha_upper = 1`), and the seasonal component into behavior similar to a
#' seasonal random walk forecast (if `gamma_upper = 1`).
#' @param seed Since the parameter grid is sampled randomly, you can set a seed
#' (local to the function) for reproducibility.
#'
#' @return A numeric matrix with six named columns: 'alpha', 'one_minus_alpha',
#' 'beta', 'one_minus_beta', 'gamma', 'one_minus_gamma'. The `alpha`
#' paramaters belong to the model's level component, the `beta` parameters
#' to the model's trend component, and the `gamma` parameters to the model's
#' seasonality component. Each pair usually adds up to 1, however dampening
#' effectively reduces the sum of `beta` and `one_minus_beta` to less than
#' 1. As per assertions on [tulip::tulip()]'s `param_grid`, each row must
#' sum up to a value between 0 and 3, the columns must be named and in
#' order, and each individual value must be between 0 and 1.
#'
#' @seealso [tulip::tulip()], [initialize_params_grid()],
#' [initialize_params_naive()]
#'
#' @references
#' \describe{
#' \item{Rob J. Hyndman, Anne B. Koehler, Ralph D. Snyder, and Simone Grose (2002). *A State Space Framework for Automatic Forecasting using Exponential Smoothing Methods*.}{\url{https://doi.org/10.1016/S0169-2070(01)00110-8}}
#' \item{James Bergstra, Yoshua Bengio (2012). *Random Search for Hyperparameter Optimization*.}{\url{https://www.jmlr.org/papers/volume13/bergstra12a/bergstra12a.pdf}}
#' }
#'
#' @export
#' @examples
#' library(ggplot2)
#'
#' param_grid_small <- initialize_params_random(
#' n_damped = 46,
#' seed = 388
#' )
#'
#' nrow(param_grid_small)
#'
#' summary(param_grid_small[, "alpha"])
#' summary(param_grid_small[, "beta"])
#' summary(param_grid_small[, "one_minus_beta"])
#' summary(param_grid_small[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid_small),
#' aes(x = alpha, y = gamma,fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # No one prevents you from combining a set of randomly drawn parameter
#' # combinations with a fixed set of parameters; for example, you can always
#' # evaluate parameters that correspond to the Random Walk, Seasonal Random
#' # Walk, or Mean model:
#'
#' param_grid_w_naive <- rbind(
#' initialize_params_naive(),
#' param_grid_small
#' )
#'
#' head(param_grid_w_naive)
#'
#' # note the new dots in the corners at (0, 0) and (0, 1)
#' ggplot(as.data.frame(param_grid_w_naive),
#' aes(x = alpha, y = gamma,fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # More samples cover the possible parameter space better
#' param_grid <- initialize_params_random(
#' n_damped = 1000,
#' seed = 388
#' )
#'
#' nrow(param_grid)
#'
#' summary(param_grid[, "alpha"])
#' summary(param_grid[, "beta"])
#' summary(param_grid[, "one_minus_beta"])
#' summary(param_grid[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid),
#' aes(x = alpha, y = gamma,fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # by default, we oversample the borders; this can be turned off to not
#' # sample 0- and 1-valued parameters as often
#' param_grid_no_border_sampling <- initialize_params_random(
#' n_damped = 1000,
#' seed = 388,
#' oversample_lower = 0,
#' oversample_upper = 0
#' )
#'
#' summary(param_grid_no_border_sampling[, "alpha"])
#' summary(param_grid_no_border_sampling[, "beta"])
#' summary(param_grid_no_border_sampling[, "one_minus_beta"])
#' summary(param_grid_no_border_sampling[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid_no_border_sampling),
#' aes(x = alpha, y = gamma, fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # The parameter space can be limited, sampling remains uniform
#' param_grid_restricted <- initialize_params_random(
#' n_damped = 1000,
#' seed = 388,
#' alpha_upper = 0.5,
#' beta_upper = 0.05,
#' gamma_upper = 0.5,
#' oversample_lower = 0.05,
#' oversample_upper = 0
#' )
#'
#' nrow(param_grid_restricted)
#'
#' summary(param_grid_restricted[, "alpha"])
#' summary(param_grid_restricted[, "beta"])
#' summary(param_grid_restricted[, "one_minus_beta"])
#' summary(param_grid_restricted[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid_restricted),
#' aes(x = alpha, y = gamma, fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
initialize_params_random <- function(n_damped = 1000,
n = n_damped / 2,
n_no_trend = ceiling(n_damped^(2/3)),
n_no_season = ceiling(n_damped^(2/3)),
n_no_trend_no_season = ceiling(n_damped^(1/3)), # nolint
alpha_lower = 0,
alpha_upper = 1,
beta_lower = 0,
beta_upper = 1,
gamma_lower = 0,
gamma_upper = 1,
beta_smaller_than_alpha = TRUE,
gamma_smaller_than_one_minus_alpha = TRUE,
oversample_lower = 0.05,
oversample_upper = 0.05,
seed = NULL) {
checkmate::assert_integerish(
x = n, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_damped, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_no_trend, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_no_season, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_no_trend_no_season, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = alpha_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = alpha_upper, lower = alpha_lower, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = beta_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = beta_upper, lower = beta_lower, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = gamma_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = gamma_upper, lower = gamma_lower, len = 1, any.missing = FALSE
)
checkmate::assert_logical(
x = beta_smaller_than_alpha, len = 1, any.missing = FALSE
)
checkmate::assert_logical(
x = gamma_smaller_than_one_minus_alpha, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = oversample_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = oversample_upper, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = seed, len = 1, null.ok = TRUE, any.missing = FALSE
)
if (n_damped > 0 && (alpha_upper == 0 || beta_upper == 0)) {
stop("If `use_damped = TRUE`, then `alpha_upper` and `beta_upper` must be strictly larger than 0.") # nolint
}
if (!is.null(seed)) {
# checking for existence to avoid issues when building vignettes
if (exists(".Random.seed")) {
random_seed_current <- .Random.seed
on.exit({.Random.seed <<- random_seed_current})
}
set.seed(seed = seed)
}
grid_base <- sample_grid(
n_target = n,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = beta_lower,
beta_upper = beta_upper,
gamma_lower = gamma_lower,
gamma_upper = gamma_upper,
beta_smaller_than_alpha = beta_smaller_than_alpha,
gamma_smaller_than_one_minus_alpha = gamma_smaller_than_one_minus_alpha,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid_damped <- sample_grid(
n_target = n_damped,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = beta_lower,
beta_upper = beta_upper,
gamma_lower = gamma_lower,
gamma_upper = gamma_upper,
beta_smaller_than_alpha = beta_smaller_than_alpha,
gamma_smaller_than_one_minus_alpha = gamma_smaller_than_one_minus_alpha,
oversample_lower = 0,
oversample_upper = oversample_upper
)
grid_damped <- add_dampening_to_grid(grid = grid_damped)
grid_no_trend <- sample_grid(
# proportionally less samples since only 2 of 3 dimensions are sampled
n_target = n_no_trend,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = 0,
beta_upper = 0,
gamma_lower = gamma_lower,
gamma_upper = gamma_upper,
beta_smaller_than_alpha = FALSE,
gamma_smaller_than_one_minus_alpha = gamma_smaller_than_one_minus_alpha,
fun_one_minus_beta = function(x) x,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid_no_season <- sample_grid(
# proportionally less samples since only 2 of 3 dimensions are sampled
n_target = n_no_season,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = beta_lower,
beta_upper = beta_upper,
gamma_lower = 0,
gamma_upper = 0,
beta_smaller_than_alpha = beta_smaller_than_alpha,
gamma_smaller_than_one_minus_alpha = FALSE,
fun_one_minus_gamma = function(x) x,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid_no_trend_no_season <- sample_grid(
# proportionally less samples since only 1 of 3 dimensions is sampled
n_target = n_no_trend_no_season,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = 0,
beta_upper = 0,
gamma_lower = 0,
gamma_upper = 0,
beta_smaller_than_alpha = FALSE,
gamma_smaller_than_one_minus_alpha = FALSE,
fun_one_minus_beta = function(x) x,
fun_one_minus_gamma = function(x) x,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid <- as.matrix(rbind(
grid_base,
grid_damped,
grid_no_trend,
grid_no_season,
grid_no_trend_no_season
))
grid <- unique(x = grid, MARGIN = 1)
return(grid)
}
sample_grid <- function(n_target = 100,
alpha_lower = 0, alpha_upper = 1,
beta_lower = 0, beta_upper = 1,
gamma_lower = 0, gamma_upper = 1,
beta_smaller_than_alpha = TRUE,
gamma_smaller_than_one_minus_alpha = TRUE,
fun_one_minus_beta = function(x) 1 - x,
fun_one_minus_gamma = function(x) 1 - x,
oversample_lower = 0.05,
oversample_upper = 0.05) {
alphas <- stats::runif(
n = n_target,
min = alpha_lower - oversample_lower,
max = alpha_upper + oversample_upper
)
alphas <- pmax(alpha_lower, pmin(alpha_upper, alphas))
beta_upper <- rep(beta_upper, n_target)
if (beta_smaller_than_alpha) {
beta_upper <- pmin(alphas, beta_upper)
}
betas <- stats::runif(
n = n_target,
min = beta_lower - oversample_lower,
max = beta_upper
)
betas <- pmax(beta_lower, pmin(beta_upper, betas))
gamma_upper <- rep(gamma_upper, n_target)
if (gamma_smaller_than_one_minus_alpha) {
gamma_upper <- pmin(1 - alphas, gamma_upper)
}
gammas <- stats::runif(
n = n_target,
min = gamma_lower - oversample_lower,
max = gamma_upper + oversample_upper
)
gammas <- pmax(gamma_lower, pmin(gamma_upper, gammas))
tmp_grid <- data.frame(
alpha = alphas,
one_minus_alpha = 1 - alphas,
beta = betas,
one_minus_beta = fun_one_minus_beta(betas),
gamma = gammas,
one_minus_gamma = fun_one_minus_beta(gammas)
)
return(tmp_grid)
}
add_dampening_to_grid <- function(grid) {
checkmate::assert_data_frame(x = grid)
if (nrow(grid) == 0L) {
return(grid)
}
dampening_factors <- 1 - c(0.99, 0.95, 0.9, 0.75, 0.5, 0.25, 0.1)^(1/12)
dampening <- rep(dampening_factors, length.out = nrow(grid))
grid$one_minus_beta <- pmax(0, grid$one_minus_beta - dampening)
return(grid)
}
timradtke/heuristika documentation built on April 24, 2023, 1:55 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions add_dampening_to_grid sample_grid initialize_params_random initialize_params_naive initialize_params_grid
Documented in initialize_params_grid initialize_params_naive initialize_params_random
#' Initialize paramaters to optimize over based on a fixed grid
#'
#' Use this function to generate a parameter grid (matrix) that can be provided
#' to the `param_grid` argument of [tulip::tulip()]. The model estimation then
#' reduces to evaluating all provided combinations and choosing the best one.
#' See Details for more. Note that there is nothing special about the matrix
#' generated by this function---you can define a set of possible parameters in
#' any way that suits you.
#'
#' The optimization procedure in [tulip::tulip()] evaluates each combination of
#' parameters provided via `param_grid`. While this is computationally costly,
#' it is also computationally stable. By consciously choosing parameters that
#' are trialled, unstable parameter combinations can be avoided. The prior
#' probability for many parameter combinations can be set to zero this way.
#' If the set of parameters can be restricted very far (for example, because one
#' updates from a previous fit or based on a related time series), it also makes
#' the optimization computationally cheap.
#'
#' The default grid returned does not include any 'alpha', 'beta', or
#' 'gamma' with value of 0.5 or higher. This reduces the set of possible models to
#' ones that adapt relatively slowly to new observations, reducing the impact an
#' outlier can have. Yet, a 'beta' of 0.5 can still lead to explosive jumps
#' depending on the context. This is *very* opinionated, and you
#' might want to deviate from that using the `upper_limit` parameter.
#'
#' This function returns a grid that repeats `n_alpha`, `n_beta`, `n_gamma`
#' values again and again. This means that the space of possible parameters
#' is not covered very well---a known drawback of grid search compared to random
#' search. Consider drawing the set of possible parameter combinations randomly
#' from a space of allowed values instead to avoid this. See also Bergstra and
#' Bengio (2012) referenced below.
#'
#' @param n_alpha Base number of `alpha` candidate values
#' @param n_beta Base number of `beta` candidate values
#' @param n_gamma Base number of `gamma` candidate values
#' @param use_damped Logical (default TRUE); should a damped trends be part of
#' the parameter grid? This is implemented by subtracting value from the
#' `one_minus_beta` parameter such that `beta + one_minus_beta < 1`.
#' @param beta_smaller_than_alpha Logical; should `beta` be constrained to
#' always be smaller than or equal to `alpha`? See, for example,
#' chapter 3.4.2 of Hyndman et al. (2002) referenced below.
#' @param gamma_smaller_than_one_minus_alpha Logical; should `gamma` be
#' constrained to always be smaller than or equal to `(1-alpha)`?
#' See, for example, chapter 3.4.3 of Hyndman et al. (2002) referenced
#' below.
#' @param use_logistic Logical; should the logistic function be used to
#' distribute the base candidate values? This is useful if the boundaries at
#' 0 and 1 should be more closely trialed than values around 0.5. If FALSE,
#' the base candidate values are distributed linearly between 0 and 1.
#' @param logistic_limit Most extreme value provided into the logistic function;
#' if `logistic_limit` is x, then the largest value trialed besides 1 is
#' `1 / (1 + exp(-1 * logistic_limit))`. The default is 5, corresponding to
#' a value of 0.9933.
#' @param upper_limit The largest value that any `alpha`, `beta`, and `gamma`
#' can take on in the returned grid; default is 0.5. Note that this is
#' applied at the very end of the function and therefore is not the most
#' efficient way of limiting the set of possible parameters.
#' @param lower_limit The lowest value that any `alpha`, `beta`, and `gamma`
#' can take on in the returned grid; default is 0. Do not deviate from this
#' unless you know what you're doing as the impact on the possible set of
#' models is large due to the `beta` parameter especially. Note that this is
#' applied at the very end of the function and therefore is not the most
#' efficient way of limiting the set of possible parameters.
#'
#' @return A numeric matrix with six named columns: 'alpha', 'one_minus_alpha',
#' 'beta', 'one_minus_beta', 'gamma', 'one_minus_gamma'. The `alpha`
#' paramaters belong to the model's level component, the `beta` parameters
#' to the model's trend component, and the `gamma` parameters to the model's
#' seasonality component. Each pair usually adds up to 1, however dampening
#' effectively reduces the sum of `beta` and `one_minus_beta` to less than
#' 1. As per assertions on [tulip::tulip()]'s `param_grid`, each row must
#' sum up to a value between 0 and 3, the columns must be named and in
#' order, and each individual value must be between 0 and 1.
#'
#' @seealso [tulip::tulip()], [initialize_params_random()],
#' [initialize_params_naive()]
#'
#' @references
#' \describe{
#' \item{Rob J. Hyndman, Anne B. Koehler, Ralph D. Snyder, and Simone Grose (2002). *A State Space Framework for Automatic Forecasting using Exponential Smoothing Methods*.}{\url{https://doi.org/10.1016/S0169-2070(01)00110-8}}
#' \item{James Bergstra, Yoshua Bengio (2012). *Random Search for Hyper-Parameter Optimization*.}{\url{https://www.jmlr.org/papers/volume13/bergstra12a/bergstra12a.pdf}}
#' }
#'
#' @export
#' @examples
#' head(initialize_params_grid(), 10)
#' tail(initialize_params_grid(), 10)
#'
#' param_grid <- data.frame(initialize_params_grid())
#'
#' library(ggplot2)
#' ggplot(param_grid, aes(x = alpha, y = beta, fill = gamma)) +
#' geom_jitter(pch = 21, color = "white", width = 0.01, height = 0.01)
#'
initialize_params_grid <- function(n_alpha = 15,
n_beta = 15,
n_gamma = 15,
use_damped = TRUE,
beta_smaller_than_alpha = TRUE,
gamma_smaller_than_one_minus_alpha = TRUE,
use_logistic = TRUE,
logistic_limit = 5,
upper_limit = 0.5,
lower_limit = 0) {
checkmate::assert_integerish(
x = n_alpha, lower = 1, any.missing = FALSE, len = 1
)
checkmate::assert_integerish(
x = n_beta, lower = 1, any.missing = FALSE, len = 1
)
checkmate::assert_integerish(
x = n_gamma, lower = 1, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = use_damped, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = beta_smaller_than_alpha, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = gamma_smaller_than_one_minus_alpha, any.missing = FALSE, len = 1
)
checkmate::assert_logical(
x = use_logistic, any.missing = FALSE, len = 1
)
checkmate::assert_numeric(
x = logistic_limit, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = lower_limit, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = upper_limit, lower = lower_limit, len = 1, any.missing = FALSE
)
if (use_logistic) {
get_params <- function(n) {
c(0, 1, 1 / (1 + exp(- seq(-1 * logistic_limit, logistic_limit,
length.out = n - 2))))
}
} else {
get_params <- function(n) seq(0, 1, length.out = n)
}
param_grid <- expand.grid(
alpha = get_params(n_alpha),
one_minus_alpha = NA,
beta = get_params(n_beta),
one_minus_beta = NA,
gamma = get_params(n_gamma),
one_minus_gamma = NA
)
param_grid$one_minus_alpha <- 1 - param_grid$alpha
param_grid$one_minus_beta <- 1 - param_grid$beta
param_grid$one_minus_gamma <- 1 - param_grid$gamma
if (beta_smaller_than_alpha) {
param_grid <- param_grid[param_grid$beta < param_grid$alpha |
param_grid$beta == 0, ]
}
if (gamma_smaller_than_one_minus_alpha) {
param_grid <- param_grid[param_grid$gamma < param_grid$one_minus_alpha |
param_grid$gamma == 0, ]
}
tmp_grid_no_trend <- param_grid
tmp_grid_no_trend$beta <- 0
tmp_grid_no_trend$one_minus_beta <- 0
tmp_grid_no_season <- param_grid
tmp_grid_no_season$gamma <- 0
tmp_grid_no_season$one_minus_gamma <- 0
tmp_grid_only_level <- param_grid
tmp_grid_only_level$beta <- 0
tmp_grid_only_level$one_minus_beta <- 0
tmp_grid_only_level$gamma <- 0
tmp_grid_only_level$one_minus_gamma <- 0
param_grid <- rbind(
tmp_grid_only_level,
tmp_grid_no_season,
tmp_grid_no_trend,
param_grid
)
if (isTRUE(use_damped)) {
dampening <- 1 - c(0.99, 0.95, 0.9, 0.75, 0.5, 0.25, 0.1)^(1/12)
tmp_grid_with_trend <- param_grid[param_grid$beta != 0 &
param_grid$one_minus_beta != 0, ]
for (i in seq_along(dampening)) {
tmp_grid_with_trend_i <- tmp_grid_with_trend
tmp_grid_with_trend_i$one_minus_beta <- pmax(
0, tmp_grid_with_trend$one_minus_beta - dampening[i]
)
param_grid <- rbind(param_grid, tmp_grid_with_trend_i)
}
}
param_grid <- param_grid[param_grid$alpha >= lower_limit, ]
param_grid <- param_grid[param_grid$beta >= lower_limit, ]
param_grid <- param_grid[param_grid$gamma >= lower_limit, ]
param_grid <- param_grid[param_grid$alpha <= upper_limit, ]
param_grid <- param_grid[param_grid$beta <= upper_limit, ]
param_grid <- param_grid[param_grid$gamma <= upper_limit, ]
param_grid <- unique(as.matrix(param_grid), MARGIN = 1)
return(param_grid)
}
#' Initialize paramaters to optimize over based on a set of naive models
#'
#' Use this function to generate a parameter grid (matrix) that can be provided
#' to the `param_grid` argument of [tulip::tulip()]. The model estimation then
#' reduces to evaluating all provided combinations and choosing the best one.
#' See Details for more. Note that there is nothing special about the matrix
#' generated by this function---you can define a set of possible parameters in
#' any way that suits you.
#'
#' @return A numeric matrix with six named columns: 'alpha', 'one_minus_alpha',
#' 'beta', 'one_minus_beta', 'gamma', 'one_minus_gamma'. The `alpha`
#' paramaters belong to the model's level component, the `beta` parameters
#' to the model's trend component, and the `gamma` parameters to the model's
#' seasonality component. Each pair usually adds up to 1, however dampening
#' effectively reduces the sum of `beta` and `one_minus_beta` to less than
#' 1. As per assertions on [tulip::tulip()]'s `param_grid`, each row must
#' sum up to a value between 0 and 3, the columns must be named and in
#' order, and each individual value must be between 0 and 1.
#'
#' @seealso [tulip::tulip()], [initialize_params_random()],
#' [initialize_params_grid()]
#'
#' @references
#' \describe{
#' \item{Rob J. Hyndman, Anne B. Koehler, Ralph D. Snyder, and Simone Grose (2002). *A State Space Framework for Automatic Forecasting using Exponential Smoothing Methods*.}{\url{https://doi.org/10.1016/S0169-2070(01)00110-8}}
#' }
#'
#' @export
#' @examples
#' initialize_params_naive()
#'
initialize_params_naive <- function() {
grid_only_naive <- data.frame(
alpha = 1,
one_minus_alpha = 0,
beta = 0,
one_minus_beta = 0,
gamma = 0,
one_minus_gamma = 0
)
grid_only_mean <- data.frame(
alpha = 0,
one_minus_alpha = 1,
beta = 0,
one_minus_beta = 0,
gamma = 0,
one_minus_gamma = 0
)
grid_only_smean <- data.frame(
alpha = 0,
one_minus_alpha = 1,
beta = 0,
one_minus_beta = 0,
gamma = 0,
one_minus_gamma = 1
)
grid_only_snaive <- data.frame(
alpha = 0,
one_minus_alpha = 0,
beta = 0,
one_minus_beta = 0,
gamma = 1,
one_minus_gamma = 0
)
grid <- rbind(
grid_only_naive,
grid_only_mean,
grid_only_smean,
grid_only_snaive
)
grid <- as.matrix(grid)
return(grid)
}
#' Initialize paramaters to optimize over randomly
#'
#' Use this function to generate a randomly sampled parameter grid (matrix) that
#' can be provided to the `param_grid` argument of [tulip::tulip()]. The model
#' estimation then reduces to evaluating all provided combinations and choosing
#' the best one. See Details for more. Note that there is nothing special about
#' the matrix generated by this function---you can define a set of possible
#' parameters in any way that suits you.
#'
#' The optimization procedure in [tulip::tulip()] evaluates each combination of
#' parameters provided via `param_grid`. While this is computationally costly,
#' it is also computationally stable. By consciously choosing parameters that
#' are trialled, unstable parameter combinations can be avoided. The prior
#' probability for many parameter combinations can be set to zero this way.
#' If the set of parameters can be restricted very far (for example, because one
#' updates from a previous fit or based on a related time series), it also makes
#' the optimization computationally cheap.
#'
#' In contrast to [initialize_params_grid()], this function draws random
#' combinations of `alpha`, `beta`, and `gamma` from an allowed space of values.
#' This can allow for better overall optimization of the model, as the overall
#' space of possible parameters is covered better. See also Bergstra and Bengio
#' (2012) referenced below for a comparison of grid search and random search.
#'
#' Depending on the set of chosen function arguments, it can be likely that the
#' function generates some duplicate parameter combinations (for example when
#' `oversample_upper` or `oversample_lower` are non-zero). These will be dropped
#' before the final matrix is returned. This means, however, that the function
#' does not guarantee to return
#' `n + n_damped + n_no_trend + n_no_season + n_no_trend_no_season` parameter
#' combinations. It might return less than that.
#'
#' One can also combine a fixed set of parameters *and* randomly drawn
#' parameters, for example to always evaluate parameter combinations known to
#' provide good results for other time series, or to also evaluate parameters
#' that were found at a previous training on the same time series, or to
#' include a set of benchmark models via [initialize_params_naive()], for
#' example. See also the examples below.
#'
#' @param n_damped Number of parameter combinations to sample that include all
#' three states (level, trend, seasonality) and dampening of the trend.
#' **Note**: By default, `n`, `n_no_trend`, `n_no_season`,
#' `n_no_trend_no_season` are functions of the value chosen for `n_damped`.
#' @param n Number of parameter combinations to sample that include all three
#' states (level, trend, seasonality), but no dampening.
#' @param n_no_trend Number of parameter combinations to sample that set the
#' trend parameters to 0, implying models that don't have a trend component;
#' since only two dimensions are sampled (level and seasonality), it usually
#' makes sense to use a smaller `n_no_trend` than `n` (unless you are
#' not interested in models with trend).
#' @param n_no_season Number of parameter combinations to sample that set the
#' seasonality parameters to 0, implying models that don't have a seasonality
#' component; since only two dimensions are sampled (level and trend), it
#' usually makes sense to use a smaller `n_no_season` than `n` (unless you are
#' not interested in models with seasonality).
#' @param n_no_trend_no_season Number of parameter combinations to sample that
#' set the trend and seasonality parameters to 0, implying models that don't
#' have a seasonality component; since only one dimension is sampled (level),
#' it usually makes sense to use a smaller `n_no_trend_no_season` than `n`
#' (unless you are not interested in models with trend and seasonality).
#' @param alpha_lower A scalar value defining the lowest possible value for the
#' `alpha` parameter. Can't be less than 0.
#' @param alpha_upper A scalar value defining the largest possible value for the
#' `alpha` parameter. The default is 1, but values larger than 1 are possible.
#' Can't be less than `alpha_lower`. If `alpha_lower` is equal to
#' `alpha_upper`, all samples for `alpha` will be equal to `alpha_lower` and
#' `alpha_upper` exactly.
#' @param beta_lower A scalar value defining the lowest possible value for the
#' `beta` parameter. Can't be less than 0.
#' @param beta_upper A scalar value defining the largest possible value for the
#' `beta` parameter. The default is 1, but values larger than 1 are possible.
#' Can't be less than `beta_lower`. If `beta_lower` is equal to
#' `beta_upper`, all samples for `beta` will be equal to `beta_lower` and
#' `beta_upper` exactly.
#' @param gamma_lower A scalar value defining the lowest possible value for the
#' `gamma` parameter. Can't be less than 0.
#' @param gamma_upper A scalar value defining the largest possible value for the
#' `gamma` parameter. The default is 1, but values larger than 1 are possible.
#' Can't be less than `gamma_lower`. If `gamma_lower` is equal to
#' `gamma_upper`, all samples for `gamma` will be equal to `gamma_lower` and
#' `gamma_upper` exactly.
#' @param beta_smaller_than_alpha If `TRUE` (default), sampling of `beta` is
#' conditional on the value of the sampled `alpha`, using
#' `pmin(alpha, beta_upper)` as the upper limit for `beta`.
#' @param gamma_smaller_than_one_minus_alpha If `TRUE` (default), sampling of
#' `gamma` is conditional on the value of the sampled `alpha`, using
#' `pmin(1 - alpha, gamma_upper)` as the upper limit for `gamma`.
#' @param oversample_lower Can be used to increase the chances that the lowest
#' allowed value is sampled for the parameters `alpha`, `beta`, and `gamma`.
#' This can be useful to find parameter combinations in which a component is
#' not smoothed at all and thus some constant average across all combinations.
#' For example, an ETS model with only a `level` component and `alpha = 0`
#' would be equivalent to the mean forecast.
#' @param oversample_upper Can be used to increase the chances that the largest
#' allowed value is sampled for the parameters `alpha`, and `gamma`.
#' This can be useful to find parameter combinations in which a component is
#' heavily smoothed (ajdusting to the latest observation). This turns the
#' level component into behavior similar to a random walk forecast (if
#' `alpha_upper = 1`), and the seasonal component into behavior similar to a
#' seasonal random walk forecast (if `gamma_upper = 1`).
#' @param seed Since the parameter grid is sampled randomly, you can set a seed
#' (local to the function) for reproducibility.
#'
#' @return A numeric matrix with six named columns: 'alpha', 'one_minus_alpha',
#' 'beta', 'one_minus_beta', 'gamma', 'one_minus_gamma'. The `alpha`
#' paramaters belong to the model's level component, the `beta` parameters
#' to the model's trend component, and the `gamma` parameters to the model's
#' seasonality component. Each pair usually adds up to 1, however dampening
#' effectively reduces the sum of `beta` and `one_minus_beta` to less than
#' 1. As per assertions on [tulip::tulip()]'s `param_grid`, each row must
#' sum up to a value between 0 and 3, the columns must be named and in
#' order, and each individual value must be between 0 and 1.
#'
#' @seealso [tulip::tulip()], [initialize_params_grid()],
#' [initialize_params_naive()]
#'
#' @references
#' \describe{
#' \item{Rob J. Hyndman, Anne B. Koehler, Ralph D. Snyder, and Simone Grose (2002). *A State Space Framework for Automatic Forecasting using Exponential Smoothing Methods*.}{\url{https://doi.org/10.1016/S0169-2070(01)00110-8}}
#' \item{James Bergstra, Yoshua Bengio (2012). *Random Search for Hyperparameter Optimization*.}{\url{https://www.jmlr.org/papers/volume13/bergstra12a/bergstra12a.pdf}}
#' }
#'
#' @export
#' @examples
#' library(ggplot2)
#'
#' param_grid_small <- initialize_params_random(
#' n_damped = 46,
#' seed = 388
#' )
#'
#' nrow(param_grid_small)
#'
#' summary(param_grid_small[, "alpha"])
#' summary(param_grid_small[, "beta"])
#' summary(param_grid_small[, "one_minus_beta"])
#' summary(param_grid_small[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid_small),
#' aes(x = alpha, y = gamma,fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # No one prevents you from combining a set of randomly drawn parameter
#' # combinations with a fixed set of parameters; for example, you can always
#' # evaluate parameters that correspond to the Random Walk, Seasonal Random
#' # Walk, or Mean model:
#'
#' param_grid_w_naive <- rbind(
#' initialize_params_naive(),
#' param_grid_small
#' )
#'
#' head(param_grid_w_naive)
#'
#' # note the new dots in the corners at (0, 0) and (0, 1)
#' ggplot(as.data.frame(param_grid_w_naive),
#' aes(x = alpha, y = gamma,fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # More samples cover the possible parameter space better
#' param_grid <- initialize_params_random(
#' n_damped = 1000,
#' seed = 388
#' )
#'
#' nrow(param_grid)
#'
#' summary(param_grid[, "alpha"])
#' summary(param_grid[, "beta"])
#' summary(param_grid[, "one_minus_beta"])
#' summary(param_grid[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid),
#' aes(x = alpha, y = gamma,fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # by default, we oversample the borders; this can be turned off to not
#' # sample 0- and 1-valued parameters as often
#' param_grid_no_border_sampling <- initialize_params_random(
#' n_damped = 1000,
#' seed = 388,
#' oversample_lower = 0,
#' oversample_upper = 0
#' )
#'
#' summary(param_grid_no_border_sampling[, "alpha"])
#' summary(param_grid_no_border_sampling[, "beta"])
#' summary(param_grid_no_border_sampling[, "one_minus_beta"])
#' summary(param_grid_no_border_sampling[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid_no_border_sampling),
#' aes(x = alpha, y = gamma, fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
#' # The parameter space can be limited, sampling remains uniform
#' param_grid_restricted <- initialize_params_random(
#' n_damped = 1000,
#' seed = 388,
#' alpha_upper = 0.5,
#' beta_upper = 0.05,
#' gamma_upper = 0.5,
#' oversample_lower = 0.05,
#' oversample_upper = 0
#' )
#'
#' nrow(param_grid_restricted)
#'
#' summary(param_grid_restricted[, "alpha"])
#' summary(param_grid_restricted[, "beta"])
#' summary(param_grid_restricted[, "one_minus_beta"])
#' summary(param_grid_restricted[, "gamma"])
#'
#' ggplot(as.data.frame(param_grid_restricted),
#' aes(x = alpha, y = gamma, fill = one_minus_beta)) +
#' coord_cartesian(xlim = c(0,1), ylim = c(0,1)) +
#' geom_abline(intercept = 1, slope = -1, linetype = 3) +
#' geom_point(pch = 21, color = "white")
#'
initialize_params_random <- function(n_damped = 1000,
n = n_damped / 2,
n_no_trend = ceiling(n_damped^(2/3)),
n_no_season = ceiling(n_damped^(2/3)),
n_no_trend_no_season = ceiling(n_damped^(1/3)), # nolint
alpha_lower = 0,
alpha_upper = 1,
beta_lower = 0,
beta_upper = 1,
gamma_lower = 0,
gamma_upper = 1,
beta_smaller_than_alpha = TRUE,
gamma_smaller_than_one_minus_alpha = TRUE,
oversample_lower = 0.05,
oversample_upper = 0.05,
seed = NULL) {
checkmate::assert_integerish(
x = n, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_damped, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_no_trend, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_no_season, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = n_no_trend_no_season, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = alpha_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = alpha_upper, lower = alpha_lower, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = beta_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = beta_upper, lower = beta_lower, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = gamma_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = gamma_upper, lower = gamma_lower, len = 1, any.missing = FALSE
)
checkmate::assert_logical(
x = beta_smaller_than_alpha, len = 1, any.missing = FALSE
)
checkmate::assert_logical(
x = gamma_smaller_than_one_minus_alpha, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = oversample_lower, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_numeric(
x = oversample_upper, lower = 0, len = 1, any.missing = FALSE
)
checkmate::assert_integerish(
x = seed, len = 1, null.ok = TRUE, any.missing = FALSE
)
if (n_damped > 0 && (alpha_upper == 0 || beta_upper == 0)) {
stop("If `use_damped = TRUE`, then `alpha_upper` and `beta_upper` must be strictly larger than 0.") # nolint
}
if (!is.null(seed)) {
# checking for existence to avoid issues when building vignettes
if (exists(".Random.seed")) {
random_seed_current <- .Random.seed
on.exit({.Random.seed <<- random_seed_current})
}
set.seed(seed = seed)
}
grid_base <- sample_grid(
n_target = n,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = beta_lower,
beta_upper = beta_upper,
gamma_lower = gamma_lower,
gamma_upper = gamma_upper,
beta_smaller_than_alpha = beta_smaller_than_alpha,
gamma_smaller_than_one_minus_alpha = gamma_smaller_than_one_minus_alpha,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid_damped <- sample_grid(
n_target = n_damped,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = beta_lower,
beta_upper = beta_upper,
gamma_lower = gamma_lower,
gamma_upper = gamma_upper,
beta_smaller_than_alpha = beta_smaller_than_alpha,
gamma_smaller_than_one_minus_alpha = gamma_smaller_than_one_minus_alpha,
oversample_lower = 0,
oversample_upper = oversample_upper
)
grid_damped <- add_dampening_to_grid(grid = grid_damped)
grid_no_trend <- sample_grid(
# proportionally less samples since only 2 of 3 dimensions are sampled
n_target = n_no_trend,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = 0,
beta_upper = 0,
gamma_lower = gamma_lower,
gamma_upper = gamma_upper,
beta_smaller_than_alpha = FALSE,
gamma_smaller_than_one_minus_alpha = gamma_smaller_than_one_minus_alpha,
fun_one_minus_beta = function(x) x,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid_no_season <- sample_grid(
# proportionally less samples since only 2 of 3 dimensions are sampled
n_target = n_no_season,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = beta_lower,
beta_upper = beta_upper,
gamma_lower = 0,
gamma_upper = 0,
beta_smaller_than_alpha = beta_smaller_than_alpha,
gamma_smaller_than_one_minus_alpha = FALSE,
fun_one_minus_gamma = function(x) x,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid_no_trend_no_season <- sample_grid(
# proportionally less samples since only 1 of 3 dimensions is sampled
n_target = n_no_trend_no_season,
alpha_lower = alpha_lower,
alpha_upper = alpha_upper,
beta_lower = 0,
beta_upper = 0,
gamma_lower = 0,
gamma_upper = 0,
beta_smaller_than_alpha = FALSE,
gamma_smaller_than_one_minus_alpha = FALSE,
fun_one_minus_beta = function(x) x,
fun_one_minus_gamma = function(x) x,
oversample_lower = oversample_lower,
oversample_upper = oversample_upper
)
grid <- as.matrix(rbind(
grid_base,
grid_damped,
grid_no_trend,
grid_no_season,
grid_no_trend_no_season
))
grid <- unique(x = grid, MARGIN = 1)
return(grid)
}
sample_grid <- function(n_target = 100,
alpha_lower = 0, alpha_upper = 1,
beta_lower = 0, beta_upper = 1,
gamma_lower = 0, gamma_upper = 1,
beta_smaller_than_alpha = TRUE,
gamma_smaller_than_one_minus_alpha = TRUE,
fun_one_minus_beta = function(x) 1 - x,
fun_one_minus_gamma = function(x) 1 - x,
oversample_lower = 0.05,
oversample_upper = 0.05) {
alphas <- stats::runif(
n = n_target,
min = alpha_lower - oversample_lower,
max = alpha_upper + oversample_upper
)
alphas <- pmax(alpha_lower, pmin(alpha_upper, alphas))
beta_upper <- rep(beta_upper, n_target)
if (beta_smaller_than_alpha) {
beta_upper <- pmin(alphas, beta_upper)
}
betas <- stats::runif(
n = n_target,
min = beta_lower - oversample_lower,
max = beta_upper
)
betas <- pmax(beta_lower, pmin(beta_upper, betas))
gamma_upper <- rep(gamma_upper, n_target)
if (gamma_smaller_than_one_minus_alpha) {
gamma_upper <- pmin(1 - alphas, gamma_upper)
}
gammas <- stats::runif(
n = n_target,
min = gamma_lower - oversample_lower,
max = gamma_upper + oversample_upper
)
gammas <- pmax(gamma_lower, pmin(gamma_upper, gammas))
tmp_grid <- data.frame(
alpha = alphas,
one_minus_alpha = 1 - alphas,
beta = betas,
one_minus_beta = fun_one_minus_beta(betas),
gamma = gammas,
one_minus_gamma = fun_one_minus_beta(gammas)
)
return(tmp_grid)
}
add_dampening_to_grid <- function(grid) {
checkmate::assert_data_frame(x = grid)
if (nrow(grid) == 0L) {
return(grid)
}
dampening_factors <- 1 - c(0.99, 0.95, 0.9, 0.75, 0.5, 0.25, 0.1)^(1/12)
dampening <- rep(dampening_factors, length.out = nrow(grid))
grid$one_minus_beta <- pmax(0, grid$one_minus_beta - dampening)
return(grid)
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.