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


#include "sqlite_dataframe.h"
#include <math.h>
#include "Rmath.h"
 
/****************************************************************************
 * UTILITY FUNCTIONS
 ****************************************************************************/
char *_create_svector1(SEXP name, const char *type, int * _namelen, int protect) {
    int namelen, res;
    char *iname = _create_sdf_skeleton1(name, &namelen, protect);
 
    if (iname == NULL) return NULL;
 
    sprintf(g_sql_buf[2], "create table [%s].sdf_data ([row name] text, "
            "V1 %s, primary key ([row name]))", iname, type);
    res = _sqlite_exec(g_sql_buf[2]);
    _sqlite_error(res);
 
    if (_namelen != NULL) *_namelen = namelen;
    return iname;
}
 
static SEXP _create_svector_sexp(const char *iname, const char *varname, 
        const char *type) {
    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(varname));
 
    /* set sexp class */
    if (strcmp(type, "ordered") == 0) {
        PROTECT(value = NEW_CHARACTER(3)); nprotected++;
        SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
        SET_VECTOR_ELT(value, 1, mkChar(type));
        SET_VECTOR_ELT(value, 2, mkChar("factor"));
    } else {
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
        SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
        SET_VECTOR_ELT(value, 1, mkChar(type));
        SET_CLASS(ret, value);
    }
 
    UNPROTECT(nprotected);
 
    return ret;
}
 
