The R Project SVN R-packages

Rev

Rev 3324 | Rev 3397 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
3255 mrmanese 1
#include "sqlite_dataframe.h"
3307 mrmanese 2
#include <math.h>
3
#include "Rmath.h"
3255 mrmanese 4
 
3358 mrmanese 5
/****************************************************************************
6
 * UTILITY FUNCTIONS
7
 ****************************************************************************/
8
static char *_create_svector1(SEXP name, const char *type, int * _namelen) {
9
    int namelen, res;
10
    char *iname = _create_sdf_skeleton1(name, &namelen);
3255 mrmanese 11
 
3358 mrmanese 12
    if (iname == NULL) return NULL;
3255 mrmanese 13
 
3358 mrmanese 14
    sprintf(g_sql_buf[2], "create table [%s].sdf_data ([row name] text, "
15
            "V1 %s, primary key ([row name]))", iname, type);
16
    res = _sqlite_exec(g_sql_buf[2]);
17
    _sqlite_error(res);
3308 mrmanese 18
 
3358 mrmanese 19
    if (_namelen != NULL) *_namelen = namelen;
20
    return iname;
21
}
3255 mrmanese 22
 
3358 mrmanese 23
static SEXP _create_svector_sexp(const char *iname, const char *varname, 
24
        const char *type) {
25
    SEXP ret, value; int nprotected = 0;
3255 mrmanese 26
    PROTECT(ret = NEW_LIST(2)); nprotected++;
27
 
28
    /* set list names */
29
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
30
    SET_STRING_ELT(value, 0, mkChar("iname"));
31
    SET_STRING_ELT(value, 1, mkChar("varname"));
32
    SET_NAMES(ret, value);
33
 
34
    /* set list values */
35
    SET_VECTOR_ELT(ret, 0, mkString(iname));
36
    SET_VECTOR_ELT(ret, 1, mkString(varname));
37
 
3358 mrmanese 38
    /* set sexp class */
39
    if (strcmp(type, "ordered") == 0) {
40
        PROTECT(value = NEW_CHARACTER(3)); nprotected++;
41
        SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
42
        SET_VECTOR_ELT(value, 1, mkChar(type));
43
        SET_VECTOR_ELT(value, 2, mkChar("factor"));
44
    } else {
3255 mrmanese 45
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
3358 mrmanese 46
        SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
47
        SET_VECTOR_ELT(value, 1, mkChar(type));
48
        SET_CLASS(ret, value);
3255 mrmanese 49
    }
50
 
51
    UNPROTECT(nprotected);
3358 mrmanese 52
 
3255 mrmanese 53
    return ret;
54
}
55
 
3358 mrmanese 56
/* if ret == NULL, 3rd arg is the length of the vector created. otherwise
57
 * it is the index in the vector ret where we will put the result extracted
58
 * from ret */
3255 mrmanese 59
int _get_vector_index_typed_result(sqlite3_stmt *stmt, SEXP *ret, int idx_or_len) {
60
    int added = 1;
61
    if (*ret == NULL || *ret == R_NilValue) {
62
        const char *coltype = sqlite3_column_decltype(stmt, 0);
63
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
64
            added = 0;
65
        }
66
 
67
        if (strcmp(coltype, "text") == 0) {
68
            PROTECT(*ret = NEW_CHARACTER(idx_or_len));
69
            if (added) 
3284 mrmanese 70
                SET_STRING_ELT(*ret, 0, mkChar((char *)sqlite3_column_text(stmt, 0)));
3255 mrmanese 71
        } else if (strcmp(coltype, "double") == 0) {
72
            PROTECT(*ret = NEW_NUMERIC(idx_or_len));
73
            if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);
74
        } else if (strcmp(coltype, "bit") == 0) {
75
            PROTECT(*ret = NEW_LOGICAL(idx_or_len));
76
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
77
        } else if (strcmp(coltype, "integer") == 0 || 
78
                   strcmp(coltype, "int") == 0) {
79
            /* caller should just copy off the vars level attr for factors */
80
            PROTECT(*ret = NEW_INTEGER(idx_or_len));
81
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
82
        } else added = 0;
83
 
84
        UNPROTECT(1);
85
    } else {
86
        const char *coltype = sqlite3_column_decltype(stmt, 0);
87
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
88
            added = 0;
89
        } else if (strcmp(coltype, "text") == 0) {
90
            SET_STRING_ELT(*ret, idx_or_len, 
3284 mrmanese 91
                    mkChar((char *)sqlite3_column_text(stmt, 0)));
3255 mrmanese 92
        } else if (strcmp(coltype, "double") == 0) {
93
            REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);
94
        } else if (strcmp(coltype, "bit") == 0) {
95
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
96
        } else if (strcmp(coltype, "integer") == 0 ||
97
                   strcmp(coltype, "int") == 0) {
98
            /* caller should just copy off the vars level attr for factors */
99
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
100
        } else added = 0;
101
    }
102
 
103
    return added;
104
}
105
 
3358 mrmanese 106
/****************************************************************************
107
 * SVEC FUNCTIONS
108
 ****************************************************************************/
