The R Project SVN R-packages

Rev

Rev 3358 | Rev 3419 | 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]);  
3397 mrmanese 488
                    _sqlite_exec("begin");
3358 mrmanese 489
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
490
                    _sqlite_error(res);
491
 
492
                    for (i = 0; i < svec_len; i++) {
493
                        sqlite3_step(stmt2);
494
 
495
                        sqlite3_reset(stmt);
496
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
497
                        sqlite3_bind_int(stmt, 2, (int)sqlite3_column_double(stmt2, 1));
498
                        sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
499
                        sqlite3_step(stmt);
500
                    }
3397 mrmanese 501
                    _sqlite_exec("commit");
3358 mrmanese 502
                } else { /* non-integer binary operation */
503
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
3397 mrmanese 504
                    _sqlite_exec("begin");
3358 mrmanese 505
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
506
                    _sqlite_error(res);
507
 
508
                    for (i = 0; i < svec_len; i++) {
509
                        sqlite3_step(stmt2);
510
 
511
                        sqlite3_reset(stmt);
512
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
513
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
514
                        sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
515
                        sqlite3_step(stmt);
516
                    }
3397 mrmanese 517
                    _sqlite_exec("commit");
3358 mrmanese 518
                }
519
                sqlite3_finalize(stmt2);
520
            } else { /* op2_len > svec_len, recycle svec */
521
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
522
                        varname_src, iname_src);
523
 
524
                if (funcname[0] == '%') {
525
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
526
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
527
                    _sqlite_error(res);
528
                } else {
529
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
530
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
531
                    _sqlite_error(res);
532
                }
533
 
3397 mrmanese 534
                i = 0; _sqlite_exec("begin");
3358 mrmanese 535
                while (i < op2_len) {
536
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
537
                    _sqlite_error(res);
538
 
539
                    if (funcname[0] == '%') {
540
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
541
                            sqlite3_step(stmt2);
542
 
543
                            sqlite3_reset(stmt);
544
                            /* simplify my life, just use ints for row names so that we
545
                             * don't have to worry about duplicates */
546
                            sqlite3_bind_int(stmt, 1, i); 
547
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
548
                            sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
549
                            sqlite3_step(stmt);
550
                        }
551
                    } else {
552
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
553
                            sqlite3_step(stmt2);
554
 
555
                            sqlite3_reset(stmt);
556
                            sqlite3_bind_int(stmt, 1, i);
557
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
558
                            sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
559
                            sqlite3_step(stmt);
560
                        }
561
                    }
562
 
563
                    /* recycle on svec if we loop again */
564
                    sqlite3_finalize(stmt2);
565
                }
3397 mrmanese 566
 
567
                _sqlite_exec("commit");
3358 mrmanese 568
            }
569
 
570
            sqlite3_finalize(stmt);
571
        } else if (IS_INTEGER(op2) || IS_LOGICAL(op2)) { /* I N T E G E R */
572
            /* we are taking advantage of the fact that logicals are stored as int.
573
             * if this becomes untrue in the future, then this is a bug */
574
            op2_len = LENGTH(op2);
575
 
576
            if (op2_len == 1) {
577
                if (funcname[0] == '%') {
578
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
579
                            varname_src, funcname[1], iname_src);
580
                } else {
581
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
582
                            varname_src, funcname, iname_src);
583
                }
584
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
585
                _sqlite_error(res);
586
                sqlite3_bind_double(stmt, 1, (double)INTEGER(op2)[0]);
587
                sqlite3_step(stmt);
588
            } else if (op2_len <= svec_len) {
589
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
590
                        varname_src, iname_src);
591
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
592
                _sqlite_error(res);
593
 
