Cleanup and reorganize code
authorPaul Hoffman <phoffman@nygenome.org>
Wed, 13 Dec 2017 00:05:12 +0000 (19:05 -0500)
committerPaul Hoffman <phoffman@nygenome.org>
Wed, 13 Dec 2017 00:05:12 +0000 (19:05 -0500)
DESCRIPTION
R/internal.R [new file with mode: 0644]
R/loom.R

index 7523995dd9a2aaec8050ed32c244e646e950524f..b30c68acb078bd47ec3dafda751224385e6cf61d 100644 (file)
@@ -19,9 +19,10 @@ Depends:
 Imports:
   utils,
   methods
-Collate:
-  'loom.R'
-  'package.R'
+Collate: 
+    'internal.R'
+    'loom.R'
+    'package.R'
 License: GPL-3
 Encoding: UTF-8
 LazyData: true
diff --git a/R/internal.R b/R/internal.R
new file mode 100644 (file)
index 0000000..52018ba
--- /dev/null
@@ -0,0 +1,59 @@
+# Validate a loom object
+#
+# @param object A loom object
+#
+# @return None, errors out if object is an invalid loom connection
+#
+# @seealso \code{\link{loom-class}}
+#
+validateLoom <- function(object) {
+  if (!inherits(x = object, what = 'loom')) {
+    stop("No need to validate a non-loom object")
+  }
+  # A loom file is a specific HDF5
+  # We need a dataset in /matrix that's a two-dimensional dense matrix
+  root.datasets <- list.datasets(object = object, path = '/', recursive = FALSE)
+  if (length(x = root.datasets) != 1) {
+    stop("There can only be one dataset at the root of the loom file")
+  }
+  if (root.datasets != 'matrix') {
+    stop("The root dataset must be called '/matrix'")
+  }
+  # There must be groups called '/col_attrs', '/row_attrs', and '/layers'
+  required.groups <- c('row_attrs', 'col_attrs', 'layers')
+  dim.matrix <- object[[root.datasets]]$dims # Columns x Rows
+  names(x = dim.matrix) <- required.groups[c(2, 1)]
+  root.groups <- list.groups(object = object, path = '/', recursive = FALSE)
+  group.msg <- paste0(
+    "There can only be three groups in the loom file: '",
+    paste(required.groups, collapse = "', '"),
+    "'"
+  )
+  if (length(x = root.groups) != 3) {
+    stop(group.msg)
+  }
+  if (!all(required.groups %in% root.groups)) {
+    stop(group.msg)
+  }
+  unlist(x = sapply(
+    X = required.groups[1:2],
+    FUN = function(group) {
+      if (length(x = list.groups(object = object[[group]], recursive = FALSE)) > 0) {
+        stop(paste("Group", group, "cannot have subgroups"))
+      }
+      if (length(x = list.attributes(object = object[[group]])) > 0) {
+        stop(paste("Group", group, "cannot have subattributes"))
+      }
+      for (dataset in list.datasets(object = object[[group]])) {
+        if (object[[paste(group, dataset, sep = '/')]]$dims != dim.matrix[group]) {
+          stop(paste("All datasets in group", group, "must be of length", required.groups[group]))
+        }
+      }
+    }
+  ))
+  for (dataset in list.datasets(object = object[['/layers']])) {
+    if (any(object[[paste('layers', dataset, sep = '/')]]$dims != dim.matrix)) {
+      stop(paste("All datasets in '/layers' must be", dim.matrix[1], 'by', dim.matrix[2]))
+    }
+  }
+}
index 5bdded1bcdfb183f39af43f00a668d02e6988a14..4898b7f79d4817f68b400be1b4caa7ac713e8cb4 100644 (file)
--- a/R/loom.R
+++ b/R/loom.R
@@ -1,3 +1,4 @@
+#' @include internal.R
 #' @import hdf5r
 #' @importFrom R6 R6Class
 NULL
@@ -920,64 +921,6 @@ create <- function(
   return(new.loom)
 }
 
-# Validate a loom object
-#
-# @param object A loom object
-#
-# @return None, errors out if object is an invalid loom connection
-#
-# @seealso \code{\link{loom-class}}
-#
-#
-validateLoom <- function(object) {
-  # A loom file is a specific HDF5
-  # We need a dataset in /matrix that's a two-dimensional dense matrix
-  root.datasets <- list.datasets(object = object, path = '/', recursive = FALSE)
-  if (length(x = root.datasets) != 1) {
-    stop("There can only be one dataset at the root of the loom file")
-  }
-  if (root.datasets != 'matrix') {
-    stop("The root dataset must be called '/matrix'")
-  }
-  # There must be groups called '/col_attrs', '/row_attrs', and '/layers'
-  required.groups <- c('row_attrs', 'col_attrs', 'layers')
-  dim.matrix <- object[[root.datasets]]$dims # Columns x Rows
-  names(x = dim.matrix) <- required.groups[c(2, 1)]
-  root.groups <- list.groups(object = object, path = '/', recursive = FALSE)
-  group.msg <- paste0(
-    "There can only be three groups in the loom file: '",
-    paste(required.groups, collapse = "', '"),
-    "'"
-  )
-  if (length(x = root.groups) != 3) {
-    stop(group.msg)
-  }
-  if (!all(required.groups %in% root.groups)) {
-    stop(group.msg)
-  }
-  unlist(x = sapply(
-    X = required.groups[1:2],
-    FUN = function(group) {
-      if (length(x = list.groups(object = object[[group]], recursive = FALSE)) > 0) {
-        stop(paste("Group", group, "cannot have subgroups"))
-      }
-      if (length(x = list.attributes(object = object[[group]])) > 0) {
-        stop(paste("Group", group, "cannot have subattributes"))
-      }
-      for (dataset in list.datasets(object = object[[group]])) {
-        if (object[[paste(group, dataset, sep = '/')]]$dims != dim.matrix[group]) {
-          stop(paste("All datasets in group", group, "must be of length", required.groups[group]))
-        }
-      }
-    }
-  ))
-  for (dataset in list.datasets(object = object[['/layers']])) {
-    if (any(object[[paste('layers', dataset, sep = '/')]]$dims != dim.matrix)) {
-      stop(paste("All datasets in '/layers' must be", dim.matrix[1], 'by', dim.matrix[2]))
-    }
-  }
-}
-
 #' Connect to a loom file
 #'
 #' @param filename The loom file to connect to
