#' Table data source.
#'
#' Build structures (table name, column names, and quoting
#' strategy) needed to represent data from a remote table.
#'
#' Generate a query that returns contents of a table, we
#' could try to eliminate this (replace the query with the table name),
#' but there are features one can work with with the query in place and
#' SQL optimizers likely make this zero-cost anyway.
#'
#' @param table_name character, name of table
#' @param columns character, column names of table
#' @return a relop representation of the data
#'
#' @examples
#'
#' my_db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' DBI::dbWriteTable(my_db,
#' 'd',
#' data.frame(AUC = 0.6, R2 = 0.2),
#' overwrite = TRUE,
#' temporary = TRUE)
#' d <- table_source('d',
#' columns = c("AUC", "R2"))
#' print(d)
#' sql <- to_sql(d, my_db)
#' cat(sql)
#' DBI::dbGetQuery(my_db, sql)
#' DBI::dbDisconnect(my_db)
#'
#'
#' @export
#'
table_source <- function(table_name, columns) {
r <- list(source = list(),
table_name = table_name,
parsed = NULL,
columns = columns)
r <- relop_decorate("relop_table_source", r)
r
}
#' List fields from a dbi connection
#'
#' @param my_db DBI connection
#' @param tableName character table name
#' @return character list of column names
#'
#' @noRd
#'
listFields <- function(my_db, tableName) {
# fails intermitnently, and sometimes gives wrong results
# filed as: https://github.com/tidyverse/dplyr/issues/3204
# tryCatch(
# return(DBI::dbListFields(my_db, tableName)),
# error = function(e) { NULL })
# below is going to have issues to to R-column name conversion!
q <- paste0("SELECT * FROM ",
DBI::dbQuoteIdentifier(my_db, tableName),
" LIMIT 1")
v <- DBI::dbGetQuery(my_db, q)
colnames(v)
}
#' DBI data source.
#'
#' Build structures (table name, column names, and quoting
#' strategy) needed to represent data from a remote table.
#'
#' Generate a query that returns contents of a table, we
#' could try to eliminate this (replace the query with the table name),
#' but there are features one can work with with the query in place and
#' SQL optimizers likely make this zero-cost anyway.
#'
#' @param db database connection
#' @param table_name name of table
#' @return a relop representation of the data
#'
#' @examples
#'
#' my_db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' DBI::dbWriteTable(my_db,
#' 'd',
#' data.frame(AUC = 0.6, R2 = 0.2),
#' overwrite = TRUE,
#' temporary = TRUE)
#' d <- dbi_table(my_db, 'd')
#' print(d)
#' sql <- to_sql(d, my_db)
#' cat(sql)
#' DBI::dbGetQuery(my_db, sql)
#' cols <- columns_used(d)
#' print(cols)
#'
#' sql2 <- to_sql(d, my_db, using = "AUC")
#' cat(sql2)
#' DBI::dbGetQuery(my_db, sql2)
#' DBI::dbDisconnect(my_db)
#'
#' @export
#'
dbi_table <- function(db, table_name) {
table_source(table_name = table_name,
columns = listFields(db, table_name))
}
#' @export
column_names.relop_table_source <- function (x, ...) {
if(length(list(...))>0) {
stop("unexpected arguemnts")
}
x$columns
}
columns_used_relop_table_source <- function (x, ...,
using = NULL,
contract = FALSE) {
if(length(list(...))>0) {
stop("columns_used_relop_table_source: unexpected arguemnts")
}
cols <- x$columns
if(length(using)>0) {
missing <- setdiff(using, x$columns)
if(length(missing)>0) {
stop(paste("rquery:columns_used request for unknown columns",
paste(missing, collapse = ", ")))
}
cols <- intersect(cols, using)
}
cols
}
#' @export
columns_used.relop_table_source <- function (x, ...,
using = NULL,
contract = FALSE) {
cols <- columns_used_relop_table_source(x, using = using, contract=contract)
r <- list(cols)
names(r) <- x$table_name
r
}
#' @export
to_sql.relop_table_source <- function (x,
db,
...,
source_limit = NULL,
indent_level = 0,
tnum = mkTempNameGenerator('tsql'),
append_cr = TRUE,
using = NULL) {
if(length(list(...))>0) {
stop("unexpected arguemnts")
}
prefix <- paste(rep(' ', indent_level), collapse = '')
tabnam <- quote_identifier(db, x$table_name)
cols <- columns_used_relop_table_source(x, using = using)
qcols <- vapply(cols,
function(ui) {
quote_identifier(db, ui)
}, character(1))
qcols <- paste(quote_identifier(db, x$table_name), qcols, sep = '.')
qt <- paste(qcols, collapse = paste0(",\n", prefix, " "))
q <- paste0(prefix,
"SELECT\n",
prefix, " ", qt, "\n",
prefix, "FROM\n",
prefix, " ", tabnam)
if(!is.null(source_limit)) {
q <- paste(q, "LIMIT", source_limit)
}
if(append_cr) {
q <- paste0(q, "\n")
}
q
}
#' @export
format.relop_table_source <- function(x, ...) {
if(length(list(...))>0) {
stop("unexpected arguemnts")
}
paste0("table('", x$table_name, "')",
"\n")
}
#' Local table to DBI data source.
#'
#' @param db database connection.
#' @param table_name name of table to create.
#' @param d data.frame to copy to database.
#' @param ... force later argument to be by name
#' @param overwrite passed to \code{\link[DBI]{dbWriteTable}}.
#' @param temporary passed to \code{\link[DBI]{dbWriteTable}}.
#' @param rowidcolumn character, name to land row-ids.
#' @return a relop representation of the data
#'
#' @examples
#'
#' my_db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' d <- dbi_copy_to(my_db, 'd',
#' data.frame(AUC = 0.6, R2 = 0.2))
#' sql <- to_sql(d, my_db)
#' cat(sql)
#' DBI::dbDisconnect(my_db)
#'
#' @export
#'
dbi_copy_to <- function(db, table_name, d,
...,
overwrite = FALSE,
temporary = TRUE,
rowidcolumn = NULL) {
if(length(list(...))>0) {
stop("rquery::dbi_table unexpeced arguments")
}
if(!is.null(rowidcolumn)) {
d[[rowidcolumn]] <- 1:nrow(d)
}
if(overwrite) {
DBI::dbWriteTable(db,
table_name,
d,
overwrite = overwrite,
temporary = temporary)
} else {
# sparklyr does not take overwrite argument
DBI::dbWriteTable(db,
table_name,
d,
temporary = temporary)
}
dbi_table(db, table_name)
}
#' @export
#'
to_pre_sql.relop_table_source <- function (x,
...) {
if(length(list(...))>0) {
stop("rquery::to_pre_sqlt.relop_table_source unexpeced arguments")
}
pre_sql_table(x$table_name, x$columns)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.