The R Project SVN R-packages

Rev

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

Rev 3419 Rev 3509
Line 1... Line 1...
1 
#define __SQLITE_MATRIX__
 1 
#define __SQLITE_MATRIX__
2 
#include "sqlite_dataframe.h"
 2 
#include "sqlite_dataframe.h"
3 
 
 3 
 
4 
/* SEXP SDFMatrixDimSymbol =  */
 - 
 
5 
/****************************************************************************
 - 
 
6 
 * utilities
 - 
 
7 
 ****************************************************************************/
 - 
 
8 
static void _installAttrib(SEXP obj, SEXP name, SEXP value) {
 - 
 
9 
    /* to bypass dim & dimnames property checking */
 - 
 
10 
    SEXP attr, cur_attr;
 - 
 
11 
    PROTECT(attr = NEW_LIST(1));
 - 
 
12 
    SETCAR(attr, value);
 - 
 
13 
    SET_TAG(attr, name);
 - 
 
14 
    if (ATTRIB(obj) == R_NilValue) SET_ATTRIB(obj, attr);
 - 
 
15 
    else {
 - 
 
16 
        cur_attr = nthcdr(ATTRIB(obj), length(ATTRIB(obj)) - 1);
 - 
 
17 
        SETCDR(cur_attr, attr);
 - 
 
18 
    }
 - 
 
19 
    UNPROTECT(1);
 - 
 
20 
}
 - 
 
21 
 
 - 
 
22 
/****************************************************************************
 4 
/****************************************************************************
23 
 * SMAT FUNCTIONS
 5 
 * SMAT FUNCTIONS
24 
 ****************************************************************************/
 6 
 ****************************************************************************/
25 
SEXP sdf_as_matrix(SEXP sdf, SEXP name) {
 7 
SEXP sdf_as_matrix(SEXP sdf, SEXP name) {
26 
    char *iname, *mat_iname, *type;
 8 
    char *iname, *mat_iname, *type;
Line 28... Line 10...
28 
    sqlite3_stmt *stmt, *stmt2;
 10 
    sqlite3_stmt *stmt, *stmt2;
29 
    int ncols, nrows, i;
 11 
    int ncols, nrows, i;
30 
    SEXP ret, tmp, names;
 12 
    SEXP ret, tmp, names;
31 
 
 13 
 
32 
    iname = SDF_INAME(sdf);
 14 
    iname = SDF_INAME(sdf);
33 
    mat_iname = CHAR_ELT(name, 0);
 - 
 
34 
 
 15 
 
35 
    if (!USE_SDF1(iname, TRUE, TRUE)) return R_NilValue;
 16 
    if (!USE_SDF1(iname, TRUE, TRUE)) return R_NilValue;
36 
 
 17 
 
37 
    /* check column types, and determine matrix mode */
 18 
    /* check column types, and determine matrix mode */
38 
    sprintf(g_sql_buf[0], "select * from [%s].sdf_data", iname);
 19 
    sprintf(g_sql_buf[0], "select * from [%s].sdf_data", iname);
Line 75... Line 56...
75 
 
 56 
 
76 
    /* store names in a SEXP */
 57 
    /* store names in a SEXP */
77 
    names = NEW_CHARACTER(ncols - 1);
 58 
    names = NEW_CHARACTER(ncols - 1);
78
59
79 
    /* insert cast-ed values, and column names */
 60 
    /* insert cast-ed values, and column names */
80 
    nrows = _get_row_count2(iname, FALSE);
 61 
    nrows = _get_row_count2(iname, TRUE);
81 
    _sqlite_error(_sqlite_exec("begin"));
 62 
    _sqlite_begin;
82 
    for (i = 1; i < ncols; i++) {
 63 
    for (i = 1; i < ncols; i++) {
83 
        colname = sqlite3_column_name(stmt, i);
 64 
        colname = sqlite3_column_name(stmt, i);
84 
 
 65 
 
85 
        sqlite3_reset(stmt2);
 66 
        sqlite3_reset(stmt2);
86 
        sqlite3_bind_text(stmt2, 1, colname, -1, SQLITE_STATIC);
 67 
        sqlite3_bind_text(stmt2, 1, colname, -1, SQLITE_STATIC);
Line 102... Line 83...
102 
        }
 83 
        }
103 
        _sqlite_error(_sqlite_exec(g_sql_buf[0]));
 84 
        _sqlite_error(_sqlite_exec(g_sql_buf[0]));
104 
    }
 85 
    }
