diff --git a/NAMESPACE b/NAMESPACE index c59004c87..2d64c11cf 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -22,6 +22,7 @@ S3method(group_modify,epi_df) S3method(groups,grouped_epi_archive) S3method(next_after,Date) S3method(next_after,integer) +S3method(print,epi_archive) S3method(print,epi_df) S3method(select,epi_df) S3method(summary,epi_df) diff --git a/R/archive.R b/R/archive.R index faaf048b2..10e48fb7b 100644 --- a/R/archive.R +++ b/R/archive.R @@ -439,69 +439,6 @@ epi_archive <- self$clobberable_versions_start <- clobberable_versions_start self$versions_end <- versions_end }, - #' Print information about an archive - #' @param class Boolean; whether to print the class label header - #' @param methods Boolean; whether to print all available methods of - #' the archive - print = function(class = TRUE, methods = TRUE) { - if (class) cat("An `epi_archive` object, with metadata:\n") - cat(sprintf("* %-9s = %s\n", "geo_type", self$geo_type)) - cat(sprintf("* %-9s = %s\n", "time_type", self$time_type)) - if (!is.null(self$additional_metadata)) { - sapply(self$additional_metadata, function(m) { - cat(sprintf("* %-9s = %s\n", names(m), m)) - }) - } - cat("----------\n") - if (length(self$DT$time_value) == 0 || all(is.na(self$DT$time_value))) { - min_time <- max_time <- NA - } else { - min_time <- Min(self$DT$time_value) - max_time <- Max(self$DT$time_value) - } - cat(sprintf("* %-14s = %s\n", "min time value", min_time)) - cat(sprintf("* %-14s = %s\n", "max time value", max_time)) - cat(sprintf( - "* %-14s = %s\n", "first version with update", - min(self$DT$version) - )) - cat(sprintf( - "* %-14s = %s\n", "last version with update", - max(self$DT$version) - )) - if (is.na(self$clobberable_versions_start)) { - cat("* No clobberable versions\n") - } else { - cat(sprintf( - "* %-14s = %s\n", "clobberable versions start", - self$clobberable_versions_start - )) - } - cat(sprintf( - "* %-14s = %s\n", "versions end", - self$versions_end - )) - cat("----------\n") - cat(sprintf( - "Data archive (stored in DT field): %i x %i\n", - nrow(self$DT), ncol(self$DT) - )) - cat(sprintf("Columns in DT: %s\n", paste(ifelse(length( - colnames(self$DT) - ) <= 4, paste(colnames(self$DT), collapse = ", "), - paste( - paste(colnames(self$DT)[1:4], collapse = ", "), "and", - length(colnames(self$DT)[5:length(colnames(self$DT))]), "more columns" - ) - )))) - if (methods) { - cat("----------\n") - writeLines(wrap_varnames( - initial = "Public R6 methods: ", - names(epi_archive$public_methods) - )) - } - }, ##### #' @description Generates a snapshot in `epi_df` format as of a given version. #' See the documentation for the wrapper function [`epix_as_of()`] for diff --git a/R/methods-epi_archive.R b/R/methods-epi_archive.R index 45db2855d..bb27c09c0 100644 --- a/R/methods-epi_archive.R +++ b/R/methods-epi_archive.R @@ -1000,3 +1000,79 @@ epix_truncate_versions_after.epi_archive <- function(x, max_version) { return((x$clone()$truncate_versions_after(max_version))) # ^ second set of parens drops invisibility } + +#' Print and summary functions for an `epi_archive` object. +#' +#' @param x The `epi_archive` object. +#' @param class Boolean; whether to print the class label header +#' @param methods Boolean; whether to print all available methods of +#' the archive +#' @param ... Additional arguments passed to methods. +#' +#' @method print epi_archive +#' @export +print.epi_archive <- function(x, class = TRUE, methods = TRUE, ...) { + # --- Copied from R6 --- + if (class) cat("An `epi_archive` object, with metadata:\n") + cat(sprintf("* %-9s = %s\n", "geo_type", x$geo_type)) + cat(sprintf("* %-9s = %s\n", "time_type", x$time_type)) + if (!is.null(x$additional_metadata)) { + sapply(x$additional_metadata, function(m) { + cat(sprintf("* %-9s = %s\n", names(m), m)) + }) + } + cat("----------\n") + if (length(x$DT$time_value) == 0 || all(is.na(x$DT$time_value))) { + min_time <- max_time <- NA + } else { + min_time <- Min(x$DT$time_value) + max_time <- Max(x$DT$time_value) + } + cat(sprintf("* %-14s = %s\n", "min time value", min_time)) + cat(sprintf("* %-14s = %s\n", "max time value", max_time)) + cat(sprintf( + "* %-14s = %s\n", "first version with update", + min(x$DT$version) + )) + cat(sprintf( + "* %-14s = %s\n", "last version with update", + max(x$DT$version) + )) + if (is.na(x$clobberable_versions_start)) { + cat("* No clobberable versions\n") + } else { + cat(sprintf( + "* %-14s = %s\n", "clobberable versions start", + x$clobberable_versions_start + )) + } + cat(sprintf( + "* %-14s = %s\n", "versions end", + x$versions_end + )) + cat("----------\n") + cat(sprintf( + "Data archive (stored in DT field): %i x %i\n", + nrow(x$DT), ncol(x$DT) + )) + cat(sprintf("Columns in DT: %s\n", paste(ifelse(length( + colnames(x$DT) + ) <= 4, paste(colnames(x$DT), collapse = ", "), + paste( + paste(colnames(x$DT)[1:4], collapse = ", "), "and", + length(colnames(x$DT)[5:length(colnames(x$DT))]), "more columns" + ) + )))) + if (methods) { + cat("----------\n") + writeLines(wrap_varnames( + initial = "Public R6 methods: ", + names(epi_archive$public_methods) + )) + } + + # Error in NextMethod() : generic function not specified + # NextMethod() + + x$DT %>% tibble %>% print +} \ No newline at end of file diff --git a/man/epi_archive.Rd b/man/epi_archive.Rd index 6a25b2af0..a937a5e0e 100644 --- a/man/epi_archive.Rd +++ b/man/epi_archive.Rd @@ -143,7 +143,6 @@ the latest version observed} \subsection{Public methods}{ \itemize{ \item \href{#method-epi_archive-new}{\code{epi_archive$new()}} -\item \href{#method-epi_archive-print}{\code{epi_archive$print()}} \item \href{#method-epi_archive-as_of}{\code{epi_archive$as_of()}} \item \href{#method-epi_archive-fill_through_version}{\code{epi_archive$fill_through_version()}} \item \href{#method-epi_archive-truncate_versions_after}{\code{epi_archive$truncate_versions_after()}} @@ -220,7 +219,6 @@ rows of \code{x}.} \subsection{Details}{ Refer to the documentation for \code{\link[=as_epi_archive]{as_epi_archive()}} for more information and examples of parameter names. -Print information about an archive } \subsection{Returns}{ @@ -228,25 +226,6 @@ An \code{epi_archive} object. } } \if{html}{\out{