The R Project SVN R-packages

Rev

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

Rev 3473 Rev 3684
Line 18... Line 18...
18 
 
 18 
 
19 
    if (_namelen != NULL) *_namelen = namelen;
 19 
    if (_namelen != NULL) *_namelen = namelen;
20 
    return iname;
 20 
    return iname;
21 
}
 21 
}
22 
 
 22 
 
23 
static SEXP _create_svector_sexp(const char *iname, const char *varname,
23 
SEXP _create_svector_sexp(const char *iname, const char *tblname,
24 
        const char *type) {
 24 
        const char *varname, const char *type) {
25 
    SEXP ret, value; int nprotected = 0;
 25 
    SEXP ret, value; int nprotected = 0;
26 
    PROTECT(ret = NEW_LIST(2)); nprotected++;
 26 
    PROTECT(ret = NEW_LIST(3)); nprotected++;
27 
 
 27 
 
28 
    /* set list names */
 28 
    /* set list names */
29 
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
 29 
    PROTECT(value = NEW_CHARACTER(3)); nprotected++;
30 
    SET_STRING_ELT(value, 0, mkChar("iname"));
 30 
    SET_STRING_ELT(value, 0, mkChar("iname"));
- 
 
 31 
    SET_STRING_ELT(value, 1, mkChar("tblname"));
31 
    SET_STRING_ELT(value, 1, mkChar("varname"));
 32 
    SET_STRING_ELT(value, 2, mkChar("varname"));
32 
    SET_NAMES(ret, value);
 33 
    SET_NAMES(ret, value);
33 
 
 34 
 
34 
    /* set list values */
 35 
    /* set list values */
35 
    SET_VECTOR_ELT(ret, 0, mkString(iname));
 36 
    SET_VECTOR_ELT(ret, 0, mkString(iname));
- 
 
 37 
    SET_VECTOR_ELT(ret, 1, mkString(tblname));
36 
    SET_VECTOR_ELT(ret, 1, mkString(varname));
 38 
    SET_VECTOR_ELT(ret, 2, mkString(varname));
37 
 
 39 
 
38 
    /* set sexp class */
 40 
    /* set sexp class */
39 
    SET_CLASS(ret, mkString("sqlite.vector"));
 41 
    SET_CLASS(ret, mkString("sqlite.vector"));
40 
 
 42 
 
41 
    /* set sdf.vector.type */
 43 
    /* set sdf.vector.type */
Line 73... Line 75...
73 
            PROTECT(*ret = NEW_INTEGER(idx_or_len));
 75 
            PROTECT(*ret = NEW_INTEGER(idx_or_len));
74 
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
 76 
            if (added) INTEGER(*ret)[0] = sqlite3_column_int(stmt, 0);
75 
        } else added = 0;
 77 
        } else added = 0;
76 
 
 78 
 
77 
        UNPROTECT(1);
 79 
        UNPROTECT(1);
78 
    } else {
 80 
    } else if (stmt != NULL) {
79 
        const char *coltype = sqlite3_column_decltype(stmt, 0);
 81 
        const char *coltype = sqlite3_column_decltype(stmt, 0);
80 
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
 82 
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
81 
            added = 0;
 83 
            added = 0;
82 
        } else if (strcmp(coltype, "text") == 0) {
 84 
        } else if (strcmp(coltype, "text") == 0) {
83 
            SET_STRING_ELT(*ret, idx_or_len,
85 
            SET_STRING_ELT(*ret, idx_or_len,
Line 89... Line 91...
89 
        } else if (strcmp(coltype, "integer") == 0 ||
 91 
        } else if (strcmp(coltype, "integer") == 0 ||
90 
                   strcmp(coltype, "int") == 0) {
 92 
                   strcmp(coltype, "int") == 0) {
91 
            /* caller should just copy off the vars level attr for factors */
 93 
            /* caller should just copy off the vars level attr for factors */
92 
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
 94 
            INTEGER(*ret)[idx_or_len] = sqlite3_column_int(stmt, 0);
93 
        } else added = 0;
 95 
        } else added = 0;
- 
 
 96 
    } else if (stmt == NULL) {
- 
 
 97 
        const char *coltype = sqlite3_column_decltype(stmt, 0);
- 
 
 98 
        if (sqlite3_column_type(stmt, 0) == SQLITE_NULL) {
- 
 
 99 
            added = 0;
- 
 
 100 
        } else if (strcmp(coltype, "text") == 0) {
- 
 
 101 
            SET_STRING_ELT(*ret, idx_or_len, NA_STRING);
- 
 
 102 
        } else if (strcmp(coltype, "double") == 0) {
- 
 
 103 
            REAL(*ret)[idx_or_len] = NA_REAL;
- 
 
 104 
        } else if (strcmp(coltype, "bit") == 0 || strcmp(coltype, "integer") == 0 ||
- 
 
 105 
                   strcmp(coltype, "int") == 0) {
- 
 
 106 
            INTEGER(*ret)[idx_or_len] = NA_INTEGER;
- 
 
 107 
        } else added = 0;
94 
    }
 108 
    }
