Re-export validateLoom and start create function
[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     # 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 }