The R Project SVN R-packages

Rev

Rev 3324 | Rev 3397 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3324 Rev 3358
Line 1... Line 1...
1 
#include "sqlite_dataframe.h"
 1 
#include "sqlite_dataframe.h"
2 
#include <math.h>
 2 
#include <math.h>
3 
#include "Rmath.h"
 3 
#include "Rmath.h"
4 
 
 4 
 
- 
 
 5 
/****************************************************************************
- 
 
 6 
 * UTILITY FUNCTIONS
- 
 
 7 
 ****************************************************************************/
- 
 
 8 
static char *_create_svector1(SEXP name, const char *type, int * _namelen) {
- 
 
 9 
    int namelen, res;
- 
 
 10 
    char *iname = _create_sdf_skeleton1(name, &namelen);
- 
 
 11 
 
- 
 
 12 
    if (iname == NULL) return NULL;
- 
 
 13 
 
- 
 
 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);
- 
 
 18 
 
- 
 
 19 
    if (_namelen != NULL) *_namelen = namelen;
- 
 
 20 
    return iname;
- 
 
 21 
}
- 
 
 22 
 
- 
 
 23 
static SEXP _create_svector_sexp(const char *iname, const char *varname,
- 
 
 24 
        const char *type) {
- 
 
 25 
    SEXP ret, value; int nprotected = 0;
- 
 
 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 
 
- 
 
 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 {
- 
 
 45 
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
- 
 
 46 
        SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
- 
 
 47 
        SET_VECTOR_ELT(value, 1, mkChar(type));
- 
 
 48 
        SET_CLASS(ret, value);
- 
 
 49 
    }
- 
 
 50 
 
- 
 
 51 
    UNPROTECT(nprotected);
- 
 
 52 
 
- 
 
 53 
    return ret;
- 
 
 54 
}
- 
 
 55 
 
- 
 
 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 */
- 
 
 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)
- 
 
 70 
                SET_STRING_ELT(*ret, 0, mkChar((char *)sqlite3_column_text(stmt, 0)));
- 
 
 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,
- 
 
 91 
                    mkChar((char *)sqlite3_column_text(stmt, 0)));
- 
 
 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 
 
- 
 
 106 
/****************************************************************************
- 
 
 107 
 * SVEC FUNCTIONS
- 
 
 108 
 ****************************************************************************/
5 
SEXP sdf_get_variable(SEXP sdf, SEXP name) {
 109 
SEXP sdf_get_variable(SEXP sdf, SEXP name) {
6 
    if (!IS_CHARACTER(name)) {
 110 
    if (!IS_CHARACTER(name)) {
7 
        Rprintf("ERROR: argument is not a string.\n");
 111 
        Rprintf("ERROR: argument is not a string.\n");
8 
        return R_NilValue;
 112 
        return R_NilValue;
9 
    }
 113 
    }
10 
 
 114 
 
11 
    char *iname = SDF_INAME(sdf);
 115 
    char *iname = SDF_INAME(sdf);
12 
    char *varname = CHAR_ELT(name, 0);
 116 
    char *varname = CHAR_ELT(name, 0);
13 
 
 117 
 
14 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
 118 
    if (!USE_SDF1(iname, TRUE)) return R_NilValue;
15 
 
 119 
 
16 
    /* check if sdf & varname w/in that sdf exists */
 120 
    /* check if sdf & varname w/in that sdf exists */
17 
    sqlite3_stmt *stmt;
 121 
    sqlite3_stmt *stmt;
18 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
 122 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
19 
 
 123 
 
Line 69... Line 173...
69 
    UNPROTECT(nprotected);
 173 
    UNPROTECT(nprotected);
70 
    return ret;
 174 
    return ret;
71 
 
 175 
 
72 
}
 176 
}
73 
 
 177 
 
74 
int _get_vector_index_typed_result(sqlite3_stmt *stmt, SEXP *ret, int idx_or_len) {
 - 
 
75 
    int added = 1;
 - 
 
76 
    if (*ret == NULL || *ret == R_NilValue) {
 - 
 
77 
        const char *coltype = sqlite3_column_decltype(stmt, 0);
 - 
 
78 
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
 - 
 
79 
            added = 0;
 - 
 
80 
        }
 - 
 
81
- 
 
82 
        if (strcmp(coltype, "text") == 0) {
 - 
 
83 
            PROTECT(*ret = NEW_CHARACTER(idx_or_len));
 - 
 
84 
            if (added)
- 
 
85 
                SET_STRING_ELT(*ret, 0, mkChar((char *)sqlite3_column_text(stmt, 0)));
 - 
 
86 
        } else if (strcmp(coltype, "double") == 0) {
 - 
 
87 
            PROTECT(*ret = NEW_NUMERIC(idx_or_len));
 - 
 
88 
            if (added) REAL(*ret)[0] = sqlite3_column_double(stmt, 0);
 - 
 
89 
        } else if (strcmp(coltype, "bit") == 0) {
 - 
 
90 
            PROTECT(*ret = NEW_LOGICAL(idx_or_len));
 - 
 
91 
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
 - 
 
92 
        } else if (strcmp(coltype, "integer") == 0 ||
- 
 
93 
                   strcmp(coltype, "int") == 0) {
 - 
 
94 
            /* caller should just copy off the vars level attr for factors */
 - 
 
95 
            PROTECT(*ret = NEW_INTEGER(idx_or_len));
 - 
 
96 
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
 - 
 
97 
        } else added = 0;
 - 
 
98 
 
 - 
 
99 
        UNPROTECT(1);
 - 
 
100 
    } else {
 - 
 
101 
        const char *coltype = sqlite3_column_decltype(stmt, 0);
 - 
 
102 
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
 - 
 
103 
            added = 0;
 - 
 
104 
        } else if (strcmp(coltype, "text") == 0) {
 - 
 
105 
            SET_STRING_ELT(*ret, idx_or_len,
- 
 
106 
                    mkChar((char *)sqlite3_column_text(stmt, 0)));
 - 
 
107 
        } else if (strcmp(coltype, "double") == 0) {
 - 
 
108 
            REAL(*ret)[idx_or_len] = sqlite3_column_double(stmt, 0);
 - 
 
109 
        } else if (strcmp(coltype, "bit") == 0) {
 - 
 
110 
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
 - 
 
111 
        } else if (strcmp(coltype, "integer") == 0 ||
 - 
 
112 
                   strcmp(coltype, "int") == 0) {
 - 
 
113 
            /* caller should just copy off the vars level attr for factors */
 - 
 
114 
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
 - 
 
115 
        } else added = 0;
 - 
 
116 
    }
 - 
 
117
- 
 
118 
    return added;
 - 
 
119 
}
 - 
 
120 
 
 178 
 
121 
SEXP sdf_get_variable_length(SEXP svec) {
 179 
SEXP sdf_get_variable_length(SEXP svec) {
122 
    char *iname = SDF_INAME(svec);
 180 
    char *iname = SDF_INAME(svec);
123 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
 181 
    if (!USE_SDF1(iname, TRUE)) return R_NilValue;
124 
    sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
 - 
 
125 
 
 182 
 
126 
    SEXP ret;
 183 
    SEXP ret;
127 
    PROTECT(ret = NEW_INTEGER(1));
 184 
    PROTECT(ret = NEW_INTEGER(1));
128 
    INTEGER(ret)[0] = _get_row_count2(g_sql_buf[0]);
 185 
    INTEGER(ret)[0] = _get_row_count2(iname, 1);
129 
    UNPROTECT(1);
 186 
    UNPROTECT(1);
130 
    return ret;
 187 
    return ret;
131 
}
 188 
}
132 
 
 189 
 
133
190
134 
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
 191 
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
135 
    SEXP ret = R_NilValue, tmp;
 192 
    SEXP ret = R_NilValue, tmp;
136 
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
 193 
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
137 
    int index, idxlen, i, retlen=0, res;
 194 
    int index, idxlen, i, retlen=0, res;
138 
 
 - 
 
139 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
 - 
 
140 
 
 - 
 
141 
    /* check if sdf exists */
 - 
 
142 
    sqlite3_stmt *stmt;
 195 
    sqlite3_stmt *stmt;
143 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
 - 
 
144 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 - 
 
145 
    sqlite3_finalize(stmt);
 - 
 
- 
 
 196 
 
146 
    if (_sqlite_error(res)) { return ret; }
 197 
    if (!USE_SDF1(iname, TRUE)) return R_NilValue;
147 
 
 198 
 
148 
    idxlen = LENGTH(idx);
 199 
    idxlen = LENGTH(idx);
149 
    if (idxlen < 1) return ret;
 200 
    if (idxlen < 1) return ret;
150 
 
 201 
 
151 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",
 202 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",
Line 166... Line 217...
166 
        }
217 
        }
167
218
168 
        if (index < 0 || res != SQLITE_ROW) {
 219 
        if (index < 0 || res != SQLITE_ROW) {
169 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
220 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
170 
             * a "dummy" call to setup the SEXP */
 221 
             * a "dummy" call to setup the SEXP */
- 
 
 222 
            sqlite3_reset(stmt);
171 
            sqlite3_bind_int(stmt, 1, 0);
 223 
            sqlite3_bind_int(stmt, 1, 0);
- 
 
 224 
            res = sqlite3_step(stmt);
- 
 
 225 
            if (res == SQLITE_ROW) {
172 
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
 226 
                _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
- 
 
 227 
            }
173 
            retlen = 0;
 228 
            retlen = 0;
174 
        }
 229 
        }
175 
 
 230 
 
- 
 
 231 
 
176 
        if (idxlen > 1) {
 232 
        if (idxlen > 1) {
177 
            for (i = 1; i < idxlen; i++) {
 233 
            for (i = 1; i < idxlen; i++) {
178 
                index = ((int) REAL(idx)[i]) - 1;
 234 
                index = ((int) REAL(idx)[i]) - 1;
179 
                if (index < 0) continue;
 235 
                if (index < 0) continue;
180 
                sqlite3_reset(stmt);
 236 
                sqlite3_reset(stmt);
Line 199... Line 255...
199 
        }
255 
        }
200
256
201 
        if (index < 0 || res != SQLITE_ROW) {
 257 
        if (index < 0 || res != SQLITE_ROW) {
202 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
258 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
203 
             * a "dummy" call to setup the SEXP */
 259 
             * a "dummy" call to setup the SEXP */
- 
 
 260 
            sqlite3_reset(stmt);
204 
            sqlite3_bind_int(stmt, 1, 0);
 261 
            sqlite3_bind_int(stmt, 1, 0);
- 
 
 262 
            res = sqlite3_step(stmt);
- 
 
 263 
            if (res == SQLITE_ROW) {
205 
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
 264 
                _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
- 
 
 265 
            }
206 
            retlen = 0;
 266 
            retlen = 0;
207 
        }
 267 
        }
208 
 
 268 
 
209 
        if (idxlen > 1) {
 269 
        if (idxlen > 1) {
210 
            for (i = 1; i < idxlen; i++) {
 270 
            for (i = 1; i < idxlen; i++) {
Line 217... Line 277...
217 
            }
 277 
            }
218 
        }
 278 
        }
219 
 
 279 
 
220 
    } else if (IS_LOGICAL(idx)) {
 280 
    } else if (IS_LOGICAL(idx)) {
221 
        /* have to deal with recycling */
 281 
        /* have to deal with recycling */
222 
        sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
 - 
 
223 
        int veclen = _get_row_count2(g_sql_buf[0]);
 282 
        int veclen = _get_row_count2(iname, 1);
224 
 
 283 
 
225 
        /* find if there is any TRUE element in the vector */
 284 
        /* find if there is any TRUE element in the vector */
226 
        for (i = 0; i < idxlen && i < veclen; i++) {
 285 
        for (i = 0; i < idxlen && i < veclen; i++) {
227 
            if (LOGICAL(idx)[i]) {
 286 
            if (LOGICAL(idx)[i]) {
228 
                sqlite3_bind_int(stmt, 1, i);
 287 
                sqlite3_bind_int(stmt, 1, i);
Line 271... Line 330...
271 
    }
 330 
    }
272 
 
 331 
 
273 
    return ret;
 332 
    return ret;
274 
}
 333 
}
275 
 
 334 
 
- 
 
 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 
 
276 
/* the global accumulator should be safe if we only do 1 cummulative or
 355 
/* the global accumulator should be safe if we only do 1 cummulative or
277 
 * aggregate at any time. it won't work for stuffs like "select max(col)-min(col)
 356 
 * aggregate at any time. it won't work for stuffs like "select max(col)-min(col)
278 
 * from sdf_data". */
 357 
 * from sdf_data". */
279 
static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */
 358 
static double g_accumulator = 0.0; /* accumulator var for cumsum, cumprod, etc. */
280 
static int g_start = 0;            /* flag for start of cummulation */
 359 
static int g_start = 0;            /* flag for start of cummulation */
Line 289... Line 368...
289 
    funcname = CHAR_ELT(func, 0);
 368 
    funcname = CHAR_ELT(func, 0);
290 
    iname_src = SDF_INAME(vector);
 369 
    iname_src = SDF_INAME(vector);
291 
    varname_src = SVEC_VARNAME(vector);
 370 
    varname_src = SVEC_VARNAME(vector);
292 
    nargs = INTEGER(_nargs)[0];
 371 
    nargs = INTEGER(_nargs)[0];
293 
 
 372 
 
294 
    if (!USE_SDF(iname_src, TRUE)) return R_NilValue;
 373 
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
295 
 
 374 
 
296 
    /* check nargs */
 375 
    /* check nargs */
297 
    if (nargs > 2) {
 376 
    if (nargs > 2) {
298 
        Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");
 377 
        Rprintf("Error: Don't know how to handle Math functions w/ more than 2 args\n");
299 
        return R_NilValue;
 378 
        return R_NilValue;
300 
    }
 379 
    }
301 
 
 380 
 
302 
    /* create a new sdf, with 1 column named V1 */
 381 
    /* create a new sdf, with 1 column named V1 */
303 
    iname = _create_sdf_skeleton2(R_NilValue, &namelen);
 382 
    iname = _create_svector1(R_NilValue, "double", &namelen);
304 
    if (iname == NULL) return R_NilValue;
 - 
 
305 
 
 - 
 
306 
    sprintf(g_sql_buf[0], "create table [%s].sdf_data ([row name] text, "
 - 
 
307 
            "V1 double)", iname);
 - 
 
308 
    res = _sqlite_exec(g_sql_buf[0]);
 - 
 
309 
    _sqlite_error(res);
 - 
 
310 
 
 383 
 
311 
    /* insert into <newsdf>.col, row.names select func(col), rownames */
 384 
    /* insert into <newsdf>.col, row.names select func(col), rownames */
312 
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
 385 
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
313 
            "select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,
 386 
            "select [row name], %s([%s]) from [%s].sdf_data", iname, funcname,
314 
            varname_src, iname_src);
 387 
            varname_src, iname_src);
Line 327... Line 400...
327 
    g_accumulator = 0.0;   /* initialize accumulator */
 400 
    g_accumulator = 0.0;   /* initialize accumulator */
328 
    g_start = 1;           /* flag that we are at start of accumulating */
 401 
    g_start = 1;           /* flag that we are at start of accumulating */
329 
    sqlite3_step(stmt);
 402 
    sqlite3_step(stmt);
330 
    sqlite3_finalize(stmt);
 403 
    sqlite3_finalize(stmt);
331 
 
 404 
 
332 
    /* create sqlite.vector sexp */
 - 
 
333 
    SEXP ret, value; int nprotected = 0;
 405 
    return _create_svector_sexp(iname, "V1", "numeric");
334 
    PROTECT(ret = NEW_LIST(2)); nprotected++;
 - 
 
- 
 
 406 
}
335 
 
 407 
 
336 
    /* set list names */
 - 
 
337 
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
 408 
SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2) {
338 
    SET_STRING_ELT(value, 0, mkChar("iname"));
 409 
    char *iname = NULL, *iname_src, *varname_src, *funcname;
339 
    SET_STRING_ELT(value, 1, mkChar("varname"));
 410 
    int res, functype = -1, op2_len, svec_len, i;
340 
    SET_NAMES(ret, value);
 411 
    sqlite3_stmt *stmt, *stmt2;
341 
 
 412 
 
- 
 
 413 
    /* get data from arguments (function name and sqlite.vector stuffs) */
342 
    /* set list values */
 414 
    funcname = CHAR_ELT(func, 0);
343 
    SET_VECTOR_ELT(ret, 0, mkString(iname));
 415 
    iname_src = SDF_INAME(vector);
344 
    SET_VECTOR_ELT(ret, 1, mkString("V1"));
 416 
    varname_src = SVEC_VARNAME(vector);
345 
 
 417 
 
- 
 
 418 
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
- 
 
 419 
    switch(funcname[0]) {
- 
 
 420 
        case '+' :
- 
 
 421 
        case '-' :
346 
    /* set sexp class */
 422 
        case '*' :
- 
 
 423 
        case '/' :
- 
 
 424 
        case '^' :
- 
 
 425 
        case '%' : /* %% and %/% */
347 
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
 426 
            functype = 0; break;  /* output is REAL */
- 
 
 427 
        case '&' :
- 
 
 428 
        case '|' :
- 
 
 429 
        case '!' :  /* ! and != */
348 
    SET_VECTOR_ELT(value, 0, mkChar("sqlite.vector"));
 430 
            if (funcname[1] == 0) { functype = 1; break; }
- 
 
 431 
        case '=' :  /* == */
- 
 
 432 
        case '<' :  /* < and <= */
349 
    SET_VECTOR_ELT(value, 1, mkChar("numeric"));
 433 
        case '>' :  /* > and >= */
350 
    SET_CLASS(ret, value);
 434 
            functype = 2;
- 
 
 435 
    }
351 
 
 436 
 
- 
 
 437 
    svec_len = _get_row_count2(iname_src, 1);
- 
 
 438 
    if (functype == 0 || functype == 2 || (functype == 1 && funcname[0] != '!')) {
- 
 
 439 
        char *insert_fmt_string1c, *insert_fmt_string1s;
- 
 
 440 
        char *insert_fmt_string2c, *insert_fmt_string2s;
- 
 
 441 
        iname = _create_svector1(R_NilValue, (functype == 0) ? "double" : "bit", NULL);
- 
 
 442 
 
- 
 
 443 
        if (functype == 1) { /* boolean binary operators */
- 
 
 444 
            insert_fmt_string1s = "insert into [%s].sdf_data "
- 
 
 445 
                        "select [row name], ([%s] != 0) %s (? != 0) from [%s].sdf_data";
- 
 
 446 
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, (? != 0) %s (? != 0))";
- 
 
 447 
            /* no need for char version of fmt_string2, since %% only occurs for functype==0 */
- 
 
 448 
            insert_fmt_string1c = insert_fmt_string1s;
- 
 
 449 
            insert_fmt_string2c = insert_fmt_string2s;
352 
    UNPROTECT(nprotected);
 450 
        } else {
- 
 
 451 
            insert_fmt_string1s = "insert into [%s].sdf_data "
- 
 
 452 
                        "select [row name], [%s] %s ? from [%s].sdf_data";
- 
 
 453 
            insert_fmt_string1c = "insert into [%s].sdf_data "
- 
 
 454 
                        "select [row name], [%s] %c ? from [%s].sdf_data";
- 
 
 455 
            /* fmt_string2c format operator from a char, used for %% and %/% */
- 
 
 456 
            /* BUG: i'm casting to int before applying / & %, w/c is different
- 
 
 457 
             * from R. added trunc to pass package test */
- 
 
 458 
            insert_fmt_string2c = "insert into [%s].sdf_data values(?, trunc(? %c ?))";
- 
 
 459 
            insert_fmt_string2s = "insert into [%s].sdf_data values(?, ? %s ?)";
- 
 
 460 
        }
353 
 
 461 
 
- 
 
 462 
 
- 
 
 463 
        if (IS_NUMERIC(op2)) {
- 
 
 464 
            op2_len = LENGTH(op2);
- 
 
 465 
 
- 
 
 466 
            if (op2_len == 1) {
- 
 
 467 
                if (funcname[0] == '%') {
- 
 
 468 
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname,
- 
 
 469 
                            varname_src, funcname[1], iname_src);
- 
 
 470 
                } else {
- 
 
 471 
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
- 
 
 472 
                            varname_src, funcname, iname_src);
- 
 
 473 
                }
- 
 
 474 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 475 
                _sqlite_error(res);
- 
 
 476 
                sqlite3_bind_double(stmt, 1, REAL(op2)[0]);
- 
 
 477 
                sqlite3_step(stmt);
- 
 
 478 
            } else if (op2_len <= svec_len) {  /* recycle op2 */
- 
 
 479 
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
- 
 
 480 
                        varname_src, iname_src);
- 
 
 481 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
- 
 
 482 
                _sqlite_error(res);
- 
 
 483 
 
- 
 
 484 
                if (funcname[0] == '%') {
- 
 
 485 
                    /* sqlite does int div with "/" if both args are int. mod is % also.
- 
 
 486 
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
- 
 
 487 
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
- 
 
 488 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 489 
                    _sqlite_error(res);
- 
 
 490 
 
- 
 
 491 
                    for (i = 0; i < svec_len; i++) {
- 
 
 492 
                        sqlite3_step(stmt2);
- 
 
 493 
 
- 
 
 494 
                        sqlite3_reset(stmt);
- 
 
 495 
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
- 
 
 496 
                        sqlite3_bind_int(stmt, 2, (int)sqlite3_column_double(stmt2, 1));
- 
 
 497 
                        sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
- 
 
 498 
                        sqlite3_step(stmt);
- 
 
 499 
                    }
- 
 
 500 
                } else { /* non-integer binary operation */
- 
 
 501 
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
- 
 
 502 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 503 
                    _sqlite_error(res);
- 
 
 504 
 
- 
 
 505 
                    for (i = 0; i < svec_len; i++) {
- 
 
 506 
                        sqlite3_step(stmt2);
- 
 
 507 
 
- 
 
 508 
                        sqlite3_reset(stmt);
- 
 
 509 
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
- 
 
 510 
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
- 
 
 511 
                        sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
- 
 
 512 
                        sqlite3_step(stmt);
- 
 
 513 
                    }
- 
 
 514 
                }
- 
 
 515 
                sqlite3_finalize(stmt2);
- 
 
 516 
            } else { /* op2_len > svec_len, recycle svec */
- 
 
 517 
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
- 
 
 518 
                        varname_src, iname_src);
- 
 
 519 
 
- 
 
 520 
                if (funcname[0] == '%') {
- 
 
 521 
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
- 
 
 522 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 523 
                    _sqlite_error(res);
- 
 
 524 
                } else {
- 
 
 525 
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
- 
 
 526 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 527 
                    _sqlite_error(res);
- 
 
 528 
                }
- 
 
 529
- 
 
 530 
                i = 0;
- 
 
 531 
                while (i < op2_len) {
- 
 
 532 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
- 
 
 533 
                    _sqlite_error(res);
- 
 
 534 
 
- 
 
 535 
                    if (funcname[0] == '%') {
- 
 
 536 
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
- 
 
 537 
                            sqlite3_step(stmt2);
- 
 
 538 
 
- 
 
 539 
                            sqlite3_reset(stmt);
- 
 
 540 
                            /* simplify my life, just use ints for row names so that we
- 
 
 541 
                             * don't have to worry about duplicates */
- 
 
 542 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 543 
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
- 
 
 544 
                            sqlite3_bind_int(stmt, 3, (int)REAL(op2)[i % op2_len]);
- 
 
 545 
                            sqlite3_step(stmt);
- 
 
 546 
                        }
- 
 
 547 
                    } else {
- 
 
 548 
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
- 
 
 549 
                            sqlite3_step(stmt2);
- 
 
 550 
 
- 
 
 551 
                            sqlite3_reset(stmt);
- 
 
 552 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 553 
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
- 
 
 554 
                            sqlite3_bind_double(stmt, 3, REAL(op2)[i % op2_len]);
- 
 
 555 
                            sqlite3_step(stmt);
- 
 
 556 
                        }
- 
 
 557 
                    }
- 
 
 558 
 
- 
 
 559 
                    /* recycle on svec if we loop again */
- 
 
 560 
                    sqlite3_finalize(stmt2);
- 
 
 561 
                }
- 
 
 562 
            }
- 
 
 563 
 
- 
 
 564 
            sqlite3_finalize(stmt);
