How to convert data frame rows iteratively into time series object and apply auto.arima to each row

Question

I have the following df:

head(customerdata)
  Customer.ID Week1 Week2 Week3 week4 week5 week6 week7 week8
1          C1   420   423   481   421   393   419   415   440
2          C2  1325  1262  1376  1370  1484  1421  1287  1400
3          C3   547   541   547   550   570   576   556   587
4          C4   349   349   375   346   374   379   433   376
5          C5   721   714   758   716   833   735   711   731
6          C6   420   423   481   421   393   419   415   440

I need to convert each customer ID ierow into a time series object and then apply auto.arima on each row and make forecasts.

I tried using apply fn :

apply(customerdata,1,as.ts) 

But this didnt work properly.

Also is there a way where i can use tidyverse packages like purrr etc. to convert each row into ts object,then apply auto.arima using map fn, then extract error stats like MAPE and also points forecast in a data.frame.

Help would be appreciated!!

Answer 1

Here's how you could do it with list-columns in tidyverse

library(dplyr)
library(tidyr)
library(purrr)
library(zoo)
library(forecast)

start_date <-ymd(20171225)
holdout <- 3

customerdata %>% gather(key, value, -Customer.ID) %>% 
  mutate(key=as.numeric(str_replace(key, "[W|w]eek", ""))) %>%
  mutate(Date=start_date + weeks(key)) %>% 
  select(Customer.ID, Date, Value=value) %>% 
  group_by(Customer.ID) %>% nest() %>% 
  mutate(zoo_obj=map(data, ~with(.x, zoo(Value, Date))),
         arima_oof_mod=map(zoo_obj, ~auto.arima(head(.x, length(.x)-holdout))),
         arima_fcst=map(arima_oof_mod, forecast, holdout),
         holdout=map(zoo_obj, tail, holdout),
         metrics=map2(arima_fcst, holdout, ~accuracy(.x,.y)),
         metrics=map(metrics, ~{as.data.frame(.x) %>% tibble::rownames_to_column()})) %>%
  unnest(metrics)

#> # A tibble: 12 x 9
#>    Customer.ID      rowname            ME      RMSE      MAE         MPE     MAPE       MASE        ACF1
#>         <fctr>        <chr>         <dbl>     <dbl>    <dbl>       <dbl>    <dbl>      <dbl>       <dbl>
#>  1          C1 Training set  9.095016e-14 28.883213 21.36000 -0.43337807 4.874127 0.04995323 -0.08025508
#>  2          C1     Test set -2.933333e+00 11.350184 11.20000 -0.75682291 2.635611 0.02619270          NA
#>  3          C2 Training set -9.095086e-14 72.805494 55.92000 -0.28176887 4.091423 0.04101511  0.13187992
#>  4          C2     Test set  5.933333e+00 59.144681 56.86667  0.24382775 4.201352 0.04170945          NA
#>  5          C3 Training set  1.136868e-13  9.939819  7.60000 -0.03188731 1.365221 0.01379310  0.13157895
#>  6          C3     Test set  2.200000e+01 25.468935 22.00000  3.79081247 3.790812 0.03992740          NA
#>  7          C4 Training set  3.410570e-14 13.032268 12.72000 -0.13041415 3.526806 0.03547128 -0.54870466
#>  8          C4     Test set  3.740000e+01 45.659172 37.40000  9.06423112 9.064231 0.10429448          NA
#>  9          C5 Training set -9.095086e-14 45.239805 37.68000 -0.34415821 4.913179 0.05034741 -0.23841614
#> 10          C5     Test set -2.273333e+01 25.040501 22.73333 -3.15454237 3.154542 0.03037591          NA
#> 11          C6 Training set  9.095016e-14 28.883213 21.36000 -0.43337807 4.874127 0.04995323 -0.08025508
#> 12          C6     Test set -2.933333e+00 11.350184 11.20000 -0.75682291 2.635611 0.02619270          NA

Answer 2

It is not necessary to convert each row to a ts object. You can run auto.arima on every row but make sure to exclude your first column.

library(forecast)
arima_models <- apply(customerdata[, -1], 1, auto.arima)

You could then run the following code to get a one-step ahead forecast for each model

model_forecasts <- lapply(arima_models, function(x) forecast(x, h = 1))

To extract the point forecasts you can use purrr::map_*

library(purrr)
map_dbl(model_forecasts, "mean")
#       1        2        3        4        5        6 
# 426.500 1365.625  587.000  372.625  739.875  426.500

Or if you set h > 1 in forecast then use

map_dfr(model_forecasts, "mean")

To calculate the MAPE you need the true outcome of course.

data

customerdata <- read.table(text = "Customer.ID Week1 Week2 Week3 week4 week5 week6 week7 week8
1          C1   420   423   481   421   393   419   415   440
2          C2  1325  1262  1376  1370  1484  1421  1287  1400
3          C3   547   541   547   550   570   576   556   587
4          C4   349   349   375   346   374   379   433   376
5          C5   721   714   758   716   833   735   711   731
6          C6   420   423   481   421   393   419   415   440", header = TRUE)