Updates to documentation
[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 to a loom file
100 #'
101 #' @param filename The loom file to connect to
102 #' @param mode How do we connect to it? Pass 'r' for read-only or 'r+' for read/write
103 #'
104 #' @return A loom file connection
105 #'
106 #' @export
107 #'
108 connect <- function(filename, mode = "r+") {
109   self <- new("loom", filename, mode)
110   # self@filename <- filename
111   self@shape <- self["matrix"]@dim
112   return(self)
113 }
114
115 #need to comment
116 #need to add progress bar
117 #but otherwise, pretty cool
118 #for paul to try :
119 # f <- connect("~/Downloads/10X43_1.loom")
120 # mean_var = map(f,f_list = c(mean,var),chunksize = 5000)
121 # nGene <- map(f, f_list = function(x) length(which(x>0)), MARGIN = 2)
122 map <- function(self, f_list = list(mean, var), MARGIN=1, chunksize=1000, selection) {
123   n_func = length(f_list)
124   if (n_func == 1) f_list=list(f_list)
125   if (MARGIN == 1) {
126     results=list();
127     for (j in 1:n_func) {
128       results[[j]] <- numeric(0)
129     }
130     rows_per_chunk <- chunksize
131     ix <- 1
132     while (ix <= self@shape[1]) {
133       rows_per_chunk <- min(rows_per_chunk, self@shape[1]-ix+1)
134       chunk <- self["matrix"][ix:(ix + rows_per_chunk -1), ]
135       for(j in 1:n_func) {
136         new_results <- apply(chunk, 1, FUN = f_list[[j]])
137         results[[j]] <- c(results[[j]], new_results)
138       }
139       ix <- ix + chunksize
140     }
141   }
142   if (MARGIN == 2) {
143     results=list();
144     for (j in 1:n_func) {
145       results[[j]] <- numeric(0)
146     }
147     cols_per_chunk <- chunksize
148     ix <- 1
149     while (ix <= self@shape[2]) {
150       cols_per_chunk <- min(cols_per_chunk, self@shape[2]-ix+1)
151       chunk <- self["matrix"][,ix:(ix + cols_per_chunk -1)]
152       for(j in 1:n_func) {
153         new_results <- apply(chunk, 2, FUN = f_list[[j]])
154         results[[j]] <- c(results[[j]], new_results)
155       }
156       ix <- ix + chunksize
157     }
158   }
159   if (n_func == 1) return(results[[1]])
160   return(results)
161 }