Add ngas paper plot

2025-05-31 16:23:03 +02:00
parent 9c90536f9f
commit 3e58060e75
1 changed files with 308 additions and 3 deletions
--- a/index.qmd
+++ b/index.qmd
@@ -85,7 +85,7 @@ BibOptions(
  hyperlink = TRUE,
  dashed = FALSE
 )
-my_bib <- ReadBib("assets/library.bib", check = FALSE)
+source("assets/01_common.R")
 col_lightgray <- "#e7e7e7"
 col_blue <- "#000088"
 col_smooth_expost <- "#a7008b"
@@ -284,6 +284,311 @@ col_yellow <- "#FCE135"
  </tr>
 </table>

+## Overview
+
+
+
+:::: {.columns}
+
+::: {.column width="48%"}
+
+#### Online Distributional Regression
+
+:::
+
+::: {.column width="4%"}
+
+:::
+
+::: {.column width="48%"}
+
+#### Distributional Modeling and Forecasting of Natural Gas Prices
+
+```{r, echo=FALSE, fig.width = 12, fig.height = 6, fig.align="center"}
+load("assets/ngas/residuals.RData")
+
+clr_day_ahead <- cols[5, "green"]
+clr_month_ahead <- cols[5, "blue"]
+
+line_da <- da_data %>%
+  ggplot(aes(y = sresids, x = obs)) +
+  geom_point(col = clr_day_ahead) +
+  geom_line(col = clr_day_ahead) +
+  theme_minimal() +
+  xlab(NULL) +
+  ylab(expression(z[t])) +
+  theme(text = element_text(size = text_size))
+
+acf_da <- forecast::ggAcf(da_data$sresids, size = 1, col = clr_day_ahead) +
+  theme_minimal() +
+  ggtitle("") +
+  theme(text = element_text(size = text_size))
+
+# Density Plot DA
+den_da <- da_data %>%
+  ggplot(aes(x = sresids)) +
+  geom_histogram(aes(y = ..density..), fill = clr_day_ahead) +
+  geom_density(aes(y = ..density..), size = 1) +
+  theme_minimal() +
+  ylab("Density") +
+  xlab(NULL) +
+  theme(text = element_text(size = text_size))
+
+line_ma <- ma_data %>%
+  ggplot(aes(y = sresids, x = obs)) +
+  geom_point(col = clr_month_ahead) +
+  geom_line(col = clr_month_ahead) +
+  theme_minimal() +
+  xlab(NULL) +
+  ylab(expression(z[t])) +
+  theme(text = element_text(size = text_size))
+
+acf_ma <- forecast::ggAcf(ma_data$sresids, size = 1, col = clr_month_ahead) +
+  theme_minimal() +
+  ggtitle("") +
+  theme(text = element_text(size = text_size))
+
+den_ma <- ma_data %>%
+  ggplot(aes(x = sresids)) +
+  geom_histogram(aes(y = after_stat(density)), fill = clr_month_ahead) +
+  geom_density(aes(y = after_stat(density)), size = 1) +
+  theme_minimal() +
+  ylab("Density") +
+  xlab(NULL) +
+  theme(text = element_text(size = text_size))
+
+plots_da <- cowplot::align_plots(line_da, acf_da, line_ma, acf_ma, align = "v", axis = "l")
+
+bottom_row_da <- cowplot::plot_grid(plots_da[[2]], den_da, align = "hv")
+
+plots_ma <- cowplot::align_plots(line_ma, acf_ma, line_ma, acf_ma, align = "v", axis = "l")
+
+bottom_row_ma <- cowplot::plot_grid(plots_ma[[2]], den_ma, align = "hv")
+
+cols_ngas <- c(
+  clr_day_ahead, clr_day_ahead, clr_day_ahead, clr_day_ahead,
+  clr_month_ahead, clr_month_ahead, clr_month_ahead, clr_month_ahead
+)
+
+
+pacfs <- map2(pacfs, cols_ngas, .f = ~ .x %>%
+  mutate(Col = .y)) %>%
+  purrr::reduce(.f = rbind)
+
+var_labs <- c(
+  "Residuals", "Absolute", "Positive", "Negative",
+  "Residuals", "Absolute", "Positive", "Negative"
+)
+
+lvls <- unique(pacfs$Var)
+
+names(var_labs) <- lvls
+
+pacfs <- transform(pacfs,
+  Var = factor(Var,
+    levels = lvls,
+    labels = c(
+      "paste(Residuals, ':',~ z[t])",
+      "paste(Absolute, ':',~ '|', z[t] ,'|')",
+      "paste(Positive, ':',~ '(', z[t],')'^'+')",
+      "paste(Negative, ':',~ '(', z[t],')'^'-')"
+    )
+  )
+)
+
+acfs <- pacfs %>%
+  dplyr::filter(Lag != 0) %>%
+  ggplot(aes(x = Lag)) +
+  geom_linerange(aes(ymin = ymin, ymax = ymax, color = Col), size = 1) +
+  geom_line(aes(y = upper), linetype = "longdash", alpha = 0.5) +
+  geom_line(aes(y = lower), linetype = "longdash", alpha = 0.5) +
+  scale_color_identity() +
+  ylab("ACF") +
+  theme_minimal() +
+  facet_grid(Product ~ Var, labeller = label_parsed) +
+  theme(
+    plot.margin = unit(c(0, 0, 0, 0.2), "cm"),
+    text = element_text(size = text_size),
+    strip.background = element_rect(fill = "grey95", colour = "grey95")
+  )
+
+acfs_da <- pacfs %>%
+  dplyr::filter(Lag != 0 & Product == "Day-Ahead") %>%
+  ggplot(aes(x = Lag)) +
+  geom_linerange(aes(ymin = ymin, ymax = ymax, color = Col), size = 1) +
+  geom_line(aes(y = upper), linetype = "longdash", alpha = 0.5) +
+  geom_line(aes(y = lower), linetype = "longdash", alpha = 0.5) +
+  scale_color_identity() +
+  ylab("ACF") +
+  theme_minimal() +
+  facet_grid(. ~ Var, labeller = label_parsed) +
+  theme(
+    plot.margin = unit(c(0, 0, 0, 0.2), "cm"),
+    text = element_text(size = text_size),
+    strip.background = element_rect(
+      fill = "grey95", colour = "grey95"
+    ),
+    axis.title.x = element_blank(),
+    axis.text.x = element_blank(),
+    axis.ticks.x = element_blank()
+  )
+
+acfs_ma <- pacfs %>%
+  dplyr::filter(Lag != 0 & Product == "Month-Ahead") %>%
+  ggplot(aes(x = Lag)) +
+  geom_linerange(aes(ymin = ymin, ymax = ymax, color = Col), size = 1) +
+  geom_line(aes(y = upper), linetype = "longdash", alpha = 0.5) +
+  geom_line(aes(y = lower), linetype = "longdash", alpha = 0.5) +
+  scale_color_identity() +
+  ylab("ACF") +
+  theme_minimal() +
+  scale_x_continuous(breaks = c(1, 10, 20, 30, 40)) +
+  facet_grid(. ~ Var, labeller = label_parsed) +
+  theme(
+    plot.margin = unit(c(0, 0, 0, 0.2), "cm"),
+    text = element_text(size = text_size),
+    strip.background = element_blank(), strip.text = element_blank()
+  )
+
+plots_da <- cowplot::align_plots(acfs_da, line_da, line_ma, acf_ma, align = "hv", axis = "l")
+
+bottom_row_da <- cowplot::plot_grid(
+  plots_da[[2]], den_da,
+  align = "hv",
+  rel_widths = c(0.66, 0.33)
+)
+
+da_plots <- cowplot::plot_grid(plots_da[[1]], bottom_row_da, nrow = 2)
+
+plots_ma <- cowplot::align_plots(acfs_ma, line_ma, line_ma, acf_ma, align = "hv", axis = "l")
+
+bottom_row_ma <- cowplot::plot_grid(
+  plots_ma[[2]],
+  den_ma,
+  align = "hv",
+  rel_widths = c(0.66, 0.33)
+)
+
+cowplot::plot_grid(
+  bottom_row_da,
+  bottom_row_ma,
+  acfs_da,
+  acfs_ma,
+  ncol = 1,
+  rel_heights = c(0.2, 0.2, 0.3, 0.3)
+)
+```
+
+:::
+
+::::
+
+## Overview
+
+:::: {.columns}
+
+::: {.column width="48%"}
+
+#### High-Resolution Peak Demand Estimation Using Generalized Additive Models and Deep Neural Networks
+
+```{r, echo=FALSE, fig.width = 12, fig.height = 6, fig.align="center"}
+load("assets/minmaxload/plot_overview.rds")
+# linesize <- 1.2
+ggplot() +
+  geom_line(
+    data = plot_df[plot_df$var == "1high_res_load", ],
+    aes(
+      x = time,
+      y = value,
+      colour = var
+    ),
+    linewidth = linesize
+  ) +
+  geom_line(
+    data = plot_df[plot_df$var == "2low_res", ],
+    aes(
+      x = time,
+      y = value,
+      colour = var
+    ),
+    linewidth = linesize
+  ) +
+  geom_line(
+    data = plot_df[plot_df$var == "4max", ],
+    aes(
+      x = time,
+      y = value,
+      colour = var
+    ),
+    linewidth = linesize
+  ) +
+  geom_line(
+    data = plot_df[plot_df$var == "3min", ],
+    aes(
+      x = time,
+      y = value,
+      colour = var
+    ),
+    linewidth = linesize
+  ) +
+  scale_color_manual(
+    values = as.character(c(
+      cols[4, col_load],
+      cols[9, col_load],
+      cols[8, col_min],
+      cols[8, col_max]
+    )),
+    labels = c(
+      "High-Resolution Load",
+      "Low-Resolution Load",
+      "Minimum",
+      "Maximum"
+    )
+  ) +
+  guides(color = guide_legend(
+    override.aes = list(size = 2)
+  )) +
+  theme_minimal() +
+  ylab("Load [MW]") +
+  xlab("Time") +
+  theme(
+    zoom.x = element_rect(fill = cols[4, "grey"], colour = NA),
+    legend.position = "bottom",
+    legend.title = element_blank(),
+    text = element_text(
+      size = text_size + 2,
+    ),
+    validate = FALSE
+  ) +
+  scale_y_continuous(breaks = seq(-1.5, 1.0, 0.5)) +
+  ggforce::facet_zoom(
+    xlim = c(
+      as.POSIXct("2021-07-24 12:00:00", tz = "UTC"),
+      as.POSIXct("2021-07-24 19:00:00", tz = "UTC")
+    ),
+    zoom.size = 2,
+    ylim = c(-.9, 1),
+    split = FALSE,
+    horizontal = FALSE,
+    show.area = TRUE
+  )
+```
+
+:::
+
+::: {.column width="4%"}
+
+:::
+
+::: {.column width="48%"}
+
+#### rcpptimer: Rcpp Tic-Toc Timer with OpenMP Support
+
+:::
+
+::::
+
+
 # CRPS Learning

 Berrisch, J., & Ziel, F. [-@BERRISCH2023105221]. *Journal of Econometrics*, 237(2), 105221.
