The R Project SVN R-packages

Rev

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