Changeset: 5c489a60b09b for MonetDB
URL: http://dev.monetdb.org/hg/MonetDB?cmd=changeset;node=5c489a60b09b
Modified Files:
monetdb5/modules/mal/Tests/rapi00.mal
monetdb5/modules/mal/rapi.c
Branch: RIntegration
Log Message:
Merged progress
diffs (208 lines):
diff --git a/monetdb5/modules/mal/Tests/rapi00.mal
b/monetdb5/modules/mal/Tests/rapi00.mal
--- a/monetdb5/modules/mal/Tests/rapi00.mal
+++ b/monetdb5/modules/mal/Tests/rapi00.mal
@@ -13,8 +13,10 @@ bat.append(b,1189641421);
io.print(b);
-r:bat[:oid,:dbl] := rapi.eval("someval <- Re(fft(arg1)); print(someval);
return(someval);",b);
+r:bat[:oid,:dbl] := rapi.eval("print(arg1);someval <- Re(fft(arg1));
print(someval); return(someval);",b);
io.print(r);
-(r:bat[:oid,:dbl], s:bat[:oid,:dbl]) := rapi.eval("someval <- Re(fft(arg1));
print(someval); return(someval,someval);",b);
+
+(r:bat[:oid,:dbl], s:bat[:oid,:dbl]) := rapi.eval("someval <- Re(fft(arg1));
print(someval); return(data.frame(someval,someval));",b);
io.print(r,s);
+
diff --git a/monetdb5/modules/mal/rapi.c b/monetdb5/modules/mal/rapi.c
--- a/monetdb5/modules/mal/rapi.c
+++ b/monetdb5/modules/mal/rapi.c
@@ -77,6 +77,8 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
char buf[64] = "rapi";
char argnames[1000] = "";
char* rcall;
+ size_t ret_rows = 0;
+ int ret_cols = 0; /* int because pci->retc is int, too*/
str *args;
int evalErr;
char *msg = createException(MAL, "rapi.eval", "NYI");
@@ -112,6 +114,7 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
for (i = pci->retc + 1; i < pci->argc; i++) {
SEXP varname = R_NilValue;
SEXP varvalue = R_NilValue;
+ size_t j;
sprintf(buf, "arg%d", i - 1);
args[i] = GDKstrdup(buf);
@@ -125,24 +128,15 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
// seems expensive to copy all values
switch (ATOMstorage(getTailType(getArgType(mb,pci,i))))
{
- case TYPE_bte:
- varvalue = NEW_LOGICAL(BATcount(b));
- memcpy((char*) (LOGICAL_POINTER(varvalue)),
- (char*) Tloc(b, BUNfirst(b)),
- BATcount(b) * sizeof(bte));
- break;
+
case TYPE_int:
varvalue = NEW_INTEGER(BATcount(b));
- memcpy((char*) (INTEGER_POINTER(varvalue)),
- (char*) Tloc(b, BUNfirst(b)),
- BATcount(b) * sizeof(int));
+ for (j = 0; j < BATcount(b); j++) {
+ // TODO: check for NULLs
+ INTEGER_POINTER(varvalue)[j] = ((int*)
Tloc(b, BUNfirst(b)))[j];
+ }
break;
- case TYPE_dbl:
- varvalue = NEW_NUMERIC(BATcount(b));
- memcpy((char*) (NUMERIC_POINTER(varvalue)),
- (char*) Tloc(b, BUNfirst(b)),
- BATcount(b) * sizeof(dbl));
- break;
+
case TYPE_str:
//varvalue = NEW_CHARACTER( strlen(*(str*)
getArgReference(stk,pci,i)));
break;
@@ -154,8 +148,6 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
}
BBPreleaseref(b->batCacheid);
}
- // TODO: it's probably a good idea to have a different, new
environment here
- // TODO: also, let's use an anonymous function call to run the
user code
// install vector into R environment
Rf_defineVar(varname, varvalue, env);
}
@@ -173,7 +165,8 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
strcat(argnames,",");
}
}
- sprintf(rcall,"ret <-
function(%s){%s}(%s)\n",argnames,exprStr,argnames);
+ sprintf(rcall, "ret <- as.data.frame((function(%s){%s})(%s))\n",
argnames,
+ exprStr, argnames);
x = R_ParseVector(mkString(rcall), INT_MAX, &status, R_NilValue);
if (status != PARSE_OK) {
@@ -186,20 +179,31 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
msg = createException(MAL, "rapi.eval", "%s", exprStr);
goto wrapup;
}
- retval = R_tryEval(VECTOR_ELT(x, i), env,&evalErr);
+ retval = R_tryEval(VECTOR_ELT(x, 0), env,&evalErr);
if (evalErr != FALSE) {
msg = createException(MAL, "rapi.eval", "%s", exprStr);
goto wrapup;
}
// ret should be a data frame with exactly as many columns as we need
from retc
+ ret_cols = LENGTH(retval);
+ ret_rows = LENGTH(VECTOR_ELT(retval, 0));
+ if (ret_cols != pci->retc) {
+ msg = createException(MAL, "rapi.eval",
+ "Expected result of %d columns, got %d",
pci->retc, ret_cols);
+ goto wrapup;
+ }
// collect the return values
for (i = 0; i < pci->retc; i++) {
+ SEXP ret_col = VECTOR_ELT(retval, i);
+ SEXPTYPE ret_type = TYPEOF(ret_col);
+ cnt = (BUN)ret_rows;
+
+
sprintf(buf, "ret%d", i);
args[i] = GDKstrdup(buf);
- cnt = (BUN)LENGTH(retval);
//do something with it
if (isaBatType(getArgType(mb,pci,i))) {
@@ -220,10 +224,16 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
b->tdense = 1;
BATsetcount(b,cnt);
+ if (ret_type != INTSXP) {
+ msg = createException(MAL, "rapi.eval",
+
"wrong R column type for column %d, expected %d, got
%d",i,INTSXP,ret_type);
+ goto
wrapup;
+ }
+
p = (int*) Tloc(b, BUNfirst(b));
for( i =0; i< (int) cnt; i++, p++){
- *p = INTEGER_POINTER(retval)[i];
- if ( Rf_isNull(((SEXP*)retval)[i])){
+ *p = INTEGER_POINTER(ret_col)[i];
+ if ( *p == NA_INTEGER){
b->T->nil = 1;
b->T->nonil = 0;
*p= int_nil;
@@ -245,9 +255,47 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
break;
}
case TYPE_dbl:
- b = BATnew(TYPE_oid, TYPE_dbl, cnt);
- // mem copy the R vector into the BAT
- break;
+ { double *p, prev;
+ b = BATnew(TYPE_oid,
TYPE_dbl, cnt);
+ BATseqbase(b, 0);
+ b->T->nil = 0;
+ b->T->nonil = 1;
+ b->tkey = 1;
+ b->tsorted = 1;
+ b->trevsorted = 1;
+ b->tdense = 1;
+ BATsetcount(b,cnt);
+
+ if (ret_type !=
REALSXP) {
+ msg =
createException(MAL, "rapi.eval",
+
"wrong R column type for column %d, expected
%d, got %d",i,INTSXP,ret_type);
+
goto wrapup;
+ }
+
+ p = (double*) Tloc(b,
BUNfirst(b));
+ for( i =0; i< (int)
cnt; i++, p++){
+ *p =
NUMERIC_POINTER(ret_col)[i];
+ if ( *p ==
NA_REAL){
+
b->T->nil = 1;
+
b->T->nonil = 0;
+ *p=
int_nil;
+ }
+ // also update
the sortedness properties
+ if (prev){
+ if ( *p
> prev && b->trevsorted){
+
b->trevsorted = 0;
+
if (*p != prev +1)
+
b->tdense = 0;
+ } else
+ if ( *p
< prev && b->tsorted){
+
b->tsorted = 0;
+
b->tdense = 0;
+ }
+ }
+ prev = *p;
+ }
+ break;
+ }
default:
// no clue what type to consider
msg = createException(MAL, "rapi.eval",
@@ -259,15 +307,13 @@ str RAPIeval(Client cntxt, MalBlkPtr mb,
msg = MAL_SUCCEED;
}
wrapup:
- // TODO: unprotect all parameters (return value?)
- //UNPROTECT(1);
MT_lock_unset(&rapiLock, "rapi.evaluate");
// free all names variables introduced so far.
- // Beware, they still live in the R global context
+ // Beware, they still live in the R context
for (i = 0; i < pci->argc; i++)
if (args[i])
GDKfree(args[i]);
GDKfree(args);
-
+ // TODO: destroy R temp environment
return msg;
}
_______________________________________________
checkin-list mailing list
[email protected]
https://www.monetdb.org/mailman/listinfo/checkin-list
