The R Project SVN R-packages

Rev

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