Change add.layers to support streaming sparse matrices
authorPaul Hoffman <hoff0792@umn.edu>
Fri, 9 Feb 2018 02:58:54 +0000 (21:58 -0500)
committerPaul Hoffman <hoff0792@umn.edu>
Fri, 9 Feb 2018 02:58:54 +0000 (21:58 -0500)
R/internal.R
R/loom.R

index eed85b2ad76a3386f0826729df53b13bf6f4491b..76910a45d87a2e2af228f87b6a030250591a4bca 100644 (file)
@@ -1,3 +1,10 @@
+# Generate chunk points
+#
+# @param data.size How big is the data being chunked
+# @param chunk.size How big should each chunk be
+#
+# @return A matrix where each column is a chunk, row 1 is start points, row 2 is end points
+#
 chunkPoints <- function(data.size, chunk.size) {
   return(vapply(
     X = 1L:ceiling(data.size / chunk.size),
@@ -11,6 +18,27 @@ chunkPoints <- function(data.size, chunk.size) {
   ))
 }
 
+# Get HDF5 data types
+#
+# @param An R object
+#
+# @return The corresponding HDF5 data type
+#
+#' @import hdf5r
+#
+# @seealso \code\link{hdf5r::h5types}
+#
+getDtype <- function(x) {
+  return(switch(
+    EXPR = class(x = x),
+    'numeric' = h5types$double,
+    'integer' = h5types$int,
+    'character' = H5T_STRING$new(size = Inf),
+    'logical' = h5types$hbool_t,
+    stop(paste("Unknown data type:", class(x = x)))
+  ))
+}
+
 # Validate a loom object
 #
 # @param object A loom object
@@ -324,7 +352,9 @@ addCells.col_attrs <- function(x, m2) {
 #
 #' @importFrom utils txtProgressBar
 #
-new.pb <- function() {return(txtProgressBar(style = 3, char = '='))}
+new.pb <- function() {
+  return(txtProgressBar(style = 3, char = '='))
+}
 
 # Cat with a new line
 #
index bc29c968e5cee07a39ac7e174052ed054901f774..5323e00c6b0852bddf62b4c8986072dd096fbabd 100644 (file)
--- a/R/loom.R
+++ b/R/loom.R
@@ -23,7 +23,7 @@ NULL
 #'
 #' @section Methods:
 #' \describe{
-#'   \item{\code{add.layer(layer, overwrite)}}{Add a data layer to this loom file, must be the same dimensions as \code{/matrix}}
+#'   \item{\code{add.layer(layer, chunk.size, overwrite)}}{Add a data layer to this loom file, must be the same dimensions as \code{/matrix}}
 #'   \item{\code{add.attribute(attribute, MARGIN, overwrite)}}{
 #'     Add extra information to this loom file where
 #'     \describe{
@@ -170,7 +170,7 @@ loom <- R6Class(
       private$load_attributes(MARGIN = 2)
     },
     # Addding attributes and layers
-    add.layer = function(layers, overwrite = FALSE) {
+    add.layer = function(layers, chunk.size = 1000, overwrite = FALSE) {
       if (self$mode == 'r') {
         stop(private$err_mode)
       }
@@ -183,7 +183,8 @@ loom <- R6Class(
       }
       # Add layers
       for (i in 1:length(x = layers)) {
-        if (!is.matrix(x = layers[[i]])) {
+        # if (!is.matrix(x = layers[[i]])) {
+        if (!inherits(x = layers[[i]], what = c('Matrix', 'matrix'))) {
           layers[[i]] <- as.matrix(x = layers[[i]])
         }
         do.transpose <- FALSE
@@ -204,22 +205,46 @@ loom <- R6Class(
         if (do.transpose) {
           layers[[i]] <- t(x = layers[[i]])
         }
-        if (names(x = layers)[i] %in% list.datasets(object = self[['layers']])) {
+        layer.name <- names(x = layers)[i]
+        if (layer.name %in% list.datasets(object = self[['layers']])) {
           if (overwrite) {
-            self[['layers']]$link_delete(name = names(x = layers)[i])
+            self[['layers']]$link_delete(name = layer.name)
           } else {
             stop(paste(
               "A layer with the name",
-              names(x = layers)[i],
+              layer.name,
               "already!"
             ))
           }
         }
+        dtype <- getDtype(x = layers[[i]][1, 1])
         self[['layers']]$create_dataset(
-          name = names(x = layers)[i],
-          robj = layers[[i]],
-          chunk_dims = self$chunksize
+          name = layer.name,
+          dtype = dtype,
+          dims = dim(x = layers[[i]])
         )
+        chunk.points <- chunkPoints(
+          data.size = dim(x = layers[[i]])[1],
+          chunk.size = chunk.size
+        )
+        # if (display.progress) {
+        #   pb <- txtProgressBar(char = '=', style = 3)
+        # }
+        for (col in 1:ncol(x = chunk.points)) {
+          row.start <- chunk.points[1, col]
+          row.end <- chunk.points[2, col]
+          self[['layers']][[layer.name]][row.start:row.end, ] <- as.matrix(
+            x = layers[[i]][row.start:row.end, ]
+          )
+          # if (display.progress) {
+          #   setTxtProgressBar(pb = pb, value = col / ncol(x = chunk.points))
+          # }
+        }
+        # self[['layers']]$create_dataset(
+        #   name = names(x = layers)[i],
+        #   robj = layers[[i]],
+        #   chunk_dims = self$chunksize
+        # )
       }
       self$flush()
       gc(verbose = FALSE)
@@ -950,6 +975,7 @@ loom <- R6Class(
 #' @param gene.attrs A named list of vectors with extra data for genes, each vector must be as long as the number of genes in \code{data}
 #' @param cell.attrs A named list of vectors with extra data for cells, each vector must be as long as the number of cells in \code{data}
 #' @param chunk.dims A one- or two-length integer vector of chunksizes for \code{/matrix}, defaults to 'auto' to automatically determine chunksize
+#' @param chunk.size How many rows of \code{data} should we stream to the loom file at any given time?
 #' @param overwrite Overwrite an already existing loom file?
 #'
 #' @return A connection to a loom file
@@ -967,7 +993,7 @@ create <- function(
   cell.attrs = NULL,
   layers = NULL,
   chunk.dims = 'auto',
-  chunk.size = 10,
+  chunk.size = 1000,
   overwrite = FALSE,
   display.progress = TRUE
 ) {
@@ -994,13 +1020,7 @@ create <- function(
   #   robj = data,
   #   chunk_dims = chunk.dims
   # )
-  dtype <- switch(
-    EXPR = class(x = data[1, 1]),
-    'numeric' = h5types$double,
-    'integer' = h5types$int,
-    'character' = H5T_STRING$new(size = Inf),
-    'logical' = h5types$hbool_t
-  )
+  dtype <- getDtype(x = data[1, 1])
   new.loom$create_dataset(
     name = 'matrix',
     dtype = dtype,