R/loom.R

   1 #' @import hdf5r
   2 #' @importFrom R6 R6Class
   3 NULL
   4
   5 #' A class for loom
   6 #'
   7 #' @docType class
   8 #' @name loom-class
   9 #' @rdname loom-class
  10 #' @return Object of class \code{\link{loom}}
  11 #' @seealso \code{\link{hdf5r::H5File}}
  12 #'
  13 #' @importFrom utils packageVersion
  14 #'
  15 #' @export
  16 #'
  17 loom <- R6Class(
  18   classname = 'loom',
  19   inherit = hdf5r::H5File,
  20   cloneable = FALSE,
  21   portable = TRUE,
  22   lock_class = TRUE,
  23   public = list(
  24     # Fields
  25     version = NULL,
  26     shape = NULL,
  27     chunksize = NULL,
  28     # Methods
  29     initialize = function(
  30       filename = NULL,
  31       mode = c('a', 'r', 'r+'),
  32       ...
  33     ) {
  34       do.validate <- file.exists(filename)
  35       super$initialize(filename = filename, mode = mode, ...)
  36       if (do.validate) {
  37         validateLoom(object = self)
  38         self$shape <- self[['matrix']]$dims
  39         chunks <- h5attr(x = self, which = 'chunks')
  40         chunks <- gsub(pattern = '(', replacement = '', x = chunks, fixed = TRUE)
  41         chunks <- gsub(pattern = ')', replacement = '', x = chunks, fixed = TRUE)
  42         chunks <- unlist(x = strsplit(x = chunks, split = ','))
  43         self$chunks <- as.integer(x = chunks)
  44         self$version <- as.character(x = tryCatch(
  45           expr = h5attr(x = self, which = 'version'),
  46           error = function(e) packageVersion(pkg = 'loomR')
  47         ))
  48       } else {
  49         # self$version <- packageVersion(pkg = 'loomR')
  50         print()
  51       }
  52     }
  53   )
  54 )
  55
  56 #' Create a loom object
  57 #'
  58 #' @param filename ...
  59 #' @param data ...
  60 #' @param row.attrs ...
  61 #' @param col.attrs ...
  62 #'
  63 #' @return A connection to a loom file
  64 #'
  65 #' @seealso \code{\link{loom-class}}
  66 #'
  67 create <- function(filename, data, row.attrs, col.attrs) {
  68   if (file.exists(filename)) {
  69     stop(paste('File', file, 'already exists!'))
  70   }
  71   new.loom <- loom$new(filename = filename, mode = 'r')
  72 }
  73
  74 # #' @importFrom utils packageVersion
  75 # #'
  76 # setMethod(
  77 #   f = 'initialize',
  78 #   signature = 'loom',
  79 #   definition = function(.Object, name, mode = 'a') {
  80 #     .Object <- callNextMethod(
  81 #       .Object,
  82 #       name = name,
  83 #       mode = mode
  84 #     )
  85 #     validateLoom(object = .Object)
  86 #     #.Object@version <- packageVersion(pkg = 'loom')
  87 #     # .Object@filename <- name
  88 #     .Object@shape <- dim(.Object['/matrix'])
  89 #     return(.Object)
  90 #   }
  91 # )
  92
  93
  94 #' Validate a loom object
  95 #'
  96 #' @param object A loom object
  97 #'
  98 #' @return None, errors if object is an invalid loom object
  99 #'
 100 #' @export
 101 #'
 102 validateLoom <- function(object) {
 103   # A loom file is a specific HDF5
 104   # We need a dataset in /matrix that's a two-dimensional dense matrix
 105   root.datasets <- list.datasets(object = object, path = '/', recursive = FALSE)
 106   if (length(x = root.datasets) != 1) {
 107     stop("There can only be one dataset at the root of the loom file")
 108   }
 109   if (root.datasets != 'matrix') {
 110     stop("The root dataset must be called '/matrix'")
 111   }
 112   # There must be groups called '/col_attrs', '/row_attrs', and '/layers'
 113   required.groups <- c('row_attrs', 'col_attrs', 'layers')
 114   dim.matrix <- object[[root.datasets]]$dims # Rows x Columns
 115   names(dim.matrix) <- required.groups[c(2, 1)]
 116   root.groups <- list.groups(object = object, path = '/', recursive = FALSE)
 117   group.msg <- paste0(
 118     "There can only be three groups in the loom file: '",
 119     paste(required.groups, collapse = "', '"),
 120     "'"
 121   )
 122   if (length(x = root.groups) != 3) {
 123     stop(group.msg)
 124   }
 125   if (!all(required.groups %in% root.groups)) {
 126     stop(group.msg)
 127   }
 128   unlist(x = sapply(
 129     X = required.groups[1:2],
 130     FUN = function(group) {
 131       if (length(x = list.groups(object = object[[group]], recursive = FALSE)) > 0) {
 132         stop(paste("Group", group, "cannot have subgroups"))
 133       }
 134       if (length(x = list.attributes(object = object[[group]])) > 0) {
 135         stop(paste("Group", group, "cannot have subattributes"))
 136       }
 137       for (dataset in list.datasets(object = object[[group]])) {
 138         if (object[[paste(group, dataset, sep = '/')]]$dims != dim.matrix[group]) {
 139           stop(paste("All datasets in group", group, "must be of length", required.groups[group]))
 140         }
 141       }
 142     }
 143   ))
 144   for (dataset in list.datasets(object = object[['/layers']])) {
 145     if (any(object[[paste('layers', dataset, sep = '/')]]$dims != dim.matrix)) {
 146       stop(paste("All datasets in '/layers' must be", dim.matrix[1], 'by', dim.matrix[2]))
 147     }
 148   }
 149 }
 150
 151 #' Connect to a loom file
 152 #'
 153 #' @param filename The loom file to connect to
 154 #' @param mode How do we connect to it? Pass 'r' for read-only or 'r+' for read/write
 155 #'
 156 #' @return A loom file connection
 157 #'
 158 #' @export
 159 #'
 160 connect <- function(filename, mode = "r+") {
 161   self <- new("loom", filename, mode)
 162   # self@filename <- filename
 163   self@shape <- self["matrix"]@dim
 164   return(self)
 165 }
 166
 167 #need to comment
 168 #need to add progress bar
 169 #but otherwise, pretty cool
 170 #for paul to try :
 171 # f <- connect("~/Downloads/10X43_1.loom")
 172 # mean_var = map(f,f_list = c(mean,var),chunksize = 5000)
 173 # nGene <- map(f, f_list = function(x) length(which(x>0)), MARGIN = 2)
 174 map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, selection) {
 175   n_func = length(f_list)
 176   if (n_func == 1) f_list=list(f_list)
 177   if (MARGIN == 1) {
 178     results=list();
 179     for (j in 1:n_func) {
 180       results[[j]] <- numeric(0)
 181     }
 182     rows_per_chunk <- chunksize
 183     ix <- 1
 184     while (ix <= self@shape[1]) {
 185       rows_per_chunk <- min(rows_per_chunk, self@shape[1]-ix+1)
 186       chunk <- self["matrix"][ix:(ix + rows_per_chunk -1), ]
 187       for(j in 1:n_func) {
 188         new_results <- apply(chunk, 1, FUN = f_list[[j]])
 189         results[[j]] <- c(results[[j]], new_results)
 190       }
 191       ix <- ix + chunksize
 192     }
 193   }
 194   if (MARGIN == 2) {
 195     results=list();
 196     for (j in 1:n_func) {
 197       results[[j]] <- numeric(0)
 198     }
 199     cols_per_chunk <- chunksize
 200     ix <- 1
 201     while (ix <= self@shape[2]) {
 202       cols_per_chunk <- min(cols_per_chunk, self@shape[2]-ix+1)
 203       chunk <- self["matrix"][,ix:(ix + cols_per_chunk -1)]
 204       for(j in 1:n_func) {
 205         new_results <- apply(chunk, 2, FUN = f_list[[j]])
 206         results[[j]] <- c(results[[j]], new_results)
 207       }
 208       ix <- ix + chunksize
 209     }
 210   }
 211   if (n_func == 1) return(results[[1]])
 212   return(results)
 213 }