109
SEXP sdf_get_variable(SEXP sdf, SEXP name) {
110
    if (!IS_CHARACTER(name)) {
111
        Rprintf("ERROR: argument is not a string.\n");
112
        return R_NilValue;
113
    }
114
 
115
    char *iname = SDF_INAME(sdf);
116
    char *varname = CHAR_ELT(name, 0);
117
 
118
    if (!USE_SDF1(iname, TRUE)) return R_NilValue;
119
 
120
    /* check if sdf & varname w/in that sdf exists */
121
    sqlite3_stmt *stmt;
122
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
123
 
124
    int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
125
 
126
    if (_sqlite_error(res)) return R_NilValue;
127
 
128
    const char *coltype = sqlite3_column_decltype(stmt, 0);
129
    sqlite3_finalize(stmt);
130
 
131
 
132
    SEXP ret, value, class = R_NilValue; int nprotected = 0;
133
    PROTECT(ret = NEW_LIST(2)); nprotected++;
134
 
135
    /* set list names */
136
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
137
    SET_STRING_ELT(value, 0, mkChar("iname"));
138
    SET_STRING_ELT(value, 1, mkChar("varname"));
139
    SET_NAMES(ret, value);
140
 
141
    /* set list values */
142
    SET_VECTOR_ELT(ret, 0, mkString(iname));
143
    SET_VECTOR_ELT(ret, 1, mkString(varname));
144
 
145
    /* set class */
146
    int type = -1;
147
    if (strcmp(coltype, "text") == 0) class = mkChar("character");
148
    else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");
149
    else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");
150
    else if (strcmp(coltype, "integer") == 0 || strcmp(coltype, "int") == 0) {
151
        /* determine if int, factor or ordered */
152
        type = _get_factor_levels1(iname, varname, ret);
153
        switch(type) {
154
            case VAR_INTEGER: class = mkChar("integer"); break;
155
            case VAR_FACTOR: class = mkChar("factor"); break;
156
            case VAR_ORDERED: class = mkChar("ordered");
157
        }
158
 
159
    }
160
 
161
    if (type != VAR_ORDERED) {
162
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
163
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
164
        SET_STRING_ELT(value, 1, class);
165
    } else {
166
        PROTECT(value = NEW_CHARACTER(3)); nprotected++;
167
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
168
        SET_STRING_ELT(value, 1, class);
169
        SET_STRING_ELT(value, 2, mkChar("factor"));
170
    }
171
    SET_CLASS(ret, value);
172
 
173
    UNPROTECT(nprotected);
174
    return ret;
175
 
176
}
177
 
178
 
3255 mrmanese 179
SEXP sdf_get_variable_length(SEXP svec) {
180
    char *iname = SDF_INAME(svec);
3358 mrmanese 181
    if (!USE_SDF1(iname, TRUE)) return R_NilValue;
3255 mrmanese 182
 
183
    SEXP ret;
184
    PROTECT(ret = NEW_INTEGER(1));
3358 mrmanese 185
    INTEGER(ret)[0] = _get_row_count2(iname, 1);
3255 mrmanese 186
    UNPROTECT(1);
187
    return ret;
188
}
189
 
190
 
191
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
192
    SEXP ret = R_NilValue, tmp;
193
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
3282 mrmanese 194
    int index, idxlen, i, retlen=0, res;
3358 mrmanese 195
    sqlite3_stmt *stmt;
3255 mrmanese 196
 
3358 mrmanese 197
    if (!USE_SDF1(iname, TRUE)) return R_NilValue;
3308 mrmanese 198
 
3255 mrmanese 199
    idxlen = LENGTH(idx);
200
    if (idxlen < 1) return ret;
201
 
202
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",
203
            varname, iname);
204
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
205
 
206
    /* get data based on index */
