Skip to content
Permalink
main
Switch branches/tags
Go to file
 
 
Cannot retrieve contributors at this time
#' 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"))