Merge branch 'main' into phili

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: MsIO
 Title: Serializing and restoring/importing mass spectrometry data objects
-Version: 0.0.5
+Version: 0.0.6
 Authors@R:
     c(person(given = "Johannes", family = "Rainer",
              email = "[email protected]",
@@ -44,8 +44,9 @@ Suggests:
     testthat,
     xcms,
     alabaster.se,
-    alabaster.matrix, 
-    MsBackendMetaboLights
+    alabaster.matrix,
+    MsBackendMetaboLights,
+    QFeatures
 License: Artistic-2.0
 Encoding: UTF-8
 VignetteBuilder: knitr
@@ -66,4 +67,5 @@ Collate:
     'Spectra.R'
     'mzTabParam.R'
     'XcmsExperiment.R'
+    'utils.R'
     'zzz.R'

NEWS.md

@@ -1,8 +1,12 @@
-# Version 0.0.5
+# Version 0.0
+
+## Changes in 0.0.6
+
+- Expand unit tests.
 
 ## Changes in 0.0.5
 
-- Add *MetaboLights* `readMsObject()` method for `MsExpriment()` objects. 
+- Add *MetaboLights* `readMsObject()` method for `MsExpriment()` objects.
 
 ## Changes in 0.0.4
 

R/MsBackendMzR.R

@@ -26,8 +26,9 @@ setMethod("saveMsObject", signature(object = "MsBackendMzR",
               object <-  Spectra::dropNaSpectraVariables(object)
               fl <- file.path(param@path, "ms_backend_data.txt")
               if (file.exists(fl))
-                  warning("Overwriting already present ",
-                          "'ms_backend_data.txt' file")
+                  stop("Overwriting or saving to an existing directory is not",
+                       " supported. Please remove the directory defined with",
+                       " parameter `path` first.")
               writeLines(paste0("# ", class(object)[1L]), con = fl)
               if (nrow(object@spectraData))
                   suppressWarnings(
@@ -126,7 +127,7 @@ validateAlabasterMsBackendMzR <- function(path = character(),
 #' @noRd
 readAlabasterMsBackendMzR <- function(path = character(), metadata = list(),
                                       spectraPath = character()) {
-    if (!requireNamespace("Spectra", quietly = TRUE))
+    if (!.is_spectra_installed())
         stop("Required package 'Spectra' missing. Please install ",
              "and try again.", call. = FALSE)
     validateAlabasterMsBackendMzR(path, metadata)

R/MsExperiment.R

@@ -102,12 +102,12 @@ setMethod("saveObject", "MsExperiment", function(x, path, ...) {
         stop("Saving of an 'MsExperiment' with an object of type 'QFeatures'",
              " in the qdata slot is currently not supported.", call. = FALSE)
     if (inherits(x@qdata, "SummarizedExperiment") &&
-        !requireNamespace("alabaster.se", quietly = TRUE))
+        !.is_alabaster_se_installed())
         stop("Required package 'alabaster.se' for export of ",
              "'SummarizedExperiment' objects missing. Please install and ",
              "try again.", call. = FALSE)
     if (length(x@sampleDataLinks) > 0 &&
-        !requireNamespace("alabaster.matrix", quietly = TRUE))
+        !.is_alabaster_matrix_installed())
         stop("Required package 'alabaster.matrix' missing. Please install and ",
              "try again.", call. = FALSE)
     dir.create(path = path, recursive = TRUE, showWarnings = FALSE)
@@ -149,7 +149,7 @@ validateAlabasterMsExperiment <- function(path = character(),
 #' @importFrom alabaster.base readObjectFile
 readAlabasterMsExperiment <- function(path = character(), metadata = list(),
                                       ...) {
-    if (!requireNamespace("MsExperiment", quietly = TRUE))
+    if (!.is_ms_experiment_installed())
         stop("Required package 'MsExperiment' missing. Please install ",
              "and try again.", call. = FALSE)
     validateAlabasterMsExperiment(path, metadata)
@@ -169,7 +169,7 @@ readAlabasterMsExperiment <- function(path = character(), metadata = list(),
     if (file.exists(file.path(path, "qdata"))) {
         qdata_obj <- readObjectFile(file.path(path, "qdata"))
         if (qdata_obj$type[1L] == "summarized_experiment") {
-            if (!requireNamespace("alabaster.se", quietly = TRUE))
+            if (!.is_alabaster_se_installed())
                 stop("Required package 'alabaster.se' not available. Please ",
                      "install and try again.", call. = FALSE)
             i <- altReadObject(file.path(path, "qdata"))
@@ -216,21 +216,27 @@ setMethod("readMsObject",
                     param = "MetaboLightsParam"),
           function(object, param, keepOntology = TRUE, keepProtocol = TRUE,
                    simplify = TRUE, ...) {
-              if (!requireNamespace("MsBackendMetaboLights", quietly = TRUE)) {
+              if (!.is_ms_backend_metabo_lights_installed())
                   stop("Required package 'MsBackendMetaboLights' is missing. ",
                        "Please install it and try again.", call. = FALSE)
-              }
+              if (!.is_spectra_installed())
+                  stop("Required package 'Spectra' is missing. ",
+                       "Please install and try again.", call. = FALSE)
               pth <- MsBackendMetaboLights::mtbls_ftp_path(param@mtblsId)
               all_fls <- MsBackendMetaboLights::mtbls_list_files(param@mtblsId)
 
               ## Extract and read assay files
               assays <- all_fls[grepl("^a_", all_fls)]
-              if (length(param@assayName) > 0)
+              if (length(param@assayName) > 0) {
                   selected_assay <- param@assayName
+                  if (!selected_assay %in% assays)
+                      stop("Specified assay \"", selected_assay, "\" does ",
+                           "not exist.", call. = FALSE)
+              }
               else {
                   if (length(assays) == 1) {
                       selected_assay <- assays
-                      message("Only one assay file found:", selected_assay, "\n")
+                      message("Only one assay file found:", selected_assay)
                   } else {
                       message("Multiple assay files found:\n")
                       selection <- menu(assays,
@@ -250,20 +256,21 @@ setMethod("readMsObject",
                                         header = TRUE, sep = "\t",
                                         check.names = FALSE)
 
-              # merging
+              ## merging
               ord <- match(assay_data$`Sample Name`, sample_info$`Sample Name`)
               merged_data <- cbind(assay_data, sample_info[ord, ])
               if (keepProtocol || keepOntology || simplify)
                   merged_data <- .clean_merged(x = merged_data,
                                                keepProtocol = keepProtocol,
                                                keepOntology = keepOntology,
                                                simplify = simplify)
-
               ## Assemble object
-              object@spectra <- Spectra::Spectra(mtblsId = param@mtblsId,
-                                                 source = MsBackendMetaboLights::MsBackendMetaboLights(),
-                                                 assayName = selected_assay,
-                                                 filePattern = param@filePattern)
+              b <- MsBackendMetaboLights::MsBackendMetaboLights()
+              object@spectra <- Spectra::Spectra(
+                                             mtblsId = param@mtblsId,
+                                             source = b,
+                                             assayName = selected_assay,
+                                             filePattern = param@filePattern)
 
               ## sample to spectra link
               fl <- object@spectra@backend@spectraData[1, "derived_spectral_data_file"]
@@ -306,4 +313,3 @@ setMethod("readMsObject",
     }
     return(x)
 }
-

R/Spectra.R

@@ -45,7 +45,7 @@ setMethod("readMsObject", signature(object = "Spectra",
               if (!existsMethod("readMsObject", c(variables[["backend"]],
                                                  "PlainTextParam")))
                   stop("Can not read a 'Spectra' object with backend '",
-                       variables["backend"], "'")
+                       variables["backend"], "'", call. = FALSE)
               tryCatch({
                   object@backend <- readMsObject(
                       do.call(variables[["backend"]], list()), param, ...)
@@ -148,7 +148,7 @@ validateAlabasterSpectra <- function(path = character(),
 
 readAlabasterSpectra <- function(path = character(), metadata = list(),
                                  ...) {
-    if (!requireNamespace("Spectra", quietly = TRUE))
+    if (!.is_spectra_installed())
         stop("Required package 'Spectra' missing. Please install ",
              "and try again.", call. = FALSE)
 
@@ -174,7 +174,7 @@ setMethod("saveMsObject", signature(object = "Spectra",
               if (file.exists(param@path))
                   stop("Overwriting or saving to an existing directory is not",
                        " supported. Please remove the directory defined with",
-                       " parameter `path` first.")
+                       " parameter `path` first.", call. = FALSE)
               saveObject(object, param@path)
           })
 

R/XcmsExperiment.R

@@ -137,7 +137,7 @@ setMethod("readMsObject",
 ################################################################################
 #' @rdname AlabasterParam
 setMethod("saveObject", "XcmsExperiment", function(x, path, ...) {
-    if (!requireNamespace("alabaster.matrix", quietly = TRUE))
+    if (!.is_alabaster_matrix_installed())
         stop("Required package 'alabaster.matrix' missing. Please install and ",
              "try again.", call. = FALSE)
     ## Save the MsExperiment part
@@ -163,11 +163,11 @@ validateAlabasterXcmsExperiment <- function(path = character(),
 }
 
 readAlabasterXcmsExperiment <- function(path = character(), metadata = list(),
-                                      ...) {
-    if (!requireNamespace("xcms", quietly = TRUE))
+                                        ...) {
+    if (!.is_xcms_installed())
         stop("Required package 'xcms' missing. Please install ",
              "and try again.", call. = FALSE)
-    if (!requireNamespace("MsExperiment", quietly = TRUE))
+    if (!.is_ms_experiment_installed())
         stop("Required package 'MsExperiment' missing. Please install ",
              "and try again.", call. = FALSE)
     validateAlabasterXcmsExperiment(path, metadata)
@@ -216,18 +216,21 @@ setMethod("saveMsObject",
                     param = "mzTabParam"),
           function(object, param){
               if (!param@sampleDataColumn %in% colnames(object@sampleData))
-                  stop("'sampleDataColumn' has to correspond to column names",
-                       "of the sampleData() table")
+                  stop("'sampleDataColumn' has to correspond to column names ",
+                       "of the sampleData() table", call. = FALSE)
               if (length(param@optionalFeatureColumns) != 0)
-                  if (!param@optionalFeatureColumns %in% colnames(object@featureDefinitions))
-                      stop("'optionalFeatureColumns' have to correspond to",
-                           "column names of the featureDefinitions() table")
+                  if (!param@optionalFeatureColumns %in%
+                      colnames(object@featureDefinitions))
+                      stop("'optionalFeatureColumns' have to correspond to ",
+                           "column names of the featureDefinitions() table",
+                           call. = FALSE)
 
               var_list <- unique(.mztab_study_variables(object@sampleData,
                                                         param@sampleDataColumn))
               fl <- file.path(param@path, paste0(param@studyId, ".mztab"))
               if (file.exists(fl))
-                  stop("File ", basename(fl), " already exists. ")
+                  stop("File \"", basename(fl), "\" already exists.",
+                       call. = FALSE)
               con <- file(fl, open = "at")
               on.exit(close(con))
 

R/utils.R

@@ -0,0 +1,23 @@
+.is_alabaster_matrix_installed <- function() {
+    requireNamespace("alabaster.matrix", quietly = TRUE)
+}
+
+.is_spectra_installed <- function() {
+    requireNamespace("Spectra", quietly = TRUE)
+}
+
+.is_alabaster_se_installed <- function() {
+    requireNamespace("alabaster.se", quietly = TRUE)
+}
+
+.is_ms_experiment_installed <- function() {
+    requireNamespace("MsExperiment", quietly = TRUE)
+}
+
+.is_ms_backend_metabo_lights_installed <- function() {
+    requireNamespace("MsBackendMetaboLights", quietly = TRUE)
+}
+
+.is_xcms_installed <- function() {
+    requireNamespace("xcms", quietly = TRUE)
+}

tests/testthat/test_MsBackendMzR.R

@@ -11,6 +11,10 @@ test_that("saveMsObject,readMsObject,PlainTextParam,MsBackendMzR works", {
     saveMsObject(b, param = param)
     expect_true(dir.exists(pth))
     expect_true(file.exists(file.path(param@path, "ms_backend_data.txt")))
+
+    ## Overwriting is not supported
+    expect_error(saveMsObject(b, param = param), "Overwriting or saving")
+
     ## Loading data again
     b_load <- readMsObject(object = MsBackendMzR(), param)
     expect_true(inherits(b_load, "MsBackendMzR"))
@@ -47,6 +51,14 @@ test_that("saveMsObject,readMsObject,PlainTextParam,MsBackendMzR works", {
     res <- readMsObject(MsBackendMzR(), param)
     expect_s4_class(res, "MsBackendMzR")
     expect_true(length(res) == 0)
+
+    ## Reading wrong backend.
+    pth <- tempdir()
+    writeLines("# MsBackendDataFrame\nSome other line\n",
+               file.path(pth, "ms_backend_data.txt"))
+    p <- PlainTextParam(path = pth)
+    expect_error(readMsObject(MsBackendMzR(), p), "Invalid class")
+    file.remove(file.path(pth, "ms_backend_data.txt"))
 })
 
 test_that("saveObject,readObject,MsBackendMzR works", {
@@ -69,6 +81,12 @@ test_that("saveObject,readObject,MsBackendMzR works", {
     expect_s4_class(res, "MsBackendMzR")
     expect_equal(length(b), length(res))
 
+    ## package Spectra not available:
+    with_mock(
+        "MsIO:::.is_spectra_installed" = function() FALSE,
+        expect_error(MsIO:::readAlabasterMsBackendMzR(pth), "package 'Spectra'")
+    )
+
     ## readObject
     res <- readObject(pth)
     expect_s4_class(res, "MsBackendMzR")
@@ -101,6 +119,8 @@ test_that("saveObject,readObject,MsBackendMzR works", {
 })
 
 test_that(".ms_backend_mzr_update_storage_path works", {
+    res <- .ms_backend_mzr_update_storage_path(numeric())
+    expect_equal(res, numeric())
     x <- sciex_mzr
     res <- .ms_backend_mzr_update_storage_path(x, "/new/path")
     expect_true(all(grepl("/new/path", res$dataStorage)))
@@ -122,4 +142,17 @@ test_that("saveMsObject,readMsObject,MsBackendMzR,AlabasterParam works", {
     expect_equal(res@spectraData, x@spectraData)
     expect_equal(spectraData(res), spectraData(x))
     expect_equal(res@peaksVariables, x@peaksVariables)
+
+    ## Unexpected errors.
+    x <- MsBackendMzR()
+    pth <- file.path(tempdir(), "remove")
+    slot(x, "spectraData", check = FALSE) <- AlabasterParam()
+    expect_error(saveObject(x, pth), "failed to save 'spectraData'")
+    unlink(pth, recursive = TRUE)
+
+    x <- MsBackendMzR()
+    pth <- file.path(tempdir(), "remove")
+    slot(x, "peaksVariables", check = FALSE) <- AlabasterParam()
+    expect_error(saveObject(x, pth), "failed to save 'peaksVariables'")
+    unlink(pth, recursive = TRUE)
 })