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