-
Notifications
You must be signed in to change notification settings - Fork 2
/
plot.R
59 lines (53 loc) · 2 KB
/
plot.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
plot_nowcast <- function(summarised_nowcast, latest_obs,
max_delay = Inf, ...) {
summarised_nowcast <- summarised_nowcast[
reference_date >= (max(as.Date(nowcast_date)) - max_delay)
]
suppressWarnings(summarised_nowcast[, holiday := NULL])
plot <- epinowcast::enw_plot_nowcast_quantiles(
summarised_nowcast,
latest_obs = latest_obs[
reference_date >= min(summarised_nowcast$reference_date)][
reference_date <= max(summarised_nowcast$reference_date)
], ...
)
return(plot)
}
plot_scores <- function(scores, ...) {
ggplot2::ggplot(scores) +
ggplot2::aes(...) +
ggplot2::geom_point(size = 1.2) +
ggplot2::geom_line(size = 1.1, alpha = 0.4) +
ggplot2::scale_fill_brewer(palette = "Paired") +
ggplot2::scale_color_brewer(palette = "Paired") +
labs(y = "Weighted interval score") +
theme_bw() +
theme(legend.position = "bottom") +
guides(fill = guide_legend(title = "Model", nrow = 4),
col = guide_legend(title = "Model", nrow = 4))
}
plot_relative_scores <- function(score, baseline) {
score <- data.table::as.data.table(score)
fixed_score <- score[
model %in% baseline,
.(reference_date, age_group, fixed_is = interval_score)
]
score <- merge(score, fixed_score, by = c("reference_date", "age_group"))
score <- score[, interval_score := interval_score / fixed_is]
score <- score[!model %in% baseline]
plot <- ggplot(score) +
aes(x = reference_date, y = interval_score, col = model) +
geom_hline(yintercept = 1, linetype = 2, size = 1.2, alpha = 0.5) +
geom_line(size = 1.1, alpha = 0.6) +
geom_point(size = 1.2) +
facet_wrap(vars(age_group)) +
scale_color_brewer(palette = "Paired") +
scale_y_log10(labels = scales::percent)
plot <- enw_plot_theme(plot) +
labs(
x = "Reference date",
y = paste0("Weighted interval score (", baseline, ")")
) + # nolint
guides(col = guide_legend(title = "Model", ncol = 2))
return(plot[])
}