Многоступенчатое прогнозирование с dplyr и do

Функция do в dplyr позволяет вам делать много классных моделей быстро и легко, но я стараюсь использовать эти модели для хороших прогнозов прокатки.

# Data illustration

require(dplyr)
require(forecast)

df <- data.frame(
  Date = seq.POSIXt(from = as.POSIXct("2015-01-01 00:00:00"), 
                    to = as.POSIXct("2015-06-30 00:00:00"), by = "hour"))

  df <- df %>% mutate(Hour = as.numeric(format(Date, "%H")) + 1, 
                      Wind = runif(4320, min = 1, max = 5000), 
                      Temp = runif(4320, min = - 20, max = 25), 
                      Price = runif(4320, min = -15, max = 45)
                      )

Моя переменная-фактор Hour, мои экзогенные переменные Wind и temp, и то, что я хочу прогнозировать, Price. Итак, в основном, у меня есть 24 модели, с которыми мне хотелось бы иметь возможность делать скользящие прогнозы.

Теперь мой фрейм данных содержит 180 дней. Я хотел бы вернуться на 100 дней и сделать прогноз на 1 день, а затем сравнить его с фактическим Price.

Выполнение этой грубой силы будет выглядеть примерно так:

# First I fit the data frame to be exactly the right length
# 100 days to start with (2015-03-21 or so), then 99, then 98.., etc. 
n <- 100 * 24

# Make the price <- NA so I can replace it with a forecast
df$Price[(nrow(df) - n): (nrow(df) - n + 24)] <- NA

# Now I make df just 81 days long, the estimation period + the first forecast
df <- df[1 : (nrow(df) - n + 24), ]

# The actual do & fit, later termed fx(df)

result <- df %>% group_by(Hour) %>% do ({
  historical <- .[!is.na(.$Price), ]
  forecasted <- .[is.na(.$Price), c("Date", "Hour", "Wind", "Temp")]
  fit <- Arima(historical$Price, xreg = historical[, 3:4], order = c(1, 1, 0))
  data.frame(forecasted[], 
             Price = forecast.Arima(fit, xreg = forecasted[3:4])$mean )
})

result

Теперь я бы изменил n на 99 * 24. Но было бы здорово иметь это в цикле или применять, но я просто не могу понять, как это сделать, а также сохранить каждый новый прогноз.

Я пробовал такой цикл, но еще не получилось:

# 100 days ago, forecast that day, then the next, etc.
for (n in 1:100) { 
  nx <- n * 24 * 80         # Because I want to start after 80 days
  df[nx:(nx + 23), 5] <- NA # Set prices to NA so I can forecast them
  fx(df) # do the function
  df.results[n] <- # Write the results into a vector / data frame to save them
    # and now rinse and repeat for n + 1
  }

Поистине удивительные бонусные очки для broom -подобного решения:)

Ответ 1

Я начну, заметив, что в вашем цикле for есть ошибка. Вместо n*24*80 вы, вероятно, имели в виду (n+80)*24. Счетчик в вашем цикле также должен перейти от 0 до 99 вместо 1 к 100, если вы хотите включить прогноз на 81-й день.

Я попытаюсь предоставить элегантное решение для вашей проблемы ниже. Во-первых, мы определяем наш тестовый файл данных точно так же, как вы сделали в своем сообщении:

set.seed(2)
df <- data.frame(
Date = seq.POSIXt(from = as.POSIXct("2015-01-01 00:00:00"), 
                    to = as.POSIXct("2015-06-30 00:00:00"), by = "hour"))
df <- df %>% mutate(Hour = as.numeric(format(Date, "%H")) + 1, 
                    Wind = runif(4320, min = 1, max = 5000), 
                    Temp = runif(4320, min = - 20, max = 25), 
                    Price = runif(4320, min = -15, max = 45)
)

Далее мы определяем функцию, которая выполняет прогноз на один конкретный день. Входные аргументы - это рассматриваемый блок данных и минимальное количество дней обучения, которые должны быть в тренировочном наборе (в этом примере - 80). minTrainingDays+offSet+1 представляет собой фактический день, который мы предсказываем. Обратите внимание, что мы начинаем отсчет с 0 для смещения.

forecastOneDay <- function(theData,minTrainingDays,offset)
{
  nrTrainingRows <- (minTrainingDays+offset)*24

  theForecast <- theData %>% 
    filter(min_rank(Date) <= nrTrainingRows+24) %>% # Drop future data that we don't need
    group_by(Hour) %>%
    do ({
      trainingData <- head(.,-1) # For each group, drop the last entry from the dataframe
      forecastData <- tail(.,1) %>% select(Date,Hour,Wind,Temp) # For each group, predict the last entry
      fit <- Arima(trainingData$Price, xreg=trainingData[,3:4], order=c(1,1,0))
      data.frame(forecastData, realPrice = tail(.,1)$Price, predictedPrice = forecast.Arima(fit,xreg=forecastData[3:4])$mean)
    })
}

Мы хотим предсказать дни 81-180. Другими словами, нам нужно как минимум 80 дней в нашем учебном наборе и хотим вычислить результаты функции для смещений 0:99. Это может быть выполнено с помощью простого вызова lapply. Начнем с объединения всех результатов в кадре данных:

# Perform one day forecasts for days 81-180
resultList <- lapply(0:99, function(x) forecastOneDay(df,80,x))
# Merge all the results
mergedForecasts <- do.call("rbind",resultList)

ИЗМЕНИТЬ После рассмотрения вашего сообщения и другого ответа, который был опубликован, я заметил две потенциальные проблемы с моим ответом. Во-первых, вам понадобилось окно roll из 80 дней обучения. Тем не менее, в моем предыдущем коде все имеющиеся учебные данные используются для соответствия модели, а не возврата только 80 дней. Во-вторых, код не является надежным для изменений DST.

