The R Project SVN R-packages

Rev

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

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