1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
|
#' SQL set operations
#'
#' These are methods for the dplyr generics `dplyr::intersect()`,
#' `dplyr::union()`, and `dplyr::setdiff()`. They are translated to
#' `INTERSECT`, `UNION`, and `EXCEPT` respectively.
#'
#' @inheritParams left_join.tbl_lazy
#' @param ... Not currently used; provided for future extensions.
#' @param all If `TRUE`, includes all matches in output, not just unique rows.
#' @exportS3Method dplyr::intersect
#' @importFrom dplyr intersect
intersect.tbl_lazy <- function(x, y, copy = FALSE, ..., all = FALSE) {
lazy_query <- add_set_op(x, y, "INTERSECT", copy = copy, ..., all = all)
x$lazy_query <- lazy_query
x
}
#' @importFrom dplyr union
#' @exportS3Method dplyr::union
#' @rdname intersect.tbl_lazy
union.tbl_lazy <- function(x, y, copy = FALSE, ..., all = FALSE) {
lazy_query <- add_union(x, y, all = all, copy = copy, ...)
x$lazy_query <- lazy_query
x
}
#' @export
#' @importFrom dplyr union_all
#' @exportS3Method dplyr::union_all
#' @rdname intersect.tbl_lazy
union_all.tbl_lazy <- function(x, y, copy = FALSE, ...) {
lazy_query <- add_union(x, y, all = TRUE, copy = copy, ...)
x$lazy_query <- lazy_query
x
}
#' @importFrom dplyr setdiff
#' @exportS3Method dplyr::setdiff
#' @rdname intersect.tbl_lazy
setdiff.tbl_lazy <- function(x, y, copy = FALSE, ..., all = FALSE) {
lazy_query <- add_set_op(x, y, "EXCEPT", copy = copy, ..., all = all)
x$lazy_query <- lazy_query
x
}
add_union <- function(x, y, all, copy = FALSE, ..., call = caller_env()) {
y <- auto_copy(x, y, copy)
check_set_op_sqlite(x, y, call = call)
# Ensure each has same variables
vars <- union(op_vars(x), op_vars(y))
x_lq <- x$lazy_query
if (inherits(x_lq, "lazy_union_query")) {
tmp <- list(lazy_query = x_lq$x)
class(tmp) <- "tbl_lazy"
x_lq$x <- fill_vars(tmp, vars)$lazy_query
x_lq$unions$table <- purrr::map(x_lq$unions$table, function(table) fill_vars(table, vars))
y <- fill_vars(y, vars)
x_lq$unions$table <- c(x_lq$unions$table, list(y))
x_lq$unions$all <- c(x_lq$unions$all, all)
return(x_lq)
}
x <- fill_vars(x, vars)
unions <- list(
table = list(fill_vars(y, vars)),
all = all
)
lazy_union_query(
x$lazy_query,
unions,
call = call
)
}
add_set_op <- function(x, y, type, copy = FALSE, ..., all = FALSE, call = caller_env()) {
y <- auto_copy(x, y, copy)
check_set_op_sqlite(x, y, call = call)
# Ensure each has same variables
vars <- union(op_vars(x), op_vars(y))
x <- fill_vars(x, vars)
y <- fill_vars(y, vars)
lazy_set_op_query(
x$lazy_query, y$lazy_query,
type = type,
all = all,
call = call
)
}
check_set_op_sqlite <- function(x, y, call) {
if (inherits(x$src$con, "SQLiteConnection")) {
# LIMIT only part the compound-select-statement not the select-core.
#
# https://www.sqlite.org/syntax/compound-select-stmt.html
# https://www.sqlite.org/syntax/select-core.html
if (!is.null(x$lazy_query$limit) || !is.null(y$lazy_query$limit)) {
cli_abort("SQLite does not support set operations on LIMITs", call = call)
}
}
}
fill_vars <- function(x, vars) {
x_vars <- op_vars(x)
if (identical(x_vars, vars)) {
return(x)
}
new_vars <- lapply(set_names(vars), function(var) {
if (var %in% x_vars) {
sym(var)
} else {
NA
}
})
transmute(x, !!!new_vars)
}
|
