feat: add cli package for class printer

DESCRIPTION

@@ -46,6 +46,7 @@ Imports:
     R6 (>= 2.4.1),
     backports,
     checkmate (>= 2.0.0),
+    cli,
     data.table (>= 1.15.0),
     evaluate,
     future,

NAMESPACE

@@ -257,6 +257,7 @@ export(tsks)
 export(unmarshal_model)
 export(warn_deprecated)
 import(checkmate)
+import(cli)
 import(data.table)
 import(mlr3misc)
 import(palmerpenguins)

R/BenchmarkResult.R

@@ -101,8 +101,7 @@ BenchmarkResult = R6Class("BenchmarkResult",
     print = function() {
       tab = self$aggregate(measures = list(), conditions = TRUE)
       setattr(tab, "class", c("data.table", "data.frame"))
-      catf("%s of %i rows with %i resampling runs",
-        format(self), private$.data$iterations(), nrow(tab))
+      cli_h1(sprintf("%s of %i rows with %i resampling runs", class(self)[1L], private$.data$iterations(), nrow(tab)))
       if (nrow(tab)) {
         tab = remove_named(tab, c("uhash", "resample_result"))
         print(tab, class = FALSE, row.names = FALSE, print.keys = FALSE, digits = 3)

R/DataBackend.R

@@ -76,7 +76,7 @@ DataBackend = R6Class("DataBackend", cloneable = FALSE,
     #' Printer.
     print = function() {
       nr = self$nrow
-      catf("%s (%ix%i)", format(self), nr, self$ncol)
+      cli_h1(sprintf("%s (%ix%i)", class(self)[1L], nr, self$ncol))
       print(self$head(6L), row.names = FALSE, print.keys = FALSE)
       if (nr > 6L) {
         catf("[...] (%i rows omitted)", nr - 6L)

R/HotstartStack.R

@@ -156,7 +156,7 @@ HotstartStack = R6Class("HotstartStack",
     #'
     #' @param ... (ignored).
     print = function(...) {
-      catf(format(self))
+      cli_h1(class(self)[1L])
       print(self$stack, digits = 2)
     }
   ),

R/Learner.R

@@ -236,21 +236,22 @@ Learner = R6Class("Learner",
     #' Printer.
     #' @param ... (ignored).
     print = function(...) {
-      catn(format(self), if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label))
-      catn(str_indent("* Model:", if (is.null(self$model)) "-" else if (is_marshaled_model(self$model)) "<marshaled>" else paste0(class(self$model)[1L])))
-      catn(str_indent("* Parameters:", as_short_string(self$param_set$values, 1000L)))
-      if (exists("validate", self)) catn(str_indent("* Validate:", format(self$validate)))
-      catn(str_indent("* Packages:", self$packages))
-      catn(str_indent("* Predict Types: ", replace(self$predict_types, self$predict_types == self$predict_type, paste0("[", self$predict_type, "]"))))
-      catn(str_indent("* Feature Types:", self$feature_types))
-      catn(str_indent("* Properties:", self$properties))
+      cli_h1(sprintf("%s (%s)%s", class(self)[1L], self$id, if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)))
+      cli_li(sprintf("Model: %s", if (is.null(self$model)) "-" else if (is_marshaled_model(self$model)) "<marshaled>" else paste0(class(self$model)[1L])))
+      cli_li(sprintf("Parameters: %s", paste(as_short_string(self$param_set$values, 1000L), collapse = ", ")))
+      if (exists("validate", self)) cli_li(sprintf("Validate: %s %s", class(self$validate[1]), self$validate$id))
+      cli_li(sprintf("Packages: %s", paste(self$packages, collapse = ", ")))
+      cli_li(sprintf("Predict Types: %s", paste(replace(self$predict_types, self$predict_types == self$predict_type, paste0("[", self$predict_type, "]")), collapse = ", ")))
+      cli_li(sprintf("Feature Types: %s", paste(self$feature_types, collapse = ", ")))
+      cli_li(sprintf("Properties: %s", paste(self$properties, collapse = ", ")))
+
       w = self$warnings
       e = self$errors
       if (length(w)) {
-        catn(str_indent("* Warnings:", w))
+        cli_li(sprintf("Warnings: %s", paste(w, collapse = ", ")))
       }
       if (length(e)) {
-        catn(str_indent("* Errors:", e))
+        cli_li(sprintf("Errors: %s", paste(e, collapse = ", ")))
       }
     },
 

R/Measure.R

@@ -160,14 +160,15 @@ Measure = R6Class("Measure",
     #' Printer.
     #' @param ... (ignored).
     print = function(...) {
-      catn(format(self), if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label))
-      catn(str_indent("* Packages:", self$packages))
-      catn(str_indent("* Range:", sprintf("[%g, %g]", self$range[1L], self$range[2L])))
-      catn(str_indent("* Minimize:", self$minimize))
-      catn(str_indent("* Average:", self$average))
-      catn(str_indent("* Parameters:", as_short_string(self$param_set$values, 1000L)))
-      catn(str_indent("* Properties:", self$properties))
-      catn(str_indent("* Predict type:", self$predict_type))
+      cli_h1(sprintf("%s (%s)%s", class(self)[1L], self$id, if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)))
+      cli_li(sprintf("Packages: %s", paste(self$packages, collapse = ", ")))
+      cli_li(sprintf("Range: [%g, %g]", self$range[1L], self$range[2L]))
+      cli_li(sprintf("Minimize: %s", self$minimize))
+      cli_li(sprintf("Average: %s", self$average))
+      cli_li(sprintf("Parameters: %s", paste(as_short_string(self$param_set$values, 1000L), collapse = ", ")))
+      cli_li(sprintf("Properties: %s", if (length(self$properties)) paste(self$properties, collapse = ", ") else "-"))
+      cli_li(sprintf("Predict type: %s", self$predict_type))
+      cli_li(sprintf("Predict sets: %s", paste(self$predict_sets, collapse = ", ")))
     },
 
     #' @description

R/Prediction.R

@@ -61,10 +61,10 @@ Prediction = R6Class("Prediction",
     print = function(...) {
       n = length(self$data$row_ids)
       if (n == 0L) {
-        catf("%s for 0 observations", format(self))
+        cli_h1(sprintf("%s for 0 observations", class(self)[1L]))
       } else {
         data = as.data.table(self)
-        catf("%s for %i observations:", format(self), n)
+        cli_h1(sprintf("%s for %i observations:", class(self)[1L], n))
         print(data, nrows = 10L, topn = 3L, class = FALSE, row.names = FALSE, print.keys = FALSE)
       }
     },

R/ResampleResult.R

@@ -74,7 +74,7 @@ ResampleResult = R6Class("ResampleResult",
       setattr(tab, "class", c("data.table", "data.frame"))
       tab[, "warnings" := map(get("warnings"), length)]
       tab[, "errors" := map(get("errors"), length)]
-      catf("%s with %i resampling iterations",  format(self), self$iters)
+      cli_h1(sprintf("%s with %i resampling iterations", class(self)[1L], self$iters))
       if (nrow(tab)) {
         tab = remove_named(tab, c("task", "learner", "resampling", "prediction"))
         print(tab, class = FALSE, row.names = FALSE, print.keys = FALSE, digits = 3)

R/Resampling.R

@@ -141,10 +141,10 @@ Resampling = R6Class("Resampling",
     #' Printer.
     #' @param ... (ignored).
     print = function(...) {
-      catn(format(self), if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label))
-      catn(str_indent("* Iterations:", self$iters))
-      catn(str_indent("* Instantiated:", self$is_instantiated))
-      catn(str_indent("* Parameters:", as_short_string(self$param_set$values, 1000L)))
+      cli_h1(sprintf("%s %s", class(self)[1L], if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)))
+      cli_li(sprintf("Iterations: %s", paste(self$iters, collapse = ", ")))
+      cli_li(sprintf("Instantiated: %s", self$is_instantiated))
+      cli_li(sprintf("Parameters: %s", paste(as_short_string(self$param_set$values, 1000L), collapse = ", ")))
     },
 
     #' @description

R/Task.R

@@ -218,40 +218,60 @@ Task = R6Class("Task",
     #' Printer.
     #' @param ... (ignored).
     print = function(...) {
-      catf("%s (%i x %i)%s", format(self), self$nrow, self$ncol,
-        if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label))
+      cli_h1(sprintf("%s (%i x %i)%s", class(self)[1L], self$nrow, self$ncol,
+             if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)))
 
       roles = private$.col_roles
       roles = roles[lengths(roles) > 0L]
 
       # print additional columns as specified in reflections
       before = mlr_reflections$task_print_col_roles$before
       iwalk(before[before %in% names(roles)], function(role, str) {
-        catn(str_indent(sprintf("* %s:", str), roles[[role]]))
+        cli_li(sprintf("%s: %s", str, roles[[role]]))
       })
 
-      catf(str_indent("* Target:", self$target_names))
-      catf(str_indent("* Properties:", self$properties))
+      cli_li(sprintf("Target: %s", self$target_names))
+
+      if (class(self)[1L] == "TaskClassif") {
+        if (!is.null(self$backend)) {
+          class_freqs = table(self$truth()) / self$nrow * 100
+          class_freqs = class_freqs[order(-class_freqs, names(class_freqs))]  # Order by class frequency, then names
+          classes = if ("twoclass" %in% self$properties) {
+            sprintf("%s (positive class, %.0f%%), %s (%.0f%%)",
+                    self$positive, class_freqs[[self$positive]], self$negative, class_freqs[[self$negative]])
+          } else {
+            paste(sprintf("%s (%.0f%%)", names(class_freqs), class_freqs), collapse = ", ")
+          }
+        } else {
+          classes = paste(self$class_names, collapse = ", ")
+        }
+        cli_li(sprintf("Target classes: %s", classes))
+      }
+
+      cli_li(sprintf("Properties: %s", if (length(self$properties)) paste(self$properties, collapse = ", ") else "-"))
 
       types = self$feature_types
       if (nrow(types)) {
         id = type = NULL
-        catf("* Features (%i):", nrow(types))
+        cli_li(sprintf("Features (%i):", nrow(types)))
         types = types[, list(N = .N, feats = str_collapse(id, n = 100L)), by = "type"][, "type" := translate_types(type)]
         setorderv(types, "N", order = -1L)
+
+        ulid <- cli_ul()
         pmap(types, function(type, N, feats) {
-          catn(str_indent(sprintf("  - %s (%i):", type, N), feats, exdent = 4L))
+          cli_li(sprintf("%s (%i): %s", type, N, feats))
         })
+        cli_end(ulid)
       }
 
       # print additional columns are specified in reflections
       after = mlr_reflections$task_print_col_roles$after
       iwalk(after[after %in% names(roles)], function(role, str) {
-        catn(str_indent(sprintf("* %s:", str), roles[[role]]))
+        cli_li(sprintf("%s: %s", str, roles[[role]]))
       })
 
       if (!is.null(private$.internal_valid_task)) {
-        catf(str_indent("* Validation Task:", sprintf("(%ix%i)", private$.internal_valid_task$nrow, private$.internal_valid_task$ncol)))
+        cli_li(sprintf("Validation Task: (%ix%i)", private$.internal_valid_task$nrow, private$.internal_valid_task$ncol))
       }
 
       if (!is.null(self$characteristics)) {

R/TaskGenerator.R

@@ -60,11 +60,12 @@ TaskGenerator = R6Class("TaskGenerator",
     #' Printer.
     #' @param ... (ignored).
     print = function(...) {
-      catn(format(self), if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label))
-      catn(str_indent("* Task type:", self$task_type))
-      catn(str_indent("* Packages:", self$packages))
-      catn(str_indent("* Parameters:", as_short_string(self$param_set$values, 1000L)))
-      catn(str_indent("* Manual:", sprintf("?%s", self$man)))
+      cli_h1(sprintf("%s (%s)%s", class(self)[1L], self$id,
+             if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)))
+      cli_li(sprintf("Task type: %s", paste(self$task_type, collapse = ", ")))
+      cli_li(sprintf("Packages: %s", paste(self$packages, collapse = ", ")))
+      cli_li(sprintf("Parameters: %s", paste(as_short_string(self$param_set$values, 1000L), collapse = ", ")))
+      cli_li(sprintf("Manual: ?%s", self$man))
     },
 
     #' @description

R/zzz.R

@@ -1,5 +1,6 @@
 #' @import data.table
 #' @import checkmate
+#' @import cli
 #' @import paradox
 #' @import mlr3misc
 #' @import palmerpenguins

inst/testthat/helper_expectations.R

@@ -51,7 +51,7 @@ expect_backend = function(b) {
   checkmate::expect_r6(b, cloneable = FALSE,
     public = c("nrow", "ncol", "colnames", "rownames", "head", "data", "hash"),
     private = c(".data", ".hash", ".calculate_hash"))
-  testthat::expect_output(print(b), "^<DataBackend")
+  testthat::expect_message(print(b), "DataBackend")
 
   n = checkmate::expect_count(b$nrow)
   p = checkmate::expect_count(b$ncol)
@@ -200,7 +200,7 @@ expect_iris_backend = function(b, n_missing = 0L) {
 
 expect_task = function(task, null_backend_ok = TRUE, duplicated_ids = FALSE) {
   checkmate::expect_r6(task, "Task", cloneable = TRUE, public = c("id", "backend", "task_type", "row_roles", "col_roles", "col_info", "head", "row_ids", "feature_names", "target_names", "formula", "nrow", "ncol", "feature_types"))
-  testthat::expect_output(print(task), "Task")
+  testthat::expect_message(print(task), "Task")
   expect_id(task$id)
   checkmate::expect_string(task$label, na.ok = TRUE)
   expect_man_exists(task$man)
@@ -334,7 +334,7 @@ expect_task_generator = function(gen) {
   checkmate::expect_function(gen$generate, args = "n")
   checkmate::expect_class(gen$param_set, "ParamSet")
   checkmate::expect_list(gen$param_set$values, names = "unique")
-  testthat::expect_output(print(gen))
+  testthat::expect_message(print(gen))
 }
 
 
@@ -346,7 +346,7 @@ expect_learner = function(lrn, task = NULL, check_man = TRUE) {
   if (check_man) {
     expect_man_exists(lrn$man)
   }
-  testthat::expect_output(print(lrn))
+  testthat::expect_message(print(lrn))
 
   checkmate::expect_choice(lrn$task_type, mlr3::mlr_reflections$task_types$type)
   checkmate::expect_character(lrn$packages, any.missing = FALSE, min.chars = 1L, unique = TRUE)
@@ -453,7 +453,7 @@ expect_marshalable_learner = function(learner, task) {
 
 expect_resampling = function(r, task = NULL) {
   checkmate::expect_r6(r, "Resampling")
-  testthat::expect_output(print(r), "Resampling")
+  testthat::expect_message(print(r), "Resampling")
   expect_id(r$id)
   expect_man_exists(r$man)
 
@@ -514,7 +514,7 @@ expect_measure = function(m) {
   checkmate::expect_r6(m, "Measure", public = c("aggregate", "score", "id", "minimize", "packages", "range", "task_type", "task_properties"))
   expect_id(m$id)
   expect_man_exists(m$man)
-  testthat::expect_output(print(m), "Measure")
+  testthat::expect_message(print(m), "Measure")
 
   if ("requires_no_prediction" %in% m$properties) {
     testthat::expect_true(is.null(m$predict_sets))
@@ -536,7 +536,7 @@ expect_measure = function(m) {
 
 expect_prediction = function(p) {
   checkmate::expect_r6(p, "Prediction", public = c("row_ids", "truth", "predict_types"))
-  testthat::expect_output(print(p), "^<Prediction")
+  testthat::expect_message(print(p), "Prediction")
   checkmate::expect_data_table(data.table::as.data.table(p), nrows  = length(p$row_ids))
   checkmate::expect_integerish(p$missing)
 }
@@ -579,7 +579,7 @@ expect_prediction_classif = function(p, task = NULL) {
 expect_resample_result = function(rr, allow_incomplete = FALSE) {
   checkmate::expect_r6(rr, "ResampleResult")
   expect_resultdata(mlr3misc::get_private(rr)$.data, FALSE)
-  testthat::expect_output(print(rr), "ResampleResult")
+  testthat::expect_message(print(rr), "ResampleResult")
   nr = mlr3misc::get_private(rr)$.data$iterations()
 
   if (nr > 0L) {
@@ -616,7 +616,7 @@ expect_resample_result = function(rr, allow_incomplete = FALSE) {
 expect_benchmark_result = function(bmr) {
   checkmate::expect_r6(bmr, "BenchmarkResult", private = ".data")
   expect_resultdata(mlr3misc::get_private(bmr)$.data, TRUE)
-  testthat::expect_output(print(bmr), "BenchmarkResult")
+  testthat::expect_message(print(bmr), "BenchmarkResult")
 
   checkmate::expect_names(names(as.data.table(bmr)), permutation.of = c(mlr3::mlr_reflections$rr_names, "prediction", "uhash"))
 

tests/testthat/_snaps/Task.md

@@ -2,18 +2,20 @@
 
     Code
       task
-    Output
-      <TaskClassif:spam> (4601 x 58): HP Spam Detection
+    Message
+
+      -- TaskClassif (4601 x 58): HP Spam Detection ----------------------------------
       * Target: type
+      * Target classes: spam (positive class, 39%), nonspam (61%)
       * Properties: twoclass
       * Features (57):
-        - dbl (57): address, addresses, all, business, capitalAve,
-          capitalLong, capitalTotal, charDollar, charExclamation, charHash,
-          charRoundbracket, charSemicolon, charSquarebracket, conference,
-          credit, cs, data, direct, edu, email, font, free, george, hp, hpl,
-          internet, lab, labs, mail, make, meeting, money, num000, num1999,
-          num3d, num415, num650, num85, num857, order, original, our, over,
-          parts, people, pm, project, re, receive, remove, report, table,
-          technology, telnet, will, you, your
+        * dbl (57): address, addresses, all, business, capitalAve, capitalLong,
+        capitalTotal, charDollar, charExclamation, charHash, charRoundbracket,
+        charSemicolon, charSquarebracket, conference, credit, cs, data, direct, edu,
+        email, font, free, george, hp, hpl, internet, lab, labs, mail, make, meeting,
+        money, num000, num1999, num3d, num415, num650, num85, num857, order,
+        original, our, over, parts, people, pm, project, re, receive, remove, report,
+        table, technology, telnet, will, you, your
+    Output
       * Characteristics:  foo=1, bar=a
 

tests/testthat/test_Task.R

@@ -586,7 +586,7 @@ test_that("head/tail", {
 test_that("Roles get printed (#877)", {
   task = tsk("iris")
   task$col_roles$weight = "Petal.Width"
-  expect_output(print(task), "Weights: Petal.Width")
+  expect_message(print(task), "Weights: Petal.Width")
 })
 
 test_that("validation task is cloned", {
@@ -632,8 +632,7 @@ test_that("can NULL validation task", {
 test_that("internal_valid_task is printed", {
   task = tsk("iris")
   task$internal_valid_task = c(1:10, 51:60, 101:110)
-  out = capture_output(print(task))
-  expect_true(grepl(pattern = "* Validation Task: (30x5)", fixed = TRUE, x = out))
+  expect_message(print(task), "Validation Task: \\(30x5\\)")
 })
 
 test_that("task hashes during resample", {

tests/testthat/test_TaskClassif.R

@@ -45,7 +45,7 @@ test_that("Target is character/factor", {
 test_that("0 feature task", {
   b = as_data_backend(iris[, 5L, drop = FALSE])
   task = TaskClassif$new(id = "zero_feat_task", b, target = "Species")
-  expect_output(print(task))
+  expect_message(print(task))
   b = task$backend
   expect_backend(b)
   expect_task(task)

tests/testthat/test_TaskRegr.R

@@ -18,7 +18,7 @@ test_that("Target is numeric", {
 test_that("TaskRegr: 0 feature task", {
   b = as_data_backend(data.table(y = runif(20)))
   task = TaskRegr$new(id = "zero_feat_task", b, target = "y")
-  expect_output(print(task))
+  expect_message(print(task))
   b = task$backend
   expect_backend(b)
   expect_task(task)