Loop output to list won't work. Is there an elegant alternative?

February 28, 2022

In order to get the accuracy values from a forecast output vs. actual values in long format with many models and id’s, I wanted to loop through the data and iteratively reduce the input object by using tail(input_object, -Forecast_horizon).

I would rather prefer some tidy approach to do this, because looping like this seems odd and crude.

library(forecast)
library(tibble)
testing_frame <- tibble(.value = rep(c(11,32,35,57,67,34),12),
                            test_value = rep(c(12,33,40,60,69,44),12),
                        id = rep(as.factor(c(rep(1,6),rep(2,6),rep(3,6),rep(4,6),rep(5,6),rep(6,6))),2),
                        model = as.character(c(rep(1,36),c(rep(2,36)))))

H = 6
iter = c(1:12)
datalist = list()
i = 1

for (i in iter) {
    acc_all = forecast::accuracy(ts(head(testing_frame$.value,frequency = H),n=H),
                                 ts(head(testing_frame$test_value,frequency = H),n=H))
    testing_frame <- tail(testing_frame, -H)
    acc_all_out = acc_all[,7]
    datalist[[i]] <- acc_all_out 
}
output = do.call(rbind, datalist)

>Solution :

There is no variation across id/model, in terms of .value/test_value, so the output is the same for each iteration. However, presumably your actual data has this variation. Below is an approach that groups by id and model (i.e. 12 groups), and then uses nest(), map() , and unnest_wider() to get your result

testing_frame %>% group_by(id, model) %>% 
  nest() %>% 
  mutate(acc = map(data,~accuracy(ts(.x$.value, frequency = H),ts(.x$test_value,frequency=H)))) %>% 
  unnest_wider(acc) %>% 
  rename_all(~c("id","model", "data","ME","RMSE","MAE","MPE","MAPE","ACF1", "Theil's U"))

Output:

   id    model data                ME  RMSE   MAE   MPE  MAPE   ACF1 `Theil's U`
   <fct> <chr> <list>           <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>       <dbl>
 1 1     1     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 2 2     1     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 3 3     1     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 4 4     1     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 5 5     1     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 6 6     1     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 7 1     2     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 8 2     2     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
 9 3     2     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
10 4     2     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
11 5     2     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128
12 6     2     <tibble [6 x 2]>  3.67  4.83  3.67  9.08  9.08 -0.114       0.128