The R Project SVN R-packages

Rev

Rev 3324 | Rev 3397 | Go to most recent revision | Only display areas with differences | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3324 Rev 3358
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
 
20
    int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
124
    int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
21
 
125
 
22
    if (_sqlite_error(res)) return R_NilValue;
126
    if (_sqlite_error(res)) return R_NilValue;
23
 
127
 
24
    const char *coltype = sqlite3_column_decltype(stmt, 0);
128
    const char *coltype = sqlite3_column_decltype(stmt, 0);
25
    sqlite3_finalize(stmt);
129
    sqlite3_finalize(stmt);
26
 
130
 
27
 
131
 
28
    SEXP ret, value, class = R_NilValue; int nprotected = 0;
132
    SEXP ret, value, class = R_NilValue; int nprotected = 0;
29
    PROTECT(ret = NEW_LIST(2)); nprotected++;
133
    PROTECT(ret = NEW_LIST(2)); nprotected++;
30
 
134
 
31
    /* set list names */
135
    /* set list names */
32
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
136
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
33
    SET_STRING_ELT(value, 0, mkChar("iname"));
137
    SET_STRING_ELT(value, 0, mkChar("iname"));
34
    SET_STRING_ELT(value, 1, mkChar("varname"));
138
    SET_STRING_ELT(value, 1, mkChar("varname"));
35
    SET_NAMES(ret, value);
139
    SET_NAMES(ret, value);
36
 
140
 
37
    /* set list values */
141
    /* set list values */
38
    SET_VECTOR_ELT(ret, 0, mkString(iname));
142
    SET_VECTOR_ELT(ret, 0, mkString(iname));
39
    SET_VECTOR_ELT(ret, 1, mkString(varname));
143
    SET_VECTOR_ELT(ret, 1, mkString(varname));
40
 
144
 
41
    /* set class */
145
    /* set class */
42
    int type = -1;
146
    int type = -1;
43
    if (strcmp(coltype, "text") == 0) class = mkChar("character");
147
    if (strcmp(coltype, "text") == 0) class = mkChar("character");
44
    else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");
148
    else if (strcmp(coltype, "double") == 0) class = mkChar("numeric");
45
    else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");
149
    else if (strcmp(coltype, "bit") == 0) class = mkChar("logical");
46
    else if (strcmp(coltype, "integer") == 0 || strcmp(coltype, "int") == 0) {
150
    else if (strcmp(coltype, "integer") == 0 || strcmp(coltype, "int") == 0) {
47
        /* determine if int, factor or ordered */
151
        /* determine if int, factor or ordered */
48
        type = _get_factor_levels1(iname, varname, ret);
152
        type = _get_factor_levels1(iname, varname, ret);
49
        switch(type) {
153
        switch(type) {
50
            case VAR_INTEGER: class = mkChar("integer"); break;
154
            case VAR_INTEGER: class = mkChar("integer"); break;
51
            case VAR_FACTOR: class = mkChar("factor"); break;
155
            case VAR_FACTOR: class = mkChar("factor"); break;
52
            case VAR_ORDERED: class = mkChar("ordered");
156
            case VAR_ORDERED: class = mkChar("ordered");
53
        }
157
        }
54
 
158
 
55
    }
159
    }
56
 
160
 
57
    if (type != VAR_ORDERED) {
161
    if (type != VAR_ORDERED) {
58
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
162
        PROTECT(value = NEW_CHARACTER(2)); nprotected++;
59
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
163
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
60
        SET_STRING_ELT(value, 1, class);
164
        SET_STRING_ELT(value, 1, class);
61
    } else {
165
    } else {
62
        PROTECT(value = NEW_CHARACTER(3)); nprotected++;
166
        PROTECT(value = NEW_CHARACTER(3)); nprotected++;
63
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
167
        SET_STRING_ELT(value, 0, mkChar("sqlite.vector"));
64
        SET_STRING_ELT(value, 1, class);
168
        SET_STRING_ELT(value, 1, class);
65
        SET_STRING_ELT(value, 2, mkChar("factor"));
169
        SET_STRING_ELT(value, 2, mkChar("factor"));
66
    }
170
    }
67
    SET_CLASS(ret, value);
171
    SET_CLASS(ret, value);
68
 
172
 
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",
152
            varname, iname);
203
            varname, iname);
153
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
204
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
154
 
205
 
