wip: epi_archive print #341

Author: dshemetov

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)

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

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
+}