Forecasting Time Series Groups with tslm() & tidyverse - r

I want to fit tslm model to each time series group.
I am following example from here but instead of fitting ets model, I would like to fit tslm.
I adjusted the code so it looks like this:
library(tidyverse)
library(timetk)
library(sweep)
library(forecast)
monthly_qty_by_cat2 <-
bike_sales %>%
mutate(order.month = as_date(as.yearmon(order.date))) %>%
group_by(category.secondary, order.month) %>%
summarise(total.qty = sum(quantity)) %>%
mutate(trendx = row_number())
monthly_qty_by_cat2_nest <-
monthly_qty_by_cat2 %>%
group_by(category.secondary) %>%
nest() %>%
mutate(data.ts = map(.x = data,
.f = tk_ts,
select = -order.month,
start = 2011,
freq = 12)) %>%
mutate(fit.ts = map(data.ts, ~tslm(total.qty ~ season, data=.x))) %>%
mutate(fcast.ts = map(fit.ts, forecast))
and it works, BUT when I change
mutate(fit.ts = map(data.ts, ~tslm(total.qty ~ season, data=.x)))
to
mutate(fit.ts = map(data.ts, ~tslm(total.qty ~ trendx, data=.x)))
I get an error:
Error: Problem with mutate() input fcast.ts.
x object 'trendx' not found
and Input fcast.ts is map(fit.ts, forecast).
How do I forecast this data with custom predictors in tslm model?
EDIT
I rewrote the code in order to use fable package:
monthly_qty_by_cat2 <-
bike_sales %>%
mutate(order.month = as_date(as.yearmon(order.date))) %>%
group_by(category.secondary, order.month) %>%
summarise(total.qty = sum(quantity)) %>%
mutate(trendx = row_number())
monthly_qty_by_cat2_nest <-
monthly_qty_by_cat2 %>%
group_by(category.secondary) %>%
as_tsibble(key = category.secondary)
monthly_qty_by_cat2_nest %>%
model(tslm = TSLM(total.qty ~ trendx)) %>%
forecast()
and receive the error:
Error: Problem with mutate() input tslm.
x object 'trendx' not found
Unable to compute required variables from provided new_data.
Does your model require extra variables to produce forecasts?

library(tidyverse)
library(tsibble)
library(fable)
library(lubridate)
monthly_qty_by_cat2 <-
sweep::bike_sales %>%
mutate(order.month = yearmonth(order.date)) %>%
group_by(category.secondary, order.month) %>%
summarise(total.qty = sum(quantity)) %>%
as_tsibble(index=order.month, key=category.secondary) %>%
mutate(x = rnorm(length(total.qty)))
#> `summarise()` regrouping output by 'category.secondary' (override with `.groups` argument)
future_x <- new_data(monthly_qty_by_cat2) %>%
mutate(x = 2)
monthly_qty_by_cat2 %>%
model(tslm = TSLM(total.qty ~ trend() + x)) %>%
forecast(new_data=future_x)
#> # A fable: 9 x 6 [1M]
#> # Key: category.secondary, .model [9]
#> category.secondary .model order.month total.qty .mean x
#> <chr> <chr> <mth> <dist> <dbl> <dbl>
#> 1 Cross Country Race tslm 2016 Jan N(369, 187840) 369. 2
#> 2 Cyclocross tslm 2016 Jan N(-2.5, 75604) -2.50 2
#> 3 Elite Road tslm 2016 Jan N(784, 322470) 784. 2
#> 4 Endurance Road tslm 2016 Jan N(159, 117760) 159. 2
#> 5 Fat Bike tslm 2016 Jan N(95, 66320) 94.6 2
#> 6 Over Mountain tslm 2016 Jan N(194, 57732) 194. 2
#> 7 Sport tslm 2016 Jan N(120, 81568) 120. 2
#> 8 Trail tslm 2016 Jan N(214, 56269) 214. 2
#> 9 Triathalon tslm 2016 Jan N(102, 94449) 102. 2
Created on 2020-07-20 by the reprex package (v0.3.0)

Related

Aggregating a dataframe with dplyr in R based on several dummy variables