155
    /* get data based on index */
206
    /* get data based on index */
156
    if (IS_NUMERIC(idx)) {
207
    if (IS_NUMERIC(idx)) {
157
        index = ((int) REAL(idx)[0]) - 1;
208
        index = ((int) REAL(idx)[0]) - 1;
158
        if (index < 0 && idxlen == 1) return ret;
209
        if (index < 0 && idxlen == 1) return ret;
159
 
210
 
160
        if (index >= 0) {
211
        if (index >= 0) {
161
            sqlite3_bind_int(stmt, 1, index);
212
            sqlite3_bind_int(stmt, 1, index);
162
            res = sqlite3_step(stmt);
213
            res = sqlite3_step(stmt);
163
            if (res == SQLITE_ROW) { 
214
            if (res == SQLITE_ROW) { 
164
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
215
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
165
            } 
216
            } 
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);
181
                sqlite3_bind_int(stmt, 1, index);
237
                sqlite3_bind_int(stmt, 1, index);
182
                res = sqlite3_step(stmt);
238
                res = sqlite3_step(stmt);
183
                if (res == SQLITE_ROW)
239
                if (res == SQLITE_ROW)
184
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
240
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
185
            }
241
            }
186
        }
242
        }
187
    } else if (IS_INTEGER(idx)) {
243
    } else if (IS_INTEGER(idx)) {
188
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
244
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
189
         * to cast idx to int. can't refactor this out, sucks. */
245
         * to cast idx to int. can't refactor this out, sucks. */
190
        index = INTEGER(idx)[0] - 1;
246
        index = INTEGER(idx)[0] - 1;
191
        if (index < 0 && idxlen == 1) return ret;
247
        if (index < 0 && idxlen == 1) return ret;
192
 
248
 
193
        if (index >= 0) {
249
        if (index >= 0) {
194
            sqlite3_bind_int(stmt, 1, index);
250
            sqlite3_bind_int(stmt, 1, index);
195
            res = sqlite3_step(stmt);
251
            res = sqlite3_step(stmt);
196
            if (res == SQLITE_ROW) { 
252
            if (res == SQLITE_ROW) { 
197
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
253
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
198
            } 
254
            } 
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++) {
211
                index = INTEGER(idx)[i] - 1;
271
                index = INTEGER(idx)[i] - 1;
212
                if (index < 0) continue;
272
                if (index < 0) continue;
213
                sqlite3_reset(stmt);
273
                sqlite3_reset(stmt);
214
                sqlite3_bind_int(stmt, 1, index);
274
                sqlite3_bind_int(stmt, 1, index);
215
                sqlite3_step(stmt);
275
                sqlite3_step(stmt);
216
                retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
276
                retlen += _get_vector_index_typed_result(stmt, &ret, retlen); 
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);
229
                sqlite3_step(stmt);
288
                sqlite3_step(stmt);
230
                /* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
289
                /* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
231
                 * index. there are at least (veclen/idxlen) cycles (int div).
290
                 * index. there are at least (veclen/idxlen) cycles (int div).
232
                 * at the last cycle, if (veclen%idxlen > 0), there will be
291
                 * at the last cycle, if (veclen%idxlen > 0), there will be
233
                 * at least (veclen%idxlen - i) if veclen%idxlen > i */
292
                 * at least (veclen%idxlen - i) if veclen%idxlen > i */
234
                retlen = (idxlen-i) * (veclen/idxlen);
293
                retlen = (idxlen-i) * (veclen/idxlen);
235
                if (veclen%idxlen > i) retlen += (veclen%idxlen - i);
294
                if (veclen%idxlen > i) retlen += (veclen%idxlen - i);
236
 
295
 
237
                /* create the vector */
296
                /* create the vector */
238
                retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
297
                retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
239
                break;
298
                break;
240
            }
299
            }
241
        }
300
        }
242
 
301
 
243
        if (i < idxlen && i < veclen) {
302
        if (i < idxlen && i < veclen) {
244
            for (i++; i < veclen; i++) {
303
            for (i++; i < veclen; i++) {
245
                if (LOGICAL(idx)[i%idxlen]) {
304
                if (LOGICAL(idx)[i%idxlen]) {
246
                    sqlite3_reset(stmt);
305
                    sqlite3_reset(stmt);
247
                    sqlite3_bind_int(stmt, 1, i);
306
                    sqlite3_bind_int(stmt, 1, i);
248
                    sqlite3_step(stmt);
307
                    sqlite3_step(stmt);
249
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
308
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
250
                }
309
                }
251
            }
310
            }
252
        }
311
        }
