The R Project SVN R-packages

Rev

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

Rev 3284 Rev 3307
1
#include <stdio.h>
1
#include <stdio.h>
2
#include <string.h>
2
#include <string.h>
3
#include "sqlite_dataframe.h"
3
#include "sqlite_dataframe.h"
4
 
4
 
5
/****************************************************************************
5
/****************************************************************************
6
 * UTILITY FUNCTIONS
6
 * UTILITY FUNCTIONS
7
 ****************************************************************************/
7
 ****************************************************************************/
8
 
8
 
9
/* if user supplied a name, return that name. otherwise, use the 
9
/* if user supplied a name, return that name. otherwise, use the 
10
 * default "data" */
10
 * default "data" */
11
int _check_sdf_name(SEXP name, char **rname, char **iname, int *file_idx) {
11
static int _check_sdf_name(SEXP name, char **rname, char **iname, int *file_idx) {
12
    int namelen = 0;
12
    int namelen = 0;
13
 
13
 
14
    /* check if arg name is supplied */
14
    /* check if arg name is supplied */
15
    if (IS_CHARACTER(name)) {
15
    if (IS_CHARACTER(name)) {
16
        *rname = CHAR_ELT(name,0);
16
        *rname = CHAR_ELT(name,0);
17
        if (!_is_r_sym(*rname)) { 
17
        if (!_is_r_sym(*rname)) { 
18
            Rprintf("Error: supplied name \"%s\"is not a valid R symbol.\n", 
18
            Rprintf("Error: supplied name \"%s\"is not a valid R symbol.\n", 
19
                    *rname); 
19
                    *rname); 
20
            return FALSE; 
20
            return FALSE; 
21
        }
21
        }
22
        namelen = strlen(*rname);
22
        namelen = strlen(*rname);
23
        *iname = (char*)R_alloc(namelen + 9, sizeof(char)); /* <name>10000.db\0 */
23
        *iname = (char*)R_alloc(namelen + 9, sizeof(char)); /* <name>10000.db\0 */
24
        sprintf(*iname, "%s.db", *rname);
24
        sprintf(*iname, "%s.db", *rname);
25
    } else if (name == R_NilValue) {
25
    } else if (name == R_NilValue) {
26
        *rname = "data";
26
        *rname = "data";
27
        namelen = 5;
27
        namelen = 5;
28
        *iname = (char*)R_alloc(13, sizeof(char)); /* data10000.db\0 */
28
        *iname = (char*)R_alloc(13, sizeof(char)); /* data10000.db\0 */
29
        *file_idx = 1;
29
        *file_idx = 1;
30
        sprintf(*iname, "%s%d.db", *rname, *file_idx);
30
        sprintf(*iname, "%s%d.db", *rname, *file_idx);
31
    } else {
31
    } else {
32
        Rprintf("Error: the supplied value for arg name is not a string.\n");
32
        Rprintf("Error: the supplied value for arg name is not a string.\n");
33
    }
33
    }
34
    return namelen;
34
    return namelen;
35
}
35
}
36
 
36
 
37
int _find_free_filename(char *rname, char **iname, int *namelen, int *file_idx) {
37
static int _find_free_filename(char *rname, char **iname, int *namelen, int *file_idx) {
38
    do {
38
    do {
39
        if (!_file_exists(*iname)) break;
39
        if (!_file_exists(*iname)) break;
40
        *namelen = sprintf(*iname, "%s%d.db", rname, ++(*file_idx)) - 3;
40
        *namelen = sprintf(*iname, "%s%d.db", rname, ++(*file_idx)) - 3;
41
    } while (*file_idx < 10000);
41
    } while (*file_idx < 10000);
42
 
42
 
43
    return *file_idx;
43
    return *file_idx;
44
}
44
}
45
 
45
 
46
/* creates an sdf attribute table */
46
/* creates an sdf attribute table */
47
static int _create_sdf_attribute2(const char *iname) {
47
static int _create_sdf_attribute2(const char *iname) {
48
    sprintf(g_sql_buf[2], "create table [%s].sdf_attributes(attr text, "
48
    sprintf(g_sql_buf[2], "create table [%s].sdf_attributes(attr text, "
49
            "value text, primary key (attr))", iname);
49
            "value text, primary key (attr))", iname);
50
    int res;
50
    int res;
51
    res = _sqlite_exec(g_sql_buf[2]);
51
    res = _sqlite_exec(g_sql_buf[2]);
52
    if (res == SQLITE_OK) {
52
    if (res == SQLITE_OK) {
53
        sprintf(g_sql_buf[2], "insert into [%s].sdf_attributes values ('name',"
53
        sprintf(g_sql_buf[2], "insert into [%s].sdf_attributes values ('name',"
54
                "'%s');", iname, iname);
54
                "'%s');", iname, iname);
55
        res = _sqlite_exec(g_sql_buf[2]);
55
        res = _sqlite_exec(g_sql_buf[2]);
56
    }
56
    }
57
    return res;
57
    return res;
58
}
58
}
59
 
59
 
-
 
60
char *_create_sdf_skeleton2(SEXP name, int *onamelen) {
-
 
61
    char *iname, *rname;
-
 
62
    int namelen, file_idx = 0, res;
-
 
63
 
-
 
64
    namelen = _check_sdf_name(name, &rname, &iname, &file_idx);
-
 
65
 
-
 
66
    if (!namelen) return NULL;
-
 
67
 
-
 
68
    _find_free_filename(rname, &iname, &namelen, &file_idx);
-
 
69
 
-
 
70
    if (file_idx >= 10000) { 
-
 
71
        Rprintf("Error: cannot find free SDF name.\n");
-
 
72
        return NULL;
-
 
73
    }
-
 
74
 
-
 
75
    /* create new db by attaching a non-existent file */
-
 
76
    iname[namelen] = 0; /* remove ".db" */
-
 
77
    sprintf(g_sql_buf[2], "attach '%s.db' as [%s]", iname, iname);
-
 
78
    res = _sqlite_exec(g_sql_buf[2]);
-
 
79
    if (_sqlite_error(res)) return NULL; 
-
 
80
 
-
 
81
    /* create attributes table */
-
 
82
    res = _create_sdf_attribute2(iname);
-
 
83
    if (_sqlite_error(res)) {
-
 
84
        sprintf(g_sql_buf[2], "detach '%s'", iname);
-
 
85
        return NULL; 
-
 
86
    }
-
 
87
 
-
 
88
    *onamelen = namelen;
-
 
89
    return iname;
-
 
90
}
60
/* checks if a column has a corresponding factor|ordered table */
91
/* checks if a column has a corresponding factor|ordered table */
61
static int _is_factor2(const char *iname, const char *factor_type, const char *colname) {
92
static int _is_factor2(const char *iname, const char *factor_type, const char *colname) {
62
    sqlite3_stmt *stmt;
93
    sqlite3_stmt *stmt;
63
    sprintf(g_sql_buf[2], "select * from [%s].[%s %s]", iname, factor_type,
94
    sprintf(g_sql_buf[2], "select * from [%s].[%s %s]", iname, factor_type,
64
            colname);
95
            colname);
65
    int res;
96
    int res;
66
    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
97
    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
67
    sqlite3_finalize(stmt);
98
    sqlite3_finalize(stmt);
68
    return res == SQLITE_OK;
99
    return res == SQLITE_OK;
69
}
100
}
70
 
101
 
71
/* create a factor|ordered table */
102
/* create a factor|ordered table */
72
static int _create_factor_table2(const char *iname, const char *factor_type, 
103
static int _create_factor_table2(const char *iname, const char *factor_type, 
73
        const char *colname) {
104
        const char *colname) {
74
    sqlite3_stmt *stmt;
105
    sqlite3_stmt *stmt;
75
    sprintf(g_sql_buf[2], "create table [%s].[%s %s] (level int, label text, "
106
    sprintf(g_sql_buf[2], "create table [%s].[%s %s] (level int, label text, "
76
            "primary key(level), unique(label));", iname, factor_type, colname);
107
            "primary key(level), unique(label));", iname, factor_type, colname);
77
    int res;
108
    int res;
78
    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
109
    res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
79
    if (res == SQLITE_OK) sqlite3_step(stmt);
110
    if (res == SQLITE_OK) sqlite3_step(stmt);
80
    sqlite3_finalize(stmt);
111
    sqlite3_finalize(stmt);
81
    return res; /* error on dup name? */
112
    return res; /* error on dup name? */
82
}
113
}
83
 
114
 