105 
    sqlite3_finalize(stmt2);
 86 
    sqlite3_finalize(stmt2);
106 
    sqlite3_finalize(stmt);
 87 
    sqlite3_finalize(stmt);
107 
    _sqlite_error(_sqlite_exec("commit"));
 88 
    _sqlite_commit;
108 
 
 89 
 
109 
    /* return smat sexp */
 90 
    /* return smat sexp */
110 
    PROTECT(ret = NEW_LIST(2)); i = 2; /* 1 for names sexp above */
 91 
    PROTECT(ret = NEW_LIST(2)); i = 1; /* 1 for names sexp above */
111 
    SET_VECTOR_ELT(ret, 0, mkString(iname));
 92 
    SET_VECTOR_ELT(ret, 0, mkString(mat_iname));
112 
    SET_VECTOR_ELT(ret, 1, mkString("V1"));
 93 
    SET_VECTOR_ELT(ret, 1, mkString("V1"));
113 
 
 94 
 
114 
    /* set smat data name */
 95 
    /* set smat data name */
115 
    PROTECT(tmp = NEW_CHARACTER(2)); i++;
 96 
    PROTECT(tmp = NEW_CHARACTER(2)); i++;
116 
    SET_STRING_ELT(tmp, 0, mkChar("iname"));
 97 
    SET_STRING_ELT(tmp, 0, mkChar("iname"));
117 
    SET_STRING_ELT(tmp, 1, mkChar("varname"));
 98 
    SET_STRING_ELT(tmp, 1, mkChar("varname"));
118 
    SET_NAMES(ret, tmp);
 99 
    SET_NAMES(ret, tmp);
119 
 
 100 
 
120 
    /* set class */
 101 
    /* set class */
121 
    PROTECT(tmp = NEW_CHARACTER(2)); i++;
 - 
 
122 
    SET_STRING_ELT(tmp, 0, mkChar("sqlite.matrix"));
 102 
    PROTECT(tmp = mkString("sqlite.matrix")); i++;
123 
    SET_STRING_ELT(tmp, 1, mkChar("matrix"));
 - 
 
124 
    SET_CLASS(ret, tmp);
 103 
    SET_CLASS(ret, tmp);
125 
 
 104 
 
126 
    /* set smat dim */
 105 
    /* set smat dim */
127 
    PROTECT(tmp = NEW_INTEGER(2)); i++;
 106 
    PROTECT(tmp = NEW_INTEGER(2)); i++;
128 
    INTEGER(tmp)[0] = nrows;
 107 
    INTEGER(tmp)[0] = nrows;
129 
    INTEGER(tmp)[1] = ncols;
 108 
    INTEGER(tmp)[1] = ncols - 1;  /* ncols includes [row names] */
130 
    /*_installAttrib(ret, R_DimSymbol, tmp);*/
 - 
 
131 
    setAttrib(ret, R_DimSymbol, tmp);
 109 
    setAttrib(ret, SDF_DimSymbol, tmp);
132 
 
 110 
 
133 
    /* set smat dimname */
 111 
    /* set smat dimname */
134 
    PROTECT(tmp = NEW_LIST(2)); i++;
 112 
    PROTECT(tmp = NEW_LIST(2)); i++;
135 
    SET_VECTOR_ELT(tmp, 0, _get_rownames2(iname));
 113 
    SET_VECTOR_ELT(tmp, 0, R_NilValue); /* NOT EXACTLY... */
136 
    SET_VECTOR_ELT(tmp, 1, names);
 114 
    SET_VECTOR_ELT(tmp, 1, names);
137 
    /*_installAttrib(ret, R_DimNamesSymbol, tmp);*/
 115 
    setAttrib(ret, SDF_DimNamesSymbol, tmp);
138 
    SET_DIMNAMES(ret, tmp);
 - 
 
139 
 
 116 
 
140 
    UNPROTECT(i);
 117 
    UNPROTECT(i);
141 
 
 118 
 
142 
    UNUSE_SDF2(iname);
 119 
    UNUSE_SDF2(iname);
143 
    UNUSE_SDF2(mat_iname);
 120 
    UNUSE_SDF2(mat_iname);