From 5a31500f817ed7842930aee4d9e9a876315ea86d Mon Sep 17 00:00:00 2001 From: Tyler Burch Date: Sat, 25 Oct 2025 22:04:48 -0400 Subject: [PATCH 1/4] Add print methods for control objects with formatted output using cli --- R/control.R | 43 +++++++++++++++++++++++++++++++++--- tests/testthat/test-checks.R | 16 ++++++++++++++ 2 files changed, 56 insertions(+), 3 deletions(-) diff --git a/R/control.R b/R/control.R index 264f92d50..25adc245f 100644 --- a/R/control.R +++ b/R/control.R @@ -72,9 +72,44 @@ control_grid <- function( res } +# Helper function to print control settings using cli +print_control_settings <- function(x) { + # Get the fields to print + fields <- names(x) + + # Build formatted lines for each field + for (field in fields) { + value <- x[[field]] + + # Format the value based on type + if (is.null(value)) { + formatted_value <- "NULL" + } else if (is.function(value)) { + formatted_value <- "" + } else if (is.logical(value)) { + formatted_value <- as.character(value) + } else if (is.numeric(value)) { + formatted_value <- format(value) + } else if (is.character(value)) { + if (length(value) == 1) { + formatted_value <- paste0("'", value, "'") + } else { + formatted_value <- paste0("[", paste(value, collapse = ", "), "]") + } + } else if (inherits(value, "tune_backend_options")) { + formatted_value <- "" + } else { + formatted_value <- paste0("<", class(value)[1], ">") + } + + cli::cli_bullets(c(" " = paste0("{.field ", field, "}: ", formatted_value))) + } +} + #' @export print.control_grid <- function(x, ...) { - cat("grid/resamples control object\n") + cli::cli_text("{.emph Grid/resamples control object}") + print_control_settings(x) invisible(x) } @@ -116,7 +151,8 @@ control_last_fit <- function( #' @export print.control_last_fit <- function(x, ...) { - cat("last fit control object\n") + cli::cli_text("{.emph Last fit control object}") + print_control_settings(x) invisible(x) } @@ -303,7 +339,8 @@ control_bayes <- #' @export print.control_bayes <- function(x, ...) { - cat("bayes control object\n") + cli::cli_text("{.emph Bayes control object}") + print_control_settings(x) invisible(x) } diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index 4b5eb456e..eaeafa64c 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -395,6 +395,22 @@ test_that("Bayes control objects", { expect_s3_class(control_bayes(), "control_bayes") }) +test_that("control object print methods", { + # Test control_grid print + expect_snapshot(control_grid()) + expect_snapshot(control_grid(verbose = TRUE, save_pred = TRUE)) + expect_snapshot(control_grid(pkgs = c("pkg1", "pkg2"), extract = I)) + + # Test control_bayes print + set.seed(123) + expect_snapshot(control_bayes()) + expect_snapshot(control_bayes(verbose_iter = TRUE, no_improve = 5, save_gp_scoring = TRUE)) + + # Test control_last_fit print + expect_snapshot(control_last_fit()) + expect_snapshot(control_last_fit(verbose = TRUE)) +}) + # ------------------------------------------------------------------------------ test_that("initial values", { From 66287114267214ee2d8ef66869bcf88ce8a4e44e Mon Sep 17 00:00:00 2001 From: Tyler Burch Date: Sat, 25 Oct 2025 22:14:57 -0400 Subject: [PATCH 2/4] air formatting Co-authored-by: github-actions[bot] <41898282+github-actions[bot]@users.noreply.github.com> --- tests/testthat/test-checks.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index eaeafa64c..47409d938 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -404,7 +404,11 @@ test_that("control object print methods", { # Test control_bayes print set.seed(123) expect_snapshot(control_bayes()) - expect_snapshot(control_bayes(verbose_iter = TRUE, no_improve = 5, save_gp_scoring = TRUE)) + expect_snapshot(control_bayes( + verbose_iter = TRUE, + no_improve = 5, + save_gp_scoring = TRUE + )) # Test control_last_fit print expect_snapshot(control_last_fit()) From 562b54f4ea9cc0ee2fbbfe8ea0dc76b0008838e5 Mon Sep 17 00:00:00 2001 From: Tyler Burch Date: Tue, 28 Oct 2025 06:37:20 -0400 Subject: [PATCH 3/4] Add default param, use cli classes --- R/control.R | 53 +++++------ tests/testthat/_snaps/checks.md | 159 ++++++++++++++++++++++++++++++++ tests/testthat/test-checks.R | 13 +++ 3 files changed, 199 insertions(+), 26 deletions(-) diff --git a/R/control.R b/R/control.R index 25adc245f..2d06a91ee 100644 --- a/R/control.R +++ b/R/control.R @@ -73,43 +73,42 @@ control_grid <- function( } # Helper function to print control settings using cli -print_control_settings <- function(x) { +print_control_settings <- function(x, default = FALSE, defaults = NULL) { # Get the fields to print fields <- names(x) + # Optionally reduce to only non-defaults + if (default && !is.null(defaults)) { + fields <- fields[ + !vapply( + fields, + function(field) { + identical(x[[field]], defaults[[field]]) + }, + logical(1) + ) + ] + } + # Build formatted lines for each field for (field in fields) { value <- x[[field]] - # Format the value based on type - if (is.null(value)) { - formatted_value <- "NULL" - } else if (is.function(value)) { - formatted_value <- "" - } else if (is.logical(value)) { - formatted_value <- as.character(value) - } else if (is.numeric(value)) { - formatted_value <- format(value) - } else if (is.character(value)) { - if (length(value) == 1) { - formatted_value <- paste0("'", value, "'") - } else { - formatted_value <- paste0("[", paste(value, collapse = ", "), "]") - } + if (is.function(value)) { + cli::cli_bullets(c(" " = "{.arg {field}}: ")) } else if (inherits(value, "tune_backend_options")) { - formatted_value <- "" + cli::cli_bullets(c(" " = "{.arg {field}}: ")) } else { - formatted_value <- paste0("<", class(value)[1], ">") + cli::cli_bullets(c(" " = "{.arg {field}}: {.val {value}}")) } - - cli::cli_bullets(c(" " = paste0("{.field ", field, "}: ", formatted_value))) } } #' @export -print.control_grid <- function(x, ...) { +print.control_grid <- function(x, default = FALSE, ...) { cli::cli_text("{.emph Grid/resamples control object}") - print_control_settings(x) + defaults <- control_grid() + print_control_settings(x, default = default, defaults = defaults) invisible(x) } @@ -150,9 +149,10 @@ control_last_fit <- function( } #' @export -print.control_last_fit <- function(x, ...) { +print.control_last_fit <- function(x, default = FALSE, ...) { cli::cli_text("{.emph Last fit control object}") - print_control_settings(x) + defaults <- control_last_fit() + print_control_settings(x, default = default, defaults = defaults) invisible(x) } @@ -338,9 +338,10 @@ control_bayes <- } #' @export -print.control_bayes <- function(x, ...) { +print.control_bayes <- function(x, default = FALSE, ...) { cli::cli_text("{.emph Bayes control object}") - print_control_settings(x) + defaults <- control_bayes() + print_control_settings(x, default = default, defaults = defaults) invisible(x) } diff --git a/tests/testthat/_snaps/checks.md b/tests/testthat/_snaps/checks.md index 6d13c88b8..7f38b90f7 100644 --- a/tests/testthat/_snaps/checks.md +++ b/tests/testthat/_snaps/checks.md @@ -294,6 +294,165 @@ Warning: Uncertainty sample scheduled after 5 poor iterations but the search will stop after 2. +# control object print methods + + Code + control_grid() + Message + Grid/resamples control object + `verbose`: FALSE + `allow_par`: TRUE + `extract`: + `save_pred`: FALSE + `pkgs`: + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +--- + + Code + control_grid(verbose = TRUE, save_pred = TRUE) + Message + Grid/resamples control object + `verbose`: TRUE + `allow_par`: TRUE + `extract`: + `save_pred`: TRUE + `pkgs`: + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +--- + + Code + control_grid(pkgs = c("pkg1", "pkg2"), extract = I) + Message + Grid/resamples control object + `verbose`: FALSE + `allow_par`: TRUE + `extract`: + `save_pred`: FALSE + `pkgs`: "pkg1" and "pkg2" + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +--- + + Code + control_bayes() + Message + Bayes control object + `verbose`: FALSE + `verbose_iter`: FALSE + `allow_par`: TRUE + `no_improve`: 10 + `uncertain`: Inf + `seed`: 51663 + `extract`: + `save_pred`: FALSE + `time_limit`: NA + `pkgs`: + `save_workflow`: FALSE + `save_gp_scoring`: FALSE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +--- + + Code + control_bayes(verbose_iter = TRUE, no_improve = 5, save_gp_scoring = TRUE) + Message + Bayes control object + `verbose`: FALSE + `verbose_iter`: TRUE + `allow_par`: TRUE + `no_improve`: 5 + `uncertain`: Inf + `seed`: 2986 + `extract`: + `save_pred`: FALSE + `time_limit`: NA + `pkgs`: + `save_workflow`: FALSE + `save_gp_scoring`: TRUE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +--- + + Code + control_last_fit() + Message + Last fit control object + `verbose`: FALSE + `allow_par`: FALSE + `extract`: + `save_pred`: TRUE + `pkgs`: + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +--- + + Code + control_last_fit(verbose = TRUE) + Message + Last fit control object + `verbose`: TRUE + `allow_par`: FALSE + `extract`: + `save_pred`: TRUE + `pkgs`: + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: + `backend_options`: + `workflow_size`: 100 + +# control object print methods with default = TRUE + + Code + print(control_grid(verbose = TRUE, pkgs = c("pkg1", "pkg2")), default = TRUE) + Message + Grid/resamples control object + `verbose`: TRUE + `pkgs`: "pkg1" and "pkg2" + +--- + + Code + print(control_bayes(verbose_iter = TRUE, no_improve = 5), default = TRUE) + Message + Bayes control object + `verbose_iter`: TRUE + `no_improve`: 5 + `seed`: 13797 + +--- + + Code + print(control_last_fit(verbose = TRUE), default = TRUE) + Message + Last fit control object + `verbose`: TRUE + `extract`: + # initial values Code diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index 47409d938..ab8d116b7 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -415,6 +415,19 @@ test_that("control object print methods", { expect_snapshot(control_last_fit(verbose = TRUE)) }) +test_that("control object print methods with default = TRUE", { + expect_snapshot(print( + control_grid(verbose = TRUE, pkgs = c("pkg1", "pkg2")), + default = TRUE + )) + set.seed(456) + expect_snapshot(print( + control_bayes(verbose_iter = TRUE, no_improve = 5), + default = TRUE + )) + expect_snapshot(print(control_last_fit(verbose = TRUE), default = TRUE)) +}) + # ------------------------------------------------------------------------------ test_that("initial values", { From 6239b7c50681481537e10243eb7b5f575b787cf2 Mon Sep 17 00:00:00 2001 From: Tyler Burch Date: Sat, 8 Nov 2025 21:45:38 -0500 Subject: [PATCH 4/4] Add NULL handling --- R/control.R | 2 + tests/testthat/_snaps/checks.md | 159 ------------------------------- tests/testthat/_snaps/control.md | 159 +++++++++++++++++++++++++++++++ tests/testthat/test-checks.R | 33 ------- tests/testthat/test-control.R | 30 ++++++ 5 files changed, 191 insertions(+), 192 deletions(-) diff --git a/R/control.R b/R/control.R index 2d06a91ee..491fd9d54 100644 --- a/R/control.R +++ b/R/control.R @@ -98,6 +98,8 @@ print_control_settings <- function(x, default = FALSE, defaults = NULL) { cli::cli_bullets(c(" " = "{.arg {field}}: ")) } else if (inherits(value, "tune_backend_options")) { cli::cli_bullets(c(" " = "{.arg {field}}: ")) + } else if (is.null(value)) { + cli::cli_bullets(c(" " = "{.arg {field}}: NULL")) } else { cli::cli_bullets(c(" " = "{.arg {field}}: {.val {value}}")) } diff --git a/tests/testthat/_snaps/checks.md b/tests/testthat/_snaps/checks.md index 7f38b90f7..6d13c88b8 100644 --- a/tests/testthat/_snaps/checks.md +++ b/tests/testthat/_snaps/checks.md @@ -294,165 +294,6 @@ Warning: Uncertainty sample scheduled after 5 poor iterations but the search will stop after 2. -# control object print methods - - Code - control_grid() - Message - Grid/resamples control object - `verbose`: FALSE - `allow_par`: TRUE - `extract`: - `save_pred`: FALSE - `pkgs`: - `save_workflow`: FALSE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - ---- - - Code - control_grid(verbose = TRUE, save_pred = TRUE) - Message - Grid/resamples control object - `verbose`: TRUE - `allow_par`: TRUE - `extract`: - `save_pred`: TRUE - `pkgs`: - `save_workflow`: FALSE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - ---- - - Code - control_grid(pkgs = c("pkg1", "pkg2"), extract = I) - Message - Grid/resamples control object - `verbose`: FALSE - `allow_par`: TRUE - `extract`: - `save_pred`: FALSE - `pkgs`: "pkg1" and "pkg2" - `save_workflow`: FALSE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - ---- - - Code - control_bayes() - Message - Bayes control object - `verbose`: FALSE - `verbose_iter`: FALSE - `allow_par`: TRUE - `no_improve`: 10 - `uncertain`: Inf - `seed`: 51663 - `extract`: - `save_pred`: FALSE - `time_limit`: NA - `pkgs`: - `save_workflow`: FALSE - `save_gp_scoring`: FALSE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - ---- - - Code - control_bayes(verbose_iter = TRUE, no_improve = 5, save_gp_scoring = TRUE) - Message - Bayes control object - `verbose`: FALSE - `verbose_iter`: TRUE - `allow_par`: TRUE - `no_improve`: 5 - `uncertain`: Inf - `seed`: 2986 - `extract`: - `save_pred`: FALSE - `time_limit`: NA - `pkgs`: - `save_workflow`: FALSE - `save_gp_scoring`: TRUE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - ---- - - Code - control_last_fit() - Message - Last fit control object - `verbose`: FALSE - `allow_par`: FALSE - `extract`: - `save_pred`: TRUE - `pkgs`: - `save_workflow`: FALSE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - ---- - - Code - control_last_fit(verbose = TRUE) - Message - Last fit control object - `verbose`: TRUE - `allow_par`: FALSE - `extract`: - `save_pred`: TRUE - `pkgs`: - `save_workflow`: FALSE - `event_level`: "first" - `parallel_over`: - `backend_options`: - `workflow_size`: 100 - -# control object print methods with default = TRUE - - Code - print(control_grid(verbose = TRUE, pkgs = c("pkg1", "pkg2")), default = TRUE) - Message - Grid/resamples control object - `verbose`: TRUE - `pkgs`: "pkg1" and "pkg2" - ---- - - Code - print(control_bayes(verbose_iter = TRUE, no_improve = 5), default = TRUE) - Message - Bayes control object - `verbose_iter`: TRUE - `no_improve`: 5 - `seed`: 13797 - ---- - - Code - print(control_last_fit(verbose = TRUE), default = TRUE) - Message - Last fit control object - `verbose`: TRUE - `extract`: - # initial values Code diff --git a/tests/testthat/_snaps/control.md b/tests/testthat/_snaps/control.md index e747970c7..398ebfc2f 100644 --- a/tests/testthat/_snaps/control.md +++ b/tests/testthat/_snaps/control.md @@ -8,3 +8,162 @@ please set the control setting `save_workflow` to be `FALSE` or change the threshold for this warning (currently 2 MB) with the `workflow_size` argument. +# control object print methods + + Code + control_grid() + Message + Grid/resamples control object + `verbose`: FALSE + `allow_par`: TRUE + `extract`: NULL + `save_pred`: FALSE + `pkgs`: NULL + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +--- + + Code + control_grid(verbose = TRUE, save_pred = TRUE) + Message + Grid/resamples control object + `verbose`: TRUE + `allow_par`: TRUE + `extract`: NULL + `save_pred`: TRUE + `pkgs`: NULL + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +--- + + Code + control_grid(pkgs = c("pkg1", "pkg2"), extract = I) + Message + Grid/resamples control object + `verbose`: FALSE + `allow_par`: TRUE + `extract`: + `save_pred`: FALSE + `pkgs`: "pkg1" and "pkg2" + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +--- + + Code + control_bayes() + Message + Bayes control object + `verbose`: FALSE + `verbose_iter`: FALSE + `allow_par`: TRUE + `no_improve`: 10 + `uncertain`: Inf + `seed`: 51663 + `extract`: NULL + `save_pred`: FALSE + `time_limit`: NA + `pkgs`: NULL + `save_workflow`: FALSE + `save_gp_scoring`: FALSE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +--- + + Code + control_bayes(verbose_iter = TRUE, no_improve = 5, save_gp_scoring = TRUE) + Message + Bayes control object + `verbose`: FALSE + `verbose_iter`: TRUE + `allow_par`: TRUE + `no_improve`: 5 + `uncertain`: Inf + `seed`: 2986 + `extract`: NULL + `save_pred`: FALSE + `time_limit`: NA + `pkgs`: NULL + `save_workflow`: FALSE + `save_gp_scoring`: TRUE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +--- + + Code + control_last_fit() + Message + Last fit control object + `verbose`: FALSE + `allow_par`: FALSE + `extract`: + `save_pred`: TRUE + `pkgs`: NULL + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +--- + + Code + control_last_fit(verbose = TRUE) + Message + Last fit control object + `verbose`: TRUE + `allow_par`: FALSE + `extract`: + `save_pred`: TRUE + `pkgs`: NULL + `save_workflow`: FALSE + `event_level`: "first" + `parallel_over`: NULL + `backend_options`: NULL + `workflow_size`: 100 + +# control object print methods with default = TRUE + + Code + print(control_grid(verbose = TRUE, pkgs = c("pkg1", "pkg2")), default = TRUE) + Message + Grid/resamples control object + `verbose`: TRUE + `pkgs`: "pkg1" and "pkg2" + +--- + + Code + print(control_bayes(verbose_iter = TRUE, no_improve = 5), default = TRUE) + Message + Bayes control object + `verbose_iter`: TRUE + `no_improve`: 5 + `seed`: 13797 + +--- + + Code + print(control_last_fit(verbose = TRUE), default = TRUE) + Message + Last fit control object + `verbose`: TRUE + `extract`: + diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R index ab8d116b7..4b5eb456e 100644 --- a/tests/testthat/test-checks.R +++ b/tests/testthat/test-checks.R @@ -395,39 +395,6 @@ test_that("Bayes control objects", { expect_s3_class(control_bayes(), "control_bayes") }) -test_that("control object print methods", { - # Test control_grid print - expect_snapshot(control_grid()) - expect_snapshot(control_grid(verbose = TRUE, save_pred = TRUE)) - expect_snapshot(control_grid(pkgs = c("pkg1", "pkg2"), extract = I)) - - # Test control_bayes print - set.seed(123) - expect_snapshot(control_bayes()) - expect_snapshot(control_bayes( - verbose_iter = TRUE, - no_improve = 5, - save_gp_scoring = TRUE - )) - - # Test control_last_fit print - expect_snapshot(control_last_fit()) - expect_snapshot(control_last_fit(verbose = TRUE)) -}) - -test_that("control object print methods with default = TRUE", { - expect_snapshot(print( - control_grid(verbose = TRUE, pkgs = c("pkg1", "pkg2")), - default = TRUE - )) - set.seed(456) - expect_snapshot(print( - control_bayes(verbose_iter = TRUE, no_improve = 5), - default = TRUE - )) - expect_snapshot(print(control_last_fit(verbose = TRUE), default = TRUE)) -}) - # ------------------------------------------------------------------------------ test_that("initial values", { diff --git a/tests/testthat/test-control.R b/tests/testthat/test-control.R index 8f7f48f37..8b074621b 100644 --- a/tests/testthat/test-control.R +++ b/tests/testthat/test-control.R @@ -38,3 +38,33 @@ test_that("workflow size warning", { ) }) }) + +test_that("control object print methods", { + expect_snapshot(control_grid()) + expect_snapshot(control_grid(verbose = TRUE, save_pred = TRUE)) + expect_snapshot(control_grid(pkgs = c("pkg1", "pkg2"), extract = I)) + + set.seed(123) + expect_snapshot(control_bayes()) + expect_snapshot(control_bayes( + verbose_iter = TRUE, + no_improve = 5, + save_gp_scoring = TRUE + )) + + expect_snapshot(control_last_fit()) + expect_snapshot(control_last_fit(verbose = TRUE)) +}) + +test_that("control object print methods with default = TRUE", { + expect_snapshot(print( + control_grid(verbose = TRUE, pkgs = c("pkg1", "pkg2")), + default = TRUE + )) + set.seed(456) + expect_snapshot(print( + control_bayes(verbose_iter = TRUE, no_improve = 5), + default = TRUE + )) + expect_snapshot(print(control_last_fit(verbose = TRUE), default = TRUE)) +})