create_random_detail_plot <- function(df, window_name, random_pct, comparison_type) {
df_plot <- df |>
filter(window == window_name, !is.na(f1)) |>
mutate(
model_lt = paste0(str_remove(forecast_source, "INSIVUMEH_"), " (LT", leadtime, ")"),
model_lt = fct_reorder(model_lt, f1)
)
if (comparison_type == "native") {
pct_data <- random_pct |> filter(window == window_name)
caption_text <- paste0("Based on ", N_BOOTSTRAP, " bootstrap simulations.\n",
"SEAS5 vs ERA5; INSIVUMEH vs ENACTS.")
} else {
pct_data <- random_pct |> filter(window == window_name, obs_source == "ENACTS")
caption_text <- paste0("Based on ", N_BOOTSTRAP, " bootstrap simulations.\n",
"All models vs ENACTS.")
}
p90 <- max(pct_data$p90)
p50 <- mean(pct_data$p50)
ggplot(df_plot, aes(x = f1, y = model_lt)) +
annotate("rect", xmin = 0, xmax = p90, ymin = -Inf, ymax = Inf,
fill = "#FDDBC7", alpha = 0.7) +
geom_vline(xintercept = p50, linetype = "dashed", color = "#B2182B", linewidth = 0.8) +
geom_segment(aes(x = 0, xend = f1, yend = model_lt), color = "grey60") +
geom_point(aes(color = significant), size = 4) +
geom_text(aes(label = paste0(round(pct_beats_random), "%")),
hjust = -0.3, size = 3) +
scale_x_continuous(limits = c(0, 1), labels = scales::percent, expand = c(0, 0.15)) +
scale_color_manual(
values = c("TRUE" = "#1A9850", "FALSE" = "grey50"),
labels = c("TRUE" = "Beats random (p<0.10)", "FALSE" = "Within random range"),
name = NULL
) +
labs(
title = paste0("Does forecast beat random guessing? (", str_to_title(window_name), ")"),
subtitle = "Red zone = random guessing range (90%). Labels = % of simulations beaten.",
x = "F1 Score",
y = NULL,
caption = caption_text
) +
theme_minimal() +
theme(
legend.position = "bottom",
plot.caption = element_text(hjust = 0),
panel.grid.major.y = element_blank()
)
}
create_random_summary_plot <- function(df_comparison, random_pct, comparison_type) {
df_summary <- df_comparison |>
group_by(forecast_source, window) |>
summarise(
avg_f1 = mean(f1, na.rm = TRUE),
n_leadtimes = n(),
n_significant = sum(significant),
.groups = "drop"
) |>
mutate(
window = factor(window, levels = c("primera", "postrera")),
model_short = str_remove(forecast_source, "INSIVUMEH_"),
label = paste0(n_significant, "/", n_leadtimes, " LTs significant")
)
if (comparison_type == "native") {
p90_max <- max(random_pct$p90)
p50_avg <- mean(random_pct$p50)
caption_text <- "SEAS5 vs ERA5; INSIVUMEH vs ENACTS."
} else {
pct_enacts <- random_pct |> filter(obs_source == "ENACTS")
p90_max <- max(pct_enacts$p90)
p50_avg <- mean(pct_enacts$p50)
caption_text <- "All models vs ENACTS."
}
ggplot(df_summary, aes(x = avg_f1, y = model_short)) +
annotate("rect", xmin = 0, xmax = p90_max, ymin = -Inf, ymax = Inf,
fill = "#FDDBC7", alpha = 0.7) +
geom_vline(xintercept = p50_avg, linetype = "dashed", color = "#B2182B", linewidth = 0.8) +
geom_segment(aes(x = 0, xend = avg_f1, yend = model_short), color = "grey60") +
geom_point(size = 4, color = "#007CE1") +
geom_text(aes(label = label), hjust = -0.1, size = 3) +
facet_wrap(~str_to_title(window), ncol = 1) +
scale_x_continuous(limits = c(0, 1), labels = scales::percent, expand = c(0, 0.15)) +
labs(
title = "Average F1 by model",
subtitle = "Red zone = random guessing range. Labels = leadtimes with significant skill.",
x = "Average F1 Score",
y = NULL,
caption = caption_text
) +
theme_minimal() +
theme(
legend.position = "none",
plot.caption = element_text(hjust = 0),
panel.grid.major.y = element_blank(),
strip.text = element_text(face = "bold", size = 11)
)
}
