1. qmtools
  2. Commit 78103b6d1b3fe4c2ca8d692e14d867cbd0413a2c
Browse code

Unit-tests for poplin subsetting.

Jaehyun Joo authored on 25/12/2021 04:39:25
Showing 9 changed files
R/combine-internals.R
History View file @ 78103b6
... ... 
@@ -3,6 +3,10 @@
3 3 
   SummarizedExperiment(colData = poplinReduced(x))
4 4 
 }
5 5
6 
+.poplin_to_se_rowdata <- function(x) {
7 
+  SummarizedExperiment(rowData = poplinReduced(x))
8 
+}
9 
+
6 10 
 ##' @importFrom SummarizedExperiment Assays
7 11 
 .poplin_to_assays <- function(x) {
8 12 
   Assays(poplin_data_list(x))
R/poplin.matrix.R
History View file @ 78103b6
... ... 
@@ -29,7 +29,11 @@ NULL
29 29
30 30
31 31 
 poplin.matrix <- function(x, tag, ...) {
32 
-  class(x) <- c(tag, "poplin.matrix", "matrix")
32 
+  if (missing(tag)) {
33 
+    class(x) <- c("poplin.matrix", "matrix")
34 
+  } else {
35 
+    class(x) <- c(tag, "poplin.matrix", "matrix")
36 
+  }
33 37 
   mostattributes(x) <- c(attributes(x), list(...))
34 38 
   x
35 39 
 }
R/subset-methods.R
History View file @ 78103b6
... ... 
@@ -31,6 +31,9 @@ setReplaceMethod(
31 31
32 32 
         tryCatch({
33 33 
           poplinData_left[ii, ] <- poplinData_right
34 
+          for (k in seq_len(ncol(poplinData_left))) {
35 
+            rownames(poplinData_left[[k]])[ii] <- rownames(value)
36 
+          }
34 37 
         }, error=function(err) {
35 38 
           stop(
36 39 
             "failed to replace 'poplinData' in '<", class(x), ">[i,] <- value'\n",
... ... 
@@ -48,6 +51,9 @@ setReplaceMethod(
48 51 
       if (missing(i)) {
49 52 
         tryCatch({
50 53 
           poplinData_left <- .replace_columns(x, jj, poplinData, value)
54 
+          for (k in seq_len(ncol(poplinData_left))) {
55 
+            colnames(poplinData_left[[k]])[jj] <- colnames(value)
56 
+          }
51 57 
         }, error=function(err) {
52 58 
           stop(
53 59 
             "failed to replace 'poplinData' in '<", class(x), ">[,j] <- value'\n",
... ... 
@@ -56,6 +62,10 @@ setReplaceMethod(
56 62 
       } else {
57 63 
         tryCatch({
58 64 
           poplinData_left <- .replace_columns(x, jj, poplinData, value, ii)
65 
+          for (k in seq_len(ncol(poplinData_left))) {
66 
+            rownames(poplinData_left[[k]])[ii] <- rownames(value)
67 
+            colnames(poplinData_left[[k]])[jj] <- colnames(value)
68 
+          }
59 69 
         }, error=function(err) {
60 70 
           stop(
61 71 
             "failed to replace 'poplinData' in '<", class(x), ">[,j] <- value'\n",
... ... 
@@ -66,6 +76,9 @@ setReplaceMethod(
66 76 
       poplinReduced_right <- poplinReduced(value)
67 77 
       tryCatch({
68 78 
         poplinReduced_left[jj, ] <- poplinReduced_right
79 
+        for (k in seq_len(ncol(poplinReduced_left))) {
80 
+          rownames(poplinReduced_left[[k]])[jj] <- colnames(value)
81 
+        }
69 82 
       }, error=function(err) {
70 83 
         stop(
71 84 
           "failed to replace 'poplinReduced' in '<", class(x), ">[,j] <- value'\n",
R/subset-methods.R.bak
History View file @ 78103b6
72 85 
new file mode 100644
... ... 
@@ -0,0 +1,79 @@
1 
+##' @export
2 
+setMethod("[", c("poplin", "ANY", "ANY"), function(x, i, j, ..., drop = TRUE) {
3 
+  if (!missing(i)) {
4 
+    ii <- .get_subset_index(i, rownames(x))
5 
+    poplinData(x) <- poplinData(x)[ii, , drop = FALSE]
6 
+    ## if (length(reducedDataList(x)) != 0L) {
7 
+    ##   message("Row-subsetting operation: 'poplinReduced' slot was reset.")
8 
+    ## }
9 
+    ## poplinReduced(x) <- new("DFrame", nrows = ncol(x))
10 
+  }
11 
+  if (!missing(j)) {
12 
+    jj <- .get_subset_index(j, colnames(x))
13 
+    poplinData(x) <- .subset_columns(x, jj, get_slot = poplinData)
14 
+    poplinReduced(x) <- poplinReduced(x)[jj, , drop = FALSE]
15 
+  }
16 
+  callNextMethod()
17 
+})
18 
+
19 
+##' @export
20 
+##' @importClassesFrom SummarizedExperiment SummarizedExperiment
21 
+##' @importFrom SummarizedExperiment rowData colData
22 
+setReplaceMethod(
23 
+  "[", c("poplin", "ANY", "ANY", "poplin"), function(x, i, j, ..., value) {
24 
+
25 
+    if (!missing(i)) {
26 
+      ii <- .get_subset_index(i, rownames(x))
27 
+
28 
+      if (missing(j)) {
29 
+        poplinData_left <- poplinData(x)
30 
+        poplinData_right <- poplinData(value)
31 
+
32 
+        tryCatch({
33 
+          poplinData_left[ii, ] <- poplinData_right
34 
+        }, error=function(err) {
35 
+          stop(
36 
+            "failed to replace 'poplinData' in '<", class(x), ">[i,] <- value'\n",
37 
+            conditionMessage(err))
38 
+        })
39 
+        poplinData(x) <- poplinData_left
40 
+      }
41 
+      ## message("Row-subsetting operation: 'poplinReduced' slot was reset.")
42 
+      ## poplinReduced(x) <- new("DFrame", nrows = ncol(x))
43 
+    }
44 
+
45 
+    if (!missing(j)) {
46 
+      jj <- .get_subset_index(j, colnames(x))
47 
+
48 
+      if (missing(i)) {
49 
+        tryCatch({
50 
+          poplinData_left <- .replace_columns(x, jj, poplinData, value)
51 
+        }, error=function(err) {
52 
+          stop(
53 
+            "failed to replace 'poplinData' in '<", class(x), ">[,j] <- value'\n",
54 
+            conditionMessage(err))
55 
+        })
56 
+      } else {
57 
+        tryCatch({
58 
+          poplinData_left <- .replace_columns(x, jj, poplinData, value, ii)
59 
+        }, error=function(err) {
60 
+          stop(
61 
+            "failed to replace 'poplinData' in '<", class(x), ">[,j] <- value'\n",
62 
+            conditionMessage(err))
63 
+        })
64 
+      }
65 
+      poplinReduced_left <- poplinReduced(x)
66 
+      poplinReduced_right <- poplinReduced(value)
67 
+      tryCatch({
68 
+        poplinReduced_left[jj, ] <- poplinReduced_right
69 
+      }, error=function(err) {
70 
+        stop(
71 
+          "failed to replace 'poplinReduced' in '<", class(x), ">[,j] <- value'\n",
72 
+          conditionMessage(err))
73 
+      })
74 
+
75 
+      poplinData(x) <- poplinData_left
76 
+      poplinReduced(x) <- poplinReduced_left
77 
+    }
78 
+    callNextMethod()
79 
+})
tests/testthat/test-combine.R
History View file @ 78103b6
0 80 
new file mode 100644
... ... 
@@ -0,0 +1,34 @@
1 
+pp <- faahko_poplin
2 
+nm <- prod(dim(pp))
3 
+poplin_data(pp, "d1") <- matrix(rnorm(nm), nrow = nrow(pp), ncol = ncol(pp))
4 
+poplin_data(pp, "d2") <- matrix(rnorm(nm), nrow = nrow(pp), ncol = ncol(pp))
5 
+poplin_reduced(pp, "r1") <- poplin.matrix(matrix(rnorm(nm), nrow = ncol(pp), ncol = 3))
6 
+poplin_reduced(pp, "r2") <- poplin.matrix(matrix(rnorm(nm), nrow = ncol(pp), ncol = 3))
7 
+
8 
+test_that("rbind work correctly.", {
9 
+  pp.alt <- pp[sample(nrow(pp)), ]
10 
+  pp2 <- rbind(pp, pp.alt)
11 
+  expect_identical(poplin_raw(pp2), rbind(poplin_raw(pp), poplin_raw(pp.alt)))
12 
+  expect_identical(poplin_data(pp2), rbind(poplin_data(pp), poplin_data(pp.alt)))
13 
+  expect_identical(poplin_reduced(pp2), rbind(poplin_reduced(pp)))
14 
+
15 
+  ## cannot combine when mismatched custom attributes are involved
16 
+  r2 <- poplin_reduced(pp.alt, "r2")
17 
+  attr(r2, "test") <- dim(pp.alt)
18 
+  poplin_reduced(pp.alt, "r2") <- r2
19 
+  expect_error(pp2 <- rbind(pp, pp.alt), "do not match")
20 
+})
21 
+
22 
+test_that("cbind work correctly.", {
23 
+  pp.alt <- pp[, sample(ncol(pp))]
24 
+  pp2 <- cbind(pp, pp.alt)
25 
+  expect_identical(poplin_raw(pp2), cbind(poplin_raw(pp), poplin_raw(pp.alt)))
26 
+  expect_identical(poplin_data(pp2), cbind(poplin_data(pp), poplin_data(pp.alt)))
27 
+  expect_identical(poplin_reduced(pp2), rbind(poplin_reduced(pp), poplin_reduced(pp.alt)))
28 
+
29 
+  ## raise warning when mismatched custom attributes are involved
30 
+  r2 <- poplin_reduced(pp.alt, "r2")
31 
+  attr(r2, "test") <- "a"
32 
+  poplin_reduced(pp.alt, "r2") <- r2
33 
+  expect_warning(pp2 <- cbind(pp, pp.alt))
34 
+})
tests/testthat/test-poplinData.R
History View file @ 78103b6
... ... 
@@ -1,7 +1,8 @@
1 
-d1 <- matrix(1, nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
1 
+nm <- prod(dim(faahko_poplin))
2 
+d1 <- matrix(rnorm(nm), nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
2 3 
 rownames(d1) <- rownames(faahko_poplin)
3 4 
 colnames(d1) <- colnames(faahko_poplin)
4 
-d2 <- matrix(2, nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
5 
+d2 <- matrix(rnorm(nm), nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
5 6 
 rownames(d2) <- rownames(faahko_poplin)
6 7 
 colnames(d2) <- colnames(faahko_poplin)
7 8
tests/testthat/test-poplinRaw.R
History View file @ 78103b6
... ... 
@@ -5,10 +5,11 @@ test_that("poplin_raw is the alias of assay.", {
5 5 
   expect_equal(poplin_raw(d, "raw_filled"), assay(d, "raw_filled"))
6 6 
 })
7 7
8 
-d1 <- matrix(1, nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
8 
+nm <- prod(dim(faahko_poplin))
9 
+d1 <- matrix(rnorm(nm), nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
9 10 
 rownames(d1) <- rownames(faahko_poplin)
10 11 
 colnames(d1) <- colnames(faahko_poplin)
11 
-d2 <- matrix(2, nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
12 
+d2 <- matrix(rnorm(nm), nrow = nrow(faahko_poplin), ncol = ncol(faahko_poplin))
12 13 
 rownames(d2) <- rownames(faahko_poplin)
13 14 
 colnames(d2) <- colnames(faahko_poplin)
14 15
tests/testthat/test-poplinReduced.R
History View file @ 78103b6
... ... 
@@ -1,6 +1,7 @@
1 
-d1 <- matrix(1, nrow = ncol(faahko_poplin), 2)
1 
+nm <- prod(dim(faahko_poplin))
2 
+d1 <- matrix(rnorm(nm), nrow = ncol(faahko_poplin), 2)
2 3 
 rownames(d1) <- colnames(faahko_poplin)
3 
-d2 <- matrix(2, nrow = ncol(faahko_poplin), 2)
4 
+d2 <- matrix(rnorm(nm), nrow = ncol(faahko_poplin), 2)
4 5 
 rownames(d2) <- colnames(faahko_poplin)
5 6
6 7 
 test_that("poplinReducedData setters/getters work with character 'type'.", {
tests/testthat/test-subset.R
History View file @ 78103b6
7 8 
new file mode 100644
... ... 
@@ -0,0 +1,108 @@
1 
+pp <- faahko_poplin
2 
+nm <- prod(dim(pp))
3 
+poplin_data(pp, "d1") <- matrix(rnorm(nm), nrow = nrow(pp), ncol = ncol(pp))
4 
+poplin_data(pp, "d2") <- matrix(rnorm(nm), nrow = nrow(pp), ncol = ncol(pp))
5 
+poplin_reduced(pp, "r1") <- poplin.matrix(matrix(rnorm(nm), nrow = ncol(pp), ncol = 3))
6 
+poplin_reduced(pp, "r2") <- poplin.matrix(matrix(rnorm(nm), nrow = ncol(pp), ncol = 3))
7 
+
8 
+test_that("subsetting by row works correctly.", {
9 
+  idx <- sample(nrow(pp), 5)
10 
+  pp_sub <- pp[idx, ]
11 
+  expect_identical(rowData(pp)[idx, ], rowData(pp_sub))
12 
+  expect_identical(poplin_raw(pp)[idx, ], poplin_raw(pp_sub))
13 
+  expect_identical(poplin_data(pp)[idx, ], poplin_data(pp_sub))
14 
+  expect_identical(poplin_data(pp, "d2")[idx, ], poplin_data(pp_sub, "d2"))
15 
+
16 
+  ## remain unchanged
17 
+  expect_identical(colData(pp), colData(pp_sub))
18 
+  expect_identical(poplin_reduced(pp), poplin_reduced(pp_sub))
19 
+  expect_identical(poplin_reduced(pp, "r2"), poplin_reduced(pp_sub, "r2"))
20 
+})
21 
+
22 
+test_that("subsetting by column works correctly.", {
23 
+  idx <- sample(ncol(pp), 5)
24 
+  pp_sub <- pp[, idx]
25 
+  expect_identical(colData(pp)[idx, ], colData(pp_sub))
26 
+  expect_identical(poplin_raw(pp)[, idx], poplin_raw(pp_sub))
27 
+  expect_identical(poplin_data(pp)[, idx], poplin_data(pp_sub))
28 
+  expect_identical(poplin_data(pp, 2)[, idx], poplin_data(pp_sub, 2))
29 
+  expect_identical(poplin_reduced(pp)[idx, ], poplin_reduced(pp_sub))
30 
+  expect_identical(poplin_reduced(pp, "r2")[idx, ], poplin_reduced(pp_sub, "r2"))
31 
+
32 
+  ## remain unchanged
33 
+  expect_identical(rowData(pp), rowData(pp_sub))
34 
+})
35 
+
36 
+test_that("subset replacement by row works correctly.", {
37 
+  to <- 1:3
38 
+  from <- 5:7
39 
+  pp2 <- pp
40 
+  pp2[to, ] <- pp[from, ]
41 
+  expect_identical(rownames(poplin_raw(pp2)), rownames(poplin_data(pp2)))
42 
+  expect_identical(rownames(pp2), rownames(poplin_data(pp2)))
43 
+  expect_identical(poplin_raw(pp)[from, ], poplin_raw(pp2)[to, ])
44 
+  expect_identical(poplin_data(pp)[from, ], poplin_data(pp2)[to, ])
45 
+  expect_identical(poplin_data(pp, 2)[from, ], poplin_data(pp2, 2)[to, ])
46 
+  expect_identical(poplin_raw(pp)[-to, ], poplin_raw(pp2)[-to, ],)
47 
+  expect_identical(poplin_data(pp)[-to, ], poplin_data(pp2)[-to, ])
48 
+  expect_identical(poplin_data(pp, 2)[-to, ], poplin_data(pp2, 2)[-to, ])
49 
+
50 
+  ## remain unchanged
51 
+  expect_identical(colData(pp), colData(pp2))
52 
+  expect_identical(poplin_reduced(pp), poplin_reduced(pp2))
53 
+  expect_identical(poplin_reduced(pp, 2), poplin_reduced(pp2, 2))
54 
+
55 
+})
56 
+
57 
+test_that("subset replacement by column works correctly.", {
58 
+  to <- 1:3
59 
+  from <- 5:7
60 
+  pp2 <- pp
61 
+  pp2[, to] <- pp[, from]
62 
+  expect_identical(colnames(poplin_raw(pp2)), colnames(poplin_data(pp2)))
63 
+  expect_identical(colnames(pp2), colnames(poplin_data(pp2)))
64 
+  expect_identical(colnames(pp2), rownames(poplin_reduced(pp2)))
65 
+  expect_identical(poplin_raw(pp)[, from], poplin_raw(pp2)[, to])
66 
+  expect_identical(poplin_data(pp)[, from], poplin_data(pp2)[, to])
67 
+  expect_identical(poplin_data(pp, 2)[, from], poplin_data(pp2, 2)[, to])
68 
+  expect_identical(poplin_reduced(pp)[from, ], poplin_reduced(pp2)[to, ])
69 
+  expect_identical(poplin_reduced(pp, 2)[from, ], poplin_reduced(pp2, 2)[to, ])
70 
+  expect_identical(poplin_raw(pp)[, -to], poplin_raw(pp2)[, -to],)
71 
+  expect_identical(poplin_data(pp)[, -to], poplin_data(pp2)[, -to])
72 
+  expect_identical(poplin_data(pp, 2)[, -to], poplin_data(pp2, 2)[, -to])
73 
+  expect_identical(poplin_reduced(pp)[-to, ], poplin_reduced(pp2)[-to, ])
74 
+  expect_identical(poplin_reduced(pp, 2)[-to, ], poplin_reduced(pp2, 2)[-to, ])
75 
+
76 
+  ## remain unchanged
77 
+  expect_identical(rowData(pp), rowData(pp2))
78 
+})
79 
+
80 
+test_that("subset replacement by both row and column work correctly.", {
81 
+  ## whole replacement
82 
+  pp2 <- pp
83 
+  poplin_raw_list(pp2) <- list()
84 
+  pp2[] <- pp
85 
+  expect_identical(pp, pp2)
86 
+
87 
+  ## partial replacement
88 
+  pp2 <- pp
89 
+  to <- 1:3
90 
+  from <- 5:7
91 
+  pp2[to, to] <- pp[from, from]
92 
+  expect_identical(rownames(poplin_raw(pp2)), rownames(poplin_data(pp2)))
93 
+  expect_identical(rownames(pp2), rownames(poplin_data(pp2)))
94 
+  expect_identical(colnames(poplin_raw(pp2)), colnames(poplin_data(pp2)))
95 
+  expect_identical(colnames(pp2), colnames(poplin_data(pp2)))
96 
+  expect_identical(colnames(pp2), rownames(poplin_reduced(pp2)))
97 
+
98 
+  expect_identical(poplin_raw(pp)[from, from], poplin_raw(pp2)[to, to])
99 
+  expect_identical(poplin_data(pp)[from, from], poplin_data(pp2)[to, to])
100 
+  expect_identical(poplin_data(pp, 2)[from, from], poplin_data(pp2, 2)[to, to])
101 
+  expect_identical(poplin_reduced(pp)[from, ], poplin_reduced(pp2)[to, ])
102 
+  expect_identical(poplin_reduced(pp, 2)[from, ], poplin_reduced(pp2, 2)[to, ])
103 
+  expect_identical(poplin_raw(pp)[-to, -to], poplin_raw(pp2)[-to, -to],)
104 
+  expect_identical(poplin_data(pp)[-to, -to], poplin_data(pp2)[-to, -to])
105 
+  expect_identical(poplin_data(pp, 2)[-to, -to], poplin_data(pp2, 2)[-to, -to])
106 
+  expect_identical(poplin_reduced(pp)[-to, ], poplin_reduced(pp2)[-to, ])
107 
+  expect_identical(poplin_reduced(pp, 2)[-to, ], poplin_reduced(pp2, 2)[-to, ])
108 
+})