The R Project SVN R-packages

Rev

Rev 4160 | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 4160 Rev 4798
Line 5... Line 5...
5
 * UTILITY FUNCTIONS
5
 * UTILITY FUNCTIONS
6
 ****************************************************************************/
6
 ****************************************************************************/
7
 
7
 
8
/* if user supplied a name (1st arg), return that name. otherwise, use the 
8
/* if user supplied a name (1st arg), return that name. otherwise, use the 
9
 * default "data". rname is R name, iname is internal name */
9
 * default "data". rname is R name, iname is internal name */
10
static int _check_sdf_name(SEXP name, char **rname, char **iname, int *file_idx) {
10
static int _check_sdf_name(SEXP name, const char **rname, char **iname, int *file_idx) {
11
    int namelen = 0;
11
    int namelen = 0;
12
 
12
 
13
    /* check if arg name is supplied */
13
    /* check if arg name is supplied */
14
    if (name == R_NilValue) {
14
    if (name == R_NilValue) {
15
        *rname = "data";
15
        *rname = "data";
Line 29... Line 29...
29
        Rprintf("Error: the supplied value for arg name is not a string.\n");
29
        Rprintf("Error: the supplied value for arg name is not a string.\n");
30
    }
30
    }
31
    return namelen;
31
    return namelen;
32
}
32
}
33
 
33
 
34
static int _find_free_filename2(char *rname, char *dirname, char **iname, int *namelen, int *file_idx) {
34
static int _find_free_filename2(const char *rname, char *dirname, char **iname, 
-
 
35
                                int *namelen, int *file_idx) {
35
    sqlite3_stmt *stmt;
36
    sqlite3_stmt *stmt;
36
    char *tmp_iname;
37
    char *tmp_iname;
37
    sqlite3_prepare(g_workspace, "select 1 from workspace where internal_name=?", -1,
38
    sqlite3_prepare(g_workspace, "select 1 from workspace where internal_name=?", -1,
38
            &stmt, NULL);
39
            &stmt, NULL);
39
    do {
40
    do {
Line 69... Line 70...
69
    }
70
    }
70
    return res;
71
    return res;
71
}
72
}
72
 
73
 
