Fix issues with create, further progress on batching
[loomr.git] / R / loom.R
index 8e8f364ccaa433dc068d4573ceb4cabb19b32ce9..758a19f114aa8a1526f32d331f08797ea68a5dbe 100644 (file)
--- a/R/loom.R
+++ b/R/loom.R
@@ -7,8 +7,8 @@ NULL
 #' @docType class
 #' @name loom-class
 #' @rdname loom-class
-#' @return Object of \code{\link{R6Class}} to generate \code{loom} objects
-#' @format An \code{\link{R6Class}} object
+#' @return Object of \code{\link{R6::R6Class}} to generate \code{loom} objects
+#' @format An \code{\link{R6::R6Class}} object
 #' @seealso \code{\link{hdf5r::H5File}}
 #'
 #' @field version Version of loomR object was created under
@@ -22,13 +22,27 @@ NULL
 #' @section Methods:
 #' \describe{
 #'   \item{\code{add.layer(layer)}}{Add a data layer to this loom file, must be in column (cells) by row (genes) orientation}
-#'   \item{\code{add.attribute(attribute, MARGIN)}}{Add extra information to this loom file; \code{attribute} is a named list where each element is a vector that is as long as one dimension of \code{/matrix}, \code{MARGIN} is either 1 for cells or 2 for genes}
+#'   \item{\code{add.attribute(attribute, MARGIN)}}{
+#'     Add extra information to this loom file where
+#'     \code{attribute} is a named list where each element is a vector that is as long as one dimension of \code{/matrix} and
+#'     \code{MARGIN} is either 1 for cells or 2 for genes
+#'   }
 #'   \item{\code{add.row.attribute(attribute)}}{A wrapper for \code{add.attribute(attribute, MARGIN = 2)}}
 #'   \item{\code{add.col.attribute(attribute)}}{A wrapper for \code{add.attribute(attribute, MARGIN = 1)}}
 #'   \item{\code{add.meta.data(meta.data)}}{A wrapper for \code{add.attribute(attribute, MARGIN = 1)}}
+#'   \item{\code{batch.scan(chunk.size, MARGIN, index.use, dataset.use)}, \code{batch.next}}{
+#'     Scan a dataset in the loom file from \code{index.use[1]} to \code{index.use[2]}, iterating by \code{chunk.size}.
+#'     \code{dataset.use} can be the name, not \code{group/name}, unless the name is present in multiple groups.
+#'     If the dataset is in col_attrs, pass \code{MARGIN = 1}; if in row_attrs, pass \code{MARGIN = 2}.
+#'     Otherwise, pass \code{MARGIN = 1} to iterate on cells or \code{MARGIN = 2} to iterate on genes.
+#'     \code{chunk.size} defaults to \code{self$chunksize}, \code{MARGIN} defaults to 1,
+#'     \code{index.use} defaults to \code{1:self$shape[MARGIN]}, \code{dataset.use} defaults to 'matrix'
+#'   }
 #' }
 #'
+#' @importFrom iterators nextElem
 #' @importFrom utils packageVersion
+#' @importFrom itertools ihasNext ichunk hasNext
 #'
 #' @export
 #'
