The R Project SVN R-packages

Rev

Rev 3308 | Rev 3397 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3308 Rev 3324
Line 9... Line 9...
9
    }
9
    }
10
 
10
 
11
    char *iname = SDF_INAME(sdf);
11
    char *iname = SDF_INAME(sdf);
12
    char *varname = CHAR_ELT(name, 0);
12
    char *varname = CHAR_ELT(name, 0);
13
 
13
 
14
    if (!USE_SDF(iname)) return R_NilValue;
14
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
15
 
15
 
16
    /* check if sdf & varname w/in that sdf exists */
16
    /* check if sdf & varname w/in that sdf exists */
17
    sqlite3_stmt *stmt;
17
    sqlite3_stmt *stmt;
18
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
18
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
19
 
19
 
Line 118... Line 118...
118
    return added;
118
    return added;
119
}
119
}
120
 
120
 
121
SEXP sdf_get_variable_length(SEXP svec) {
121
SEXP sdf_get_variable_length(SEXP svec) {
122
    char *iname = SDF_INAME(svec);
122
    char *iname = SDF_INAME(svec);
123
    if (!USE_SDF(iname)) return R_NilValue;
123
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
124
    sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
124
    sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
125
 
125
 
126
    SEXP ret;
126
    SEXP ret;
127
    PROTECT(ret = NEW_INTEGER(1));
127
    PROTECT(ret = NEW_INTEGER(1));
128
    INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);
128
    INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);
Line 134... Line 134...
134
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
134
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
135
    SEXP ret = R_NilValue, tmp;
135
    SEXP ret = R_NilValue, tmp;
136
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
136
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
137
    int index, idxlen, i, retlen=0, res;
137
    int index, idxlen, i, retlen=0, res;
138
 
138
 
139
    if (!USE_SDF(iname)) return R_NilValue;
139
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
140
 
140
 
141
    /* check if sdf exists */
141
    /* check if sdf exists */
142
    sqlite3_stmt *stmt;
142
    sqlite3_stmt *stmt;
143
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
143
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
144
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
144
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
Line 271... Line 271...
271
    }
271
    }
272
 
272
 
273
    return ret;
273
    return ret;
274
}
274
}
275
 
275
 
-
 
276
/* the global accumulator should be safe if we only do 1 cummulative or
-
 
277
 * aggregate at any time. it won't work for stuffs like "select max(col)-min(col)
-
 
278
 * from sdf_data". */
-
 
279
static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */
-
 
280
static int g_start = 0;            /* flag for start of cummulation */
-
 
281
static int g_narm = 0;             /* for Summary group */
276
 
282
 
277
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {
283
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {
278
    char *iname, *iname_src, *varname_src, *funcname;
284
    char *iname, *iname_src, *varname_src, *funcname;
279
    int namelen, res, nargs;
285
    int namelen, res, nargs;
280
    sqlite3_stmt *stmt;
286
    sqlite3_stmt *stmt;
Line 283... Line 289...
283
    funcname = CHAR_ELT(func, 0);
289
    funcname = CHAR_ELT(func, 0);
284
    iname_src = SDF_INAME(vector);
290
    iname_src = SDF_INAME(vector);
285
    varname_src = SVEC_VARNAME(vector);
291
    varname_src = SVEC_VARNAME(vector);
286
    nargs = INTEGER(_nargs)[0];
292
    nargs = INTEGER(_nargs)[0];
287
 
293
 
288
    if (!USE_SDF(iname_src)) return R_NilValue;
294
    if (!USE_SDF(iname_src, TRUE)) return R_NilValue;
289
 
295
 
290
    /* check nargs */
296
    /* check nargs */
291
    if (nargs > 2) {
297
    if (nargs > 2) {
292
        Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");
298
        Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");
293
        return R_NilValue;
299
        return R_NilValue;
Line 316... Line 322...
316
         * at R */
322
         * at R */
317
        iname[namelen] = '.';
323
        iname[namelen] = '.';
318
        return mkString(iname);
324
        return mkString(iname);
319
    }
325
    }
320
 
326
 
-
 
327
    g_accumulator = 0.0;   /* initialize accumulator */
-
 
328
    g_start = 1;           /* flag that we are at start of accumulating */
321
    sqlite3_step(stmt);
329
    sqlite3_step(stmt);
322
    sqlite3_finalize(stmt);
330
    sqlite3_finalize(stmt);
323
 
331
 
324
    /* create sqlite.vector sexp */
332
    /* create sqlite.vector sexp */
325
    SEXP ret, value; int nprotected = 0;
333
    SEXP ret, value; int nprotected = 0;
Line 345... Line 353...
345
 
353
 
346
    return ret;
354
    return ret;
347
 
355
 
348
}
356
}
349
 