73
char *_create_sdf_skeleton1(SEXP name, int *onamelen, int protect) {
74
char *_create_sdf_skeleton1(SEXP name, int *onamelen, int protect) {
-
 
75
    const char *rname;
74
    char *iname, *rname;
76
    char *iname;
75
    int namelen, file_idx = 0, res;
77
    int namelen, file_idx = 0, res;
76
 
78
 
77
    namelen = _check_sdf_name(name, &rname, &iname, &file_idx);
79
    namelen = _check_sdf_name(name, &rname, &iname, &file_idx);
78
 
80
 
79
    if (!namelen) return NULL;
81
    if (!namelen) return NULL;
Line 257... Line 259...
257
        sqlite3_stmt *stmt;
259
        sqlite3_stmt *stmt;
258
 
260
 
259
        /* create sdf_data table */
261
        /* create sdf_data table */
260
        SEXP names = GET_NAMES(df), variable, levels, var_class;
262
        SEXP names = GET_NAMES(df), variable, levels, var_class;
261
        int ncols = GET_LENGTH(names), type, *types;
263
        int ncols = GET_LENGTH(names), type, *types;
262
        char *col_name, *class, *factor;
264
        const char *col_name, *class, *factor;
263
 
265
 
264
        /* variables for adding rownames */
266
        /* variables for adding rownames */
265
        SEXP rownames;
267
        SEXP rownames;
266
        int nrows;
268
        int nrows;
267
        char *row_name;
269
        const char *row_name;
268
 
270
 
269
        /* TODO: put constraints on table after inserting everything? */
271
        /* TODO: put constraints on table after inserting everything? */
270
 
272
 
271
 
273
 
272
        /* 
274
        /* 
Line 394... Line 396...
394
        
396
        
395
    return ret;
397
    return ret;
396
}
398
}
397
 
399
 
398
SEXP sdf_get_names(SEXP sdf) {
400
SEXP sdf_get_names(SEXP sdf) {
399
    char *iname;
401
    const char *iname;
400
    iname = SDF_INAME(sdf);
402
    iname = SDF_INAME(sdf);
401
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
403
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
402
 
404
 
403
    int len;
405
    int len;
404
    len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
406
    len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
Line 422... Line 424...
422
    UNPROTECT(1);
424
    UNPROTECT(1);
423
    return ret;
425
    return ret;
424
}
426
}
425
 
427
 
426
SEXP sdf_get_length(SEXP sdf) {
428
SEXP sdf_get_length(SEXP sdf) {
427
    char *iname;
429
    const char *iname;
428
    int len;
430
    int len;
429
    sqlite3_stmt *stmt;
431
    sqlite3_stmt *stmt;
430
    int res;
432
    int res;
431
 
433
 
432
    iname  = SDF_INAME(sdf); 
434
    iname  = SDF_INAME(sdf); 
Line 441... Line 443...
441
    return ScalarInteger(len);
443
    return ScalarInteger(len);
442
}
444
}
443
 
445
 
444
/* get row count */
446
/* get row count */
445
SEXP sdf_get_row_count(SEXP sdf) {
447
SEXP sdf_get_row_count(SEXP sdf) {
446
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
448
    const char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
447
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
449
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
448
 
450
 
449
    int nrow;
451
    int nrow;
450
    SEXP ret;
452
    SEXP ret;
451
   
453
   
Line 458... Line 460...
458
}
460
}
459
 
461
 
460
    
462
    
461
SEXP sdf_import_table(SEXP _filename, SEXP _name, SEXP _sep, SEXP _quote, 
463
SEXP sdf_import_table(SEXP _filename, SEXP _name, SEXP _sep, SEXP _quote, 
462
        SEXP _rownames, SEXP _colnames) {
464
        SEXP _rownames, SEXP _colnames) {
463
    char *filename = CHAR_ELT(_filename, 0);
465
    const char *filename = CHAR_ELT(_filename, 0);
464
    FILE *f = fopen(filename, "r");
466
    FILE *f = fopen(filename, "r");
465
 
467
 
466
    if (f == NULL) {
468
    if (f == NULL) {
467
        Rprintf("Error: File %s does not exist.", filename);
469
        Rprintf("Error: File %s does not exist.", filename);
468
        return R_NilValue;
470
        return R_NilValue;
Line 478... Line 480...
478
    return R_NilValue;
480
    return R_NilValue;
479
}
481
}
480
 
482
 
481
SEXP sdf_get_index(SEXP sdf, SEXP row, SEXP col, SEXP new_sdf) {
483
SEXP sdf_get_index(SEXP sdf, SEXP row, SEXP col, SEXP new_sdf) {
482
    SEXP ret = R_NilValue;
484
    SEXP ret = R_NilValue;
483
    char *iname = SDF_INAME(sdf);
485
    const char *iname = SDF_INAME(sdf);
484
    sqlite3_stmt *stmt;
486
    sqlite3_stmt *stmt;
485
    int buflen = 0, idxlen, col_cnt, row_cnt, index;
487
    int buflen = 0, idxlen, col_cnt, row_cnt, index;
486
    int i, j,res;
488
    int i, j,res;
487
    int *col_indices = NULL, col_index_len = 0, *dup_indices = NULL;
489
    int *col_indices = NULL, col_index_len = 0, *dup_indices = NULL;
488
    int row_index_len = 0, force_new_df = LOGICAL(new_sdf)[0];
490
    int row_index_len = 0, force_new_df = LOGICAL(new_sdf)[0];
Line 867... Line 869...
867
 
869
 
868
    return ret;
870
    return ret;
869
}
871
}
870
 
872
 
871
SEXP sdf_rbind(SEXP sdf, SEXP data) {
873
SEXP sdf_rbind(SEXP sdf, SEXP data) {
872
    char *class;
-
 
873
    char *iname = SDF_INAME(sdf), *colname;
874
    const char *iname = SDF_INAME(sdf), *class, *colname;
874
    SEXP ret = R_NilValue, col, names, levels, rownames;
875
    SEXP ret = R_NilValue, col, names, levels, rownames;
875
    int ncols, buflen, buflen2, i, j, res, nrows, *types, rownames_type;
876
    int ncols, buflen, buflen2, i, j, res, nrows, *types, rownames_type;
876
    sqlite3_stmt *stmt;
877
    sqlite3_stmt *stmt;
877
    const char *type;
878
    const char *type, *rn_str; 
878
    char *rn_str; 
-
 
879
 
879
 
880
    class = CHAR_ELT(GET_CLASS(data), 0);
880
    class = CHAR_ELT(GET_CLASS(data), 0);
881
    if (strcmp(class,"data.frame") == 0) {
881
    if (strcmp(class,"data.frame") == 0) {
882
        /* check table names, types. variables may not be in same order, as
882
        /* check table names, types. variables may not be in same order, as
883
         * long as names and types are identical. */
883
         * long as names and types are identical. */
Line 1050... Line 1050...
1050
    return ret;
1050
    return ret;
1051
}
1051
}
1052
 
1052
 
1053
 
1053
 
1054
SEXP sdf_get_iname(SEXP sdf) {
1054
SEXP sdf_get_iname(SEXP sdf) {
-
 
1055
    const char *iname;
1055
    char *iname, *sql;
1056
    char *sql;
1056
    sqlite3_stmt *stmt;
1057
    sqlite3_stmt *stmt;
1057
    SEXP ret, names;
1058
    SEXP ret, names;
1058
 
1059
 
1059
    iname = SDF_INAME(sdf);
1060
    iname = SDF_INAME(sdf);
1060
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
1061
    if (!USE_SDF1(iname, TRUE, FALSE)) return R_NilValue;
Line 1079... Line 1080...
1079
 
1080
 
1080
    return ret;
1081
    return ret;
1081
}
1082
}
1082
 
1083
 
1083
SEXP sdf_select(SEXP sdf, SEXP select, SEXP where, SEXP limit, SEXP debug) {
1084
SEXP sdf_select(SEXP sdf, SEXP select, SEXP where, SEXP limit, SEXP debug) {
1084
    char *iname, *tmp;
1085
    const char *iname, *tmp;
1085
    sqlite3_stmt *stmt;
1086
    sqlite3_stmt *stmt;
1086
    int buflen0 = 0, buflen1 = 0, len, nrows, res;
1087
    int buflen0 = 0, buflen1 = 0, len, nrows, res;
1087
    SEXP ret = NULL;
1088
    SEXP ret = NULL;
1088
    int dbg = LOGICAL(debug)[0];
1089
    int dbg = LOGICAL(debug)[0];
1089
 
1090