Nothing
#' Make a table description directly.
#'
#' Build minimal structures (table name and column names) 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 (non-empty and unique values).
#' @param ... not used, force later argument to bind by name
#' @param qualifiers optional named ordered vector of strings carrying additional db hierarchy terms, such as schema.
#' @param q_table_name optional character, qualified table name, note: has to be re-generated for different DB connections.
#' @param head_sample optional, head_sample of table as an example
#' @param limit_was optional, row limit used to produce head_sample.
#' @return a relop representation of the data
#'
#' @seealso \code{\link{db_td}}, \code{\link{local_td}}
#'
#' @examples
#'
#' if (requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) {
#' my_db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' rq_copy_to(my_db,
#' 'd',
#' data.frame(AUC = 0.6, R2 = 0.2),
#' overwrite = TRUE,
#' temporary = TRUE)
#' d <- mk_td('d',
#' columns = c("AUC", "R2"))
#' print(d)
#' sql <- to_sql(d, my_db)
#' cat(sql)
#' print(DBI::dbGetQuery(my_db, sql))
#' DBI::dbDisconnect(my_db)
#' }
#'
#' @seealso \code{\link{db_td}}, \code{\link{local_td}}, \code{\link{rq_copy_to}}, \code{\link{materialize}}, \code{\link{execute}}, \code{\link{to_sql}}
#'
#' @export
#'
mk_td <- function(table_name, columns,
...,
qualifiers = NULL,
q_table_name = NULL,
head_sample = NULL,
limit_was = NULL) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::mk_td")
if(is.null(table_name)) {
stop("rquery::mk_td called with NULL table_name")
}
if(is.null(q_table_name)) {
q_table_name <- table_name
}
if((length(columns)<=0) || (!is.character(columns))) {
stop("rquery::mk_td columns must be a non-empty character vector")
}
if(length(columns)!=length(unique(columns))) {
stop("rquery::mk_td columns must be unique")
}
if(!is.null(head_sample)) {
diff = setdiff(union(columns, colnames(head_sample)), intersect(columns, colnames(head_sample)))
if(length(diff) > 0) {
stop(paste("wrapr::mk_td columns and colnames(head_sample) disagree", paste(diff, collapse = ', ')))
}
}
r <- list(source = list(),
table_name = table_name,
q_table_name = q_table_name,
parsed = NULL,
columns = columns,
qualifiers = qualifiers,
head_sample = head_sample,
limit_was = limit_was)
r <- relop_decorate("relop_table_source", r)
r
}
#' @describeIn mk_td old name for mk_td
#' @export
table_source <- mk_td
#' Construct a table description from a database source.
#'
#' Build structures (table name, column names, and quoting
#' strategy) needed to represent data from a remote table.
#'
#' Note: in examples we use \code{rq_copy_to()} to create data. This is only for the purpose of having
#' easy portable examples. With big data the data is usually already in the remote database or
#' Spark system. The task is almost always to connect and work with this pre-existing remote data
#' and the method to do this is \code{db_td}
#' which builds a reference to a remote table given the table name.
#'
#'
#' @param db database connection
#' @param table_name name of table
#' @param ... not used, force later argument to bind by name
#' @param qualifiers optional named ordered vector of strings carrying additional db hierarchy terms, such as schema.
#' @param limit_was optional, row limit used to produce head_sample. If NULL no head_sample is produced and rq_colnames is used to get column names.
#' @return a relop representation of the data
#'
#' @seealso \code{\link{mk_td}}, \code{\link{local_td}}, \code{\link{rq_copy_to}}, \code{\link{materialize}}, \code{\link{execute}}, \code{\link{to_sql}}
#'
#' @examples
#'
#' if (requireNamespace("DBI", quietly = TRUE) && requireNamespace("RSQLite", quietly = TRUE)) {
#' my_db <- DBI::dbConnect(RSQLite::SQLite(), ":memory:")
#' rq_copy_to(my_db,
#' 'd',
#' data.frame(AUC = 0.6, R2 = 0.2),
#' overwrite = TRUE,
#' temporary = TRUE)
#' d <- db_td(my_db, 'd')
#' print(d)
#' sql <- to_sql(d, my_db)
#' cat(sql)
#' print(DBI::dbGetQuery(my_db, sql))
#' cols <- columns_used(d)
#' print(cols)
#'
#' sql2 <- to_sql(d, my_db, using = "AUC")
#' cat(sql2)
#' print(DBI::dbGetQuery(my_db, sql2))
#' DBI::dbDisconnect(my_db)
#' }
#'
#' @export
#'
db_td <- function(db, table_name,
...,
qualifiers = NULL,
limit_was = 6L) {
q_table_name <- quote_table_name(db, table_name, qualifiers = qualifiers)
if((length(limit_was) == 1) && getDBOption(db, "rquery_sample_on_db_td", TRUE)) {
head_sample = rq_head(db, table_name, qualifiers = qualifiers)
columns = colnames(head_sample)
} else {
head_sample = NULL
limit_was = NULL
columns = rq_colnames(db, table_name, qualifiers = qualifiers)
}
mk_td(table_name = table_name,
columns = columns,
q_table_name = q_table_name,
qualifiers = qualifiers,
head_sample = head_sample,
limit_was = limit_was)
}
#' @describeIn db_td old name for db_td
#' @export
dbi_table <- db_td
#' Construct a table description of a local data.frame.
#'
#' @param d data.frame or name of data.frame to use as a data source.
#' @param ... not used, force later arguments to be optional.
#' @param name if not null name to user for table.
#' @param name_source temporary name source.
#' @param env environment to work in.
#' @return a relop representation of the data
#'
#' @seealso \code{\link{db_td}}, \code{\link{mk_td}}
#'
#' @examples
#'
#' d <- data.frame(x = 1)
#' local_td(d)
#' local_td("d")
#' local_td(as.name("d"))
#' local_td(data.frame(x = 1))
#' d %.>% local_td # needs wrapr 1.5.0 or newer to capture name
#'
#' @export
#'
local_td <- function(d,
...,
name = NULL,
name_source = wrapr::mk_tmp_name_source("rqltd"),
env = parent.frame()) {
force(env)
UseMethod("local_td")
}
#' @export
local_td.data.frame <- function(d,
...,
name = NULL,
name_source = wrapr::mk_tmp_name_source("rqltd"),
env = parent.frame()) {
force(env)
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::local_td.data.frame")
table_name <- name
if(is.null(table_name)) {
table_name <- substitute(d)
if(is.name(table_name) || is.character(table_name)) {
table_name <- as.character(table_name)
} else {
table_name = name_source()
}
}
d <- as.data.frame(d)
rownames(d) <- NULL
row_limit = 6L
mk_td(table_name = table_name,
columns = colnames(d),
head_sample = utils::head(d, n = row_limit),
limit_was = row_limit)
}
#' @export
local_td.character <- function(d,
...,
name = NULL,
name_source = wrapr::mk_tmp_name_source("rqltd"),
env = parent.frame()) {
force(env)
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::local_td.character")
table_name <- d
d <- get(table_name, envir = env)
if(!is.data.frame(d)) {
stop("rquery::local_td.character: argument d must be a string that resolves to a data.frame")
}
row_limit = 6L
mk_td(table_name = table_name,
columns = colnames(d),
head_sample = utils::head(d, n = row_limit),
limit_was = row_limit)
}
#' @export
local_td.name <- function(d,
...,
name = NULL,
name_source = wrapr::mk_tmp_name_source("rqltd"),
env = parent.frame()) {
force(env)
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::local_td.name")
table_name <- as.character(d)
d <- get(table_name, envir = env)
if(!is.data.frame(d)) {
stop("rquery::local_td.name: argument d must be a name that resolves to a data.frame")
}
row_limit = 6L
mk_td(table_name = table_name,
columns = colnames(d),
head_sample = utils::head(d, n = row_limit),
limit_was = row_limit)
}
#' @export
tables_used.relop_table_source <- function(node, ...) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::tables_used.relop_table_source")
node$table_name
}
#' @export
column_names.relop_table_source <- function (x, ...) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::column_names.relop_table_source")
x$columns
}
columns_used_relop_table_source <- function (x,
...,
using = NULL) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery:::columns_used_relop_table_source")
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) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::columns_used.relop_table_source")
cols <- columns_used_relop_table_source(x, using = using)
r <- list(cols)
names(r) <- x$table_name
r
}
#' @export
to_sql.relop_table_source <- function (x,
db,
...,
limit = NULL,
source_limit = NULL,
indent_level = 0,
tnum = mk_tmp_name_source('tsql'),
append_cr = TRUE,
using = NULL) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::to_sql.relop_table_source")
dispatch_to_sql_method(
method_name = "to_sql.relop_table_source",
x = x,
db = db,
limit = limit,
source_limit = source_limit,
indent_level = indent_level,
tnum = tnum,
append_cr = append_cr,
using = using)
}
to_sql_relop_table_source <- function(
x,
db,
...,
limit = NULL,
source_limit = NULL,
indent_level = 0,
tnum = mk_tmp_name_source('tsql'),
append_cr = TRUE,
using = NULL) {
wrapr::stop_if_dot_args(substitute(list(...)),
"rquery::to_sql.relop_table_source")
prefix <- paste(rep(' ', indent_level), collapse = '')
tabnam <- quote_table_name(db, x$table_name, qualifiers = x$qualifiers)
cols <- columns_used_relop_table_source(x, using = using)
qcols <- vapply(cols,
function(ui) {
quote_identifier(db, ui)
}, character(1))
qt <- paste(qcols, collapse = paste0(",\n", prefix, " "))
q <- paste0(prefix,
"SELECT\n",
prefix, " ", qt, "\n",
prefix, "FROM\n",
prefix, " ", tabnam)
if((!is.null(limit))||(!is.null(source_limit))) {
limit <- min(limit, source_limit)
q <- paste(q, "LIMIT",
format(ceiling(limit), scientific = FALSE))
}
if(append_cr) {
q <- paste0(q, "\n")
}
q
}
#' @export
format_node.relop_table_source <- function(node) {
max_cols <- 20
cols <- paste0('"', node$columns, '"')
if(length(cols)>max_cols) {
cols <- c(cols[seq_len(max_cols)], "...")
}
paste0("mk_td(\"", node$table_name, "\", c(\n ",
paste(cols, collapse = ",\n "),
"))\n")
}
#' @export
print.relop <- function(x, ...) {
txt <- format(x)
txt <- trimws(gsub("[ \t\r\n]+", " ", txt), which = "both")
print(txt, ...)
if(!is.null(x$head_sample)) {
print(x$head_sample)
if(nrow(x$head_sample) >= x$limit_was) {
cat(" ...")
}
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.