84
/* copy a factor|ordered table from a sdf(db) to another sdf(db) */
115
/* copy a factor|ordered table from a sdf(db) to another sdf(db) */
85
static int _copy_factor_levels2(const char *factor_type, const char *iname_src,
116
static int _copy_factor_levels2(const char *factor_type, const char *iname_src,
86
        const char *colname_src, const char *iname_dst, const char *colname_dst) {
117
        const char *colname_src, const char *iname_dst, const char *colname_dst) {
87
    sqlite3_stmt *stmt;
118
    sqlite3_stmt *stmt;
88
    int res;
119
    int res;
89
    res = _create_factor_table2(iname_dst, factor_type, colname_dst);
120
    res = _create_factor_table2(iname_dst, factor_type, colname_dst);
90
    if (res == SQLITE_OK) {
121
    if (res == SQLITE_OK) {
91
        sprintf(g_sql_buf[2], "insert into [%s].[%s %s] select * from [%s].[%s %s]",
122
        sprintf(g_sql_buf[2], "insert into [%s].[%s %s] select * from [%s].[%s %s]",
92
                iname_src, factor_type, colname_src, iname_dst, factor_type,
123
                iname_src, factor_type, colname_src, iname_dst, factor_type,
93
                colname_dst);
124
                colname_dst);
94
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
125
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, 0);
95
        if (res == SQLITE_OK) sqlite3_step(stmt);
126
        if (res == SQLITE_OK) sqlite3_step(stmt);
96
        sqlite3_finalize(stmt);
127
        sqlite3_finalize(stmt);
97
    }
128
    }
98
    return res; /* error on dup name? */
129
    return res; /* error on dup name? */
99
}
130
}
100
 
131
 
101
 
132
 
102
/* assumes stmt has col_cnt + 1 columns, col 0 is [row name]. returned SEXP is 
133
/* assumes stmt has col_cnt + 1 columns, col 0 is [row name]. returned SEXP is 
103
 * not UNPROTECT-ed, user will have to do that. will create the names &
134
 * not UNPROTECT-ed, user will have to do that. will create the names &
104
 * attach factor infos */
135
 * attach factor infos */
105
static SEXP _setup_df_sexp1(sqlite3_stmt *stmt, const char *iname, 
136
static SEXP _setup_df_sexp1(sqlite3_stmt *stmt, const char *iname, 
106
        int col_cnt, int row_cnt, int *dup_indices) {
137
        int col_cnt, int row_cnt, int *dup_indices) {
107
    SEXP ret, names, value, class = R_NilValue;
138
    SEXP ret, names, value, class = R_NilValue;
108
    int i, type;
139
    int i, type;
109
    const char *colname, *coltype;
140
    const char *colname, *coltype;
110
 
141
 
111
    PROTECT(ret = NEW_LIST(col_cnt));
142
    PROTECT(ret = NEW_LIST(col_cnt));
112
 
143
 
113
    /* set up names. */
144
    /* set up names. */
114
    PROTECT(names = NEW_CHARACTER(col_cnt));
145
    PROTECT(names = NEW_CHARACTER(col_cnt));
115
    for (i = 0; i < col_cnt; i++) {
146
    for (i = 0; i < col_cnt; i++) {
116
        colname = sqlite3_column_name(stmt, i+1);  /* +1 bec [row name is 0] */
147
        colname = sqlite3_column_name(stmt, i+1);  /* +1 bec [row name is 0] */
117
        coltype = sqlite3_column_decltype(stmt, i+1);
148
        coltype = sqlite3_column_decltype(stmt, i+1);
118
 
149
 
119
        if (dup_indices[i] == 0) {
150
        if (dup_indices[i] == 0) {
120
            strcpy(g_sql_buf[1], colname);
151
            strcpy(g_sql_buf[1], colname);
121
        } else {
152
        } else {
122
            sprintf(g_sql_buf[1], "%s.%d", colname, dup_indices[i]);
153
            sprintf(g_sql_buf[1], "%s.%d", colname, dup_indices[i]);
123
        }
154
        }
124
 
155
 
125
        SET_STRING_ELT(names, i, mkChar(g_sql_buf[1]));
156
        SET_STRING_ELT(names, i, mkChar(g_sql_buf[1]));
126
 
157
 
127
        if (strcmp(coltype, "text") == 0) {
158
        if (strcmp(coltype, "text") == 0) {
128
            PROTECT(value = NEW_CHARACTER(row_cnt));
159
            PROTECT(value = NEW_CHARACTER(row_cnt));
129
        } else if (strcmp(coltype, "double") == 0) {
160
        } else if (strcmp(coltype, "double") == 0) {
130
            PROTECT(value = NEW_NUMERIC(row_cnt));
161
            PROTECT(value = NEW_NUMERIC(row_cnt));
131
        } else if (strcmp(coltype, "bit") == 0) {
162
        } else if (strcmp(coltype, "bit") == 0) {
132
            PROTECT(value = NEW_LOGICAL(row_cnt));
163
            PROTECT(value = NEW_LOGICAL(row_cnt));
133
        } else if (strcmp(coltype, "integer") == 0 || 
164
        } else if (strcmp(coltype, "integer") == 0 || 
134
                   strcmp(coltype, "int") == 0) {
165
                   strcmp(coltype, "int") == 0) {
135
            PROTECT(value = NEW_INTEGER(row_cnt));
166
            PROTECT(value = NEW_INTEGER(row_cnt));
136
            type = _get_factor_levels1(iname, colname, value);
167
            type = _get_factor_levels1(iname, colname, value);
137
            if (type == VAR_FACTOR) {
168
            if (type == VAR_FACTOR) {
138
                PROTECT(class = mkString("factor"));
169
                PROTECT(class = mkString("factor"));
139
                SET_CLASS(value, class);
170
                SET_CLASS(value, class);
140
                UNPROTECT(1);
171
                UNPROTECT(1);
141
            } else if (type == VAR_ORDERED) {
172
            } else if (type == VAR_ORDERED) {
142
                PROTECT(class = NEW_CHARACTER(2));
173
                PROTECT(class = NEW_CHARACTER(2));
143
                SET_STRING_ELT(class, 0, mkChar("ordered"));
174
                SET_STRING_ELT(class, 0, mkChar("ordered"));
144
                SET_STRING_ELT(class, 1, mkChar("factor"));
175
                SET_STRING_ELT(class, 1, mkChar("factor"));
145
                SET_CLASS(value, class);
176
                SET_CLASS(value, class);
146
                UNPROTECT(1);
177
                UNPROTECT(1);
147
            }
178
            }
148
        } else {
179
        } else {
149
            Rprintf("Error: not supported type %s for %s\n", coltype, colname);
180
            Rprintf("Error: not supported type %s for %s\n", coltype, colname);
150
            UNPROTECT(2); /* unprotect ret, names */
181
            UNPROTECT(2); /* unprotect ret, names */
151
            return R_NilValue;
182
            return R_NilValue;
152
        }
183
        }
153
 
184
 
154
        SET_VECTOR_ELT(ret, i, value);
185
        SET_VECTOR_ELT(ret, i, value);
155
        UNPROTECT(1); /* unprotect value */
186
        UNPROTECT(1); /* unprotect value */
156
                    
187
                    
157
    }
188
    }
158
    SET_NAMES(ret, names);
189
    SET_NAMES(ret, names);
159
    UNPROTECT(1); /* unprotect names only */
190
    UNPROTECT(1); /* unprotect names only */
160
    return ret;
191
    return ret;
161
}
192
}
162
 
193
 
163
/* expected that 1st col of stmt is [row name], so we start with index 1 */
194
/* expected that 1st col of stmt is [row name], so we start with index 1 */
164
static int _add_row_to_df(SEXP df, sqlite3_stmt *stmt, int row, int ncols) {
195
static int _add_row_to_df(SEXP df, sqlite3_stmt *stmt, int row, int ncols) {
165
    SEXP vec;
196
    SEXP vec;
166
    int type = -1, is_null, i;
197
    int type = -1, is_null, i;
167
    for (i = 1; i <= ncols; i++) {
198
    for (i = 1; i <= ncols; i++) {
168
        vec = VECTOR_ELT(df, i-1);
199
        vec = VECTOR_ELT(df, i-1);
169
        type = TYPEOF(vec);
200
        type = TYPEOF(vec);
170
 
201
 
171
        is_null = (sqlite3_column_type(stmt, row) == SQLITE_NULL);
202
        is_null = (sqlite3_column_type(stmt, row) == SQLITE_NULL);
172
 
203
 
173
        if (type == CHARSXP) {
204
        if (type == CHARSXP) {
174
            SET_STRING_ELT(vec, row, mkChar((char *)sqlite3_column_text(stmt, i)));
205
            SET_STRING_ELT(vec, row, mkChar((char *)sqlite3_column_text(stmt, i)));
175
        } else if (type == INTSXP) {
206
        } else if (type == INTSXP) {
176
            INTEGER(vec)[row] = sqlite3_column_int(stmt, i);
207
            INTEGER(vec)[row] = sqlite3_column_int(stmt, i);
177
        } else if (type == REALSXP) {
208
        } else if (type == REALSXP) {
178
            REAL(vec)[row] = sqlite3_column_double(stmt, i);
209
            REAL(vec)[row] = sqlite3_column_double(stmt, i);
179
        } else if (type == LGLSXP) {
210
        } else if (type == LGLSXP) {
180
            LOGICAL(vec)[row] = sqlite3_column_int(stmt, i);
211
            LOGICAL(vec)[row] = sqlite3_column_int(stmt, i);
181
        }
212
        }
182
    }
213
    }
183
    return type;
214
    return type;
184
}
215
}
185
 
216
 