207
    if (IS_NUMERIC(idx)) {
208
        index = ((int) REAL(idx)[0]) - 1;
209
        if (index < 0 && idxlen == 1) return ret;
210
 
3281 mrmanese 211
        if (index >= 0) {
3255 mrmanese 212
            sqlite3_bind_int(stmt, 1, index);
213
            res = sqlite3_step(stmt);
214
            if (res == SQLITE_ROW) { 
215
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
216
            } 
217
        } 
218
 
3281 mrmanese 219
        if (index < 0 || res != SQLITE_ROW) {
3255 mrmanese 220
            /* something wrong w/ 1st idx, and it is quietly ignored. we make 
221
             * a "dummy" call to setup the SEXP */
3358 mrmanese 222
            sqlite3_reset(stmt);
3255 mrmanese 223
            sqlite3_bind_int(stmt, 1, 0);
3358 mrmanese 224
            res = sqlite3_step(stmt);
225
            if (res == SQLITE_ROW) {
226
                _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
227
            }
3255 mrmanese 228
            retlen = 0;
229
        }
230
 
3358 mrmanese 231
 
3255 mrmanese 232
        if (idxlen > 1) {
233
            for (i = 1; i < idxlen; i++) {
234
                index = ((int) REAL(idx)[i]) - 1;
235
                if (index < 0) continue;
236
                sqlite3_reset(stmt);
237
                sqlite3_bind_int(stmt, 1, index);
238
                res = sqlite3_step(stmt);
239
                if (res == SQLITE_ROW)
240
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
241
            }
242
        }
243
    } else if (IS_INTEGER(idx)) {
244
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
245
         * to cast idx to int. can't refactor this out, sucks. */
246
        index = INTEGER(idx)[0] - 1;
247
        if (index < 0 && idxlen == 1) return ret;
248
 
3281 mrmanese 249
        if (index >= 0) {
3255 mrmanese 250
            sqlite3_bind_int(stmt, 1, index);
3281 mrmanese 251
            res = sqlite3_step(stmt);
252
            if (res == SQLITE_ROW) { 
253
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
254
            } 
255
        } 
256
 
257
        if (index < 0 || res != SQLITE_ROW) {
258
            /* something wrong w/ 1st idx, and it is quietly ignored. we make 
259
             * a "dummy" call to setup the SEXP */
3358 mrmanese 260
            sqlite3_reset(stmt);
3255 mrmanese 261
            sqlite3_bind_int(stmt, 1, 0);
3358 mrmanese 262
            res = sqlite3_step(stmt);
263
            if (res == SQLITE_ROW) {
264
                _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
265
            }
3255 mrmanese 266
            retlen = 0;
267
        }
268
 
269
        if (idxlen > 1) {
270
            for (i = 1; i < idxlen; i++) {
271
                index = INTEGER(idx)[i] - 1;
272
                if (index < 0) continue;
273
                sqlite3_reset(stmt);
274
                sqlite3_bind_int(stmt, 1, index);
275
                sqlite3_step(stmt);
276
                retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
277
            }
278
        }
279
 
280
    } else if (IS_LOGICAL(idx)) {
281
        /* have to deal with recycling */
3358 mrmanese 282
        int veclen = _get_row_count2(iname, 1);
3255 mrmanese 283
 
284
        /* find if there is any TRUE element in the vector */
3281 mrmanese 285
        for (i = 0; i < idxlen && i < veclen; i++) {
3255 mrmanese 286
            if (LOGICAL(idx)[i]) {
287
                sqlite3_bind_int(stmt, 1, i);
288
                sqlite3_step(stmt);
289
                /* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
290
                 * index. there are at least (veclen/idxlen) cycles (int div).
291
                 * at the last cycle, if (veclen%idxlen > 0), there will be
292
                 * at least (veclen%idxlen - i) if veclen%idxlen > i */
293
                retlen = (idxlen-i) * (veclen/idxlen);
294
                if (veclen%idxlen > i) retlen += (veclen%idxlen - i);
295
 
296
                /* create the vector */
297
                retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
298
                break;
299
            }
300
        }
301
 
3281 mrmanese 302
        if (i < idxlen && i < veclen) {
3255 mrmanese 303
            for (i++; i < veclen; i++) {
304
                if (LOGICAL(idx)[i%idxlen]) {
305
                    sqlite3_reset(stmt);
306
                    sqlite3_bind_int(stmt, 1, i);
307
                    sqlite3_step(stmt);
308
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
309
                }
310
            }
311
        }
312
    }
313
 
314
    sqlite3_finalize(stmt);
315
 
316
    if (ret != R_NilValue) {
317
        ret = _shrink_vector(ret, retlen);
318
        tmp = GET_LEVELS(svec);
319
        if (tmp != R_NilValue) {
320
            SET_LEVELS(ret, duplicate(tmp));
321
            if (LENGTH(GET_CLASS(svec)) == 2) {
322
                SET_CLASS(ret, mkString("factor"));
323
            } else {
324
                PROTECT(tmp = NEW_CHARACTER(2));
325
                SET_STRING_ELT(tmp, 0, mkChar("ordered"));
326
                SET_STRING_ELT(tmp, 1, mkChar("factor"));
327
                UNPROTECT(1);
328
            }
329
        }
330
    }
331
 
332
    return ret;
333
}
334
 
3358 mrmanese 335
/* sqlite.vector.[<- */
336
SEXP sdf_set_variable_index(SEXP svec, SEXP idx, SEXP value) {
337
    int idx_len, val_len;
338
 
339
    /* match levels if factor or ordered */
340
    if (inherits(value, "ordered")) {
341
    } else if (inherits(value, "factor")) {
342
    }
343
 
344
    idx_len = LENGTH(idx);
345
    val_len = LENGTH(value);
346
 
347
    if (IS_NUMERIC(idx)) {
348
    } else if (IS_INTEGER(idx)) {
349
    } else if (IS_LOGICAL(idx)) {
350
    }
351
 
352
    return R_NilValue;
353
}
354
 
3324 mrmanese 355
/* the global accumulator should be safe if we only do 1 cummulative or
356
 * aggregate at any time. it won't work for stuffs like "select max(col)-min(col)
357
 * from sdf_data". */
358
static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */
359
static int g_start = 0;            /* flag for start of cummulation */
360
static int g_narm = 0;             /* for Summary group */
3255 mrmanese 361
 
