The R Project SVN R-packages

Rev

Rev 4590 | 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
 ****************************************************************************/
3419 mrmanese 8
char *_create_svector1(SEXP name, const char *type, int * _namelen, int protect) {
3358 mrmanese 9
    int namelen, res;
3419 mrmanese 10
    char *iname = _create_sdf_skeleton1(name, &namelen, protect);
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
 
3684 mrmanese 23
SEXP _create_svector_sexp(const char *iname, const char *tblname,
24
        const char *varname, const char *type) {
3358 mrmanese 25
    SEXP ret, value; int nprotected = 0;
3684 mrmanese 26
    PROTECT(ret = NEW_LIST(3)); nprotected++;
3255 mrmanese 27
 
28
    /* set list names */
3684 mrmanese 29
    PROTECT(value = NEW_CHARACTER(3)); nprotected++;
3255 mrmanese 30
    SET_STRING_ELT(value, 0, mkChar("iname"));
3684 mrmanese 31
    SET_STRING_ELT(value, 1, mkChar("tblname"));
32
    SET_STRING_ELT(value, 2, mkChar("varname"));
3255 mrmanese 33
    SET_NAMES(ret, value);
34
 
35
    /* set list values */
36
    SET_VECTOR_ELT(ret, 0, mkString(iname));
3684 mrmanese 37
    SET_VECTOR_ELT(ret, 1, mkString(tblname));
38
    SET_VECTOR_ELT(ret, 2, mkString(varname));
3255 mrmanese 39
 
3358 mrmanese 40
    /* set sexp class */
3456 mrmanese 41
    SET_CLASS(ret, mkString("sqlite.vector"));
3255 mrmanese 42
 
3456 mrmanese 43
    /* set sdf.vector.type */
44
    SET_SDFVECTORTYPE(ret, mkString(type));
45
 
3255 mrmanese 46
    UNPROTECT(nprotected);
3358 mrmanese 47
 
3255 mrmanese 48
    return ret;
49
}
50
 
4160 mrmanese 51
/* if ret == NULL, 3rd arg is the length of the vector to be created. otherwise
3358 mrmanese 52
 * it is the index in the vector ret where we will put the result extracted
53
 * from ret */
4160 mrmanese 54
int _get_vector_index_typed_result(sqlite3_stmt *stmt, SEXP *ret, int colidx,
55
        int idx_or_len, int *coltype) {
56
    int added = 1, ctype;
3255 mrmanese 57
    if (*ret == NULL || *ret == R_NilValue) {
4160 mrmanese 58
        if ((ctype = sqlite3_column_type(stmt, colidx)) == SQLITE_NULL) {
3255 mrmanese 59
            added = 0;
60
        }
61
 
4160 mrmanese 62
        if (ctype == SQLITE_TEXT) {
3255 mrmanese 63
            PROTECT(*ret = NEW_CHARACTER(idx_or_len));
64
            if (added) 
4160 mrmanese 65
                SET_STRING_ELT(*ret, 0, mkChar((char *)sqlite3_column_text(stmt, colidx)));
66
        } else if (ctype == SQLITE_FLOAT) {
3255 mrmanese 67
            PROTECT(*ret = NEW_NUMERIC(idx_or_len));
4160 mrmanese 68
            if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, colidx);
69
        } else if (ctype == SQLITE_INTEGER) {
70
            /* sqlite does not differentiate b/w ints & bits, so we have to
71
             * do it ourselves since R distinguishes b/w ints & logicals */
72
            if (strcmp(sqlite3_column_decltype(stmt, colidx), "bit") == 0) {
73
                ctype = SQLITEDF_BIT; 
74
                PROTECT(*ret = NEW_LOGICAL(idx_or_len));
75
                if (added) LOGICAL(*ret)[0] = sqlite3_column_int(stmt, colidx);
76
            } else {
77
                PROTECT(*ret = NEW_INTEGER(idx_or_len));
78
                if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, colidx);
79
            }
3255 mrmanese 80
        } else added = 0;
81
 
4160 mrmanese 82
        if (added) UNPROTECT(1);
83
        *coltype = ctype;
3684 mrmanese 84
    } else if (stmt != NULL) {
4160 mrmanese 85
        int ctype = *coltype;
86
 
4590 mrmanese 87
        /* first row/previous rows must have been NULL so that *coltype 
88
         * was not set */
4160 mrmanese 89
        if (ctype == SQLITE_NULL) {
90
            ctype = *coltype = sqlite3_column_type(stmt, colidx);
91
            /* distinguish int or logical */
92
            if (ctype == SQLITE_INTEGER) 
93
                ctype = (strcmp(sqlite3_column_decltype(stmt, colidx), "bit") == 0) ?
94
                    SQLITEDF_BIT : SQLITE_INTEGER;
95
        }
96
 
97
        if (sqlite3_column_type(stmt, colidx) == SQLITE_NULL) {
3255 mrmanese 98
            added = 0;
4160 mrmanese 99
        } else if (ctype == SQLITE_TEXT) {
3255 mrmanese 100
            SET_STRING_ELT(*ret, idx_or_len, 
4160 mrmanese 101
                    mkChar((char *)sqlite3_column_text(stmt, colidx)));
102
        } else if (ctype == SQLITE_FLOAT) {
103
            REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, colidx);
104
        } else if (ctype == SQLITE_INTEGER) {
105
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, colidx);
106
        } else if (ctype == SQLITEDF_BIT) {
107
            LOGICAL(*ret)[idx_or_len] = sqlite3_column_int(stmt, colidx);
3255 mrmanese 108
        } else added = 0;
3684 mrmanese 109
    } else if (stmt == NULL) {
4160 mrmanese 110
        /* used when there is no row returned (sqlite3_step(stmt)!= QLITE_ROW),
111
         * and we just insert NAs in the result */
112
        ctype = *coltype;
113
        if (ctype == SQLITE_NULL) { 
114
            /* since stmt == NULL, we can't check its column type */
3684 mrmanese 115
            added = 0;
4160 mrmanese 116
        } else if (ctype == SQLITE_TEXT) {
3684 mrmanese 117
            SET_STRING_ELT(*ret, idx_or_len, NA_STRING);
4160 mrmanese 118
        } else if (ctype == SQLITE_FLOAT) {
3684 mrmanese 119
            REAL(*ret)[idx_or_len] = NA_REAL;
4160 mrmanese 120
        } else if (ctype == SQLITE_INTEGER) {
3684 mrmanese 121
            INTEGER(*ret)[idx_or_len] = NA_INTEGER;
4160 mrmanese 122
        } else if (ctype == SQLITEDF_BIT) {
123
            LOGICAL(*ret)[idx_or_len] = NA_LOGICAL;
3684 mrmanese 124
        } else added = 0;
3255 mrmanese 125
    }
126
 
127
    return added;
128
}
129
 
3358 mrmanese 130
/****************************************************************************
131
 * SVEC FUNCTIONS
132
 ****************************************************************************/
133
SEXP sdf_get_variable(SEXP sdf, SEXP name) {
4798 mrmanese 134
    const char *iname, *varname, *svec_type = NULL;
3456 mrmanese 135
    const char *coltype;
136
    int type = -1, res, nprotected = 0;
137
    SEXP ret, value;
138
 
3358 mrmanese 139
    if (!IS_CHARACTER(name)) {
3471 mrmanese 140
        error("argument is not a string.\n");
3358 mrmanese 141
    }
142
 
3456 mrmanese 143
    iname = SDF_INAME(sdf);
144
    varname = CHAR_ELT(name, 0);
3358 mrmanese 145
 
3419 mrmanese 146
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
3358 mrmanese 147
 
148
    /* check if sdf & varname w/in that sdf exists */
149
    sqlite3_stmt *stmt;
150
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
151
 
3456 mrmanese 152
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
3358 mrmanese 153
 
154
    if (_sqlite_error(res)) return R_NilValue;
155
 
3456 mrmanese 156
    coltype = sqlite3_column_decltype(stmt, 0);
3358 mrmanese 157
    sqlite3_finalize(stmt);
3456 mrmanese 158
 
3684 mrmanese 159
    PROTECT(ret = NEW_LIST(3)); nprotected++;
3358 mrmanese 160
 
161
    /* set list names */
3684 mrmanese 162
    PROTECT(value = NEW_CHARACTER(3)); nprotected++;
3358 mrmanese 163
    SET_STRING_ELT(value, 0, mkChar("iname"));
3684 mrmanese 164
    SET_STRING_ELT(value, 1, mkChar("tblname"));
165
    SET_STRING_ELT(value, 2, mkChar("varname"));
3358 mrmanese 166
    SET_NAMES(ret, value);
167
 
168
    /* set list values */
169
    SET_VECTOR_ELT(ret, 0, mkString(iname));
3684 mrmanese 170
    SET_VECTOR_ELT(ret, 1, mkString("sdf_data"));
171
    SET_VECTOR_ELT(ret, 2, mkString(varname));
3358 mrmanese 172
 
173
    /* set class */
3456 mrmanese 174
    if (strcmp(coltype, "text") == 0) svec_type = "character";
175
    else if (strcmp(coltype, "double") == 0) svec_type = "numeric";
176
    else if (strcmp(coltype, "bit") == 0) svec_type = "logical";
3358 mrmanese 177
    else if (strcmp(coltype, "integer") == 0 || strcmp(coltype, "int") == 0) {
178
        /* determine if int, factor or ordered */
4160 mrmanese 179
        type = _get_factor_levels1(iname, varname, ret, FALSE);
3358 mrmanese 180
        switch(type) {
3456 mrmanese 181
            case VAR_INTEGER: svec_type = "integer"; break;
182
            case VAR_FACTOR: svec_type = "factor"; break;
183
            case VAR_ORDERED: svec_type = "ordered";
3358 mrmanese 184
        }
185
    }
186
 
3456 mrmanese 187
    SET_CLASS(ret, mkString("sqlite.vector"));
188
    SET_SDFVECTORTYPE(ret, mkString(svec_type));
3358 mrmanese 189
 
190
    UNPROTECT(nprotected);
191
    return ret;
192
 
193
}
194
 