594
                if (funcname[0] == '%') {
595
                    /* sqlite does int div with "/" if both args are int. mod is % also.
596
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
597
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
3397 mrmanese 598
                    _sqlite_exec("begin");
3358 mrmanese 599
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
600
                    _sqlite_error(res);
601
 
602
                    for (i = 0; i < svec_len; i++) {
603
                        sqlite3_step(stmt2);
604
 
605
                        sqlite3_reset(stmt);
606
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
607
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
608
                        sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
609
                        sqlite3_step(stmt);
610
                    }
3397 mrmanese 611
                    _sqlite_exec("commit");
3358 mrmanese 612
                } else {
613
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
3397 mrmanese 614
                    _sqlite_exec("begin");
3358 mrmanese 615
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
616
                    _sqlite_error(res);
617
 
618
                    for (i = 0; i < svec_len; i++) {
619
                        sqlite3_step(stmt2);
620
 
621
                        sqlite3_reset(stmt);
622
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
623
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
624
                        sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
625
                        sqlite3_step(stmt);
626
                    }
3397 mrmanese 627
                    _sqlite_exec("commit");
3358 mrmanese 628
                }
629
                sqlite3_finalize(stmt2);
630
            } else {
631
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
632
                        varname_src, iname_src);
633
 
634
                if (funcname[0] == '%') {
635
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
636
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
637
                    _sqlite_error(res);
638
                } else {
639
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
640
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
641
                    _sqlite_error(res);
642
                }
643
 
3397 mrmanese 644
                i = 0; _sqlite_exec("begin");
3358 mrmanese 645
                while (i < op2_len) {
646
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
647
                    _sqlite_error(res);
648
 
649
                    if (funcname[0] == '%') {
650
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
651
                            sqlite3_step(stmt2);
652
 
653
                            sqlite3_reset(stmt);
654
                            /* simplify my life, just use ints for row names so that we
655
                             * don't have to worry about duplicates */
656
                            sqlite3_bind_int(stmt, 1, i); 
657
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
658
                            sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
659
                            sqlite3_step(stmt);
660
                        }
661
                    } else {
662
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
663
                            sqlite3_step(stmt2);
664
 
665
                            sqlite3_reset(stmt);
666
                            sqlite3_bind_int(stmt, 1, i);
667
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
668
                            sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
669
                            sqlite3_step(stmt);
670
                        }
671
                    }
672
 
673
                    /* recycle on svec if we loop again */
674
                    sqlite3_finalize(stmt2);
675
                }
3397 mrmanese 676
                _sqlite_exec("commit");
3358 mrmanese 677
            }
678
 
679
            sqlite3_finalize(stmt);
680
        } else if (inherits(op2, "sqlite.vector")) { 
681
            /* op2 is surely not a factor, as handled by the R wrapper */
682
            char *iname_op2, *varname_op2;
683
            sqlite3_stmt *stmt3;
684
            iname_op2 = SDF_INAME(op2);
685
            varname_op2 = SVEC_VARNAME(op2);
686
 
687
            if (!USE_SDF1(iname_op2, TRUE)) {
688
                /* delete created sqlite.vector */
689
                Rprintf("Warning: detaching created result SDF %s\n", iname);
690
                sdf_detach_sdf(mkString(iname));
691
                return R_NilValue;
692
            }
693
 
694
            op2_len = _get_row_count2(iname_op2, 1);
695
 
696
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_src, iname_src);
697
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
698
            _sqlite_error(res);
699
 
700
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_op2, iname_op2);
701
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt3, 0);
702
            _sqlite_error(res);
703
 
704
            if (funcname[0] == '%') {
705
                sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
3397 mrmanese 706
                _sqlite_exec("begin");
3358 mrmanese 707
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
708
                _sqlite_error(res);
709
 
710
                if (svec_len == op2_len) {
711
                    for (i = 0; i < svec_len; i++) {
712
                        sqlite3_step(stmt2); 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
                } else if (svec_len < op2_len) {
721
                    i = 0;
722
                    while (i < op2_len) {
723
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
724
                            sqlite3_step(stmt3);
725
 
726
                            sqlite3_reset(stmt);
727
                            sqlite3_bind_int(stmt, 1, i);
728
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
729
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
730
                            sqlite3_step(stmt);
731
                        }
732
                        sqlite3_reset(stmt2);
733
                    }
734
                } else {
735
                    i = 0;
736
                    while (i < svec_len) {
737
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
738
                            sqlite3_step(stmt2);
739
 
740
                            sqlite3_reset(stmt);
741
                            sqlite3_bind_int(stmt, 1, i);
742
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
743
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
744
                            sqlite3_step(stmt);
745
                        }
746
                        sqlite3_reset(stmt3);
747
                    }
748
                }
3397 mrmanese 749
                _sqlite_exec("commit");
