Issue #498 Implement a print function for forecast objects

DESCRIPTION

@@ -56,7 +56,8 @@ Imports:
     Metrics,
     rlang,
     scoringRules,
-    stats
+    stats,
+    stringr
 Suggests: 
     kableExtra,
     knitr,

NAMESPACE

@@ -1,6 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(as_forecast,default)
+S3method(print,forecast_binary)
+S3method(print,forecast_integer)
+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)
@@ -57,6 +62,7 @@ export(plot_quantile_coverage)
 export(plot_ranges)
 export(plot_score_table)
 export(plot_wis)
+export(print_forecast_info)
 export(quantile_score)
 export(quantile_to_interval)
 export(rules_binary)
@@ -179,4 +185,5 @@ importFrom(stats,runif)
 importFrom(stats,sd)
 importFrom(stats,weighted.mean)
 importFrom(stats,wilcox.test)
+importFrom(stringr,str_pad)
 importFrom(utils,combn)

R/utils.R

@@ -200,3 +200,84 @@
   }
   return(data)
 }
+
+#' @title Print information about a `forecast` object.
+#' @description This function prints information about a forecast object,
+#' including "Forecast type", "Protected columns", "Metric columns",
+#' "Forecast unit".
+#' @importFrom stringr str_pad
+#' @export
+#' @keywords print-forecasts
+#' @examples
+#' print(example_quantile %>% as_forecast)
+print_forecast_info <- function(data) {
+  # Wrap text and create four spaces in the beginning.
+  width <- 40
+  wrap_text <- function(str) {
+    str <- strwrap(str, width = width - 4, simplify = FALSE)
+    str <- sapply(str, function(line) paste("  ", line, sep = "")) %>%
+      paste(collapse = "\n    ")
+    return(str)
+  }
+
+  eq_str <-  rep("=", width) %>% paste(collapse = "") %>% paste("\n")
+  s_ <- str_pad("Forecast data information", width = width, side = "both") %>%
+    paste("\n")
+  s_ <- paste("", eq_str, s_, eq_str)
+
+  type <- get_forecast_type(data)
+  col <- "Forecast type:"
+  s_ <- paste(col, str_pad(type, width = width - nchar(col) - 1), "\n\n") %>%
+    paste(s_, .)
+
+  # Exclude protected columns.
+  protect_cols <- get_protected_columns(data)
+  if (is.null(attr(data, "metric_names"))) {
+    met_cols <- c()
+    mets <- "NA"
+  } else {
+    met_cols <- get_metrics(data)
+    mets <- met_cols %>% paste(collapse = ", ")
+  }
+
+  # Protected columns
+  protect_pri <- protect_cols[!(protect_cols %in% met_cols)] %>%
+    paste(collapse = ", ")
+  s_ <- paste0("Protected columns:\n    ", wrap_text(protect_pri), "\n\n") %>%
+    paste(s_, .)
+
+  # Print metrics columns if exist.
+  if (length(met_cols) != 0) {
+    s_ <- paste0("Metric columns (protected):\n    ", wrap_text(mets), "\n\n") %>%
+      paste(s_, .)
+  }
+
+  # Forecast unit
+  unit <- get_forecast_unit(data) %>% paste(collapse = ", ")
+  s_ <- paste0("Forecast unit:\n    ",  wrap_text(unit),  "\n") %>%
+    paste(s_, .)
+  s_tab1 <- str_pad("data.table print", width = width, side = "both")
+  s_ <- paste(s_, "\n", eq_str, s_tab1, "\n", eq_str)
+  cat(s_)
+  print(data.table(data))
+}
+
+#' @title Print information about a `forecast_binary` object.
+#' @export
+print.forecast_binary <- function(data) print_forecast_info(data)
+
+#' @title Print information about a `forecast_quantile` object.
+#' @export
+print.forecast_quantile <- function(data) print_forecast_info(data)
+
+#' @title Print information about a `forecast_point` object.
+#' @export
+print.forecast_point <- function(data) print_forecast_info(data)
+
+#' @title Print information about a `forecast_sample` object.
+#' @export
+print.forecast_sample <- function(data) print_forecast_info(data)
+
+#' @title Print information about a `forecast_integer` object.
+#' @export
+print.forecast_integer <- function(data) print_forecast_info(data)