Прогнозирование пророка по идентификатору и заполнение фрейма данных прогнозами на месяц вперед

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.

Для случая с одним идентификатором процедура выглядит следующим образом:

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

Я хочу повторить эту процедуру и создать набор данных с каждым месячным прогнозом с соответствующими им идентификаторами строк.Есть идеи, как лучше это сделать?

Answer 1

Как я уже сказал в комментариях, лучше всего split() по id в list().Таким образом, вы можете использовать lapply() или (purrr::map()), чтобы делать прогнозы и вычислять метрики для каждого идентификатора.

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 будет содержать выходные данные из прогноза, снова разделенные наЯ бы.

Вы можете "объединить" их обратно в 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, чтобы связать истинный прогноз с метриками, если хотите.