Mercurial > repos > computational-metabolomics > mspurity_createdatabase

comparison createDatabase.R @ 8:efd14b326007 draft

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
planemo upload for repository https://github.com/computational-metabolomics/mspurity-galaxy commit 7e1748612a9f9dce11a9e54ff36752b600e7aea3
author computational-metabolomics
date Wed, 12 Jun 2024 16:05:01 +0000
parents 2f71b3495221
children
comparison
equal deleted inserted replaced
7:0cc6b67dccb8 8:efd14b326007
4 library(CAMERA) 4 library(CAMERA)
5 print(sessionInfo()) 5 print(sessionInfo())
6 print("CREATING DATABASE") 6 print("CREATING DATABASE")
7 7
8 xset_pa_filename_fix <- function(opt, pa, xset) { 8 xset_pa_filename_fix <- function(opt, pa, xset) {
9
10 if (!is.null(opt$mzML_files) && !is.null(opt$galaxy_names)) { 9 if (!is.null(opt$mzML_files) && !is.null(opt$galaxy_names)) {
11 # NOTE: Relies on the pa@fileList having the names of files given as 'names' of the variables 10 # NOTE: Relies on the pa@fileList having the names of files given as 'names' of the variables
12 # needs to be done due to Galaxy moving the files around and screwing up any links to files 11 # needs to be done due to Galaxy moving the files around and screwing up any links to files
13 12
14 filepaths <- trimws(strsplit(opt$mzML_files, ",")[[1]]) 13 filepaths <- trimws(strsplit(opt$mzML_files, ",")[[1]])
16 15
17 galaxy_names <- trimws(strsplit(opt$galaxy_names, ",")[[1]]) 16 galaxy_names <- trimws(strsplit(opt$galaxy_names, ",")[[1]])
18 galaxy_names <- galaxy_names[galaxy_names != ""] 17 galaxy_names <- galaxy_names[galaxy_names != ""]
19 18
20 nsave <- names(pa@fileList) 19 nsave <- names(pa@fileList)
21 old_filenames <- basename(pa@fileList) 20 old_filenames <- basename(pa@fileList)
22 pa@fileList <- filepaths[match(names(pa@fileList), galaxy_names)] 21 pa@fileList <- filepaths[match(names(pa@fileList), galaxy_names)]
23 names(pa@fileList) <- nsave 22 names(pa@fileList) <- nsave
24 23
25 pa@puritydf$filename <- basename(pa@fileList[match(pa@puritydf$filename, old_filenames)]) 24 pa@puritydf$filename <- basename(pa@fileList[match(pa@puritydf$filename, old_filenames)])
26 pa@grped_df$filename <- basename(pa@fileList[match(pa@grped_df$filename, old_filenames)]) 25 pa@grped_df$filename <- basename(pa@fileList[match(pa@grped_df$filename, old_filenames)])
27 } 26 }
28 27
29 28
30 if (!all(basename(pa@fileList) == basename(xset@filepaths))) { 29 if (!all(basename(pa@fileList) == basename(xset@filepaths))) {
31 if (!all(names(pa@fileList) == basename(xset@filepaths))) { 30 if (!all(names(pa@fileList) == basename(xset@filepaths))) {
32 print("FILELISTS DO NOT MATCH") 31 print("FILELISTS DO NOT MATCH")
33 message("FILELISTS DO NOT MATCH") 32 message("FILELISTS DO NOT MATCH")
34 quit(status = 1) 33 quit(status = 1)
35 }else{ 34 } else {
36 xset@filepaths <- unname(pa@fileList) 35 xset@filepaths <- unname(pa@fileList)
37 } 36 }
38 } 37 }
39 38
40 print(xset@phenoData) 39 print(xset@phenoData)
62 # store options 61 # store options
63 opt <- parse_args(OptionParser(option_list = option_list)) 62 opt <- parse_args(OptionParser(option_list = option_list))
64 print(opt) 63 print(opt)
65 64
66 loadRData <- function(rdata_path, name) { 65 loadRData <- function(rdata_path, name) {
67 #loads an RData file, and returns the named xset object if it is there 66 # loads an RData file, and returns the named xset object if it is there
68 load(rdata_path) 67 load(rdata_path)
69 return(get(ls()[ls() %in% name])) 68 return(get(ls()[ls() %in% name]))
70 } 69 }
71 70
72 getxcmsSetObject <- function(xobject) { 71 getxcmsSetObject <- function(xobject) {
73 # XCMS 1.x 72 # XCMS 1.x
74 if (class(xobject) == "xcmsSet") 73 if (class(xobject) == "xcmsSet") {
75 return(xobject) 74 return(xobject)
76 # XCMS 3.x 75 }
77 if (class(xobject) == "XCMSnExp") { 76 # XCMS 3.x
78 # Get the legacy xcmsSet object 77 if (class(xobject) == "XCMSnExp") {
79 suppressWarnings(xset <- as(xobject, "xcmsSet")) 78 # Get the legacy xcmsSet object
80 xcms::sampclass(xset) <- xset@phenoData$sample_group 79 suppressWarnings(xset <- as(xobject, "xcmsSet"))
81 return(xset) 80 xcms::sampclass(xset) <- xset@phenoData$sample_group
82 } 81 return(xset)
82 }
83 } 83 }
84 84
85 85
86 print(paste("pa", opt$pa)) 86 print(paste("pa", opt$pa))
87 print(opt$xset) 87 print(opt$xset)
94 print(pa@fileList) 94 print(pa@fileList)
95 95
96 # Missing list element causes failures (should be updated 96 # Missing list element causes failures (should be updated
97 # in msPurity R package for future releases) 97 # in msPurity R package for future releases)
98 if (!exists("allfrag", where = pa@filter_frag_params)) { 98 if (!exists("allfrag", where = pa@filter_frag_params)) {
99 pa@filter_frag_params$allfrag <- FALSE 99 pa@filter_frag_params$allfrag <- FALSE
100 } 100 }
101 101
102 if (opt$xcms_camera_option == "xcms") { 102 if (opt$xcms_camera_option == "xcms") {
103
104 xset <- loadRData(opt$xset, c("xset", "xdata")) 103 xset <- loadRData(opt$xset, c("xset", "xdata"))
105 xset <- getxcmsSetObject(xset) 104 xset <- getxcmsSetObject(xset)
106 fix <- xset_pa_filename_fix(opt, pa, xset) 105 fix <- xset_pa_filename_fix(opt, pa, xset)
107 pa <- fix[[1]] 106 pa <- fix[[1]]
108 xset <- fix[[2]] 107 xset <- fix[[2]]
109 xa <- NULL 108 xa <- NULL
110 }else{ 109 } else {
111
112 xa <- loadRData(opt$xset, "xa") 110 xa <- loadRData(opt$xset, "xa")
113 fix <- xset_pa_filename_fix(opt, pa, xa@xcmsSet) 111 fix <- xset_pa_filename_fix(opt, pa, xa@xcmsSet)
114 pa <- fix[[1]] 112 pa <- fix[[1]]
115 xa@xcmsSet <- fix[[2]] 113 xa@xcmsSet <- fix[[2]]
116 xset <- NULL 114 xset <- NULL
117 } 115 }
118 116
119 117
120 if (is.null(opt$grpPeaklist)) { 118 if (is.null(opt$grpPeaklist)) {
121 grpPeaklist <- NA 119 grpPeaklist <- NA
122 }else{ 120 } else {
123 grpPeaklist <- opt$grpPeaklist 121 grpPeaklist <- opt$grpPeaklist
124 } 122 }
125 123
126 dbPth <- msPurity::createDatabase(pa, 124 dbPth <- msPurity::createDatabase(pa,
127 xset = xset, 125 xset = xset,
128 xsa = xa, 126 xsa = xa,
129 outDir = opt$outDir, 127 outDir = opt$outDir,
130 grpPeaklist = grpPeaklist, 128 grpPeaklist = grpPeaklist,
131 dbName = "createDatabase_output.sqlite" 129 dbName = "createDatabase_output.sqlite"
132 ) 130 )
133 131
134 132
135 133
136 134
137 135
138 if (!is.null(opt$eic)) { 136 if (!is.null(opt$eic)) {
139
140 if (is.null(xset)) { 137 if (is.null(xset)) {
141 xset <- xa@xcmsSet 138 xset <- xa@xcmsSet
142 } 139 }
143 # previous check should have matched filelists together 140 # previous check should have matched filelists together
144 xset@filepaths <- unname(pa@fileList) 141 xset@filepaths <- unname(pa@fileList)
145 142
146 convert2Raw <- function(x, xset) { 143 convert2Raw <- function(x, xset) {
148 # for each file get list of peaks 145 # for each file get list of peaks
149 x$rt_raw <- xset@rt$raw[[sid]][match(x$rt, xset@rt$corrected[[sid]])] 146 x$rt_raw <- xset@rt$raw[[sid]][match(x$rt, xset@rt$corrected[[sid]])]
150 x$rtmin_raw <- xset@rt$raw[[sid]][match(x$rtmin, xset@rt$corrected[[sid]])] 147 x$rtmin_raw <- xset@rt$raw[[sid]][match(x$rtmin, xset@rt$corrected[[sid]])]
151 x$rtmax_raw <- xset@rt$raw[[sid]][match(x$rtmax, xset@rt$corrected[[sid]])] 148 x$rtmax_raw <- xset@rt$raw[[sid]][match(x$rtmax, xset@rt$corrected[[sid]])]
152 return(x) 149 return(x)
153
154 } 150 }
155 151
156 xset@peaks <- as.matrix( 152 xset@peaks <- as.matrix(
157 plyr::ddply(data.frame(xset@peaks), ~ sample, convert2Raw, xset = xset)) 153 plyr::ddply(data.frame(xset@peaks), ~sample, convert2Raw, xset = xset)
154 )
158 155
159 # Saves the EICS into the previously created database 156 # Saves the EICS into the previously created database
160 px <- msPurity::purityX(xset, 157 px <- msPurity::purityX(xset,
161 saveEIC = TRUE, 158 saveEIC = TRUE,
162 cores = 1, 159 cores = 1,
163 sqlitePth = dbPth, 160 sqlitePth = dbPth,
164 rtrawColumns = TRUE) 161 rtrawColumns = TRUE
165 162 )
166 } 163 }
167 164
168 closeAllConnections() 165 closeAllConnections()