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