Description Usage Arguments Source code Unit Tests References Examples
select is a wrapper for the sql select query and is used to retrieve records from a dbframe object. generate.select.sql assembles a valid sql select statement from its arguments. The arguments map to clauses in the sql select statement, so you may need to consult an introduction to sql to best use these functions.
1 2 3 4 |
x |
A dbframe object that references the table of interest. |
table |
A character object containing the name of the sql table to query. |
cols |
A character vector containing the column names (or functions of the column names) to retrieve from the database. |
where |
A character object that contains conditions to use to filter the records. |
group.by |
A character vector that defines groups of records to combine with an aggregate function. |
having |
A character object that filters the groups defined by “group.by”. |
order.by |
A character vector that lists the columns to be used for sorting the results. |
limit |
A character vector or number that limits and offsets the sql query results. |
... |
Additional arguments to pass to dbGetQuery. |
as.data.frame |
Logical; if TRUE, execute the query and return the results as a data frame. If FALSE, return a dbframe that has the sql statement for the query as its “table” |
The inidividual methods do some minor parsing, but most of the work is done by generate.select.sql.
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 47 48 49 50 51 | <<*>>=
generate.select.sql <- function(table, cols = "*", where = NULL,
group.by = NULL, having = NULL, order.by = NULL, limit = NULL, ...) {
<<Format the "select" part of the statement>>
<<Format the "group by" part of the statement>>
<<Format the "order by" part of the statement>>
<<Format the "having" part of the statement>>
<<Format the "where" part of the statement>>
<<Format the "limit" part of the statement>>
return(paste("select", cols, "from", table, where,
group.by, having, order.by, limit))
}
setGeneric("select", function(x, cols, as.data.frame = TRUE,...)
standardGeneric("select"))
setMethod("select", signature = c("ANY", "missing"),
function(x, cols, as.data.frame = TRUE,...) {
<<Execute select for c("ANY", "missing")>>})
setMethod("select", signature = c("dbframe", "character"),
function(x, cols, as.data.frame = TRUE,...) {
<<Execute select for c("dbframe", "character")>>})
setMethod("select", signature = c("data.frame", "character"),
function(x, cols, as.data.frame = TRUE,...) {
<<Handle arguments and set up the local environment>>
<<Export the new data frame to a temporary SQLite database>>
<<Query the new database and close database connection>>
return(queryresults)
})
setMethod("select", signature = c("list", "character"),
function(x, cols,...) {
<<Detect inappropriate uses of the "list" method>>
<<Define and attach to "main" db>>
<<Extract the arguments that describe the join>>
<<Execute the query and return its results>>
})
## setMethod("select", signature = c("dbframe", "list"),
## function(x, cols,...) {
## <Handle lists of a single query element>>
## <Manage arguments for compound queries>>
## <Construct individual SQL select statements for compound queries>>
## <Execute query and return data>>
## })
<<Define additional useful functions>>
|
Unfortunately, this method doesn't yet allow for joins or compound queries involving data.frames. Maybe a better approach would be to always let the “main” database be a temporary one on disk.
To write the "select" part, we add the group.by variables and the cols variables together (and store them in cols).
1 2 3 4 5 |
To save typing, I assume that we want to retrieve the grouping variables and so we don't have to specify them explicitly in the cols vector. I think it makes sense to have the grouping variables on the left side of the results set instead of the right side. The next code chunk does both of those.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 | <<Add new group.by variables in front of cols variables>>=
cols <-
if (is.null(cols)) {
group.by
} else if (is.null(group.by)) {
cols
} else {
if (is.null(names(cols)))
names(cols) <- rep("", length(cols))
if (is.null(names(group.by)))
names(group.by) <- rep("", length(group.by))
c(group.by[!(names(group.by) %in% names(cols))
| nchar(names(group.by)) == 0], cols)
}
|
Managing the other arguments is easy. If they're NULL we replace the variable with an empty string; if they're not, we add the appropriate label and replace the variable with a character object that contains a clause for the sql statement.
1 2 3 4 5 6 7 |
1 2 3 4 5 6 7 |
1 2 3 4 5 6 7 |
1 2 3 4 5 6 7 |
1 2 3 4 5 6 7 |
The individual methods just call generate.select.sql and execute the select statement. If cols is "missing" it returns results for cols equal to "*" (i.e. all of the columns of the table).
1 2 |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 | <<Execute select for c("dbframe", "character")>>=
if (!is.linked(x)) {
warning("Table does not exist in the data base")
return(list())
}
arguments <- list(table = tablename(x), cols = cols,...)
sql.statement <- do.call("generate.select.sql", arguments)
if (as.data.frame) {
dbc <- dbConnect(x)
d <- do.call("dbGetQuery", c(conn = dbc, statement = sql.statement,
arguments))
dbDisconnect(dbc)
} else {
if (is.null(arguments$readonly)) {
readonly <- readonly(x)
} else {
readonly <- arguments$readonly
arguments$readonly <- NULL
}
d <- do.call("new", c(Class = "dbframe", table = sql.statement,
readonly = readonly, dbConnect.arguments = arguments))
}
return(d)
|
1 2 3 4 5 6 | <<Handle arguments and set up the local environment>>=
if (!as.data.frame)
warning("'as.data.frame' ignored when selecte is called on a data.frame.")
tablename <- "dataframe"
require(RSQLite)
require(RSQLite.extfuns)
|
1 2 3 |
1 2 3 4 | <<Query the new database and close database connection>>=
sql.statement <- generate.select.sql(tablename, cols,...)
queryresults <- dbGetQuery(dbc, sql.statement)
dbDisconnect(dbc)
|
So far, I'm only supporting joins for dbframes that are linked to sqlite data bases and for data.frames.
1 2 3 4 5 6 7 8 9 10 | <<Detect inappropriate uses of the "list" method>>=
if (length(x) == 1) return(select(x[[1]], cols,...))
if (is.null(names(x))) names(x) <- LETTERS[seq_along(x)]
tableclasses <- sapply(x, class)
if (!all(tableclasses %in% c("dbframe_sqlite", "data.frame")))
stop("Some of your dbframes aren't supported yet")
if (any(tableclasses == "data.frame")) {
require(RSQLite)
require(RSQLite.extfuns)
}
|
One nice feature of this function is that it handles all of the “attach” commands that are necessary to merge tables that exist in different databases. If all of the dbframes link to the same database, then that one will obviously be the main database; otherwise we connect to a temporary sqlite database and attach everything there.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 | <<Define and attach to "main" db>>=
dbnames <- tablenames <- rep(NA, length(x))
for (s in seq_along(x)) {
if (tableclasses[s] == "dbframe_sqlite") {
dbnames[s] <- dbname(x[[s]])
tablenames[s] <- tablename(x[[s]])
} else {
dbnames[s] <- "temp"
tablenames[s] <- names(x)[[s]]
}
}
not.data.frames <- which(tableclasses != "data.frame")
dbalias <- dbnames
if (isTRUE(sum(!duplicated(dbnames[not.data.frames])) == 1)) {
maindbc <- dbConnect(x[[not.data.frames[1]]])
dbnames[not.data.frames] <- "main"
dbalias[not.data.frames] <- "main"
} else {
maindbc <- dbConnect("SQLite", dbname = ":memory:")
<<Attach sqlite_dbframes to the main db>>
}
<<Write dataframes to the main db>>
|
Any data frames are just going to be written to the temporary database.
1 2 3 4 |
Tables that already exist in other databases are attached to the temporary database.
1 2 3 4 5 6 7 8 9 10 | <<Attach sqlite_dbframes to the main db>>=
dbcount <- 0
unique.databases <- unique(dbnames[!(dbnames %in% c("temp", "main"))])
for (db in unique.databases) {
dbcount <- dbcount + 1
currentalias <- sprintf("ALIAS%d", dbcount)
dbalias[dbalias == db] <- currentalias
r <- dbSendQuery(maindbc, sprintf("attach database '%s' as %s", db, currentalias))
dbClearResult(r)
}
|
The columns are already specified for the query; the only thing to do is assemble the sql code for the "table" part. If the join type is not specified, the default is to do an inner join; there is no default for “on” or “using”, so one (and only one) of those arguments must be specified.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 | <<Extract the arguments that describe the join>>=
arguments <- list(...)
join <- extract.element("join", "inner", length(x) - 1, arguments)
on <- extract.element("on", NA, length(x) - 1, arguments)
using <- extract.element("using", NA, length(x) - 1, arguments)
if (any(is.na(on) & is.na(using)))
stop("'on' and 'using' can't both be specified for the same join.")
arguments$join <- NULL
arguments$on <- NULL
arguments$using <- NULL
arguments$cols <- cols
arguments$table <- paste(collapse = " ", c(
sprintf("%s.%s %s", dbalias[1], tablenames[1], names(x)[1]),
sprintf("%s join %s.%s %s %s", join, dbalias[-1], tablenames[-1],
names(x)[-1],
ifelse(is.na(on), ifelse(is.na(using), "",
sprintf("using(%s)", using)), sprintf("on %s", on)))))
|
Actually executing the query is the same as for the other methods. We're not going to worry about detaching the tables explicitly, since we know that they were only attached if we're using a temporary data base.
1 2 3 4 | <<Execute the query and return its results>>=
results <- dbGetQuery(maindbc, do.call(generate.select.sql, arguments))
dbDisconnect(maindbc)
return(results)
|
1 2 3 4 5 6 7 | <<Define additional useful functions>>=
extract.element <- function(name, default, length.required, argument.list) {
v <- if (name %in% names(argument.list)) argument.list[[name]] else default
if (is.na(length.required) | length(v) == length.required) return(v)
else if (length(v) == 1) return(rep(v, length.required))
else stop("Incorrect length of argument")
}
|
I just have some basic sanity-check type unit tests; i.e. do the functions run at a minimal level.
1 2 3 4 5 6 7 8 9 10 | <<test-select.R>>=
library(testthat)
data(chickwts)
chickwts$feed <- as.character(chickwts$feed)
test_that("insert and select work", {
<<Individual tests that insert and select work>>})
test_that("column renaming scheme works", {
<<Individual tests that column renaming works>>})
test_that("joins work", {
<<Individual tests that joins work>>})
|
First we'll check that the methods defined on data frames work, then that they work for dbframes.
1 2 3 4 5 6 |
1 2 3 4 5 6 7 8 9 10 11 12 | <<Individual tests that column renaming works>>=
expect_that(
c("feed", "AverageWeight"),
is_identical_to(names(select(chickwts,
c(AverageWeight = "avg(weight)"), group.by = "feed"))))
<<Create temporary test database and dbframe>>
insert(testdbframe) <- chickwts
expect_that(
c("feed", "AverageWeight"),
is_identical_to(names(select(testdbframe,
c(AverageWeight = "avg(weight)"), group.by = "feed"))))
<<Remove temporary test database>>
|
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 | <<Individual tests that joins work>>=
<<Create temporary test database and dbframe>>
expect_that(select(list(A = chickwts,B = chickwts),
c("feed", weightA = "A.weight", weightB = "B.weight"),
using = "feed", order.by = c("feed", "weightA", "weightB")),
equals({
d <- merge(chickwts, chickwts, by = "feed",
suffixes = c("A", "B"))
d$feed <- as.character(d$feed)
d[do.call(order, d),]
}, check.attributes = FALSE))
avgwts <- dbframe("select2", dbname = testdbfile, clear = TRUE,
data = select(chickwts, c(averageweight = "avg(weight)"),
group.by = c(thefeed = "feed")))
expect_that(select(list(a = chickwts, b = avgwts),
c("feed", "weight", "averageweight"),
on = ("feed = thefeed"), order.by = "feed, weight"),
equals({
d <- merge(chickwts, select(avgwts), by.x = "feed",
by.y = "thefeed")
d$feed <- as.character(d$feed)
d[do.call(order, d),]
}, check.attributes = FALSE))
<<Remove temporary test database>>
|
1 2 3 4 |
1 2 | <<Remove temporary test database>>=
unlink(testdbfile)
|
sql as understood by sqlite. http://www.sqlite.org/lang_select.html
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 | filename <- tempfile(fileext = ".db")
data(chickwts)
chicksdb <- dbframe("select1", dbname = filename,
clear = TRUE, data = chickwts)
select(chicksdb, where = "weight > 200", order.by = "weight")
select(chicksdb, c(averageweight = "avg(weight)"), group.by = "feed")
select(chicksdb, c(averageweight = "avg(weight)"), group.by = "feed",
having = "averageweight > 250")
## and an example of querying the data frame directly
select(chickwts, c(averageweight = "avg(weight)"),
group.by = c(thefeed = "feed"))
avgwts <- dbframe("select2", dbname = filename, clear = TRUE,
data = select(chickwts, c(averageweight = "avg(weight)"),
group.by = c(thefeed = "feed")))
## an example of a join
select(list(a = chicksdb, b = avgwts), c("feed", "weight", "averageweight"),
on = ("feed = thefeed"), order.by = "feed, weight")
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.