Chunk loomR::create
authorPaul Hoffman <phoffman@nygenome.org>
Wed, 7 Feb 2018 22:38:51 +0000 (17:38 -0500)
committerPaul Hoffman <phoffman@nygenome.org>
Wed, 7 Feb 2018 22:38:51 +0000 (17:38 -0500)
R/internal.R
R/loom.R

index 5c697609071bc6c977ec7e39804947970e706bb4..eed85b2ad76a3386f0826729df53b13bf6f4491b 100644 (file)
@@ -1,3 +1,16 @@
+chunkPoints <- function(data.size, chunk.size) {
+  return(vapply(
+    X = 1L:ceiling(data.size / chunk.size),
+    FUN = function(i) {
+      return(c(
+        start = (chunk.size * (i - 1L)) + 1L,
+        end = min(chunk.size * i, data.size)
+      ))
+    },
+    FUN.VALUE = numeric(length = 2L)
+  ))
+}
+
 # Validate a loom object
 #
 # @param object A loom object
index 8663664d25f4835b06425621b0c411549ff3f73d..641fe48172a3aef4960f42f96faea6a56b6e0b69 100644 (file)
--- a/R/loom.R
+++ b/R/loom.R
@@ -954,7 +954,7 @@ loom <- R6Class(
 #'
 #' @return A connection to a loom file
 #'
-#' @importFrom utils packageVersion
+#' @importFrom utils packageVersion txtProgressBar setTxtProgressBar
 #'
 #' @seealso \code{\link{loom-class}}
 #'
@@ -967,7 +967,9 @@ create <- function(
   cell.attrs = NULL,
   layers = NULL,
   chunk.dims = 'auto',
-  overwrite = FALSE
+  chunk.size = 10,
+  overwrite = FALSE,
+  display.progress = TRUE,
 ) {
   mode <- ifelse(test = overwrite, yes = 'w', no = 'w-')
   if (file.exists(filename) && !overwrite) {
@@ -987,11 +989,38 @@ create <- function(
   }
   new.loom <- loom$new(filename = filename, mode = mode)
   # Create the matrix
+  # new.loom$create_dataset(
+  #   name = 'matrix',
+  #   robj = data,
+  #   chunk_dims = chunk.dims
+  # )
+  dtype <- switch(
+    EXPR = class(x = data[1]),
+    'numeric' = h5types$double,
+    'integer' = h5types$int,
+    'character' = H5T_STRING$new(size = Inf),
+    'logical' = h5types$hbool_t
+  )
   new.loom$create_dataset(
     name = 'matrix',
-    robj = data,
-    chunk_dims = chunk.dims
+    dtype = dtype,
+    dims = dim(x = data)
+  )
+  chunk.points <- chunkPoints(
+    data.size = dim(x = data)[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]
+    new.loom[['matrix']][row.start:row.end, ] <- as.matrix(x = data[row.start:row.end, ])
+    if (display.progress) {
+      setTxtProgressBar(pb = pb, value = col / ncol(x = chunk.points))
+    }
+  }
   new.loom$matrix <- new.loom[['matrix']]
   new.loom$shape <- rev(x = new.loom[['matrix']]$dims)
   # Groups