#' @include ChromBackend.R ChromBackendMemory.R
NULL

#' @title The Chromatograms class to manage and access chromatographic data
#'
#' @name Chromatograms
#'
#' @aliases Chromatograms-class Chromatograms
#' @aliases [,Chromatograms-method
#' @aliases [<-,Chromatograms-method
#' @aliases [[,Chromatograms-method
#' @aliases [[<-,Chromatograms-method
#' @aliases chromExtract
#' @aliases filterEmptyChromatograms
#'
#' @description
#' The `Chromatograms` class encapsules chromatographic data and related
#' metadata. The chromatographic data is represented by a *backend* extending
#' the virtual [ChromBackend] class which provides the raw data to the
#' `Chromatograms` object. Different backends and their properties are
#' described in the [ChromBackend] class documentation.
#'
#' **Available Backends**: The package provides several backends:
#' - `ChromBackendMemory`: Stores data in memory (default, ideal for small datasets).
#' - `ChromBackendMzR`: Reads peaks data from raw MS files on demand.
#' - `ChromBackendSpectra`: Generates chromatographic data from a `Spectra` object.
#'   This backend supports both in-memory and file-backed `Spectra` objects, using
#'   an internal `spectraSortIndex` to avoid physically reordering the spectra.
#'
#' @section Creation of objects:
#'
#' `Chromatograms` objects can be created using the `Chromatograms()`
#' construction function. Either by providing a `ChromBackend` object or by
#' providing a `Spectra` object. The `Spectra` object will be used to generate
#' a `Chromatograms` object with a backend of class [`ChromBackendSpectra`].
#'
#' @section Data stored in a `Chromatograms` object:
#'
#' The `Chromatograms` object is a container for chromatographic data, which
#' includes peaks data (*retention time* and related intensity values, also
#' referred to as *peaks data variables* in the context of `Chromatograms`) and
#' metadata of individual chromatogram (so called *chromatograms variables*).
#' While a core set of chromatograms variables (the
#' `coreChromatogramsVariables()`) and peaks data variables (the
#' `corePeaksVariables()`) are guaranteed to be provided by a `Chromatograms`,
#' it is possible to add arbitrary variables to a `Chromatograms` object.
#'
#' The `Chromatograms` object is designed to contain chromatographic data of a
#' (large) set of chromatograms. The data is organized *linearly* and can be
#' thought of a list of chromatograms, i.e. each element in the `Chromatograms`
#' is one chromatogram.
#'
#' The *chromatograms variables* information in the `Chromatograms` object can
#' be accessed using the `chromData()` function. Specific chromatograms
#' variables can be accessed by either precising the `"columns"` parameter in
#' `chromData()` or using `$`. `@chromData` can be accessed, replaced but
#' also filtered/subsetted. Refer to the [chromData] documentation for more
#' details.
#'
#' The *peaks data variables* information in the `Chromatograms` object can be
#' accessed using the `peaksData()` function. Specific peaks variables can be
#' accessed by either precising the `"columns"` parameter in `peaksData()` or
#' using `$`. `@peaksData` can be accessed, replaced but also
#' filtered/subsetted. Refer to the [peaksData] documentation for more details.
#'
#' @section Processing of `Chromatograms` objects:
#'
#' Functions that process the chromatograms data in some ways can be applied to
#' the object either directly or by using the `processingQueue` mechanism. The
#' `@processingQueue` is a list of processing steps that are stored within the
#' object and only applied when needed. This was created so that the data can be
#' processed in a single step and is very useful for larger datasets. This is
#' even more true as this processing queue will call function that can be
#' applied on the data in a chunk-wise manner. This allows for parallel
#' processing of the data and reduces the memory demand. To read more about the
#' `processingQueue`, and how to parallelize your processes, see the
#' [processingQueue] documentation.
#'
#' @section Subsetting and accessing data:
#' The `Chromatograms` class supports subsetting by chromatogram (i.e. rows) using
#' the `[` operator. The `[` operator does not support subsetting by columns.
#' Specific chromatograms or peaks variables can be accessed using the `[[`
#' operator or the `$` operator. The `[[` operator can also be used to
#' replace specific chromatograms or peaks variables.
#'
#' @section Changing the backend:
#' The `setBackend()` function can be used to change the backend of a
#' `Chromatograms` object. This can be useful to switch to a backend that
#' better suits the needs of the user, for example switching to a memory-based
#' backend for smaller datasets or to a file-based backend for larger datasets.
#' The `setBackend()` function supports parallelization of the backend
#' conversion using the `BPPARAM` parameter. Note that any queued processing
#' steps are applied during the backend switch (since `peaksData()` is called
#' to transfer the data) and the processing queue is emptied afterwards.
#'
#' @section Filtering chromatograms:
#'
#' - `filterEmptyChromatograms()`: removes empty chromatograms (i.e.
#'   chromatograms without peaks) from the object. Returns the filtered
#'   `Chromatograms` object (with chromatograms in their original order).
#'
#' @section Extracting chromatograms based on a peak table:
#'
#' The `chromExtract()` function allows users to extract specific regions of
#' interest from a `Chromatograms` object based on a user-provided peak table.
#' Each row in the `peak.table` defines a region to extract, using minimum and
#' maximum retention time (and m/z in the case of `chromBackendSpectra`)
#' boundaries, and identifiers that uniquely match chromatograms in the object.
#'
#' The resulting **new** `Chromatograms` object contains only chromatograms
#' overlapping the specified regions, with updated metadata reflecting the
#' extracted boundaries.
#'
#' This function is most commonly used to subset chromatographic data around
#' detected peaks or predefined time/mass ranges, for example to reprocess,
#' visualize, or quantify extracted chromatograms corresponding to known
#' features. It's important to notes that filtering by m/z is only supported
#' when using a `ChromBackendSpectra` backend. if the `mzMin` and `mzMax`
#' columns are provided when using other backends, they will be ignored.
#'
#'
#' @param BPPARAM Parallel setup configuration. See [BiocParallel::bpparam()]
#'        for more information.
#'
#' @param backend [ChromBackend] object providing the raw data for the
#'        `Chromatograms` object.
#'
#' @param by A `character` vector naming one or more columns that uniquely
#'        identify chromatograms in both `peak.table` and
#'        `chromData(object)`. The combination of these columns must be unique
#'        within `chromData(object)`. Typically includes `"dataOrigin"`,
#'        `"msLevel"`, or both.
#'
#' @param chromData For `Chromatograms()` build from a `Spectra` object backend,
#'        a `data.frame` with the chromatographic data. If not provided
#'        (or if empty), a default `data.frame` with the core chromatographic
#'        variables will be created.
#'
#' @param drop For `[`: `logical(1)` default to `FALSE`.
#'
#' @param f `factor` defining the grouping to split the `Chromatograms` object.
#'
#' @param factorize.by A `character` vector with the names of the variables in
#'        the `Spectra` object and the `chromData` slot that should be used
#'        to factorize the `Spectra` object data to generate the
#'        chromatographic data.
#'
#' @param i For `[`: `integer`, `logical` or `character` to subset the object.
#'
#' @param j For `[` and `[[`: ignored.
#'
#' @param name A `character` string specifying the name of the variable to
#'        access.
#'
#' @param object A [Chromatograms] object.
#'
#' @param peak.table For `chromExtract()` A `data frame` containing the
#'        following minimum columns:
#'          - rtMin: Minimum retention time for each peak. Cannot be NA.
#'          - rtMax: Maximum retention time for each peak. Cannot be NA.
#'          - mzMin: Minimum m/z value for each peak.
#'          - mzMax: Maximum m/z value for each peak.
#'        Additionally, the `peak.table` must include columns that uniquely
#'        identify chromatograms in the `object`. Common choices are
#'        "msLevel" and/or "dataOrigin". These columns must also be present
#'        in the `chromData` of the `object`. Any extra columns in
#'        `peak.table` will be added to the `chromData` of the newly created
#'        object.
#'
#' @param processingQueue [list] a list of processing steps (i.e. functions) to
#'        be applied to the chromatographic data. The processing steps are
#'        applied in the order they are listed in the `processingQueue`.
#'
#' @param summarize.method For `Chromatograms` created with a `Spectra` object:
#'        A `character` vector with the name of the function to be used to
#'        summaries the spectra data intensity. The available methods are "sum"
#'        and "max". The default is "sum".
#'
#' @param spectraVariables A `character` vector specifying which variables
#'        from the `Spectra` object should be added to the chromData. These
#'        will be mapped using the `chromSpectraIndex` variable.
#'
#' @param value The value to replace the variable with.
#'
#' @param x A [Chromatograms] object.
#'
#' @param ... Additional arguments.
#'
#' @md
#'
#' @exportClass Chromatograms
#'
#' @return Refer to the individual function description for information on
#' the return value.
#'
#' @seealso [chromData] for a general description of the chromatographic
#'          metadata available in the object, as well as how to access, replace
#'          and subset them.
#'          [peaksData] for a general description of the chromatographic peaks
#'          data available in the object, as well as how to access, replace and
#'          subset them.
#'          [processingQueue] for more information on the queuing of
#'          processings and parallelization for larger dataset.
#'
#' @examples
#'
#' ## Create a Chromatograms object with ChromBackendMemory
#' cdata <- data.frame(
#'     msLevel = c(1L, 1L, 1L),
#'     mz = c(112.2, 123.3, 134.4),
#'     dataOrigin = c("mem1", "mem2", "mem3")
#' )
#' pdata <- list(
#'     data.frame(rtime = c(2.1, 2.5, 3.0, 3.4, 3.9),
#'                intensity = c(100, 250, 400, 300, 150)),
#'     data.frame(rtime = c(3.5, 4.0, 4.5),
#'                intensity = c(80, 120, 90)),
#'     data.frame(rtime = c(5.1, 5.8, 6.3, 6.9, 7.5),
#'                intensity = c(80, 500, 1200, 600, 120))
#' )
#' chr <- Chromatograms(ChromBackendMemory(), chromData = cdata, peaksData = pdata)
#' chr
#'
#' ## Create a Chromatograms object from a Spectra object
#' library(MsBackendMetaboLights)
#' library(Spectra)
#'
#' be <- backendInitialize(MsBackendMetaboLights(),
#'     mtblsId = "MTBLS39",
#'     filePattern = c("63B.cdf")
#' )
#' s <- Spectra(be)
#' s <- setBackend(s, MsBackendMemory())
#' chr <- Chromatograms(s)
#'
#' ## Subset
#' chr[1:2]
#'
#' ## Access a specific variable
#' chr[["msLevel"]]
#' chr$msLevel
#'
#' ## Replace data of a specific variable
#' chr$msLevel <- c(2L, 2L, 2L)
#'
#' ## Re-factorize the data
#' chr <- factorize(chr)
#'
#' ## Change the backend to memory
#' chr <- setBackend(chr, ChromBackendMemory())
#'
NULL

