From a7010e38fed4e4384549623389ebd14b4e3427f8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 9 May 2025 23:18:25 +0000 Subject: [PATCH 1/6] Use drop=FALSE to avoid losing dimension in double-elided case --- R/repr_matrix_df.r | 6 ++++-- tests/testthat/test_repr_array_df.r | 22 ++++++++++++++++++++++ 2 files changed, 26 insertions(+), 2 deletions(-) diff --git a/R/repr_matrix_df.r b/R/repr_matrix_df.r index af8dcbe..f5b2730 100644 --- a/R/repr_matrix_df.r +++ b/R/repr_matrix_df.r @@ -43,8 +43,10 @@ arr_partition <- function(a, rows, cols) { # assign a list of parts that can be coerced to strings if (!is.null(part_r) && !is.null(part_c)) { structure(list( - ul = a[part_r$start, part_c$start], ll = a[part_r$end, part_c$start], - ur = a[part_r$start, part_c$end ], lr = a[part_r$end, part_c$end ]), + ul = a[part_r$start, part_c$start, drop = FALSE], + ll = a[part_r$end , part_c$start, drop = FALSE], + ur = a[part_r$start, part_c$end, drop = FALSE], + lr = a[part_r$end , part_c$end, drop = FALSE]), omit = 'both') } else if (!is.null(part_r)) { structure(list( diff --git a/tests/testthat/test_repr_array_df.r b/tests/testthat/test_repr_array_df.r index 816e8b0..f34f188 100644 --- a/tests/testthat/test_repr_array_df.r +++ b/tests/testthat/test_repr_array_df.r @@ -204,3 +204,25 @@ test_that('data.frame with list columns can be displayed', { expect_identical(repr_html(data.table::as.data.table(df)), sub('data\\.frame','data.table',expected)) } }) + +test_that('forced-narrow inputs work', { + withr::local_options(repr.matrix.max.rows = 2L, repr.matrix.max.cols = 2L) + df <- data.frame(a = 1:3, b = 4:6, c = 7:9) + expect_silent(repr_text(df)) + expect_identical( + # Scrub non-ASCII characters to make the test platform-agnostic. + gsub("[^a-zA-Z0-9.&;<>= '\"/:\n\t]", "*", repr_html(df)), + " + + +\t +\t + + +\t +\t +\t + +
A data.frame: 3 * 3
a*c
<int>*<int>
1*7
***
3*9
+") +}) From 4ac0788b9a1ebbc09674937001eac6652c77b801 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 9 May 2025 23:44:48 +0000 Subject: [PATCH 2/6] avoid copy of potentially large data.table input --- NAMESPACE | 2 ++ R/repr_matrix_df.r | 50 ++++++++++++++++++++++++----- tests/testthat/test_repr_array_df.r | 9 ++++++ 3 files changed, 53 insertions(+), 8 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 520dccd..f799e56 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,7 @@ # Generated by roxygen2: do not edit by hand +S3method(partition_from_parts,data.table) +S3method(partition_from_parts,default) S3method(repr_geojson,SpatialCollections) S3method(repr_geojson,SpatialGrid) S3method(repr_geojson,SpatialGridDataFrame) diff --git a/R/repr_matrix_df.r b/R/repr_matrix_df.r index f5b2730..f1dbdab 100644 --- a/R/repr_matrix_df.r +++ b/R/repr_matrix_df.r @@ -33,14 +33,14 @@ onload_chars <- function() { chars$times_s <- .char_fallback('\u00D7', 'x') } -arr_partition <- function(a, rows, cols) { - stopifnot(rows >= 2L, cols >= 2L) - - # create sequences of indices to bisect rows and columns - part_r <- partition(nrow(a), rows) - part_c <- partition(ncol(a), cols) - - # assign a list of parts that can be coerced to strings +#' Assign a list of parts that can be coerced to strings +#' @noRd +partition_from_parts <- function(a, part_r, part_c) { + UseMethod("partition_from_parts") +} + +#' @export +partition_from_parts.default <- function(a, part_r, part_c) { if (!is.null(part_r) && !is.null(part_c)) { structure(list( ul = a[part_r$start, part_c$start, drop = FALSE], @@ -63,6 +63,40 @@ arr_partition <- function(a, rows, cols) { } } +#' @export +partition_from_parts.data.table <- function(a, part_r, part_c) { + if (!is.null(part_r) && !is.null(part_c)) { + structure(list( + ul = a[part_r$start, part_c$start, with = FALSE], + ll = a[part_r$end , part_c$start, with = FALSE], + ur = a[part_r$start, part_c$end, with = FALSE], + lr = a[part_r$end , part_c$end, with = FALSE]), + omit = 'both') + } else if (!is.null(part_r)) { + structure(list( + upper = a[part_r$start, , with = FALSE], + lower = a[part_r$end, , with = FALSE]), + omit = 'rows') + } else if (!is.null(part_c)) { + structure(list( + left = a[, part_c$start, with = FALSE], + right = a[, part_c$end, with = FALSE]), + omit = 'cols') + } else { + structure(list(full = a), omit = 'none') + } +} + +arr_partition <- function(a, rows, cols) { + stopifnot(rows >= 2L, cols >= 2L) + + # create sequences of indices to bisect rows and columns + part_r <- partition(nrow(a), rows) + part_c <- partition(ncol(a), cols) + + partition_from_parts(a, part_r, part_c) +} + # unpack tibble and coerce to data.frame arr_part_unpack_tbl <- function(tbl) { tbl_col_format <- function(col, prefix = '') { diff --git a/tests/testthat/test_repr_array_df.r b/tests/testthat/test_repr_array_df.r index f34f188..a51980f 100644 --- a/tests/testthat/test_repr_array_df.r +++ b/tests/testthat/test_repr_array_df.r @@ -226,3 +226,12 @@ test_that('forced-narrow inputs work', { ") }) + +test_that('data.table and data.frame elision is the same', { + skip_if_not_installed('data.table') + withr::local_options(list(repr.matrix.max.rows = 10L, repr.matrix.max.cols = 10L)) + DF <- data.frame(matrix(rnorm(100L*100L), 100L, 100L)) + expect_identical(repr_text(DF), repr_text(data.table::as.data.table(DF))) + expect_identical(repr_text(DF[1:10, ]), repr_text(data.table::as.data.table(DF[1:10, ]))) + expect_identical(repr_text(DF[1:10, 1:10]), repr_text(data.table::as.data.table(DF[1:10, 1:10]))) +}) From c778719df4dd7e735d86a2ad05ab35b8be37b68f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 21 Jul 2025 15:05:40 -0700 Subject: [PATCH 3/6] Need drop=FALSE for data.table too --- R/repr_matrix_df.r | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/R/repr_matrix_df.r b/R/repr_matrix_df.r index f1dbdab..93b9eb5 100644 --- a/R/repr_matrix_df.r +++ b/R/repr_matrix_df.r @@ -67,20 +67,20 @@ partition_from_parts.default <- function(a, part_r, part_c) { partition_from_parts.data.table <- function(a, part_r, part_c) { if (!is.null(part_r) && !is.null(part_c)) { structure(list( - ul = a[part_r$start, part_c$start, with = FALSE], - ll = a[part_r$end , part_c$start, with = FALSE], - ur = a[part_r$start, part_c$end, with = FALSE], - lr = a[part_r$end , part_c$end, with = FALSE]), + ul = a[part_r$start, part_c$start, with = FALSE, drop = FALSE], + ll = a[part_r$end , part_c$start, with = FALSE, drop = FALSE], + ur = a[part_r$start, part_c$end, with = FALSE, drop = FALSE], + lr = a[part_r$end , part_c$end, with = FALSE, drop = FALSE]), omit = 'both') } else if (!is.null(part_r)) { structure(list( - upper = a[part_r$start, , with = FALSE], - lower = a[part_r$end, , with = FALSE]), + upper = a[part_r$start, , with = FALSE, drop = FALSE], + lower = a[part_r$end, , with = FALSE, drop = FALSE]), omit = 'rows') } else if (!is.null(part_c)) { structure(list( - left = a[, part_c$start, with = FALSE], - right = a[, part_c$end, with = FALSE]), + left = a[, part_c$start, with = FALSE, drop = FALSE], + right = a[, part_c$end, with = FALSE, drop = FALSE]), omit = 'cols') } else { structure(list(full = a), omit = 'none') From 4bb4a78e297ae0c59f87946c6dc46d56a9fb4619 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 21 Jul 2025 15:06:00 -0700 Subject: [PATCH 4/6] test --- tests/testthat/test_repr_array_df.r | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/tests/testthat/test_repr_array_df.r b/tests/testthat/test_repr_array_df.r index a51980f..111857e 100644 --- a/tests/testthat/test_repr_array_df.r +++ b/tests/testthat/test_repr_array_df.r @@ -235,3 +235,17 @@ test_that('data.table and data.frame elision is the same', { expect_identical(repr_text(DF[1:10, ]), repr_text(data.table::as.data.table(DF[1:10, ]))) expect_identical(repr_text(DF[1:10, 1:10]), repr_text(data.table::as.data.table(DF[1:10, 1:10]))) }) + +test_that('data.table elision works in 1-column and 1-row edge cases', { + skip_if_not_installed('data.table') + withr::local_options(list(repr.matrix.max.rows = 2L, repr.matrix.max.cols = 2L)) + + DF <- data.frame(a = 1:3) + expect_identical(repr_text(DF), repr_text(data.table::as.data.table(DF))) + + DF <- data.frame(a = 1L, b = 2L, c = 3L) + expect_identical(repr_text(DF), repr_text(data.table::as.data.table(DF))) + + DF <- data.frame(a = 1:3, b = 4:6, c = 7:9) + expect_identical(repr_text(DF), repr_text(data.table::as.data.table(DF))) +}) From 085265f03b54953ae98ead1eb6b6c70afdac73c6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 09:26:54 -0700 Subject: [PATCH 5/6] Redundant withr Suggests --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 8453dfa..60158e6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -32,7 +32,8 @@ Suggests: Cairo, stringr, testthat (>= 3.0.0), - leaflet + leaflet, + withr Enhances: data.table, tibble, From eec1696a3a0aba0819534dfb52476fbb048b6dcc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 22 Jul 2025 09:29:56 -0700 Subject: [PATCH 6/6] importFrom(utils,str) --- NAMESPACE | 1 + R/repr_matrix_df.r | 1 + 2 files changed, 2 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index f799e56..d1e55be 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -139,4 +139,5 @@ importFrom(tools,Rd2latex) importFrom(tools,Rd2txt) importFrom(utils,capture.output) importFrom(utils,head) +importFrom(utils,str) importFrom(utils,tail) diff --git a/R/repr_matrix_df.r b/R/repr_matrix_df.r index 93b9eb5..476e359 100644 --- a/R/repr_matrix_df.r +++ b/R/repr_matrix_df.r @@ -120,6 +120,7 @@ arr_part_unpack_tbl <- function(tbl) { } arr_parts_format <- function(parts) structure(lapply(parts, arr_part_format), omit = attr(parts, 'omit')) +#' @importFrom utils capture.output str arr_part_format <- function(part) { if (inherits(part, 'tbl')) { part <- arr_part_unpack_tbl(part)