f1f316138303e36f70890a8f00daf9bc0b44cd31
[loomr.git] / 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     matrix = NULL,
29     layers = NULL,
30     col.attrs = NULL,
31     row.attrs = NULL,
32     # Methods
33     initialize = function(filename = NULL, mode = c('a', 'r', 'r+', 'w', 'w+'), ...) {
34       # If the file exists, run validation steps
35       do.validate <- file.exists(filename) && !(mode %in% c('w', 'w+'))
36       super$initialize(filename = filename, mode = mode, ...)
37       if (do.validate) {
38         # Run the validation steps
39         validateLoom(object = self)
40         # Store the shape of /matrix
41         self$shape <- self[['matrix']]$dims
42         # Store the chunk size
43         chunks <- h5attr(x = self, which = 'chunks')
44         chunks <- gsub(pattern = '(', replacement = '', x = chunks, fixed = TRUE)
45         chunks <- gsub(pattern = ')', replacement = '', x = chunks, fixed = TRUE)
46         chunks <- unlist(x = strsplit(x = chunks, split = ','))
47         self$chunks <- as.integer(x = chunks)
48         # Store version information
49         self$version <- as.character(x = tryCatch(
50           # Try getting a version
51           # If it doesn't exist, can we write to the file?
52           # If so, store the version as this version of loomR
53           # Otherwise, store the version as NA_character_
54           expr = h5attr(x = self, which = 'version'),
55           error = function(e) {
56             if (mode != 'r') {
57               version <- packageVersion(pkg = 'loomR')
58               h5attr(x = self, which = 'version') <- version
59             } else {
60               version <- NA_character_
61             }
62             return(version)
63           }
64         ))
65         # Load layers
66         private$load_layers()
67         # Load attributes
68         private$load_attirubtes(MARGIN = 1)
69         private$load_attributes(MARGIN = 2)
70       } else {
71         # Assume new HDF5 file
72         self$version <- packageVersion(pkg = 'loomR')
73       }
74     },
75     add.layer = function(layer) {
76       invisible(x = NULL)
77     },
78     add.attribute = function(attribute, MARGIN = 1) {
79       invisible(x = NULL)
80     },
81     add.row.attribute = function(attribute) {
82       invisible(x = NULL)
83     },
84     add.col.attribute = function(attribute) {
85       invisible(x = NULL)
86     }
87   ),
88   private = list(
89     add_attribute = function(attribute, MARGIN) {
90       invisible(x = NULL)
91     },
92     load_attributes = function(MARGIN) {
93       attribute <- switch(
94         EXPR = MARGIN,
95         '1' = 'row_attrs',
96         '2' = 'col_attrs',
97         stop('Invalid attribute dimension')
98       )
99       group <- self[[attribute]]
100       attributes <- unlist(x = lapply(
101         X = names(x = group),
102         FUN = function(x) {
103           d <- list(group[[x]])
104           names(x = d) <- x
105           return(d)
106         }
107       ))
108       switch(
109         EXPR = MARGIN,
110         '1' = self$row.attrs <- attributes,
111         '2' = self$col.attrs <- attributes
112       )
113     },
114     load_layers = function() {
115       invisible(x = NULL)
116     }
117   )
118 )
119
120 #' Create a loom object
121 #'
122 #' @param filename ...
123 #' @param data ...
124 #' @param row.attrs ...
125 #' @param col.attrs ...
126 #' @param chunk.dims ...
127 #'
128 #' @return A connection to a loom file
129 #'
130 #' @importFrom utils packageVersion
131 #'
132 #' @seealso \code{\link{loom-class}}
133 #'
134 create <- function(
135   filename,
136   data,
137   row.attrs = NULL,
138   col.attrs = NULL,
139   layers = NULL,
140   chunk.dims = 'auto'
141 ) {
142   if (file.exists(filename)) {
143     stop(paste('File', file, 'already exists!'))
144   }
145   if (!is.matrix(x = data)) {
146     data <- as.matrix(x = data)
147   }
148   if (length(x = chunk.dims) > 2 || length(x = chunk.dims < 1)) {
149     stop("'chunk.dims' must be a one- or two-length integer vector or 'auto'")
150   } else if (length(x = chunk.dims == 1)) {
151     if (!grepl(pattern = '^auto$', x = chunk.dims, perl = TRUE)) {
152       chunk.dims <- rep.int(x = as.integer(x = chunk.dims), times = 2)
153     }
154   } else {
155     chunk.dims <- as.integer(x = chunk.dims)
156   }
157   new.loom <- loom$new(filename = filename, mode = 'r')
158   h5attr(x = new.loom, which = 'version') <- as.character(x = packageVersion(pkg = 'loomR'))
159   new.loom$create_dataset(
160     name = 'matrix',
161     robj = data,
162     chunk_dims = chunk.dims
163   )
164   # Groups
165   new.loom$create_group(name = 'layers')
166   new.loom$create_group(name = 'row_attrs')
167   new.loom$create_group(name = 'col_attrs')
168   # Add layers
169   for (ly in layers) {
170     new.loom$add.layer(layer = ly)
171   }
172   for (rw in row.attrs) {
173     new.loom$add.row.attribute(attribute = rw)
174   }
175   for (cl in col.attrs) {
176     new.loom$add.col.attribute(attribute = cl)
177   }
178   # Set last bit of information
179   new.loom$shape <- ''
180   new.loom$chunksize <- ''
181 }
182
183 # #' @importFrom utils packageVersion
184 # #'
185 # setMethod(
186 #   f = 'initialize',
187 #   signature = 'loom',
188 #   definition = function(.Object, name, mode = 'a') {
189 #     .Object <- callNextMethod(
190 #       .Object,
191 #       name = name,
192 #       mode = mode
193 #     )
194 #     validateLoom(object = .Object)
195 #     #.Object@version <- packageVersion(pkg = 'loom')
196 #     # .Object@filename <- name
197 #     .Object@shape <- dim(.Object['/matrix'])
198 #     return(.Object)
199 #   }
200 # )
201
202
203 #' Validate a loom object
204 #'
205 #' @param object A loom object
206 #'
207 #' @return None, errors if object is an invalid loom object
208 #'
209 #' @export
210 #'
211 validateLoom <- function(object) {
212   # A loom file is a specific HDF5
213   # We need a dataset in /matrix that's a two-dimensional dense matrix
214   root.datasets <- list.datasets(object = object, path = '/', recursive = FALSE)
215   if (length(x = root.datasets) != 1) {
216     stop("There can only be one dataset at the root of the loom file")
217   }
218   if (root.datasets != 'matrix') {
219     stop("The root dataset must be called '/matrix'")
220   }
221   # There must be groups called '/col_attrs', '/row_attrs', and '/layers'
222   required.groups <- c('row_attrs', 'col_attrs', 'layers')
223   dim.matrix <- object[[root.datasets]]$dims # Rows x Columns
224   names(dim.matrix) <- required.groups[c(2, 1)]
225   root.groups <- list.groups(object = object, path = '/', recursive = FALSE)
226   group.msg <- paste0(
227     "There can only be three groups in the loom file: '",
228     paste(required.groups, collapse = "', '"),
229     "'"
230   )
231   if (length(x = root.groups) != 3) {
232     stop(group.msg)
233   }
234   if (!all(required.groups %in% root.groups)) {
235     stop(group.msg)
236   }
237   unlist(x = sapply(
238     X = required.groups[1:2],
239     FUN = function(group) {
240       if (length(x = list.groups(object = object[[group]], recursive = FALSE)) > 0) {
241         stop(paste("Group", group, "cannot have subgroups"))
242       }
243       if (length(x = list.attributes(object = object[[group]])) > 0) {
244         stop(paste("Group", group, "cannot have subattributes"))
245       }
246       for (dataset in list.datasets(object = object[[group]])) {
247         if (object[[paste(group, dataset, sep = '/')]]$dims != dim.matrix[group]) {
248           stop(paste("All datasets in group", group, "must be of length", required.groups[group]))
249         }
250       }
251     }
252   ))
253   for (dataset in list.datasets(object = object[['/layers']])) {
254     if (any(object[[paste('layers', dataset, sep = '/')]]$dims != dim.matrix)) {
255       stop(paste("All datasets in '/layers' must be", dim.matrix[1], 'by', dim.matrix[2]))
256     }
257   }
258 }
259
260 #' Connect to a loom file
261 #'
262 #' @param filename The loom file to connect to
263 #' @param mode How do we connect to it? Pass 'r' for read-only or 'r+' for read/write
264 #'
265 #' @return A loom file connection
266 #'
267 #' @export
268 #'
269 connect <- function(filename, mode = "r") {
270   new.loom <- loom$new(filename = filename, mode = mode)
271   return(new.loom)
272 }
273
274 #need to comment
275 #need to add progress bar
276 #but otherwise, pretty cool
277 #for paul to try :
278 # f <- connect("~/Downloads/10X43_1.loom")
279 # mean_var = map(f,f_list = c(mean,var),chunksize = 5000)
280 # nGene <- map(f, f_list = function(x) length(which(x>0)), MARGIN = 2)
281 map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, selection) {
282   n_func = length(f_list)
283   if (n_func == 1) {
284     f_list <- list(f_list)
285   }
286   if (MARGIN == 1) {
287     results <- list()
288     for (j in 1:n_func) {
289       results[[j]] <- numeric(0)
290     }
291     rows_per_chunk <- chunksize
292     ix <- 1
293     while (ix <= self@shape[1]) {
294       rows_per_chunk <- min(rows_per_chunk, self@shape[1] - ix + 1)
295       chunk <- self["matrix"][ix:(ix + rows_per_chunk - 1), ]
296       for (j in 1:n_func) {
297         new_results <- apply(chunk, 1, FUN = f_list[[j]])
298         results[[j]] <- c(results[[j]], new_results)
299       }
300       ix <- ix + chunksize
301     }
302   }
303   if (MARGIN == 2) {
304     results <- list()
305     for (j in 1:n_func) {
306       results[[j]] <- numeric(0)
307     }
308     cols_per_chunk <- chunksize
309     ix <- 1
310     while (ix <= self@shape[2]) {
311       cols_per_chunk <- min(cols_per_chunk, self@shape[2] - ix + 1)
312       chunk <- self["matrix"][, ix:(ix + cols_per_chunk - 1)]
313       for (j in 1:n_func) {
314         new_results <- apply(chunk, 2, FUN = f_list[[j]])
315         results[[j]] <- c(results[[j]], new_results)
316       }
317       ix <- ix + chunksize
318     }
319   }
320   if (n_func == 1) {
321     results <- results[[1]]
322   }
323   return(results)
324 }