Issue #498: Implement a simple print function for forecast objects.

DESCRIPTION

@@ -21,6 +21,10 @@ Authors@R: c(
            role = c("ctb"),
            email = "[email protected]",
            comment = c(ORCID = "0000-0002-3777-1410")), 
+    person(given = "Toshiaki Asakura",
+           role = c("ctb"),
+           email = "[email protected]",
+           comment = c(ORCID = "0000-0001-8838-785X")), 
     person("Sebastian", "Funk", 
             email = "[email protected]", 
             role = c("aut")))

NAMESPACE

@@ -6,6 +6,10 @@ S3method(is_forecast,forecast_binary)
 S3method(is_forecast,forecast_point)
 S3method(is_forecast,forecast_quantile)
 S3method(is_forecast,forecast_sample)
+S3method(print,forecast_binary)
+S3method(print,forecast_point)
+S3method(print,forecast_quantile)
+S3method(print,forecast_sample)
 S3method(print,scoringutils_check)
 S3method(quantile_to_interval,data.frame)
 S3method(quantile_to_interval,numeric)

NEWS.md

@@ -45,6 +45,7 @@ The update introduces breaking changes. If you want to keep using the older vers
 - Added unit tests for `interval_coverage_quantile()` and `interval_coverage_dev_quantile()` in order to make sure that the functions provide the correct warnings when insufficient quantiles are provided.
 - Documentation pkgdown pages are now created both for the stable and dev versions.
 - Output columns for pairwise comparisons have been renamed to contain the name of the metric used for comparing.
+- Added a method for `print()` that prints out additional information for `forecast` objects. 
 
 # scoringutils 1.2.2
 

R/available_forecasts.R

@@ -61,7 +61,7 @@ get_forecast_counts <- function(data,
   data <- data[data[, .I[1], by = collapse_by]$V1]
 
   # count number of rows = number of forecasts
-  out <- data[, .(count = .N), by = by]
+  out <- as.data.table(data)[, .(count = .N), by = by]
 
   # make sure that all combinations in "by" are included in the output (with
   # count = 0). To achieve that, take the unique values in data and expand grid

R/utils.R

@@ -200,3 +200,53 @@ ensure_data.table <- function(data) {
   }
   return(data)
 }
+
+#' @title Print Information About A Forecast Object
+#' @description This function prints information about a forecast object,
+#' including "Forecast type", "Score columns",
+#' "Forecast unit".
+#'
+#' @param x An object of class 'forecast_*' object as produced by
+#' `as_forecast()`
+#' @param ... additional arguments for [print()]
+#' @return NULL
+#' @export
+#' @keywords check-forecasts
+#' @examples
+#' dat <- as_forecast(example_quantile)
+#' print(dat)
+print.forecast_binary <- function(x, ...) {
+  # Obtain forecast object information for printing
+  forecast_type <- get_forecast_type(x)
+  score_cols <- get_score_names(x)
+  forecast_unit <- get_forecast_unit(x)
+
+  # Print forecast object information
+  cat("Forecast type:\n")
+  print(forecast_type)
+
+  if (!is.null(score_cols)) {
+    cat("\nScore columns:\n")
+    print(score_cols)
+  }
+
+  cat("\nForecast unit:\n")
+  print(forecast_unit)
+
+  cat("\n")
+  NextMethod(x, ...)
+
+  return(invisible(x))
+}
+
+#' @rdname print.forecast_binary
+#' @export
+print.forecast_quantile <- print.forecast_binary
+
+#' @rdname print.forecast_binary
+#' @export
+print.forecast_point <- print.forecast_binary
+
+#' @rdname print.forecast_binary
+#' @export
+print.forecast_sample <- print.forecast_binary

tests/testthat/test-available_forecasts.R

@@ -12,6 +12,9 @@ test_that("get_forecast_counts() works as expected", {
   expect_equal(nrow(af), 4)
   expect_equal(af$`count`, c(256, 256, 128, 247))
 
+  # Ensure the returning object class is exactly same as a data.table.
+  expect_s3_class(af, c("data.table", "data.frame"), exact = TRUE)
+
   # Setting `collapse = c()` means that all quantiles and samples are counted
   af <- get_forecast_counts(
     na.omit(example_quantile),

tests/testthat/test-utils.R

@@ -78,3 +78,38 @@ test_that("get_score_names() works as expected", {
     "but are no longer column names of the data: `crps`"
   )
 })
+
+test_that("print() works on forecast_* objects", {
+  # Check print works on each forecast object
+  test_dat <- list(example_binary, example_quantile,
+    example_point, example_continuous, example_integer)
+  for (dat in test_dat){
+    dat <- suppressMessages(as_forecast(dat))
+    forecast_type <- get_forecast_type(dat)
+    forecast_unit <- get_forecast_unit(dat)
+
+    # Check Forecast type
+    expect_output(print(dat), "Forecast type")
+    expect_output(print(dat), forecast_type)
+    # Check Forecast unit
+    expect_output(print(dat), "Forecast unit")
+    expect_output(print(dat), pattern = paste(forecast_unit, collapse = " "))
+
+    # Check print.data.table works.
+    output_original <- capture.output(print(dat))
+    output_test <- capture.output(print(data.table(dat)))
+    expect_contains(output_original, output_test)
+  }
+
+  # Check Score columns are printed
+  dat <- example_quantile %>%
+    set_forecast_unit(c("location", "target_end_date",
+      "target_type", "horizon", "model")) %>%
+    as_forecast() %>%
+    add_coverage() %>%
+    suppressMessages
+
+  expect_output(print(dat), "Score columns")
+  score_cols <- get_score_names(dat)
+  expect_output(print(dat), pattern = paste(score_cols, collapse = " "))
+})