Add GCIMSDataset methods for getChromatogram()/getSpectrum()

NAMESPACE

@@ -14,10 +14,12 @@ export("peaks<-")
 export("sampleNames<-")
 export(DelayedOperation)
 export(GCIMSChromatogram)
+export(GCIMSChromatogramSet)
 export(GCIMSDataset)
 export(GCIMSDataset_fromList)
 export(GCIMSSample)
 export(GCIMSSpectrum)
+export(GCIMSSpectrumSet)
 export(add_peaklist_rect)
 export(align)
 export(alignDt)
@@ -64,13 +66,17 @@ export(smooth)
 export(updateObject)
 exportClasses(DelayedOperation)
 exportClasses(GCIMSChromatogram)
+exportClasses(GCIMSChromatogramSet)
 exportClasses(GCIMSDataset)
 exportClasses(GCIMSSample)
 exportClasses(GCIMSSpectrum)
+exportClasses(GCIMSSpectrumSet)
+exportMethods("[[")
 exportMethods("baseline<-")
 exportMethods("description<-")
 exportMethods("intensity<-")
 exportMethods("peaks<-")
+exportMethods("sampleNames<-")
 exportMethods(align)
 exportMethods(baseline)
 exportMethods(decimate)
@@ -80,16 +86,21 @@ exportMethods(estimateBaseline)
 exportMethods(filterDt)
 exportMethods(filterRt)
 exportMethods(findPeaks)
+exportMethods(getChromatogram)
 exportMethods(getRIC)
+exportMethods(getSpectrum)
 exportMethods(getTIS)
 exportMethods(integratePeaks)
 exportMethods(intensity)
+exportMethods(length)
+exportMethods(pData)
 exportMethods(peaks)
 exportMethods(plot)
 exportMethods(plotRIC)
 exportMethods(plotTIS)
 exportMethods(prealign)
 exportMethods(rtime)
+exportMethods(sampleNames)
 exportMethods(smooth)
 exportMethods(updateObject)
 import(methods)

NEWS.md

@@ -1,5 +1,12 @@
 # GCIMS (development version)
 
+- `getChromatogram()` and `getSpectrum()` are now S4 generics with methods
+  for `GCIMSDataset`, in addition to the existing `GCIMSSample` method.
+  Calling them on a dataset returns a new `GCIMSChromatogramSet`/
+  `GCIMSSpectrumSet` object: one chromatogram/spectrum per sample (each kept
+  on its own native axis, no interpolation across samples), together with a
+  copy of `pData()`. Both new classes have a `plot()` method that can color
+  by `SampleID` or by any `pData()` column via `color_by`.
 - `GCIMSSample()` now validates the object right after construction, so
   passing an intensity matrix in the wrong orientation (drift time/retention
   time swapped) errors immediately with a clear message instead of

R/aaa-AllGenerics.R

@@ -45,6 +45,24 @@ NULL
 #'
 setGeneric("dtime", function(object, ...) standardGeneric("dtime"))
 
+#' @describeIn GCIMS-generics Get a chromatogram
+#'
+#' @return A [GCIMSChromatogram] (one sample) or a [GCIMSChromatogramSet]
+#' (several samples, one chromatogram each, with a copy of `pData()`)
+#' @param object An object to extract a chromatogram from
+#' @param ... Further arguments, possibly used by downstream methods.
+#' @export
+setGeneric("getChromatogram", function(object, ...) standardGeneric("getChromatogram"))
+
+#' @describeIn GCIMS-generics Get a spectrum
+#'
+#' @return A [GCIMSSpectrum] (one sample) or a [GCIMSSpectrumSet]
+#' (several samples, one spectrum each, with a copy of `pData()`)
+#' @param object An object to extract a spectrum from
+#' @param ... Further arguments, possibly used by downstream methods.
+#' @export
+setGeneric("getSpectrum", function(object, ...) standardGeneric("getSpectrum"))
+
 #' @describeIn GCIMS-generics Get the Total Ion Spectrum
 #'
 #' @return The Total Ion Spectrum as a numeric vector or a matrix

R/aaa-class-GCIMSChromatogramSet.R