195
 
3255 mrmanese 196
SEXP sdf_get_variable_length(SEXP svec) {
4798 mrmanese 197
    const char *iname = SDF_INAME(svec);
3419 mrmanese 198
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
3255 mrmanese 199
 
3446 mrmanese 200
    return ScalarInteger(_get_row_count2(iname, 1));
3255 mrmanese 201
}
202
 
203
 
204
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
205
    SEXP ret = R_NilValue, tmp;
4798 mrmanese 206
    const char *iname = SDF_INAME(svec), *tblname = SVEC_TBLNAME(svec),
207
               *varname = SVEC_VARNAME(svec);
4590 mrmanese 208
    int *index, _idx, nrows, i, init=FALSE, retlen=0, res, coltype;
3358 mrmanese 209
    sqlite3_stmt *stmt;
3255 mrmanese 210
 
3419 mrmanese 211
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
3308 mrmanese 212
 
4590 mrmanese 213
    /* get # of rows in svec */
214
    nrows = _get_row_count2(iname, TRUE);
215
    if (nrows < 1) return ret;
3255 mrmanese 216
 
4160 mrmanese 217
    sprintf(g_sql_buf[0], "select [%s] from [%s].[%s] where rowid=?",
3684 mrmanese 218
            varname, iname, tblname);
3255 mrmanese 219
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
3684 mrmanese 220
    if (_sqlite_error(res)) error("cannot complete request");
3255 mrmanese 221
 
4590 mrmanese 222
    index = _make_row_index(idx, &nrows);
3255 mrmanese 223
 
4590 mrmanese 224
    for (i = 0; i < nrows; i++) {
225
        _idx = index[i];
226
        if (_idx < 1 || _idx == NA_INTEGER) continue;
227
        sqlite3_reset(stmt);
228
        sqlite3_bind_int(stmt, 1, _idx);
229
        res = sqlite3_step(stmt);
230
        if (!init) {
3255 mrmanese 231
            if (res == SQLITE_ROW) { 
4590 mrmanese 232
                /* valid 1st row. initialize the returned vector with length
233
                 * nrows. retlen holds the length of vector ret. 
234
                 */ 
235
                retlen = _get_vector_index_typed_result(stmt, &ret, 0, nrows, &coltype);
236
            } else {
237
                /* invalid 1st row, initalize anyway but now with length 
238
                 * nrows-1. we put dummy results in 1st element of vector which
239
                 * should be overwritten in succeeding calls
4160 mrmanese 240
                 */
3255 mrmanese 241
                sqlite3_reset(stmt);
4590 mrmanese 242
                sqlite3_bind_int(stmt, 1, 0);  /* get 1st row */
3255 mrmanese 243
                res = sqlite3_step(stmt);
4590 mrmanese 244
                _get_vector_index_typed_result(stmt, &ret, 0, nrows - 1, &coltype);
245
                retlen = 0;
3255 mrmanese 246
            }
4590 mrmanese 247
            init = TRUE;
248
        } else {
249
            retlen += _get_vector_index_typed_result((res == SQLITE_ROW) ? stmt : NULL,
250
                            &ret, 0, retlen, &coltype);
3255 mrmanese 251
        }
252
    }
253
 
254
    sqlite3_finalize(stmt);
255
 
256
    if (ret != R_NilValue) {
257
        ret = _shrink_vector(ret, retlen);
258
        tmp = GET_LEVELS(svec);
259
        if (tmp != R_NilValue) {
260
            SET_LEVELS(ret, duplicate(tmp));
3456 mrmanese 261
            if (TEST_SDFVECTORTYPE(svec, "factor")) {
3255 mrmanese 262
                SET_CLASS(ret, mkString("factor"));
263
            } else {
264
                PROTECT(tmp = NEW_CHARACTER(2));
265
                SET_STRING_ELT(tmp, 0, mkChar("ordered"));
266
                SET_STRING_ELT(tmp, 1, mkChar("factor"));
267
                UNPROTECT(1);
268
            }
269
        }
270
    }
271
 
272
    return ret;
273
}
274
 
3358 mrmanese 275
/* sqlite.vector.[<- */
276
SEXP sdf_set_variable_index(SEXP svec, SEXP idx, SEXP value) {
4590 mrmanese 277
    int *index;
278
    int coltype, valtype, idx_len, val_len, svec_len, i, i2, res;
4798 mrmanese 279
    const char *iname = SDF_INAME(svec), *tblname = SVEC_TBLNAME(svec),
280
               *varname = SVEC_VARNAME(svec);
4590 mrmanese 281
    const char *decltype;
4160 mrmanese 282
    sqlite3_stmt *stmt;
3358 mrmanese 283
 
284
 
4590 mrmanese 285
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
286
 
287
    /* find the type of the svec */
288
    sprintf(g_sql_buf[0], "select [%s] from [%s].[%s] where not [%s] is null limit 1", 
289
                varname, iname, tblname, varname);
290
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
291
    if (_sqlite_error(res)) error("cannot complete request");
292
    sqlite3_step(stmt);
293
    decltype = sqlite3_column_decltype(stmt, 0);
294
    Rprintf("decltype: %s\n", decltype); 
295
    coltype = _get_r_type(decltype);
296
    sqlite3_finalize(stmt);
297
 
298
    /* get index */
3358 mrmanese 299
    val_len = LENGTH(value);
4590 mrmanese 300
    idx_len = svec_len = _get_row_count2(iname, TRUE);
301
    /*Rprintf("idx_len: %d\n", idx_len);*/
302
    index = _make_row_index(idx, &idx_len);
4160 mrmanese 303
    if (idx_len % val_len != 0) 
304
        warning("number of items to replace is not a multiple of replacement length");
305
 
4590 mrmanese 306
    /* find the type of value to be assigned */
307
    valtype = TYPEOF(value);
308
 
309
    /* we will use the style similar to R's */
310
    coltype = coltype * 100 + valtype;
311
 
4160 mrmanese 312
    sprintf(g_sql_buf[0], "update [%s].[%s] set [%s]=? where rowid=?",
313
            iname, tblname, varname);
314
    _sqlite_begin;
315
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
4590 mrmanese 316
    if (_sqlite_error(res)) error("cannot complete request");
317
    /*Rprintf("idx_len: %d\n", idx_len);*/
4160 mrmanese 318
 
4590 mrmanese 319
    Rprintf("coltype: %d\n", coltype);
320
    switch (coltype) {
321
        case 1010: /* logical <- logical */
322
        case 1310: /* int <- logical */
323
        case 1313: /* int <- int */
324
            /* TODO: check if factor */
325
            for (i = 0; i < idx_len; i++) { 
326
                sqlite3_reset(stmt);
327
                i2 = i % val_len;
328
                sqlite3_bind_int(stmt, 1, INTEGER(value)[i2]);
329
                sqlite3_bind_int(stmt, 2, index[i]);
330
                sqlite3_step(stmt);
331
            }
332
            break;
333
        case 1410: /* real <- logical */
334
        case 1413: /* real <- int */
335
            for (i = 0; i < idx_len; i++) { 
336
                sqlite3_reset(stmt);
337
                i2 = i % val_len;
338
                sqlite3_bind_double(stmt, 1, (double) INTEGER(value)[i2]);
339
                sqlite3_bind_int(stmt, 2, index[i]);
340
                sqlite3_step(stmt);
341
            }
342
            break;
343
        case 1414: /* real <- real */
344
            for (i = 0; i < idx_len; i++) { 
345
                sqlite3_reset(stmt);
346
                i2 = i % val_len;
347
                sqlite3_bind_double(stmt, 1, REAL(value)[i2]);
348
                sqlite3_bind_int(stmt, 2, index[i]);
349
                res = sqlite3_step(stmt);
350
            }
351
            break;
352
        case 1610: /* character <- logical */
353
            for (i = 0; i < idx_len; i++) { 
354
                sqlite3_reset(stmt);
355
                i2 = i % val_len;
356
                sqlite3_bind_text(stmt, 1, 
357
                        (INTEGER(value)[i2]) ? "TRUE" : "FALSE", -1,
358
                        SQLITE_STATIC);
359
                sqlite3_bind_int(stmt, 2, index[i]);
360
                sqlite3_step(stmt);
361
            }
362
            break;
363
        case 1613: /* character <- integer */
364
            /* value could be a factor! */
365
            for (i = 0; i < idx_len; i++) { 
366
                sqlite3_reset(stmt);
367
                i2 = i % val_len;
368
                res = sprintf(g_sql_buf[1], "%d", INTEGER(value)[i2], 
369
                        SQLITE_STATIC);
370
                sqlite3_bind_text(stmt, 1, g_sql_buf[1], res, SQLITE_STATIC);
371
                sqlite3_bind_int(stmt, 2, index[i]);
372
                sqlite3_step(stmt);
373
            }
374
            break;
375
        case 1614: { /* character <- real */
376
            SEXP chvalue;
377
            PROTECT(chvalue = AS_CHARACTER(value));
378
            for (i = 0; i < idx_len; i++) { 
379
                sqlite3_reset(stmt);
380
                i2 = i % val_len;
381
                sqlite3_bind_text(stmt, 1, CHAR(STRING_ELT(chvalue, i2)), 
382
                        -1, SQLITE_STATIC);
383
                sqlite3_bind_int(stmt, 2, index[i]);
384
                sqlite3_step(stmt);
385
            }
386
            UNPROTECT(1);
387
          }
388
            break;
389
        case 1616: /* character <- character */
390
            for (i = 0; i < idx_len; i++) { 
391
                sqlite3_reset(stmt);
392
                i2 = i % val_len;
393
                sqlite3_bind_text(stmt, 1, CHAR(STRING_ELT(value, i2)), 
394
                        -1, SQLITE_STATIC);
395
                sqlite3_bind_int(stmt, 2, index[i]);
396
                sqlite3_step(stmt);
397
            }
398
            break;
399
        case 1314: /* int <- real */
400
            _sqlite_commit;
401
            error("cannot promote vector from integer to real");
402
        case 1014: /* logical <- real */
403
            _sqlite_commit;
404
            error("cannot promote vector from logical to real");
405
        case 1013: /* logical <- int */
406
            _sqlite_commit;
407
            error("cannot promote vector from logical to integer");
408
        case 1016: /* logical <- character */
409
            _sqlite_commit;
410
            error("cannot promote vector from logical to character");
411
        case 1316: /* integer <- character */
412
            /* TODO: this could be factors */
413
            _sqlite_commit;
414
            error("cannot promote vector from integer to character");
415
        case 1416: /* real <- character */
416
            _sqlite_commit;
417
            error("cannot promote vector from real to character");
418
        default:
419
            _sqlite_commit;
420
            error("don't know what to do with coltype=%d", coltype);
3358 mrmanese 421
    }
4590 mrmanese 422
    _sqlite_commit;
3358 mrmanese 423
 
4590 mrmanese 424
    return svec;
3358 mrmanese 425
}
426
 
