The R Project SVN R-packages

Rev

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