253
    }
312
    }
254
 
313
 
255
    sqlite3_finalize(stmt);
314
    sqlite3_finalize(stmt);
256
 
315
 
257
    if (ret != R_NilValue) {
316
    if (ret != R_NilValue) {
258
        ret = _shrink_vector(ret, retlen);
317
        ret = _shrink_vector(ret, retlen);
259
        tmp = GET_LEVELS(svec);
318
        tmp = GET_LEVELS(svec);
260
        if (tmp != R_NilValue) {
319
        if (tmp != R_NilValue) {
261
            SET_LEVELS(ret, duplicate(tmp));
320
            SET_LEVELS(ret, duplicate(tmp));
262
            if (LENGTH(GET_CLASS(svec)) == 2) {
321
            if (LENGTH(GET_CLASS(svec)) == 2) {
263
                SET_CLASS(ret, mkString("factor"));
322
                SET_CLASS(ret, mkString("factor"));
264
            } else {
323
            } else {
265
                PROTECT(tmp = NEW_CHARACTER(2));
324
                PROTECT(tmp = NEW_CHARACTER(2));
266
                SET_STRING_ELT(tmp, 0, mkChar("ordered"));
325
                SET_STRING_ELT(tmp, 0, mkChar("ordered"));
267
                SET_STRING_ELT(tmp, 1, mkChar("factor"));
326
                SET_STRING_ELT(tmp, 1, mkChar("factor"));
268
                UNPROTECT(1);
327
                UNPROTECT(1);
269
            }
328
            }
270
        }
329
        }
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 */
281
static int g_narm = 0;             /* for Summary group */
360
static int g_narm = 0;             /* for Summary group */
282
 
361
 
283
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {
362
SEXP sdf_do_variable_math(SEXP func, SEXP vector, SEXP extra_args, SEXP _nargs) {
284
    char *iname, *iname_src, *varname_src, *funcname;
363
    char *iname, *iname_src, *varname_src, *funcname;
285
    int namelen, res, nargs;
364
    int namelen, res, nargs;
286
    sqlite3_stmt *stmt;
365
    sqlite3_stmt *stmt;
287
 
366
 
288
    /* get data from arguments (function name and sqlite.vector stuffs) */
367
    /* get data from arguments (function name and sqlite.vector stuffs) */
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);
315
 
388
 
316
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
389
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0); 
317
    if (_sqlite_error(res)) {
390
    if (_sqlite_error(res)) {
318
        sprintf(g_sql_buf[0], "detach %s", iname);
391
        sprintf(g_sql_buf[0], "detach %s", iname);
319
        _sqlite_exec(g_sql_buf[0]);
392
        _sqlite_exec(g_sql_buf[0]);
320
 
393
 
321
        /* we will return a string with the file name, and do file.remove
394
        /* we will return a string with the file name, and do file.remove
322
         * at R */
395
         * at R */
323
        iname[namelen] = '.';
396
        iname[namelen] = '.';
324
        return mkString(iname);
397
        return mkString(iname);
325
    }
398
    }
326
 
399
 
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;
360
    int res;
808
    int res;
361
    sqlite3_stmt *stmt;
809
    sqlite3_stmt *stmt;
362
    double _ret = NA_REAL; SEXP ret;
810
    double _ret = NA_REAL; SEXP ret;
363
 
811
 
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;
375
        g_accumulator = 0.0;
823
        g_accumulator = 0.0;
376
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
824
        sprintf(g_sql_buf[0], "select min_df([%s]) from [%s].sdf_data", varname_src, iname_src);
377
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
825
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
378
        if (_sqlite_error(res)) return R_NilValue;
826
        if (_sqlite_error(res)) return R_NilValue;
379
        sqlite3_step(stmt); sqlite3_finalize(stmt);
827
        sqlite3_step(stmt); sqlite3_finalize(stmt);
380
        _ret = g_accumulator;
828
        _ret = g_accumulator;
381
 
829
 
382
        if (R_IsNA(_ret) && !g_narm) {
830
        if (R_IsNA(_ret) && !g_narm) {
383
            PROTECT(ret = NEW_NUMERIC(2));
831
            PROTECT(ret = NEW_NUMERIC(2));
384
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
832
            REAL(ret)[0] = REAL(ret)[1] = R_NaReal;
385
            goto __sdf_do_variable_summary_out;
833
            goto __sdf_do_variable_summary_out;
386
        }
834
        }
387
        
835
        
388
        g_start = 1;
836
        g_start = 1;
389
        g_accumulator = 0.0;
837
        g_accumulator = 0.0;
390
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
838
        sprintf(g_sql_buf[0], "select max_df([%s]) from [%s].sdf_data", varname_src, iname_src);
391
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
839
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
392
        if (_sqlite_error(res)) return R_NilValue;
840
        if (_sqlite_error(res)) return R_NilValue;
393
        sqlite3_step(stmt); sqlite3_finalize(stmt);
841
        sqlite3_step(stmt); sqlite3_finalize(stmt);
394
 
842
 
395
        /* if there is NA, then the if above should have caught it already */
843
        /* if there is NA, then the if above should have caught it already */
396
        PROTECT(ret = NEW_NUMERIC(2));
844
        PROTECT(ret = NEW_NUMERIC(2));
397
        REAL(ret)[0] = _ret;
845
        REAL(ret)[0] = _ret;
398
        REAL(ret)[1] = g_accumulator;
846
        REAL(ret)[1] = g_accumulator;
399
    } else {
847
    } else {
400
        g_start = 1;  /* we'll use these instead of sqlite3_aggregate_context */
848
        g_start = 1;  /* we'll use these instead of sqlite3_aggregate_context */
401
        g_accumulator = 0.0;
849
        g_accumulator = 0.0;
402
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
850
        sprintf(g_sql_buf[0], "select %s_df([%s]) from [%s].sdf_data", funcname, varname_src, iname_src);
403
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
851
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
404
        if (_sqlite_error(res)) return R_NilValue;
852
        if (_sqlite_error(res)) return R_NilValue;
405
        res = sqlite3_step(stmt); sqlite3_finalize(stmt);
853
        res = sqlite3_step(stmt); sqlite3_finalize(stmt);
406
 
854
 
407
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
855
        if (strcmp(funcname, "all") == 0 || strcmp(funcname, "any") == 0) {
408
            PROTECT(ret = NEW_LOGICAL(1));
856
            PROTECT(ret = NEW_LOGICAL(1));
409
            if (R_IsNA(g_accumulator)) LOGICAL(ret)[0] = NA_INTEGER;
857
            if (R_IsNA(g_accumulator)) LOGICAL(ret)[0] = NA_INTEGER;
410
            else LOGICAL(ret)[0] = !(g_accumulator == 0);
858
            else LOGICAL(ret)[0] = !(g_accumulator == 0);
411
        } else {
859
        } else {
412
            PROTECT(ret = NEW_NUMERIC(1));
860
            PROTECT(ret = NEW_NUMERIC(1));
413
            REAL(ret)[0] = g_accumulator;
861
            REAL(ret)[0] = g_accumulator;
414
        }
862
        }
415
    }
