The R Project SVN R-packages

Rev

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