Merge pull request #24 from rformassspectrometry/phili

Addition of `ChromBackendMemory` class and functionalities

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Chromatograms
 Title: Infrastructure for Chromatographic Mass Spectrometry Data
-Version: 0.1.0
+Version: 0.2.0
 Description: The Chromatograms packages defines a efficient infrastructure
    for storing and handling of chromatographic mass spectrometry data. It
    provides different implementations of *backends* to store and represent the
@@ -20,7 +20,8 @@ Authors@R: c(person(given = "Laurent", family = "Gatto",
 		    role = c("aut", "cre"),
 		    comment = c(ORCID = "0009-0007-5429-6846")))
 Depends:
-    ProtGenerics (>= 1.35.4)
+    ProtGenerics (>= 1.35.4),
+    R (>= 4.2.0)
 Imports:
     methods,
     S4Vectors,
@@ -33,7 +34,6 @@ Suggests:
     BiocStyle
 License: Artistic-2.0
 Encoding: UTF-8
-LazyData: yes
 VignetteBuilder: knitr
 BugReports: https://github.com/RforMassSpectrometry/Chromatograms/issues
 URL: https://github.com/RforMassSpectrometry/Chromatograms
@@ -44,3 +44,7 @@ Collate:
     'AllGenerics.R'
     'ChromBackend-functions.R'
     'ChromBackend.R'
+    'ChromBackendMemory-functions.R'
+    'hidden_aliases.R'
+    'helpers.R'
+    'ChromBackendMemory.R'

NAMESPACE

@@ -1,11 +1,13 @@
 # Generated by roxygen2: do not edit by hand
 
+export(ChromBackendMemory)
 export(coreChromVariables)
 export(corePeaksVariables)
 export(fillCoreChromVariables)
 export(validChromData)
 export(validPeaksData)
 exportClasses(ChromBackend)
+exportClasses(ChromBackendMemory)
 exportMethods("$")
 exportMethods("$<-")
 exportMethods("[")
@@ -54,13 +56,17 @@ exportMethods(productMzMax)
 exportMethods(productMzMin)
 exportMethods(reset)
 exportMethods(rtime)
-exportMethods(selectChromVariables)
 exportMethods(split)
 importFrom(IRanges,NumericList)
+importFrom(MsCoreUtils,i2index)
+importFrom(MsCoreUtils,rbindFill)
+importFrom(MsCoreUtils,vapply1c)
 importFrom(methods,.valueClassTest)
 importFrom(methods,as)
 importFrom(methods,is)
+importFrom(methods,new)
 importFrom(methods,validObject)
+importFrom(utils,capture.output)
 importMethodsFrom(ProtGenerics,"collisionEnergy<-")
 importMethodsFrom(ProtGenerics,"dataOrigin<-")
 importMethodsFrom(ProtGenerics,"dataStorage<-")
@@ -86,5 +92,6 @@ importMethodsFrom(ProtGenerics,peaksVariables)
 importMethodsFrom(ProtGenerics,precursorMz)
 importMethodsFrom(ProtGenerics,productMz)
 importMethodsFrom(ProtGenerics,rtime)
+importMethodsFrom(S4Vectors,"[")
 importMethodsFrom(S4Vectors,isEmpty)
 importMethodsFrom(S4Vectors,split)

NEWS.md

@@ -0,0 +1,7 @@
+# Version 0.2.0
+
+## Changes in 0.2.0
+- Addition of ChomBackendMemory class and associated methods 
+
+## Changes in 0.1.0
+- Addition of basic ChromBackend class and default methods 

R/AllGenerics.R

@@ -9,11 +9,6 @@ setGeneric("chromIndex", function(object, ...) standardGeneric("chromIndex"))
 setGeneric("chromIndex<-", function(object, value)
     standardGeneric("chromIndex<-"))
 #' @rdname ChromBackend
-setGeneric("chromNames", function(object, ...) standardGeneric("chromNames"))
-#' @rdname ChromBackend
-setGeneric("chromNames<-", function(object, value)
-    standardGeneric("chromNames<-"))
-#' @rdname ChromBackend
 setGeneric("chromVariables", function(object, ...)
     standardGeneric("chromVariables"))
 #' @rdname ChromBackend