setClassUnion("ChromBackendOrMissing", c("ChromBackend", "missing"))

#' The `Chromatograms` class
#'
#' The `Chromatograms` class is a container for chromatographic data.
#'
#' @slot backend [ChromBackend] the *backend* object providing the raw data for
#'       the `Chromatograms` object.
#'
#' @slot processingQueue `list` a list of processing steps to be applied to the
#'       `Chromatograms`. Each element in the list is a function that
#'       processes the data. The processing steps are applied in
#'       the order they are listed in the `processingQueue`.
#'
#' @slot processing `character` a character vector with the names of the
#'       processing steps that have been applied to the `Chromatograms` object.
#'       This is mainly used in the "show" method to display the processing
#'       steps that have been applied to the `Chromatograms` object.
#'
#' @slot processingChunkSize `numeric(1)` the number of chromatograms to be
#'       processed in a single chunk. This is useful for processing large
#'       data sets in smaller chunks to avoid memory issues.
#'
#' @slot version `character(1)` the version of the `Chromatograms` object.
#'
#' @noRd
setClass("Chromatograms",
    slots = c(
        backend = "ChromBackend",
        processingQueue = "list",
        processing = "character",
        processingChunkSize = "numeric",
        version = "character"
    ),
    prototype = prototype(
        version = "0.1",
        processingChunkSize = Inf,
        processingQueue = list(),
        processing = character()
    )
)