3307 mrmanese 362
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {
363
    char *iname, *iname_src, *varname_src, *funcname;
364
    int namelen, res, nargs;
365
    sqlite3_stmt *stmt;
3255 mrmanese 366
 
3307 mrmanese 367
    /* get data from arguments (function name and sqlite.vector stuffs) */
368
    funcname = CHAR_ELT(func, 0);
369
    iname_src = SDF_INAME(vector);
370
    varname_src = SVEC_VARNAME(vector);
371
    nargs = INTEGER(_nargs)[0];
3255 mrmanese 372
 
3358 mrmanese 373
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
3308 mrmanese 374
 
3307 mrmanese 375
    /* check nargs */
376
    if (nargs > 2) {
377
        Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");
378
        return R_NilValue;
379
    }
380
 
381
    /* create a new sdf, with 1 column named V1 */
3358 mrmanese 382
    iname = _create_svector1(R_NilValue, "double", &namelen);
3307 mrmanese 383
 
384
    /* insert into <newsdf>.col, row.names select func(col), rownames */
385
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
386
            "select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,
387
            varname_src, iname_src);
388
 
389
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
390
    if (_sqlite_error(res)) {
391
        sprintf(g_sql_buf[0], "detach %s", iname);
392
        _sqlite_exec(g_sql_buf[0]);
393
 
394
        /* we will return a string with the file name, and do file.remove
395
         * at R */
396
        iname[namelen] = '.';
397
        return mkString(iname);
398
    }
399
 
3324 mrmanese 400
    g_accumulator = 0.0;   /* initialize accumulator */
401
    g_start = 1;           /* flag that we are at start of accumulating */
3307 mrmanese 402
    sqlite3_step(stmt);
403
    sqlite3_finalize(stmt);
404
 
3358 mrmanese 405
    return _create_svector_sexp(iname, "V1", "numeric");
406
}
3307 mrmanese 407
 
3358 mrmanese 408
SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2) {
409
    char *iname = NULL, *iname_src, *varname_src, *funcname;
410
    int res, functype = -1, op2_len, svec_len, i;
411
    sqlite3_stmt *stmt, *stmt2;
3307 mrmanese 412
 
3358 mrmanese 413
    /* get data from arguments (function name and sqlite.vector stuffs) */
414
    funcname = CHAR_ELT(func, 0);
415
    iname_src = SDF_INAME(vector);
416
    varname_src = SVEC_VARNAME(vector);
3307 mrmanese 417
 
3358 mrmanese 418
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
419
    switch(funcname[0]) {
420
        case '+' :
421
        case '-' :
422
        case '*' :
423
        case '/' :
424
        case '^' :
425
        case '%' : /* %% and %/% */ 
426
            functype = 0; break;  /* output is REAL */
427
        case '&' :
428
        case '|' :
429
        case '!' :  /* ! and != */
430
            if (funcname[1] == 0) { functype = 1; break; }
431
        case '=' :  /* == */
432
        case '<' :  /* < and <= */
433
        case '>' :  /* > and >= */
434
            functype = 2; 
435
    }
3307 mrmanese 436
 
3358 mrmanese 437
    svec_len = _get_row_count2(iname_src, 1);
438
    if (functype == 0 || functype == 2 || (functype == 1 && funcname[0] != '!')) {
439
        char *insert_fmt_string1c, *insert_fmt_string1s;
440
        char *insert_fmt_string2c, *insert_fmt_string2s;
441
        iname = _create_svector1(R_NilValue, (functype == 0) ? "double" : "bit", NULL);
3307 mrmanese 442
 
3358 mrmanese 443
        if (functype == 1) { /* boolean binary operators */
444
            insert_fmt_string1s = "insert into [%s].sdf_data "
445
                        "select [row name], ([%s] != 0) %s (? != 0) from [%s].sdf_data";
446
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, (? != 0) %s (? != 0))";
447
            /* no need for char version of fmt_string2, since %% only occurs for functype==0 */
448
            insert_fmt_string1c = insert_fmt_string1s;
449
            insert_fmt_string2c = insert_fmt_string2s;
450
        } else {
451
            insert_fmt_string1s = "insert into [%s].sdf_data "
452
                        "select [row name], [%s] %s ? from [%s].sdf_data";
453
            insert_fmt_string1c = "insert into [%s].sdf_data "
454
                        "select [row name], [%s] %c ? from [%s].sdf_data";
455
            /* fmt_string2c format operator from a char, used for %% and %/% */
456
            /* BUG: i'm casting to int before applying / & %, w/c is different
457
             * from R. added trunc to pass package test */
458
            insert_fmt_string2c = "insert into [%s].sdf_data values(?, trunc(? %c ?))";
459
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, ? %s ?)";
460
        }
3307 mrmanese 461
 
3358 mrmanese 462
 
463
        if (IS_NUMERIC(op2)) {
464
            op2_len = LENGTH(op2);
465
 
466
            if (op2_len == 1) {
467
                if (funcname[0] == '%') {
468
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
469
                            varname_src, funcname[1], iname_src);
470
                } else {
471
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
472
                            varname_src, funcname, iname_src);
473
                }
474
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
475
                _sqlite_error(res);
476
                sqlite3_bind_double(stmt, 1, REAL(op2)[0]);
477
                sqlite3_step(stmt);
478
            } else if (op2_len <= svec_len) {  /* recycle op2 */
479
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
480
                        varname_src, iname_src);
