从预测对象中提取信息到单独的 data.frame

Question

我正在使用 forecast 包中的预测函数进行造林，我还使用同一包中的准确度函数。输出是几个对象（class 矩阵），但我想关注名称为 ERROR_Electricity 和 ERROR_Cement 的文件。你可以看到下面的代码：

#  CODE
    library(fpp2)
    library(dplyr)
    library(forecast)
    library(tidyr)
    library(stringr)

    #INPUT DATA
    mydata_qauselec <- qauselec
    mydata_qcement <- window(qcement, start = 1956, end = c(2010, 2))

    # Мerging data
    mydata <- cbind(mydata_qauselec, mydata_qcement)
    colnames(mydata) <- c("Electricity", "Cement")

    # Test Extract Name
    mydata1 <- data.frame(mydata)
    COL_NAMES <- names(mydata1)
    rm(mydata_qauselec, mydata_qcement)

    # FORCASTING HORIZON
    forecast_horizon <- 12

    # FORECASTING
    for(i in 1:ncol(mydata)){
      # Build a ts for this column
      timeseries <- msts(mydata[,i], start = 1956, seasonal.periods = c(4))
      # Build a foreacst based on the ts
      forecast <- snaive(timeseries, biasadj = TRUE, h =  forecast_horizon)
      accuracy_results <- accuracy(forecast)
      residuals_snaive <- Box.test(zoo::na.approx(forecast$residuals), type = "Ljung") 
      # rename the forecast according to the original variable name
      colname <- colnames(mydata)[i]
      #FORECASTING SETS
      forecastName <- paste("SNAIVE_", colname," <- forecast", sep = "")
      eval(parse(text = forecastName))
      #EVALUATION SET
      forecastName1 <- paste("ERROR_", colname," <- accuracy_results", sep="")
      eval(parse(text = forecastName1))
      #RESIDUALS SET
      forecastName2 <- paste("RESIDUALS_", colname," <- residuals_snaive", sep  "")
      eval(parse(text = forecastName2))
    }

所以我的意图是以自动方式将对象 ERROR_Electricity 和 ERROR_Cement 放入 DF_TABLE。所以代码需要找到这两个名称以ERROR_开头的对象并放入数据框DF_TABLE。这对我来说非常重要，因为这只是一个小例子的测试，一个普通的例子可能有 5 或 10 个名称以 ERROR_ 开头的对象。您可以在下面看到一些示例，但意图是以自动化方式进行，而不是像下面的示例那样使用括号中的规范 (ERROR_Electricity、ERROR_Cement)。

DF_TABLE <- data.frame(rbind(ERROR_Electricity, ERROR_Cement))

有人可以帮我处理这段代码吗？

Answer 1

我建议对 apply() 系列使用 R-泛函方法。为了使事情变得更简单，让我们将您的预测运行包装到一个单独的函数中：

BuildForecast <- function(Z, hrz = forecast_horizon) {
  timeseries <- msts(Z, start = 1956, seasonal.periods = 4)
  forecast <- snaive(timeseries, biasadj = TRUE, h =  hrz)
}

然后我们可以使用lapply()轻松获得mydata1数据框每一列的预测列表：

frc_list <- lapply(X = mydata1, BuildForecast)

同样的方法可以提取准确度和残差：

res_accur <- lapply(frc_list,  accuracy)
# forecast::residuals() is a built-in function to extract the residuals values
res_resid <- lapply(frc_list, 
  function(Z) Box.test(zoo::na.approx(residuals(Z)), type = "Ljung"))

lapply()的输出是一个列表。如果需要更紧凑的结构，可以这样绑定结果：

res_accur_v <- do.call(rbind, res_accur)

或使用vapply():

res_resid_v <- vapply(frc_list, 
  function(Z) unlist(Box.test(zoo::na.approx(residuals(Z)), type = "Ljung")),
  character(5))

从预测对象中提取信息到单独的 data.frame

Extract information from forecasting object into separate data.frame

for-loop

r

forecasting