I am using dplyr to aggregate my dataframe, so it shows percentages of people choosing specific protein design tasks by company size. I have different dummy variables for protein design tasks, because this was a multiple choice question in a survey.
I figured out a way to do this, but my code is very long, because I aggregate the data per task and then join all these separate dataframes together into one. I’m curious whether there is a more elegant (shorter) way to do this?
library(tidyverse)
EarlyAccess <- read_csv("https://dropbox.com/s/antzwk1jh4ldrhi/EarlyAccess_anon.csv?dl=1")
#################### STABILITY ################################################
Proportions_tasks_stability <- EarlyAccess %>%
select(size, Improving.stability..generic..thermal..pH.) %>%
group_by(size, Improving.stability..generic..thermal..pH.) %>%
summarise(count_var_stability=n())%>%
mutate(total_group_by_size = sum(count_var_stability)) %>%
mutate(pc_var_stability=count_var_stability/sum(count_var_stability)*100) %>%
filter(Improving.stability..generic..thermal..pH.=="Improving stability (generic, thermal, pH)") %>%
select(size, Improving.stability..generic..thermal..pH., pc_var_stability)
######################## ACTIVITY #############################################
Proportions_tasks_activity <- EarlyAccess %>%
select(size, Improving.activity ) %>%
group_by(size, Improving.activity) %>%
summarise(count_var_activity=n())%>%
mutate(total_group_by_size = sum(count_var_activity)) %>%
mutate(pc_var_activity=count_var_activity/sum(count_var_activity)*100) %>%
filter(Improving.activity=="Improving activity") %>%
select(size, Improving.activity, pc_var_activity)
######################## BINDING AFFINITY ######################################
Proportions_tasks_binding.affinity<- EarlyAccess %>%
select(size, Improving.binding.affinity ) %>%
group_by(size, Improving.binding.affinity) %>%
summarise(count_var_binding.affinity=n())%>%
mutate(total_group_by_size = sum(count_var_binding.affinity)) %>%
mutate(pc_var_binding.affinity=count_var_binding.affinity/sum(count_var_binding.affinity)*100) %>%
filter(Improving.binding.affinity=="Improving binding affinity") %>%
select(size, Improving.binding.affinity, pc_var_binding.affinity)
# Then join them
Protein_design_tasks <- Proportions_tasks_stability %>%
inner_join(Proportions_tasks_activity, by = "size") %>%
inner_join(Proportions_tasks_binding.affinity, by = "size")
Using the datafile you provided, this should give the percentages of the selected category within each column for each size:
library(tidyverse)
df <-
read_csv("https://dropbox.com/s/antzwk1jh4ldrhi/EarlyAccess_anon.csv?dl=1")
df |>
group_by(size) |>
summarise(
pc_var_stability = sum(
Improving.stability..generic..thermal..pH. == "Improving stability (generic, thermal, pH)",
na.rm = TRUE
) / n() * 100,
pc_var_activity = sum(Improving.activity == "Improving activity",
na.rm = TRUE) / n() * 100,
pc_var_binding.affinity = sum(
Improving.binding.affinity == "Improving binding affinity",
na.rm = TRUE
) / n() * 100
)
#> # A tibble: 7 × 4
#> size pc_var_stability pc_var_activity pc_var_binding.affinity
#> <chr> <dbl> <dbl> <dbl>
#> 1 1000-10000 43.5 47.8 34.8
#> 2 10000+ 65 65 70
#> 3 11-50 53.8 53.8 46.2
#> 4 2-10 51.1 46.8 46.8
#> 5 200-1000 64.7 52.9 52.9
#> 6 50-200 42.1 42.1 36.8
#> 7 Just me 48.5 39.4 54.5
Looking at your data, each column has either the string value you're testing for or NA, so you could make it even shorter/tidier just by counting non-NAs in relevant columns:
df |>
group_by(size) |>
summarise(across(
c(
Improving.stability..generic..thermal..pH.,
Improving.activity,
Improving.binding.affinity
),
\(val) 100 * sum(!is.na(val)) / n()
))
If what you're aiming to do is summarise across all columns then the latter method may work best - there are several ways of specifying which columns you want and so you don't necessarily need to type all names and values in. You might also find it clearest to make calculating and formatting all percentages a named function to call:
library(tidyverse)
df <-
read_csv("https://dropbox.com/s/antzwk1jh4ldrhi/EarlyAccess_anon.csv?dl=1",
show_col_types = FALSE)
perc_nonmissing <- function(val) {
sprintf("%.1f%%", 100 * sum(!is.na(val)) / n())
}
df |>
group_by(size) |>
summarise(across(-c(1:2), perc_nonmissing))
#> # A tibble: 7 × 12
#> size Disco…¹ Searc…² Under…³ Impro…⁴ Impro…⁵ Impro…⁶ Impro…⁷ Impro…⁸ Impro…⁹
#> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr> <chr>
#> 1 1000-… 21.7% 17.4% 43.5% 47.8% 39.1% 43.5% 30.4% 39.1% 39.1%
#> 2 10000+ 40.0% 55.0% 55.0% 65.0% 70.0% 65.0% 20.0% 30.0% 40.0%
#> 3 11-50 30.8% 26.9% 42.3% 53.8% 38.5% 53.8% 15.4% 30.8% 38.5%
#> 4 2-10 38.3% 40.4% 48.9% 46.8% 36.2% 51.1% 23.4% 31.9% 42.6%
# etc.

