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
|
sql_quantile <- function(f,
style = c("infix", "ordered"),
window = FALSE) {
force(f)
style <- match.arg(style)
force(window)
function(x, probs, na.rm = FALSE) {
check_probs(probs)
check_na_rm(na.rm)
sql <- switch(style,
infix = sql_call2(f, x, probs),
ordered = build_sql(
sql_call2(f, probs), " WITHIN GROUP (ORDER BY ", x, ")"
)
)
if (window) {
sql <- win_over(sql,
partition = win_current_group(),
frame = win_current_frame()
)
}
sql
}
}
sql_median <- function(f,
style = c("infix", "ordered"),
window = FALSE) {
quantile <- sql_quantile(f, style = style, window = window)
function(x, na.rm = FALSE) {
quantile(x, 0.5, na.rm = na.rm)
}
}
check_probs <- function(probs) {
if (!is.numeric(probs)) {
cli_abort("{.arg probs} must be numeric")
}
if (length(probs) > 1) {
cli_abort("SQL translation only supports single value for {.arg probs}.")
}
}
|
