The R Project SVN R-packages

#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, *vectype = NULL;
    sqlite3_stmt *stmt, *stmt2;
    int ncols, nrows, i;
    SEXP ret, names;

    iname = SDF_INAME(sdf);

    if (!USE_SDF1(iname, TRUE, TRUE)) return R_NilValue;

    /* check column types, and determine matrix mode */
    sprintf(g_sql_buf[0], "select * from [%s].sdf_data", iname);
    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt, 0);
    sqlite3_step(stmt);

    ncols = sqlite3_column_count(stmt);
    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"; vectype = "numeric";
        } else if (strcmp(dectype, "int") == 0) {
            if (_is_factor2(iname, "factor", colname) || _is_factor2(iname, "ordered", colname)) {
                type = "text"; vectype = "character"; break;
            } 
            type = "double";
        } else if (strcmp(dectype, "bit") == 0) {
            if (type == NULL) { type = "bit"; vectype = "logical";  }
        } else if (strcmp(dectype, "text") == 0) {
            type = "text"; vectype = "character"; break;
        }
    }


    /* create sdf with 1 column */
    mat_iname = _create_svector1(name, type, NULL, TRUE);

    /* create and set sdf_matrix_rownames & sdf_matrix_colnames */
    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 "
            "select [row name] from [%s].sdf_data", mat_iname, iname);
    _sqlite_error(_sqlite_exec(g_sql_buf[0]));
    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_colnames values (?)", mat_iname);
    sqlite3_prepare(g_workspace, g_sql_buf[0], -1, &stmt2, 0);

    /* store names in a SEXP */
    names = NEW_CHARACTER(ncols - 1);
    
    /* insert cast-ed values, and column names */
    nrows = _get_row_count2(iname, TRUE);
    _sqlite_begin;
    for (i = 1; i < ncols; i++) {
        colname = sqlite3_column_name(stmt, i);

        sqlite3_reset(stmt2);
        sqlite3_bind_text(stmt2, 1, colname, -1, SQLITE_STATIC);
        sqlite3_step(stmt2);

        SET_STRING_ELT(names, i-1, mkChar(colname));

        if ((_is_factor2(iname, "ordered", colname) && ((dectype = "ordered"))) || 
            ( _is_factor2(iname, "factor", colname) && ((dectype = "factor")))) {
            sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
                    "select [row name]|| %d, [%s].[%s %s].label from [%s].sdf_data "
                    "join [%s].[%s %s] on [%s].sdf_data.[%s]=[%s].[%s %s].level",
                    mat_iname, i, iname, dectype, colname, iname, iname, dectype, 
                    colname, iname, colname, iname, dectype, colname);
        } else {
            sprintf(g_sql_buf[0], "insert into [%s].sdf_data([row name], V1) "
                    "select [row name] || %d, cast([%s] as %s) from [%s].sdf_data", mat_iname, i,
                    colname, type, iname);
        }
        _sqlite_error(_sqlite_exec(g_sql_buf[0]));
    }
    sqlite3_finalize(stmt2);
    sqlite3_finalize(stmt);
    _sqlite_commit;

    /* return smat sexp */
    ret = _create_smat_sexp(mat_iname, vectype, nrows, ncols - 1, names);

    UNUSE_SDF2(iname);
    UNUSE_SDF2(mat_iname);
    return ret;
}

/* "decorate" passed svec w/ rownames & colnames to make it a sqlite.matrix */
SEXP sdf_create_smat(SEXP svec, SEXP dimnames) {
    SEXP tmp, ret = svec;
    sqlite3_stmt *stmt;
    char *mat_iname;
    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 = 1;
    SET_CLASS(ret, tmp);

    /* set smat dim */
    PROTECT(tmp = NEW_INTEGER(2)); i++;
    INTEGER(tmp)[0] = nrows;
    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, 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;
    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);

    

    UNPROTECT(1);
    UNUSE_SDF2(mat_iname);
    UNUSE_SDF2(mat2_iname);
    return ret;
}