Permalink
Cannot retrieve contributors at this time
193 lines (170 sloc)
5.68 KB
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#' Backend: SQLite | |
#' | |
#' @description | |
#' See `vignette("translation-function")` and `vignette("translation-verb")` for | |
#' details of overall translation technology. Key differences for this backend | |
#' are: | |
#' | |
#' * Uses non-standard `LOG()` function | |
#' * Date-time extraction functions from lubridate | |
#' * Custom median translation | |
#' * Right and full joins are simulated using left joins | |
#' | |
#' Use `simulate_sqlite()` with `lazy_frame()` to see simulated SQL without | |
#' converting to live access database. | |
#' | |
#' @name backend-sqlite | |
#' @aliases NULL | |
#' @examples | |
#' library(dplyr, warn.conflicts = FALSE) | |
#' | |
#' lf <- lazy_frame(a = TRUE, b = 1, c = 2, d = "z", con = simulate_sqlite()) | |
#' lf %>% transmute(x = paste(c, " times")) | |
#' lf %>% transmute(x = log(b), y = log(b, base = 2)) | |
NULL | |
#' @export | |
#' @rdname backend-sqlite | |
simulate_sqlite <- function() simulate_dbi("SQLiteConnection") | |
#' @export | |
dbplyr_edition.SQLiteConnection <- function(con) { | |
2L | |
} | |
#' @export | |
db_connection_describe.SQLiteConnection <- function(con) { | |
paste0("sqlite ", sqlite_version(), " [", con@dbname, "]") | |
} | |
#' @export | |
sql_query_explain.SQLiteConnection <- function(con, sql, ...) { | |
build_sql("EXPLAIN QUERY PLAN ", sql, con = con) | |
} | |
#' @export | |
sql_query_set_op.SQLiteConnection <- sql_query_set_op.Hive | |
#' @export | |
sql_query_upsert.SQLiteConnection <- sql_query_upsert.PqConnection | |
sqlite_version <- function() { | |
numeric_version(RSQLite::rsqliteVersion()[[2]]) | |
} | |
# SQL methods ------------------------------------------------------------- | |
#' @export | |
sql_translation.SQLiteConnection <- function(con) { | |
sql_variant( | |
sql_translator(.parent = base_scalar, | |
as.numeric = sql_cast("REAL"), | |
as.double = sql_cast("REAL"), | |
log = function(x, base = exp(1)) { | |
if (base != exp(1)) { | |
sql_expr(log(!!x) / log(!!base)) | |
} else { | |
sql_expr(log(!!x)) | |
} | |
}, | |
paste = sql_paste_infix(" ", "||", function(x) sql_expr(cast(!!x %as% text))), | |
paste0 = sql_paste_infix("", "||", function(x) sql_expr(cast(!!x %as% text))), | |
# https://www.sqlite.org/lang_corefunc.html#maxoreunc | |
pmin = sql_aggregate_n("MIN", "pmin"), | |
pmax = sql_aggregate_n("MAX", "pmax"), | |
# lubridate, | |
today = function() { | |
date <- function(x) {} # suppress R CMD check note | |
sql_expr(date("now")) | |
}, | |
now = function() sql_expr(datetime("now")), | |
# https://modern-sql.com/feature/extract#proprietary-strftime | |
year = function(x) sql_expr(cast(strftime("%Y", !!x) %as% NUMERIC)), | |
month = function(x) sql_expr(cast(strftime("%m", !!x) %as% NUMERIC)), | |
mday = function(x) sql_expr(cast(strftime("%d", !!x) %as% NUMERIC)), | |
day = function(x) sql_expr(cast(strftime("%d", !!x) %as% NUMERIC)), | |
hour = function(x) sql_expr(cast(strftime("%H", !!x) %as% NUMERIC)), | |
minute = function(x) sql_expr(cast(strftime("%M", !!x) %as% NUMERIC)), | |
second = function(x) sql_expr(cast(strftime("%f", !!x) %as% REAL)), | |
yday = function(x) sql_expr(cast(strftime("%j", !!x) %as% NUMERIC)), | |
), | |
sql_translator(.parent = base_agg, | |
sd = sql_aggregate("STDEV", "sd"), | |
median = sql_aggregate("MEDIAN"), | |
), | |
if (sqlite_version() >= "3.25") { | |
sql_translator(.parent = base_win, | |
sd = win_aggregate("STDEV"), | |
median = win_absent("median") | |
) | |
} else { | |
base_no_win # nocov | |
} | |
) | |
} | |
#' @export | |
sql_escape_logical.SQLiteConnection <- function(con, x){ | |
y <- as.character(as.integer(x)) | |
y[is.na(x)] <- "NULL" | |
y | |
} | |
#' @export | |
sql_query_wrap.SQLiteConnection <- function(con, from, name = NULL, ..., lvl = 0) { | |
if (is.ident(from)) { | |
setNames(from, name) | |
} else { | |
if (is.null(name)) { | |
build_sql(sql_indent_subquery(from, con, lvl), con = con) | |
} else { | |
build_sql(sql_indent_subquery(from, con, lvl), " AS ", as_subquery_name(name), con = con) | |
} | |
} | |
} | |
#' @export | |
sql_expr_matches.SQLiteConnection <- function(con, x, y) { | |
# https://sqlite.org/lang_expr.html#isisnot | |
build_sql(x, " IS ", y, con = con) | |
} | |
#' @export | |
sql_query_join.SQLiteConnection <- function(con, x, y, vars, type = "inner", by = NULL, na_matches = FALSE, ..., lvl = 0) { | |
# workaround as SQLite doesn't support FULL OUTER JOIN and RIGHT JOIN | |
# see: https://www.sqlite.org/omitted.html | |
if (type %in% c("left", "inner", "semi", "cross")) { | |
return(NextMethod()) | |
} | |
# as `x` and `y` the vars also need to be swapped in vars and by | |
vars_right <- list( | |
alias = vars$alias, | |
x = vars$y, | |
y = vars$x, | |
all_x = vars$all_y, | |
all_y = vars$all_x | |
) | |
by_right <- list( | |
x = by$y, | |
y = by$x, | |
x_as = by$y_as, | |
y_as = by$x_as | |
) | |
if (type == "full") { | |
x_join <- sql_query_join(con, x, y, vars, type = "left", by = by, na_matches = na_matches, ..., lvl = lvl + 1) | |
y_join <- sql_query_join(con, y, x, vars_right, type = "left", by = by_right, na_matches = na_matches, ..., lvl = lvl + 1) | |
join_sql <- sql_query_set_op( | |
con, | |
x = x_join, | |
y = y_join, | |
method = "UNION", | |
lvl = lvl + 1 | |
) | |
sql_query_select( | |
con, | |
select = ident(vars$alias), | |
from = dbplyr_sql_subquery(con, join_sql, lvl = lvl), | |
subquery = TRUE, | |
lvl = lvl | |
) | |
} else if (type == "right") { | |
sql_query_join(con, y, x, vars_right, type = "left", by = by_right, na_matches = na_matches, ..., lvl = lvl) | |
} | |
} | |
#' @export | |
values_prepare.SQLiteConnection <- function(con, df) { | |
needs_escape <- purrr::map_lgl(df, ~ is(.x, "Date") || inherits(.x, "POSIXct")) | |
purrr::modify_if(df, needs_escape, ~ escape(.x, con = con, parens = FALSE, collapse = NULL)) | |
} | |
#' @export | |
supports_window_clause.SQLiteConnection <- function(con) { | |
TRUE | |
} | |
globalVariables(c("datetime", "NUMERIC", "REAL")) |