The R Project SVN R-packages

Rev

Rev 3255 | Rev 3282 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

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