3358 mrmanese 750
            } else { /* not an integer op %% or %/% */
751
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
3397 mrmanese 752
                _sqlite_exec("begin");
3358 mrmanese 753
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
754
                _sqlite_error(res);
755
 
756
                if (svec_len == op2_len) {
757
                    for (i = 0; i < svec_len; i++) {
758
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
759
 
760
                        sqlite3_reset(stmt);
761
                        sqlite3_bind_int(stmt, 1, i);
762
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
763
                        sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
764
                        sqlite3_step(stmt);
765
                    }
766
                } else if (svec_len < op2_len) { /* recycle svec */
767
                    i = 0;
768
                    while (i < op2_len) {
769
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
770
                            sqlite3_step(stmt3);
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(stmt2);
779
                    }
780
                } else { /* svec_len > op2_len, recycle op2 */
781
                    i = 0;
782
                    while (i < svec_len) {
783
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
784
                            sqlite3_step(stmt2);
785
 
786
                            sqlite3_reset(stmt);
787
                            sqlite3_bind_int(stmt, 1, i);
788
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
789
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
790
                            sqlite3_step(stmt);
791
                        }
792
                        sqlite3_reset(stmt3);
793
                    }
794
                }
3397 mrmanese 795
                _sqlite_exec("commit");
3358 mrmanese 796
            }
797
 
798
            sqlite3_finalize(stmt);
799
            sqlite3_finalize(stmt2);
800
            sqlite3_finalize(stmt3);
801
        }
802
    } else if (functype == 1 && funcname[0] != '!') { /* unary not operator */
803
        iname = _create_svector1(R_NilValue, "bit", NULL);
804
        sprintf(g_sql_buf[2], "insert into [%s].sdf_data "
805
                    "select [row name], [%s] == 0 from [%s].sdf_data", 
806
                    iname, varname_src, iname_src);
807
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
808
        _sqlite_error(res);
809
        sqlite3_step(stmt);
810
        sqlite3_finalize(stmt);
811
    }
812
 
813
    if (iname != NULL)
814
        return _create_svector_sexp(iname, "V1", 
815
                (functype == 0) ? "numeric" : "logical");
816
 
817
    return R_NilValue;
818
 
3307 mrmanese 819
}
820
 
3324 mrmanese 821
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
822
    char *iname_src, *varname_src, *funcname;
823
    int res;
824
    sqlite3_stmt *stmt;
825
    double _ret = NA_REAL; SEXP ret;
3307 mrmanese 826
 
3324 mrmanese 827
    /* get data from arguments (function name and sqlite.vector stuffs) */
828
    funcname = CHAR_ELT(func, 0);
829
    iname_src = SDF_INAME(vector);
830
    varname_src = SVEC_VARNAME(vector);
3307 mrmanese 831
 
3358 mrmanese 832
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
3324 mrmanese 833
 
834
    g_narm = LOGICAL(na_rm)[0];
835
    if (strcmp(funcname, "range") == 0) {
836
        /* special handling for range. use min then max */
837
        g_start = 1;
838
        g_accumulator = 0.0;
839
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
840
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
841
        if (_sqlite_error(res)) return R_NilValue;
842
        sqlite3_step(stmt); sqlite3_finalize(stmt);
843
        _ret = g_accumulator;
844
 
845
        if (R_IsNA(_ret) && !g_narm) {
846
            PROTECT(ret = NEW_NUMERIC(2));
847
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
848
            goto __sdf_do_variable_summary_out;
849
        }
850
 
851
        g_start = 1;
852
        g_accumulator = 0.0;
853
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
854
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
855
        if (_sqlite_error(res)) return R_NilValue;
856
        sqlite3_step(stmt); sqlite3_finalize(stmt);
857
 
858
        /* if there is NA, then the if above should have caught it already */
859
        PROTECT(ret = NEW_NUMERIC(2));
860
        REAL(ret)[0] = _ret;
861
        REAL(ret)[1] = g_accumulator;
862
    } else {
863
        g_start = 1;  /* we'll use these instead of sqlite3_aggregate_context */
864
        g_accumulator = 0.0;
865
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
866
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
867
        if (_sqlite_error(res)) return R_NilValue;
868
        res = sqlite3_step(stmt); sqlite3_finalize(stmt);
869
 
870
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
871
            PROTECT(ret = NEW_LOGICAL(1));
872
            if (R_IsNA(g_accumulator)) LOGICAL(ret)[0] = NA_INTEGER;
873
            else LOGICAL(ret)[0] = !(g_accumulator == 0);
874
        } else {
875
            PROTECT(ret = NEW_NUMERIC(1));
876
            REAL(ret)[0] = g_accumulator;
877
        }
