# 【迁移】从差异基因到RRA聚合

Last updated on March 19, 2024 pm

通过比对，我们得到了counts矩阵，接下来可以进行DEGs分析。此时如果我们有多组之间的对比，则可以使用RRA算法来聚合我们的结果。

## RRA的安装

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20

    conda create -n tcga -c conda-forge r-base=4.1.2 -y
    conda activate tcga
    conda install -c conda-forge r-rvest=1.0.2 -y
    conda install -c conda-forge r-xml=3.99_0.8 -y
    conda install -c conda-forge r-rcpparmadillo=0.10.8.1.0 -y
    conda install -c conda-forge r-bh=1.78.0_0 -y
    conda install -c conda-forge r-biocmanager=1.30.16 -y
    conda install -c bioconda bioconductor-summarizedexperiment=1.24.0 -y
    conda install -c bioconda bioconductor-tcgabiolinks=2.22.1 -y
    conda install -c bioconda bioconductor-deseq2=1.34.0 -y
    conda install -c bioconda bioconductor-rhdf5=2.38.0 -y
    conda install -c bioconda bioconductor-limma=3.50.1 -y
    conda install -c bioconda bioconductor-apeglm=1.16.0 -y
    conda install -c bioconda r-sleuth=0.30.0 -y
    conda install -c bioconda r-wasabi=1.0.1 -y
    conda install -c conda-forge r-irkernel=1.3 -y
    conda install -c conda-forge r-ashr=2.2_54 -y
    conda install -c conda-forge r-robustrankaggreg=1.1 -y
    conda install -c conda-forge r-devtools=2.4.3 -y
    IRkernel::installspec(name='tcga', displayname='r-tcga')

- deseq2 数据要求：低生物学重复 & raw counts；假定负二项分布；适合高通量测序数据
- sleuth 数据要求：Kallisto输出的结果
- limma 数据要求：logCPM；假定正态分布；适合芯片数据
- fpkm数据差异基因分析 ：理论上是不能进行分析的，无计可施时可以参考
- 高生物学重复请直接使用 wilcox.test 以避免大量假阳性
- 多数据集结果整合：RobustRankAggreg

fpkm转tpm示例（基于 SummarizedExperiment 数据框架）

    1
    2
    3
    4
    5
    6
    7

    fpkmToTpm <- function(fpkm){
        exp(log(fpkm) - log(sum(fpkm)) + log(1e6))
    }
    f_fpkmToTpm <- function(l_e){
         apply(l_e,2,fpkmToTpm)
    }
    assay(sce, "TPM") <- f_fpkmToTpm(assay(sce, "HTSeq - FPKM"))

## 第一步，多组差异基因分析

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35

    library(DESeq2)
    count_all <- read.csv("~/upload/zl_liu/star_data/yyz_01/yyz_01.csv",header=TRUE)
    count_all
    cts_b <- count_all[ ,c(-1,-2,-3)]
    rownames(cts_b) <- count_all$ID
    keep <- rowSums(cts_b) > ncol(cts_b)
    cts_b[keep,]
    f_DESeq2 <- function(cts_bb, rowInfo, ControlN, TreatN, rm.NA=T){
        cts_b <- cts_bb[,c(ControlN, TreatN)]
        conditions <- factor(c(rep("Control",length(ControlN)), rep("Treat",length(TreatN))))
        colData_b <- data.frame(row.names = colnames(cts_b), conditions)
        print(colData_b)
        dds <- DESeqDataSetFromMatrix(countData = cts_b,
                                  colData = colData_b,
                                  design = ~ conditions)
        dds <- DESeq(dds)
        res <- results(dds)
        rres <- cbind(rowInfo, data.frame(res))
        if(rm.NA){rres <- rres[!is.na(rres$padj),]}
        rres <- rres[order(rres$log2FoldChange, decreasing = T),]
        saveRDS(rres, paste('DEGs', paste(TreatN, collapse = '_'), 'vs.', paste(ControlN, collapse = '_'), 'DESeq2.rds',sep = '_'))
        rres
    }
    Ct1 <- c('X1.control.DMSO', 'X2.control.DMSO')
    Tt1 <- c('X1.OE.DMSO', 'X2.OE.DMSO')
    Ct2 <- c('X1.OE.DMSO', 'X2.OE.DMSO')
    Tt2 <- c('X1.OE.Enz', 'X2.OE.Enz')
    Ct3 <- c('X1.control.Enz', 'X2.control.Enz')
    Tt3 <- c('X1.OE.Enz', 'X2.OE.Enz')
    Ct4 <- c('X1.CAF.DMSO', 'X2.CAF.DMSO')
    Tt4 <- c('X1.CAF.Enz', 'X2.CAF.Enz')
    r1 <- f_DESeq2(cts_b[keep,], count_all[keep,c(1,2,3)], Ct1, Tt1)
    r2 <- f_DESeq2(cts_b[keep,], count_all[keep,c(1,2,3)], Ct2, Tt2)
    r3 <- f_DESeq2(cts_b[keep,], count_all[keep,c(1,2,3)], Ct3, Tt3)
    r4 <- f_DESeq2(cts_b[keep,], count_all[keep,c(1,2,3)], Ct4, Tt4)