@@ -1107,133 +1050,6 @@ subset.loom <- function(
   return(new.loom)
 }
 
-# Map a function or a series of functions over a loom file
-#
-# @param X A loom object
-# @param MARGIN The dimmension to map over, pass 1 for cells or 2 for genes
-# @param FUN A function to map to the loom file
-# @param chunk.size Chunk size to use, defaults to \code{loomfile$chunksize[MARGIN]}
-# @param index.use Indices of the dataset to use, defaults to \code{1:loomfile$shape[MARGIN]}
-# @param dataset.use Dataset to use, defauts to 'matrix'
-# @param display.progress Display a progress bar
-# @param expected Shape of expected results. Can pass either 'matrix' or 'vector'; defaults to shape of 'dataset.use'
-# @param ... Extra parameters for FUN
-#
-# @return The results of the map
-#
-# @importFrom utils txtProgressBar setTxtProgressBar
-#
-map <- function(
-  X,
-  MARGIN = 1,
-  FUN,
-  chunk.size = NULL,
-  index.use = NULL,
-  dataset.use = 'matrix',
-  display.progress = TRUE,
-  expected = NULL,
-  ...
-) {
-  if (!inherits(x = X, what = 'loom')) {
-    stop("map only works on loom objects")
-  }
-  if (!inherits(x = FUN, what = 'function')) {
-    stop("FUN must be a function")
-  }
-  # Check for existance of dataset
-  if (!any(grepl(pattern = dataset.use, x = list.datasets(object = X)))) {
-    stop(paste("Cannot find dataset", dataset.use, "in the loom file"))
-  }
-  # Figure out if we're returning a vector or matrix
-  full.dataset <- grep(
-    pattern = dataset.use,
-    x = list.datasets(object = X),
-    value = TRUE
-  )
-  results.matrix <- TRUE
-  dataset.matrix <- TRUE
-  if (grepl(pattern = 'col_attrs', x = full.dataset)) {
-    MARGIN <- 1
-    results.matrix <- FALSE
-    dataset.matrix <- FALSE
-  } else if (grepl(pattern = 'row_attrs', x = full.dataset)) {
-    MARGIN <- 2
-    results.matrix <- FALSE
-    dataset.matrix <- FALSE
-  }
-  if (!is.null(x = expected)) {
-    results.matrix <- switch(
-      EXPR = expected,
-      'vector' = FALSE,
-      'matrix' = TRUE,
-      stop("'expected' must be one of 'matrix', 'vector', or NULL")
-    )
-  }
-  # Determine the shape of our results
-  if (!(MARGIN %in% c(1, 2))) {
-    stop("MARGIN must be either 1 (cells) or 2 (genes)")
-  }
-  if (is.null(x = index.use)) {
-    index.use <- c(1, X$shape[MARGIN])
-  } else if (length(x = index.use) == 1) {
-    index.use <- c(1, index.use)
-  }
-  index.use[1] <- max(1, index.use[1])
-  index.use[2] <- min(index.use[2], X$shape[MARGIN])
-  batch <- X$batch.scan(
-    chunk.size = chunk.size,
-    MARGIN = MARGIN,
-    index.use = index.use,
-    dataset.use = dataset.use,
-    force.reset = TRUE
-  )
-  # Create our results holding object
-  if (results.matrix) {
-    switch(
-      EXPR = MARGIN,
-      '1' = results <- matrix(
-        nrow = length(x = index.use[1]:index.use[2]),
-        ncol = X$shape[2]
-      ),
-      '2' = results <- matrix(
-        nrow = X$shape[1],
-        ncol = length(x = index.use[1]:index.use[2])
-      )
-    )
-  } else {
-    results <- vector(length = length(x = index.use[1]:index.use[2]))
-  }
-  if (display.progress) {
-    pb <- txtProgressBar(char = '=', style = 3)
-  }
-  for (i in 1:length(x = batch)) {
-    chunk.indices <- X$batch.next(return.data = FALSE)
-    chunk.data <- if (dataset.matrix) {
-      switch(
-        EXPR = MARGIN,
-        '1' = X[[dataset.use]][chunk.indices, ],
-        '2' = X[[dataset.use]][, chunk.indices]
-      )
-    } else {
-      X[[dataset.use]][chunk.indices]
-    }
-    chunk.data <- FUN(chunk.data, ...)
-    if (results.matrix) {
-      if (MARGIN == 1) {
-        results[chunk.indices, ] <- chunk.data
-      } else if (MARGIN == 2) {
-        results[, chunk.indices] <- chunk.data
-      }
-    } else {
-      results[chunk.indices] <- chunk.data
-    }
-    if (display.progress) {
-      setTxtProgressBar(pb = pb, value = i / length(x = batch))
-    }
-  }
-  return(results)
-}
-
 # #need to comment
 # #need to add progress bar
 # #but otherwise, pretty cool