setValidity("Chromatograms", function(object) {
    msg <- character()
    if (!is(.backend(object), "ChromBackend")) {
        msg <- ("backend must be a ChromBackend object")
    }
    if (!is.numeric(processingChunkSize(object)) ||
        length(processingChunkSize(object)) != 1) {
        msg <- c(msg, "processingChunkSize must be a numeric value")
    }
    msg <- c(msg, .valid_processing_queue(.processingQueue(object)))
    if (length(msg)) {
        msg
    } else {
        TRUE
    }
})

#' @rdname Chromatograms
#' @export
setMethod(
    "Chromatograms", "ChromBackendOrMissing",
    function(object = ChromBackendMemory(), processingQueue = list(), ...) {
        if (missing(object))
            object <- ChromBackendMemory()
        ## Extract backend-specific parameters from ... and initialize backend
        dots <- list(...)
        if (length(dots) > 0 && length(object) == 0) {
            ## Backend is empty, initialize it with provided parameters
            object <- do.call(backendInitialize, c(list(object), dots))
            dots <- list()
        }
        do.call(new, c(list("Chromatograms", backend = object,
                             processingQueue = processingQueue), dots))
    }
)

#' @rdname Chromatograms
#' @importFrom methods new
#' @export
setMethod(
    "Chromatograms", "Spectra",
    function(object, summarize.method = c("sum", "max"),
             chromData = data.frame(),
             factorize.by = c("msLevel", "dataOrigin"),
             spectraVariables = character(), ...) {
        bd <- backendInitialize(ChromBackendSpectra(),
            spectra = object, factorize.by = factorize.by,
            chromData = chromData,
            summarize.method = summarize.method,
            spectraVariables = spectraVariables, ...)
        new("Chromatograms", backend = bd, processingQueue = list(), ...)
    }
)


