test_that("simple expressions left as is", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) expect_equal(capture_dot(dt, NULL), NULL) expect_equal(capture_dot(dt, 10), 10) expect_equal(capture_dot(dt, x), quote(x)) expect_equal(capture_dot(dt, x + y), quote(x + y)) expect_equal(capture_dot(dt, x[[1]]), quote(x[[1]])) # logicals expect_equal(eval(capture_dot(dt, T), globalenv()), TRUE) expect_equal(eval(capture_dot(dt, F), globalenv()), FALSE) expect_equal(capture_dot(dt, TRUE), TRUE) expect_equal(capture_dot(dt, FALSE), FALSE) }) test_that("existing non-variables get inlined", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) n <- 10 expect_equal(capture_dot(dt, x + n), quote(x + 10)) expect_equal(capture_dot(dt, x + m), quote(x + m)) }) test_that("unless we're operating in the global environment", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) quo <- new_quosure(quote(x + n), globalenv()) expect_equal(capture_dot(dt, !!quo), quote(x + ..n)) expect_equal(capture_dot(dt, !!quo, j = FALSE), quote(x + n)) }) test_that("using environment of inlined quosures", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) n <- 10 quo <- new_quosure(quote(x + n), env(n = 20)) expect_equal(capture_dot(dt, f(!!quo)), quote(f(x + 20))) expect_equal(capture_dot(dt, f(!!quo), j = FALSE), quote(f(x + 20))) }) test_that(". gets converted to .SD", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) expect_equal(capture_dot(dt, .), quote(.SD)) expect_equal(capture_dot(dt, .SD), quote(.SD)) }) test_that("translate context functions", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) expect_equal(capture_dot(dt, cur_data()), quote(.SD)) expect_error(capture_dot(dt, cur_data_all()), "not available") expect_equal(capture_dot(dt, cur_group()), quote(.BY)) expect_equal(capture_dot(dt, cur_group_id()), quote(.GRP)) expect_equal(capture_dot(dt, cur_group_rows()), quote(.I)) }) test_that("translates if_else()/ifelse()", { df <- data.frame(x = 1:5) expect_equal( capture_dot(df, ifelse(x < 0, 1, 2)), expr(fifelse(x < 0, 1, 2)) ) expect_equal( capture_dot(df, if_else(x < 0, 1, 2)), expr(fifelse(x < 0, 1, 2)) ) # Handles unusual argument names/order expect_equal( capture_dot(df, ifelse(x < 0, n = 2, yes = 1)), expr(fifelse(x < 0, 1, 2)) ) expect_equal( capture_dot(df, if_else(x < 0, f = 2, true = 1)), expr(fifelse(x < 0, 1, 2)) ) # tidyeval works inside if_else, #220 expect_equal( capture_dot(df, if_else(.data$x < 3, 1, 2)), expr(fifelse(x < 3, 1, 2)) ) }) test_that("translates coalesce()", { df <- data.frame(x = 1:5) expect_equal( capture_dot(df, coalesce(x, 1)), expr(fcoalesce(x, 1)) ) }) test_that("can use local variable with coalesce() and replace_na()", { dt <- lazy_dt(data.frame(x = c(1, NA)), "dt") n <- 10 expect_equal( capture_dot(dt, coalesce(x, n)), expr(fcoalesce(x, 10)) ) expect_equal( capture_dot(dt, replace_na(x, n)), expr(fcoalesce(x, 10)) ) }) test_that("translates case_when()", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) expect_equal( capture_dot(dt, case_when(x1 ~ y1, x2 ~ y2, x3 ~ TRUE, TRUE ~ y4)), quote(fcase(x1, y1, x2, y2, x3, TRUE, rep(TRUE, .N), y4)) ) # can use T for default, #272 expect_equal( capture_dot(dt, case_when(x1 ~ y1, x2 ~ y2, x3 ~ TRUE, T ~ y4)), quote(fcase(x1, y1, x2, y2, x3, TRUE, rep(TRUE, .N), y4)) ) # translates recursively expect_equal( capture_dot(dt, case_when(x == 1 ~ n())), quote(fcase(x == 1, .N)) ) }) test_that("translates lag()/lead()", { df <- data.frame(x = 1:5, y = 1:5) expect_equal( capture_dot(df, lag(x)), expr(shift(x, type = "lag")) ) expect_equal( capture_dot(df, lead(x, 2, default = 3)), expr(shift(x, n = 2, fill = 3, type = "lead")) ) # Errors with order_by expect_snapshot_error( capture_dot(df, lag(x, order_by = y)), ) }) test_that("can use local variable with lag()/lead()", { dt <- lazy_dt(data.frame(x = c(1, NA)), "dt") n <- 10 expect_equal( capture_dot(dt, lag(x, n)), expr(shift(x, n = 10, type = "lag")) ) }) test_that("can process many expressions in one go", { dt <- lazy_dt(data.frame(x = 1:10, y = 1:10)) n <- 10 dots <- capture_dots(dt, x = x + n, y = y) expect_named(dots, c("x", "y")) expect_equal(dots$x, quote(x + 10)) }) test_that("can use anonymous functions", { dt <- lazy_dt(data.frame(x = 1:2, y = 1)) expect_equal( capture_dot(dt, x = sapply(x, function(x) x)) %>% deparse(), "sapply(x, function(x) x)" ) }) test_that("can splice a data frame", { df <- data.frame(b = rep(2, 3), c = rep(3, 3)) dots <- capture_dots(df, !!!df) expect_equal(dots, as.list(df)) }) # evaluation -------------------------------------------------------------- test_that("can access functions in local env", { dt <- lazy_dt(data.frame(g = c(1, 1, 2), x = 1:3)) f <- function(x) 100 expect_equal(dt %>% summarise(n = f()) %>% pull(), 100) }) test_that("can disambiguate using .data and .env", { dt <- lazy_dt(data.frame(x = 1)) x <- 2 expect_equal(capture_dot(dt, .data$x), quote(x)) expect_equal(capture_dot(dt, .env$x), quote(..x)) out <- dt %>% summarise(data = .data$x, env = .env$x) %>% as_tibble() expect_equal(out, tibble(data = 1, env = 2)) var <- "x" out <- dt %>% summarise(data = .data[[var]], env = .env[[var]]) %>% collect() expect_equal(out, tibble(data = 1, env = 2)) }) test_that("locals are executed before call", { dt <- lazy_dt(data.frame(x = 1, y = 2)) expect_equal( dt %>% step_locals(exprs(a = 1, b = 2, c = a + b), "c") %>% dt_eval(), 3 ) }) # dplyr verbs ------------------------------------------------------------- test_that("n() is equivalent to .N", { dt <- lazy_dt(data.frame(g = c(1, 1, 2), x = 1:3)) expect_equal( dt %>% summarise(n = n()) %>% pull(), 3L ) expect_equal( dt %>% group_by(g) %>% summarise(n = n()) %>% pull(), c(2L, 1L) ) }) test_that("row_number() is equivalent .I", { dt <- lazy_dt(data.frame(g = c(1, 1, 2), x = 1:3)) expect_equal( dt %>% mutate(n = row_number()) %>% pull(), 1:3L ) expect_equal( dt %>% group_by(g) %>% mutate(n = row_number()) %>% pull(), c(1:2, 1) ) }) test_that("row_number(x) is equivalent to rank", { dt <- lazy_dt(data.frame(x = c(10, 30, 20))) expect_equal( dt %>% mutate(n = row_number(x)) %>% pull(), c(1L, 3L, 2L) ) }) test_that("scoped verbs produce nice output", { dt <- lazy_dt(data.table(x = 1:5), "DT") expect_equal( dt %>% summarise_all(mean) %>% show_query(), expr(DT[, .(x = mean(x))]) ) expect_equal( dt %>% summarise_all(~ mean(.)) %>% show_query(), expr(DT[, .(x = mean(x))]) ) expect_equal( dt %>% summarise_all(row_number) %>% show_query(), expr(DT[, .(x = frank(x, ties.method = "first", na.last = "keep"))]) ) expect_equal( dt %>% summarise_all(~ n()) %>% show_query(), expr(DT[, .(x = .N)]) ) }) test_that("non-Gforce verbs work", { dt <- lazy_dt(data.table(x = 1:2), "DT") add <- function(x) sum(x) expect_equal(dt %>% summarise_at(vars(x), add) %>% pull(), 3) expect_equal(dt %>% mutate_at(vars(x), add) %>% pull(), c(3, 3)) }) test_that("`desc(col)` is translated to `-col` inside arrange", { dt <- lazy_dt(data.table(x = c("a", "b")), "DT") step <- arrange(dt, desc(x)) out <- collect(step) expect_equal(show_query(step), expr(DT[order(-x)])) expect_equal(out$x, c("b", "a")) }) test_that("desc() checks the number of arguments", { expect_snapshot(error = TRUE, capture_dot(df, desc(a, b))) }) test_that("n_distinct() is translated to uniqueN()", { # Works with multiple inputs expect_equal( dt_squash(expr(n_distinct(c(1, 1, 2), c(1, 2, 1)))), expr(uniqueN(data.table(c(1, 1, 2), c(1, 2, 1)))) ) # Works with single column selection (in summarise()) expect_equal( dt_squash(expr(n_distinct(x))), expr(uniqueN(x)) ) dt <- lazy_dt(data.table(x = c("a", "a", "b", NA)), "DT") step <- summarise(dt, num = n_distinct(x, na.rm = TRUE)) out <- collect(step) expect_equal( show_query(step), expr(DT[, .(num = uniqueN(x, na.rm = TRUE))]) ) expect_equal(out$num, 2) }) # fun_name ---------------------------------------------------------------- test_that("finds name of functions with GForce implementations", { expect_equal(fun_name(mean), expr(mean)) # unless overridden mean <- function() {} expect_equal(fun_name(mean), NULL) })
Generated by dwww version 1.15 on Tue Jul 2 07:56:20 CEST 2024.