代码之家 › 专栏 › 技术社区 › Hydro

R?

ensemble-learning predict regression ggplot2 r

Hydro · 技术社区 · 5 年前

predict 六月至九月 Level 对于 Year 2020 multiple linear regression model plot May 31 ,显示为实心黑线和 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")

我的目标

我想用 fitted model 到 predic 2020 假设这么多年来 DF 会重演(不仅仅是2016年),然后 情节 多年来在哪里 Forecasted 场景(六月到九月)以不同的颜色显示-如下所示

0 回复 | 直到 5 年前

TimTeaFan 5 年前

下面的代码应该能满足您的需要(如果我理解正确的话)。然而,这张图仍然很混乱。

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)

^{reprex package

(0.3.0版)}