R/MultiOmicQC-checkers.R

In Bioconductor/MultiOmicQC: Quality control for Multi-omics datasets

.printInconsistent <- function(charList) {
    paste(
        vapply(seq_along(charList), function(i, string) {
            paste0(names(string)[[i]], ": ",
                paste(Biobase::selectSome(string[[i]], 5L), collapse = ", ")
            )
        }, character(1L), string = charList)
    , collapse = "\n    ")
}

.consistencyChecker <- function(x, name, FUN) {
    if (!is(x, "MultiAssayExperiment"))
        stop("Provide a 'MultiAssayExperiment' object")
    hasRR <- hasRowRanges(x)
    exps <- experiments(x)

    funList <- lapply(exps[hasRR], function(y) {
        FUN(rowRanges(y))
    })
    if (length(funList) == 1L) { return(TRUE) }
    allConsistent <- all(duplicated(funList)[-1L])
    if (!allConsistent) {
        inconList <- funList[!duplicated(funList)]
        warning(
            "Inconsistent '", name, "' found:\n", "    ",
            .printInconsistent(inconList)
        )
    }
    allConsistent
}

#' @name MultiOmicQC-checkers
#'
#' @title Check seqinfo consistency across ranged experiments
#'
#' @description A set of functions to check several aspects of ranged
#' experiments including \code{seqlengths}, \code{seqlevels} and
#' \code{seqlevelsStyle}. These group of functions return a logical scalar
#' value when the names, styles, etc. are consistent accross all experiments.
#'
#' @section checkSeqlengths:
#' Runs and checks \code{seqlengths} on all ranged experiments.
#'
#' @section checkSeqlevels:
#' Checks \code{seqnames} levels of all ranged experiments for
#' consistency. Inconsistent seqlevels can be problematic when ranged
#' experiments differ by annotations.
#'
#' @section checkSeqlevelsStyle:
#' Checks all \code{seqlevelsStyle} of all ranged experiments by comparing
#' the first style with the rest using the \code{duplicated} function.
#'
#' @param x A \linkS4class{MultiAssayExperiment}
#'
#' @export
checkSeqlengths <- function(x) {
    .consistencyChecker(x, "seqlengths", seqlengths)
}

#' @rdname MultiOmicQC-checkers
#'
#' @export
checkSeqlevels <- function(x) {
    .consistencyChecker(x, "seqlevels", seqlevels)
}

#' @rdname MultiOmicQC-checkers
#'
#' @export
checkSeqlevelsStyle <- function(x) {
    .consistencyChecker(x, "seqlevelsStyle", seqlevelsStyle)
}