-
Notifications
You must be signed in to change notification settings - Fork 81
/
MPI.R
139 lines (113 loc) · 4.3 KB
/
MPI.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
##
## findPeaks slave function for parallel execution
##
############################################################
## findPeaksPar
##
## This should at some point be replaced by a call that does not need
## parameter lists and getting options from the environment.
findPeaksPar <- function(arg) {
require(xcms)
procDate <- date()
params <- arg$params
myID <- arg$id
if (is.null(params$method))
params$method <- getOption("BioC")$xcms$findPeaks.method
method <- match.arg(params$method, getOption("BioC")$xcms$findPeaks.methods)
if (is.na(method))
stop("unknown method : ", method)
method <- paste("findPeaks", method, sep=".")
## What about using the getXcmsRaw call here???
xRaw <- xcmsRaw(arg$file, profmethod=params$profmethod,
profparam=params$profparam, profstep = 0,
includeMSn=params$includeMSn, mslevel=params$mslevel,
scanrange=params$scanrange)
if(params$lockMassFreq == TRUE){
xRaw <- stitch(xRaw, AutoLockMass(xRaw))
}
## remove parameters which are not used by method() from the parameter list
params["method"] <- NULL
params["id"] <- NULL
params["profmethod"] <- NULL
params["profparam"] <- NULL
params["includeMSn"] <- NULL
params["lockMassFreq"] <- NULL
params["mslevel"] <- NULL
params["scanrange"] <- NULL ## avoid filtering scanrange twice.
peaks <- do.call(method, args = c(list(object = xRaw), params))
## Ensure to remove data to avoid memory accumulation.
scanT <- xRaw@scantime
rm(xRaw)
gc()
list(scantime = scanT,
peaks = cbind(peaks,
sample = rep.int(myID, nrow(peaks))),
date = procDate)
}
############################################################
## findChromPeaks
##
## Same as findPeaksPar but without the need to pass argument lists
## and read settings from the global options.
## args should be a list with arguments
## o file: the file name
## o readParams: parameter class to read the file; actually we would only
## need the scanrange, the includeMSn and the lockMassFreq here.
## o detectParams: parameter class for the peak detection.
findChromPeaksInFile <- function(args) {
## Placeholder
}
##
## findPeaks slave function for parallel execution
##
fillPeaksChromPar <- function(arg) {
require(xcms)
params <- arg$params
myID <- arg$id
cat(arg$file, "\n")
prof <- params$prof
rtcor <- params$rtcor
peakrange <- params$peakrange
expand.mz <- params$expand.mz
expand.rt <- params$expand.rt
gvals <- params$gvals$gvals
lcraw <- xcmsRaw(arg$file, profmethod=params$prof$method, profstep = 0)
if (length(params$dataCorrection) > 1) {
## Note: dataCorrection (as set in the xcmsSet function) is either
## 1 for all or for none.
if (any(params$dataCorrection == 1))
lcraw <- stitch(lcraw, AutoLockMass(lcraw))
}
if (exists("params$polarity") && length(params$polarity) >0) {
if (length(params$polarity) > 0) {
## Retain wanted polarity only
lcraws <- split(lcraw, lcraw@polarity, DROP=TRUE)
lcraw <- lcraws[[params$polarity]]
}
}
if (length(prof) > 2)
lcraw@profparam <- prof[seq(3, length(prof))]
if (length(rtcor) == length(lcraw@scantime) ) {
lcraw@scantime <- rtcor
} else {
warning("(corrected) retention time vector length mismatch for ", basename(arg$file))
}
## Expanding the peakrange
incrMz <- (peakrange[, "mzmax"] - peakrange[, "mzmin"]) / 2 * (expand.mz - 1)
peakrange[, "mzmax"] <- peakrange[, "mzmax"] + incrMz
peakrange[, "mzmin"] <- peakrange[, "mzmin"] - incrMz
incrRt <- (peakrange[, "rtmax"] - peakrange[, "rtmin"]) / 2 * (expand.rt - 1)
peakrange[, "rtmax"] <- peakrange[, "rtmax"] + incrRt
peakrange[, "rtmin"] <- peakrange[, "rtmin"] - incrRt
naidx <- which(is.na(gvals[,myID]))
newpeaks <- getPeaks(lcraw, peakrange[naidx,,drop=FALSE], step = prof$step)
list(myID=myID, newpeaks=cbind(newpeaks, sample=myID))
}
msgfun.featureDetection <- function(x,i) {
message("Detecting features in file #",i,":",basename(x[[i]]$file))
flush.console();
}
msgfunGeneric <- function(x, i) {
message(i,":",basename(x[[i]]$file))
flush.console();
}