3419 mrmanese 427
SEXP sdf_variable_summary(SEXP svec, SEXP maxsum) {
4798 mrmanese 428
    const char *iname, *tblname, *varname, *type;
3419 mrmanese 429
    sqlite3_stmt *stmt;
430
    int nprotected = 0;
431
    SEXP ret, names;
432
 
433
    iname = SDF_INAME(svec);
3684 mrmanese 434
    tblname = SVEC_TBLNAME(svec);
3419 mrmanese 435
    varname = SVEC_VARNAME(svec);
436
    USE_SDF1(iname, TRUE, FALSE);
437
 
3456 mrmanese 438
    if ((TEST_SDFVECTORTYPE(svec, "ordered") && ((type = "ordered"))) ||
439
            (TEST_SDFVECTORTYPE(svec, "factor") && ((type = "factor")))) {
3419 mrmanese 440
        int nrows, i, max_rows = INTEGER(maxsum)[0];
441
 
442
 
443
        sprintf(g_sql_buf[0], "[%s].[%s %s]", iname, type, varname);
444
        nrows = _get_row_count2(g_sql_buf[0], FALSE);
445
        if (nrows <= max_rows) max_rows = nrows;
446
        else { nrows = max_rows; max_rows--; }
447
 
448
        PROTECT(ret = NEW_INTEGER(nrows)); nprotected = 1;
449
        PROTECT(names = NEW_CHARACTER(nrows)); nprotected++;
450
 
451
        sprintf(g_sql_buf[0], "select [%s].[%s %s].label, count(*) from "
3684 mrmanese 452
                "[%s].[%s] join [%s].[%s %s] on [%s].[%s].[%s]=[%s].[%s %s].level "
453
                "group by [%s].[%s].[%s], [%s].[%s %s].level order by count(*) desc",
454
                iname, type, varname, iname, tblname, iname, type, varname, iname, tblname, varname,
455
                iname, type, varname, iname, tblname, varname, iname, type, varname);
3419 mrmanese 456
        sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
457
 
458
        for (i = 0; i < max_rows; i++) {
459
            sqlite3_step(stmt);
460
            SET_STRING_ELT(names, i, mkChar((char *)sqlite3_column_text(stmt, 0)));
461
            INTEGER(ret)[i] = sqlite3_column_int(stmt, 1);
462
        }
463
 
464
        if (nrows > max_rows) {
465
            int others_sum = 0;
466
            SET_STRING_ELT(names, nrows-1, mkChar("(Others)"));
467
            while (sqlite3_step(stmt) == SQLITE_ROW) {
468
                others_sum += sqlite3_column_int(stmt, 1);
469
            }
470
            INTEGER(ret)[nrows-1] = others_sum;
471
        }
3456 mrmanese 472
    } else if (TEST_SDFVECTORTYPE(svec, "logical")) {
3419 mrmanese 473
        sprintf(g_sql_buf[0], "select count(*) from "
3684 mrmanese 474
                "[%s].[%s] group by [%s] order by [%s]", iname, tblname, varname, varname);
3419 mrmanese 475
 
476
        PROTECT(names = NEW_CHARACTER(3)); nprotected = 1;
477
        PROTECT(ret = NEW_CHARACTER(3)); nprotected++;
478
 
479
        SET_STRING_ELT(names, 0, mkChar("Mode"));
480
        SET_STRING_ELT(names, 1, mkChar("FALSE"));
481
        SET_STRING_ELT(names, 2, mkChar("TRUE"));
482
 
483
        sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
484
        SET_STRING_ELT(ret, 0, mkChar("logical"));
485
        sqlite3_step(stmt);
486
        SET_STRING_ELT(ret, 1, mkChar((const char *)sqlite3_column_text(stmt, 0)));
487
        sqlite3_step(stmt);
488
        SET_STRING_ELT(ret, 2, mkChar((const char *)sqlite3_column_text(stmt, 0)));
489
 
490
    } else return R_NilValue;
491
 
492
    sqlite3_finalize(stmt);
493
    SET_NAMES(ret, names);
494
    SET_CLASS(ret, mkString("table"));
495
    UNPROTECT(nprotected);
496
    return ret;
497
}
498
 
499
 
3324 mrmanese 500
/* the global accumulator should be safe if we only do 1 cummulative or
501
 * aggregate at any time. it won't work for stuffs like "select max(col)-min(col)
502
 * from sdf_data". */
3432 mrmanese 503
static long double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */
3324 mrmanese 504
static int g_start = 0;            /* flag for start of cummulation */
505
static int g_narm = 0;             /* for Summary group */
3255 mrmanese 506
 
3473 mrmanese 507
void _init_sqlite_function_accumulator() {
508
    g_accumulator = 0.0;   /* initialize accumulator */
509
    g_start = 1;           /* flag that we are at start of accumulating */
510
}
511
 