#' @rdname hidden_aliases
#'
#' @param object A [Chromatograms] object.
#' @importMethodsFrom methods show
#' @importFrom utils capture.output
#'
#' @exportMethod show
setMethod(
    "show", "Chromatograms",
    function(object) {
        cat("Chromatographic data (", class(object)[1L], ") with ",
            length(.backend(object)), " chromatograms in a ",
            class(.backend(object)), " backend:\n", sep = "")
        if (length(.backend(object))) {
            txt <- capture.output(show(.backend(object)))
            cat(txt[-1], sep = "\n")
        }
        if (length(.processingQueue(object)))
            cat("Lazy evaluation queue:",
                length(.processingQueue(object)),
                "processing step(s)\n")
        lp <- length(.processing(object))
        if (lp) {
            lps <- .processing(object)
            if (lp > 3) {
                lps <- lps[seq_len(3)]
                lps <- c(lps, paste0("...", lp - 3,
                    " more processings. ",
                    "Use 'processingLog' to list all."))
            }
            cat("Processing:\n", paste(lps, collapse = "\n "), "\n")
        }
    }
)

#' @rdname Chromatograms
#'
#' @note
#' This needs to be discussed, if we want for example to be able to set a
#' a backend to `ChromBackendMzR` we need to implement backendInitialize()
#' better. = Support peaksData and chromData as arguments AND have a way to
#' write .mzml files (which we do not have for chromatographic data).
#'
#' @importMethodsFrom ProtGenerics setBackend
#'
#' @exportMethod setBackend
setMethod(
    "setBackend", c("Chromatograms", "ChromBackend"),
    function(object, backend, f = processingChunkFactor(object),
             BPPARAM = SerialParam(), ...) {
        backend_class <- class(.backend(object))
        BPPARAM <- backendBpparam(.backend(object), BPPARAM)
        BPPARAM <- backendBpparam(backend, BPPARAM)
        if (!supportsSetBackend(backend))
            stop(class(backend), " does not support 'setBackend'")
        if (!length(f) || length(levels(f)) == 1 || !length(object)) {
            bd_new <- backendInitialize(backend,
                peaksData = peaksData(object),
                chromData = chromData(object))
        } else {
            queue <- .processingQueue(object)
            bd_new <- bplapply(
                split(.backend(object), f = f),
                function(z, queue, ...) {
                    if (length(queue))
                        z <- .run_process_queue(z, queue)
                    backendInitialize(backend,
                        peaksData = peaksData(z),
                        chromData = chromData(z),
                        BPPARAM = SerialParam())
                },
                queue = queue, ...,
                BPPARAM = BPPARAM)
            bd_new <- backendMerge(bd_new)
        }
        if (any(colnames(chromData(bd_new)) %in% c("rtMin", "rtMax")))
            chromData(bd_new) <- chromData(bd_new)[,
                !colnames(chromData(bd_new)) %in% c("rtMin", "rtMax")]
        object@backend <- bd_new
        object@processingQueue <- list()
        object@processing <- .logging(
            object@processing, "Switch backend from ",
            backend_class, " to ", class(.backend(object)))
        object
    }
)

