R/redim_matrix.R

In fmi-basel/gbuehler-MiniChip: MiniChip

#' @title redim_matrix
#'
#' @description This function summarizes a matrix into the desired numbe rof rows and columns.
#'
#' @details It was taken from this reference: https://gdevailly.netlify.app/post/plotting-big-matrices-in-r/
#'
#' @param mat A list of counts across peak summits generated by SummitHeatmap.
#' @param target_height The desired number of rows of the output matrix.
#' @param target_width The desired number of columns of the output matrix.
#' @param summary_func The function to use for summarising the matrix.Default=mean.
#' @param output_type The type of output matrix.
#' @param n_core Numebr of cores to sue for calculation.
#'
#' @return A matrix of the size target_height by target_width that summarizes the original matrix.
#'
#' @importFrom parallel mclapply
#'
redim_matrix <- function(mat, target_height = 100, target_width = 100,
summary_func = function(x) mean(x, na.rm = TRUE),
output_type = 0.0, #vapply style
n_core = 1 # parallel processing
) {

  if(target_height > nrow(mat) | target_width > ncol(mat)) {
    stop("Input matrix must be bigger than target width and height.")
  }

  seq_height <- round(seq(1, nrow(mat), length.out = target_height + 1))
  seq_width  <- round(seq(1, ncol(mat), length.out = target_width  + 1))

  # complicated way to write a double for loop
  do.call(rbind, parallel::mclapply(seq_len(target_height), function(i) { # i is row
    vapply(seq_len(target_width), function(j) { # j is column
      summary_func(
        mat[
          seq(seq_height[i], seq_height[i + 1]),
          seq(seq_width[j] , seq_width[j + 1] )
          ]
      )
    }, output_type)
  }, mc.cores = n_core))
}