186
static void _set_rownames2(SEXP df) {
217
static void _set_rownames2(SEXP df) {
187
    SEXP value = VECTOR_ELT(df, 0);
218
    SEXP value = VECTOR_ELT(df, 0);
188
    int len = LENGTH(value), i;
219
    int len = LENGTH(value), i;
189
    PROTECT(value = NEW_CHARACTER(len));
220
    PROTECT(value = NEW_CHARACTER(len));
190
    for (i = 0; i < len; i++) {
221
    for (i = 0; i < len; i++) {
191
        sprintf(g_sql_buf[2], "%d", i+1);
222
        sprintf(g_sql_buf[2], "%d", i+1);
192
        SET_STRING_ELT(value, i, mkChar(g_sql_buf[2]));
223
        SET_STRING_ELT(value, i, mkChar(g_sql_buf[2]));
193
    }
224
    }
194
 
225
 
195
    SET_ROWNAMES(df, value);
226
    SET_ROWNAMES(df, value);
196
    UNPROTECT(1);
227
    UNPROTECT(1);
197
}
228
}
198
 
229
 
199
 
230
 
200
/****************************************************************************
231
/****************************************************************************
201
 * SDF FUNCTIONS
232
 * SDF FUNCTIONS
202
 ****************************************************************************/
233
 ****************************************************************************/
203
 
234
 
204
SEXP sdf_create_sdf(SEXP df, SEXP name) {
235
SEXP sdf_create_sdf(SEXP df, SEXP name) {
205
    SEXP ret;
236
    SEXP ret;
206
    char *rname, *iname; 
237
    char *iname; 
207
    int file_idx = 0, namelen, res, i, j;
238
    int namelen, res, i, j;
208
 
-
 
209
    namelen = _check_sdf_name(name, &rname, &iname, &file_idx);
-
 
210
    if (!namelen) return R_NilValue;
-
 
211
 
-
 
212
 
239
 
213
    /* at this point, iname will contain #{iname}.db */
240
    /* find free name, attach sdf, create sdf_attributes */
214
    _find_free_filename(rname, &iname, &namelen, &file_idx);
241
    iname = _create_sdf_skeleton2(name, &namelen);
215
    
242
    
216
    /* found a free number */
-
 
217
    if (file_idx < 10000) {
243
    if (iname != NULL) {
218
        /* create a sdf db file by running "attach" statement to non-existent
-
 
219
         * db file
-
 
220
         */
-
 
221
        int sql_len, sql_len2;
244
        int sql_len, sql_len2;
222
        sqlite3_stmt *stmt;
245
        sqlite3_stmt *stmt;
223
 
246
 
224
        iname[namelen] = 0;  /* remove ".db" */
-
 
225
        sql_len = sprintf(g_sql_buf[0], "attach '%s.db' as %s", iname, iname);
-
 
226
 
-
 
227
        res = _sqlite_exec(g_sql_buf[0]);
-
 
228
        if (_sqlite_error(res)) return R_NilValue; /* duplicate dbname */
-
 
229
            
-
 
230
 
-
 
231
        /* 
-
 
232
         * create tables for the sdf db
-
 
233
         */
-
 
234
 
-
 
235
        /* create sdf_attributes table */
-
 
236
        res = _create_sdf_attribute2(iname);
-
 
237
        if (_sqlite_error(res)) return R_NilValue;
-
 
238
 
-
 
239
        /* create sdf_data table */
247
        /* create sdf_data table */
240
        SEXP names = GET_NAMES(df), variable, levels;
248
        SEXP names = GET_NAMES(df), variable, levels;
241
        int ncols = GET_LENGTH(names), type, *types;
249
        int ncols = GET_LENGTH(names), type, *types;
242
        char *col_name, *class, *factor;
250
        char *col_name, *class, *factor;
243
 
251
 
244
        /* TODO: put constraints on table after inserting everything? */
252
        /* TODO: put constraints on table after inserting everything? */
245
 
253
 
246
 
254
 
247
        /* 
255
        /* 
248
         * create the create table and insert sql scripts by looping through
256
         * create the create table and insert sql scripts by looping through
249
         * the columns of df
257
         * the columns of df
250
         */
258
         */
251
        types = (int *)R_alloc(ncols, sizeof(int));
259
        types = (int *)R_alloc(ncols, sizeof(int));
252
        sql_len = sprintf(g_sql_buf[0], "create table [%s].sdf_data ([row name] text", iname);
260
        sql_len = sprintf(g_sql_buf[0], "create table [%s].sdf_data ([row name] text", iname);
253
        sql_len2 = sprintf(g_sql_buf[1], "insert into [%s].sdf_data values(?", iname);
261
        sql_len2 = sprintf(g_sql_buf[1], "insert into [%s].sdf_data values(?", iname);
254
 
262
 
255
        for (i = 0; i < ncols; i++) {
263
        for (i = 0; i < ncols; i++) {
256
            col_name = CHAR(STRING_ELT(names, i));
264
            col_name = CHAR(STRING_ELT(names, i));
257
 
265
 
258
            /* add column definition to the create table sql */
266
            /* add column definition to the create table sql */
259
            _expand_buf(0, sql_len+strlen(col_name)+10);
267
            _expand_buf(0, sql_len+strlen(col_name)+10);
260
 
268
 
261
            variable = _getListElement(df, col_name);
269
            variable = _getListElement(df, col_name);
262
            class = CHAR(STRING_ELT(GET_CLASS(variable), 0));
270
            class = CHAR(STRING_ELT(GET_CLASS(variable), 0));
263
            type = TYPEOF(variable);
271
            type = TYPEOF(variable);
264
            types[i] = type;
272
            types[i] = type;
265
 
273
 
266
            sql_len += sprintf(g_sql_buf[0]+sql_len, ", [%s] %s", col_name, 
274
            sql_len += sprintf(g_sql_buf[0]+sql_len, ", [%s] %s", col_name, 
267
                    _get_column_type(class, type));
275
                    _get_column_type(class, type));
268
 
276
 
269
            /* add handler to insert table sql */
277
            /* add handler to insert table sql */
270
            _expand_buf(1, sql_len+5);
278
            _expand_buf(1, sql_len+5);
271
            strcpy(g_sql_buf[1]+sql_len2, ",?");
279
            strcpy(g_sql_buf[1]+sql_len2, ",?");
272
            sql_len2 += 2; 
280
            sql_len2 += 2; 
273
 
281
 
274
            /* create separate table for factors decode */
282
            /* create separate table for factors decode */
275
            if (strcmp(class, "factor") == 0 || strcmp(class, "ordered") == 0){
283
            if (strcmp(class, "factor") == 0 || strcmp(class, "ordered") == 0){
276
                if (_create_factor_table2(iname, class, col_name)) 
284
                if (_create_factor_table2(iname, class, col_name)) 
277
                    return R_NilValue; /* dup tbl name? */
285
                    return R_NilValue; /* dup tbl name? */
278
 
286
 
279
                levels = GET_LEVELS(variable);
287
                levels = GET_LEVELS(variable);
280
                sprintf(g_sql_buf[2], "insert into [%s].[%s %s] values(?, ?);",
288
                sprintf(g_sql_buf[2], "insert into [%s].[%s %s] values(?, ?);",
281
                        iname, class, col_name);
289
                        iname, class, col_name);
282
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, NULL);
290
                res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, NULL);
283
                if (_sqlite_error(res)) return R_NilValue; /* dup tbl name? */
291
                if (_sqlite_error(res)) return R_NilValue; /* dup tbl name? */
284
 
292
 
285
                for (j = 0; j < GET_LENGTH(levels); j++) {
293
                for (j = 0; j < GET_LENGTH(levels); j++) {
286
                    sqlite3_reset(stmt);
294
                    sqlite3_reset(stmt);
287
                    factor = CHAR(STRING_ELT(levels, j));
295
                    factor = CHAR(STRING_ELT(levels, j));
288
                    sqlite3_bind_int(stmt, 1, j+1);
296
                    sqlite3_bind_int(stmt, 1, j+1);
289
                    sqlite3_bind_text(stmt, 2, factor, strlen(factor), SQLITE_STATIC);
297
                    sqlite3_bind_text(stmt, 2, factor, -1, SQLITE_STATIC);
290
                    sqlite3_step(stmt);
298
                    sqlite3_step(stmt);
291
                }
299
                }
292
                sqlite3_finalize(stmt);
300
                sqlite3_finalize(stmt);
293
            }
301
            }
294
        }
302
        }
295
        
303
        
296
        _expand_buf(0,sql_len+35);
304
        _expand_buf(0,sql_len+35);
297
        /* sql_len += sprintf(g_sql_buf[0]+sql_len, ", primary key([row name]));");*/
305
        /* sql_len += sprintf(g_sql_buf[0]+sql_len, ", primary key([row name]));");*/
298
        sql_len += sprintf(g_sql_buf[0]+sql_len, ");");
306
        sql_len += sprintf(g_sql_buf[0]+sql_len, ");");
299
        res = _sqlite_exec(g_sql_buf[0]);
307
        res = _sqlite_exec(g_sql_buf[0]);
300
        if (_sqlite_error(res)) return R_NilValue; /* why? */
308
        if (_sqlite_error(res)) return R_NilValue; /* why? */
301
 
309
 
302
        /*
310
        /*
303
         * add the data in df to the sdf
311
         * add the data in df to the sdf
304
         */
312
         */
305
        SEXP rownames = getAttrib(df, R_RowNamesSymbol);
313
        SEXP rownames = getAttrib(df, R_RowNamesSymbol);
306
        int nrows = GET_LENGTH(rownames);
314
        int nrows = GET_LENGTH(rownames);
307
        char *row_name;
315
        char *row_name;
308
 
316
 
309
        sprintf(g_sql_buf[1]+sql_len2, ")");
317
        sprintf(g_sql_buf[1]+sql_len2, ")");
310
        res = sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt, NULL);
318
        res = sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt, NULL);
