Mercurial > repos > prog > lcmsmatching
comparison MsPeakForestDb.R @ 1:45e985cd8e9e draft
planemo upload for repository https://github.com/workflow4metabolomics/lcmsmatching.git commit d4048accde6bdfd5b3e14f5394902d38991854f8-dirty
| author | prog |
|---|---|
| date | Tue, 31 Jan 2017 05:27:24 -0500 |
| parents | 3afe41d3e9e7 |
| children | 9a0288561ba3 |
comparison
equal
deleted
inserted
replaced
| 0:3afe41d3e9e7 | 1:45e985cd8e9e |
|---|---|
| 6 | 6 |
| 7 ##################### | 7 ##################### |
| 8 # CLASS DECLARATION # | 8 # CLASS DECLARATION # |
| 9 ##################### | 9 ##################### |
| 10 | 10 |
| 11 MsPeakForestDb <- setRefClass("MsPeakForestDb", contains = "MsDb", fields = list(.url = "character", .url.scheduler = "ANY")) | 11 MsPeakForestDb <- setRefClass("MsPeakForestDb", contains = "MsDb", fields = list(.url = "character", .url.scheduler = "ANY", .token = "character")) |
| 12 | 12 |
| 13 ############### | 13 ############### |
| 14 # CONSTRUCTOR # | 14 # CONSTRUCTOR # |
| 15 ############### | 15 ############### |
| 16 | 16 |
| 17 MsPeakForestDb$methods( initialize = function(url = NA_character_, useragent = NA_character_, ...) { | 17 MsPeakForestDb$methods( initialize = function(url = NA_character_, useragent = NA_character_, token = NA_character_, ...) { |
| 18 | 18 |
| 19 # Check URL | 19 # Check URL |
| 20 if (is.null(url) || is.na(url)) | 20 if (is.null(url) || is.na(url)) |
| 21 stop("No URL defined for new MsPeakForestDb instance.") | 21 stop("No URL defined for new MsPeakForestDb instance.") |
| 22 | 22 |
| 23 if (substring(url, nchar(url) - 1, 1) == '/') | |
| 24 url <- substring(url, nchar(url) - 1) | |
| 23 .url <<- url | 25 .url <<- url |
| 24 .url.scheduler <<- UrlRequestScheduler$new(n = 3, useragent = useragent) | 26 .url.scheduler <<- UrlRequestScheduler$new(n = 3, useragent = useragent) |
| 25 .self$.url.scheduler$setVerbose(1L) | 27 .self$.url.scheduler$setVerbose(1L) |
| 28 .token <<- token | |
| 26 | 29 |
| 27 callSuper(...) | 30 callSuper(...) |
| 28 }) | 31 }) |
| 29 | 32 |
| 30 ########### | 33 ########### |
| 33 | 36 |
| 34 MsPeakForestDb$methods( .get.url = function(url, params = NULL, ret.type = 'json') { | 37 MsPeakForestDb$methods( .get.url = function(url, params = NULL, ret.type = 'json') { |
| 35 | 38 |
| 36 res <- NULL | 39 res <- NULL |
| 37 | 40 |
| 41 # Add url prefix | |
| 42 if (substring(url, 1, 1) == '/') | |
| 43 url <- substring(url, 2) | |
| 44 url <- paste(.self$.url, url, sep = '/') | |
| 45 | |
| 46 # Add token | |
| 47 if ( ! is.na(.self$.token)) | |
| 48 params <- c(params, token = .self$.token) | |
| 49 param.str <- if (is.null(params)) '' else paste('?', vapply(names(params), function(p) paste(p, params[[p]], sep = '='), FUN.VALUE = ''), collapse = '&', sep = '') | |
| 50 | |
| 51 # Get URL | |
| 38 content <- .self$.url.scheduler$getUrl(url = url, params = params) | 52 content <- .self$.url.scheduler$getUrl(url = url, params = params) |
| 39 | 53 |
| 40 if (ret.type == 'json') { | 54 if (ret.type == 'json') { |
| 41 | 55 |
| 42 library(RJSONIO) | 56 library(RJSONIO) |
| 65 # GET MOLECULE IDS # | 79 # GET MOLECULE IDS # |
| 66 #################### | 80 #################### |
| 67 | 81 |
| 68 MsPeakForestDb$methods( getMoleculeIds = function() { | 82 MsPeakForestDb$methods( getMoleculeIds = function() { |
| 69 | 83 |
| 70 ids <- as.character(.self$.get.url(url = paste0(.self$.url, 'compounds/all/ids'))) | 84 ids <- as.character(.self$.get.url(url = 'compounds/all/ids')) |
| 71 | 85 |
| 72 return(ids) | 86 return(ids) |
| 73 }) | 87 }) |
| 74 | 88 |
| 75 #################### | 89 #################### |
| 76 # GET NB MOLECULES # | 90 # GET NB MOLECULES # |
| 77 #################### | 91 #################### |
| 78 | 92 |
| 79 MsPeakForestDb$methods( getNbMolecules = function() { | 93 MsPeakForestDb$methods( getNbMolecules = function() { |
| 80 | 94 |
| 81 n <- .self$.get.url(url = paste0(.self$.url, 'compounds/all/count'), ret.type = 'integer') | 95 n <- .self$.get.url(url = 'compounds/all/count', ret.type = 'integer') |
| 82 | 96 |
| 83 return(n) | 97 return(n) |
| 84 }) | 98 }) |
| 85 | 99 |
| 86 ############################### | 100 ############################### |
| 88 ############################### | 102 ############################### |
| 89 | 103 |
| 90 MsPeakForestDb$methods( getChromCol = function(molid = NULL) { | 104 MsPeakForestDb$methods( getChromCol = function(molid = NULL) { |
| 91 | 105 |
| 92 # Set URL | 106 # Set URL |
| 93 url <- paste0(.self$.url, 'metadata/lc/list-code-columns') | |
| 94 params <- NULL | 107 params <- NULL |
| 95 if ( ! is.null(molid)) | 108 if ( ! is.null(molid)) |
| 96 params <- list(molids = paste(molid, collapse = ',')) | 109 params <- list(molids = paste(molid, collapse = ',')) |
| 97 | 110 |
| 98 # Call webservice | 111 # Call webservice |
| 99 wscols <- .self$.get.url(url = url, params = params) | 112 wscols <- .self$.get.url(url = 'metadata/lc/list-code-columns', params = params) |
| 100 | 113 |
| 101 # Build data frame | 114 # Build data frame |
| 102 cols <- data.frame(id = character(), title = character()) | 115 cols <- data.frame(id = character(), title = character()) |
| 103 for(id in names(wscols)) | 116 for(id in names(wscols)) |
| 104 cols <- rbind(cols, data.frame(id = id, title = wscols[[id]]$name, stringsAsFactors = FALSE)) | 117 cols <- rbind(cols, data.frame(id = id, title = wscols[[id]]$name, stringsAsFactors = FALSE)) |
| 116 stop("The parameter molid must consist only in a single value.") | 129 stop("The parameter molid must consist only in a single value.") |
| 117 | 130 |
| 118 rt <- list() | 131 rt <- list() |
| 119 | 132 |
| 120 # Set URL | 133 # Set URL |
| 121 url <- paste0(.self$.url, 'spectra/lcms/search') | |
| 122 params <- NULL | 134 params <- NULL |
| 123 if ( ! is.null(molid)) | 135 if ( ! is.null(molid)) |
| 124 params <- list(molids = paste(molid, collapse = ',')) | 136 params <- list(molids = paste(molid, collapse = ',')) |
| 125 | 137 |
| 126 # Call webservice | 138 # Call webservice |
| 127 spectra <- .self$.get.url(url = url, params = params) | 139 spectra <- .self$.get.url(url = 'spectra/lcms/search', params = params) |
| 128 if (class(spectra) == 'list' && length(spectra) > 0) { | 140 if (class(spectra) == 'list' && length(spectra) > 0) { |
| 129 for (s in spectra) | 141 for (s in spectra) |
| 130 if (is.na(col) || s$liquidChromatography$columnCode %in% col) { | 142 if (is.na(col) || s$liquidChromatography$columnCode %in% col) { |
| 131 ret.time <- (s$RTmin + s$RTmax) / 2 | 143 ret.time <- (s$RTmin + s$RTmax) / 2 |
| 132 c <- s$liquidChromatography$columnCode | 144 c <- s$liquidChromatography$columnCode |
| 158 # Get non NA values | 170 # Get non NA values |
| 159 non.na.molid <- molid[ ! is.na(molid)] | 171 non.na.molid <- molid[ ! is.na(molid)] |
| 160 | 172 |
| 161 if (length(non.na.molid) > 0) { | 173 if (length(non.na.molid) > 0) { |
| 162 # Set URL | 174 # Set URL |
| 163 url <- paste0(.self$.url, 'compounds/all/names') | |
| 164 params <- c(molids = paste(non.na.molid, collapse = ',')) | 175 params <- c(molids = paste(non.na.molid, collapse = ',')) |
| 165 | 176 |
| 166 # Call webservice | 177 # Call webservice |
| 167 names[ ! is.na(molid)] <- .self$.get.url(url = url, params = params) | 178 names[ ! is.na(molid)] <- .self$.get.url(url = 'compounds/all/names', params = params) |
| 168 } | 179 } |
| 169 | 180 |
| 170 return(names) | 181 return(names) |
| 171 }) | 182 }) |
| 172 | 183 |
| 185 | 196 |
| 186 if (is.na(n)) | 197 if (is.na(n)) |
| 187 ids <- c(ids, NA_character_) | 198 ids <- c(ids, NA_character_) |
| 188 | 199 |
| 189 else { | 200 else { |
| 190 url <- paste0(.self$.url, 'search/compounds/name/', curlEscape(n)) | 201 compounds <- .self$.get.url(url = paste0('search/compounds/name/', curlEscape(n)))$compoundNames |
| 191 compounds <- .self$.get.url(url = url)$compoundNames | |
| 192 ids <- c(ids, list(vapply(compounds, function(c) as.character(c$compound$id), FUN.VALUE = ''))) | 202 ids <- c(ids, list(vapply(compounds, function(c) as.character(c$compound$id), FUN.VALUE = ''))) |
| 193 } | 203 } |
| 194 } | 204 } |
| 195 | 205 |
| 196 return(ids) | 206 return(ids) |
| 201 ################# | 211 ################# |
| 202 | 212 |
| 203 MsPeakForestDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { | 213 MsPeakForestDb$methods( getNbPeaks = function(molid = NA_integer_, type = NA_character_) { |
| 204 | 214 |
| 205 # Build URL | 215 # Build URL |
| 206 url <- paste0(.self$.url, 'spectra/lcms/count-peaks') | |
| 207 params <- NULL | 216 params <- NULL |
| 208 if ( ! is.na(type)) | 217 if ( ! is.na(type)) |
| 209 params <- c(params, mode = if (type == MSDB.TAG.POS) 'pos' else 'neg') | 218 params <- c(params, mode = if (type == MSDB.TAG.POS) 'pos' else 'neg') |
| 210 if ( ! is.null(molid) && (length(molid) > 1 || ! is.na(molid))) | 219 if ( ! is.null(molid) && (length(molid) > 1 || ! is.na(molid))) |
| 211 params <- c(params, molids = paste(molid, collapse = ',')) | 220 params <- c(params, molids = paste(molid, collapse = ',')) |
| 212 | 221 |
| 213 # Run request | 222 # Run request |
| 214 n <- .self$.get.url(url = url, params = params, ret.type = 'integer') | 223 n <- .self$.get.url(url = 'spectra/lcms/count-peaks', params = params, ret.type = 'integer') |
| 215 | 224 |
| 216 return(sum(n)) | 225 return(sum(n)) |
| 217 }) | 226 }) |
| 218 | 227 |
| 219 ################# | 228 ################# |
| 220 # GET MZ VALUES # | 229 # GET MZ VALUES # |
| 221 ################# | 230 ################# |
| 222 | 231 |
| 223 MsPeakForestDb$methods( getMzValues = function(mode = NULL) { | 232 MsPeakForestDb$methods( getMzValues = function(mode = NULL, max.results = NA_integer_) { |
| 224 | |
| 225 # Build URL | |
| 226 url <- paste0(.self$.url, 'spectra/lcms/peaks/list-mz') | |
| 227 | 233 |
| 228 # Query params | 234 # Query params |
| 229 params <- NULL | 235 params <- NULL |
| 230 if ( ! is.null(mode)) | 236 if ( ! is.null(mode)) |
| 231 params <- c(params, mode = if (mode == MSDB.TAG.POS) 'positive' else 'negative') | 237 params <- c(params, mode = if (mode == MSDB.TAG.POS) 'positive' else 'negative') |
| 232 | 238 |
| 233 # Get MZ valuels | 239 # Get MZ valuels |
| 234 mz <- .self$.get.url(url = url, params = params) | 240 mz <- .self$.get.url(url = 'spectra/lcms/peaks/list-mz', params = params) |
| 241 | |
| 242 # Apply cut-off | |
| 243 if ( ! is.na(max.results)) | |
| 244 mz <- mz[1:max.results] | |
| 235 | 245 |
| 236 return(mz) | 246 return(mz) |
| 237 }) | 247 }) |
| 238 | 248 |
| 239 ############################## | 249 ############################## |
| 241 ############################## | 251 ############################## |
| 242 | 252 |
| 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) { | 253 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 | 254 |
| 245 # Build URL for mz search | 255 # Build URL for mz search |
| 246 url <- paste0(.self$.url, 'spectra/lcms/peaks/get-range/', mz.low, '/', mz.high) | 256 url <- paste0('spectra/lcms/peaks/get-range/', mz.low, '/', mz.high) |
| 247 | 257 |
| 248 # Get spectra | 258 # Get spectra |
| 249 spectra <- .self$.get.url(url = url) | 259 spectra <- .self$.get.url(url = url) |
| 250 | 260 |
| 251 # Build result data frame | 261 # Build result data frame |
| 263 | 273 |
| 264 rt.res <- data.frame(MSDB.TAG.MOLID = character(), MSDB.TAG.COL = character(), MSDB.TAG.COLRT = numeric()) | 274 rt.res <- data.frame(MSDB.TAG.MOLID = character(), MSDB.TAG.COL = character(), MSDB.TAG.COLRT = numeric()) |
| 265 | 275 |
| 266 if (nrow(results) > 0) { | 276 if (nrow(results) > 0) { |
| 267 # Build URL for rt search | 277 # Build URL for rt search |
| 268 url <- paste0(.self$.url, 'spectra/lcms/range-rt-min/', rt.low, '/', rt.high) | 278 url <- paste0('spectra/lcms/range-rt-min/', rt.low, '/', rt.high) |
| 269 params <- NULL | 279 params <- NULL |
| 270 if ( ! is.null(col)) | 280 if ( ! is.null(col)) |
| 271 params <- c(columns = paste(col, collapse = ',')) | 281 params <- c(columns = paste(col, collapse = ',')) |
| 272 | 282 |
| 273 # Run query | 283 # Run query |
