Question

我有一个数据框，其中包含多个（千）个不等长的每月时间序列，并由一个非连续的id变量分隔。数据集看起来像这样，

id1 <- rep(12, 60)
ds1 <- seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "month")
value1 <- sample(60)

id2 <- rep(132, 48)
ds2 <- seq(as.Date("2015-01-01"), as.Date("2018-12-31"), by = "month")
value2 <- sample(48)

id3 <- rep(210, 72)
ds3 <- seq(as.Date("2013-01-01"), as.Date("2018-12-31"), by = "month")
value3 <- sample(72)

id <- c(id1, id2, id3)
ds <- c(ds1, ds2, ds3)
y <- c(value1, value2, value3)

df <- data.frame(id, ds, y)
> head(df)
  id         ds  y
1 12 2014-01-01 51
2 12 2014-02-01 22
3 12 2014-03-01 34
4 12 2014-04-01 53
5 12 2014-05-01 26
6 12 2014-06-01 56

我想在每个由id分隔的时间序列上运行先知预测模型，并生成一个数据帧，该数据帧具有一个或两个诊断统计数据的提前一个月的预测。该数据框的行应以id变量开头，即。第一列应为ID。

对于单个id情况，该过程如下所示

library(prophet)
set.seed(1234)

id <- rep(23, 60)
ds <- seq(as.Date("2014-01-01"), as.Date("2018-12-31"), by = "month")
y <- sample(60)
df <- data.frame(ds, y)

m <- prophet(df, seasonality.mode = 'multiplicative')
future <- make_future_dataframe(m, periods = 1)
fcst <- predict(m, future)
last_fcst <- fcst[61,]
mse <- mean((df$y - fcst$yhat[c(1:60)])^2)
mae <- mean(abs((df$y - fcst$yhat[c(1:60)])))
final <- cbind(last_fcst, mse, mae)
final
> final
           ds    trend multiplicative_terms multiplicative_terms_lower multiplicative_terms_upper     yearly
61 2018-12-02 27.19465           -0.1401155                 -0.1401155                 -0.1401155 -0.1401155
   yearly_lower yearly_upper additive_terms additive_terms_lower additive_terms_upper yhat_lower yhat_upper
61   -0.1401155   -0.1401155              0                    0                    0   3.689257   42.66293
   trend_lower trend_upper     yhat      mse      mae
61    27.19465    27.19465 23.38425 242.4414 12.80532

我想重复此过程，并创建一个数据集，每个预测期为一个月，并带有相应的行ID。知道什么是最好的方法吗？

Answer 1

正如我在评论中所说，最好在split()中通过list()标识。这样，您可以使用lapply()或（purrr::map()）进行预测并计算每个ID的指标。

library(prophet)
library(dplyr) # for data wrangling
library(purrr) # for map/map2, equivalents are lapply/mapply from baseR

# preparations
l_df <- df %>% 
  split(.$id)

m_list <- map(l_df, prophet) # prophet call
future_list <- map(m_list, make_future_dataframe, periods = 1) # makes future obs
forecast_list <- map2(m_list, future_list, predict) # map2 because we have two inputs

因此，forecast_list将包含预测的输出，并再次除以id。

只要每个data.frame相等（相同的结构），就可以使用bind_rows(forecast_list)将它们“合并”回df中。

对于指标，我将遵循相同的原则：

# to evaluate the model: create a new list
eval_list <- map2(forecast_list, l_df, function(x,z) {
 # x is the single dataframe of predictions
 # z is the original dataframe with actuals

  x <- x[1:(nrow(x)-1), ] # subset to exclude first true forecast
  x <- x %>% mutate(y_true = (z %>% select(y) %>% pull()) ) # add the column of actual values

})

# metrics evaluation:
eval_list <- map(eval_list, function(x) {
  x <- x %>% 
    summarise(mse = mean((y_true - yhat)^2)) # add more scores
})
# $`12`
# mse
# 1 199.1829
# 
# $`132`
# mse
# 1 156.6394
# 
# $`210`
# mse
# 1 415.9659

如果需要，您可以像使用map2()一样使用eval_list将真实的预测与指标绑定。

先知通过id进行预测并在数据框架中填充提前一个月的预测

1 个答案: