Browse code

fix conflicts

From: Laurent <lg390@cam.ac.uk>

git-svn-id: file:///home/git/hedgehog.fhcrc.org/bioconductor/trunk/madman/Rpacks/mzR@121322 bc3139a8-67e5-0310-9ffc-ced21a209358

Laurent Gatto authored on 23/09/2016 22:05:29
Showing 9 changed files

... ...
@@ -2,7 +2,7 @@ Package: mzR
2 2
 Type: Package
3 3
 Title: parser for netCDF, mzXML, mzData and mzML and mzIdentML files
4 4
        (mass spectrometry data)
5
-Version: 2.7.5
5
+Version: 2.7.6
6 6
 Author: Bernd Fischer, Steffen Neumann, Laurent Gatto, Qiang Kou
7 7
 Maintainer: Bernd Fischer <b.fischer@dkfz.de>,
8 8
 	    Steffen Neumann <sneumann@ipb-halle.de>,
... ...
@@ -19,7 +19,7 @@ License: Artistic-2.0
19 19
 LazyLoad: yes
20 20
 Depends: Rcpp (>= 0.10.1), methods, utils
21 21
 Imports: Biobase, BiocGenerics (>= 0.13.6), ProtGenerics
22
-Suggests: msdata (>= 0.3.5), RUnit, mzID, BiocStyle, knitr
22
+Suggests: msdata (>= 0.3.5), RUnit, mzID, BiocStyle, knitr, XML
23 23
 VignetteBuilder: knitr
24 24
 LinkingTo: Rcpp, zlibbioc
25 25
 RcppModules: Ramp, Pwiz, Ident
... ...
@@ -19,6 +19,7 @@ exportMethods(close,
19 19
               chromatogramsInfo,
20 20
               manufacturer,
21 21
               model,
22
+	      isolationWindow,
22 23
               ionisation,
23 24
               analyzer,
24 25
               detector,
... ...
@@ -1,3 +1,7 @@
1
+CHANGES IN VERSION 2.7.6
2
+------------------------
3
+ o new isolationWindow accessor <2016-09-23 Fri>
4
+ 
1 5
 CHANGES IN VERSION 2.7.5
2 6
 ------------------------
3 7
  o Apply Martin's free/delete patch - see
... ...
@@ -18,14 +18,17 @@ setGeneric("analyzer", function(object) standardGeneric("analyzer"))
18 18
 setGeneric("detector", function(object) standardGeneric("detector"))
19 19
 setGeneric("isInitialized", function(object) standardGeneric("isInitialized"))
20 20
 setGeneric("initializeRamp",
21
-           signature=c("object"),
21
+           signature = c("object"),
22 22
            function(object) standardGeneric("initializeRamp"))
23
-setGeneric("header", function(object,scans,...) standardGeneric("header"))
24
-setGeneric("peaksCount", function(object,scans,...) standardGeneric("peaksCount"))
23
+setGeneric("header", function(object, scans, ...) standardGeneric("header"))
24
+setGeneric("peaksCount",
25
+           function(object, scans, ...) standardGeneric("peaksCount"))
25 26
 setGeneric("get3Dmap",
26
-           signature=c("object"),
27
-           function(object,scans,lowMz,highMz,resMz,...) standardGeneric("get3Dmap"))
28
-
27
+           signature = c("object"),
28
+           function(object, scans, lowMz, highMz, resMz, ...)
29
+               standardGeneric("get3Dmap"))
30
+setGeneric("isolationWindow",
31
+           function(object, ...) standardGeneric("isolationWindow"))
29 32
 
30 33
 ### BiocGenerics
31 34
 ## setGeneric("score", function(x, ...) standardGeneric("score"))
... ...
@@ -161,3 +161,5 @@ pwiz.version <- function() {
161 161
     .Call('mzR_pwiz_version', PACKAGE = 'mzR')
162 162
 }
163 163
 
164
+setMethod("isolationWindow", "mzRpwiz",
165
+          function(object, ...) .isolationWindow(fileName(object), ...))
... ...
@@ -157,3 +157,5 @@ setMethod("show",
157 157
             invisible(NULL)
158 158
           })
159 159
 
160
+setMethod("isolationWindow", "mzRramp",
161
+          function(object, ...) .isolationWindow(fileName(object), ...))
160 162
new file mode 100644
... ...
@@ -0,0 +1,29 @@
1
+setMethod("isolationWindow", "character",
2
+          function(object, ...) .isolationWindow(object, ...))
3
+
4
+
5
+.isolationWindow <- function(x, unique. = TRUE, simplify = TRUE) {
6
+    stopifnot(all(file.exists(x)))
7
+    if (!requireNamespace("XML"))
8
+        stop("Please install the XML package to use this functionality.")
9
+    res <- lapply(x, function(xx) {
10
+        xml <- XML::xmlParse(xx)
11
+        ns <- c(x = "http://psi.hupo.org/ms/mzml")
12
+        path <- c(low = "//x:isolationWindow/x:cvParam[@accession='MS:1000828']/@value",
13
+                  high = "//x:isolationWindow/x:cvParam[@accession='MS:1000829']/@value")
14
+        low <- as.numeric(XML::xpathSApply(xml, path["low"], namespaces = ns))
15
+        high <- as.numeric(XML::xpathSApply(xml, path["high"], namespaces = ns))
16
+        cbind(low, high)
17
+    })
18
+    if (.multipleIsolationWindows(res))
19
+        message("Found multiple isolation windows in an acquisition.")
20
+    if (unique.)
21
+        res <- lapply(res, base::unique)
22
+    if (simplify & length(x) == 1) res <- res[[1]]
23
+    return(res)
24
+}
25
+
26
+.multipleIsolationWindows <- function(x) {
27
+    x <- lapply(x, base::unique)
28
+    any(sapply(x, function(xx) nrow(xx) > 1))
29
+}
0 30
new file mode 100644
... ...
@@ -0,0 +1,21 @@
1
+test_isolationWindow <- function() {
2
+    library("msdata")
3
+    f <- msdata::proteomics(full.names = TRUE)
4
+    rw1 <- openMSfile(f, backend = "Ramp")
5
+    rw2 <- openMSfile(f, backend = "pwiz")
6
+    i1 <- isolationWindow(f)
7
+    i2 <- isolationWindow(rw1)
8
+    i3 <- isolationWindow(rw2)
9
+    checkEquals(i1, i2)
10
+    checkEquals(i1, i3)
11
+    i1 <- isolationWindow(f, unique = FALSE)
12
+    i2 <- isolationWindow(rw1, unique = FALSE)
13
+    i3 <- isolationWindow(rw2, unique = FALSE)
14
+    checkEquals(i1, i2)
15
+    checkEquals(i1, i3)
16
+    i1 <- isolationWindow(c(f, f), unique = FALSE)
17
+    checkEquals(length(i1), 2L)
18
+    checkEquals(i1[[1]], i1[[2]])
19
+    hd <- header(rw1)
20
+    checkEquals(sum(hd$msLevel == 2), nrow(i1[[1]]))
21
+}
0 22
new file mode 100644
... ...
@@ -0,0 +1,62 @@
1
+\name{isolationWindow-methods}
2
+\docType{methods}
3
+\alias{isolationWindow}
4
+\alias{isolationWindow-methods}
5
+\alias{isolationWindow,character-method}
6
+\alias{isolationWindow,mzRpwiz-method}
7
+\alias{isolationWindow,mzRramp-method}
8
+
9
+\title{ Returns the ion selection isolation window }
10
+
11
+\description{
12
+
13
+  The methods return matrices of lower (column \code{low}) and upper
14
+  (column \code{high}) isolation window offsets. Matrices are returned
15
+  as a list of length equal to the number of input files (provided as
16
+  file names of raw mass spectrometry data objects, see below). By
17
+  default (i.e when \code{unique. = TRUE} ), only unique offsets are
18
+  returned, as they are expected to identical for all spectra per
19
+  acquisition. If this is not the case, a message is displayed.
20
+  
21
+}
22
+
23
+
24
+\section{Methods}{
25
+  \describe{
26
+
27
+    \item{\code{signature(object = "character", unique. = "logical",
28
+	simplify = "logical")}}{Returns the isolation window for the
29
+      file \code{object}. By default, only unique isolation windows
30
+      are returned per file (\code{unique = TRUE}); if set to
31
+      \code{FALSE}, a \code{matrix} with as many rows as there are MS2
32
+      spectra. If only one file passed an input and \code{simplify} is
33
+      set to \code{TRUE} (default), the resulting \code{list} of
34
+      length 1 is simplified to a \code{matrix}.  }
35
+
36
+    \item{\code{signature(object = "mzRpwiz", unique. = "logical",
37
+	simplify = "logical")}}{As above for \code{mzRpwiz} objects. }
38
+
39
+    \item{\code{signature(object = "mzRramp", unique. = "logical",
40
+	simplify = "logical")}}{As above for \code{mzRramp} object. }
41
+
42
+  }
43
+}
44
+
45
+\author{
46
+
47
+  Laurent Gatto <lg390@cam.ac.uk> based on the functionality from the
48
+  \code{msPurity:::get_isolation_offsets} function.
49
+
50
+}
51
+
52
+\examples{
53
+library("msdata")
54
+f <- msdata::proteomics(full.names = TRUE)
55
+isolationWindow(f)
56
+
57
+rw <- openMSfile(f)
58
+isolationWindow(rw)
59
+str(isolationWindow(rw, unique = FALSE))
60
+}
61
+
62
+\keyword{methods}
0 63
\ No newline at end of file