311
 
319
 
312
        for (i = 0; i < nrows; i++) {
320
        for (i = 0; i < nrows; i++) {
313
            row_name = CHAR(STRING_ELT(rownames, i));
321
            row_name = CHAR(STRING_ELT(rownames, i));
314
            sqlite3_reset(stmt);
322
            sqlite3_reset(stmt);
315
 
323
 
316
            if (*row_name)
324
            if (*row_name)
317
                sqlite3_bind_text(stmt, 1, row_name, strlen(row_name), SQLITE_STATIC);
325
                sqlite3_bind_text(stmt, 1, row_name, strlen(row_name), SQLITE_STATIC);
318
            else
326
            else
319
                sqlite3_bind_int(stmt, 1, i);
327
                sqlite3_bind_int(stmt, 1, i);
320
 
328
 
321
            for (j = 0; j < ncols; j++) {
329
            for (j = 0; j < ncols; j++) {
322
                variable = VECTOR_ELT(df, j);
330
                variable = VECTOR_ELT(df, j);
323
                switch(types[j]) {
331
                switch(types[j]) {
324
                    case INTSXP : 
332
                    case INTSXP : 
325
                        sqlite3_bind_int(stmt, j+2, INTEGER(variable)[i]);
333
                        sqlite3_bind_int(stmt, j+2, INTEGER(variable)[i]);
326
                        break;
334
                        break;
327
                    case REALSXP:
335
                    case REALSXP:
328
                        sqlite3_bind_double(stmt, j+2, REAL(variable)[i]);
336
                        sqlite3_bind_double(stmt, j+2, REAL(variable)[i]);
329
                        break;
337
                        break;
330
                    case CHARSXP:
338
                    case CHARSXP:
331
                        col_name = CHAR(STRING_ELT(variable,i));
339
                        col_name = CHAR(STRING_ELT(variable,i));
332
                        sqlite3_bind_text(stmt, j+2, col_name, strlen(col_name), SQLITE_STATIC);
340
                        sqlite3_bind_text(stmt, j+2, col_name, strlen(col_name), SQLITE_STATIC);
333
                }
341
                }
334
                /* TODO: handle NA's & NULL's */
342
                /* TODO: handle NA's & NULL's */
335
            }
343
            }
336
 
344
 
337
            res = sqlite3_step(stmt);
345
            res = sqlite3_step(stmt);
338
            if (res != SQLITE_DONE) { 
346
            if (res != SQLITE_DONE) { 
339
                sqlite3_finalize(stmt);
347
                sqlite3_finalize(stmt);
340
                Rprintf("ERROR: %s\n", sqlite3_errmsg(g_workspace));
348
                Rprintf("ERROR: %s\n", sqlite3_errmsg(g_workspace));
341
                return R_NilValue; /* why? */
349
                return R_NilValue; /* why? */
342
            }
350
            }
343
        }
351
        }
344
                
352
                
345
        sqlite3_finalize(stmt);
353
        sqlite3_finalize(stmt);
346
 
354
 
347
        /*
355
        /*
348
         * add the new sdf to the workspace
356
         * add the new sdf to the workspace
349
         */
357
         */
350
        iname[namelen] = '.';
358
        iname[namelen] = '.';
351
        strcpy(g_sql_buf[0], iname);
359
        strcpy(g_sql_buf[0], iname);
352
        iname[namelen] = 0;
360
        iname[namelen] = 0;
353
        res = _add_sdf1(g_sql_buf[0], iname);
361
        res = _add_sdf1(g_sql_buf[0], iname);
354
        if (_sqlite_error(res)) return R_NilValue; /* why? */
362
        if (_sqlite_error(res)) return R_NilValue; /* why? */
355
 
363
 
356
        /*
364
        /*
357
         * create a new object representing the sdf
365
         * create a new object representing the sdf
358
         */
366
         */
359
        ret = _create_sdf_sexp(iname);
367
        ret = _create_sdf_sexp(iname);
360
 
368
 
361
    } else {
369
    } else {
362
        Rprintf("ERROR: cannot find a free internal name for %s", rname);
370
        Rprintf("ERROR: cannot find a free internal name.");
363
        ret = R_NilValue;
371
        ret = R_NilValue;
364
    }
372
    }
365
        
373
        
366
    return ret;
374
    return ret;
367
}
375
}
368
 
376
 
369
SEXP sdf_get_names(SEXP sdf) {
377
SEXP sdf_get_names(SEXP sdf) {
370
    char *iname = SDF_INAME(sdf);
378
    char *iname = SDF_INAME(sdf);
371
    int len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
379
    int len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
372
 
380
 
373
    sqlite3_stmt *stmt;
381
    sqlite3_stmt *stmt;
374
    int res, i;
382
    int res, i;
375
   
383
   
376
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], len, &stmt, NULL);
384
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], len, &stmt, NULL);
377
    if (_sqlite_error(res)) return R_NilValue;
385
    if (_sqlite_error(res)) return R_NilValue;
378
 
386
 
379
    SEXP ret;
387
    SEXP ret;
380
 
388
 
381
    len = sqlite3_column_count(stmt)-1;
389
    len = sqlite3_column_count(stmt)-1;
382
    PROTECT(ret = NEW_CHARACTER(len));
390
    PROTECT(ret = NEW_CHARACTER(len));
383
 
391
 
384
    for (i = 0; i < len; i++) {
392
    for (i = 0; i < len; i++) {
385
        SET_STRING_ELT(ret, i, mkChar(sqlite3_column_name(stmt, i+1)));
393
        SET_STRING_ELT(ret, i, mkChar(sqlite3_column_name(stmt, i+1)));
386
    }
394
    }
387
 
395
 
388
    sqlite3_finalize(stmt);
396
    sqlite3_finalize(stmt);
389
    UNPROTECT(1);
397
    UNPROTECT(1);
390
    return ret;
398
    return ret;
391
}
399
}
392
 
400
 
393
SEXP sdf_get_length(SEXP sdf) {
401
SEXP sdf_get_length(SEXP sdf) {
394
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
402
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
395
    int len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
403
    int len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
396
 
404
 
397
    sqlite3_stmt *stmt;
405
    sqlite3_stmt *stmt;
398
    int res;
406
    int res;
399
   
407
   
400
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], len, &stmt, NULL);
408
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], len, &stmt, NULL);
401
    if (_sqlite_error(res)) return R_NilValue;
409
    if (_sqlite_error(res)) return R_NilValue;
402
 
410
 
403
    SEXP ret;
411
    SEXP ret;
404
 
412
 
405
    len = sqlite3_column_count(stmt)-1;
413
    len = sqlite3_column_count(stmt)-1;
406
    PROTECT(ret = NEW_INTEGER(1));
414
    PROTECT(ret = NEW_INTEGER(1));
407
    INTEGER(ret)[0] = len;
415
    INTEGER(ret)[0] = len;
408
 
416
 
409
    sqlite3_finalize(stmt);
417
    sqlite3_finalize(stmt);
410
    UNPROTECT(1);
418
    UNPROTECT(1);
411
    return ret;
419
    return ret;
412
}
420
}
413
 
421
 
414
/* get row count */
422
/* get row count */
415
SEXP sdf_get_row_count(SEXP sdf) {
423
SEXP sdf_get_row_count(SEXP sdf) {
416
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
424
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
417
    char **out;
425
    char **out;
418
    int res, ncol, nrow;
426
    int res, ncol, nrow;
419
    SEXP ret;
427
    SEXP ret;
420
   
428
   
421
    sprintf(g_sql_buf[0], "select count(*) from [%s].sdf_data;", iname);
429
    sprintf(g_sql_buf[0], "select count(*) from [%s].sdf_data;", iname);
422
    res = sqlite3_get_table(g_workspace, g_sql_buf[0], &out, &nrow, &ncol, NULL);
430
    res = sqlite3_get_table(g_workspace, g_sql_buf[0], &out, &nrow, &ncol, NULL);
423
    if (_sqlite_error(res)) return R_NilValue;
431
    if (_sqlite_error(res)) return R_NilValue;
424
 
432
 
425
 
433
 
426
    if (nrow != 1) ret = R_NilValue;
434
    if (nrow != 1) ret = R_NilValue;
427
    else {
435
    else {
428
        PROTECT(ret = NEW_INTEGER(1));
436
        PROTECT(ret = NEW_INTEGER(1));
429
        INTEGER(ret)[0] = atoi(out[1]);
437
        INTEGER(ret)[0] = atoi(out[1]);
430
        UNPROTECT(1);
438
        UNPROTECT(1);
431
    }
439
    }
432
 
440
 
433
    sqlite3_free_table(out);
441
    sqlite3_free_table(out);
434
    return ret;
442
    return ret;
435
}
443
}
436
 
444
 
437
    
445
    