3434 mrmanese 512
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP other_args) {
4798 mrmanese 513
    const char *iname_src, *varname_src, *funcname;
514
    char *iname;
3434 mrmanese 515
    int namelen, res;
3307 mrmanese 516
    sqlite3_stmt *stmt;
3255 mrmanese 517
 
3307 mrmanese 518
    /* get data from arguments (function name and sqlite.vector stuffs) */
519
    funcname = CHAR_ELT(func, 0);
520
    iname_src = SDF_INAME(vector);
521
    varname_src = SVEC_VARNAME(vector);
3255 mrmanese 522
 
3419 mrmanese 523
    if (!USE_SDF1(iname_src, TRUE, TRUE)) return R_NilValue;
3308 mrmanese 524
 
3307 mrmanese 525
    /* create a new sdf, with 1 column named V1 */
3419 mrmanese 526
    iname = _create_svector1(R_NilValue, "double", &namelen, TRUE);
3307 mrmanese 527
 
528
    /* insert into <newsdf>.col, row.names select func(col), rownames */
3434 mrmanese 529
    if (strcmp(funcname, "round") == 0 || strcmp(funcname, "signif") == 0) {
530
        double digits = REAL(_getListElement(other_args, "digits"))[0];
531
        sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
532
                "select [row name], %s([%s],?) from [%s].sdf_data", iname, funcname,
533
                varname_src, iname_src);
534
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
535
        if (_sqlite_error(res)) goto vecmath_prepare_error;
536
        res = sqlite3_bind_double(stmt, 1, digits);
537
    } else if (strcmp(funcname, "log") == 0) {
538
        double base = REAL(_getListElement(other_args, "base"))[0];
539
        sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
540
                "select [row name], %s([%s],?) from [%s].sdf_data", iname, funcname,
541
                varname_src, iname_src);
542
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
543
        if (_sqlite_error(res)) goto vecmath_prepare_error;
544
        res = sqlite3_bind_double(stmt, 1, base);
545
    } else {
546
        sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
547
                "select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,
548
                varname_src, iname_src);
549
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
550
    }
3307 mrmanese 551
 
552
    if (_sqlite_error(res)) {
3434 mrmanese 553
vecmath_prepare_error:
3307 mrmanese 554
        sprintf(g_sql_buf[0], "detach %s", iname);
555
        _sqlite_exec(g_sql_buf[0]);
556
 
557
        /* we will return a string with the file name, and do file.remove
558
         * at R */
559
        iname[namelen] = '.';
560
        return mkString(iname);
561
    }
562
 
3473 mrmanese 563
    _init_sqlite_function_accumulator();
3307 mrmanese 564
    sqlite3_step(stmt);
565
    sqlite3_finalize(stmt);
566
 
3419 mrmanese 567
    UNUSE_SDF2(iname);
568
    UNUSE_SDF2(iname_src);
569
 
3684 mrmanese 570
    return _create_svector_sexp(iname, "sdf_data", "V1", "numeric");
3358 mrmanese 571
}
3307 mrmanese 572
 
3434 mrmanese 573
SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2, SEXP arg_reversed) {
4798 mrmanese 574
    const char *iname_src, *varname_src, *funcname;
575
    char *iname = NULL; 
3434 mrmanese 576
    int res, functype = -1, op2_len, svec_len, i, reversed;
3358 mrmanese 577
    sqlite3_stmt *stmt, *stmt2;
3307 mrmanese 578
 
3358 mrmanese 579
    /* get data from arguments (function name and sqlite.vector stuffs) */
580
    funcname = CHAR_ELT(func, 0);
581
    iname_src = SDF_INAME(vector);
582
    varname_src = SVEC_VARNAME(vector);
3434 mrmanese 583
    reversed = LOGICAL(arg_reversed)[0];
3307 mrmanese 584
 
3419 mrmanese 585
    if (!USE_SDF1(iname_src, TRUE, TRUE)) return R_NilValue;
3358 mrmanese 586
    switch(funcname[0]) {
587
        case '+' :
588
        case '-' :
589
        case '*' :
590
        case '/' :
591
        case '^' :
592
        case '%' : /* %% and %/% */ 
593
            functype = 0; break;  /* output is REAL */
594
        case '&' :
595
        case '|' :
596
        case '!' :  /* ! and != */
597
            if (funcname[1] == 0) { functype = 1; break; }
598
        case '=' :  /* == */
599
        case '<' :  /* < and <= */
600
        case '>' :  /* > and >= */
601
            functype = 2; 
602
    }
3307 mrmanese 603
 
3358 mrmanese 604
    svec_len = _get_row_count2(iname_src, 1);
605
    if (functype == 0 || functype == 2 || (functype == 1 && funcname[0] != '!')) {
606
        char *insert_fmt_string1c, *insert_fmt_string1s;
607
        char *insert_fmt_string2c, *insert_fmt_string2s;
3434 mrmanese 608
        int vec_idx, sdf_idx;
609
 
3419 mrmanese 610
        iname = _create_svector1(R_NilValue, (functype == 0) ? "double" : "bit", NULL, TRUE);
3307 mrmanese 611
 
3434 mrmanese 612
        /* insert_fmt_string prefixes:
613
         * 1 - op2 is an ordinary vector, op2_len = 1, straightforward insert-select
614
         * 2 - op2 is an ordinary vector, op2_len > 1, may need recycling, loop both sides
615
         * s - operator will be printed as string
616
         * c - operator is either INTDIV or RMOD (int division, R modulo). initially, I
617
         *     thought I could cast both op to int then use / and % of sqlite, which is just
618
         *     the 2nd character of the funcname. however, R's INTDIV and casts to int 
619
         *     after division (e.g. 3.5 %/% 1.5 == 2). RMOD operates on doubles too,
620
         *     which is the remainder of the largest int multiple of "divisor"
621
         *     (e.g. 3.5 %% 1.5 = 0.5)
622
         */ 
3358 mrmanese 623
        if (functype == 1) { /* boolean binary operators */
3434 mrmanese 624
            if (!reversed) {
625
                insert_fmt_string1s = "insert into [%s].sdf_data "
626
                            "select [row name], ([%s] != 0) %s (? != 0) from [%s].sdf_data";
627
            } else {
628
                insert_fmt_string1s = "insert into [%s].sdf_data "
629
                            "select [row name], (? != 0) %s ([%s] != 0) from [%s].sdf_data";
630
            }
3358 mrmanese 631
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, (? != 0) %s (? != 0))";
632
            /* no need for char version of fmt_string2, since %% only occurs for functype==0 */
633
            insert_fmt_string1c = insert_fmt_string1s;
634
            insert_fmt_string2c = insert_fmt_string2s;
635
        } else {
3434 mrmanese 636
            if (!reversed) {
637
                insert_fmt_string1s = "insert into [%s].sdf_data "
638
                            "select [row name], [%s] %s ? from [%s].sdf_data";
639
                insert_fmt_string1c = "insert into [%s].sdf_data "
640
                            "select [row name], %s([%s],?) from [%s].sdf_data";
641
            } else {
642
                insert_fmt_string1s = "insert into [%s].sdf_data "
643
                            "select [row name], ? %s [%s] from [%s].sdf_data";
644
                insert_fmt_string1c = "insert into [%s].sdf_data "
645
                            "select [row name], %s(?,[%s]) from [%s].sdf_data";
646
            }
3358 mrmanese 647
            /* fmt_string2c format operator from a char, used for %% and %/% */
3434 mrmanese 648
            insert_fmt_string2c = "insert into [%s].sdf_data values(?, %s(?,?))";
3358 mrmanese 649
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, ? %s ?)";
650
        }
3307 mrmanese 651
 
3434 mrmanese 652
        /* for 2* insert statements, the values below specifies the index of bind().
653
         * if !reversed, then e1 is svec, e2 is anything. otherwise, e2 is the svec */
654
        if (reversed) { sdf_idx = 3; vec_idx = 2; }
655
        else { sdf_idx = 2; vec_idx = 3; }
3358 mrmanese 656
 
657
        if (IS_NUMERIC(op2)) {
658
            op2_len = LENGTH(op2);
659
 
660
            if (op2_len == 1) {
661
                if (funcname[0] == '%') {
662
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
3434 mrmanese 663
                            (funcname[1] == '%') ? "r_mod" : "r_intdiv", varname_src, iname_src);
3358 mrmanese 664
                } else {
665
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
666
                            varname_src, funcname, iname_src);
667
                }
668
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
669
                _sqlite_error(res);
670
                sqlite3_bind_double(stmt, 1, REAL(op2)[0]);
671
                sqlite3_step(stmt);
3419 mrmanese 672
                sqlite3_finalize(stmt);
3358 mrmanese 673
            } else if (op2_len <= svec_len) {  /* recycle op2 */
674
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
675
                        varname_src, iname_src);
676
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
677
                _sqlite_error(res);
678
 
679
                if (funcname[0] == '%') {
3434 mrmanese 680
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, 
681
                            (funcname[1] == '%') ? "r_mod" : "r_intdiv");  
3419 mrmanese 682
                    _sqlite_begin;
3358 mrmanese 683
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
684
                    _sqlite_error(res);
685
 
686
                    for (i = 0; i < svec_len; i++) {
687
                        sqlite3_step(stmt2);
688
 
689
                        sqlite3_reset(stmt);
690
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
3434 mrmanese 691
                        sqlite3_bind_int(stmt, sdf_idx, (int)sqlite3_column_double(stmt2, 1));
692
                        sqlite3_bind_int(stmt, vec_idx, (int)REAL(op2)[i % op2_len]);
3358 mrmanese 693
                        sqlite3_step(stmt);
694
                    }
