diff --git a/NEWS.md b/NEWS.md index 1d91d6621..9a4930800 100644 --- a/NEWS.md +++ b/NEWS.md @@ -68,6 +68,8 @@ * Can use `T` to specify the default in `case_when()`, (#272). +* `slice()` no longer returns excess rows (#10). + * More translations for tidyr verbs have been added: * `drop_na()` (@markfairbanks, #194) diff --git a/R/step-subset-slice.R b/R/step-subset-slice.R index 51cf0ba1b..1cf1ce343 100644 --- a/R/step-subset-slice.R +++ b/R/step-subset-slice.R @@ -56,12 +56,17 @@ slice.dtplyr_step <- function(.data, ...) { if (length(dots) == 0) { i <- NULL - } else if (length(dots) == 1) { - i <- dots[[1]] } else { - i <- call2("c", !!!dots) + if (length(dots) == 1) { + .rows <- dots[[1]] + } else { + .rows <- call2("c", !!!dots) + } + # Update logic once data.table #4353 is merged + # https://github.com/Rdatatable/data.table/pull/4353 + between <- call2("between", .rows, quote(-.N), quote(.N)) + i <- call2("[", .rows, between) } - i <- expr(!!i) step_subset_i(.data, i) } diff --git a/R/tidyeval.R b/R/tidyeval.R index aaf7d9cae..d1bec1952 100644 --- a/R/tidyeval.R +++ b/R/tidyeval.R @@ -14,7 +14,7 @@ dt_eval <- function(x) { # Make sure data.table functions are available so dtplyr still works # even when data.table isn't attached dt_funs <- c( - "CJ", "copy", "dcast", "melt", "nafill", + "between", "CJ", "copy", "dcast", "melt", "nafill", "fcase", "fcoalesce", "fifelse", "fintersect", "frank", "frankv", "fsetdiff", "funion", "setcolorder", "setnames", "tstrsplit" ) diff --git a/tests/testthat/test-step-subset-slice.R b/tests/testthat/test-step-subset-slice.R index bd84669ee..c26cc19a3 100644 --- a/tests/testthat/test-step-subset-slice.R +++ b/tests/testthat/test-step-subset-slice.R @@ -7,12 +7,12 @@ test_that("can slice", { expr(DT) ) expect_equal( - dt %>% slice(1:4) %>% show_query(), - expr(DT[1:4]) + dt %>% slice(c(1, 2)) %>% show_query(), + expr(DT[c(1, 2)[between(c(1, 2), -.N, .N)]]) ) expect_equal( dt %>% slice(1, 2, 3) %>% show_query(), - expr(DT[c(1, 2, 3)]) + expr(DT[c(1, 2, 3)[between(c(1, 2, 3), -.N, .N)]]) ) }) @@ -22,7 +22,7 @@ test_that("can slice when grouped", { expect_equal( dt2 %>% show_query(), - expr(DT[DT[, .I[1], by = .(x)]$V1]) + expr(DT[DT[, .I[1[between(1, -.N, .N)]], by = .(x)]$V1]) ) expect_equal(as_tibble(dt2), tibble(x = c(1, 2), y = c(1, 3))) }) @@ -35,6 +35,14 @@ test_that("slicing doesn't sorts groups", { ) }) +test_that("doesn't return excess rows, #10", { + dt <- lazy_dt(data.table(x = 1:2)) + expect_equal( + dt %>% slice(1:3) %>% pull(x), + 1:2 + ) +}) + # variants ---------------------------------------------------------------- test_that("functions silently truncate results", {