#' @rdname Chromatograms
#' @export
setMethod("$", signature = "Chromatograms", function(x, name) {
    .backend(x)[[name]]
})

#' @rdname Chromatograms
#' @export
setReplaceMethod("$", signature = "Chromatograms", function(x, name, value) {
    x@backend[[name]] <- value
    x
})

#' @rdname Chromatograms
#' @importFrom methods slot<-
#' @importFrom MsCoreUtils i2index
#' @export
setMethod("[", "Chromatograms", function(x, i, j, ..., drop = FALSE) {
    if (!missing(j))
        stop("Subsetting 'Chromatograms' by columns is not (yet) supported")
    if (missing(i))
        return(x)
    slot(x, "backend", check = FALSE) <- extractByIndex(
        .backend(x), i2index(i, length(x)))
    x
})

#' @rdname Chromatograms
#' @export
setMethod("[[", "Chromatograms", function(x, i, j, ...) {
    if (!is.character(i))
        stop("'i' is supposed to be a character defining the chromatogram or ",
             "peak variable to access.")
    if (!missing(j))
        stop("'j' is not supported.")
    if (!(i %in% peaksVariables(x)) && !(i %in% chromVariables(x)))
        stop("No variable '", i, "' available")
    else
        do.call("[[", list(.backend(x), i))
})

#' @rdname Chromatograms
#'
#' @export
setReplaceMethod("[[", "Chromatograms", function(x, i, j, ..., value) {
    if (!is.character(i))
        stop("'i' is supposed to be a character defining the chromatogram ",
             "or peak variable to replace or create.")
    if (!(i %in% peaksVariables(x)) && !(i %in% chromVariables(x)))
        stop("No variable '", i, "' available")
    if (!missing(j))
        stop("'j' is not supported.")
    x@backend <- do.call("[[<-", list(.backend(x), i = i, value = value))
    x
})

#' @rdname Chromatograms
#' @export
setMethod(
    "factorize", "Chromatograms",
    function(object, factorize.by = c("msLevel", "dataOrigin"), ...) {
        object@backend <- factorize(.backend(object), ...)
        object
    }
)

#' @rdname Chromatograms
#' @export
setMethod(
    "chromExtract", "Chromatograms",
    function(object, peak.table, by, ...) {
        new_bd <- chromExtract(.backend(object), peak.table, by, ...)
        return(Chromatograms(new_bd))
    }
)

#' @rdname Chromatograms
#' @export
setMethod(
    "filterEmptyChromatograms", "Chromatograms",
    function(object, ...) {
        if (!length(object)) return(object)
        object@backend <- extractByIndex(
            .backend(object), which(as.logical(lengths(object))))
        object@processing <- .logging(
            object@processing, "Filter: removed empty chromatograms.")
        object
    }
)


