Add .processHistory slot to xcmsSet

o Add .processHistory slot, ProcessHistory class and functionality to
  track processing steps.
o Add unit tests for subsetting, splitting and concatenating of xcmsSet
  objects checking that .processHistory slot is processed correctly.
o Add showError method for xcmsSet objects that lists eventual errors
  during the feature detection step.
o This addresses discussions in issue #55.

DESCRIPTION

@@ -58,6 +58,7 @@ Collate:
     'fastMatch.R'
     'functions-utils.R'
     'functions-IO.R'
+    'functions-ProcessHistory.R'
     'functions-xcmsEIC.R'
     'functions-xcmsFragments.R'
     'functions-xcmsRaw.R'

NAMESPACE

@@ -175,3 +175,8 @@ export(
     "imputeLinInterpol",
     "useOriginalCode"
 )
+
+## New methods
+exportMethods(
+    "showError"
+)

R/AllGenerics.R

@@ -126,6 +126,7 @@ setGeneric("sampnames", function(object) standardGeneric("sampnames"))
 setGeneric("sampnames<-", function(object, value) standardGeneric("sampnames<-"))
 setGeneric("scanrange", function(object, ...) standardGeneric("scanrange"))
 setGeneric("scanrange<-", function(object, value) standardGeneric("scanrange<-"))
+setGeneric("showError", function(object, ...) standardGeneric("showError"))
 setGeneric("sortMz", function(object, ...) standardGeneric("sortMz"))
 setGeneric("specDist", function(object, ...) standardGeneric("specDist"))
 setGeneric("specDist.meanMZmatch",

R/DataClasses.R

@@ -1,6 +1,12 @@
 ## All class definitions should go in here.
 #' @include AllGenerics.R
 
+############################################################
+## Class unions
+setClassUnion("characterOrNULL", c("character", "NULL"))
+##setClassUnion("ANYorNULL", c("ANY", "NULL"))
+
+
 ############################################################
 ## xcmsSet
 ##
@@ -18,7 +24,8 @@ setClass("xcmsSet",
                                          progressInfo = "list",
                                          progressCallback="function",
                                          mslevel = "numeric",
-                                         scanrange = "numeric"),
+                                         scanrange = "numeric",
+                                         .processHistory = "list"),
          prototype = prototype(peaks = matrix(nrow = 0, ncol = 0),
                                groups = matrix(nrow = 0, ncol = 0),
                                groupidx = list(),
@@ -32,7 +39,8 @@ setClass("xcmsSet",
                                progressInfo = list(),
                                mslevel = numeric(0),
                                scanrange= numeric(0),
-                               progressCallback = function(progress) NULL),
+                               progressCallback = function(progress) NULL,
+                               .processHistory = list()),
          validity = function(object) {
              msg <- validMsg(NULL, NULL)
              ## Check if all slots are present.
@@ -47,6 +55,15 @@ setClass("xcmsSet",
                                              paste(missingSlots, collapse = ","),
                                              ". Please update the object using",
                                              " the 'updateObject' method."))
+             ## Check the .processHistory slot.
+             if (!any(missingSlots == ".processHistory")) {
+                 inh <- unlist(lapply(object@.processHistory,
+                                      FUN = function(z) {
+                                          return(inherits(z, "ProcessHistory"))
+                                      }))
+                 if (!all(inh))
+                     msg <- validMsg(msg, "Slot '.processHistory' should only contain 'ProcessHistory' objects!")
+             }
              if (!is.null(msg))
                  return(msg)
              return(TRUE)
@@ -172,3 +189,43 @@ setClass("rampSource",
 ## xcmsPeaks
 setClass("xcmsPeaks", contains = "matrix")
 
+############################################################
+## Processing history type statics
+.PROCSTEP.UNKNOWN <- "Unknown"
+.PROCSTEP.FEATURE.DETECTION <- "Feature detection"
+.PROCSTEPS <- c(
+    .PROCSTEP.UNKNOWN,
+    .PROCSTEP.FEATURE.DETECTION
+)
+
+############################################################
+## ProcessHistory
+setClass("ProcessHistory",
+         slots = c(
+             type = "character",
+             date = "character",
+             info = "character",
+             fileIndex = "integer",
+             error = "ANY"
+         ),
+         contains = "Versioned",
+         prototype = prototype(
+             type = .PROCSTEP.UNKNOWN,
+             date = character(),
+             info = character(),
+             fileIndex = integer(),  ## This can be of length 1 or > 1.
+             error = NULL,
+             new("Versioned", versions = c(ProcessHistory = "0.0.2"))
+         ),
+         validity = function(object) {
+             msg <- validMsg(NULL, NULL)
+             ## check type:
+             if (!any(object@type == .PROCSTEPS))
+                 msg <- validMsg(msg, paste0("Got invalid type '", object@type,
+                                             "'! Allowd are: ",
+                                             paste0("\"", .PROCSTEPS, "\"",
+                                                    collapse = ", ")))
+             if (is.null(msg)) TRUE
+             else msg
+         }
+         )

R/MPI.R

@@ -11,6 +11,7 @@
 findPeaksPar <- function(arg) {
     require(xcms)
 
+    procDate <- date()
     params <- arg$params
     myID <- arg$id
     if (is.null(params$method))
@@ -43,7 +44,8 @@ findPeaksPar <- function(arg) {
 
     list(scantime=xRaw@scantime,
          peaks=cbind(peaks,
-                     sample = rep.int(myID, nrow(peaks))))
+                     sample = rep.int(myID, nrow(peaks))),
+         date = procDate)
 }
 
 ############################################################

R/functions-ProcessHistory.R

@@ -0,0 +1,40 @@
+############################################################
+## Functions for ProcessHistory objects
+
+############################################################
+## Constructor
+ProcessHistory <- function(type., date., info., error., fileIndex.) {
+    if (missing(type.))
+        type. <- .PROCSTEP.UNKNOWN
+    if (missing(info.))
+        info. <- character()
+    if (missing(error.))
+        error. <- NULL
+    if (missing(date.))
+        date. <- date()
+    if (missing(fileIndex.))
+        fileIndex. <- integer()
+    return(new("ProcessHistory", type = type., info = info.,
+               date = date., error = error.,
+               fileIndex = as.integer(fileIndex.)))
+}
+
+############################################################
+## updateFileIndex
+## Update the file index mapping index in 'old' to index in 'new' dropping
+## all indices that are not in 'new'
+updateFileIndex <- function(x, old = integer(), new = integer()) {
+    if (length(old) == 0 & length(new) == 0)
+        return(x)
+    if (length(old) != length(new))
+        stop("Lengths of 'old' and 'new' don't match!")
+    fidx <- x@fileIndex
+    fidx <- fidx[fidx %in% old]
+    if (length(fidx) == 0)
+        stop("None of the file indices matches 'old'!")
+    for (i in 1:length(fidx)) {
+        fidx[i] <- new[old == fidx[i]]
+    }
+    x@fileIndex <- fidx
+    return(x)
+}