From db57cb61bed02810b475cea2b9d03b0af74ab918 Mon Sep 17 00:00:00 2001 From: Daniel Date: Tue, 27 Aug 2024 20:51:01 +0200 Subject: [PATCH] comments --- R/data_modify.R | 13 ++++++++++-- tests/testthat/test-data_modify.R | 35 ++++++++++++++++++++++++++++++- 2 files changed, 45 insertions(+), 3 deletions(-) diff --git a/R/data_modify.R b/R/data_modify.R index 0a12bb034..c6ac081e9 100644 --- a/R/data_modify.R +++ b/R/data_modify.R @@ -149,6 +149,11 @@ data_modify.default <- function(data, ...) { data_modify.data.frame <- function(data, ..., .if = NULL, .at = NULL, .modify = NULL) { dots <- eval(substitute(alist(...))) + # error for data frames with no rows... + if (nrow(data) == 0) { + insight::format_error("`data_modify()` only works for data frames with at least one row.") + } + # check if we have dots, or only at/modify ---- if (length(dots)) { @@ -205,6 +210,10 @@ data_modify.grouped_df <- function(data, ..., .if = NULL, .at = NULL, .modify = # the data.frame method later... dots <- match.call(expand.dots = FALSE)[["..."]] + # error for data frames with no rows... + if (nrow(data) == 0) { + insight::format_error("`data_modify()` only works for data frames with at least one row.") + } grps <- attr(data, "groups", exact = TRUE) grps <- grps[[".rows"]] @@ -358,8 +367,8 @@ data_modify.grouped_df <- function(data, ..., .if = NULL, .at = NULL, .modify = if (!is.null(symbol_string) && all(symbol_string == "n()")) { # "special" functions - using "n()" just returns number of rows new_variable <- nrow(data) - } else if (!is.null(symbol_string) && length(symbol_string) == 1 && grepl("n()", symbol_string, fixed = TRUE)) { - # "special" functions, like "1:n()" or similar + } else if (!is.null(symbol_string) && length(symbol_string) == 1 && grepl("\\bn\\(\\)", symbol_string)) { + # "special" functions, like "1:n()" or similar - but not "1:fun()" symbol_string <- str2lang(gsub("n()", "nrow(data)", symbol_string, fixed = TRUE)) new_variable <- try(with(data, eval(symbol_string)), silent = TRUE) } else { diff --git a/tests/testthat/test-data_modify.R b/tests/testthat/test-data_modify.R index 14bca59ca..4a6c5a491 100644 --- a/tests/testthat/test-data_modify.R +++ b/tests/testthat/test-data_modify.R @@ -353,6 +353,13 @@ test_that("data_modify errors for non df", { }) +test_that("data_modify errors for empty data frames", { + data(mtcars) + x <- mtcars[1, ] + expect_error(data_modify(x[-1, ], new_var = 5), regex = "`data_modify()` only works") +}) + + test_that("data_modify errors for non df", { data(efc) a <- "center(c22hour)" # <---------------- error in variable name @@ -492,8 +499,10 @@ test_that("data_modify works with functions that return character vectors", { }) -test_that("data_modify 1:n() and similar works in grouped data frames", { +test_that("data_modify 1:n() and similar works in (grouped) data frames", { data(mtcars) + out <- data_modify(mtcars, Trials = 1:n()) # nolint + expect_identical(out$Trials, 1:32) x <- data_group(mtcars, "gear") out <- data_modify(x, Trials = 1:n()) # nolint expect_identical(out$Trials[out$gear == 3], 1:15) @@ -562,3 +571,27 @@ test_that("data_modify .if/.at arguments", { out <- data_modify(d, new_length = Petal.Length * 2, .if = is.numeric, .modify = round) expect_equal(out$new_length, c(3, 3, 3, 3, 3), ignore_attr = TRUE) }) + + +skip_if_not_installed("withr") + +withr::with_environment( + new.env(), + test_that("data_modify 1:n() and similar works in (grouped) data frames inside function calls", { + data(mtcars) + x <- data_group(mtcars, "gear") + + foo <- function(d) { + out <- data_modify(d, Trials = 1:n()) + out$Trials + } + expect_identical( + foo(x), + c( + 1L, 2L, 3L, 1L, 2L, 3L, 4L, 4L, 5L, 6L, 7L, 5L, 6L, 7L, 8L, + 9L, 10L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 11L, 1L, 2L, 3L, + 4L, 5L, 12L + ) + ) + }) +)