The R Project SVN – R-packages – Diff – /trunk/SQLiteDF/src/sqlite_vector.c


#include "sqlite_dataframe.h"
#include <math.h>
#include "Rmath.h"
 
SEXP sdf_get_variable(SEXP sdf, SEXP name) {
    if (!IS_CHARACTER(name)) {
        Rprintf("ERROR: argument is not a string.\n");
        return R_NilValue;
    }
 
    char *iname = SDF_INAME(sdf);
    char *varname = CHAR_ELT(name, 0);
 
    if (!USE_SDF(iname)) return R_NilValue;
 
    /* check if sdf & varname w/in that sdf exists */
    sqlite3_stmt *stmt;
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
 
    int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 
    if (_sqlite_error(res)) return R_NilValue;
 
    const char *coltype = sqlite3_column_decltype(stmt, 0);
    sqlite3_finalize(stmt);
 
 
    SEXP ret, value, class = R_NilValue; int nprotected = 0;
    PROTECT(ret = NEW_LIST(2)); nprotected++;
 
    /* set list names */
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
    SET_STRING_ELT(value, 0, mkChar("iname"));
    SET_STRING_ELT(value, 1, mkChar("varname"));
    SET_NAMES(ret, value);
 
    /* set list values */
    SET_VECTOR_ELT(ret, 0, mkString(iname));
    SET_VECTOR_ELT(ret, 1, mkString(varname));
 
    /* set class */
    int type = -1;
    if (strcmp(coltype, "text") == 0) class = mkChar("character");
    else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");
    else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");
    else if (strcmp(coltype, "integer") == 0 || strcmp(coltype, "int") == 0) {
        /* determine if int, factor or ordered */
        type = _get_factor_levels1(iname, varname, ret);
        switch(type) {
            case VAR_INTEGER: class = mkChar("integer"); break;
            case VAR_FACTOR: class = mkChar("factor"); break;
            case VAR_ORDERED: class = mkChar("ordered");
        }
 
    }
 
    if (type != VAR_ORDERED) {
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
        SET_STRING_ELT(value, 1, class);
    } else {
        PROTECT(value = NEW_CHARACTER(3)); nprotected++;
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
        SET_STRING_ELT(value, 1, class);
        SET_STRING_ELT(value, 2, mkChar("factor"));
    }
    SET_CLASS(ret, value);
 
    UNPROTECT(nprotected);
    return ret;
 
}
 
int _get_vector_index_typed_result(sqlite3_stmt *stmt, SEXP *ret, int idx_or_len) {
    int added = 1;
    if (*ret == NULL || *ret == R_NilValue) {
        const char *coltype = sqlite3_column_decltype(stmt, 0);
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
            added = 0;
        }
        
        if (strcmp(coltype, "text") == 0) {
            PROTECT(*ret = NEW_CHARACTER(idx_or_len));
            if (added) 
                SET_STRING_ELT(*ret, 0, mkChar((char *)sqlite3_column_text(stmt, 0)));
        } else if (strcmp(coltype, "double") == 0) {
            PROTECT(*ret = NEW_NUMERIC(idx_or_len));
            if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);
        } else if (strcmp(coltype, "bit") == 0) {
            PROTECT(*ret = NEW_LOGICAL(idx_or_len));
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
        } else if (strcmp(coltype, "integer") == 0 || 
                   strcmp(coltype, "int") == 0) {
            /* caller should just copy off the vars level attr for factors */
            PROTECT(*ret = NEW_INTEGER(idx_or_len));
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
        } else added = 0;
 
        UNPROTECT(1);
    } else {
        const char *coltype = sqlite3_column_decltype(stmt, 0);
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
            added = 0;
        } else if (strcmp(coltype, "text") == 0) {
            SET_STRING_ELT(*ret, idx_or_len, 
                    mkChar((char *)sqlite3_column_text(stmt, 0)));
        } else if (strcmp(coltype, "double") == 0) {
            REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);
        } else if (strcmp(coltype, "bit") == 0) {
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
        } else if (strcmp(coltype, "integer") == 0 ||
                   strcmp(coltype, "int") == 0) {
            /* caller should just copy off the vars level attr for factors */
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
        } else added = 0;
    }
        
    return added;
}
 