863
    }
416
 
864
 
417
__sdf_do_variable_summary_out:
865
__sdf_do_variable_summary_out:
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) {
428
    int ret = 1;
914
    int ret = 1;
429
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
915
    if (sqlite3_value_type(arg) == SQLITE_NULL) { 
430
        sqlite3_result_null(ctx); 
916
        sqlite3_result_null(ctx); 
431
        ret = 0;
917
        ret = 0;
432
    } else {
918
    } else {
433
        if (sqlite3_value_type(arg) == SQLITE_INTEGER) 
919
        if (sqlite3_value_type(arg) == SQLITE_INTEGER) 
434
            *value = sqlite3_value_int(arg); 
920
            *value = sqlite3_value_int(arg); 
435
        else *value = sqlite3_value_double(arg); 
921
        else *value = sqlite3_value_double(arg); 
436
    }
922
    }
437
    return ret;
923
    return ret;
438
}
924
}
439
 
925
 
440
#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\
926
#define SQLITE_MATH_FUNC1(name, func) static void __vecmath_ ## name(\
441
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
927
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
442
    double value; \
928
    double value; \
443
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
929
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
444
        sqlite3_result_double(ctx, func(value)); \
930
        sqlite3_result_double(ctx, func(value)); \
445
    }  \
931
    }  \