95
109
96 
    return added;
 110 
    return added;
97 
}
 111 
}
98 
 
 112 
 
Line 123... Line 137...
123 
    if (_sqlite_error(res)) return R_NilValue;
 137 
    if (_sqlite_error(res)) return R_NilValue;
124 
 
 138 
 
125 
    coltype = sqlite3_column_decltype(stmt, 0);
 139 
    coltype = sqlite3_column_decltype(stmt, 0);
126 
    sqlite3_finalize(stmt);
 140 
    sqlite3_finalize(stmt);
127
141
128 
    PROTECT(ret = NEW_LIST(2)); nprotected++;
 142 
    PROTECT(ret = NEW_LIST(3)); nprotected++;
129 
 
 143 
 
130 
    /* set list names */
 144 
    /* set list names */
131 
    PROTECT(value = NEW_CHARACTER(2)); nprotected++;
 145 
    PROTECT(value = NEW_CHARACTER(3)); nprotected++;
132 
    SET_STRING_ELT(value, 0, mkChar("iname"));
 146 
    SET_STRING_ELT(value, 0, mkChar("iname"));
- 
 
 147 
    SET_STRING_ELT(value, 1, mkChar("tblname"));
133 
    SET_STRING_ELT(value, 1, mkChar("varname"));
 148 
    SET_STRING_ELT(value, 2, mkChar("varname"));
134 
    SET_NAMES(ret, value);
 149 
    SET_NAMES(ret, value);
135 
 
 150 
 
136 
    /* set list values */
 151 
    /* set list values */
137 
    SET_VECTOR_ELT(ret, 0, mkString(iname));
 152 
    SET_VECTOR_ELT(ret, 0, mkString(iname));
- 
 
 153 
    SET_VECTOR_ELT(ret, 1, mkString("sdf_data"));
138 
    SET_VECTOR_ELT(ret, 1, mkString(varname));
 154 
    SET_VECTOR_ELT(ret, 2, mkString(varname));
139 
 
 155 
 
140 
    /* set class */
 156 
    /* set class */
141 
    if (strcmp(coltype, "text") == 0) svec_type = "character";
 157 
    if (strcmp(coltype, "text") == 0) svec_type = "character";
142 
    else if (strcmp(coltype, "double") == 0) svec_type = "numeric";
 158 
    else if (strcmp(coltype, "double") == 0) svec_type = "numeric";
143 
    else if (strcmp(coltype, "bit") == 0) svec_type = "logical";
 159 
    else if (strcmp(coltype, "bit") == 0) svec_type = "logical";
Line 169... Line 185...
169 
}
 185 
}
170 
 
 186 
 
171
187
172 
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
 188 
