diff --git a/DESCRIPTION b/DESCRIPTION index e43dae4..88e9d74 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,6 +16,7 @@ URL: https://ethanbass.github.io/chromConverter, https://github.com/ethanbass/ch BugReports: https://github.com/ethanbass/chromConverter/issues Imports: bitops, + fs, purrr, readxl, reticulate, @@ -29,6 +30,7 @@ Imports: Suggests: entab, mzR, + pbapply, testthat (>= 3.0.0) Config/reticulate: list( packages = list( list(package = "scipy"), list(package="numpy"), diff --git a/NEWS.md b/NEWS.md index 55b92aa..fcf052c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,10 @@ the `read_chemstation_uv` function. * Added `extract_metadata` function for extracting metadata from a list of chromatograms and returning it as a `data.frame` or `tibble`. +* Added `progress_bar` option in `read_chroms`. +* Updated `reshape_chroms` and `reshape_chrom` to allow switching between "wide" and "long" formats. +* Added wide format option in `read_mzml`. +* Added automatic detection of file formats by `read_chroms`. * Minor changes to storage of metadata in attributes for the purpose of simplification. * Minor updates to documentation. diff --git a/R/attach_metadata.R b/R/attach_metadata.R index 4183e56..8781570 100644 --- a/R/attach_metadata.R +++ b/R/attach_metadata.R @@ -255,6 +255,9 @@ extract_metadata <- function(chrom_list, "data_format", "parser","format_out"), format_out = c("data.frame", "tibble") ){ + if (is.matrix(chrom_list) | is.data.frame(chrom_list)){ + chrom_list <- list(chrom_list) + } what <- match.arg(what, several.ok = TRUE) format_out <- match.arg(format_out, c("data.frame", "tibble")) metadata <- purrr::map_df(chrom_list, function(chrom){ @@ -264,10 +267,10 @@ extract_metadata <- function(chrom_list, }) if (format_out == "tibble"){ metadata <- tibble::add_column(.data = metadata, - data.frame(name=names(chrom_list)), + data.frame(name = names(chrom_list)), .before=TRUE) } else if (format_out == "data.frame"){ - metadata <- data.frame(metadata, row.names = names(chrom_list)) + metadata <- data.frame(name = names(chrom_list), metadata, row.names = names(chrom_list)) } metadata } diff --git a/R/parsers.R b/R/parsers.R index 8196b73..e0bae96 100644 --- a/R/parsers.R +++ b/R/parsers.R @@ -259,6 +259,7 @@ read_chemstation_csv <- function(file, format_out = c("matrix","data.frame")){ #' @param what What types of data to return (argument to \code{\link[RaMS]{grabMSdata}}. #' Options include \code{MS1}, \code{MS2}, \code{BPC}, \code{TIC}, \code{DAD}, #' \code{chroms}, \code{metadata}, or \code{everything}). +#' @param verbose Argument to \code{\link[RaMS]{grabMSdata}} controlling \code{verbosity}. #' @param ... Additional arguments to \code{\link[RaMS]{grabMSdata}}. #' @return If \code{RaMS} is selected, the function will return a list of "tidy" #' \code{data.table} objects. If \code{mzR} is selected, the function will return a @@ -268,13 +269,14 @@ read_chemstation_csv <- function(file, format_out = c("matrix","data.frame")){ #' @export read_mzml read_mzml <- function(path, format_out = c("matrix", "data.frame"), - data_format = c("wide","long"), + data_format = c("long","wide"), parser=c("RaMS","mzR"), what=c("MS1","MS2", "BPC", "TIC", "DAD", - "chroms", "metadata", "everything"), ...){ + "chroms", "metadata", "everything"), verbose = FALSE, + ...){ parser <- match.arg(parser, c("RaMS", "mzR")) format_out <- match.arg(format_out, c("matrix", "data.frame")) - data_format <- match.arg(data_format, c("wide","long")) + data_format <- match.arg(data_format, c("long","wide")) what <- match.arg(what, c("MS1","MS2", "BPC", "TIC", "DAD", "chroms", "metadata", "everything"), several.ok = TRUE) if (all(c("MS1","MS2", "BPC", "TIC", "DAD", @@ -282,29 +284,31 @@ read_mzml <- function(path, format_out = c("matrix", "data.frame"), what <- grep("everything",what, invert = TRUE,value = TRUE) } if (parser == "RaMS"){ - data <- RaMS::grabMSdata(path, grab_what = what, ...) - } - if (parser == "mzR"){ - if (!requireNamespace("mzR", quietly = TRUE)) { - stop( - "The `mzR` package must be installed from Bioconductor to read `mzML` files: - BiocManager::install('mzR')", - call. = FALSE) - } - x <- mzR::openMSfile(path) - info <- mzR::header(x) - UV_scans <- which(info$msLevel==0) - rts <- info[UV_scans,"retentionTime"] - lambdas <- seq(info$scanWindowLowerLimit[UV_scans[1]], info$scanWindowUpperLimit[UV_scans[1]]) - pks <- mzR::peaks(x) - data <- t(sapply(UV_scans, function(j) pks[[j]][,2])) - rownames(data) <- rts - colnames(data) <- lambdas - if (data_format == "long"){ - data <- reshape_chrom(data) + data <- RaMS::grabMSdata(path, grab_what = what, verbosity = verbose, ...) + if (data_format == "wide"){ + data <- reshape_chroms(data, data_format = "wide") } - if (format_out == "data.frame"){ - data <- as.data.frame(data) + } else if (parser == "mzR"){ + if (!requireNamespace("mzR", quietly = TRUE)) { + stop( + "The `mzR` package is not installed. Please install it from Bioconductor: + BiocManager::install('mzR')", + call. = FALSE) + } + x <- mzR::openMSfile(path) + info <- mzR::header(x) + UV_scans <- which(info$msLevel==0) + rts <- info[UV_scans,"retentionTime"] + lambdas <- seq(info$scanWindowLowerLimit[UV_scans[1]], info$scanWindowUpperLimit[UV_scans[1]]) + pks <- mzR::peaks(x) + data <- t(sapply(UV_scans, function(j) pks[[j]][,2])) + rownames(data) <- rts + colnames(data) <- lambdas + if (data_format == "long"){ + data <- reshape_chrom(data) + } + if (format_out == "data.frame"){ + data <- as.data.frame(data) } } data diff --git a/R/read_chroms.R b/R/read_chroms.R index 146ad97..37cb455 100644 --- a/R/read_chroms.R +++ b/R/read_chroms.R @@ -42,6 +42,8 @@ #' \code{cdf}, \code{mzml}, or \code{animl}. #' @param read_metadata Logical, whether to attach metadata (if it's available). #' Defaults to TRUE. +#' @param progress_bar Logical. Whether to show progress bar. Defaults to +#' \code{TRUE} if \code{\link[pbapply]{pbapply}} is installed. #' @param dat Existing list of chromatograms to append results. #' (Defaults to NULL). #' @return A list of chromatograms in \code{matrix} or \code{data.frame} format, @@ -73,31 +75,42 @@ read_chroms <- function(paths, find_files, data_format = c("wide","long"), export = FALSE, path_out = NULL, export_format = c("csv", "cdf", "mzml", "animl"), - read_metadata = TRUE, dat = NULL){ - if (length(format_in) > 1){ - stop("Please specify the file format of your chromatograms by setting the `format_in` argument.") - } - format_in <- match.arg(format_in, c("agilent_d", "chemstation", "chemstation_uv", - "chemstation_ch", "chemstation_fid", - "chemstation_csv", "masshunter_dad", - "shimadzu_fid", "shimadzu_dad", "chromeleon_uv", - "thermoraw", "mzml", "waters_arw", - "waters_raw", "msd", "csd", "wsd", "other")) + read_metadata = TRUE, progress_bar, dat = NULL){ data_format <- match.arg(data_format, c("wide","long")) format_out <- match.arg(format_out, c("matrix", "data.frame")) parser <- match.arg(parser, c("", "chromconverter", "aston","entab", "thermoraw", "openchrom", "rainbow")) + if (missing(progress_bar)){ + progress_bar <- check_for_pkg("pbapply", return_boolean = TRUE) + } if (missing(find_files)){ - if (!(format_in %in% c("agilent_d", "waters_raw"))){ - ft <- all(file_test("-f", paths)) + if (length(format_in) == 1){ + if (!(format_in %in% c("agilent_d", "waters_raw"))){ + ft <- all(file_test("-f", paths)) + } else { + ext <- switch(format_in, + agilent_d = "\\.d", + waters_raw = "\\.raw") + ft <- all(grepl(ext, paths, ignore.case = TRUE)) + } + find_files <- !ft } else{ - ext <- switch(format_in, - agilent_d = "\\.d", - waters_raw = "\\.raw") - ft <- all(grepl(ext, paths, ignore.case = TRUE)) + find_files <- FALSE } - find_files <- !ft } + if (length(format_in) > 1){ + if (!find_files){ + format_in <- get_filetype(ifelse(length(paths)>1, paths[[1]], paths)) + } else{ + stop("Please specify the file format of your chromatograms by setting the `format_in` argument.") + } + } + format_in <- match.arg(format_in, c("agilent_d", "chemstation", "chemstation_uv", + "chemstation_ch", "chemstation_fid", + "chemstation_csv", "masshunter_dad", + "shimadzu_fid", "shimadzu_dad", "chromeleon_uv", + "thermoraw", "mzml", "waters_arw", + "waters_raw", "msd", "csd", "wsd", "other")) if (parser == ""){ parser <- check_parser(format_in, find = TRUE) } @@ -244,7 +257,8 @@ read_chroms <- function(paths, find_files, } )) } else {file_names <- sapply(strsplit(basename(files),"\\."), function(x) x[1])} if (parser != "openchrom"){ - data <- lapply(X = files, function(file){ + laplee <- choose_apply_fnc(progress_bar) + data <- laplee(X = files, function(file){ df <- try(converter(file), silent = TRUE) }) errors <- which(sapply(data, function(x) inherits(x,"try-error"))) diff --git a/R/reshape_chroms.R b/R/reshape_chroms.R index d5a4440..f453bce 100644 --- a/R/reshape_chroms.R +++ b/R/reshape_chroms.R @@ -5,22 +5,59 @@ #' @param idx Indices of chromatograms to convert #' @param sample_var String with name of new column containing sample IDs. #' @param lambdas Wavelength(s) to include. +#' @param data_format Whether to return data in \code{wide} or \code{long} format. +#' @param combine Whether to combine chromatograms into a single \code{data.frame} +#' (applicable only if \code{data_format} is TRUE). +#' @param ... Additional arguments to \code{reshape_chrom}. #' @return A list of chromatographic matrices in long format. #' @author Ethan Bass -reshape_chroms <- function(x, idx, sample_var = "sample", lambdas){ +reshape_chroms <- function(x, idx, sample_var = "sample", lambdas=NULL, + data_format, combine = TRUE, ...){ + if (missing(data_format)){ + data_format <- switch(attr(x[[1]],"data_format"), + long="wide",wide="long") + } if (missing(idx)){ idx <- seq_along(x) } dat <- lapply(idx, function(i){ - xx <- reshape_chrom(x[[i]], lambdas) - xx[,sample_var] <- names(x)[[i]] + if (is.null(lambdas)){ + if (data_format == "wide"){ + lambda.idx <- grep("lambda", colnames(x[[i]])) + lambdas <- unique(as.data.frame(x[[i]])[,lambda.idx]) + } else if (data_format == "long"){ + lambdas <- colnames(x[[i]]) + } + } + xx <- reshape_chrom(x[[i]], lambdas = lambdas, data_format = data_format, ...) + if (data_format == "long"){ + xx[,sample_var] <- names(x)[[i]] + } xx }) - do.call(rbind,dat) + if (combine & data_format == "long"){ + dat <- do.call(rbind,dat) + } else { + names(dat) <- names(x) + } + dat +} + +#' @noRd +reshape_chrom <- function(x, data_format, ...){ + # if (missing(data_format)){ + # data_format <- switch(attr(x[[1]],"data_format"), + # long="wide", wide="long") + # } + fn <- switch(data_format, + long = reshape_chrom_long, + wide = reshape_chrom_wide) + + fn(x, ...) } -#' Reshapes a single chromatogram from wide to long format +#' Reshapes a single chromatogram from wide to long format #' @name reshape_chrom #' @importFrom stats reshape #' @param x A chromatographic matrix in wide format. @@ -28,19 +65,58 @@ reshape_chroms <- function(x, idx, sample_var = "sample", lambdas){ #' @return A chromatographic matrix in long format. #' @author Ethan Bass #' @noRd -reshape_chrom <- function(x, lambdas){ +reshape_chrom_long <- function(x, lambdas, format_out=c("data.frame","matrix")){ + if (!is.null(attr(x, "data_format")) && attr(x, "data_format") == "long"){ + warning("The data already appear to be in long format!", immediate. = TRUE) + } if (ncol(x) == 1) stop("The provided data is already in long format!") - x <- as.data.frame(x) + format_out <- match.arg(format_out,c("data.frame","matrix")) + xx <- as.data.frame(x) if (!missing(lambdas)){ - x <- x[,lambdas, drop=FALSE] + xx <- xx[,lambdas, drop = FALSE] } - data <- reshape(as.data.frame(rt=rownames(x),x), direction = "long", - varying = list(1:ncol(x)), v.names="absorbance", - times = colnames(x), timevar = "lambda", - idvar="rt", ids=rownames(x)) + data <- reshape(as.data.frame(rt=rownames(xx), xx), direction = "long", + varying = list(1:ncol(xx)), v.names="absorbance", + times = colnames(xx), timevar = "lambda", + idvar = "rt", ids = rownames(xx)) rownames(data) <- NULL data$rt <- as.numeric(data$rt) data$lambda <- as.numeric(data$lambda) - data[,c(3,2,1)] + data <- data[,c(3,2,1)] + if (format_out == "matrix"){ + data <- as.matrix(data) + } + data <- transfer_metadata(data, x) + attr(data, "data_format") <- "long" + data +} + + +#' @noRd +reshape_chrom_wide <- function(x, lambdas, lambda_var = "lambda", time_var="rt", + value_var = "int", drop){ + if (!is.null(attr(x, "data_format")) && attr(x, "data_format") == "wide"){ + warning("The data already appear to be in wide format!",immediate. = TRUE) + } + x <- as.data.frame(x) + if (missing(drop)){ + drop <- colnames(x)[which(sapply(x,is.character))] + } + if (missing(value_var)){ + value_var <- colnames(x)[grep("int|abs", colnames(x),ignore.case = TRUE)] + } + if (!missing(lambdas)){ + x <- x[which(x[,lambda_var] %in% lambdas),] + } + data <- reshape(x, idvar=time_var, timevar=lambda_var, v.names = value_var, + new.row.names = unique(x$rt), direction="wide", drop=drop) + colnames(data) <- gsub(paste0(value_var,"."),"", colnames(data)) + data <- as.matrix(data) + rownames(data) <- data[,1] + data <- data[,-1] + data <- transfer_metadata(data, x) + attr(data, "data_format") <- "wide" + data } + diff --git a/R/utils.R b/R/utils.R index daaf4d7..c0aa7a1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -117,3 +117,82 @@ extract_header <- function(x, chrom.idx, sep){ } list(header,index) } + +#' Check for suggested package +#' @noRd +check_for_pkg <- function(pkg, return_boolean = FALSE){ + pkg_exists <- requireNamespace(pkg, quietly = TRUE) + if (!pkg_exists) { + stop(paste( + "Package", sQuote(pkg), "must be installed to perform this action: + try", paste0("`install.packages('", pkg, "')`.")), + call. = FALSE + ) + } + if (return_boolean){ + pkg_exists + } +} + +#' Choose apply function +#' @return Returns \code{\link[pbapply]{pblapply}} if \code{progress_bar == TRUE}, +#' otherwise returns \code{\link{lapply}}. +#' @noRd +choose_apply_fnc <- function(progress_bar, parallel = FALSE, cl = NULL){ + if (progress_bar){ + check_for_pkg("pbapply") + fn <- pbapply::pblapply + } else{ + fn <- lapply + } + fn +} + +#'@noRd +transfer_metadata <- function (new_object, old_object, exclude = c("names", "row.names", + "class", "dim", "dimnames")) +{ + a <- attributes(old_object) + a[exclude] <- NULL + attributes(new_object) <- c(attributes(new_object), a) + new_object +} + +#' @noRd +get_filetype <- function(file, out = c("format_in", "filetype")){ + out <- match.arg(out, c("format_in", "filetype")) + magic <- readBin(file, what = "raw", n = 4) + magic <- paste(paste0("x",as.character(magic)),collapse="/") + # magic + filetype <- switch(magic, + "x01/x32/x00/x00" = "AgilentChemstationMS", + "x02/x02/x00/x00" = "AgilentMasshunterDADHeader", + "x02/x33/x30/x00" = "AgilentChemstationMWD", + "x02/x33/x31/x00" = "AgilentChemstationDAD", + "x02/x38/x31/x00" = "AgilentChemstationFID", #81 + "x03/x02/x00/x00" = "AgilentMasshunterDAD", + "x03/x31/x33/x30" = "AgilentChemstationCH", #131 + "x03/x31/x33/x31" = "AgilentChemstationDAD", #131 rainbow + "x03/x31/x37/x39" = "AgilentChemstationFID", #179 + "x03/x31/x38/x31" = "AgilentChemstationFID", #181 + "x02/x33/x30/x00" = "AgilentChemstationCH", #31/30 + "x01/xa1/x46/x00" = "ThermoRAW", + "xd0/xcf/x11/xe0" = "ShimadzuLCD", + "x80/x00/x01/x00" = "WatersRAW" + ) + if (is.null(filetype)){ + stop("File type not recognized. Please specify a filetype by providing an argument to `format_in` + or file an issue at `https://github.com/ethanbass/chromConverter/issues`.") + } + format_in <- switch(filetype, + "AgilentChemstationMS" = "chemstation", + "AgilentChemstationCH" = "chemstation_ch", + "AgilentChemstationFID" = "chemstation_ch", + "AgilentChemstationDAD" = "chemstation_uv", + "ThermoRAW" = "thermoraw", + "ShimadzuLCD" = "shimadzu_lcd", + "WatersRAW" = "waters_raw" + ) + + switch(out, "filetype" = filetype, "format_in" = format_in) +} diff --git a/README.md b/README.md index d516913..029880d 100644 --- a/README.md +++ b/README.md @@ -125,7 +125,7 @@ Parsers in OpenChrom are organized by detector-type. Thus, for the `format_in` a ###### Extracting metadata -chromConverter includes some options to extract metadata from the provided files. If `read_metadata = TRUE`, metadata will be extracted and stored as `attributes` of the associated object. A list of [`attributes`](https://stat.ethz.ch/R-manual/R-devel/library/base/html/attributes.html) can be extracted from any R object using the `attributes()` function. Single attributes can be extracted using `attr()`: e.g. `attr(dat[[1]], "sample_name"). +chromConverter includes some options to extract metadata from the provided files. If `read_metadata = TRUE`, metadata will be extracted and stored as `attributes` of the associated object. The metadata can then be extracted into a data.frame or tibble using the `extract_metadata` function. ### Further analysis diff --git a/man/read_chroms.Rd b/man/read_chroms.Rd index 5084791..21b731a 100644 --- a/man/read_chroms.Rd +++ b/man/read_chroms.Rd @@ -19,6 +19,7 @@ read_chroms( path_out = NULL, export_format = c("csv", "cdf", "mzml", "animl"), read_metadata = TRUE, + progress_bar, dat = NULL ) } @@ -60,6 +61,9 @@ unless you are using OpenChrom parsers, where you could have \code{csv}, \item{read_metadata}{Logical, whether to attach metadata (if it's available). Defaults to TRUE.} +\item{progress_bar}{Logical. Whether to show progress bar. Defaults to +\code{TRUE} if \code{\link[pbapply]{pbapply}} is installed.} + \item{dat}{Existing list of chromatograms to append results. (Defaults to NULL).} } diff --git a/man/read_mzml.Rd b/man/read_mzml.Rd index 35aa738..74cdf1b 100644 --- a/man/read_mzml.Rd +++ b/man/read_mzml.Rd @@ -7,9 +7,10 @@ read_mzml( path, format_out = c("matrix", "data.frame"), - data_format = c("wide", "long"), + data_format = c("long", "wide"), parser = c("RaMS", "mzR"), what = c("MS1", "MS2", "BPC", "TIC", "DAD", "chroms", "metadata", "everything"), + verbose = FALSE, ... ) } @@ -28,6 +29,8 @@ a list of data.tables regardless of what is selected here.} Options include \code{MS1}, \code{MS2}, \code{BPC}, \code{TIC}, \code{DAD}, \code{chroms}, \code{metadata}, or \code{everything}).} +\item{verbose}{Argument to \code{\link[RaMS]{grabMSdata}} controlling \code{verbosity}.} + \item{...}{Additional arguments to \code{\link[RaMS]{grabMSdata}}.} } \value{ diff --git a/man/reshape_chroms.Rd b/man/reshape_chroms.Rd index d263d0f..7e49e01 100644 --- a/man/reshape_chroms.Rd +++ b/man/reshape_chroms.Rd @@ -4,7 +4,15 @@ \alias{reshape_chroms} \title{Reshapes list of chromatograms from wide to long format} \usage{ -reshape_chroms(x, idx, sample_var = "sample", lambdas) +reshape_chroms( + x, + idx, + sample_var = "sample", + lambdas = NULL, + data_format, + combine = TRUE, + ... +) } \arguments{ \item{x}{A list of chromatographic matrices in wide format.} @@ -14,6 +22,13 @@ reshape_chroms(x, idx, sample_var = "sample", lambdas) \item{sample_var}{String with name of new column containing sample IDs.} \item{lambdas}{Wavelength(s) to include.} + +\item{data_format}{Whether to return data in \code{wide} or \code{long} format.} + +\item{combine}{Whether to combine chromatograms into a single \code{data.frame} +(applicable only if \code{data_format} is TRUE).} + +\item{...}{Additional arguments to \code{reshape_chrom}.} } \value{ A list of chromatographic matrices in long format. diff --git a/tests/testthat/test-read_chroms.R b/tests/testthat/test-read_chroms.R index 3e7aa6d..73afaf1 100644 --- a/tests/testthat/test-read_chroms.R +++ b/tests/testthat/test-read_chroms.R @@ -3,14 +3,14 @@ library(testthat) path_csv <- "testdata/DAD1.CSV" path_uv <- "testdata/dad1.uv" -x <- read_chroms(path_csv, format_in = "chemstation_csv") +x <- read_chroms(path_csv, format_in = "chemstation_csv", progress_bar = FALSE) test_that("aston parser works", { skip_if_missing_dependecies() paths <- rep(path_uv,2) x1 <- read_chroms(paths, format_in = "chemstation_uv", parser = "aston", find_files = FALSE, - read_metadata = TRUE) + read_metadata = TRUE, progress_bar = FALSE) expect_equal(as.numeric(x[[1]][,1]), as.numeric(x1[[1]][,"220.0"])) expect_equal(as.numeric(rownames(x[[1]])), as.numeric(rownames(x1[[1]]))) expect_equal(length(x1), length(paths)) @@ -20,7 +20,7 @@ test_that("aston parser works", { x1 <- read_chroms(path_uv, format_in = "chemstation_uv", parser = "chromconverter", find_files = FALSE, - read_metadata = TRUE) + read_metadata = TRUE, progress_bar = FALSE) test_that("read_chemstation_uv parser works", { expect_equal(as.numeric(x[[1]][,1]), as.numeric(x1[[1]][,"220"])) @@ -43,7 +43,7 @@ test_that("entab parser works", { file <- "testdata/DAD1.uv" x1 <- read_chroms(file, format_in = "chemstation_uv", parser = "entab", find_files = FALSE, - read_metadata = TRUE) + read_metadata = TRUE, progress_bar = FALSE) expect_equal(as.numeric(x[[1]][,1]), as.numeric(x1[[1]][,"220"])) expect_equal(as.numeric(rownames(x[[1]])), as.numeric(rownames(x1[[1]]))) expect_equal(class(x1[[1]])[1], "matrix") @@ -67,7 +67,7 @@ test_that("entab parser works", { test_that("shimadzu parser works", { file <- "testdata/ladder.txt" - x <- read_chroms(file, format_in = "shimadzu_fid", find_files = FALSE) + x <- read_chroms(file, format_in = "shimadzu_fid", find_files = FALSE, progress_bar = FALSE) expect_equal(class(x[[1]])[1], "matrix") expect_equal(attributes(x[[1]])$instrument, "GC-2014") }) @@ -91,3 +91,21 @@ test_that("check_path works on unix/linux", { # expect_equal(attributes(x[[1]])$instrument, "GC-2014") # }) +test_that("read_mzml works", { + ext_filepath <- system.file("extdata", package = "RaMS") + DAD_filepath <- list.files(ext_filepath, full.names = TRUE, + pattern = "uv_test_mini.mzML") + dad_long <- read_mzml(DAD_filepath, what = "DAD", verbose=FALSE) + expect_equal(dad_long, + RaMS::grabMSdata(files = DAD_filepath, grab_what = "DAD", verbosity = FALSE) + ) + dad_wide <- read_mzml(DAD_filepath, what = "DAD", verbose=FALSE, data_format="wide") + expect_equal(nrow(dad_wide[[1]]), length(unique(dad_long[[1]]$rt))) + expect_equal(ncol(dad_wide[[1]]), length(unique(dad_long[[1]]$lambda))) + expect_equal(as.numeric(colnames(dad_wide[[1]])), unique(dad_long[[1]]$lambda)) + expect_equal(as.numeric(rownames(dad_wide[[1]])), unique(dad_long[[1]]$rt)) +}) + +test_that("get_filetype works as expected", { + expect_equal(get_filetype(path_uv), "chemstation_uv") +})