Cleaning an oddly structured dataframe from an excel file (any recommendations on functions also appreciated)

I'm trying to make a dataframe pulled from an excel file more user-friendly by creating a "Type" column.
The data can be found here: https://www.dmo.gov.uk/data/pdfdatareport?reportCode=D1A (direct download excel link here: https://www.dmo.gov.uk/umbraco/surface/DataExport/GetDataExport?reportCode=D1A&exportFormatValue=xls&parameters=%26COBDate%3D11%2F04%2F2011)
As you can probably see, the type of data is all grouped together in column A, like so:
What I'd like to do is is change title "Conventional Gilts" to being "Name", and create a "Type" column that has the different categories pulled from their grouped title. In the linked file, the "Types" would be: "Ultra-Short", "Short", "Medium", "Long", "Index-linked Gilts (3-month Indexation Lag)", "Undated Gilts (non "rump")", and ""Rump" Gilts".
While I feel I would need to do some form of pattern recognition using a package like grepl, I'm not sure how I can achieve this from a 'dynamic' perspective (changing if new categories are created).
Any advice on how to achieve this (or even achieve this in a function) would be greatly appreciated.
I don't know about a single function to do all this; the data is haphazardly arranged and needs to be fixed "manually", for example:
library(readxl)
library(tidyverse)
gilts <- read_xls("C:/Users/Administrator/Documents/gilts.xls")
gilts %>%
filter(!apply(gilts, 1, function(x) all(is.na(x)))) %>%
filter(seq(nrow(.)) < 44) %>%
select(1:7) %>%
filter(seq(nrow(.)) != 1) %>%
setNames(unlist(slice(., 1))) %>%
filter(seq(nrow(.)) != 1) %>%
mutate(splitter = cumsum(is.na(`ISIN Code`))) %>%
group_by(splitter) %>%
mutate(Type = first(`Conventional Gilts`)) %>%
summarize(across(everything(), ~.x[-1])) %>%
ungroup() %>%
select(-1) %>%
select(c(8, 1:7)) %>%
rename(Name = `Conventional Gilts`) %>%
mutate(across(c(4, 5, 7),
~ as.Date(as.numeric(.x), origin = "1899-12-30"))) %>%
mutate(across(contains("million"), as.numeric))
#> `summarise()` has grouped output by 'splitter'. You can override using the
#> `.groups` argument.
#> # A tibble: 37 x 8
#> Type Name ISIN ~1 Redempti~2 First Is~3 Divid~4 Current/~5 Total~6
#> <chr> <chr> <chr> <date> <date> <chr> <date> <dbl>
#> 1 Ultra-Short 9% Conv~ GB0002~ 2011-07-12 1987-07-12 12 Jan~ 2011-07-01 7312.
#> 2 Ultra-Short 3¼% Tre~ GB00B3~ 2011-12-07 2008-11-14 7 Jun/~ 2011-05-26 15747
#> 3 Ultra-Short 5% Trea~ GB0030~ 2012-03-07 2001-05-25 7 Mar/~ 2011-08-26 26867.
#> 4 Ultra-Short 5¼% Tre~ GB00B1~ 2012-06-07 2007-03-16 7 Jun/~ 2011-05-26 25612.
#> 5 Ultra-Short 4½% Tre~ GB00B2~ 2013-03-07 2008-03-05 7 Mar/~ 2011-08-26 33787.
#> 6 Ultra-Short 8% Trea~ GB0008~ 2013-09-27 1993-04-01 27 Mar~ 2011-09-16 8378.
#> 7 Ultra-Short 2¼% Tre~ GB00B3~ 2014-03-07 2009-03-20 7 Mar/~ 2011-08-26 29123.
#> 8 Short 5% Trea~ GB0031~ 2014-09-07 2002-07-25 7 Mar/~ 2011-08-26 36579.
#> 9 Short 2¾% Tre~ GB00B4~ 2015-01-22 2009-11-04 22 Jan~ 2011-07-13 28181.
#> 10 Short 4¾% Tre~ GB0033~ 2015-09-07 2003-09-26 7 Mar/~ 2011-08-26 33650.
#> # ... with 27 more rows, and abbreviated variable names 1: `ISIN Code`,
#> # 2: `Redemption Date`, 3: `First Issue Date`, 4: `Dividend Dates`,
#> # 5: `Current/Next \nEx-dividend Date`,
#> # 6: `Total Amount in Issue \n(£ million nominal)`
Created on 2022-10-30 with reprex v2.0.2
Different approach, premised on the fact that all the gilts start with numbers and the types do not. Makes use of janitor which has super helpful functions for cleaning up messy imported data like this.
library(tidyverse)
library(readxl)
library(janitor)
import_gilts <- read_excel("20221031 - Gilts in Issue.xls.xls", skip = 7)
gilts <- import_gilts %>%
filter(!str_detect(1, "^Note|^Page")) %>%
rename(Name = `Conventional Gilts`) %>%
remove_empty(which = "rows") %>%
mutate(Type = case_when(str_detect(Name, "^[^0-9]") ~ Name,
TRUE ~ NA_character_),
.before = Name) %>%
fill(Type, .direction = "down") %>%
arrange(desc(...9)) %>%
row_to_names(row_number = 2) %>%
rename(Type = 1,
Name = 2) %>%
filter(Type != Name)
Quick draft so there's certainly room for improvement.
Should be able to be turned into a function as long as the number of imported columns and number of rows to skip reading in the file stay the same.