/* if ret == NULL, 3rd arg is the length of the vector created. otherwise
 * it is the index in the vector ret where we will put the result extracted
 * from 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;
}
 
/****************************************************************************
 * SVEC FUNCTIONS
 ****************************************************************************/
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_SDF1(iname, TRUE, FALSE)) 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;
 
}
 
 
SEXP sdf_get_variable_length(SEXP svec) {
    char *iname = SDF_INAME(svec);
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
 
    SEXP ret;
    PROTECT(ret = NEW_INTEGER(1));
    INTEGER(ret)[0] = _get_row_count2(iname, 1);
    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;
    sqlite3_stmt *stmt;
 
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
 
    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_reset(stmt);
            sqlite3_bind_int(stmt, 1, 0);
            res = sqlite3_step(stmt);
            if (res == SQLITE_ROW) {
                _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_reset(stmt);
            sqlite3_bind_int(stmt, 1, 0);
            res = sqlite3_step(stmt);
            if (res == SQLITE_ROW) {
                _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 */
        int veclen = _get_row_count2(iname, 1);
 
        /* 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;
}
 
/* sqlite.vector.[<- */
SEXP sdf_set_variable_index(SEXP svec, SEXP idx, SEXP value) {
    int idx_len, val_len;
 
    /* match levels if factor or ordered */
    if (inherits(value, "ordered")) {
    } else if (inherits(value, "factor")) {
    }
 
    idx_len = LENGTH(idx);
    val_len = LENGTH(value);
 
    if (IS_NUMERIC(idx)) {
    } else if (IS_INTEGER(idx)) {
    } else if (IS_LOGICAL(idx)) {
    }
 
    return R_NilValue;
}
 
SEXP sdf_variable_summary(SEXP svec, SEXP maxsum) {
    char *iname, *varname, *type;
    sqlite3_stmt *stmt;
    int nprotected = 0;
    SEXP ret, names;
 
    iname = SDF_INAME(svec);
    varname = SVEC_VARNAME(svec);
    USE_SDF1(iname, TRUE, FALSE);
 
    if ((inherits(svec, "ordered") && ((type = "ordered"))) ||
            (inherits(svec, "factor") && ((type = "factor")))) {
        int nrows, i, max_rows = INTEGER(maxsum)[0];
 
 
        sprintf(g_sql_buf[0], "[%s].[%s %s]", iname, type, varname);
        nrows = _get_row_count2(g_sql_buf[0], FALSE);
        if (nrows <= max_rows) max_rows = nrows;
        else { nrows = max_rows; max_rows--; }
 
        PROTECT(ret = NEW_INTEGER(nrows)); nprotected = 1;
        PROTECT(names = NEW_CHARACTER(nrows)); nprotected++;
 
        sprintf(g_sql_buf[0], "select [%s].[%s %s].label, count(*) from "
                "[%s].sdf_data join [%s].[%s %s] on [%s].sdf_data.[%s]=[%s].[%s %s].level "
                "group by [%s].sdf_data.[%s], [%s].[%s %s].level order by count(*) desc",
                iname, type, varname, iname, iname, type, varname, iname, varname,
                iname, type, varname, iname, varname, iname, type, varname);
        sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 
        for (i = 0; i < max_rows; i++) {
            sqlite3_step(stmt);
            SET_STRING_ELT(names, i, mkChar((char *)sqlite3_column_text(stmt, 0)));
            INTEGER(ret)[i] = sqlite3_column_int(stmt, 1);
        }
 
        if (nrows > max_rows) {
            int others_sum = 0;
            SET_STRING_ELT(names, nrows-1, mkChar("(Others)"));
            while (sqlite3_step(stmt) == SQLITE_ROW) {
                others_sum += sqlite3_column_int(stmt, 1);
            }
            INTEGER(ret)[nrows-1] = others_sum;
        }
    } else if (inherits(svec, "logical")) {
        sprintf(g_sql_buf[0], "select count(*) from "
                "[%s].sdf_data group by [%s] order by [%s]", iname, varname, varname);
 
        PROTECT(names = NEW_CHARACTER(3)); nprotected = 1;
        PROTECT(ret = NEW_CHARACTER(3)); nprotected++;
 
        SET_STRING_ELT(names, 0, mkChar("Mode"));
        SET_STRING_ELT(names, 1, mkChar("FALSE"));
        SET_STRING_ELT(names, 2, mkChar("TRUE"));
 
        sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
        SET_STRING_ELT(ret, 0, mkChar("logical"));
        sqlite3_step(stmt);
        SET_STRING_ELT(ret, 1, mkChar((const char *)sqlite3_column_text(stmt, 0)));
        sqlite3_step(stmt);
        SET_STRING_ELT(ret, 2, mkChar((const char *)sqlite3_column_text(stmt, 0)));
 
    } else return R_NilValue;
 
    sqlite3_finalize(stmt);
    SET_NAMES(ret, names);
    SET_CLASS(ret, mkString("table"));
    UNPROTECT(nprotected);
    return ret;
}
            
 
/* the global accumulator should be safe if we only do 1 cummulative or
 * aggregate at any time. it won't work for stuffs like "select max(col)-min(col)
 * from sdf_data". */
static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */
static int g_start = 0;            /* flag for start of cummulation */
static int g_narm = 0;             /* for Summary group */
 
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_SDF1(iname_src, TRUE, TRUE)) 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_svector1(R_NilValue, "double", &namelen, TRUE);
 
    /* 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);
    }
 
    g_accumulator = 0.0;   /* initialize accumulator */
    g_start = 1;           /* flag that we are at start of accumulating */
    sqlite3_step(stmt);
    sqlite3_finalize(stmt);
 
    UNUSE_SDF2(iname);
    UNUSE_SDF2(iname_src);
 
    return _create_svector_sexp(iname, "V1", "numeric");
}
 
SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2) {
    char *iname = NULL, *iname_src, *varname_src, *funcname;
    int res, functype = -1, op2_len, svec_len, i;
    sqlite3_stmt *stmt, *stmt2;
 
    /* 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);
 
    if (!USE_SDF1(iname_src, TRUE, TRUE)) return R_NilValue;
    switch(funcname[0]) {
        case '+' :
        case '-' :
        case '*' :
        case '/' :
        case '^' :
        case '%' : /* %% and %/% */ 
            functype = 0; break;  /* output is REAL */
        case '&' :
        case '|' :
        case '!' :  /* ! and != */
            if (funcname[1] == 0) { functype = 1; break; }
        case '=' :  /* == */
        case '<' :  /* < and <= */
        case '>' :  /* > and >= */
            functype = 2; 
    }
 
    svec_len = _get_row_count2(iname_src, 1);
    if (functype == 0 || functype == 2 || (functype == 1 && funcname[0] != '!')) {
        char *insert_fmt_string1c, *insert_fmt_string1s;
        char *insert_fmt_string2c, *insert_fmt_string2s;
        iname = _create_svector1(R_NilValue, (functype == 0) ? "double" : "bit", NULL, TRUE);
 
        if (functype == 1) { /* boolean binary operators */
            insert_fmt_string1s = "insert into [%s].sdf_data "
                        "select [row name], ([%s] != 0) %s (? != 0) from [%s].sdf_data";
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, (? != 0) %s (? != 0))";
            /* no need for char version of fmt_string2, since %% only occurs for functype==0 */
            insert_fmt_string1c = insert_fmt_string1s;
            insert_fmt_string2c = insert_fmt_string2s;
        } else {
            insert_fmt_string1s = "insert into [%s].sdf_data "
                        "select [row name], [%s] %s ? from [%s].sdf_data";
            insert_fmt_string1c = "insert into [%s].sdf_data "
                        "select [row name], [%s] %c ? from [%s].sdf_data";
            /* fmt_string2c format operator from a char, used for %% and %/% */
            /* BUG: i'm casting to int before applying / & %, w/c is different
             * from R. added trunc to pass package test */
            insert_fmt_string2c = "insert into [%s].sdf_data values(?, trunc(? %c ?))";
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, ? %s ?)";
        }
 
 
        if (IS_NUMERIC(op2)) {
            op2_len = LENGTH(op2);
 
            if (op2_len == 1) {
                if (funcname[0] == '%') {
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
                            varname_src, funcname[1], iname_src);
                } else {
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
                            varname_src, funcname, iname_src);
                }
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                _sqlite_error(res);
                sqlite3_bind_double(stmt, 1, REAL(op2)[0]);
                sqlite3_step(stmt);
                sqlite3_finalize(stmt);
            } else if (op2_len <= svec_len) {  /* recycle op2 */
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
                        varname_src, iname_src);
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
                _sqlite_error(res);
 
                if (funcname[0] == '%') {
                    /* sqlite does int div with "/" if both args are int. mod is % also.
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
                    _sqlite_begin;
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
 
                    for (i = 0; i < svec_len; i++) {
                        sqlite3_step(stmt2);
 
                        sqlite3_reset(stmt);
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
                        sqlite3_bind_int(stmt, 2, (int)sqlite3_column_double(stmt2, 1));
                        sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
                        sqlite3_step(stmt);
                    }
                    sqlite3_finalize(stmt);
                    sqlite3_finalize(stmt2);
                    _sqlite_commit;
                } else { /* non-integer binary operation */
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
                    _sqlite_begin;
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
 
                    for (i = 0; i < svec_len; i++) {
                        sqlite3_step(stmt2);
 
                        sqlite3_reset(stmt);
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
                        sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
                        sqlite3_step(stmt);
                    }
                    sqlite3_finalize(stmt);
                    sqlite3_finalize(stmt2);
                    _sqlite_commit;
                }
 
            } else { /* op2_len > svec_len, recycle svec */
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
                        varname_src, iname_src);
 
                if (funcname[0] == '%') {
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
                } else {
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
                }
               
                i = 0; _sqlite_begin;
                while (i < op2_len) {
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
                    _sqlite_error(res);
 
                    if (funcname[0] == '%') {
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
                            sqlite3_step(stmt2);
 
                            sqlite3_reset(stmt);
                            /* simplify my life, just use ints for row names so that we
                             * don't have to worry about duplicates */
                            sqlite3_bind_int(stmt, 1, i); 
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
                            sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
                            sqlite3_step(stmt);
                        }
                    } else {
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
                            sqlite3_step(stmt2);
 
                            sqlite3_reset(stmt);
                            sqlite3_bind_int(stmt, 1, i);
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
                            sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
                            sqlite3_step(stmt);
                        }
                    }
 
                    /* recycle on svec if we loop again */
                    sqlite3_finalize(stmt2);
                }
 
                sqlite3_finalize(stmt);
                _sqlite_commit;
            }
 
 
        } else if (IS_INTEGER(op2) || IS_LOGICAL(op2)) { /* I N T E G E R */
            /* we are taking advantage of the fact that logicals are stored as int.
             * if this becomes untrue in the future, then this is a bug */
            op2_len = LENGTH(op2);
 
            if (op2_len == 1) {
                if (funcname[0] == '%') {
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname, 
                            varname_src, funcname[1], iname_src);
                } else {
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
                            varname_src, funcname, iname_src);
                }
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                _sqlite_error(res);
                sqlite3_bind_double(stmt, 1, (double)INTEGER(op2)[0]);
                sqlite3_step(stmt);
            } else if (op2_len <= svec_len) {
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
                        varname_src, iname_src);
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
                _sqlite_error(res);
 
                if (funcname[0] == '%') {
                    /* sqlite does int div with "/" if both args are int. mod is % also.
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
                    _sqlite_begin;
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
 
                    for (i = 0; i < svec_len; i++) {
                        sqlite3_step(stmt2);
 
                        sqlite3_reset(stmt);
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
                        sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
                        sqlite3_step(stmt);
                    }
                    _sqlite_commit;
                } else {
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
                    _sqlite_begin;
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
 
                    for (i = 0; i < svec_len; i++) {
                        sqlite3_step(stmt2);
 
                        sqlite3_reset(stmt);
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
                        sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
                        sqlite3_step(stmt);
                    }
                    _sqlite_commit;
                }
                sqlite3_finalize(stmt2);
            } else {
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
                        varname_src, iname_src);
 
                if (funcname[0] == '%') {
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);  
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
                } else {
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                    _sqlite_error(res);
                }
               
                i = 0; _sqlite_begin; 
                while (i < op2_len) {
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
                    _sqlite_error(res);
 
                    if (funcname[0] == '%') {
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
                            sqlite3_step(stmt2);
 
                            sqlite3_reset(stmt);
                            /* simplify my life, just use ints for row names so that we
                             * don't have to worry about duplicates */
                            sqlite3_bind_int(stmt, 1, i); 
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
                            sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
                            sqlite3_step(stmt);
                        }
                    } else {
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
                            sqlite3_step(stmt2);
 
                            sqlite3_reset(stmt);
                            sqlite3_bind_int(stmt, 1, i);
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
                            sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
                            sqlite3_step(stmt);
                        }
                    }
 
                    /* recycle on svec if we loop again */
                    sqlite3_finalize(stmt2);
                }
                _sqlite_commit;
            }
 
            sqlite3_finalize(stmt);
        } else if (inherits(op2, "sqlite.vector")) { 
            /* op2 is surely not a factor, as handled by the R wrapper */
            char *iname_op2, *varname_op2;
            sqlite3_stmt *stmt3;
            iname_op2 = SDF_INAME(op2);
            varname_op2 = SVEC_VARNAME(op2);
 
            if (!USE_SDF1(iname_op2, TRUE, TRUE)) {
                /* delete created sqlite.vector */
                Rprintf("Warning: detaching created result SDF %s\n", iname);
                sdf_detach_sdf(mkString(iname));
                return R_NilValue;
            }
            _sqlite_begin;
 
            op2_len = _get_row_count2(iname_op2, 1);
            
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_src, iname_src);
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
            _sqlite_error(res);
 
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_op2, iname_op2);
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt3, 0);
            _sqlite_error(res);
 
            if (funcname[0] == '%') {
                sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                _sqlite_error(res);
 
                if (svec_len == op2_len) {
                    for (i = 0; i < svec_len; i++) {
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
 
                        sqlite3_reset(stmt);
                        sqlite3_bind_int(stmt, 1, i);
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
                        sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
                        sqlite3_step(stmt);
                    }
                } else if (svec_len < op2_len) {
                    i = 0;
                    while (i < op2_len) {
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
                            sqlite3_step(stmt3);
 
                            sqlite3_reset(stmt);
                            sqlite3_bind_int(stmt, 1, i);
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
                            sqlite3_step(stmt);
                        }
                        sqlite3_reset(stmt2);
                    }
                } else {
                    i = 0;
                    while (i < svec_len) {
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
                            sqlite3_step(stmt2);
 
                            sqlite3_reset(stmt);
                            sqlite3_bind_int(stmt, 1, i);
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
                            sqlite3_step(stmt);
                        }
                        sqlite3_reset(stmt3);
                    }
                }
                _sqlite_commit;
            } else { /* not an integer op %% or %/% */
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
                _sqlite_error(res);
 
                if (svec_len == op2_len) {
                    for (i = 0; i < svec_len; i++) {
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
 
                        sqlite3_reset(stmt);
                        sqlite3_bind_int(stmt, 1, i);
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
                        sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
                        sqlite3_step(stmt);
                    }
                } else if (svec_len < op2_len) { /* recycle svec */
                    i = 0;
                    while (i < op2_len) {
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
                            sqlite3_step(stmt3);
 
                            sqlite3_reset(stmt);
                            sqlite3_bind_int(stmt, 1, i);
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
                            sqlite3_step(stmt);
                        }
                        sqlite3_reset(stmt2);
                    }
                } else { /* svec_len > op2_len, recycle op2 */
                    i = 0;
                    while (i < svec_len) {
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
                            sqlite3_step(stmt2);
 
                            sqlite3_reset(stmt);
                            sqlite3_bind_int(stmt, 1, i);
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
                            sqlite3_step(stmt);
                        }
                        sqlite3_reset(stmt3);
                    }
                }
 
            }
 
            sqlite3_finalize(stmt);
            sqlite3_finalize(stmt2);
            sqlite3_finalize(stmt3);
            _sqlite_commit;
 
            UNUSE_SDF2(iname_op2);
        }
    } else if (functype == 1 && funcname[0] != '!') { /* unary not operator */
        iname = _create_svector1(R_NilValue, "bit", NULL, TRUE);
        sprintf(g_sql_buf[2], "insert into [%s].sdf_data "
                    "select [row name], [%s] == 0 from [%s].sdf_data", 
                    iname, varname_src, iname_src);
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
        _sqlite_error(res);
        sqlite3_step(stmt);
        sqlite3_finalize(stmt);
    }
 
    if (iname != NULL) {
        return _create_svector_sexp(iname, "V1", 
                (functype == 0) ? "numeric" : "logical");
        UNUSE_SDF2(iname);
    }
 
    UNUSE_SDF2(iname_src);
 
    return R_NilValue;
 
}
 
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
    char *iname_src, *varname_src, *funcname;
    int res;
    sqlite3_stmt *stmt;
    double _ret = NA_REAL; SEXP ret;
 
    /* 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);
 
    if (!USE_SDF1(iname_src, TRUE, FALSE)) return R_NilValue;
 
    g_narm = LOGICAL(na_rm)[0];
    if (strcmp(funcname, "range") == 0) {
        /* special handling for range. use min then max */
        g_start = 1;
        g_accumulator = 0.0;
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
        if (_sqlite_error(res)) return R_NilValue;
        sqlite3_step(stmt); sqlite3_finalize(stmt);
        _ret = g_accumulator;
 
        if (R_IsNA(_ret) && !g_narm) {
            PROTECT(ret = NEW_NUMERIC(2));
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
            goto __sdf_do_variable_summary_out;
        }
        
        g_start = 1;
        g_accumulator = 0.0;
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
        if (_sqlite_error(res)) return R_NilValue;
        sqlite3_step(stmt); sqlite3_finalize(stmt);
 
        /* if there is NA, then the if above should have caught it already */
        PROTECT(ret = NEW_NUMERIC(2));
        REAL(ret)[0] = _ret;
        REAL(ret)[1] = g_accumulator;
    } else {
        g_start = 1;  /* we'll use these instead of sqlite3_aggregate_context */
        g_accumulator = 0.0;
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
        if (_sqlite_error(res)) return R_NilValue;
        res = sqlite3_step(stmt); sqlite3_finalize(stmt);
 
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
            PROTECT(ret = NEW_LOGICAL(1));
            if (R_IsNA(g_accumulator)) LOGICAL(ret)[0] = NA_INTEGER;
            else LOGICAL(ret)[0] = !(g_accumulator == 0);
        } else {
            PROTECT(ret = NEW_NUMERIC(1));
            REAL(ret)[0] = g_accumulator;
        }
    }
 