SEXP sdf_get_variable_index(SEXP svec, SEXP idx) {
173 
    SEXP ret = R_NilValue, tmp;
 189 
    SEXP ret = R_NilValue, tmp;
174 
    char *iname = SDF_INAME(svec), *varname = SVEC_VARNAME(svec);
 190 
    char *iname = SDF_INAME(svec), *tblname = SVEC_TBLNAME(svec),
- 
 
 191 
         *varname = SVEC_VARNAME(svec);
175 
    int index, idxlen, i, retlen=0, res;
 192 
    int index, idxlen, i, retlen=0, res;
176 
    sqlite3_stmt *stmt;
 193 
    sqlite3_stmt *stmt;
177 
 
 194 
 
178 
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
 195 
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
179 
 
 196 
 
180 
    idxlen = LENGTH(idx);
 197 
    idxlen = LENGTH(idx);
181 
    if (idxlen < 1) return ret;
 198 
    if (idxlen < 1) return ret;
182 
 
 199 
 
183 
    sprintf(g_sql_buf[0], "select [%s] from [%s].sdf_data limit ?,1",
 200 
    sprintf(g_sql_buf[0], "select [%s] from [%s].[%s] limit ?,1",
184 
            varname, iname);
 201 
            varname, iname, tblname);
185 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 202 
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
- 
 
 203 
    if (_sqlite_error(res)) error("cannot complete request");
186 
 
 204 
 
187 
    /* get data based on index */
 205 
    /* get data based on index */
188 
    if (IS_NUMERIC(idx)) {
 206 
    if (IS_NUMERIC(idx)) {
189 
        index = ((int) REAL(idx)[0]) - 1;
 207 
        index = ((int) REAL(idx)[0]) - 1;
190 
        if (index < 0 && idxlen == 1) return ret;
 208 
        if (index < 0 && idxlen == 1) return ret;
Line 215... Line 233...
215 
                index = ((int) REAL(idx)[i]) - 1;
 233 
                index = ((int) REAL(idx)[i]) - 1;
216 
                if (index < 0) continue;
 234 
                if (index < 0) continue;
217 
                sqlite3_reset(stmt);
 235 
                sqlite3_reset(stmt);
218 
                sqlite3_bind_int(stmt, 1, index);
 236 
                sqlite3_bind_int(stmt, 1, index);
219 
                res = sqlite3_step(stmt);
 237 
                res = sqlite3_step(stmt);
220 
                if (res == SQLITE_ROW)
 238 
                if (res == SQLITE_ROW) {
221 
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
239 
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
- 
 
 240 
                } else {
- 
 
 241 
                    retlen += _get_vector_index_typed_result(NULL, &ret, retlen);
- 
 
 242 
                }
222 
            }
 243 
            }
223 
        }
 244 
        }
224 
    } else if (IS_INTEGER(idx)) {
 245 
    } else if (IS_INTEGER(idx)) {
225 
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
 246 
        /* similar to REAL (IS_NUMERIC) above, except that we don't have
226 
         * to cast idx to int. can't refactor this out, sucks. */
 247 
         * to cast idx to int. can't refactor this out, sucks. */
Line 251... Line 272...
251 
            for (i = 1; i < idxlen; i++) {
 272 
            for (i = 1; i < idxlen; i++) {
252 
                index = INTEGER(idx)[i] - 1;
 273 
                index = INTEGER(idx)[i] - 1;
253 
                if (index < 0) continue;
 274 
                if (index < 0) continue;
254 
                sqlite3_reset(stmt);
 275 
                sqlite3_reset(stmt);
255 
                sqlite3_bind_int(stmt, 1, index);
 276 
                sqlite3_bind_int(stmt, 1, index);
256 
                sqlite3_step(stmt);
 277 
                res = sqlite3_step(stmt);
- 
 
 278 
                if (res == SQLITE_ROW) {
257 
                retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
279 
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
- 
 
 280 
                } else {
- 
 
 281 
                    retlen += _get_vector_index_typed_result(NULL, &ret, retlen);
- 
 
 282 
                }
258 
            }
 283 
            }
259 
        }
 284 
        }
260 
 
 285 
 
261 
    } else if (IS_LOGICAL(idx)) {
 286 
    } else if (IS_LOGICAL(idx)) {
262 
        /* have to deal with recycling */
 287 
        /* have to deal with recycling */
Line 283... Line 308...
283 
        if (i < idxlen && i < veclen) {
 308 
        if (i < idxlen && i < veclen) {
284 
            for (i++; i < veclen; i++) {
 309 
            for (i++; i < veclen; i++) {
285 
                if (LOGICAL(idx)[i%idxlen]) {
 310 
                if (LOGICAL(idx)[i%idxlen]) {
286 
                    sqlite3_reset(stmt);
 311 
                    sqlite3_reset(stmt);
287 
                    sqlite3_bind_int(stmt, 1, i);
 312 
                    sqlite3_bind_int(stmt, 1, i);
288 
                    sqlite3_step(stmt);
 313 
                    res = sqlite3_step(stmt);
- 
 
 314 
                    if (res == SQLITE_ROW) {
289 
                    retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
 315 
                        retlen += _get_vector_index_typed_result(stmt, &ret, retlen);
- 
 
 316 
                    } else {
- 
 
 317 
                        retlen += _get_vector_index_typed_result(NULL, &ret, retlen);
- 
 
 318 
                    }
290 
                }
 319 
                }
291 
            }
 320 
            }
292 
        }
 321 
        }
293 
    }
 322 
    }
