Skip to content

Commit 280ca1a

Browse files
krlmlrkrlmlr
committed
SNAPSHPOT
1 parent 1f2d4b1 commit 280ca1a

File tree

7 files changed

+141
-53
lines changed

7 files changed

+141
-53
lines changed

‎R/as_duckplyr_tibble.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
#' as_duckplyr_tibble
22
#'
33
#' `as_duckplyr_tibble()` converts the input to a tibble and then to a duckplyr data frame.
4+
#' This function also accepts \pkg{dbplyr} lazy tables.
45
#'
56
#' @return For `as_duckplyr_tibble()`, an object of class
67
#' `c("duckplyr_df", class(tibble()))` .

‎R/compute.R‎

Lines changed: 35 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,43 @@
11
# Generated by 02-duckplyr_df-methods.R
22
#' @export
3-
compute.duckplyr_df <- function(x, ...) {
3+
compute.duckplyr_df <- function(x, ..., name = NULL, temporary = TRUE) {
4+
if (is.null(name)) {
5+
if (!isTRUE(temporary)) {
6+
cli::cli_abort("{.arg name} must be provided if {.arg temporary} is {.val {FALSE}}.")
7+
}
8+
name <- unique_table_name()
9+
}
10+
stopifnot(!is.null(name) || !isTRUE(temporary))
11+
12+
con <- get_default_duckdb_connection()
13+
quoted <- DBI::dbQuoteIdentifier(con, name)
14+
unquoted <- DBI::dbUnquoteIdentifier(con, quoted)[[1]]
15+
if (length(unquoted) == 1) {
16+
schema <- ""
17+
table <- unquoted@name[[1]]
18+
} else if (length(unquoted) == 2) {
19+
schema <- unquoted@name[[1]]
20+
table <- unquoted@name[[2]]
21+
} else {
22+
cli::cli_abort('{.arg name} must be either a string or of the form {.code SQL("schema.table")}')
23+
}
24+
425
# Our implementation
526
rel_try(NULL,
6-
"No relational implementation for compute()" = TRUE,
727
{
28+
browser()
29+
sql <- paste0(
30+
"CREATE ",
31+
if (isTRUE(temporary)) "TEMPORARY ",
32+
"TABLE ",
33+
quoted,
34+
" AS FROM _"
35+
)
36+
rel <- duckdb_rel_from_df(x)
37+
duckdb$rel_sql(rel, sql)
38+
out_rel <- duckdb$rel_from_table(con, table_name = table, schema_name = schema)
39+
out <- rel_to_df(out_rel)
40+
out <- dplyr_reconstruct(out, x)
841
return(out)
942
}
1043
)

‎R/handle_desc.R‎

Lines changed: 31 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,23 +1,43 @@
11
# Used in arrange()
2+
# Handles calls to 'desc' function by
3+
# - extracting the sort order
4+
# - removing any desc-function calls from the expressions: desc(colname) -> colname
25
handle_desc <- function(dots) {
3-
# Handles calls to 'desc' function by
4-
# - extracting the sort order
5-
# - removing any desc-function calls from the expressions: desc(colname) -> colname
66
ascending <- rep(TRUE, length(dots))
77

88
for (i in seq_along(dots)) {
99
expr <- quo_get_expr(dots[[i]])
10+
env <- quo_get_env(dots[[i]])
1011

11-
if (!is.call(expr)) next
12-
if (expr[[1]] != "desc") next
12+
if (is_desc(expr, env)) {
13+
ascending[[i]] <- FALSE
14+
dots[[i]] <- new_quosure(expr[[2]], env = env)
15+
}
16+
}
1317

14-
# Check that desc is called with a single argument
15-
# (dplyr::desc() accepts only one argument)
16-
if (length(expr) > 2) cli::cli_abort("`desc()` must be called with exactly one argument.")
18+
list(dots = dots, ascending = ascending)
19+
}
1720

18-
ascending[i] <- FALSE
19-
dots[[i]] <- new_quosure(expr[[2]], env = quo_get_env(dots[[i]]))
21+
is_desc <- function(expr, env) {
22+
if (!is.call(expr)) {
23+
return(FALSE)
2024
}
2125

22-
list(dots = dots, ascending = ascending)
26+
if (expr[[1]] == "desc") {
27+
if (!identical(eval(expr[[1]], env), dplyr::desc)) {
28+
return(FALSE)
29+
}
30+
} else if (expr[[1]] == "::") {
31+
if (expr[[2]] != "dplyr" && expr[[2]] != "duckplyr") {
32+
return(FALSE)
33+
}
34+
} else {
35+
return(FALSE)
36+
}
37+
38+
if (length(expr) > 2) {
39+
cli::cli_abort("{.fun desc} must be called with exactly one argument.")
40+
}
41+
42+
TRUE
2343
}

‎R/mutate.R‎

Lines changed: 11 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -12,7 +12,9 @@ mutate.duckplyr_df <- function(.data, ..., .by = NULL, .keep = c("all", "used",
1212
{
1313
rel <- duckdb_rel_from_df(.data)
1414

15-
if (length(by_names) > 0) {
15+
need_oo <- (length(by_names) > 0)
16+
17+
if (need_oo) {
1618
rel <- oo_prep(rel)
1719
}
1820

@@ -31,9 +33,15 @@ mutate.duckplyr_df <- function(.data, ..., .by = NULL, .keep = c("all", "used",
3133

3234
names_new <- c(names_new, new)
3335

36+
new_expr <- rel_translate(dot, names_data = names_out, alias = new, partition = by_names, need_window = TRUE)
37+
if (isTRUE(attr(new_expr, "reorder")) && !need_oo) {
38+
rel <- oo_prep(rel)
39+
need_oo <- TRUE
40+
names_out <- rel_names(rel)
41+
}
42+
3443
new_pos <- match(new, names_out, nomatch = length(names_out) + 1L)
3544
exprs <- imap(set_names(names_out), relexpr_reference, rel = NULL)
36-
new_expr <- rel_translate(dot, names_data = names_out, alias = new, partition = by_names, need_window = TRUE)
3745
exprs[[new_pos]] <- new_expr
3846

3947
rel <- rel_project(rel, unname(exprs))
@@ -43,7 +51,7 @@ mutate.duckplyr_df <- function(.data, ..., .by = NULL, .keep = c("all", "used",
4351
names_used <- c(names_used, setdiff(new_names_used, names_used))
4452
}
4553

46-
if (length(by_names) > 0) {
54+
if (need_oo) {
4755
rel <- oo_restore(rel)
4856
}
4957

‎R/relational-expr.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -101,6 +101,7 @@ relexpr_window <- function(
101101
stopifnot(is.null(offset_expr) || inherits(offset_expr, "relational_relexpr"))
102102
stopifnot(is.null(default_expr) || inherits(default_expr, "relational_relexpr"))
103103
stopifnot(is.null(alias) || is_string(alias))
104+
104105
new_relexpr(
105106
list(
106107
expr = expr,

‎R/translate.R‎

Lines changed: 56 additions & 37 deletions
Original file line numberDiff line numberDiff line change
@@ -217,27 +217,9 @@ rel_translate_lang <- function(
217217
}
218218
)
219219

220-
aliases <- c(
221-
sd = "stddev",
222-
first = "first_value",
223-
last = "last_value",
224-
nth = "nth_value",
225-
"/" = "___divide",
226-
"log10" = "___log10",
227-
"log" = "___log",
228-
"as.integer" = "r_base::as.integer",
229-
"<" = "r_base::<",
230-
"<=" = "r_base::<=",
231-
">" = "r_base::>",
232-
">=" = "r_base::>=",
233-
"==" = "r_base::==",
234-
"!=" = "r_base::!=",
235-
NULL
236-
)
237-
238220
known_window <- c(
239221
# Window functions
240-
"rank", "dense_rank", "percent_rank",
222+
"min_rank", "dense_rank", "percent_rank",
241223
"row_number", "first", "last", "nth",
242224
"cume_dist", "lead", "lag", "ntile",
243225

@@ -249,14 +231,6 @@ rel_translate_lang <- function(
249231

250232
window <- need_window && (name %in% known_window)
251233

252-
if (name %in% names(aliases)) {
253-
name <- aliases[[name]]
254-
if (grepl("^r_base::", name)) {
255-
meta_ext_register()
256-
}
257-
}
258-
# name <- aliases[name] %|% name
259-
260234
order_bys <- list()
261235
offset_expr <- NULL
262236
default_expr <- NULL
@@ -276,6 +250,15 @@ rel_translate_lang <- function(
276250
order_bys <- list(do_translate(expr$order_by, in_window = TRUE))
277251
expr$order_by <- NULL
278252
}
253+
} else if (name %in% c("row_number", "min_rank", "dense_rank")) {
254+
if (name == "row_number" && length(expr) == 1) {
255+
# Fallthrough
256+
} else if (length(expr) == 2 && is.name(expr[[2]])) {
257+
order_bys <- list(do_translate(expr[[2]], in_window = TRUE))
258+
expr <- list(expr[[1]])
259+
} else {
260+
cli::cli_abort("{.fun {name}} can only be translated if it uses column names as arguments")
261+
}
279262
}
280263

281264
args <- map(as.list(expr[-1]), do_translate, in_window = in_window || window)
@@ -286,6 +269,33 @@ rel_translate_lang <- function(
286269
}
287270
}
288271

272+
# Aliasing comes last:
273+
aliases <- c(
274+
sd = "stddev",
275+
first = "first_value",
276+
last = "last_value",
277+
nth = "nth_value",
278+
min_rank = "rank",
279+
"/" = "___divide",
280+
log10 = "___log10",
281+
log = "___log",
282+
as.integer = "r_base::as.integer",
283+
"<" = "r_base::<",
284+
"<=" = "r_base::<=",
285+
">" = "r_base::>",
286+
">=" = "r_base::>=",
287+
"==" = "r_base::==",
288+
"!=" = "r_base::!=",
289+
NULL
290+
)
291+
292+
if (name %in% names(aliases)) {
293+
name <- aliases[[name]]
294+
if (grepl("^r_base::", name)) {
295+
meta_ext_register()
296+
}
297+
}
298+
289299
fun <- relexpr_function(name, args)
290300
if (window) {
291301
partitions <- map(partition, relexpr_reference)
@@ -321,6 +331,7 @@ rel_translate <- function(
321331
}
322332

323333
used <- character()
334+
reorder <- FALSE
324335

325336
do_translate <- function(expr, in_window = FALSE, top_level = FALSE) {
326337
stopifnot(!is_quosure(expr))
@@ -347,15 +358,23 @@ rel_translate <- function(
347358
}
348359
},
349360
#
350-
language = rel_translate_lang(
351-
expr,
352-
do_translate,
353-
names_data,
354-
env,
355-
partition,
356-
in_window,
357-
need_window
358-
),
361+
language = {
362+
lang <- rel_translate_lang(
363+
expr,
364+
do_translate,
365+
names_data,
366+
env,
367+
partition,
368+
in_window,
369+
need_window
370+
)
371+
372+
if (inherits(lang, "relational_relexpr_window") && length(lang$order_bys) > 0) {
373+
used <<- unique(c(used, map_chr(lang$order_bys, ~ .x$name)))
374+
reorder <<- TRUE
375+
}
376+
lang
377+
},
359378
#
360379
cli::cli_abort("Internal: Unknown type {.val {typeof(expr)}}")
361380
)
@@ -367,5 +386,5 @@ rel_translate <- function(
367386
out <- relexpr_set_alias(out, alias)
368387
}
369388

370-
structure(out, used = used)
389+
structure(out, used = used, reorder = reorder)
371390
}

‎R/unique_table_name.R‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
# From dbplyr
2+
unique_table_name <- function(prefix = "") {
3+
vals <- c(letters, LETTERS, 0:9)
4+
name <- paste0(sample(vals, 10, replace = TRUE), collapse = "")
5+
paste0(prefix, "duckplyr_", name)
6+
}

0 commit comments

Comments
 (0)