481
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
482
                _sqlite_error(res);
483
 
484
                if (funcname[0] == '%') {
485
                    /* sqlite does int div with "/" if both args are int. mod is % also.
486
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
487
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
488
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
489
                    _sqlite_error(res);
490
 
491
                    for (i = 0; i < svec_len; i++) {
492
                        sqlite3_step(stmt2);
493
 
494
                        sqlite3_reset(stmt);
495
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
496
                        sqlite3_bind_int(stmt, 2, (int)sqlite3_column_double(stmt2, 1));
497
                        sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
498
                        sqlite3_step(stmt);
499
                    }
500
                } else { /* non-integer binary operation */
501
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
502
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
503
                    _sqlite_error(res);
504
 
505
                    for (i = 0; i < svec_len; i++) {
506
                        sqlite3_step(stmt2);
507
 
508
                        sqlite3_reset(stmt);
509
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
510
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
511
                        sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
512
                        sqlite3_step(stmt);
513
                    }
514
                }
515
                sqlite3_finalize(stmt2);
516
            } else { /* op2_len > svec_len, recycle svec */
517
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
518
                        varname_src, iname_src);
519
 
520
                if (funcname[0] == '%') {
521
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
522
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
523
                    _sqlite_error(res);
524
                } else {
525
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
526
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
527
                    _sqlite_error(res);
528
                }
529
 
530
                i = 0;
531
                while (i < op2_len) {
532
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
533
                    _sqlite_error(res);
534
 
535
                    if (funcname[0] == '%') {
536
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
537
                            sqlite3_step(stmt2);
538
 
539
                            sqlite3_reset(stmt);
540
                            /* simplify my life, just use ints for row names so that we
541
                             * don't have to worry about duplicates */
542
                            sqlite3_bind_int(stmt, 1, i); 
543
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
544
                            sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
545
                            sqlite3_step(stmt);
546
                        }
547
                    } else {
548
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
549
                            sqlite3_step(stmt2);
550
 
551
                            sqlite3_reset(stmt);
552
                            sqlite3_bind_int(stmt, 1, i);
553
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
554
                            sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
555
                            sqlite3_step(stmt);
556
                        }
557
                    }
558
 
559
                    /* recycle on svec if we loop again */
560
                    sqlite3_finalize(stmt2);
561
                }
562
            }
563
 
564
            sqlite3_finalize(stmt);
565
        } else if (IS_INTEGER(op2) || IS_LOGICAL(op2)) { /* I N T E G E R */
566
            /* we are taking advantage of the fact that logicals are stored as int.
567
             * if this becomes untrue in the future, then this is a bug */
568
            op2_len = LENGTH(op2);
569
 
570
            if (op2_len == 1) {
571
                if (funcname[0] == '%') {
572
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
573
                            varname_src, funcname[1], iname_src);
574
                } else {
575
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
576
                            varname_src, funcname, iname_src);
577
                }
578
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
579
                _sqlite_error(res);
580
                sqlite3_bind_double(stmt, 1, (double)INTEGER(op2)[0]);
581
                sqlite3_step(stmt);
582
            } else if (op2_len <= svec_len) {
583
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
584
                        varname_src, iname_src);
585
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
586
                _sqlite_error(res);
587
 
588
                if (funcname[0] == '%') {
589
                    /* sqlite does int div with "/" if both args are int. mod is % also.
590
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
591
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
592
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
593
                    _sqlite_error(res);
594
 
595
                    for (i = 0; i < svec_len; i++) {
596
                        sqlite3_step(stmt2);
597
 
598
                        sqlite3_reset(stmt);
599
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
600
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
601
                        sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
602
                        sqlite3_step(stmt);
603
                    }
604
                } else {
605
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
606
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
607
                    _sqlite_error(res);
608
 
609
                    for (i = 0; i < svec_len; i++) {
610
                        sqlite3_step(stmt2);
611
 
612
                        sqlite3_reset(stmt);
613
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
614
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
615
                        sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
616
                        sqlite3_step(stmt);
617
                    }
618
                }
619
                sqlite3_finalize(stmt2);
620
            } else {
621
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
622
                        varname_src, iname_src);
623
 
624
                if (funcname[0] == '%') {
625
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
626
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
627
                    _sqlite_error(res);
628
                } else {
629
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
630
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
631
                    _sqlite_error(res);
632
                }
633
 
634
                i = 0;
635
                while (i < op2_len) {
636
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
637
                    _sqlite_error(res);
638
 
639
                    if (funcname[0] == '%') {
640
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
641
                            sqlite3_step(stmt2);
642
 
643
                            sqlite3_reset(stmt);
644
                            /* simplify my life, just use ints for row names so that we
645
                             * don't have to worry about duplicates */
646
                            sqlite3_bind_int(stmt, 1, i); 
647
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
648
                            sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
649
                            sqlite3_step(stmt);
650
                        }
651
                    } else {
652
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
653
                            sqlite3_step(stmt2);
654
 
655
                            sqlite3_reset(stmt);
656
                            sqlite3_bind_int(stmt, 1, i);
657
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
658
                            sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
659
                            sqlite3_step(stmt);
660
                        }