__sdf_do_variable_summary_out:
    UNPROTECT(1);
    return ret;
}
 
 
SEXP sdf_sort_variable(SEXP svec, SEXP decreasing) {
    char *iname, *iname_src, *varname_src, *type;
    sqlite3_stmt *stmt;
    int res;
 
    iname_src = SDF_INAME(svec);
    varname_src = SVEC_VARNAME(svec);
 
    if (!USE_SDF1(iname_src, TRUE, TRUE)) return R_NilValue;
 
    /* determine type of svec */
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit 1", varname_src, iname_src);
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
    _sqlite_error(res);
    sqlite3_step(stmt);
    strcpy(g_sql_buf[0], sqlite3_column_decltype(stmt, 0));
    sqlite3_finalize(stmt);
 
    /* create a new vector of that type */
    iname = _create_svector1(mkString("tmp-sort"), g_sql_buf[0], NULL, TRUE);
 
    /* insert to new sdf ordered */
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data "
            "select [row name], [%s] from [%s].sdf_data "
            "order by [%s] %s", iname, varname_src, iname_src, varname_src,
            (LOGICAL(decreasing)[0]) ? "desc" : "asc");
    res = _sqlite_exec(g_sql_buf[0]);
    _sqlite_error(res);
 
    if (inherits(svec, "factor")) { /* copy factor table to iname */
        if (inherits(svec, "ordered")) type = "ordered";
        else type = "factor";
        _copy_factor_levels2(type, iname_src, varname_src, iname, "V1");
    } else type = CHAR_ELT(GET_CLASS(svec), 1);
 
    UNUSE_SDF2(iname_src);
    UNUSE_SDF2(iname);
 
    return _create_svector_sexp(iname, "V1", type);
}
 
/****************************************************************************
 * 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)); \
    }  \
}
 
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
    double value; \
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
        if (g_start) { g_start = 0; g_accumulator = value; } \
        else g_accumulator = func(g_accumulator, value); \
        sqlite3_result_double(ctx, g_accumulator); \
    }  \
}
 
/* 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 SUM(a, b)  (a) + (b)
#define PROD(a, b) (a) * (b)
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
 
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
SQLITE_MATH_FUNC_CUM(cummin, MIN)
SQLITE_MATH_FUNC_CUM(cummax, MAX)
 
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
    double value; \
    if (!g_narm && R_IsNA(g_accumulator)) return; /* NA if na.rm=F & NA found */ \
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
            int tmp = sqlite3_value_int(argv[0]); \
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
        } else value = sqlite3_value_double(argv[0]);  \
        if (R_IsNA(value)) { \
            if (!g_narm) g_accumulator = value; return; \
        } else if (g_start) { g_start = 0; g_accumulator = value; } \
        else g_accumulator = func(g_accumulator, value); \
    } \
}
 
