Merge pull request #69 from r-lib/fix-bug-sparse-columns

Fixed bug where `coerce_to_sparse_data_frame()` and `coerce_to_sparse_tibble()` didn't work with matrices with fully sparse columns.

Author: EmilHvitfeldt

NEWS.md

@@ -2,6 +2,8 @@
 
 * All sparse vector types now have a significant smaller base object size. (#67)
 
+* Fixed bug where `coerce_to_sparse_data_frame()` and `coerce_to_sparse_tibble()` didn't work with matrices with fully sparse columns. (#69)
+
 # sparsevctrs 0.1.0
 
 * Initial CRAN submission.

R/coerce.R

@@ -171,22 +171,31 @@ coerce_to_sparse_data_frame <- function(x) {
 
 .sparse_matrix_to_list <- function(x) {
   values <- x@x
-  positions <- x@i
-  
+  x_positions <- x@i
+  n_nonzero <- diff(x@p)
+
   x_length <- nrow(x)
 
   res <- list()
-  for (i in seq_len(ncol(x))) {
-    start <- x@p[i] + 1
-    end <- x@p[i + 1]
-  
-    index <- seq(start, end)
+  start <- 1
+  for (i in seq_along(n_nonzero)) {
+    if (n_nonzero[i] == 0) {
+      res[[i]] <- sparse_double(
+        values = double(),
+        positions = double(),
+        length = x_length
+      )
+      next
+    } 
+
+    index <- seq(start, start + n_nonzero[i] - 1)
 
     res[[i]] <- sparse_double(
       values = values[index],
-      positions = positions[index] + 1,
+      positions = x_positions[index] + 1,
       length = x_length
     )
+    start <- start + n_nonzero[i]
   }
 
   names(res) <- colnames(x)

tests/testthat/test-coerce.R

@@ -202,4 +202,22 @@ test_that("coerce_to_sparse_tibble() errors with wrong input", {
     error = TRUE,
     coerce_to_sparse_tibble(1:10)
   )
+})
+
+test_that(".sparse_matrix_to_list() handles fully sparse columns (#69)", {
+  skip_if_not_installed("Matrix")
+  
+  x_mat <- matrix(
+    c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0), 
+    nrow = 3
+  )
+  colnames(x_mat) <- letters[1:6]
+  
+  x_df <- as.data.frame(x_mat)
+  x_mat_sparse <- Matrix::Matrix(x_mat, sparse = TRUE)
+
+  expect_identical(
+    coerce_to_sparse_data_frame(x_mat_sparse),
+    x_df
+  )
 })