Mercurial > repos > computational-metabolomics > mspurity_frag4feature
comparison createDatabase.R @ 8:cb4aeec93d49 draft
planemo upload for repository https://github.com/computational-metabolomics/mspurity-galaxy commit 7e1748612a9f9dce11a9e54ff36752b600e7aea3
author | computational-metabolomics |
---|---|
date | Wed, 12 Jun 2024 16:08:23 +0000 |
parents | d4a17be5429a |
children |
comparison
equal
deleted
inserted
replaced
7:e9fbb65451f6 | 8:cb4aeec93d49 |
---|---|
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() |