## 第二步，RRA聚合差异结果

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29

    require(RobustRankAggreg)
    f_dflist_RRA <- function(dflist, nameN, N, orderN, decreasing=T){
        res <- list()
        for (name in names(dflist)){
            tmp <- dflist[[name]]
            if (nrow(tmp) == 1){
                res[[name]] <- tmp[1, nameN]
            }else if(nrow(tmp) >=2){
                res[[name]] <- tmp[order(tmp[[orderN]],decreasing = decreasing), nameN]
            }
        }
        if(length(res) < 1){ return(NULL)}
        aggregateRanks(glist = res, N = N)
    }
    rownames(count_all) <- count_all$ID

    r <- list(r1=r1,r2=r2,r3=r3,r4=r4)
    r <- lapply(r, FUN = function(x){subset(x, padj<0.05 & log2FoldChange > 1)})
    r <- f_dflist_RRA(r, 'ID', sum(keep), 'log2FoldChange')
    r <- cbind(count_all[r$Name,c(2,3)], r)
    r
    write.csv(r, 'RRA_up.csv')

    r <- list(r1=r1,r2=r2,r3=r3,r4=r4)
    r <- lapply(r, FUN = function(x){subset(x, padj<0.05 & log2FoldChange < -1)})
    r <- f_dflist_RRA(r, 'ID', sum(keep), 'log2FoldChange', decreasing = F)
    r <- cbind(count_all[r$Name,c(2,3)], r)
    r
    write.csv(r, 'RRA_down.csv')

## 附加：绘图

### 安装包

    1
    2
    3
    4
    5
    6
    7
    8
    9

    conda create -n rsf -c conda-forge r-sf=1.0_4
    conda activate rsf
    library(sf)
    # install.packages("sf", version = "1.0-4")
    install.packages("ggVennDiagram")
    conda install -c conda-forge r-ggsci -y
    conda install -c conda-forge r-irkernel -y
    Rscript -e "IRkernel::installspec(name='ggVennDiagram', displayname='r-ggVennDiagram')"
    conda install -c conda-forge r-venndiagram -y

### 数据准备

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16

    x <- list()
    r <- list()
    r$cell <- readRDS('../A_ref_A_fiig.1_A/DEG.rds')
    r$tissue <- readRDS('../B_ref_A_fiig.1_A/DEG.rds')
    names(r$tissue)[3] <- 'symbol'
    r_up <- lapply(r, FUN = function(x){subset(x, log2FoldChange > 0)})
    x$cell_up <- r_up$cell$symbol
    x$RRA_up <- readRDS('r_up.rds')
    x$RRA_up <- x$RRA_up$Name
    x$tissue_up <- r_up$tissue$symbol
    r_dn <- lapply(r, FUN = function(x){subset(x, log2FoldChange < 0)})
    x$cell_down <- r_dn$cell$symbol
    x$RRA_down <- readRDS('r_dn.rds')
    x$RRA_down <- x$RRA_down$Name
    x$tissue_down <- r_dn$tissue$symbol
    summary(x)

### 绘图1

    1
    2
    3
    4
    5
    6
    7
    8

    #载入所需的R包；
    library(ggplot2)
    library(ggsci)
    library(sf)
    library(ggVennDiagram)
    color4 <- alpha("#99CC00",0.5)
    ggVennDiagram(x[1:6], label_alpha=0) +
      scale_fill_gradient(low='white',high =color4)

### 绘图2

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22

    venn.plot <- venn.diagram(
        x = x[1:3],
        filename = NULL,
        cex = 2.5,
        cat.cex = 2.5,
        cat.dist = c(0.07, 0.07, 0.02),
        cat.pos = c(-20, 20, 20),
        alpha = 0.5,
        fill = c("#99CC00", "#c77cff", '#f8766d')
    );
    grid.draw(venn.plot)
    venn.plot <- venn.diagram(
        x = x[4:6],
        filename = NULL,
        cex = 2.5,
        cat.cex = 2.5,
        cat.dist = c(0.07, 0.07, 0.02),
        cat.pos = c(-20, 20, 20),
        alpha = 0.5,
        fill = c("#99CC00", "#c77cff", '#f8766d')
    );
    grid.draw(venn.plot)

## 附加：单细胞数据

