The R Project SVN – R-packages – Diff – /trunk/SQLiteDF/src/sqlite_matrix.c

 #define __SQLITE_MATRIX__
 #include "sqlite_dataframe.h"
 /****************************************************************************
+ * UTILITY FUNCTIONS
+ ****************************************************************************/
+static SEXP _create_smat_sexp(const char *mat_iname, const char *type,
+        int nrows, int ncols, SEXP colnames) {
+    SEXP ret, tmp;
+    int i;
+    /* return smat sexp */
+    PROTECT(ret = NEW_LIST(3)); i = 1; /* 1 for names sexp above */
+    SET_VECTOR_ELT(ret, 0, mkString(mat_iname));
+    SET_VECTOR_ELT(ret, 1, mkString("sdf_data"));
+    SET_VECTOR_ELT(ret, 2, mkString("V1"));
+    /* set smat data name */
+    PROTECT(tmp = NEW_CHARACTER(3)); i++;
+    SET_STRING_ELT(tmp, 0, mkChar("iname"));
+    SET_STRING_ELT(tmp, 1, mkChar("tblname"));
+    SET_STRING_ELT(tmp, 2, mkChar("varname"));
+    SET_NAMES(ret, tmp);
+    /* set class */
+    PROTECT(tmp = mkString("sqlite.matrix")); i++;
+    SET_CLASS(ret, tmp);
+    /* set smat dim */
+    PROTECT(tmp = NEW_INTEGER(2)); i++;
+    INTEGER(tmp)[0] = nrows;
+    INTEGER(tmp)[1] = ncols;  /* mind [row names], w/c is not included in the count */
+    setAttrib(ret, SDF_DimSymbol, tmp);
+    /* set smat dimname */
+    PROTECT(tmp = NEW_LIST(2)); i++;
+    SET_VECTOR_ELT(tmp, 0, _create_svector_sexp(mat_iname,
+                "sdf_matrix_rownames", "name", "character"));
+    SET_VECTOR_ELT(tmp, 1, colnames);
+    setAttrib(ret, SDF_DimNamesSymbol, tmp);
+    /* set sdf.vector.type */
+    setAttrib(ret, SDF_VectorTypeSymbol, mkString(type));
+    UNPROTECT(i);
+    return ret;
+}
+/****************************************************************************
  * SMAT FUNCTIONS
  ****************************************************************************/
 SEXP sdf_as_matrix(SEXP sdf, SEXP name) {
     char *iname, *mat_iname, *type;
-    const char *dectype, *colname;
+    const char *dectype, *colname, *vectype;
     sqlite3_stmt *stmt, *stmt2;
     int ncols, nrows, i;
     SEXP ret, tmp, names;
     iname = SDF_INAME(sdf);
     type = NULL;
     for (i = 1; i < ncols; i++) {
         dectype = sqlite3_column_decltype(stmt, i);
         colname = sqlite3_column_name(stmt, i);
         if (strcmp(dectype, "double") == 0) {
-            type = "double";
+            type = "double"; vectype = "numeric";
         } else if (strcmp(dectype, "int") == 0) {
             if (_is_factor2(iname, "factor", colname) || _is_factor2(iname, "ordered", colname)) {
-                type = "text"; break;
+                type = "text"; vectype = "character"; break;
             }
             type = "double";
         } else if (strcmp(dectype, "bit") == 0) {
-            if (type == NULL) type = "bit";
+            if (type == NULL) { type = "bit"; vectype = "logical";  }
         } else if (strcmp(dectype, "text") == 0) {
-            type = "text"; break;
+            type = "text"; vectype = "character"; break;
+        }
+    }
     /* create sdf with 1 column */
     sqlite3_finalize(stmt2);
     sqlite3_finalize(stmt);
     _sqlite_commit;
     /* return smat sexp */
-    PROTECT(ret = NEW_LIST(3)); i = 1; /* 1 for names sexp above */
+    ret = _create_smat_sexp(mat_iname, vectype, nrows, ncols - 1, names);
-    SET_VECTOR_ELT(ret, 0, mkString(mat_iname));
-    SET_VECTOR_ELT(ret, 1, mkString("sdf_data"));
-    SET_VECTOR_ELT(ret, 2, mkString("V1"));
-    /* set smat data name */
+    UNUSE_SDF2(iname);
-    PROTECT(tmp = NEW_CHARACTER(3)); i++;
+    UNUSE_SDF2(mat_iname);
+    return ret;
+}
+/* "decorate" passed svec w/ rownames & colnames to make it a sqlite.matrix */
-    SET_STRING_ELT(tmp, 0, mkChar("iname"));
+SEXP sdf_create_smat(SEXP svec, SEXP dimnames) {
-    SET_STRING_ELT(tmp, 1, mkChar("tblname"));
+    SEXP tmp, ret = svec;
+    sqlite3_stmt *stmt;
-    SET_STRING_ELT(tmp, 2, mkChar("varname"));
+    char *mat_iname;
-    SET_NAMES(ret, tmp);
+    int i, nrows, ncols;
+    mat_iname = SDF_INAME(svec);
+    if (!USE_SDF1(mat_iname, TRUE, TRUE)) return R_NilValue;
+    /* create and set sdf_matrix_rownames */
+    sprintf(g_sql_buf[0], "create table [%s].sdf_matrix_rownames(name text)", mat_iname);
+    _sqlite_error(_sqlite_exec(g_sql_buf[0]));
+    sprintf(g_sql_buf[0], "insert into [%s].sdf_matrix_rownames(name) values (?)", mat_iname);
+    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
+    tmp = VECTOR_ELT(dimnames, 0);
+    if (inherits(tmp, "sqlite.vector")) {
+        char *iname = SDF_INAME(tmp), *tblname = SVEC_TBLNAME(tmp),
+             *varname = SVEC_VARNAME(tmp);
+        USE_SDF1(iname, TRUE, TRUE);
+        nrows = _get_row_count2(iname, TRUE);
+        sprintf(g_sql_buf[0], "insert into [%s].sdf_matrix_rownames(name) "
+                "select [%s] from [%s].[%s]", mat_iname, varname, iname, tblname);
+        _sqlite_error(_sqlite_exec(g_sql_buf[0]));
+        UNUSE_SDF2(iname);
+    } else {
+        nrows = LENGTH(tmp);
+        _sqlite_begin;
+        for (i = 0; i < nrows; i++) {
+            sqlite3_reset(stmt);
+            sqlite3_bind_text(stmt, 1, CHAR_ELT(tmp, i), -1, SQLITE_STATIC);
+            sqlite3_step(stmt);
+        }
+        _sqlite_commit;
+    }
+    /* create and set sdf_matrix_colnames */
+    sprintf(g_sql_buf[0], "create table [%s].sdf_matrix_colnames(name text)", mat_iname);
+    _sqlite_error(_sqlite_exec(g_sql_buf[0]));
+    sprintf(g_sql_buf[0], "insert into [%s].sdf_matrix_rownames(name) values (?)", mat_iname);
+    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, NULL);
+    tmp = VECTOR_ELT(dimnames, 1);
+    ncols = LENGTH(tmp);
+    _sqlite_begin;
+    for (i = 0; i < ncols; i++) {
+        sqlite3_reset(stmt);
+        sqlite3_bind_text(stmt, 1, CHAR_ELT(tmp, i), -1, SQLITE_STATIC);
+        sqlite3_step(stmt);
+    }
+    _sqlite_commit;
+    /* modify the passed svec sexp to smat */
     /* set class */