661
                    }
662
 
663
                    /* recycle on svec if we loop again */
664
                    sqlite3_finalize(stmt2);
665
                }
666
            }
667
 
668
            sqlite3_finalize(stmt);
669
        } else if (inherits(op2, "sqlite.vector")) { 
670
            /* op2 is surely not a factor, as handled by the R wrapper */
671
            char *iname_op2, *varname_op2;
672
            sqlite3_stmt *stmt3;
673
            iname_op2 = SDF_INAME(op2);
674
            varname_op2 = SVEC_VARNAME(op2);
675
 
676
            if (!USE_SDF1(iname_op2, TRUE)) {
677
                /* delete created sqlite.vector */
678
                Rprintf("Warning: detaching created result SDF %s\n", iname);
679
                sdf_detach_sdf(mkString(iname));
680
                return R_NilValue;
681
            }
682
 
683
            op2_len = _get_row_count2(iname_op2, 1);
684
 
685
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_src, iname_src);
686
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
687
            _sqlite_error(res);
688
 
689
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_op2, iname_op2);
690
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt3, 0);
691
            _sqlite_error(res);
692
 
693
            if (funcname[0] == '%') {
694
                sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
695
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
696
                _sqlite_error(res);
697
 
698
                if (svec_len == op2_len) {
699
                    for (i = 0; i < svec_len; i++) {
700
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
701
 
702
                        sqlite3_reset(stmt);
703
                        sqlite3_bind_int(stmt, 1, i);
704
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
705
                        sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
706
                        sqlite3_step(stmt);
707
                    }
708
                } else if (svec_len < op2_len) {
709
                    i = 0;
710
                    while (i < op2_len) {
711
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
712
                            sqlite3_step(stmt3);
713
 
714
                            sqlite3_reset(stmt);
715
                            sqlite3_bind_int(stmt, 1, i);
716
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
717
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
718
                            sqlite3_step(stmt);
719
                        }
720
                        sqlite3_reset(stmt2);
721
                    }
722
                } else {
723
                    i = 0;
724
                    while (i < svec_len) {
725
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
726
                            sqlite3_step(stmt2);
727
 
728
                            sqlite3_reset(stmt);
729
                            sqlite3_bind_int(stmt, 1, i);
730
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
731
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
732
                            sqlite3_step(stmt);
733
                        }
734
                        sqlite3_reset(stmt3);
735
                    }
736
                }
737
            } else { /* not an integer op %% or %/% */
738
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
739
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
740
                _sqlite_error(res);
741
 
742
                if (svec_len == op2_len) {
743
                    for (i = 0; i < svec_len; i++) {
744
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
745
 
746
                        sqlite3_reset(stmt);
747
                        sqlite3_bind_int(stmt, 1, i);
748
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
749
                        sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
750
                        sqlite3_step(stmt);
751
                    }
752
                } else if (svec_len < op2_len) { /* recycle svec */
753
                    i = 0;
754
                    while (i < op2_len) {
755
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
756
                            sqlite3_step(stmt3);
757
 
758
                            sqlite3_reset(stmt);
759
                            sqlite3_bind_int(stmt, 1, i);
760
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
761
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
762
                            sqlite3_step(stmt);
763
                        }
764
                        sqlite3_reset(stmt2);
765
                    }
766
                } else { /* svec_len > op2_len, recycle op2 */
767
                    i = 0;
768
                    while (i < svec_len) {
769
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
770
                            sqlite3_step(stmt2);
771
 
772
                            sqlite3_reset(stmt);
773
                            sqlite3_bind_int(stmt, 1, i);
774
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
775
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
776
                            sqlite3_step(stmt);
777
                        }
778
                        sqlite3_reset(stmt3);
779
                    }
780
                }
781
            }
782
 
783
            sqlite3_finalize(stmt);
784
            sqlite3_finalize(stmt2);
785
            sqlite3_finalize(stmt3);
786
        }
787
    } else if (functype == 1 && funcname[0] != '!') { /* unary not operator */
788
        iname = _create_svector1(R_NilValue, "bit", NULL);
789
        sprintf(g_sql_buf[2], "insert into [%s].sdf_data "
790
                    "select [row name], [%s] == 0 from [%s].sdf_data", 
791
                    iname, varname_src, iname_src);
792
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
793
        _sqlite_error(res);
794
        sqlite3_step(stmt);
795
        sqlite3_finalize(stmt);
796
    }
797
 
798
    if (iname != NULL)
799
        return _create_svector_sexp(iname, "V1", 
800
                (functype == 0) ? "numeric" : "logical");
801
 
802
    return R_NilValue;
803
 
3307 mrmanese 804
}
805
 
3324 mrmanese 806
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
807
    char *iname_src, *varname_src, *funcname;
808
    int res;
809
    sqlite3_stmt *stmt;
810
    double _ret = NA_REAL; SEXP ret;
3307 mrmanese 811
 
3324 mrmanese 812
    /* get data from arguments (function name and sqlite.vector stuffs) */
813
    funcname = CHAR_ELT(func, 0);
814
    iname_src = SDF_INAME(vector);
815
    varname_src = SVEC_VARNAME(vector);