446
}
932
}
447
 
933
 
448
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
934
#define SQLITE_MATH_FUNC_CUM(name, func) static void __vecmath_ ## name(\
449
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
935
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
450
    double value; \
936
    double value; \
451
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
937
    if (__vecmath_checkarg(ctx, argv[0], &value)) { \
452
        if (g_start) { g_start = 0; g_accumulator = value; } \
938
        if (g_start) { g_start = 0; g_accumulator = value; } \
453
        else g_accumulator = func(g_accumulator, value); \
939
        else g_accumulator = func(g_accumulator, value); \
454
        sqlite3_result_double(ctx, g_accumulator); \
940
        sqlite3_result_double(ctx, g_accumulator); \
455
    }  \
941
    }  \
456
}
942
}
457
 
943
 
458
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
944
/* SQLITE_MATH_FUNC1(abs, abs)   in SQLite */
459
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
945
SQLITE_MATH_FUNC1(sign, sign)   /* in R */
460
SQLITE_MATH_FUNC1(sqrt, sqrt)
946
SQLITE_MATH_FUNC1(sqrt, sqrt)
461
SQLITE_MATH_FUNC1(floor, floor)
947
SQLITE_MATH_FUNC1(floor, floor)
462
SQLITE_MATH_FUNC1(ceiling, ceil)
948
SQLITE_MATH_FUNC1(ceiling, ceil)
463
SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */
949
SQLITE_MATH_FUNC1(trunc, ftrunc) /* in R */
464
/* SQLITE_MATH_FUNC1(round, )   in SQLite */
950
/* SQLITE_MATH_FUNC1(round, )   in SQLite */
465
/* SQLITE_MATH_FUNC1(signif, ) 2 arg */
951
/* SQLITE_MATH_FUNC1(signif, ) 2 arg */
466
SQLITE_MATH_FUNC1(exp, exp)
952
SQLITE_MATH_FUNC1(exp, exp)
467
/* SQLITE_MATH_FUNC1(log, ) 2 arg */
953
/* SQLITE_MATH_FUNC1(log, ) 2 arg */
468
SQLITE_MATH_FUNC1(cos, cos)
954
SQLITE_MATH_FUNC1(cos, cos)
469
SQLITE_MATH_FUNC1(sin, sin)
955
SQLITE_MATH_FUNC1(sin, sin)
470
SQLITE_MATH_FUNC1(tan, tan)
956
SQLITE_MATH_FUNC1(tan, tan)
471
SQLITE_MATH_FUNC1(acos, acos)
957
SQLITE_MATH_FUNC1(acos, acos)
472
SQLITE_MATH_FUNC1(asin, asin)
958
SQLITE_MATH_FUNC1(asin, asin)
473
SQLITE_MATH_FUNC1(atan, atan)
959
SQLITE_MATH_FUNC1(atan, atan)
474
SQLITE_MATH_FUNC1(cosh, cosh)
960
SQLITE_MATH_FUNC1(cosh, cosh)
475
SQLITE_MATH_FUNC1(sinh, sinh)
961
SQLITE_MATH_FUNC1(sinh, sinh)
476
SQLITE_MATH_FUNC1(tanh, tanh)
962
SQLITE_MATH_FUNC1(tanh, tanh)
477
SQLITE_MATH_FUNC1(acosh, acosh)  /* nowhere in include?? */
963
SQLITE_MATH_FUNC1(acosh, acosh)  /* nowhere in include?? */
478
SQLITE_MATH_FUNC1(asinh, asinh)  /* nowhere in include?? */
964
SQLITE_MATH_FUNC1(asinh, asinh)  /* nowhere in include?? */
479
SQLITE_MATH_FUNC1(atanh, atanh)  /* nowhere in include?? */
965
SQLITE_MATH_FUNC1(atanh, atanh)  /* nowhere in include?? */
480
SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */
966
SQLITE_MATH_FUNC1(lgamma, lgammafn) /* in R */
481
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
967
SQLITE_MATH_FUNC1(gamma, gammafn) /* in R */
482
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
968
/* SQLITE_MATH_FUNC1(gammaCody, gammaCody)   * in R ?? */
483
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
969
SQLITE_MATH_FUNC1(digamma, digamma) /* in R */    
484
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
970
SQLITE_MATH_FUNC1(trigamma, trigamma) /* in R */
485
 
971
 
