LCOV - code coverage report
Current view: top level - monetdb5/extras/rapi - converters.c.h (source / functions) Hit Total Coverage
Test: coverage.info Lines: 97 115 84.3 %
Date: 2020-06-29 20:00:14 Functions: 2 2 100.0 %

          Line data    Source code
       1             : /*
       2             :  * This Source Code Form is subject to the terms of the Mozilla Public
       3             :  * License, v. 2.0.  If a copy of the MPL was not distributed with this
       4             :  * file, You can obtain one at http://mozilla.org/MPL/2.0/.
       5             :  *
       6             :  * Copyright 1997 - July 2008 CWI, August 2008 - 2020 MonetDB B.V.
       7             :  */
       8             : 
       9             : #define RSTR(somestr) mkCharCE(somestr, CE_UTF8)
      10             : 
      11             : //Element-wise conversion functions, use no-op as passthrough when no conversion required
      12             : #define M_TO_R_NOOP(v)               (v)
      13             : #define R_TO_M_NOOP(v)               (v)
      14             : #define M_TO_R_DATE(v)               mDate_to_rDate(v)
      15             : #define R_TO_M_DATE(v)               rDate_to_mDate(v)
      16             : 
      17             : #define BAT_TO_SXP(bat,tpe,retsxp,newfun,ptrfun,ctype,naval,memcopy,mapfun)     \
      18             :         do {                                                                                                                            \
      19             :                 tpe v; size_t j;                                                                                                \
      20             :                 ctype *valptr = NULL;                                                                                   \
      21             :                 tpe* p = (tpe*) Tloc(bat, 0);                                                                   \
      22             :                 retsxp = PROTECT(newfun(BATcount(bat)));                                                \
      23             :                 if (!retsxp) break;                                                                                             \
      24             :                 valptr = ptrfun(retsxp);                                                                                \
      25             :                 if (bat->tnonil && !bat->tnil) {                                                          \
      26             :                         if (memcopy) {                                                                                          \
      27             :                                 memcpy(valptr, p,                                                                               \
      28             :                                         BATcount(bat) * sizeof(tpe));                                           \
      29             :                         } else {                                                                                                        \
      30             :                                 for (j = 0; j < BATcount(bat); j++) {                                        \
      31             :                                         valptr[j] = mapfun((ctype) p[j]);                                       \
      32             :                                 }                                                                                                               \
      33             :                         }                                                                                                                       \
      34             :                 } else {                                                                                                                \
      35             :                 for (j = 0; j < BATcount(bat); j++) {                                                        \
      36             :                         v = p[j];                                                                                                       \
      37             :                         if ( is_##tpe##_nil(v))                                                                         \
      38             :                                 valptr[j] = naval;                                                                              \
      39             :                         else                                                                                                            \
      40             :                                 valptr[j] = mapfun((ctype) v);                                                  \
      41             :                 }}                                                                                                                              \
      42             :         } while (0)
      43             : 
      44             : #define BAT_TO_INTSXP(bat,tpe,retsxp,memcopy)                                           \
      45             :         BAT_TO_SXP(bat,tpe,retsxp,NEW_INTEGER,INTEGER_POINTER,int,NA_INTEGER,memcopy,M_TO_R_NOOP)\
      46             : 
      47             : #define BAT_TO_REALSXP(bat,tpe,retsxp,memcopy)                                          \
      48             :         BAT_TO_SXP(bat,tpe,retsxp,NEW_NUMERIC,NUMERIC_POINTER,double,NA_REAL,memcopy,M_TO_R_NOOP)\
      49             : 
      50             : //DATE stored as integer in MonetDB with epoch 0, R uses double and epoch 1970
      51             : #define BAT_TO_DATESXP(bat,tpe,retsxp,memcopy)                                                  \
      52             :         BAT_TO_SXP(bat,tpe,retsxp,NEW_NUMERIC,NUMERIC_POINTER,double,NA_REAL,memcopy, M_TO_R_DATE); \
      53             :         SEXP klass = mkString("Date");                                                                                \
      54             :         classgets(retsxp, klass);
      55             : 
      56             : #define SXP_TO_BAT(tpe, access_fun, na_check, mapfun)                                   \
      57             :         do {                                                                                                                            \
      58             :                 tpe *p, prev = tpe##_nil; size_t j;                                                             \
      59             :                 b = COLnew(0, TYPE_##tpe, cnt, TRANSIENT);                                              \
      60             :                 if (!b) break;                                                  \
      61             :                 b->tnil = false; b->tnonil = true; b->tkey = false;                            \
      62             :                 b->tsorted = true; b->trevsorted = true;                                          \
      63             :                 b->tseqbase = oid_nil;                                                                                       \
      64             :                 p = (tpe*) Tloc(b, 0);                                                                                  \
      65             :                 for( j = 0; j < cnt; j++, p++){                                                                  \
      66             :                         *p = mapfun((tpe) access_fun(s)[j]);                                            \
      67             :                         if (na_check){ b->tnil = true;       b->tnonil = false;   *p= tpe##_nil;} \
      68             :                         if (j > 0){                                                                                                  \
      69             :                                 if (b->trevsorted && !is_##tpe##_nil(*p) && (is_##tpe##_nil(prev) || *p > prev)){ \
      70             :                                         b->trevsorted = false;                                                               \
      71             :                                 } else                                                                                                  \
      72             :                                         if (b->tsorted && !is_##tpe##_nil(prev) && (is_##tpe##_nil(*p) || *p < prev)){ \
      73             :                                                 b->tsorted = false;                                                          \
      74             :                                         }                                                                                                       \
      75             :                         }                                                                                                                       \
      76             :                         prev = *p;                                                                                                      \
      77             :                 }                                                                                                                               \
      78             :                 BATsetcount(b, cnt);                                                                                    \
      79             :                 BATsettrivprop(b);                                                                                              \
      80             :         } while (0)
      81             : 
      82             : // DATE epoch differs betwen MonetDB (00-01-01) and R (1970-01-01)
      83             : // no c API for R date handling so use fixed offset
      84             : // >>`-as.double(as.Date(0, origin="0-1-1"))`
      85             : static const int days0To1970 = 719528;
      86             : 
      87             : static int
      88           4 : mDate_to_rDate(int v)
      89             : {
      90           4 :         return v-days0To1970;
      91             : }
      92             : 
      93             : static int
      94           3 : rDate_to_mDate(int v)
      95             : {
      96           3 :         return v+days0To1970;
      97             : }
      98             : 
      99             : static SEXP
     100         161 : bat_to_sexp(BAT* b, int type)
     101             : {
     102         161 :         SEXP varvalue = NULL;
     103             :         // TODO: deal with SQL types (DECIMAL/TIME/TIMESTAMP)
     104         161 :         switch (ATOMstorage(b->ttype)) {
     105           0 :         case TYPE_void: {
     106           0 :                 size_t i = 0;
     107           0 :                 varvalue = PROTECT(NEW_LOGICAL(BATcount(b)));
     108           0 :                 if (!varvalue) {
     109             :                         return NULL;
     110             :                 }
     111           0 :                 for (i = 0; i < BATcount(b); i++) {
     112           0 :                         LOGICAL_POINTER(varvalue)[i] = NA_LOGICAL;
     113             :                 }
     114             :                 break;
     115             :         }
     116           6 :         case TYPE_bte:
     117          22 :                 BAT_TO_INTSXP(b, bte, varvalue, 0);
     118             :                 break;
     119           1 :         case TYPE_sht:
     120           7 :                 BAT_TO_INTSXP(b, sht, varvalue, 0);
     121             :                 break;
     122          49 :         case TYPE_int:
     123             :                 //Storage is int but the actual defined type may be different
     124          49 :                 switch (type) {
     125             :                 case TYPE_int:
     126             :                         //Storage is int but the actual defined type may be different
     127          45 :                         switch (type) {
     128          45 :                                 case TYPE_int: {
     129             :                                         // special case: memcpy for int-to-int conversion without NULLs
     130          93 :                                         BAT_TO_INTSXP(b, int, varvalue, 1);
     131             :                                 } break;
     132             :                                 default: {
     133             :                                         if (type == ATOMindex("date")) {
     134             :                                                 BAT_TO_DATESXP(b, int, varvalue, 0);
     135             :                                         } else {
     136             :                                                 //Type stored as int but no implementation to decode into native R type
     137             :                                                 BAT_TO_INTSXP(b, int, varvalue, 1);
     138             :                                         }
     139             :                                 }
     140             :                         }
     141             :                         break;
     142           4 :                 default:
     143           4 :                         if (type == TYPE_date) {
     144           6 :                                 BAT_TO_DATESXP(b, int, varvalue, 0);
     145             :                         } else {
     146             :                                 //Type stored as int but no implementation to decode into native R type
     147           2 :                                 BAT_TO_INTSXP(b, int, varvalue, 1);
     148             :                         }
     149             :                         break;
     150             :                 }
     151             :                 break;
     152             : #ifdef HAVE_HGE
     153           1 :         case TYPE_hge: /* R's integers are stored as int, so we cannot be sure hge will fit */
     154           5 :                 BAT_TO_REALSXP(b, hge, varvalue, 0);
     155             :                 break;
     156             : #endif
     157           2 :         case TYPE_flt:
     158           7 :                 BAT_TO_REALSXP(b, flt, varvalue, 0);
     159             :                 break;
     160          84 :         case TYPE_dbl:
     161             :                 // special case: memcpy for double-to-double conversion without NULLs
     162         558 :                 BAT_TO_REALSXP(b, dbl, varvalue, 1);
     163             :                 break;
     164          11 :         case TYPE_lng: /* R's integers are stored as int, so we cannot be sure long will fit */
     165      201005 :                 BAT_TO_REALSXP(b, lng, varvalue, 0);
     166             :                 break;
     167           7 :         case TYPE_str: { // there is only one string type, thus no macro here
     168           7 :                 BUN p, q, j = 0;
     169           7 :                 BATiter li = bat_iterator(b);
     170           7 :                 varvalue = PROTECT(NEW_STRING(BATcount(b)));
     171           7 :                 if (varvalue == NULL) {
     172             :                         return NULL;
     173             :                 }
     174             :                 /* special case where we exploit the duplicate-eliminated string heap */
     175           7 :                 if (GDK_ELIMDOUBLES(b->tvheap)) {
     176           7 :                         SEXP* sexp_ptrs = GDKzalloc(b->tvheap->free * sizeof(SEXP));
     177           7 :                         if (!sexp_ptrs) {
     178             :                                 return NULL;
     179             :                         }
     180         490 :                         BATloop(b, p, q) {
     181         483 :                                 const char *t = (const char *) BUNtvar(li, p);
     182         483 :                                 ptrdiff_t offset = t - b->tvheap->base;
     183         483 :                                 if (!sexp_ptrs[offset]) {
     184          42 :                                         if (strNil(t)) {
     185           1 :                                                 sexp_ptrs[offset] = NA_STRING;
     186             :                                         } else {
     187          20 :                                                 sexp_ptrs[offset] = RSTR(t);
     188             :                                         }
     189             :                                 }
     190         483 :                                 SET_STRING_ELT(varvalue, j++, sexp_ptrs[offset]);
     191             :                         }
     192           7 :                         GDKfree(sexp_ptrs);
     193             :                 }
     194             :                 else {
     195           0 :                         if (b->tnonil) {
     196           0 :                                 BATloop(b, p, q) {
     197           0 :                                         SET_STRING_ELT(varvalue, j++, RSTR(
     198             :                                                                            (const char *) BUNtvar(li, p)));
     199             :                                 }
     200             :                         }
     201             :                         else {
     202           0 :                                 BATloop(b, p, q) {
     203           0 :                                         const char *t = (const char *) BUNtvar(li, p);
     204           0 :                                         if (strNil(t)) {
     205           0 :                                                 SET_STRING_ELT(varvalue, j++, NA_STRING);
     206             :                                         } else {
     207           0 :                                                 SET_STRING_ELT(varvalue, j++, RSTR(t));
     208             :                                         }
     209             :                                 }
     210             :                         }
     211             :                 }
     212           7 :         }       break;
     213             :         }
     214             :         return varvalue;
     215             : }
     216             : 
     217          81 : static BAT* sexp_to_bat(SEXP s, int type) {
     218          81 :         BAT* b = NULL;
     219          81 :         BUN cnt = LENGTH(s);
     220          81 :         switch (type) {
     221          44 :         case TYPE_int:
     222          44 :                 if (!IS_INTEGER(s)) {
     223             :                         return NULL;
     224             :                 }
     225      402330 :                 SXP_TO_BAT(int, INTEGER_POINTER, *p==NA_INTEGER, R_TO_M_NOOP);
     226             :                 break;
     227           1 :         case TYPE_lng:
     228           1 :                 if (!IS_INTEGER(s)) {
     229             :                         return NULL;
     230             :                 }
     231           6 :                 SXP_TO_BAT(lng, INTEGER_POINTER, *p==NA_INTEGER, R_TO_M_NOOP);
     232             :                 break;
     233             : #ifdef HAVE_HGE
     234           1 :         case TYPE_hge:
     235           1 :                 if (!IS_INTEGER(s)) {
     236             :                         return NULL;
     237             :                 }
     238           6 :                 SXP_TO_BAT(hge, INTEGER_POINTER, *p==NA_INTEGER, R_TO_M_NOOP);
     239             :                 break;
     240             : #endif
     241           3 :         case TYPE_bte:
     242             :         case TYPE_bit:                   // only R logical types fit into bit BATs
     243           3 :                 if (!IS_LOGICAL(s)) {
     244             :                         return NULL;
     245             :                 }
     246        1008 :                 SXP_TO_BAT(bit, LOGICAL_POINTER, *p==NA_LOGICAL, R_TO_M_NOOP);
     247             :                 break;
     248          25 :         case TYPE_dbl:
     249          25 :                 if (!IS_NUMERIC(s)) {
     250             :                         return NULL;
     251             :                 }
     252        1057 :                 SXP_TO_BAT(dbl, NUMERIC_POINTER, (ISNA(*p) || isnan(*p) || isinf(*p)), R_TO_M_NOOP);
     253             :                 break;
     254           6 :         case TYPE_str: {
     255           6 :                 SEXP levels;
     256           6 :                 size_t j;
     257           6 :                 if (!IS_CHARACTER(s) && !isFactor(s)) {
     258             :                         return NULL;
     259             :                 }
     260           6 :                 b = COLnew(0, TYPE_str, cnt, TRANSIENT);
     261           6 :                 if (!b) return NULL;
     262           6 :                 b->tnil = false;
     263           6 :                 b->tnonil = true;
     264           6 :                 b->tkey = false;
     265           6 :                 b->tsorted = false;
     266           6 :                 b->trevsorted = false;
     267             :                 /* get levels once, since this is a function call */
     268           6 :                 levels = GET_LEVELS(s);
     269             : 
     270          38 :                 for (j = 0; j < cnt; j++) {
     271          26 :                         SEXP rse;
     272          26 :                         if (isFactor(s)) {
     273          17 :                                 int ii = INTEGER(s)[j];
     274          17 :                                 if (ii == NA_INTEGER) {
     275           1 :                                         rse = NA_STRING;
     276             :                                 } else {
     277          16 :                                         rse = STRING_ELT(levels, ii - 1);
     278             :                                 }
     279             :                         } else {
     280           9 :                                 rse = STRING_ELT(s, j);
     281             :                         }
     282          26 :                         if (rse == NA_STRING) {
     283           2 :                                 b->tnil = true;
     284           2 :                                 b->tnonil = false;
     285           2 :                                 if (BUNappend(b, str_nil, false) != GDK_SUCCEED) {
     286           0 :                                         BBPreclaim(b);
     287           0 :                                         return NULL;
     288             :                                 }
     289             :                         } else {
     290          24 :                                 if (BUNappend(b, CHAR(rse), false) != GDK_SUCCEED) {
     291           0 :                                         BBPreclaim(b);
     292           0 :                                         return NULL;
     293             :                                 }
     294             :                         }
     295             :                 }
     296             :                 break;
     297             :         }
     298           1 :         default:
     299           1 :                 if (type == TYPE_date) {
     300           1 :                         if (!IS_NUMERIC(s)) {
     301             :                                 return NULL;
     302             :                         }
     303           4 :                         SXP_TO_BAT(date, NUMERIC_POINTER, *p==NA_REAL, R_TO_M_DATE);
     304             :                 }
     305             :         }
     306             : 
     307          80 :         if (b) {
     308          80 :                 BATsetcount(b, cnt);
     309          80 :                 BBPkeepref(b->batCacheid);
     310             :         }
     311             :         return b;
     312             : }

Generated by: LCOV version 1.14