Skip to content

Commit

Permalink
Merge pull request #361 from lgatto/SpectrumList
Browse files Browse the repository at this point in the history
Add new class SpectrumList
  • Loading branch information
lgatto authored Oct 13, 2018
2 parents f3ef40c + 09a3fad commit 077bdf4
Show file tree
Hide file tree
Showing 9 changed files with 1,125 additions and 10 deletions.
94 changes: 93 additions & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
Expand Up @@ -63,6 +63,7 @@ Depends:
Biobase (>= 2.15.2),
mzR (>= 2.15.1),
BiocParallel,
S4Vectors,
ProtGenerics (>= 1.9.1)
Imports:
IRanges (>= 2.13.28),
Expand All @@ -79,7 +80,6 @@ Imports:
digest,
lattice,
ggplot2,
S4Vectors,
XML,
scales,
MASS,
Expand Down Expand Up @@ -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'
12 changes: 8 additions & 4 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -149,7 +150,8 @@ export(MSnSet,
combineSpectraMovingWindow,
estimateMzScattering,
hasSpectra, hasChromatograms,
mergeFeatureVars, expandFeatureVars
mergeFeatureVars, expandFeatureVars,
Spectra
)

exportClasses(pSet,
Expand All @@ -168,7 +170,9 @@ exportClasses(pSet,
OnDiskMSnExp,
ProcessingStep,
Chromatogram,
Chromatograms)
Chromatograms,
Spectra
)

exportMethods(updateObject,
exprs,
Expand Down
44 changes: 44 additions & 0 deletions R/DataClasses.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
})
88 changes: 88 additions & 0 deletions R/functions-Spectra.R
Original file line number Diff line number Diff line change
@@ -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
}
Loading

0 comments on commit 077bdf4

Please sign in to comment.