From 18f42a80d335d6048a2132714c1ada5a9d2d5e51 Mon Sep 17 00:00:00 2001 From: nikosbosse Date: Tue, 5 Dec 2023 13:03:29 +0100 Subject: [PATCH] Create `plot_forecast_counts()` to replace previous S3 method --- NAMESPACE | 2 +- R/available_forecasts.R | 2 - R/plot.R | 45 +++++++++---------- ...tion_counts.Rd => plot_forecast_counts.Rd} | 33 +++++++------- tests/testthat/test-plot_avail_forecasts.R | 4 +- vignettes/scoringutils.Rmd | 2 +- 6 files changed, 40 insertions(+), 48 deletions(-) rename man/{plot.prediction_counts.Rd => plot_forecast_counts.Rd} (51%) diff --git a/NAMESPACE b/NAMESPACE index ad4f49cba..d44c528b8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method(plot,prediction_counts) S3method(print,scoringutils_check) S3method(quantile_to_interval,data.frame) S3method(quantile_to_interval,numeric) @@ -49,6 +48,7 @@ export(pairwise_comparison) export(pit) export(pit_sample) export(plot_correlation) +export(plot_forecast_counts) export(plot_heatmap) export(plot_interval_coverage) export(plot_pairwise_comparison) diff --git a/R/available_forecasts.R b/R/available_forecasts.R index 946cbc519..8225620d3 100644 --- a/R/available_forecasts.R +++ b/R/available_forecasts.R @@ -70,7 +70,5 @@ get_forecast_counts <- function(data, out <- merge(out, out_empty, by = by, all.y = TRUE) out[, count := nafill(count, fill = 0)] - class(out) <- c("prediction_counts", class(out)) - return(out[]) } diff --git a/R/plot.R b/R/plot.R index a8244207c..4d8d602e3 100644 --- a/R/plot.R +++ b/R/plot.R @@ -942,13 +942,13 @@ plot_pit <- function(pit, #' @description #' Visualise Where Forecasts Are Available #' @inheritParams print.scoringutils_check -#' @param x an S3 object of class "prediction_counts" +#' @param forecast_counts a data.table (or similar) with forecast counts #' as produced by [get_forecast_counts()] -#' @param yvar character vector of length one that denotes the name of the column +#' @param y character vector of length one that denotes the name of the column #' to appear on the y-axis of the plot. Default is "model". -#' @param xvar character vector of length one that denotes the name of the column -#' to appear on the x-axis of the plot. Default is "forecast_date". -#' @param make_xvar_factor logical (default is TRUE). Whether or not to convert +#' @param x character vector of length one that denotes the name of the column +#' to appear on the x-axis of the plot. +#' @param make_x_factor logical (default is TRUE). Whether or not to convert #' the variable on the x-axis to a factor. This has an effect e.g. if dates #' are shown on the x-axis. #' @param show_numbers logical (default is `TRUE`) that indicates whether @@ -960,35 +960,34 @@ plot_pit <- function(pit, #' @export #' @examples #' library(ggplot2) -#' available_forecasts <- get_forecast_counts( +#' forecast_counts <- get_forecast_counts( #' example_quantile, by = c("model", "target_type", "target_end_date") #' ) -#' plot( -#' available_forecasts, xvar = "target_end_date", show_numbers = FALSE +#' plot_forecast_counts( +#' forecast_counts, x = "target_end_date", show_numbers = FALSE #' ) + #' facet_wrap("target_type") -plot.prediction_counts <- function(x, - yvar = "model", - xvar = "forecast_date", - make_xvar_factor = TRUE, - show_numbers = TRUE, - ...) { - x <- as.data.table(x) +plot_forecast_counts <- function(forecast_counts, + y = "model", + x, + make_x_factor = TRUE, + show_numbers = TRUE) { - if (make_xvar_factor) { - x[, eval(xvar) := as.factor(get(xvar))] + forecast_counts <- ensure_data.table(forecast_counts) + + if (make_x_factor) { + forecast_counts[, eval(x) := as.factor(get(x))] } - setnames(x, old = "count", new = "Count") + setnames(forecast_counts, old = "count", new = "Count") plot <- ggplot( - x, - aes(y = .data[[yvar]], x = .data[[xvar]]) + forecast_counts, + aes(y = .data[[y]], x = .data[[x]]) ) + geom_tile(aes(fill = `Count`), - width = 0.97, height = 0.97 - ) + + width = 0.97, height = 0.97) + scale_fill_gradient( low = "grey95", high = "steelblue", na.value = "lightgrey" @@ -1001,12 +1000,10 @@ plot.prediction_counts <- function(x, ) ) + theme(panel.spacing = unit(2, "lines")) - if (show_numbers) { plot <- plot + geom_text(aes(label = `Count`)) } - return(plot) } diff --git a/man/plot.prediction_counts.Rd b/man/plot_forecast_counts.Rd similarity index 51% rename from man/plot.prediction_counts.Rd rename to man/plot_forecast_counts.Rd index d3343d659..c4f4cade9 100644 --- a/man/plot.prediction_counts.Rd +++ b/man/plot_forecast_counts.Rd @@ -1,36 +1,33 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/plot.R -\name{plot.prediction_counts} -\alias{plot.prediction_counts} +\name{plot_forecast_counts} +\alias{plot_forecast_counts} \title{Visualise Where Forecasts Are Available} \usage{ -\method{plot}{prediction_counts}( +plot_forecast_counts( + forecast_counts, + y = "model", x, - yvar = "model", - xvar = "forecast_date", - make_xvar_factor = TRUE, - show_numbers = TRUE, - ... + make_x_factor = TRUE, + show_numbers = TRUE ) } \arguments{ -\item{x}{an S3 object of class "prediction_counts" +\item{forecast_counts}{a data.table (or similar) with forecast counts as produced by \code{\link[=get_forecast_counts]{get_forecast_counts()}}} -\item{yvar}{character vector of length one that denotes the name of the column +\item{y}{character vector of length one that denotes the name of the column to appear on the y-axis of the plot. Default is "model".} -\item{xvar}{character vector of length one that denotes the name of the column -to appear on the x-axis of the plot. Default is "forecast_date".} +\item{x}{character vector of length one that denotes the name of the column +to appear on the x-axis of the plot.} -\item{make_xvar_factor}{logical (default is TRUE). Whether or not to convert +\item{make_x_factor}{logical (default is TRUE). Whether or not to convert the variable on the x-axis to a factor. This has an effect e.g. if dates are shown on the x-axis.} \item{show_numbers}{logical (default is \code{TRUE}) that indicates whether or not to show the actual count numbers on the plot} - -\item{...}{additional arguments (not used here)} } \value{ ggplot object with a plot of interval coverage @@ -40,11 +37,11 @@ Visualise Where Forecasts Are Available } \examples{ library(ggplot2) -available_forecasts <- get_forecast_counts( +forecast_counts <- get_forecast_counts( example_quantile, by = c("model", "target_type", "target_end_date") ) -plot( - available_forecasts, xvar = "target_end_date", show_numbers = FALSE +plot_forecast_counts( + forecast_counts, x = "target_end_date", show_numbers = FALSE ) + facet_wrap("target_type") } diff --git a/tests/testthat/test-plot_avail_forecasts.R b/tests/testthat/test-plot_avail_forecasts.R index a246987c1..d34caec51 100644 --- a/tests/testthat/test-plot_avail_forecasts.R +++ b/tests/testthat/test-plot_avail_forecasts.R @@ -3,8 +3,8 @@ test_that("plot.forecast_counts() works as expected", { example_quantile, by = c("model", "target_type", "target_end_date") ) - p <- plot(available_forecasts, - xvar = "target_end_date", show_numbers = FALSE + p <- plot_forecast_counts(available_forecasts, + x = "target_end_date", show_numbers = FALSE ) + facet_wrap("target_type") expect_s3_class(p, "ggplot") diff --git a/vignettes/scoringutils.Rmd b/vignettes/scoringutils.Rmd index da2898fb6..92e532335 100644 --- a/vignettes/scoringutils.Rmd +++ b/vignettes/scoringutils.Rmd @@ -92,7 +92,7 @@ This information can also be visualised using `plot()`: ```{r, fig.width=11, fig.height=6} example_quantile %>% get_forecast_counts(by = c("model", "forecast_date", "target_type")) %>% - plot() + + plot_forecast_counts(x = "forecast_date") + facet_wrap(~ target_type) ```