List of models to model function

Machine Learning and Modeling
1

I am trying to reproduce the example of table 7.1 from https://otexts.com/fpp3/selecting-predictors.html.

The idea of the code was something like this:

library(fpp3)
library(purrr)
library(fable)
library(fabletools)

list_of_regressor <- colnames(us_change)[3:6]

list_of_models <- map(1:length(list_of_regressor), ~ combn(list_of_regressor, .x) %>%
                        apply(., 2, function(v) paste0("Consumption", " ~ ", paste(v, collapse = " + ")))) %>%
  unlist()

models <- us_change %>%
  model(
    TSLM(list_of_models)
  )

models %>% glance() %>% select(.model, adj_r_squared, CV, AIC, AICc, BIC)

I also tried different ways:

# Try #2
list_of_models2 <- map(1:length(list_of_regressor), ~ combn(list_of_regressor, .x) %>%
                        apply(., 2, function(v) as.formula(paste0("Consumption", " ~ ", paste(v, collapse = " + "))))) %>%
  unlist()

models <- us_change %>%
  model(
    map(.x = list_of_models2, .f = function(x) TSLM(x))
  )


# Try #3
list_of_models3 <- map(1:length(list_of_regressor), ~ combn(list_of_regressor, .x) %>%
                         apply(., 2, function(v) (paste0("TSLM(Consumption", " ~ ", paste(v, collapse = " + ", ")"))))) %>%
  unlist()

models <- us_change %>%
  do.call(model, TSLM(list_of_models2))

I looked on internet, but I haven't found anything. So, any help will be appreciated.

2 
library(fpp3)
library(purrr)
library(fable)
library(fabletools)

list_of_regressor <- colnames(us_change)[3:6]

mlist <- map(1:length(list_of_regressor), ~ combn(list_of_regressor, .x) %>%
                        apply(., 2, function(v) paste0("Consumption", " ~ ", paste(v, collapse = " + ")))) %>%
  unlist()


models <- map_dfr(
  mlist,
  ~ tibble("formula" = .,
  "model" = list(model(
    us_change,
    TSLM(formula = as.formula(.))
  )))
)

glanced <- map_dfr(models$model,
    ~ glance(.) %>% select( adj_r_squared, CV, AIC, AICc, BIC))

results_df<- bind_cols(models,glanced) %>% arrange(AIC)

results_df

# A tibble: 15 x 7
   formula                                                    model            adj_r_squared    CV   AIC  AICc   BIC
   <chr>                                                      <list>                   <dbl> <dbl> <dbl> <dbl> <dbl>
 1 Consumption ~ Income + Production + Savings + Unemployment <tibble [1 x 1]>        0.763  0.104 -457. -456. -437.
 2 Consumption ~ Income + Production + Savings                <tibble [1 x 1]>        0.761  0.105 -455. -455. -439.
 3 Consumption ~ Income + Savings + Unemployment              <tibble [1 x 1]>        0.760  0.104 -454. -454. -438.
 4 Consumption ~ Income + Savings                             <tibble [1 x 1]>        0.735  0.114 -436. -436. -423.
 5 Consumption ~ Income + Production + Unemployment           <tibble [1 x 1]>        0.366  0.271 -262. -262. -246.
 6 Consumption ~ Production + Savings + Unemployment          <tibble [1 x 1]>        0.349  0.279 -257. -257. -241.
 7 Consumption ~ Income + Unemployment                        <tibble [1 x 1]>        0.345  0.276 -257. -257. -244.
 8 Consumption ~ Income + Production                          <tibble [1 x 1]>        0.336  0.282 -254. -254. -241.
 9 Consumption ~ Production + Savings                         <tibble [1 x 1]>        0.324  0.287 -251. -250. -238.
10 Consumption ~ Savings + Unemployment                       <tibble [1 x 1]>        0.311  0.291 -247. -247. -234.
11 Consumption ~ Production + Unemployment                    <tibble [1 x 1]>        0.308  0.293 -246. -246. -233.
12 Consumption ~ Production                                   <tibble [1 x 1]>        0.276  0.304 -238. -238. -228.
13 Consumption ~ Unemployment                                 <tibble [1 x 1]>        0.274  0.303 -237. -237. -228.
14 Consumption ~ Income                                       <tibble [1 x 1]>        0.143  0.356 -205. -204. -195.
15 Consumption ~ Savings                                      <tibble [1 x 1]>        0.0611 0.388 -187. -186. -177.
2 Likes
3

You've mostly gotten it in your second and third attempts.

Attempt 2
You're passing a list of model definitions to the model() function, rather than the model definitions themselves. You can use !!! to unsplice a list of model definitions (or alternatively, call model() with a list of arguments using do.call()).

models <- us_change %>%
  model(
    !!!map(.x = list_of_models2, .f = function(x) TSLM(x))
  )

Attempt 3
The first argument of do.call() is the function to use, and you've piped in the data (us_change) as the function to use. Also, TSLM() accepts a formula, not a list of formulas - you'll need to do something similar to what you've done in attempt 2.
do.call(model, c(list(us_change), map(.x = list_of_models2, .f = TSLM)))

Book code
The code I've used in the book is a bit more general (although likely more complicated than wanted). You may find it interesting to look into:

# Build model definitions in a table
opts <- expand.grid(Income = 0:1, Production = 0:1, Savings = 0:1, Unemployment = 0:1) %>%
  mutate(
    formulae =
      pmap(list(Income = Income, Production = Production, Savings = Savings, Unemployment = Unemployment),
           function(...){
             spec <- list(...)
             new_formula(
               sym("Consumption"),
               reduce(syms(names(spec)[spec==1]), call2, .fn = "+", .init = 1)
             )
           }
      ),
    models = set_names(map(formulae, TSLM), map_chr(formulae, deparse))
  )

# Apply model definitions via unsplicing
us_change %>%
  model(
    !!!opts$models
  )
1 Like
4

How can I generalize it? Suppose I have a string vector like:

list_of_regressor <- colnames(us_change)[3:6]

The function pmap uses as an argument a list with specific strings. How can I make it more general, as if the list of regressor can get bigger, if necessary.

I tried this way, but it didn't worked:

library(purrr)
library(fable)
library(fabletools)
library(rlang)

list_of_regressor <- c("1", colnames(us_change)[3:6])

mlist <- map(1:length(list_of_regressor), ~ combn(list_of_regressor, .x) %>%
               apply(., 2, function(v) paste0("Consumption", " ~ ", paste(v, collapse = " + ")))) %>%
  unlist()

df_mlist <- data.frame(formula_str = mlist) %>%
  mutate(formula_sym = lapply(formula_str, as.symbol)) %>%
  mutate(models = set_names(map(formula_str, TSLM), map_chr(formula_sym, deparse)))
  


us_change %>%
  model(
    !!!df_mlist$models
  )

Update #1: I was able to run the following code, but I don't know if all the lines is actually needed...

library(purrr)
library(fable)
library(fabletools)
library(rlang)

list_of_regressor <- c("1", colnames(us_change)[3:6])

mlist <- map(1:length(list_of_regressor), ~ combn(list_of_regressor, .x) %>%
               apply(., 2, function(v) paste0("Consumption", " ~ ", paste(v, collapse = " + ")))) %>%
  unlist()

df_mlist <- data.frame(formula_str = mlist) %>%
  mutate(formula_sym = lapply(formula_str, as.symbol)) %>%
  mutate(formula_list = set_names(map(formula_str, as.formula))) %>%
  mutate(models = set_names(map(formula_list, TSLM), map_chr(formula_sym, deparse)))
5

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.