feat: add cli package for class printer

DESCRIPTION

@@ -48,14 +48,15 @@ Imports:
     R6 (>= 2.4.1),
     backports (>= 1.5.0),
     checkmate (>= 2.0.0),
+    cli,
     data.table (>= 1.15.0),
     evaluate,
     future,
     future.apply (>= 1.5.0),
     lgr (>= 0.3.4),
     mlbench,
     mlr3measures (>= 1.0.0),
-    mlr3misc (>= 0.15.0),
+    mlr3misc (>= 0.17.0),
     parallelly,
     palmerpenguins,
     paradox (>= 1.0.1),
@@ -72,8 +73,6 @@ Suggests:
     RhpcBLASctl,
     rpart,
     testthat (>= 3.2.0)
-Remotes:
-    mlr-org/mlr3misc
 Encoding: UTF-8
 Config/testthat/edition: 3
 Config/testthat/parallel: false

NAMESPACE

@@ -273,6 +273,7 @@ export(uhashes)
 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))
+      cat_cli(cli_h1("{.cls {class(self)[1L]}} of {.val {private$.data$iterations()}} rows with {.val {nrow(tab)}} resampling run"))
       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)
+      cat_cli(cli_h1("{.cls {class(self)[1L]}} ({.val {nr}}x{.val {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))
+      cat_cli(cli_h1("{.cls {class(self)[1L]}}"))
       print(self$stack, digits = 2)
     }
   ),

R/Learner.R

@@ -254,23 +254,37 @@ 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("* Encapsulation:", paste0(self$encapsulation[[1]], " (fallback: ", if (is.null(self$fallback)) "-" else class(self$fallback)[[1L]], ")")))
-      catn(str_indent("* Properties:", self$properties))
-      catn(str_indent("* Other settings:", paste0("use_weights = '", self$use_weights, "'")))
+      msg_h =  if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)
+      model =  if (is.null(self$model)) "-" else if (is_marshaled_model(self$model)) "<marshaled>" else paste0(class(self$model)[1L])
+
+      cat_cli({
+        cli_h1("{.cls {class(self)[1L]}} ({self$id}){msg_h}")
+        cli_li("Model: {model}")
+        cli_li("Parameters: {as_short_string(self$param_set$values, 1000L)}")
+      })
+
+      if (exists("validate", self)) cat_cli(cli_li("Validate: {.cls {class(self$validate[1])}} {self$validate$id}"))
+      cat_cli(cli_li("Packages: {.pkg {self$packages}}"))
+
+      pred_typs = replace(self$predict_types, self$predict_types == self$predict_type, paste0("[", self$predict_type, "]"))
+      encapsulation = self$encapsulation[[1]]
+      fallback = if (encapsulation != 'none') class(self$fallback)[[1L]] else "-"
+
+      cat_cli({
+        cli_li("Predict Types: {pred_typs}")
+        cli_li("Feature Types: {self$feature_types}")
+        cli_li("Encapsulation: {encapsulation} (fallback: {fallback})")
+        cli_li("Properties: {self$properties}")
+        cli_li("Other settings: use_weights = '{self$use_weights}'")
+      })
+
       w = self$warnings
       e = self$errors
       if (length(w)) {
-        catn(str_indent("* Warnings:", w))
+        cat_cli(cli_alert_warning("Warnings: {w}"))
       }
       if (length(e)) {
-        catn(str_indent("* Errors:", e))
+        cat_cli(cli_alert_danger("Errors: {e}"))
       }
     },
 

R/Measure.R

@@ -183,15 +183,20 @@ 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))
-      catn(str_indent("* Aggregator:", if (is.null(self$aggregator)) "mean()" else "[user-defined]"))
+      msg_h = if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)
+      msg_properties = if (length(self$properties)) self$properties else "-"
+      cat_cli({
+        cli_h1("{.cls {class(self)[1L]}} ({self$id}){msg_h}")
+        cli_li("Packages: {.pkg {self$packages}}")
+        cli_li("Range: [{self$range[1L]}, {self$range[2L]}]")
+        cli_li("Minimize: {.val {self$minimize}}")
+        cli_li("Average: {self$average}")
+        cli_li("Parameters: {as_short_string(self$param_set$values, 1000L)}")
+        cli_li("Properties: {msg_properties}")
+        cli_li("Predict type: {self$predict_type}")
+        cli_li("Predict sets: {self$predict_sets}")
+        cli_li("Aggregator: {if (is.null(self$aggregator)) 'mean()' else '[user-defined]'}")
+      })
     },
 
     #' @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))
+        cat_cli(cli_h1("{.cls {class(self)[1L]}} for {.val 0} observations"))
       } else {
         data = as.data.table(self)
-        catf("%s for %i observations:", format(self), n)
+        cat_cli(cli_h1("{.cls {class(self)[1L]}} for {.val {n}} observations:"))
         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)
+      cat_cli(cli_h1("{.cls {class(self)[1L]}} with {.val {self$iters}} resampling iterations"))
       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

@@ -145,10 +145,13 @@ 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)))
+      msg_h = if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)
+      cat_cli({
+        cli_h1("{.cls {class(self)[1L]}} {msg_h}")
+        cli_li("Iterations: {.val {self$iters}}")
+        cli_li("Instantiated: {.val {self$is_instantiated}}")
+        cli_li("Parameters: {as_short_string(self$param_set$values, 1000L)}")
+      })
     },
 
     #' @description

R/Task.R