@@ -49,8 +44,5 @@ setGeneric("productMzMin", function(object, ...)
 setGeneric("productMzMin<-", function(object, value)
     standardGeneric("productMzMin<-"))
 #' @rdname ChromBackend
-setGeneric("selectChromVariables", function(object, ...)
-    standardGeneric("selectChromVariables"))
-#' @rdname ChromBackend
 setGeneric("reset", function(object, ...)
-    standardGeneric("reset"))
+    standardGeneric("reset")) ## needs to be moved to ProtGenerics

R/ChromBackend-functions.R

@@ -55,6 +55,8 @@ coreChromVariables <- function() .CORE_CHROM_VARIABLES
 #' ## The data.frame thus contains columns for all core chromatogram
 #' ## variables in the respective expected data type (but filled with
 #' ## missing values).
+#'
+#' @rdname hidden_aliases
 fillCoreChromVariables <- function(x = data.frame()) {
     nr <- nrow(x)
     cv <- .CORE_CHROM_VARIABLES
@@ -87,13 +89,14 @@ fillCoreChromVariables <- function(x = data.frame()) {
 #' @importFrom methods is
 #'
 #' @export
+#' @rdname hidden_aliases
 validChromData <- function(x = data.frame(), error = TRUE) {
-    .valid_chrom_backend_data_storage(x$dataStorage)
+    msg <- .valid_chrom_backend_data_storage(x$dataStorage)
     cn <- intersect(colnames(x), names(.CORE_CHROM_VARIABLES))
     msg <- unlist(lapply(cn, function(z) {
         if (!is(x[, z], .CORE_CHROM_VARIABLES[z]))
             paste0("Column \"", z, "\" has the wrong data type. ")
-        else character()
+        else NULL
     }), use.names = FALSE)
     if (length(msg) && error)
         stop(msg)
@@ -105,10 +108,15 @@ validChromData <- function(x = data.frame(), error = TRUE) {
 #'
 #' @noRd
 .CORE_PEAKS_VARIABLES <- c(
-    intensity = "numeric",
-    rtime = "numeric"
+    rtime = "numeric",
+    intensity = "numeric"
 )
 
+#' an empty peaks data.frame
+#' @noRd
+.EMPTY_PEAKS_DATA <- as.data.frame(lapply(.CORE_PEAKS_VARIABLES,
+                                          function(x) vector(x, 0)))
+
 #' @rdname ChromBackend
 #'
 #' @export
@@ -124,24 +132,21 @@ corePeaksVariables <- function() .CORE_PEAKS_VARIABLES
 #' @export
 
 #' @rdname hidden_aliases
-validPeaksData <- function(x = list()) {
-    if (!is.list(x)) {
-        stop("'peaksData' must be a 'list'")
-    }
-    lapply(x, function(df) {
-        if (!is.data.frame(df))
-            stop("All the peaksData entries should be of class 'data.frame'")
-        pv <- intersect(colnames(df), names(.CORE_PEAKS_VARIABLES))
-        if (!all(vapply(pv, function(col) is(df[[col]]
-                                             , .CORE_PEAKS_VARIABLES[[col]]),
-                        logical(1))))
-            stop("The peaksData variable ", col, " has the wrong data type.")
-    })
+validPeaksData <- function(x = list(), error = TRUE) {
+    if (!is.list(x)) stop("'peaksData' must be a 'list'")
+    if (!length(x)) return(NULL)
+    first_cols <- colnames(x[[1]])
+    expected_cols <- names(.CORE_PEAKS_VARIABLES)
+    expected_types <- .CORE_PEAKS_VARIABLES
+    msgs <- unlist(lapply(seq_along(x), function(i) {
+        df <- x[[i]]
+        # Check if the column names match those in the first data.frame
+        if (!identical(colnames(df), first_cols))
+            return(paste("All data.frames must have the same columns in the",
+                         " same order. Issue found in entry", i))
+        # Check column types and any other validation with .validate_entry
+        .validate_entry(x[[i]], i, expected_cols, expected_types)
+    }))
+    if (length(msgs) && error) stop(msgs)
+    else msgs
 }
-
-#' @noRd
-.valid_chrom_backend_data_storage <- function(x) {
-    if (anyNA(x))
-        return("'NA' values in dataStorage are not allowed.")
-    NULL
-}  ## what's this ?