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