Closed spsanderson closed 2 years ago
Function:
#' Boilerplate Workflow #' #' @family Boiler_Plate #' @family SVM #' @family rbf #' #' @author Steven P. Sanderson II, MPH #' #' @details This uses `parsnip::svm_rb()` and sets the `parsnip::engine` #' to `kernlab`. #' #' @seealso \url{https://parsnip.tidymodels.org/reference/svm_rbf.html} #' #' @description This is a boilerplate function to automatically create the following: #' - recipe #' - model specification #' - workflow #' - tuned model (grid ect) #' - calibration tibble and plot #' #' @param .data The data being passed to the function. The time-series object. #' @param .date_col The column that holds the datetime. #' @param .value_col The column that has the value #' @param .formula The formula that is passed to the recipe like `value ~ .` #' @param .rsamp_obj The rsample splits object #' @param .prefix Default is `ts_smooth_es` #' @param .tune Defaults to TRUE, this creates a tuning grid and tuned model. #' @param .grid_size If `.tune` is TRUE then the `.grid_size` is the size of the #' tuning grid. #' @param .num_cores How many cores do you want to use. Default is 1 #' @param .cv_assess How many observations for assess. See [timetk::time_series_cv()] #' @param .cv_skip How many observations to skip. See [timetk::time_series_cv()] #' @param .cv_slice_limit How many slices to return. See [timetk::time_series_cv()] #' @param .best_metric Default is "rmse". See [modeltime::default_forecast_accuracy_metric_set()] #' @param .bootstrap_final Not yet implemented. #' #' @examples #' \dontrun{ #' library(dplyr) #' #' data <- AirPassengers %>% #' ts_to_tbl() %>% #' select(-index) #' #' splits <- time_series_split( #' data #' , date_col #' , assess = 12 #' , skip = 3 #' , cumulative = TRUE #' ) #' #' ts_auto_rbf <- ts_auto_svm_rbf( #' .data = data, #' .num_cores = 5, #' .date_col = date_col, #' .value_col = value, #' .rsamp_obj = splits, #' .formula = value ~ ., #' .grid_size = 3 #' ) #' #' ts_smooth_rbf$recipe_info #' } #' #' @return #' A list #' #' @export #' ts_auto_svm_rbf <- function(.data, .date_col, .value_col, .formula, .rsamp_obj, .prefix = "ts_svm_rbf", .tune = TRUE, .grid_size = 10, .num_cores = 1, .cv_assess = 12, .cv_skip = 3, .cv_slice_limit = 6, .best_metric = "rmse", .bootstrap_final = FALSE){ # Tidyeval ---- date_col_var_expr <- rlang::enquo(.date_col) value_col_var_expr <- rlang::enquo(.value_col) sampling_object <- .rsamp_obj # Cross Validation cv_assess = as.numeric(.cv_assess) cv_skip = as.numeric(.cv_skip) cv_slice = as.numeric(.cv_slice_limit) # Tuning Grid grid_size <- as.numeric(.grid_size) num_cores <- as.numeric(.num_cores) best_metric <- as.character(.best_metric) # Data and splits splits <- .rsamp_obj data_tbl <- dplyr::as_tibble(.data) # Checks ---- if (rlang::quo_is_missing(date_col_var_expr)){ rlang::abort( message = "'.date_col' must be supplied.", use_cli_format = TRUE ) } if (rlang::quo_is_missing(value_col_var_expr)){ rlang::abort( message = "'.value_col' must be supplied.", use_cli_format = TRUE ) } if (!inherits(x = splits, what = "rsplit")){ rlang::abort( message = "'.rsamp_obj' must be have class rsplit, use the rsample package.", use_cli_format = TRUE ) } # Recipe ---- # Get the initial recipe call recipe_call <- get_recipe_call(match.call()) rec_syntax <- paste0(.prefix, "_recipe") %>% assign_value(!!recipe_call) rec_obj <- recipes::recipe(formula = .formula, data = data_tbl) rec_obj <- rec_obj %>% timetk::step_timeseries_signature({{date_col_var_expr}}) %>% timetk::step_holiday_signature({{date_col_var_expr}}) %>% recipes::step_novel(recipes::all_nominal_predictors()) %>% recipes::step_mutate_at(tidyselect::vars_select_helpers$where(is.character) , fn = ~ as.factor(.)) %>% recipes::step_dummy(recipes::all_nominal(), one_hot = TRUE) %>% recipes::step_normalize(recipes::all_numeric_predictors(), -date_col_index.num) %>% recipes::step_nzv(recipes::all_predictors(), -date_col_index.num) %>% recipes::step_corr(recipes::all_numeric_predictors(), threshold = 0) # Tune/Spec ---- if (.tune){ model_spec <- parsnip::svm_rbf( cost = tune::tune(), rbf_sigma = tune::tune(), margin = tune::tune() ) } else { model_spec <- parsnip::svm_poly() } model_spec <- model_spec %>% parsnip::set_mode(mode = "regression") %>% parsnip::set_engine("kernlab") # Workflow ---- wflw <- workflows::workflow() %>% workflows::add_recipe(rec_obj) %>% workflows::add_model(model_spec) # Tuning Grid ---- if (.tune){ tuning_grid_spec <- dials::grid_latin_hypercube( hardhat::extract_parameter_set_dials(model_spec), size = grid_size ) # Make TS CV ---- tscv <- timetk::time_series_cv( data = rsample::training(splits), date_var = {{date_col_var_expr}}, cumulative = TRUE, assess = cv_assess, skip = cv_skip, slice_limit = cv_slice ) # Start parallel backend modeltime::parallel_start(num_cores) # Tune the workflow tuned_results <- wflw %>% tune::tune_grid( resamples = tscv, grid = tuning_grid_spec, metrics = modeltime::default_forecast_accuracy_metric_set() ) # Stop parallel backend modeltime::parallel_stop() # Get the best result set by a specified metric best_result_set <- tuned_results %>% tune::show_best(metric = best_metric, n = 1) # Plot results tune_results_plt <- tuned_results %>% tune::autoplot() + ggplot2::theme_minimal() + ggplot2::geom_smooth(se = FALSE) # Make final workflow wflw_fit <- wflw %>% tune::finalize_workflow( tuned_results %>% tune::show_best(metric = best_metric, n = Inf) %>% dplyr::slice(1) ) %>% parsnip::fit(rsample::training(splits)) } else { wflw_fit <- wflw %>% parsnip::fit(rsample::training(splits)) } # Calibrate and Plot ---- cap <- healthyR.ts::calibrate_and_plot( wflw_fit, .splits_obj = splits, .data = data_tbl, .interactive = TRUE, .print_info = FALSE ) # Return ---- output <- list( recipe_info = list( recipe_call = recipe_call, recipe_syntax = rec_syntax, rec_obj = rec_obj ), model_info = list( model_spec = model_spec, wflw = wflw, fitted_wflw = wflw_fit, was_tuned = ifelse(.tune, "tuned", "not_tuned") ), model_calibration = list( plot = cap$plot, calibration_tbl = cap$calibration_tbl, model_accuracy = cap$model_accuracy ) ) if (.tune){ output$tuned_info = list( tuning_grid = tuning_grid_spec, tscv = tscv, tuned_results = tuned_results, grid_size = grid_size, best_metric = best_metric, best_result_set = best_result_set, tuning_grid_plot = tune_results_plt, plotly_grid_plot = plotly::ggplotly(tune_results_plt) ) } return(invisible(output)) }
Example:
> ts_auto_rbf $recipe_info $recipe_info$recipe_call recipe(.data = data, .date_col = date_col, .value_col = value, .formula = value ~ ., .rsamp_obj = splits, .grid_size = 3, .num_cores = 5) $recipe_info$recipe_syntax [1] "ts_svm_rbf_recipe <-" [2] "\n recipe(.data = data, .date_col = date_col, .value_col = value, .formula = value ~ \n ., .rsamp_obj = splits, .grid_size = 3, .num_cores = 5)" $recipe_info$rec_obj Recipe Inputs: role #variables outcome 1 predictor 1 Operations: Timeseries signature features from date_col Holiday signature features from date_col Novel factor level assignment for recipes::all_nominal_predictors() Variable mutation for tidyselect::vars_select_helpers$where(is.character) Dummy variables from recipes::all_nominal() Centering and scaling for recipes::all_numeric_predictors(), -date_col_index.num Sparse, unbalanced variable filter on recipes::all_predictors(), -date_col_index.num Correlation filter on recipes::all_numeric_predictors() $model_info $model_info$model_spec Radial Basis Function Support Vector Machine Specification (regression) Main Arguments: cost = tune::tune() rbf_sigma = tune::tune() margin = tune::tune() Computational engine: kernlab $model_info$wflw == Workflow ========================================================================================= Preprocessor: Recipe Model: svm_rbf() -- Preprocessor ------------------------------------------------------------------------------------- 8 Recipe Steps * step_timeseries_signature() * step_holiday_signature() * step_novel() * step_mutate_at() * step_dummy() * step_normalize() * step_nzv() * step_corr() -- Model -------------------------------------------------------------------------------------------- Radial Basis Function Support Vector Machine Specification (regression) Main Arguments: cost = tune::tune() rbf_sigma = tune::tune() margin = tune::tune() Computational engine: kernlab $model_info$fitted_wflw == Workflow [trained] =============================================================================== Preprocessor: Recipe Model: svm_rbf() -- Preprocessor ------------------------------------------------------------------------------------- 8 Recipe Steps * step_timeseries_signature() * step_holiday_signature() * step_novel() * step_mutate_at() * step_dummy() * step_normalize() * step_nzv() * step_corr() -- Model -------------------------------------------------------------------------------------------- Support Vector Machine object of class "ksvm" SV type: eps-svr (regression) parameter : epsilon = 0.150649102730677 cost C = 0.331322049813943 Gaussian Radial Basis kernel function. Hyperparameter : sigma = 0.707178547548035 Number of Support Vectors : 81 Objective Function Value : -8.3971 Training error : 0.162684 $model_info$was_tuned [1] "tuned" $model_calibration $model_calibration$plot $model_calibration$calibration_tbl # Modeltime Table # A tibble: 1 x 5 .model_id .model .model_desc .type .calibration_data <int> <list> <chr> <chr> <list> 1 1 <workflow> KERNLAB Test <tibble [12 x 4]> $model_calibration$model_accuracy # A tibble: 1 x 9 .model_id .model_desc .type mae mape mase smape rmse rsq <int> <chr> <chr> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> 1 1 KERNLAB Test 101. 19.5 2.10 22.5 126. 0.00403 $tuned_info $tuned_info$tuning_grid # A tibble: 3 x 3 cost rbf_sigma margin <dbl> <dbl> <dbl> 1 0.0292 3.83e- 6 0.0356 2 0.331 7.07e- 1 0.151 3 25.3 1.48e-10 0.121 $tuned_info$tscv # Time Series Cross Validation Plan # A tibble: 6 x 2 splits id <list> <chr> 1 <split [120/12]> Slice1 2 <split [117/12]> Slice2 3 <split [114/12]> Slice3 4 <split [111/12]> Slice4 5 <split [108/12]> Slice5 6 <split [105/12]> Slice6 $tuned_info$tuned_results # Tuning results # NA # A tibble: 6 x 4 splits id .metrics .notes <list> <chr> <list> <list> 1 <split [120/12]> Slice1 <tibble [18 x 7]> <tibble [0 x 3]> 2 <split [117/12]> Slice2 <tibble [18 x 7]> <tibble [0 x 3]> 3 <split [114/12]> Slice3 <tibble [18 x 7]> <tibble [0 x 3]> 4 <split [111/12]> Slice4 <tibble [18 x 7]> <tibble [0 x 3]> 5 <split [108/12]> Slice5 <tibble [18 x 7]> <tibble [0 x 3]> 6 <split [105/12]> Slice6 <tibble [18 x 7]> <tibble [0 x 3]> $tuned_info$grid_size [1] 3 $tuned_info$best_metric [1] "rmse" $tuned_info$best_result_set # A tibble: 1 x 9 cost rbf_sigma margin .metric .estimator mean n std_err .config <dbl> <dbl> <dbl> <chr> <chr> <dbl> <int> <dbl> <chr> 1 0.331 0.707 0.151 rmse standard 101. 6 7.26 Preprocessor1_Model2 $tuned_info$tuning_grid_plot `geom_smooth()` using method = 'loess' and formula 'y ~ x' $tuned_info$plotly_grid_plot There were 50 or more warnings (use warnings() to see the first 50)
Function:
Example: