Changeset: 3a53a2b51cba for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=3a53a2b51cba
Modified Files:
monetdb5/extras/rapi/rapi.R
monetdb5/extras/rapi/rapi.c
monetdb5/extras/rapi/rapi.h
sql/backends/monet5/Tests/All
sql/backends/monet5/Tests/rapi05.sql
Branch: RIntegration
Log Message:
R API: Bugfixes, moved R package directory into dbfarm, rewrote init code,
better error messages on return type mismatches, test output
diffs (truncated from 398 to 300 lines):
diff --git a/monetdb5/extras/rapi/rapi.R b/monetdb5/extras/rapi/rapi.R
--- a/monetdb5/extras/rapi/rapi.R
+++ b/monetdb5/extras/rapi/rapi.R
@@ -20,20 +20,22 @@
# auto-install packages by intercepting library()
.library.original <- library
-library <- function(package, help, pos = 2, lib.loc = NULL, character.only =
FALSE,
+# configure our own library path in the dbfarm
+.libPaths(.rapi.libdir)
+
+library <- function(package, help, pos = 2, lib.loc = .libPaths(),
character.only = FALSE,
logical.return = FALSE, warn.conflicts = TRUE, quietly = FALSE,
verbose = getOption("verbose")) {
package <- as.character(substitute(package))
if (!(package %in% installed.packages()[,"Package"]))
- install.packages(package,repos=c("http://cran.rstudio.com/";))
+
install.packages(package,repos=c("http://cran.rstudio.com/";),lib=.rapi.libdir)
.library.original(package,help,pos,lib.loc,character.only=T,logical.return,warn.conflicts,quietly)
}
# do not re-install existing packages if install.packages() is called
install.packages.original <- install.packages
-# TODO how to check version etc?
# redirect default graphics device to PDF
options(device="pdf")
diff --git a/monetdb5/extras/rapi/rapi.c b/monetdb5/extras/rapi/rapi.c
--- a/monetdb5/extras/rapi/rapi.c
+++ b/monetdb5/extras/rapi/rapi.c
@@ -41,6 +41,9 @@
// other headers
#include <string.h>
+#include <sys/stat.h>
+
+#define SOME_CONFIG_VAR_FOR_RHOME "/usr/lib64/R"
#define BAT_TO_INTSXP(bat,tpe,retsxp) { \
tpe v; size_t j; \
@@ -113,67 +116,120 @@
// The R-environment should be single threaded, calling for some protective
measures.
static MT_Lock rapiLock;
static int rapiInitialized = FALSE;
+static char* rtypenames[] = { "NIL", "SYM", "LIST", "CLO", "ENV", "PROM",
+ "LANG", "SPECIAL", "BUILTIN", "CHAR", "LGL", "unknown",
"unknown",
+ "INT", "REAL", "CPLX", "STR", "DOT", "ANY", "VEC", "EXPR",
"BCODE",
+ "EXTPTR", "WEAKREF", "RAW", "S4" };
-void writeConsole(const char * buf, int buflen) {
- (void) buflen;
- THRprintf(GDKout, "%s", buf);
- fprintf(stderr, "%s", buf);
+// helper function to translate R TYPEOF() return values to something readable
+char* rtypename(int rtypeid) {
+ if (rtypeid < 0 || rtypeid > 25) {
+ return "unknown";
+ } else
+ return rtypenames[rtypeid];
}
+
void writeConsoleEx(const char * buf, int buflen, int foo) {
(void) buflen;
(void) foo;
- THRprintf(GDKout, "%s", buf);
+ // TODO: do we really want to write this to the console?
+ THRprintf(GDKout, "# %s", buf);
+}
+
+void writeConsole(const char * buf, int buflen) {
+ writeConsoleEx(buf,buflen,-42);
}
static int RAPIinitialize(void) {
- char *rargv[] = { "whatever", "--quiet", "--no-save",
"--no-restore-data" };
- int rargc = 4;
- int evalErr;
- ParseStatus status;
- char rlibs[BUFSIZ];
- char rapiinclude[BUFSIZ];
MT_lock_init(&rapiLock, "rapi_lock");
- // adapted from Rinit.c (JRI package)
- if (!getenv("R_HOME")) {
- return 1;
- }
+ // set R_HOME for packages etc.
+ setenv("R_HOME", SOME_CONFIG_VAR_FOR_RHOME, TRUE);
- // TODO: put this into dbfarm
- snprintf(rlibs, BUFSIZ, "%s%c%s%c%s%c%s",
- LOCALSTATEDIR, DIR_SEP, "monetdb5", DIR_SEP, "rapi",
- DIR_SEP, "libs");
- setenv("R_LIBS_USER", rlibs, TRUE);
+#ifdef _RAPI_DEBUG_
+ printf("# R libraries installed in %s\n",rlibs);
+#endif
#ifdef RIF_HAS_RSIGHAND
R_SignalHandlers=0;
#endif
+ // set some command line arguments
{
- int stat = Rf_initialize_R(rargc, rargv);
+ structRstart rp;
+ Rstart Rp = &rp;
+ char *rargv[] = { "R" ,"--vanilla"};
+ int stat;
+
+ R_DefParams(Rp);
+ Rp->R_Slave = TRUE;
+ Rp->R_Quiet = TRUE;
+ Rp->R_Interactive = FALSE;
+ Rp->R_Verbose = FALSE;
+ Rp->LoadSiteFile = FALSE;
+ Rp->RestoreAction = SA_NORESTORE;
+ Rp->SaveAction = SA_NOSAVE;
+ Rp->NoRenviron = TRUE;
+ stat = Rf_initialize_R(2, rargv);
if (stat < 0) {
return 2;
}
+ R_SetParams(Rp);
}
+ // yes, again...
#ifdef RIF_HAS_RSIGHAND
R_SignalHandlers=0;
#endif
- /* disable stack checking, because threads will thow it off */
+
+ /* disable stack checking, because threads will throw it off */
R_CStackLimit = (uintptr_t) -1;
- R_Interactive = FALSE;
- ptr_R_WriteConsole = writeConsole;
- ptr_R_WriteConsoleEx = writeConsoleEx;
R_Outputfile = NULL;
R_Consolefile = NULL;
+ ptr_R_WriteConsoleEx = writeConsoleEx;
+ ptr_R_WriteConsole = writeConsole;
+
+ ptr_R_ReadConsole = NULL;
+
// big boy here
setup_Rmainloop();
- // run the R environment initialization script rapi.R
- snprintf(rapiinclude, BUFSIZ, "source(\"%s\")",
- locate_file("rapi", ".R", 0));
- R_tryEval(VECTOR_ELT(R_ParseVector(
- mkString(rapiinclude), 1, &status, R_NilValue), 0), R_GlobalEnv,
&evalErr);
+ {
+ int evalErr;
+ ParseStatus status;
+ char rlibs[BUFSIZ];
+ char rapiinclude[BUFSIZ];
+ SEXP librisexp;
+ struct stat sb;
+
+ // r library folder, create if not exists
+ snprintf(rlibs, BUFSIZ, "%s%c%s", GDKgetenv("gdk_dbpath"),
DIR_SEP,
+ "rapi_packages");
+
+ if (stat(rlibs, &sb) != 0) {
+ if (mkdir(rlibs, S_IRWXU) != 0) {
+ return 4;
+ }
+ }
+
+ PROTECT(librisexp = allocVector(STRSXP, 1));
+ SET_STRING_ELT(librisexp, 0, mkChar(rlibs));
+ Rf_defineVar(Rf_install(".rapi.libdir"),librisexp, R_GlobalEnv);
+ UNPROTECT(1);
+
+ // run rapi.R environment setup script
+ snprintf(rapiinclude, BUFSIZ, "source(\"%s\")",
+ locate_file("rapi", ".R", 0));
+ R_tryEvalSilent(
+ VECTOR_ELT(
+
R_ParseVector(mkString(rapiinclude), 1, &status,
+ R_NilValue),
0), R_GlobalEnv, &evalErr);
+
+ // of course the script may contain errors as well
+ if (evalErr != FALSE) {
+ return 5;
+ }
+ }
rapiInitialized++;
return 0;
@@ -187,7 +243,7 @@ str RAPIparser(int *ret, str *rcall) {
(void) R_ParseVector(mkString(*rcall), INT_MAX, &status, R_NilValue);
if (status != PARSE_OK)
msg = createException(MAL, "rapi.eval", "%s", *rcall);
- free(*rcall);
+ free(*rcall); // why free here? This is someone else's job, no?
return msg;
}
@@ -221,22 +277,18 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
throw(MAL, "rapi.eval", MAL_MALLOC_FAIL);
}
+ // we don't need no context, but the compiler needs us to touch it (...)
+ (void) cntxt;
+
/* startup internal R environment if needed */
if (!rapiInitialized) {
initstatus = RAPIinitialize();
if (initstatus != 0) {
- msg = createException(MAL, "rapi.eval",
- "failed to initialize R environment
(%i)", initstatus);
- goto wrapup;
+ throw(MAL, "rapi.eval", "failed to initialise R
environment (%i)",
+ initstatus);
}
}
-#ifdef _RAPI_DEBUG_
- mnstr_printf(cntxt->fdout, "# User R expression: %s\n", exprStr);
-#else
- (void) cntxt;
-#endif
-
MT_lock_set(&rapiLock, "rapi.evaluate");
env = PROTECT(eval(lang1(install("new.env")),R_GlobalEnv));
assert(env != NULL);
@@ -313,7 +365,7 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
break;
default:
// no clue what type to consider
- msg = createException(MAL, "rapi.eval", "unknown
argument type");
+ msg = createException(MAL, "rapi.eval", "unknown
argument type ");
goto wrapup;
}
BBPreleaseref(b->batCacheid);
@@ -339,24 +391,20 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
"ret <-
as.data.frame((function(%s){%s})(%s),nm=NA,stringsAsFactors=F)\n",
argnames, exprStr, argnames);
-#ifdef _RAPI_DEBUG_
- mnstr_printf(cntxt->fdout, "# Executed R expression %s\n", rcall);
-#endif
+ x = R_ParseVector(mkString(rcall), 1, &status, R_NilValue);
+ assert(LENGTH(x) == 1);
- x = R_ParseVector(mkString(rcall), INT_MAX, &status, R_NilValue);
if (status != PARSE_OK) {
- msg = createException(MAL, "rapi.eval", "%s", exprStr);
+ msg = createException(MAL, "rapi.eval",
+ "Error parsing R expression '%s'. ", exprStr);
goto wrapup;
}
- /* parsing creates a separate call for each statement, since our r code
can consist of multiple statements, we need to evaluate each vector entry */
- if (LENGTH(x) != 1) {
- msg = createException(MAL, "rapi.eval", "%s", exprStr);
- goto wrapup;
- }
retval = R_tryEval(VECTOR_ELT(x, 0), env, &evalErr);
if (evalErr != FALSE) {
- msg = createException(MAL, "rapi.eval", "%s", exprStr);
+ msg = createException(MAL, "rapi.eval",
+ "Error running R expression '%s'. Error
message: %s", exprStr,
+ R_curErrorBuf());
goto wrapup;
}
@@ -376,7 +424,7 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
int *ret = (int *) getArgReference(stk, pci, i);
cnt = (BUN) ret_rows;
- // check if return type is indeed a BAT
+ // check if MAL return type is indeed a BAT
if (!isaBatType(getArgType(mb,pci,i))) {
msg = createException(MAL, "rapi.eval",
"I only like BAT return types");
@@ -387,9 +435,10 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
switch (bat_type) {
case TYPE_int: {
if (!IS_INTEGER(ret_col)) {
- msg = createException(MAL, "rapi.eval",
- "wrong R column type for column
%d, expected integer",
- i);
+ msg =
+ createException(MAL,
"rapi.eval",
+ "wrong R column
type for column %d, expected INTeger, got %s.",
+ i,
rtypename(TYPEOF(ret_col)));
goto wrapup;
}
SXP_TO_BAT(int, INTEGER_POINTER, *p==NA_INTEGER);
@@ -397,30 +446,32 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
}
case TYPE_lng: {
if (!IS_INTEGER(ret_col)) {
- msg = createException(MAL, "rapi.eval",
- "wrong R column type for column
%d, expected integer",
_______________________________________________
checkin-list mailing list
[email protected]
https://www.monetdb.org/mailman/listinfo/checkin-list
