R/mts_crisprPartition.R

In MultiSEp: Predict Synthetic Lethality and Other Gene Dependency Relationships from Multiomics Data

mts_crisprPartition <- function(dataMatrix, 
                                NumSampleThreshold = 20,
                                partitionThreshold = -0.5,
                                verbose = FALSE,
                                cores) {
  
  if (missing(dataMatrix))        stop("No Matrix Provided")
  if (!is.data.frame(dataMatrix)) stop("dataMatrix must be a data frame")
  
  if (missing(cores)) {
    cores <- 1
    if (verbose) message("1 core selected")
  } else if (!is.numeric(cores) || cores < 1) {
    stop("cores should be >= 1")
  } else {
    if (verbose) message(cores, " cores selected")
  }
  
  
  if (missing(NumSampleThreshold)) {
    if (verbose) message("Number of samples threshold not entered, using ", NumSampleThreshold, " samples")
  } else {
    if (verbose) message("Number of samples threshold: ", NumSampleThreshold)
  }
  
  if (missing(partitionThreshold)) {
    if (verbose) message("Partition threshold not supplied, using ", partitionThreshold)
  } else {
    if (verbose) message("Partition threshold: ", partitionThreshold)
  }
  
  # filter out NA rownames in matrix 
  dataMatrix <- dataMatrix[!is.na(rownames(dataMatrix)), , drop = FALSE]
  
  presence_counts <- rowSums(!is.na(dataMatrix))
  genes_over_20 <- names(presence_counts)[presence_counts > NumSampleThreshold]
  if (length(genes_over_20) == 0) {
    stop(paste("No genes have CRISPR scores in over", NumSampleThreshold, "samples"))
  }
  dataMatrix <- dataMatrix[genes_over_20, , drop = FALSE]
  
  result_list <- pbmclapply(genes_over_20, function(gene) {
    vals    <- as.numeric(dataMatrix[gene, ])
    samples <- colnames(dataMatrix)
    tab     <- data.frame(Sample = samples,
                          Values  = vals,
                          stringsAsFactors = FALSE)
    tab     <- tab[!is.na(tab$Values), , drop = FALSE]
    tab$Cluster_Assignment <- ifelse(tab$Values < partitionThreshold, 1, 2)
    tab
  }, mc.cores = cores)
  names(result_list) <- genes_over_20 
  return(result_list)
}