486
#define SUM(a, b)  (a) + (b)
972
#define SUM(a, b)  (a) + (b)
487
#define PROD(a, b) (a) * (b)
973
#define PROD(a, b) (a) * (b)
488
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
974
#define MIN(a, b) ((a) <= (b)) ? (a) : (b)
489
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
975
#define MAX(a, b) ((a) >= (b)) ? (a) : (b)
490
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
976
#define ALL(a, b) (((a) == 0) || ((b) == 0)) ? 0 : 1
491
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
977
#define ANY(a, b) (((a) == 0) && ((b) == 0)) ? 0 : 1
492
 
978
 
493
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
979
SQLITE_MATH_FUNC_CUM(cumsum, SUM)
494
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
980
SQLITE_MATH_FUNC_CUM(cumprod, PROD)
495
SQLITE_MATH_FUNC_CUM(cummin, MIN)
981
SQLITE_MATH_FUNC_CUM(cummin, MIN)
496
SQLITE_MATH_FUNC_CUM(cummax, MAX)
982
SQLITE_MATH_FUNC_CUM(cummax, MAX)
497
 
983
 
498
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
984
#define SQLITE_SUMMARY_FUNC(name, func) static void __vecsummary_ ## name(\
499
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
985
        sqlite3_context *ctx, int argc, sqlite3_value **argv) { \
500
    double value; \
986
    double value; \
501
    if (!g_narm && R_IsNA(g_accumulator)) return; /* NA if na.rm=F & NA found */ \
987
    if (!g_narm && R_IsNA(g_accumulator)) return; /* NA if na.rm=F & NA found */ \
502
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
988
    if (sqlite3_value_type(argv[0]) != SQLITE_NULL) {  \
503
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
989
        if (sqlite3_value_type(argv[0]) == SQLITE_INTEGER) {  \
504
            int tmp = sqlite3_value_int(argv[0]); \
990
            int tmp = sqlite3_value_int(argv[0]); \
505
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
991
            value = (tmp == NA_INTEGER) ? R_NaReal : tmp; \
506
        } else value = sqlite3_value_double(argv[0]);  \
992
        } else value = sqlite3_value_double(argv[0]);  \
507
        if (R_IsNA(value)) { \
993
        if (R_IsNA(value)) { \
508
            if (!g_narm) g_accumulator = value; return; \
994
            if (!g_narm) g_accumulator = value; return; \
509
        } else if (g_start) { g_start = 0; g_accumulator = value; } \
995
        } else if (g_start) { g_start = 0; g_accumulator = value; } \
510
        else g_accumulator = func(g_accumulator, value); \
996
        else g_accumulator = func(g_accumulator, value); \
511
    } \
997
    } \
512
}
998
}
513
 
999
 
514
SQLITE_SUMMARY_FUNC(all_df, ALL)
1000
SQLITE_SUMMARY_FUNC(all_df, ALL)
515
SQLITE_SUMMARY_FUNC(any_df, ANY)
1001
SQLITE_SUMMARY_FUNC(any_df, ANY)
516
SQLITE_SUMMARY_FUNC(sum_df, SUM)
1002
SQLITE_SUMMARY_FUNC(sum_df, SUM)
517
SQLITE_SUMMARY_FUNC(prod_df, PROD)
1003
SQLITE_SUMMARY_FUNC(prod_df, PROD)
518
SQLITE_SUMMARY_FUNC(min_df, MIN)
1004
SQLITE_SUMMARY_FUNC(min_df, MIN)
519
SQLITE_SUMMARY_FUNC(max_df, MAX)
1005
SQLITE_SUMMARY_FUNC(max_df, MAX)
520
 
1006
 
521
static void __vecsummary_finalize(sqlite3_context *ctx) {
1007
static void __vecsummary_finalize(sqlite3_context *ctx) {
522
    /* g_accumulator already summarizes it. just return that */
1008
    /* g_accumulator already summarizes it. just return that */
523
    sqlite3_result_double(ctx, g_accumulator);
1009
    sqlite3_result_double(ctx, g_accumulator);
524
}
1010
}
525
 
1011
 
