From 02b6c303f0ed73c051d9bd27b21bee70e4b93e47 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Wed, 8 Oct 2025 12:59:16 -0400 Subject: [PATCH 01/13] Implement `list_transpose()` --- NAMESPACE | 1 + NEWS.md | 2 + R/list-transpose.R | 171 ++++++++++++++++++++++++ man/list_transpose.Rd | 113 ++++++++++++++++ tests/testthat/_snaps/list-transpose.md | 76 +++++++++++ tests/testthat/test-list-transpose.R | 169 +++++++++++++++++++++++ 6 files changed, 532 insertions(+) create mode 100644 R/list-transpose.R create mode 100644 man/list_transpose.Rd create mode 100644 tests/testthat/_snaps/list-transpose.md create mode 100644 tests/testthat/test-list-transpose.R diff --git a/NAMESPACE b/NAMESPACE index 9e4c92c73..2fca5a960 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -487,6 +487,7 @@ export(list_combine) export(list_drop_empty) export(list_of) export(list_sizes) +export(list_transpose) export(list_unchop) export(maybe_lossy_cast) export(n_fields) diff --git a/NEWS.md b/NEWS.md index ca3aa80cd..097a4162a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # vctrs (development version) +* New `list_transpose()` for transposing a list of vectors. + * `vec_interleave()` gains new `.size` and `.error_call` arguments. * `vec_interleave()` now reports the correct index in errors when `NULL`s are present. diff --git a/R/list-transpose.R b/R/list-transpose.R new file mode 100644 index 000000000..05964ce9d --- /dev/null +++ b/R/list-transpose.R @@ -0,0 +1,171 @@ +#' Transpose a list of vectors +#' +#' @description +#' `list_transpose()` takes a list of vectors, transposes it, and returns a new +#' list of vectors. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams rlang::args_error_context +#' +#' @param x A list. +#' +#' @param size The expected size of each element of `x`. If not provided, +#' computed automatically by [vec_size_common()]. +#' +#' @param ptype The expected type of each element of `x`. If not provided, +#' computed automatically by [vec_ptype_common()]. +#' +#' @param x_arg Argument name used in error messages. +#' +#' @returns +#' A list of vectors with the following invariants: +#' +#' For the list: +#' +#' - `vec_ptype(list_transpose(x)) == vec_ptype(x)` +#' - `vec_size(list_transpose(x)) == (size || vec_size_common(!!!x))` +#' +#' For the list elements: +#' +#' - `vec_ptype(list_transpose(x)[[i]]) == (ptype || vec_ptype_common(!!!x))` +#' - `vec_size(list_transpose(x)[[i]]) == vec_size(x)` +#' +#' @export +#' @examples +#' # Input: +#' # - List size 3 +#' # - Element size 2 +#' # Output: +#' # - List size 2 +#' # - Element size 3 +#' list_transpose(list(1:2, 3:4, 5:6)) +#' +#' # With data frames +#' x <- data_frame(a = 1:2, b = letters[1:2]) +#' y <- data_frame(a = 3:4, b = letters[3:4]) +#' list_transpose(list(x, y)) +#' +#' # Size 1 elements are recycled to the common size before transposing +#' list_transpose(list(1, 2:4)) +#' +#' # With all size 1 elements, you can use `size` if you want to force a known +#' # common size other than size 1 +#' list_transpose(list(1, 2), size = 3) +#' +#' # With size 0 elements, the invariants are a bit tricky! +#' # This must return a size 0 list, but then you lose expected +#' # type (integer) and size (2) information about the elements. +#' # Losing that information makes it difficult to reverse the +#' # transposition. +#' # +#' # Input: +#' # - List size 2 +#' # - Element size 0 +#' # Output: +#' # - List size 0 +#' # - Element size 2 +#' x <- list(integer(), integer()) +#' out <- list_transpose(x) +#' out +#' +#' # Note how transposing a second time doesn't recover the original list +#' list_transpose(out) +#' +#' # To work around this, provide the lost `size` and `ptype` manually +#' list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) +#' +#' # If you'd like to pad with a missing value rather than recycling or +#' # erroring, you might do something like this, which left-pads +#' x <- list(1, 2:5, 6:7) +#' sizes <- list_sizes(x) +#' size <- max(sizes) +#' index <- which(sizes != size) +#' x[index] <- lapply( +#' index, +#' function(i) vec_c(rep(NA, times = size - sizes[[i]]), x[[i]]) +#' ) +#' list_transpose(x) +#' +#' # `NULL` values aren't allowed in `list_transpose()`. If you'd like `NULL`s +#' # to be treated as size 1 missing values, replace them with `NA` first. +#' x <- list(1:3, NULL, 5:7, NULL) +#' x <- vec_assign(x, vec_detect_missing(x), list(NA)) +#' list_transpose(x) +list_transpose <- function( + x, + ..., + size = NULL, + ptype = NULL, + x_arg = caller_arg(x), + error_call = current_env() +) { + check_dots_empty0(...) + + # Disallow `NULL` entirely. These would break `vec_size()` invariants of + # `list_transpose()` if we simply drop them via `list_interleave()`. + # + # For example: + # + # ``` + # list_transpose(list(1:4, NULL, 5:8)) + # ``` + # + # Input: + # - List size 3 + # - Element size 4 + # Output: + # - List size 4 + # - Element size 3 + # + # But if we drop `NULL` you'd get: + # - List size 4 + # - Element size 2 + # + # A reasonable thing for users to do would be to replace `NULL` with `NA` + # ahead of time. This is similar to `keep_empty` in some tidyr functions. + # But we force the caller to make that decision, and it's a fairly easy + # replacement to make with `vec_detect_missing()` and `vec_assign()`. + # + # ``` + # list_transpose(list(1:4, NA, 5:8)) + # ``` + allow_null <- FALSE + + obj_check_list(x, arg = x_arg, call = error_call) + list_check_all_vectors( + x, + allow_null = allow_null, + arg = x_arg, + call = error_call + ) + + flat <- list_interleave( + x, + size = size, + ptype = ptype, + name_spec = "inner", + x_arg = x_arg, + error_call = error_call + ) + + x_size <- vec_size(x) + + if (is_null(size)) { + # Identical to `elt_size <- vec_size_common(!!!x)`, but faster. + # Utilizes known info about the `list_interleave()` return value. + if (x_size == 0L) { + elt_size <- 0L + } else { + elt_size <- vec_size(flat) / x_size + } + } else { + elt_size <- size + } + + sizes <- vec_rep(x_size, times = elt_size) + + # Chop the one big vector into transposed pieces of size `x_size` + out <- vec_chop(flat, sizes = sizes) + + out +} diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd new file mode 100644 index 000000000..0f111c6da --- /dev/null +++ b/man/list_transpose.Rd @@ -0,0 +1,113 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/list-transpose.R +\name{list_transpose} +\alias{list_transpose} +\title{Transpose a list of vectors} +\usage{ +list_transpose( + x, + ..., + size = NULL, + ptype = NULL, + x_arg = caller_arg(x), + error_call = current_env() +) +} +\arguments{ +\item{x}{A list.} + +\item{...}{These dots are for future extensions and must be empty.} + +\item{size}{The expected size of each element of \code{x}. If not provided, +computed automatically by \code{\link[=vec_size_common]{vec_size_common()}}.} + +\item{ptype}{The expected type of each element of \code{x}. If not provided, +computed automatically by \code{\link[=vec_ptype_common]{vec_ptype_common()}}.} + +\item{x_arg}{Argument name used in error messages.} + +\item{error_call}{The execution environment of a currently +running function, e.g. \code{caller_env()}. The function will be +mentioned in error messages as the source of the error. See the +\code{call} argument of \code{\link[rlang:abort]{abort()}} for more information.} +} +\value{ +A list of vectors with the following invariants: + +For the list: +\itemize{ +\item \code{vec_ptype(list_transpose(x)) == vec_ptype(x)} +\item \code{vec_size(list_transpose(x)) == (size || vec_size_common(!!!x))} +} + +For the list elements: +\itemize{ +\item \code{vec_ptype(list_transpose(x)[[i]]) == (ptype || vec_ptype_common(!!!x))} +\item \code{vec_size(list_transpose(x)[[i]]) == vec_size(x)} +} +} +\description{ +\code{list_transpose()} takes a list of vectors, transposes it, and returns a new +list of vectors. +} +\examples{ +# Input: +# - List size 3 +# - Element size 2 +# Output: +# - List size 2 +# - Element size 3 +list_transpose(list(1:2, 3:4, 5:6)) + +# With data frames +x <- data_frame(a = 1:2, b = letters[1:2]) +y <- data_frame(a = 3:4, b = letters[3:4]) +list_transpose(list(x, y)) + +# Size 1 elements are recycled to the common size before transposing +list_transpose(list(1, 2:4)) + +# With all size 1 elements, you can use `size` if you want to force a known +# common size other than size 1 +list_transpose(list(1, 2), size = 3) + +# With size 0 elements, the invariants are a bit tricky! +# This must return a size 0 list, but then you lose expected +# type (integer) and size (2) information about the elements. +# Losing that information makes it difficult to reverse the +# transposition. +# +# Input: +# - List size 2 +# - Element size 0 +# Output: +# - List size 0 +# - Element size 2 +x <- list(integer(), integer()) +out <- list_transpose(x) +out + +# Note how transposing a second time doesn't recover the original list +list_transpose(out) + +# To work around this, provide the lost `size` and `ptype` manually +list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) + +# If you'd like to pad with a missing value rather than recycling or +# erroring, you might do something like this, which left-pads +x <- list(1, 2:5, 6:7) +sizes <- list_sizes(x) +size <- max(sizes) +index <- which(sizes != size) +x[index] <- lapply( + index, + function(i) vec_c(rep(NA, times = size - sizes[[i]]), x[[i]]) +) +list_transpose(x) + +# `NULL` values aren't allowed in `list_transpose()`. If you'd like `NULL`s +# to be treated as size 1 missing values, replace them with `NA` first. +x <- list(1:3, NULL, 5:7, NULL) +x <- vec_assign(x, vec_detect_missing(x), list(NA)) +list_transpose(x) +} diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md new file mode 100644 index 000000000..af015e8b2 --- /dev/null +++ b/tests/testthat/_snaps/list-transpose.md @@ -0,0 +1,76 @@ +# `x` must be a list + + Code + list_transpose(1) + Condition + Error in `list_transpose()`: + ! `1` must be a list, not the number 1. + +--- + + Code + list_transpose(1, x_arg = "x", error_call = quote(foo())) + Condition + Error in `foo()`: + ! `x` must be a list, not the number 1. + +# `...` must be empty + + Code + list_transpose(1, 2) + Condition + Error in `list_transpose()`: + ! `...` must be empty. + x Problematic argument: + * ..1 = 2 + i Did you forget to name an argument? + +# respects `size` + + Code + list_transpose(list(1:2), size = 3) + Condition + Error in `list_transpose()`: + ! Can't recycle `list(1:2)[[1]]` (size 2) to size 3. + +# respects `ptype` + + Code + list_transpose(list(1, 2), ptype = character()) + Condition + Error in `list_transpose()`: + ! Can't convert `list(1, 2)[[1]]` to . + +--- + + Code + list_transpose(list(1, 2), ptype = character(), x_arg = "x", error_call = quote( + foo())) + Condition + Error in `foo()`: + ! Can't convert `x[[1]]` to . + +# doesn't allow `NULL` elements + + Code + list_transpose(list(1:4, NULL, 5:8)) + Condition + Error in `list_transpose()`: + ! `list(1:4, NULL, 5:8)[[2]]` must be a vector, not `NULL`. + +# doesn't allow scalar elements + + Code + list_transpose(list(1:4, lm(1 ~ 1))) + Condition + Error in `list_transpose()`: + ! `list(1:4, lm(1 ~ 1))[[2]]` must be a vector, not a object. + +--- + + Code + list_transpose(list(1:4, lm(1 ~ 1)), x_arg = "x", error_call = quote(foo())) + Condition + Error in `foo()`: + ! `x[[2]]` must be a vector, not a object. + diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R new file mode 100644 index 000000000..a0aa800bd --- /dev/null +++ b/tests/testthat/test-list-transpose.R @@ -0,0 +1,169 @@ +test_that("transposes vectors", { + expect_identical( + list_transpose(list(1:2, 3:4, 5:6)), + list(c(1L, 3L, 5L), c(2L, 4L, 6L)) + ) +}) + +test_that("transposes data frames", { + expect_identical( + list_transpose(list( + data_frame(a = 1:3, b = letters[1:3]), + data_frame(a = 4:6, b = letters[4:6]) + )), + list( + data_frame(a = c(1L, 4L), b = letters[c(1L, 4L)]), + data_frame(a = c(2L, 5L), b = letters[c(2L, 5L)]), + data_frame(a = c(3L, 6L), b = letters[c(3L, 6L)]) + ) + ) +}) + +test_that("works with empty `x`", { + # Input: + # - List size 0 + # - Element size 0 (inferred) + expect_identical(list_transpose(list()), list()) + + # Input + # - List size 0 + # - Element size 2 (provided) + # - Element type unspecified (inferred) + # Output + # - List size 2 + # - Element size 0 + # - Element type unspecified + expect_identical( + list_transpose(list(), size = 2), + list(unspecified(), unspecified()) + ) + + # Input + # - List size 0 + # - Element size 2 (provided) + # - Element type integer (provided) + # Output + # - List size 2 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), size = 2, ptype = integer()), + list(integer(), integer()) + ) +}) + +test_that("can recover original type and size with manual `ptype` and `size`", { + # - List size 2 + # - Element size 0 + # - Element type integer + x <- list(integer(), integer()) + + # - List size 0 + # - Element size 2 (but no elements) + # - Element type integer (but no elements) + out <- list_transpose(x) + expect_identical(out, list()) + + # Simply transposing again doesn't recover the original `x`, but supplying + # a known `ptype` and `size` does + expect_identical( + list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)), + x + ) +}) + +test_that("retains only inner names", { + # I don't think we should expose `name_spec`, we've hard coded it to `"inner"` + # for now. What would this even do with outer names? Exposing `name_spec` for + # the interleave step would allow making names of `a_w` and `b_y` via a glue + # spec, which feels weird and not useful. + x <- list(a = c(w = 1, x = 2), b = c(y = 3, z = 4)) + + expect_identical( + list_transpose(x), + list( + c(w = 1, y = 3), + c(x = 2, z = 4) + ) + ) + + # Silent repair of duplicate data frame row names + x <- list( + data.frame(a = 1, row.names = "x"), + data.frame(a = 2, row.names = "x") + ) + + expect_silent({ + expect_identical( + list_transpose(x), + list(data.frame(a = c(1, 2), row.names = c("x...1", "x...2"))) + ) + }) +}) + +test_that("`x` must be a list", { + expect_snapshot(error = TRUE, { + list_transpose(1) + }) + expect_snapshot(error = TRUE, { + list_transpose(1, x_arg = "x", error_call = quote(foo())) + }) +}) + +test_that("`...` must be empty", { + expect_snapshot(error = TRUE, { + list_transpose(1, 2) + }) +}) + +test_that("respects `size`", { + # Useful for the case where you somehow know the element size from somewhere + # else, but you also happen to only have all size 1 elements right now + expect_identical( + list_transpose(list(1L, 2L), size = 3), + list(1:2, 1:2, 1:2) + ) + + expect_snapshot(error = TRUE, { + list_transpose(list(1:2), size = 3) + }) +}) + +test_that("respects `ptype`", { + expect_identical( + list_transpose(list(1, 2), ptype = integer()), + list(1:2) + ) + + expect_snapshot(error = TRUE, { + list_transpose( + list(1, 2), + ptype = character() + ) + }) + expect_snapshot(error = TRUE, { + list_transpose( + list(1, 2), + ptype = character(), + x_arg = "x", + error_call = quote(foo()) + ) + }) +}) + +test_that("doesn't allow `NULL` elements", { + # These would break the invariants around the size of the output relative + # to the size of the input + expect_snapshot(error = TRUE, { + list_transpose(list(1:4, NULL, 5:8)) + }) +}) + +test_that("doesn't allow scalar elements", { + expect_snapshot(error = TRUE, { + list_transpose(list(1:4, lm(1 ~ 1))) + }) + expect_snapshot(error = TRUE, { + list_transpose(list(1:4, lm(1 ~ 1)), x_arg = "x", error_call = quote(foo())) + }) +}) From bf564cae4b4221711ac21b371487210210bdcd87 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Wed, 8 Oct 2025 13:40:46 -0400 Subject: [PATCH 02/13] Add to `_pkgdown.yml` --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 1206fdde4..1ffc21fcb 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -48,6 +48,7 @@ reference: - vec_c - list_combine - vec_interleave + - list_transpose - vec_cbind - vec_rbind - name_spec From 687084586c0a2a641de55d6f5034ed3f74c57ee4 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Tue, 14 Oct 2025 11:12:29 -0400 Subject: [PATCH 03/13] Show some error output --- R/list-transpose.R | 4 ++++ man/list_transpose.Rd | 4 ++++ 2 files changed, 8 insertions(+) diff --git a/R/list-transpose.R b/R/list-transpose.R index 05964ce9d..ba3671bd0 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -77,6 +77,8 @@ #' # If you'd like to pad with a missing value rather than recycling or #' # erroring, you might do something like this, which left-pads #' x <- list(1, 2:5, 6:7) +#' try(list_transpose(x)) +#' #' sizes <- list_sizes(x) #' size <- max(sizes) #' index <- which(sizes != size) @@ -89,6 +91,8 @@ #' # `NULL` values aren't allowed in `list_transpose()`. If you'd like `NULL`s #' # to be treated as size 1 missing values, replace them with `NA` first. #' x <- list(1:3, NULL, 5:7, NULL) +#' try(list_transpose(x)) +#' #' x <- vec_assign(x, vec_detect_missing(x), list(NA)) #' list_transpose(x) list_transpose <- function( diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 0f111c6da..1792e6e7e 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -96,6 +96,8 @@ list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) # If you'd like to pad with a missing value rather than recycling or # erroring, you might do something like this, which left-pads x <- list(1, 2:5, 6:7) +try(list_transpose(x)) + sizes <- list_sizes(x) size <- max(sizes) index <- which(sizes != size) @@ -108,6 +110,8 @@ list_transpose(x) # `NULL` values aren't allowed in `list_transpose()`. If you'd like `NULL`s # to be treated as size 1 missing values, replace them with `NA` first. x <- list(1:3, NULL, 5:7, NULL) +try(list_transpose(x)) + x <- vec_assign(x, vec_detect_missing(x), list(NA)) list_transpose(x) } From b4ea0c7a614b70561ab6b9eacd5f0378a75c4172 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Tue, 14 Oct 2025 11:19:18 -0400 Subject: [PATCH 04/13] Add recycle tests --- tests/testthat/_snaps/list-transpose.md | 9 +++++++++ tests/testthat/test-list-transpose.R | 11 +++++++++++ 2 files changed, 20 insertions(+) diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index af015e8b2..800e1f93e 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -25,6 +25,15 @@ * ..1 = 2 i Did you forget to name an argument? +# recycles inputs to common size before transposing + + Code + x <- list(1:2, 3:5) + list_transpose(x) + Condition + Error in `list_transpose()`: + ! Can't recycle `x[[1]]` (size 2) to match `x[[2]]` (size 3). + # respects `size` Code diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index a0aa800bd..d32840825 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -116,6 +116,17 @@ test_that("`...` must be empty", { }) }) +test_that("recycles inputs to common size before transposing", { + expect_identical( + list_transpose(list(1, 2:3, 4)), + list(c(1, 2, 4), c(1, 3, 4)) + ) + expect_snapshot(error = TRUE, { + x <- list(1:2, 3:5) + list_transpose(x) + }) +}) + test_that("respects `size`", { # Useful for the case where you somehow know the element size from somewhere # else, but you also happen to only have all size 1 elements right now From 84b82c517a2395491b1e95236805c4a3e5af20a5 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Tue, 14 Oct 2025 13:44:00 -0400 Subject: [PATCH 05/13] Add `null` argument --- R/list-transpose.R | 122 ++++++++++-- man/list_transpose.Rd | 31 ++- tests/testthat/_snaps/list-transpose.md | 104 +++++++++++ tests/testthat/test-list-transpose.R | 239 ++++++++++++++++++++++++ 4 files changed, 474 insertions(+), 22 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index ba3671bd0..42d93a057 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -9,6 +9,18 @@ #' #' @param x A list. #' +#' @param null A value to replace `NULL` elements with before transposing. +#' +#' If specified: +#' +#' - `null` must be size 1. +#' +#' - `null` will participate in common type determination alongside the +#' elements of `x`. +#' +#' If not specified, an error will be thrown if any `NULL` values are +#' detected. +#' #' @param size The expected size of each element of `x`. If not provided, #' computed automatically by [vec_size_common()]. #' @@ -22,14 +34,18 @@ #' #' For the list: #' -#' - `vec_ptype(list_transpose(x)) == vec_ptype(x)` -#' - `vec_size(list_transpose(x)) == (size || vec_size_common(!!!x))` +#' - `vec_ptype(list_transpose(x)) == ` +#' - `vec_size(list_transpose(x)) == vec_size_common(!!!x, .size = size)` #' #' For the list elements: #' -#' - `vec_ptype(list_transpose(x)[[i]]) == (ptype || vec_ptype_common(!!!x))` +#' - `vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x, .ptype = ptype)` #' - `vec_size(list_transpose(x)[[i]]) == vec_size(x)` #' +#' If `NULL` elements are present in `x`, then an error is thrown unless `null` +#' is provided, in which case any `NULL` elements are treated as size 1 for the +#' common size computation. +#' #' @export #' @examples #' # Input: @@ -88,16 +104,17 @@ #' ) #' list_transpose(x) #' -#' # `NULL` values aren't allowed in `list_transpose()`. If you'd like `NULL`s -#' # to be treated as size 1 missing values, replace them with `NA` first. +#' # `NULL` values aren't allowed in `list_transpose()` #' x <- list(1:3, NULL, 5:7, NULL) #' try(list_transpose(x)) #' -#' x <- vec_assign(x, vec_detect_missing(x), list(NA)) -#' list_transpose(x) +#' # Use `null` to replace `NULL` values before transposing +#' list_transpose(x, null = NA) +#' list_transpose(x, null = 0L) list_transpose <- function( x, ..., + null = NULL, size = NULL, ptype = NULL, x_arg = caller_arg(x), @@ -105,9 +122,23 @@ list_transpose <- function( ) { check_dots_empty0(...) - # Disallow `NULL` entirely. These would break `vec_size()` invariants of + obj_check_list(x, arg = x_arg, call = error_call) + + if (is.object(x)) { + # The list input type should not affect the transposition process in any + # way. In particular, supplying a list subclass that doesn't have a + # `vec_cast.subclass.list` method shouldn't prevent the insertion of + # `list(null)` before the transposition. The fact that we must insert + # `list(null)` should be considered an internal detail. + x <- unclass(x) + } + + # We disallow `NULL` elements. These would break `vec_size()` invariants of # `list_transpose()` if we simply drop them via `list_interleave()`. # + # Either `list_check_all_vectors()` errors, or the user supplied `null` which + # will replace `NULL`s with size 1 vectors before we `list_interleave()`. + # # For example: # # ``` @@ -125,17 +156,15 @@ list_transpose <- function( # - List size 4 # - Element size 2 # - # A reasonable thing for users to do would be to replace `NULL` with `NA` - # ahead of time. This is similar to `keep_empty` in some tidyr functions. - # But we force the caller to make that decision, and it's a fairly easy - # replacement to make with `vec_detect_missing()` and `vec_assign()`. + # Users should instead use `null` to replace `NULL` elements with something + # else, like `NA`. This is similar to `purrr::list_transpose(default =)` and + # `keep_empty` in some tidyr functions. # # ``` - # list_transpose(list(1:4, NA, 5:8)) + # list_transpose(list(1:4, NULL, 5:8), null = NA) # ``` - allow_null <- FALSE + allow_null <- !is_null(null) - obj_check_list(x, arg = x_arg, call = error_call) list_check_all_vectors( x, allow_null = allow_null, @@ -143,6 +172,36 @@ list_transpose <- function( call = error_call ) + ptype <- list_transpose_ptype_common( + x, + null, + ptype, + x_arg, + error_call + ) + + if (!is_null(null)) { + # Do `null` checks regardless of usage + null <- vec_cast( + x = null, + to = ptype, + x_arg = "null", + to_arg = "", + call = error_call + ) + vec_check_size( + null, + size = 1L, + arg = "null", + call = error_call + ) + + if (vec_any_missing(x)) { + null <- list(null) + x <- vec_assign(x, vec_detect_missing(x), null) + } + } + flat <- list_interleave( x, size = size, @@ -173,3 +232,36 @@ list_transpose <- function( out } + +# Computes the `ptype` incorporating both `x` and `null` +# +# Like `ptype_finalize()` in `vec_recode_values()` and `vec_if_else()` +list_transpose_ptype_common <- function( + x, + null, + ptype, + x_arg, + error_call +) { + if (!is_null(ptype)) { + # Validate and return user specified `ptype` + ptype <- vec_ptype(ptype, x_arg = "ptype", call = error_call) + return(vec_ptype_finalise(ptype)) + } + + # Compute from `x` + ptype <- vec_ptype_common(!!!x, .arg = x_arg, .call = error_call) + + if (!is_null(null)) { + # Layer in `null` + ptype <- vec_ptype2( + x = null, + y = ptype, + x_arg = "null", + y_arg = "", + call = error_call + ) + } + + ptype +} diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 1792e6e7e..d6c5aba61 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -7,6 +7,7 @@ list_transpose( x, ..., + null = NULL, size = NULL, ptype = NULL, x_arg = caller_arg(x), @@ -18,6 +19,18 @@ list_transpose( \item{...}{These dots are for future extensions and must be empty.} +\item{null}{A value to replace \code{NULL} elements with before transposing. + +If specified: +\itemize{ +\item \code{null} must be size 1. +\item \code{null} will participate in common type determination alongside the +elements of \code{x}. +} + +If not specified, an error will be thrown if any \code{NULL} values are +detected.} + \item{size}{The expected size of each element of \code{x}. If not provided, computed automatically by \code{\link[=vec_size_common]{vec_size_common()}}.} @@ -36,15 +49,19 @@ A list of vectors with the following invariants: For the list: \itemize{ -\item \code{vec_ptype(list_transpose(x)) == vec_ptype(x)} -\item \code{vec_size(list_transpose(x)) == (size || vec_size_common(!!!x))} +\item \verb{vec_ptype(list_transpose(x)) == } +\item \code{vec_size(list_transpose(x)) == vec_size_common(!!!x, .size = size)} } For the list elements: \itemize{ -\item \code{vec_ptype(list_transpose(x)[[i]]) == (ptype || vec_ptype_common(!!!x))} +\item \code{vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x, .ptype = ptype)} \item \code{vec_size(list_transpose(x)[[i]]) == vec_size(x)} } + +If \code{NULL} elements are present in \code{x}, then an error is thrown unless \code{null} +is provided, in which case any \code{NULL} elements are treated as size 1 for the +common size computation. } \description{ \code{list_transpose()} takes a list of vectors, transposes it, and returns a new @@ -107,11 +124,11 @@ x[index] <- lapply( ) list_transpose(x) -# `NULL` values aren't allowed in `list_transpose()`. If you'd like `NULL`s -# to be treated as size 1 missing values, replace them with `NA` first. +# `NULL` values aren't allowed in `list_transpose()` x <- list(1:3, NULL, 5:7, NULL) try(list_transpose(x)) -x <- vec_assign(x, vec_detect_missing(x), list(NA)) -list_transpose(x) +# Use `null` to replace `NULL` values before transposing +list_transpose(x, null = NA) +list_transpose(x, null = 0L) } diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 800e1f93e..25fe2d1d5 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -83,3 +83,107 @@ Error in `foo()`: ! `x[[2]]` must be a vector, not a object. +# `x` being a list subclass can't affect the transposition + + Code + vec_cast(list(null), to = x) + Condition + Error: + ! Can't convert `list(null)` to . + +# `x` being a doesn't affect the transposition + + Code + list_transpose(x) + Condition + Error in `list_transpose()`: + ! `[[1]]` must be a vector, not `NULL`. + +# `null` must be a vector + + Code + list_transpose(x, null = lm(1 ~ 1)) + Condition + Error in `list_transpose()`: + ! `null` must be a vector, not a object. + +--- + + Code + list_transpose(x, null = lm(1 ~ 1)) + Condition + Error in `list_transpose()`: + ! `null` must be a vector, not a object. + +# `null` participates in common type determination + + Code + list_transpose(x, null = "x") + Condition + Error in `list_transpose()`: + ! Can't combine `null` and . + +--- + + Code + list_transpose(x, null = "x", ptype = double()) + Condition + Error in `list_transpose()`: + ! Can't convert `null` to . + +--- + + Code + list_transpose(x, null = "x") + Condition + Error in `list_transpose()`: + ! Can't combine `null` and . + +--- + + Code + list_transpose(x, null = "x", ptype = double()) + Condition + Error in `list_transpose()`: + ! Can't convert `null` to . + +# `null` must be size 1 + + Code + list_transpose(x, null = 2:3) + Condition + Error in `list_transpose()`: + ! `null` must have size 1, not size 2. + +--- + + Code + list_transpose(x, null = 4:5) + Condition + Error in `list_transpose()`: + ! `null` must have size 1, not size 2. + +--- + + Code + list_transpose(x, null = 2:3) + Condition + Error in `list_transpose()`: + ! `null` must have size 1, not size 2. + +# `null` can't result in recycle to size 0 + + Code + list_transpose(x, null = integer()) + Condition + Error in `list_transpose()`: + ! `null` must have size 1, not size 0. + +# `null` influences type in the empty `list()` case + + Code + list_transpose(list(), null = 1:2) + Condition + Error in `list_transpose()`: + ! `null` must have size 1, not size 2. + diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index d32840825..7fe392322 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -178,3 +178,242 @@ test_that("doesn't allow scalar elements", { list_transpose(list(1:4, lm(1 ~ 1)), x_arg = "x", error_call = quote(foo())) }) }) + +test_that("`x` being a list subclass can't affect the transposition", { + x <- structure(list(1, NULL, 2), class = c("my_list", "list")) + + null <- 0 + + # Note how this is an error. We perform a cast like this internally. + expect_snapshot(error = TRUE, { + vec_cast(list(null), to = x) + }) + + # But we unclass `x` first, so it won't matter. + # Our output type is always `` and as long as `obj_is_list()` + # passes, we don't care about the input type. + expect_identical( + list_transpose(x, null = null), + list(c(1, 0, 2)) + ) +}) + +test_that("`x` being a doesn't affect the transposition", { + # As a primitive function, `list_transpose()` doesn't know anything + # about ``, and shouldn't treat it specially + + # No preservation of type + x <- list_of(.ptype = integer()) + expect_identical(list_transpose(x), list()) + expect_identical(list_transpose(x, ptype = character()), list()) + + x <- list_of(NULL, .ptype = integer()) + expect_snapshot(error = TRUE, { + list_transpose(x) + }) + expect_identical( + list_transpose(x, null = "x"), + list("x") + ) + + # `ptype` overrules list-of type + x <- list_of(1L, 2L) + expect_identical( + list_transpose(x, ptype = double()), + list(c(1, 2)) + ) + + # Common type determination with `null` overrules list-of type + x <- list_of(1L, NULL, 2L) + expect_identical( + list_transpose(x, null = 0), + list(c(1, 0, 2)) + ) +}) + +test_that("`null` replaces `NULL` elements", { + x <- list(1:2, NULL, 3:4, NULL) + + expect_identical( + list_transpose(x, null = 0L), + list( + int(1, 0, 3, 0), + int(2, 0, 4, 0) + ) + ) +}) + +test_that("`null` must be a vector", { + x <- list(1, NULL) + expect_snapshot(error = TRUE, { + list_transpose(x, null = lm(1 ~ 1)) + }) + + # Even when not used + x <- list(1, 2) + expect_snapshot(error = TRUE, { + list_transpose(x, null = lm(1 ~ 1)) + }) +}) + +test_that("`null` participates in common type determination", { + x <- list(1L, NULL) + expect_identical( + list_transpose(x, null = 0), + list(c(1, 0)) + ) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x") + }) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x", ptype = double()) + }) + + # Even when not used + x <- list(1L, 2L) + expect_identical( + list_transpose(x, null = 0), + list(c(1, 2)) + ) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x") + }) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x", ptype = double()) + }) +}) + +test_that("`null` must be size 1", { + x <- list(1L, NULL) + expect_identical( + list_transpose(x, null = 2L), + list(int(1, 2)) + ) + expect_identical( + list_transpose(x, null = 2L, size = 2), + list(int(1, 2), int(1, 2)) + ) + expect_snapshot(error = TRUE, { + list_transpose(x, null = 2:3) + }) + + x <- list(1L, NULL, 2:3) + expect_identical( + list_transpose(x, null = 4L), + list(int(1, 4, 2), int(1, 4, 3)) + ) + expect_snapshot(error = TRUE, { + list_transpose(x, null = 4:5) + }) + + # Even when not used + x <- list(1L, 2L) + expect_snapshot(error = TRUE, { + list_transpose(x, null = 2:3) + }) +}) + +test_that("`null` can't result in recycle to size 0", { + # This is one reason we force `null` to be size 1. + # If it participated in common size determination it would result in `list()` + # by forcing the elements to recycle to size 0 first. + x <- list(1L, 2L) + expect_snapshot(error = TRUE, { + list_transpose(x, null = integer()) + }) +}) + +test_that("`null` influences type in the empty `list()` case", { + # Input + # - List size 0 + # - Element size 0 (inferred from list) + # - Element type integer (inferred from `null`) + # Output + # - List size 0 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L), + list() + ) + + # Input + # - List size 0 + # - Element size 0 (supplied by `size`) + # - Element type integer (inferred from `null`) + # Output + # - List size 0 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L, size = 0), + list() + ) + + # Input + # - List size 0 + # - Element size 1 (supplied by `size`) + # - Element type integer (inferred from `null`) + # Output + # - List size 1 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L, size = 1), + list(integer()) + ) + + # Input + # - List size 0 + # - Element size 2 (supplied by `size`) + # - Element type integer (inferred from `null`) + # Output + # - List size 2 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L, size = 2), + list(integer(), integer()) + ) + + # This is one reason we force `null` to be size 1. + # If it participated in common size determination, it would result in an + # element size of 2, and then an output list size of 2, giving us + # `list(integer(), integer())` which would be very odd. + # + # Input + # - List size 0 + # - Element size 0 (inferred from list) + # - Element type integer (inferred from `null`) + expect_snapshot(error = TRUE, { + list_transpose(list(), null = 1:2) + }) +}) + +test_that("`null` influences type in the only `NULL` case", { + # Input + # - List size 2 + # - Element size 1 (inferred from `NULL` being treated as size 1) + # - Element type integer (inferred from `null`) + # Output + # - List size 1 + # - Element size 2 + # - Element type integer + expect_identical( + list_transpose(list(NULL, NULL), null = 1L), + list(c(1L, 1L)) + ) + expect_identical( + list_transpose(list(NULL, NULL), null = 1L, ptype = double()), + list(c(1, 1)) + ) +}) + +test_that("`ptype` is finalized", { + # `vec_ptype(NA)` alone returns `unspecified()`, must also call + # `vec_ptype_finalize()` + expect_identical( + list_transpose(list(TRUE, FALSE), ptype = NA), + list(c(TRUE, FALSE)) + ) +}) From 4a7ba1c69cffcd5027a973bdb20429b6ba790773 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Wed, 15 Oct 2025 14:22:33 -0400 Subject: [PATCH 06/13] temp --- R/list-transpose.R | 258 ++++++++++-------------- man/list_transpose.Rd | 85 ++++---- tests/testthat/_snaps/list-transpose.md | 129 ++---------- tests/testthat/test-list-transpose.R | 244 ++-------------------- 4 files changed, 194 insertions(+), 522 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index 42d93a057..441a57aff 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -1,28 +1,43 @@ #' Transpose a list of vectors #' #' @description -#' `list_transpose()` takes a list of vectors, transposes it, and returns a new -#' list of vectors. +#' `list_transpose()` takes a list of vectors of equal size, transposes it, and +#' returns a new list of vectors of equal size. #' -#' @inheritParams rlang::args_dots_empty -#' @inheritParams rlang::args_error_context +#' To predict the output from `list_transpose()`, swap the size of the list +#' with the size of the list elements. For example: +#' +#' - Input: List of size 2, elements of size 3 +#' - Output: List of size 3, elements of size 2 +#' +#' @details +#' In an ideal world, this function would transpose a data frame. Data frames +#' have a few desirable properties: #' -#' @param x A list. +#' - Each column is the same size +#' - `NULL` columns are not allowed #' -#' @param null A value to replace `NULL` elements with before transposing. +#' The downside is that data frames must have names. When transposing, names +#' are meaningless, both on the input and output. +#' +#' The compromise struck here is to allow a list, which doesn't require names, +#' but to enforce that each element of the list must be the same size and can't +#' be `NULL`. +#' +#' @inheritParams rlang::args_dots_empty +#' @inheritParams rlang::args_error_context #' -#' If specified: +#' @param x A list of vectors. #' -#' - `null` must be size 1. +#' - Each vector must be the same size. #' -#' - `null` will participate in common type determination alongside the -#' elements of `x`. +#' - Each vector will be [cast][vctrs::theory-faq-coercion] to the common type +#' before transposing. #' -#' If not specified, an error will be thrown if any `NULL` values are -#' detected. +#' - `NULL` elements are not allowed. #' #' @param size The expected size of each element of `x`. If not provided, -#' computed automatically by [vec_size_common()]. +#' computed as `vec_size(x[[1L]])`, or `0L` if `x` is empty. #' #' @param ptype The expected type of each element of `x`. If not provided, #' computed automatically by [vec_ptype_common()]. @@ -35,17 +50,13 @@ #' For the list: #' #' - `vec_ptype(list_transpose(x)) == ` -#' - `vec_size(list_transpose(x)) == vec_size_common(!!!x, .size = size)` +#' - `vec_size(list_transpose(x)) == size %||% vec_size(x[[1L]]) %||% 0L` #' #' For the list elements: #' #' - `vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x, .ptype = ptype)` #' - `vec_size(list_transpose(x)[[i]]) == vec_size(x)` #' -#' If `NULL` elements are present in `x`, then an error is thrown unless `null` -#' is provided, in which case any `NULL` elements are treated as size 1 for the -#' common size computation. -#' #' @export #' @examples #' # Input: @@ -61,13 +72,6 @@ #' y <- data_frame(a = 3:4, b = letters[3:4]) #' list_transpose(list(x, y)) #' -#' # Size 1 elements are recycled to the common size before transposing -#' list_transpose(list(1, 2:4)) -#' -#' # With all size 1 elements, you can use `size` if you want to force a known -#' # common size other than size 1 -#' list_transpose(list(1, 2), size = 3) -#' #' # With size 0 elements, the invariants are a bit tricky! #' # This must return a size 0 list, but then you lose expected #' # type (integer) and size (2) information about the elements. @@ -90,8 +94,14 @@ #' # To work around this, provide the lost `size` and `ptype` manually #' list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) #' -#' # If you'd like to pad with a missing value rather than recycling or -#' # erroring, you might do something like this, which left-pads +#' # Note that this function doesn't recycle elements. This is purposeful, +#' # it is meant for transposing "rectangular lists", which are lists with +#' # elements of equal size. +#' x <- list(1, 2:3) +#' try(list_transpose(x)) +#' +#' # If you'd like to pad with a missing value rather than erroring, +#' # you might do something like this, which left-pads #' x <- list(1, 2:5, 6:7) #' try(list_transpose(x)) #' @@ -104,105 +114,77 @@ #' ) #' list_transpose(x) #' -#' # `NULL` values aren't allowed in `list_transpose()` +#' # `NULL` values aren't allowed in `list_transpose()` because theoretically +#' # this function is meant to transpose a data frame, which can't have `NULL` +#' # columns. #' x <- list(1:3, NULL, 5:7, NULL) #' try(list_transpose(x)) #' -#' # Use `null` to replace `NULL` values before transposing -#' list_transpose(x, null = NA) -#' list_transpose(x, null = 0L) +#' # Either drop the `NULL` values or replace them with something else +#' list_transpose(list_drop_empty(x)) +#' +#' na <- list(vec_rep(NA, vec_size_common(!!!x))) +#' x <- vec_assign(x, vec_detect_missing(x), na) +#' list_transpose(x) list_transpose <- function( x, ..., - null = NULL, size = NULL, ptype = NULL, x_arg = caller_arg(x), error_call = current_env() ) { - check_dots_empty0(...) - - obj_check_list(x, arg = x_arg, call = error_call) - - if (is.object(x)) { - # The list input type should not affect the transposition process in any - # way. In particular, supplying a list subclass that doesn't have a - # `vec_cast.subclass.list` method shouldn't prevent the insertion of - # `list(null)` before the transposition. The fact that we must insert - # `list(null)` should be considered an internal detail. - x <- unclass(x) - } - - # We disallow `NULL` elements. These would break `vec_size()` invariants of - # `list_transpose()` if we simply drop them via `list_interleave()`. - # - # Either `list_check_all_vectors()` errors, or the user supplied `null` which - # will replace `NULL`s with size 1 vectors before we `list_interleave()`. + # NOTES: # - # For example: + # # Recycling # - # ``` - # list_transpose(list(1:4, NULL, 5:8)) - # ``` + # Resist the urge to provide support for recycling in this function. It is + # designed to transpose a "df-list" or "rectangular list" returned by + # `df_list()`, which already contains vectors of equal size. # - # Input: - # - List size 3 - # - Element size 4 - # Output: - # - List size 4 - # - Element size 3 + # We treat differing sizes as a user error. # - # But if we drop `NULL` you'd get: - # - List size 4 - # - Element size 2 + # This also leaves open the possibility of providing automatic support for + # padding via `too_short = c("error", "left", "right"), pad = NULL` where + # `pad` could be a scalar value to pad with when choosing `"left"` or + # `"right"`. # - # Users should instead use `null` to replace `NULL` elements with something - # else, like `NA`. This is similar to `purrr::list_transpose(default =)` and - # `keep_empty` in some tidyr functions. - # - # ``` - # list_transpose(list(1:4, NULL, 5:8), null = NA) - # ``` - allow_null <- !is_null(null) + check_dots_empty0(...) + + obj_check_list(x, arg = x_arg, call = error_call) + + # Disallow `NULL` elements - i.e. pretend the user supplied a data frame, + # which can't have `NULL` columns list_check_all_vectors( x, - allow_null = allow_null, + allow_null = FALSE, arg = x_arg, call = error_call ) - ptype <- list_transpose_ptype_common( + # Finalize `size` + if (is_null(size)) { + if (vec_size(x) == 0L) { + size <- 0L + } else { + size <- vec_size(x[[1L]]) + } + } + + # Check that all elements are the same size, with no recycling - i.e. pretend + # the user supplied a data frame, where all columns are the same size + list_check_all_size( x, - null, - ptype, - x_arg, - error_call + size = size, + arg = x_arg, + call = error_call ) - if (!is_null(null)) { - # Do `null` checks regardless of usage - null <- vec_cast( - x = null, - to = ptype, - x_arg = "null", - to_arg = "", - call = error_call - ) - vec_check_size( - null, - size = 1L, - arg = "null", - call = error_call - ) - - if (vec_any_missing(x)) { - null <- list(null) - x <- vec_assign(x, vec_detect_missing(x), null) - } - } + x_size <- vec_size(x) + sizes <- vec_rep(x_size, times = size) - flat <- list_interleave( + out <- list_interleave( x, size = size, ptype = ptype, @@ -211,57 +193,39 @@ list_transpose <- function( error_call = error_call ) - x_size <- vec_size(x) - - if (is_null(size)) { - # Identical to `elt_size <- vec_size_common(!!!x)`, but faster. - # Utilizes known info about the `list_interleave()` return value. - if (x_size == 0L) { - elt_size <- 0L - } else { - elt_size <- vec_size(flat) / x_size - } - } else { - elt_size <- size - } - - sizes <- vec_rep(x_size, times = elt_size) - # Chop the one big vector into transposed pieces of size `x_size` - out <- vec_chop(flat, sizes = sizes) + out <- vec_chop(out, sizes = sizes) out } -# Computes the `ptype` incorporating both `x` and `null` +# We disallow `NULL` elements. These would break `vec_size()` invariants of +# `list_transpose()` if we simply drop them via `list_interleave()`. # -# Like `ptype_finalize()` in `vec_recode_values()` and `vec_if_else()` -list_transpose_ptype_common <- function( - x, - null, - ptype, - x_arg, - error_call -) { - if (!is_null(ptype)) { - # Validate and return user specified `ptype` - ptype <- vec_ptype(ptype, x_arg = "ptype", call = error_call) - return(vec_ptype_finalise(ptype)) - } - - # Compute from `x` - ptype <- vec_ptype_common(!!!x, .arg = x_arg, .call = error_call) - - if (!is_null(null)) { - # Layer in `null` - ptype <- vec_ptype2( - x = null, - y = ptype, - x_arg = "null", - y_arg = "", - call = error_call - ) - } - - ptype -} +# Either `list_check_all_vectors()` errors, or the user supplied `null` which +# will replace `NULL`s with size 1 vectors before we `list_interleave()`. +# +# For example: +# +# ``` +# list_transpose(list(1:4, NULL, 5:8)) +# ``` +# +# Input: +# - List size 3 +# - Element size 4 +# Output: +# - List size 4 +# - Element size 3 +# +# But if we drop `NULL` you'd get: +# - List size 4 +# - Element size 2 +# +# Users should instead use `null` to replace `NULL` elements with something +# else, like `NA`. This is similar to `purrr::list_transpose(default =)` and +# `keep_empty` in some tidyr functions. +# +# ``` +# list_transpose(list(1:4, NULL, 5:8), null = NA) +# ``` diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index d6c5aba61..480520e99 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -7,7 +7,6 @@ list_transpose( x, ..., - null = NULL, size = NULL, ptype = NULL, x_arg = caller_arg(x), @@ -15,24 +14,18 @@ list_transpose( ) } \arguments{ -\item{x}{A list.} - -\item{...}{These dots are for future extensions and must be empty.} - -\item{null}{A value to replace \code{NULL} elements with before transposing. - -If specified: +\item{x}{A list of vectors. \itemize{ -\item \code{null} must be size 1. -\item \code{null} will participate in common type determination alongside the -elements of \code{x}. -} +\item Each vector must be the same size. +\item Each vector will be \link[=theory-faq-coercion]{cast} to the common type +before transposing. +\item \code{NULL} elements are not allowed. +}} -If not specified, an error will be thrown if any \code{NULL} values are -detected.} +\item{...}{These dots are for future extensions and must be empty.} \item{size}{The expected size of each element of \code{x}. If not provided, -computed automatically by \code{\link[=vec_size_common]{vec_size_common()}}.} +computed as \code{vec_size(x[[1L]])}, or \code{0L} if \code{x} is empty.} \item{ptype}{The expected type of each element of \code{x}. If not provided, computed automatically by \code{\link[=vec_ptype_common]{vec_ptype_common()}}.} @@ -50,7 +43,7 @@ A list of vectors with the following invariants: For the list: \itemize{ \item \verb{vec_ptype(list_transpose(x)) == } -\item \code{vec_size(list_transpose(x)) == vec_size_common(!!!x, .size = size)} +\item \code{vec_size(list_transpose(x)) == size \%||\% vec_size(x[[1L]]) \%||\% 0L} } For the list elements: @@ -58,14 +51,32 @@ For the list elements: \item \code{vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x, .ptype = ptype)} \item \code{vec_size(list_transpose(x)[[i]]) == vec_size(x)} } - -If \code{NULL} elements are present in \code{x}, then an error is thrown unless \code{null} -is provided, in which case any \code{NULL} elements are treated as size 1 for the -common size computation. } \description{ -\code{list_transpose()} takes a list of vectors, transposes it, and returns a new -list of vectors. +\code{list_transpose()} takes a list of vectors of equal size, transposes it, and +returns a new list of vectors of equal size. + +To predict the output from \code{list_transpose()}, swap the size of the list +with the size of the list elements. For example: +\itemize{ +\item Input: List of size 2, elements of size 3 +\item Output: List of size 3, elements of size 2 +} +} +\details{ +In an ideal world, this function would transpose a data frame. Data frames +have a few desirable properties: +\itemize{ +\item Each column is the same size +\item \code{NULL} columns are not allowed +} + +The downside is that data frames must have names. When transposing, names +are meaningless, both on the input and output. + +The compromise struck here is to allow a list, which doesn't require names, +but to enforce that each element of the list must be the same size and can't +be \code{NULL}. } \examples{ # Input: @@ -81,13 +92,6 @@ x <- data_frame(a = 1:2, b = letters[1:2]) y <- data_frame(a = 3:4, b = letters[3:4]) list_transpose(list(x, y)) -# Size 1 elements are recycled to the common size before transposing -list_transpose(list(1, 2:4)) - -# With all size 1 elements, you can use `size` if you want to force a known -# common size other than size 1 -list_transpose(list(1, 2), size = 3) - # With size 0 elements, the invariants are a bit tricky! # This must return a size 0 list, but then you lose expected # type (integer) and size (2) information about the elements. @@ -110,8 +114,14 @@ list_transpose(out) # To work around this, provide the lost `size` and `ptype` manually list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) -# If you'd like to pad with a missing value rather than recycling or -# erroring, you might do something like this, which left-pads +# Note that this function doesn't recycle elements. This is purposeful, +# it is meant for transposing "rectangular lists", which are lists with +# elements of equal size. +x <- list(1, 2:3) +try(list_transpose(x)) + +# If you'd like to pad with a missing value rather than erroring, +# you might do something like this, which left-pads x <- list(1, 2:5, 6:7) try(list_transpose(x)) @@ -124,11 +134,16 @@ x[index] <- lapply( ) list_transpose(x) -# `NULL` values aren't allowed in `list_transpose()` +# `NULL` values aren't allowed in `list_transpose()` because theoretically +# this function is meant to transpose a data frame, which can't have `NULL` +# columns. x <- list(1:3, NULL, 5:7, NULL) try(list_transpose(x)) -# Use `null` to replace `NULL` values before transposing -list_transpose(x, null = NA) -list_transpose(x, null = 0L) +# Either drop the `NULL` values or replace them with something else +list_transpose(list_drop_empty(x)) + +na <- list(vec_rep(NA, vec_size_common(!!!x))) +x <- vec_assign(x, vec_detect_missing(x), na) +list_transpose(x) } diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 25fe2d1d5..0e438a9ec 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -25,14 +25,21 @@ * ..1 = 2 i Did you forget to name an argument? -# recycles inputs to common size before transposing +# no recycling is done Code - x <- list(1:2, 3:5) - list_transpose(x) + list_transpose(list(1L, 2:3)) Condition Error in `list_transpose()`: - ! Can't recycle `x[[1]]` (size 2) to match `x[[2]]` (size 3). + ! `list(1L, 2:3)[[2]]` must have size 1, not size 2. + +# doesn't allow `NULL` elements + + Code + list_transpose(list(1:4, NULL, 5:8)) + Condition + Error in `list_transpose()`: + ! `list(1:4, NULL, 5:8)[[2]]` must be a vector, not `NULL`. # respects `size` @@ -40,7 +47,7 @@ list_transpose(list(1:2), size = 3) Condition Error in `list_transpose()`: - ! Can't recycle `list(1:2)[[1]]` (size 2) to size 3. + ! `list(1:2)[[1]]` must have size 3, not size 2. # respects `ptype` @@ -59,14 +66,6 @@ Error in `foo()`: ! Can't convert `x[[1]]` to . -# doesn't allow `NULL` elements - - Code - list_transpose(list(1:4, NULL, 5:8)) - Condition - Error in `list_transpose()`: - ! `list(1:4, NULL, 5:8)[[2]]` must be a vector, not `NULL`. - # doesn't allow scalar elements Code @@ -83,107 +82,3 @@ Error in `foo()`: ! `x[[2]]` must be a vector, not a object. -# `x` being a list subclass can't affect the transposition - - Code - vec_cast(list(null), to = x) - Condition - Error: - ! Can't convert `list(null)` to . - -# `x` being a doesn't affect the transposition - - Code - list_transpose(x) - Condition - Error in `list_transpose()`: - ! `[[1]]` must be a vector, not `NULL`. - -# `null` must be a vector - - Code - list_transpose(x, null = lm(1 ~ 1)) - Condition - Error in `list_transpose()`: - ! `null` must be a vector, not a object. - ---- - - Code - list_transpose(x, null = lm(1 ~ 1)) - Condition - Error in `list_transpose()`: - ! `null` must be a vector, not a object. - -# `null` participates in common type determination - - Code - list_transpose(x, null = "x") - Condition - Error in `list_transpose()`: - ! Can't combine `null` and . - ---- - - Code - list_transpose(x, null = "x", ptype = double()) - Condition - Error in `list_transpose()`: - ! Can't convert `null` to . - ---- - - Code - list_transpose(x, null = "x") - Condition - Error in `list_transpose()`: - ! Can't combine `null` and . - ---- - - Code - list_transpose(x, null = "x", ptype = double()) - Condition - Error in `list_transpose()`: - ! Can't convert `null` to . - -# `null` must be size 1 - - Code - list_transpose(x, null = 2:3) - Condition - Error in `list_transpose()`: - ! `null` must have size 1, not size 2. - ---- - - Code - list_transpose(x, null = 4:5) - Condition - Error in `list_transpose()`: - ! `null` must have size 1, not size 2. - ---- - - Code - list_transpose(x, null = 2:3) - Condition - Error in `list_transpose()`: - ! `null` must have size 1, not size 2. - -# `null` can't result in recycle to size 0 - - Code - list_transpose(x, null = integer()) - Condition - Error in `list_transpose()`: - ! `null` must have size 1, not size 0. - -# `null` influences type in the empty `list()` case - - Code - list_transpose(list(), null = 1:2) - Condition - Error in `list_transpose()`: - ! `null` must have size 1, not size 2. - diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index 7fe392322..4d5c077ad 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -116,23 +116,31 @@ test_that("`...` must be empty", { }) }) -test_that("recycles inputs to common size before transposing", { - expect_identical( - list_transpose(list(1, 2:3, 4)), - list(c(1, 2, 4), c(1, 3, 4)) - ) +test_that("no recycling is done", { + # We mimic the idea of transposing a data frame of equal column sizes expect_snapshot(error = TRUE, { - x <- list(1:2, 3:5) - list_transpose(x) + list_transpose(list(1L, 2:3)) + }) +}) + +test_that("doesn't allow `NULL` elements", { + # We mimic the idea of transposing a data frame, which doesn't allow `NULL` + # columns + expect_snapshot(error = TRUE, { + list_transpose(list(1:4, NULL, 5:8)) }) }) test_that("respects `size`", { # Useful for the case where you somehow know the element size from somewhere - # else, but you also happen to only have all size 1 elements right now + # else, but you also happen to only have all empty elements right now expect_identical( - list_transpose(list(1L, 2L), size = 3), - list(1:2, 1:2, 1:2) + list_transpose(list(), size = 3), + list(unspecified(), unspecified(), unspecified()) + ) + expect_identical( + list_transpose(list(), size = 3, ptype = integer()), + list(integer(), integer(), integer()) ) expect_snapshot(error = TRUE, { @@ -162,14 +170,6 @@ test_that("respects `ptype`", { }) }) -test_that("doesn't allow `NULL` elements", { - # These would break the invariants around the size of the output relative - # to the size of the input - expect_snapshot(error = TRUE, { - list_transpose(list(1:4, NULL, 5:8)) - }) -}) - test_that("doesn't allow scalar elements", { expect_snapshot(error = TRUE, { list_transpose(list(1:4, lm(1 ~ 1))) @@ -180,21 +180,13 @@ test_that("doesn't allow scalar elements", { }) test_that("`x` being a list subclass can't affect the transposition", { - x <- structure(list(1, NULL, 2), class = c("my_list", "list")) - - null <- 0 + x <- structure(list(1, 2), class = c("my_list", "list")) - # Note how this is an error. We perform a cast like this internally. - expect_snapshot(error = TRUE, { - vec_cast(list(null), to = x) - }) - - # But we unclass `x` first, so it won't matter. # Our output type is always `` and as long as `obj_is_list()` # passes, we don't care about the input type. expect_identical( - list_transpose(x, null = null), - list(c(1, 0, 2)) + list_transpose(x), + list(c(1, 2)) ) }) @@ -207,206 +199,12 @@ test_that("`x` being a doesn't affect the transposition", { expect_identical(list_transpose(x), list()) expect_identical(list_transpose(x, ptype = character()), list()) - x <- list_of(NULL, .ptype = integer()) - expect_snapshot(error = TRUE, { - list_transpose(x) - }) - expect_identical( - list_transpose(x, null = "x"), - list("x") - ) - # `ptype` overrules list-of type x <- list_of(1L, 2L) expect_identical( list_transpose(x, ptype = double()), list(c(1, 2)) ) - - # Common type determination with `null` overrules list-of type - x <- list_of(1L, NULL, 2L) - expect_identical( - list_transpose(x, null = 0), - list(c(1, 0, 2)) - ) -}) - -test_that("`null` replaces `NULL` elements", { - x <- list(1:2, NULL, 3:4, NULL) - - expect_identical( - list_transpose(x, null = 0L), - list( - int(1, 0, 3, 0), - int(2, 0, 4, 0) - ) - ) -}) - -test_that("`null` must be a vector", { - x <- list(1, NULL) - expect_snapshot(error = TRUE, { - list_transpose(x, null = lm(1 ~ 1)) - }) - - # Even when not used - x <- list(1, 2) - expect_snapshot(error = TRUE, { - list_transpose(x, null = lm(1 ~ 1)) - }) -}) - -test_that("`null` participates in common type determination", { - x <- list(1L, NULL) - expect_identical( - list_transpose(x, null = 0), - list(c(1, 0)) - ) - expect_snapshot(error = TRUE, { - list_transpose(x, null = "x") - }) - expect_snapshot(error = TRUE, { - list_transpose(x, null = "x", ptype = double()) - }) - - # Even when not used - x <- list(1L, 2L) - expect_identical( - list_transpose(x, null = 0), - list(c(1, 2)) - ) - expect_snapshot(error = TRUE, { - list_transpose(x, null = "x") - }) - expect_snapshot(error = TRUE, { - list_transpose(x, null = "x", ptype = double()) - }) -}) - -test_that("`null` must be size 1", { - x <- list(1L, NULL) - expect_identical( - list_transpose(x, null = 2L), - list(int(1, 2)) - ) - expect_identical( - list_transpose(x, null = 2L, size = 2), - list(int(1, 2), int(1, 2)) - ) - expect_snapshot(error = TRUE, { - list_transpose(x, null = 2:3) - }) - - x <- list(1L, NULL, 2:3) - expect_identical( - list_transpose(x, null = 4L), - list(int(1, 4, 2), int(1, 4, 3)) - ) - expect_snapshot(error = TRUE, { - list_transpose(x, null = 4:5) - }) - - # Even when not used - x <- list(1L, 2L) - expect_snapshot(error = TRUE, { - list_transpose(x, null = 2:3) - }) -}) - -test_that("`null` can't result in recycle to size 0", { - # This is one reason we force `null` to be size 1. - # If it participated in common size determination it would result in `list()` - # by forcing the elements to recycle to size 0 first. - x <- list(1L, 2L) - expect_snapshot(error = TRUE, { - list_transpose(x, null = integer()) - }) -}) - -test_that("`null` influences type in the empty `list()` case", { - # Input - # - List size 0 - # - Element size 0 (inferred from list) - # - Element type integer (inferred from `null`) - # Output - # - List size 0 - # - Element size 0 - # - Element type integer - expect_identical( - list_transpose(list(), null = 1L), - list() - ) - - # Input - # - List size 0 - # - Element size 0 (supplied by `size`) - # - Element type integer (inferred from `null`) - # Output - # - List size 0 - # - Element size 0 - # - Element type integer - expect_identical( - list_transpose(list(), null = 1L, size = 0), - list() - ) - - # Input - # - List size 0 - # - Element size 1 (supplied by `size`) - # - Element type integer (inferred from `null`) - # Output - # - List size 1 - # - Element size 0 - # - Element type integer - expect_identical( - list_transpose(list(), null = 1L, size = 1), - list(integer()) - ) - - # Input - # - List size 0 - # - Element size 2 (supplied by `size`) - # - Element type integer (inferred from `null`) - # Output - # - List size 2 - # - Element size 0 - # - Element type integer - expect_identical( - list_transpose(list(), null = 1L, size = 2), - list(integer(), integer()) - ) - - # This is one reason we force `null` to be size 1. - # If it participated in common size determination, it would result in an - # element size of 2, and then an output list size of 2, giving us - # `list(integer(), integer())` which would be very odd. - # - # Input - # - List size 0 - # - Element size 0 (inferred from list) - # - Element type integer (inferred from `null`) - expect_snapshot(error = TRUE, { - list_transpose(list(), null = 1:2) - }) -}) - -test_that("`null` influences type in the only `NULL` case", { - # Input - # - List size 2 - # - Element size 1 (inferred from `NULL` being treated as size 1) - # - Element type integer (inferred from `null`) - # Output - # - List size 1 - # - Element size 2 - # - Element type integer - expect_identical( - list_transpose(list(NULL, NULL), null = 1L), - list(c(1L, 1L)) - ) - expect_identical( - list_transpose(list(NULL, NULL), null = 1L, ptype = double()), - list(c(1, 1)) - ) }) test_that("`ptype` is finalized", { From 1cfe32beb41c2e49ab67315535869264281687f4 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Wed, 15 Oct 2025 15:03:13 -0400 Subject: [PATCH 07/13] temp --- R/list-transpose.R | 95 +++++++++++++++++++++++++++++----------------- 1 file changed, 61 insertions(+), 34 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index 441a57aff..8137955e8 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -140,15 +140,73 @@ list_transpose <- function( # # Resist the urge to provide support for recycling in this function. It is # designed to transpose a "df-list" or "rectangular list" returned by - # `df_list()`, which already contains vectors of equal size. - # - # We treat differing sizes as a user error. + # `df_list()`, which already contains vectors of equal size. We treat any + # differing sizes as a user error. # # This also leaves open the possibility of providing automatic support for # padding via `too_short = c("error", "left", "right"), pad = NULL` where # `pad` could be a scalar value to pad with when choosing `"left"` or # `"right"`. # + # # `NULL` handling + # + # We spent a lot of effort trying to rationalize `NULL` handling, but + # ultimately decided to treat this function as if it takes a "df-list", + # which don't allow `NULL` columns. + # + # Simply dropping `NULL`s is not a good option. That would break `vec_size()` + # invariants of `list_transpose()`. For example: + # + # ``` + # I: List size 3, Element size 4 + # O: List size 4, Element size 3 (in theory) + # O: List size 4, Element size 2 (if you drop `NULL`s) + # list_transpose(list(1:4, NULL, 5:8)) + # ``` + # + # Adding a `null` argument that accepts a vector to replace `NULL`s with is + # extremely tricky to get right due to the number of edge cases related to + # empty inputs. In particular, deciding whether `null` should participate in + # size determination or not is very confusing. + # + # ``` + # # If `null` participates in size determination + # # I: List size 0, Element size 2 (infer from `null`?) + # # O: List size 2, Element size 0 + # list_transpose(list(), null = 1:2) + # # list(integer(), integer()) + # # Very weird output result, expecting `list()` + # + # # If `null` must be the input element size, then this errors + # list_transpose(list(), null = 1:2) + # # Error: Can't recycle `null` (2) to size 0. + # # But then this works + # list_transpose(list(1:2), null = 1:2) + # # You'd have to do this + # list_transpose(list(), null = 1:2, size = 2) + # ``` + # + # ``` + # # If `null` participates in size determination + # # I: List size 1, Element size 2 (infer from `null`?) + # # O: List size 2, Element size 1 + # list_transpose(list(NULL), null = 1:2) + # # list(1L, 2L) + # + # # If `null` must be the input element size, then this errors + # list_transpose(list(NULL), null = 1:2) + # # Error: Can't recycle `null` (2) to size 0. + # # Again, you'd have to do this + # list_transpose(list(NULL), null = 1:2, size = 2) + # + # # This is weird because it feels like it should be identical to replacing + # # the `NULL`s up front, i.e. + # list_transpose(list(1:2)) + # ``` + # + # And then you also have to deal with common type. Does `null` contribute to + # the common type or is it cast to the input element type? What happens when + # there are no inputs or only `NULL`s and the type is `unspecified`? check_dots_empty0(...) @@ -198,34 +256,3 @@ list_transpose <- function( out } - -# We disallow `NULL` elements. These would break `vec_size()` invariants of -# `list_transpose()` if we simply drop them via `list_interleave()`. -# -# Either `list_check_all_vectors()` errors, or the user supplied `null` which -# will replace `NULL`s with size 1 vectors before we `list_interleave()`. -# -# For example: -# -# ``` -# list_transpose(list(1:4, NULL, 5:8)) -# ``` -# -# Input: -# - List size 3 -# - Element size 4 -# Output: -# - List size 4 -# - Element size 3 -# -# But if we drop `NULL` you'd get: -# - List size 4 -# - Element size 2 -# -# Users should instead use `null` to replace `NULL` elements with something -# else, like `NA`. This is similar to `purrr::list_transpose(default =)` and -# `keep_empty` in some tidyr functions. -# -# ``` -# list_transpose(list(1:4, NULL, 5:8), null = NA) -# ``` From 896ff98928bb61633b745e2923668eae5601dad1 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 16 Oct 2025 07:26:32 -0400 Subject: [PATCH 08/13] temp --- R/list-transpose.R | 287 +++++++++---------- man/list_transpose.Rd | 121 ++++---- tests/testthat/_snaps/list-transpose.md | 137 ++++++++- tests/testthat/test-list-transpose.R | 352 ++++++++++++++++++++++-- 4 files changed, 675 insertions(+), 222 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index 8137955e8..1a0c4ee4d 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -1,8 +1,8 @@ #' Transpose a list of vectors #' #' @description -#' `list_transpose()` takes a list of vectors of equal size, transposes it, and -#' returns a new list of vectors of equal size. +#' `list_transpose()` takes a list of vectors, transposes it, and returns a new +#' list of vectors. #' #' To predict the output from `list_transpose()`, swap the size of the list #' with the size of the list elements. For example: @@ -10,34 +10,34 @@ #' - Input: List of size 2, elements of size 3 #' - Output: List of size 3, elements of size 2 #' -#' @details -#' In an ideal world, this function would transpose a data frame. Data frames -#' have a few desirable properties: +#' @inheritParams rlang::args_dots_empty +#' @inheritParams rlang::args_error_context #' -#' - Each column is the same size -#' - `NULL` columns are not allowed +#' @param x A list of vectors. #' -#' The downside is that data frames must have names. When transposing, names -#' are meaningless, both on the input and output. +#' - Each vector will be [recycled][theory-faq-recycling] to the common size +#' before transposing. #' -#' The compromise struck here is to allow a list, which doesn't require names, -#' but to enforce that each element of the list must be the same size and can't -#' be `NULL`. +#' - Each vector will be [cast][theory-faq-coercion] to the common type before +#' transposing. #' -#' @inheritParams rlang::args_dots_empty -#' @inheritParams rlang::args_error_context +#' @param null A value to replace `NULL` elements with before transposing. #' -#' @param x A list of vectors. +#' If left unspecified, any `NULL` elements in `x` result in an error. #' -#' - Each vector must be the same size. +#' If specified: #' -#' - Each vector will be [cast][vctrs::theory-faq-coercion] to the common type -#' before transposing. +#' - Will be [recycled][theory-faq-recycling] to the common size of `x` before +#' transposing. +#' +#' - Will participate in determining the common type, and will be +#' [cast][theory-faq-coercion] to that type before transposing. #' -#' - `NULL` elements are not allowed. +#' Note that `null` can alter the output type, but cannot alter the output +#' size. #' #' @param size The expected size of each element of `x`. If not provided, -#' computed as `vec_size(x[[1L]])`, or `0L` if `x` is empty. +#' computed automatically by [vec_size_common()]. #' #' @param ptype The expected type of each element of `x`. If not provided, #' computed automatically by [vec_ptype_common()]. @@ -50,21 +50,17 @@ #' For the list: #' #' - `vec_ptype(list_transpose(x)) == ` -#' - `vec_size(list_transpose(x)) == size %||% vec_size(x[[1L]]) %||% 0L` +#' - `vec_size(list_transpose(x)) == vec_size_common(!!!x)` #' #' For the list elements: #' -#' - `vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x, .ptype = ptype)` +#' - `vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x)` #' - `vec_size(list_transpose(x)[[i]]) == vec_size(x)` #' #' @export #' @examples -#' # Input: -#' # - List size 3 -#' # - Element size 2 -#' # Output: -#' # - List size 2 -#' # - Element size 3 +#' # I: List size 3, Element size 2 +#' # O: List size 2, Element size 3 #' list_transpose(list(1:2, 3:4, 5:6)) #' #' # With data frames @@ -72,18 +68,17 @@ #' y <- data_frame(a = 3:4, b = letters[3:4]) #' list_transpose(list(x, y)) #' +#' # Size 1 elements are recycled +#' list_transpose(list(1, 2:3, 4)) +#' #' # With size 0 elements, the invariants are a bit tricky! #' # This must return a size 0 list, but then you lose expected #' # type (integer) and size (2) information about the elements. #' # Losing that information makes it difficult to reverse the #' # transposition. #' # -#' # Input: -#' # - List size 2 -#' # - Element size 0 -#' # Output: -#' # - List size 0 -#' # - Element size 2 +#' # I: List size 2, Element size 0 +#' # O: List size 0, Element size 2 #' x <- list(integer(), integer()) #' out <- list_transpose(x) #' out @@ -94,12 +89,6 @@ #' # To work around this, provide the lost `size` and `ptype` manually #' list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) #' -#' # Note that this function doesn't recycle elements. This is purposeful, -#' # it is meant for transposing "rectangular lists", which are lists with -#' # elements of equal size. -#' x <- list(1, 2:3) -#' try(list_transpose(x)) -#' #' # If you'd like to pad with a missing value rather than erroring, #' # you might do something like this, which left-pads #' x <- list(1, 2:5, 6:7) @@ -114,131 +103,121 @@ #' ) #' list_transpose(x) #' -#' # `NULL` values aren't allowed in `list_transpose()` because theoretically -#' # this function is meant to transpose a data frame, which can't have `NULL` -#' # columns. +#' # `NULL` values aren't allowed in `list_transpose()` #' x <- list(1:3, NULL, 5:7, NULL) #' try(list_transpose(x)) #' -#' # Either drop the `NULL` values or replace them with something else -#' list_transpose(list_drop_empty(x)) +#' # Replace them with `null` +#' list_transpose(x, null = NA) +#' list_transpose(x, null = -(1:3)) #' -#' na <- list(vec_rep(NA, vec_size_common(!!!x))) -#' x <- vec_assign(x, vec_detect_missing(x), na) -#' list_transpose(x) +#' # Note that using `null` is not fully identical to swapping any `NULL`s +#' # with their replacement value ahead of the `list_transpose()` call. +#' # Most of the time `null` works as you'd expect, but some confusion can occur +#' # when you have a length >1 `null` and `x` is an empty list, a list of +#' # `NULL`s, or a list with only size 1 elements. The main thing to remember is +#' # that `null` is not allowed to change the output size, which makes it more +#' # predictable to program with, but sometimes requires you to provide more +#' # information through `size`. +#' +#' # This is an error, because the common size from the list is 0, +#' # and you can't recycle `null` to that size. +#' try(list_transpose(list(), null = 3:4)) +#' try(list_transpose(list(NULL), null = 3:4)) +#' +#' # This is also an error, because the common size from the list is 1, +#' # and you can't recycle `null` to that size either. +#' try(list_transpose(list(1, 2), null = 3:4)) +#' +#' # If you're programming with `list_transpose()` and you're supplying a +#' # length >1 `null` value like this, then that implies you know the +#' # expected element size (otherwise you wouldn't have been able to create +#' # the `null` value). Supply that `size` to override the inferred common size, +#' # and then things work as expected: +#' +#' # I: List size 0, Element size 2 +#' # O: List size 2, Element size 0 +#' list_transpose(list(), null = 3:4, size = 2) +#' +#' # I: List size 1, Element size 2 +#' # O: List size 2, Element size 1 +#' list_transpose(list(NULL), null = 3:4, size = 2) +#' +#' # I: List size 2, Element size 2 +#' # O: List size 2, Element size 2 +#' list_transpose(list(1, 2), null = 3:4, size = 2) list_transpose <- function( x, ..., + null = NULL, size = NULL, ptype = NULL, x_arg = caller_arg(x), error_call = current_env() ) { - # NOTES: - # - # # Recycling - # - # Resist the urge to provide support for recycling in this function. It is - # designed to transpose a "df-list" or "rectangular list" returned by - # `df_list()`, which already contains vectors of equal size. We treat any - # differing sizes as a user error. - # - # This also leaves open the possibility of providing automatic support for - # padding via `too_short = c("error", "left", "right"), pad = NULL` where - # `pad` could be a scalar value to pad with when choosing `"left"` or - # `"right"`. - # - # # `NULL` handling - # - # We spent a lot of effort trying to rationalize `NULL` handling, but - # ultimately decided to treat this function as if it takes a "df-list", - # which don't allow `NULL` columns. - # - # Simply dropping `NULL`s is not a good option. That would break `vec_size()` - # invariants of `list_transpose()`. For example: - # - # ``` - # I: List size 3, Element size 4 - # O: List size 4, Element size 3 (in theory) - # O: List size 4, Element size 2 (if you drop `NULL`s) - # list_transpose(list(1:4, NULL, 5:8)) - # ``` - # - # Adding a `null` argument that accepts a vector to replace `NULL`s with is - # extremely tricky to get right due to the number of edge cases related to - # empty inputs. In particular, deciding whether `null` should participate in - # size determination or not is very confusing. - # - # ``` - # # If `null` participates in size determination - # # I: List size 0, Element size 2 (infer from `null`?) - # # O: List size 2, Element size 0 - # list_transpose(list(), null = 1:2) - # # list(integer(), integer()) - # # Very weird output result, expecting `list()` - # - # # If `null` must be the input element size, then this errors - # list_transpose(list(), null = 1:2) - # # Error: Can't recycle `null` (2) to size 0. - # # But then this works - # list_transpose(list(1:2), null = 1:2) - # # You'd have to do this - # list_transpose(list(), null = 1:2, size = 2) - # ``` - # - # ``` - # # If `null` participates in size determination - # # I: List size 1, Element size 2 (infer from `null`?) - # # O: List size 2, Element size 1 - # list_transpose(list(NULL), null = 1:2) - # # list(1L, 2L) - # - # # If `null` must be the input element size, then this errors - # list_transpose(list(NULL), null = 1:2) - # # Error: Can't recycle `null` (2) to size 0. - # # Again, you'd have to do this - # list_transpose(list(NULL), null = 1:2, size = 2) - # - # # This is weird because it feels like it should be identical to replacing - # # the `NULL`s up front, i.e. - # list_transpose(list(1:2)) - # ``` - # - # And then you also have to deal with common type. Does `null` contribute to - # the common type or is it cast to the input element type? What happens when - # there are no inputs or only `NULL`s and the type is `unspecified`? - check_dots_empty0(...) obj_check_list(x, arg = x_arg, call = error_call) - # Disallow `NULL` elements - i.e. pretend the user supplied a data frame, - # which can't have `NULL` columns + # Disallow `NULL` elements if the user isn't replacing them with something list_check_all_vectors( x, - allow_null = FALSE, + allow_null = !is_null(null), arg = x_arg, call = error_call ) - # Finalize `size` - if (is_null(size)) { - if (vec_size(x) == 0L) { - size <- 0L - } else { - size <- vec_size(x[[1L]]) - } - } + # `size` only comes from `x` and `size`. + # `null` is recycled to this size but doesn't contribute to it! + size <- vec_size_common( + !!!x, + .size = size, + .arg = x_arg, + .call = error_call + ) - # Check that all elements are the same size, with no recycling - i.e. pretend - # the user supplied a data frame, where all columns are the same size - list_check_all_size( + # `ptype` comes from `x`, `null`, and `ptype` + ptype <- list_transpose_ptype_common( x, - size = size, - arg = x_arg, - call = error_call + null, + ptype, + x_arg, + error_call ) + if (is.object(x)) { + # The list input type should not affect the transposition process in any + # way. In particular, supplying a list subclass that doesn't have a + # `vec_cast.subclass.list` method shouldn't prevent the insertion of + # `list(null)` before the transposition. The fact that we must insert + # `list(null)` should be considered an internal detail. + x <- unclass(x) + } + + if (!is_null(null)) { + # Always perform `null` checks + null <- vec_cast( + x = null, + to = ptype, + x_arg = "null", + to_arg = "", + call = error_call + ) + + null <- vec_recycle( + x = null, + size = size, + x_arg = "null", + call = error_call + ) + # TODO!: vec_check_recyclable() + + if (vec_any_missing(x)) { + null <- list(null) + x <- vec_assign(x, vec_detect_missing(x), null) + } + } + x_size <- vec_size(x) sizes <- vec_rep(x_size, times = size) @@ -256,3 +235,33 @@ list_transpose <- function( out } + +list_transpose_ptype_common <- function( + x, + null, + ptype, + x_arg, + error_call +) { + if (!is_null(ptype)) { + # Validate and return user specified `ptype` + ptype <- vec_ptype(ptype, x_arg = "ptype", call = error_call) + return(vec_ptype_finalise(ptype)) + } + + # Compute from `x` + ptype <- vec_ptype_common(!!!x, .arg = x_arg, .call = error_call) + + if (!is_null(null)) { + # Layer in `null` + ptype <- vec_ptype2( + x = null, + y = ptype, + x_arg = "null", + y_arg = "", + call = error_call + ) + } + + ptype +} diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index 480520e99..bf398fac7 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -7,6 +7,7 @@ list_transpose( x, ..., + null = NULL, size = NULL, ptype = NULL, x_arg = caller_arg(x), @@ -16,16 +17,31 @@ list_transpose( \arguments{ \item{x}{A list of vectors. \itemize{ -\item Each vector must be the same size. -\item Each vector will be \link[=theory-faq-coercion]{cast} to the common type +\item Each vector will be \link[=theory-faq-recycling]{recycled} to the common size before transposing. -\item \code{NULL} elements are not allowed. +\item Each vector will be \link[=theory-faq-coercion]{cast} to the common type before +transposing. }} \item{...}{These dots are for future extensions and must be empty.} +\item{null}{A value to replace \code{NULL} elements with before transposing. + +If left unspecified, any \code{NULL} elements in \code{x} result in an error. + +If specified: +\itemize{ +\item Will be \link[=theory-faq-recycling]{recycled} to the common size of \code{x} before +transposing. +\item Will participate in determining the common type, and will be +\link[=theory-faq-coercion]{cast} to that type before transposing. +} + +Note that \code{null} can alter the output type, but cannot alter the output +size.} + \item{size}{The expected size of each element of \code{x}. If not provided, -computed as \code{vec_size(x[[1L]])}, or \code{0L} if \code{x} is empty.} +computed automatically by \code{\link[=vec_size_common]{vec_size_common()}}.} \item{ptype}{The expected type of each element of \code{x}. If not provided, computed automatically by \code{\link[=vec_ptype_common]{vec_ptype_common()}}.} @@ -43,18 +59,18 @@ A list of vectors with the following invariants: For the list: \itemize{ \item \verb{vec_ptype(list_transpose(x)) == } -\item \code{vec_size(list_transpose(x)) == size \%||\% vec_size(x[[1L]]) \%||\% 0L} +\item \code{vec_size(list_transpose(x)) == vec_size_common(!!!x)} } For the list elements: \itemize{ -\item \code{vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x, .ptype = ptype)} +\item \code{vec_ptype(list_transpose(x)[[i]]) == vec_ptype_common(!!!x)} \item \code{vec_size(list_transpose(x)[[i]]) == vec_size(x)} } } \description{ -\code{list_transpose()} takes a list of vectors of equal size, transposes it, and -returns a new list of vectors of equal size. +\code{list_transpose()} takes a list of vectors, transposes it, and returns a new +list of vectors. To predict the output from \code{list_transpose()}, swap the size of the list with the size of the list elements. For example: @@ -63,28 +79,9 @@ with the size of the list elements. For example: \item Output: List of size 3, elements of size 2 } } -\details{ -In an ideal world, this function would transpose a data frame. Data frames -have a few desirable properties: -\itemize{ -\item Each column is the same size -\item \code{NULL} columns are not allowed -} - -The downside is that data frames must have names. When transposing, names -are meaningless, both on the input and output. - -The compromise struck here is to allow a list, which doesn't require names, -but to enforce that each element of the list must be the same size and can't -be \code{NULL}. -} \examples{ -# Input: -# - List size 3 -# - Element size 2 -# Output: -# - List size 2 -# - Element size 3 +# I: List size 3, Element size 2 +# O: List size 2, Element size 3 list_transpose(list(1:2, 3:4, 5:6)) # With data frames @@ -92,18 +89,17 @@ x <- data_frame(a = 1:2, b = letters[1:2]) y <- data_frame(a = 3:4, b = letters[3:4]) list_transpose(list(x, y)) +# Size 1 elements are recycled +list_transpose(list(1, 2:3, 4)) + # With size 0 elements, the invariants are a bit tricky! # This must return a size 0 list, but then you lose expected # type (integer) and size (2) information about the elements. # Losing that information makes it difficult to reverse the # transposition. # -# Input: -# - List size 2 -# - Element size 0 -# Output: -# - List size 0 -# - Element size 2 +# I: List size 2, Element size 0 +# O: List size 0, Element size 2 x <- list(integer(), integer()) out <- list_transpose(x) out @@ -114,12 +110,6 @@ list_transpose(out) # To work around this, provide the lost `size` and `ptype` manually list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) -# Note that this function doesn't recycle elements. This is purposeful, -# it is meant for transposing "rectangular lists", which are lists with -# elements of equal size. -x <- list(1, 2:3) -try(list_transpose(x)) - # If you'd like to pad with a missing value rather than erroring, # you might do something like this, which left-pads x <- list(1, 2:5, 6:7) @@ -134,16 +124,47 @@ x[index] <- lapply( ) list_transpose(x) -# `NULL` values aren't allowed in `list_transpose()` because theoretically -# this function is meant to transpose a data frame, which can't have `NULL` -# columns. +# `NULL` values aren't allowed in `list_transpose()` x <- list(1:3, NULL, 5:7, NULL) try(list_transpose(x)) -# Either drop the `NULL` values or replace them with something else -list_transpose(list_drop_empty(x)) - -na <- list(vec_rep(NA, vec_size_common(!!!x))) -x <- vec_assign(x, vec_detect_missing(x), na) -list_transpose(x) +# Replace them with `null` +list_transpose(x, null = NA) +list_transpose(x, null = -(1:3)) + +# Note that using `null` is not fully identical to swapping any `NULL`s +# with their replacement value ahead of the `list_transpose()` call. +# Most of the time `null` works as you'd expect, but some confusion can occur +# when you have a length >1 `null` and `x` is an empty list, a list of +# `NULL`s, or a list with only size 1 elements. The main thing to remember is +# that `null` is not allowed to change the output size, which makes it more +# predictable to program with, but sometimes requires you to provide more +# information through `size`. + +# This is an error, because the common size from the list is 0, +# and you can't recycle `null` to that size. +try(list_transpose(list(), null = 3:4)) +try(list_transpose(list(NULL), null = 3:4)) + +# This is also an error, because the common size from the list is 1, +# and you can't recycle `null` to that size either. +try(list_transpose(list(1, 2), null = 3:4)) + +# If you're programming with `list_transpose()` and you're supplying a +# length >1 `null` value like this, then that implies you know the +# expected element size (otherwise you wouldn't have been able to create +# the `null` value). Supply that `size` to override the inferred common size, +# and then things work as expected: + +# I: List size 0, Element size 2 +# O: List size 2, Element size 0 +list_transpose(list(), null = 3:4, size = 2) + +# I: List size 1, Element size 2 +# O: List size 2, Element size 1 +list_transpose(list(NULL), null = 3:4, size = 2) + +# I: List size 2, Element size 2 +# O: List size 2, Element size 2 +list_transpose(list(1, 2), null = 3:4, size = 2) } diff --git a/tests/testthat/_snaps/list-transpose.md b/tests/testthat/_snaps/list-transpose.md index 0e438a9ec..780367c37 100644 --- a/tests/testthat/_snaps/list-transpose.md +++ b/tests/testthat/_snaps/list-transpose.md @@ -25,21 +25,14 @@ * ..1 = 2 i Did you forget to name an argument? -# no recycling is done +# recycles inputs to common size before transposing Code - list_transpose(list(1L, 2:3)) + x <- list(1:2, 3:5) + list_transpose(x) Condition Error in `list_transpose()`: - ! `list(1L, 2:3)[[2]]` must have size 1, not size 2. - -# doesn't allow `NULL` elements - - Code - list_transpose(list(1:4, NULL, 5:8)) - Condition - Error in `list_transpose()`: - ! `list(1:4, NULL, 5:8)[[2]]` must be a vector, not `NULL`. + ! Can't recycle `x[[1]]` (size 2) to match `x[[2]]` (size 3). # respects `size` @@ -47,7 +40,7 @@ list_transpose(list(1:2), size = 3) Condition Error in `list_transpose()`: - ! `list(1:2)[[1]]` must have size 3, not size 2. + ! Can't recycle `list(1:2)[[1]]` (size 2) to size 3. # respects `ptype` @@ -66,6 +59,14 @@ Error in `foo()`: ! Can't convert `x[[1]]` to . +# doesn't allow `NULL` elements + + Code + list_transpose(list(1:4, NULL, 5:8)) + Condition + Error in `list_transpose()`: + ! `list(1:4, NULL, 5:8)[[2]]` must be a vector, not `NULL`. + # doesn't allow scalar elements Code @@ -82,3 +83,115 @@ Error in `foo()`: ! `x[[2]]` must be a vector, not a object. +# `x` being a list subclass can't affect the transposition + + Code + vec_cast(list(null), to = x) + Condition + Error: + ! Can't convert `list(null)` to . + +# `x` being a doesn't affect the transposition + + Code + list_transpose(x) + Condition + Error in `list_transpose()`: + ! `x[[1]]` must be a vector, not `NULL`. + +# `null` must be a vector + + Code + list_transpose(x, null = lm(1 ~ 1)) + Condition + Error in `list_transpose()`: + ! `null` must be a vector, not a object. + +--- + + Code + list_transpose(x, null = lm(1 ~ 1)) + Condition + Error in `list_transpose()`: + ! `null` must be a vector, not a object. + +# `null` participates in common type determination + + Code + list_transpose(x, null = "x") + Condition + Error in `list_transpose()`: + ! Can't combine `null` and . + +--- + + Code + list_transpose(x, null = "x", ptype = double()) + Condition + Error in `list_transpose()`: + ! Can't convert `null` to . + +--- + + Code + list_transpose(x, null = "x") + Condition + Error in `list_transpose()`: + ! Can't combine `null` and . + +--- + + Code + list_transpose(x, null = "x", ptype = double()) + Condition + Error in `list_transpose()`: + ! Can't convert `null` to . + +# `null` size 0 behavior + + Code + list_transpose(list(1, 2), null = double()) + Condition + Error in `list_transpose()`: + ! Can't recycle `null` (size 0) to size 1. + +--- + + Code + list_transpose(list(1, 2, NULL), null = double()) + Condition + Error in `list_transpose()`: + ! Can't recycle `null` (size 0) to size 1. + +# `null` size >1 behavior + + Code + list_transpose(list(), null = 3:4) + Condition + Error in `list_transpose()`: + ! Can't recycle `null` (size 2) to size 0. + +--- + + Code + list_transpose(list(NULL), null = 3:4) + Condition + Error in `list_transpose()`: + ! Can't recycle `null` (size 2) to size 0. + +--- + + Code + list_transpose(list(1, 2), null = 3:4) + Condition + Error in `list_transpose()`: + ! Can't recycle `null` (size 2) to size 1. + +--- + + Code + list_transpose(list(1, 2, NULL), null = 3:4) + Condition + Error in `list_transpose()`: + ! Can't recycle `null` (size 2) to size 1. + diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index 4d5c077ad..44f4ec02b 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -116,31 +116,23 @@ test_that("`...` must be empty", { }) }) -test_that("no recycling is done", { - # We mimic the idea of transposing a data frame of equal column sizes - expect_snapshot(error = TRUE, { - list_transpose(list(1L, 2:3)) - }) -}) - -test_that("doesn't allow `NULL` elements", { - # We mimic the idea of transposing a data frame, which doesn't allow `NULL` - # columns +test_that("recycles inputs to common size before transposing", { + expect_identical( + list_transpose(list(1, 2:3, 4)), + list(c(1, 2, 4), c(1, 3, 4)) + ) expect_snapshot(error = TRUE, { - list_transpose(list(1:4, NULL, 5:8)) + x <- list(1:2, 3:5) + list_transpose(x) }) }) test_that("respects `size`", { # Useful for the case where you somehow know the element size from somewhere - # else, but you also happen to only have all empty elements right now + # else, but you also happen to only have all size 1 elements right now expect_identical( - list_transpose(list(), size = 3), - list(unspecified(), unspecified(), unspecified()) - ) - expect_identical( - list_transpose(list(), size = 3, ptype = integer()), - list(integer(), integer(), integer()) + list_transpose(list(1L, 2L), size = 3), + list(1:2, 1:2, 1:2) ) expect_snapshot(error = TRUE, { @@ -170,6 +162,14 @@ test_that("respects `ptype`", { }) }) +test_that("doesn't allow `NULL` elements", { + # These would break the invariants around the size of the output relative + # to the size of the input if we just dropped them + expect_snapshot(error = TRUE, { + list_transpose(list(1:4, NULL, 5:8)) + }) +}) + test_that("doesn't allow scalar elements", { expect_snapshot(error = TRUE, { list_transpose(list(1:4, lm(1 ~ 1))) @@ -180,13 +180,21 @@ test_that("doesn't allow scalar elements", { }) test_that("`x` being a list subclass can't affect the transposition", { - x <- structure(list(1, 2), class = c("my_list", "list")) + x <- structure(list(1, NULL, 2), class = c("my_list", "list")) + null <- 0 + + # Note how this is an error. We perform a cast like this internally. + expect_snapshot(error = TRUE, { + vec_cast(list(null), to = x) + }) + + # But we unclass `x` first, so it won't matter. # Our output type is always `` and as long as `obj_is_list()` # passes, we don't care about the input type. expect_identical( - list_transpose(x), - list(c(1, 2)) + list_transpose(x, null = null), + list(c(1, 0, 2)) ) }) @@ -199,12 +207,314 @@ test_that("`x` being a doesn't affect the transposition", { expect_identical(list_transpose(x), list()) expect_identical(list_transpose(x, ptype = character()), list()) + x <- list_of(NULL, .ptype = integer()) + expect_snapshot(error = TRUE, { + list_transpose(x) + }) + expect_identical( + list_transpose(x, null = "x"), + list() + ) + expect_identical( + list_transpose(x, null = "x", size = 2), + list("x", "x") + ) + # `ptype` overrules list-of type x <- list_of(1L, 2L) expect_identical( list_transpose(x, ptype = double()), list(c(1, 2)) ) + + # Common type determination with `null` overrules list-of type + x <- list_of(1L, NULL, 2L) + expect_identical( + list_transpose(x, null = 0), + list(c(1, 0, 2)) + ) +}) + +test_that("`null` replaces `NULL` elements", { + x <- list(1:2, NULL, 3:4, NULL) + + expect_identical( + list_transpose(x, null = 0L), + list( + int(1, 0, 3, 0), + int(2, 0, 4, 0) + ) + ) +}) + +test_that("`null` must be a vector", { + x <- list(1, NULL) + expect_snapshot(error = TRUE, { + list_transpose(x, null = lm(1 ~ 1)) + }) + + # Even when not used + x <- list(1, 2) + expect_snapshot(error = TRUE, { + list_transpose(x, null = lm(1 ~ 1)) + }) +}) + +test_that("`null` participates in common type determination", { + x <- list(1L, NULL) + expect_identical( + list_transpose(x, null = 0), + list(c(1, 0)) + ) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x") + }) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x", ptype = double()) + }) + + # Even when not used + x <- list(1L, 2L) + expect_identical( + list_transpose(x, null = 0), + list(c(1, 2)) + ) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x") + }) + expect_snapshot(error = TRUE, { + list_transpose(x, null = "x", ptype = double()) + }) +}) + +test_that("`null` is recycled to common size of inputs or `size`", { + x <- list(1:2, NULL, 5:6) + expect_identical( + list_transpose(x, null = NA), + list(c(1L, NA, 5L), c(2L, NA, 6L)) + ) + + x <- list(1:2, NULL, 5:6) + expect_identical( + list_transpose(x, null = 3:4), + list(c(1L, 3L, 5L), c(2L, 4L, 6L)) + ) +}) + +test_that("`null` size 0 behavior", { + # Element common size is inferred to be 0 from `x` + # + # I: List size 0, Element size 0 + # O: List size 0, Element size 0 + expect_identical( + list_transpose(list(), null = double()), + list() + ) + # I: List size 1, Element size 0 + # O: List size 0, Element size 1 + expect_identical( + list_transpose(list(NULL), null = double()), + list() + ) + + # Element common size is inferred to be 1 from `x` + # + # I: List size 2, Element size 1 (can't recycle `null` to this) + # O: List size 1, Element size 2 + expect_snapshot(error = TRUE, { + list_transpose(list(1, 2), null = double()) + }) + # I: List size 3, Element size 1 (can't recycle `null` to this) + # O: List size 1, Element size 3 + expect_snapshot(error = TRUE, { + list_transpose(list(1, 2, NULL), null = double()) + }) + + # Like with the `null` size >1 case, if you are programming with + # `list_transpose()` and built `null` to be size 0, you obviously expect each + # element to also be size 0. So to guard against the all size 1 element case + # (when they should be recycled to a known size 0), supply the known element + # size. + size <- 0L + null <- double() + + # I: List size 2, Element size 0 + # O: List size 0, Element size 2 + expect_identical( + list_transpose(list(1, 2), null = null, size = size), + list() + ) +}) + +test_that("`null` size 1 behavior", { + # This is the easy to explain case because everything recycles as you'd + # imagine it to work anyways + + # Element common size is inferred to be 0 from `x` + # + # I: List size 0, Element size 0 (can recycle `null` to this) + # O: List size 0, Element size 0 + expect_identical( + list_transpose(list(), null = 3), + list() + ) + # I: List size 1, Element size 0 (can recycle `null` to this) + # O: List size 0, Element size 1 + expect_identical( + list_transpose(list(NULL), null = 3), + list() + ) + + # Element common size is inferred to be 1 from `x` + # + # I: List size 2, Element size 1 + # O: List size 1, Element size 2 + expect_identical( + list_transpose(list(1, 2), null = 3), + list(c(1, 2)) + ) + # I: List size 3, Element size 1 + # O: List size 1, Element size 3 + expect_identical( + list_transpose(list(1, 2, NULL), null = 3), + list(c(1, 2, 3)) + ) +}) + +test_that("`null` size >1 behavior", { + # Element common size is inferred to be 0 from `x` + # + # I: List size 0, Element size 0 (can't recycle `null` to this) + # O: List size 0, Element size 0 + expect_snapshot(error = TRUE, { + list_transpose(list(), null = 3:4) + }) + # I: List size 1, Element size 0 (can't recycle `null` to this) + # O: List size 0, Element size 1 + expect_snapshot(error = TRUE, { + list_transpose(list(NULL), null = 3:4) + }) + + # Element common size is inferred to be 1 from `x` + # + # I: List size 2, Element size 1 (can't recycle `null` to this) + # O: List size 1, Element size 2 + expect_snapshot(error = TRUE, { + list_transpose(list(1, 2), null = 3:4) + }) + # I: List size 3, Element size 1 (can't recycle `null` to this) + # O: List size 1, Element size 3 + expect_snapshot(error = TRUE, { + list_transpose(list(1, 2, NULL), null = 3:4) + }) + + # The idea is that if you are programming with `list_transpose()` and you are + # supplying a length >1 `null`, then you obviously know the expected element + # size, otherwise you wouldn't have been able to make `null`. So the correct + # way to generically program with `list_transpose()` and `null` and guard + # against both the empty list case and the all size 1 element case is to go + # ahead and supply that known element size. + size <- 2L + null <- c(3, 4) + + # I: List size 0, Element size 2 + # O: List size 2, Element size 0 + expect_identical( + list_transpose(list(), null = null, size = 2), + list(double(), double()) + ) + # I: List size 1, Element size 2 + # O: List size 2, Element size 1 + expect_identical( + list_transpose(list(NULL), null = null, size = 2), + list(3, 4) + ) + + # I: List size 2, Element size 2 + # O: List size 2, Element size 2 + expect_identical( + list_transpose(list(1, 2), null = null, size = 2), + list(c(1, 2), c(1, 2)) + ) + # I: List size 3, Element size 2 + # O: List size 2, Element size 3 + expect_identical( + list_transpose(list(1, 2, NULL), null = null, size = 2), + list(c(1, 2, 3), c(1, 2, 4)) + ) +}) + +test_that("`null` influences type in the empty `list()` case", { + # Input + # - List size 0 + # - Element size 0 (inferred from list) + # - Element type integer (inferred from `null`) + # Output + # - List size 0 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L), + list() + ) + + # Input + # - List size 0 + # - Element size 0 (supplied by `size`) + # - Element type integer (inferred from `null`) + # Output + # - List size 0 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L, size = 0), + list() + ) + + # Input + # - List size 0 + # - Element size 1 (supplied by `size`) + # - Element type integer (inferred from `null`) + # Output + # - List size 1 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L, size = 1), + list(integer()) + ) + + # Input + # - List size 0 + # - Element size 2 (supplied by `size`) + # - Element type integer (inferred from `null`) + # Output + # - List size 2 + # - Element size 0 + # - Element type integer + expect_identical( + list_transpose(list(), null = 1L, size = 2), + list(integer(), integer()) + ) +}) + +test_that("`null` influences type in the only `NULL` case", { + # Input + # - List size 2 + # - Element size 1 (inferred from `NULL` being treated as size 1) + # - Element type integer (inferred from `null`) + # Output + # - List size 1 + # - Element size 2 + # - Element type integer + expect_identical( + list_transpose(list(NULL, NULL), null = 1L, size = 1L), + list(c(1L, 1L)) + ) + expect_identical( + list_transpose(list(NULL, NULL), null = 1L, size = 1L, ptype = double()), + list(c(1, 1)) + ) }) test_that("`ptype` is finalized", { From 6e31b16800d97d9c7f56f9309e27b3c304334b1a Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 16 Oct 2025 09:08:35 -0400 Subject: [PATCH 09/13] temp --- R/list-transpose.R | 86 +++++++++++++++++++--------- man/list_transpose.Rd | 86 +++++++++++++++++++--------- tests/testthat/test-list-transpose.R | 35 +++++++++-- 3 files changed, 145 insertions(+), 62 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index 1a0c4ee4d..91edd6ed9 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -34,7 +34,7 @@ #' [cast][theory-faq-coercion] to that type before transposing. #' #' Note that `null` can alter the output type, but cannot alter the output -#' size. +#' size. See the examples for consequences of this. #' #' @param size The expected size of each element of `x`. If not provided, #' computed automatically by [vec_size_common()]. @@ -71,6 +71,9 @@ #' # Size 1 elements are recycled #' list_transpose(list(1, 2:3, 4)) #' +#' # --------------------------------------------------------------------------- +#' # Using `size` and `ptype` +#' #' # With size 0 elements, the invariants are a bit tricky! #' # This must return a size 0 list, but then you lose expected #' # type (integer) and size (2) information about the elements. @@ -89,6 +92,9 @@ #' # To work around this, provide the lost `size` and `ptype` manually #' list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) #' +#' # --------------------------------------------------------------------------- +#' # Padding +#' #' # If you'd like to pad with a missing value rather than erroring, #' # you might do something like this, which left-pads #' x <- list(1, 2:5, 6:7) @@ -97,12 +103,18 @@ #' sizes <- list_sizes(x) #' size <- max(sizes) #' index <- which(sizes != size) +#' #' x[index] <- lapply( #' index, #' function(i) vec_c(rep(NA, times = size - sizes[[i]]), x[[i]]) #' ) +#' x +#' #' list_transpose(x) #' +#' # --------------------------------------------------------------------------- +#' # `NULL` handling +#' #' # `NULL` values aren't allowed in `list_transpose()` #' x <- list(1:3, NULL, 5:7, NULL) #' try(list_transpose(x)) @@ -111,41 +123,59 @@ #' list_transpose(x, null = NA) #' list_transpose(x, null = -(1:3)) #' -#' # Note that using `null` is not fully identical to swapping any `NULL`s -#' # with their replacement value ahead of the `list_transpose()` call. -#' # Most of the time `null` works as you'd expect, but some confusion can occur -#' # when you have a length >1 `null` and `x` is an empty list, a list of -#' # `NULL`s, or a list with only size 1 elements. The main thing to remember is -#' # that `null` is not allowed to change the output size, which makes it more -#' # predictable to program with, but sometimes requires you to provide more -#' # information through `size`. -#' -#' # This is an error, because the common size from the list is 0, -#' # and you can't recycle `null` to that size. -#' try(list_transpose(list(), null = 3:4)) -#' try(list_transpose(list(NULL), null = 3:4)) -#' -#' # This is also an error, because the common size from the list is 1, -#' # and you can't recycle `null` to that size either. -#' try(list_transpose(list(1, 2), null = 3:4)) -#' -#' # If you're programming with `list_transpose()` and you're supplying a -#' # length >1 `null` value like this, then that implies you know the -#' # expected element size (otherwise you wouldn't have been able to create -#' # the `null` value). Supply that `size` to override the inferred common size, -#' # and then things work as expected: -#' +#' # When you don't know the list element size up front, but you still want +#' # to replace `NULL`s with something, use a size 1 `null` value which will +#' # get recycled to the element size after it has been computed +#' list_transpose(list(), null = NA) +#' list_transpose(list(1, NULL, 3), null = NA) +#' list_transpose(list(1, NULL, 3:4), null = NA) +#' +#' # When you do know the list element size up front, it's best to also provide +#' # that information as `size`, as this helps direct the recycling process +#' # for `null`, particularly in the cases of an empty list, a list of `NULL`s, +#' # or a list of size 1 elements. You typically know the list element size if +#' # you are providing a `null` of size != 1, because otherwise you wouldn't +#' # have been able to make `null` in the first place! +#' size <- 2L +#' null <- 3:4 +#' +#' # `size` overrides the inferred element size of 0 +#' # +#' # I: List size 0, Element size 0 +#' # O: List size 0, Element size 0 +#' try(list_transpose(list(), null = null)) #' # I: List size 0, Element size 2 #' # O: List size 2, Element size 0 -#' list_transpose(list(), null = 3:4, size = 2) +#' list_transpose(list(), null = null, size = size) #' +#' # Same idea here +#' # +#' # I: List size 1, Element size 0 +#' # O: List size 0, Element size 1 +#' try(list_transpose(list(NULL), null = null)) #' # I: List size 1, Element size 2 #' # O: List size 2, Element size 1 -#' list_transpose(list(NULL), null = 3:4, size = 2) +#' list_transpose(list(NULL), null = null, size = size) #' +#' # `size` overrides the inferred element size of 1 +#' # +#' # I: List size 2, Element size 1 +#' # O: List size 1, Element size 2 +#' try(list_transpose(list(1, 2), null = null)) #' # I: List size 2, Element size 2 #' # O: List size 2, Element size 2 -#' list_transpose(list(1, 2), null = 3:4, size = 2) +#' list_transpose(list(1, 2), null = null, size = size) +#' +#' # The reason that `list_transpose()` recycles `null` to the common size +#' # rather than letting `null` participate in common size determination is +#' # due to this example. When supplying a size 1 `null`, most of the time +#' # you don't know the element size, and you just want `null` to recycle to +#' # whatever the required size will be. If `null` participated in determining +#' # the common size, the output of this would be `list(logical())` rather than +#' # `list()` because the element size would be computed as 1. Since a size 1 +#' # `null` is much more common than a size !=1 `null`, we've optimized for this +#' # case at the cost of needing to specify `size` explicitly in some scenarios. +#' list_transpose(list(), null = NA) list_transpose <- function( x, ..., diff --git a/man/list_transpose.Rd b/man/list_transpose.Rd index bf398fac7..fada4d5bf 100644 --- a/man/list_transpose.Rd +++ b/man/list_transpose.Rd @@ -38,7 +38,7 @@ transposing. } Note that \code{null} can alter the output type, but cannot alter the output -size.} +size. See the examples for consequences of this.} \item{size}{The expected size of each element of \code{x}. If not provided, computed automatically by \code{\link[=vec_size_common]{vec_size_common()}}.} @@ -92,6 +92,9 @@ list_transpose(list(x, y)) # Size 1 elements are recycled list_transpose(list(1, 2:3, 4)) +# --------------------------------------------------------------------------- +# Using `size` and `ptype` + # With size 0 elements, the invariants are a bit tricky! # This must return a size 0 list, but then you lose expected # type (integer) and size (2) information about the elements. @@ -110,6 +113,9 @@ list_transpose(out) # To work around this, provide the lost `size` and `ptype` manually list_transpose(out, size = vec_size(x), ptype = vec_ptype_common(!!!x)) +# --------------------------------------------------------------------------- +# Padding + # If you'd like to pad with a missing value rather than erroring, # you might do something like this, which left-pads x <- list(1, 2:5, 6:7) @@ -118,12 +124,18 @@ try(list_transpose(x)) sizes <- list_sizes(x) size <- max(sizes) index <- which(sizes != size) + x[index] <- lapply( index, function(i) vec_c(rep(NA, times = size - sizes[[i]]), x[[i]]) ) +x + list_transpose(x) +# --------------------------------------------------------------------------- +# `NULL` handling + # `NULL` values aren't allowed in `list_transpose()` x <- list(1:3, NULL, 5:7, NULL) try(list_transpose(x)) @@ -132,39 +144,57 @@ try(list_transpose(x)) list_transpose(x, null = NA) list_transpose(x, null = -(1:3)) -# Note that using `null` is not fully identical to swapping any `NULL`s -# with their replacement value ahead of the `list_transpose()` call. -# Most of the time `null` works as you'd expect, but some confusion can occur -# when you have a length >1 `null` and `x` is an empty list, a list of -# `NULL`s, or a list with only size 1 elements. The main thing to remember is -# that `null` is not allowed to change the output size, which makes it more -# predictable to program with, but sometimes requires you to provide more -# information through `size`. - -# This is an error, because the common size from the list is 0, -# and you can't recycle `null` to that size. -try(list_transpose(list(), null = 3:4)) -try(list_transpose(list(NULL), null = 3:4)) - -# This is also an error, because the common size from the list is 1, -# and you can't recycle `null` to that size either. -try(list_transpose(list(1, 2), null = 3:4)) - -# If you're programming with `list_transpose()` and you're supplying a -# length >1 `null` value like this, then that implies you know the -# expected element size (otherwise you wouldn't have been able to create -# the `null` value). Supply that `size` to override the inferred common size, -# and then things work as expected: - +# When you don't know the list element size up front, but you still want +# to replace `NULL`s with something, use a size 1 `null` value which will +# get recycled to the element size after it has been computed +list_transpose(list(), null = NA) +list_transpose(list(1, NULL, 3), null = NA) +list_transpose(list(1, NULL, 3:4), null = NA) + +# When you do know the list element size up front, it's best to also provide +# that information as `size`, as this helps direct the recycling process +# for `null`, particularly in the cases of an empty list, a list of `NULL`s, +# or a list of size 1 elements. You typically know the list element size if +# you are providing a `null` of size != 1, because otherwise you wouldn't +# have been able to make `null` in the first place! +size <- 2L +null <- 3:4 + +# `size` overrides the inferred element size of 0 +# +# I: List size 0, Element size 0 +# O: List size 0, Element size 0 +try(list_transpose(list(), null = null)) # I: List size 0, Element size 2 # O: List size 2, Element size 0 -list_transpose(list(), null = 3:4, size = 2) +list_transpose(list(), null = null, size = size) +# Same idea here +# +# I: List size 1, Element size 0 +# O: List size 0, Element size 1 +try(list_transpose(list(NULL), null = null)) # I: List size 1, Element size 2 # O: List size 2, Element size 1 -list_transpose(list(NULL), null = 3:4, size = 2) +list_transpose(list(NULL), null = null, size = size) +# `size` overrides the inferred element size of 1 +# +# I: List size 2, Element size 1 +# O: List size 1, Element size 2 +try(list_transpose(list(1, 2), null = null)) # I: List size 2, Element size 2 # O: List size 2, Element size 2 -list_transpose(list(1, 2), null = 3:4, size = 2) +list_transpose(list(1, 2), null = null, size = size) + +# The reason that `list_transpose()` recycles `null` to the common size +# rather than letting `null` participate in common size determination is +# due to this example. When supplying a size 1 `null`, most of the time +# you don't know the element size, and you just want `null` to recycle to +# whatever the required size will be. If `null` participated in determining +# the common size, the output of this would be `list(logical())` rather than +# `list()` because the element size would be computed as 1. Since a size 1 +# `null` is much more common than a size !=1 `null`, we've optimized for this +# case at the cost of needing to specify `size` explicitly in some scenarios. +list_transpose(list(), null = NA) } diff --git a/tests/testthat/test-list-transpose.R b/tests/testthat/test-list-transpose.R index 44f4ec02b..8ff1d908c 100644 --- a/tests/testthat/test-list-transpose.R +++ b/tests/testthat/test-list-transpose.R @@ -347,8 +347,13 @@ test_that("`null` size 0 behavior", { }) test_that("`null` size 1 behavior", { - # This is the easy to explain case because everything recycles as you'd - # imagine it to work anyways + # This example of `list_transpose(list(), null = 3)` is a big reason why + # we recycle `null` rather than letting it participate in common size + # determination. A size 1 `null` is a very common way to say "I don't know + # what the element size is, but replace `NULL` with this and recycle it.". + # Since the user has no preexisting knowledge about the element size, the + # size of `null` should not impact the output, and you should get `list()`, + # not `list(numeric())`. # Element common size is inferred to be 0 from `x` # @@ -379,6 +384,24 @@ test_that("`null` size 1 behavior", { list_transpose(list(1, 2, NULL), null = 3), list(c(1, 2, 3)) ) + + # Like with `null` size 0 and size >1, you can still supply `size` to override + # the inferred size if you know the element size is actually 1 + size <- 1L + null <- 3 + + # I: List size 0, Element size 1 + # O: List size 1, Element size 0 + expect_identical( + list_transpose(list(), null = null, size = size), + list(numeric()) + ) + # I: List size 1, Element size 1 + # O: List size 1, Element size 1 + expect_identical( + list_transpose(list(NULL), null = null, size = size), + list(3) + ) }) test_that("`null` size >1 behavior", { @@ -420,26 +443,26 @@ test_that("`null` size >1 behavior", { # I: List size 0, Element size 2 # O: List size 2, Element size 0 expect_identical( - list_transpose(list(), null = null, size = 2), + list_transpose(list(), null = null, size = size), list(double(), double()) ) # I: List size 1, Element size 2 # O: List size 2, Element size 1 expect_identical( - list_transpose(list(NULL), null = null, size = 2), + list_transpose(list(NULL), null = null, size = size), list(3, 4) ) # I: List size 2, Element size 2 # O: List size 2, Element size 2 expect_identical( - list_transpose(list(1, 2), null = null, size = 2), + list_transpose(list(1, 2), null = null, size = size), list(c(1, 2), c(1, 2)) ) # I: List size 3, Element size 2 # O: List size 2, Element size 3 expect_identical( - list_transpose(list(1, 2, NULL), null = null, size = 2), + list_transpose(list(1, 2, NULL), null = null, size = size), list(c(1, 2, 3), c(1, 2, 4)) ) }) From 0329b875f067b52161a3fb9a78337e7aaa12e112 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 16 Oct 2025 09:11:17 -0400 Subject: [PATCH 10/13] Use `vec_check_recyclable()` --- R/list-transpose.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index 91edd6ed9..bddf5082c 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -234,13 +234,12 @@ list_transpose <- function( call = error_call ) - null <- vec_recycle( + vec_check_recyclable( x = null, size = size, x_arg = "null", call = error_call ) - # TODO!: vec_check_recyclable() if (vec_any_missing(x)) { null <- list(null) From 5d89f92a902502fc72a3fbedd02aec39875c0c25 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 16 Oct 2025 09:14:40 -0400 Subject: [PATCH 11/13] Typo --- R/list-transpose.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/list-transpose.R b/R/list-transpose.R index bddf5082c..7a6a2e113 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -237,7 +237,7 @@ list_transpose <- function( vec_check_recyclable( x = null, size = size, - x_arg = "null", + arg = "null", call = error_call ) From fbda2964fe69507c4c822f12d9413286896462e2 Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 16 Oct 2025 09:14:45 -0400 Subject: [PATCH 12/13] Comment --- R/list-transpose.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/list-transpose.R b/R/list-transpose.R index 7a6a2e113..d91784d17 100644 --- a/R/list-transpose.R +++ b/R/list-transpose.R @@ -265,6 +265,7 @@ list_transpose <- function( out } +# Same as `ptype_finalize()` in `vec_recode_values()` and `vec_if_else()` list_transpose_ptype_common <- function( x, null, From b39cbe7bffc12de2a9b74877045aa68ae520959d Mon Sep 17 00:00:00 2001 From: Davis Vaughan Date: Thu, 16 Oct 2025 09:16:09 -0400 Subject: [PATCH 13/13] Link to PR --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 097a4162a..41c632bda 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,6 @@ # vctrs (development version) -* New `list_transpose()` for transposing a list of vectors. +* New `list_transpose()` for transposing a list of vectors (#2059). * `vec_interleave()` gains new `.size` and `.error_call` arguments.