From 7dc972138d5465c9bb0aac87229c1b08dcffa6d5 Mon Sep 17 00:00:00 2001 From: Toshiaki Asakura Date: Sat, 6 Jan 2024 16:41:18 +0000 Subject: [PATCH 1/2] Implement a print function for forecast objects --- DESCRIPTION | 3 +- NAMESPACE | 7 ++++ R/utils.R | 79 ++++++++++++++++++++++++++++++++++++++ man/print_forecast_info.Rd | 17 ++++++++ 4 files changed, 105 insertions(+), 1 deletion(-) create mode 100644 man/print_forecast_info.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 95e581a07..f93eb4bae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -56,7 +56,8 @@ Imports: Metrics, rlang, scoringRules, - stats + stats, + stringr Suggests: kableExtra, knitr, diff --git a/NAMESPACE b/NAMESPACE index c4ba7a2dc..614039100 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/utils.R b/R/utils.R index bcf234e0b..6b43dd98e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -200,3 +200,82 @@ 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", "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) \ No newline at end of file diff --git a/man/print_forecast_info.Rd b/man/print_forecast_info.Rd new file mode 100644 index 000000000..9cf78cc28 --- /dev/null +++ b/man/print_forecast_info.Rd @@ -0,0 +1,17 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{print_forecast_info} +\alias{print_forecast_info} +\title{Print information about a \code{forecast} object.} +\usage{ +print_forecast_info(data) +} +\description{ +This function prints information about a forecast object, +including "Forecast type", "Protected columns", "Metric columns", +"Forecast unit". +} +\examples{ +print(example_quantile \%>\% as_forecast) +} +\keyword{print-forecasts} From 448aa975df5e3638cf160822df3968f2ae458a6d Mon Sep 17 00:00:00 2001 From: Toshiaki Asakura Date: Sat, 6 Jan 2024 17:22:38 +0000 Subject: [PATCH 2/2] Style the code using lintr. --- R/utils.R | 68 +++++++++++++++++----------------- man/print.forecast_binary.Rd | 11 ++++++ man/print.forecast_integer.Rd | 11 ++++++ man/print.forecast_point.Rd | 11 ++++++ man/print.forecast_quantile.Rd | 11 ++++++ man/print.forecast_sample.Rd | 11 ++++++ 6 files changed, 90 insertions(+), 33 deletions(-) create mode 100644 man/print.forecast_binary.Rd create mode 100644 man/print.forecast_integer.Rd create mode 100644 man/print.forecast_point.Rd create mode 100644 man/print.forecast_quantile.Rd create mode 100644 man/print.forecast_sample.Rd diff --git a/R/utils.R b/R/utils.R index 6b43dd98e..82a44a1d2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -202,59 +202,61 @@ ensure_data.table <- function(data) { } #' @title Print information about a `forecast` object. -#' @description This function prints 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 +#' @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 ") +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") + + 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. + 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"))){ + if (is.null(attr(data, "metric_names"))) { met_cols <- c() mets <- "NA" } else { met_cols <- get_metrics(data) - mets <- met_cols %>% paste(collapse=", ") + 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_, .) + 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") + 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)) @@ -278,4 +280,4 @@ 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) \ No newline at end of file +print.forecast_integer <- function(data) print_forecast_info(data) diff --git a/man/print.forecast_binary.Rd b/man/print.forecast_binary.Rd new file mode 100644 index 000000000..aaed86573 --- /dev/null +++ b/man/print.forecast_binary.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{print.forecast_binary} +\alias{print.forecast_binary} +\title{Print information about a \code{forecast_binary} object.} +\usage{ +\method{print}{forecast_binary}(data) +} +\description{ +Print information about a \code{forecast_binary} object. +} diff --git a/man/print.forecast_integer.Rd b/man/print.forecast_integer.Rd new file mode 100644 index 000000000..3dbfa2f81 --- /dev/null +++ b/man/print.forecast_integer.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{print.forecast_integer} +\alias{print.forecast_integer} +\title{Print information about a \code{forecast_integer} object.} +\usage{ +\method{print}{forecast_integer}(data) +} +\description{ +Print information about a \code{forecast_integer} object. +} diff --git a/man/print.forecast_point.Rd b/man/print.forecast_point.Rd new file mode 100644 index 000000000..3f5c28ea5 --- /dev/null +++ b/man/print.forecast_point.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{print.forecast_point} +\alias{print.forecast_point} +\title{Print information about a \code{forecast_point} object.} +\usage{ +\method{print}{forecast_point}(data) +} +\description{ +Print information about a \code{forecast_point} object. +} diff --git a/man/print.forecast_quantile.Rd b/man/print.forecast_quantile.Rd new file mode 100644 index 000000000..bd76ee7fd --- /dev/null +++ b/man/print.forecast_quantile.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{print.forecast_quantile} +\alias{print.forecast_quantile} +\title{Print information about a \code{forecast_quantile} object.} +\usage{ +\method{print}{forecast_quantile}(data) +} +\description{ +Print information about a \code{forecast_quantile} object. +} diff --git a/man/print.forecast_sample.Rd b/man/print.forecast_sample.Rd new file mode 100644 index 000000000..157951a28 --- /dev/null +++ b/man/print.forecast_sample.Rd @@ -0,0 +1,11 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{print.forecast_sample} +\alias{print.forecast_sample} +\title{Print information about a \code{forecast_sample} object.} +\usage{ +\method{print}{forecast_sample}(data) +} +\description{ +Print information about a \code{forecast_sample} object. +}