tidymodels isn't quite there yet in terms of an integrated solution (but it is coming in 2019). Here's some code to do the optimization. In the code below, use the latest version of recipes.
dials doesn't really play into this type of optimization unless you want to keep the parameters inside of a specific range (notes on how to do that below).
I'm a huge fan of Nelder-Mead, but it might not be a great solution here since it spends a lot of runs in the terminal phase of the optimization. Simulated annealing might work better. Either way, set a maximum number of runs that you are willing to do.
Also, this approach is probably better than random search when there are a lot of tuning parameters. YMMV.
Also also, you'll probably need more than one rep of CV for these data. I bumped to five.
library(caret)
#> Loading required package: lattice
#> Loading required package: ggplot2
library(tidymodels)
#> ── Attaching packages ─────────────────────────────────────────────────────────── tidymodels 0.0.2 ──
#> ✔ broom 0.5.0 ✔ purrr 0.2.5
#> ✔ dials 0.0.1.9000 ✔ recipes 0.1.4
#> ✔ dplyr 0.7.8 ✔ rsample 0.0.3
#> ✔ infer 0.4.0 ✔ tibble 1.4.2
#> ✔ parsnip 0.0.1 ✔ yardstick 0.0.2
#> ── Conflicts ────────────────────────────────────────────────────────────── tidymodels_conflicts() ──
#> ✖ purrr::discard() masks scales::discard()
#> ✖ rsample::fill() masks tidyr::fill()
#> ✖ dplyr::filter() masks stats::filter()
#> ✖ dplyr::lag() masks stats::lag()
#> ✖ purrr::lift() masks caret::lift()
#> ✖ yardstick::precision() masks caret::precision()
#> ✖ yardstick::recall() masks caret::recall()
#> ✖ recipes::step() masks stats::step()
#> ✖ yardstick::tidy() masks rsample::tidy(), recipes::tidy(), broom::tidy()
data(Sacramento)
Sacramento <-
Sacramento %>%
dplyr::select(-zip)
# Setup the preprocessing
preproc <- recipe(price ~ ., data = Sacramento) %>%
step_log(price) %>%
# City has a lot of levels and some with small freq;
# Collapse some into an "other" city
step_other(city) %>%
step_dummy(all_nominal()) %>%
# In case we still have a column of all zeros
step_zv(all_predictors()) %>%
step_center(all_predictors()) %>%
step_scale(all_predictors())
## Create split of data and precompute the preprocessing parts
set.seed(955)
ctrl <-
vfold_cv(Sacramento, v = 10, repeats = 5, strata = NULL) %>%
mutate(recipes = map(splits, prepper, preproc))
# Run the model, predict the assessment set, and return MAE
get_svm_mae <- function(split, recipe, model, ...){
holdout_data <-
bake(recipe, new_data = assessment(split))
model %>%
fit(price ~ ., data = juice(recipe)) %>%
predict(new_data = holdout_data) %>%
bind_cols(holdout_data) %>%
mae(price, .pred) %>%
pull(".estimate")
}
# make objective function
svm_obj <- function(param){
# You may want to put in some kind of constraints here so that if an
# element of `param` is outside of a suitable range, just return a
# larger number like 10^5.
svm_mod <-
svm_rbf(mode = "regression", cost = 10^(param[2]), rbf_sigma = 10^(param[2]))%>%
set_engine("kernlab")
# You could also use furrr::future_map2_dbl for running in parallel here
results <-
ctrl %>%
mutate(mae = map2_dbl(splits, recipes, get_svm_mae, model = svm_mod)) %>%
summarize(estimate = mean(mae)) %>%
pull("estimate")
# cat("log-C", sprintf("%+2.4f", param[1]),
# "log-s", sprintf("%+2.4f", param[2]),
# "mae", sprintf("%2.6f", results), "\n")
results
}
# cost = 100, and sigma = 1 are probably suboptimal choices
optim(c(2, 0), svm_obj, method = "Nelder-Mead", control = list(maxit = 50))
#> $par
#> [1] 2.4138794 -0.1871338
#>
#> $value
#> [1] 0.2492046
#>
#> $counts
#> function gradient
#> 51 NA
#>
#> $convergence
#> [1] 1
#>
#> $message
#> NULL
Created on 2018-12-09 by the reprex package (v0.2.1)