The R Project SVN R-packages

Rev

Rev 3308 | Rev 3358 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 3308 Rev 3324
Line 78... Line 78...
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_SDF(iname)) { _delete_sdf2(iname); return NULL; }
 83 
    if (!USE_SDF(iname, FALSE)) { /* _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)) {
Line 253... Line 253...
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 */
- 
 
 259 
        SEXP rownames;
- 
 
 260 
        int nrows;
- 
 
 261 
        char *row_name;
- 
 
 262 
 
258 
        /* TODO: put constraints on table after inserting everything? */
 263 
        /* TODO: put constraints on table after inserting everything? */
259 
 
 264 
 
260 
 
 265 
 
261 
        /*
266 
        /*
262 
         * create the create table and insert sql scripts by looping through
 267 
         * create the create table and insert sql scripts by looping through
Line 306... Line 311...
306 
                sqlite3_finalize(stmt);
 311 
                sqlite3_finalize(stmt);
307 
            }
 312 
            }
308 
        }
 313 
        }
309
314
310 
        _expand_buf(0,sql_len+35);
 315 
        _expand_buf(0,sql_len+35);
311 
        /* sql_len += sprintf(g_sql_buf[0]+sql_len, ", primary key([row name]));");*/
 316 
        sql_len += sprintf(g_sql_buf[0]+sql_len, ", primary key([row name]));");
312 
        sql_len += sprintf(g_sql_buf[0]+sql_len, ");");
 317 
        /* sql_len += sprintf(g_sql_buf[0]+sql_len, ");"); */
313 
        res = _sqlite_exec(g_sql_buf[0]);
 318 
        res = _sqlite_exec(g_sql_buf[0]);
314 
        if (_sqlite_error(res)) return R_NilValue; /* why? */
 319 
        if (_sqlite_error(res)) return R_NilValue; /* why? */
315 
 
 320 
 
316 
        /*
 321 
        /*
317 
         * add the data in df to the sdf
 322 
         * add the data in df to the sdf
318 
         */
 323 
         */
319 
        SEXP rownames = getAttrib(df, R_RowNamesSymbol);
 324 
        rownames = getAttrib(df, R_RowNamesSymbol);
320 
        int nrows = GET_LENGTH(rownames);
 325 
        nrows = GET_LENGTH(rownames);
321 
        char *row_name;
 - 
 
322 
 
 326 
 
323 
        sprintf(g_sql_buf[1]+sql_len2, ")");
 327 
        sprintf(g_sql_buf[1]+sql_len2, ")");
324 
        res = sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt, NULL);
 328 
        res = sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt, NULL);
325 
 
 329 
 
