Mercurial > repos > computational-metabolomics > mspurity_spectralmatching

comparison purityX.R @ 8:77706396e7bd 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:03:14 +0000
parents fecfe8c80e25
children c33b92eeb1fb
comparison
equal deleted inserted replaced
7:20f4fdaf36bb 8:77706396e7bd
20 make_option("--camera_xcms", default = "xset"), 20 make_option("--camera_xcms", default = "xset"),
21 make_option("--files", type = "character"), 21 make_option("--files", type = "character"),
22 make_option("--galaxy_files", type = "character"), 22 make_option("--galaxy_files", type = "character"),
23 make_option("--choose_class", type = "character"), 23 make_option("--choose_class", type = "character"),
24 make_option("--ignore_files", type = "character"), 24 make_option("--ignore_files", type = "character"),
25 make_option("--rtraw_columns", action = "store_true") 25 make_option("--rtraw_columns", action = "store_true")
26 ) 26 )
27 27
28 28
29 opt <- parse_args(OptionParser(option_list = option_list)) 29 opt <- parse_args(OptionParser(option_list = option_list))
30 print(opt) 30 print(opt)
31 31
32 32
33 if (!is.null(opt$xgroups)) { 33 if (!is.null(opt$xgroups)) {
34 xgroups <- as.numeric(strsplit(opt$xgroups, ",")[[1]]) 34 xgroups <- as.numeric(strsplit(opt$xgroups, ",")[[1]])
35 }else{ 35 } else {
36 xgroups <- NULL 36 xgroups <- NULL
37 } 37 }
38 38
39 39
40 print(xgroups) 40 print(xgroups)
41 41
42 if (!is.null(opt$remove_nas)) { 42 if (!is.null(opt$remove_nas)) {
43 df <- df[!is.na(df$mz), ] 43 df <- df[!is.na(df$mz), ]
44 } 44 }
45 45
46 if (is.null(opt$isotope_matrix)) { 46 if (is.null(opt$isotope_matrix)) {
47 im <- NULL 47 im <- NULL
48 }else{ 48 } else {
49 im <- read.table(opt$isotope_matrix, 49 im <- read.table(opt$isotope_matrix,
50 header = TRUE, sep = "\t", stringsAsFactors = FALSE) 50 header = TRUE, sep = "\t", stringsAsFactors = FALSE
51 )
51 } 52 }
52 53
53 if (is.null(opt$exclude_isotopes)) { 54 if (is.null(opt$exclude_isotopes)) {
54 isotopes <- FALSE 55 isotopes <- FALSE
55 }else{ 56 } else {
56 isotopes <- TRUE 57 isotopes <- TRUE
57 } 58 }
58 59
59 if (is.null(opt$rtraw_columns)) { 60 if (is.null(opt$rtraw_columns)) {
60 rtraw_columns <- FALSE 61 rtraw_columns <- FALSE
61 }else{ 62 } else {
62 rtraw_columns <- TRUE 63 rtraw_columns <- TRUE
63 } 64 }
64 65
65 loadRData <- function(rdata_path, xset_name) { 66 loadRData <- function(rdata_path, xset_name) {
66 #loads an RData file, and returns the named xset object if it is there 67 # loads an RData file, and returns the named xset object if it is there
67 load(rdata_path) 68 load(rdata_path)
68 return(get(ls()[ls() == xset_name])) 69 return(get(ls()[ls() == xset_name]))
70 }
71
72
73
74
75 getxcmsSetObject <- function(xobject) {
76 # XCMS 1.x
77 if (class(xobject) == "xcmsSet") {
78 return(xobject)
79 }
80 # XCMS 3.x
81 if (class(xobject) == "XCMSnExp") {
82 # Get the legacy xcmsSet object
83 suppressWarnings(xset <- as(xobject, "xcmsSet"))
84 sampclass(xset) <- xset@phenoData$sample_group
85 return(xset)
86 }
69 } 87 }
70 88
71 target_obj <- loadRData(opt$xset_path, opt$rdata_name) 89 target_obj <- loadRData(opt$xset_path, opt$rdata_name)
72 90
73 if (opt$camera_xcms == "camera") { 91 if (opt$camera_xcms == "camera") {
74 xset <- target_obj@xcmsSet 92 xset <- target_obj@xcmsSet
75 }else{ 93 } else {
76 xset <- target_obj 94 xset <- target_obj
77 } 95 }
96
97 xset <- getxcmsSetObject(xset)
78 98
79 print(xset) 99 print(xset)
80 100
81 minOffset <- as.numeric(opt$minOffset) 101 minOffset <- as.numeric(opt$minOffset)
82 maxOffset <- as.numeric(opt$maxOffset) 102 maxOffset <- as.numeric(opt$maxOffset)
83 103
84 if (opt$iwNorm == "none") { 104 if (opt$iwNorm == "none") {
85 iwNorm <- FALSE 105 iwNorm <- FALSE
86 iwNormFun <- NULL 106 iwNormFun <- NULL
87 }else if (opt$iwNorm == "gauss") { 107 } else if (opt$iwNorm == "gauss") {
88 iwNorm <- TRUE 108 iwNorm <- TRUE
89 iwNormFun <- msPurity::iwNormGauss(minOff = -minOffset, maxOff = maxOffset) 109 iwNormFun <- msPurity::iwNormGauss(minOff = -minOffset, maxOff = maxOffset)
90 }else if (opt$iwNorm == "rcosine") { 110 } else if (opt$iwNorm == "rcosine") {
91 iwNorm <- TRUE 111 iwNorm <- TRUE
92 iwNormFun <- msPurity::iwNormRcosine(minOff = -minOffset, maxOff = maxOffset) 112 iwNormFun <- msPurity::iwNormRcosine(minOff = -minOffset, maxOff = maxOffset)
93 }else if (opt$iwNorm == "QE5") { 113 } else if (opt$iwNorm == "QE5") {
94 iwNorm <- TRUE 114 iwNorm <- TRUE
95 iwNormFun <- msPurity::iwNormQE.5() 115 iwNormFun <- msPurity::iwNormQE.5()
96 } 116 }
97 117
98 print(xset@filepaths) 118 print(xset@filepaths)
99 119
100 if (!is.null(opt$files)) { 120 if (!is.null(opt$files)) {
103 print(updated_filepaths) 123 print(updated_filepaths)
104 updated_filenames <- basename(updated_filepaths) 124 updated_filenames <- basename(updated_filepaths)
105 original_filenames <- basename(xset@filepaths) 125 original_filenames <- basename(xset@filepaths)
106 update_idx <- match(updated_filenames, original_filenames) 126 update_idx <- match(updated_filenames, original_filenames)
107 127
108 if (!is.null(opt$galaxy_files)) { 128 if (!is.null(opt$galaxy_files)) {
109 galaxy_files <- trimws(strsplit(opt$galaxy_files, ",")[[1]]) 129 galaxy_files <- trimws(strsplit(opt$galaxy_files, ",")[[1]])
110 galaxy_files <- galaxy_files[galaxy_files != ""] 130 galaxy_files <- galaxy_files[galaxy_files != ""]
111 xset@filepaths <- galaxy_files[update_idx] 131 xset@filepaths <- galaxy_files[update_idx]
112 }else{ 132 } else {
113 xset@filepaths <- updated_filepaths[update_idx] 133 xset@filepaths <- updated_filepaths[update_idx]
114 } 134 }
115 } 135 }
116 136
117 if (!is.null(opt$choose_class)) { 137 if (!is.null(opt$choose_class)) {
118 classes <- trimws(strsplit(opt$choose_class, ",")[[1]]) 138 classes <- trimws(strsplit(opt$choose_class, ",")[[1]])
119 139
120 ignore_files_class <- which(!as.character(xset@phenoData$class) %in% classes) 140 ignore_files_class <- which(!as.character(xset@phenoData$class) %in% classes)
121 141
122 print("choose class") 142 print("choose class")
123 print(ignore_files_class) 143 print(ignore_files_class)
124 }else{ 144 } else {
125 ignore_files_class <- NA 145 ignore_files_class <- NA
126 } 146 }
127 147
128 if (!is.null(opt$ignore_files)) { 148 if (!is.null(opt$ignore_files)) {
129 ignore_files_string <- trimws(strsplit(opt$ignore_files, ",")[[1]]) 149 ignore_files_string <- trimws(strsplit(opt$ignore_files, ",")[[1]])
130 filenames <- rownames(xset@phenoData) 150 filenames <- rownames(xset@phenoData)
131 ignore_files <- which(filenames %in% ignore_files_string) 151 ignore_files <- which(filenames %in% ignore_files_string)
132 152
133 ignore_files <- unique(c(ignore_files, ignore_files_class)) 153 ignore_files <- unique(c(ignore_files, ignore_files_class))
134 ignore_files <- ignore_files[ignore_files != ""] 154 ignore_files <- ignore_files[ignore_files != ""]
135 }else{ 155 } else {
136 if (anyNA(ignore_files_class)) { 156 if (anyNA(ignore_files_class)) {
137 ignore_files <- NULL 157 ignore_files <- NULL
138 }else{ 158 } else {
139 ignore_files <- ignore_files_class 159 ignore_files <- ignore_files_class
140 } 160 }
141
142 } 161 }
143 162
144 print("ignore_files") 163 print("ignore_files")
145 print(ignore_files) 164 print(ignore_files)
146 165
147 166
148 ppLCMS <- msPurity::purityX(xset = xset, 167 ppLCMS <- msPurity::purityX(
149 offsets = c(minOffset, maxOffset), 168 xset = xset,
150 cores = opt$cores, 169 offsets = c(minOffset, maxOffset),
151 xgroups = xgroups, 170 cores = opt$cores,
152 purityType = opt$purityType, 171 xgroups = xgroups,
153 ilim = opt$ilim, 172 purityType = opt$purityType,
154 isotopes = isotopes, 173 ilim = opt$ilim,
155 im = im, 174 isotopes = isotopes,
156 iwNorm = iwNorm, 175 im = im,
157 iwNormFun = iwNormFun, 176 iwNorm = iwNorm,
158 singleFile = opt$singleFile, 177 iwNormFun = iwNormFun,
159 fileignore = ignore_files, 178 singleFile = opt$singleFile,
160 rtrawColumns = rtraw_columns) 179 fileignore = ignore_files,
180 rtrawColumns = rtraw_columns
181 )
161 182
162 dfp <- ppLCMS@predictions 183 dfp <- ppLCMS@predictions
163 184
164 # to make compatable with deconrank 185 # to make compatable with deconrank
165 colnames(dfp)[colnames(dfp) == "grpid"] <- "peakID" 186 # (keep grpid for other compatibility)
187 dfp <- data.frame("peakID"=dfp$grpid, dfp)
188
166 colnames(dfp)[colnames(dfp) == "median"] <- "medianPurity" 189 colnames(dfp)[colnames(dfp) == "median"] <- "medianPurity"
167 colnames(dfp)[colnames(dfp) == "mean"] <- "meanPurity" 190 colnames(dfp)[colnames(dfp) == "mean"] <- "meanPurity"
168 colnames(dfp)[colnames(dfp) == "sd"] <- "sdPurity" 191 colnames(dfp)[colnames(dfp) == "sd"] <- "sdPurity"
169 colnames(dfp)[colnames(dfp) == "stde"] <- "sdePurity" 192 colnames(dfp)[colnames(dfp) == "stde"] <- "sdePurity"
170 colnames(dfp)[colnames(dfp) == "RSD"] <- "cvPurity" 193 colnames(dfp)[colnames(dfp) == "RSD"] <- "cvPurity"