438
SEXP sdf_import_table(SEXP _filename, SEXP _name, SEXP _sep, SEXP _quote, 
446
SEXP sdf_import_table(SEXP _filename, SEXP _name, SEXP _sep, SEXP _quote, 
439
        SEXP _rownames, SEXP _colnames) {
447
        SEXP _rownames, SEXP _colnames) {
440
    char *filename = CHAR_ELT(_filename, 0);
448
    char *filename = CHAR_ELT(_filename, 0);
441
    FILE *f = fopen(filename, "r");
449
    FILE *f = fopen(filename, "r");
442
 
450
 
443
    if (f == NULL) {
451
    if (f == NULL) {
444
        Rprintf("Error: File %s does not exist.", filename);
452
        Rprintf("Error: File %s does not exist.", filename);
445
        return R_NilValue;
453
        return R_NilValue;
446
    }
454
    }
447
 
455
 
448
    /*char *sep = CHAR_ELT(_sep, 0), *quote = CHAR_ELT(_quote,0);
456
    /*char *sep = CHAR_ELT(_sep, 0), *quote = CHAR_ELT(_quote,0);
449
    char *name = CHAR_ELT(_name, 0);*/
457
    char *name = CHAR_ELT(_name, 0);*/
450
 
458
 
451
    /* create the table */
459
    /* create the table */
452
    /* insert the stuffs */
460
    /* insert the stuffs */
453
    /* register to workspace */
461
    /* register to workspace */
454
 
462
 
455
    return R_NilValue;
463
    return R_NilValue;
456
}
464
}
457
 
465
 
458
SEXP sdf_get_index(SEXP sdf, SEXP row, SEXP col) {
466
SEXP sdf_get_index(SEXP sdf, SEXP row, SEXP col) {
459
    SEXP ret = R_NilValue;
467
    SEXP ret = R_NilValue;
460
    char *iname = SDF_INAME(sdf);
468
    char *iname = SDF_INAME(sdf);
461
    sqlite3_stmt *stmt;
469
    sqlite3_stmt *stmt;
462
    int buflen = 0, idxlen, col_cnt, row_cnt, index;
470
    int buflen = 0, idxlen, col_cnt, row_cnt, index;
463
    int i, j,res;
471
    int i, j,res;
464
    int *col_indices, col_index_len, *dup_indices;
472
    int *col_indices, col_index_len, *dup_indices;
465
    int row_index_len = 0;
473
    int row_index_len = 0;
466
 
474
 
467
    sprintf(g_sql_buf[0], "select * from [%s].sdf_data ", iname);
475
    sprintf(g_sql_buf[0], "select * from [%s].sdf_data ", iname);
468
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
476
    res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
469
    if (_sqlite_error(res)) return R_NilValue;
477
    if (_sqlite_error(res)) return R_NilValue;
470
 
478
 
471
    buflen = sprintf(g_sql_buf[0], "select [row name]");
479
    buflen = sprintf(g_sql_buf[0], "select [row name]");
472
    idxlen = LENGTH(col);
480
    idxlen = LENGTH(col);
473
    col_cnt = sqlite3_column_count(stmt) - 1;
481
    col_cnt = sqlite3_column_count(stmt) - 1;
474
 
482
 
475
    /*
483
    /*
476
     * PROCESS COLUMN INDEX
484
     * PROCESS COLUMN INDEX
477
     */
485
     */
478
    if (col == R_NilValue) {
486
    if (col == R_NilValue) {
479
        for (i = 1; i < col_cnt+1; i++) {
487
        for (i = 1; i < col_cnt+1; i++) {
480
            buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
488
            buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
481
                    sqlite3_column_name(stmt, i)); 
489
                    sqlite3_column_name(stmt, i)); 
482
        }
490
        }
483
        _expand_buf(0, buflen+20+strlen(iname));
491
        _expand_buf(0, buflen+20+strlen(iname));
484
        buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
492
        buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
485
        col_index_len = col_cnt;
493
        col_index_len = col_cnt;
486
        col_indices = (int *)R_alloc(idxlen, sizeof(int));
494
        col_indices = (int *)R_alloc(idxlen, sizeof(int));
487
        dup_indices = (int *)R_alloc(idxlen, sizeof(int));
495
        dup_indices = (int *)R_alloc(idxlen, sizeof(int));
488
        for (i = 0; i < col_cnt; i++) { col_indices[i] = i; dup_indices[i] = 0; }
496
        for (i = 0; i < col_cnt; i++) { col_indices[i] = i; dup_indices[i] = 0; }
489
    } else if (col == R_NilValue || idxlen < 1) {
497
    } else if (col == R_NilValue || idxlen < 1) {
490
        sqlite3_finalize(stmt);
498
        sqlite3_finalize(stmt);
491
        return R_NilValue;
499
        return R_NilValue;
492
    } else if (IS_NUMERIC(col)) {
500
    } else if (IS_NUMERIC(col)) {
493
        col_indices = (int *)R_alloc(idxlen, sizeof(int));
501
        col_indices = (int *)R_alloc(idxlen, sizeof(int));
494
        dup_indices = (int *)R_alloc(idxlen, sizeof(int));
502
        dup_indices = (int *)R_alloc(idxlen, sizeof(int));
495
        col_index_len = 0;
503
        col_index_len = 0;
496
 
504
 
497
        for (i = 0; i < idxlen; i++) {
505
        for (i = 0; i < idxlen; i++) {
498
            /* no need to correct for 0 base because col 0 is [row name] */
506
            /* no need to correct for 0 base because col 0 is [row name] */
499
            index = ((int) REAL(col)[i]); 
507
            index = ((int) REAL(col)[i]); 
500
            if (index > col_cnt) {
508
            if (index > col_cnt) {
501
                sqlite3_finalize(stmt);
509
                sqlite3_finalize(stmt);
502
                Rprintf("Error: undefined columns selected\n");
510
                Rprintf("Error: undefined columns selected\n");
503
                return R_NilValue;
511
                return R_NilValue;
504
            } else if (index > 0) {
512
            } else if (index > 0) {
505
                buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
513
                buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
506
                        sqlite3_column_name(stmt,index));
514
                        sqlite3_column_name(stmt,index));
507
                dup_indices[col_index_len] = 0;
515
                dup_indices[col_index_len] = 0;
508
                for (j = 0; j < col_index_len; j++) {
516
                for (j = 0; j < col_index_len; j++) {
509
                    if (col_indices[j] == index) dup_indices[col_index_len]++;
517
                    if (col_indices[j] == index) dup_indices[col_index_len]++;
510
                }
518
                }
511
                col_indices[col_index_len++] = index;
519
                col_indices[col_index_len++] = index;
512
            } else if (index < 0) {
520
            } else if (index < 0) {
513
                sqlite3_finalize(stmt);
521
                sqlite3_finalize(stmt);
514
                Rprintf("Error: negative indices not supported.\n");
522
                Rprintf("Error: negative indices not supported.\n");
515
                return R_NilValue;
523
                return R_NilValue;
516
            }
524
            }
517
        }
525
        }
518
 
526
 
519
        if (col_index_len == 0) {
527
        if (col_index_len == 0) {
520
            sqlite3_finalize(stmt);
528
            sqlite3_finalize(stmt);
521
            Rprintf("Error: no indices detected??\n");
529
            Rprintf("Error: no indices detected??\n");
522
            return R_NilValue;
530
            return R_NilValue;
523
        } else { 
531
        } else { 
524
            _expand_buf(0, buflen+20+strlen(iname));
532
            _expand_buf(0, buflen+20+strlen(iname));
525
            buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
533
            buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
526
        }
534
        }
527
    } else if (IS_INTEGER(col)) {
535
    } else if (IS_INTEGER(col)) {
528
        /* identical logic with IS_NUMERIC, except that we don't have to cast
536
        /* identical logic with IS_NUMERIC, except that we don't have to cast
529
         * stuffs from SEXP col. the alternative is doing if idxlen times. */
537
         * stuffs from SEXP col. the alternative is doing if idxlen times. */
530
        col_indices = (int *)R_alloc(idxlen, sizeof(int));
538
        col_indices = (int *)R_alloc(idxlen, sizeof(int));
531
        dup_indices = (int *)R_alloc(idxlen, sizeof(int));
539
        dup_indices = (int *)R_alloc(idxlen, sizeof(int));
532
        col_index_len = 0;
540
        col_index_len = 0;
533
 
541
 
534
        for (i = 0; i < idxlen; i++) {
542
        for (i = 0; i < idxlen; i++) {
535
            /* no need to correct for 0 base because col 0 is [row name] */
543
            /* no need to correct for 0 base because col 0 is [row name] */
536
            index = INTEGER(col)[i];
544
            index = INTEGER(col)[i];
537
            if (index > col_cnt) {
545
            if (index > col_cnt) {
538
                sqlite3_finalize(stmt);
546
                sqlite3_finalize(stmt);
539
                Rprintf("Error: undefined columns selected\n");
547
                Rprintf("Error: undefined columns selected\n");
540
                return R_NilValue;
548
                return R_NilValue;
541
            } else if (index > 0) {
549
            } else if (index > 0) {
542
                buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
550
                buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
543
                        sqlite3_column_name(stmt,index));
551
                        sqlite3_column_name(stmt,index));
544
                dup_indices[col_index_len] = 0;
552
                dup_indices[col_index_len] = 0;
545
                for (j = 0; j < col_index_len; j++) {
553
                for (j = 0; j < col_index_len; j++) {
546
                    if (col_indices[j] == index) dup_indices[col_index_len]++;
554
                    if (col_indices[j] == index) dup_indices[col_index_len]++;
547
                }
555
                }
548
                col_indices[col_index_len++] = index;
556
                col_indices[col_index_len++] = index;
549
            } else if (index < 0) {
557
            } else if (index < 0) {
550
                sqlite3_finalize(stmt);
558
                sqlite3_finalize(stmt);
551
                Rprintf("Error: negative indices not supported.\n");
559
                Rprintf("Error: negative indices not supported.\n");
552
                return R_NilValue;
560
                return R_NilValue;
553
            }
561
            }
554
        }