326 
        for (i = 0; i < nrows; i++) {
 330 
        for (i = 0; i < nrows; i++) {
327 
            row_name = CHAR(STRING_ELT(rownames, i));
 - 
 
328 
            sqlite3_reset(stmt);
 331 
            sqlite3_reset(stmt);
329 
 
 332 
 
- 
 
 333 
            /* since this is coming from a real dataframe, we're assured that
- 
 
 334 
             * the rownames are unique */
330 
            if (*row_name)
 335 
            if (IS_CHARACTER(rownames)) {
- 
 
 336 
                row_name = CHAR(STRING_ELT(rownames, i));
- 
 
 337 
                if (*row_name) /* if not empty string */
331 
                sqlite3_bind_text(stmt, 1, row_name, strlen(row_name), SQLITE_STATIC);
 338 
                    sqlite3_bind_text(stmt, 1, row_name, strlen(row_name), SQLITE_STATIC);
- 
 
 339 
                else sqlite3_bind_int(stmt, 1, i);
332 
            else
 340 
            } else if (IS_INTEGER(rownames)) {
- 
 
 341 
                sqlite3_bind_int(stmt, 1, INTEGER(rownames)[i]);
333 
                sqlite3_bind_int(stmt, 1, i);
 342 
            } else sqlite3_bind_int(stmt, 1, i);
334 
 
 343 
 
335 
            for (j = 0; j < ncols; j++) {
 344 
            for (j = 0; j < ncols; j++) {
336 
                variable = VECTOR_ELT(df, j);
 345 
                variable = VECTOR_ELT(df, j);
337 
                switch(types[j]) {
 346 
                switch(types[j]) {
338 
                    case INTSXP :
347 
                    case INTSXP :
Line 370... Line 379...
370 
}
 379 
}
371 
 
 380 
 
372 
SEXP sdf_get_names(SEXP sdf) {
 381 
SEXP sdf_get_names(SEXP sdf) {
373 
    char *iname;
 382 
    char *iname;
374 
    iname = SDF_INAME(sdf);
 383 
    iname = SDF_INAME(sdf);
375 
    if (!USE_SDF(iname)) return R_NilValue;
 384 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
376 
 
 385 
 
377 
    int len;
 386 
    int len;
378 
    len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
 387 
    len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
379 
 
 388 
 
380 
    sqlite3_stmt *stmt;
 389 
    sqlite3_stmt *stmt;
Line 398... Line 407...
398 
}
 407 
}
399 
 
 408 
 
400 
SEXP sdf_get_length(SEXP sdf) {
 409 
SEXP sdf_get_length(SEXP sdf) {
401 
    char *iname;
 410 
    char *iname;
402 
    iname  = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
 411 
    iname  = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
403 
    if (!USE_SDF(iname)) return R_NilValue;
 412 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
404 
 
 413 
 
405 
    int len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
 414 
    int len = sprintf(g_sql_buf[0], "select * from [%s].sdf_data;", iname);
406 
 
 415 
 
407 
    sqlite3_stmt *stmt;
 416 
    sqlite3_stmt *stmt;
408 
    int res;
 417 
    int res;
Line 422... Line 431...
422 
}
 431 
}
423 
 
 432 
 
424 
/* get row count */
 433 
/* get row count */
425 
SEXP sdf_get_row_count(SEXP sdf) {
 434 
SEXP sdf_get_row_count(SEXP sdf) {
426 
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
 435 
    char *iname = CHAR(STRING_ELT(_getListElement(sdf, "iname"),0));
427 
    if (!USE_SDF(iname)) return R_NilValue;
 436 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
428 
 
 437 
 
429 
    char **out;
 438 
    char **out;
430 
    int res, ncol, nrow;
 439 
    int res, ncol, nrow;
431 
    SEXP ret;
 440 
    SEXP ret;
432
441
Line 468... Line 477...
468 
}
 477 
}
469 
 
 478 
 
470 
SEXP sdf_get_index(SEXP sdf, SEXP row, SEXP col) {
 479 
SEXP sdf_get_index(SEXP sdf, SEXP row, SEXP col) {
471 
    SEXP ret = R_NilValue;
 480 
    SEXP ret = R_NilValue;
472 
    char *iname = SDF_INAME(sdf);
 481 
    char *iname = SDF_INAME(sdf);
473 
    if (!USE_SDF(iname)) return R_NilValue;
 482 
    if (!USE_SDF(iname, TRUE)) return R_NilValue;
474 
 
 483 
 
475 
    sqlite3_stmt *stmt;
 484 
    sqlite3_stmt *stmt;
476 
    int buflen = 0, idxlen, col_cnt, row_cnt, index;
 485 
    int buflen = 0, idxlen, col_cnt, row_cnt, index;
477 
    int i, j,res;
 486 
    int i, j,res;
478 
    int *col_indices, col_index_len, *dup_indices;
 487 
    int *col_indices, col_index_len, *dup_indices;
Line 850... Line 859...
850 
    }
 859 
    }
851 
 
 860 
 
852 
    return ret;
 861 
    return ret;
853 
}
 862 
}
854 
 
 863 
 
- 
 
 864 
SEXP sdf_rbind(SEXP sdf, SEXP data) {
- 
 
 865 
    char *class = CHAR_ELT(data, 0);
- 
 
 866 
    char *iname = SDF_INAME(sdf), *colname;
- 
 
 867 
    SEXP ret = R_NilValue, col, names, levels;
- 
 
 868 
    int len, buflen, buflen2, i, j, res, type, nrows;
- 
 
 869 
    sqlite3_stmt *stmt;
- 
 
 870 
 
- 
 
 871 
    if (strcmp(class,"data.frame") == 0) {
- 
 
 872 
        /* check table names, types. variables may not be in same order, as
- 
 
 873 
         * long as names and types are identical. */
- 
 
 874 
        names = GET_NAMES(data);
- 
 
 875 
        len = GET_LENGTH(names);
- 
 
 876 
 
- 
 
 877 
        buflen = sprintf(g_sql_buf[0], "select 1");
- 
 
 878 
        for (i = 0; i < len; i++) {
- 
 
 879 
            _expand_buf(0, buflen + 100);
- 
 
 880 
            buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", CHAR_ELT(names, i));
- 
 
 881 
        }
- 
 
 882 
        _expand_buf(0, buflen + 100);
- 
 
 883 
        sprintf(g_sql_buf[0]+buflen, " from %s", iname);
- 
 
 884 
 
- 
 
 885 
        res = sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
- 
 
 886 
        if (res != SQLITE_OK) { /* column name mismatch */
- 
 
 887 
            Rprintf("Error: column names should exactly match the names of the SDF.\n");
- 
 
 888 
            return ret;
- 
 
 889 
        }
- 
 
 890 
 
- 
 
 891 
        /* now check the type */
- 
 
 892 
        sqlite3_step(stmt);
- 
 
 893 
        for (i = 0; i< len; i++) {
- 
 
 894 
            do {
- 
 
 895 
                type = sqlite3_column_type(stmt, i+1);
- 
 
 896 
            } while((type == SQLITE_NULL) && (sqlite3_step(stmt) != SQLITE_DONE));
- 
 
 897 
 
- 
 
 898 
            if (type == SQLITE_NULL) {
- 
 
 899 
                Rprintf("Error: can't figure out type of col %d because all rows are NULL."
- 
 
 900 
                        " There is still a way to figure out type, but I'm bailing out.", i);
- 
 
 901 
                sqlite3_finalize(stmt);
- 
 
 902 
                return ret;
- 
 
 903 
            }
- 
 
 904 
 
- 
 
 905 
            col = VECTOR_ELT(data, i);
- 
 
 906 
            class = CHAR_ELT(GET_CLASS(col),0);
- 
 
 907 
            if ((type == SQLITE_FLOAT && !IS_NUMERIC(col)) ||
- 
 
 908 
                (type == SQLITE_TEXT && !IS_CHARACTER(col)) ||
- 
 
 909 
                (type == SQLITE_INTEGER && !IS_INTEGER(col))) break;
- 
 
 910 
 
- 
 
 911 
            /* additional tests for int */
- 
 
 912 
            if (type == SQLITE_INTEGER) {
- 
 
 913 
                colname = CHAR_ELT(names, i);
- 
 
 914 
 
- 
 
 915 
                /* test if the sdf column is indeed a factor */
- 
 
 916 
                if (strcmp(class,"factor") == 0) {
- 
 
 917 
                    sqlite3_stmt *stmt2;
- 
 
 918 
                    if (!_is_factor2(iname, "factor", colname)) break;
- 
 
 919 
                    sprintf(g_sql_buf[1], "[%s].[factor %s]", iname, colname);
- 
 
 920 
                    nrows = _get_row_count2(g_sql_buf[1]);
- 
 
 921 
 
- 
 
 922 
                    levels = GET_LEVELS(col);
- 
 
 923 
                    if (nrows < GET_LENGTH(levels)) {
- 
 
 924 
                        Rprintf("Error: The data frame variable %s has more levels than"
- 
 
 925 
                                " its SDF counterpart.\n", colname);
- 
 
 926 
                        break;
- 
 
 927 
                    }
- 
 
 928 
 
- 
 
 929 
                    sprintf(g_sql_buf[2], "select label from %s ordered by level", g_sql_buf[1]);
- 
 
 930 
                    sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, NULL);
- 
 
 931
- 
 
 932 
                    for (j = 0; j < nrows; j++)  {
- 
 
 933 
                        sqlite3_step(stmt2);
- 
 
 934 
                        if (strcmp((char *)sqlite3_column_text(stmt2, 0), CHAR_ELT(levels, j)) == 0) {
- 
 
 935 
                            Rprintf("Error: Level label mismatch in variable %s, [%s] in data frame"
- 
 
 936 
                                    " vs [%s] in SDF.\n", colname, (char *)sqlite3_column_text(stmt2, 0),
- 
 
 937 
                                    CHAR_ELT(levels, j));
- 
 
 938 
                            break;
- 
 
 939 
                        }
- 
 
 940 
                    }
- 
 
 941 
 
- 
 
 942 
                    if (j < nrows); break;
- 
 
 943 
 
- 
 
 944 
                }  else if (strcmp(class,"ordered") == 0) { /* same with ordered */
- 
 
 945 
                    sqlite3_stmt *stmt2;
- 
 
 946 
                    if (!_is_factor2(iname, "ordered", colname)) break;
- 
 
 947 
                    sprintf(g_sql_buf[1], "[%s].[ordered %s]", iname, colname);
- 
 
 948 
                    nrows = _get_row_count2(g_sql_buf[1]);
- 
 
 949 
 
- 
 
 950 
                    levels = GET_LEVELS(col);
- 
 
 951 
                    if (nrows < GET_LENGTH(levels)) {
- 
 
 952 
                        Rprintf("Error: The data frame variable %s has more levels than"
- 
 
 953 
                                " its SDF counterpart.\n", colname);
- 
 
 954 
                        break;
- 
 
 955 
                    }
- 
 
 956 
 
- 
 
 957 
                    sprintf(g_sql_buf[2], "select label from %s ordered by level", g_sql_buf[1]);
- 
 
 958 
                    sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt2, NULL);
- 
 
 959
- 
 
 960 
                    for (j = 0; j < nrows; j++)  {
- 
 
 961 
                        sqlite3_step(stmt2);
- 
 
 962 
                        if (strcmp((char *)sqlite3_column_text(stmt2, 0), CHAR_ELT(levels, j)) == 0) {
- 
 
 963 
                            Rprintf("Error: Level label mismatch in variable %s, [%s] in data frame"
- 
 
 964 
                                    " vs [%s] in SDF.\n", colname, (char *)sqlite3_column_text(stmt2, 0),
- 
 
 965 
                                    CHAR_ELT(levels, j));
- 
 
 966 
                            break;
- 
 
 967 
                        }
- 
 
 968 
                    }
- 
 
 969 
 
- 
 
 970 
                    if (j < nrows); break;
- 
 
 971 
 
- 
 
 972 
                }  /* else if class == "ordered" */
- 
 
 973 
            } /* if integer */
- 
 
 974 
        } /* for loop for column type checking */
- 
 
 975 
 
- 
 
 976 
        if (i < len) {
- 
 
 977 
            Rprintf("Error: type mismatch at variable %s\n", CHAR_ELT(names, i));
- 
 
 978 
            return ret;
- 
 
 979 
        }
- 
 
 980 
 
- 
 
 981 
        /* create the insert statement */
- 
 
 982 
        buflen = sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name]", iname);
- 
 
 983 
        buflen2 = sprintf(g_sql_buf[1], "values(?");
- 
 
 984 
        for (i = 0; i < len; i++) {
- 
 
 985 
            _expand_buf(0, buflen+100);
- 
 
 986 
            buflen += sprintf(g_sql_buf[0]+buflen, ",[%s]", CHAR_ELT(names, i));
- 
 
 987 
            _expand_buf(1, buflen2+5);
- 
 
 988 
            buflen2 += sprintf(g_sql_buf[1]+buflen2, ",?");
- 
 
 989 
        }
- 
 
 990 
 
- 
 
 991 
        _expand_buf(2, buflen + buflen2 + 10);
- 
 
 992 
        sprintf(g_sql_buf[2], "%s) %s", g_sql_buf[0], g_sql_buf[1]);
- 
 
 993 
        res = sqlite3_prepare(g_workspace, g_sql_buf[2], -1, &stmt, NULL);
- 
 
 994 
        if (_sqlite_error(res)) return ret;
- 
 
 995 
 
- 
 
 996 
        /* finally, add rows */
- 
 
 997 
        nrows = LENGTH(GET_ROWNAMES(data));
- 
 
 998 
 
- 
 
 999 
        for (i = 0; i < nrows; i++) {
- 
 
 1000
- 
 
 1001 
        }
- 
 
 1002 
 
- 
 
 1003 
 
- 
 
 1004 
    } else if (strcmp(class,"sqlite.data.frame") == 0) {
- 
 
 1005 
    }
- 
 
 1006 
 
- 
 
 1007 
    return ret;
- 
 
 1008 
}
- 
 
 1009 
 
855 
 
 1010 
 
856 
SEXP sopen(SEXP name) {
 1011 
SEXP sopen(SEXP name) {
857 
    char *filename;
 1012 
    char *filename;
858
1013
859 
    if (IS_CHARACTER(name)) {
 1014 
    if (IS_CHARACTER(name)) {