526
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
1012
#define VMENTRY1(func)  {#func, __vecmath_ ## func}
527
#define VSENTRY1(func)  {#func, __vecsummary_ ## func}
1013
#define VSENTRY1(func)  {#func, __vecsummary_ ## func}
528
void __register_vector_math() {
1014
void __register_vector_math() {
529
    int i, res;
1015
    int i, res;
530
    static const struct {
1016
    static const struct {
531
        char *name;
1017
        char *name;
532
        void (*func)(sqlite3_context*, int, sqlite3_value**);
1018
        void (*func)(sqlite3_context*, int, sqlite3_value**);
533
    } arr_func1[] = {
1019
    } arr_func1[] = {
534
        VMENTRY1(sign),
1020
        VMENTRY1(sign),
535
        VMENTRY1(sqrt),
1021
        VMENTRY1(sqrt),
536
        VMENTRY1(floor),
1022
        VMENTRY1(floor),
537
        VMENTRY1(ceiling),
1023
        VMENTRY1(ceiling),
538
        VMENTRY1(trunc),
1024
        VMENTRY1(trunc),
539
        VMENTRY1(exp),
1025
        VMENTRY1(exp),
540
        VMENTRY1(cos),
1026
        VMENTRY1(cos),
541
        VMENTRY1(sin),
1027
        VMENTRY1(sin),
542
        VMENTRY1(tan),
1028
        VMENTRY1(tan),
543
        VMENTRY1(acos),
1029
        VMENTRY1(acos),
544
        VMENTRY1(asin),
1030
        VMENTRY1(asin),
545
        VMENTRY1(atan),
1031
        VMENTRY1(atan),
546
        VMENTRY1(cosh),
1032
        VMENTRY1(cosh),
547
        VMENTRY1(sinh),
1033
        VMENTRY1(sinh),
548
        VMENTRY1(tanh),
1034
        VMENTRY1(tanh),
549
        VMENTRY1(acosh),
1035
        VMENTRY1(acosh),
550
        VMENTRY1(asinh),
1036
        VMENTRY1(asinh),
551
        VMENTRY1(atanh),
1037
        VMENTRY1(atanh),
552
        VMENTRY1(lgamma),
1038
        VMENTRY1(lgamma),
553
        VMENTRY1(gamma),
1039
        VMENTRY1(gamma),
554
        VMENTRY1(digamma),
1040
        VMENTRY1(digamma),
555
        VMENTRY1(trigamma),
1041
        VMENTRY1(trigamma),
556
        VMENTRY1(cumsum),
1042
        VMENTRY1(cumsum),
557
        VMENTRY1(cumprod),
1043
        VMENTRY1(cumprod),
558
        VMENTRY1(cummin),
1044
        VMENTRY1(cummin),
559
        VMENTRY1(cummax)
1045
        VMENTRY1(cummax)
560
    }, arr_sum1[] = {
1046
    }, arr_sum1[] = {
561
        VSENTRY1(all_df),  /* can't override sum, min, max */
1047
        VSENTRY1(all_df),  /* can't override sum, min, max */
562
        VSENTRY1(any_df),
1048
        VSENTRY1(any_df),
563
        VSENTRY1(sum_df),
1049
        VSENTRY1(sum_df),
564
        VSENTRY1(prod_df),
1050
        VSENTRY1(prod_df),
565
        VSENTRY1(min_df),
1051
        VSENTRY1(min_df),
566
        VSENTRY1(max_df)
1052
        VSENTRY1(max_df)
567
    };
1053
    };
568
 
1054
 
569
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
1055
    int len = sizeof(arr_func1) / sizeof(arr_func1[0]);
570
 
1056
 
571
    for (i = 0; i < len; i++) {
1057
    for (i = 0; i < len; i++) {
572
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
1058
        res = sqlite3_create_function(g_workspace, arr_func1[i].name, 1, 
573
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
1059
                SQLITE_ANY, NULL, arr_func1[i].func, NULL, NULL);
574
        _sqlite_error(res);
1060
        _sqlite_error(res);
575
    }
1061
    }
576
 
1062
 
577
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
1063
    len = sizeof(arr_sum1) / sizeof(arr_sum1[0]);
578
    for (i = 0; i < len; i++) {
1064
    for (i = 0; i < len; i++) {
579
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
1065
        res = sqlite3_create_function(g_workspace, arr_sum1[i].name, 1, 
580
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
1066
                SQLITE_ANY, NULL, NULL, arr_sum1[i].func, __vecsummary_finalize);
581
        _sqlite_error(res);
1067
        _sqlite_error(res);
582
    }
1068
    }
583
}
1069
}