Changeset: e9939515dd04 for MonetDB URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=e9939515dd04 Added Files: clients/R/MonetDB.R/R/dbapply.R clients/R/Tests/dbapply.R clients/R/Tests/dbapply.stable.err clients/R/Tests/dbapply.stable.out Modified Files: clients/R/MonetDB.R/DESCRIPTION clients/R/MonetDB.R/NAMESPACE clients/R/MonetDB.R/NEWS clients/R/Tests/All Branch: default Log Message:
R Connector: Autmatic code shipping diffs (272 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 @@ -12,3 +12,4 @@ Description: Allows to pull data from Mo 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 \ No newline at end of file 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,dbApply) # 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,5 +1,6 @@ 0.9.9 - dbWriteTable now quotes table/column names if necessary, and outputs warnings if it did +- New dbApply function to automatically create embedded R functions in MonetDB 0.9.8 - Added support for esoteric data types such as MONTH_INTERVAL (Thanks, Roman) 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,66 @@ +.encodeGlobals <- function(name) { + vars <- findGlobals(name,merge=F)$variables + if (length(vars) < 1) { + return(NA) + } + if (getOption("monetdb.debug.query",FALSE)) + message("Variable(s) ",paste0(vars,collapse=", ")) + + # TODO: optionally inline serialized context for remote dbs + res <- tempfile() + save(list=vars,file=res,envir=environment(name),compress=T) + return(res) +} + +if (is.null(getGeneric("dbApply"))) setGeneric("dbApply", function(conn, ...) + standardGeneric("dbApply")) + +setMethod("dbApply", signature(conn="MonetDBConnection"), def=function(conn, table, rettype, fun) { + # generate unique function name + dbfunname <- "__r_dapply_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")) + 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 + sfilename <- .encodeGlobals(fun) + if (!is.na(sfilename)) { + dbrcode <- paste0(dbrcode,'# load serialized global variables\nload("',sfilename,'")\n') + } + # get source of user function and append + dbrcode <- paste0(dbrcode,"# user-supplied function\n.userfun <- ",paste0(deparse(fun),collapse="\n"),"\n# calling user function\nreturn(.userfun(.dbdata))\n") + + # find out things about the table, then wrap the r function + res <- dbSendQuery(conn,paste0("SELECT * FROM ",table," LIMIT 1")) + dbnames <- res@env$info$names + dbtypes <- res@env$info$dbtypes + dbfun <- paste0("CREATE FUNCTION ",dbfunname,"(",paste0(dbnames," ", dbtypes, collapse=", "), + ") \nRETURNS TABLE(retval ",rettype,") LANGUAGE R {\n# rename arguments\n.dbdata <- data.frame(", + paste0(dbnames, collapse=", "),")\n",dbrcode,"};\n") + # call the function we just created + dbsel <- paste0("SELECT * FROM ", dbfunname, "( (SELECT * FROM ", table, " AS t) );\n") + # ok, talk to DB (EZ) + dbBegin(conn) + dbSendQuery(conn,dbfun) + res <- dbGetQuery(conn,dbsel) + dbRollback(conn) + return(res[,1]) +}) + + diff --git a/clients/R/Tests/All b/clients/R/Tests/All --- a/clients/R/Tests/All +++ b/clients/R/Tests/All @@ -2,5 +2,6 @@ HAVE_LIBR?install HAVE_LIBR?dbi HAVE_LIBR?survey HAVE_LIBR?dplyr +HAVE_LIBR?dbapply diff --git a/clients/R/Tests/dbapply.R b/clients/R/Tests/dbapply.R new file mode 100644 --- /dev/null +++ b/clients/R/Tests/dbapply.R @@ -0,0 +1,58 @@ +ll <- NULL +if (Sys.getenv("TSTTRGDIR") != "") { + ll <- paste0(Sys.getenv("TSTTRGDIR"),"/rlibdir") +} +library(MonetDB.R,quietly=T,lib.loc=ll) + +args <- commandArgs(trailingOnly = TRUE) +dbport <- 50000 +dbname <- "mTests_clients_R" +if (length(args) > 0) + dbport <- args[[1]] +if (length(args) > 1) + dbname <- args[[2]] + +options(monetdb.insert.splitsize=10) +options(monetdb.profile=F) + + +tname <- "monetdbtest" + +con <- dbConnect(MonetDB(), port=dbport, dbname=dbname, wait=T) +stopifnot(dbIsValid(con)) + +# make sure embedded R is working in general +dbBegin(con) +dbSendQuery(con, "CREATE FUNCTION fuuu() RETURNS TABLE(i INTEGER) LANGUAGE R {42L}") +res <- dbGetQuery(con, "SELECT * FROM fuuu();") +print(res$i[[1]]) +stopifnot(identical(42L, res$i[[1]])) +dbRollback(con) + +data(mtcars) +dbWriteTable(con,tname,mtcars, overwrite=T) +stopifnot(identical(TRUE, dbExistsTable(con,tname))) + +res <- dbApply(con, tname, "double", function(d) { + d$mpg +}) +stopifnot(identical(res, mtcars$mpg)) + +res <- dbApply(con, tname, "double", function(d) { + min(d$mpg) +}) +stopifnot(identical(res, min(mtcars$mpg))) + +# model fitting / in-db application +fitted <- lm(mpg~.,data=mtcars) +predictions <- dbApply(con,tname,"double",function(d) { + predict(fitted, newdata=d) +}) +stopifnot(identical(unname(predict(fitted, newdata=mtcars)), predictions)) + +dbRemoveTable(con,tname) +stopifnot(identical(FALSE, dbExistsTable(con,tname))) + + + +print("SUCCESS") diff --git a/clients/R/Tests/dbapply.stable.err b/clients/R/Tests/dbapply.stable.err new file mode 100644 --- /dev/null +++ b/clients/R/Tests/dbapply.stable.err @@ -0,0 +1,37 @@ +stderr of test 'dbapply` in directory 'clients/R` itself: + + +# 11:43:10 > +# 11:43:10 > "mserver5" "--debug=10" "--set" "gdk_nr_threads=0" "--set" "mapi_open=true" "--set" "mapi_port=35780" "--set" "mapi_usock=/var/tmp/mtest-66645/.s.monetdb.35780" "--set" "monet_prompt=" "--forcemito" "--set" "mal_listing=2" "--dbpath=/Users/hannes/monetdb-install/var/MonetDB/mTests_clients_R" "--set" "mal_listing=0" "--set" "embedded_r=yes" +# 11:43:10 > + +# builtin opt gdk_dbpath = /Users/hannes/monetdb-install/var/monetdb5/dbfarm/demo +# builtin opt gdk_debug = 0 +# builtin opt gdk_vmtrim = no +# builtin opt monet_prompt = > +# builtin opt monet_daemon = no +# builtin opt mapi_port = 50000 +# builtin opt mapi_open = false +# builtin opt mapi_autosense = false +# builtin opt sql_optimizer = default_pipe +# builtin opt sql_debug = 0 +# cmdline opt gdk_nr_threads = 0 +# cmdline opt mapi_open = true +# cmdline opt mapi_port = 35780 +# cmdline opt mapi_usock = /var/tmp/mtest-66645/.s.monetdb.35780 +# cmdline opt monet_prompt = +# cmdline opt mal_listing = 2 +# cmdline opt gdk_dbpath = /Users/hannes/monetdb-install/var/MonetDB/mTests_clients_R +# cmdline opt mal_listing = 0 +# cmdline opt embedded_r = yes +# cmdline opt gdk_debug = 536870922 + +# 11:43:14 > +# 11:43:14 > "R" "--vanilla" "--slave" "--args" "35780" +# 11:43:14 > + + +# 11:43:21 > +# 11:43:21 > "Done." +# 11:43:21 > + diff --git a/clients/R/Tests/dbapply.stable.out b/clients/R/Tests/dbapply.stable.out new file mode 100644 --- /dev/null +++ b/clients/R/Tests/dbapply.stable.out @@ -0,0 +1,46 @@ +stdout of test 'dbapply` in directory 'clients/R` itself: + + +# 11:43:10 > +# 11:43:10 > "mserver5" "--debug=10" "--set" "gdk_nr_threads=0" "--set" "mapi_open=true" "--set" "mapi_port=35780" "--set" "mapi_usock=/var/tmp/mtest-66645/.s.monetdb.35780" "--set" "monet_prompt=" "--forcemito" "--set" "mal_listing=2" "--dbpath=/Users/hannes/monetdb-install/var/MonetDB/mTests_clients_R" "--set" "mal_listing=0" "--set" "embedded_r=yes" +# 11:43:10 > + +# MonetDB 5 server v11.22.0 +# This is an unreleased version +# Serving database 'mTests_clients_R', using 4 threads +# Compiled for x86_64-apple-darwin14.3.0/64bit with 64bit OIDs and 128bit integers dynamically linked +# Found 16.000 GiB available main-memory. +# Copyright (c) 1993-July 2008 CWI. +# Copyright (c) August 2008-2015 MonetDB B.V., all rights reserved +# Visit http://www.monetdb.org/ for further information +# Listening for connection requests on mapi:monetdb://dakar.da.cwi.nl.hhk.dk:35780/ +# Listening for UNIX domain connection requests on mapi:monetdb:///var/tmp/mtest-66645/.s.monetdb.35780 +# MonetDB/GIS module loaded +# Start processing logs sql/sql_logs version 52200 +# Start reading the write-ahead log 'sql_logs/sql/log.5' +# Finished reading the write-ahead log 'sql_logs/sql/log.5' +# Finished processing logs sql/sql_logs +# MonetDB/SQL module loaded +# MonetDB/R module loaded + +Ready. + +# 11:43:14 > +# 11:43:14 > "R" "--vanilla" "--slave" "--args" "35780" +# 11:43:14 > + +[1] TRUE +An object of class "MonetDBResult" +Slot "env": +<environment: 0x7fa0e4a984e8> + +[1] 42 +[1] TRUE +[1] TRUE +[1] TRUE +[1] "SUCCESS" + +# 11:43:21 > +# 11:43:21 > "Done." +# 11:43:21 > + _______________________________________________ checkin-list mailing list checkin-list@monetdb.org https://www.monetdb.org/mailman/listinfo/checkin-list