3419 mrmanese 695
                    sqlite3_finalize(stmt);
696
                    sqlite3_finalize(stmt2);
697
                    _sqlite_commit;
3358 mrmanese 698
                } else { /* non-integer binary operation */
699
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
3419 mrmanese 700
                    _sqlite_begin;
3358 mrmanese 701
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
702
                    _sqlite_error(res);
703
 
704
                    for (i = 0; i < svec_len; i++) {
705
                        sqlite3_step(stmt2);
706
 
707
                        sqlite3_reset(stmt);
708
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
3434 mrmanese 709
                        sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 1));
710
                        sqlite3_bind_double(stmt, vec_idx, REAL(op2)[i % op2_len]);
3358 mrmanese 711
                        sqlite3_step(stmt);
712
                    }
3419 mrmanese 713
                    sqlite3_finalize(stmt);
714
                    sqlite3_finalize(stmt2);
715
                    _sqlite_commit;
3358 mrmanese 716
                }
717
            } else { /* op2_len > svec_len, recycle svec */
718
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
719
                        varname_src, iname_src);
720
 
721
                if (funcname[0] == '%') {
3434 mrmanese 722
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, 
723
                            (funcname[1] == '%') ? "r_mod" : "r_intdiv");
3358 mrmanese 724
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
725
                    _sqlite_error(res);
726
                } else {
727
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
728
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
729
                    _sqlite_error(res);
730
                }
3434 mrmanese 731
 
3419 mrmanese 732
                i = 0; _sqlite_begin;
3358 mrmanese 733
                while (i < op2_len) {
734
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
735
                    _sqlite_error(res);
736
 
737
                    if (funcname[0] == '%') {
738
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
739
                            sqlite3_step(stmt2);
740
 
741
                            sqlite3_reset(stmt);
742
                            /* simplify my life, just use ints for row names so that we
743
                             * don't have to worry about duplicates */
744
                            sqlite3_bind_int(stmt, 1, i); 
3434 mrmanese 745
                            sqlite3_bind_int(stmt, sdf_idx, sqlite3_column_int(stmt2, 1));
746
                            sqlite3_bind_int(stmt, vec_idx, (int)REAL(op2)[i % op2_len]);
3358 mrmanese 747
                            sqlite3_step(stmt);
748
                        }
749
                    } else {
750
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
751
                            sqlite3_step(stmt2);
752
 
753
                            sqlite3_reset(stmt);
754
                            sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 755
                            sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 1));
756
                            sqlite3_bind_double(stmt, vec_idx, REAL(op2)[i % op2_len]);
3358 mrmanese 757
                            sqlite3_step(stmt);
758
                        }
759
                    }
760
 
761
                    /* recycle on svec if we loop again */
762
                    sqlite3_finalize(stmt2);
763
                }
3397 mrmanese 764
 
3419 mrmanese 765
                sqlite3_finalize(stmt);
766
                _sqlite_commit;
3358 mrmanese 767
            }
768
 
769
        } else if (IS_INTEGER(op2) || IS_LOGICAL(op2)) { /* I N T E G E R */
770
            /* we are taking advantage of the fact that logicals are stored as int.
771
             * if this becomes untrue in the future, then this is a bug */
3458 mrmanese 772
            /* we are binding double because ___ (?) */
3358 mrmanese 773
            op2_len = LENGTH(op2);
774
 
775
            if (op2_len == 1) {
776
                if (funcname[0] == '%') {
777
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
3434 mrmanese 778
                            varname_src, (funcname[1] == '%') ? "r_mod" : "r_intdiv", iname_src);
3358 mrmanese 779
                } else {
780
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
781
                            varname_src, funcname, iname_src);
782
                }
783
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
784
                _sqlite_error(res);
785
                sqlite3_bind_double(stmt, 1, (double)INTEGER(op2)[0]);
786
                sqlite3_step(stmt);
787
            } else if (op2_len <= svec_len) {
788
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
789
                        varname_src, iname_src);
790
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
791
                _sqlite_error(res);
792
 
793
                if (funcname[0] == '%') {
3434 mrmanese 794
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, 
795
                            (funcname[1] == '%') ? "r_mod" : "r_intdiv");
3419 mrmanese 796
                    _sqlite_begin;
3358 mrmanese 797
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
798
                    _sqlite_error(res);
799
 
800
                    for (i = 0; i < svec_len; i++) {
801
                        sqlite3_step(stmt2);
802
 
803
                        sqlite3_reset(stmt);
804
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
3434 mrmanese 805
                        sqlite3_bind_int(stmt, sdf_idx, sqlite3_column_int(stmt2, 1));
806
                        sqlite3_bind_int(stmt, vec_idx, INTEGER(op2)[i % op2_len]);
3358 mrmanese 807
                        sqlite3_step(stmt);
808
                    }
3458 mrmanese 809
                    sqlite3_finalize(stmt);
810
                    sqlite3_finalize(stmt2);
3419 mrmanese 811
                    _sqlite_commit;
3358 mrmanese 812
                } else {
813
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
3419 mrmanese 814
                    _sqlite_begin;
3358 mrmanese 815
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
816
                    _sqlite_error(res);
817
 
818
                    for (i = 0; i < svec_len; i++) {
819
                        sqlite3_step(stmt2);
820
 
821
                        sqlite3_reset(stmt);
822
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
3434 mrmanese 823
                        sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 1));
824
                        sqlite3_bind_double(stmt, vec_idx, (double)INTEGER(op2)[i % op2_len]);
3358 mrmanese 825
                        sqlite3_step(stmt);
826
                    }
3458 mrmanese 827
                    sqlite3_finalize(stmt);
828
                    sqlite3_finalize(stmt2);
3419 mrmanese 829
                    _sqlite_commit;
3358 mrmanese 830
                }
831
            } else {
832
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
833
                        varname_src, iname_src);
834
 
835
                if (funcname[0] == '%') {
3434 mrmanese 836
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname,
837
                            (funcname[1] == '%') ? "r_mod" : "r_intdiv");
3358 mrmanese 838
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
839
                    _sqlite_error(res);
840
                } else {
841
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
842
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
843
                    _sqlite_error(res);
844
                }
845
 
3419 mrmanese 846
                i = 0; _sqlite_begin; 
3358 mrmanese 847
                while (i < op2_len) {
848
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
849
                    _sqlite_error(res);
850
 
851
                    if (funcname[0] == '%') {
852
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
853
                            sqlite3_step(stmt2);
854
 
855
                            sqlite3_reset(stmt);
856
                            /* simplify my life, just use ints for row names so that we
857
                             * don't have to worry about duplicates */
858
                            sqlite3_bind_int(stmt, 1, i); 
3434 mrmanese 859
                            sqlite3_bind_int(stmt, sdf_idx, sqlite3_column_int(stmt2, 1));
860
                            sqlite3_bind_int(stmt, vec_idx, INTEGER(op2)[i % op2_len]);
3358 mrmanese 861
                            sqlite3_step(stmt);
862
                        }
863
                    } else {
864
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
865
                            sqlite3_step(stmt2);
866
 
867
                            sqlite3_reset(stmt);
868
                            sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 869
                            sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 1));
870
                            sqlite3_bind_double(stmt, vec_idx, (double)INTEGER(op2)[i % op2_len]);
3358 mrmanese 871
                            sqlite3_step(stmt);
872
                        }
873
                    }
874
 
875
                    /* recycle on svec if we loop again */
876
                    sqlite3_finalize(stmt2);
877
                }
3458 mrmanese 878
                sqlite3_finalize(stmt);
3419 mrmanese 879
                _sqlite_commit;
3358 mrmanese 880
            }
881
 
3458 mrmanese 882
        } else if (IS_CHARACTER(op2)) {
883
            if (functype != 2) error("not supported");
884
 
885
            op2_len = LENGTH(op2);
886
 
887
            if (op2_len == 1) {
888
                sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
889
                            varname_src, funcname, iname_src);
890
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
891
                _sqlite_error(res);
892
                sqlite3_bind_text(stmt, 1, CHAR_ELT(op2, 0), -1, SQLITE_STATIC);
893
                sqlite3_step(stmt);
894
            } else if (op2_len <= svec_len) {
895
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
896
                        varname_src, iname_src);
897
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
898
                _sqlite_error(res);
899
 
900
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
901
                _sqlite_begin;
902
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
903
                _sqlite_error(res);
904
 
905
                for (i = 0; i < svec_len; i++) {
906
                    sqlite3_step(stmt2);
907
 
908
                    sqlite3_reset(stmt);
909
                    sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
910
                    sqlite3_bind_text(stmt, sdf_idx, (char *)sqlite3_column_text(stmt2, 1), -1, SQLITE_STATIC);
911
                    sqlite3_bind_text(stmt, vec_idx, CHAR_ELT(op2, i % op2_len), -1 , SQLITE_STATIC);
912
                    sqlite3_step(stmt);
913
                }