562
        }
555
 
563
 
556
        if (col_index_len == 0) {
564
        if (col_index_len == 0) {
557
            sqlite3_finalize(stmt);
565
            sqlite3_finalize(stmt);
558
            Rprintf("Error: no indices detected??\n");
566
            Rprintf("Error: no indices detected??\n");
559
            return R_NilValue;
567
            return R_NilValue;
560
        } else { 
568
        } else { 
561
            _expand_buf(0, buflen+20+strlen(iname));
569
            _expand_buf(0, buflen+20+strlen(iname));
562
            buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
570
            buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
563
        }
571
        }
564
    } else if (IS_LOGICAL(col)) {
572
    } else if (IS_LOGICAL(col)) {
565
        /* recycling stuff, so max column output is the # of cols in the df */
573
        /* recycling stuff, so max column output is the # of cols in the df */
566
        col_indices = (int *)R_alloc(col_cnt, sizeof(int));
574
        col_indices = (int *)R_alloc(col_cnt, sizeof(int));
567
        dup_indices = (int *)R_alloc(col_cnt, sizeof(int));
575
        dup_indices = (int *)R_alloc(col_cnt, sizeof(int));
568
        col_index_len = 0;
576
        col_index_len = 0;
569
        for (i = 0; i < col_cnt; i++) {
577
        for (i = 0; i < col_cnt; i++) {
570
            if (LOGICAL(col)[i%idxlen]) {
578
            if (LOGICAL(col)[i%idxlen]) {
571
                buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
579
                buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", 
572
                        sqlite3_column_name(stmt,i+1));
580
                        sqlite3_column_name(stmt,i+1));
573
                dup_indices[col_index_len] = 0;
581
                dup_indices[col_index_len] = 0;
574
                col_indices[col_index_len++] = i;
582
                col_indices[col_index_len++] = i;
575
            }
583
            }
576
        }
584
        }
577
 
585
 
578
        if (col_index_len == 0) {
586
        if (col_index_len == 0) {
579
            sqlite3_finalize(stmt);
587
            sqlite3_finalize(stmt);
580
            Rprintf("Warning: no column selected.\n");
588
            Rprintf("Warning: no column selected.\n");
581
            return R_NilValue;
589
            return R_NilValue;
582
        } else { 
590
        } else { 
583
            _expand_buf(0, buflen+20+strlen(iname));
591
            _expand_buf(0, buflen+20+strlen(iname));
584
            buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
592
            buflen += sprintf(g_sql_buf[0]+buflen, " from [%s].sdf_data", iname);
585
        }
593
        }
586
    } else {
594
    } else {
587
        sqlite3_finalize(stmt);
595
        sqlite3_finalize(stmt);
588
        Rprintf("Error: don't know how to handle column index.\n");
596
        Rprintf("Error: don't know how to handle column index.\n");
589
        return R_NilValue;
597
        return R_NilValue;
590
    }
598
    }
591
 
599
 
592
    /* 
600
    /* 
593
     * PROCESS ROW INDEX
601
     * PROCESS ROW INDEX
594
     */
602
     */
595
    idxlen = LENGTH(row);
603
    idxlen = LENGTH(row);
