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))


tmastny/tsrecipes documentation built on Aug. 28, 2020, 11:38 a.m.