# 单细胞水平的差异基因热图的一些展示方式

## 定义绘图函数

    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
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    90
    91
    92
    93
    94
    95
    96
    97
    98
    99
    100
    101
    102
    103
    104
    105
    106
    107
    108
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121

    library(Seurat)
    library(ggsci)
    library(tidyverse)

    f_df_order <- function(df, oN, groupN){
        df <- as.data.frame(df)
        for(oi in levels(df[[groupN]])){
            idx <- df[[groupN]] == oi
            tmp <- df[idx, ]
            tmp <- tmp[order(tmp[[oN]], decreasing = T),]
            df[idx, ] <- tmp
        }
        df
    }

    f_metaG2G <- function(metaG, matrixN=F, downSample=NULL){
        res  <- list()
        alltype <- unique(metaG[[1]])
        for(type in alltype){
            res[[type]] <- rownames(metaG)[metaG[[1]] == type]
            if (matrixN){
                res[[type]] <- gsub('-','.',res[[type]])
            }
        }
        if(!is.null(downSample)){
            pTb <- f_br_cluster(NULL, downSample, metaG)
            for (nM in colnames(pTb)){
                tmp <- pTb[nM]
                pTb[nM][tmp>0] <- min(tmp[tmp>0])
            }
            pTb <- apply(X = pTb, FUN = max, MARGIN=1)
            for(nM in names(pTb)){
                res[[nM]] <- sample(x = res[[nM]], size = pTb[nM])
            }
        }
        res
    }

    f_scale_t <- function(matrixA){
        t(scale(t(as.matrix(matrixA))))
    }
    f_matrix_groupMean <- function(matrixA, group, matrixN = T, normal_distribution=F, downSample=NULL, autoG2G=T, scale=F){
        if(!matrixN){
            matrixA <- as.data.frame(as.matrix(matrixA))
        }
        res <- data.frame(row.names = rownames(matrixA))
        if(autoG2G){
            group <- f_metaG2G(group, matrixN = matrixN, downSample = downSample)
        }
        matrixA <- matrixA[, Reduce(x = group, f = c)]
        if(!normal_distribution){
            matrixA <- f_rank_transformation(matrixA)
        }else{
            if(scale){
                matrixA <- f_scale_t(matrixA)
            }
        }
        rowF <- rowMeans
        for(name in names(group)){
            if (length(group[[name]]) == 1){
                res[[name]] <- matrixA[,group[[name]]]
            }else{
                res[[name]] <- rowF(matrixA[,group[[name]]])
            }
        }
        res
    }
    f_matrix_groupMean_g <- function(groupN, matrixA, group, matrixN = T, normal_distribution=F, autoG2G=T, scale=F){
        if(!matrixN){
            matrixA <- as.data.frame(as.matrix(matrixA))
        }
        res <- data.frame(row.names = rownames(matrixA))
        if(autoG2G){
            group <- f_metaG2G(group, matrixN = matrixN, downSample = downSample)
        }
        group <- Reduce(x = group, f = c)
        matrixA <- matrixA[, group]
        if(!normal_distribution){
            matrixA <- f_rank_transformation(matrixA)
        }else{
            if(scale){
                matrixA <- f_scale_t(matrixA)
            }
        }
        groupN <- f_metaG2G(groupN, matrixN = matrixN)
        rowF <- rowMeans
        for(name in names(groupN)){
            tmp <- (group %in% groupN[[name]])
            if (sum(tmp) == 1){
                res[[name]] <- matrixA[,tmp]
            }else{
                res[[name]] <- rowF(matrixA[,tmp])
            }
        }
        res
    }
    require(reshape2)
    require(ggplot2)
    f_matrix_heatmap <- function(dfA, levels = NULL, xlevels=NULL){
        # 转换前，先增加一列ID列，保存行名字
        dfA <- as.data.frame(dfA)
        dfA$df_ID <- rownames(dfA)
        dfm <- melt(dfA, na.rm = T, id.vars = c('df_ID'))
        if(is.null(xlevels)){
            dfm$variable <- factor(x = as.character(dfm$variable), ordered = T)
        }else{
            dfm$variable <- factor(x = as.character(dfm$variable), levels = xlevels)
        }
        if (length(levels) > 0){
            dfm$df_ID  <- factor(x = as.character(dfm$df_ID), levels = rev(levels))
        }
        p <- ggplot(dfm, aes(x=variable, y=df_ID))
        p <- p + geom_tile(aes(fill=value))
        p <- p + scale_fill_gradient(low = 'white', high = 'red')
    #     p <- p + scale_fill_gradient(low = 'steel blue', high = 'pink')
    #     p <- p + scale_fill_gradientn(colours = c('#3E5CC5','#65B48E','#E6EB00','#E64E00'))
        p <- p + xlab("samples") + theme_bw() + theme(panel.grid.major = element_blank()) + theme(legend.key=element_blank())
        p <- p + theme(axis.text.x=element_text(angle=45, hjust=1, vjust=1))
        p <- p + labs(x=NULL, y=NULL) # 删除xy轴标题
        p
    }

## Seurat自带的绘图

    1
    2
    3
    4
    5

    topgene <- FindAllMarkers(sce, only.pos = TRUE, min.pct = 0.25, logfc.threshold = 0.25)
    topgene %>%
        group_by(cluster) %>%
        top_n(n = 10, wt = avg_log2FC) %>%
        f_df_order('avg_log2FC', 'cluster') -> top10

    1
    2
    3
    4
    5

    p <- DoHeatmap(sce, features = top10$gene, assay = 'integrated', label = F, disp.min = -0.5, disp.max = 1) +  scale_fill_gradientn(colours = c('#3E5CC5','#65B48E', '#E6EB00','red'))
    ggsave(p, filename = 'fig1.C1_12inch.pdf', width = 12, height = 12)

    p <- DoHeatmap(sce, features = top10$gene, assay = 'integrated', label = F, disp.min = -0.5, disp.max = 1) + scale_fill_gradient(low = 'white', high = 'red')
    ggsave(p, filename = 'fig1.C3_12inch.pdf', width = 12, height = 12)

## 转换成均值再绘图

    1
    2
    3

    grp <- f_metaG2G(metaG = as.data.frame(Idents(sce)), matrixN = F)
    p <- f_matrix_heatmap(scale(f_matrix_groupMean(mat, group = grp, autoG2G = F, normal_distribution = T, scale = T)), levels = top10$gene, xlevels = levels(sce))
    ggsave(p, filename = 'fig1.Cm_12inch.pdf', width = 12, height = 12)

生信 绘图
单细胞水平的差异基因热图的一些展示方式
https://occdn.limour.top/1571.html
Author
Limour
Posted on
February 25, 2022
Licensed under
单细胞水平的细胞周期评分 Previous
一些常见图的美化 Next

#### Search

Keyword