0

我有一个数据框，其中包含多个（数千个）不等长的每月时间序列，由一个非序列 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。知道什么是最好的方法吗？

4

1 回答 1

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使用将它们“合并”回 a 中。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()像我一样使用 foreval_list将真实预测与指标绑定。

于 2019-03-04T10:57:52.187 回答