- 
 
 565 
        } else if (IS_INTEGER(op2) || IS_LOGICAL(op2)) { /* I N T E G E R */
- 
 
 566 
            /* we are taking advantage of the fact that logicals are stored as int.
- 
 
 567 
             * if this becomes untrue in the future, then this is a bug */
- 
 
 568 
            op2_len = LENGTH(op2);
- 
 
 569 
 
- 
 
 570 
            if (op2_len == 1) {
- 
 
 571 
                if (funcname[0] == '%') {
- 
 
 572 
                    sprintf(g_sql_buf[2], insert_fmt_string1c, iname,
- 
 
 573 
                            varname_src, funcname[1], iname_src);
- 
 
 574 
                } else {
- 
 
 575 
                    sprintf(g_sql_buf[2], insert_fmt_string1s, iname,
- 
 
 576 
                            varname_src, funcname, iname_src);
- 
 
 577 
                }
- 
 
 578 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 579 
                _sqlite_error(res);
- 
 
 580 
                sqlite3_bind_double(stmt, 1, (double)INTEGER(op2)[0]);
- 
 
 581 
                sqlite3_step(stmt);
- 
 
 582 
            } else if (op2_len <= svec_len) {
- 
 
 583 
                sprintf(g_sql_buf[2], "select [row name], [%s] from [%s].sdf_data",
- 
 
 584 
                        varname_src, iname_src);
- 
 
 585 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
- 
 
 586 
                _sqlite_error(res);
- 
 
 587 
 
- 
 
 588 
                if (funcname[0] == '%') {
- 
 
 589 
                    /* sqlite does int div with "/" if both args are int. mod is % also.
- 
 
 590 
                     * fortunately, in both cases the sqlite op is 2nd char of funcname */
- 
 
 591 
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
- 
 
 592 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 593 
                    _sqlite_error(res);
- 
 
 594 
 
- 
 
 595 
                    for (i = 0; i < svec_len; i++) {
- 
 
 596 
                        sqlite3_step(stmt2);
- 
 
 597 
 
- 
 
 598 
                        sqlite3_reset(stmt);
- 
 
 599 
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
- 
 
 600 
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
- 
 
 601 
                        sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
- 
 
 602 
                        sqlite3_step(stmt);
- 
 
 603 
                    }
- 
 
 604 
                } else {
- 
 
 605 
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
- 
 
 606 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 607 
                    _sqlite_error(res);
- 
 
 608 
 
- 
 
 609 
                    for (i = 0; i < svec_len; i++) {
- 
 
 610 
                        sqlite3_step(stmt2);
- 
 
 611 
 
- 
 
 612 
                        sqlite3_reset(stmt);
- 
 
 613 
                        sqlite3_bind_text(stmt, 1, (char *)sqlite3_column_text(stmt2, 0), -1, SQLITE_STATIC);
- 
 
 614 
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
- 
 
 615 
                        sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
- 
 
 616 
                        sqlite3_step(stmt);
- 
 
 617 
                    }
- 
 
 618 
                }
- 
 
 619 
                sqlite3_finalize(stmt2);
- 
 
 620 
            } else {
- 
 
 621 
                sprintf(g_sql_buf[1], "select [%s] from [%s].sdf_data",
- 
 
 622 
                        varname_src, iname_src);
- 
 
 623 
 
- 
 
 624 
                if (funcname[0] == '%') {
- 
 
 625 
                    sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
- 
 
 626 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 627 
                    _sqlite_error(res);
- 
 
 628 
                } else {
- 
 
 629 
                    sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
- 
 
 630 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 631 
                    _sqlite_error(res);
- 
 
 632 
                }
- 
 
 633
- 
 
 634 
                i = 0;
- 
 
 635 
                while (i < op2_len) {
- 
 
 636 
                    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
- 
 
 637 
                    _sqlite_error(res);
- 
 
 638 
 
- 
 
 639 
                    if (funcname[0] == '%') {
- 
 
 640 
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
- 
 
 641 
                            sqlite3_step(stmt2);
- 
 
 642 
 
- 
 
 643 
                            sqlite3_reset(stmt);
- 
 
 644 
                            /* simplify my life, just use ints for row names so that we
- 
 
 645 
                             * don't have to worry about duplicates */
- 
 
 646 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 647 
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 1));
- 
 
 648 
                            sqlite3_bind_int(stmt, 3, INTEGER(op2)[i % op2_len]);
- 
 
 649 
                            sqlite3_step(stmt);
- 
 
 650 
                        }
- 
 
 651 
                    } else {
- 
 
 652 
                        for ( ; i < op2_len && sqlite3_step(stmt) == SQLITE_ROW ; i++) {
- 
 
 653 
                            sqlite3_step(stmt2);
- 
 
 654 
 
- 
 
 655 
                            sqlite3_reset(stmt);
- 
 
 656 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 657 
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 1));
- 
 
 658 
                            sqlite3_bind_double(stmt, 3, (double)INTEGER(op2)[i % op2_len]);
- 
 
 659 
                            sqlite3_step(stmt);
- 
 
 660 
                        }
- 
 
 661 
                    }
- 
 
 662 
 
- 
 
 663 
                    /* recycle on svec if we loop again */
- 
 
 664 
                    sqlite3_finalize(stmt2);
- 
 
 665 
                }
- 
 
 666 
            }
- 
 
 667 
 
- 
 
 668 
            sqlite3_finalize(stmt);
- 
 
 669 
        } else if (inherits(op2, "sqlite.vector")) {
- 
 
 670 
            /* op2 is surely not a factor, as handled by the R wrapper */
- 
 
 671 
            char *iname_op2, *varname_op2;
- 
 
 672 
            sqlite3_stmt *stmt3;
- 
 
 673 
            iname_op2 = SDF_INAME(op2);
- 
 
 674 
            varname_op2 = SVEC_VARNAME(op2);
- 
 
 675 
 
- 
 
 676 
            if (!USE_SDF1(iname_op2, TRUE)) {
- 
 
 677 
                /* delete created sqlite.vector */
- 
 
 678 
                Rprintf("Warning: detaching created result SDF %s\n", iname);
- 
 
 679 
                sdf_detach_sdf(mkString(iname));
- 
 
 680 
                return R_NilValue;
- 
 
 681 
            }
- 
 
 682 
 
- 
 
 683 
            op2_len = _get_row_count2(iname_op2, 1);
- 
 
 684
- 
 
 685 
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_src, iname_src);
- 
 
 686 
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, 0);
- 
 
 687 
            _sqlite_error(res);
- 
 
 688 
 
- 
 
 689 
            sprintf(g_sql_buf[2], "select [%s] from [%s].sdf_data", varname_op2, iname_op2);