878
    }
879
 
880
__sdf_do_variable_summary_out:
881
    UNPROTECT(1);
882
    return ret;
883
}
884
 
885
 
3358 mrmanese 886
SEXP sdf_sort_variable(SEXP svec, SEXP decreasing) {
887
    char *iname, *iname_src, *varname_src, *type;
888
    sqlite3_stmt *stmt;
889
    int res;
890
 
891
    iname_src = SDF_INAME(svec);
892
    varname_src = SVEC_VARNAME(svec);
893
 
894
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
895
 
896
    /* determine type of svec */
897
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit 1", varname_src, iname_src);
898
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
899
    _sqlite_error(res);
900
    sqlite3_step(stmt);
901
    strcpy(g_sql_buf[0], sqlite3_column_decltype(stmt, 0));
902
    sqlite3_finalize(stmt);
903
 
904
    /* create a new vector of that type */
905
    iname = _create_svector1(R_NilValue, g_sql_buf[0], NULL);
906
 
907
    /* insert to new sdf ordered */
908
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data "
909
            "select [row name], [%s] from [%s].sdf_data "
910
            "order by [%s] %s", iname, varname_src, iname_src, varname_src,
911
            (LOGICAL(decreasing)[0]) ? "desc" : "asc");
912
    res = _sqlite_exec(g_sql_buf[0]);
913
    _sqlite_error(res);
914
 
915
    if (inherits(svec, "factor")) { /* copy factor table to iname */
916
        if (inherits(svec, "ordered")) type = "ordered";
917
        else type = "factor";
918
        _copy_factor_levels2(type, iname_src, varname_src, iname, "V1");
919
    } else type = CHAR_ELT(GET_CLASS(svec), 1);
920
 
921
    return _create_svector_sexp(iname, "V1", type);
922
}
923
 
3307 mrmanese 924
/****************************************************************************
925
 * VECTOR MATH/OPS/GROUP OPERATIONS
926
 ****************************************************************************/
3324 mrmanese 927
 
3307 mrmanese 928
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
929
    int ret = 1;
930
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
931
        sqlite3_result_null(ctx); 
932
        ret = 0;
933
    } else {
934
        if (sqlite3_value_type(arg) == SQLITE_INTEGER) 
935
            *value = sqlite3_value_int(arg); 
936
        else *value = sqlite3_value_double(arg); 
937
    }
938
    return ret;
939
}
940
 
941
#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\
942
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
943
    double value; \
944
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
945
        sqlite3_result_double(ctx, func(value)); \
946
    }  \
947
}
948
 
3324 mrmanese 949
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
950
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
951
    double value; \
952
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
953
        if (g_start) { g_start = 0; g_accumulator = value; } \
954
        else g_accumulator = func(g_accumulator, value); \
955
        sqlite3_result_double(ctx, g_accumulator); \
956
    }  \
957
}
958
 
3307 mrmanese 959
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
960
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
961
SQLITE_MATH_FUNC1(sqrt, sqrt)
962
SQLITE_MATH_FUNC1(floor, floor)
963
SQLITE_MATH_FUNC1(ceiling, ceil)
964
SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */
965
/* SQLITE_MATH_FUNC1(round, )   in SQLite */
966
/* SQLITE_MATH_FUNC1(signif, ) 2 arg */
967
SQLITE_MATH_FUNC1(exp, exp)
968
/* SQLITE_MATH_FUNC1(log, ) 2 arg */
969
SQLITE_MATH_FUNC1(cos, cos)
970
SQLITE_MATH_FUNC1(sin, sin)
971
SQLITE_MATH_FUNC1(tan, tan)
972
SQLITE_MATH_FUNC1(acos, acos)
973
SQLITE_MATH_FUNC1(asin, asin)
974
SQLITE_MATH_FUNC1(atan, atan)
975
SQLITE_MATH_FUNC1(cosh, cosh)
976
SQLITE_MATH_FUNC1(sinh, sinh)
977
SQLITE_MATH_FUNC1(tanh, tanh)
978
SQLITE_MATH_FUNC1(acosh, acosh)  /* nowhere in include?? */
979
SQLITE_MATH_FUNC1(asinh, asinh)  /* nowhere in include?? */
980
SQLITE_MATH_FUNC1(atanh, atanh)  /* nowhere in include?? */
981
SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */
982
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
983
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
984
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
985
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
986
 
