From c7fade43569b94261656cb6d259ef88153c059b6 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Fri, 20 Sep 2024 08:08:33 +0200 Subject: [PATCH 1/5] remove ggdist from Suggests --- DESCRIPTION | 1 - man/get_metrics.forecast_point.Rd | 2 +- 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index f15bcf91..02e111a5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -62,7 +62,6 @@ Imports: scoringRules, stats Suggests: - ggdist, kableExtra, knitr, magrittr, diff --git a/man/get_metrics.forecast_point.Rd b/man/get_metrics.forecast_point.Rd index 4bc4dae2..43f8143e 100644 --- a/man/get_metrics.forecast_point.Rd +++ b/man/get_metrics.forecast_point.Rd @@ -34,7 +34,7 @@ The mean squared error, for example, is only a meaningful scoring rule if the forecaster actually reported the mean of their predictive distribution as a point forecast. If the forecaster reported the median, then the mean absolute error would be the appropriate scoring rule. If the scoring rule -and the predictive task do not align, misleading results ensue. +and the predictive task do not align, the results will be misleading. Failure to respect this correspondence can lead to grossly misleading results! Consider the example in the section below. From ba045f315190670bbd03b8791337acdb0cd1742a Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Fri, 20 Sep 2024 08:18:37 +0200 Subject: [PATCH 2/5] Comment out code --- vignettes/Deprecated-visualisations.Rmd | 337 ++++++++++++------------ 1 file changed, 170 insertions(+), 167 deletions(-) diff --git a/vignettes/Deprecated-visualisations.Rmd b/vignettes/Deprecated-visualisations.Rmd index 9fab9ce5..217a8054 100644 --- a/vignettes/Deprecated-visualisations.Rmd +++ b/vignettes/Deprecated-visualisations.Rmd @@ -26,7 +26,6 @@ The example data used is the data shipped with the `scoringutils` package. It co library(scoringutils) library(data.table) library(ggplot2) -library(ggdist) library(magrittr) library(magrittr) #pipe operator ``` @@ -98,123 +97,127 @@ In previous versions of `scoringutils`, forecasts and observed values could be v #" facet_wrap(~ location + target_type, scales = "free_y") + #" aes(fill = model, color = model) -plot_predictions <- function(data, - by = NULL, - x = "date", - interval_range = c(0, 50, 90)) { - - # split truth data and forecasts in order to apply different filtering - truth_data <- data.table::as.data.table(data)[!is.na(observed)] - forecasts <- data.table::as.data.table(data)[!is.na(predicted)] - - del_cols <- - colnames(truth_data)[!(colnames(truth_data) %in% c(by, "observed", x))] - - truth_data <- unique(suppressWarnings(truth_data[, eval(del_cols) := NULL])) - - # find out what type of predictions we have. convert sample based to - # interval range data - - if ("quantile_level" %in% colnames(data)) { - forecasts <- scoringutils:::quantile_to_interval( - forecasts, - keep_quantile_col = FALSE - ) - } else if ("sample_id" %in% colnames(data)) { - # using a scoringutils internal function - forecasts <- scoringutils:::sample_to_interval_long( - as_forecast_sample(forecasts), - interval_range = interval_range, - keep_quantile_col = FALSE - ) - } - - # select appropriate boundaries and pivot wider - select <- forecasts$interval_range %in% setdiff(interval_range, 0) - intervals <- forecasts[select, ] - - # delete quantile column in intervals if present. This is important for - # pivoting - if ("quantile_level" %in% names(intervals)) { - intervals[, quantile_level := NULL] - } - - plot <- ggplot(data = data, aes(x = .data[[x]])) + - theme_scoringutils() + - ylab("True and predicted values") - - if (nrow(intervals) != 0) { - # pivot wider and convert range to a factor - intervals <- data.table::dcast(intervals, ... ~ boundary, - value.var = "predicted") - - # only plot interval ranges if there are interval ranges to plot - plot <- plot + - ggdist::geom_lineribbon( - data = intervals, - aes( - ymin = lower, ymax = upper, - # We use the fill_ramp aesthetic for this instead of the default fill - # because we want to keep fill to be able to use it for other - # variables - fill_ramp = factor( - interval_range, - levels = sort(unique(interval_range), decreasing = TRUE) - ) - ), - lwd = 0.4 - ) + - ggdist::scale_fill_ramp_discrete( - name = "interval_range", - # range argument was added to make sure that the line for the median - # and the ribbon don"t have the same opacity, making the line - # invisible - range = c(0.15, 0.75) - ) - } - # We could treat this step as part of ggdist::geom_lineribbon() but we treat - # it separately here to deal with the case when only the median is provided - # (in which case ggdist::geom_lineribbon() will fail) - if (0 %in% interval_range) { - select_median <- - forecasts$interval_range == 0 & forecasts$boundary == "lower" - median <- forecasts[select_median] - - if (nrow(median) > 0) { - plot <- plot + - geom_line( - data = median, - mapping = aes(y = predicted), - lwd = 0.4 - ) - } - } - - # add observed values - if (nrow(truth_data) > 0) { - plot <- plot + - geom_point( - data = truth_data, - show.legend = FALSE, - inherit.aes = FALSE, - aes(x = .data[[x]], y = observed), - color = "black", - size = 0.5 - ) + - geom_line( - data = truth_data, - inherit.aes = FALSE, - show.legend = FALSE, - aes(x = .data[[x]], y = observed), - linetype = 1, - color = "grey40", - lwd = 0.2 - ) - } - - return(plot) -} +# Code is commented out because `ggdist` requires R version 4.1.0, while +# scoringutils does not. +# library(ggdist) +# plot_predictions <- function(data, +# by = NULL, +# x = "date", +# interval_range = c(0, 50, 90)) { +# +# # split truth data and forecasts in order to apply different filtering +# truth_data <- data.table::as.data.table(data)[!is.na(observed)] +# forecasts <- data.table::as.data.table(data)[!is.na(predicted)] +# +# del_cols <- +# colnames(truth_data)[!(colnames(truth_data) %in% c(by, "observed", x))] +# +# truth_data <- unique(suppressWarnings(truth_data[, eval(del_cols) := NULL])) +# +# # find out what type of predictions we have. convert sample based to +# # interval range data +# +# if ("quantile_level" %in% colnames(data)) { +# forecasts <- scoringutils:::quantile_to_interval( +# forecasts, +# keep_quantile_col = FALSE +# ) +# } else if ("sample_id" %in% colnames(data)) { +# # using a scoringutils internal function +# forecasts <- scoringutils:::sample_to_interval_long( +# as_forecast_sample(forecasts), +# interval_range = interval_range, +# keep_quantile_col = FALSE +# ) +# } +# +# # select appropriate boundaries and pivot wider +# select <- forecasts$interval_range %in% setdiff(interval_range, 0) +# intervals <- forecasts[select, ] +# +# # delete quantile column in intervals if present. This is important for +# # pivoting +# if ("quantile_level" %in% names(intervals)) { +# intervals[, quantile_level := NULL] +# } +# +# plot <- ggplot(data = data, aes(x = .data[[x]])) + +# theme_scoringutils() + +# ylab("True and predicted values") +# +# if (nrow(intervals) != 0) { +# # pivot wider and convert range to a factor +# intervals <- data.table::dcast(intervals, ... ~ boundary, +# value.var = "predicted") +# +# # only plot interval ranges if there are interval ranges to plot +# plot <- plot + +# ggdist::geom_lineribbon( +# data = intervals, +# aes( +# ymin = lower, ymax = upper, +# # We use the fill_ramp aesthetic for this instead of the default fill +# # because we want to keep fill to be able to use it for other +# # variables +# fill_ramp = factor( +# interval_range, +# levels = sort(unique(interval_range), decreasing = TRUE) +# ) +# ), +# lwd = 0.4 +# ) + +# ggdist::scale_fill_ramp_discrete( +# name = "interval_range", +# # range argument was added to make sure that the line for the median +# # and the ribbon don"t have the same opacity, making the line +# # invisible +# range = c(0.15, 0.75) +# ) +# } +# +# # We could treat this step as part of ggdist::geom_lineribbon() but we treat +# # it separately here to deal with the case when only the median is provided +# # (in which case ggdist::geom_lineribbon() will fail) +# if (0 %in% interval_range) { +# select_median <- +# forecasts$interval_range == 0 & forecasts$boundary == "lower" +# median <- forecasts[select_median] +# +# if (nrow(median) > 0) { +# plot <- plot + +# geom_line( +# data = median, +# mapping = aes(y = predicted), +# lwd = 0.4 +# ) +# } +# } +# +# # add observed values +# if (nrow(truth_data) > 0) { +# plot <- plot + +# geom_point( +# data = truth_data, +# show.legend = FALSE, +# inherit.aes = FALSE, +# aes(x = .data[[x]], y = observed), +# color = "black", +# size = 0.5 +# ) + +# geom_line( +# data = truth_data, +# inherit.aes = FALSE, +# show.legend = FALSE, +# aes(x = .data[[x]], y = observed), +# linetype = 1, +# color = "grey40", +# lwd = 0.2 +# ) +# } +# +# return(plot) +# } ``` `plot_predictions()` does the actual work of producing a plot. The `by` argument is needed so that the user can facet the plot correctly and the user needs to specify all columns relevant for facetting. `make_NA()` represents a form of filtering, but instead of filtering entire rows, the relevant entries in the columns "predicted" or "observed" are made `NA`. This allows the user to filter observations and forecasts independently. @@ -278,71 +281,71 @@ In the following are a few examples of using the two functions to create a plot Visualising the median forecasts for the example data. The truth data is restricted to a period between 2021-05-01 and 2021-07-22. The forecast data is a forecast from the model "EuroCOVIDhub-ensemble" made on the "2021-06-07". All other data is set to `NA`, effectively removing it from the plot. ```{r} -median_forecasts <- example_quantile[quantile_level == 0.5] -median_forecasts %>% - make_NA(what = "truth", - target_end_date <= "2021-05-01", - target_end_date > "2021-07-22") %>% - make_NA(what = "forecast", - model != "EuroCOVIDhub-ensemble", - forecast_date != "2021-06-07") %>% - plot_predictions( - by = c("location", "target_type"), - x = "target_end_date" - ) + - facet_wrap(location ~ target_type, scales = "free_y") +# median_forecasts <- example_quantile[quantile_level == 0.5] +# median_forecasts %>% +# make_NA(what = "truth", +# target_end_date <= "2021-05-01", +# target_end_date > "2021-07-22") %>% +# make_NA(what = "forecast", +# model != "EuroCOVIDhub-ensemble", +# forecast_date != "2021-06-07") %>% +# plot_predictions( +# by = c("location", "target_type"), +# x = "target_end_date" +# ) + +# facet_wrap(location ~ target_type, scales = "free_y") ``` This is the same plot, but with a variety of prediction intervals shown, instead of just the median. ```{r} -example_quantile %>% - make_NA(what = "truth", - target_end_date <= "2021-05-01", - target_end_date > "2021-07-22") %>% - make_NA(what = "forecast", - model != "EuroCOVIDhub-ensemble", - forecast_date != "2021-06-07") %>% - plot_predictions( - by = c("location", "target_type"), - x = "target_end_date", - interval_range = c(0, 10, 20, 30, 40, 50, 60) - ) + - facet_wrap(location ~ target_type, scales = "free_y") +# example_quantile %>% +# make_NA(what = "truth", +# target_end_date <= "2021-05-01", +# target_end_date > "2021-07-22") %>% +# make_NA(what = "forecast", +# model != "EuroCOVIDhub-ensemble", +# forecast_date != "2021-06-07") %>% +# plot_predictions( +# by = c("location", "target_type"), +# x = "target_end_date", +# interval_range = c(0, 10, 20, 30, 40, 50, 60) +# ) + +# facet_wrap(location ~ target_type, scales = "free_y") ``` And a similar plot, this time based on continuous forecasts. The predictions are automatically converted to a quantile-based forecasts for plotting. ```{r} -example_sample_continuous %>% - make_NA(what = "truth", - target_end_date <= "2021-05-01", - target_end_date > "2021-07-22") %>% - make_NA(what = "forecast", - model != "EuroCOVIDhub-ensemble", - forecast_date != "2021-06-07") %>% - plot_predictions( - by = c("location", "target_type"), - x = "target_end_date", - interval_range = c(0, 50, 90, 95) - ) + - facet_wrap(location ~ target_type, scales = "free_y") +# example_sample_continuous %>% +# make_NA(what = "truth", +# target_end_date <= "2021-05-01", +# target_end_date > "2021-07-22") %>% +# make_NA(what = "forecast", +# model != "EuroCOVIDhub-ensemble", +# forecast_date != "2021-06-07") %>% +# plot_predictions( +# by = c("location", "target_type"), +# x = "target_end_date", +# interval_range = c(0, 50, 90, 95) +# ) + +# facet_wrap(location ~ target_type, scales = "free_y") ``` Displaying two forecasts at a time with additional colours: ```{r} -example_quantile %>% - make_NA(what = "truth", - target_end_date > "2021-07-15", - target_end_date <= "2021-05-22") %>% - make_NA(what = "forecast", - !(model %in% c("EuroCOVIDhub-ensemble", "EuroCOVIDhub-baseline")), - forecast_date != "2021-06-28") %>% - plot_predictions(x = "target_end_date", by = c("target_type", "location")) + - aes(colour = model, fill = model) + - facet_wrap(target_type ~ location, ncol = 4, scales = "free_y") + - labs(x = "Target end date") +# example_quantile %>% +# make_NA(what = "truth", +# target_end_date > "2021-07-15", +# target_end_date <= "2021-05-22") %>% +# make_NA(what = "forecast", +# !(model %in% c("EuroCOVIDhub-ensemble", "EuroCOVIDhub-baseline")), +# forecast_date != "2021-06-28") %>% +# plot_predictions(x = "target_end_date", by = c("target_type", "location")) + +# aes(colour = model, fill = model) + +# facet_wrap(target_type ~ location, ncol = 4, scales = "free_y") + +# labs(x = "Target end date") ``` From 0727a47ac3fa54457a23cdc69afdd2617de5d2ab Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 23 Sep 2024 17:49:52 +0200 Subject: [PATCH 3/5] put ggdist back in and exclude installation on R 4.0.0 --- .github/workflows/R-CMD-check.yaml | 2 +- DESCRIPTION | 1 + vignettes/Deprecated-visualisations.Rmd | 348 ++++++++++++------------ 3 files changed, 175 insertions(+), 176 deletions(-) diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml index 734ead91..0827abcb 100644 --- a/.github/workflows/R-CMD-check.yaml +++ b/.github/workflows/R-CMD-check.yaml @@ -42,7 +42,7 @@ jobs: - uses: r-lib/actions/setup-r-dependencies@v2 with: - extra-packages: any::rcmdcheck + extra-packages: any::rcmdcheck, ggdist=?ignore-before-r=4.1.0 needs: check - uses: r-lib/actions/check-r-package@v2 diff --git a/DESCRIPTION b/DESCRIPTION index 02e111a5..f15bcf91 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -62,6 +62,7 @@ Imports: scoringRules, stats Suggests: + ggdist, kableExtra, knitr, magrittr, diff --git a/vignettes/Deprecated-visualisations.Rmd b/vignettes/Deprecated-visualisations.Rmd index 217a8054..b072e5ea 100644 --- a/vignettes/Deprecated-visualisations.Rmd +++ b/vignettes/Deprecated-visualisations.Rmd @@ -34,7 +34,7 @@ library(magrittr) #pipe operator In previous versions of `scoringutils`, forecasts and observed values could be visualised using the function `plot_predictions()` and its `make_na()` helper function. The following shows the function code first and then an example. -```{r} +```{r eval=("ggdist" %in% rownames(installed.packages()))} #" @title Plot Predictions vs True Values #" #" @description @@ -98,126 +98,124 @@ In previous versions of `scoringutils`, forecasts and observed values could be v #" aes(fill = model, color = model) -# Code is commented out because `ggdist` requires R version 4.1.0, while -# scoringutils does not. -# library(ggdist) -# plot_predictions <- function(data, -# by = NULL, -# x = "date", -# interval_range = c(0, 50, 90)) { -# -# # split truth data and forecasts in order to apply different filtering -# truth_data <- data.table::as.data.table(data)[!is.na(observed)] -# forecasts <- data.table::as.data.table(data)[!is.na(predicted)] -# -# del_cols <- -# colnames(truth_data)[!(colnames(truth_data) %in% c(by, "observed", x))] -# -# truth_data <- unique(suppressWarnings(truth_data[, eval(del_cols) := NULL])) -# -# # find out what type of predictions we have. convert sample based to -# # interval range data -# -# if ("quantile_level" %in% colnames(data)) { -# forecasts <- scoringutils:::quantile_to_interval( -# forecasts, -# keep_quantile_col = FALSE -# ) -# } else if ("sample_id" %in% colnames(data)) { -# # using a scoringutils internal function -# forecasts <- scoringutils:::sample_to_interval_long( -# as_forecast_sample(forecasts), -# interval_range = interval_range, -# keep_quantile_col = FALSE -# ) -# } -# -# # select appropriate boundaries and pivot wider -# select <- forecasts$interval_range %in% setdiff(interval_range, 0) -# intervals <- forecasts[select, ] -# -# # delete quantile column in intervals if present. This is important for -# # pivoting -# if ("quantile_level" %in% names(intervals)) { -# intervals[, quantile_level := NULL] -# } -# -# plot <- ggplot(data = data, aes(x = .data[[x]])) + -# theme_scoringutils() + -# ylab("True and predicted values") -# -# if (nrow(intervals) != 0) { -# # pivot wider and convert range to a factor -# intervals <- data.table::dcast(intervals, ... ~ boundary, -# value.var = "predicted") -# -# # only plot interval ranges if there are interval ranges to plot -# plot <- plot + -# ggdist::geom_lineribbon( -# data = intervals, -# aes( -# ymin = lower, ymax = upper, -# # We use the fill_ramp aesthetic for this instead of the default fill -# # because we want to keep fill to be able to use it for other -# # variables -# fill_ramp = factor( -# interval_range, -# levels = sort(unique(interval_range), decreasing = TRUE) -# ) -# ), -# lwd = 0.4 -# ) + -# ggdist::scale_fill_ramp_discrete( -# name = "interval_range", -# # range argument was added to make sure that the line for the median -# # and the ribbon don"t have the same opacity, making the line -# # invisible -# range = c(0.15, 0.75) -# ) -# } -# -# # We could treat this step as part of ggdist::geom_lineribbon() but we treat -# # it separately here to deal with the case when only the median is provided -# # (in which case ggdist::geom_lineribbon() will fail) -# if (0 %in% interval_range) { -# select_median <- -# forecasts$interval_range == 0 & forecasts$boundary == "lower" -# median <- forecasts[select_median] -# -# if (nrow(median) > 0) { -# plot <- plot + -# geom_line( -# data = median, -# mapping = aes(y = predicted), -# lwd = 0.4 -# ) -# } -# } -# -# # add observed values -# if (nrow(truth_data) > 0) { -# plot <- plot + -# geom_point( -# data = truth_data, -# show.legend = FALSE, -# inherit.aes = FALSE, -# aes(x = .data[[x]], y = observed), -# color = "black", -# size = 0.5 -# ) + -# geom_line( -# data = truth_data, -# inherit.aes = FALSE, -# show.legend = FALSE, -# aes(x = .data[[x]], y = observed), -# linetype = 1, -# color = "grey40", -# lwd = 0.2 -# ) -# } -# -# return(plot) -# } +library(ggdist) +plot_predictions <- function(data, + by = NULL, + x = "date", + interval_range = c(0, 50, 90)) { + + # split truth data and forecasts in order to apply different filtering + truth_data <- data.table::as.data.table(data)[!is.na(observed)] + forecasts <- data.table::as.data.table(data)[!is.na(predicted)] + + del_cols <- + colnames(truth_data)[!(colnames(truth_data) %in% c(by, "observed", x))] + + truth_data <- unique(suppressWarnings(truth_data[, eval(del_cols) := NULL])) + + # find out what type of predictions we have. convert sample based to + # interval range data + + if ("quantile_level" %in% colnames(data)) { + forecasts <- scoringutils:::quantile_to_interval( + forecasts, + keep_quantile_col = FALSE + ) + } else if ("sample_id" %in% colnames(data)) { + # using a scoringutils internal function + forecasts <- scoringutils:::sample_to_interval_long( + as_forecast_sample(forecasts), + interval_range = interval_range, + keep_quantile_col = FALSE + ) + } + + # select appropriate boundaries and pivot wider + select <- forecasts$interval_range %in% setdiff(interval_range, 0) + intervals <- forecasts[select, ] + + # delete quantile column in intervals if present. This is important for + # pivoting + if ("quantile_level" %in% names(intervals)) { + intervals[, quantile_level := NULL] + } + + plot <- ggplot(data = data, aes(x = .data[[x]])) + + theme_scoringutils() + + ylab("True and predicted values") + + if (nrow(intervals) != 0) { + # pivot wider and convert range to a factor + intervals <- data.table::dcast(intervals, ... ~ boundary, + value.var = "predicted") + + # only plot interval ranges if there are interval ranges to plot + plot <- plot + + ggdist::geom_lineribbon( + data = intervals, + aes( + ymin = lower, ymax = upper, + # We use the fill_ramp aesthetic for this instead of the default fill + # because we want to keep fill to be able to use it for other + # variables + fill_ramp = factor( + interval_range, + levels = sort(unique(interval_range), decreasing = TRUE) + ) + ), + lwd = 0.4 + ) + + ggdist::scale_fill_ramp_discrete( + name = "interval_range", + # range argument was added to make sure that the line for the median + # and the ribbon don"t have the same opacity, making the line + # invisible + range = c(0.15, 0.75) + ) + } + + # We could treat this step as part of ggdist::geom_lineribbon() but we treat + # it separately here to deal with the case when only the median is provided + # (in which case ggdist::geom_lineribbon() will fail) + if (0 %in% interval_range) { + select_median <- + forecasts$interval_range == 0 & forecasts$boundary == "lower" + median <- forecasts[select_median] + + if (nrow(median) > 0) { + plot <- plot + + geom_line( + data = median, + mapping = aes(y = predicted), + lwd = 0.4 + ) + } + } + + # add observed values + if (nrow(truth_data) > 0) { + plot <- plot + + geom_point( + data = truth_data, + show.legend = FALSE, + inherit.aes = FALSE, + aes(x = .data[[x]], y = observed), + color = "black", + size = 0.5 + ) + + geom_line( + data = truth_data, + inherit.aes = FALSE, + show.legend = FALSE, + aes(x = .data[[x]], y = observed), + linetype = 1, + color = "grey40", + lwd = 0.2 + ) + } + + return(plot) +} ``` `plot_predictions()` does the actual work of producing a plot. The `by` argument is needed so that the user can facet the plot correctly and the user needs to specify all columns relevant for facetting. `make_NA()` represents a form of filtering, but instead of filtering entire rows, the relevant entries in the columns "predicted" or "observed" are made `NA`. This allows the user to filter observations and forecasts independently. @@ -280,72 +278,72 @@ In the following are a few examples of using the two functions to create a plot Visualising the median forecasts for the example data. The truth data is restricted to a period between 2021-05-01 and 2021-07-22. The forecast data is a forecast from the model "EuroCOVIDhub-ensemble" made on the "2021-06-07". All other data is set to `NA`, effectively removing it from the plot. -```{r} -# median_forecasts <- example_quantile[quantile_level == 0.5] -# median_forecasts %>% -# make_NA(what = "truth", -# target_end_date <= "2021-05-01", -# target_end_date > "2021-07-22") %>% -# make_NA(what = "forecast", -# model != "EuroCOVIDhub-ensemble", -# forecast_date != "2021-06-07") %>% -# plot_predictions( -# by = c("location", "target_type"), -# x = "target_end_date" -# ) + -# facet_wrap(location ~ target_type, scales = "free_y") +```{r eval=("ggdist" %in% rownames(installed.packages()))} +median_forecasts <- example_quantile[quantile_level == 0.5] +median_forecasts %>% + make_NA(what = "truth", + target_end_date <= "2021-05-01", + target_end_date > "2021-07-22") %>% + make_NA(what = "forecast", + model != "EuroCOVIDhub-ensemble", + forecast_date != "2021-06-07") %>% + plot_predictions( + by = c("location", "target_type"), + x = "target_end_date" + ) + + facet_wrap(location ~ target_type, scales = "free_y") ``` This is the same plot, but with a variety of prediction intervals shown, instead of just the median. -```{r} -# example_quantile %>% -# make_NA(what = "truth", -# target_end_date <= "2021-05-01", -# target_end_date > "2021-07-22") %>% -# make_NA(what = "forecast", -# model != "EuroCOVIDhub-ensemble", -# forecast_date != "2021-06-07") %>% -# plot_predictions( -# by = c("location", "target_type"), -# x = "target_end_date", -# interval_range = c(0, 10, 20, 30, 40, 50, 60) -# ) + -# facet_wrap(location ~ target_type, scales = "free_y") +```{r eval=("ggdist" %in% rownames(installed.packages()))} +example_quantile %>% + make_NA(what = "truth", + target_end_date <= "2021-05-01", + target_end_date > "2021-07-22") %>% + make_NA(what = "forecast", + model != "EuroCOVIDhub-ensemble", + forecast_date != "2021-06-07") %>% + plot_predictions( + by = c("location", "target_type"), + x = "target_end_date", + interval_range = c(0, 10, 20, 30, 40, 50, 60) + ) + + facet_wrap(location ~ target_type, scales = "free_y") ``` And a similar plot, this time based on continuous forecasts. The predictions are automatically converted to a quantile-based forecasts for plotting. -```{r} -# example_sample_continuous %>% -# make_NA(what = "truth", -# target_end_date <= "2021-05-01", -# target_end_date > "2021-07-22") %>% -# make_NA(what = "forecast", -# model != "EuroCOVIDhub-ensemble", -# forecast_date != "2021-06-07") %>% -# plot_predictions( -# by = c("location", "target_type"), -# x = "target_end_date", -# interval_range = c(0, 50, 90, 95) -# ) + -# facet_wrap(location ~ target_type, scales = "free_y") +```{r eval=("ggdist" %in% rownames(installed.packages()))} +example_sample_continuous %>% + make_NA(what = "truth", + target_end_date <= "2021-05-01", + target_end_date > "2021-07-22") %>% + make_NA(what = "forecast", + model != "EuroCOVIDhub-ensemble", + forecast_date != "2021-06-07") %>% + plot_predictions( + by = c("location", "target_type"), + x = "target_end_date", + interval_range = c(0, 50, 90, 95) + ) + + facet_wrap(location ~ target_type, scales = "free_y") ``` Displaying two forecasts at a time with additional colours: -```{r} -# example_quantile %>% -# make_NA(what = "truth", -# target_end_date > "2021-07-15", -# target_end_date <= "2021-05-22") %>% -# make_NA(what = "forecast", -# !(model %in% c("EuroCOVIDhub-ensemble", "EuroCOVIDhub-baseline")), -# forecast_date != "2021-06-28") %>% -# plot_predictions(x = "target_end_date", by = c("target_type", "location")) + -# aes(colour = model, fill = model) + -# facet_wrap(target_type ~ location, ncol = 4, scales = "free_y") + -# labs(x = "Target end date") +```{r eval=("ggdist" %in% rownames(installed.packages()))} +example_quantile %>% + make_NA(what = "truth", + target_end_date > "2021-07-15", + target_end_date <= "2021-05-22") %>% + make_NA(what = "forecast", + !(model %in% c("EuroCOVIDhub-ensemble", "EuroCOVIDhub-baseline")), + forecast_date != "2021-06-28") %>% + plot_predictions(x = "target_end_date", by = c("target_type", "location")) + + aes(colour = model, fill = model) + + facet_wrap(target_type ~ location, ncol = 4, scales = "free_y") + + labs(x = "Target end date") ``` From 6a570f50a8ade5d6e5fbba58e5259f59dacda34f Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 23 Sep 2024 17:56:46 +0200 Subject: [PATCH 4/5] simplify check --- vignettes/Deprecated-visualisations.Rmd | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/vignettes/Deprecated-visualisations.Rmd b/vignettes/Deprecated-visualisations.Rmd index b072e5ea..f2152cf8 100644 --- a/vignettes/Deprecated-visualisations.Rmd +++ b/vignettes/Deprecated-visualisations.Rmd @@ -34,7 +34,7 @@ library(magrittr) #pipe operator In previous versions of `scoringutils`, forecasts and observed values could be visualised using the function `plot_predictions()` and its `make_na()` helper function. The following shows the function code first and then an example. -```{r eval=("ggdist" %in% rownames(installed.packages()))} +```{r eval=!require("ggdist")} #" @title Plot Predictions vs True Values #" #" @description @@ -278,7 +278,7 @@ In the following are a few examples of using the two functions to create a plot Visualising the median forecasts for the example data. The truth data is restricted to a period between 2021-05-01 and 2021-07-22. The forecast data is a forecast from the model "EuroCOVIDhub-ensemble" made on the "2021-06-07". All other data is set to `NA`, effectively removing it from the plot. -```{r eval=("ggdist" %in% rownames(installed.packages()))} +```{r eval=!require("ggdist")} median_forecasts <- example_quantile[quantile_level == 0.5] median_forecasts %>% make_NA(what = "truth", @@ -296,7 +296,7 @@ median_forecasts %>% This is the same plot, but with a variety of prediction intervals shown, instead of just the median. -```{r eval=("ggdist" %in% rownames(installed.packages()))} +```{r eval=!require("ggdist")} example_quantile %>% make_NA(what = "truth", target_end_date <= "2021-05-01", @@ -314,7 +314,7 @@ example_quantile %>% And a similar plot, this time based on continuous forecasts. The predictions are automatically converted to a quantile-based forecasts for plotting. -```{r eval=("ggdist" %in% rownames(installed.packages()))} +```{r eval=!require("ggdist")} example_sample_continuous %>% make_NA(what = "truth", target_end_date <= "2021-05-01", @@ -332,7 +332,7 @@ example_sample_continuous %>% Displaying two forecasts at a time with additional colours: -```{r eval=("ggdist" %in% rownames(installed.packages()))} +```{r eval=!require("ggdist")} example_quantile %>% make_NA(what = "truth", target_end_date > "2021-07-15", From f87fe68e9f2702ca2d9dcb4b5527d6e603ab0fe6 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Mon, 23 Sep 2024 17:58:19 +0200 Subject: [PATCH 5/5] make require quietly --- vignettes/Deprecated-visualisations.Rmd | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/vignettes/Deprecated-visualisations.Rmd b/vignettes/Deprecated-visualisations.Rmd index f2152cf8..492e241b 100644 --- a/vignettes/Deprecated-visualisations.Rmd +++ b/vignettes/Deprecated-visualisations.Rmd @@ -34,7 +34,7 @@ library(magrittr) #pipe operator In previous versions of `scoringutils`, forecasts and observed values could be visualised using the function `plot_predictions()` and its `make_na()` helper function. The following shows the function code first and then an example. -```{r eval=!require("ggdist")} +```{r eval=!require("ggdist", quietly = TRUE)} #" @title Plot Predictions vs True Values #" #" @description @@ -278,7 +278,7 @@ In the following are a few examples of using the two functions to create a plot Visualising the median forecasts for the example data. The truth data is restricted to a period between 2021-05-01 and 2021-07-22. The forecast data is a forecast from the model "EuroCOVIDhub-ensemble" made on the "2021-06-07". All other data is set to `NA`, effectively removing it from the plot. -```{r eval=!require("ggdist")} +```{r eval=!require("ggdist", quietly = TRUE)} median_forecasts <- example_quantile[quantile_level == 0.5] median_forecasts %>% make_NA(what = "truth", @@ -296,7 +296,7 @@ median_forecasts %>% This is the same plot, but with a variety of prediction intervals shown, instead of just the median. -```{r eval=!require("ggdist")} +```{r eval=!require("ggdist", quiet = TRUE)} example_quantile %>% make_NA(what = "truth", target_end_date <= "2021-05-01", @@ -314,7 +314,7 @@ example_quantile %>% And a similar plot, this time based on continuous forecasts. The predictions are automatically converted to a quantile-based forecasts for plotting. -```{r eval=!require("ggdist")} +```{r eval=!require("ggdist", quietly = TRUE)} example_sample_continuous %>% make_NA(what = "truth", target_end_date <= "2021-05-01", @@ -332,7 +332,7 @@ example_sample_continuous %>% Displaying two forecasts at a time with additional colours: -```{r eval=!require("ggdist")} +```{r eval=!require("ggdist", quietly = TRUE)} example_quantile %>% make_NA(what = "truth", target_end_date > "2021-07-15",