The R Project SVN R-packages

Rev

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

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