- Re-introduce the "MS:-1" CV term for software without CV term, but don't
export this information.
... | ... |
@@ -103,9 +103,9 @@ |
103 | 103 |
## issue #151: CV param ?? is not valid. |
104 | 104 |
## if (length(z) == 2) |
105 | 105 |
## z <- c(z, "MS:-1") |
106 |
- if (length(z) < 2) |
|
106 |
+ if (length(z) < 3) |
|
107 | 107 |
stop("Each element in 'software_processing' has to be of ", |
108 |
- "length >= 2") |
|
108 |
+ "length >= 3") |
|
109 | 109 |
z |
110 | 110 |
} |
111 | 111 |
x <- lapply(x, check_element) |
... | ... |
@@ -178,7 +178,7 @@ copyWriteMSData <- function(object, file, original_file, header, |
178 | 178 |
## Check software_processing: |
179 | 179 |
software_processing <- .check_software_processing(software_processing) |
180 | 180 |
## Add mzR processing: |
181 |
- mzR <- c("mzR", paste(packageVersion("mzR"), collapse = ".")) |
|
181 |
+ mzR <- c("mzR", paste(packageVersion("mzR"), collapse = "."), "MS:-1") |
|
182 | 182 |
if (outformat == "mzml") |
183 | 183 |
mzR <- c(mzR, "MS:1000544") |
184 | 184 |
if (outformat == "mzxml") |
... | ... |
@@ -48,8 +48,9 @@ test_validSpectrumList <- function() { |
48 | 48 |
|
49 | 49 |
test_check_software_processing <- function() { |
50 | 50 |
checkException(mzR:::.check_software_processing("a")) |
51 |
- res <- mzR:::.check_software_processing(c("mzR", "1.0.0")) |
|
51 |
+ res <- mzR:::.check_software_processing(c("mzR", "1.0.0", "MS:-1")) |
|
52 | 52 |
checkEquals(class(res), "list") |
53 |
- checkEquals(res, list(c("mzR", "1.0.0"))) |
|
53 |
+ checkEquals(res, list(c("mzR", "1.0.0", "MS:-1"))) |
|
54 |
+ checkException(mzR:::.check_software_processing(c("mzR", "1.0.0"))) |
|
54 | 55 |
checkException(mzR:::.check_software_processing(c(3, 5))) |
55 | 56 |
} |
... | ... |
@@ -40,9 +40,9 @@ test_mzML <- function() { |
40 | 40 |
checkTrue(any(colnames(hdr) == "spectrumId")) |
41 | 41 |
checkTrue(all(hdr$centroided)) |
42 | 42 |
checkEquals(hdr$spectrumId, paste0("spectrum=", hdr$acquisitionNum)) |
43 |
- hdr <- header(mzxml,1) |
|
43 |
+ hdr <- header(mzml,1) |
|
44 | 44 |
checkTrue(is.list(hdr)) |
45 |
- hdr <- header(mzxml, 2:3) |
|
45 |
+ hdr <- header(mzml, 2:3) |
|
46 | 46 |
checkTrue(is.data.frame(hdr)) |
47 | 47 |
checkTrue(nrow(hdr) == 2) |
48 | 48 |
|
... | ... |
@@ -250,7 +250,7 @@ test_copyWriteMSData <- function() { |
250 | 250 |
out_file <- paste0(test_folder, "test_copyWrite.mzML") |
251 | 251 |
mzR::copyWriteMSData(file = out_file, original_file = test_file, |
252 | 252 |
header = hdr, object = pks, |
253 |
- software_processing = c("MSnbase", "2.3.8")) |
|
253 |
+ software_processing = c("MSnbase", "2.3.8", "MS:-1")) |
|
254 | 254 |
in_file <- openMSfile(out_file, backend = "pwiz") |
255 | 255 |
hdr_2 <- header(in_file) |
256 | 256 |
pks_2 <- peaks(in_file) |
... | ... |
@@ -264,7 +264,7 @@ test_copyWriteMSData <- function() { |
264 | 264 |
out_file <- paste0(test_folder, "test_copyWrite.mzXML") |
265 | 265 |
mzR::copyWriteMSData(file = out_file, original_file = test_file, |
266 | 266 |
header = hdr, object = pks, outformat = "mzXML", |
267 |
- software_processing = c("MSnbase", "2.3.8")) |
|
267 |
+ software_processing = c("MSnbase", "2.3.8", "MS:-1")) |
|
268 | 268 |
in_file <- openMSfile(out_file, backend = "pwiz") |
269 | 269 |
hdr_2 <- header(in_file) |
270 | 270 |
pks_2 <- peaks(in_file) |
... | ... |
@@ -543,7 +543,8 @@ void RcppPwiz::writeSpectrumList(const string& file, const string& format, |
543 | 543 |
* o soft_proc: is supposed to be a character vector of length >= 2: |
544 | 544 |
* soft_proc[0]: The software name (required). |
545 | 545 |
* soft_proc[1]: The software version (required). |
546 |
- * soft_proc[2]: The CV ID of the software. Use "-1" if not known. |
|
546 |
+ * soft_proc[2]: The CV ID of the software. Use "MS:-1" if not known, in |
|
547 |
+ * which case we are NOT writing the corresponding CV element. |
|
547 | 548 |
* soft_proc[3-length]: CV IDs of the processing steps (optional). |
548 | 549 |
*/ |
549 | 550 |
void RcppPwiz::addDataProcessing(MSData& msd, Rcpp::StringVector soft_proc) { |
... | ... |
@@ -552,8 +553,10 @@ void RcppPwiz::addDataProcessing(MSData& msd, Rcpp::StringVector soft_proc) { |
552 | 553 |
new_soft->version = soft_proc(1); |
553 | 554 |
int soft_proc_size = soft_proc.size(); |
554 | 555 |
if (soft_proc_size > 2) { |
555 |
- CVTermInfo cv_term = cvTermInfo(soft_proc(2)); |
|
556 |
- new_soft->set(cv_term.cvid); |
|
556 |
+ if (soft_proc(2) != "MS:-1") { |
|
557 |
+ CVTermInfo cv_term = cvTermInfo(soft_proc(2)); |
|
558 |
+ new_soft->set(cv_term.cvid); |
|
559 |
+ } |
|
557 | 560 |
} |
558 | 561 |
// Order: get the number of already present dataProcessingPtrs and |
559 | 562 |
// increment |