Mercurial > repos > prog > lcmsmatching

comparison MsPeakForestDb.R @ 0:e66bb061af06 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit 3529b25417f8e1a5836474c9adec4b696d35099d-dirty
author prog
date Tue, 12 Jul 2016 12:02:37 -0400
parents
children 253d531a0193
comparison
equal deleted inserted replaced
-1:000000000000 0:e66bb061af06
1 if ( ! exists('MsPeakForestDb')) { # Do not load again if already loaded
2
3 library(methods)
4 source('MsDb.R')
5 source(file.path('UrlRequestScheduler.R'))
6
7 #####################
8 # CLASS DECLARATION #
9 #####################
10
11 MsPeakForestDb <- setRefClass("MsPeakForestDb", contains = "MsDb", fields = list(.url = "character", .url.scheduler = "ANY"))
12
13 ###############
14 # CONSTRUCTOR #
15 ###############
16
17 MsPeakForestDb$methods( initialize = function(url = NA_character_, useragent = NA_character_, ...) {
18
19 # Check URL
20 if (is.null(url) || is.na(url))
21 stop("No URL defined for new MsPeakForestDb instance.")
22
23 .url <<- url
24 .url.scheduler <<- UrlRequestScheduler$new(n = 3, useragent = useragent)
25 .self$.url.scheduler$setVerbose(1L)
26
27 callSuper(...)
28 })
29
30 ###########
31 # GET URL #
32 ###########
33
34 MsPeakForestDb$methods( .get.url = function(url, params = NULL, ret.type = 'json') {
35
36 res <- NULL
37
38 content <- .self$.url.scheduler$getUrl(url = url, params = params)
39
40 if (ret.type == 'json') {
41
42 library(RJSONIO)
43
44 res <- fromJSON(content, nullValue = NA)
45
46 if (class(res) == 'list' && 'success' %in% names(res) && res$success == FALSE) {
47 param.str <- if (is.null(params)) '' else paste('?', vapply(names(params), function(p) paste(p, params[[p]], sep = '='), FUN.VALUE = ''), collapse = '&', sep = '')
48 stop(paste0("Failed to run web service. URL was \"", url, param.str, "\"."))
49 }
50 } else {
51 if (ret.type == 'integer') {
52 if (grepl('^[0-9]+$', content, perl = TRUE))
53 res <- as.integer(content)
54 else {
55 library(RJSONIO)
56 res <- fromJSON(content, nullValue = NA)
57 }
58 }
59 }
60
61 return(res)
62 })
63
64 ####################
65 # GET MOLECULE IDS #
66 ####################
67
68 MsPeakForestDb$methods( getMoleculeIds = function() {
69
70 ids <- as.character(.self$.get.url(url = paste0(.self$.url, 'compounds/all/ids')))
71
72 return(ids)
73 })
74
75 ####################
76 # GET NB MOLECULES #
77 ####################
78
79 MsPeakForestDb$methods( getNbMolecules = function() {
80
81 n <- .self$.get.url(url = paste0(.self$.url, 'compounds/all/count'), ret.type = 'integer')
82
83 return(n)
84 })
85
86 ###############################
87 # GET CHROMATOGRAPHIC COLUMNS #
88 ###############################
89
90 MsPeakForestDb$methods( getChromCol = function(molid = NULL) {
91
92 # Set URL
93 url <- paste0(.self$.url, 'metadata/lc/list-code-columns')
94 params <- NULL
95 if ( ! is.null(molid))
96 params <- list(molids = paste(molid, collapse = ','))
97
98 # Call webservice
99 wscols <- .self$.get.url(url = url, params = params)
100
101 # Build data frame
102 cols <- data.frame(id = character(), title = character())
103 for(id in names(wscols))
104 cols <- rbind(cols, data.frame(id = id, title = wscols[[id]]$name, stringsAsFactors = FALSE))
105
106 return(cols)
107 })
108
109 #######################
110 # GET RETENTION TIMES #
111 #######################
112
113 MsPeakForestDb$methods( getRetentionTimes = function(molid, col = NA_character_) {
114
115 if (is.null(molid) || is.na(molid) || length(molid) != 1)
116 stop("The parameter molid must consist only in a single value.")
117
118 rt <- list()
119
120 # Set URL
121 url <- paste0(.self$.url, 'spectra/lcms/search')
122 params <- NULL
123 if ( ! is.null(molid))
124 params <- list(molids = paste(molid, collapse = ','))
125
126 # Call webservice
127 spectra <- .self$.get.url(url = url, params = params)
128 if (class(spectra) == 'list' && length(spectra) > 0) {
129 for (s in spectra)
130 if (is.na(col) || s$liquidChromatography$columnCode %in% col) {
131 ret.time <- (s$RTmin + s$RTmax) / 2
132 c <- s$liquidChromatography$columnCode
133 if (c %in% names(rt)) {
134 if ( ! ret.time %in% rt[[c]])
135 rt[[c]] <- c(rt[[c]], ret.time)
136 } else
137 rt[[c]] <- ret.time
138 }
139 }
140
141 return(rt)
142 })
143
144 #####################
145 # GET MOLECULE NAME #
146 #####################
147
148 MsPeakForestDb$methods( getMoleculeName = function(molid) {
149
150 library(RJSONIO)
151
152 if (is.null(molid))
153 return(NA_character_)
154
155 # Initialize names
156 names <- as.character(molid)
157
158 # Get non NA values
159 non.na.molid <- molid[ ! is.na(molid)]
160
161 if (length(non.na.molid) > 0) {
162 # Set URL
163 url <- paste0(.self$.url, 'compounds/all/names')
164 params <- c(molids = paste(non.na.molid, collapse = ','))
165
166 # Call webservice
167 names[ ! is.na(molid)] <- .self$.get.url(url = url, params = params)
168 }
169
170 return(names)
171 })
172
173 ################
174 # FIND BY NAME #
175 ################
176
177 MsPeakForestDb$methods( findByName = function(name) {
178
179 if (is.null(name))
180 return(NA_character_)
181
182 ids <- list()
183
184 for (n in name) {
185
186 if (is.na(n))
187 ids <- c(ids, NA_character_)
188
189 else {
190 url <- paste0(.self$.url, 'search/compounds/name/', curlEscape(n))
191 compounds <- .self$.get.url(url = url)$compoundNames
192 ids <- c(ids, list(vapply(compounds, function(c) as.character(c$compound$id), FUN.VALUE = '')))
193 }
194 }
195
196 return(ids)
197 })
198
199 #################
200 # GET NB PEAKS #
201 #################
202
203 MsPeakForestDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) {
204
205 # Build URL
206 url <- paste0(.self$.url, 'spectra/lcms/count-peaks')
207 params <- NULL
208 if ( ! is.na(type))
209 params <- c(params, mode = if (type == MSDB.TAG.POS) 'pos' else 'neg')
210 if ( ! is.null(molid) && (length(molid) > 1 || ! is.na(molid)))
211 params <- c(params, molids = paste(molid, collapse = ','))
212
213 # Run request
214 n <- .self$.get.url(url = url, params = params, ret.type = 'integer')
215
216 return(sum(n))
217 })
218
219 #################
220 # GET MZ VALUES #
221 #################
222
223 MsPeakForestDb$methods( getMzValues = function(mode = NULL) {
224
225 # Build URL
226 url <- paste0(.self$.url, 'spectra/lcms/peaks/list-mz')
227
228 # Query params
229 params <- NULL
230 if ( ! is.null(mode))
231 params <- c(params, mode = if (mode == MSDB.TAG.POS) 'positive' else 'negative')
232
233 # Get MZ valuels
234 mz <- .self$.get.url(url = url, params = params)
235
236 return(mz)
237 })
238
239 ##############################
240 # DO SEARCH FOR MZ RT BOUNDS #
241 ##############################
242
243 MsPeakForestDb$methods( .do.search.for.mz.rt.bounds = function(mode, mz.low, mz.high, rt.low = NULL, rt.high = NULL, col = NULL, attribs = NULL, molids = NULL) {
244
245 # Build URL for mz search
246 url <- paste0(.self$.url, 'spectra/lcms/peaks/get-range/', mz.low, '/', mz.high)
247
248 # Get spectra
249 spectra <- .self$.get.url(url = url)
250
251 # Build result data frame
252 results <- data.frame(MSDB.TAG.MOLID = character(), MSDB.TAG.MOLNAMES = character(), MSDB.TAG.MZTHEO = numeric(), MSDB.TAG.COMP = character(), MSDB.TAG.ATTR = character())
253 for (x in spectra)
254 results <- rbind(results, data.frame(MSDB.TAG.MOLID = vapply(x$source$listOfCompounds, function(c) as.character(c$id), FUN.VALUE = ''),
255 MSDB.TAG.MOLNAMES = vapply(x$source$listOfCompounds, function(c) paste(c$names, collapse = MSDB.MULTIVAL.FIELD.SEP), FUN.VALUE = ''),
256 MSDB.TAG.MZTHEO = as.numeric(x$theoricalMass),
257 MSDB.TAG.COMP = as.character(x$composition),
258 MSDB.TAG.ATTR = as.character(x$attribution),
259 stringsAsFactors = FALSE))
260
261 # RT search
262 if ( ! is.null(rt.low) && ! is.null(rt.high)) {
263
264 rt.res <- data.frame(MSDB.TAG.MOLID = character(), MSDB.TAG.COL = character(), MSDB.TAG.COLRT = numeric())
265
266 if (nrow(results) > 0) {
267 # Build URL for rt search
268 url <- paste0(.self$.url, 'spectra/lcms/range-rt-min/', rt.low, '/', rt.high)
269 params <- NULL
270 if ( ! is.null(col))
271 params <- c(columns = paste(col, collapse = ','))
272
273 # Run query
274 rtspectra <- .self$.get.url(url = url, params = params)
275
276 # Get compound/molecule IDs
277 for (x in spectra)
278 rt.res <- rbind(rt.res, data.frame(MSDB.TAG.MOLID = vapply(x$listOfCompounds, function(c) as.character(c$id), FUN.VALUE = ''),
279 MSDB.TAG.COL = as.character(x$liquidChromatography$columnCode),
280 MSDB.TAG.COLRT = (as.numeric(x$RTmin) + as.numeric(x$RTmax)) / 2,
281 stringsAsFactors = FALSE))
282 }
283
284 # Add retention times and column info
285 results <- merge(results, rt.res)
286 }
287
288 # Rename columns with proper names
289 colnames(results) <- vapply(colnames(results), function(s) eval(parse(text=s)), FUN.VALUE = '')
290
291 return(results)
292 })
293 }