SQLITE_SUMMARY_FUNC(all_df, ALL)
SQLITE_SUMMARY_FUNC(any_df, ANY)
SQLITE_SUMMARY_FUNC(sum_df, SUM)
SQLITE_SUMMARY_FUNC(prod_df, PROD)
SQLITE_SUMMARY_FUNC(min_df, MIN)
SQLITE_SUMMARY_FUNC(max_df, MAX)
 
static void __vecsummary_finalize(sqlite3_context *ctx) {
    /* g_accumulator already summarizes it. just return that */
    sqlite3_result_double(ctx, g_accumulator);
}
 
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
#define VSENTRY1(func)  {#func, __vecsummary_ ## 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),
        VMENTRY1(cumsum),
        VMENTRY1(cumprod),
        VMENTRY1(cummin),
        VMENTRY1(cummax)
    }, arr_sum1[] = {
        VSENTRY1(all_df),  /* can't override sum, min, max */
        VSENTRY1(any_df),
        VSENTRY1(sum_df),
        VSENTRY1(prod_df),
        VSENTRY1(min_df),
        VSENTRY1(max_df)
    };
 
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
 
    for (i = 0; i < 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);
    }
 
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
    for (i = 0; i < len; i++) {
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
        _sqlite_error(res);
    }
}

Rev 3397	Rev 3419
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	`/****************************************************************************`	5	`/****************************************************************************`
6	`* UTILITY FUNCTIONS`	6	`* UTILITY FUNCTIONS`
7	`****************************************************************************/`	7	`****************************************************************************/`
8	`static char _create_svector1(SEXP name, const char type, int * _namelen) {`	8	`char _create_svector1(SEXP name, const char type, int * _namelen, int protect) {`
9	`int namelen, res;`	9	`int namelen, res;`
10	`char *iname = _create_sdf_skeleton1(name, &namelen);`	10	`char *iname = _create_sdf_skeleton1(name, &namelen, protect);`
11		11
12	`if (iname == NULL) return NULL;`	12	`if (iname == NULL) return NULL;`
13		13
14	`sprintf(g_sql_buf[2], "create table [%s].sdf_data ([row name] text, "`	14	`sprintf(g_sql_buf[2], "create table [%s].sdf_data ([row name] text, "`
15	`"V1 %s, primary key ([row name]))", iname, type);`	15	`"V1 %s, primary key ([row name]))", iname, type);`
16	`res = _sqlite_exec(g_sql_buf[2]);`	16	`res = _sqlite_exec(g_sql_buf[2]);`
17	`_sqlite_error(res);`	17	`_sqlite_error(res);`
18		18
19	`if (_namelen != NULL) *_namelen = namelen;`	19	`if (_namelen != NULL) *_namelen = namelen;`
20	`return iname;`	20	`return iname;`
21	`}`	21	`}`
22		22
23	`static SEXP _create_svector_sexp(const char iname, const char varname,`	23	`static SEXP _create_svector_sexp(const char iname, const char varname,`
24	`const char *type) {`	24	`const char *type) {`
25	`SEXP ret, value; int nprotected = 0;`	25	`SEXP ret, value; int nprotected = 0;`
26	`PROTECT(ret = NEW_LIST(2)); nprotected++;`	26	`PROTECT(ret = NEW_LIST(2)); nprotected++;`
27		27
28	`/* set list names */`	28	`/* set list names */`
29	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	29	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
30	`SET_STRING_ELT(value, 0, mkChar("iname"));`	30	`SET_STRING_ELT(value, 0, mkChar("iname"));`
31	`SET_STRING_ELT(value, 1, mkChar("varname"));`	31	`SET_STRING_ELT(value, 1, mkChar("varname"));`
32	`SET_NAMES(ret, value);`	32	`SET_NAMES(ret, value);`
33		33
34	`/* set list values */`	34	`/* set list values */`
35	`SET_VECTOR_ELT(ret, 0, mkString(iname));`	35	`SET_VECTOR_ELT(ret, 0, mkString(iname));`
36	`SET_VECTOR_ELT(ret, 1, mkString(varname));`	36	`SET_VECTOR_ELT(ret, 1, mkString(varname));`
37		37
38	`/* set sexp class */`	38	`/* set sexp class */`
39	`if (strcmp(type, "ordered") == 0) {`	39	`if (strcmp(type, "ordered") == 0) {`
40	`PROTECT(value = NEW_CHARACTER(3)); nprotected++;`	40	`PROTECT(value = NEW_CHARACTER(3)); nprotected++;`
41	`SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));`	41	`SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));`
42	`SET_VECTOR_ELT(value, 1, mkChar(type));`	42	`SET_VECTOR_ELT(value, 1, mkChar(type));`
43	`SET_VECTOR_ELT(value, 2, mkChar("factor"));`	43	`SET_VECTOR_ELT(value, 2, mkChar("factor"));`
44	`} else {`	44	`} else {`
45	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	45	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
46	`SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));`	46	`SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));`
47	`SET_VECTOR_ELT(value, 1, mkChar(type));`	47	`SET_VECTOR_ELT(value, 1, mkChar(type));`
48	`SET_CLASS(ret, value);`	48	`SET_CLASS(ret, value);`
49	`}`	49	`}`
50		50
51	`UNPROTECT(nprotected);`	51	`UNPROTECT(nprotected);`
52		52
53	`return ret;`	53	`return ret;`
54	`}`	54	`}`
55		55
56	`/* if ret == NULL, 3rd arg is the length of the vector created. otherwise`	56	`/* if ret == NULL, 3rd arg is the length of the vector created. otherwise`
57	`* it is the index in the vector ret where we will put the result extracted`	57	`* it is the index in the vector ret where we will put the result extracted`
58	`* from ret */`	58	`* from ret */`
59	`int _get_vector_index_typed_result(sqlite3_stmt stmt, SEXP ret, int idx_or_len) {`	59	`int _get_vector_index_typed_result(sqlite3_stmt stmt, SEXP ret, int idx_or_len) {`
60	`int added = 1;`	60	`int added = 1;`
61	`if (ret == NULL \|\| ret == R_NilValue) {`	61	`if (ret == NULL \|\| ret == R_NilValue) {`
62	`const char *coltype = sqlite3_column_decltype(stmt, 0);`	62	`const char *coltype = sqlite3_column_decltype(stmt, 0);`
63	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`	63	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`
64	`added = 0;`	64	`added = 0;`
65	`}`	65	`}`
66		66
67	`if (strcmp(coltype, "text") == 0) {`	67	`if (strcmp(coltype, "text") == 0) {`
68	`PROTECT(*ret = NEW_CHARACTER(idx_or_len));`	68	`PROTECT(*ret = NEW_CHARACTER(idx_or_len));`
69	`if (added)`	69	`if (added)`
70	`SET_STRING_ELT(ret, 0, mkChar((char )sqlite3_column_text(stmt, 0)));`	70	`SET_STRING_ELT(ret, 0, mkChar((char )sqlite3_column_text(stmt, 0)));`
71	`} else if (strcmp(coltype, "double") == 0) {`	71	`} else if (strcmp(coltype, "double") == 0) {`
72	`PROTECT(*ret = NEW_NUMERIC(idx_or_len));`	72	`PROTECT(*ret = NEW_NUMERIC(idx_or_len));`
73	`if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);`	73	`if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);`
74	`} else if (strcmp(coltype, "bit") == 0) {`	74	`} else if (strcmp(coltype, "bit") == 0) {`
75	`PROTECT(*ret = NEW_LOGICAL(idx_or_len));`	75	`PROTECT(*ret = NEW_LOGICAL(idx_or_len));`
76	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`	76	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`
77	`} else if (strcmp(coltype, "integer") == 0 \|\|`	77	`} else if (strcmp(coltype, "integer") == 0 \|\|`
78	`strcmp(coltype, "int") == 0) {`	78	`strcmp(coltype, "int") == 0) {`
79	`/* caller should just copy off the vars level attr for factors */`	79	`/* caller should just copy off the vars level attr for factors */`
80	`PROTECT(*ret = NEW_INTEGER(idx_or_len));`	80	`PROTECT(*ret = NEW_INTEGER(idx_or_len));`
81	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`	81	`if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);`
82	`} else added = 0;`	82	`} else added = 0;`
83		83
84	`UNPROTECT(1);`	84	`UNPROTECT(1);`
85	`} else {`	85	`} else {`
86	`const char *coltype = sqlite3_column_decltype(stmt, 0);`	86	`const char *coltype = sqlite3_column_decltype(stmt, 0);`
87	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`	87	`if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {`
88	`added = 0;`	88	`added = 0;`
89	`} else if (strcmp(coltype, "text") == 0) {`	89	`} else if (strcmp(coltype, "text") == 0) {`
90	`SET_STRING_ELT(*ret, idx_or_len,`	90	`SET_STRING_ELT(*ret, idx_or_len,`
91	`mkChar((char *)sqlite3_column_text(stmt, 0)));`	91	`mkChar((char *)sqlite3_column_text(stmt, 0)));`
92	`} else if (strcmp(coltype, "double") == 0) {`	92	`} else if (strcmp(coltype, "double") == 0) {`
93	`REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);`	93	`REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);`
94	`} else if (strcmp(coltype, "bit") == 0) {`	94	`} else if (strcmp(coltype, "bit") == 0) {`
95	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`	95	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`
96	`} else if (strcmp(coltype, "integer") == 0 \|\|`	96	`} else if (strcmp(coltype, "integer") == 0 \|\|`
97	`strcmp(coltype, "int") == 0) {`	97	`strcmp(coltype, "int") == 0) {`
98	`/* caller should just copy off the vars level attr for factors */`	98	`/* caller should just copy off the vars level attr for factors */`
99	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`	99	`INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);`
100	`} else added = 0;`	100	`} else added = 0;`
101	`}`	101	`}`
102		102
103	`return added;`	103	`return added;`
104	`}`	104	`}`
105		105
106	`/****************************************************************************`	106	`/****************************************************************************`
107	`* SVEC FUNCTIONS`	107	`* SVEC FUNCTIONS`
108	`****************************************************************************/`	108	`****************************************************************************/`
109	`SEXP sdf_get_variable(SEXP sdf, SEXP name) {`	109	`SEXP sdf_get_variable(SEXP sdf, SEXP name) {`
110	`if (!IS_CHARACTER(name)) {`	110	`if (!IS_CHARACTER(name)) {`
111	`Rprintf("ERROR: argument is not a string.\n");`	111	`Rprintf("ERROR: argument is not a string.\n");`
112	`return R_NilValue;`	112	`return R_NilValue;`
113	`}`	113	`}`
114		114
115	`char *iname = SDF_INAME(sdf);`	115	`char *iname = SDF_INAME(sdf);`
116	`char *varname = CHAR_ELT(name, 0);`	116	`char *varname = CHAR_ELT(name, 0);`
117		117
118	`if (!USE_SDF1(iname, TRUE)) return R_NilValue;`	118	`if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;`
119		119
120	`/* check if sdf & varname w/in that sdf exists */`	120	`/* check if sdf & varname w/in that sdf exists */`
121	`sqlite3_stmt *stmt;`	121	`sqlite3_stmt *stmt;`
122	`sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);`	122	`sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);`
123		123
124	`int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`	124	`int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
125		125
126	`if (_sqlite_error(res)) return R_NilValue;`	126	`if (_sqlite_error(res)) return R_NilValue;`
127		127
128	`const char *coltype = sqlite3_column_decltype(stmt, 0);`	128	`const char *coltype = sqlite3_column_decltype(stmt, 0);`
129	`sqlite3_finalize(stmt);`	129	`sqlite3_finalize(stmt);`
130		130
131		131
132	`SEXP ret, value, class = R_NilValue; int nprotected = 0;`	132	`SEXP ret, value, class = R_NilValue; int nprotected = 0;`
133	`PROTECT(ret = NEW_LIST(2)); nprotected++;`	133	`PROTECT(ret = NEW_LIST(2)); nprotected++;`
134		134
135	`/* set list names */`	135	`/* set list names */`
136	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	136	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
137	`SET_STRING_ELT(value, 0, mkChar("iname"));`	137	`SET_STRING_ELT(value, 0, mkChar("iname"));`
138	`SET_STRING_ELT(value, 1, mkChar("varname"));`	138	`SET_STRING_ELT(value, 1, mkChar("varname"));`
139	`SET_NAMES(ret, value);`	139	`SET_NAMES(ret, value);`
140		140
141	`/* set list values */`	141	`/* set list values */`
142	`SET_VECTOR_ELT(ret, 0, mkString(iname));`	142	`SET_VECTOR_ELT(ret, 0, mkString(iname));`
143	`SET_VECTOR_ELT(ret, 1, mkString(varname));`	143	`SET_VECTOR_ELT(ret, 1, mkString(varname));`
144		144
145	`/* set class */`	145	`/* set class */`
146	`int type = -1;`	146	`int type = -1;`
147	`if (strcmp(coltype, "text") == 0) class = mkChar("character");`	147	`if (strcmp(coltype, "text") == 0) class = mkChar("character");`
148	`else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");`	148	`else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");`
149	`else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");`	149	`else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");`
150	`else if (strcmp(coltype, "integer") == 0 \|\| strcmp(coltype, "int") == 0) {`	150	`else if (strcmp(coltype, "integer") == 0 \|\| strcmp(coltype, "int") == 0) {`
151	`/* determine if int, factor or ordered */`	151	`/* determine if int, factor or ordered */`
152	`type = _get_factor_levels1(iname, varname, ret);`	152	`type = _get_factor_levels1(iname, varname, ret);`
153	`switch(type) {`	153	`switch(type) {`
154	`case VAR_INTEGER: class = mkChar("integer"); break;`	154	`case VAR_INTEGER: class = mkChar("integer"); break;`
155	`case VAR_FACTOR: class = mkChar("factor"); break;`	155	`case VAR_FACTOR: class = mkChar("factor"); break;`
156	`case VAR_ORDERED: class = mkChar("ordered");`	156	`case VAR_ORDERED: class = mkChar("ordered");`
157	`}`	157	`}`
158		158
159	`}`	159	`}`
160		160
161	`if (type != VAR_ORDERED) {`	161	`if (type != VAR_ORDERED) {`
162	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`	162	`PROTECT(value = NEW_CHARACTER(2)); nprotected++;`
163	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`	163	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`
164	`SET_STRING_ELT(value, 1, class);`	164	`SET_STRING_ELT(value, 1, class);`
165	`} else {`	165	`} else {`
166	`PROTECT(value = NEW_CHARACTER(3)); nprotected++;`	166	`PROTECT(value = NEW_CHARACTER(3)); nprotected++;`
167	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`	167	`SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));`
168	`SET_STRING_ELT(value, 1, class);`	168	`SET_STRING_ELT(value, 1, class);`
169	`SET_STRING_ELT(value, 2, mkChar("factor"));`	169	`SET_STRING_ELT(value, 2, mkChar("factor"));`
170	`}`	170	`}`
171	`SET_CLASS(ret, value);`	171	`SET_CLASS(ret, value);`
172		172
173	`UNPROTECT(nprotected);`	173	`UNPROTECT(nprotected);`
174	`return ret;`	174	`return ret;`
175		175
176	`}`	176	`}`
177		177
178		178
179	`SEXP sdf_get_variable_length(SEXP svec) {`	179	`SEXP sdf_get_variable_length(SEXP svec) {`
180	`char *iname = SDF_INAME(svec);`	180	`char *iname = SDF_INAME(svec);`
181	`if (!USE_SDF1(iname, TRUE)) return R_NilValue;`	181	`if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;`
182		182
183	`SEXP ret;`	183	`SEXP ret;`
184	`PROTECT(ret = NEW_INTEGER(1));`	184	`PROTECT(ret = NEW_INTEGER(1));`
185	`INTEGER(ret)[0] = _get_row_count2(iname, 1);`	185	`INTEGER(ret)[0] = _get_row_count2(iname, 1);`
186	`UNPROTECT(1);`	186	`UNPROTECT(1);`
187	`return ret;`	187	`return ret;`
188	`}`	188	`}`
189		189
190		190
191	`SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {`	191	`SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {`
192	`SEXP ret = R_NilValue, tmp;`	192	`SEXP ret = R_NilValue, tmp;`
193	`char iname = SDF_INAME(svec), varname = SVEC_VARNAME(svec);`	193	`char iname = SDF_INAME(svec), varname = SVEC_VARNAME(svec);`
194	`int index, idxlen, i, retlen=0, res;`	194	`int index, idxlen, i, retlen=0, res;`
195	`sqlite3_stmt *stmt;`	195	`sqlite3_stmt *stmt;`
196		196
197	`if (!USE_SDF1(iname, TRUE)) return R_NilValue;`	197	`if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;`
198		198
199	`idxlen = LENGTH(idx);`	199	`idxlen = LENGTH(idx);`
200	`if (idxlen < 1) return ret;`	200	`if (idxlen < 1) return ret;`
201		201
202	`sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",`	202	`sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",`
203	`varname, iname);`	203	`varname, iname);`
204	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`	204	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
205		205
206	`/* get data based on index */`	206	`/* get data based on index */`
207	`if (IS_NUMERIC(idx)) {`	207	`if (IS_NUMERIC(idx)) {`
208	`index = ((int) REAL(idx)[0]) - 1;`	208	`index = ((int) REAL(idx)[0]) - 1;`
209	`if (index < 0 && idxlen == 1) return ret;`	209	`if (index < 0 && idxlen == 1) return ret;`
210		210
211	`if (index >= 0) {`	211	`if (index >= 0) {`
212	`sqlite3_bind_int(stmt, 1, index);`	212	`sqlite3_bind_int(stmt, 1, index);`
213	`res = sqlite3_step(stmt);`	213	`res = sqlite3_step(stmt);`
214	`if (res == SQLITE_ROW) {`	214	`if (res == SQLITE_ROW) {`
215	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`	215	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`
216	`}`	216	`}`
217	`}`	217	`}`
218		218
219	`if (index < 0 \|\| res != SQLITE_ROW) {`	219	`if (index < 0 \|\| res != SQLITE_ROW) {`
220	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`	220	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`
221	`* a "dummy" call to setup the SEXP */`	221	`* a "dummy" call to setup the SEXP */`
222	`sqlite3_reset(stmt);`	222	`sqlite3_reset(stmt);`
223	`sqlite3_bind_int(stmt, 1, 0);`	223	`sqlite3_bind_int(stmt, 1, 0);`
224	`res = sqlite3_step(stmt);`	224	`res = sqlite3_step(stmt);`
225	`if (res == SQLITE_ROW) {`	225	`if (res == SQLITE_ROW) {`
226	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`	226	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`
227	`}`	227	`}`
228	`retlen = 0;`	228	`retlen = 0;`
229	`}`	229	`}`
230		230
231		231
232	`if (idxlen > 1) {`	232	`if (idxlen > 1) {`
233	`for (i = 1; i < idxlen; i++) {`	233	`for (i = 1; i < idxlen; i++) {`
234	`index = ((int) REAL(idx)[i]) - 1;`	234	`index = ((int) REAL(idx)[i]) - 1;`
235	`if (index < 0) continue;`	235	`if (index < 0) continue;`
236	`sqlite3_reset(stmt);`	236	`sqlite3_reset(stmt);`
237	`sqlite3_bind_int(stmt, 1, index);`	237	`sqlite3_bind_int(stmt, 1, index);`
238	`res = sqlite3_step(stmt);`	238	`res = sqlite3_step(stmt);`
239	`if (res == SQLITE_ROW)`	239	`if (res == SQLITE_ROW)`
240	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`	240	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`
241	`}`	241	`}`
242	`}`	242	`}`
243	`} else if (IS_INTEGER(idx)) {`	243	`} else if (IS_INTEGER(idx)) {`
244	`/* similar to REAL (IS_NUMERIC) above, except that we don't have`	244	`/* similar to REAL (IS_NUMERIC) above, except that we don't have`
245	`* to cast idx to int. can't refactor this out, sucks. */`	245	`* to cast idx to int. can't refactor this out, sucks. */`
246	`index = INTEGER(idx)[0] - 1;`	246	`index = INTEGER(idx)[0] - 1;`
247	`if (index < 0 && idxlen == 1) return ret;`	247	`if (index < 0 && idxlen == 1) return ret;`
248		248
249	`if (index >= 0) {`	249	`if (index >= 0) {`
250	`sqlite3_bind_int(stmt, 1, index);`	250	`sqlite3_bind_int(stmt, 1, index);`
251	`res = sqlite3_step(stmt);`	251	`res = sqlite3_step(stmt);`
252	`if (res == SQLITE_ROW) {`	252	`if (res == SQLITE_ROW) {`
253	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`	253	`retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);`
254	`}`	254	`}`
255	`}`	255	`}`
256		256
257	`if (index < 0 \|\| res != SQLITE_ROW) {`	257	`if (index < 0 \|\| res != SQLITE_ROW) {`
258	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`	258	`/* something wrong w/ 1st idx, and it is quietly ignored. we make`
259	`* a "dummy" call to setup the SEXP */`	259	`* a "dummy" call to setup the SEXP */`
260	`sqlite3_reset(stmt);`	260	`sqlite3_reset(stmt);`
261	`sqlite3_bind_int(stmt, 1, 0);`	261	`sqlite3_bind_int(stmt, 1, 0);`
262	`res = sqlite3_step(stmt);`	262	`res = sqlite3_step(stmt);`
263	`if (res == SQLITE_ROW) {`	263	`if (res == SQLITE_ROW) {`
264	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`	264	`_get_vector_index_typed_result(stmt, &ret, idxlen - 1);`
265	`}`	265	`}`
266	`retlen = 0;`	266	`retlen = 0;`
267	`}`	267	`}`
268		268
269	`if (idxlen > 1) {`	269	`if (idxlen > 1) {`
270	`for (i = 1; i < idxlen; i++) {`	270	`for (i = 1; i < idxlen; i++) {`
271	`index = INTEGER(idx)[i] - 1;`	271	`index = INTEGER(idx)[i] - 1;`
272	`if (index < 0) continue;`	272	`if (index < 0) continue;`
273	`sqlite3_reset(stmt);`	273	`sqlite3_reset(stmt);`
274	`sqlite3_bind_int(stmt, 1, index);`	274	`sqlite3_bind_int(stmt, 1, index);`
275	`sqlite3_step(stmt);`	275	`sqlite3_step(stmt);`
276	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`	276	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`
277	`}`	277	`}`
278	`}`	278	`}`
279		279
280	`} else if (IS_LOGICAL(idx)) {`	280	`} else if (IS_LOGICAL(idx)) {`
281	`/* have to deal with recycling */`	281	`/* have to deal with recycling */`
282	`int veclen = _get_row_count2(iname, 1);`	282	`int veclen = _get_row_count2(iname, 1);`
283		283
284	`/* find if there is any TRUE element in the vector */`	284	`/* find if there is any TRUE element in the vector */`
285	`for (i = 0; i < idxlen && i < veclen; i++) {`	285	`for (i = 0; i < idxlen && i < veclen; i++) {`
286	`if (LOGICAL(idx)[i]) {`	286	`if (LOGICAL(idx)[i]) {`
287	`sqlite3_bind_int(stmt, 1, i);`	287	`sqlite3_bind_int(stmt, 1, i);`
288	`sqlite3_step(stmt);`	288	`sqlite3_step(stmt);`
289	`/* there are at least (idxlen-i) TRUE per cycle of the LOGICAL`	289	`/* there are at least (idxlen-i) TRUE per cycle of the LOGICAL`
290	`* index. there are at least (veclen/idxlen) cycles (int div).`	290	`* index. there are at least (veclen/idxlen) cycles (int div).`
291	`* at the last cycle, if (veclen%idxlen > 0), there will be`	291	`* at the last cycle, if (veclen%idxlen > 0), there will be`
292	`* at least (veclen%idxlen - i) if veclen%idxlen > i */`	292	`* at least (veclen%idxlen - i) if veclen%idxlen > i */`
293	`retlen = (idxlen-i) * (veclen/idxlen);`	293	`retlen = (idxlen-i) * (veclen/idxlen);`
294	`if (veclen%idxlen > i) retlen += (veclen%idxlen - i);`	294	`if (veclen%idxlen > i) retlen += (veclen%idxlen - i);`
295		295
296	`/* create the vector */`	296	`/* create the vector */`
297	`retlen = _get_vector_index_typed_result(stmt, &ret, retlen);`	297	`retlen = _get_vector_index_typed_result(stmt, &ret, retlen);`
298	`break;`	298	`break;`
299	`}`	299	`}`
300	`}`	300	`}`
301		301
302	`if (i < idxlen && i < veclen) {`	302	`if (i < idxlen && i < veclen) {`
303	`for (i++; i < veclen; i++) {`	303	`for (i++; i < veclen; i++) {`
304	`if (LOGICAL(idx)[i%idxlen]) {`	304	`if (LOGICAL(idx)[i%idxlen]) {`
305	`sqlite3_reset(stmt);`	305	`sqlite3_reset(stmt);`
306	`sqlite3_bind_int(stmt, 1, i);`	306	`sqlite3_bind_int(stmt, 1, i);`
307	`sqlite3_step(stmt);`	307	`sqlite3_step(stmt);`
308	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`	308	`retlen += _get_vector_index_typed_result(stmt, &ret, retlen);`
309	`}`	309	`}`
310	`}`	310	`}`
311	`}`	311	`}`
312	`}`	312	`}`
313		313
314	`sqlite3_finalize(stmt);`	314	`sqlite3_finalize(stmt);`
315		315
316	`if (ret != R_NilValue) {`	316	`if (ret != R_NilValue) {`
317	`ret = _shrink_vector(ret, retlen);`	317	`ret = _shrink_vector(ret, retlen);`
318	`tmp = GET_LEVELS(svec);`	318	`tmp = GET_LEVELS(svec);`
319	`if (tmp != R_NilValue) {`	319	`if (tmp != R_NilValue) {`
320	`SET_LEVELS(ret, duplicate(tmp));`	320	`SET_LEVELS(ret, duplicate(tmp));`
321	`if (LENGTH(GET_CLASS(svec)) == 2) {`	321	`if (LENGTH(GET_CLASS(svec)) == 2) {`
322	`SET_CLASS(ret, mkString("factor"));`	322	`SET_CLASS(ret, mkString("factor"));`
323	`} else {`	323	`} else {`
324	`PROTECT(tmp = NEW_CHARACTER(2));`	324	`PROTECT(tmp = NEW_CHARACTER(2));`
325	`SET_STRING_ELT(tmp, 0, mkChar("ordered"));`	325	`SET_STRING_ELT(tmp, 0, mkChar("ordered"));`
326	`SET_STRING_ELT(tmp, 1, mkChar("factor"));`	326	`SET_STRING_ELT(tmp, 1, mkChar("factor"));`
327	`UNPROTECT(1);`	327	`UNPROTECT(1);`
328	`}`	328	`}`
329	`}`	329	`}`
330	`}`	330	`}`
331		331
332	`return ret;`	332	`return ret;`
333	`}`	333	`}`
334		334
335	`/* sqlite.vector.[<- */`	335	`/* sqlite.vector.[<- */`
336	`SEXP sdf_set_variable_index(SEXP svec, SEXP idx, SEXP value) {`	336	`SEXP sdf_set_variable_index(SEXP svec, SEXP idx, SEXP value) {`
337	`int idx_len, val_len;`	337	`int idx_len, val_len;`
338		338
339	`/* match levels if factor or ordered */`	339	`/* match levels if factor or ordered */`
340	`if (inherits(value, "ordered")) {`	340	`if (inherits(value, "ordered")) {`
341	`} else if (inherits(value, "factor")) {`	341	`} else if (inherits(value, "factor")) {`
342	`}`	342	`}`
343		343
344	`idx_len = LENGTH(idx);`	344	`idx_len = LENGTH(idx);`
345	`val_len = LENGTH(value);`	345	`val_len = LENGTH(value);`
346		346
347	`if (IS_NUMERIC(idx)) {`	347	`if (IS_NUMERIC(idx)) {`
348	`} else if (IS_INTEGER(idx)) {`	348	`} else if (IS_INTEGER(idx)) {`
349	`} else if (IS_LOGICAL(idx)) {`	349	`} else if (IS_LOGICAL(idx)) {`
350	`}`	350	`}`
351		351
352	`return R_NilValue;`	352	`return R_NilValue;`
353	`}`	353	`}`
354		354
-		355	`SEXP sdf_variable_summary(SEXP svec, SEXP maxsum) {`
-		356	`char iname, varname, *type;`
-		357	`sqlite3_stmt *stmt;`
-		358	`int nprotected = 0;`
-		359	`SEXP ret, names;`
-		360
-		361	`iname = SDF_INAME(svec);`
-		362	`varname = SVEC_VARNAME(svec);`
-		363	`USE_SDF1(iname, TRUE, FALSE);`
-		364
-		365	`if ((inherits(svec, "ordered") && ((type = "ordered"))) \|\|`
-		366	`(inherits(svec, "factor") && ((type = "factor")))) {`
-		367	`int nrows, i, max_rows = INTEGER(maxsum)[0];`
-		368
-		369
-		370	`sprintf(g_sql_buf[0], "[%s].[%s %s]", iname, type, varname);`
-		371	`nrows = _get_row_count2(g_sql_buf[0], FALSE);`
-		372	`if (nrows <= max_rows) max_rows = nrows;`
-		373	`else { nrows = max_rows; max_rows--; }`
-		374
-		375	`PROTECT(ret = NEW_INTEGER(nrows)); nprotected = 1;`
-		376	`PROTECT(names = NEW_CHARACTER(nrows)); nprotected++;`
-		377
-		378	`sprintf(g_sql_buf[0], "select [%s].[%s %s].label, count(*) from "`
-		379	`"[%s].sdf_data join [%s].[%s %s] on [%s].sdf_data.[%s]=[%s].[%s %s].level "`
-		380	`"group by [%s].sdf_data.[%s], [%s].[%s %s].level order by count(*) desc",`
-		381	`iname, type, varname, iname, iname, type, varname, iname, varname,`
-		382	`iname, type, varname, iname, varname, iname, type, varname);`
-		383	`sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
-		384
-		385	`for (i = 0; i < max_rows; i++) {`
-		386	`sqlite3_step(stmt);`
-		387	`SET_STRING_ELT(names, i, mkChar((char *)sqlite3_column_text(stmt, 0)));`
-		388	`INTEGER(ret)[i] = sqlite3_column_int(stmt, 1);`
-		389	`}`
-		390
-		391	`if (nrows > max_rows) {`
-		392	`int others_sum = 0;`
-		393	`SET_STRING_ELT(names, nrows-1, mkChar("(Others)"));`
-		394	`while (sqlite3_step(stmt) == SQLITE_ROW) {`
-		395	`others_sum += sqlite3_column_int(stmt, 1);`
-		396	`}`
-		397	`INTEGER(ret)[nrows-1] = others_sum;`
-		398	`}`
-		399	`} else if (inherits(svec, "logical")) {`
-		400	`sprintf(g_sql_buf[0], "select count(*) from "`
-		401	`"[%s].sdf_data group by [%s] order by [%s]", iname, varname, varname);`
-		402
-		403	`PROTECT(names = NEW_CHARACTER(3)); nprotected = 1;`
-		404	`PROTECT(ret = NEW_CHARACTER(3)); nprotected++;`
-		405
-		406	`SET_STRING_ELT(names, 0, mkChar("Mode"));`
-		407	`SET_STRING_ELT(names, 1, mkChar("FALSE"));`
-		408	`SET_STRING_ELT(names, 2, mkChar("TRUE"));`
-		409
-		410	`sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
-		411	`SET_STRING_ELT(ret, 0, mkChar("logical"));`
-		412	`sqlite3_step(stmt);`
-		413	`SET_STRING_ELT(ret, 1, mkChar((const char *)sqlite3_column_text(stmt, 0)));`
-		414	`sqlite3_step(stmt);`
-		415	`SET_STRING_ELT(ret, 2, mkChar((const char *)sqlite3_column_text(stmt, 0)));`
-		416
-		417	`} else return R_NilValue;`
-		418
-		419	`sqlite3_finalize(stmt);`
-		420	`SET_NAMES(ret, names);`
-		421	`SET_CLASS(ret, mkString("table"));`
-		422	`UNPROTECT(nprotected);`
-		423	`return ret;`
-		424	`}`
-		425
-		426
355	`/* the global accumulator should be safe if we only do 1 cummulative or`	427	`/* the global accumulator should be safe if we only do 1 cummulative or`
356	`* aggregate at any time. it won't work for stuffs like "select max(col)-min(col)`	428	`* aggregate at any time. it won't work for stuffs like "select max(col)-min(col)`
357	`* from sdf_data". */`	429	`* from sdf_data". */`
358	`static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */`	430	`static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */`
359	`static int g_start = 0; /* flag for start of cummulation */`	431	`static int g_start = 0; /* flag for start of cummulation */`
360	`static int g_narm = 0; /* for Summary group */`	432	`static int g_narm = 0; /* for Summary group */`
361		433
362	`SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {`	434	`SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {`
363	`char iname, iname_src, varname_src, funcname;`	435	`char iname, iname_src, varname_src, funcname;`
364	`int namelen, res, nargs;`	436	`int namelen, res, nargs;`
365	`sqlite3_stmt *stmt;`	437	`sqlite3_stmt *stmt;`
366		438
367	`/* get data from arguments (function name and sqlite.vector stuffs) */`	439	`/* get data from arguments (function name and sqlite.vector stuffs) */`
368	`funcname = CHAR_ELT(func, 0);`	440	`funcname = CHAR_ELT(func, 0);`
369	`iname_src = SDF_INAME(vector);`	441	`iname_src = SDF_INAME(vector);`
370	`varname_src = SVEC_VARNAME(vector);`	442	`varname_src = SVEC_VARNAME(vector);`
371	`nargs = INTEGER(_nargs)[0];`	443	`nargs = INTEGER(_nargs)[0];`
372		444
373	`if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;`	445	`if (!USE_SDF1(iname_src, TRUE, TRUE)) return R_NilValue;`
374		446
375	`/* check nargs */`	447	`/* check nargs */`
376	`if (nargs > 2) {`	448	`if (nargs > 2) {`
377	`Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");`	449	`Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");`
378	`return R_NilValue;`	450	`return R_NilValue;`
379	`}`	451	`}`
380		452
381	`/* create a new sdf, with 1 column named V1 */`	453	`/* create a new sdf, with 1 column named V1 */`
382	`iname = _create_svector1(R_NilValue, "double", &namelen);`	454	`iname = _create_svector1(R_NilValue, "double", &namelen, TRUE);`
383		455
384	`/* insert into <newsdf>.col, row.names select func(col), rownames */`	456	`/* insert into <newsdf>.col, row.names select func(col), rownames */`
385	`sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "`	457	`sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "`
386	`"select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,`	458	`"select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,`
387	`varname_src, iname_src);`	459	`varname_src, iname_src);`
388		460
389	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`	461	`res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);`
390	`if (_sqlite_error(res)) {`	462	`if (_sqlite_error(res)) {`
391	`sprintf(g_sql_buf[0], "detach %s", iname);`	463	`sprintf(g_sql_buf[0], "detach %s", iname);`
392	`_sqlite_exec(g_sql_buf[0]);`	464	`_sqlite_exec(g_sql_buf[0]);`
393		465
394	`/* we will return a string with the file name, and do file.remove`	466	`/* we will return a string with the file name, and do file.remove`
395	`* at R */`	467	`* at R */`
396	`iname[namelen] = '.';`	468	`iname[namelen] = '.';`
397	`return mkString(iname);`	469	`return mkString(iname);`
398	`}`	470	`}`
399		471
400	`g_accumulator = 0.0; /* initialize accumulator */`	472	`g_accumulator = 0.0; /* initialize accumulator */`
401	`g_start = 1; /* flag that we are at start of accumulating */`	473	`g_start = 1; /* flag that we are at start of accumulating */`
402	`sqlite3_step(stmt);`	474	`sqlite3_step(stmt);`
403	`sqlite3_finalize(stmt);`	475	`sqlite3_finalize(stmt);`
404		476
-		477	`UNUSE_SDF2(iname);`
-		478	`UNUSE_SDF2(iname_src);`
-		479
405	`return _create_svector_sexp(iname, "V1", "numeric");`	480	`return _create_svector_sexp(iname, "V1", "numeric");`
406	`}`	481	`}`
407		482
408	`SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2) {`	483	`SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2) {`
409	`char iname = NULL, iname_src, varname_src, funcname;`	484	`char iname = NULL, iname_src, varname_src, funcname;`
410	`int res, functype = -1, op2_len, svec_len, i;`	485	`int res, functype = -1, op2_len, svec_len, i;`
411	`sqlite3_stmt stmt, stmt2;`	486	`sqlite3_stmt stmt, stmt2;`
412		487
413	`/* get data from arguments (function name and sqlite.vector stuffs) */`	488	`/* get data from arguments (function name and sqlite.vector stuffs) */`
414	`funcname = CHAR_ELT(func, 0);`	489	`funcname = CHAR_ELT(func, 0);`
415	`iname_src = SDF_INAME(vector);`	490	`iname_src = SDF_INAME(vector);`
416	`varname_src = SVEC_VARNAME(vector);`	491	`varname_src = SVEC_VARNAME(vector);`
417		492
418	`if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;`	493	`if (!USE_SDF1(iname_src, TRUE, TRUE)) return R_NilValue;`
419	`switch(funcname[0]) {`	494	`switch(funcname[0]) {`
420	`case '+' :`	495	`case '+' :`
421	`case '-' :`	496	`case '-' :`
422	`case '*' :`	497	`case '*' :`
423	`case '/' :`	498	`case '/' :`
424	`case '^' :`	499	`case '^' :`
425	`case '%' : /* %% and %/% */`	500	`case '%' : /* %% and %/% */`

The R Project SVN R-packages

(root)/trunk/SQLiteDF/src/sqlite_vector.c – Rev 3397 → 3419