Browse code

Revert to ordinary matrix for BSseqStat and BSseqTstat

Peter Hickey authored on 30/09/2018 01:08:13
Showing4 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
... ...
@@ -92,12 +92,11 @@ computeStat <- function(BSseqStat, coef = NULL) {
92 92
                                      what = "cor.coefficients")[coef,coef]
93 93
         # NOTE: classifyTestsF() calls as.matrix(tstats) and so realises this
94 94
         #       array
95
-        stat <- .DelayedMatrix(as.matrix(classifyTestsF(tstats,
96
-                                                        cor.coefficients,
97
-                                                        fstat.only = TRUE)))
95
+        stat <- as.matrix(
96
+            classifyTestsF(tstats, cor.coefficients, fstat.only = TRUE))
98 97
         stat.type <- "fstat"
99 98
     } else {
100
-        stat <- .DelayedMatrix(tstats)
99
+        stat <- tstats
101 100
         stat.type <- "tstat"
102 101
     }
103 102
     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
 }