From 6ac33b9b91911bdc94060a91bc885ccd67319067 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Wed, 27 Oct 2021 06:54:10 +0200 Subject: [PATCH 01/17] Draft implementation --- R/print-str.R | 74 +++++++++++++++++++++++++++++++++++++++++------- R/type-list-of.R | 11 ++++--- R/utils.R | 12 ++++++++ 3 files changed, 82 insertions(+), 15 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index e04c6ac71..bbb690b5e 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -9,18 +9,26 @@ #' @param x A vector #' @param ... Additional arguments passed on to methods. See [print()] and #' [str()] for commonly used options +#' @param max The maximum number of items to print, defaults to +#' `getOption("print.max")`. #' @keywords internal #' @export -obj_print <- function(x, ...) { - obj_print_header(x, ...) - obj_print_data(x, ...) - obj_print_footer(x, ...) +obj_print <- function(x, ..., max = NULL) { + max <- get_max_print(max) + obj_print_header_dispatch(x, ..., max = max) + obj_print_data_dispatch(x, ..., max = max) + obj_print_footer_dispatch(x, ..., max = max) invisible(x) } #' @export #' @rdname obj_print -obj_print_header <- function(x, ...) { +obj_print_header <- function(x, ..., max = NULL) { + max <- get_max_print(max) + return(obj_print_header_dispatch(x, ..., max = max)) + UseMethod("obj_print_header") +} +obj_print_header_dispatch <- function(x, ..., max) { UseMethod("obj_print_header") } @@ -32,16 +40,33 @@ obj_print_header.default <- function(x, ...) { #' @export #' @rdname obj_print -obj_print_data <- function(x, ...) { +obj_print_data <- function(x, ..., max) { + max <- get_max_print(max) + return(obj_print_data_dispatch(x, ..., max = max)) + UseMethod("obj_print_data") +} +obj_print_data_dispatch <- function(x, ..., max) { UseMethod("obj_print_data") } #' @export -obj_print_data.default <- function(x, ...) { - if (length(x) == 0) +obj_print_data.default <- function(x, ..., max) { + if (!vec_is(x)) { + print(x, quote = FALSE) return(invisible(x)) + } + + if (vec_size(x) > max) { + x_max <- vec_slice(x, seq_len(max)) + } else { + x_max <- x + } + + if (vec_size(x_max) == 0) { + return(invisible(x)) + } - out <- stats::setNames(format(x), names(x)) + out <- stats::setNames(format(x_max), names(x_max)) print(out, quote = FALSE) invisible(x) @@ -49,15 +74,42 @@ obj_print_data.default <- function(x, ...) { #' @export #' @rdname obj_print -obj_print_footer <- function(x, ...) { +obj_print_footer <- function(x, ..., max = NULL) { + max <- get_max_print(max) + return(obj_print_footer_dispatch(x, ..., max = max)) + UseMethod("obj_print_footer") +} +obj_print_footer_dispatch <- function(x, ..., max) { UseMethod("obj_print_footer") } #' @export -obj_print_footer.default <- function(x, ...) { +obj_print_footer.default <- function(x, ..., max = NULL) { + if (!vec_is(x)) { + return(invisible(x)) + } + + delta <- vec_size(x) - max + if (delta > 0) { + cat_line("... and ", big_mark(delta), " more") + } invisible(x) } +get_max_print <- function(max, frame = parent.frame()) { + max_print <- getOption("max.print") + if (is.null(max)) { + return(max_print) + } + + stopifnot(is_integerish(max, 1L, finite = TRUE), max >= 0) + if (max > max_print) { + # Avoid truncation in case we're forwarding to print() + local_options(max.print = max, .frame = frame) + } + max +} + # str --------------------------------------------------------------------- diff --git a/R/type-list-of.R b/R/type-list-of.R index ff99360b5..3d99631f8 100644 --- a/R/type-list-of.R +++ b/R/type-list-of.R @@ -101,11 +101,14 @@ vec_proxy.vctrs_list_of <- function(x, ...) { # Formatting -------------------------------------------------------------- #' @export -obj_print_data.vctrs_list_of <- function(x, ...) { - if (length(x) == 0) - return() +obj_print_data.vctrs_list_of <- function(x, ..., max) { + out <- vec_data(x) + if (max < length(out)) { + out <- out[seq_len(max)] + } - print(vec_data(x)) + print(out) + invisible(x) } #' @export diff --git a/R/utils.R b/R/utils.R index 8fadd8706..c413ce1ab 100644 --- a/R/utils.R +++ b/R/utils.R @@ -284,3 +284,15 @@ named <- function(x) { } x } + +# copied from piller +# function for the thousand separator, +# returns "," unless it's used for the decimal point, in which case returns "." +big_mark <- function(x) { + # The thousand separator, + # "," unless it's used for the decimal point, in which case "." + mark <- if (identical(getOption("OutDec"), ",")) "." else "," + ret <- formatC(x, big.mark = mark, format = "d", preserve.width = "individual") + ret[is.na(x)] <- "??" + ret +} From 35186b7acf107a4a6685cac7cf5a3ba01c1c7fd6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Wed, 27 Oct 2021 07:05:13 +0200 Subject: [PATCH 02/17] Add tests --- tests/testthat/_snaps/print-str.md | 55 +++++++++++++++++++++++++++ tests/testthat/_snaps/type-list-of.md | 11 ++++++ tests/testthat/test-print-str.R | 35 +++++++++++++++++ tests/testthat/test-type-list-of.R | 1 + 4 files changed, 102 insertions(+) diff --git a/tests/testthat/_snaps/print-str.md b/tests/testthat/_snaps/print-str.md index 78dd3db92..c609cd06e 100644 --- a/tests/testthat/_snaps/print-str.md +++ b/tests/testthat/_snaps/print-str.md @@ -29,3 +29,58 @@ $ carb: num 4 4 1 1 2 1 4 2 2 4 ... @ row.names: chr [1:32] "Mazda RX4" "Mazda RX4 Wag" "Datsun 710" "Hornet 4 Drive" ... +# max argument (#1355) + + Code + x <- vctrs::new_vctr(letters) + print(x, max = 5) + Output + + [1] a b c d e + ... and 21 more + Code + print(x, max = 30) + Output + + [1] a b c d e f g h i j k l m n o p q r s t u v w x y z + +# small max.print option (#1355) + + Code + x <- vctrs::new_vctr(letters) + print(x) + Output + + [1] a b c d e + ... and 21 more + +# large max.print option (#1355) + + Code + x <- vctrs::new_vctr(letters) + print(x) + Output + + [1] a b c d e f g h i j k l m n o p q r s t u v w x y z + +# both max argument and max.print option (#1355) + + Code + x <- vctrs::new_vctr(letters) + print(x, max = 5) + Output + + [1] a b c d e + ... and 21 more + Code + print(x, max = 20) + Output + + [1] a b c d e f g h i j k l m n o p q r s t + ... and 6 more + Code + print(x, max = 30) + Output + + [1] a b c d e f g h i j k l m n o p q r s t u v w x y z + diff --git a/tests/testthat/_snaps/type-list-of.md b/tests/testthat/_snaps/type-list-of.md index 5c46e692c..1ff19159d 100644 --- a/tests/testthat/_snaps/type-list-of.md +++ b/tests/testthat/_snaps/type-list-of.md @@ -11,6 +11,17 @@ [1] 2 3 +--- + + Code + print(list_of(1, 2:3), max = 1) + Output + [2]> + [[1]] + [1] 1 + + ... and 1 more + --- Code diff --git a/tests/testthat/test-print-str.R b/tests/testthat/test-print-str.R index d84a85cb4..696fdd300 100644 --- a/tests/testthat/test-print-str.R +++ b/tests/testthat/test-print-str.R @@ -5,3 +5,38 @@ test_that("show attributes", { expect_snapshot(obj_str(mtcars)) }) + +test_that("max argument (#1355)", { + expect_snapshot({ + x <- vctrs::new_vctr(letters) + print(x, max = 5) + print(x, max = 30) + }) +}) + +test_that("small max.print option (#1355)", { + local_options(max.print = 5) + expect_snapshot({ + x <- vctrs::new_vctr(letters) + print(x) + }) +}) + +test_that("large max.print option (#1355)", { + local_options(max.print = 30) + expect_snapshot({ + x <- vctrs::new_vctr(letters) + print(x) + }) +}) + +test_that("both max argument and max.print option (#1355)", { + local_options(max.print = 10) + + expect_snapshot({ + x <- vctrs::new_vctr(letters) + print(x, max = 5) + print(x, max = 20) + print(x, max = 30) + }) +}) diff --git a/tests/testthat/test-type-list-of.R b/tests/testthat/test-type-list-of.R index 493c46a0e..8ecd732f1 100644 --- a/tests/testthat/test-type-list-of.R +++ b/tests/testthat/test-type-list-of.R @@ -41,6 +41,7 @@ test_that("is_list_of as expected", { test_that("print method gives human friendly output", { skip_on_cran() # Depends on tibble expect_snapshot(list_of(1, 2:3)) + expect_snapshot(print(list_of(1, 2:3), max = 1)) expect_snapshot(tibble::tibble(x = list_of(1, 2:3))) }) From dc20934f2e48385dbeb2f77f81a2e3b3ab31986e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Wed, 27 Oct 2021 07:07:38 +0200 Subject: [PATCH 03/17] NEWS --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index c6fcd0980..b05c2e4af 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # vctrs (development version) +* `obj_print()`, `obj_print_header()`, `obj_print_data()` and + `obj_print_footer()` gain `max` argument that controls the maximum number + of items to print. By default, `getOption("max.print")` is consulted + (#1355, @krlmlr). + * `vec_assert()` produces a more informative error when `size` is invalid (#1470). From 611f2615e8ff9a88ac28bce39d202f1cd9a0ef68 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Wed, 27 Oct 2021 07:09:12 +0200 Subject: [PATCH 04/17] Document --- man/obj_print.Rd | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/man/obj_print.Rd b/man/obj_print.Rd index 895ee69c8..e2a99cd3b 100644 --- a/man/obj_print.Rd +++ b/man/obj_print.Rd @@ -11,13 +11,13 @@ \alias{obj_str_footer} \title{\code{print()} and \code{str()} generics.} \usage{ -obj_print(x, ...) +obj_print(x, ..., max = NULL) -obj_print_header(x, ...) +obj_print_header(x, ..., max = NULL) -obj_print_data(x, ...) +obj_print_data(x, ..., max) -obj_print_footer(x, ...) +obj_print_footer(x, ..., max = NULL) obj_str(x, ...) @@ -32,6 +32,9 @@ obj_str_footer(x, ...) \item{...}{Additional arguments passed on to methods. See \code{\link[=print]{print()}} and \code{\link[=str]{str()}} for commonly used options} + +\item{max}{The maximum number of items to print, defaults to +\code{getOption("print.max")}.} } \description{ These are constructed to be more easily extensible since you can override From 475365734acc2bdab6266947fefa2644412f81dd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Wed, 27 Oct 2021 18:40:44 +0200 Subject: [PATCH 05/17] Sentence case. --- R/utils.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/utils.R b/R/utils.R index c413ce1ab..507a20096 100644 --- a/R/utils.R +++ b/R/utils.R @@ -285,9 +285,10 @@ named <- function(x) { x } -# copied from piller -# function for the thousand separator, -# returns "," unless it's used for the decimal point, in which case returns "." +# Copied from pillar. +# +# Function for the thousand separator, returns "," unless it's used for the +# decimal point, in which case returns "." big_mark <- function(x) { # The thousand separator, # "," unless it's used for the decimal point, in which case "." From 9b806f997c371b4474492e6b4f04227d10976793 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Wed, 27 Oct 2021 18:41:13 +0200 Subject: [PATCH 06/17] local_max_print() --- R/print-str.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index bbb690b5e..8a31ba775 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -14,7 +14,7 @@ #' @keywords internal #' @export obj_print <- function(x, ..., max = NULL) { - max <- get_max_print(max) + max <- local_max_print(max) obj_print_header_dispatch(x, ..., max = max) obj_print_data_dispatch(x, ..., max = max) obj_print_footer_dispatch(x, ..., max = max) @@ -24,7 +24,7 @@ obj_print <- function(x, ..., max = NULL) { #' @export #' @rdname obj_print obj_print_header <- function(x, ..., max = NULL) { - max <- get_max_print(max) + max <- local_max_print(max) return(obj_print_header_dispatch(x, ..., max = max)) UseMethod("obj_print_header") } @@ -41,7 +41,7 @@ obj_print_header.default <- function(x, ...) { #' @export #' @rdname obj_print obj_print_data <- function(x, ..., max) { - max <- get_max_print(max) + max <- local_max_print(max) return(obj_print_data_dispatch(x, ..., max = max)) UseMethod("obj_print_data") } @@ -75,7 +75,7 @@ obj_print_data.default <- function(x, ..., max) { #' @export #' @rdname obj_print obj_print_footer <- function(x, ..., max = NULL) { - max <- get_max_print(max) + max <- local_max_print(max) return(obj_print_footer_dispatch(x, ..., max = max)) UseMethod("obj_print_footer") } @@ -96,7 +96,7 @@ obj_print_footer.default <- function(x, ..., max = NULL) { invisible(x) } -get_max_print <- function(max, frame = parent.frame()) { +local_max_print <- function(max, frame = parent.frame()) { max_print <- getOption("max.print") if (is.null(max)) { return(max_print) From 7516e5f38d7e53de39198afd5b6f56260cacb4d3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 29 Oct 2021 16:10:40 +0200 Subject: [PATCH 07/17] Apply suggestions from code review Good catch @DavisVaughan! Co-authored-by: Davis Vaughan --- R/print-str.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index 8a31ba775..d6600c9f2 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -40,7 +40,7 @@ obj_print_header.default <- function(x, ...) { #' @export #' @rdname obj_print -obj_print_data <- function(x, ..., max) { +obj_print_data <- function(x, ..., max = NULL) { max <- local_max_print(max) return(obj_print_data_dispatch(x, ..., max = max)) UseMethod("obj_print_data") @@ -84,7 +84,7 @@ obj_print_footer_dispatch <- function(x, ..., max) { } #' @export -obj_print_footer.default <- function(x, ..., max = NULL) { +obj_print_footer.default <- function(x, ..., max) { if (!vec_is(x)) { return(invisible(x)) } From 9d0c1fe9240d55efd91b57deffabe44128179065 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 29 Oct 2021 16:34:46 +0200 Subject: [PATCH 08/17] Suggest remedy if truncated --- R/print-str.R | 15 +++++++++++++-- tests/testthat/_snaps/print-str.md | 4 ++++ tests/testthat/_snaps/type-list-of.md | 1 + 3 files changed, 18 insertions(+), 2 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index d6600c9f2..5a6fa066e 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -91,7 +91,17 @@ obj_print_footer.default <- function(x, ..., max) { delta <- vec_size(x) - max if (delta > 0) { + max_print <- attr(max, "max_print") + if (is.null(max_print)) { + max_print <- getOption("max.print") + } + cat_line("... and ", big_mark(delta), " more") + if (max < max_print) { + cat_line("Set `max` to a larger value to show all items.") + } else { + cat_line("Set `options(max.print = )` to a larger value to show all items.") + } } invisible(x) } @@ -99,7 +109,7 @@ obj_print_footer.default <- function(x, ..., max) { local_max_print <- function(max, frame = parent.frame()) { max_print <- getOption("max.print") if (is.null(max)) { - return(max_print) + max <- max_print } stopifnot(is_integerish(max, 1L, finite = TRUE), max >= 0) @@ -107,7 +117,8 @@ local_max_print <- function(max, frame = parent.frame()) { # Avoid truncation in case we're forwarding to print() local_options(max.print = max, .frame = frame) } - max + + structure(max, max_print = max_print) } diff --git a/tests/testthat/_snaps/print-str.md b/tests/testthat/_snaps/print-str.md index c609cd06e..b608de37e 100644 --- a/tests/testthat/_snaps/print-str.md +++ b/tests/testthat/_snaps/print-str.md @@ -38,6 +38,7 @@ [1] a b c d e ... and 21 more + Set `max` to a larger value to show all items. Code print(x, max = 30) Output @@ -53,6 +54,7 @@ [1] a b c d e ... and 21 more + Set `options(max.print = )` to a larger value to show all items. # large max.print option (#1355) @@ -72,12 +74,14 @@ [1] a b c d e ... and 21 more + Set `max` to a larger value to show all items. Code print(x, max = 20) Output [1] a b c d e f g h i j k l m n o p q r s t ... and 6 more + Set `options(max.print = )` to a larger value to show all items. Code print(x, max = 30) Output diff --git a/tests/testthat/_snaps/type-list-of.md b/tests/testthat/_snaps/type-list-of.md index 1ff19159d..62798b284 100644 --- a/tests/testthat/_snaps/type-list-of.md +++ b/tests/testthat/_snaps/type-list-of.md @@ -21,6 +21,7 @@ [1] 1 ... and 1 more + Set `max` to a larger value to show all items. --- From ce01ffb55c5b5db7442d8a6f92f0b1d1aff7c458 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 29 Oct 2021 16:40:25 +0200 Subject: [PATCH 09/17] Document max argument --- R/print-str.R | 10 +++++++++- man/obj_print.Rd | 6 ++++++ 2 files changed, 15 insertions(+), 1 deletion(-) diff --git a/R/print-str.R b/R/print-str.R index 5a6fa066e..f59a91a01 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -6,6 +6,12 @@ #' the `_header()`, `_data()` or `_footer()` components individually. The #' default methods are built on top of `format()`. #' +#' @details +#' If you are implementing `obj_print_header()`, `obj_print_data()` or +#' `obj_print_footer()`, your method can assume that the `max` argument +#' is a scalar integer that accurately describes the maximum number of items +#' to print, and that `getOption("max.print")` is set to at least that value. +#' #' @param x A vector #' @param ... Additional arguments passed on to methods. See [print()] and #' [str()] for commonly used options @@ -112,7 +118,9 @@ local_max_print <- function(max, frame = parent.frame()) { max <- max_print } - stopifnot(is_integerish(max, 1L, finite = TRUE), max >= 0) + stopifnot(is_integerish(max, 1L, finite = TRUE), max >= 0, max < 2147483648) + max <- as.integer(max) + if (max > max_print) { # Avoid truncation in case we're forwarding to print() local_options(max.print = max, .frame = frame) diff --git a/man/obj_print.Rd b/man/obj_print.Rd index e2a99cd3b..b6f96d527 100644 --- a/man/obj_print.Rd +++ b/man/obj_print.Rd @@ -41,4 +41,10 @@ These are constructed to be more easily extensible since you can override the \verb{_header()}, \verb{_data()} or \verb{_footer()} components individually. The default methods are built on top of \code{format()}. } +\details{ +If you are implementing \code{obj_print_header()}, \code{obj_print_data()} or +\code{obj_print_footer()}, your method can assume that the \code{max} argument +is a scalar integer that accurately describes the maximum number of items +to print, and that \code{getOption("max.print")} is set to at least that value. +} \keyword{internal} From 10d508436be6b146bb104d2a8052c7f20083105c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 29 Oct 2021 16:40:31 +0200 Subject: [PATCH 10/17] Document --- man/obj_print.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/obj_print.Rd b/man/obj_print.Rd index b6f96d527..67bc5bd45 100644 --- a/man/obj_print.Rd +++ b/man/obj_print.Rd @@ -15,7 +15,7 @@ obj_print(x, ..., max = NULL) obj_print_header(x, ..., max = NULL) -obj_print_data(x, ..., max) +obj_print_data(x, ..., max = NULL) obj_print_footer(x, ..., max = NULL) From 667e321dc6c2035b7c62c1337c642818e4935b5f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 29 Oct 2021 16:43:03 +0200 Subject: [PATCH 11/17] Add test for list_of corner cases --- R/type-list-of.R | 6 +++++- tests/testthat/_snaps/type-list-of.md | 16 ++++++++++++++++ tests/testthat/test-type-list-of.R | 2 ++ 3 files changed, 23 insertions(+), 1 deletion(-) diff --git a/R/type-list-of.R b/R/type-list-of.R index 3d99631f8..1c1cf0035 100644 --- a/R/type-list-of.R +++ b/R/type-list-of.R @@ -107,7 +107,11 @@ obj_print_data.vctrs_list_of <- function(x, ..., max) { out <- out[seq_len(max)] } - print(out) + # Zero-length lists handled by header and footer + if (length(out) > 0) { + print(out) + } + invisible(x) } diff --git a/tests/testthat/_snaps/type-list-of.md b/tests/testthat/_snaps/type-list-of.md index 62798b284..9eef79b87 100644 --- a/tests/testthat/_snaps/type-list-of.md +++ b/tests/testthat/_snaps/type-list-of.md @@ -11,6 +11,13 @@ [1] 2 3 +--- + + Code + list_of(.ptype = integer()) + Output + [0]> + --- Code @@ -23,6 +30,15 @@ ... and 1 more Set `max` to a larger value to show all items. +--- + + Code + print(list_of(1, 2:3), max = 0) + Output + [2]> + ... and 2 more + Set `max` to a larger value to show all items. + --- Code diff --git a/tests/testthat/test-type-list-of.R b/tests/testthat/test-type-list-of.R index 8ecd732f1..40d9f8c0b 100644 --- a/tests/testthat/test-type-list-of.R +++ b/tests/testthat/test-type-list-of.R @@ -41,7 +41,9 @@ test_that("is_list_of as expected", { test_that("print method gives human friendly output", { skip_on_cran() # Depends on tibble expect_snapshot(list_of(1, 2:3)) + expect_snapshot(list_of(.ptype = integer())) expect_snapshot(print(list_of(1, 2:3), max = 1)) + expect_snapshot(print(list_of(1, 2:3), max = 0)) expect_snapshot(tibble::tibble(x = list_of(1, 2:3))) }) From 04483a227e11d7582a2d0e0d74c2e5f71ad682e0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 29 Oct 2021 17:24:19 +0200 Subject: [PATCH 12/17] Detail on slicing --- R/print-str.R | 3 +++ man/obj_print.Rd | 3 +++ 2 files changed, 6 insertions(+) diff --git a/R/print-str.R b/R/print-str.R index f59a91a01..324f744f2 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -12,6 +12,9 @@ #' is a scalar integer that accurately describes the maximum number of items #' to print, and that `getOption("max.print")` is set to at least that value. #' +#' All methods receive `x` unchanged when called from `obj_print()`. +#' `obj_print_data()` should print only the first `max` elements. +#' #' @param x A vector #' @param ... Additional arguments passed on to methods. See [print()] and #' [str()] for commonly used options diff --git a/man/obj_print.Rd b/man/obj_print.Rd index 67bc5bd45..0593cf76c 100644 --- a/man/obj_print.Rd +++ b/man/obj_print.Rd @@ -46,5 +46,8 @@ If you are implementing \code{obj_print_header()}, \code{obj_print_data()} or \code{obj_print_footer()}, your method can assume that the \code{max} argument is a scalar integer that accurately describes the maximum number of items to print, and that \code{getOption("max.print")} is set to at least that value. + +All methods receive \code{x} unchanged when called from \code{obj_print()}. +\code{obj_print_data()} should print only the first \code{max} elements. } \keyword{internal} From c895ff3d2b43eb9f101441fcf28d1c873071b55f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 21 Aug 2022 14:39:41 +0200 Subject: [PATCH 13/17] Handle max entirely in obj_print(), without genericity --- R/print-str.R | 89 ++++++++++++++++++++++++------------------------ R/type-list-of.R | 5 +-- 2 files changed, 46 insertions(+), 48 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index 324f744f2..caecf82a8 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -23,21 +23,48 @@ #' @keywords internal #' @export obj_print <- function(x, ..., max = NULL) { - max <- local_max_print(max) - obj_print_header_dispatch(x, ..., max = max) - obj_print_data_dispatch(x, ..., max = max) - obj_print_footer_dispatch(x, ..., max = max) + if (!vec_is(x)) { + delta <- 0 + x_max <- x + } else { + max <- local_max_print(max) + delta <- vec_size(x) - max + + if (vec_size(x) > max) { + x_max <- vec_slice(x, seq_len(max)) + } else { + x_max <- x + } + } + + obj_print_header_dispatch(x, ...) + obj_print_data_dispatch(x_max, ...) + obj_print_footer_dispatch(x, ...) + + if (delta > 0) { + max_print <- attr(max, "max_print") + if (is.null(max_print)) { + max_print <- getOption("max.print") + } + + cat_line("... and ", big_mark(delta), " more") + if (max < max_print) { + cat_line("Set `max` to a larger value to show all items.") + } else { + cat_line("Set `options(max.print = )` to a larger value to show all items.") + } + } + invisible(x) } #' @export #' @rdname obj_print -obj_print_header <- function(x, ..., max = NULL) { - max <- local_max_print(max) - return(obj_print_header_dispatch(x, ..., max = max)) +obj_print_header <- function(x, ...) { + return(obj_print_header_dispatch(x, ...)) UseMethod("obj_print_header") } -obj_print_header_dispatch <- function(x, ..., max) { +obj_print_header_dispatch <- function(x, ...) { UseMethod("obj_print_header") } @@ -49,33 +76,26 @@ obj_print_header.default <- function(x, ...) { #' @export #' @rdname obj_print -obj_print_data <- function(x, ..., max = NULL) { - max <- local_max_print(max) - return(obj_print_data_dispatch(x, ..., max = max)) +obj_print_data <- function(x, ...) { + return(obj_print_data_dispatch(x, ...)) UseMethod("obj_print_data") } -obj_print_data_dispatch <- function(x, ..., max) { +obj_print_data_dispatch <- function(x, ...) { UseMethod("obj_print_data") } #' @export -obj_print_data.default <- function(x, ..., max) { +obj_print_data.default <- function(x, ...) { if (!vec_is(x)) { print(x, quote = FALSE) return(invisible(x)) } - if (vec_size(x) > max) { - x_max <- vec_slice(x, seq_len(max)) - } else { - x_max <- x - } - - if (vec_size(x_max) == 0) { + if (vec_size(x) == 0) { return(invisible(x)) } - out <- stats::setNames(format(x_max), names(x_max)) + out <- stats::setNames(format(x), names(x)) print(out, quote = FALSE) invisible(x) @@ -83,35 +103,16 @@ obj_print_data.default <- function(x, ..., max) { #' @export #' @rdname obj_print -obj_print_footer <- function(x, ..., max = NULL) { - max <- local_max_print(max) - return(obj_print_footer_dispatch(x, ..., max = max)) +obj_print_footer <- function(x, ...) { + return(obj_print_footer_dispatch(x, ...)) UseMethod("obj_print_footer") } -obj_print_footer_dispatch <- function(x, ..., max) { +obj_print_footer_dispatch <- function(x, ...) { UseMethod("obj_print_footer") } #' @export -obj_print_footer.default <- function(x, ..., max) { - if (!vec_is(x)) { - return(invisible(x)) - } - - delta <- vec_size(x) - max - if (delta > 0) { - max_print <- attr(max, "max_print") - if (is.null(max_print)) { - max_print <- getOption("max.print") - } - - cat_line("... and ", big_mark(delta), " more") - if (max < max_print) { - cat_line("Set `max` to a larger value to show all items.") - } else { - cat_line("Set `options(max.print = )` to a larger value to show all items.") - } - } +obj_print_footer.default <- function(x, ...) { invisible(x) } diff --git a/R/type-list-of.R b/R/type-list-of.R index f2b7690fc..c445de97f 100644 --- a/R/type-list-of.R +++ b/R/type-list-of.R @@ -102,11 +102,8 @@ vec_proxy.vctrs_list_of <- function(x, ...) { # Formatting -------------------------------------------------------------- #' @export -obj_print_data.vctrs_list_of <- function(x, ..., max) { +obj_print_data.vctrs_list_of <- function(x, ...) { out <- vec_data(x) - if (max < length(out)) { - out <- out[seq_len(max)] - } # Zero-length lists handled by header and footer if (length(out) > 0) { From 6ece3fb8777d14c790e186213a6d46c940698f04 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 21 Aug 2022 14:41:19 +0200 Subject: [PATCH 14/17] Restore --- R/type-list-of.R | 10 +++------- 1 file changed, 3 insertions(+), 7 deletions(-) diff --git a/R/type-list-of.R b/R/type-list-of.R index c445de97f..fb6960e7b 100644 --- a/R/type-list-of.R +++ b/R/type-list-of.R @@ -103,14 +103,10 @@ vec_proxy.vctrs_list_of <- function(x, ...) { #' @export obj_print_data.vctrs_list_of <- function(x, ...) { - out <- vec_data(x) + if (length(x) == 0) + return() - # Zero-length lists handled by header and footer - if (length(out) > 0) { - print(out) - } - - invisible(x) + print(vec_data(x)) } #' @export From b755345e2081773a8ad563e2722185f917591dea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 21 Aug 2022 14:42:03 +0200 Subject: [PATCH 15/17] No longer need _dispatch() functions --- R/print-str.R | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index caecf82a8..185d4b4cb 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -61,10 +61,6 @@ obj_print <- function(x, ..., max = NULL) { #' @export #' @rdname obj_print obj_print_header <- function(x, ...) { - return(obj_print_header_dispatch(x, ...)) - UseMethod("obj_print_header") -} -obj_print_header_dispatch <- function(x, ...) { UseMethod("obj_print_header") } @@ -77,10 +73,6 @@ obj_print_header.default <- function(x, ...) { #' @export #' @rdname obj_print obj_print_data <- function(x, ...) { - return(obj_print_data_dispatch(x, ...)) - UseMethod("obj_print_data") -} -obj_print_data_dispatch <- function(x, ...) { UseMethod("obj_print_data") } @@ -104,10 +96,6 @@ obj_print_data.default <- function(x, ...) { #' @export #' @rdname obj_print obj_print_footer <- function(x, ...) { - return(obj_print_footer_dispatch(x, ...)) - UseMethod("obj_print_footer") -} -obj_print_footer_dispatch <- function(x, ...) { UseMethod("obj_print_footer") } From 8ad1bf54e767bc08b71a2ce0e1f23f5288855e86 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 21 Aug 2022 14:50:10 +0200 Subject: [PATCH 16/17] Document --- man/obj_print.Rd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/man/obj_print.Rd b/man/obj_print.Rd index 0593cf76c..463809821 100644 --- a/man/obj_print.Rd +++ b/man/obj_print.Rd @@ -13,11 +13,11 @@ \usage{ obj_print(x, ..., max = NULL) -obj_print_header(x, ..., max = NULL) +obj_print_header(x, ...) -obj_print_data(x, ..., max = NULL) +obj_print_data(x, ...) -obj_print_footer(x, ..., max = NULL) +obj_print_footer(x, ...) obj_str(x, ...) From e7fc6eb10ee4e401f75fbf3df1b734c94ae3b1b9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 21 Aug 2022 14:57:11 +0200 Subject: [PATCH 17/17] Cleanup --- R/print-str.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/print-str.R b/R/print-str.R index 185d4b4cb..3d9e1a62e 100644 --- a/R/print-str.R +++ b/R/print-str.R @@ -37,9 +37,9 @@ obj_print <- function(x, ..., max = NULL) { } } - obj_print_header_dispatch(x, ...) - obj_print_data_dispatch(x_max, ...) - obj_print_footer_dispatch(x, ...) + obj_print_header(x, ...) + obj_print_data(x_max, ...) + obj_print_footer(x, ...) if (delta > 0) { max_print <- attr(max, "max_print")