357
 
-
 
358
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
-
 
359
    char *iname_src, *varname_src, *funcname;
-
 
360
    int res;
-
 
361
    sqlite3_stmt *stmt;
-
 
362
    double _ret = NA_REAL; SEXP ret;
-
 
363
 
-
 
364
    /* get data from arguments (function name and sqlite.vector stuffs) */
-
 
365
    funcname = CHAR_ELT(func, 0);
-
 
366
    iname_src = SDF_INAME(vector);
-
 
367
    varname_src = SVEC_VARNAME(vector);
-
 
368
 
-
 
369
    if (!USE_SDF(iname_src, TRUE)) return R_NilValue;
-
 
370
 
-
 
371
    g_narm = LOGICAL(na_rm)[0];
-
 
372
    if (strcmp(funcname, "range") == 0) {
-
 
373
        /* special handling for range. use min then max */
-
 
374
        g_start = 1;
-
 
375
        g_accumulator = 0.0;
-
 
376
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
-
 
377
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
-
 
378
        if (_sqlite_error(res)) return R_NilValue;
-
 
379
        sqlite3_step(stmt); sqlite3_finalize(stmt);
-
 
380
        _ret = g_accumulator;
-
 
381
 
-
 
382
        if (R_IsNA(_ret) && !g_narm) {
-
 
383
            PROTECT(ret = NEW_NUMERIC(2));
-
 
384
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
-
 
385
            goto __sdf_do_variable_summary_out;
-
 
386
        }
-
 
387
        
-
 
388
        g_start = 1;
-
 
389
        g_accumulator = 0.0;
-
 
390
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
-
 
391
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
-
 
392
        if (_sqlite_error(res)) return R_NilValue;
-
 
393
        sqlite3_step(stmt); sqlite3_finalize(stmt);
-
 
394
 
-
 
395
        /* if there is NA, then the if above should have caught it already */
-
 
396
        PROTECT(ret = NEW_NUMERIC(2));
-
 
397
        REAL(ret)[0] = _ret;
-
 
398
        REAL(ret)[1] = g_accumulator;
-
 
399
    } else {
-
 
400
        g_start = 1;  /* we'll use these instead of sqlite3_aggregate_context */
-
 
401
        g_accumulator = 0.0;
-
 
402
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
-
 
403
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
-
 
404
        if (_sqlite_error(res)) return R_NilValue;
-
 
405
        res = sqlite3_step(stmt); sqlite3_finalize(stmt);
-
 
406
 
-
 
407
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
-
 
408
            PROTECT(ret = NEW_LOGICAL(1));
-
 
409
            if (R_IsNA(g_accumulator)) LOGICAL(ret)[0] = NA_INTEGER;
-
 
410
            else LOGICAL(ret)[0] = !(g_accumulator == 0);
-
 
411
        } else {
-
 
412
            PROTECT(ret = NEW_NUMERIC(1));
-
 
413
            REAL(ret)[0] = g_accumulator;
-
 
414
        }
-
 
415
    }
-
 
416
 
-
 
417
__sdf_do_variable_summary_out:
-
 
418
    UNPROTECT(1);
-
 
419
    return ret;
-
 
420
}
350
 
421
 
351
 
422
 
352
/****************************************************************************
423
/****************************************************************************
353
 * VECTOR MATH/OPS/GROUP OPERATIONS
424
 * VECTOR MATH/OPS/GROUP OPERATIONS
354
 ****************************************************************************/
425
 ****************************************************************************/
-
 
426
 
355
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
427
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
356
    int ret = 1;
428
    int ret = 1;
357
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
429
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
358
        sqlite3_result_null(ctx); 
430
        sqlite3_result_null(ctx); 
359
        ret = 0;
431
        ret = 0;
Line 371... Line 443...
371
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
443
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
372
        sqlite3_result_double(ctx, func(value)); \
444
        sqlite3_result_double(ctx, func(value)); \
373
    }  \
445
    }  \
374
}
446
}
375
 
447
 
-
 
448
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
-
 
449
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
-
 
450
    double value; \
-
 
451
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
-
 
452
        if (g_start) { g_start = 0; g_accumulator = value; } \
-
 
453
        else g_accumulator = func(g_accumulator, value); \
-
 
454
        sqlite3_result_double(ctx, g_accumulator); \
-
 
455
    }  \
-
 
456
}
-
 
457
 