596
    if (row == R_NilValue) {
604
    if (row == R_NilValue) {
597
        if (col_index_len == 1) {
605
        if (col_index_len == 1) {
598
            ret = sdf_get_variable(sdf, mkString(sqlite3_column_name(stmt,col_indices[0])));
606
            ret = sdf_get_variable(sdf, mkString(sqlite3_column_name(stmt,col_indices[0])));
599
            sqlite3_finalize(stmt);
607
            sqlite3_finalize(stmt);
600
            return ret;
608
            return ret;
601
        } if (col_index_len > 1) {
609
        } if (col_index_len > 1) {
602
            /* create a new SDF, logic similar to sdf_create_sdf */
610
            /* create a new SDF, logic similar to sdf_create_sdf */
603
 
611
 
604
            /* we have to close the current statement so we can do
-
 
605
             * edits in the db */
-
 
606
            /* sqlite3_finalize(stmt); */
-
 
607
 
-
 
608
            /* find a new name. data<n> ? */
612
            /* find a new name. data<n> ? */
609
            char *iname2, *rname2;
613
            char *iname2;
610
            const char *colname;
614
            const char *colname;
611
            int namelen, file_idx = 0, sql_len, sql_len2;
615
            int namelen, sql_len, sql_len2;
612
            namelen = _check_sdf_name(R_NilValue, &rname2, &iname2, &file_idx);
-
 
613
 
-
 
614
            if (!namelen) return R_NilValue; 
-
 
615
 
-
 
616
            _find_free_filename(rname2, &iname2, &namelen, &file_idx);
-
 
617
 
-
 
618
            if (file_idx >= 10000) { 
-
 
619
                Rprintf("Error: cannot find free SDF name.\n");
-
 
620
                return R_NilValue;
-
 
621
            }
-
 
622
 
-
 
623
 
616
 
624
            /* create new db by attaching a non-existent file */
-
 
625
            iname2[namelen] = 0; /* remove ".db" */
-
 
626
            sprintf(g_sql_buf[1], "attach '%s.db' as %s", iname2, iname2);
-
 
627
            res = _sqlite_exec(g_sql_buf[1]);
-
 
628
            if (_sqlite_error(res)) return R_NilValue; 
-
 
629
 
-
 
630
            /* create attributes table */
-
 
631
            res = _create_sdf_attribute2(iname2);
617
            iname2 = _create_sdf_skeleton2(R_NilValue, &namelen);
632
            if (_sqlite_error(res)) return R_NilValue; 
-
 
633
 
618
 
634
            /* create sdf_data table */
619
            /* create sdf_data table */
635
            sql_len = sprintf(g_sql_buf[1], "create table [%s].sdf_data ([row name] text", iname2);
620
            sql_len = sprintf(g_sql_buf[1], "create table [%s].sdf_data ([row name] text", iname2);
636
            sql_len2 = 0;
621
            sql_len2 = 0;
637
 
622
 
638
            for (i = 0; i < col_index_len; i++) {
623
            for (i = 0; i < col_index_len; i++) {
639
                colname = sqlite3_column_name(stmt, col_indices[i]);
624
                colname = sqlite3_column_name(stmt, col_indices[i]);
640
                if (dup_indices[i] == 0) {
625
                if (dup_indices[i] == 0) {
641
                    sql_len += sprintf(g_sql_buf[1]+sql_len, ", [%s] %s", colname,
626
                    sql_len += sprintf(g_sql_buf[1]+sql_len, ", [%s] %s", colname,
642
                            sqlite3_column_decltype(stmt, col_indices[i]));
627
                            sqlite3_column_decltype(stmt, col_indices[i]));
643
                } else {
628
                } else {
644
                    /* un-duplicate col names by appending num, just like R */
629
                    /* un-duplicate col names by appending num, just like R */
645
                    sql_len += sprintf(g_sql_buf[1]+sql_len, ", [%s.%d] %s", colname,
630
                    sql_len += sprintf(g_sql_buf[1]+sql_len, ", [%s.%d] %s", colname,
646
                            dup_indices[i], 
631
                            dup_indices[i], 
647
                            sqlite3_column_decltype(stmt, col_indices[i]));
632
                            sqlite3_column_decltype(stmt, col_indices[i]));
648
                }
633
                }
649
 
634
 
650
                /* deal with possibly factor columns */
635
                /* deal with possibly factor columns */
651
                if (_is_factor2(iname, "factor", colname)) {
636
                if (_is_factor2(iname, "factor", colname)) {
652
                    /* found a factor column */
637
                    /* found a factor column */
653
 
638
 
654
                    if (dup_indices[i] == 0)  {
639
                    if (dup_indices[i] == 0)  {
655
                        _copy_factor_levels2("factor", iname, colname, iname2, colname);
640
                        _copy_factor_levels2("factor", iname, colname, iname2, colname);
656
                    } else {
641
                    } else {
657
                        sprintf(g_sql_buf[3], "%s.%d", colname, dup_indices[i]);
642
                        sprintf(g_sql_buf[3], "%s.%d", colname, dup_indices[i]);
658
                        _copy_factor_levels2("factor", iname, colname, iname2, 
643
                        _copy_factor_levels2("factor", iname, colname, iname2, 
659
                                g_sql_buf[3]);
644
                                g_sql_buf[3]);
660
                    }
645
                    }
661
                }
646
                }
662
 
647
 
663
                /* and deal with ordered factors too... life is hard, then you die */
648
                /* and deal with ordered factors too... life is hard, then you die */
664
                if (_is_factor2(iname, "ordered", colname)) {
649
                if (_is_factor2(iname, "ordered", colname)) {
665
                    
650
                    
666
                    if (dup_indices[i] == 0)  {
651
                    if (dup_indices[i] == 0)  {
667
                        _copy_factor_levels2("ordered", iname, colname, iname2, 
652
                        _copy_factor_levels2("ordered", iname, colname, iname2, 
668
                                colname);
653
                                colname);
669
                    } else {
654
                    } else {
670
                        sprintf(g_sql_buf[3], "%s.%d", colname, dup_indices[i]);
655
                        sprintf(g_sql_buf[3], "%s.%d", colname, dup_indices[i]);
671
                        _copy_factor_levels2("ordered", iname, colname, iname2, 
656
                        _copy_factor_levels2("ordered", iname, colname, iname2, 
672
                                g_sql_buf[3]);
657
                                g_sql_buf[3]);
673
                    }
658
                    }
674
                }
659
                }
675
                                
660
                                
676
            }
661
            }
677
 
662
 
678
            /* don't need it anymore */
663
            /* don't need it anymore */
679
            sqlite3_finalize(stmt);
664
            sqlite3_finalize(stmt);
680
 
665
 
681
            /* no table index created, that's for v2 I hope*/
666
            /* no table index created, that's for v2 I hope*/
682
            sql_len += sprintf(g_sql_buf[1]+sql_len, ");");
667
            sql_len += sprintf(g_sql_buf[1]+sql_len, ");");
683
            res = _sqlite_exec(g_sql_buf[1]);
668
            res = _sqlite_exec(g_sql_buf[1]);
684
            if (_sqlite_error(res)) { Rprintf("here? %s\n", g_sql_buf[1]); return R_NilValue; }
669
            if (_sqlite_error(res)) { Rprintf("here? %s\n", g_sql_buf[1]); return R_NilValue; }
685
 
670
 
686
            /* insert data (with row names). buf[0] contains a select */
671
            /* insert data (with row names). buf[0] contains a select */
687
            sprintf(g_sql_buf[1], "insert into [%s].sdf_data %s", iname2,
672
            sprintf(g_sql_buf[1], "insert into [%s].sdf_data %s", iname2,
688
                    g_sql_buf[0]);
673
                    g_sql_buf[0]);
689
            res = _sqlite_exec(g_sql_buf[1]);
674
            res = _sqlite_exec(g_sql_buf[1]);
690
            if (_sqlite_error(res)) return R_NilValue;
675
            if (_sqlite_error(res)) return R_NilValue;
691
 
676
 
692
            /* add new sdf to workspace */
677
            /* add new sdf to workspace */
693
            sprintf(g_sql_buf[0], "%s.db", iname2);
678
            sprintf(g_sql_buf[0], "%s.db", iname2);
694
            res = _add_sdf1(g_sql_buf[0], iname2);
679
            res = _add_sdf1(g_sql_buf[0], iname2);
695
            if (_sqlite_error(res)) return R_NilValue;
680
            if (_sqlite_error(res)) return R_NilValue;
696
 
681
 
697
            /* create SEXP for the SDF */
682
            /* create SEXP for the SDF */
698
            ret = _create_sdf_sexp(iname2);
683
            ret = _create_sdf_sexp(iname2);
699
            return ret;
684
            return ret;
700
        } else { sqlite3_finalize(stmt); return R_NilValue; }
685
        } else { sqlite3_finalize(stmt); return R_NilValue; }
701
    } else if (row == R_NilValue || idxlen < 1) {
686
    } else if (row == R_NilValue || idxlen < 1) {
702
        sqlite3_finalize(stmt);
687
        sqlite3_finalize(stmt);
703
        return R_NilValue;
688
        return R_NilValue;
704
    } else if (IS_NUMERIC(row)) {
689
    } else if (IS_NUMERIC(row)) {
705
        sqlite3_finalize(stmt);
690
        sqlite3_finalize(stmt);
706
 
691
 
707
        sprintf(g_sql_buf[1], "[%s].sdf_data", iname);
692
        sprintf(g_sql_buf[1], "[%s].sdf_data", iname);
708
        row_cnt = _get_row_count2(g_sql_buf[1]);
693
        row_cnt = _get_row_count2(g_sql_buf[1]);
709
 
694
 
710
        /* append " limit ?,1" to the formed select statement */
695
        /* append " limit ?,1" to the formed select statement */
711
        _expand_buf(0, buflen+10);
696
        _expand_buf(0, buflen+10);
712
        buflen += sprintf(g_sql_buf[0]+buflen, " limit ?,1");
697
        buflen += sprintf(g_sql_buf[0]+buflen, " limit ?,1");
713
        /*Rprintf("sql [%d]: %s\n", buflen, g_sql_buf[0]); */
698
        /*Rprintf("sql [%d]: %s\n", buflen, g_sql_buf[0]); */
714
 
699
 
715
        index = ((int) REAL(row)[0]) - 1;
700
        index = ((int) REAL(row)[0]) - 1;
716
        if (idxlen < 0 && idxlen == 1) return R_NilValue;
701
        if (idxlen < 0 && idxlen == 1) return R_NilValue;
717
 
702
 
718
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
703
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
719
        if (_sqlite_error(res)) return R_NilValue;
704
        if (_sqlite_error(res)) return R_NilValue;
720
 
705
 
721
        sqlite3_bind_int(stmt, 1, index);
706
        sqlite3_bind_int(stmt, 1, index);
722
        res = sqlite3_step(stmt);
707
        res = sqlite3_step(stmt);
723
 
708
 
724
        /* create data frame */
709
        /* create data frame */
725
        ret = _setup_df_sexp1(stmt, iname, col_index_len, idxlen, dup_indices);
710
        ret = _setup_df_sexp1(stmt, iname, col_index_len, idxlen, dup_indices);
726
        if (ret == R_NilValue) { sqlite3_finalize(stmt); return R_NilValue; }
711
        if (ret == R_NilValue) { sqlite3_finalize(stmt); return R_NilValue; }
727
 
712
 
728
        /* put data in it */
713
        /* put data in it */
729
        if (index >= 0 && index < row_cnt) {
714
        if (index >= 0 && index < row_cnt) {
730
            _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
715
            _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
731
        }
716
        }
732
 
717
 
733
        for (i = 1; i < idxlen; i++) {
718
        for (i = 1; i < idxlen; i++) {
734
            sqlite3_reset(stmt);
719
            sqlite3_reset(stmt);
735
            index = ((int) REAL(row)[i]) - 1;
720
            index = ((int) REAL(row)[i]) - 1;
736
            if (index >= 0 && index < row_cnt) {
721
            if (index >= 0 && index < row_cnt) {
737
                sqlite3_bind_int(stmt, 1, index);
722
                sqlite3_bind_int(stmt, 1, index);
738
                res = sqlite3_step(stmt);
723
                res = sqlite3_step(stmt);
739
                _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
724
                _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
740
            }
725
            }
741
        }
726
        }
742
        sqlite3_finalize(stmt);
727
        sqlite3_finalize(stmt);
743
 
728
 
744
        /* shrink vectors */
729
        /* shrink vectors */
745
        if (row_index_len < idxlen) {
730
        if (row_index_len < idxlen) {
746
            for (i = 0; i < col_index_len; i++) {
731
            for (i = 0; i < col_index_len; i++) {
747
                SET_VECTOR_ELT(ret, i, 
732
                SET_VECTOR_ELT(ret, i, 
748
                        _shrink_vector(VECTOR_ELT(ret, i), row_index_len));
733
                        _shrink_vector(VECTOR_ELT(ret, i), row_index_len));
749
            }
734
            }
750
        }
735
        }
751
 
736
 
752
        UNPROTECT(1); /* for the ret from _setup_df_sexp1 */
737
        UNPROTECT(1); /* for the ret from _setup_df_sexp1 */
753
    } else if (IS_INTEGER(row)) {
738
    } else if (IS_INTEGER(row)) {
754
        /* same stuff as with IS_INTEGER, except for setting of var index*/
739
        /* same stuff as with IS_INTEGER, except for setting of var index*/
755
        sqlite3_finalize(stmt);
740
        sqlite3_finalize(stmt);
756
 
741
 
757
        sprintf(g_sql_buf[1], "[%s].sdf_data", iname);
742
        sprintf(g_sql_buf[1], "[%s].sdf_data", iname);
758
        row_cnt = _get_row_count2(g_sql_buf[1]);
743
        row_cnt = _get_row_count2(g_sql_buf[1]);
759
 
744
 
760
        /* append " limit ?,1" to the formed select statement */
745
        /* append " limit ?,1" to the formed select statement */
761
        _expand_buf(0, buflen+10);
746
        _expand_buf(0, buflen+10);
762
        buflen += sprintf(g_sql_buf[0]+buflen, " limit ?,1");
747
        buflen += sprintf(g_sql_buf[0]+buflen, " limit ?,1");
763
 
748
 
764
        index = INTEGER(row)[0] - 1;
749
        index = INTEGER(row)[0] - 1;
765
        if (idxlen < 0 && idxlen == 1) return R_NilValue;
750
        if (idxlen < 0 && idxlen == 1) return R_NilValue;
766
 
751
 
767
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
752
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
768
        if (_sqlite_error(res)) return R_NilValue;
753
        if (_sqlite_error(res)) return R_NilValue;
769
 
754
 
770
        sqlite3_bind_int(stmt, 1, index);
755
        sqlite3_bind_int(stmt, 1, index);
771
        res = sqlite3_step(stmt);
756
        res = sqlite3_step(stmt);
772
 
757
 
773
        /* create data frame */
758
        /* create data frame */
774
        ret = _setup_df_sexp1(stmt, iname, col_index_len, idxlen, dup_indices);
759
        ret = _setup_df_sexp1(stmt, iname, col_index_len, idxlen, dup_indices);
775
        if (ret == R_NilValue) { sqlite3_finalize(stmt); return R_NilValue; }
760
        if (ret == R_NilValue) { sqlite3_finalize(stmt); return R_NilValue; }
776
 
761
 
777
        /* put data in it */
762
        /* put data in it */
778
        if (index >= 0 && index < row_cnt) {
763
        if (index >= 0 && index < row_cnt) {
779
            _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
764
            _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
780
        }
765
        }
781
 
766
 
782
        for (i = 1; i < idxlen; i++) {
767
        for (i = 1; i < idxlen; i++) {
783
            sqlite3_reset(stmt);
768
            sqlite3_reset(stmt);
784
            index = INTEGER(row)[i] - 1;
769
            index = INTEGER(row)[i] - 1;
785
            if (index >= 0 && index < row_cnt) {
770
            if (index >= 0 && index < row_cnt) {
786
                sqlite3_bind_int(stmt, 1, index);
771
                sqlite3_bind_int(stmt, 1, index);
787
                res = sqlite3_step(stmt); 
772
                res = sqlite3_step(stmt); 
788
                _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
773
                _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
789
            }
774
            }
790
        }
775
        }
791
        sqlite3_finalize(stmt);
776
        sqlite3_finalize(stmt);
792
 
777
 
793
        /* shrink vectors */
778
        /* shrink vectors */
794
        if (row_index_len < idxlen) {
779
        if (row_index_len < idxlen) {
795
            for (i = 0; i < col_index_len; i++) {
780
            for (i = 0; i < col_index_len; i++) {
796
                SET_VECTOR_ELT(ret, i, 
781
                SET_VECTOR_ELT(ret, i, 
797
                        _shrink_vector(VECTOR_ELT(ret, i), row_index_len));
782
                        _shrink_vector(VECTOR_ELT(ret, i), row_index_len));
798
            }
783
            }
799
        }
784
        }
800
        UNPROTECT(1); /* for the ret from _setup_df_sexp1 */
785
        UNPROTECT(1); /* for the ret from _setup_df_sexp1 */
801
    } else if (IS_LOGICAL(row)) {
786
    } else if (IS_LOGICAL(row)) {
802
        /* */
787
        /* */
803
        sqlite3_finalize(stmt);
788
        sqlite3_finalize(stmt);
804
        int est_row_cnt = 0;
789
        int est_row_cnt = 0;
805
 
790
 
806
        sprintf(g_sql_buf[1], "[%s].sdf_data", iname);
791
        sprintf(g_sql_buf[1], "[%s].sdf_data", iname);
807
        row_cnt = _get_row_count2(g_sql_buf[1]);
792
        row_cnt = _get_row_count2(g_sql_buf[1]);
808
 
793
 
809
        /* append " limit ?,1" to the formed select statement */
794
        /* append " limit ?,1" to the formed select statement */
810
        _expand_buf(0, buflen+10);
795
        _expand_buf(0, buflen+10);
811
        buflen += sprintf(g_sql_buf[0]+buflen, " limit ?,1");
796
        buflen += sprintf(g_sql_buf[0]+buflen, " limit ?,1");
812
 
797
 
813
        /* find if there is any TRUE element in the vector */
798
        /* find if there is any TRUE element in the vector */
814
        for (i = 0; i < idxlen && i < row_cnt; i++) {
799
        for (i = 0; i < idxlen && i < row_cnt; i++) {
815
            if (LOGICAL(row)[i]) break;
800
            if (LOGICAL(row)[i]) break;
816
        }
801
        }
817
 
802
 
818
        if (i < idxlen && i < row_cnt) {
803
        if (i < idxlen && i < row_cnt) {
819
            est_row_cnt = (idxlen-i) * (row_cnt/idxlen);
804
            est_row_cnt = (idxlen-i) * (row_cnt/idxlen);
820
            if (row_cnt%idxlen > i) est_row_cnt += (row_cnt%idxlen - i);
805
            if (row_cnt%idxlen > i) est_row_cnt += (row_cnt%idxlen - i);
821
 
806
 
822
            res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
807
            res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
823
            if (_sqlite_error(res)) return R_NilValue;
808
            if (_sqlite_error(res)) return R_NilValue;
824
 
809
 
825
            sqlite3_bind_int(stmt, 1, i);
810
            sqlite3_bind_int(stmt, 1, i);
826
            sqlite3_step(stmt);
811
            sqlite3_step(stmt);
827
            ret = _setup_df_sexp1(stmt, iname, col_index_len, est_row_cnt, dup_indices);
812
            ret = _setup_df_sexp1(stmt, iname, col_index_len, est_row_cnt, dup_indices);
828
            _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
813
            _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
829
            
814
            
830
            for (i++ ; i < row_cnt; i++) {
815
            for (i++ ; i < row_cnt; i++) {
831
                if (LOGICAL(row)[i%idxlen]) {
816
                if (LOGICAL(row)[i%idxlen]) {
832
                    sqlite3_reset(stmt);
817
                    sqlite3_reset(stmt);
833
                    sqlite3_bind_int(stmt, 1, i);
818
                    sqlite3_bind_int(stmt, 1, i);
834
                    sqlite3_step(stmt);
819
                    sqlite3_step(stmt);
835
                    _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
820
                    _add_row_to_df(ret, stmt, row_index_len++, col_index_len);
836
                }
821
                }
837
            }
822
            }
838
        }
823
        }
839
 
824
 
840
        sqlite3_finalize(stmt);
825
        sqlite3_finalize(stmt);
841
 
826
 
842
        /* shrink vectors */
827
        /* shrink vectors */
843
        if (est_row_cnt > 0 && row_index_len < est_row_cnt) {
828
        if (est_row_cnt > 0 && row_index_len < est_row_cnt) {
844
            for (i = 0; i < col_index_len; i++) {
829
            for (i = 0; i < col_index_len; i++) {
845
                SET_VECTOR_ELT(ret, i, 
830
                SET_VECTOR_ELT(ret, i, 
846
                        _shrink_vector(VECTOR_ELT(ret, i), row_index_len));
831
                        _shrink_vector(VECTOR_ELT(ret, i), row_index_len));
847
            }
832
            }
848
        }
833
        }
849
 
834
 
850
        UNPROTECT(1); /* for the ret from _setup_df_sexp1 */
835
        UNPROTECT(1); /* for the ret from _setup_df_sexp1 */
851
    }
836
    }
