如何在使用 DPLYR 的批量预测模型中找到准确性？

Question

我正在对如下所示的数据框（名称：df5）使用批量预测方法：

 Primary.Base.Product  Variable  Value
    A                     Aug '16    1 
    A                     Sep '16    4
    B                     Aug '16    10
    B                     Sep '16    2
    Z                     Aug '16    6
    Z                     Sep '16    12

我在这里尝试了 ramhiser 建议的 DPLYR 代码：For loop for forecasting several datasets at once in R

library(dplyr)
    library(smooth)
    library(forecast)
    library(tstools)
    #Create a DF
    Primary.Base.Product <- c('A','A','B','B','C','C')
    variable <- c('Aug16','Sep16','Aug16','Sep16','Aug16','Sep16')
    value <- c(1,4,10,2,6,12)
    df5 = data.frame(Primary.Base.Product,variable,value)
    #Do Batch Forecasting:
    model_fits2 <- group_by(df5, Primary.Base.Product) %>% do(fit=ets(.$value))
    head(model_fits2)
    forecast(model_fits2$fit[[1]])

它工作正常，但我如何将数据拆分为测试和训练并使用 accuracy() 函数计算准确度？另外，如何计算拟合值与实际值的准确性？

感谢任何形式的帮助！提前致谢！

我试过了：

model_fits2 <- group_by(df5, Primary.Base.Product) %>%   
               do(fit=ets(.$value[1:(nrow(df5)-10)]))
model_acc2 <- group_by(df5, Primary.Base.Product) %>% 
              do(acc=accuracy(.$value[(nrow(df5)+1):nrow(df5)],                                
                              forecast(model_fits2$fit,h=10)))

错误是：

ets 中的错误（对象，lambda = lambda，biasadj = biasadj，allow.multiplicative.trend = allow.multiplicative.trend，： y 应该是一个单变量时间序列

Answer 1

将每个组按 50/50 拆分，然后将 forecast 应用于 values 和 test=0 并将 accuracy 应用于 values 和 测试=1。

library(dplyr)
library(smooth)
library(forecast)
library(tstools)
model_fits2 <- group_by(df5, Primary.Base.Product) %>% 
               arrange(Primary.Base.Product) %>% 
               #n() number of obs in this group
               mutate(test=ifelse(row_number() <= n()/2, 0, 1)) %>% 
               do(acc=accuracy(forecast(ets(.$value[.$test==0])), .$value[.$test==1]))
               #If you need the output as dataframe then use tidyr::unnest
               #do(acc=data.frame(accuracy(forecast(ets(.$value[.$test==0])), .$value[.$test==1])) %>% rownames_to_column(var = 'model')) 
               # %>% tidyr::unnest()

数据

df5 <- rbind(df5,df5) #Increase the dataset

请注意，nrow(df5)+1 : nrow(df5) 在df5 之外返回索引，因此使用这些索引的任何子集都将返回 NA，见下文。

nrow(df5)+1 : nrow(df5)
[1] 13 14 15 16 17 18 19 20 21 22 23 24
df5$value[nrow(df5)+1 : nrow(df5)]
[1] NA NA NA NA NA NA NA NA NA NA NA NA
#See the difference between 
> 4+1 : 4 
[1] 5 6 7 8 
> (4+1) : 4 
[1] 5 4
#the 1st one similar to 
> 4 + (1:4) 
[1] 5 6 7 8