Эти два вопроса исправлены в приведенном ниже коде. Входы функции также более интуитивно понятны: число дней обучения и фактический предсказанный день можно использовать в качестве входных мер. Обратите внимание, что формат данных POSIXlt правильно обрабатывает такие вещи, как DST, високосные годы и т.д. При выполнении операций с датами. Поскольку даты в вашем фреймворке имеют тип POSIXct, нам нужно сделать небольшое преобразование типа назад и вперед, чтобы правильно обрабатывать вещи.

Новый код ниже:

forecastOneDay <- function(theData,nrTrainingDays,predictDay) # predictDay should be greater than nrTrainingDays
{
  initialDate <- as.POSIXlt(theData$Date[1]); # First day (midnight hour)
  startDate <- initialDate # Beginning of training interval
  endDate <- initialDate # End of test interval

  startDate$mday <- initialDate$mday + (predictDay-nrTrainingDays-1) # Go back 80 days from predictday
  endDate$mday <- startDate$mday + (nrTrainingDays+1) # +1 to include prediction day

  theForecast <- theData %>% 
    filter(Date >= as.POSIXct(startDate),Date < as.POSIXct(endDate)) %>% 
    group_by(Hour) %>%
    do ({
      trainingData <- head(.,-1) # For each group, drop the last entry from the dataframe
      forecastData <- tail(.,1) %>% select(Date,Hour,Wind,Temp) # For each group, predict the last entry
      fit <- Arima(trainingData$Price, xreg=trainingData[,3:4], order=c(1,1,0))
      data.frame(forecastData, realPrice = tail(.,1)$Price, predictedPrice = forecast.Arima(fit,xreg=forecastData[3:4])$mean)
    })
}

# Perform one day forecasts for days 81-180
resultList <- lapply(81:180, function(x) forecastOneDay(df,80,x))
# Merge all the results
mergedForecasts <- do.call("rbind",resultList)

Результаты выглядят следующим образом:

> head(mergedForecasts)
Source: local data frame [6 x 6]
Groups: Hour

                 Date Hour     Wind      Temp  realPrice predictedPrice
1 2015-03-22 00:00:00    1 1691.589 -8.722152 -11.207139       5.918541
2 2015-03-22 01:00:00    2 1790.928 18.098358   3.902686      37.885532
3 2015-03-22 02:00:00    3 1457.195 10.166422  22.193270      34.984164
4 2015-03-22 03:00:00    4 1414.502  4.993783   6.370435      12.037642
5 2015-03-22 04:00:00    5 3020.755  9.540715  25.440357      -1.030102
6 2015-03-22 05:00:00    6 4102.651  2.446729  33.528199      39.607848
> tail(mergedForecasts)
Source: local data frame [6 x 6]
Groups: Hour

                 Date Hour      Wind       Temp  realPrice predictedPrice
1 2015-06-29 18:00:00   19 1521.9609 13.6414797  12.884175     -6.7789109
2 2015-06-29 19:00:00   20  555.1534  3.4758159  37.958768     -5.1193514
3 2015-06-29 20:00:00   21 4337.6605  4.7242352  -9.244882     33.6817379
4 2015-06-29 21:00:00   22 3140.1531  0.8127839  15.825230     -0.4625457
5 2015-06-29 22:00:00   23 1389.0330 20.4667234 -14.802268     15.6755880
6 2015-06-29 23:00:00   24  763.0704  9.1646139  23.407525      3.8214642

Ответ 2

Можно создать "катящийся" data.frame с dplyr следующим образом

library(dplyr)
library(lubridate)

WINDOW_SIZE_DAYS <- 80

df2 <- df %>%
  mutate(Day = yday(Date)) %>%
  replicate( n = WINDOW_SIZE_DAYS, simplify = FALSE ) %>% 
  bind_rows %>%
  group_by(Date) %>%
  mutate(Replica_Num = 1:n() ) %>%
  mutate(Day_Group_id = Day + Replica_Num - 1 ) %>%
  ungroup() %>%
  group_by(Day_Group_id) %>%
  filter( n() >= 24*WINDOW_SIZE_DAYS - 1 ) %>%
  select( -Replica_Num ) %>%
  arrange(Date) %>%
  ungroup()

В принципе, этот код реплицирует наблюдения по мере необходимости и назначает соответствующий Day_Group_id каждому 80-дневному фрагменту. Это позволяет использовать group_by(Day_Group_id) для запуска модели отдельно для каждого 80-дневного фрагмента.

Впоследствии его можно использовать по желанию. Например, просто скопируйте/вставьте код аримы сверху следующим образом:

df3 <- df2 %>%
  group_by(Day_Group_id, Hour) %>%
  arrange(Date) %>%
  do ({
    trainingData <- head(.,-1) # For each group, drop the last entry from the dataframe
    forecastData <- tail(.,1) %>% select(Date,Hour,Wind,Temp) # For each group, predict the last entry
    fit <- Arima(trainingData$Price, xreg=trainingData[,3:4], order=c(1,1,0))
    data.frame(forecastData, realPrice = tail(.,1)$Price, predictedPrice = forecast.Arima(fit,xreg=forecastData[3:4])$mean)
  })

Обратите внимание:

Здесь используется filter(n() >= 24*WINDOW_SIZE_DAYS - 1) вместо filter(n() == 24*WINDOW_SIZE_DAYS), чтобы выбрать полные 80-дневные окна. Это происходит из-за регулировки времени летнего времени на 2015-03-08. Час 2015-03-08 02:00:00 не существует в наборе данных, поскольку он перескакивает с 2015-03-08 01:00:00 прямо на 2015-03-08 03:00:00.