852
 
837
 
853
    if (ret != R_NilValue && col_index_len > 1) {
838
    if (ret != R_NilValue && col_index_len > 1) {
854
        SEXP class = mkString("data.frame");
839
        SEXP class = mkString("data.frame");
855
        SET_CLASS(ret, class);
840
        SET_CLASS(ret, class);
856
        _set_rownames2(ret);
841
        _set_rownames2(ret);
857
    } else if (ret != R_NilValue && col_index_len == 1) {
842
    } else if (ret != R_NilValue && col_index_len == 1) {
858
        ret = VECTOR_ELT(ret, 0);
843
        ret = VECTOR_ELT(ret, 0);
859
    }
844
    }
860
 
845
 
861
    return ret;
846
    return ret;
862
}
847
}
863
 
848
 
864
 
849
 
865
SEXP sopen(SEXP name) {
850
SEXP sopen(SEXP name) {
866
    char *filename;
851
    char *filename;
867
    
852
    
868
    if (IS_CHARACTER(name)) {
853
    if (IS_CHARACTER(name)) {
869
        filename = CHAR(STRING_ELT(name,0));
854
        filename = CHAR(STRING_ELT(name,0));
870
        Rprintf("%s\n", filename);
855
        Rprintf("%s\n", filename);
871
    }
856
    }
872
    /* sqlite3 *db;
857
    /* sqlite3 *db;
873
    int res = sqlite3_open(filename, &db); */
858
    int res = sqlite3_open(filename, &db); */
874
    SEXP ret;
859
    SEXP ret;
875
    PROTECT(ret = NEW_LOGICAL(1));
860
    PROTECT(ret = NEW_LOGICAL(1));
876
    LOGICAL(ret)[0] = IS_CHARACTER(name);
861
    LOGICAL(ret)[0] = IS_CHARACTER(name);
877
    /* sqlite3_close(db); */ 
862
    /* sqlite3_close(db); */ 
878
    UNPROTECT(1);
863
    UNPROTECT(1);
879
    return ret;
864
    return ret;
880
}
865
}