The R Project SVN R-packages

Rev

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

Rev 3821 Rev 4160
Line 149... Line 149...
149
}
149
}
150
 
150
 
151
 
151
 
152
/* assumes stmt has col_cnt + 1 columns, col 0 is [row name]. returned SEXP is 
152
/* assumes stmt has col_cnt + 1 columns, col 0 is [row name]. returned SEXP is 
153
 * not UNPROTECT-ed, user will have to do that. will create the names &
153
 * not UNPROTECT-ed, user will have to do that. will create the names &
154
 * attach factor infos */
154
 * attach factor infos.
-
 
155
 * not that this will only create the data frame, not pull data from sqlite */
155
static SEXP _setup_df_sexp1(sqlite3_stmt *stmt, const char *iname, 
156
static SEXP _setup_df_sexp1(sqlite3_stmt *stmt, const char *iname, 
156
        int col_cnt, int row_cnt, int *dup_indices) {
157
        int col_cnt, int row_cnt, int *dup_indices) {
157
    SEXP ret, names, value, class = R_NilValue;
158
    SEXP ret, names, value = R_NilValue;
158
    int i, type;
159
    int i;
159
    const char *colname, *coltype;
160
    const char *colname, *coltype;
160
 
161
 
161
    PROTECT(ret = NEW_LIST(col_cnt));
162
    PROTECT(ret = NEW_LIST(col_cnt));
162
 
163
 
163
    /* set up names. */
164
    /* set up names. */
164
    PROTECT(names = NEW_CHARACTER(col_cnt));
165
    PROTECT(names = NEW_CHARACTER(col_cnt));
165
    for (i = 0; i < col_cnt; i++) {
166
    for (i = 0; i < col_cnt; i++) {
166
        colname = sqlite3_column_name(stmt, i+1);  /* +1 bec [row name is 0] */
167
        colname = sqlite3_column_name(stmt, i+1);  /* +1 bec [row name is 0] */
167
        coltype = sqlite3_column_decltype(stmt, i+1);
168
        coltype = sqlite3_column_decltype(stmt, i+1);
168
 
169
 
169
        if (dup_indices[i] == 0) {
170
        if (dup_indices == NULL || dup_indices[i] == 0) {
170
            strcpy(g_sql_buf[1], colname);
171
            strcpy(g_sql_buf[1], colname);
171
        } else {
172
        } else {
172
            sprintf(g_sql_buf[1], "%s.%d", colname, dup_indices[i]);
173
            sprintf(g_sql_buf[1], "%s.%d", colname, dup_indices[i]);
173
        }
174
        }
174
 
175
 
Line 181... Line 182...
181
        } else if (strcmp(coltype, "bit") == 0) {
182
        } else if (strcmp(coltype, "bit") == 0) {
182
            PROTECT(value = NEW_LOGICAL(row_cnt));
183
            PROTECT(value = NEW_LOGICAL(row_cnt));
183
        } else if (strcmp(coltype, "integer") == 0 || 
184
        } else if (strcmp(coltype, "integer") == 0 || 
184
                   strcmp(coltype, "int") == 0) {
185
                   strcmp(coltype, "int") == 0) {
185
            PROTECT(value = NEW_INTEGER(row_cnt));
186
            PROTECT(value = NEW_INTEGER(row_cnt));
186
            type = _get_factor_levels1(iname, colname, value);
-
 
187
            if (type == VAR_FACTOR) {
-
 
-
 
187
 
188
                PROTECT(class = mkString("factor"));
188
            /* attach level values, & set class of factor/ordered if
189
                SET_CLASS(value, class);
-
 
190
                UNPROTECT(1);
-
 
191
            } else if (type == VAR_ORDERED) {
189
             * value is a factor/ordered */
192
                PROTECT(class = NEW_CHARACTER(2));
-
 
193
                SET_STRING_ELT(class, 0, mkChar("ordered"));
190
            _get_factor_levels1(iname, colname, value, TRUE);
194
                SET_STRING_ELT(class, 1, mkChar("factor"));
-
 
195
                SET_CLASS(value, class);
-
 
196
                UNPROTECT(1);
-
 
197
            }
-
 
198
        } else {
191
        } else {
199
            UNPROTECT(2); /* unprotect ret, names */
192
            UNPROTECT(2); /* unprotect ret, names */
200
            error("not supported type %s for %s\n", coltype, colname);
193
            error("not supported type %s for %s\n", coltype, colname);
201
        }
194
        }
202
 
195
 
Line 362... Line 355...
362
                variable = VECTOR_ELT(df, j);
355
                variable = VECTOR_ELT(df, j);
363
                switch(types[j]) {
356
                switch(types[j]) {
364
                    case INTSXP : 
357
                    case INTSXP : 
365
                        sqlite3_bind_int(stmt, j+2, INTEGER(variable)[i]);
358
                        sqlite3_bind_int(stmt, j+2, INTEGER(variable)[i]);
366
                        break;
359
                        break;
-
 
360
                    case LGLSXP : 
-
 
361
                        /* they might make it a bit although currentLY 
-
 
362
                         * LOGICAL==INTEGER macro */
-
 
363
                        sqlite3_bind_int(stmt, j+2, LOGICAL(variable)[i]);
-
 
364
                        break;
367
                    case REALSXP:
365
                    case REALSXP:
368
                        sqlite3_bind_double(stmt, j+2, REAL(variable)[i]);
366
                        sqlite3_bind_double(stmt, j+2, REAL(variable)[i]);
369
                        break;
367
                        break;
370
                    case CHARSXP:
368
                    case CHARSXP:
371
                    case STRSXP:
369
                    case STRSXP:
Line 507... Line 505...
507
 
505
 
508
    /*
506
    /*
509
     * PROCESS COLUMN INDEX: set columns in the select statement
507
     * PROCESS COLUMN INDEX: set columns in the select statement
510
     */
508
     */
511
    if (col == R_NilValue) {
509
    if (col == R_NilValue) {
512
        int len;
-
 
513
        for (i = 1; i < col_cnt+1; i++) {
510
        for (i = 1; i < col_cnt+1; i++) {
514
            colname = sqlite3_column_name(stmt, i);
511
            colname = sqlite3_column_name(stmt, i);
515
            buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", colname);
512
            buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", colname);
516
            _expand_buf(0, buflen + 100);
513
            _expand_buf(0, buflen + 100);
517
        }
514
        }
Line 1080... Line 1077...
1080
    sqlite3_finalize(stmt);
1077
    sqlite3_finalize(stmt);
1081
    UNPROTECT(2);
1078
    UNPROTECT(2);
1082
 
1079
 
1083
    return ret;
1080
    return ret;
1084
}
1081
}
-
 
1082
 
-
 
1083
SEXP sdf_select(SEXP sdf, SEXP select, SEXP where, SEXP limit, SEXP debug) {
-
 
1084
    char *iname, *tmp;
-
 
1085
    sqlite3_stmt *stmt;
-
 
1086
    int buflen0 = 0, buflen1 = 0, len, nrows, res;
-
 
1087
    SEXP ret = NULL;
-
 
1088
    int dbg = LOGICAL(debug)[0];
-
 
1089
 
-
 
1090
    iname = SDF_INAME(sdf);
-
 
1091
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
-
 
1092
 
-
 
1093
    /* create the sql to be executed */
-
 
1094
 
-
 
1095
    /* process select stmt */
-
 
1096
    if (select == R_NilValue) {
-
 
1097
        buflen0 = sprintf(g_sql_buf[0], "select * from [%s].sdf_data", iname);
-
 
1098
    } else if (!IS_CHARACTER(select)) {
-
 
1099
        error("select argument is not a string");
-
 
1100
    } else {
-
 
1101
        tmp = CHAR_ELT(select, 0);
-
 
1102
        _expand_buf(0, strlen(tmp)+100);
-
 
1103
        buflen0 = sprintf(g_sql_buf[0], "select [row name], %s from [%s].sdf_data", 
-
 
1104
                tmp, iname);
-
 
1105
    }
-
 
1106
 
-
 
1107
    /* create separate count() statement, to determine number of rows */
-
 
1108
    buflen1 = sprintf(g_sql_buf[1], "select count([row name]) from [%s].sdf_data", iname);
-
 
1109
 
-
 
1110
    /* process where clause */
-
 
1111
    if (where == R_NilValue) {
-
 
1112
        /* do nothing */
-
 
1113
    } else if (!IS_CHARACTER(where)) {
-
 
1114
        error("where argument is not a string");
-
 
1115
    } else {
-
 
1116
        tmp = CHAR_ELT(where, 0);
-
 
1117
        len = strlen(tmp);
-
 
1118
        _expand_buf(0, buflen0+len+10);
-
 
1119
        buflen0 += sprintf(g_sql_buf[0]+buflen0, " where %s", tmp);
-
 
1120
        _expand_buf(1, buflen1+len+10);
-
 
1121
        buflen1 += sprintf(g_sql_buf[1]+buflen1, " where %s", tmp);
-
 
1122
    }
-
 
1123
 
-
 
1124
    /* process limit clause */
-
 
1125
    if (limit == R_NilValue) {
-
 
1126
        /* do nothing */
-
 
1127
    } else if (!IS_CHARACTER(limit)) {
-
 
1128
        error("limit argument is not a string");
-
 
1129
    } else {
-
 
1130
        tmp = CHAR_ELT(limit, 0);
-
 
1131
        len = strlen(tmp);
-
 
1132
        _expand_buf(0, buflen0+len+10);
-
 
1133
        buflen0 += sprintf(g_sql_buf[0]+buflen0, " limit %s", tmp);
-
 
1134
        _expand_buf(1, buflen1+len+10);
-
 
1135
        
-
 
1136
        /* limit xxx happens after everything has been selected, and so
-
 
1137
         * limit actually limits the count(*) result! not the rows to
-
 
1138
         * be counted */
-
 
1139
    }
-
 
1140
 
-
 
1141
    /* test if the "select count(*) " is a valid sql statement */
-
 
1142
    res = sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt, NULL);
-
 
1143
    if (_sqlite_error(res)) error("Error in SQL select statement.");
-
 
1144
 
-
 
1145
    /* get the number of rows from the "select count(*) " query */
-
 
1146
    sqlite3_step(stmt);
-
 
1147
    nrows = sqlite3_column_int(stmt, 0);
-
 
1148
    sqlite3_finalize(stmt);
-
 
1149
 
-
 
1150
    if (nrows == 0) return R_NilValue;
-
 
1151
 
-
 
1152
    /* test again if actual select stmt is a valid sql statement */
-
 
1153
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
-
 
1154
    if (_sqlite_error(res)) error("Error in SQL select statement.");
-
 
1155
    len = sqlite3_column_count(stmt);
-
 
1156
 
-
 
1157
    if (dbg)
-
 
1158
        Rprintf("sql: %s\nncols: %d, nrows: %d\n", g_sql_buf[0], len, nrows);
-
 
1159
 
-
 
1160
    if (len < 2) { sqlite3_finalize(stmt); return R_NilValue; }
-
 
1161
    else if (len == 2) { /* return a vector */
-
 
1162
        int coltype, idx = 0;
-
 
1163
        const char *colname;
-
 
1164
 
-
 
1165
        /* initialize R vector */
-
 
1166
        res = sqlite3_step(stmt);
-
 
1167
        if (res == SQLITE_ROW)
-
 
1168
            idx = _get_vector_index_typed_result(stmt, &ret, 1, nrows, &coltype);
-
 
1169
 
-
 
1170
        while ((res = sqlite3_step(stmt)) == SQLITE_ROW) {
-
 
1171
            idx += _get_vector_index_typed_result(stmt, &ret, 1, idx, &coltype);
-
 
1172
        }
-
 
1173
 
-
 
1174
        if (ret != R_NilValue) {
-
 
1175
            if (idx < nrows) ret = _shrink_vector(ret, idx);
-
 
1176
            if (coltype == SQLITE_INTEGER) {
-
 
1177
                colname = sqlite3_column_name(stmt, 1);
-
 
1178
                _get_factor_levels1(iname, colname, ret, TRUE);
-
 
1179
            }
-
 
1180
            /*UNPROTECT(1); _get_vector_index_typed_result UNPROTECTs already*/
-
 
1181
        }
-
 
1182
    } else { /* return a data frame */
-
 
1183
        --len;  /* _setup_df_sexp1 does not count the preceding [row name] */
-
 
1184
        ret = _setup_df_sexp1(stmt, iname, len, nrows, NULL);
-
 
1185
        if (ret != R_NilValue) {
-
 
1186
            int idx;
-
 
1187
 
-
 
1188
            for (idx = 0; sqlite3_step(stmt) == SQLITE_ROW && idx < nrows; idx++) {
-
 
1189
                _add_row_to_df(ret, stmt, idx, len);
-
 
1190
            }
-
 
1191
 
-
 
1192
            if (idx < nrows) {
-
 
1193
                for (int i = 0; i < len; i++) {
-
 
1194
                    SET_VECTOR_ELT(ret, i, 
-
 
1195
                            _shrink_vector(VECTOR_ELT(ret, i), idx));
-
 
1196
                }
-
 
1197
            }
-
 
1198
 
-
 
1199
            SET_CLASS(ret, mkString("data.frame"));
-
 
1200
            _set_rownames2(ret);
-
 
1201
            
-
 
1202
            UNPROTECT(1);
-
 
1203
        }
-
 
1204
    }
-
 
1205
 
-
 
1206
    sqlite3_finalize(stmt);
-
 
1207
    return ret;
-
 
1208
}