294 
 
 323 
 
Line 332... Line 361...
332 
 
 361 
 
333 
    return R_NilValue;
 362 
    return R_NilValue;
334 
}
 363 
}
335 
 
 364 
 
336 
SEXP sdf_variable_summary(SEXP svec, SEXP maxsum) {
 365 
SEXP sdf_variable_summary(SEXP svec, SEXP maxsum) {
337 
    char *iname, *varname, *type;
 366 
    char *iname, *tblname, *varname, *type;
338 
    sqlite3_stmt *stmt;
 367 
    sqlite3_stmt *stmt;
339 
    int nprotected = 0;
 368 
    int nprotected = 0;
340 
    SEXP ret, names;
 369 
    SEXP ret, names;
341 
 
 370 
 
342 
    iname = SDF_INAME(svec);
 371 
    iname = SDF_INAME(svec);
- 
 
 372 
    tblname = SVEC_TBLNAME(svec);
343 
    varname = SVEC_VARNAME(svec);
 373 
    varname = SVEC_VARNAME(svec);
344 
    USE_SDF1(iname, TRUE, FALSE);
 374 
    USE_SDF1(iname, TRUE, FALSE);
345 
 
 375 
 
346 
    if ((TEST_SDFVECTORTYPE(svec, "ordered") && ((type = "ordered"))) ||
 376 
    if ((TEST_SDFVECTORTYPE(svec, "ordered") && ((type = "ordered"))) ||
347 
            (TEST_SDFVECTORTYPE(svec, "factor") && ((type = "factor")))) {
 377 
            (TEST_SDFVECTORTYPE(svec, "factor") && ((type = "factor")))) {
Line 355... Line 385...
355 
 
 385 
 
356 
        PROTECT(ret = NEW_INTEGER(nrows)); nprotected = 1;
 386 
        PROTECT(ret = NEW_INTEGER(nrows)); nprotected = 1;
357 
        PROTECT(names = NEW_CHARACTER(nrows)); nprotected++;
 387 
        PROTECT(names = NEW_CHARACTER(nrows)); nprotected++;
358 
 
 388 
 
359 
        sprintf(g_sql_buf[0], "select [%s].[%s %s].label, count(*) from "
 389 
        sprintf(g_sql_buf[0], "select [%s].[%s %s].label, count(*) from "
360 
                "[%s].sdf_data join [%s].[%s %s] on [%s].sdf_data.[%s]=[%s].[%s %s].level "
 390 
                "[%s].[%s] join [%s].[%s %s] on [%s].[%s].[%s]=[%s].[%s %s].level "
361 
                "group by [%s].sdf_data.[%s], [%s].[%s %s].level order by count(*) desc",
 391 
                "group by [%s].[%s].[%s], [%s].[%s %s].level order by count(*) desc",
362 
                iname, type, varname, iname, iname, type, varname, iname, varname,
 392 
                iname, type, varname, iname, tblname, iname, type, varname, iname, tblname, varname,
363 
                iname, type, varname, iname, varname, iname, type, varname);
 393 
                iname, type, varname, iname, tblname, varname, iname, type, varname);
364 
        sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
 394 
        sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
365 
 
 395 
 
366 
        for (i = 0; i < max_rows; i++) {
 396 
        for (i = 0; i < max_rows; i++) {
367 
            sqlite3_step(stmt);
 397 
            sqlite3_step(stmt);
368 
            SET_STRING_ELT(names, i, mkChar((char *)sqlite3_column_text(stmt, 0)));
 398 
            SET_STRING_ELT(names, i, mkChar((char *)sqlite3_column_text(stmt, 0)));
Line 377... Line 407...
377 
            }
 407 
            }
378 
            INTEGER(ret)[nrows-1] = others_sum;
 408 
            INTEGER(ret)[nrows-1] = others_sum;
379 
        }
 409 
        }
380 
    } else if (TEST_SDFVECTORTYPE(svec, "logical")) {
 410 
    } else if (TEST_SDFVECTORTYPE(svec, "logical")) {
381 
        sprintf(g_sql_buf[0], "select count(*) from "
 411 
        sprintf(g_sql_buf[0], "select count(*) from "
382 
                "[%s].sdf_data group by [%s] order by [%s]", iname, varname, varname);
 412 
                "[%s].[%s] group by [%s] order by [%s]", iname, tblname, varname, varname);
383 
 
 413 
 
384 
        PROTECT(names = NEW_CHARACTER(3)); nprotected = 1;
 414 
        PROTECT(names = NEW_CHARACTER(3)); nprotected = 1;
385 
        PROTECT(ret = NEW_CHARACTER(3)); nprotected++;
 415 
        PROTECT(ret = NEW_CHARACTER(3)); nprotected++;
386 
 
 416 
 
387 
        SET_STRING_ELT(names, 0, mkChar("Mode"));
 417 
        SET_STRING_ELT(names, 0, mkChar("Mode"));
Line 472... Line 502...
472 
    sqlite3_finalize(stmt);
 502 
    sqlite3_finalize(stmt);
473 
 
 503 
 
474 
    UNUSE_SDF2(iname);
 504 
    UNUSE_SDF2(iname);
475 
    UNUSE_SDF2(iname_src);
 505 
    UNUSE_SDF2(iname_src);
476 
 
 506 
 
477 
    return _create_svector_sexp(iname, "V1", "numeric");
 507 
    return _create_svector_sexp(iname, "sdf_data", "V1", "numeric");
478 
}
 508 
}
479 
 
 509 
 
