Re-export validateLoom and start create function
[loomr.git] / R / loom.R
index 9129c8898e0511cd7ade5a77a8118be203e90c0f..076e7cab65748e7ccd6f703da35d9f0d41f54c81 100644 (file)
--- a/R/loom.R
+++ b/R/loom.R
-#' @import h5
-#' @importFrom methods setClass setMethod setGeneric callNextMethod
+#' @import hdf5r
+#' @importFrom R6 R6Class
 NULL
 
 #' A class for loom
 #'
+#' @docType class
 #' @name loom-class
 #' @rdname loom-class
-#' @exportClass loom
-#'
-loom <- setClass(
-  Class = 'loom',
-  #i'm not sure what we should store as slots, and what we should store as attributes or groups
-  slots = c(
-    version = 'ANY',
-    filename = 'ANY',
-    shape = "vector"
-  ),
-  contains = 'H5File'
+#' @return Object of class \code{\link{loom}}
+#' @seealso \code{\link{hdf5r::H5File}}
+#'
+#' @importFrom utils packageVersion
+#'
+#' @export
+#'
+loom <- R6Class(
+  classname = 'loom',
+  inherit = hdf5r::H5File,
+  cloneable = FALSE,
+  portable = TRUE,
+  lock_class = TRUE,
+  public = list(
+    # Fields
+    version = NULL,
+    shape = NULL,
+    chunksize = NULL,
+    # Methods
+    initialize = function(
+      filename = NULL,
+      mode = c('a', 'r', 'r+'),
+      ...
+    ) {
+      do.validate <- file.exists(filename)
+      super$initialize(filename = filename, mode = mode, ...)
+      if (do.validate) {
+        validateLoom(object = self)
+        self$shape <- self[['matrix']]$dims
+        chunks <- h5attr(x = self, which = 'chunks')
+        chunks <- gsub(pattern = '(', replacement = '', x = chunks, fixed = TRUE)
+        chunks <- gsub(pattern = ')', replacement = '', x = chunks, fixed = TRUE)
+        chunks <- unlist(x = strsplit(x = chunks, split = ','))
+        self$chunks <- as.integer(x = chunks)
+        self$version <- as.character(x = tryCatch(
+          expr = h5attr(x = self, which = 'version'),
+          error = function(e) packageVersion(pkg = 'loomR')
+        ))
+      } else {
+        # self$version <- packageVersion(pkg = 'loomR')
+        print()
+      }
+    }
+  )
 )
 
-#' @importFrom utils packageVersion
+#' Create a loom object
+#'
+#' @param filename ...
+#' @param data ...
+#' @param row.attrs ...
+#' @param col.attrs ...
+#'
+#' @return A connection to a loom file
 #'
-setMethod(
-  f = 'initialize',
-  signature = 'loom',
-  definition = function(.Object, name, mode = 'a') {
-    .Object <- callNextMethod(
-      .Object,
-      name = name,
-      mode = mode
-    )
-    #.Object@version <- packageVersion(pkg = 'loom')
-    return(.Object)
+#' @seealso \code{\link{loom-class}}
+#'
+create <- function(filename, data, row.attrs, col.attrs) {
+  if (file.exists(filename)) {
+    stop(paste('File', file, 'already exists!'))
   }
-)
+  new.loom <- loom$new(filename = filename, mode = 'r')
+}
+
+# #' @importFrom utils packageVersion
+# #'
+# setMethod(
+#   f = 'initialize',
+#   signature = 'loom',
+#   definition = function(.Object, name, mode = 'a') {
+#     .Object <- callNextMethod(
+#       .Object,
+#       name = name,
+#       mode = mode
+#     )
+#     validateLoom(object = .Object)
+#     #.Object@version <- packageVersion(pkg = 'loom')
+#     # .Object@filename <- name
+#     .Object@shape <- dim(.Object['/matrix'])
+#     return(.Object)
+#   }
+# )
+
 
 #' Validate a loom object
 #'
 #' @param object A loom object
 #'
-#' @return TRUE if a valid loom object
+#' @return None, errors if object is an invalid loom object
+#'
+#' @export
 #'
 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)
+  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') {
+  if (root.datasets != 'matrix') {
     stop("The root dataset must be called '/matrix'")
   }
-  dim.matrix <- object[root.datasets]@dim # Rows x Columns
   # There must be groups called '/col_attrs', '/row_attrs', and '/layers'
-  required.groups <- c('/col_attrs', '/row_attrs', '/layers')
-  root.groups <- list.groups(.Object = object, path = '/', recursive = FALSE)
+  required.groups <- c('row_attrs', 'col_attrs', 'layers')
+  dim.matrix <- object[[root.datasets]]$dims # Rows x Columns
+  names(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 = "', '"),
@@ -66,30 +125,45 @@ validateLoom <- function(object) {
   if (!all(required.groups %in% root.groups)) {
     stop(group.msg)
   }
-  vapply(
+  unlist(x = sapply(
     X = required.groups[1:2],
     FUN = function(group) {
-      if (length(x = list.groups(.Object = object, path = group, recursive = FALSE)) > 0) {
+      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) {
+      if (length(x = list.attributes(object = object[[group]])) > 0) {
         stop(paste("Group", group, "cannot have subattributes"))
       }
-      for (dataset in list.datasets(.Object = object, path = group)) {
-        break
+      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 = function(filename, mode = "r+") {
+#' Connect to a loom file
+#'
+#' @param filename The loom file to connect to
+#' @param mode How do we connect to it? Pass 'r' for read-only or 'r+' for read/write
+#'
+#' @return A loom file connection
+#'
+#' @export
+#'
+connect <- function(filename, mode = "r+") {
   self <- new("loom", filename, mode)
-  self@filename <- filename
-  self@shape = dim(self["matrix"])
+  self@filename <- filename
+  self@shape <- self["matrix"]@dim
   return(self)
 }
 
-
 #need to comment
 #need to add progress bar
 #but otherwise, pretty cool
@@ -99,8 +173,8 @@ connect = function(filename, mode = "r+") {
 # nGene <- map(f, f_list = function(x) length(which(x>0)), MARGIN = 2)
 map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, selection) {
   n_func = length(f_list)
-  if (n_func==1) f_list=list(f_list)
-  if (MARGIN==1) {
+  if (n_func == 1) f_list=list(f_list)
+  if (MARGIN == 1) {
     results=list();
     for (j in 1:n_func) {
       results[[j]] <- numeric(0)
@@ -114,11 +188,10 @@ map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, select
         new_results <- apply(chunk, 1, FUN = f_list[[j]])
         results[[j]] <- c(results[[j]], new_results)
       }
-      ix <- ix + chunksize 
+      ix <- ix + chunksize
     }
   }
-  
-  if (MARGIN==2) {
+  if (MARGIN == 2) {
     results=list();
     for (j in 1:n_func) {
       results[[j]] <- numeric(0)
@@ -132,9 +205,9 @@ map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, select
         new_results <- apply(chunk, 2, FUN = f_list[[j]])
         results[[j]] <- c(results[[j]], new_results)
       }
-      ix <- ix + chunksize 
+      ix <- ix + chunksize
     }
-  }  
+  }
   if (n_func == 1) return(results[[1]])
   return(results)
 }