@@ -0,0 +1,128 @@
+#' GCIMSChromatogramSet class
+#'
+#' @description
+#' GCIMSChromatogramSet is an S4 class to store one [GCIMSChromatogram] per
+#' sample of a [GCIMSDataset], together with a copy of `pData()` so plots can
+#' use the dataset's annotations.
+#'
+#' Samples are not required to share a common retention time axis: each
+#' chromatogram keeps its own, exactly as extracted from its sample. No
+#' interpolation is performed.
+#'
+#' @slot chromatograms A named list of [GCIMSChromatogram] objects, one per
+#' sample, named after their `SampleID`.
+#' @slot pData A `DataFrame` with the phenotype data, or `NULL`.
+#'
+#' @export
+#' @family GCIMSChromatogram
+methods::setClass(
+  Class = "GCIMSChromatogramSet",
+  slots = c(
+    chromatograms = "list",
+    pData = "DataFrameOrNULL"
+  )
+)
+
+methods::setMethod(
+  "initialize", "GCIMSChromatogramSet",
+  function(.Object, chromatograms = list(), pData = NULL) {
+    if (!rlang::is_named(chromatograms) && length(chromatograms) > 0) {
+      cli_abort("chromatograms should be a named list, with the SampleID of each chromatogram as its name")
+    }
+    if (!all(purrr::map_lgl(chromatograms, inherits, "GCIMSChromatogram"))) {
+      cli_abort("All elements of chromatograms should be GCIMSChromatogram objects")
+    }
+    if (!is.null(pData)) {
+      if (!"SampleID" %in% colnames(pData)) {
+        cli_abort("pData should have a SampleID column")
+      }
+      if (!setequal(as.character(pData[["SampleID"]]), names(chromatograms))) {
+        cli_abort(
+          c(
+            "pData$SampleID does not match the names of chromatograms",
+            "i" = "Both should refer to exactly the same set of samples"
+          )
+        )
+      }
+      # Guarantee pData's row order matches the chromatograms order, so the
+      # two never need to be reconciled again afterwards (e.g. in plot()):
+      pData <- pData[match(names(chromatograms), as.character(pData[["SampleID"]])), , drop = FALSE]
+    }
+    .Object@chromatograms <- chromatograms
+    .Object@pData <- pData
+    .Object
+  }
+)
+
+#' Create a [GCIMSChromatogramSet-class] object
+#'
+#' @param chromatograms A named list of [GCIMSChromatogram] objects, one per
+#' sample, named after their `SampleID`.
+#' @param pData A `data.frame`/`DataFrame`/tibble with the phenotype data, or `NULL`.
+#' @return A [GCIMSChromatogramSet-class] object
+#' @export
+#' @family GCIMSChromatogram
+GCIMSChromatogramSet <- function(chromatograms = list(), pData = NULL) {
+  if (!is.null(pData) && !inherits(pData, "DataFrame")) {
+    pData <- S4Vectors::DataFrame(pData)
+  }
+  methods::new("GCIMSChromatogramSet", chromatograms = chromatograms, pData = pData)
+}
+
+#' @describeIn GCIMSChromatogramSet-class Get the sample names
+#' @param object A [GCIMSChromatogramSet] object
+#' @return A character vector with the sample names
+#' @export
+setMethod("sampleNames", "GCIMSChromatogramSet", function(object) {
+  nms <- names(object@chromatograms)
+  if (is.null(nms)) character(0) else nms
+})
+
+#' @describeIn GCIMSChromatogramSet-class Set the sample names
+#' @param object A [GCIMSChromatogramSet] object
+#' @param value A character vector of length the number of chromatograms with the new sample names
+#' @return The [GCIMSChromatogramSet] object, with samples renamed in both
+#' `chromatograms` and `pData()`
+#' @export
+setReplaceMethod("sampleNames", "GCIMSChromatogramSet", function(object, value) {
+  if (length(value) != length(object@chromatograms)) {
+    cli_abort(
+      c(
+        "Invalid sample names",
+        "x" = "The number of sample names given ({length(value)}) != Number of samples ({length(object@chromatograms)})"
+      )
+    )
+  }
+  if (anyNA(value) || anyDuplicated(value)) {
+    cli_abort("Sample names must be unique and not missing")
+  }
+  names(object@chromatograms) <- value
+  if (!is.null(object@pData)) {
+    object@pData[["SampleID"]] <- value
+  }
+  object
+})
+
+#' @describeIn GCIMSChromatogramSet-class Get the phenotype data
+#' @param object A [GCIMSChromatogramSet] object
+#' @return A tibble with the phenotype data, or `NULL` if not set
+#' @export
+setMethod("pData", "GCIMSChromatogramSet", function(object) {
+  if (is.null(object@pData)) {
+    return(NULL)
+  }
+  tibble::as_tibble(object@pData)
+})
+
+#' @describeIn GCIMSChromatogramSet-class Number of chromatograms (samples) in the set
+#' @param x A [GCIMSChromatogramSet] object
+#' @return An integer with the number of chromatograms
+#' @export
+setMethod("length", "GCIMSChromatogramSet", function(x) length(x@chromatograms))
+
+#' @describeIn GCIMSChromatogramSet-class Extract the chromatogram of a single sample
+#' @param x A [GCIMSChromatogramSet] object
+#' @param i A number or a string with the sample index or name
+#' @return The [GCIMSChromatogram] of the requested sample
+#' @export
+setMethod("[[", "GCIMSChromatogramSet", function(x, i) x@chromatograms[[i]])