@@ -62,7 +76,8 @@ loom <- R6Class(
       if (do.validate) {
         # Run the validation steps
         validateLoom(object = self)
-        # Store the shape of /matrix
+        # Store /matrix and the shape of /matrix
+        self$matrix <- self[['matrix']]
         self$shape <- self[['matrix']]$dims
         # Store the chunk size
         chunks <- h5attr(x = self, which = 'chunks')
@@ -97,36 +112,42 @@ loom <- R6Class(
         self$version <- as.character(x = packageVersion(pkg = 'loomR'))
       }
     },
-    add.layer = function(layer, name) {
-      # Layers have to be matricies
-      if (!is.matrix(x = layer)) {
-        layer <- as.matrix(x = layer)
+    add.layer = function(layers) {
+      # Value checking
+      if (!is.list(x = layers) || is.null(x = names(x = layers))) {
+        stop("'layers' must be a named list")
       }
       if (is.null(x = self$shape)) {
         stop(private$err_msg)
       }
-      do.transpose <- FALSE
-      if (any(dim(x = layer) != self$shape)) {
-        if (all(rev(x = dim(x = layer)) == self$shape)) {
-          do.transpose <- TRUE
+      # Add layers
+      for (i in 1:length(x = layers)) {
+        if (!is.matrix(x = layers[[i]])) {
+          layers[[i]] <- as.matrix(x = layers[[i]])
+        }
+        do.transpose <- FALSE
+        if (any(dim(x = layers[[i]]) != self$shape)) {
+          if (all(rev(x = dim(x = layers[[i]])) == self$shape)) {
+            do.transpose <- TRUE
+          } else {
+            stop(paste(
+              "All layers must have",
+              self$shape[1],
+              "rows for cells and",
+              self$shape[2],
+              "columns for genes"
+            ))
+          }
+        }
+        if (do.transpose) {
+          self[['layers', names(x = layers)[i]]] <- t(x = layers[[i]])
         } else {
-          stop(paste(
-            "All layers must have",
-            self$shape[1],
-            "rows for cells and",
-            self$shape[2],
-            "columns for genes"
-          ))
+          self[['layers', names(x = layers)[i]]] <- layers[[i]]
         }
       }
-      # Transpose the matrix since hdf5r uses column x row
-      if (do.transpose) {
-        self[['layers', name]] <- t(x = layer)
-      } else {
-        self[[layers, name]] <- layer
-      }
       self$flush()
       private$load_layers()
+      invisible(x = self)
     },
     add.attribute = function(attribute, MARGIN) {
       # Value checking
@@ -166,29 +187,137 @@ loom <- R6Class(
       gc(verbose = FALSE)
       # Load the attributes for this margin
       private$load_attributes(MARGIN = MARGIN)
+      invisible(x = self)
     },
     # Add attributes for genes
     add.row.attribute = function(attribute) {
       self$add.attribute(attribute = attribute, MARGIN = 2)
+      invisible(x = self)
     },
     # Add attributes for cells
     add.col.attribute = function(attribute) {
       self$add.attribute(attribute = attribute, MARGIN = 1)
+      invisible(x = self)
     },
     # Add metadata, follows cells
     add.meta.data = function(meta.data) {
       self$add.col.attribute(attribute = meta.data)
+      invisible(x = self)
+    },
+    # Batch scan
+    batch.scan = function(
+      chunk.size = NULL,
+      MARGIN = 1,
+      index.use = NULL,
+      dataset.use = 'matrix'
+    ) {
+      if (is.null(x = private$it) || !grepl(pattern = dataset.use, x = private$iter.dataset)) {
+        # Check the existence of the dataset
+        private$iter.dataset <- grep(
+          pattern = dataset.use,
+          x = list.datasets(object = self),
+          value = TRUE
+        )
+        if (length(x = private$iter.dataset) != 1) {
+          stop(paste0("Cannot find dataset '", dataset.use, "' in the loom file"))
+        }
+        # Check the margin
+        if (!(MARGIN %in% c(1, 2))) {
+          stop("MARGIN must be 1 (cells) or 2 (genes)")
+        } else {
+          private$iter.margin <- MARGIN
+        }
+        if (is.null(x = chunk.size)) {
+          chunk.size <- self$chunksize[MARGIN]
+        }
+        # Set the indices to use
+        if (is.null(x = index.use)) {
+          index.use <- c(1, self$shape[MARGIN])
+        } else if (length(x = index.use) == 1) {
+          index.use <- index.use <- 1:index.use
+        } else {
+          index.use <- c(index.use[1], index.use[2])
+        }
+        index.use[1] <- max(1, index.use[1])
+        index.use[2] <- min(index.use[2], self$shape[MARGIN])
+        if (index.use[1] > index.use[2]) {
+          stop(paste0(
+            "Starting index (",
+            index.use[1],
+            ") must be lower than the ending index (",
+            index.use[2],
+            ")"
+          ))
+        }
+        # Setup our iterator
+        private$it <- ihasNext(iterable = ichunk(
+          iterable = index.use[1]:index.use[2],
+          chunkSize = chunk.size
+        ))
+        private$iter.index <- c(index.use[1], ceiling(x = index.use[2] / chunk.size))
+      }
+      return(private$iter.index[1]:private$iter.index[2])
+      # # Do the iterating
+      # if (hasNext(obj = private$it)) {
+      #   chunk.indices <- unlist(x = nextElem(obj = private$it))
+      #   if (private$iter.dataset == 'matrix' || grepl(pattern = 'layers', x = private$iter.dataset)) {
+      #     return(switch(
+      #       EXPR = private$iter.margin,
+      #       '1' = self[[private$iter.dataset]][chunk.indices, ],
+      #       '2' = self[[private$iter.dataset]][, chunk.indices]
+      #     ))
+      #   } else {
+      #     return(self[[private$iter.dataset]][chunk.indices])
+      #   }
+      # } else {
+      #   private$it <- NULL
+      #   return(NULL)
+      # }
+    },
+    batch.next = function() {
+      if (!'hasNext.ihasNext' %in% suppressWarnings(expr = methods(class = class(x = private$it)))) {
+        stop("Please setup the iterator with self$batch.scan")
+      }
+      # Do the iterating
+      if (hasNext(obj = private$it)) {
+        chunk.indices <- unlist(x = nextElem(obj = private$it))
+        if (private$iter.dataset == 'matrix' || grepl(pattern = 'layers', x = private$iter.dataset)) {
+          to.return <- switch(
+            EXPR = private$iter.margin,
+            '1' = self[[private$iter.dataset]][chunk.indices, ],
+            '2' = self[[private$iter.dataset]][, chunk.indices]
+          )
+        } else {
+          to.return <- self[[private$iter.dataset]][chunk.indices]
+        }
+        if (!hasNext(obj = private$it)) {
+          private$reset_batch()
+        }
+        return(to.return)
+      } else {
+        private$reset_batch()
+        return(NULL)
+      }
     }
   ),
   # Private fields and methods
   # @field err_msg A simple error message if this object hasn't been created with loomR::create or loomR::connect
+  # @field it
+  # @field iter.dataset
+  # @field iter.margin
+  # @field iter.index
   # \describe{
   #   \item{\code{load_attributes(MARGIN)}}{Load attributes of a given MARGIN into \code{self$col.attrs} or \code{self$row.attrs}}
   #   \item{\code{load_layers()}}{Load layers into \code{self$layers}}
+  #   \item{\code{reset_batch()}}{Reset the batch iterator fields}
   # }
   private = list(
     # Fields
     err_msg = "This loom object has not been created with either loomR::create or loomR::connect, please use these function to create or connect to a loom file",
+    it = NULL,
+    iter.dataset = NULL,
+    iter.margin = NULL,
+    iter.index = NULL,
     # Methods
     load_attributes = function(MARGIN) {
       attribute <- switch(
@@ -221,6 +350,12 @@ loom <- R6Class(
           return(d)
         }
       ))
+    },
+    reset_batch = function() {
+      private$it <- NULL
+      private$iter.dataset <- NULL
+      private$iter.margin <- NULL
+      private$iter.index <- NULL
     }
   )
 )
@@ -239,6 +374,8 @@ loom <- R6Class(
 #'
 #' @seealso \code{\link{loom-class}}
 #'
+#' @export
+#'
 create <- function(
   filename,
   data,
@@ -266,15 +403,21 @@ create <- function(
   # Create the matrix
   new.loom$create_dataset(
     name = 'matrix',
-    robj = t(x = data),
+    robj = data,
     chunk_dims = chunk.dims
   )
+  new.loom$matrix <- new.loom[['matrix']]
   new.loom$shape <- new.loom[['matrix']]$dims
+  # Groups
+  new.loom$create_group(name = 'layers')
+  new.loom$create_group(name = 'row_attrs')
+  new.loom$create_group(name = 'col_attrs')
+  # Check for the existance of gene or cell names
   if (!is.null(x = colnames(x = data))) {
     new.loom$add.row.attribute(attribute = list('gene_names' = colnames(x = data)))
   }
   if (!is.null(x = rownames(x = data))) {
-    new.loom$add.col.attribute(attribute = list('cell_names' = colnames(x = data)))
+    new.loom$add.col.attribute(attribute = list('cell_names' = rownames(x = data)))
   }
   # Store some constants as HDF5 attributes
   h5attr(x = new.loom, which = 'version') <- new.loom$version
@@ -283,13 +426,9 @@ create <- function(
     paste(new.loom[['matrix']]$chunk_dims, collapse = ', '),
     ')'
   )
-  # Groups
-  new.loom$create_group(name = 'layers')
-  new.loom$create_group(name = 'row_attrs')
-  new.loom$create_group(name = 'col_attrs')
   # Add layers
-  for (ly in layers) {
-    new.loom$add.layer(layer = ly)
+  if (!is.null(x = layers)) {
+    new.loom$add.layer(layer = layers)
   }
   if (!is.null(x = gene.attrs)) {
     new.loom$add.row.attribute(attribute = gene.attrs)
@@ -311,7 +450,9 @@ create <- function(
 #'
 #' @param object A loom object
 #'
-#' @return None, errors if object is an invalid loom connection
+#' @return None, errors out if object is an invalid loom connection
+#'
+#' @seealso \code{\link{loom-class}}
 #'
 #' @export
 #'
@@ -327,7 +468,7 @@ validateLoom <- function(object) {
   }
   # 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 # Rows x Columns
+  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(
@@ -371,6 +512,8 @@ validateLoom <- function(object) {
 #'
 #' @return A loom file connection
 #'
+#' @seealso \code{\link{loom-class}}
+#'
 #' @export
 #'
 connect <- function(filename, mode = "r") {
@@ -381,6 +524,20 @@ connect <- function(filename, mode = "r") {
   return(new.loom)
 }
 
+CreateLoomFromSeurat <- function(object, filename) {
+  object.data=t(object@raw.data[rownames(object@data),object@cell.names])
+  object.meta.data=object@meta.data
+  row_attrs=list(); col_attrs=list()
+  gene.names=colnames(object.data)
+  object.meta.data$ident = object@ident
+  object.meta.data$CellID = object@cell.names
+  for(i in 1:ncol(object.meta.data)) {
+    col_attrs[[colnames(object.meta.data)[i]]]=object.meta.data[,i]
+  }
+  row_attrs[["Gene"]]=gene.names
+  create(filename,object.data,gene.attrs = row_attrs, cell.attrs = col_attrs)
+}
+
 #need to comment
 #need to add progress bar
 #but otherwise, pretty cool