914
                sqlite3_finalize(stmt2);
915
                _sqlite_commit;
916
            } else {
917
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
918
                        varname_src, iname_src);
919
 
920
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
921
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
922
                _sqlite_error(res);
923
 
924
                i = 0; _sqlite_begin; 
925
                while (i < op2_len) {
926
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
927
                    _sqlite_error(res);
928
 
929
                    for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
930
                        sqlite3_step(stmt2);
931
 
932
                        sqlite3_reset(stmt);
933
                        sqlite3_bind_int(stmt, 1, i);
934
                        sqlite3_bind_text(stmt, sdf_idx, (char *)sqlite3_column_text(stmt2, 1), -1, SQLITE_STATIC);
935
                        sqlite3_bind_text(stmt, vec_idx, CHAR_ELT(op2, i % op2_len), -1 , SQLITE_STATIC);
936
                        sqlite3_step(stmt);
937
                    }
938
 
939
                    /* recycle on svec if we loop again */
940
                    sqlite3_finalize(stmt2);
941
                }
942
                sqlite3_finalize(stmt);
943
                _sqlite_commit;
944
            }
945
 
3358 mrmanese 946
        } else if (inherits(op2, "sqlite.vector")) { 
947
            /* op2 is surely not a factor, as handled by the R wrapper */
3434 mrmanese 948
            /* even though it is impossible for reversed to be FALSE, still use
949
             * sdf_idx and vec_idx so that code would be less confusing */
4798 mrmanese 950
            const char *iname_op2, *varname_op2;
3358 mrmanese 951
            sqlite3_stmt *stmt3;
952
            iname_op2 = SDF_INAME(op2);
953
            varname_op2 = SVEC_VARNAME(op2);
954
 
3419 mrmanese 955
            if (!USE_SDF1(iname_op2, TRUE, TRUE)) {
3358 mrmanese 956
                /* delete created sqlite.vector */
3458 mrmanese 957
                warning("detaching created result SDF %s\n", iname);
3358 mrmanese 958
                sdf_detach_sdf(mkString(iname));
959
                return R_NilValue;
960
            }
3419 mrmanese 961
            _sqlite_begin;
3358 mrmanese 962
 
963
            op2_len = _get_row_count2(iname_op2, 1);
964
 
965
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_src, iname_src);
966
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
967
            _sqlite_error(res);
968
 
969
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_op2, iname_op2);
970
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt3, 0);
971
            _sqlite_error(res);
972
 
973
            if (funcname[0] == '%') {
3434 mrmanese 974
                sprintf(g_sql_buf[2], insert_fmt_string2c, iname,
975
                            (funcname[1] == '%') ? "r_mod" : "r_intdiv");
3358 mrmanese 976
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
977
                _sqlite_error(res);
978
 
979
                if (svec_len == op2_len) {
980
                    for (i = 0; i < svec_len; i++) {
981
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
982
 
983
                        sqlite3_reset(stmt);
984
                        sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 985
                        sqlite3_bind_int(stmt, sdf_idx, sqlite3_column_int(stmt2, 0));
986
                        sqlite3_bind_int(stmt, vec_idx, sqlite3_column_int(stmt3, 0));
3358 mrmanese 987
                        sqlite3_step(stmt);
988
                    }
989
                } else if (svec_len < op2_len) {
990
                    i = 0;
991
                    while (i < op2_len) {
992
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
993
                            sqlite3_step(stmt3);
994
 
995
                            sqlite3_reset(stmt);
996
                            sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 997
                            sqlite3_bind_int(stmt, sdf_idx, sqlite3_column_int(stmt2, 0));
998
                            sqlite3_bind_int(stmt, vec_idx, sqlite3_column_int(stmt3, 0));
3358 mrmanese 999
                            sqlite3_step(stmt);
1000
                        }
1001
                        sqlite3_reset(stmt2);
1002
                    }
1003
                } else {
1004
                    i = 0;
1005
                    while (i < svec_len) {
1006
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
1007
                            sqlite3_step(stmt2);
1008
 
1009
                            sqlite3_reset(stmt);
1010
                            sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 1011
                            sqlite3_bind_int(stmt, sdf_idx, sqlite3_column_int(stmt2, 0));
1012
                            sqlite3_bind_int(stmt, vec_idx, sqlite3_column_int(stmt3, 0));
3358 mrmanese 1013
                            sqlite3_step(stmt);
1014
                        }
1015
                        sqlite3_reset(stmt3);
1016
                    }
1017
                }
3419 mrmanese 1018
                _sqlite_commit;
3358 mrmanese 1019
            } else { /* not an integer op %% or %/% */
1020
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
1021
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
1022
                _sqlite_error(res);
1023
 
1024
                if (svec_len == op2_len) {
1025
                    for (i = 0; i < svec_len; i++) {
1026
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
1027
 
1028
                        sqlite3_reset(stmt);
1029
                        sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 1030
                        sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 0));
1031
                        sqlite3_bind_double(stmt, vec_idx, sqlite3_column_double(stmt3, 0));
3358 mrmanese 1032
                        sqlite3_step(stmt);
1033
                    }
1034
                } else if (svec_len < op2_len) { /* recycle svec */
1035
                    i = 0;
1036
                    while (i < op2_len) {
1037
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
1038
                            sqlite3_step(stmt3);
1039
 
1040
                            sqlite3_reset(stmt);
1041
                            sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 1042
                            sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 0));
1043
                            sqlite3_bind_double(stmt, vec_idx, sqlite3_column_double(stmt3, 0));
3358 mrmanese 1044
                            sqlite3_step(stmt);
1045
                        }
1046
                        sqlite3_reset(stmt2);
1047
                    }
1048
                } else { /* svec_len > op2_len, recycle op2 */
1049
                    i = 0;
1050
                    while (i < svec_len) {
1051
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
1052
                            sqlite3_step(stmt2);
1053
 
1054
                            sqlite3_reset(stmt);
1055
                            sqlite3_bind_int(stmt, 1, i);
3434 mrmanese 1056
                            sqlite3_bind_double(stmt, sdf_idx, sqlite3_column_double(stmt2, 0));
1057
                            sqlite3_bind_double(stmt, vec_idx, sqlite3_column_double(stmt3, 0));
3358 mrmanese 1058
                            sqlite3_step(stmt);
1059
                        }
1060
                        sqlite3_reset(stmt3);
1061
                    }
1062
                }
1063
            }
1064
 
1065
            sqlite3_finalize(stmt);
1066
            sqlite3_finalize(stmt2);
1067
            sqlite3_finalize(stmt3);
3419 mrmanese 1068
            _sqlite_commit;
1069
 
1070
            UNUSE_SDF2(iname_op2);
3358 mrmanese 1071
        }
1072
    } else if (functype == 1 && funcname[0] != '!') { /* unary not operator */
3419 mrmanese 1073
        iname = _create_svector1(R_NilValue, "bit", NULL, TRUE);
3358 mrmanese 1074
        sprintf(g_sql_buf[2], "insert into [%s].sdf_data "
1075
                    "select [row name], [%s] == 0 from [%s].sdf_data", 
1076
                    iname, varname_src, iname_src);
1077
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
1078
        _sqlite_error(res);
1079
        sqlite3_step(stmt);
1080
        sqlite3_finalize(stmt);
1081
    }
1082
 
3419 mrmanese 1083
    if (iname != NULL) {
3684 mrmanese 1084
        return _create_svector_sexp(iname, "sdf_data", "V1", 
3358 mrmanese 1085
                (functype == 0) ? "numeric" : "logical");
3419 mrmanese 1086
        UNUSE_SDF2(iname);
1087
    }
3358 mrmanese 1088
 
3419 mrmanese 1089
    UNUSE_SDF2(iname_src);
1090
 
3358 mrmanese 1091
    return R_NilValue;
1092
 
3307 mrmanese 1093
}
1094
 
3324 mrmanese 1095
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
4798 mrmanese 1096
    const char *iname_src, *varname_src, *funcname;
3324 mrmanese 1097
    int res;
1098
    sqlite3_stmt *stmt;
3855 mrmanese 1099
    double _ret = NA_REAL, _ret2; SEXP ret;
3307 mrmanese 1100
 
3324 mrmanese 1101
    /* get data from arguments (function name and sqlite.vector stuffs) */
1102
    funcname = CHAR_ELT(func, 0);
1103
    iname_src = SDF_INAME(vector);
1104
    varname_src = SVEC_VARNAME(vector);
3307 mrmanese 1105
 
3419 mrmanese 1106
    if (!USE_SDF1(iname_src, TRUE, FALSE)) return R_NilValue;
3324 mrmanese 1107
 
1108
    g_narm = LOGICAL(na_rm)[0];