@@ -587,7 +892,7 @@ Du kannst dann auch easy darauf verweisen: \ref{eq:exp_combination}.

 ### Optimality

-In stochastic settings, the cumulative Risk should be analyzed `r Citet(my_bib, "wintenberger2017optimal")`:
+In stochastic settings, the cumulative Risk should be analyzed @wintenberger2017optimal:
 \begin{align}
    &\underbrace{\widetilde{\mathcal{R}}_t = \sum_{i=1}^t \mathbb{E}[\ell(\widetilde{X}_{i},Y_i)|\mathcal{F}_{i-1}]}_{\text{Cumulative Risk of Forecaster}} \\
    &\underbrace{\widehat{\mathcal{R}}_{t,k} = \sum_{i=1}^t \mathbb{E}[\ell(\widehat{X}_{i,k},Y_i)|\mathcal{F}_{i-1}]}_{\text{Cumulative Risk of Experts}}
@@ -629,7 +934,7 @@ The forecaster is asymptotically not worse than the best convex combination $\wi

 ::: {.column width="48%"}

-Optimal rates with respect to selection \eqref{eq_opt_select} and convex aggregation \eqref{eq_opt_conv}  `r Citet(my_bib, "wintenberger2017optimal")`: 
+Optimal rates with respect to selection \eqref{eq_opt_select} and convex aggregation \eqref{eq_opt_conv}  @wintenberger2017optimal: 


 \begin{align}