R：按時間序列數據按列組應用多個功能

Question

我在小時級有時間序列數據。我正在嘗試爲這些數據建立一個預測。數據的下面是示例：

sample <- 
structure(list(group_type = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("Group 1", 
"Group 2", "Group 5"), class = "factor"), sub_group_type = structure(c(1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 
3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 
3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L), .Label = c("Sub Group 1", "Sub Group 2", "Sub Group 3"), 
class = "factor"), date = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), .Label = c("1/1/17", 
"1/2/17", "1/3/17"), class = "factor"), hour = c(6L, 7L, 8L, 9L, 10L, 11L, 12L, 
6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 
10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 
7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 
11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 
8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 6L, 7L, 8L, 9L, 10L, 11L, 12L), weekday = structure(c(2L, 2L, 2L, 2L, 2L, 
2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 3L, 3L, 3L, 3L, 3L, 3L, 3L), 
.Label = c("Monday", "Sunday", "Tuesday"), class = "factor"), total = c(9L, 9L, 
10L, 6L, 2L, 14L, 3L, 11L, 12L, 12L, 0L, 10L, 8L, 13L, 14L, 17L, 12L, 5L, 9L, 7L, 
10L, 13L, 23L, 11L, 3L, 6L, 10L, 11L, 14L, 16L, 13L, 2L, 3L, 4L, 14L, 11L, 16L, 
8L, 12L, 7L, 6L, 13L, 13L, 22L, 12L, 7L, 9L, 8L, 14L, 9L, 16L, 15L, 6L, 7L, 6L, 
12L, 13L, 14L, 7L, 3L, 13L, 11L, 6L, 8L, 15L, 11L, 3L, 10L, 9L, 7L, 12L, 10L, 10L, 
3L, 14L, 8L, 12L, 10L, 20L, 5L, 4L, 8L, 12L, 3L, 0L, 4L, 5L, 1L, 6L, 7L, 0L, 3L, 
1L, 1L, 0L, 2L, 2L, 0L, 2L, 0L, 3L, 7L, 6L, 2L, 1L)), .Names = c("group_type", 
"sub_group_type", "date", "hour", "weekday", "total"), class = "data.frame", 
row.names = c(NA, -105L)) 

我申請以下功能對上述數據：

models <- function(x){ 
    x <- msts(x, seasonal.periods=c(24,168)) 
    mod_exp <- ets(x, ic='aicc', restrict=T) 
    mod_hwa <- HoltWinters(x,seasonal = "additive") 
    mod_hwm <- HoltWinters(x,seasonal = "multiplicative") 
    mod_neural <- nnetar(x, p=7, size=25) 
    mod_tbats <- tbats(x, ic='aicc', seasonal.periods=7) 
    mod_bats <- bats(x, ic='aicc', seasonal.periods=7) 
    mod_stl <- stlm(x, s.window=7, ic='aicc', robust=TRUE, method='ets') 
    mod_sts <- StructTS(x) 
} 

test <- by(sample,list(sample$group_type,sample$sub_group_type,sample$date, sample$hour 
),models) 

但是，我發現了以下錯誤：

Error in ets(x, ic = "aicc", restrict = T) : y should be a univariate time series 

如果我如下所示將數據拆分爲應用ets（）函數，我可以在沒有任何問題的情況下運行它。但是，這種分裂的數據是不適合我爲組和子組是太多和他們每個人都有不同的時間序列模式的數量非常可行的選擇：

sub_sample_1 <- sample[sample$group_type == "Group 1" & sample$sub_group_type == "Sub Group 1",6] 
x <- msts(sub_sample_1, seasonal.periods=24) 
mod_arima <- auto.arima(x, ic='aicc', stepwise=F) 
mod_exp <- ets(x, ic='aicc', restrict=T) 
mod_hwa <- HoltWinters(x,seasonal = "additive") 
mod_hwm <- HoltWinters(x,seasonal = "multiplicative") 
mod_neural <- nnetar(x, p=24, size=10) 
mod_tbats <- tbats(x, ic='aicc', seasonal.periods=24) 
mod_bats <- bats(x, ic='aicc', seasonal.periods=24) 
mod_stl <- stlm(x, s.window=24, ic='aicc', robust=TRUE, method='ets') 
mod_sts <- StructTS(x) 

有沒有什麼解決辦法，使我可以通過一組列來應用模型而不會遇到任何錯誤？

此外，並非所有模型都適用於所有組。對於sub_sample_1數據，HoltWinters，neuralnet，蝙蝠和STL是給我的錯誤和其他人共同

> mod_hwa <- HoltWinters(x,seasonal = "additive") 
Error in decompose(ts(x[1L:wind], start = start(x), frequency = f), seasonal) : 
time series has no or less than 2 periods 

> mod_hwm <- HoltWinters(x,seasonal = "multiplicative") 
Error in HoltWinters(x, seasonal = "multiplicative") : 
data must be non-zero for multiplicative Holt-Winters 

> mod_bats <- bats(x, ic='aicc', seasonal.periods=24) 
Error in optim(par = param.vector$vect, fn = calcLikelihoodNOTransformed, : 
function cannot be evaluated at initial parameters 

我可以理解爲什麼這些模型是不是我的數據的工作。我應用該功能時如何排除錯誤？

在此先感謝您的幫助！

這個問題是相似的（擴展可能），我其他的問題，從您的當前設置出現here

Answer 1

幾個問題：如果沒有指定return()

1. 函數返回的最後一行。因此，您的第一次嘗試將會丟失除mod_sts之外的所有行，這將爲by的每個子集分配值test。

2. 在你的子集代碼中，你實際上傳遞了第6列（一個原子向量），而你在第一次代碼嘗試中傳遞了所有數據幀的列。這可能是你錯誤的原因，其中的輸入應該是每msts文檔：

   A numeric vector, ts object, matrix or data frame. It is intended that the time series data is univariate, otherwise treated the same as ts().

3. 你by正在接收四組，group_type，sub_group_type，日期和小時不像你第二個子集的代碼是兩個。除非您的數據非常大，否則這些許多分組可能會導致行數很少或沒有行，因此模型過程的數據點不夠，因爲您最後的代碼塊似乎暗示了這一點。

隨着中說，考慮由前兩個分組返回命名的元素列表，指定與第6列如下調整。而由於by需要的因素，在子集化數據幀可能會產生任何行的組合，下面用tryCatch捕捉到任何錯誤，並返回空列表的最後一行被過濾掉。

models <- function(x){ 
    x <- msts(x, seasonal.periods=c(24,168)) 
    list(
    mod_exp = ets(x, ic='aicc', restrict=T), 
    mod_hwa = HoltWinters(x,seasonal = "additive"), 
    mod_hwm = HoltWinters(x,seasonal = "multiplicative"), 
    mod_neural = nnetar(x, p=7, size=25), 
    mod_tbats = tbats(x, ic='aicc', seasonal.periods=7), 
    mod_bats = bats(x, ic='aicc', seasonal.periods=7), 
    mod_stl = stlm(x, s.window=7, ic='aicc', robust=TRUE, method='ets'), 
    mod_sts = StructTS(x) 
) 
} 

# TRY/CATCH TO CAPTURE ERRORS AND RETURN EMPTY LIST 
test <- by(sample[,6], list(sample$group_type, sample$sub_group_type), 
      function(x) tryCatch({ models(x) 
           }, error=function(e) return(list(NA)))) 

# TO REMOVE NULLs AND NAs (EMPTY ITEMS) 
test <- Filter(function(i) length(i) > 0, test)