1109
    if (strcmp(funcname, "range") == 0) {
1110
        /* special handling for range. use min then max */
3473 mrmanese 1111
        _init_sqlite_function_accumulator();
3324 mrmanese 1112
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
1113
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
1114
        if (_sqlite_error(res)) return R_NilValue;
3855 mrmanese 1115
        sqlite3_step(stmt); 
1116
        _ret = sqlite3_column_double(stmt, 0);
1117
        sqlite3_finalize(stmt);
3324 mrmanese 1118
 
1119
        if (R_IsNA(_ret) && !g_narm) {
1120
            PROTECT(ret = NEW_NUMERIC(2));
1121
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
1122
            goto __sdf_do_variable_summary_out;
1123
        }
1124
 
3473 mrmanese 1125
        _init_sqlite_function_accumulator();
3324 mrmanese 1126
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
1127
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
1128
        if (_sqlite_error(res)) return R_NilValue;
3855 mrmanese 1129
        sqlite3_step(stmt); 
1130
        _ret2 = sqlite3_column_double(stmt, 0);
1131
        sqlite3_finalize(stmt);
3324 mrmanese 1132
 
1133
        /* if there is NA, then the if above should have caught it already */
1134
        PROTECT(ret = NEW_NUMERIC(2));
1135
        REAL(ret)[0] = _ret;
3855 mrmanese 1136
        REAL(ret)[1] = _ret2;
3324 mrmanese 1137
    } else {
3473 mrmanese 1138
        _init_sqlite_function_accumulator();
3324 mrmanese 1139
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
1140
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
1141
        if (_sqlite_error(res)) return R_NilValue;
3855 mrmanese 1142
        res = sqlite3_step(stmt); 
1143
        _ret = sqlite3_column_double(stmt, 0);
1144
        sqlite3_finalize(stmt);
3324 mrmanese 1145
 
1146
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
1147
            PROTECT(ret = NEW_LOGICAL(1));
3855 mrmanese 1148
            if (R_IsNA(_ret)) LOGICAL(ret)[0] = NA_INTEGER;
1149
            else LOGICAL(ret)[0] = (_ret != 0);
3324 mrmanese 1150
        } else {
1151
            PROTECT(ret = NEW_NUMERIC(1));
3855 mrmanese 1152
            REAL(ret)[0] = _ret;
3324 mrmanese 1153
        }
1154
    }
1155
 
1156
__sdf_do_variable_summary_out:
1157
    UNPROTECT(1);
1158
    return ret;
1159
}
1160
 
1161
 
3358 mrmanese 1162
SEXP sdf_sort_variable(SEXP svec, SEXP decreasing) {
4798 mrmanese 1163
    const char *iname, *tblname, *varname, *type, *sort_type;
3358 mrmanese 1164
    sqlite3_stmt *stmt;
1165
    int res;
1166
 
3808 mrmanese 1167
    iname = SDF_INAME(svec);
1168
    tblname = SVEC_TBLNAME(svec);
1169
    varname = SVEC_VARNAME(svec);
3358 mrmanese 1170
 
3808 mrmanese 1171
    if (!USE_SDF1(iname, TRUE, TRUE)) return R_NilValue;
3358 mrmanese 1172
 
1173
    /* determine type of svec */
3808 mrmanese 1174
    sprintf(g_sql_buf[0], "select [%s] from [%s].[%s] limit 1", varname, iname, tblname);
3358 mrmanese 1175
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
1176
    _sqlite_error(res);
1177
    sqlite3_step(stmt);
1178
    strcpy(g_sql_buf[0], sqlite3_column_decltype(stmt, 0));
1179
    sqlite3_finalize(stmt);
1180
 
3456 mrmanese 1181
    if (TEST_SDFVECTORTYPE(svec, "factor")) { /* copy factor table to iname */
1182
        if (TEST_SDFVECTORTYPE(svec, "ordered")) type = "ordered";
3358 mrmanese 1183
        else type = "factor";
3808 mrmanese 1184
        _copy_factor_levels2(type, iname, varname, iname, "V1");
3471 mrmanese 1185
    } else type = CHAR_ELT(GET_SDFVECTORTYPE(svec), 0);
3358 mrmanese 1186
 
3808 mrmanese 1187
    if (strcmp(tblname, "sdf_data") == 0) {
1188
        /* cache sorted data if column to be sorted comes from main sdf_data */
3419 mrmanese 1189
 
3808 mrmanese 1190
        /* test if there is already a sort_varname table */
1191
        sort_type = (LOGICAL(decreasing)[0]) ? "desc" : "asc";
1192
        sprintf(g_sql_buf[1], "select count(*) from [%s].sqlite_master "
1193
                "where type='table' and name='sort_%s_%s'", iname, sort_type, varname);
1194
        sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt, NULL);
1195
        sqlite3_step(stmt);
1196
        res = sqlite3_column_int(stmt, 0);
1197
        sqlite3_finalize(stmt);
1198
 
1199
        if (res == 0) {
1200
            sprintf(g_sql_buf[1], "create table [%s].[sort_%s_%s] ([%s] %s)", 
1201
                    iname, sort_type, varname, varname, g_sql_buf[0]);
1202
            if (_sqlite_error(_sqlite_exec(g_sql_buf[1]))) 
1203
                    error("Can't create table: %s", g_sql_buf[1]);
1204
 
1205
            /* insert to new sdf ordered */
1206
            sprintf(g_sql_buf[0], "insert into [%s].[sort_%s_%s] "
1207
                    "select [%s] from [%s].[%s] order by [%s] %s", 
1208
                    iname, sort_type, varname, varname, iname, tblname, varname, sort_type);
1209
 
1210
            res = _sqlite_exec(g_sql_buf[0]);
1211
            if (_sqlite_error(res)) error("Can't insert: %s", g_sql_buf[0]);
1212
        }
1213
 
1214
        UNUSE_SDF2(iname);
1215
        sprintf(g_sql_buf[0], "sort_%s_%s", sort_type, varname);
1216
        return _create_svector_sexp(iname, g_sql_buf[0], varname, type);
1217
    } else {
1218
        /* create a new sdf table, copy data to that */
1219
 
1220
        /* create a sorted column */
1221
 
1222
        error("Not yet supported.");
1223
    }
1224
 
1225
    return R_NilValue;
3358 mrmanese 1226
}
1227
 
3307 mrmanese 1228
/****************************************************************************
1229
 * VECTOR MATH/OPS/GROUP OPERATIONS
1230
 ****************************************************************************/
3855 mrmanese 1231
struct accumulator_t {
1232
    /* long double acts weird here, but if it's not long double,
1233
     * it f*cks up sum() */
1234
    long double accumulator;
1235
    int started;
1236
};
3324 mrmanese 1237
 
3434 mrmanese 1238
R_INLINE int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
3307 mrmanese 1239
    int ret = 1;
1240
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
1241
        sqlite3_result_null(ctx); 
1242
        ret = 0;
1243
    } else {
1244
        if (sqlite3_value_type(arg) == SQLITE_INTEGER) 
1245
            *value = sqlite3_value_int(arg); 
1246
        else *value = sqlite3_value_double(arg); 
1247
    }
1248
    return ret;
1249
}
1250
 
1251
#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\
1252
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
1253
    double value; \
1254
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
1255
        sqlite3_result_double(ctx, func(value)); \
1256
    }  \
1257
}
1258
 
3434 mrmanese 1259
#define SQLITE_MATH_FUNC2(name, func) static void __vecmath_ ## name(\
1260
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
1261
    double value1, value2; \
1262
    if (__vecmath_checkarg(ctx, argv[0], &value1) && \
1263
        __vecmath_checkarg(ctx, argv[1], &value2)) { \
1264
        sqlite3_result_double(ctx, func((long double)value1, (long double)value2)); \
1265
    }  \
1266
}
1267
 
3324 mrmanese 1268
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
1269
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
1270
    double value; \
1271
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
1272
        if (g_start) { g_start = 0; g_accumulator = value; } \
1273
        else g_accumulator = func(g_accumulator, value); \
1274
        sqlite3_result_double(ctx, g_accumulator); \
1275
    }  \
1276
}
1277
 
3434 mrmanese 1278
#define LOGBASE(a, b) log(a)/log(b)
1279
 
3307 mrmanese 1280
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
1281
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
1282
SQLITE_MATH_FUNC1(sqrt, sqrt)
1283
SQLITE_MATH_FUNC1(floor, floor)
1284
SQLITE_MATH_FUNC1(ceiling, ceil)
1285
SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */
3434 mrmanese 1286
/*SQLITE_MATH_FUNC2(round, fprec)  2 arg, in SQLite, but override with R's version */
1287
SQLITE_MATH_FUNC2(signif, fround) /* 2 arg, in R */
3307 mrmanese 1288
SQLITE_MATH_FUNC1(exp, exp)
3434 mrmanese 1289
SQLITE_MATH_FUNC2(log, LOGBASE) /* 2 arg */
3307 mrmanese 1290
SQLITE_MATH_FUNC1(cos, cos)
1291
SQLITE_MATH_FUNC1(sin, sin)
1292
SQLITE_MATH_FUNC1(tan, tan)
1293
SQLITE_MATH_FUNC1(acos, acos)
1294
SQLITE_MATH_FUNC1(asin, asin)
1295
SQLITE_MATH_FUNC1(atan, atan)
1296
SQLITE_MATH_FUNC1(cosh, cosh)
1297
SQLITE_MATH_FUNC1(sinh, sinh)
1298
SQLITE_MATH_FUNC1(tanh, tanh)
1299
SQLITE_MATH_FUNC1(acosh, acosh)  /* nowhere in include?? */
1300
SQLITE_MATH_FUNC1(asinh, asinh)  /* nowhere in include?? */
1301
SQLITE_MATH_FUNC1(atanh, atanh)  /* nowhere in include?? */
1302
SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */
1303
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
1304
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
1305
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
1306
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
1307
 