map_df -- Argument 1 must be a data frame or a named atomic vector

I am an infectious diseases physician and have set myself the challenge of creating a dataframe with the UK cumulative published cases of monkeypox, so I can graph it as a runing tally or a chloropleth map as there is no nice dashboard at present for this.
All the data is published as html webpages rather than as a nice csv so I am trying to scrape it all off the internet using the rvest package.
Data is only published intermittently (about twice per week) with the cumulative totals for each of the 4 home nations in UK.
I have managed to get working code to pull data from each of the separate webpages and testing it on the first 2 pages in my mpx_gov_uk_pages list works well giving a small example tibble:
library(tidyverse)
library(lubridate)
library(rvest)
library(janitor)
# load in overview page url which has links to each date of published cases
mpx_gov_uk_overview_page <- c("https://www.gov.uk/government/publications/monkeypox-outbreak-epidemiological-overview")
# extract urls for each date page
mpx_gov_uk_pages <- mpx_gov_uk_overview_page %>%
read_html %>%
html_nodes(".govuk-link") %>%
html_attr('href') %>%
str_subset("\\d{1,2}-[a-z]+-\\d{4}") %>%
paste0("https://www.gov.uk", .) %>%
as.character()
# make table for home nations for each date
table1 <- mpx_gov_uk_pages[1] %>%
read_html() %>%
html_table() %>%
.[[1]] %>%
janitor::clean_names() %>%
rename(area = starts_with(c("uk", "devolved")),
cases = matches(c("total", "confirmed_cases"))) %>%
separate(cases, c("cases", NA), sep = "\\s\\(") %>%
mutate(date = dmy(str_extract(mpx_gov_uk_pages[1], "\\d{1,2}-[a-z]+-\\d{4}")),
cases = as.numeric(gsub(",", "", cases))) %>%
select(date, area, cases) %>%
filter(!area %in% c("Total"))
table2 <- mpx_gov_uk_pages[2] %>%
read_html() %>%
html_table() %>%
.[[1]] %>%
janitor::clean_names() %>%
rename(area = starts_with(c("uk", "devolved")),
cases = matches(c("total", "confirmed_cases"))) %>%
separate(cases, c("cases", NA), sep = "\\s\\(") %>%
mutate(date = dmy(str_extract(mpx_gov_uk_pages[2], "\\d{1,2}-[a-z]+-\\d{4}")),
cases = as.numeric(gsub(",", "", cases))) %>%
select(date, area, cases) %>%
filter(!area %in% c("Total"))
#> Warning: Expected 2 pieces. Missing pieces filled with `NA` in 1 rows [4].
# Combine tables
bind_rows(table1, table2)
#> # A tibble: 8 × 3
#> date area cases
#> <date> <chr> <dbl>
#> 1 2022-08-02 England 2638
#> 2 2022-08-02 Northern Ireland 24
#> 3 2022-08-02 Scotland 65
#> 4 2022-08-02 Wales 32
#> 5 2022-07-29 England 2436
#> 6 2022-07-29 Northern Ireland 19
#> 7 2022-07-29 Scotland 61
#> 8 2022-07-29 Wales 30
I want to automate this by creating a generic function and passing the list of urls to purrr::map_df as there will be an ever growing number of pages (there's already 13):
pull_first_table <- function(x){
x %>%
read_html() %>%
html_table() %>%
.[[1]] %>%
janitor::clean_names() %>%
rename(area = starts_with(c("uk", "devolved")),
cases = matches(c("total", "confirmed_cases"))) %>%
separate(cases, c("cases", NA), sep = "\\s\\(") %>%
mutate(date = dmy(str_extract({{x}}, "\\d{1,2}-[a-z]+-\\d{4}")),
cases = as.numeric(gsub(",", "", cases))) %>%
select(date, area, cases) %>%
filter(!area %in% c("Total"))
}
summary_table <- map_df(mpx_gov_uk_pages, ~ pull_first_table)
Error in `dplyr::bind_rows()`:
! Argument 1 must be a data frame or a named atomic vector.
Run `rlang::last_error()` to see where the error occurred.
The generic function seems to work ok when I supply it with a single element e.g. mpx_gov_uk_cases[2] but I cannot seem to get map_df to work properly even though the webscraping is producing tibbles.
All help and pointers greatly welcomed.
We just need the function and not a lambda expression.
map_dfr(mpx_gov_uk_pages, pull_first_table)
-output
# A tibble: 52 × 3
date area cases
<date> <chr> <dbl>
1 2022-08-02 England 2638
2 2022-08-02 Northern Ireland 24
3 2022-08-02 Scotland 65
4 2022-08-02 Wales 32
5 2022-07-29 England 2436
6 2022-07-29 Northern Ireland 19
7 2022-07-29 Scotland 61
8 2022-07-29 Wales 30
9 2022-07-26 England 2325
10 2022-07-26 Northern Ireland 18
# … with 42 more rows
If we use the lambda expression,
map_dfr(mpx_gov_uk_pages, ~ pull_first_table(.x))

fable box_cox accuracy error and forecast not converting back to original series

I'm following on a previous answer related with fable R and the use of
box_cox function to transform the response variable. When I tried to get the accuracy of model an error occurred. Also when I used the forecast function the series is still transformed. Thanks
Library(fpp3)
lambda2 <- tsibbledata::PBS %>%
aggregate_key(Concession, Cost = sum(Cost)) %>%
features(Cost, features = guerrero)
lambda2
#> # A tibble: 3 x 2
#> Concession lambda_guerrero
#> <chr*> <dbl>
#> 1 Concessional 0.252
#> 2 General 0.658
#> 3 <aggregated> 0.364
tsibbledata::PBS %>%
aggregate_key(Concession, Cost = sum(Cost)) %>%
# Add lambda to the dataset, matching based on the key variable
left_join(lambda2, by = "Concession") %>%
autoplot(box_cox(Cost, lambda_guerrero))
tsibbledata::PBS %>%
aggregate_key(Concession, Cost = sum(Cost)) %>%
# Add lambda to the dataset, matching based on the key variable
left_join(lambda2, by = "Concession") %>%
autoplot(box_cox(Cost, lambda_guerrero)) +
facet_grid(rows = vars(Concession), scales = "free_y")
act<-tsibbledata::PBS %>%
aggregate_key(Concession, Cost = sum(Cost),Scripts=sum(Scripts))
fut<-new_data(act, 10) %>% mutate(Scripts=mean(act$Scripts))
fit<-act %>%
# Add lambda to the dataset, matching based on the key variable
left_join(lambda2, by = "Concession") %>%
model( arima=ARIMA(box_cox(Cost,lambda_guerrero)~Scripts))
accuracy(fit)
#> Error: Problem with `mutate()` input `fit`.
#> x Can't convert a call to a string
#> i Input `fit` is `map(fit, accuracy, measures = measures, ...)`.
fit %>% forecast(fut )
#> A fable: 30 x 6 [1M]
#> Key: Concession, .model [3]
#> Concession .model Month `box_cox(Cost, lambda_guerrero)` .mean Scripts
#> <chr> <chr> <mth> <dist> <dbl> <dbl>
#> 1 Concessional arima 2008 Jul N(521, 2.3) 521. 7752813.
#> 2 Concessional arima 2008 Aug N(521, 3.8) 521. 7752813.
#> 3 Concessional arima 2008 Sep N(522, 4.8) 522. 7752813.
#> 4 Concessional arima 2008 Oct N(525, 5.8) 525. 7752813.
#> 5 Concessional arima 2008 Nov N(528, 6.8) 528. 7752813.
#> 6 Concessional arima 2008 Dec N(530, 7.7) 530. 7752813.
#> 7 Concessional arima 2009 Jan N(530, 8.7) 530. 7752813.
#> 8 Concessional arima 2009 Feb N(524, 9.5) 524. 7752813.
#> 9 Concessional arima 2009 Mar N(525, 10) 525. 7752813.
#> 10 Concessional arima 2009 Apr N(524, 11) 524. 7752813.
#> ... with 20 more rows

Extract Model Description from a mable

I have a mable object that is like so:
models
# A mable: 1 x 3
ets arima nnetar
<model> <model> <model>
1 <ETS(M,Ad,M)> <ARIMA(2,1,2)(0,0,2)[12]> <NNAR(14,1,10)[12]>
I just want the models descriptions so I can place them in a plot. So I ran the following code:
model_desc <- models %>%
gather() %>%
select(key, value) %>%
set_names("model","model_desc") %>%
mutate(model_desc_char = model_desc %>% as.character())
as_tibble() %>%
select(model, model_desc)
This still gives me back a tibble where model_desc is still a list object. I think this is because of how a mable is constructed and how its structure is supposed to be.
** UPDATE **
I solved the problem by doing the following:
model_desc <- models %>%
as_tibble() %>%
gather() %>%
mutate(model_desc = print(value)) %>%
select(key, model_desc) %>%
set_names("model", "model_desc")
For anybody else who will encounter this going forward, I have pasted a solution that works for me with the latest versions of fable/fabletools.
library(fable)
#> Loading required package: fabletools
library(tsibble)
library(tsibbledata)
library(lubridate)
#>
#> Attaching package: 'lubridate'
#> The following object is masked from 'package:tsibble':
#>
#> interval
#> The following objects are masked from 'package:base':
#>
#> date, intersect, setdiff, union
library(dplyr)
#>
#> Attaching package: 'dplyr'
#> The following objects are masked from 'package:stats':
#>
#> filter, lag
#> The following objects are masked from 'package:base':
#>
#> intersect, setdiff, setequal, union
library(tidyr)
aus_retail %>%
filter(
State %in% c("New South Wales", "Victoria"),
Industry == "Department stores"
) %>%
model(
ets = ETS(box_cox(Turnover, 0.3)),
arima = ARIMA(log(Turnover)),
snaive = SNAIVE(Turnover)
) %>%
pivot_longer(cols = -c(State, Industry),
names_to = "model_type",
values_to = "model_specifics_mdl") %>%
mutate(model_specifics = format(model_specifics_mdl)) %>%
select(-model_specifics_mdl)
#> # A tibble: 6 x 4
#> State Industry model_type model_specifics
#> <chr> <chr> <chr> <chr>
#> 1 New South Wales Department stores ets <ETS(A,Ad,A)>
#> 2 New South Wales Department stores arima <ARIMA(2,1,1)(2,1,1)[12]>
#> 3 New South Wales Department stores snaive <SNAIVE>
#> 4 Victoria Department stores ets <ETS(A,A,A)>
#> 5 Victoria Department stores arima <ARIMA(2,1,1)(1,1,2)[12]>
#> 6 Victoria Department stores snaive <SNAIVE>
Created on 2020-09-07 by the reprex package (v0.3.0)
This ended up solving my issue:
model_desc <- models %>%
as_tibble() %>%
gather() %>%
mutate(model_desc = print(value)) %>%
select(key, model_desc) %>%
set_names("model", "model_desc")

Resources