knitr::opts_chunk$set( collapse = TRUE, comment = "#>" )
library(tsrecipes) library(tidymodels)
lg <- logistic_reg(penalty = tune(), mixture = 1) %>% set_engine("glmnet")
rec <- recipe(prices) %>% update_role(everything(), new_role = "var") %>% update_role(class, new_role = "outcome") %>% step_dct(ts, k = tune())
pipeline <- workflow() %>% add_model(lg) %>% add_recipe(rec)
coef_grid <- expand_grid( k = c(4, 8, 16, 32), penalty = 10^seq(-4, -1, length.out = 30) )
cv_results <- pipeline %>% tune_grid( resamples = vfold_cv(prices), grid = coef_grid )
cv_results %>% collect_metrics() %>% filter(.metric == "accuracy") %>% arrange(desc(mean))
cv_results %>% show_best("accuracy")
model <- pipeline %>% finalize_workflow(cv_results %>% select_best("accuracy")) %>% fit(data = prices)
model %>% pull_workflow_fit() %>% vip::vip()
step <- model$pre$mold$blueprint$recipe$steps[[1]]
prices_coef <- prices %>% bind_cols(model$pre$mold$predictors) price_recon <- prices_coef %>% reconstruct("ts", step, starts_with("dct_"))
price_recon %>% sample_n(10) %>% unnest(c(ts, ts_recon, n)) %>% ggplot(aes(n)) + geom_line(aes(y = ts), color = "red") + geom_line(aes(y = ts_recon), color = "blue") + facet_wrap(~id)
ts.32_imp <- prices_coef %>% summarise(across(starts_with("dct_"), mean)) %>% mutate(dct_32_ts = list(seq( min(prices_coef$dct_32_ts), max(prices_coef$dct_32_ts) ))) %>% unnest(dct_32_ts) %>% bind_cols(predict(pull_workflow_fit(model), ., type = "prob")) ts.32_imp %>% ggplot(aes(dct_32_ts, .pred_increase)) + geom_line()
ts.32_recon <- ts.32_imp %>% reconstruct("ts", step, starts_with("dct_"))
set.seed(10) ts.32_recon %>% select(dct_32_ts, ts_recon, n) %>% sample_n(10) %>% unnest(c(ts_recon, n)) %>% ggplot(aes(n, ts_recon, color = as.factor(dct_32_ts))) + geom_line(show.legend = FALSE) + facet_wrap(~dct_32_ts)
prices %>% count(class) %>% mutate(n / sum(n))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.