Add new class SpectrumList

DESCRIPTION

@@ -63,6 +63,7 @@ Depends:
     Biobase (>= 2.15.2),
     mzR (>= 2.15.1),
     BiocParallel,
+    S4Vectors,
     ProtGenerics (>= 1.9.1)
 Imports:
     IRanges (>= 2.13.28),
@@ -79,7 +80,6 @@ Imports:
     digest,
     lattice,
     ggplot2,
-    S4Vectors,
     XML,
     scales,
     MASS,
@@ -117,3 +117,95 @@ URL: https://github.com/lgatto/MSnbase
 biocViews: Infrastructure, Proteomics, MassSpectrometry,
     QualityControl, DataImport
 RoxygenNote: 6.1.0
+Collate: 
+    'AllClassUnions.R'
+    'AllGenerics.R'
+    'DataClasses.R'
+    'MzTab.R'
+    'NTR.R'
+    'RcppExports.R'
+    'TMT10.R'
+    'TMT11.R'
+    'TMT6.R'
+    'TMT7.R'
+    'averageMSnSet.R'
+    'cache.R'
+    'coerce.R'
+    'combineFeatures.R'
+    'compfnames.R'
+    'environment.R'
+    'fData-utils.R'
+    'fdata-selection.R'
+    'foi.R'
+    'functions-Chromatogram.R'
+    'functions-Chromatograms.R'
+    'functions-MIAPE.R'
+    'functions-MSnExp.R'
+    'functions-MSnProcess.R'
+    'functions-MSnSet.R'
+    'functions-OnDiskMSnExp.R'
+    'functions-ReporterIons.R'
+    'functions-Spectra.R'
+    'functions-Spectrum.R'
+    'functions-Spectrum1.R'
+    'functions-Spectrum2.R'
+    'functions-addIdentificationData.R'
+    'functions-fragments.R'
+    'functions-mzR.R'
+    'functions-plotting.R'
+    'header.R'
+    'hmap.R'
+    'iPQF.R'
+    'iTRAQ4.R'
+    'iTRAQ5.R'
+    'iTRAQ8.R'
+    'iTRAQ9.R'
+    'imputation.R'
+    'map.R'
+    'matching.R'
+    'methods-Chromatogram.R'
+    'methods-Chromatograms.R'
+    'methods-MIAPE.R'
+    'methods-MSnExp.R'
+    'methods-MSnProcess.R'
+    'methods-MSnSet.R'
+    'methods-MSnSetList.R'
+    'methods-NAnnotatedDataFrame.R'
+    'methods-OnDiskMSnExp.R'
+    'methods-ProcessingStep.R'
+    'methods-ReporterIons.R'
+    'methods-Spectra.R'
+    'methods-Spectrum.R'
+    'methods-Spectrum1.R'
+    'methods-Spectrum2.R'
+    'methods-all.equal.R'
+    'methods-filters.R'
+    'methods-fragments.R'
+    'methods-mzR.R'
+    'methods-other.R'
+    'methods-pSet.R'
+    'methods-updateObjectTo.R'
+    'methods-write.R'
+    'missing-data.R'
+    'nadata.R'
+    'nav.R'
+    'options.R'
+    'plotting-MSnExp.R'
+    'plotting-MSnSet.R'
+    'plotting-OnDiskMSnExp.R'
+    'plotting-Spectrum.R'
+    'plotting-Spectrum1.R'
+    'plotting-Spectrum2.R'
+    'plotting-dataframe.R'
+    'quantitation-MS2-isobaric.R'
+    'quantitation-MS2-labelfree.R'
+    'readChromData.R'
+    'readMSData.R'
+    'readMSData2.R'
+    'readMSnSet.R'
+    'readMzXMLData.R'
+    'readWriteMgfData.R'
+    'readWriteMzTab.R'
+    'utils.R'
+    'writeMSData.R'
+    'zzz.R'

NAMESPACE

@@ -33,8 +33,9 @@ importFrom(ggplot2, geom_histogram, geom_text, geom_line, geom_point,
            facet_grid)
 
 importFrom(MALDIquant, binPeaks, match.closest) ## only using ::: functions
-importFrom(S4Vectors, isEmpty, metadata, DataFrame)
-importFrom(S4Vectors, isEmpty, metadata, DataFrame, replaceROWS)
+importFrom(S4Vectors, isEmpty, metadata, DataFrame, replaceROWS, SimpleList)
+importMethodsFrom(S4Vectors, showAsCell, "mcols<-", mcols, split)
+importClassesFrom(S4Vectors, SimpleList)
 importFrom(MASS, rlm)
 
 ## importFrom(rols, olsQuery, term)
