Changeset: 1be39ea27123 for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=1be39ea27123
Added Files:
clients/R/MonetDB.R/R/dbapply.R
clients/R/MonetDB.R/man/dbApply.Rd
clients/R/Tests/dbapply.R
clients/R/Tests/dbapply.reqtests
clients/R/Tests/dbapply.stable.err
clients/R/Tests/dbapply.stable.out
clients/R/Tests/deps-install.R
clients/R/Tests/deps-install.stable.err
clients/R/Tests/deps-install.stable.out
clients/R/Tests/deps-test.R
clients/R/Tests/deps-test.stable.err
clients/R/Tests/deps-test.stable.out
clients/R/Tests/deps-test.timeout
clients/R/Tests/dplyr-flights.R
clients/R/Tests/dplyr-flights.reqtests
clients/R/Tests/dplyr-flights.stable.err
clients/R/Tests/dplyr-flights.stable.out
clients/R/Tests/install.R
clients/R/Tests/install.reqtests
Removed Files:
clients/R/Tests/install-dependencies.sh
clients/R/Tests/install.sh
Modified Files:
clients/R/MonetDB.R/DESCRIPTION
clients/R/MonetDB.R/NAMESPACE
clients/R/MonetDB.R/NEWS
clients/R/MonetDB.R/R/control.R
clients/R/MonetDB.R/R/dbi.R
clients/R/MonetDB.R/R/dplyr.R
clients/R/MonetDB.R/R/mapi.R
clients/R/Tests/All
clients/R/Tests/dbi.R
clients/R/Tests/dbi.stable.err
clients/R/Tests/dbi.stable.out
clients/R/Tests/dplyr.R
clients/R/Tests/dplyr.reqtests
clients/R/Tests/dplyr.stable.out
clients/R/Tests/install.stable.err
clients/R/Tests/install.stable.out
clients/R/Tests/survey.reqtests
Branch: Jul2015
Log Message:
Copied R connector version to Jul2015 branch
Changesets: 56314:d98bdfc0ff74 56185:503571785830 56183:1631964a8187
56182:d4407c6f864d 56181:a2b9e148eef0 56159:92bf06ce1de6 56157:b58218b5fd9d
56156:51806c911fec 56146:ff8b818a5a3c 56122:e9939515dd04 56120:bf4003213d1a
diffs (truncated from 1535 to 300 lines):
diff --git a/clients/R/MonetDB.R/DESCRIPTION b/clients/R/MonetDB.R/DESCRIPTION
--- a/clients/R/MonetDB.R/DESCRIPTION
+++ b/clients/R/MonetDB.R/DESCRIPTION
@@ -1,14 +1,16 @@
Package: MonetDB.R
-Version: 0.9.9
+Version: 1.0.0
Title: Connect MonetDB to R
Authors@R: c(person("Hannes Muehleisen", role = c("aut", "cre"),email =
"han...@cwi.nl"),
person("Thomas Lumley", role = "ctb"),
person("Anthony Damico", role = "ctb"))
Author: Hannes Muehleisen [aut, cre], Thomas Lumley [ctb], Anthony Damico [ctb]
Maintainer: Hannes Muehleisen <han...@cwi.nl>
-Depends: DBI (>= 0.3.1), digest (>= 0.6.4), methods, R (>= 3.1.1)
+Depends: DBI (>= 0.3.1)
+Imports: digest (>= 0.6.4), methods, codetools
Enhances: dplyr (>= 0.3.0)
Description: Allows to pull data from MonetDB into R. Includes a DBI
implementation and a dplyr backend.
License: MPL (== 1.1)
URL: http://monetr.r-forge.r-project.org
SystemRequirements: MonetDB, available from http://www.monetdb.org
+Collate: mapi.R dbi.R dbapply.R dplyr.R control.R
diff --git a/clients/R/MonetDB.R/NAMESPACE b/clients/R/MonetDB.R/NAMESPACE
--- a/clients/R/MonetDB.R/NAMESPACE
+++ b/clients/R/MonetDB.R/NAMESPACE
@@ -1,10 +1,10 @@
-import(DBI,digest,methods)
+import(DBI,digest,methods,codetools)
# export only driver constructor, everything else is DBI stuff..
export(MonetDB,MonetR,MonetDBR,MonetDB.R)
export(monet.read.csv,monetdb.read.csv)
# this one is not in the DBI
-exportMethods(dbSendUpdate,dbSendUpdateAsync,dbTransaction)
+exportMethods(dbSendUpdate,dbSendUpdateAsync,dbTransaction,mdbapply)
# shorthands
export(mc,mq)
useDynLib(MonetDB.R)
diff --git a/clients/R/MonetDB.R/NEWS b/clients/R/MonetDB.R/NEWS
--- a/clients/R/MonetDB.R/NEWS
+++ b/clients/R/MonetDB.R/NEWS
@@ -1,10 +1,13 @@
-0.9.9
-- dbWriteTable now quotes column names
-
-0.9.8
+1.0.0
- Added support for esoteric data types such as MONTH_INTERVAL (Thanks, Roman)
- Cleaned up SQL to R type mapping (we had this twice)
- Now creating actual R integers if data fits
+- dbWriteTable now quotes table/column names if necessary, and outputs
warnings if it did
+- New mdbapply function to automatically create and run embedded R functions
in MonetDB
+- Fixes for dplyr backend (Thanks, Anthony)
+- Fix for case when query only returns a prompt (CALL ..., Thanks, Roman)
+- Fix for empty result set on dbGetQuery(), no longer returning NULL (Thanks,
Fabian)
+- Fix for dbConnect(), it ignored the url parameter somehow, which broke some
sqlsurvey (Thanks, Anthony)
0.9.7
- Fixed crash on Windows (Sorry, everyone)
diff --git a/clients/R/MonetDB.R/R/control.R b/clients/R/MonetDB.R/R/control.R
--- a/clients/R/MonetDB.R/R/control.R
+++ b/clients/R/MonetDB.R/R/control.R
@@ -5,7 +5,7 @@ monetdb.server.start <-
if( !file.exists( bat.file ) ) stop( paste( bat.file , "does not exist.
Run monetdb.server.setup() to create a batch file." ) )
# uugly, find path of pid file again by parsing shell script.
- sc <- read.table(bat.file,sep="\n",stringsAsFactors=F)
+ sc <- utils::read.table(bat.file,sep="\n",stringsAsFactors=F)
pidfile <- substring(sc[[2,1]],11)
# run script
diff --git a/clients/R/MonetDB.R/R/dbapply.R b/clients/R/MonetDB.R/R/dbapply.R
new file mode 100644
--- /dev/null
+++ b/clients/R/MonetDB.R/R/dbapply.R
@@ -0,0 +1,79 @@
+# TOOD: support running this on a select in addition to table?
+# TODO: support remote dbs, find out whether its local via canary file
+# TODO: don't actually construct the data frame but use attr/class trick to
save copying
+
+if (is.null(getGeneric("mdbapply"))) setGeneric("mdbapply", function(conn,
table, fun, ...)
+ standardGeneric("mdbapply"))
+
+setMethod("mdbapply", signature(conn="MonetDBConnection"), def=function(conn,
table, fun, ...) {
+ # make sure table exists
+ if (!dbExistsTable(conn, table)) {
+ stop("Table ", table, " does not exist.")
+ }
+
+ # generate unique function name
+ dbfunname <- "mdbapply_autogen_"
+ while (dbGetQuery(conn, paste0("select count(*) from functions where
name='", dbfunname, "'"))[[1]] > 0)
+ dbfunname <- paste0(dbfunname, sample(letters, 1))
+
+ # test R integration with dummy function
+ dbBegin(conn)
+ dbSendQuery(conn,paste0("CREATE FUNCTION ", dbfunname, "() RETURNS TABLE(d
INTEGER) LANGUAGE R {1L}"))
+ res <- dbGetQuery(conn,paste0("SELECT * FROM ", dbfunname, "()"))[[1]]
+ dbRollback(conn)
+
+ # now generate the UDF
+ # find packages loaded here and load them on the server as well
+ toloadpkgs <-
setdiff(unique(sapply(strsplit(grep("^package:",search(),value=T),":"),function(x)
x[[2]])),c("base","stats","methods","utils","codetools","graphics","grDevices","datasets","MonetDB.R","DBI","digest"))
+ dbrcode <- ''
+ if (length(toloadpkgs) > 0) {
+ if (getOption("monetdb.debug.query",FALSE))
+ message("Package(s) ",paste0(toloadpkgs,collapse=", "))
+ dbrcode <- paste0('# loading packages\ninvisible(lapply(setdiff(',
+ paste0(deparse(toloadpkgs),collapse=""),
+ ',unique(sapply(strsplit(grep("^package:", search(),
value=T),":"), function(x) x[[2]]))), function(pname) library(pname,
character.only=T, quietly=T)))\n')
+ }
+ # serialize global variables into ascii string, and add the code to scan it
again into the current env
+ vars <- codetools::findGlobals(fun, merge=F)$variables
+ mdbapply_dotdot <- list(...)
+ if (length(mdbapply_dotdot) > 0) {
+ vars <- c(vars,"mdbapply_dotdot")
+ assign("mdbapply_dotdot", mdbapply_dotdot, envir=environment(fun))
+ }
+ sfilename <- NA
+ if (length(vars) > 0) {
+ if (getOption("monetdb.debug.query",FALSE))
+ message("Variable(s) ",paste0(vars,collapse=", "))
+ sfilename <- tempfile()
+ save(list=vars,file=sfilename,envir=environment(fun), compress=T)
+ dbrcode <- paste0(dbrcode, '# load serialized global variable(s) ',
paste(vars, collapse=", "), '\nload("', sfilename, '")\n')
+ }
+
+ rfilename <- tempfile()
+ # get source of user function and append
+ dbrcode <- paste0(dbrcode, "# user-supplied function\nmdbapply_userfun <- ",
paste0(deparse(fun), collapse="\n"),
+ "\n# calling user function\nsaveRDS(do.call(mdbapply_userfun,
if(exists('mdbapply_dotdot')){c(list(mdbapply_dbdata), mdbapply_dotdot)}
else{list(mdbapply_dbdata)}),file=\"", rfilename, "\")\nreturn(42L)\n")
+
+ # find out things about the table, then wrap the R function
+ query <- paste0("SELECT * FROM ", table, " AS t")
+ res <- monetdb_queryinfo(conn, query)
+ dbfun <- paste0("CREATE FUNCTION ", dbfunname,"(",
paste0(dbQuoteIdentifier(conn, res$names)," ", res$dbtypes, collapse=", "),
+ ") \nRETURNS TABLE(retval INTEGER) LANGUAGE R {\n# rename
arguments\nmdbapply_dbdata <- data.frame(",
+ paste0(res$names, collapse=", "),", stringsAsFactors=F)\n",
dbrcode, "};\n")
+ # call the function we just created
+ dbsel <- paste0("SELECT * FROM ", dbfunname, "( (",query,") );\n")
+ # ok, talk to DB (easiest part of this)
+ res <- NA
+ dbBegin(conn)
+ tryCatch({
+ dbSendQuery(conn, dbfun)
+ dbGetQuery(conn, dbsel)
+ res <- readRDS(rfilename)
+ }, finally={
+ dbRollback(conn)
+ file.remove(stats::na.omit(c(sfilename, rfilename)))
+ })
+ res
+})
+
+
diff --git a/clients/R/MonetDB.R/R/dbi.R b/clients/R/MonetDB.R/R/dbi.R
--- a/clients/R/MonetDB.R/R/dbi.R
+++ b/clients/R/MonetDB.R/R/dbi.R
@@ -22,8 +22,8 @@ setMethod("dbUnloadDriver", "MonetDBDriv
setMethod("dbGetInfo", "MonetDBDriver", def=function(dbObj, ...)
list(name="MonetDBDriver",
- driver.version=packageVersion("MonetDB.R"),
- DBI.version=packageVersion("DBI"),
+ driver.version=utils::packageVersion("MonetDB.R"),
+ DBI.version=utils::packageVersion("DBI"),
client.version="NA",
max.connections=125) # R can only handle 128 connections, three of
which are pre-allocated
)
@@ -46,8 +46,8 @@ setMethod("dbConnect", "MonetDBDriver",
password="monetdb",
host="localhost", port=50000L, timeout=86400L, wait=FALSE, language="sql",
..., url="") {
- if (substring(dbname, 1, 10) == "monetdb://") {
- url <- dbname
+ if (substring(url, 1, 10) == "monetdb://") {
+ dbname <- url
}
timeout <- as.integer(timeout)
@@ -205,7 +205,7 @@ setMethod("dbListFields", "MonetDBConnec
setMethod("dbExistsTable", "MonetDBConnection", def=function(conn, name, ...) {
# TODO: this is evil...
return(tolower(gsub("(^\"|\"$)","",as.character(name))) %in%
- tolower(dbListTables(conn,sys_tables=T)))
+ tolower(dbListTables(conn, sys_tables=T)))
})
setMethod("dbGetException", "MonetDBConnection", def=function(conn, ...) {
@@ -215,13 +215,12 @@ setMethod("dbGetException", "MonetDBConn
setMethod("dbReadTable", "MonetDBConnection", def=function(conn, name, ...) {
if (!dbExistsTable(conn, name))
stop(paste0("Unknown table: ", name));
- dbGetQuery(conn,paste0("SELECT * FROM ", name))
+ dbGetQuery(conn, paste0("SELECT * FROM ", name))
})
# This one does all the work in this class
setMethod("dbSendQuery", signature(conn="MonetDBConnection",
statement="character"),
- def=function(conn, statement, ..., list=NULL, async=FALSE) {
-
+ def=function(conn, statement, ..., list=NULL, async=FALSE) {
if(!is.null(list) || length(list(...))){
if (length(list(...))) statement <- .bindParameters(statement, list(...))
if (!is.null(list)) statement <- .bindParameters(statement, list)
@@ -245,11 +244,11 @@ setMethod("dbSendQuery", signature(conn=
env$data <- resp$tuples
resp$tuples <- NULL # clean up
env$info <- resp
- env$delivered <- 0
+ env$delivered <- -1
env$query <- statement
env$open <- TRUE
}
- if (resp$type == Q_UPDATE || resp$type == Q_CREATE || resp$type ==
MSG_ASYNC_REPLY) {
+ if (resp$type == Q_UPDATE || resp$type == Q_CREATE || resp$type ==
MSG_ASYNC_REPLY || resp$type == MSG_PROMPT) {
env$success = TRUE
env$conn <- conn
env$query <- statement
@@ -281,20 +280,28 @@ setMethod("dbSendQuery", signature(conn=
}
}
- return(new("MonetDBResult", env=env))
+ invisible(new("MonetDBResult", env=env))
})
# quoting
-setMethod("dbQuoteIdentifier", c("MonetDBConnection", "character"),
function(conn, x, ...) {
- qts <- !grepl("^[a-z][a-z0-9_]+$",x,perl=T)
- x[qts] <- paste('"', gsub('"', '""', x[qts], fixed = TRUE), '"', sep = "")
- SQL(x)
-})
+quoteIfNeeded <- function(conn, x, ...) {
+ chars <- !grepl("^[a-z][a-z0-9_]*$", x, perl=T) & !grepl("^\"[^\"]*\"$", x,
perl=T)
+ if (any(chars)) {
+ message("Identifier(s) ", paste(x[chars], collapse=", "), " contain
uppercase or reserved SQL characters and need(s) to be quoted in queries.")
+ }
+ reserved <- toupper(x) %in% .SQL92Keywords
+ if (any(reserved)) {
+ message("Identifier(s) ", paste(x[reserved], collapse=", "), " are
reserved SQL keywords and need(s) to be quoted in queries.")
+ }
+ qts <- reserved | chars
+ x[qts] <- dbQuoteIdentifier(conn, x[qts])
+ x
+}
-# overload as per DBI documentation
-setMethod("dbQuoteIdentifier", c("MonetDBConnection", "SQL"), function(conn,
x, ...) {x})
+# # overload as per DBI documentation
+# setMethod("dbQuoteIdentifier", c("MonetDBConnection", "SQL"), function(conn,
x, ...) {x})
# adapted from RMonetDB, very useful...
setMethod("dbWriteTable", "MonetDBConnection", def=function(conn, name, value,
overwrite=FALSE,
@@ -310,7 +317,8 @@ setMethod("dbWriteTable", "MonetDBConnec
if (overwrite && append) {
stop("Setting both overwrite and append to true makes no sense.")
}
- qname <- make.db.names(conn, name)
+
+ qname <- quoteIfNeeded(conn, name)
if (dbExistsTable(conn, qname)) {
if (overwrite) dbRemoveTable(conn, qname)
if (!overwrite && !append) stop("Table ", qname, " already exists. Set
overwrite=TRUE if you want
@@ -319,7 +327,7 @@ setMethod("dbWriteTable", "MonetDBConnec
}
if (!dbExistsTable(conn, qname)) {
fts <- sapply(value, dbDataType, dbObj=conn)
- fdef <- paste('"', make.db.names(conn, names(value)), '"', fts,
collapse=', ')
+ fdef <- paste(quoteIfNeeded(conn, names(value)), fts, collapse=', ')
ct <- paste("CREATE TABLE ", qname, " (", fdef, ")", sep= '')
dbSendUpdate(conn, ct)
}
@@ -458,8 +466,8 @@ monetdbRtype <- function(dbType) {
}
setMethod("fetch", signature(res="MonetDBResult", n="numeric"),
def=function(res, n, ...) {
- # dbGetQuery() still calls fetch(), thus no error message yet
- # warning("fetch() is deprecated, use dbFetch()")
+ # DBI on CRAN still uses fetch()
+ # message("fetch() is deprecated, use dbFetch()")
dbFetch(res, n, ...)
})
@@ -474,6 +482,9 @@ setMethod("dbFetch", signature(res="Mone
# okay, so we arrive here with the tuples from the first result in
res@env$data as a list
info <- res@env$info
+ if (res@env$delivered < 0) {
+ res@env$delivered <- 0
+ }
stopifnot(res@env$delivered <= info$rows, info$index <= info$rows)
remaining <- info$rows - res@env$delivered
@@ -514,7 +525,7 @@ setMethod("dbFetch", signature(res="Mone
# we have delivered everything, return empty df (spec is not clear on this
one...)
if (n < 1) {
_______________________________________________
checkin-list mailing list
checkin-list@monetdb.org
https://www.monetdb.org/mailman/listinfo/checkin-list