#' @title Merging, combining and splitting Chromatograms
#'
#' @name concatenateChromatograms
#'
#' @aliases c,Chromatograms-method
#' @aliases concatenateChromatograms
#' @aliases split,Chromatograms,ANY-method
#'
#' @description
#'
#' Various functions are available to combine or split data from one or more
#' `Chromatograms` objects. These are:
#'
#' - `c()` and `concatenateChromatograms()`: combines several `Chromatograms`
#'   objects into a single object. The resulting `Chromatograms` contains all
#'   data from all individual `Chromatograms`, i.e. the union of all their
#'   chromatograms variables. Concatenation will fail if the processing queue
#'   of any of the `Chromatograms` objects is not empty or if different backends
#'   are used for the `Chromatograms` objects. In such cases it is suggested to
#'   first change the backends of all `Chromatograms` to the same type of
#'   backend (using the [setBackend()] function) and to eventually (if needed)
#'   apply the processing queue using the [applyProcessing()] function.
#'
#' - `split()`: splits the `Chromatograms` object based on a provided grouping
#'   factor returning a `list` of `Chromatograms` objects.
#'
#' @param x A `Chromatograms` object.
#'
#' @param f `factor` defining the grouping to split the `Chromatograms` object.
#'
#' @param drop For `split()`: not considered.
#'
#' @param ... For `c()` and `concatenateChromatograms()`: `Chromatograms`
#'        objects or a `list` of `Chromatograms` objects.
#'
#' @return
#'
#' - `c()` and `concatenateChromatograms()`: a single `Chromatograms` object
#'   containing the data from all input objects.
#'
#' - `split()`: a `list` of `Chromatograms` objects.
#'
#' @examples
#'
#' ## Create two Chromatograms objects
#' cdata1 <- data.frame(
#'     msLevel = c(1L, 1L),
#'     mz = c(112.2, 123.3),
#'     dataOrigin = c("file1", "file1")
#' )
#' pdata1 <- list(
#'     data.frame(rtime = c(1.0, 2.0, 3.0), intensity = c(100, 200, 150)),
#'     data.frame(rtime = c(1.0, 2.0, 3.0), intensity = c(80, 120, 90))
#' )
#' chr1 <- Chromatograms(
#'     ChromBackendMemory(),
#'     chromData = cdata1,
#'     peaksData = pdata1
#' )
#'
#' cdata2 <- data.frame(
#'     msLevel = c(2L, 2L),
#'     mz = c(134.4, 145.5),
#'     dataOrigin = c("file2", "file2")
#' )
#' pdata2 <- list(
#'     data.frame(rtime = c(4.0, 5.0, 6.0), intensity = c(300, 400, 350)),
#'     data.frame(rtime = c(4.0, 5.0, 6.0), intensity = c(200, 250, 180))
#' )
#' chr2 <- Chromatograms(
#'     ChromBackendMemory(),
#'     chromData = cdata2,
#'     peaksData = pdata2
#' )
#'
#' ## Combine using c()
#' chr_combined <- c(chr1, chr2)
#' chr_combined
#'
#' ## Combine using concatenateChromatograms
#' chr_combined2 <- concatenateChromatograms(chr1, chr2)
#'
#' ## Combine a list of Chromatograms
#' chr_list <- list(chr1, chr2)
#' chr_combined3 <- concatenateChromatograms(chr_list)
#'
#' ## Split by msLevel
#' chr_split <- split(chr_combined, f = chr_combined$msLevel)
#' chr_split
#'
NULL

#' Internal function to concatenate a list of `Chromatograms` objects.
#'
#' @param x `list` of `Chromatograms` objects.
#'
#' @return `Chromatograms`.
#'
#' @author Philippine Louail, Johannes Rainer
#'
#' @noRd
.concatenate_chromatograms <- function(x) {
    cls <- vapply(x, class, character(1))
    if (any(cls != "Chromatograms"))
        stop("Can only concatenate 'Chromatograms' objects")
    x <- x[lengths(x) > 0]
    if (length(x) == 0) return(Chromatograms())
    if (length(x) == 1) return(x[[1L]])
    pqs <- lapply(x, function(z) z@processingQueue)
    if (any(lengths(pqs)))
        stop("Can not concatenate 'Chromatograms' objects with non-empty ",
             "processing queue. Consider calling 'applyProcessing' before.")
    procs <- unique(unlist(lapply(x, function(z) z@processing)))
    object <- new("Chromatograms",
        backend = backendMerge(lapply(x, function(z) z@backend)),
        processing = c(procs,
            paste0("Merged ", length(x),
                   " Chromatograms into one [", date(), "]")))
    validObject(object)
    object
}

#' @export
#'
#' @rdname concatenateChromatograms
concatenateChromatograms <- function(x, ...) {
    if (is.list(x))
        .concatenate_chromatograms(unlist(unname(c(x, list(...)))))
    else
        .concatenate_chromatograms(unlist(unname(list(x, ...))))
}

#' @rdname concatenateChromatograms
#'
#' @exportMethod c
setMethod("c", "Chromatograms", function(x, ...) {
    .concatenate_chromatograms(unname(list(unname(x), ...)))
})

#' @rdname concatenateChromatograms
setMethod("split", "Chromatograms", function(x, f, drop = FALSE, ...) {
    bcknds <- split(x@backend, f, ...)
    lapply(bcknds, function(b) {
        slot(x, "backend", check = FALSE) <- b
        x
    })
})
