R/utils.R

In BiocNeighbors: Nearest Neighbor Detection for Bioconductor Packages

#' @importFrom BiocParallel bpnworkers
.assign_jobs <- function (jobs, BPPARAM) 
# Assigns a vector of job indices to workers.
# Returns a list of job indices, one per worker.
{
    ncores <- bpnworkers(BPPARAM)
    if (ncores==1L) {
        return(list(jobs))
    }

    njobs <- length(jobs)
    starting <- as.integer(seq(1, njobs + 1, length.out = ncores + 1))
    jobsize <- diff(starting)
    starting <- starting[-length(starting)]

    output <- vector("list", ncores)
    for (i in seq_len(ncores)) {
        idx <- starting[i] - 1L + seq_len(jobsize[i])
        output[[i]] <- jobs[idx]
    }
    output
}

#' @importFrom BiocParallel bpnworkers
.split_matrix_for_workers <- function(mat, job.id, BPPARAM) {
    # Avoid unnecessary allocation where possible.
    if (bpnworkers(BPPARAM)==1L) {
        if (identical(job.id, seq_along(job.id))) {
            list(mat)
        } else {
            list(mat[,job.id,drop=FALSE])
        }
    } else {
        jobs <- .assign_jobs(job.id, BPPARAM)
        lapply(jobs, function(x) mat[,x,drop=FALSE])
    }
}

.subset_to_index <- function(subset, x, byrow=TRUE) 
# Converts an arbitary subset into an integer vector.
{
    if (byrow) {
        dummy <- seq_len(nrow(x))
        names(dummy) <- rownames(x)
    } else {
        dummy <- seq_len(ncol(x))
        names(dummy) <- colnames(x) 
    }

    out <- unname(dummy[subset])
    if (any(is.na(out))) {
        stop("'subset' indices out of range of 'x'")
    }
    return(out)
}

.order_to_index <- function(order) 
# Convenience function to convert from a (used) ordering vector to an indexing vector.
# Applying this returns an ordered sequence to its original state.    
{
    new.pos <- integer(length(order))
    new.pos[order] <- seq_along(new.pos)
    new.pos
}

.combine_matrices <- function(collected, i, reorder=NULL) 
# Combines NN-related matrix results across multiple cores.
{
    all.mat <- lapply(collected, "[[", i=i)
    out <- do.call(cbind, all.mat)
    if (!is.null(reorder)) { 
        out[,reorder] <- out
    }
    t(out)
}

.combine_lists <- function(collected, i, reorder=NULL) 
# Combines neighbor related list results across mutliple cores.
{
    all.lists <- lapply(collected, "[[", i=i)
    out <- unlist(all.lists, recursive=FALSE)
    out[reorder] <- out
    out
}

# To use in missing,missing-method definitions.
.default_param <- function(x) list(BNPARAM=KmknnParam())