3307 mrmanese 816
 
3358 mrmanese 817
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
3324 mrmanese 818
 
819
    g_narm = LOGICAL(na_rm)[0];
820
    if (strcmp(funcname, "range") == 0) {
821
        /* special handling for range. use min then max */
822
        g_start = 1;
823
        g_accumulator = 0.0;
824
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
825
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
826
        if (_sqlite_error(res)) return R_NilValue;
827
        sqlite3_step(stmt); sqlite3_finalize(stmt);
828
        _ret = g_accumulator;
829
 
830
        if (R_IsNA(_ret) && !g_narm) {
831
            PROTECT(ret = NEW_NUMERIC(2));
832
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
833
            goto __sdf_do_variable_summary_out;
834
        }
835
 
836
        g_start = 1;
837
        g_accumulator = 0.0;
838
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
839
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
840
        if (_sqlite_error(res)) return R_NilValue;
841
        sqlite3_step(stmt); sqlite3_finalize(stmt);
842
 
843
        /* if there is NA, then the if above should have caught it already */
844
        PROTECT(ret = NEW_NUMERIC(2));
845
        REAL(ret)[0] = _ret;
846
        REAL(ret)[1] = g_accumulator;
847
    } else {
848
        g_start = 1;  /* we'll use these instead of sqlite3_aggregate_context */
849
        g_accumulator = 0.0;
850
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
851
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
852
        if (_sqlite_error(res)) return R_NilValue;
853
        res = sqlite3_step(stmt); sqlite3_finalize(stmt);
854
 
855
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
856
            PROTECT(ret = NEW_LOGICAL(1));
857
            if (R_IsNA(g_accumulator)) LOGICAL(ret)[0] = NA_INTEGER;
858
            else LOGICAL(ret)[0] = !(g_accumulator == 0);
859
        } else {
860
            PROTECT(ret = NEW_NUMERIC(1));
861
            REAL(ret)[0] = g_accumulator;
862
        }
863
    }
864
 
865
__sdf_do_variable_summary_out:
866
    UNPROTECT(1);
867
    return ret;
868
}
869
 
870
 
3358 mrmanese 871
SEXP sdf_sort_variable(SEXP svec, SEXP decreasing) {
872
    char *iname, *iname_src, *varname_src, *type;
873
    sqlite3_stmt *stmt;
874
    int res;
875
 
876
    iname_src = SDF_INAME(svec);
877
    varname_src = SVEC_VARNAME(svec);
878
 
879
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
880
 
881
    /* determine type of svec */
882
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit 1", varname_src, iname_src);
883
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
884
    _sqlite_error(res);
885
    sqlite3_step(stmt);
886
    strcpy(g_sql_buf[0], sqlite3_column_decltype(stmt, 0));
887
    sqlite3_finalize(stmt);
888
 
889
    /* create a new vector of that type */
890
    iname = _create_svector1(R_NilValue, g_sql_buf[0], NULL);
891
 
892
    /* insert to new sdf ordered */
893
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data "
894
            "select [row name], [%s] from [%s].sdf_data "
895
            "order by [%s] %s", iname, varname_src, iname_src, varname_src,
896
            (LOGICAL(decreasing)[0]) ? "desc" : "asc");
897
    res = _sqlite_exec(g_sql_buf[0]);
898
    _sqlite_error(res);
899
 
900
    if (inherits(svec, "factor")) { /* copy factor table to iname */
901
        if (inherits(svec, "ordered")) type = "ordered";
902
        else type = "factor";
903
        _copy_factor_levels2(type, iname_src, varname_src, iname, "V1");
904
    } else type = CHAR_ELT(GET_CLASS(svec), 1);
905
 
906
    return _create_svector_sexp(iname, "V1", type);
907
}
908
 
3307 mrmanese 909
/****************************************************************************
910
 * VECTOR MATH/OPS/GROUP OPERATIONS
911
 ****************************************************************************/
3324 mrmanese 912
 
3307 mrmanese 913
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
914
    int ret = 1;
915
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
916
        sqlite3_result_null(ctx); 
917
        ret = 0;
918
    } else {
919
        if (sqlite3_value_type(arg) == SQLITE_INTEGER) 
920
            *value = sqlite3_value_int(arg); 
921
        else *value = sqlite3_value_double(arg); 
922
    }
923
    return ret;
924
}
925
 
926
#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\
927
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
928
    double value; \
929
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
930
        sqlite3_result_double(ctx, func(value)); \
931
    }  \
932
}
933
 
3324 mrmanese 934
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
935
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
936
    double value; \
937
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
938
        if (g_start) { g_start = 0; g_accumulator = value; } \
939
        else g_accumulator = func(g_accumulator, value); \
940
        sqlite3_result_double(ctx, g_accumulator); \
941
    }  \
942
}
943
 