- 
 
 690 
            res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt3, 0);
- 
 
 691 
            _sqlite_error(res);
- 
 
 692 
 
- 
 
 693 
            if (funcname[0] == '%') {
- 
 
 694 
                sprintf(g_sql_buf[2], insert_fmt_string2c, iname, funcname[1]);
- 
 
 695 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 696 
                _sqlite_error(res);
- 
 
 697 
 
- 
 
 698 
                if (svec_len == op2_len) {
- 
 
 699 
                    for (i = 0; i < svec_len; i++) {
- 
 
 700 
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
- 
 
 701 
 
- 
 
 702 
                        sqlite3_reset(stmt);
- 
 
 703 
                        sqlite3_bind_int(stmt, 1, i);
- 
 
 704 
                        sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
- 
 
 705 
                        sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
- 
 
 706 
                        sqlite3_step(stmt);
- 
 
 707 
                    }
- 
 
 708 
                } else if (svec_len < op2_len) {
- 
 
 709 
                    i = 0;
- 
 
 710 
                    while (i < op2_len) {
- 
 
 711 
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
- 
 
 712 
                            sqlite3_step(stmt3);
- 
 
 713 
 
- 
 
 714 
                            sqlite3_reset(stmt);
- 
 
 715 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 716 
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
- 
 
 717 
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
- 
 
 718 
                            sqlite3_step(stmt);
- 
 
 719 
                        }
- 
 
 720 
                        sqlite3_reset(stmt2);
- 
 
 721 
                    }
- 
 
 722 
                } else {
- 
 
 723 
                    i = 0;
- 
 
 724 
                    while (i < svec_len) {
- 
 
 725 
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
- 
 
 726 
                            sqlite3_step(stmt2);
- 
 
 727 
 
- 
 
 728 
                            sqlite3_reset(stmt);
- 
 
 729 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 730 
                            sqlite3_bind_int(stmt, 2, sqlite3_column_int(stmt2, 0));
- 
 
 731 
                            sqlite3_bind_int(stmt, 3, sqlite3_column_int(stmt3, 0));
- 
 
 732 
                            sqlite3_step(stmt);
- 
 
 733 
                        }
- 
 
 734 
                        sqlite3_reset(stmt3);
- 
 
 735 
                    }
- 
 
 736 
                }
- 
 
 737 
            } else { /* not an integer op %% or %/% */
- 
 
 738 
                sprintf(g_sql_buf[2], insert_fmt_string2s, iname, funcname);
- 
 
 739 
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 740 
                _sqlite_error(res);
- 
 
 741 
 
- 
 
 742 
                if (svec_len == op2_len) {
- 
 
 743 
                    for (i = 0; i < svec_len; i++) {
- 
 
 744 
                        sqlite3_step(stmt2); sqlite3_step(stmt3);
- 
 
 745 
 
- 
 
 746 
                        sqlite3_reset(stmt);
- 
 
 747 
                        sqlite3_bind_int(stmt, 1, i);
- 
 
 748 
                        sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
- 
 
 749 
                        sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
- 
 
 750 
                        sqlite3_step(stmt);
- 
 
 751 
                    }
- 
 
 752 
                } else if (svec_len < op2_len) { /* recycle svec */
- 
 
 753 
                    i = 0;
- 
 
 754 
                    while (i < op2_len) {
- 
 
 755 
                        for ( ; sqlite3_step(stmt2) == SQLITE_ROW && i < op2_len; i++) {
- 
 
 756 
                            sqlite3_step(stmt3);
- 
 
 757 
 
- 
 
 758 
                            sqlite3_reset(stmt);
- 
 
 759 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 760 
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
- 
 
 761 
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
- 
 
 762 
                            sqlite3_step(stmt);
- 
 
 763 
                        }
- 
 
 764 
                        sqlite3_reset(stmt2);
- 
 
 765 
                    }
- 
 
 766 
                } else { /* svec_len > op2_len, recycle op2 */
- 
 
 767 
                    i = 0;
- 
 
 768 
                    while (i < svec_len) {
- 
 
 769 
                        for ( ; sqlite3_step(stmt3) == SQLITE_ROW && i < svec_len; i++) {
- 
 
 770 
                            sqlite3_step(stmt2);
- 
 
 771 
 
- 
 
 772 
                            sqlite3_reset(stmt);
- 
 
 773 
                            sqlite3_bind_int(stmt, 1, i);
- 
 
 774 
                            sqlite3_bind_double(stmt, 2, sqlite3_column_double(stmt2, 0));
- 
 
 775 
                            sqlite3_bind_double(stmt, 3, sqlite3_column_double(stmt3, 0));
- 
 
 776 
                            sqlite3_step(stmt);
- 
 
 777 
                        }
- 
 
 778 
                        sqlite3_reset(stmt3);
- 
 
 779 
                    }
- 
 
 780 
                }
- 
 
 781 
            }
- 
 
 782 
 
- 
 
 783 
            sqlite3_finalize(stmt);
- 
 
 784 
            sqlite3_finalize(stmt2);
- 
 
 785 
            sqlite3_finalize(stmt3);
- 
 
 786 
        }
