Expected `out` to be identical to `data.frame(a = c(1L, 2L, 3L, 4L, 2L, 3L, 4L, 5L), b = 2)`.
Differences:
  `attr(actual, 'row.names')`: NA -8            
`attr(expected, 'row.names')`:  1  2 3 4 5 6 7 8

Expected `out` to be identical to `data.frame(a = c(1L, 2L, 2L, 3L, 3L, 4L, 4L, 5L), b = 2)`.
Differences:
  `attr(actual, 'row.names')`: NA -8            
`attr(expected, 'row.names')`:  1  2 3 4 5 6 7 8

Expected `df1` to equal `rel5`.
Differences:
  `attr(actual, 'row.names')`:  1   
`attr(expected, 'row.names')`: NA -1

# Run this file with testthat::test_local(filter = "^relational$")
test_that("we can create a relation from a df", {
rel <- rel_from_df(con, data.frame(a = 1))
test_that("we don't add optional quotes to columns", {
test_that("we won't crash when creating a relation from odd things", {
# na seems to be fine, single col data frame with a single row with NA in it
test_that("we can round-trip a data frame", {
as.data.frame.duckdb_relation(rel_from_df(con, data.frame(a = 1:3, b = letters[1:3]))),
test_that("we can recognize if a df is materialized", {
rel <- rel_from_df(con, data.frame(a = 1:3))
test_that("we can create various expressions and don't crash", {
test_that("we can create comparison expressions with appropriate operators", {
test_that("we cannot create comparison expressions with inappropriate operators", {
test_that("we can create operator expressions", {
expr_operator("NOT IN", list(expr_reference("some_column"), expr_constant(-42), expr_constant(42)))
test_that("we can use operator expressions in relations", {
list(expr_operator("NOT IN", list(expr_reference("id"), expr_constant(2L), expr_constant(4L), expr_constant(5L))))
test_that("expr_operator validates ... parameter", {
expr_operator("IN", list(expr_reference("col")), extra_param = "value"),
# TODO should maybe be a different file, test_enum_strings.R
test_that("we can cast R strings to DuckDB strings", {
gen_rand_string <- function(x, max_len) paste0(chars[sample(1:length(chars), runif(1) * max_len, replace = TRUE)], collapse = "")
test_string_vec <- c(vapply(1:n, gen_rand_string, "character", max_len), NA, NA, NA, NA, NA, NA, NA, NA) # batman
df <- data.frame(s = test_string_vec, stringsAsFactors = FALSE)
expect_equal(df, as.data.frame.duckdb_relation(rel_from_df(con, df)), ignore_attr = TRUE)
expect_equal(df, res, ignore_attr = TRUE)
expect_equal(df, df2, ignore_attr = TRUE)
test_that("the altrep-conversion for relations works", {
expect_true(any(grepl("DUCKDB_ALTREP_REL_VECTOR", inspect_output, fixed = TRUE)))
expect_true(any(grepl("DUCKDB_ALTREP_REL_ROWNAMES", inspect_output, fixed = TRUE)))
expect_snapshot(transform = function(x) gsub("0x[0-9a-f]+", "0x...", x), {
test_that("the altrep-conversion for relations work for weirdo types for strict = FALSE", {
rel <- rel_from_df(con, test_df, strict = FALSE)
test_that("we can get the relation object back from an altrep df", {
test_that("rel_order() sorts NAs last", {
test_df <- rel_from_df(con, data.frame(a = c(NA, 1:3)))
expected_result <- data.frame(a = c(1:3, NA))
test_that("Inner join returns all inner relations", {
dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) AS a = b")
left <- rel_from_df(con, data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2)))
right <- rel_from_df(con, data.frame(right_b = c(1, 3), right_c = c(4, 5)))
cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_b"))))
rel2 <- rel_join(left, right, cond, "inner")
expected_result <- data.frame(left_a = c(1, 2), left_b = c(1, 1), right_b = c(1, 1), right_c = c(4, 4))
test_that("Left join returns all left relations", {
right <- rel_from_df(con, data.frame(right_b = c(1)))
rel2 <- rel_join(left, right, cond, "left")
expected_result <- data.frame(left_a = c(1, 2, 3), left_b = c(1, 1, 2), right_b = c(1, 1, NA))
test_that("Right join returns all right relations", {
left <- rel_from_df(con, data.frame(left_b = c(1)))
right <- rel_from_df(con, data.frame(right_a = c(1, 2, 3), right_b = c(1, 1, 2)))
rel2 <- rel_join(left, right, cond, "right")
expected_result <- data.frame(left_b = c(1, 1, NA), right_a = c(1, 2, 3), right_b = c(1, 1, 2))
test_that("Full join returns all outer relations", {
left <- rel_from_df(con, data.frame(left_a = c(1, 2, 5), left_b = c(4, 5, 6)))
cond <- list(expr_function("eq", list(expr_reference("left_a"), expr_reference("right_a"))))
rel2 <- rel_join(left, right, cond, "outer")
right <- rel_from_df(con, data.frame(right_a = c(1, 4, 5), right_b = c(7, 8, 9)))
cross <- rel_join(left, right, list(), "cross")
order_by <- rel_order(cross, list(expr_reference("right_a"), expr_reference("right_a")))
left <- rel_from_df(con, data.frame(left_b = c(1, 5, 6)))
cond <- list(expr_function("eq", list(expr_reference("left_b"), expr_reference("right_a"))))
# select * from left semi join right on (left_b = right_a)
rel2 <- rel_join(left, right, cond, "semi")
expected_result <- data.frame(left_b = c(1))
# select * from left anti join right on (left_b = right_a)
rel2 <- rel_join(left, right, cond, "anti")
expected_result <- data.frame(left_b = c(5, 6))
test_that("Union all does not immediately materialize", {
test_that("Union all has the correct values", {
order_by_rel <- rel_order(rel, list(expr_reference("a"), expr_reference("b")))
test_that("Union all keeps duplicates", {
dbExecute(con, "CREATE OR REPLACE MACRO gte(a, b) AS a >= b")
test_df2 <- rel_from_df(con, data.frame(event_ts = c(1, 3, 6, 8), event_id = c(0, 1, 2, 3)))
cond <- list(expr_function("gte", list(expr_reference("ts"), expr_reference("event_ts"))))
rel <- rel_join(test_df1, test_df2, cond, join_ref_type = "asof")
rel_proj <- rel_project(rel, list(expr_reference("ts"), expr_reference("event_id")))
test_df2 <- rel_from_df(con, data.frame(event_ts = c(2, 4, 6, 8), event_id = c(0, 1, 2, 3)))
rel <- rel_join(test_df1, test_df2, cond, join = "left", join_ref_type = "asof")
rel_proj <- rel_project(rel, list(expr_reference("ts"), expr_reference("event_ts"), expr_reference("event_id")))
test_that("Positional cross join works", {
test_df2 <- rel_from_df(con, data.frame(c = c(11, 12), d = c(1, 2)))
rel <- rel_join(test_df1, test_df2, list(), join = "cross", join_ref_type = "positional")
test_that("regular positional join works", {
cond <- expr_function("eq", list(expr_reference("a"), expr_reference("c")))
rel <- rel_join(test_df1, test_df2, list(cond), join_ref_type = "positional")
test_that("Invalid asof join condition throws error", {
dbExecute(con, "CREATE OR REPLACE MACRO neq(a, b) AS a <> b")
test_df2 <- rel_from_df(con, data.frame(begin = c(1, 3, 6, 8), value = c(0, 1, 2, 3)))
cond <- list(expr_function("neq", list(expr_reference("ts"), expr_reference("begin"))))
expect_error(rel_join(test_df1, test_df2, cond, join_ref_type = "asof"), "Binder")
test_that("multiple inequality conditions for asof join throws error", {
cond1 <- expr_function("gte", list(expr_reference("ts"), expr_reference("begin")))
cond2 <- expr_function("gte", list(expr_reference("ts"), expr_reference("value")))
expect_error(rel_join(test_df1, test_df2, conds, join_ref_type = "asof"), "Binder")
timing_df <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6)))
events_df <- rel_from_df(con, data.frame(event_ts = c(1, 3, 6, 8), event_id = c(0, 1, 2, 3)))
rel <- rel_inner_join(timing_df, events_df, cond)
rel_proj <- rel_project(rel, list(expr_reference("ts"), expr_reference("event_ts")))
rel_order <- rel_order(rel_proj, list(expr_reference("ts"), expr_reference("event_ts")))
test_that("Inequality join works to perform between operation", {
dbExecute(con, "CREATE OR REPLACE MACRO gt(a, b) AS a > b")
dbExecute(con, "CREATE OR REPLACE MACRO lt(a, b) AS a < b")
timing_df <- rel_from_df(con, data.frame(ts = c(1, 2, 3, 4, 5, 6, 7, 8, 9)))
window_lead <- expr_window(lead, offset_expr = expr_constant(1))
proj_window <- rel_project(events_df, list(expr_reference("event_ts"), window_lead, expr_reference("event_id")))
cond1 <- expr_function("gt", list(expr_reference("ts"), expr_reference("event_ts")))
cond2 <- expr_function("lt", list(expr_reference("ts"), expr_reference("lead")))
rel <- rel_inner_join(timing_df, proj_window, conds)
expected_result <- data.frame(ts = c(2, 4, 5, 7))
# nobody should do this in reality. It's a pretty dumb idea
test_that("we can union the same relation to itself", {
test_that("we throw an error when attempting to union all relations that are not compatible", {
# The two data frames have different dimensions, therefore you get a binding error.
test_that("A union with different column types casts to the richer type", {
test_df_a1 <- rel_from_df(con, data.frame(a = c(1)))
test_df_a2 <- rel_from_df(con, data.frame(a = c("1")))
expected <- data.frame(a = c("1.0", "1"))
test_that("Set Intersect returns set intersection", {
test_df_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
test_df_b <- rel_from_df(con, data.frame(a = c(1, 6), b = c(3, 8)))
expected_result <- data.frame(a = c(1), b = c(3))
test_that("Set intersect casts columns to the richer type", {
test_that("Set Diff returns the set difference", {
expected_result <- data.frame(a = c(2), b = c(4))
test_that("Symmetric difference returns the symmetric difference", {
ordered_rel <- rel_order(rel, list(expr_reference("a"), expr_reference("b")))
expected_result <- data.frame(a = c(2, 6), b = c(4, 8))
test_that("rel aggregate with no groups but a sum over a column, sums the column", {
rel_a <- rel_from_df(con, data.frame(a = c(1, 2), b = c(3, 4)))
aggrs <- list(sum = expr_function("sum", list(expr_reference("a"))))
res <- rel_aggregate(rel_a, list(), aggrs)
expected_result <- data.frame(sum = c(3))
test_that("rel aggregate with groups and aggregate function works", {
rel_b <- rel_aggregate(rel_a, list(expr_reference("b")), aggrs)
expected_result <- data.frame(b = c(3, 4), sum = c(3, 10))
test_that("Window sum expression function test works", {
#   select j, i, sum(i) over (partition by j) from a order by 1,2
aggrs <- expr_window(sum_func, partitions = list(expr_reference("b")))
window_proj <- rel_project(rel_a, list(expr_reference("a"), aggrs))
expected_result <- data.frame(a = c(1:8), window_result = c(3, 3, 7, 7, 11, 11, 15, 15))
test_that("Window count function works", {
#   select a, b, count(b) over (partition by a) from a order by a
count <- expr_window(count_func, partitions = list(expr_reference("b")))
expected_result <- data.frame(window_result = c(2, 2, 2, 2, 2, 2, 2, 2))
test_that("Window avg function works", {
#     select a, b, avg(b) over (partition by a) from a order by a
avg_window <- expr_window(avg_func, partitions = list(expr_reference("b")))
test_that("Window sum with Partition, order, and window boundaries works", {
#     SUM(x) OVER (partition by b ROWS BETWEEN 3 PRECEDING AND CURRENT ROW)
window_proj <- rel_project(rel_a, list(expr_reference("a"), sum_window))
expected_result <- data.frame(a = c(1:8), window_result = c(1, 3, 6, 9, 5, 11, 18, 21))
test_that("Window boundaries boundaries are CaSe INsenSItive", {
test_that("Window avg with a filter expression and partition works", {
#   select a, b, avg(a) FILTER (WHERE x % 2 = 0) over (partition by b)
DBI::dbExecute(con, "CREATE OR REPLACE MACRO mod(a, b) as a % b")
DBI::dbExecute(con, "CREATE OR REPLACE MACRO eq(a, b) as a = b")
mod_function <- expr_function("mod", list(expr_reference("a"), expr_constant(2)))
filters <- list(expr_function("eq", list(zero, mod_function)))
avg_func <- expr_function("avg", args = list(expr_reference("a")), filter_bys = filters)
avg_filter_window <- expr_window(avg_func, partitions = partitions)
expected_result <- data.frame(avg_filter = c(2, 2, 4, 4, 6, 6, 8, 8))
test_that("Window lag function works as expected", {
#   select a, b, lag(a, 1) OVER () order by a
window_lag <- expr_window(lag, offset_expr = expr_constant(1))
proj_window <- rel_project(rel_a, list(expr_reference("a"), window_lag))
expected_result <- data.frame(a = c(1:8), lag = c(NA, 1, 2, 3, 4, 5, 6, 7))
test_that("function name for window is case insensitive", {
test_that("Window lead function works as expected", {
proj_window <- rel_project(rel_a, list(expr_reference("a"), window_lead))
expected_result <- data.frame(a = c(1:8), lead = c(2, 3, 4, 5, 6, 7, 8, NA))
test_that("Window function with string aggregate works", {
#   select j, s, string_agg(s, '|') over (partition by b) from a order by j, s;
window_str_cat <- expr_window(str_agg, partitions = partitions)
proj_window <- rel_project(rel_a, list(expr_reference("r"), window_str_cat))
expected_result <- data.frame(r = c(1:4), str_agg_res = c("hello,Big", "hello,Big", "world,42", "world,42"))
test_that("You can perform window functions on row_number", {
# select a, b, row_number() OVER () from tmp order by a;
proj <- rel_project(rel_a, list(expr_reference("a"), window_function))
expected_result <- data.frame(a = c(1:8), row_number = (8:1))
# also tests order by inside the rank function.
# these tests come from https://dplyr.tidyverse.org/articles/window-functions.html
test_that("You can perform the window function min_rank", {
# select rank() OVER (order by a) from t1
rel_a <- rel_from_df(con, data.frame(a = c(1, 1, 2, 2, 2)))
min_rank_window <- expr_window(rank_func, order_bys = list(expr_reference("a")))
window_proj <- rel_project(rel_a, list(expr_reference("a"), min_rank_window))
expected_result <- data.frame(a = c(1, 1, 2, 2, 2), window_result = c(1, 1, 3, 3, 3))
test_that("You can perform the window function dense_rank", {
# select dense_rank() OVER (order by a) from t1;
min_rank_window <- expr_window(dense_rank_fun, order_bys = list(expr_reference("a")))
expected_result <- data.frame(a = c(1, 1, 2, 2, 2), window_result = c(1, 1, 2, 2, 2))
test_that("You can perform the window function cume_dist", {
# select cume_dist() OVER (order by a) from t1;
cume_dist_window <- expr_window(cume_dist_func, order_bys = list(expr_reference("a")))
window_proj <- rel_project(rel_a, list(expr_reference("a"), cume_dist_window))
test_that("You can perform the window function percent rank", {
# select percent_rank() OVER (order by a) from t1;
rel_a <- rel_from_df(con, data.frame(a = c(5, 1, 3, 2, 2)))
percent_rank_wind <- expr_window(percent_rank_func, order_bys = list(expr_reference("a")))
window_proj <- rel_project(rel_a, list(expr_reference("a"), percent_rank_wind))
test_that("R semantics for adding NaNs is respected", {
test_df_b <- rel_from_df(con, data.frame(c = c(NaN, 6), d = c(3, 8)))
cond <- list(expr_function("eq", list(expr_reference("b"), expr_reference("d"))))
rel_join <- rel_join(test_df_a, test_df_b, cond, "inner")
addition_expression <- expr_function("+", list(expr_reference("a"), expr_reference("c")))
test_that("R semantics for arithmetics sum function are respected", {
test_df_a <- rel_from_df(con, data.frame(a = c(1:5, NA)))
ans <- rel_aggregate(test_df_a, list(), list(sum_rel))
test_that("anti joins for eq_na_matches works", {
dbExecute(con, 'CREATE OR REPLACE MACRO "___eq_na_matches_na"(a, b) AS ((a IS NULL AND b IS NULL) OR (a = b))')
rel1 <- rel_from_df(con, data.frame(x = c(1, 1, 2, 3)))
rel2 <- rel_from_df(con, data.frame(y = c(2, 3, 3, 4)))
cond <- list(expr_function("___eq_na_matches_na", list(expr_reference("x"), expr_reference("y"))))
out <- rel_join(rel1, rel2, cond, "anti")
expect_equal(res, data.frame(x = c(1, 1)))
test_that("semi joins for eq_na_matches works", {
rel1 <- rel_from_df(con, data.frame(x = c(1, 1, 2, 2)))
out <- rel_join(rel1, rel2, cond, "semi")
expect_equal(res, data.frame(x = c(2, 2)))
test_that("rel_project does not automatically quote upper-case column names", {
test_that("rel_to_sql works for row_number", {
invisible(DBI::dbExecute(con, "CREATE MACRO \"==\"(a, b) AS a = b"))
expect_equal(sub_str_sql, "SELECT row_number() OVER () AS ___row_number")
rel <- rel_from_table_function(con, "generate_series", list(1L, 10L, 2L))
expect_equal(df$generate_series, c(1, 3, 5, 7, 9))
test_that("we don't crash with evaluation errors", {
invisible(DBI::dbExecute(con, "CREATE OR REPLACE MACRO \"==\"(x, y) AS x = y"))
# This query is supposed to throw a runtime error.
# If this succeeds, find a new query that throws a runtime error.
expect_error(nrow(ans), "Error evaluating duckdb query")
test_that("Handle zero-length lists (#186)", {
skip_if(getRversion() < "4.2", "Error message formatting differs in R 4.1")
invisible(DBI::dbExecute(con, "CREATE MACRO \"<=\"(a, b) AS a <= b"))
forbid <- rel_to_altrep(rel2, allow_materialization = FALSE)
forbid_nrow <- rel_to_altrep(rel2, n_cells = 0)
five_rows <- rel_to_altrep(rel2, n_rows = 5)
four_rows <- rel_to_altrep(rel2, n_rows = 4)
ten_cells <- rel_to_altrep(rel2, n_cells = 10)
nine_cells <- rel_to_altrep(rel2, n_cells = 9)
ok_both <- rel_to_altrep(rel2, n_rows = 5, n_cells = 10)
bad_rows <- rel_to_altrep(rel2, n_rows = 4, n_cells = 10)
bad_cells <- rel_to_altrep(rel2, n_rows = 5, n_cells = 9)
rel_to_view(rel1, "", "test_view", temporary = TRUE)
expect_equal(dbGetQuery(con, "SELECT * FROM test_view"), df1)
expect_error(dbExecute(con, "DROP VIEW test_view"), NA)
df1 <- data.frame(a = c(TRUE, FALSE, NA))
df2 <- vctrs::new_data_frame(list(a = structure(c(TRUE, FALSE, NA), class = "foo")))
rel <- rel_from_df(con, df2, strict = FALSE)
df2 <- vctrs::new_data_frame(list(a = structure(c(1L, 2L, NA), class = "foo")))
df2 <- vctrs::new_data_frame(list(a = structure(c(1, 2, NA), class = "foo")))
df1 <- vctrs::new_data_frame(list(a = list(1L, 2:3, NULL, 4:6)))
df2 <- vctrs::new_data_frame(list(a = structure(list(1L, 2:3, NULL, 4:6), class = "foo")), n = 4L)
df2 <- vctrs::new_data_frame(list(a = structure(as.Date(c("2020-01-01", "2020-01-02", NA)), class = c("foo", "Date"))))
df1 <- data.frame(a = as.difftime(c(1, 2, NA), units = "secs"))
df2 <- vctrs::new_data_frame(list(a = structure(as.difftime(c(1, 2, NA), units = "secs"), class = c("foo", "difftime"))))
df1 <- data.frame(a = factor(c("a", "b", NA)))
df2 <- data.frame(a = ordered(c("a", "b", NA)))
df1 <- vctrs::new_data_frame(list(a = data.frame(b = 1:3, c = 4:6)))
df2 <- vctrs::new_data_frame(list(a = structure(data.frame(b = 1:3, c = 4:6), class = c("foo", "data.frame"))))
df1 <- data.frame(a = structure(1745781814.84963, class = c("POSIXct", "POSIXt"), tzone = "UTC"))
df2 <- data.frame(a = structure(1745781814.84963, class = c("foo", "POSIXct", "POSIXt")))
df2 <- data.frame(a = structure(1745781814.84963, class = c("foo", "POSIXct", "POSIXt"), tzone = ""))
df2 <- data.frame(a = structure(1745781814.84963, class = c("foo", "POSIXct", "POSIXt"), tzone = "UTC"))
test_that("rel_order() supports descending order", {
test_df <- rel_from_df(con, data.frame(a = c(1:3)))
rel <- rel_order(test_df, orders, ascending = FALSE)
expected_result <- data.frame(a = c(3L, 2L, 1L))
rel <- rel_order(test_df, orders, nulls_first = TRUE)
expected_result <- data.frame(a = c(NA, 1L, 2L, 3L))
test_that("rel_order() nulls_first error checking works", {
expect_error(rel_order(test_df, orders, nulls_first = c(TRUE, FALSE, TRUE)), "length of nulls_first")
test_that("expr_window() supports descending order_bys", {
# rank() OVER (ORDER BY a DESC) should give reverse ranks
rel_a <- rel_from_df(con, data.frame(a = c(1, 2, 3)))
window_proj <- rel_project(rel_a, list(expr_reference("a"), rank_window))
expected_result <- data.frame(a = c(1, 2, 3), rank_desc = c(3L, 2L, 1L))
test_that("expr_window() supports nulls_first in order_bys", {
# rank() OVER (ORDER BY a NULLS FIRST) - NULLs should get rank 1
rel_a <- rel_from_df(con, data.frame(a = c(1, 2, NA)))
# With NULLS FIRST: NULL gets rank 1, 1 gets rank 2, 2 gets rank 3
expected_result <- data.frame(a = c(1, 2, NA), rank_nulls_first = c(2L, 3L, 1L))
test_that("expr_window() ascending/nulls_first error checking works", {