R/aaa-class-GCIMSSample.R

@@ -307,7 +307,7 @@ subset.GCIMSSample <- function(
 #' getChromatogram(x)
 #' # Take the maximum intensity in the region for each retention time:
 #' sp1 <- getChromatogram(x, aggregate = function(x) apply(x, 2, max))
-getChromatogram <- function(object, dt_range = NULL, rt_range = NULL, dt_idx = NULL, rt_idx = NULL, aggregate = colSums) {
+setMethod("getChromatogram", "GCIMSSample", function(object, dt_range = NULL, rt_range = NULL, dt_idx = NULL, rt_idx = NULL, aggregate = colSums) {
   dt <- dtime(object)
   rt <- rtime(object)
   idx <- dt_rt_range_normalization(dt, rt, dt_range, rt_range, dt_idx, rt_idx)
@@ -328,7 +328,7 @@ getChromatogram <- function(object, dt_range = NULL, rt_range = NULL, dt_idx = N
     description = object@description,
     baseline = basel
   )
-}
+})
 
 #' Get IMS spectrum from a sample
 #'
@@ -348,7 +348,7 @@ getChromatogram <- function(object, dt_range = NULL, rt_range = NULL, dt_idx = N
 #'
 #' # Take the maximum intensity in the region for each drift time:
 #' sp1 <- getSpectrum(x, aggregate = function(x) apply(x, 1, max))
-getSpectrum <- function(object, dt_range = NULL, rt_range = NULL, dt_idx = NULL, rt_idx = NULL, aggregate = rowSums) {
+setMethod("getSpectrum", "GCIMSSample", function(object, dt_range = NULL, rt_range = NULL, dt_idx = NULL, rt_idx = NULL, aggregate = rowSums) {
   dt <- dtime(object)
   rt <- rtime(object)
   idx <- dt_rt_range_normalization(dt, rt, dt_range, rt_range, dt_idx, rt_idx)
@@ -369,5 +369,5 @@ getSpectrum <- function(object, dt_range = NULL, rt_range = NULL, dt_idx = NULL,
     description = object@description,
     baseline = basel
   )
-}
+})
 

R/aaa-class-GCIMSSpectrumSet.R

@@ -0,0 +1,128 @@
+#' GCIMSSpectrumSet class
+#'
+#' @description
+#' GCIMSSpectrumSet is an S4 class to store one [GCIMSSpectrum] per sample of
+#' a [GCIMSDataset], together with a copy of `pData()` so plots can use the
+#' dataset's annotations.
+#'
+#' Samples are not required to share a common drift time axis: each spectrum
+#' keeps its own, exactly as extracted from its sample. No interpolation is
+#' performed.
+#'
+#' @slot spectra A named list of [GCIMSSpectrum] objects, one per sample,
+#' named after their `SampleID`.
+#' @slot pData A `DataFrame` with the phenotype data, or `NULL`.
+#'
+#' @export
+#' @family GCIMSSpectrum
+methods::setClass(
+  Class = "GCIMSSpectrumSet",
+  slots = c(
+    spectra = "list",
+    pData = "DataFrameOrNULL"
+  )
+)
+
+methods::setMethod(
+  "initialize", "GCIMSSpectrumSet",
+  function(.Object, spectra = list(), pData = NULL) {
+    if (!rlang::is_named(spectra) && length(spectra) > 0) {
+      cli_abort("spectra should be a named list, with the SampleID of each spectrum as its name")
+    }
+    if (!all(purrr::map_lgl(spectra, inherits, "GCIMSSpectrum"))) {
+      cli_abort("All elements of spectra should be GCIMSSpectrum objects")
+    }
+    if (!is.null(pData)) {
+      if (!"SampleID" %in% colnames(pData)) {
+        cli_abort("pData should have a SampleID column")
+      }
+      if (!setequal(as.character(pData[["SampleID"]]), names(spectra))) {
+        cli_abort(
+          c(
+            "pData$SampleID does not match the names of spectra",
+            "i" = "Both should refer to exactly the same set of samples"
+          )
+        )
+      }
+      # Guarantee pData's row order matches the spectra order, so the two
+      # never need to be reconciled again afterwards (e.g. in plot()):
+      pData <- pData[match(names(spectra), as.character(pData[["SampleID"]])), , drop = FALSE]
+    }
+    .Object@spectra <- spectra
+    .Object@pData <- pData
+    .Object
+  }
+)
+
+#' Create a [GCIMSSpectrumSet-class] object
+#'
+#' @param spectra A named list of [GCIMSSpectrum] objects, one per sample,
+#' named after their `SampleID`.
+#' @param pData A `data.frame`/`DataFrame`/tibble with the phenotype data, or `NULL`.
+#' @return A [GCIMSSpectrumSet-class] object
+#' @export
+#' @family GCIMSSpectrum
+GCIMSSpectrumSet <- function(spectra = list(), pData = NULL) {
+  if (!is.null(pData) && !inherits(pData, "DataFrame")) {
+    pData <- S4Vectors::DataFrame(pData)
+  }
+  methods::new("GCIMSSpectrumSet", spectra = spectra, pData = pData)
+}
+
+#' @describeIn GCIMSSpectrumSet-class Get the sample names
+#' @param object A [GCIMSSpectrumSet] object
+#' @return A character vector with the sample names
+#' @export
+setMethod("sampleNames", "GCIMSSpectrumSet", function(object) {
+  nms <- names(object@spectra)
+  if (is.null(nms)) character(0) else nms
+})
+
+#' @describeIn GCIMSSpectrumSet-class Set the sample names
+#' @param object A [GCIMSSpectrumSet] object
+#' @param value A character vector of length the number of spectra with the new sample names
+#' @return The [GCIMSSpectrumSet] object, with samples renamed in both
+#' `spectra` and `pData()`
+#' @export
+setReplaceMethod("sampleNames", "GCIMSSpectrumSet", function(object, value) {
+  if (length(value) != length(object@spectra)) {
+    cli_abort(
+      c(
+        "Invalid sample names",
+        "x" = "The number of sample names given ({length(value)}) != Number of samples ({length(object@spectra)})"
+      )
+    )
+  }
+  if (anyNA(value) || anyDuplicated(value)) {
+    cli_abort("Sample names must be unique and not missing")
+  }
+  names(object@spectra) <- value
+  if (!is.null(object@pData)) {
+    object@pData[["SampleID"]] <- value
+  }
+  object
+})
+
+#' @describeIn GCIMSSpectrumSet-class Get the phenotype data
+#' @param object A [GCIMSSpectrumSet] object
+#' @return A tibble with the phenotype data, or `NULL` if not set
+#' @export
+setMethod("pData", "GCIMSSpectrumSet", function(object) {
+  if (is.null(object@pData)) {
+    return(NULL)
+  }
+  tibble::as_tibble(object@pData)
+})
+
+#' @describeIn GCIMSSpectrumSet-class Number of spectra (samples) in the set
+#' @param x A [GCIMSSpectrumSet] object
+#' @return An integer with the number of spectra
+#' @export
+setMethod("length", "GCIMSSpectrumSet", function(x) length(x@spectra))
+
+#' @describeIn GCIMSSpectrumSet-class Extract the spectrum of a single sample
+#' @param x A [GCIMSSpectrumSet] object
+#' @param i A number or a string with the sample index or name
+#' @return The [GCIMSSpectrum] of the requested sample
+#' @export
+setMethod("[[", "GCIMSSpectrumSet", function(x, i) x@spectra[[i]])