- 
 
 787 
    } else if (functype == 1 && funcname[0] != '!') { /* unary not operator */
- 
 
 788 
        iname = _create_svector1(R_NilValue, "bit", NULL);
- 
 
 789 
        sprintf(g_sql_buf[2], "insert into [%s].sdf_data "
- 
 
 790 
                    "select [row name], [%s] == 0 from [%s].sdf_data",
- 
 
 791 
                    iname, varname_src, iname_src);
- 
 
 792 
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
- 
 
 793 
        _sqlite_error(res);
- 
 
 794 
        sqlite3_step(stmt);
- 
 
 795 
        sqlite3_finalize(stmt);
- 
 
 796 
    }
- 
 
 797 
 
- 
 
 798 
    if (iname != NULL)
- 
 
 799 
        return _create_svector_sexp(iname, "V1",
- 
 
 800 
                (functype == 0) ? "numeric" : "logical");
- 
 
 801 
 
354 
    return ret;
 802 
    return R_NilValue;
355 
 
 803 
 
356 
}
 804 
}
357 
 
 805 
 
358 
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
 806 
SEXP sdf_do_variable_summary(SEXP func, SEXP vector, SEXP na_rm) {
359 
    char *iname_src, *varname_src, *funcname;
 807 
    char *iname_src, *varname_src, *funcname;
Line 364... Line 812...
364 
    /* get data from arguments (function name and sqlite.vector stuffs) */
 812 
    /* get data from arguments (function name and sqlite.vector stuffs) */
365 
    funcname = CHAR_ELT(func, 0);
 813 
    funcname = CHAR_ELT(func, 0);
366 
    iname_src = SDF_INAME(vector);
 814 
    iname_src = SDF_INAME(vector);
367 
    varname_src = SVEC_VARNAME(vector);
 815 
    varname_src = SVEC_VARNAME(vector);
368 
 
 816 
 
369 
    if (!USE_SDF(iname_src, TRUE)) return R_NilValue;
 817 
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
370 
 
 818 
 
371 
    g_narm = LOGICAL(na_rm)[0];
 819 
    g_narm = LOGICAL(na_rm)[0];
372 
    if (strcmp(funcname, "range") == 0) {
 820 
    if (strcmp(funcname, "range") == 0) {
373 
        /* special handling for range. use min then max */
 821 
        /* special handling for range. use min then max */
374 
        g_start = 1;
 822 
        g_start = 1;
Line 418... Line 866...
418 
    UNPROTECT(1);
 866 
    UNPROTECT(1);
419 
    return ret;
 867 
    return ret;
420 
}
 868 
}
421 
 
 869 
 
422 
 
 870 
 
- 
 
 871 
SEXP sdf_sort_variable(SEXP svec, SEXP decreasing) {
- 
 
 872 
    char *iname, *iname_src, *varname_src, *type;
- 
 
 873 
    sqlite3_stmt *stmt;
- 
 
 874 
    int res;
- 
 
 875 
 
- 
 
 876 
    iname_src = SDF_INAME(svec);
- 
 
 877 
    varname_src = SVEC_VARNAME(svec);
- 
 
 878 
 
- 
 
 879 
    if (!USE_SDF1(iname_src, TRUE)) return R_NilValue;
- 
 
 880 
 
- 
 
 881 
    /* determine type of svec */
- 
 
 882 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit 1", varname_src, iname_src);
- 
 
 883 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
- 
 
 884 
    _sqlite_error(res);
- 
 
 885 
    sqlite3_step(stmt);
- 
 
 886 
    strcpy(g_sql_buf[0], sqlite3_column_decltype(stmt, 0));
- 
 
 887 
    sqlite3_finalize(stmt);
- 
 
 888 
 
- 
 
 889 
    /* create a new vector of that type */
- 
 
 890 
    iname = _create_svector1(R_NilValue, g_sql_buf[0], NULL);
- 
 
 891 
 
- 
 
 892 
    /* insert to new sdf ordered */
- 
 
 893 
    sprintf(g_sql_buf[0], "insert into [%s].sdf_data "
- 
 
 894 
            "select [row name], [%s] from [%s].sdf_data "
- 
 
 895 
            "order by [%s] %s", iname, varname_src, iname_src, varname_src,
- 
 
 896 
            (LOGICAL(decreasing)[0]) ? "desc" : "asc");
- 
 
 897 
    res = _sqlite_exec(g_sql_buf[0]);
- 
 
 898 
    _sqlite_error(res);
- 
 
 899 
 
- 
 
 900 
    if (inherits(svec, "factor")) { /* copy factor table to iname */
- 
 
 901 
        if (inherits(svec, "ordered")) type = "ordered";
- 
 
 902 
        else type = "factor";
- 
 
 903 
        _copy_factor_levels2(type, iname_src, varname_src, iname, "V1");
- 
 
 904 
    } else type = CHAR_ELT(GET_CLASS(svec), 1);
- 
 
 905 
 
- 
 
 906 
    return _create_svector_sexp(iname, "V1", type);
- 
 
 907 
}
- 
 
 908 
 
423 
/****************************************************************************
 909 
/****************************************************************************
424 
 * VECTOR MATH/OPS/GROUP OPERATIONS
 910 
 * VECTOR MATH/OPS/GROUP OPERATIONS
425 
 ****************************************************************************/
 911 
 ****************************************************************************/
426 
 
 912 
 
427 
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {
 913 
int __vecmath_checkarg(sqlite3_context *ctx, sqlite3_value *arg, double *value) {