Merge branch 'master' of github.com:mojaveazure/loomR
authorPaul Hoffman <phoffman@nygenome.org>
Mon, 23 Oct 2017 22:38:00 +0000 (18:38 -0400)
committerPaul Hoffman <phoffman@nygenome.org>
Mon, 23 Oct 2017 22:38:00 +0000 (18:38 -0400)
1  2 
R/loom.R

diff --cc R/loom.R
index 7071222f439ed7b7829572c37f3006679dca6346,10f31f57769d3a290c20f91294fdccc176a84c30..9129c8898e0511cd7ade5a77a8118be203e90c0f
+++ b/R/loom.R
@@@ -32,49 -35,59 +35,106 @@@ setMethod
    }
  )
  
 +#' Validate a loom object
 +#'
 +#' @param object A loom object
 +#'
 +#' @return TRUE if a valid loom object
 +#'
 +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'")
 +  }
 +  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)
 +  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)
 +  }
 +  vapply(
 +    X = required.groups[1:2],
 +    FUN = function(group) {
 +      if (length(x = list.groups(.Object = object, path = 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, path = group)) {
 +        break
 +      }
 +    }
 +  )
 +}
++
+ connect = function(filename, mode = "r+") {
+   self <- new("loom", filename, mode)
+   self@filename <- filename
+   self@shape = dim(self["matrix"])
+   return(self)
+ }
+ #need to comment
+ #need to add progress bar
+ #but otherwise, pretty cool
+ #for paul to try :
+ # f <- connect("~/Downloads/10X43_1.loom")
+ # mean_var = map(f,f_list = c(mean,var),chunksize = 5000)
+ # 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) {
+     results=list();
+     for (j in 1:n_func) {
+       results[[j]] <- numeric(0)
+     }
+     rows_per_chunk <- chunksize
+     ix <- 1
+     while (ix <= self@shape[1]) {
+       rows_per_chunk <- min(rows_per_chunk, self@shape[1]-ix+1)
+       chunk <- self["matrix"][ix:(ix + rows_per_chunk -1), ]
+       for(j in 1:n_func) {
+         new_results <- apply(chunk, 1, FUN = f_list[[j]])
+         results[[j]] <- c(results[[j]], new_results)
+       }
+       ix <- ix + chunksize 
+     }
+   }
+   
+   if (MARGIN==2) {
+     results=list();
+     for (j in 1:n_func) {
+       results[[j]] <- numeric(0)
+     }
+     cols_per_chunk <- chunksize
+     ix <- 1
+     while (ix <= self@shape[2]) {
+       cols_per_chunk <- min(cols_per_chunk, self@shape[2]-ix+1)
+       chunk <- self["matrix"][,ix:(ix + cols_per_chunk -1)]
+       for(j in 1:n_func) {
+         new_results <- apply(chunk, 2, FUN = f_list[[j]])
+         results[[j]] <- c(results[[j]], new_results)
+       }
+       ix <- ix + chunksize 
+     }
+   }  
+   if (n_func == 1) return(results[[1]])
+   return(results)
+ }