3324 mrmanese 987
#define SUM(a, b)  (a) + (b)
988
#define PROD(a, b) (a) * (b)
989
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
990
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
991
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
992
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
993
 
994
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
995
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
996
SQLITE_MATH_FUNC_CUM(cummin, MIN)
997
SQLITE_MATH_FUNC_CUM(cummax, MAX)
998
 
999
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
1000
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
1001
    double value; \
1002
    if (!g_narm && R_IsNA(g_accumulator)) return; /* NA if na.rm=F & NA found */ \
1003
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
1004
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
1005
            int tmp = sqlite3_value_int(argv[0]); \
1006
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
1007
        } else value = sqlite3_value_double(argv[0]);  \
1008
        if (R_IsNA(value)) { \
1009
            if (!g_narm) g_accumulator = value; return; \
1010
        } else if (g_start) { g_start = 0; g_accumulator = value; } \
1011
        else g_accumulator = func(g_accumulator, value); \
1012
    } \
1013
}
1014
 
1015
SQLITE_SUMMARY_FUNC(all_df, ALL)
1016
SQLITE_SUMMARY_FUNC(any_df, ANY)
1017
SQLITE_SUMMARY_FUNC(sum_df, SUM)
1018
SQLITE_SUMMARY_FUNC(prod_df, PROD)
1019
SQLITE_SUMMARY_FUNC(min_df, MIN)
1020
SQLITE_SUMMARY_FUNC(max_df, MAX)
1021
 
1022
static void __vecsummary_finalize(sqlite3_context *ctx) {
1023
    /* g_accumulator already summarizes it. just return that */
1024
    sqlite3_result_double(ctx, g_accumulator);
1025
}
1026
 
3307 mrmanese 1027
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
3324 mrmanese 1028
#define VSENTRY1(func)  {#func, __vecsummary_ ## func}
3307 mrmanese 1029
void __register_vector_math() {
1030
    int i, res;
1031
    static const struct {
1032
        char *name;
1033
        void (*func)(sqlite3_context*, int, sqlite3_value**);
1034
    } arr_func1[] = {
1035
        VMENTRY1(sign),
1036
        VMENTRY1(sqrt),
1037
        VMENTRY1(floor),
1038
        VMENTRY1(ceiling),
1039
        VMENTRY1(trunc),
1040
        VMENTRY1(exp),
1041
        VMENTRY1(cos),
1042
        VMENTRY1(sin),
1043
        VMENTRY1(tan),
1044
        VMENTRY1(acos),
1045
        VMENTRY1(asin),
1046
        VMENTRY1(atan),
1047
        VMENTRY1(cosh),
1048
        VMENTRY1(sinh),
1049
        VMENTRY1(tanh),
1050
        VMENTRY1(acosh),
1051
        VMENTRY1(asinh),
1052
        VMENTRY1(atanh),
1053
        VMENTRY1(lgamma),
1054
        VMENTRY1(gamma),
1055
        VMENTRY1(digamma),
3324 mrmanese 1056
        VMENTRY1(trigamma),
1057
        VMENTRY1(cumsum),
1058
        VMENTRY1(cumprod),
1059
        VMENTRY1(cummin),
1060
        VMENTRY1(cummax)
1061
    }, arr_sum1[] = {
1062
        VSENTRY1(all_df),  /* can't override sum, min, max */
1063
        VSENTRY1(any_df),
1064
        VSENTRY1(sum_df),
1065
        VSENTRY1(prod_df),
1066
        VSENTRY1(min_df),
1067
        VSENTRY1(max_df)
3307 mrmanese 1068
    };
1069
 
3324 mrmanese 1070
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
3307 mrmanese 1071
 
3324 mrmanese 1072
    for (i = 0; i < len; i++) {
3307 mrmanese 1073
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
1074
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
1075
        _sqlite_error(res);
1076
    }
3324 mrmanese 1077
 
1078
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
1079
    for (i = 0; i < len; i++) {
1080
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
1081
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
1082
        _sqlite_error(res);
1083
    }
3307 mrmanese 1084
}