lm() 使用 lapply 进行时间序列预测答案

【问题标题】：Time series forecasting by lm() using lapplylm() 使用 lapply 进行时间序列预测
【发布时间】：2020-07-07 19:34:45
【问题描述】：

我试图使用lm() 预测时间序列问题，我的数据如下所示

Customer_key  date         sales
 A35          2018-05-13   31
 A35          2018-05-20   20
 A35          2018-05-27   43
 A35          2018-06-03   31
 BH22         2018-05-13   60
 BH22         2018-05-20   67
 BH22         2018-05-27   78
 BH22         2018-06-03   55

通过

将我的df 转换为列表格式

df <- dcast(df, date ~ customer_key,value.var = c("sales"))
df <- subset(df, select = -c(dt))
demandWithKey <- as.list(df)

尝试编写一个函数，以便将此函数应用于所有客户

my_fun <- function(x) {
  fit <- lm(ds_load ~ date, data=df) ## After changing to list ds_load and date column names
                                     ## are no longer available for formula
  fit_b <- forecast(fit$fitted.values, h=20) ## forecast using lm()
  return(data.frame(c(fit$fitted.values, fit_b[["mean"]])))
}

fcast <- lapply(df, my_fun)

我知道上述函数不起作用，但基本上我正在寻找分组数据的拟合值和预测值。但是我已经尝试了使用tslm()（转换为时间序列数据）等的所有其他方法，但没有运气，我只能以某种方式让lm()在一个客户身上工作。还有很多问题/帖子只是关于拟合模型，但我也想同时进行预测。

【问题讨论】：

标签： r time-series linear-regression lapply lm

【解决方案1】：

lm() 用于回归模型但是在这里你有一个时间序列，所以为了预测你必须使用时间序列模型之一（ARMA ARCH GARCH ...）所以你可以使用 r 中的函数：“预测”包中的 auto.arima()

【讨论】：

感谢您的回复。我确实有其他客户的 arima 模型，但我可以为每个客户单独执行 lm()。我正在寻找同时应用 lm() 的分组数据。

【解决方案2】：

我不知道你到底在做什么，但你可以让这变得不那么复杂。

使用by 避免了重塑数据的需要，它拆分了您的数据，例如在您的情况下按客户 ID 并在子集上应用函数（即，它是 split 和 lapply 的组合；请参阅 ?by）。

由于您想在结果中以某种方式比较拟合值和预测值，您可能需要predict 而不是$fitted.values，否则这些值的长度将不同。因为您的自变量是每周间隔的日期，您可以使用seq.Date 并将第一个日期作为起始值；该序列具有长度实际值（nrow 每个客户）加上 forecast 的 h= 参数。

出于演示目的，我将拟合值添加为下面的第一列。

res <- by(dat, dat$cus_key, function(x) {
      H <- 20  ## globally define 'h'
      fit <- lm(sales ~ date, x)
      fitted <- fit$fitted.values
      pred <- predict(fit, newdata=data.frame(
        date=seq(x$date[1], length.out= nrow(x) + H, by="week")))
      fcst <- c(fitted, forecast(fitted, h=H)$mean)
      fit.na <- `length<-`(unname(fitted), length(pred))  ## for demonstration
      return(cbind(fit.na, pred, fcst))
      })

结果

res
# dat$cus_key: A28
#    fit.na  pred  fcst
# 1    41.4  41.4  41.4
# 2    47.4  47.4  47.4
# 3    53.4  53.4  53.4
# 4    59.4  59.4  59.4
# 5    65.4  65.4  65.4
# 6      NA  71.4  71.4
# 7      NA  77.4  77.4
# 8      NA  83.4  83.4
# 9      NA  89.4  89.4
# 10     NA  95.4  95.4
# 11     NA 101.4 101.4
# 12     NA 107.4 107.4
# 13     NA 113.4 113.4
# 14     NA 119.4 119.4
# 15     NA 125.4 125.4
# 16     NA 131.4 131.4
# 17     NA 137.4 137.4
# 18     NA 143.4 143.4
# 19     NA 149.4 149.4
# 20     NA 155.4 155.4
# 21     NA 161.4 161.4
# 22     NA 167.4 167.4
# 23     NA 173.4 173.4
# 24     NA 179.4 179.4
# 25     NA 185.4 185.4
# ---------------------------------------------------------------- 
# dat$cus_key: B16
#    fit.na pred fcst
# 1    49.0 49.0 49.0
# 2    47.7 47.7 47.7
# 3    46.4 46.4 46.4
# 4    45.1 45.1 45.1
# 5    43.8 43.8 43.8
# 6      NA 42.5 42.5
# 7      NA 41.2 41.2
# 8      NA 39.9 39.9
# 9      NA 38.6 38.6
# 10     NA 37.3 37.3
# 11     NA 36.0 36.0
# 12     NA 34.7 34.7
# 13     NA 33.4 33.4
# 14     NA 32.1 32.1
# 15     NA 30.8 30.8
# 16     NA 29.5 29.5
# 17     NA 28.2 28.2
# 18     NA 26.9 26.9
# 19     NA 25.6 25.6
# 20     NA 24.3 24.3
# 21     NA 23.0 23.0
# 22     NA 21.7 21.7
# 23     NA 20.4 20.4
# 24     NA 19.1 19.1
# 25     NA 17.8 17.8
# ---------------------------------------------------------------- 
# dat$cus_key: C12
#    fit.na  pred  fcst
# 1    56.4  56.4  56.4
# 2    53.2  53.2  53.2
# 3    50.0  50.0  50.0
# 4    46.8  46.8  46.8
# 5    43.6  43.6  43.6
# 6      NA  40.4  40.4
# 7      NA  37.2  37.2
# 8      NA  34.0  34.0
# 9      NA  30.8  30.8
# 10     NA  27.6  27.6
# 11     NA  24.4  24.4
# 12     NA  21.2  21.2
# 13     NA  18.0  18.0
# 14     NA  14.8  14.8
# 15     NA  11.6  11.6
# 16     NA   8.4   8.4
# 17     NA   5.2   5.2
# 18     NA   2.0   2.0
# 19     NA  -1.2  -1.2
# 20     NA  -4.4  -4.4
# 21     NA  -7.6  -7.6
# 22     NA -10.8 -10.8
# 23     NA -14.0 -14.0
# 24     NA -17.2 -17.2
# 25     NA -20.4 -20.4

如您所见，预测和预测产生相同的值，因为在这种情况下，这两种方法都基于同一个解释变量 date。

玩具数据：

set.seed(42)
dat <- transform(expand.grid(cus_key=paste0(LETTERS[1:3], sample(12:43, 3)),
                             date=seq.Date(as.Date("2018-05-13"), length.out=5, by="week")),
                 sales=sample(20:80, 15, replace=TRUE))

【讨论】：