前言

近期，張澤民教授團隊開發了一種在cell cluster里面計算純度的算法ROGUE，什么意思呢？經過傳統的降維方式（t-SNE，UMAP）降維聚類后的cell cluster，其每一個cell cluster里面并不會是100%的同一類型的細胞，里面可能含有一些其他類型的細胞也分到同一個cell cluster里面，因此有必要計算每一個cell cluster的純度
文章鏈接：An entropy-based metric for assessing the purity of single cell populations

測試算法

首先，我們模擬創建一個單細胞數據中某cell cluster的表達矩陣

exper = data.frame(abs(matrix(rnorm(10000),nrow=100)))
row.names(exper) = paste(rep('gene'),1:100,sep = '_')
colnames(exper) = paste(rep('cell'),1:100,sep = '_')

然后計算該矩陣的平均表達量和香濃熵，文章是這么定義每個基因的香濃熵的：

library(tibble)

Entropy <- function(expr, r = 1){
  tmp <- log(expr+1)
  entropy <- Matrix::rowMeans(tmp) #計算香濃熵
  mean.expr <- log(Matrix::rowMeans(expr)+r) #計算表達均值的log值

  ent_res <- tibble(
    Gene = rownames(expr),
    mean.expr = mean.expr,
    entropy = entropy
  )

  return(ent_res)
}

結果為：

函數Entropy()

計算好每個基因表達量均值的log值和每個基因的香濃熵以后，作者利用loess來擬合基因表達量均值的log值和每個基因的香濃熵之間的關系，實現由函數：entropy_fit：

entropy_fit <- function(.x, span = 0.5, mt.method = "fdr"){
  .x <- .x %>% dplyr::filter(is.finite(mean.expr)) %>% dplyr::filter(entropy > 0)
  fit <- loess(entropy~mean.expr, data = .x, span=span)
  prd <- predict(fit, .x$mean.expr)
  .x %>%
    dplyr::mutate(fit = prd) %>%
    dplyr::mutate(ds = fit - entropy) %>%
    dplyr::mutate(pv = 1-pnorm(.$ds, mean = mean(.$ds), sd = sd(.$ds))) %>%
    dplyr::filter(pv > 0.1) -> tmp

  fit <- loess(entropy~mean.expr, data = tmp, span=span)
  prd <- predict(fit, .x$mean.expr)
  .x %>%
    dplyr::mutate(fit = prd) %>%
    dplyr::mutate(ds = fit - entropy) %>%
    dplyr::filter(is.finite(ds)) %>%
    dplyr::mutate(pv = 1-pnorm(.$ds, mean = mean(.$ds), sd = sd(.$ds))) %>%
    dplyr::filter(pv > 0.1) -> tmp

  fit <- loess(entropy~mean.expr, data = tmp, span=span)
  prd <- predict(fit, .x$mean.expr)

  .x %>%
    dplyr::mutate(fit = prd) %>%
    dplyr::mutate(ds = fit - entropy) %>%
    dplyr::filter(is.finite(ds)) -> .x

  .x <- .x %>% dplyr::mutate(p.value = 1-pnorm(.x$ds, mean = mean(.x$ds), sd = sd(.x$ds)))
  p.adj <- p.adjust(.x$p.value, method = mt.method)
  .x <- .x %>% dplyr::mutate(p.adj = p.adj) %>% dplyr::arrange(desc(ds))
}

結果為：

函數entropy_fit()

這里用loess（局部加權回歸）來預測基因平均表達量的log值與熵的關系，預測的模型為fit，而后者需要利用基因表達量均值的log值作為決策變量，來根據模型fit預測響應變量的值，我們稱之為預測entropy
并且作者定義ds如下：

dplyr::mutate(fit = prd) %>%
dplyr::mutate(ds = fit - entropy)

ds為預測entropy減去真實entropy，ds越大說明該cluster內某基因的熵變很大，即真實表達水平與預測的（與cluster內部大部分基因不一樣）相差很大，說明很有可能是其他類型的細胞（雜質）

最后要計算的是Rogue值
該值定義如下：

其中而ROGUE介于0-1之間；當平臺是UMI的，那么K=45，若平臺為full-length，則K=500

SE_fun <- function(expr, span = 0.5, r = 1, mt.method = "fdr", if.adj = T){
  ent_res <- ROGUE::Entropy(expr, r = r)
  ent_res <- ROGUE::entropy_fit(ent_res, span = span, mt.method = mt.method)
  if(!isTRUE(if.adj)){
    ent_res <- ent_res %>% dplyr::mutate(p.adj = p.value)
  }
  return(ent_res)
}

##  .x即為函數SE_fun()的返回值
CalculateRogue <- function(.x, platform = NULL, cutoff = 0.05, k = NULL, features = NULL){
  if(is.null(k)){
    if(is.null(platform)){
      warning("Please provide a \"platform\" argument or specify a k value")
    }else if(platform == "UMI"){
      k = 45
    }else if(platform == "full-length"){
      k = 500
    }else if(!is.null(platform) & !(platform %in% c("UMI","full-length"))){
      warning("Please provide valid \"platform\" argument")
    }
  }else if(!is.null(k)){
    k <- k
  }

  if(!is.null(features)){
    .x <- .x %>% dplyr::filter(Gene %in% features)
    sig_value <- sum(abs(.x$ds))
    Rogue <- 1-sig_value/(sig_value+k)
    return(Rogue)
  }else{
    sig_value <- abs(.x$ds[.x$p.adj < cutoff & .x$p.value < cutoff])
    sig_value <- sum(sig_value)
    Rogue <- 1-sig_value/(sig_value+k)
    return(Rogue)
  }
}

其中.x即為函數SE_fun()的返回值，在計算sig_value時，用的是該cell cluster中所有基因的ds值的總和；ROGUE值越高，說明該cell cluster細胞純度越高，反之越低；

Github：https://github.com/PaulingLiu/ROGUE/blob/master/R/ROGUE.R