The R Project SVN R-packages

Rev

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