480 
SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2, SEXP arg_reversed) {
 510 
SEXP sdf_do_variable_op(SEXP func, SEXP vector, SEXP op2, SEXP arg_reversed) {
481 
    char *iname = NULL, *iname_src, *varname_src, *funcname;
 511 
    char *iname = NULL, *iname_src, *varname_src, *funcname;
482 
    int res, functype = -1, op2_len, svec_len, i, reversed;
 512 
    int res, functype = -1, op2_len, svec_len, i, reversed;
Line 985... Line 1015...
985 
        sqlite3_step(stmt);
 1015 
        sqlite3_step(stmt);
986 
        sqlite3_finalize(stmt);
 1016 
        sqlite3_finalize(stmt);
987 
    }
 1017 
    }
988 
 
 1018 
 
989 
    if (iname != NULL) {
 1019 
    if (iname != NULL) {
990 
        return _create_svector_sexp(iname, "V1",
1020 
        return _create_svector_sexp(iname, "sdf_data", "V1",
991 
                (functype == 0) ? "numeric" : "logical");
 1021 
                (functype == 0) ? "numeric" : "logical");
992 
        UNUSE_SDF2(iname);
 1022 
        UNUSE_SDF2(iname);
993 
    }
 1023 
    }
994 
 
 1024 
 
995 
    UNUSE_SDF2(iname_src);
 1025 
    UNUSE_SDF2(iname_src);
Line 1096... Line 1126...
1096 
    } else type = CHAR_ELT(GET_SDFVECTORTYPE(svec), 0);
 1126 
    } else type = CHAR_ELT(GET_SDFVECTORTYPE(svec), 0);
1097 
 
 1127 
 
1098 
    UNUSE_SDF2(iname_src);
 1128 
    UNUSE_SDF2(iname_src);
1099 
    UNUSE_SDF2(iname);
 1129 
    UNUSE_SDF2(iname);
1100 
 
 1130 
 
1101 
    return _create_svector_sexp(iname, "V1", type);
 1131 
    return _create_svector_sexp(iname, "sdf_data", "V1", type);
1102 
}
 1132 
}
1103 
 
 1133 
 
1104 
/****************************************************************************
 1134 
/****************************************************************************
1105 
 * VECTOR MATH/OPS/GROUP OPERATIONS
 1135 
 * VECTOR MATH/OPS/GROUP OPERATIONS
1106 
 ****************************************************************************/
 1136 
 ****************************************************************************/