### 第一步 读取数据

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    25
    26
    27
    28
    29
    30
    31
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45

    library(Seurat)
    library(plyr)
    library(dplyr)
    library(patchwork)
    library(purrr)
    f_metadata_removeNA <- function(sObject, lc_groupN){
        sObject@meta.data <- sObject@meta.data[colnames(sObject),]
        sObject <- subset(x = sObject, !!sym(lc_groupN)%in%f_br_cluster_f(sObject, lc_groupN))
        sObject
    }
    f_br_cluster_f <- function(sObject, lc_groupN){
        lc_filter <- unlist(unique(sObject[[lc_groupN]]))
        lc_filter <- lc_filter[!is.na(lc_filter)]
        lc_filter
    }

    scRNA_split = readRDS("~/zlliu/R_output/21.09.21.SingleR/scRNA.rds")
    scRNA_split <- f_metadata_removeNA(scRNA_split, 'Region')

    n_ExN <- c('L4 IT','L5 IT','L5 ET','IT','L6b','L5/6 IT Car3','L6 IT','L2/3 IT','L5/6 NP','L6 IT Car3','L6 CT')
    n_InN <- c('Lamp5','Pvalb','Sst','Vip','Sncg','PAX6')
    n_NoN <- c('Astro','Endo','Micro-PVM','OPC','Oligo','Pericyte','VLMC')
    n_groups <- list(NoN=n_NoN, ExN=n_ExN, InN=n_InN)

    f_listUpdateRe <- function(lc_obj, lc_bool, lc_item){
        lc_obj[lc_bool] <- rep(lc_item,times=sum(lc_bool))
        lc_obj
    }
    f_grouplabel <- function(lc_meta.data, lc_groups){
        res <- lc_meta.data[[1]]
        for(lc_g in names(lc_groups)){
            lc_bool = (res %in% lc_groups[[lc_g]])
            for(c_n in colnames(lc_meta.data)){
                lc_bool = lc_bool  (lc_meta.data[[c_n]] %in% lc_groups[[lc_g]])
            }
            res <- f_listUpdateRe(res, lc_bool, lc_g)
        }
        names(res) <- rownames(lc_meta.data)
        res
    }

    scRNA_split[['n_groups']] <- f_grouplabel(scRNA_split[[c("hM1_hmca_class")]], n_groups)
    sc_Neuron <- subset(x = scRNA_split, n_groups %in% c("InN", "ExN"))

    samples <- SplitObject(object = sc_Neuron, split.by = 'orig.ident')

### 第二步 计算差异基因

    1
    2
    3
    4
    5
    6

    DEGs <- list()
    for (name in names(samples)){
        tmp <- samples[[name]]
        Idents(tmp) <- 'Region'
        DEGs[[name]] = FindAllMarkers(tmp, only.pos = T)
    }

### 第三步 整合数据

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21

    f_dflist_subset <- function(dflist, nameN=NULL, ...){
        res <- list()
        for (name in names(dflist)){
            res[[name]] <- subset(dflist[[name]], ...)
        }
        res
    }
    require(RobustRankAggreg)
    f_dflist_RRA <- function(dflist, nameN, N, orderN, decreasing=T){
        res <- list()
        for (name in names(dflist)){
            tmp <- dflist[[name]]
            if (nrow(tmp) == 1){
                res[[name]] <- tmp[1, nameN]
            }else if(nrow(tmp) >=2){
                res[[name]] <- tmp[order(tmp[[orderN]],decreasing = decreasing), nameN]
            }
        }
        if(length(res) < 1){ return(NULL)}
        aggregateRanks(glist = res, N = N)
    }

    1
    2
    3
    4
    5
    6
    7
    8
    9

    res <- data.frame()
    for(name in unique(sc_Neuron@meta.data$Region)){
        tmp <- f_dflist_subset(DEGs, name, cluster==nameN)
        tmp <- f_dflist_RRA(tmp, 'gene', N=24223, 'avg_log2FC', decreasing = T)
        if(!is.null(tmp)){
            tmp[['cluster']] <- name
            res <- rbind(res, tmp)
        }
    }

### 第四步 保存结果

    1
    2
    3
    4
    5
    6
    7
    8
    9

    require(openxlsx)
    wb <- createWorkbook()
    for (name in names(samples)){
        addWorksheet(wb = wb, sheetName = name)
        writeData(wb = wb, sheet = name, x = DEGs[[name]])
    }
    addWorksheet(wb = wb, sheetName = 'RRA')
    writeData(wb = wb, sheet = 'RRA', x = res)
    saveWorkbook(wb, "DEG_Brain_Regin_Neuron.xlsx", overwrite = TRUE)

#DEGs #RRA
【迁移】从差异基因到RRA聚合
https://hexo.limour.top/cong-cha-yi-ji-yin-dao-RRA-ju-he
Author
Limour
Posted on
July 22, 2022
Updated on
March 19, 2024
Licensed under
【迁移】Counts矩阵的标准化方法：TMM和VST、RLOG Previous
【迁移】森林图展示回归分析的结果 Next

#### Search

Keyword