The R Project SVN R-packages

Rev

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

Rev 3255 Rev 3281
Line 13... Line 13...
13 
    sqlite3_stmt *stmt;
 13 
    sqlite3_stmt *stmt;
14 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
 14 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
15 
 
 15 
 
16 
    int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 16 
    int res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
17 
 
 17 
 
18 
    if (_sqlite_error(res)) { sqlite3_finalize(stmt); return R_NilValue; }
 18 
    if (_sqlite_error(res)) return R_NilValue;
19 
 
 19 
 
20 
    int sxptype;
 - 
 
21 
    const char *coltype = sqlite3_column_decltype(stmt, 0);
 20 
    const char *coltype = sqlite3_column_decltype(stmt, 0);
22 
    sqlite3_finalize(stmt);
 21 
    sqlite3_finalize(stmt);
23 
 
 22 
 
24 
 
 23 
 
25 
    SEXP ret, value, class; int nprotected = 0;
 24 
    SEXP ret, value, class = R_NilValue; int nprotected = 0;
26 
    PROTECT(ret = NEW_LIST(2)); nprotected++;
 25 
    PROTECT(ret = NEW_LIST(2)); nprotected++;
27 
 
 26 
 
28 
    /* set list names */
 27 
    /* set list names */
29 
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
 28 
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
30 
    SET_STRING_ELT(value, 0, mkChar("iname"));
 29 
    SET_STRING_ELT(value, 0, mkChar("iname"));
Line 128... Line 127...
128 
 
 127 
 
129
128
130 
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
 129 
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
131 
    SEXP ret = R_NilValue, tmp;
 130 
    SEXP ret = R_NilValue, tmp;
132 
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
 131 
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
133 
    int index, idxlen, i, retlen, res, nprotected = 0;
 132 
    int index, idxlen, i, retlen, res;
134 
 
 133 
 
135 
    /* check if sdf exists */
 134 
    /* check if sdf exists */
136 
    sqlite3_stmt *stmt;
 135 
    sqlite3_stmt *stmt;
137 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
 136 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data", varname, iname);
138 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 137 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
Line 149... Line 148...
149 
    /* get data based on index */
 148 
    /* get data based on index */
150 
    if (IS_NUMERIC(idx)) {
 149 
    if (IS_NUMERIC(idx)) {
151 
        index = ((int) REAL(idx)[0]) - 1;
 150 
        index = ((int) REAL(idx)[0]) - 1;
152 
        if (index < 0 && idxlen == 1) return ret;
 151 
        if (index < 0 && idxlen == 1) return ret;
153 
 
 152 
 
154 
        if (index > 0) {
 153 
        if (index >= 0) {
155 
            sqlite3_bind_int(stmt, 1, index);
 154 
            sqlite3_bind_int(stmt, 1, index);
156 
            res = sqlite3_step(stmt);
 155 
            res = sqlite3_step(stmt);
157 
            if (res == SQLITE_ROW) {
156 
            if (res == SQLITE_ROW) {
158 
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
 157 
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
159 
            }
158 
            }
160 
        }
159 
        }
161
160
162 
        if (index <= 0 || res != SQLITE_ROW) {
 161 
        if (index < 0 || res != SQLITE_ROW) {
163 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
162 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
164 
             * a "dummy" call to setup the SEXP */
 163 
             * a "dummy" call to setup the SEXP */
165 
            sqlite3_bind_int(stmt, 1, 0);
 164 
            sqlite3_bind_int(stmt, 1, 0);
166 
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
 165 
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
167 
            retlen = 0;
 166 
            retlen = 0;
Line 182... Line 181...
182 
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
 181 
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
183 
         * to cast idx to int. can't refactor this out, sucks. */
 182 
         * to cast idx to int. can't refactor this out, sucks. */
184 
        index = INTEGER(idx)[0] - 1;
 183 
        index = INTEGER(idx)[0] - 1;
185 
        if (index < 0 && idxlen == 1) return ret;
 184 
        if (index < 0 && idxlen == 1) return ret;
186 
 
 185 
 
187 
        if (index > 0) {
 186 
        if (index >= 0) {
188 
            sqlite3_bind_int(stmt, 1, index);
 187 
            sqlite3_bind_int(stmt, 1, index);
189 
            sqlite3_step(stmt);
 188 
            res = sqlite3_step(stmt);
- 
 
 189 
            if (res == SQLITE_ROW) {
190 
            retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
 190 
                retlen = _get_vector_index_typed_result(stmt, &ret, idxlen);
191 
        } else {
 191 
            }
- 
 
 192 
        }
- 
 
 193
- 
 
 194 
        if (index < 0 || res != SQLITE_ROW) {
- 
 
 195 
            /* something wrong w/ 1st idx, and it is quietly ignored. we make
- 
 
 196 
             * a "dummy" call to setup the SEXP */
192 
            sqlite3_bind_int(stmt, 1, 0);
 197 
            sqlite3_bind_int(stmt, 1, 0);
193 
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
 198 
            _get_vector_index_typed_result(stmt, &ret, idxlen - 1);
194 
            retlen = 0;
 199 
            retlen = 0;
195 
        }
 200 
        }
196 
 
 201 
 
Line 209... Line 214...
209 
        /* have to deal with recycling */
 214 
        /* have to deal with recycling */
210 
        sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
 215 
        sprintf(g_sql_buf[0], "[%s].sdf_data", iname);
211 
        int veclen = _get_row_count2(g_sql_buf[0]);
 216 
        int veclen = _get_row_count2(g_sql_buf[0]);
212 
 
 217 
 
213 
        /* find if there is any TRUE element in the vector */
 218 
        /* find if there is any TRUE element in the vector */
214 
        for (i = 0; i < idxlen; i++) {
 219 
        for (i = 0; i < idxlen && i < veclen; i++) {
215 
            if (LOGICAL(idx)[i]) {
 220 
            if (LOGICAL(idx)[i]) {
216 
                sqlite3_bind_int(stmt, 1, i);
 221 
                sqlite3_bind_int(stmt, 1, i);
217 
                sqlite3_step(stmt);
 222 
                sqlite3_step(stmt);
218 
                /* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
 223 
                /* there are at least (idxlen-i) TRUE per cycle of the LOGICAL
219 
                 * index. there are at least (veclen/idxlen) cycles (int div).
 224 
                 * index. there are at least (veclen/idxlen) cycles (int div).
Line 226... Line 231...
226 
                retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
 231 
                retlen = _get_vector_index_typed_result(stmt, &ret, retlen);
227 
                break;
 232 
                break;
228 
            }
 233 
            }
229 
        }
 234 
        }
230 
 
 235 
 
231 
        if (i < idxlen) {
 236 
        if (i < idxlen && i < veclen) {
232 
            for (i++; i < veclen; i++) {
 237 
            for (i++; i < veclen; i++) {
233 
                if (LOGICAL(idx)[i%idxlen]) {
 238 
                if (LOGICAL(idx)[i%idxlen]) {
234 
                    sqlite3_reset(stmt);
 239 
                    sqlite3_reset(stmt);
235 
                    sqlite3_bind_int(stmt, 1, i);
 240 
                    sqlite3_bind_int(stmt, 1, i);
236 
                    sqlite3_step(stmt);
 241 
                    sqlite3_step(stmt);