R/ProcessingStep.R

In lgatto/ProtGenerics: Generic infrastructure for Bioconductor mass spectrometry packages

setClassUnion("characterOrFunction", c("character", "function"))

#' @title Processing step
#'
#' @aliases ProcessingStep-class characterOrFunction-class
#' 
#' @description
#'
#' Class containing the function and arguments to be applied in a lazy-execution
#' framework.
#'
#' Objects of this class are created using the `ProcessingStep()` function. The
#' processing step is executed with the `executeProcessingStep()` function.
#'
#' @details
#'
#' This object contains all relevant information of a data analysis processing
#' step, i.e. the function and all of its arguments to be applied to the data.
#' This object is mainly used to record possible processing steps of a
#' `Spectra` or `OnDiskMSnExp` object (from the `Spectra` and `MSnbase`
#' packages, respectively).
#'
#' @return The `ProcessingStep` function returns and object of type
#'     `ProcessingStep`.
#'
#' @author Johannes Rainer
#'
#' @exportClass ProcessingStep
#'
#' @md
#'
#' @examples
#'
#' ## Create a simple processing step object
#' ps <- ProcessingStep(sum)
#'
#' executeProcessingStep(ps, 1:10)
#'
#' @name ProcessingStep
NULL

setClass("ProcessingStep",
         representation = representation(
             FUN = "characterOrFunction",
             ARGS = "list"
         ),
         prototype = prototype(
             ARGS = list(),
             FUN = character()
         ),
         validity = function(object) {
             msg <- character()
             ## Fails with un-exported functions.
             if (length(object@FUN)) {
                 if (!is.function(object@FUN)) {
                     res <- try(match.fun(object@FUN), silent = TRUE)
                     if (is(res, "try-error"))
                         msg <- c(msg, paste0("Function '", object@FUN,
                                              "' not found."))
                 }
             }
             if (length(msg))
                 msg
             else TRUE
         })

#' @param FUN `function` or `character` representing a function name.
#'
#' @param ARGS `list` of arguments to be passed along to `FUN`.
#'
#' @rdname ProcessingStep
#'
#' @md
#'
#' @export
ProcessingStep <- function(FUN = character(), ARGS = list())  {
    if (missing(FUN))
        FUN <- character()
    new("ProcessingStep", FUN = FUN, ARGS = ARGS)
}

.cat_fun <- function(x) {
    if (is.function(x))
        "user-provided function"
    else x
}

#' @rdname ProcessingStep
#'
#' @exportMethod show
setMethod("show", "ProcessingStep", function(object) {
    cat("Object of class \"", class(object), "\"\n", sep = "")
    cat(" Function: ", .cat_fun(object@FUN), "\n", sep = "")
    args <- object@ARGS
    if (length(args) > 0) {
        cat(" Arguments:\n")
        for (i in seq_along(args)) {
            cat("  o ", names(args)[i], " = ", .cat_fun(args[[i]]),
                "\n", sep = "")
        }
    }
})

#' @param object `ProcessingStep` object.
#'
#' @param ... optional additional arguments to be passed along.
#'
#' @rdname ProcessingStep
#'
#' @md
#'
#' @export
executeProcessingStep <- function(object, ...) {
    if (!is(object, "ProcessingStep"))
        stop("'object' is supposed to be a 'ProcessingStep' object!")
    do.call(object@FUN, args = c(list(...), object@ARGS))
}