3307 mrmanese 944
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
945
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
946
SQLITE_MATH_FUNC1(sqrt, sqrt)
947
SQLITE_MATH_FUNC1(floor, floor)
948
SQLITE_MATH_FUNC1(ceiling, ceil)
949
SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */
950
/* SQLITE_MATH_FUNC1(round, )   in SQLite */
951
/* SQLITE_MATH_FUNC1(signif, ) 2 arg */
952
SQLITE_MATH_FUNC1(exp, exp)
953
/* SQLITE_MATH_FUNC1(log, ) 2 arg */
954
SQLITE_MATH_FUNC1(cos, cos)
955
SQLITE_MATH_FUNC1(sin, sin)
956
SQLITE_MATH_FUNC1(tan, tan)
957
SQLITE_MATH_FUNC1(acos, acos)
958
SQLITE_MATH_FUNC1(asin, asin)
959
SQLITE_MATH_FUNC1(atan, atan)
960
SQLITE_MATH_FUNC1(cosh, cosh)
961
SQLITE_MATH_FUNC1(sinh, sinh)
962
SQLITE_MATH_FUNC1(tanh, tanh)
963
SQLITE_MATH_FUNC1(acosh, acosh)  /* nowhere in include?? */
964
SQLITE_MATH_FUNC1(asinh, asinh)  /* nowhere in include?? */
965
SQLITE_MATH_FUNC1(atanh, atanh)  /* nowhere in include?? */
966
SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */
967
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
968
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
969
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
970
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
971
 
3324 mrmanese 972
#define SUM(a, b)  (a) + (b)
973
#define PROD(a, b) (a) * (b)
974
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
975
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
976
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
977
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
978
 
979
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
980
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
981
SQLITE_MATH_FUNC_CUM(cummin, MIN)
982
SQLITE_MATH_FUNC_CUM(cummax, MAX)
983
 
984
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
985
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
986
    double value; \
987
    if (!g_narm && R_IsNA(g_accumulator)) return; /* NA if na.rm=F & NA found */ \
988
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
989
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
990
            int tmp = sqlite3_value_int(argv[0]); \
991
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
992
        } else value = sqlite3_value_double(argv[0]);  \
993
        if (R_IsNA(value)) { \
994
            if (!g_narm) g_accumulator = value; return; \
995
        } else if (g_start) { g_start = 0; g_accumulator = value; } \
996
        else g_accumulator = func(g_accumulator, value); \
997
    } \
998
}
999
 
1000
SQLITE_SUMMARY_FUNC(all_df, ALL)
1001
SQLITE_SUMMARY_FUNC(any_df, ANY)
1002
SQLITE_SUMMARY_FUNC(sum_df, SUM)
1003
SQLITE_SUMMARY_FUNC(prod_df, PROD)
1004
SQLITE_SUMMARY_FUNC(min_df, MIN)
1005
SQLITE_SUMMARY_FUNC(max_df, MAX)
1006
 
1007
static void __vecsummary_finalize(sqlite3_context *ctx) {
1008
    /* g_accumulator already summarizes it. just return that */
1009
    sqlite3_result_double(ctx, g_accumulator);
1010
}
1011
 
3307 mrmanese 1012
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
3324 mrmanese 1013
#define VSENTRY1(func)  {#func, __vecsummary_ ## func}
3307 mrmanese 1014
void __register_vector_math() {
1015
    int i, res;
1016
    static const struct {
1017
        char *name;
1018
        void (*func)(sqlite3_context*, int, sqlite3_value**);
1019
    } arr_func1[] = {
1020
        VMENTRY1(sign),
1021
        VMENTRY1(sqrt),
1022
        VMENTRY1(floor),
1023
        VMENTRY1(ceiling),
1024
        VMENTRY1(trunc),
1025
        VMENTRY1(exp),
1026
        VMENTRY1(cos),
1027
        VMENTRY1(sin),
1028
        VMENTRY1(tan),
1029
        VMENTRY1(acos),
1030
        VMENTRY1(asin),
1031
        VMENTRY1(atan),
1032
        VMENTRY1(cosh),
1033
        VMENTRY1(sinh),
1034
        VMENTRY1(tanh),
1035
        VMENTRY1(acosh),
1036
        VMENTRY1(asinh),
1037
        VMENTRY1(atanh),
1038
        VMENTRY1(lgamma),
1039
        VMENTRY1(gamma),
1040
        VMENTRY1(digamma),
3324 mrmanese 1041
        VMENTRY1(trigamma),
1042
        VMENTRY1(cumsum),
1043
        VMENTRY1(cumprod),
1044
        VMENTRY1(cummin),
1045
        VMENTRY1(cummax)
1046
    }, arr_sum1[] = {
1047
        VSENTRY1(all_df),  /* can't override sum, min, max */
1048
        VSENTRY1(any_df),
1049
        VSENTRY1(sum_df),
1050
        VSENTRY1(prod_df),
1051
        VSENTRY1(min_df),
1052
        VSENTRY1(max_df)
3307 mrmanese 1053
    };
1054
 
3324 mrmanese 1055
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
3307 mrmanese 1056
 
3324 mrmanese 1057
    for (i = 0; i < len; i++) {
3307 mrmanese 1058
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
1059
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
1060
        _sqlite_error(res);
1061
    }
3324 mrmanese 1062
 
1063
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
1064
    for (i = 0; i < len; i++) {
1065
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
1066
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
1067
        _sqlite_error(res);
1068
    }
3307 mrmanese 1069
}