3855 mrmanese 1308
#define SUM(a, b)  ((long double)(a) + (b))
3324 mrmanese 1309
#define PROD(a, b) (a) * (b)
1310
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
1311
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
1312
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
1313
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
1314
 
1315
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
1316
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
1317
SQLITE_MATH_FUNC_CUM(cummin, MIN)
1318
SQLITE_MATH_FUNC_CUM(cummax, MAX)
1319
 
1320
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
1321
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
1322
    double value; \
3855 mrmanese 1323
    struct accumulator_t *acc; \
1324
    acc = sqlite3_aggregate_context(ctx, sizeof(struct accumulator_t)); \
1325
    if (!g_narm && R_IsNA(acc->accumulator)) return; /* NA if na.rm=F & NA found */ \
3324 mrmanese 1326
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
1327
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
1328
            int tmp = sqlite3_value_int(argv[0]); \
1329
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
1330
        } else value = sqlite3_value_double(argv[0]);  \
1331
        if (R_IsNA(value)) { \
3855 mrmanese 1332
            if (!g_narm) acc->accumulator = value; return; /* else ignore */ \
1333
        } else if (!acc->started) { \
1334
            acc->started = 1; \
1335
            acc->accumulator = value; \
1336
        } else acc->accumulator = func(acc->accumulator, value); \
3324 mrmanese 1337
    } \
1338
}
1339
 
1340
SQLITE_SUMMARY_FUNC(all_df, ALL)
1341
SQLITE_SUMMARY_FUNC(any_df, ANY)
1342
SQLITE_SUMMARY_FUNC(sum_df, SUM)
1343
SQLITE_SUMMARY_FUNC(prod_df, PROD)
1344
SQLITE_SUMMARY_FUNC(min_df, MIN)
1345
SQLITE_SUMMARY_FUNC(max_df, MAX)
1346
 
1347
static void __vecsummary_finalize(sqlite3_context *ctx) {
1348
    /* g_accumulator already summarizes it. just return that */
3855 mrmanese 1349
    struct accumulator_t *acc = (struct accumulator_t *)
1350
                sqlite3_aggregate_context(ctx, sizeof(struct accumulator_t)); 
1351
    sqlite3_result_double(ctx, acc->accumulator);
3324 mrmanese 1352
}
1353
 
3434 mrmanese 1354
static void __r_modulo(sqlite3_context *ctx, int argc, sqlite3_value **argv) {
1355
    if (sqlite3_value_type(argv[0]) == SQLITE_NULL ||
1356
        sqlite3_value_type(argv[1]) == SQLITE_NULL) { 
1357
        sqlite3_result_null(ctx); 
1358
    } else {
1359
        double v1, v2, q, tmp;
1360
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER && 
1361
            sqlite3_value_type(argv[1]) == SQLITE_INTEGER) {
1362
            int i1, i2;
1363
            i1 = sqlite3_value_int(argv[0]);
1364
            i2 = sqlite3_value_int(argv[1]);
1365
            if (i1 > 0 && i2 > 0) { 
1366
                sqlite3_result_int(ctx, i1 % i2); return;
1367
            }
1368
            v1 = i1; v2 = i2;
1369
        } else {
1370
            v1 = sqlite3_value_double(argv[0]);
1371
            v2 = sqlite3_value_double(argv[1]);
1372
        }
1373
        /* copied from myfmod() in src/main/arithmetic.c */
1374
        q = v1 / v2; 
1375
        if (v2 == 0) sqlite3_result_double(ctx, R_NaN);
1376
        tmp = v1 - floor(q) * v2;
1377
        /* checking omitted */
1378
        q = floor(tmp/v2);
1379
        sqlite3_result_double(ctx, tmp - q*v2);
1380
 
1381
    }
1382
}
1383
 
1384
static void __r_intdiv(sqlite3_context *ctx, int argc, sqlite3_value **argv) {
1385
    if (sqlite3_value_type(argv[0]) == SQLITE_NULL ||
1386
        sqlite3_value_type(argv[1]) == SQLITE_NULL) { 
1387
        sqlite3_result_null(ctx); 
1388
    } else {
1389
        double v1, v2;
1390
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER && 
1391
            sqlite3_value_type(argv[1]) == SQLITE_INTEGER) {
1392
            int i1, i2;
1393
            i1 = sqlite3_value_int(argv[0]);
1394
            i2 = sqlite3_value_int(argv[1]);
1395
            if (i1 == NA_INTEGER || i2 == NA_INTEGER) {
1396
                sqlite3_result_int(ctx, NA_INTEGER); return;
1397
            } else if (i2 == 0) {
1398
                sqlite3_result_int(ctx, 0); return;
1399
            }
1400
            v1 = i1; v2 = i2;
1401
        } else {
1402
            v1 = sqlite3_value_double(argv[0]);
1403
            v2 = sqlite3_value_double(argv[1]);
1404
        }
1405
        /* copied from IDIVOP cases in src/main/arithmetic.c */
1406
        sqlite3_result_double(ctx, floor(v1/v2));
1407
    }
1408
}
3307 mrmanese 1409
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
3324 mrmanese 1410
#define VSENTRY1(func)  {#func, __vecsummary_ ## func}
3307 mrmanese 1411
void __register_vector_math() {
1412
    int i, res;
1413
    static const struct {
1414
        char *name;
1415
        void (*func)(sqlite3_context*, int, sqlite3_value**);
1416
    } arr_func1[] = {
1417
        VMENTRY1(sign),
1418
        VMENTRY1(sqrt),
1419
        VMENTRY1(floor),
1420
        VMENTRY1(ceiling),
1421
        VMENTRY1(trunc),
1422
        VMENTRY1(exp),
1423
        VMENTRY1(cos),
1424
        VMENTRY1(sin),
1425
        VMENTRY1(tan),
1426
        VMENTRY1(acos),
1427
        VMENTRY1(asin),
1428
        VMENTRY1(atan),
1429
        VMENTRY1(cosh),
1430
        VMENTRY1(sinh),
1431
        VMENTRY1(tanh),
1432
        VMENTRY1(acosh),
1433
        VMENTRY1(asinh),
1434
        VMENTRY1(atanh),
1435
        VMENTRY1(lgamma),
1436
        VMENTRY1(gamma),
1437
        VMENTRY1(digamma),
3324 mrmanese 1438
        VMENTRY1(trigamma),
1439
        VMENTRY1(cumsum),
1440
        VMENTRY1(cumprod),
1441
        VMENTRY1(cummin),
1442
        VMENTRY1(cummax)
3434 mrmanese 1443
    }, arr_func2[] =  {
1444
        {"r_mod", __r_modulo},
1445
        {"r_intdiv", __r_intdiv},
1446
        /*VMENTRY1(round),*/
1447
        VMENTRY1(signif),
1448
        VMENTRY1(log)
3324 mrmanese 1449
    }, arr_sum1[] = {
1450
        VSENTRY1(all_df),  /* can't override sum, min, max */
1451
        VSENTRY1(any_df),
1452
        VSENTRY1(sum_df),
1453
        VSENTRY1(prod_df),
1454
        VSENTRY1(min_df),
1455
        VSENTRY1(max_df)
3307 mrmanese 1456
    };
1457
 
3324 mrmanese 1458
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
3307 mrmanese 1459
 
3324 mrmanese 1460
    for (i = 0; i < len; i++) {
3307 mrmanese 1461
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
1462
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
1463
        _sqlite_error(res);
1464
    }
3324 mrmanese 1465
 
3434 mrmanese 1466
    len = sizeof(arr_func2) / sizeof(arr_func2[0]);
1467
    for (i = 0; i < len; i++) {
1468
        res = sqlite3_create_function(g_workspace, arr_func2[i].name, 2, 
1469
                SQLITE_ANY, NULL, arr_func2[i].func, NULL, NULL);
1470
        _sqlite_error(res);
1471
    }
1472
 
3324 mrmanese 1473
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
1474
    for (i = 0; i < len; i++) {
1475
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
1476
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
1477
        _sqlite_error(res);
1478
    }
3307 mrmanese 1479
}