/
VERBS-where.R
87 lines (79 loc) · 2.02 KB
/
VERBS-where.R
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
#' Where clause
#'
#' Clause for subsetting rows.
#'
#' @rdname where-table.express
#' @name where-table.express
#' @export
#'
#' @param .data The input data.
#' @template generic-dots
#'
where <- function(.data, ...) {
UseMethod("where")
}
#' @rdname where-table.express
#' @export
#' @importFrom rlang enquo
#' @importFrom rlang is_missing
#' @importFrom rlang quo_get_expr
#'
#' @param which Passed to [data.table::data.table].
#' @param .collapse A boolean function which will be used to "concatenate" all conditions in `...`.
#' @template parse-arg
#' @template chain-arg
#'
#' @details
#'
#' For [ExprBuilder], the expressions in `...` can call [nest_expr()], and are eagerly nested if
#' they do.
#'
#' The [data.table::data.table-class] method is **lazy**, so it expects another verb to follow
#' *afterwards*.
#'
#' @template docu-examples
#'
#' @examples
#'
#' data("mtcars")
#'
#' data.table::as.data.table(mtcars) %>%
#' start_expr %>%
#' where(vs == 0, am == 1)
#'
where.ExprBuilder <- function(.data, ..., which, .collapse = `&`,
.parse = getOption("table.express.parse", FALSE),
.chain = getOption("table.express.chain", TRUE))
{
clause <- parse_dots(.parse, ...)
if (length(clause) == 0L) {
return(.data)
}
clause <- .data$seek_and_nestroy(clause)
first_where <- clause[[1L]]
if (length(clause) == 1L) {
clause <- first_where
}
else {
.collapse <- rlang::quo_get_expr(rlang::enquo(.collapse))
clause <- reduce_expr(clause[-1L], first_where, .collapse, .parse = .parse)
}
.data <- .data$set_i(clause, .chain)
if (!rlang::is_missing(which)) {
frame_append(.data, which = !!which, .parse = FALSE)
}
.data
}
#' @rdname where-table.express
#' @export
#'
#' @examples
#'
#' data.table::as.data.table(mtcars) %>%
#' where(vs == 0) %>%
#' transmute(mpg = round(mpg))
#'
where.data.table <- function(.data, ...) {
eb <- EagerExprBuilder$new(.data)
where.ExprBuilder(eb, ...)
}