Add support for dgCMatrix from the Matrix package

ChangeLog

@@ -1,3 +1,6 @@
+Release 0.3-1 (//):
+  * Add support for dgCMatrix from Matrix.
+
 Release 0.3-0 (3/17/2016):
   * Rename package to 'coop'.
   * 'Namespaced' the internal lib.

DESCRIPTION

@@ -12,7 +12,8 @@ License: BSD 2-clause License + file LICENSE
 Depends:
     R (>= 3.0.0)
 Enhances: 
-    slam (>= 0.1.32)
+    slam (>= 0.1.32),
+    Matrix
 Suggests:
     memuse,
     microbenchmark,

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(cosine,default)
+S3method(cosine,dgCMatrix)
 S3method(cosine,matrix)
 S3method(cosine,simple_triplet_matrix)
 S3method(covar,default)

R/cosine.r

@@ -50,5 +50,39 @@ cosine.default <- function(x, y)
 #' @export
 cosine.simple_triplet_matrix <- function(x, y)
 {
-  co_sparse(x, y, type=CO_SIM)
+  if (!missing(y))
+    stop("argument 'y' can not be used with a matrix 'x'")
+
+  n <- x$ncol
+  a <- x$v
+  i <- x$i
+  j <- x$j
+  index <- 1L
+  type <- CO_SIM
+
+  if (length(a) != length(i) || length(i) != length(j))
+    stop("Malformed simple_triplet_matrix: lengths of 'v', 'i', and 'j' do not agree")
+
+  co_sparse(n, a, i, j, index, type)
+}
+
+
+
+#' @export
+cosine.dgCMatrix <- function(x, y)
+{
+  if (!missing(y))
+    stop("argument 'y' can not be used with a matrix 'x'")
+
+  n <- ncol(x)
+  a <- x@x
+  i <- x@i
+  j <- .Call("R_extract_colind_from_csr", i, x@p, package="coop")
+  index <- 0L
+  type <- CO_SIM
+
+  if (length(a) != length(i) || length(i) != length(j))
+    stop("Malformed dgCMatrix: lengths of 'x', 'i', and 'p' do not agree")
+
+  co_sparse(n, a, i, j, index, type)
 }

R/wrappers_sparse.r

@@ -1,22 +1,11 @@
-co_sparse <- function(x, y, type)
+co_sparse <- function(n, a, i, j, index, type)
 {
-  if (!missing(y))
-    stop("argument 'y' can not be used with a matrix 'x'")
-
-  a <- x$v
-  i <- x$i
-  j <- x$j
-  n <- as.integer(x$ncol)
-
-  if (length(a) != length(i) || length(i) != length(j))
-    stop("Malformed simple_triplet_matrix: lengths of 'v', 'i', and 'j' do not agree")
-
   if (!is.double(a))
     storage.mode(a) <- "double"
   if (!is.integer(i))
     storage.mode(i) <- "integer"
   if (!is.integer(j))
     storage.mode(j) <- "integer"
 
-  .Call(R_co_sparse, n, a, i, j, as.integer(type))
+  .Call(R_co_sparse, as.integer(n), a, i, j, as.integer(index), as.integer(type))
 }

src/wrapper.c

@@ -103,18 +103,19 @@ SEXP R_co_vecvec(SEXP x, SEXP y, SEXP type_)
 //  Sparse
 // ---------------------------------------------
 
-#define INEDEX_FROM_1 1
+// #define INEDEX_FROM_1 1
 
-SEXP R_co_sparse(SEXP n_, SEXP a, SEXP i, SEXP j, SEXP type_)
+SEXP R_co_sparse(SEXP n_, SEXP a, SEXP i, SEXP j, SEXP index_, SEXP type_)
 {
-  const int type = INTEGER(type_)[0];
   int check;
   const int n = INTEGER(n_)[0];
+  const int index = INTEGER(index_)[0];
+  const int type = INTEGER(type_)[0];
   SEXP ret;
   PROTECT(ret = allocMatrix(REALSXP, n, n));
 
   if (type == CO_SIM)
-    check = coop_cosine_sparse_coo(INEDEX_FROM_1, n, LENGTH(a), REAL(a), INTEGER(i), INTEGER(j), REAL(ret));
+    check = coop_cosine_sparse_coo(index, n, LENGTH(a), REAL(a), INTEGER(i), INTEGER(j), REAL(ret));
   else
     BADTYPE();
 
@@ -159,3 +160,37 @@ SEXP R_sparsity_dbl(SEXP x, SEXP tol)
 
   return ret;
 }
+
+
+
+#define INT(x,i) INTEGER(x)[i]
+
+SEXP R_extract_colind_from_csr(SEXP row_ind, SEXP col_ptr)
+{
+  int i, j = 0;
+  int c = 0, ind = 0;
+  int diff;
+  const int len = LENGTH(row_ind);
+
+  SEXP col_ind;
+  PROTECT(col_ind = allocVector(INTSXP, len));
+
+  for (i=0; i<len-1 && c<LENGTH(col_ptr); i++)
+  {
+    diff = INT(col_ptr, i+1) - INT(col_ptr, i);
+
+    while (diff > 0)
+    {
+      INT(col_ind, ind) = j;
+
+      ind++;
+      diff--;
+    }
+
+    c++; // hehehe
+    j++;
+  }
+
+  UNPROTECT(1);
+  return col_ind;
+}

tests/sparse_matrix.R

@@ -1,4 +1,4 @@
-if(require(slam))
+if (require(slam))
 {
   library(slam)
   library(coop)
@@ -28,5 +28,34 @@ if(require(slam))
   t2 <- cosine(coo)
 
   stopifnot(all.equal(t1, t2))
+}
+
+
+
+if (require(Matrix))
+{
+  library(Matrix)
+  library(coop)
+  set.seed(1234)
+
+  m <- 30
+  n <- 10
+
+  ### Very sparse, has column of 0's
+  x <- coop:::dense_stored_sparse_mat(m, n, prop=.05)
+  coo <- as(x, "sparseMatrix")
+
+  t1 <- cosine(x)
+  t2 <- cosine(coo)
+
+  stopifnot(all.equal(t1, t2))
 
+  ### Not very sparse
+  x <- coop:::dense_stored_sparse_mat(m, n, prop=.25)
+  coo <- as(x, "sparseMatrix")
+
+  t1 <- cosine(x)
+  t2 <- cosine(coo)
+
+  stopifnot(all.equal(t1, t2))
 }