Browse code

Merge branch 'no_delay'

Peter Hickey authored on 07/10/2018 03:34:23
Showing5 changed files

... ...
@@ -64,7 +64,7 @@ smoothSds <- function(BSseqStat, k = 101, qSd = 0.75, mc.cores = 1,
64 64
                              rawSds <- as.array(rawSds)
65 65
                              smoothSd(rawSds, k = k, qSd = qSd)
66 66
                          }, mc.cores = mc.cores))
67
-    smoothSds <- .DelayedMatrix(as.matrix(smoothSds))
67
+    smoothSds <- as.matrix(smoothSds)
68 68
     if("smoothSds" %in% names(getStats(BSseqStat)))
69 69
         BSseqStat@stats[["smoothSds"]] <- smoothSds
70 70
     else
... ...
@@ -85,19 +85,20 @@ computeStat <- function(BSseqStat, coef = NULL) {
85 85
     raw_tstats <- getStats(BSseqStat, what = "rawTstats")[, coef, drop = FALSE]
86 86
     scaled_sds <- getStats(BSseqStat, what = "rawSds") /
87 87
         getStats(BSseqStat, what = "smoothSds")
88
-    scaled_sds_matrix <- do.call(cbind, replicate(ncol(raw_tstats), scaled_sds))
88
+    scaled_sds_matrix <- matrix(
89
+        rep(scaled_sds, ncol(raw_tstats)),
90
+        ncol = ncol(raw_tstats))
89 91
     tstats <- raw_tstats * scaled_sds_matrix
90 92
     if(length(coef) > 1) {
91 93
         cor.coefficients <- getStats(BSseqStat,
92 94
                                      what = "cor.coefficients")[coef,coef]
93 95
         # NOTE: classifyTestsF() calls as.matrix(tstats) and so realises this
94 96
         #       array
95
-        stat <- .DelayedMatrix(as.matrix(classifyTestsF(tstats,
96
-                                                        cor.coefficients,
97
-                                                        fstat.only = TRUE)))
97
+        stat <- as.matrix(
98
+            classifyTestsF(tstats, cor.coefficients, fstat.only = TRUE))
98 99
         stat.type <- "fstat"
99 100
     } else {
100
-        stat <- .DelayedMatrix(tstats)
101
+        stat <- tstats
101 102
         stat.type <- "tstat"
102 103
     }
103 104
     if("stat" %in% names(getStats(BSseqStat))) {
... ...
@@ -9,9 +9,6 @@ setValidity("BSseqStat", function(object) {
9 9
        anyDuplicated(names(object@stats)))
10 10
         msg <- validMsg(msg, "the 'stats' list needs to be named with unique names.")
11 11
     for(name in c("rawSds", "smoothsSds", "stat", "rawTstats")) {
12
-        if(name %in% names(object@stats) &&
13
-           !is(object@stats[[name]], "DelayedMatrix"))
14
-            msg <- validMsg(msg, sprintf("component '%s' of slot 'stats' has to be a DelayedMatrix object", name))
15 12
         if(name %in% names(object@stats) && isTRUE(nrow(object@stats[[name]]) != length(object@gr)))
16 13
             msg <- validMsg(msg, sprintf("component '%s' of slot 'stats' has to have the same number of rows as slot 'gr' is long", name))
17 14
     }
... ...
@@ -24,17 +21,6 @@ setMethod("show", signature(object = "BSseqStat"),
24 21
               cat(" ", length(object), "methylation loci\n")
25 22
               cat("based on smoothed data:\n")
26 23
               cat(" ", object@parameters$smoothText, "\n")
27
-              not_delayed_matrices <- c("cor.coefficients", "stat.type")
28
-              delayed_matrices <- setdiff(names(object@stats),
29
-                                          not_delayed_matrices)
30
-              is_HDF5Array_backed <- vapply(object@stats[delayed_matrices],
31
-                                            .isHDF5ArrayBacked,
32
-                                            logical(1L))
33
-              if (any(is_HDF5Array_backed)) {
34
-                  cat("'stats' slot is HDF5Array-backed\n")
35
-              } else {
36
-                  cat("'stats' slot is in-memory\n")
37
-              }
38 24
           })
39 25
 
40 26
 setMethod("[", "BSseqStat", function(x, i, ...) {
... ...
@@ -48,7 +34,6 @@ setMethod("[", "BSseqStat", function(x, i, ...) {
48 34
     x@stats <- lapply(statnames, function(nam) {
49 35
         if(nam %in% c("rawTstats", "modelCoefficients", "rawSds", "smoothSds",
50 36
                       "stat")) {
51
-            stopifnot(is(x@stats[[nam]], "DelayedMatrix"))
52 37
             return(x@stats[[nam]][i,,drop=FALSE])
53 38
         }
54 39
         x@stats[[nam]]
... ...
@@ -59,26 +44,24 @@ setMethod("[", "BSseqStat", function(x, i, ...) {
59 44
 BSseqStat <- function(gr = NULL, stats = NULL, parameters = NULL) {
60 45
     out <- new("BSseqStat")
61 46
     out@gr <- gr
62
-    not_delayed_matrices <- c("cor.coefficients", "stat.type")
63
-    delayed_matrices <- setdiff(names(stats), not_delayed_matrices)
64
-    stats[delayed_matrices] <- endoapply(stats[delayed_matrices],
65
-                                         .DelayedMatrix)
66 47
     out@stats <- stats
67 48
     out@parameters <- parameters
68 49
     out
69 50
 }
70 51
 
71
-setMethod("updateObject", "BSseqStat",
72
-          function(object, ...) {
73
-              not_delayed_matrices <- c("cor.coefficients", "stat.type")
74
-              delayed_matrices <- setdiff(names(stats), not_delayed_matrices)
75
-              stats <- object@stats
76
-              stats[delayed_matrices] <- endoapply(stats[delayed_matrices],
77
-                                                   .DelayedMatrix)
78
-              object@stats <- stats
79
-              object
80
-          }
81
-)
52
+# TODO: updateObject() to use ordinary matrix instead of DelayedMatrix with
53
+#       in-memory seed.
54
+# setMethod("updateObject", "BSseqStat",
55
+#           function(object, ...) {
56
+#               not_delayed_matrices <- c("cor.coefficients", "stat.type")
57
+#               delayed_matrices <- setdiff(names(stats), not_delayed_matrices)
58
+#               stats <- object@stats
59
+#               stats[delayed_matrices] <- endoapply(stats[delayed_matrices],
60
+#                                                    .DelayedMatrix)
61
+#               object@stats <- stats
62
+#               object
63
+#           }
64
+# )
82 65
 
83 66
 ## summary.BSseqStat <- function(object, ...) {
84 67
 ##     quant <- quantile(getStats(object)[, "tstat.corrected"],
... ...
@@ -1,5 +1,5 @@
1 1
 setClass("BSseqTstat", contains = "hasGRanges",
2
-         representation(stats = "DelayedMatrix",
2
+         representation(stats = "matrix",
3 3
                         parameters = "list")
4 4
          )
5 5
 setValidity("BSseqTstat", function(object) {
... ...
@@ -17,11 +17,6 @@ setMethod("show", signature(object = "BSseqTstat"),
17 17
               cat(" ", object@parameters$smoothText, "\n")
18 18
               cat("with parameters\n")
19 19
               cat(" ", object@parameters$tstatText, "\n")
20
-              if (.isHDF5ArrayBacked(object@stats)) {
21
-                  cat("'stats' slot is HDF5Array-backed\n")
22
-              } else {
23
-                  cat("'stats' slot is in-memory\n")
24
-              }
25 20
           })
26 21
 
27 22
 setMethod("[", "BSseqTstat", function(x, i, ...) {
... ...
@@ -37,7 +32,7 @@ setMethod("[", "BSseqTstat", function(x, i, ...) {
37 32
 BSseqTstat <- function(gr = NULL, stats = NULL, parameters = NULL) {
38 33
     out <- new("BSseqTstat")
39 34
     out@gr <- gr
40
-    out@stats <- .DelayedMatrix(stats)
35
+    out@stats <- stats
41 36
     out@parameters <- parameters
42 37
     out
43 38
 }
... ...
@@ -75,7 +70,7 @@ plot.BSseqTstat <- function(x, y, ...) {
75 70
 setMethod("updateObject", "BSseqTstat",
76 71
           function(object, ...) {
77 72
               stats <- object@stats
78
-              stats <- .DelayedMatrix(stats)
73
+              stats <- stats
79 74
               object@stats <- stats
80 75
               object
81 76
           }
... ...
@@ -27,19 +27,6 @@
27 27
     quantile(x, ...)
28 28
 }
29 29
 
30
-.DelayedMatrix <- function(x) {
31
-    x_name <- deparse(substitute(x))
32
-    X <- try(DelayedArray(x), silent = TRUE)
33
-    if (is(X, "try-error")) {
34
-        stop("Could not construct DelayedMatrix from '", x_name, "'",
35
-             call. = FALSE)
36
-    }
37
-    if (!is(X, "DelayedMatrix")) {
38
-        stop("'", x_name, "' must be matrix-like", call. = FALSE)
39
-    }
40
-    X
41
-}
42
-
43 30
 .isSimpleDelayedMatrix <- function(x) {
44 31
     is(x@seed, "matrix")
45 32
 }
... ...
@@ -39,6 +39,7 @@ data.frame2GRanges <- function(df, keepColumns = FALSE, ignoreStrand = FALSE) {
39 39
     }, logical(1L))
40 40
 }
41 41
 
42
+# TODO: The below is a hack, need a more reliable way to do this.
42 43
 .getBSseqBackends <- function(x) {
43 44
     assay_backends <- lapply(assays(x, withDimnames = FALSE), function(assay) {
44 45
         if (is.matrix(assay)) return(NULL)
... ...
@@ -46,14 +47,11 @@ data.frame2GRanges <- function(df, keepColumns = FALSE, ignoreStrand = FALSE) {
46 47
         if (all(vapply(seed_classes, function(x) x == "matrix", logical(1)))) {
47 48
             return(NULL)
48 49
         }
49
-        if (is.list(seed_classes)) {
50
-            seed_packages <- lapply(seed_classes, attr, "package")
51
-        } else {
52
-            seed_packages <- attr(seed_classes, "package")
50
+        backend <- gsub("Seed", "", as.vector(seed_classes))
51
+        if (!identical(backend, "HDF5Array")) {
52
+            stop("Don't know backend of object with seed '", seed_classes, "'.")
53 53
         }
54
-        seed_packages <- unique(seed_packages)
55
-        srb <- supportedRealizationBackends()
56
-        srb[srb[["package"]] == seed_packages, "BACKEND"]
54
+        backend
57 55
     })
58 56
     unique(unlist(assay_backends))
59 57
 }