From f70061211a8aa8c9a65e486b15bb141e89f222b7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 7 Mar 2024 05:37:36 +0100 Subject: [PATCH] groups --- NAMESPACE | 1 + R/groups.R | 32 ++++++++++++++++++++++++++++ R/overwrite.R | 1 + R/restore.R | 1 + dplyr-methods/groups.txt | 3 +++ tests/testthat/test-as_duckplyr_df.R | 16 ++++++++++++++ tools/00-funs.R | 4 +++- 7 files changed, 57 insertions(+), 1 deletion(-) create mode 100644 R/groups.R create mode 100644 dplyr-methods/groups.txt diff --git a/NAMESPACE b/NAMESPACE index 94933843..9d71e5d1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -21,6 +21,7 @@ S3method(group_map,duckplyr_df) S3method(group_modify,duckplyr_df) S3method(group_size,duckplyr_df) S3method(group_vars,duckplyr_df) +S3method(groups,duckplyr_df) S3method(head,duckplyr_df) S3method(inner_join,duckplyr_df) S3method(intersect,duckplyr_df) diff --git a/R/groups.R b/R/groups.R new file mode 100644 index 00000000..d9931a57 --- /dev/null +++ b/R/groups.R @@ -0,0 +1,32 @@ +# Generated by 02-duckplyr_df-methods.R +#' @export +groups.duckplyr_df <- function(x) { + # Our implementation + rel_try( + # Always fall back to dplyr + "No relational implementation for groups()" = TRUE, + { + return(out) + } + ) + + # dplyr forward + groups <- dplyr$groups.data.frame + out <- groups(x) + return(out) + + # dplyr implementation + syms(group_vars(x)) +} + +duckplyr_groups <- function(x, ...) { + try_fetch( + x <- as_duckplyr_df(x), + error = function(e) { + testthat::skip(conditionMessage(e)) + } + ) + out <- groups(x, ...) + class(out) <- setdiff(class(out), "duckplyr_df") + out +} diff --git a/R/overwrite.R b/R/overwrite.R index f8acc334..0c7edfae 100644 --- a/R/overwrite.R +++ b/R/overwrite.R @@ -21,6 +21,7 @@ methods_overwrite <- function() { vctrs::s3_register("dplyr::group_modify", "data.frame", group_modify.duckplyr_df) vctrs::s3_register("dplyr::group_size", "data.frame", group_size.duckplyr_df) vctrs::s3_register("dplyr::group_vars", "data.frame", group_vars.duckplyr_df) + vctrs::s3_register("dplyr::groups", "data.frame", groups.duckplyr_df) vctrs::s3_register("dplyr::inner_join", "data.frame", inner_join.duckplyr_df) vctrs::s3_register("dplyr::intersect", "data.frame", intersect.duckplyr_df) vctrs::s3_register("dplyr::left_join", "data.frame", left_join.duckplyr_df) diff --git a/R/restore.R b/R/restore.R index a898dada..13acdab9 100644 --- a/R/restore.R +++ b/R/restore.R @@ -21,6 +21,7 @@ methods_restore <- function() { vctrs::s3_register("dplyr::group_modify", "data.frame", dplyr$group_modify.data.frame) vctrs::s3_register("dplyr::group_size", "data.frame", dplyr$group_size.data.frame) vctrs::s3_register("dplyr::group_vars", "data.frame", dplyr$group_vars.data.frame) + vctrs::s3_register("dplyr::groups", "data.frame", dplyr$groups.data.frame) vctrs::s3_register("dplyr::inner_join", "data.frame", dplyr$inner_join.data.frame) vctrs::s3_register("dplyr::intersect", "data.frame", dplyr$intersect.data.frame) vctrs::s3_register("dplyr::left_join", "data.frame", dplyr$left_join.data.frame) diff --git a/dplyr-methods/groups.txt b/dplyr-methods/groups.txt new file mode 100644 index 00000000..890a0575 --- /dev/null +++ b/dplyr-methods/groups.txt @@ -0,0 +1,3 @@ +groups.data.frame <- function(x) { + syms(group_vars(x)) +} diff --git a/tests/testthat/test-as_duckplyr_df.R b/tests/testthat/test-as_duckplyr_df.R index 27a78df4..3efd64ef 100644 --- a/tests/testthat/test-as_duckplyr_df.R +++ b/tests/testthat/test-as_duckplyr_df.R @@ -863,6 +863,22 @@ test_that("as_duckplyr_df() and group_vars()", { expect_equal(pre, post) }) +test_that("as_duckplyr_df() and groups()", { + withr::local_envvar(DUCKPLYR_FORCE = "FALSE") + + skip("Special") + + # Data + test_df <- data.frame(a = 1:6 + 0, b = 2, g = rep(1:3, 1:3)) + + # Run + pre <- test_df %>% as_duckplyr_df() %>% groups() + post <- test_df %>% groups() %>% as_duckplyr_df() + + # Compare + expect_equal(pre, post) +}) + test_that("as_duckplyr_df() and inner_join(join_by(a))", { withr::local_envvar(DUCKPLYR_FALLBACK_FORCE = "TRUE") diff --git a/tools/00-funs.R b/tools/00-funs.R index 9c2876bf..84a507fd 100644 --- a/tools/00-funs.R +++ b/tools/00-funs.R @@ -16,7 +16,7 @@ df_methods <- filter(!grepl("_$|^as[.]tbl$", name)) %>% # special dplyr methods, won't implement filter(!(name %in% c( - "group_indices", "group_nest", "group_split", "group_trim", "groups", "n_groups", + "group_indices", "group_nest", "group_split", "group_trim", "n_groups", "same_src", # data frames can be copied into duck-frames with zero cost NULL ))) %>% @@ -30,6 +30,7 @@ df_methods <- "group_map", "group_modify", "group_size", + "groups", "rowwise", NULL ))) %>% @@ -704,6 +705,7 @@ test_skip_map <- c( group_size = "Special", group_split = "WAT", group_trim = "Grouped", + groups = "Special", nest_by = "WAT", # FIXME: Fail with rowwise() rowwise = "Stack overflow",