R/evaluation.R

In wefang/scLearn: Regulome Prediction based on scRNA-seq

#' Porject bulk and single cell onto bulk together
#' @export
#' @param genes.use the vector of genes to be used in the projection
project_joint <- function(bulk_mat, sc_mat, genes.use) {
  fpkm_concat <- cbind(bulk_mat[genes.use, ], sc_mat[genes.use, ])
  cor_self <- cor(fpkm_concat)
  proj <- scale(cor_self[1:ncol(bulk_mat), ]^4)
  proj
}

#' Compare correlation of different single cell data to the bulk
#' @importFrom ghelper aveMatFac
#' @export
summarize_cor <- function(sc_list, bulk, lab_sc, lab_bulk) {
  # average bulk based on labels
  bulk_ave <- t(aveMatFac(t(bulk), lab_bulk))
  if (is.character(lab_bulk)) lab_bulk <- factor(lab_bulk)
  if (is.character(lab_sc)) lab_sc <- factor(lab_sc)
  out <- lapply(levels(lab_bulk), function(x) {
    temp <- lapply(sc_list, function(sc_mat) {
      cor(sc_mat[ , lab_sc == x, drop = F], bulk_ave[, x, drop = F])
    })
    bound <- do.call(cbind, temp)
    colnames(bound) <- names(sc_list)
    bound
  })
  names(out) <- levels(lab_bulk)
  out
}

cs_cor <- function(y, p) {
  sapply(1:nrow(p), function(i) cor(y[i, ], p[i, ]))
}

hclust_mat <- function(mat) {
  ord <- hclust(dist(mat))$order
  mat[ord, ]
}

max_norm <- function(x) {
  pos <- x - rowMins(x)
  norm <- pos/rowMaxs(pos)
}

library(matrixStats)
match_range <- function(x, y) {
  rmax <- rowMaxs(x)
  rmin <- rowMins(x)
  rmax_target <- rowMaxs(y)
  rmin_target <- rowMins(y)
  (x - rmin)/(rmax - rmin) * (rmax_target- rmin_target) + rmin_target
}