diff --git a/DESCRIPTION b/DESCRIPTION index 3dbbef169..c955dc470 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: xcms -Version: 2.99.2 -Date: 2017-05-30 +Version: 2.99.3 +Date: 2017-06-13 Title: LC/MS and GC/MS Data Analysis Author: Colin A. Smith , Ralf Tautenhahn , diff --git a/R/functions-IO.R b/R/functions-IO.R index 140f58805..362a1413b 100644 --- a/R/functions-IO.R +++ b/R/functions-IO.R @@ -6,15 +6,15 @@ ## isCdfFile ## ## Just guessing whether the file is a CDF file based on its ending. -isCdfFile <- function(x) { - fileEnds <- c("cdf", "nc") - ## check for endings and and ending followed by a . (e.g. cdf.gz) - patts <- paste0("\\.", fileEnds, "($|\\.)") - res <- sapply(patts, function(z) { - grep(z, x, ignore.case = TRUE) - }) - any(unlist(res)) -} +## isCdfFile <- function(x) { +## fileEnds <- c("cdf", "nc") +## ## check for endings and and ending followed by a . (e.g. cdf.gz) +## patts <- paste0("\\.", fileEnds, "($|\\.)") +## res <- sapply(patts, function(z) { +## grep(z, x, ignore.case = TRUE) +## }) +## any(unlist(res)) +## } ############################################################ ## isMzMLFile @@ -34,16 +34,63 @@ isMzMLFile <- function(x) { ## isRampFile ## ## Files that have to be read using the Ramp backend. -isRampFile <- function(x) { - fileEnds <- c("mzxml", "mzdata") - ## check for endings and and ending followed by a . (e.g. mzML.gz) - patts <- paste0("\\.", fileEnds, "($|\\.)") - res <- sapply(patts, function(z) { - grep(z, x, ignore.case = TRUE) - }) - any(unlist(res)) +## isRampFile <- function(x) { +## fileEnds <- c("mzxml", "mzdata") +## ## check for endings and and ending followed by a . (e.g. mzML.gz) +## patts <- paste0("\\.", fileEnds, "($|\\.)") +## res <- sapply(patts, function(z) { +## grep(z, x, ignore.case = TRUE) +## }) +## any(unlist(res)) +## } + +#' Guess the correct mzR backend from the file name (ending) +#' +#' @noRd +.mzRBackendFromFilename <- function(x = character()) { + if (length(x) != 1) + stop("parameter 'x' has to be of length 1") + if (grepl("\\.mzml($|\\.)|\\.mzxml($|\\.)", x, ignore.case = TRUE)) { + return("pwiz") + } else if (grepl("\\.mzdata($|\\.)", x, ignore.case = TRUE)) { + return("Ramp") + } else if (grepl("\\.cdf($|\\.)|\\.nc($|\\.)", x, ignore.case = TRUE)) { + return("netCDF") + } else { + return(NA) + } +} + +#' Return the mzR backend based on the provided file type. +#' +#' @noRd +.mzRBackendFromFiletype <- function(x = character()) { + x <- match.arg(tolower(x), c("mzml", "mzxml", "cdf", "netcdf", "mzdata")) + if (x == "netcdf") + x <- "cdf" + .mzRBackendFromFilename(paste0("dummy.", x)) } +#' Return the mzR backend based on the file content of the file. This uses code +#' from @sneumann, issue #188 +#' +#' @noRd +.mzRBackendFromFilecontent <- function(x = character()) { + if (length(x) != 1) + stop("parameter 'x' has to be of length 1") + ## check mzML: + suppressWarnings( + first_lines <- readLines(x, n = 4) + ) + if (any(grepl("= rtr[1])) checkTrue(all(rtime(res[[1]]) <= rtr[2])) checkTrue(all(rtime(res[[2]]) >= rtr[1])) checkTrue(all(rtime(res[[2]]) <= rtr[2])) - checkTrue(all(rtime(res[[3]]) >= rtr[1])) - checkTrue(all(rtime(res[[3]]) <= rtr[2])) tmp <- filterRt(filterFile(xod_x, file = 2), rt = rtr) checkEquals(rtime(tmp), rtime(res[[2]])) ints <- spectrapply(tmp, function(z) return(max(intensity(z)))) @@ -1047,9 +1046,11 @@ test_extractChromatograms <- function() { ## Check names checkEquals(names(rtime(res[[1]])), names(intensity(res[[1]]))) ## Assure we get the same with an OnDiskMSnExp and grouped XCMSnExp - res_2 <- xcms:::extractChromatograms(od_x, aggregationFun = "max", rt = rtr) + res_2 <- xcms:::extractChromatograms(filterFile(od_x, file = c(1, 2)), + aggregationFun = "max", rt = rtr) checkEquals(res, res_2) - res_3 <- xcms:::extractChromatograms(xod_xg, aggregationFun = "max", rt = rtr) + res_3 <- xcms:::extractChromatograms(filterFile(xod_xg, file = c(1, 2)), + aggregationFun = "max", rt = rtr) checkEquals(res, res_3) ## XCMSnExp: with mzrange and rtrange: @@ -1170,48 +1171,40 @@ test_extractMsData <- function() { ## checkEquals(lengths(rts), unlist(lapply(all, nrow))) ## On an OnDiskMSnExp with only mz mzr <- c(300, 302) - res <- extractMsData(od_x, mz = mzr) - checkEquals(length(res), length(fileNames(od_x))) + res <- extractMsData(filterFile(od_x, 1:2), mz = mzr) + checkEquals(length(res), 2) checkTrue(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2])) checkTrue(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2])) - checkTrue(all(res[[3]][, "mz"] >= mzr[1] & res[[3]][, "mz"] <= mzr[2])) ## On an OnDiskMSnExp with only rt rtr <- c(2500, 2800) - res <- extractMsData(od_x, rt = rtr) + res <- extractMsData(filterFile(od_x, 1:2), rt = rtr) checkTrue(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2])) checkTrue(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2])) - checkTrue(all(res[[3]][, "rt"] >= rtr[1] & res[[3]][, "rt"] <= rtr[2])) ## LLLLL TODO Continue here, and then add example to the extractMsData ## help page. ## On an OnDiskMSnExp with mz and rt - res <- extractMsData(od_x, rt = rtr, mz = mzr) + res <- extractMsData(filterFile(od_x, 1:2), rt = rtr, mz = mzr) checkTrue(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2])) checkTrue(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2])) - checkTrue(all(res[[3]][, "rt"] >= rtr[1] & res[[3]][, "rt"] <= rtr[2])) checkTrue(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2])) checkTrue(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2])) - checkTrue(all(res[[3]][, "mz"] >= mzr[1] & res[[3]][, "mz"] <= mzr[2])) - + ## XCMSnExp, xod_xgr ## with adjusted retention times - res <- extractMsData(xod_xgr, rt = rtr, mz = mzr) + res <- extractMsData(filterFile(xod_xgr, 1:2), rt = rtr, mz = mzr) checkTrue(all(res[[1]][, "rt"] >= rtr[1] & res[[1]][, "rt"] <= rtr[2])) checkTrue(all(res[[2]][, "rt"] >= rtr[1] & res[[2]][, "rt"] <= rtr[2])) - checkTrue(all(res[[3]][, "rt"] >= rtr[1] & res[[3]][, "rt"] <= rtr[2])) checkTrue(all(res[[1]][, "mz"] >= mzr[1] & res[[1]][, "mz"] <= mzr[2])) checkTrue(all(res[[2]][, "mz"] >= mzr[1] & res[[2]][, "mz"] <= mzr[2])) - checkTrue(all(res[[3]][, "mz"] >= mzr[1] & res[[3]][, "mz"] <= mzr[2])) ## without adjusted retention times - res_2 <- extractMsData(xod_xgr, adjustedRtime = FALSE, rt = rtr, mz = mzr) + res_2 <- extractMsData(filterFile(xod_xgr, 1:2), adjustedRtime = FALSE, + rt = rtr, mz = mzr) checkTrue(all(res_2[[1]][, "rt"] >= rtr[1] & res_2[[1]][, "rt"] <= rtr[2])) checkTrue(all(res_2[[2]][, "rt"] >= rtr[1] & res_2[[2]][, "rt"] <= rtr[2])) - checkTrue(all(res_2[[3]][, "rt"] >= rtr[1] & res_2[[3]][, "rt"] <= rtr[2])) checkTrue(all(res_2[[1]][, "mz"] >= mzr[1] & res_2[[1]][, "mz"] <= mzr[2])) checkTrue(all(res_2[[2]][, "mz"] >= mzr[1] & res_2[[2]][, "mz"] <= mzr[2])) - checkTrue(all(res_2[[3]][, "mz"] >= mzr[1] & res_2[[3]][, "mz"] <= mzr[2])) - checkTrue(nrow(res[[1]]) != nrow(res_2[[1]])) - checkTrue(nrow(res[[2]]) != nrow(res_2[[2]])) - checkTrue(nrow(res[[3]]) != nrow(res_2[[3]])) + ## checkTrue(nrow(res[[1]]) != nrow(res_2[[1]])) + ## checkTrue(nrow(res[[2]]) != nrow(res_2[[2]])) ## rt and mzr out of range. res <- extractMsData(od_x, rt = c(6000, 6300), mz = c(0, 3)) @@ -1220,9 +1213,9 @@ test_extractMsData <- function() { res <- extractMsData(od_x, rt = c(6000, 6300)) checkEquals(length(res), 3) checkTrue(all(unlist(lapply(res, FUN = nrow)) == 0)) - res <- extractMsData(od_x, mz = c(0, 3)) - checkEquals(length(res), 3) - checkTrue(all(unlist(lapply(res, FUN = nrow)) == 0)) + ## res <- extractMsData(od_x, mz = c(0, 3)) + ## checkEquals(length(res), 3) + ## checkTrue(all(unlist(lapply(res, FUN = nrow)) == 0)) } ############################################################ diff --git a/inst/unitTests/runit.functions-IO.R b/inst/unitTests/runit.functions-IO.R new file mode 100644 index 000000000..854ee1854 --- /dev/null +++ b/inst/unitTests/runit.functions-IO.R @@ -0,0 +1,38 @@ +test_mzRBackendFromFilename <- function() { + checkEquals(xcms:::.mzRBackendFromFilename("test.mzML"), "pwiz") + checkEquals(xcms:::.mzRBackendFromFilename("test.mzXML"), "pwiz") + checkEquals(xcms:::.mzRBackendFromFilename("test.mzdata"), "Ramp") + checkEquals(xcms:::.mzRBackendFromFilename("test.cdf"), "netCDF") + checkEquals(xcms:::.mzRBackendFromFilename("test.nc"), "netCDF") + checkEquals(xcms:::.mzRBackendFromFilename("test.bla"), NA) + checkException(xcms:::.mzRBackendFromFilename(c(1, 2))) +} + +test_mzRBackendFromFiletype <- function() { + checkEquals(xcms:::.mzRBackendFromFiletype("mzml"), "pwiz") + checkEquals(xcms:::.mzRBackendFromFiletype("MZXML"), "pwiz") + checkEquals(xcms:::.mzRBackendFromFiletype("mzdata"), "Ramp") + checkEquals(xcms:::.mzRBackendFromFiletype("netcdf"), "netCDF") + checkEquals(xcms:::.mzRBackendFromFiletype("cdf"), "netCDF") + checkException(xcms:::.mzRBackendFromFiletype(c(1, 2))) + checkException(xcms:::.mzRBackendFromFiletype("bla")) +} + +test_mzRBackendFromFilecontent <- function() { + ## mzXML + fl <- system.file("threonine", "threonine_i2_e35_pH_tree.mzXML", + package = "msdata") + checkEquals(xcms:::.mzRBackendFromFilecontent(fl), "pwiz") + ## CDF + fl <- system.file("cdf", "ko15.CDF", package = "msdata") + checkEquals(xcms:::.mzRBackendFromFilecontent(fl), "netCDF") + tmpf <- tempfile() + file.copy(fl, tmpf) + checkEquals(xcms:::.mzRBackendFromFilecontent(tmpf), "netCDF") + ## mzML + fl <- system.file("microtofq", "MM14.mzML", package = "msdata") + checkEquals(xcms:::.mzRBackendFromFilecontent(fl), "pwiz") + ## mzData + fl <- system.file("iontrap", "extracted.mzData", package = "msdata") + checkEquals(xcms:::.mzRBackendFromFilecontent(fl), "Ramp") +} diff --git a/inst/unitTests/runit.obiwarp.R b/inst/unitTests/runit.obiwarp.R index fe5565742..7c517360b 100644 --- a/inst/unitTests/runit.obiwarp.R +++ b/inst/unitTests/runit.obiwarp.R @@ -1,27 +1,34 @@ test.obiwarp.default <- function() { - xr <- retcor(faahko, method="obiwarp", profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", profStep = 10) } test.obiwarp.local <- function() { - xr <- retcor(faahko, method="obiwarp", localAlignment=1, profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", localAlignment=1, profStep = 10) } test.obiwarp.cor <- function() { - xr <- retcor(faahko, method="obiwarp", distFunc="cor", profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", distFunc="cor", profStep = 10) } test.obiwarp.cor_opt <- function() { - xr <- retcor(faahko, method="obiwarp", distFunc="cor_opt", profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", distFunc="cor_opt", profStep = 10) } test.obiwarp.cov <- function() { - xr <- retcor(faahko, method="obiwarp", distFunc="cov", profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", distFunc="cov", profStep = 10) } test.obiwarp.euc <- function() { - xr <- retcor(faahko, method="obiwarp", distFunc="euc", profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", distFunc="euc", profStep = 10) } test.obiwarp.prd <- function() { - xr <- retcor(faahko, method="obiwarp", distFunc="prd", profStep = 10) + faahko_sub <- faahko[,1:2] + xr <- retcor(faahko_sub, method="obiwarp", distFunc="prd", profStep = 10) } diff --git a/tests/doRUnit.R b/tests/doRUnit.R index 729feb8af..a7f0f5c44 100644 --- a/tests/doRUnit.R +++ b/tests/doRUnit.R @@ -111,3 +111,4 @@ if(require("RUnit", quietly=TRUE)) { } else { warning("cannot run unit tests -- package RUnit is not available") } +