SEXP sdf_get_variable_length(SEXP svec) {
    char *iname = SDF_INAME(svec);
    if (!USE_SDF(iname)) return R_NilValue;
    sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
 
    SEXP ret;
    PROTECT(ret = NEW_INTEGER(1));
    INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);
    UNPROTECT(1);
    return ret;
}
 
    
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
    SEXP ret = R_NilValue, tmp;
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
    int index, idxlen, i, retlen=0, res;
 
    if (!USE_SDF(iname)) return R_NilValue;
 
    /* check if sdf exists */
    sqlite3_stmt *stmt;
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
    sqlite3_finalize(stmt);
    if (_sqlite_error(res)) { return ret; }
 
    idxlen = LENGTH(idx);
    if (idxlen < 1) return ret;
 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",
            varname, iname);
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 
    /* get data based on index */
    if (IS_NUMERIC(idx)) {
        index = ((int) REAL(idx)[0]) - 1;
        if (index < 0 && idxlen == 1) return ret;
 
        if (index >= 0) {
            sqlite3_bind_int(stmt, 1, index);
            res = sqlite3_step(stmt);
            if (res == SQLITE_ROW) { 
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
            } 
        } 
        
        if (index < 0 || res != SQLITE_ROW) {
            /* something wrong w/ 1st idx, and it is quietly ignored. we make 
             * a "dummy" call to setup the SEXP */
            sqlite3_bind_int(stmt, 1, 0);
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
            retlen = 0;
        }
 
        if (idxlen > 1) {
            for (i = 1; i < idxlen; i++) {
                index = ((int) REAL(idx)[i]) - 1;
                if (index < 0) continue;
                sqlite3_reset(stmt);
                sqlite3_bind_int(stmt, 1, index);
                res = sqlite3_step(stmt);
                if (res == SQLITE_ROW)
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
            }
        }
    } else if (IS_INTEGER(idx)) {
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
         * to cast idx to int. can't refactor this out, sucks. */
        index = INTEGER(idx)[0] - 1;
        if (index < 0 && idxlen == 1) return ret;
 
        if (index >= 0) {
            sqlite3_bind_int(stmt, 1, index);
            res = sqlite3_step(stmt);
            if (res == SQLITE_ROW) { 
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
            } 
        } 
        
        if (index < 0 || res != SQLITE_ROW) {
            /* something wrong w/ 1st idx, and it is quietly ignored. we make 
             * a "dummy" call to setup the SEXP */
            sqlite3_bind_int(stmt, 1, 0);
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
            retlen = 0;
        }
 
        if (idxlen > 1) {
            for (i = 1; i < idxlen; i++) {
                index = INTEGER(idx)[i] - 1;
                if (index < 0) continue;
                sqlite3_reset(stmt);
                sqlite3_bind_int(stmt, 1, index);
                sqlite3_step(stmt);
                retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
            }
        }
 
    } else if (IS_LOGICAL(idx)) {
        /* have to deal with recycling */
        sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
        int veclen = _get_row_count2(g_sql_buf[0]);
 
        /* find if there is any TRUE element in the vector */
        for (i = 0; i < idxlen && i < veclen; i++) {
            if (LOGICAL(idx)[i]) {
                sqlite3_bind_int(stmt, 1, i);
                sqlite3_step(stmt);
                /* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
                 * index. there are at least (veclen/idxlen) cycles (int div).
                 * at the last cycle, if (veclen%idxlen > 0), there will be
                 * at least (veclen%idxlen - i) if veclen%idxlen > i */
                retlen = (idxlen-i) * (veclen/idxlen);
                if (veclen%idxlen > i) retlen += (veclen%idxlen - i);
 
                /* create the vector */
                retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
                break;
            }
        }
 
        if (i < idxlen && i < veclen) {
            for (i++; i < veclen; i++) {
                if (LOGICAL(idx)[i%idxlen]) {
                    sqlite3_reset(stmt);
                    sqlite3_bind_int(stmt, 1, i);
                    sqlite3_step(stmt);
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
                }
            }
        }
    }
 
    sqlite3_finalize(stmt);
 
    if (ret != R_NilValue) {
        ret = _shrink_vector(ret, retlen);
        tmp = GET_LEVELS(svec);
        if (tmp != R_NilValue) {
            SET_LEVELS(ret, duplicate(tmp));
            if (LENGTH(GET_CLASS(svec)) == 2) {
                SET_CLASS(ret, mkString("factor"));
            } else {
                PROTECT(tmp = NEW_CHARACTER(2));
                SET_STRING_ELT(tmp, 0, mkChar("ordered"));
                SET_STRING_ELT(tmp, 1, mkChar("factor"));
                UNPROTECT(1);
            }
        }
    }
 
    return ret;
}
 
 
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {
    char *iname, *iname_src, *varname_src, *funcname;
    int namelen, res, nargs;
    sqlite3_stmt *stmt;
 
    /* get data from arguments (function name and sqlite.vector stuffs) */
    funcname = CHAR_ELT(func, 0);
    iname_src = SDF_INAME(vector);
    varname_src = SVEC_VARNAME(vector);
    nargs = INTEGER(_nargs)[0];
 
    if (!USE_SDF(iname_src)) return R_NilValue;
 
    /* check nargs */
    if (nargs > 2) {
        Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");
        return R_NilValue;
    }
 
    /* create a new sdf, with 1 column named V1 */
    iname = _create_sdf_skeleton2(R_NilValue, &namelen);
    if (iname == NULL) return R_NilValue;
 
    sprintf(g_sql_buf[0], "create table [%s].sdf_data ([row name] text, "
            "V1 double)", iname);
    res = _sqlite_exec(g_sql_buf[0]);
    _sqlite_error(res);
 
    /* insert into <newsdf>.col, row.names select func(col), rownames */
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
            "select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,
            varname_src, iname_src);
 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
    if (_sqlite_error(res)) {
        sprintf(g_sql_buf[0], "detach %s", iname);
        _sqlite_exec(g_sql_buf[0]);
 
        /* we will return a string with the file name, and do file.remove
         * at R */
        iname[namelen] = '.';
        return mkString(iname);
    }
 
    sqlite3_step(stmt);
    sqlite3_finalize(stmt);
 
 
 
 
 
 
 
    /* create sqlite.vector sexp */
    SEXP ret, value; int nprotected = 0;
    PROTECT(ret = NEW_LIST(2)); nprotected++;
 
    /* set list names */
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
    SET_STRING_ELT(value, 0, mkChar("iname"));
    SET_STRING_ELT(value, 1, mkChar("varname"));
    SET_NAMES(ret, value);
 
    /* set list values */
    SET_VECTOR_ELT(ret, 0, mkString(iname));
    SET_VECTOR_ELT(ret, 1, mkString("V1"));
 
    /* set sexp class */
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
    SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
    SET_VECTOR_ELT(value, 1, mkChar("numeric"));
    SET_CLASS(ret, value);
 
    UNPROTECT(nprotected);
 
    return ret;
 
}
 
 
 
/****************************************************************************
 * VECTOR MATH/OPS/GROUP OPERATIONS
 ****************************************************************************/
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
    int ret = 1;
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
        sqlite3_result_null(ctx); 
        ret = 0;
    } else {
        if (sqlite3_value_type(arg) == SQLITE_INTEGER) 
            *value = sqlite3_value_int(arg); 
        else *value = sqlite3_value_double(arg); 
    }
    return ret;
}
 
