Модель множественной линейной регрессии вместе с ансамблем ggplot в R?

Question

Я пытаюсь predict июнь - сентябрь Level для Year 2020, используя multiple linear regression model. В моем примере ниже я предполагаю, что условия 2016 года будут повторяться, и использую его для прогнозирования уровня с июня по сентябрь на 2020 год. I plot наблюдаемый уровень до May 31, показанный как solid черной линией и Forecasted Level показано синей пунктирной линией.

library(tidyverse)
library(lubridate)

set.seed(1500)

DF <- data.frame(Date = seq(as.Date("2000-01-01"), to = as.Date("2018-12-31"), by = "days"),
                 Level = runif(6940, 360, 366), Flow = runif(6940, 1,10),
                 PCP = runif(6940, 0,25), MeanT = runif(6940, 1, 30)) %>% 
                  mutate(Year = year(Date), Month = month(Date), Day = day(Date)) %>% 
                  filter(between(Month, 6, 9))
Model <- lm(data = DF, Level~Flow+PCP+MeanT)
Yr_2016 <- DF %>%
  filter(Year == 2016) %>% 
  select(c(3:5)) 
Pred2020 <- data.frame(Date = seq(as.Date("2020-06-01"), to = as.Date("2020-9-30"), by = "days"),
                       Forecast = predict(Model, Yr_2016))
  
Obs2020 <- data.frame(Date = seq(as.Date("2020-01-01"), to = as.Date("2020-05-31"), by = "days"),
                      Level = runif(152, 360, 366))

ggplot(data = Obs2020, aes(x = Date, y = Level), col = "black")+
  geom_line(size = 2)+
  geom_line(data = Pred2020, aes(x = Date, y = Forecast), linetype = "dashed")

My goal

I want to use the fitted model to predict June - Sep for the year 2020 assuming that all the years in DF will repeat itself (not just the year 2016) and then have a plot where all the years Forecasted scenarios (June -Sep) are shown in different colours - something like below

введите описание изображения здесь

Answer 1

новый ответ

Приведенный ниже код должен делать то, что вы ищете (если я правильно понял). График, однако, по-прежнему хаотичный c.

library(tidyverse)
library(lubridate)

set.seed(1500)

DF <- data.frame(Date = seq(as.Date("2000-01-01"), to = as.Date("2018-12-31"), by = "days"),
                 Level = runif(6940, 360, 366), Flow = runif(6940, 1,10),
                 PCP = runif(6940, 0,25), MeanT = runif(6940, 1, 30)) %>% 
  mutate(Year = year(Date), Month = month(Date), Day = day(Date)) %>% 
  filter(between(Month, 6, 9))

Model <- lm(data = DF, Level ~ Flow + PCP + MeanT)

Obs2020 <- data.frame(Date = seq(as.Date("2020-01-01"),
                                 to = as.Date("2020-05-31"),
                                 by = "days"),
                      Level = runif(152, 362.7, 363.25))
pred_data <- DF %>% 
  nest_by(Year) %>% 
  mutate(pred_df = list(tibble(Date = seq(as.Date("2020-06-01"),
                                          to = as.Date("2020-09-30"),
                                          by = "days"),
                               Forecast = predict(.env$Model, data)))) %>%
  select(Year, pred_df) %>% 
  unnest(pred_df) 

ggplot(data = Obs2020, aes(x = Date, y = Level), col = "black") +
  geom_line(size = 0.1) +
  geom_line(data = pred_data,
            aes(x = Date, y = Forecast, group = factor(Year), color = factor(Year)),
            size = 0.1)

^{Created on 2020-06-20 by the пакет реплекс (v0.3.0)}