vctrs update

DESCRIPTION

@@ -20,7 +20,7 @@ Depends:
 Imports: 
     glue,
     rlang (>= 0.4.5),
-    vctrs (>= 0.2.4),
+    vctrs (>= 0.2.99.9010),
     warp
 Suggests: 
     covr,
@@ -65,3 +65,5 @@ Collate:
     'slider-package.R'
     'utils.R'
     'zzz.R'
+Remotes:
+    r-lib/vctrs

NEWS.md

@@ -1,5 +1,15 @@
 # slider (development version)
 
+* `hop()` and its variants no longer place the names of `.x` on the output.
+  Because there is no _size_ guarantee on the output, the size of `.x` can
+  be different than the size of the output, meaning that the names might not
+  line up. This also affects `slide_period()`, which is implemented using
+  a `hop()` variant (#75).
+
+* With data frames containing row names, `slide()` and its variants now copy
+  those row names onto the output. This is an implicit benefit from vctrs
+  gaining better support for data frame row names.
+
 # slider 0.1.2
 
 * Updated to stay compatible with the latest version of vctrs.

R/utils.R

@@ -93,20 +93,20 @@ compute_size <- function(x, type) {
   }
 }
 
-# Ensures that `slide_vec(c(x = 1), ~.x, .ptype = NULL)` works, and keeps it
-# in line with what `map_dbl(c(x = 1), ~c(y = 2))` does by only keeping names
-# from `x`
+# Unconditionally use only the names from `.x` on the output when simplifying.
+# Ensures that the following are aligned:
+#
+# slide_vec(c(x = 1), ~c(y = 2))
+# purrr::map_dbl(c(x = 1), ~c(y = 2))
+#
+# slide_vec(1, ~c(y = 2))
+# purrr::map_dbl(1, ~c(y = 2))
 vec_simplify <- function(x) {
   names <- vec_names(x)
 
-  if (is.null(names)) {
-    out <- vec_c(!!!x)
-    return(out)
-  }
-
   x <- vec_set_names(x, NULL)
 
-  out <- vec_c(!!!x)
+  out <- vec_unchop(x)
 
   vec_set_names(out, names)
 }

src/hop.c

@@ -109,9 +109,6 @@ SEXP hop_common_impl(SEXP x,
   out = vec_restore(out, ptype);
   REPROTECT(out, out_prot_idx);
 
-  out = copy_names(out, x, type);
-  REPROTECT(out, out_prot_idx);
-
   UNPROTECT(5);
   return out;
 }

src/index.c

@@ -227,9 +227,6 @@ SEXP hop_index_common_impl(SEXP x,
   out = vec_restore(out, ptype);
   REPROTECT(out, out_prot_idx);
 
-  out = copy_names(out, x, type);
-  REPROTECT(out, out_prot_idx);
-
   UNPROTECT(n_prot);
   return out;
 }

tests/testthat/test-hop-index-vec.R