#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
    double value; \
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
        sqlite3_result_double(ctx, func(value)); \
    }  \
}
 
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
SQLITE_MATH_FUNC1(sqrt, sqrt)
SQLITE_MATH_FUNC1(floor, floor)
SQLITE_MATH_FUNC1(ceiling, ceil)
SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */
/* SQLITE_MATH_FUNC1(round, )   in SQLite */
/* SQLITE_MATH_FUNC1(signif, ) 2 arg */
SQLITE_MATH_FUNC1(exp, exp)
/* SQLITE_MATH_FUNC1(log, ) 2 arg */
SQLITE_MATH_FUNC1(cos, cos)
SQLITE_MATH_FUNC1(sin, sin)
SQLITE_MATH_FUNC1(tan, tan)
SQLITE_MATH_FUNC1(acos, acos)
SQLITE_MATH_FUNC1(asin, asin)
SQLITE_MATH_FUNC1(atan, atan)
SQLITE_MATH_FUNC1(cosh, cosh)
SQLITE_MATH_FUNC1(sinh, sinh)
SQLITE_MATH_FUNC1(tanh, tanh)
SQLITE_MATH_FUNC1(acosh, acosh)  /* nowhere in include?? */
SQLITE_MATH_FUNC1(asinh, asinh)  /* nowhere in include?? */
SQLITE_MATH_FUNC1(atanh, atanh)  /* nowhere in include?? */
SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
 
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
void __register_vector_math() {
    int i, res;
    static const struct {
        char *name;
        void (*func)(sqlite3_context*, int, sqlite3_value**);
    } arr_func1[] = {
        VMENTRY1(sign),
        VMENTRY1(sqrt),
        VMENTRY1(floor),
        VMENTRY1(ceiling),
        VMENTRY1(trunc),
        VMENTRY1(exp),
        VMENTRY1(cos),
        VMENTRY1(sin),
        VMENTRY1(tan),
        VMENTRY1(acos),
        VMENTRY1(asin),
        VMENTRY1(atan),
        VMENTRY1(cosh),
        VMENTRY1(sinh),
        VMENTRY1(tanh),
        VMENTRY1(acosh),
        VMENTRY1(asinh),
        VMENTRY1(atanh),
        VMENTRY1(lgamma),
        VMENTRY1(gamma),
        VMENTRY1(digamma),
        VMENTRY1(trigamma)
    };
 
    int func1_len = sizeof(arr_func1) / sizeof(arr_func1[0]);
 
    for (i = 0; i < func1_len; i++) {
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
        _sqlite_error(res);
    }
}

