The R Project SVN R-packages

Rev

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

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