@@ -100,41 +100,15 @@ test_that("can return a matrix and rowwise bind the results together", {
 test_that("names exist on inner sliced elements", {
   names <- letters[1:5]
   x <- set_names(1:5, names)
-  exp <- set_names(as.list(names), names)
+  exp <- as.list(names)
   i <- vec_seq_along(x)
   expect_equal(hop_index_vec(x, i, i, i, ~list(names(.x))), exp)
 })
 
-test_that("names can be placed on atomics", {
+test_that("names are never placed on the output", {
   names <- letters[1:5]
   x <- set_names(1:5, names)
   i <- vec_seq_along(x)
-  expect_equal(names(hop_index_vec(x, i, i, i, ~.x)), names)
-  expect_equal(names(hop_index_vec(x, i, i, i, ~.x, .ptype = int())), names)
-  expect_equal(names(hop_index_vec(x, i, i, i, ~.x, .ptype = dbl())), names)
-})
-
-test_that("names are not placed on data frames rownames", {
-  names <- letters[1:2]
-  x <- set_names(1:2, names)
-  i <- vec_seq_along(x)
-  out <- hop_index_vec(x, i, i, i, ~data.frame(x = .x), .ptype = data.frame(x = int()))
-  expect_equal(rownames(out), c("1", "2"))
-})
-
-test_that("names can be placed on arrays", {
-  names <- letters[1:2]
-  x <- set_names(1:2, names)
-  i <- vec_seq_along(x)
-  out <- hop_index_vec(x, i, i, i, ~array(.x, c(1, 1)), .ptype = array(int(), dim = c(0, 1)))
-  expect_equal(rownames(out), names)
-})
-
-test_that("names can be placed correctly on proxied objects", {
-  names <- letters[1:2]
-  x <- set_names(1:2, names)
-  i <- vec_seq_along(x)
-  datetime_lt <- as.POSIXlt(new_datetime(0))
-  out <- hop_index_vec(x, i, i, i, ~datetime_lt, .ptype = datetime_lt)
-  expect_equal(names(out), names)
+  expect_null(names(hop_index_vec(x, i, i, i, ~.x)))
+  expect_null(names(hop_index_vec(x, i, i, i, ~.x, .ptype = int())))
 })

tests/testthat/test-hop-index.R

@@ -266,3 +266,18 @@ test_that("can order by two vectors using a data frame", {
     )
   )
 })
+
+# ------------------------------------------------------------------------------
+# input names
+
+test_that("names exist on inner sliced elements", {
+  names <- letters[1:5]
+  x <- set_names(1:5, names)
+  exp <- as.list(names)
+  expect_equal(hop_index(x, 1:5, 1:5, 1:5, ~names(.x)), exp)
+})
+
+test_that("names are never placed on the output", {
+  x <- set_names(1:5, letters[1:5])
+  expect_null(names(hop_index(x, 1:5, 1:5, 1:5, ~.x)))
+})

tests/testthat/test-hop-vec.R

@@ -78,36 +78,12 @@ test_that("can return a matrix and rowwise bind the results together", {
 test_that("names exist on inner sliced elements", {
   names <- letters[1:5]
   x <- set_names(1:5, names)
-  exp <- set_names(as.list(names), names)
+  exp <- as.list(names)
   expect_equal(hop_vec(x, 1:5, 1:5, ~list(names(.x))), exp)
 })
 
-test_that("names can be placed on atomics", {
-  names <- letters[1:5]
-  x <- set_names(1:5, names)
-  expect_equal(names(hop_vec(x, 1:5, 1:5, ~.x)), names)
-  expect_equal(names(hop_vec(x, 1:5, 1:5, ~.x, .ptype = int())), names)
-  expect_equal(names(hop_vec(x, 1:5, 1:5, ~.x, .ptype = dbl())), names)
-})
-
-test_that("names are not placed on data frames rownames", {
-  names <- letters[1:2]
-  x <- set_names(1:2, names)
-  out <- hop_vec(x, 1:2, 1:2, ~data.frame(x = .x), .ptype = data.frame(x = int()))
-  expect_equal(rownames(out), c("1", "2"))
-})
-
-test_that("names can be placed on arrays", {
-  names <- letters[1:2]
-  x <- set_names(1:2, names)
-  out <- hop_vec(x, 1:2, 1:2, ~array(.x, c(1, 1)), .ptype = array(int(), dim = c(0, 1)))
-  expect_equal(rownames(out), names)
-})
-
-test_that("names can be placed correctly on proxied objects", {
-  names <- letters[1:2]
-  x <- set_names(1:2, names)
-  datetime_lt <- as.POSIXlt(new_datetime(0))
-  out <- hop_vec(x, 1:2, 1:2, ~datetime_lt, .ptype = datetime_lt)
-  expect_equal(names(out), names)
+test_that("names are never placed on the output", {
+  x <- set_names(1:5, letters[1:5])
+  expect_null(names(hop_vec(x, 1:5, 1:5, ~.x)))
+  expect_null(names(hop_vec(x, 1:5, 1:5, ~.x, .ptype = int())))
 })

tests/testthat/test-hop.R

@@ -112,3 +112,18 @@ test_that("`.starts` and `.stops` must be integerish", {
   expect_error(hop(1, "x", 1, identity), class = "vctrs_error_subscript_type")
   expect_error(hop(1, 1, "x", identity), class = "vctrs_error_subscript_type")
 })
+
+# ------------------------------------------------------------------------------
+# input names
+
+test_that("names exist on inner sliced elements", {
+  names <- letters[1:5]
+  x <- set_names(1:5, names)
+  exp <- as.list(names)
+  expect_equal(hop(x, 1:5, 1:5, ~names(.x)), exp)
+})
+
+test_that("names are never placed on the output", {
+  x <- set_names(1:5, letters[1:5])
+  expect_null(names(hop(x, 1:5, 1:5, ~.x)))
+})

tests/testthat/test-slide-index.R

@@ -1063,10 +1063,10 @@ test_that("input names are retained from proxied objects", {
   expect_equal(names(slide_index(x, i, ~.x)), names)
 })
 
-test_that("row names are not extracted from data frames", {
+test_that("row names are extracted from data frames", {
   x <- data.frame(x = 1:5, row.names = letters[1:5])
   i <- vec_seq_along(x)
-  expect_equal(names(slide_index(x, i, ~.x)), NULL)
+  expect_equal(names(slide_index(x, i, ~.x)), letters[1:5])
 })
 
 test_that("row names are extracted from arrays", {
@@ -1082,9 +1082,11 @@ test_that("names are retained on inner sliced object", {
   exp <- set_names(as.list(names), names)
   expect_equal(slide_index(x, i, ~names(.x)), exp)
 
-  x <- data.frame(x = 1:5, row.names = letters[1:5])
+  names <- letters[1:5]
+  x <- data.frame(x = 1:5, row.names = names)
   i <- vec_seq_along(x)
-  expect_equal(slide_index(x, i, ~rownames(.x)), as.list(rownames(x)))
+  expect <- set_names(as.list(names), names)
+  expect_equal(slide_index(x, i, ~rownames(.x)), expect)
 
   names <- c("r1", "r2")
   x <- array(1:4, c(2, 2), dimnames = list(names, c("c1", "c2")))

tests/testthat/test-slide-period-vec.R

@@ -153,3 +153,19 @@ test_that("slide_period_dfc() works", {
     slide_dfc(x, ~data.frame(x = .x), .before = 1)
   )
 })
+
+# ------------------------------------------------------------------------------
+# input names
+
+test_that("names exist on inner sliced elements", {
+  names <- letters[1:5]
+  x <- set_names(1:5, names)
+  exp <- as.list(names)
+  expect_equal(slide_period_vec(x, new_date(1:5), "day", ~list(names(.x))), exp)
+})
+
+test_that("names are never placed on the output", {
+  x <- set_names(1:5, letters[1:5])
+  expect_null(names(slide_period_vec(x, new_date(1:5), "day", ~.x)))
+  expect_null(names(slide_period_vec(x, new_date(1:5), "day", ~.x, .ptype = int())))
+})

tests/testthat/test-slide-vec.R

@@ -93,17 +93,19 @@ test_that("names can be placed on atomics", {
 test_that("when simplifying, names from `.x` are kept, and new names from `.f` results are dropped", {
   x <- set_names(1, "x")
 
-  expect_identical(
-    slide_vec(x, ~c(y = 2), .ptype = NULL),
-    c(x = 2)
-  )
+  expect_identical(slide_vec(x, ~c(y = 2), .ptype = NULL), c(x = 2))
+  expect_identical(slide_vec(1, ~c(y = 2), .ptype = NULL), 2)
 })
 
-test_that("names are not placed on data frames rownames", {
+test_that("names can be placed on data frames", {
   names <- letters[1:2]
   x <- set_names(1:2, names)
+
+  out <- slide_vec(x, ~data.frame(x = .x))
+  expect_equal(rownames(out), names)
+
   out <- slide_vec(x, ~data.frame(x = .x), .ptype = data.frame(x = int()))
-  expect_equal(rownames(out), c("1", "2"))
+  expect_equal(rownames(out), names)
 })
 
 test_that("names can be placed on arrays", {

tests/testthat/test-slide.R

@@ -466,9 +466,9 @@ test_that("input names are retained from proxied objects", {
   expect_equal(names(slide(x, ~.x)), names)
 })
 
-test_that("row names are not extracted from data frames", {
+test_that("row names are extracted from data frames", {
   x <- data.frame(x = 1:5, row.names = letters[1:5])
-  expect_equal(names(slide(x, ~.x)), NULL)
+  expect_equal(names(slide(x, ~.x)), letters[1:5])
 })
 
 test_that("row names are extracted from arrays", {
@@ -482,8 +482,10 @@ test_that("names are retained on inner sliced object", {
   exp <- set_names(as.list(names), names)
   expect_equal(slide(x, ~names(.x)), exp)
 
-  x <- data.frame(x = 1:5, row.names = letters[1:5])
-  expect_equal(slide(x, ~rownames(.x)), as.list(rownames(x)))
+  names <- letters[1:5]
+  x <- data.frame(x = 1:5, row.names = names)
+  expect <- set_names(as.list(names), names)
+  expect_equal(slide(x, ~rownames(.x)), expect)
 
   names <- c("r1", "r2")
   x <- array(1:4, c(2, 2), dimnames = list(names, c("c1", "c2")))