R/dropModels.R

In EuracBiomedicalResearch/CompMetaboTools: Utility Functions from the Eurac Research Computational Metabolomics Team

#' @title Remove model fits based on specified criteria
#'
#' @description
#' 
#' The `dropModels` function takes model fits such as the ones returned by
#' `xcms:::rowFitModel` or [withinBatchFit()] and removes models idenfified by
#' function `FLAG_FUN`. This function can be one of the `flag_*` functions (such
#' as [flag_model_residual()]) that take a linear model fit as input and return
#' a logical indicating whether the model fit is problematic or not.
#'
#' @param x `list` of linear models such as returned by `xcms:::rowFitModel` or
#'     [withinBatchFit()].
#'
#' @param FLAG_FUN `function` to test whether the model fit is problematic or not,
#'     such as [flag_model_residual()]. The funciton has to take a linear model
#'     object (as generated by [lm()]) as input and return `TRUE` if the model
#'     should be removed or `FALSE` otherwise.
#'
#' @param ... additional parameters to be passed to `FUN`.
#'
#' @return The input `x` with poor quality models identified by `FUN` replaced
#'     with `NA`.
#'
#' @author Johannes Rainer
#'
#' @export
dropModels <- function(x, FLAG_FUN, ...) {
    to_rem <- vapply(x, FUN = FLAG_FUN, FUN.VALUE = logical(1), ...)
    message("Dropping ", sum(to_rem, na.rm = TRUE), " of ",
            length(to_rem), " models.")
    x[which(to_rem)] <- NA
    x
}