@@ -214,44 +214,69 @@ 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))
+      msg_h = if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)
+      cat_cli(cli_h1("{.cls {class(self)[1L]}} ({self$nrow}x{self$ncol}){msg_h}"))
 
       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 %chin% names(roles)], function(role, str) {
-        catn(str_indent(sprintf("* %s:", str), roles[[role]]))
+        cat_cli(cli_li("{str}: {roles[[role]]}"))
       })
 
-      catf(str_indent("* Target:", self$target_names))
-      catf(str_indent("* Properties:", self$properties))
+      cat_cli(cli_li("Target: {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 = ", ")
+        }
+        cat_cli(cli_li("Target classes: {classes}"))
+      }
+
+      properties = if (length(self$properties)) paste(self$properties, collapse = ", ") else "-"
+      cat_cli(cli_li("Properties: {properties}"))
 
       types = self$feature_types
-      if (nrow(types)) {
-        id = type = NULL
-        catf("* 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)
-        pmap(types, function(type, N, feats) {
-          catn(str_indent(sprintf("  - %s (%i):", type, N), feats, exdent = 4L))
-        })
-      }
+
+      cat_cli({
+        if (nrow(types)) {
+          id = type = NULL
+          cli_li("Features ({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) {
+            cli_li("{type} ({N}): {feats}")
+          })
+          cli_end(ulid)
+        }
+      })
+
 
       # print additional columns are specified in reflections
       after = mlr_reflections$task_print_col_roles$after
       iwalk(after[after %chin% names(roles)], function(role, str) {
-        catn(str_indent(sprintf("* %s:", str), roles[[role]]))
+        cat_cli(cli_li("{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)))
+        cat_cli(cli_li("Validation Task: ({private$.internal_valid_task$nrow}x{private$.internal_valid_task$ncol})"))
       }
 
       if (!is.null(self$characteristics)) {
-        catf(str_indent("* Characteristics: ", as_short_string(self$characteristics)))
+        cat_cli(cli_li("Characteristics: {as_short_string(self$characteristics)}"))
       }
     },
 

R/TaskGenerator.R

@@ -60,11 +60,14 @@ 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)))
+      cat_cli({
+        msg_h = if (is.null(self$label) || is.na(self$label)) "" else paste0(": ", self$label)
+        cli_h1("{.cls {class(self)[1L]}} ({self$id}){msg_h}")
+        cli_li("Task type: {self$task_type}")
+        cli_li("Packages: {.pkg {self$packages}}")
+        cli_li("Parameters: {as_short_string(self$param_set$values, 1000L)}")
+        cli_li("Manual: {.help {self$man}}")
+      })
     },
 
     #' @description

R/score_roc_measures.R

@@ -94,20 +94,23 @@ print.roc_measures = function(x, abbreviations = TRUE, digits = 2, ...) {
     c(x$measures[["fdr"]], x$measures[["npv"]], x$measures[["lr_minus"]], x$measures[["dor"]]))
 
   names(dimnames(res)) = c("true", "predicted")
+  cat_cli({cli_h2("ROC Measures")})
   print(noquote(res))
   if (abbreviations) {
-    catn("Abbreviations:")
-    catn("tpr - True positive rate (Sensitivity, Recall)")
-    catn("fpr - False positive rate (Fall-out)")
-    catn("fnr - False negative rate (Miss rate)")
-    catn("tnr - True negative rate (Specificity)")
-    catn("ppv - Positive predictive value (Precision)")
-    catn("fomr - False omission rate")
-    catn("lrp - Positive likelihood ratio (LR+)")
-    catn("fdr - False discovery rate")
-    catn("npv - Negative predictive value")
-    catn("acc - Accuracy")
-    catn("lrm - Negative likelihood ratio (LR-)")
-    catn("dor - Diagnostic odds ratio")
+    cat_cli({
+      cli_h3("Abbreviations:")
+      cli_li("tpr - True positive rate (Sensitivity, Recall)")
+      cli_li("fpr - False positive rate (Fall-out)")
+      cli_li("fnr - False negative rate (Miss rate)")
+      cli_li("tnr - True negative rate (Specificity)")
+      cli_li("ppv - Positive predictive value (Precision)")
+      cli_li("fomr - False omission rate")
+      cli_li("lrp - Positive likelihood ratio (LR+)")
+      cli_li("fdr - False discovery rate")
+      cli_li("npv - Negative predictive value")
+      cli_li("acc - Accuracy")
+      cli_li("lrm - Negative likelihood ratio (LR-)")
+      cli_li("dor - Diagnostic odds ratio")
+    })
   }
 }

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_output(print(b), "DataBackend")
 
   n = checkmate::expect_count(b$nrow)
   p = checkmate::expect_count(b$ncol)
@@ -538,7 +538,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_output(print(p), "Prediction")
   checkmate::expect_data_table(data.table::as.data.table(p), nrows  = length(p$row_ids))
   checkmate::expect_integerish(p$missing)
 }

tests/testthat/_snaps/Task.md

@@ -3,17 +3,18 @@
     Code
       task
     Output
-      <TaskClassif:spam> (4601 x 58): HP Spam Detection
+
+      -- <TaskClassif> (4601x58): 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
-      * Characteristics:  foo=1, bar=a
+        * 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
+      * Characteristics: foo=1, bar=a
 

tests/testthat/test_Task.R

@@ -657,8 +657,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_match(out, "* Validation Task: (30x5)", fixed = TRUE)
+  expect_output(print(task), "Validation Task: \\(30x5\\)")
 })
 
 test_that("task hashes during resample", {