Store tolerance and redundantMatching as slot in TopDownSets; see #72

sgibb · Jan 30, 2018 · 6ce6341 · 6ce6341
1 parent e778277
commit 6ce6341
Show file tree

Hide file tree

Showing 11 changed files with 147 additions and 30 deletions.
diff --git a/NEWS b/NEWS
@@ -17,6 +17,10 @@ Changes in version 1.1.6
   `redundantIonMatch="remove"`. This will reduce the number of fragment
   matches. Choose `"closest"` for both to get the old behaviour.
   See also #72 [2018-01-29].
+- `TopDownSet` object store the matching `tolerance` and strategies
+  (`redundantIonMatch`, `redundantFragmentMatch`). `AbstractTopDownSet` and
+  `NCBSet` lost their `tolerance` slot. Saved objects need to be recreated
+  [2018-01-30].
 
 Changes in version 1.1.5
 - Keep full filename (before `basename` was used) in `AbstractTopDownSet`

diff --git a/NEWS.md b/NEWS.md
@@ -17,6 +17,10 @@
   `redundantIonMatch="remove"`. This will reduce the number of fragment
   matches. Choose `"closest"` for both to get the old behaviour.
   See also [#72](https://github.com/sgibb/topdownr/issues/72) [2018-01-29].
+- `TopDownSet` object store the matching `tolerance` and strategies
+  (`redundantIonMatch`, `redundantFragmentMatch`). `AbstractTopDownSet` and
+  `NCBSet` lost their `tolerance` slot. Saved objects need to be recreated
+  [2018-01-30].
 
 ## Changes in version 1.1.5
 - Keep full filename (before `basename` was used) in `AbstractTopDownSet`

diff --git a/R/AllClasses.R b/R/AllClasses.R
@@ -53,9 +53,6 @@ setClass(
 #' columns to the condition/run. It just stores values that are
 #' different from zero.
 #' @slot files `character`, files that were imported.
-#' @slot tolerance `double`,
-#' tolerance in *ppm* that were used for matching the experimental
-#' *m/z* values to the theoretical fragments.
 #' @slot processing `character`, log messages.
 #'
 #' @return This is an *Abstract/VIRTUAL* class
@@ -117,15 +114,13 @@ setClass(
         colData="DataFrame",
         assay="dgCMatrix",
         files="character",
-        tolerance="numeric",
         processing="character"
     ),
     prototype=prototype(
         rowViews=new("XStringViews"),
         colData=new("DataFrame"),
         assay=new("dgCMatrix"),
         files=character(),
-        tolerance=double(),
         processing=character()),
         validity=function(object).validateAbstractTopDownSet(object)
 )
@@ -153,6 +148,9 @@ setClass(
 #' @slot tolerance `double`,
 #' tolerance in *ppm* that were used for matching the
 #' experimental mz values to the theoretical fragments.
+#' @slot redundantMatching `character`, matching strategies for redundant
+#' ion/fragment matches. See `redundantIonMatch` and
+#' `redundantFragmentMatch` in [readTopDownFiles()] for details.
 #' @slot processing `character`, log messages.
 #'
 #' @return An [TopDownSet-class] object.
@@ -227,7 +225,15 @@ setClass(
 setClass(
     "TopDownSet",
     contains="AbstractTopDownSet",
-    prototype=prototype(rowViews=new("FragmentViews"))
+    slots=c(
+        tolerance="numeric",
+        redundantMatching="character"
+    ),
+    prototype=prototype(
+        rowViews=new("FragmentViews"),
+        tolerance=double(),
+        redundantMatching=rep.int("remove", 2L)
+    )
 )
 
 #' The NCBSet class
@@ -251,9 +257,6 @@ setClass(
 #' with `1`, by an C-terminal fragmentl with `2` and
 #' by both fragment types/bidirectional by `3` respectively.
 #' @slot files `character`, files that were imported.
-#' @slot tolerance `double`,
-#' tolerance in *ppm* that were used for matching the experimental mz values
-#' to the theoretical fragments.
 #' @slot processing `character`, log messages.
 #'
 #' @return An [NCBSet-class] object.

diff --git a/R/functions-TopDownSet.R b/R/functions-TopDownSet.R
@@ -119,6 +119,10 @@ readTopDownFiles <- function(path, pattern=".*",
                                              "UvpdActivation"),
                              verbose=interactive()) {
 
+
+    redundantIonMatch <- match.arg(redundantIonMatch)
+    redundantFragmentMatch <- match.arg(redundantFragmentMatch)
+
     files <- .listTopDownFiles(path, pattern=pattern)
 
     sequence <- .readFasta(files$fasta, verbose=verbose)
@@ -146,8 +150,8 @@ readTopDownFiles <- function(path, pattern=".*",
         MoreArgs=list(
             fmass=elementMetadata(fragmentViews)$mass,
             tolerance=tolerance,
-            redundantIonMatch=match.arg(redundantIonMatch),
-            redundantFragmentMatch=match.arg(redundantFragmentMatch),
+            redundantIonMatch=redundantIonMatch,
+            redundantFragmentMatch=redundantFragmentMatch,
             verbose=verbose
         ),
         SIMPLIFY=FALSE, USE.NAMES=FALSE
@@ -178,11 +182,16 @@ readTopDownFiles <- function(path, pattern=".*",
         colData=.colsToRle(.colsToLogical(as(header, "DataFrame"))),
         assay=assay,
         files=unlist(unname(files)),
-        tolerance=tolerance
+        tolerance=tolerance,
+        redundantMatching=c(
+            ion=redundantIonMatch,
+            fragment=redundantFragmentMatch
+        )
     )
     tds <- .atdsLogMsg(
         tds, .logdim(tds), " matched (tolerance: ",
-        round(tolerance / 1e-6, 1L), " ppm).", addDim=FALSE
+        round(tolerance / 1e-6, 1L), " ppm, strategies ion/fragment: ",
+        redundantIonMatch, "/", redundantFragmentMatch, ").", addDim=FALSE
     )
     tds <- updateConditionNames(tds, sampleColumns=sampleColumns, verbose=FALSE)
     updateMedianInjectionTime(tds)
@@ -215,7 +224,9 @@ readTopDownFiles <- function(path, pattern=".*",
     k <- .matchFragments(
         s[, 1L],
         elementMetadata(fv)$mass,
-        tolerance=object@tolerance
+        tolerance=object@tolerance,
+        redundantIonMatch=object@redundantMatching[1L],
+        redundantFragmentMatch=object@redundantMatching[2L]
     )
 
     notNA <- !is.na(k)

diff --git a/R/methods-AbstractTopDownSet.R b/R/methods-AbstractTopDownSet.R
@@ -212,8 +212,8 @@ setReplaceMethod("colData", "AbstractTopDownSet", function(object, ..., value) {
 
 #' @describeIn AbstractTopDownSet Combine `AbstractTopDownSet` objects.
 #'
-#' If the `rowViews` are identically `combine` allows to combine two or more
-#' `AbstractTopDownSet` objects. Please note that it uses the default
+#' `combine` allows to combine two or more `AbstractTopDownSet` objects.
+#' Please note that it uses the default
 #' `sampleColumns` to define technical replicates (see [readTopDownFiles()]).and
 #' the default `by` argument to group ion injection times for the calculation of
 #' the median time (see [updateMedianInjectionTime()]). Both could be modified
@@ -239,7 +239,6 @@ setMethod("combine",
     x@colData <- .colsToRle(.colsToLogical(.rbind(x@colData, y@colData)))
     x@assay <- .cbind(x@assay, y@assay)[names(x@rowViews),]
     x@files <- unique(x@files, y@files)
-    x@tolerance <- max(x@tolerance, y@tolerance)
     x@processing <- c(x@processing, y@processing)
     x <- updateConditionNames(x)
     x <- updateMedianInjectionTime(x)

diff --git a/R/methods-TopDownSet.R b/R/methods-TopDownSet.R
@@ -39,6 +39,45 @@ setMethod("aggregate", "TopDownSet",
     }
 })
 
+#' @describeIn TopDownSet Combine `TopDownSet` objects.
+#'
+#' `combine` allows to combine two or more `TopDownSet` objects.
+#' Please note that it uses the default
+#' `sampleColumns` to define technical replicates (see [readTopDownFiles()]).and
+#' the default `by` argument to group ion injection times for the calculation of
+#' the median time (see [updateMedianInjectionTime()]). Both could be modified
+#' after `combine` by calling [updateConditionNames()] (with modified
+#' `sampleColumns` argument) and [updateMedianInjectionTime()] (with modified
+#' `by` argument).
+#'
+## @param x `TopDownSet`
+## @param y `TopDownSet`
+## @param \ldots
+#' @aliases combine,TopDownSet,TopDownSet-method
+#' @export
+setMethod("combine",
+          signature(x="TopDownSet", y="TopDownSet"),
+          function(x, y) {
+
+    x <- callNextMethod()
+
+    if (x@tolerance != y@tolerance) {
+        warning("Matching tolerance differs, choosing the larger one.")
+    }
+    x@tolerance <- max(x@tolerance, y@tolerance)
+
+    if (any(x@redundantMatching != y@redundantMatching)) {
+        warning(
+            "Matching strategies differ, ",
+            "keeping the strategy of object 'x'."
+        )
+    }
+
+    if (validObject(x)) {
+        x
+    }
+})
+
 #' @describeIn TopDownSet Filter by CV.
 #'
 #' Filtering is done by coefficient of variation across technical replicates
@@ -411,7 +450,6 @@ setAs("TopDownSet", "NCBSet", function(from) {
         colData=from@colData,
         assay=assay,
         files=from@files,
-        tolerance=from@tolerance,
         processing=from@processing
     )
     colData(ncb)$AssignedIntensity <- Matrix::colSums(from@assay)

diff --git a/data/tds.RData b/data/tds.RData
diff --git a/man/AbstractTopDownSet-class.Rd b/man/AbstractTopDownSet-class.Rd
diff --git a/man/NCBSet-class.Rd b/man/NCBSet-class.Rd
diff --git a/man/TopDownSet-class.Rd b/man/TopDownSet-class.Rd
diff --git a/tests/testthat/test_TopDownSet.R b/tests/testthat/test_TopDownSet.R
@@ -139,6 +139,54 @@ test_that("aggregate", {
     expect_equal(aggregate(tds, by=list(rep(c(2, 10), c(3, 2)))), tda)
 })
 
+test_that("combine", {
+    tds$Mz <- 100
+    tds$AgcTarget <- 1e5
+    tds$EtdReagentTarget <- 1e6
+    tds$EtdActivation <- tds$CidActivation <- tds$HcdActivation <- NA_real_
+    tds$UvpdActivation <- (1:5) * 1000
+    tds$IonInjectionTimeMs <- 1:5
+    tds@tolerance <- 5e-6
+    tds@redundantMatching <- c("remove", "remove")
+    rownames(tds@assay) <- rownames(tds)
+    tds <- updateConditionNames(tds)
+    tds1 <- tds2 <- tds
+    o <- c(matrix(1:10, nrow=2, byrow=TRUE))
+    a <- cbind(tds1@assay, tds2@assay)[, o]
+    cd <- .colsToRle(rbind(tds1@colData, tds2@colData)[o, ])
+    colnames(a) <- rownames(cd) <- paste0("C", rep((1:5) * 1000, each=2), "_",
+                                          rep(1:2, 5))
+    tdsr <- new("TopDownSet",
+                rowViews=tds@rowViews,
+                colData=cd,
+                assay=a,
+                tolerance=5e-6,
+                files=unique(tds1@files, tds2@files),
+                processing=c(tds1@processing, tds2@processing,
+                             paste("[2017-12-28 15:30:00]",
+                                   "Condition names updated based on: Mz,",
+                                   "AgcTarget, EtdReagentTarget,",
+                                   "EtdActivation, CidActivation,",
+                                   "HcdActivation, UvpdActivation. Order of",
+                                   "conditions changed. 5 conditions."),
+                             paste("[2017-12-28 15:30:01]",
+                                   "Recalculate median injection time based",
+                                   "on: Mz, AgcTarget."),
+                             paste("[2017-12-28 15:30:02]",
+                                   "Combined 8 fragments [3;5] and 8 fragments",
+                                   "[3;5] into a 16 fragments [3;10]",
+                                   "TopDownSet object.")))
+    tdsr$MedianIonInjectionTimeMs <- Rle(3, 10)
+    expect_equal(combine(tds1, tds2), tdsr)
+    tds2@tolerance <- 1e-6
+    expect_warning(combine(tds1, tds2), "Matching tolerance differs")
+    expect_equal(suppressWarnings(combine(tds1, tds2)), tdsr)
+    tds2@tolerance <- tds1@tolerance
+    tds2@redundantMatching <- c("closest", "closest")
+    expect_warning(combine(tds1, tds2), "Matching strategies differ")
+    expect_equal(suppressWarnings(combine(tds1, tds2)), tdsr)
+})
+
 test_that("conditionNames", {
     expect_equal(conditionNames(tds),
                  paste("condition",