c66f118b50723c574b1438b2a4d494da3f71ff3c
[loomr.git] / R / loom.R
1 #' @import h5
2 #' @importFrom methods setClass setMethod setGeneric callNextMethod
3 NULL
4
5 #' A class for loom
6 #'
7 #' @slot shape The shape of /matrix
8 #' @slot version The version of loomR that this object was made under
9 #'
10 #' @name loom-class
11 #' @rdname loom-class
12 #' @exportClass loom
13 #'
14 loom <- setClass(
15   Class = 'loom',
16   #i'm not sure what we should store as slots, and what we should store as attributes or groups
17   slots = c(
18     # filename = 'ANY', # Already provided through H5File@location
19     shape = 'vector',
20     version = 'ANY'
21   ),
22   contains = 'H5File'
23 )
24
25 #' @importFrom utils packageVersion
26 #'
27 setMethod(
28   f = 'initialize',
29   signature = 'loom',
30   definition = function(.Object, name, mode = 'a') {
31     .Object <- callNextMethod(
32       .Object,
33       name = name,
34       mode = mode
35     )
36     validateLoom(object = .Object)
37     #.Object@version <- packageVersion(pkg = 'loom')
38     # .Object@filename <- name
39     .Object@shape <- dim(.Object['/matrix'])
40     return(.Object)
41   }
42 )
43
44 #' Validate a loom object
45 #'
46 #' @param object A loom object
47 #'
48 #' @return None, errors if object is an invalid loom object
49 #'
50 validateLoom <- function(object) {
51   # A loom file is a specific HDF5
52   # We need a dataset in /matrix that's a two-dimensional dense matrix
53   root.datasets <- list.datasets(.Object = object, path = '/', recursive = FALSE)
54   if (length(x = root.datasets) != 1) {
55     stop("There can only be one dataset at the root of the loom file")
56   }
57   if (root.datasets != '/matrix') {
58     stop("The root dataset must be called '/matrix'")
59   }
60   # There must be groups called '/col_attrs', '/row_attrs', and '/layers'
61   required.groups <- c('/row_attrs', '/col_attrs', '/layers')
62   dim.matrix <- object[root.datasets]@dim # Rows x Columns
63   names(dim.matrix) <- required.groups[1:2]
64   root.groups <- list.groups(.Object = object, path = '/', recursive = FALSE)
65   group.msg <- paste0(
66     "There can only be three groups in the loom file: '",
67     paste(required.groups, collapse = "', '"),
68     "'"
69   )
70   if (length(x = root.groups) != 3) {
71     stop(group.msg)
72   }
73   if (!all(required.groups %in% root.groups)) {
74     stop(group.msg)
75   }
76   unlist(x = sapply(
77     X = required.groups[1:2],
78     FUN = function(group) {
79       if (length(x = list.groups(.Object = object[group], recursive = FALSE)) > 0) {
80         stop(paste("Group", group, "cannot have subgroups"))
81       }
82       if (length(x = list.attributes(.Object = object[group])) > 0) {
83         stop(paste("Group", group, "cannot have subattributes"))
84       }
85       for (dataset in list.datasets(.Object = object[group])) {
86         if (object[dataset]@dim != dim.matrix[group]) {
87           stop(paste("All datasets in group", group, "must be of length", required.groups[group]))
88         }
89       }
90     }
91   ))
92   for (dataset in list.datasets(.Object = object['/layers'])) {
93     if (any(object[dataset]@dim != dim.matrix)) {
94       stop(paste("All datasets in '/layers' must be", dim.matrix[1], 'by', dim.matrix[2]))
95     }
96   }
97 }
98
99 connect = function(filename, mode = "r+") {
100   self <- new("loom", filename, mode)
101   # self@filename <- filename
102   self@shape = dim(self["matrix"])
103   return(self)
104 }
105
106
107 #need to comment
108 #need to add progress bar
109 #but otherwise, pretty cool
110 #for paul to try :
111 # f <- connect("~/Downloads/10X43_1.loom")
112 # mean_var = map(f,f_list = c(mean,var),chunksize = 5000)
113 # nGene <- map(f, f_list = function(x) length(which(x>0)), MARGIN = 2)
114 map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, selection) {
115   n_func = length(f_list)
116   if (n_func==1) f_list=list(f_list)
117   if (MARGIN==1) {
118     results=list();
119     for (j in 1:n_func) {
120       results[[j]] <- numeric(0)
121     }
122     rows_per_chunk <- chunksize
123     ix <- 1
124     while (ix <= self@shape[1]) {
125       rows_per_chunk <- min(rows_per_chunk, self@shape[1]-ix+1)
126       chunk <- self["matrix"][ix:(ix + rows_per_chunk -1), ]
127       for(j in 1:n_func) {
128         new_results <- apply(chunk, 1, FUN = f_list[[j]])
129         results[[j]] <- c(results[[j]], new_results)
130       }
131       ix <- ix + chunksize
132     }
133   }
134
135   if (MARGIN==2) {
136     results=list();
137     for (j in 1:n_func) {
138       results[[j]] <- numeric(0)
139     }
140     cols_per_chunk <- chunksize
141     ix <- 1
142     while (ix <= self@shape[2]) {
143       cols_per_chunk <- min(cols_per_chunk, self@shape[2]-ix+1)
144       chunk <- self["matrix"][,ix:(ix + cols_per_chunk -1)]
145       for(j in 1:n_func) {
146         new_results <- apply(chunk, 2, FUN = f_list[[j]])
147         results[[j]] <- c(results[[j]], new_results)
148       }
149       ix <- ix + chunksize
150     }
151   }
152   if (n_func == 1) return(results[[1]])
153   return(results)
154 }