376
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
458
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
377
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
459
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
378
SQLITE_MATH_FUNC1(sqrt, sqrt)
460
SQLITE_MATH_FUNC1(sqrt, sqrt)
379
SQLITE_MATH_FUNC1(floor, floor)
461
SQLITE_MATH_FUNC1(floor, floor)
380
SQLITE_MATH_FUNC1(ceiling, ceil)
462
SQLITE_MATH_FUNC1(ceiling, ceil)
Line 399... Line 481...
399
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
481
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
400
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
482
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
401
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
483
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
402
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
484
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
403
 
485
 
-
 
486
#define SUM(a, b)  (a) + (b)
-
 
487
#define PROD(a, b) (a) * (b)
-
 
488
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
-
 
489
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
-
 
490
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
-
 
491
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
-
 
492
 
-
 
493
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
-
 
494
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
-
 
495
SQLITE_MATH_FUNC_CUM(cummin, MIN)
-
 
496
SQLITE_MATH_FUNC_CUM(cummax, MAX)
-
 
497
 
-
 
498
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
-
 
499
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
-
 
500
    double value; \
-
 
501
    if (!g_narm && R_IsNA(g_accumulator)) return; /* NA if na.rm=F & NA found */ \
-
 
502
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
-
 
503
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
-
 
504
            int tmp = sqlite3_value_int(argv[0]); \
-
 
505
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
-
 
506
        } else value = sqlite3_value_double(argv[0]);  \
-
 
507
        if (R_IsNA(value)) { \
-
 
508
            if (!g_narm) g_accumulator = value; return; \
-
 
509
        } else if (g_start) { g_start = 0; g_accumulator = value; } \
-
 
510
        else g_accumulator = func(g_accumulator, value); \
-
 
511
    } \
-
 
512
}
-
 
513
 
-
 
514
SQLITE_SUMMARY_FUNC(all_df, ALL)
-
 
515
SQLITE_SUMMARY_FUNC(any_df, ANY)
-
 
516
SQLITE_SUMMARY_FUNC(sum_df, SUM)
-
 
517
SQLITE_SUMMARY_FUNC(prod_df, PROD)
-
 
518
SQLITE_SUMMARY_FUNC(min_df, MIN)
-
 
519
SQLITE_SUMMARY_FUNC(max_df, MAX)
-
 
520
 
-
 
521
static void __vecsummary_finalize(sqlite3_context *ctx) {
-
 
522
    /* g_accumulator already summarizes it. just return that */
-
 
523
    sqlite3_result_double(ctx, g_accumulator);
-
 
524
}
-
 
525
 
404
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
526
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
-
 
527
#define VSENTRY1(func)  {#func, __vecsummary_ ## func}
405
void __register_vector_math() {
528
void __register_vector_math() {
406
    int i, res;
529
    int i, res;
407
    static const struct {
530
    static const struct {
408
        char *name;
531
        char *name;
409
        void (*func)(sqlite3_context*, int, sqlite3_value**);
532
        void (*func)(sqlite3_context*, int, sqlite3_value**);
Line 427... Line 550...
427
        VMENTRY1(asinh),
550
        VMENTRY1(asinh),
428
        VMENTRY1(atanh),
551
        VMENTRY1(atanh),
429
        VMENTRY1(lgamma),
552
        VMENTRY1(lgamma),
430
        VMENTRY1(gamma),
553
        VMENTRY1(gamma),
431
        VMENTRY1(digamma),
554
        VMENTRY1(digamma),
432
        VMENTRY1(trigamma)
555
        VMENTRY1(trigamma),
-
 
556
        VMENTRY1(cumsum),
-
 
557
        VMENTRY1(cumprod),
-
 
558
        VMENTRY1(cummin),
-
 
559
        VMENTRY1(cummax)
-
 
560
    }, arr_sum1[] = {
-
 
561
        VSENTRY1(all_df),  /* can't override sum, min, max */
-
 
562
        VSENTRY1(any_df),
-
 
563
        VSENTRY1(sum_df),
-
 
564
        VSENTRY1(prod_df),
-
 
565
        VSENTRY1(min_df),
-
 
566
        VSENTRY1(max_df)
433
    };
567
    };
434
 
568
 
435
    int func1_len = sizeof(arr_func1) / sizeof(arr_func1[0]);
569
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
436
 
570
 
437
    for (i = 0; i < func1_len; i++) {
571
    for (i = 0; i < len; i++) {
438
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
572
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
439
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
573
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
440
        _sqlite_error(res);
574
        _sqlite_error(res);
441
    }
575
    }
-
 
576
 
-
 
577
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
-
 
578
    for (i = 0; i < len; i++) {
-
 
579
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
-
 
580
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
-
 
581
        _sqlite_error(res);
-
 
582
    }
442
}
583
}