Changeset: 86ca45e0400f for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=86ca45e0400f
Modified Files:
clients/R/MonetDB.R/R/dbi.R
clients/R/MonetDB.R/R/dplyr.R
monetdb5/extras/rapi/converters.c
tools/embedded/embedded.c
tools/embedded/embedded.h
tools/embedded/rpackage/R/monetdb.R
tools/embedded/rpackage/tests/testthat/test_dbi.R
tools/embedded/rpackage/tests/testthat/test_lowlevel.R
Branch: embedded
Log Message:
Querying, not really converting SEXP. Needed for dplyr support
diffs (237 lines):
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
@@ -230,7 +230,7 @@ setMethod("dbReadTable", "MonetDBConnect
name <- quoteIfNeeded(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
@@ -301,7 +301,7 @@ setMethod("dbSendQuery", signature(conn=
# This one does all the work in this class
setMethod("dbSendQuery", signature(conn="MonetDBEmbeddedConnection",
statement="character"),
- def=function(conn, statement, ..., list=NULL) {
+ def=function(conn, statement, ..., list=NULL, notreally=F) {
if (!conn@connenv$open) {
stop("This connection was closed.")
}
@@ -312,7 +312,7 @@ setMethod("dbSendQuery", signature(conn=
env <- NULL
if (getOption("monetdb.debug.query", F)) message("QQ: '", statement, "'")
- resp <- monetdb_embedded_query(statement)
+ resp <- monetdb_embedded_query(statement, notreally)
env <- new.env(parent=emptyenv())
if (resp$type == Q_TABLE) {
diff --git a/clients/R/MonetDB.R/R/dplyr.R b/clients/R/MonetDB.R/R/dplyr.R
--- a/clients/R/MonetDB.R/R/dplyr.R
+++ b/clients/R/MonetDB.R/R/dplyr.R
@@ -54,8 +54,7 @@ db_query_fields.MonetDBConnection <- fun
}
db_query_fields.MonetDBEmbeddedConnection <- function(con, sql, ...) {
- # PREPARE does not work in embedded mode
- names(dbGetQuery(con, dplyr::build_sql("SELECT * FROM ", sql, " WHERE 1=0")))
+ names(dbGetQuery(con, dplyr::build_sql("SELECT * FROM ", sql), notreally=T))
}
db_query_rows.MonetDBConnection <- function(con, sql, ...) {
@@ -63,14 +62,7 @@ db_query_rows.MonetDBConnection <- funct
}
db_query_rows.MonetDBEmbeddedConnection <- function(con, sql, ...) {
- # TODO: is there a better way of doing this?
- if (!grepl("^\\w*SELECT.*", as.character(sql), perl=T, ignore.case=T)) {
- sql <- dplyr::build_sql("SELECT * FROM ", sql)
- }
- dbGetQuery(con, dplyr::build_sql("CREATE TEMPORARY TABLE dqrv AS ", sql, "
WITH DATA"))
- ct <- dbGetQuery(con, dplyr::build_sql("SELECT COUNT(*) AS ct FROM
dqrv"))$ct[[1]]
- dbGetQuery(con, dplyr::build_sql("DROP TABLE dqrv"))
- return(ct)
+ attr(dbGetQuery(con, sql, notreally=T), "__rows")
}
db_insert_into.MonetDBConnection <- function(con, table, values, ...) {
diff --git a/monetdb5/extras/rapi/converters.c
b/monetdb5/extras/rapi/converters.c
--- a/monetdb5/extras/rapi/converters.c
+++ b/monetdb5/extras/rapi/converters.c
@@ -1,31 +1,31 @@
#include <Rdefines.h>
#include "mal.h"
-#define BAT_TO_INTSXP(bat,tpe,retsxp)
\
+#define BAT_TO_SXP(bat,tpe,retsxp,newfun,ptrfun,ctype,naval)\
do {
\
- tpe v; size_t j;
\
- retsxp = PROTECT(NEW_INTEGER(BATcount(bat))); \
+ tpe v; size_t j;
\
+ retsxp = PROTECT(newfun(BATcount(bat))); \
+ if (bat->T->nonil && !bat->T->nil) { \
+ for (j = 0; j < BATcount(bat); j++) { \
+ ptrfun(retsxp)[j] = \
+ (ctype) ((tpe*) Tloc(bat, BUNfirst(bat)))[j];\
+ } \
+ } else { \
for (j = 0; j < BATcount(bat); j++) {
\
v = ((tpe*) Tloc(bat, BUNfirst(bat)))[j];
\
if ( v == tpe##_nil)
\
- INTEGER_POINTER(retsxp)[j] = NA_INTEGER; \
+ ptrfun(retsxp)[j] = naval;
\
else
\
- INTEGER_POINTER(retsxp)[j] = (int)v;
\
- }
\
+ ptrfun(retsxp)[j] = (ctype)v; \
+ }}
\
} while (0)
+#define BAT_TO_INTSXP(bat,tpe,retsxp)
\
+ BAT_TO_SXP(bat,tpe,retsxp,NEW_INTEGER,INTEGER_POINTER,int,NA_INTEGER)\
+
#define BAT_TO_REALSXP(bat,tpe,retsxp)
\
- do {
\
- tpe v; size_t j;
\
- retsxp = PROTECT(NEW_NUMERIC(BATcount(bat))); \
- for (j = 0; j < BATcount(bat); j++) {
\
- v = ((tpe*) Tloc(bat, BUNfirst(bat)))[j];
\
- if ( v == tpe##_nil)
\
- NUMERIC_POINTER(retsxp)[j] = NA_REAL;
\
- else
\
- NUMERIC_POINTER(retsxp)[j] = (double)v;
\
- }
\
- } while (0)
+ BAT_TO_SXP(bat,tpe,retsxp,NEW_NUMERIC,NUMERIC_POINTER,double,NA_REAL)\
+
#define SCALAR_TO_INTSXP(tpe,retsxp) \
do {
\
@@ -102,14 +102,23 @@ static SEXP bat_to_sexp(BAT* b) {
BATiter li;
li = bat_iterator(b);
varvalue = PROTECT(NEW_STRING(BATcount(b)));
- BATloop(b, p, q) {
- const char *t = (const char *) BUNtail(li, p);
- if (ATOMcmp(TYPE_str, t, str_nil) == 0) {
- SET_STRING_ELT(varvalue, j, NA_STRING);
- } else {
- SET_STRING_ELT(varvalue, j, mkCharCE(t,
CE_UTF8));
+
+ if (b->T->nonil && !b->T->nil) {
+ BATloop(b, p, q) {
+ SET_STRING_ELT(varvalue, j++, mkCharCE(
+ (const char *) BUNtail(li, p),
CE_UTF8));
}
- j++;
+ }
+ else {
+ BATloop(b, p, q) {
+ const char *t = (const char *)
BUNtail(li, p);
+ if (ATOMcmp(TYPE_str, t, str_nil) == 0)
{
+ SET_STRING_ELT(varvalue, j,
NA_STRING);
+ } else {
+ SET_STRING_ELT(varvalue, j,
mkCharCE(t, CE_UTF8));
+ }
+ j++;
+ }
}
} break;
}
diff --git a/tools/embedded/embedded.c b/tools/embedded/embedded.c
--- a/tools/embedded/embedded.c
+++ b/tools/embedded/embedded.c
@@ -221,7 +221,7 @@ SEXP monetdb_query_R(SEXP query, SEXP no
char notreally = LOGICAL(notreallys)[0];
if (err != NULL) { // there was an error
- return mkCharCE(err, CE_UTF8);
+ return ScalarString(mkCharCE(err, CE_UTF8));
}
if (output && output->nr_cols > 0) {
int i;
@@ -229,7 +229,7 @@ SEXP monetdb_query_R(SEXP query, SEXP no
retlist = PROTECT(allocVector(VECSXP, output->nr_cols));
names = PROTECT(NEW_STRING(output->nr_cols));
SET_ATTR(retlist, install("__rows"),
-
Rf_ScalarReal(BATcount(BATdescriptor(output->cols[0].b))));
+
Rf_ScalarReal(BATcount(BATdescriptor(output->cols[0].b))));
for (i = 0; i < output->nr_cols; i++) {
res_col col = output->cols[i];
BAT* b = BATdescriptor(col.b);
diff --git a/tools/embedded/embedded.h b/tools/embedded/embedded.h
--- a/tools/embedded/embedded.h
+++ b/tools/embedded/embedded.h
@@ -24,7 +24,7 @@ int monetdb_startup(char* dir, char sile
char* monetdb_query(char* query, void** result);
char* monetdb_append(const char* schema, const char* table, append_data *ad,
int ncols);
void monetdb_cleanup_result(void* output);
-SEXP monetdb_query_R(SEXP querysexp);
+SEXP monetdb_query_R(SEXP querysexp, SEXP notreally);
SEXP monetdb_startup_R(SEXP dirsexp, SEXP silentsexp);
SEXP monetdb_append_R(SEXP schemaname, SEXP tablename, SEXP tabledata);
diff --git a/tools/embedded/rpackage/R/monetdb.R
b/tools/embedded/rpackage/R/monetdb.R
--- a/tools/embedded/rpackage/R/monetdb.R
+++ b/tools/embedded/rpackage/R/monetdb.R
@@ -24,7 +24,7 @@ monetdb_embedded_startup <- function(dir
invisible(TRUE)
}
-monetdb_embedded_query <- function(query, notreally) {
+monetdb_embedded_query <- function(query, notreally=F) {
query <- as.character(query)
if (length(query) != 1) {
stop("Need a single query as parameter.")
@@ -47,7 +47,9 @@ monetdb_embedded_query <- function(query
}
if (is.list(res)) {
resp$type <- 1 # Q_TABLE
- resp$tuples <- as.data.frame(res, stringsAsFactors=F)
+ attr(res, "row.names") <- c(NA_integer_, length(res[[1]]))
+ class(res) <- "data.frame"
+ resp$tuples <- res
}
resp
}
diff --git a/tools/embedded/rpackage/tests/testthat/test_dbi.R
b/tools/embedded/rpackage/tests/testthat/test_dbi.R
--- a/tools/embedded/rpackage/tests/testthat/test_dbi.R
+++ b/tools/embedded/rpackage/tests/testthat/test_dbi.R
@@ -181,8 +181,8 @@ basicDf <- data.frame(
test_that("round-trip leaves data.frame unchanged", {
dbWriteTable(con, "t1", basicDf, row.names = FALSE)
- expect_equal(dbGetQuery(con, "select * from t1"), basicDf)
- expect_equal(dbReadTable(con, "t1"), basicDf)
+ expect_equivalent(dbGetQuery(con, "select * from t1"), basicDf)
+ expect_equivalent(dbReadTable(con, "t1"), basicDf)
dbRemoveTable(con, "t1")
})
@@ -190,7 +190,7 @@ test_that("NAs work in first row", {
na_first <- basicDf[c(5, 1:4), ]
rownames(na_first) <- NULL
dbWriteTable(con, "t1", na_first, row.names = FALSE)
- expect_equal(dbReadTable(con, "t1"), na_first)
+ expect_equivalent(dbReadTable(con, "t1"), na_first)
dbRemoveTable(con, "t1")
})
diff --git a/tools/embedded/rpackage/tests/testthat/test_lowlevel.R
b/tools/embedded/rpackage/tests/testthat/test_lowlevel.R
--- a/tools/embedded/rpackage/tests/testthat/test_lowlevel.R
+++ b/tools/embedded/rpackage/tests/testthat/test_lowlevel.R
@@ -38,10 +38,10 @@ test_that("rollback works", {
res <- monetdb_embedded_query("SELECT i FROM foo")
expect_equal(res$tuples$i, 42)
monetdb_embedded_query("ROLLBACK")
+ res <- monetdb_embedded_query("SELECT * FROM tables WHERE name='foo'")
+ expect_equal(nrow(res$tuples), 0)
res <- monetdb_embedded_query("SELECT i FROM foo")
expect_equal(res$type, "!")
- res <- monetdb_embedded_query("SELECT * FROM tables WHERE name='foo'")
- expect_equal(nrow(res$tuples), 0)
})
test_that("rollback with errors", {
_______________________________________________
checkin-list mailing list
[email protected]
https://www.monetdb.org/mailman/listinfo/checkin-list
