R/SharedMethods.R

In LoomExperiment: LoomExperiment container

#' @importFrom S4Vectors endoapply
.subset.LoomExperiment <- function(x, i, j, ...)
{
    rg <- rowGraphs(x)
    cg <- colGraphs(x)
    rowGraphs(x) <- LoomGraphs()
    colGraphs(x) <- LoomGraphs()
    x <- callNextMethod()
    if (!missing(i)) {
        if (is.logical(i))
            i <- which(i)
        if (all(i > 0))
            rowGraphs(x) <- .change.nnode(endoapply(rg, function(y) loomSelectHits(y, i)))
        else
            rowGraphs(x) <- .change.nnode(endoapply(rg, function(y) loomDropHits(y, i)))
    }
    else
        rowGraphs(x) <- rg
    if (!missing(j)) {
        if (is.logical(j))
            j <- which(j)
        if (all(j > 0))
            colGraphs(x) <- .change.nnode(endoapply(cg, function(y) loomSelectHits(y, j)))
        else
            colGraphs(x) <- .change.nnode(endoapply(cg, function(y) loomDropHits(y, j)))
    }
    else
        colGraphs(x) <- cg
    x
}

.rbind.LoomExperiment <-
    function(..., deparse.level = 1)
{
    li <- list(...)
    rn <- names(rowGraphs(li[[1]]))

    clgs <- lapply(li, colGraphs)
    clgs <- do.call(c, clgs)

    rlgs <- lapply(li, rowGraphs)
    rlgs <- do.call(rbind, rlgs)
    if (is(rlgs, "matrix"))
        rlgs <- LoomGraphs()
    names(rlgs) <- rn
    x <- callNextMethod()
    rowGraphs(x) <- .change.nnode(rlgs, nrow(x))
    colGraphs(x) <- clgs
    x
}

.cbind.LoomExperiment <-
    function(..., deparse.level = 1)
{
    li <- list(...)
    cn <- names(colGraphs(li[[1]]))

    rlgs <- lapply(li, rowGraphs)
    rlgs <- do.call(c, rlgs)

    clgs <- lapply(li, colGraphs)
    clgs <- do.call(cbind, clgs)
    if (is(clgs, "matrix"))
        clgs <- LoomGraphs()
    names(clgs) <- cn
    x <- callNextMethod()
    colGraphs(x) <- .change.nnode(clgs, ncol(x))
    rowGraphs(x) <- rlgs
    x
}

.show.LoomExperiment <- function(object)
{
    scat <- function(fmt, vals=character(), exdent=2, ...)
    {
        vals <- ifelse(nzchar(vals), vals, "''")
        lbls <- paste(S4Vectors:::selectSome(vals), collapse=' ')
        txt <- sprintf(fmt, length(vals), lbls)
        cat(strwrap(txt, exdent=exdent, ...), sep='\n')
    }
    callNextMethod()
    if (length(object@rowGraphs) > 0) {
        if (is.null(names(object@rowGraphs)))
            cat(sprintf('rowGraphs(%d):\n', length(object@rowGraphs)))
        else
            scat('rowGraphs(%d): %s\n', names(object@rowGraphs))
    }
    else
        cat('rowGraphs(0): NULL\n')
    if (length(object@colGraphs) > 0) {
        if (is.null(names(object@colGraphs)))
            cat(sprintf('colGraphs(%d):\n', length(object@colGraphs)))
        else
            scat('colGraphs(%d): %s\n', names(object@colGraphs))
    }
    else
        cat('colGraphs(0): NULL\n')
}