Rev 3307	Rev 3308
1	`#include "sqlite_dataframe.h"`	1	`#include "sqlite_dataframe.h"`
2	`#include <math.h>`	2	`#include <math.h>`
3	`#include "Rmath.h"`	3	`#include "Rmath.h"`
4		4
5	`SEXP sdf_get_variable(SEXP sdf, SEXP name) {`	5	`SEXP sdf_get_variable(SEXP sdf, SEXP name) {`
6	`if (!IS_CHARACTER(name)) {`	6	`if (!IS_CHARACTER(name)) {`
7	`Rprintf("ERROR: argument is not a string.\n");`	7	`Rprintf("ERROR: argument is not a string.\n");`
8	`return R_NilValue;`	8	`return R_NilValue;`
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;`
-		15
14	`/* check if sdf & varname w/in that sdf exists */`	16	`/* check if sdf & varname w/in that sdf exists */`
15	`sqlite3_stmt *stmt;`	17	`sqlite3_stmt *stmt;`
16	`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);`
17		19
18	`int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`	20	`int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
19		21
20	`if (_sqlite_error(res)) return R_NilValue;`	22	`if (_sqlite_error(res)) return R_NilValue;`
21		23
22	`const char *coltype = sqlite3_column_decltype(stmt, 0);`	24	`const char *coltype = sqlite3_column_decltype(stmt, 0);`
23	`sqlite3_finalize(stmt);`	25	`sqlite3_finalize(stmt);`
24		26
25		27
26	`SEXP ret, value, class = R_NilValue; int nprotected = 0;`	28	`SEXP ret, value, class = R_NilValue; int nprotected = 0;`
27	`PROTECT(ret = NEW_LIST(2)); nprotected++;`	29	`PROTECT(ret = NEW_LIST(2)); nprotected++;`
28		30
29	`/* set list names */`	31	`/* set list names */`
30	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	32	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
31	`SET_STRING_ELT(value, 0, mkChar("iname"));`	33	`SET_STRING_ELT(value, 0, mkChar("iname"));`
32	`SET_STRING_ELT(value, 1, mkChar("varname"));`	34	`SET_STRING_ELT(value, 1, mkChar("varname"));`
33	`SET_NAMES(ret, value);`	35	`SET_NAMES(ret, value);`
34		36
35	`/* set list values */`	37	`/* set list values */`
36	`SET_VECTOR_ELT(ret, 0, mkString(iname));`	38	`SET_VECTOR_ELT(ret, 0, mkString(iname));`
37	`SET_VECTOR_ELT(ret, 1, mkString(varname));`	39	`SET_VECTOR_ELT(ret, 1, mkString(varname));`
38		40
39	`/* set class */`	41	`/* set class */`
40	`int type = -1;`	42	`int type = -1;`
41	`if (strcmp(coltype, "text") == 0) class = mkChar("character");`	43	`if (strcmp(coltype, "text") == 0) class = mkChar("character");`
42	`else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");`	44	`else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");`
43	`else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");`	45	`else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");`
44	`else if (strcmp(coltype, "integer") == 0 \|\| strcmp(coltype, "int") == 0) {`	46	`else if (strcmp(coltype, "integer") == 0 \|\| strcmp(coltype, "int") == 0) {`
45	`/* determine if int, factor or ordered */`	47	`/* determine if int, factor or ordered */`
46	`type = _get_factor_levels1(iname, varname, ret);`	48	`type = _get_factor_levels1(iname, varname, ret);`
47	`switch(type) {`	49	`switch(type) {`
48	`case VAR_INTEGER: class = mkChar("integer"); break;`	50	`case VAR_INTEGER: class = mkChar("integer"); break;`
49	`case VAR_FACTOR: class = mkChar("factor"); break;`	51	`case VAR_FACTOR: class = mkChar("factor"); break;`
50	`case VAR_ORDERED: class = mkChar("ordered");`	52	`case VAR_ORDERED: class = mkChar("ordered");`
51	`}`	53	`}`
52		54
53	`}`	55	`}`
54		56
55	`if (type != VAR_ORDERED) {`	57	`if (type != VAR_ORDERED) {`
56	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	58	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
57	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`	59	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`
58	`SET_STRING_ELT(value, 1, class);`	60	`SET_STRING_ELT(value, 1, class);`
59	`} else {`	61	`} else {`
60	`PROTECT(value = NEW_CHARACTER(3)); nprotected++;`	62	`PROTECT(value = NEW_CHARACTER(3)); nprotected++;`
61	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`	63	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`
62	`SET_STRING_ELT(value, 1, class);`	64	`SET_STRING_ELT(value, 1, class);`
63	`SET_STRING_ELT(value, 2, mkChar("factor"));`	65	`SET_STRING_ELT(value, 2, mkChar("factor"));`
64	`}`	66	`}`
65	`SET_CLASS(ret, value);`	67	`SET_CLASS(ret, value);`
66		68
67	`UNPROTECT(nprotected);`	69	`UNPROTECT(nprotected);`
68	`return ret;`	70	`return ret;`
69		71
70	`}`	72	`}`
71		73
72	`int _get_vector_index_typed_result(sqlite3_stmt stmt, SEXP ret, int idx_or_len) {`	74	`int _get_vector_index_typed_result(sqlite3_stmt stmt, SEXP ret, int idx_or_len) {`
73	`int added = 1;`	75	`int added = 1;`
74	`if (ret == NULL \|\| ret == R_NilValue) {`	76	`if (ret == NULL \|\| ret == R_NilValue) {`
75	`const char *coltype = sqlite3_column_decltype(stmt, 0);`	77	`const char *coltype = sqlite3_column_decltype(stmt, 0);`
76	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`	78	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`
77	`added = 0;`	79	`added = 0;`
78	`}`	80	`}`
79		81
80	`if (strcmp(coltype, "text") == 0) {`	82	`if (strcmp(coltype, "text") == 0) {`
81	`PROTECT(*ret = NEW_CHARACTER(idx_or_len));`	83	`PROTECT(*ret = NEW_CHARACTER(idx_or_len));`
82	`if (added)`	84	`if (added)`
83	`SET_STRING_ELT(ret, 0, mkChar((char )sqlite3_column_text(stmt, 0)));`	85	`SET_STRING_ELT(ret, 0, mkChar((char )sqlite3_column_text(stmt, 0)));`
84	`} else if (strcmp(coltype, "double") == 0) {`	86	`} else if (strcmp(coltype, "double") == 0) {`
85	`PROTECT(*ret = NEW_NUMERIC(idx_or_len));`	87	`PROTECT(*ret = NEW_NUMERIC(idx_or_len));`
86	`if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);`	88	`if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);`
87	`} else if (strcmp(coltype, "bit") == 0) {`	89	`} else if (strcmp(coltype, "bit") == 0) {`
88	`PROTECT(*ret = NEW_LOGICAL(idx_or_len));`	90	`PROTECT(*ret = NEW_LOGICAL(idx_or_len));`
89	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`	91	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`
90	`} else if (strcmp(coltype, "integer") == 0 \|\|`	92	`} else if (strcmp(coltype, "integer") == 0 \|\|`
91	`strcmp(coltype, "int") == 0) {`	93	`strcmp(coltype, "int") == 0) {`
92	`/* caller should just copy off the vars level attr for factors */`	94	`/* caller should just copy off the vars level attr for factors */`
93	`PROTECT(*ret = NEW_INTEGER(idx_or_len));`	95	`PROTECT(*ret = NEW_INTEGER(idx_or_len));`
94	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`	96	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`
95	`} else added = 0;`	97	`} else added = 0;`
96		98
97	`UNPROTECT(1);`	99	`UNPROTECT(1);`
98	`} else {`	100	`} else {`
99	`const char *coltype = sqlite3_column_decltype(stmt, 0);`	101	`const char *coltype = sqlite3_column_decltype(stmt, 0);`
100	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`	102	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`
101	`added = 0;`	103	`added = 0;`
102	`} else if (strcmp(coltype, "text") == 0) {`	104	`} else if (strcmp(coltype, "text") == 0) {`
103	`SET_STRING_ELT(*ret, idx_or_len,`	105	`SET_STRING_ELT(*ret, idx_or_len,`
104	`mkChar((char *)sqlite3_column_text(stmt, 0)));`	106	`mkChar((char *)sqlite3_column_text(stmt, 0)));`
105	`} else if (strcmp(coltype, "double") == 0) {`	107	`} else if (strcmp(coltype, "double") == 0) {`
106	`REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);`	108	`REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);`
107	`} else if (strcmp(coltype, "bit") == 0) {`	109	`} else if (strcmp(coltype, "bit") == 0) {`
108	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`	110	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`
109	`} else if (strcmp(coltype, "integer") == 0 \|\|`	111	`} else if (strcmp(coltype, "integer") == 0 \|\|`
110	`strcmp(coltype, "int") == 0) {`	112	`strcmp(coltype, "int") == 0) {`
111	`/* caller should just copy off the vars level attr for factors */`	113	`/* caller should just copy off the vars level attr for factors */`
112	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`	114	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`
113	`} else added = 0;`	115	`} else added = 0;`
114	`}`	116	`}`
115		117
116	`return added;`	118	`return added;`
117	`}`	119	`}`
118		120
119	`SEXP sdf_get_variable_length(SEXP svec) {`	121	`SEXP sdf_get_variable_length(SEXP svec) {`
120	`char *iname = SDF_INAME(svec);`	122	`char *iname = SDF_INAME(svec);`
-		123	`if (!USE_SDF(iname)) return R_NilValue;`
121	`sprintf(g_sql_buf[0], "[%s].sdf_data", iname);`	124	`sprintf(g_sql_buf[0], "[%s].sdf_data", iname);`
122		125
123	`SEXP ret;`	126	`SEXP ret;`
124	`PROTECT(ret = NEW_INTEGER(1));`	127	`PROTECT(ret = NEW_INTEGER(1));`
125	`INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);`	128	`INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);`
126	`UNPROTECT(1);`	129	`UNPROTECT(1);`
127	`return ret;`	130	`return ret;`
128	`}`	131	`}`
129		132
130		133
131	`SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {`	134	`SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {`
132	`SEXP ret = R_NilValue, tmp;`	135	`SEXP ret = R_NilValue, tmp;`
133	`char iname = SDF_INAME(svec), varname = SVEC_VARNAME(svec);`	136	`char iname = SDF_INAME(svec), varname = SVEC_VARNAME(svec);`
134	`int index, idxlen, i, retlen=0, res;`	137	`int index, idxlen, i, retlen=0, res;`
135		138
-		139	`if (!USE_SDF(iname)) return R_NilValue;`
-		140
136	`/* check if sdf exists */`	141	`/* check if sdf exists */`
137	`sqlite3_stmt *stmt;`	142	`sqlite3_stmt *stmt;`
138	`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);`
139	`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);`
140	`sqlite3_finalize(stmt);`	145	`sqlite3_finalize(stmt);`
141	`if (_sqlite_error(res)) { return ret; }`	146	`if (_sqlite_error(res)) { return ret; }`
142		147
143	`idxlen = LENGTH(idx);`	148	`idxlen = LENGTH(idx);`
144	`if (idxlen < 1) return ret;`	149	`if (idxlen < 1) return ret;`
145		150
146	`sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",`	151	`sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",`
147	`varname, iname);`	152	`varname, iname);`
148	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`	153	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
149		154
150	`/* get data based on index */`	155	`/* get data based on index */`
151	`if (IS_NUMERIC(idx)) {`	156	`if (IS_NUMERIC(idx)) {`
152	`index = ((int) REAL(idx)[0]) - 1;`	157	`index = ((int) REAL(idx)[0]) - 1;`
153	`if (index < 0 && idxlen == 1) return ret;`	158	`if (index < 0 && idxlen == 1) return ret;`
154		159
155	`if (index >= 0) {`	160	`if (index >= 0) {`
156	`sqlite3_bind_int(stmt, 1, index);`	161	`sqlite3_bind_int(stmt, 1, index);`
157	`res = sqlite3_step(stmt);`	162	`res = sqlite3_step(stmt);`
158	`if (res == SQLITE_ROW) {`	163	`if (res == SQLITE_ROW) {`
159	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`	164	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`
160	`}`	165	`}`
161	`}`	166	`}`
162		167
163	`if (index < 0 \|\| res != SQLITE_ROW) {`	168	`if (index < 0 \|\| res != SQLITE_ROW) {`
164	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`	169	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`
165	`* a "dummy" call to setup the SEXP */`	170	`* a "dummy" call to setup the SEXP */`
166	`sqlite3_bind_int(stmt, 1, 0);`	171	`sqlite3_bind_int(stmt, 1, 0);`
167	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`	172	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`
168	`retlen = 0;`	173	`retlen = 0;`
169	`}`	174	`}`
170		175
171	`if (idxlen > 1) {`	176	`if (idxlen > 1) {`
172	`for (i = 1; i < idxlen; i++) {`	177	`for (i = 1; i < idxlen; i++) {`
173	`index = ((int) REAL(idx)[i]) - 1;`	178	`index = ((int) REAL(idx)[i]) - 1;`
174	`if (index < 0) continue;`	179	`if (index < 0) continue;`
175	`sqlite3_reset(stmt);`	180	`sqlite3_reset(stmt);`
176	`sqlite3_bind_int(stmt, 1, index);`	181	`sqlite3_bind_int(stmt, 1, index);`
177	`res = sqlite3_step(stmt);`	182	`res = sqlite3_step(stmt);`
178	`if (res == SQLITE_ROW)`	183	`if (res == SQLITE_ROW)`
179	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`	184	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`
180	`}`	185	`}`
181	`}`	186	`}`
182	`} else if (IS_INTEGER(idx)) {`	187	`} else if (IS_INTEGER(idx)) {`
183	`/* similar to REAL (IS_NUMERIC) above, except that we don't have`	188	`/* similar to REAL (IS_NUMERIC) above, except that we don't have`
184	`* to cast idx to int. can't refactor this out, sucks. */`	189	`* to cast idx to int. can't refactor this out, sucks. */`
185	`index = INTEGER(idx)[0] - 1;`	190	`index = INTEGER(idx)[0] - 1;`
186	`if (index < 0 && idxlen == 1) return ret;`	191	`if (index < 0 && idxlen == 1) return ret;`
187		192
188	`if (index >= 0) {`	193	`if (index >= 0) {`
189	`sqlite3_bind_int(stmt, 1, index);`	194	`sqlite3_bind_int(stmt, 1, index);`
190	`res = sqlite3_step(stmt);`	195	`res = sqlite3_step(stmt);`
191	`if (res == SQLITE_ROW) {`	196	`if (res == SQLITE_ROW) {`
192	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`	197	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`
193	`}`	198	`}`
194	`}`	199	`}`
195		200
196	`if (index < 0 \|\| res != SQLITE_ROW) {`	201	`if (index < 0 \|\| res != SQLITE_ROW) {`
197	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`	202	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`
198	`* a "dummy" call to setup the SEXP */`	203	`* a "dummy" call to setup the SEXP */`
199	`sqlite3_bind_int(stmt, 1, 0);`	204	`sqlite3_bind_int(stmt, 1, 0);`
200	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`	205	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`
201	`retlen = 0;`	206	`retlen = 0;`
202	`}`	207	`}`
203		208
204	`if (idxlen > 1) {`	209	`if (idxlen > 1) {`
205	`for (i = 1; i < idxlen; i++) {`	210	`for (i = 1; i < idxlen; i++) {`
206	`index = INTEGER(idx)[i] - 1;`	211	`index = INTEGER(idx)[i] - 1;`
207	`if (index < 0) continue;`	212	`if (index < 0) continue;`
208	`sqlite3_reset(stmt);`	213	`sqlite3_reset(stmt);`
209	`sqlite3_bind_int(stmt, 1, index);`	214	`sqlite3_bind_int(stmt, 1, index);`
210	`sqlite3_step(stmt);`	215	`sqlite3_step(stmt);`
211	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`	216	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`
212	`}`	217	`}`
213	`}`	218	`}`
214		219
215	`} else if (IS_LOGICAL(idx)) {`	220	`} else if (IS_LOGICAL(idx)) {`
216	`/* have to deal with recycling */`	221	`/* have to deal with recycling */`
217	`sprintf(g_sql_buf[0], "[%s].sdf_data", iname);`	222	`sprintf(g_sql_buf[0], "[%s].sdf_data", iname);`
218	`int veclen = _get_row_count2(g_sql_buf[0]);`	223	`int veclen = _get_row_count2(g_sql_buf[0]);`
219		224
220	`/* find if there is any TRUE element in the vector */`	225	`/* find if there is any TRUE element in the vector */`
221	`for (i = 0; i < idxlen && i < veclen; i++) {`	226	`for (i = 0; i < idxlen && i < veclen; i++) {`
222	`if (LOGICAL(idx)[i]) {`	227	`if (LOGICAL(idx)[i]) {`
223	`sqlite3_bind_int(stmt, 1, i);`	228	`sqlite3_bind_int(stmt, 1, i);`
224	`sqlite3_step(stmt);`	229	`sqlite3_step(stmt);`
225	`/* there are at least (idxlen-i) TRUE per cycle of the LOGICAL`	230	`/* there are at least (idxlen-i) TRUE per cycle of the LOGICAL`
226	`* index. there are at least (veclen/idxlen) cycles (int div).`	231	`* index. there are at least (veclen/idxlen) cycles (int div).`
227	`* at the last cycle, if (veclen%idxlen > 0), there will be`	232	`* at the last cycle, if (veclen%idxlen > 0), there will be`
228	`* at least (veclen%idxlen - i) if veclen%idxlen > i */`	233	`* at least (veclen%idxlen - i) if veclen%idxlen > i */`
229	`retlen = (idxlen-i) * (veclen/idxlen);`	234	`retlen = (idxlen-i) * (veclen/idxlen);`
230	`if (veclen%idxlen > i) retlen += (veclen%idxlen - i);`	235	`if (veclen%idxlen > i) retlen += (veclen%idxlen - i);`
231		236
232	`/* create the vector */`	237	`/* create the vector */`
233	`retlen = _get_vector_index_typed_result(stmt, &ret, retlen);`	238	`retlen = _get_vector_index_typed_result(stmt, &ret, retlen);`
234	`break;`	239	`break;`
235	`}`	240	`}`
236	`}`	241	`}`
237		242
238	`if (i < idxlen && i < veclen) {`	243	`if (i < idxlen && i < veclen) {`
239	`for (i++; i < veclen; i++) {`	244	`for (i++; i < veclen; i++) {`
240	`if (LOGICAL(idx)[i%idxlen]) {`	245	`if (LOGICAL(idx)[i%idxlen]) {`
241	`sqlite3_reset(stmt);`	246	`sqlite3_reset(stmt);`
242	`sqlite3_bind_int(stmt, 1, i);`	247	`sqlite3_bind_int(stmt, 1, i);`
243	`sqlite3_step(stmt);`	248	`sqlite3_step(stmt);`
244	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`	249	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`
245	`}`	250	`}`
246	`}`	251	`}`
247	`}`	252	`}`
248	`}`	253	`}`
249		254
250	`sqlite3_finalize(stmt);`	255	`sqlite3_finalize(stmt);`
251		256
252	`if (ret != R_NilValue) {`	257	`if (ret != R_NilValue) {`
253	`ret = _shrink_vector(ret, retlen);`	258	`ret = _shrink_vector(ret, retlen);`
254	`tmp = GET_LEVELS(svec);`	259	`tmp = GET_LEVELS(svec);`
255	`if (tmp != R_NilValue) {`	260	`if (tmp != R_NilValue) {`
256	`SET_LEVELS(ret, duplicate(tmp));`	261	`SET_LEVELS(ret, duplicate(tmp));`
257	`if (LENGTH(GET_CLASS(svec)) == 2) {`	262	`if (LENGTH(GET_CLASS(svec)) == 2) {`
258	`SET_CLASS(ret, mkString("factor"));`	263	`SET_CLASS(ret, mkString("factor"));`
259	`} else {`	264	`} else {`
260	`PROTECT(tmp = NEW_CHARACTER(2));`	265	`PROTECT(tmp = NEW_CHARACTER(2));`
261	`SET_STRING_ELT(tmp, 0, mkChar("ordered"));`	266	`SET_STRING_ELT(tmp, 0, mkChar("ordered"));`
262	`SET_STRING_ELT(tmp, 1, mkChar("factor"));`	267	`SET_STRING_ELT(tmp, 1, mkChar("factor"));`
263	`UNPROTECT(1);`	268	`UNPROTECT(1);`
264	`}`	269	`}`
265	`}`	270	`}`
266	`}`	271	`}`
267		272
268	`return ret;`	273	`return ret;`
269	`}`	274	`}`
270		275
271		276
272	`SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {`	277	`SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {`
273	`char iname, iname_src, varname_src, funcname;`	278	`char iname, iname_src, varname_src, funcname;`
274	`int namelen, res, nargs;`	279	`int namelen, res, nargs;`
275	`sqlite3_stmt *stmt;`	280	`sqlite3_stmt *stmt;`
276		281
277	`/* get data from arguments (function name and sqlite.vector stuffs) */`	282	`/* get data from arguments (function name and sqlite.vector stuffs) */`
278	`funcname = CHAR_ELT(func, 0);`	283	`funcname = CHAR_ELT(func, 0);`
279	`iname_src = SDF_INAME(vector);`	284	`iname_src = SDF_INAME(vector);`
280	`varname_src = SVEC_VARNAME(vector);`	285	`varname_src = SVEC_VARNAME(vector);`
281	`nargs = INTEGER(_nargs)[0];`	286	`nargs = INTEGER(_nargs)[0];`
282		287
-		288	`if (!USE_SDF(iname_src)) return R_NilValue;`
-		289
283	`/* check nargs */`	290	`/* check nargs */`
284	`if (nargs > 2) {`	291	`if (nargs > 2) {`
285	`Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");`	292	`Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");`
286	`return R_NilValue;`	293	`return R_NilValue;`
287	`}`	294	`}`
288		295
289	`/* create a new sdf, with 1 column named V1 */`	296	`/* create a new sdf, with 1 column named V1 */`
290	`iname = _create_sdf_skeleton2(R_NilValue, &namelen);`	297	`iname = _create_sdf_skeleton2(R_NilValue, &namelen);`
291	`if (iname == NULL) return R_NilValue;`	298	`if (iname == NULL) return R_NilValue;`
292		299
293	`sprintf(g_sql_buf[0], "create table [%s].sdf_data ([row name] text, "`	300	`sprintf(g_sql_buf[0], "create table [%s].sdf_data ([row name] text, "`
294	`"V1 double)", iname);`	301	`"V1 double)", iname);`
295	`res = _sqlite_exec(g_sql_buf[0]);`	302	`res = _sqlite_exec(g_sql_buf[0]);`
296	`_sqlite_error(res);`	303	`_sqlite_error(res);`
297		304
298	`/* insert into <newsdf>.col, row.names select func(col), rownames */`	305	`/* insert into <newsdf>.col, row.names select func(col), rownames */`
299	`sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "`	306	`sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "`
300	`"select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,`	307	`"select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,`
301	`varname_src, iname_src);`	308	`varname_src, iname_src);`
302		309
303	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`	310	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
304	`if (_sqlite_error(res)) {`	311	`if (_sqlite_error(res)) {`
305	`sprintf(g_sql_buf[0], "detach %s", iname);`	312	`sprintf(g_sql_buf[0], "detach %s", iname);`
306	`_sqlite_exec(g_sql_buf[0]);`	313	`_sqlite_exec(g_sql_buf[0]);`
307		314
308	`/* we will return a string with the file name, and do file.remove`	315	`/* we will return a string with the file name, and do file.remove`
309	`* at R */`	316	`* at R */`
310	`iname[namelen] = '.';`	317	`iname[namelen] = '.';`
311	`return mkString(iname);`	318	`return mkString(iname);`
312	`}`	319	`}`
313		320
314	`sqlite3_step(stmt);`	321	`sqlite3_step(stmt);`
315	`sqlite3_finalize(stmt);`	322	`sqlite3_finalize(stmt);`
316		323
317	`/* add to workspace */`	-
318	`strcpy(g_sql_buf[0], iname);`	-
319	`iname[namelen] = '.';`	-
320	`_add_sdf1(iname, g_sql_buf[0]);`	-
321	`iname[namelen] = 0;`	-
322		-
323	`/* create sqlite.vector sexp */`	324	`/* create sqlite.vector sexp */`
324	`SEXP ret, value; int nprotected = 0;`	325	`SEXP ret, value; int nprotected = 0;`
325	`PROTECT(ret = NEW_LIST(2)); nprotected++;`	326	`PROTECT(ret = NEW_LIST(2)); nprotected++;`
326		327
327	`/* set list names */`	328	`/* set list names */`
328	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	329	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
329	`SET_STRING_ELT(value, 0, mkChar("iname"));`	330	`SET_STRING_ELT(value, 0, mkChar("iname"));`
330	`SET_STRING_ELT(value, 1, mkChar("varname"));`	331	`SET_STRING_ELT(value, 1, mkChar("varname"));`
331	`SET_NAMES(ret, value);`	332	`SET_NAMES(ret, value);`
332		333
333	`/* set list values */`	334	`/* set list values */`
334	`SET_VECTOR_ELT(ret, 0, mkString(iname));`	335	`SET_VECTOR_ELT(ret, 0, mkString(iname));`
335	`SET_VECTOR_ELT(ret, 1, mkString("V1"));`	336	`SET_VECTOR_ELT(ret, 1, mkString("V1"));`
336		337
337	`/* set sexp class */`	338	`/* set sexp class */`
338	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	339	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
339	`SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));`	340	`SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));`
340	`SET_VECTOR_ELT(value, 1, mkChar("numeric"));`	341	`SET_VECTOR_ELT(value, 1, mkChar("numeric"));`
341	`SET_CLASS(ret, value);`	342	`SET_CLASS(ret, value);`
342		343
343	`UNPROTECT(nprotected);`	344	`UNPROTECT(nprotected);`
344		345
345	`return ret;`	346	`return ret;`
346		347
347	`}`	348	`}`
348		349
349		350
350		351
351	`/****************************************************************************`	352	`/****************************************************************************`
352	`* VECTOR MATH/OPS/GROUP OPERATIONS`	353	`* VECTOR MATH/OPS/GROUP OPERATIONS`
353	`****************************************************************************/`	354	`****************************************************************************/`
354	`int __vecmath_checkarg(sqlite3_context ctx, sqlite3_value arg, double *value) {`	355	`int __vecmath_checkarg(sqlite3_context ctx, sqlite3_value arg, double *value) {`
355	`int ret = 1;`	356	`int ret = 1;`
356	`if (sqlite3_value_type(arg) == SQLITE_NULL) {`	357	`if (sqlite3_value_type(arg) == SQLITE_NULL) {`
357	`sqlite3_result_null(ctx);`	358	`sqlite3_result_null(ctx);`
358	`ret = 0;`	359	`ret = 0;`
359	`} else {`	360	`} else {`
360	`if (sqlite3_value_type(arg) == SQLITE_INTEGER)`	361	`if (sqlite3_value_type(arg) == SQLITE_INTEGER)`
361	`*value = sqlite3_value_int(arg);`	362	`*value = sqlite3_value_int(arg);`
362	`else *value = sqlite3_value_double(arg);`	363	`else *value = sqlite3_value_double(arg);`
363	`}`	364	`}`
364	`return ret;`	365	`return ret;`
365	`}`	366	`}`
366		367
367	`#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\`	368	`#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\`
368	`sqlite3_context ctx, int argc, sqlite3_value *argv) { \`	369	`sqlite3_context ctx, int argc, sqlite3_value *argv) { \`
369	`double value; \`	370	`double value; \`
370	`if (__vecmath_checkarg(ctx, argv[0], &value)) { \`	371	`if (__vecmath_checkarg(ctx, argv[0], &value)) { \`
371	`sqlite3_result_double(ctx, func(value)); \`	372	`sqlite3_result_double(ctx, func(value)); \`
372	`} \`	373	`} \`
373	`}`	374	`}`
374		375
375	`/* SQLITE_MATH_FUNC1(abs, abs) in SQLite */`	376	`/* SQLITE_MATH_FUNC1(abs, abs) in SQLite */`
376	`SQLITE_MATH_FUNC1(sign, sign) /* in R */`	377	`SQLITE_MATH_FUNC1(sign, sign) /* in R */`
377	`SQLITE_MATH_FUNC1(sqrt, sqrt)`	378	`SQLITE_MATH_FUNC1(sqrt, sqrt)`
378	`SQLITE_MATH_FUNC1(floor, floor)`	379	`SQLITE_MATH_FUNC1(floor, floor)`
379	`SQLITE_MATH_FUNC1(ceiling, ceil)`	380	`SQLITE_MATH_FUNC1(ceiling, ceil)`
380	`SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */`	381	`SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */`
381	`/* SQLITE_MATH_FUNC1(round, ) in SQLite */`	382	`/* SQLITE_MATH_FUNC1(round, ) in SQLite */`
382	`/* SQLITE_MATH_FUNC1(signif, ) 2 arg */`	383	`/* SQLITE_MATH_FUNC1(signif, ) 2 arg */`
383	`SQLITE_MATH_FUNC1(exp, exp)`	384	`SQLITE_MATH_FUNC1(exp, exp)`
384	`/* SQLITE_MATH_FUNC1(log, ) 2 arg */`	385	`/* SQLITE_MATH_FUNC1(log, ) 2 arg */`
385	`SQLITE_MATH_FUNC1(cos, cos)`	386	`SQLITE_MATH_FUNC1(cos, cos)`
386	`SQLITE_MATH_FUNC1(sin, sin)`	387	`SQLITE_MATH_FUNC1(sin, sin)`
387	`SQLITE_MATH_FUNC1(tan, tan)`	388	`SQLITE_MATH_FUNC1(tan, tan)`
388	`SQLITE_MATH_FUNC1(acos, acos)`	389	`SQLITE_MATH_FUNC1(acos, acos)`
389	`SQLITE_MATH_FUNC1(asin, asin)`	390	`SQLITE_MATH_FUNC1(asin, asin)`
390	`SQLITE_MATH_FUNC1(atan, atan)`	391	`SQLITE_MATH_FUNC1(atan, atan)`
391	`SQLITE_MATH_FUNC1(cosh, cosh)`	392	`SQLITE_MATH_FUNC1(cosh, cosh)`
392	`SQLITE_MATH_FUNC1(sinh, sinh)`	393	`SQLITE_MATH_FUNC1(sinh, sinh)`
393	`SQLITE_MATH_FUNC1(tanh, tanh)`	394	`SQLITE_MATH_FUNC1(tanh, tanh)`
394	`SQLITE_MATH_FUNC1(acosh, acosh) /* nowhere in include?? */`	395	`SQLITE_MATH_FUNC1(acosh, acosh) /* nowhere in include?? */`
395	`SQLITE_MATH_FUNC1(asinh, asinh) /* nowhere in include?? */`	396	`SQLITE_MATH_FUNC1(asinh, asinh) /* nowhere in include?? */`
396	`SQLITE_MATH_FUNC1(atanh, atanh) /* nowhere in include?? */`	397	`SQLITE_MATH_FUNC1(atanh, atanh) /* nowhere in include?? */`
397	`SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */`	398	`SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */`
398	`SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */`	399	`SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */`
399	`/* SQLITE_MATH_FUNC1(gammaCody, gammaCody) * in R ?? */`	400	`/* SQLITE_MATH_FUNC1(gammaCody, gammaCody) * in R ?? */`
400	`SQLITE_MATH_FUNC1(digamma, digamma) /* in R */`	401	`SQLITE_MATH_FUNC1(digamma, digamma) /* in R */`
401	`SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */`	402	`SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */`
402		403
403	`#define VMENTRY1(func) {#func, __vecmath_ ## func}`	404	`#define VMENTRY1(func) {#func, __vecmath_ ## func}`
404	`void __register_vector_math() {`	405	`void __register_vector_math() {`
405	`int i, res;`	406	`int i, res;`
406	`static const struct {`	407	`static const struct {`
407	`char *name;`	408	`char *name;`
408	`void (func)(sqlite3_context, int, sqlite3_value**);`	409	`void (func)(sqlite3_context, int, sqlite3_value**);`
409	`} arr_func1[] = {`	410	`} arr_func1[] = {`
410	`VMENTRY1(sign),`	411	`VMENTRY1(sign),`
411	`VMENTRY1(sqrt),`	412	`VMENTRY1(sqrt),`
412	`VMENTRY1(floor),`	413	`VMENTRY1(floor),`
413	`VMENTRY1(ceiling),`	414	`VMENTRY1(ceiling),`
414	`VMENTRY1(trunc),`	415	`VMENTRY1(trunc),`
415	`VMENTRY1(exp),`	416	`VMENTRY1(exp),`
416	`VMENTRY1(cos),`	417	`VMENTRY1(cos),`
417	`VMENTRY1(sin),`	418	`VMENTRY1(sin),`
418	`VMENTRY1(tan),`	419	`VMENTRY1(tan),`
419	`VMENTRY1(acos),`	420	`VMENTRY1(acos),`
420	`VMENTRY1(asin),`	421	`VMENTRY1(asin),`
421	`VMENTRY1(atan),`	422	`VMENTRY1(atan),`
422	`VMENTRY1(cosh),`	423	`VMENTRY1(cosh),`
423	`VMENTRY1(sinh),`	424	`VMENTRY1(sinh),`
424	`VMENTRY1(tanh),`	425	`VMENTRY1(tanh),`
425	`VMENTRY1(acosh),`	426	`VMENTRY1(acosh),`
426	`VMENTRY1(asinh),`	427	`VMENTRY1(asinh),`
427	`VMENTRY1(atanh),`	428	`VMENTRY1(atanh),`
428	`VMENTRY1(lgamma),`	429	`VMENTRY1(lgamma),`
429	`VMENTRY1(gamma),`	430	`VMENTRY1(gamma),`
430	`VMENTRY1(digamma),`	431	`VMENTRY1(digamma),`
431	`VMENTRY1(trigamma)`	432	`VMENTRY1(trigamma)`
432	`};`	433	`};`
433		434
434	`int func1_len = sizeof(arr_func1) / sizeof(arr_func1[0]);`	435	`int func1_len = sizeof(arr_func1) / sizeof(arr_func1[0]);`
435		436
436	`for (i = 0; i < func1_len; i++) {`	437	`for (i = 0; i < func1_len; i++) {`
437	`res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1,`	438	`res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1,`
438	`SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);`	439	`SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);`
439	`_sqlite_error(res);`	440	`_sqlite_error(res);`
440	`}`	441	`}`
441	`}`	442	`}`

The R Project SVN R-packages

(root)/trunk/SQLiteDF/src/sqlite_vector.c – Rev 3307 → 3308