-    PROTECT(tmp = mkString("sqlite.matrix")); i++;
+    PROTECT(tmp = mkString("sqlite.matrix")); i = 1;
     SET_CLASS(ret, tmp);
     /* set smat dim */
     PROTECT(tmp = NEW_INTEGER(2)); i++;
     INTEGER(tmp)[0] = nrows;
-    INTEGER(tmp)[1] = ncols - 1;  /* ncols includes [row names] */
+    INTEGER(tmp)[1] = ncols;
     setAttrib(ret, SDF_DimSymbol, tmp);
     /* set smat dimname */
     PROTECT(tmp = NEW_LIST(2)); i++;
     SET_VECTOR_ELT(tmp, 0, _create_svector_sexp(mat_iname,
                 "sdf_matrix_rownames", "name", "character"));
-    SET_VECTOR_ELT(tmp, 1, names);
+    SET_VECTOR_ELT(tmp, 1, duplicate(VECTOR_ELT(dimnames, 1)));
     setAttrib(ret, SDF_DimNamesSymbol, tmp);
+    /* sdf.vector.type already set */
     UNPROTECT(i);
+    UNUSE_SDF2(mat_iname);
+    return ret;
+}
+SEXP sdf_get_matrix_columns(SEXP smat, SEXP cols) {
+    SEXP colnames, ret;
+    sqlite3_stmt *stmt1, *stmt2;
+    char *mat_iname, *mat2_iname, *type;
+    const char *coltype, *vectype;
+    int i, nrows, ncols, index, idxlen, ci_len, ci_actual_len;
+    int *col_indices;
+    mat_iname = SDF_INAME(smat);
+    if (!USE_SDF1(mat_iname, TRUE, TRUE)) return R_NilValue;
+    idxlen = LENGTH(cols);
+    sprintf(g_sql_buf[0], "[%s].sdf_matrix_colnames", mat_iname);
+    ncols = _get_row_count2(g_sql_buf[0], FALSE);
+    sprintf(g_sql_buf[0], "[%s].sdf_matrix_rownames", mat_iname);
+    nrows = _get_row_count2(g_sql_buf[0], FALSE);
+    /* get column indices selected */
+    ci_len = (ncols > idxlen) ? ncols : idxlen;
+    col_indices = (int *)R_alloc(ci_len, sizeof(int));
+    ci_actual_len = 0;
+    if (IS_NUMERIC(cols)) {
+        for (i = 0; i < idxlen; i++) {
+            index = (int) REAL(cols)[i];
+            if (index <= ncols && index > 0) col_indices[ci_actual_len++] = index-1;
+        }
+    } else if (IS_INTEGER(cols)) {
+        for (i = 0; i < idxlen; i++) {
+            index = INTEGER(cols)[i];
+            if (index <= ncols && index > 0) col_indices[ci_actual_len++] = index-1;
+        }
+    } else if (IS_LOGICAL(cols)) {
+        for (i = 0; i < ncols; i++) {
+            if (LOGICAL(cols)[i % ncols]) col_indices[ci_actual_len++] = INTEGER(cols)[i];
+        }
+    }
+    /* get matrix "mode" / type */
+    sprintf(g_sql_buf[1], "select [row name], V1 from [%s].[sdf_data] limit ?,?", mat_iname);
+    sqlite3_prepare(g_workspace, g_sql_buf[1], -1, &stmt1, NULL);
+    sqlite3_bind_int(stmt1, 1, 1);  /* limit 1,1 */
+    sqlite3_bind_int(stmt1, 2, 1);
+    sqlite3_step(stmt1);
+    coltype = (const char*) strcpy(g_sql_buf[0], sqlite3_column_decltype(stmt1, 1));
+    sqlite3_finalize(stmt1);
+    PROTECT(colnames = NEW_CHARACTER(ci_actual_len));
+    /* create new matrix */
+    mat2_iname = _create_svector1(mkString(mat_iname), coltype, NULL, TRUE);
+    coltype = strcpy(g_sql_buf[3], g_sql_buf[0]);
+    _sqlite_begin;
+    /* create sdf_matrix_rownames and sdf_matrix_colnames */
+    sprintf(g_sql_buf[0], "create table [%s].sdf_matrix_rownames(name text)", mat2_iname);
+    _sqlite_error(_sqlite_exec(g_sql_buf[0]));
+    sprintf(g_sql_buf[0], "create table [%s].sdf_matrix_colnames(name text)", mat2_iname);
+    _sqlite_error(_sqlite_exec(g_sql_buf[0]));
+    /* stmt to insert-select to the new matrix */
+    sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
+            " select [row name], V1 from [%s].[sdf_data] limit ?,?",
+            mat2_iname, mat_iname);
+    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt1, NULL);
+    /* stmt to insert-select to the new matrix-column table */
+    sprintf(g_sql_buf[0], "insert into [%s].sdf_matrix_colnames "
+            " select name from [%s].sdf_matrix_colnames limit ?, 1", mat2_iname, mat_iname);
+    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt2, NULL);
+    for (i = 0; i < ci_actual_len; i++) {
+        sqlite3_reset(stmt1);
+        sqlite3_bind_int(stmt1, 1, col_indices[i]*nrows);
+        sqlite3_bind_int(stmt1, 2, nrows);
+        sqlite3_step(stmt1);
+        sqlite3_reset(stmt2);
+        sqlite3_bind_int(stmt2, 1, col_indices[i]+1);
+        sqlite3_step(stmt2);
+    }
+    sqlite3_finalize(stmt1);
+    sqlite3_finalize(stmt2);
+    /* copy colnames to a sexp, as the sexp's names() */
+    sprintf(g_sql_buf[0], "select name from [%s].sdf_matrix_colnames", mat2_iname);
+    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt1, NULL);
+    for (i = 0; sqlite3_step(stmt1) == SQLITE_ROW; i++) {
+        SET_STRING_ELT(colnames, i, mkChar((char *)sqlite3_column_text(stmt1, 0)));
+    }
+    sqlite3_finalize(stmt1);
+    /* copy matrix-rows table */
+    sprintf(g_sql_buf[0], "insert into [%s].sdf_matrix_rownames "
+            "select * from [%s].sdf_matrix_rownames", mat2_iname, mat_iname);
+    _sqlite_error(_sqlite_exec(g_sql_buf[0]));
+    _sqlite_commit;
+    /* return matrix SEXP */
+    if (strcmp(coltype, "text") == 0) vectype = "character";
+    else if (strcmp(coltype, "int") == 0) vectype = "integer";
+    else if (strcmp(coltype, "double") == 0) vectype = "numeric";
+    ret = _create_smat_sexp(mat2_iname, coltype, nrows, ci_actual_len, colnames);
-    UNUSE_SDF2(iname);
+    UNPROTECT(1);
     UNUSE_SDF2(mat_iname);
+    UNUSE_SDF2(mat2_iname);
     return ret;
+}

The R Project SVN R-packages

(root)/trunk/SQLiteDF/src/sqlite_matrix.c – Rev 3684 → 3808