The R Project SVN R-packages

Rev

Rev 3446 | Rev 3458 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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