Loop output to list. Is there an elegant alternative?-CodePudding

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)

CodePudding user response：

A somewhat more succint approach would be to use data frame unpacking in summarise() to create new columns for each metric returned by accuracy():

library(tidyverse)
library(forecast)

testing_frame %>% 
  group_by(id, model) %>% 
  summarise(
    accuracy(
      ts(.value, frequency = H),
      ts(test_value, frequency = H)
    ) %>% as_tibble()
  )
#> # A tibble: 12 x 9
#> # Groups:   id [6]
#>    id    model    ME  RMSE   MAE   MPE  MAPE   ACF1 `Theil's U`
#>    <fct> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>  <dbl>       <dbl>
#>  1 1     1      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  2 1     2      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  3 2     1      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  4 2     2      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  5 3     1      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  6 3     2      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  7 4     1      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  8 4     2      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#>  9 5     1      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#> 10 5     2      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#> 11 6     1      3.67  4.83  3.67  9.08  9.08 -0.114       0.128
#> 12 6     2      3.67  4.83  3.67  9.08  9.08 -0.114       0.128

CodePudding user response：

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