@@ -149,7 +150,8 @@ export(MSnSet,
        combineSpectraMovingWindow,
        estimateMzScattering,
        hasSpectra, hasChromatograms,
-       mergeFeatureVars, expandFeatureVars
+       mergeFeatureVars, expandFeatureVars,
+       Spectra
        )
 
 exportClasses(pSet,
@@ -168,7 +170,9 @@ exportClasses(pSet,
               OnDiskMSnExp,
               ProcessingStep,
               Chromatogram,
-              Chromatograms)
+              Chromatograms,
+	      Spectra
+	      )
 
 exportMethods(updateObject,
               exprs,

R/DataClasses.R

@@ -673,3 +673,47 @@ setClass("Chromatograms",
          validity = function(object)
              .validChromatograms(object)
          )
+
+#' @name Spectra
+#'
+#' @aliases Spectra-class show,Spectra-method
+#'
+#' @title List of Spectrum objects along with annotations
+#'
+#' @description
+#'
+#' `Spectra` objects allow to collect one or more [Spectrum-class] object(s)
+#' ([Spectrum1-class] or [Spectrum2-class]) in a `list`-like structure with
+#' the possibility to add arbitrary annotations to each individual
+#' `Spectrum` object. These can be accessed/set with the [mcols()] method.
+#'
+#' Functions to access the individual spectra's attributes are available
+#' (listed below).
+#'
+#' @details
+#'
+#' `Spectra` inherits all methods from the [SimpleList] class of the
+#' `S4Vectors` package. This includes `lapply` and other data manipulation
+#' and subsetting operations.
+#'
+#' @param object For all functions: a `Spectra` object.
+#'
+#' @param x For all functions: a `Spectra` object.
+#' 
+#' @md
+#'
+#' @rdname Spectra
+NULL
+
+.Spectra <- setClass("Spectra",
+                     contains = "SimpleList",
+                     prototype = prototype(elementType = "Spectrum")
+                     )
+
+setValidity("Spectra", function(object) {
+    ## All elements in the list have to be Spectrum objects.
+    msg <- character()
+    if (any(vapply(object, function(z) !is(z, "Spectrum"), logical(1))))
+        msg <- c(msg, "All elements have to be Spectrum objects")
+    if (length(msg)) msg else TRUE
+})

R/functions-Spectra.R

@@ -0,0 +1,88 @@
+#' @rdname Spectra
+#'
+#' @section Constructor:
+#'
+#' New [Spectra] can be created with the `Spectra(...)` function
+#' where `...` can either be a single [Spectrum-class] object or a `list` of
+#' `Spectrum` objects ([Spectrum1-class] and/or [Spectrum2-class]).
+#'
+#' @param ... For `Spectra`: [Spectrum-class] object(s) or a `list` of
+#'     [Spectrum-class] objects.
+#'
+#' @param elementMetadata For `Spectra`: [DataFrame] with optional information
+#'     that should be added as metadata information (`mcols`) to the object.
+#'     The number of rows has to match the number of [Spectrum-class] objects,
+#'     each row is expected to represent additional metadata information for
+#'     one spectrum.
+#'
+#' @author Johannes Rainer
+#'
+#' @md
+#'
+#' @examples
+#' 
+#' ## Create from Spectrum objects
+#' sp1 <- new("Spectrum1", mz = c(1, 2, 4), intensity = c(4, 5, 2))
+#' sp2 <- new("Spectrum2", mz = c(1, 2, 3, 4), intensity = c(5, 3, 2, 5),
+#'     precursorMz = 2)
+#'
+#' spl <- Spectra(sp1, sp2)
+#' spl
+#' spl[[1]]
+#'
+#' ## Add also metadata columns
+#' mcols(spl)$id <- c("a", "b")
+#' mcols(spl)
+#'
+#' ## Create a Spectra with metadata
+#' spl <- Spectra(sp1, sp2, elementMetadata = DataFrame(id = c("a", "b")))
+#'
+#' mcols(spl)
+#' mcols(spl)$id
+Spectra <- function(..., elementMetadata = NULL) {
+    args <- list(...)
+    if (length(args) == 1L && is.list(args[[1L]]))
+        args <- args[[1L]]
+    new("Spectra", listData = args, elementMetadata = elementMetadata)
+}
+
+.show_Spectra <- function(x, margin = "", print.classinfo = FALSE) {
+    cat("Spectra with", length(x), "spectra and", length(mcols(x)),
+        "metadata column(s):\n")
+    if (length(x)) {
+        out <- S4Vectors:::makePrettyMatrixForCompactPrinting(
+                               x, .make_naked_matrix_from_Spectra)
+        if (print.classinfo) {
+            .COL2CLASS <- c(msLevel = "integer", rtime = "numeric",
+                            peaksCount = "integer")
+            classinfo <- S4Vectors:::makeClassinfoRowForCompactPrinting(
+                                         x, .COL2CLASS)
+            out <- rbind(classinfo, out)
+        }
+        if (nrow(out))
+            rownames(out) <- paste0(margin, rownames(out))
+        print(out, quote = FALSE, right = TRUE, max = length(out))
+    }
+}
+
+.short_spectrum_info <- function(x) {
+    c(msLevel = x@msLevel, rtime = ifelse(length(x@rt), x@rt, NA_real_),
+      peaksCount = peaksCount(x))
+}
+
+.make_naked_matrix_from_Spectra <- function(x) {
+    x_len <- length(x)
+    mcls <- mcols(x, use.names = FALSE)
+    x_mcls_len <- if (is.null(mcls)) 0L else ncol(mcls)
+    res <- do.call(rbind, lapply(x, .short_spectrum_info))
+    res <- apply(res, 2, format, digits = 6)
+    if (!is.matrix(res))
+        res <- t(as.matrix(res))
+    res <- res[, c("msLevel", "rtime", "peaksCount"), drop = FALSE]
+    if (x_mcls_len > 0) {
+        tmp <- do.call(data.frame, c(lapply(mcls, showAsCell),
+                                     list(check.names = FALSE)))
+        res <- cbind(res, `|` = rep.int("|", x_len), as.matrix(tmp))
+    }
+    res
+}