一些常见图的美化

发布于 2022-02-11  385 次阅读


火山图

  • https://mp.weixin.qq.com/s/TvAor9voh_kDnIxsC-U48w
  • https://www.bioconductor.org/packages/release/bioc/vignettes/EnhancedVolcano/inst/doc/EnhancedVolcano.html
library(EnhancedVolcano)
data <- read.csv('findmarkers_all.csv', row.names = 1)
pdf('EnhancedVolcano.pdf', width = 9, height = 9)
EnhancedVolcano(data,
    lab = rownames(data),
    x = 'avg_log2FC',
    y = 'p_val_adj',  pCutoff = 1e-10)
dev.off()

 

和弦图

  • https://blog.csdn.net/weixin_43528109/article/details/83819728
  • https://my.oschina.net/u/4579431/blog/4347371
require(reshape2)
require(circlize)
f_CC_nV_o <- function(cellchat, measure='count', LC="HSPC", RC="CRPC", use.Pos = T, use.mat = F, lc_filter=NULL){
    mat <- cellchat@net[[RC]][[measure]] - cellchat@net[[LC]][[measure]]
    if(!is.null(lc_filter)){
        mat <- mat[lc_filter, lc_filter]
    }
    if(use.Pos){
        mat[mat < 0] = 0
    }else{
        mat[mat > 0] = 0
        mat  <- -mat
    }
    if(!use.mat){
        mat <- melt(mat)
        mat <- mat[mat$value > 0, ]
        colnames(mat) <- c('from', 'to', 'value')
    }
    mat
}
f_CC_nV_sp <- function(mat, Nuse, is.source=T, track.height=0.3, ...){
    if(is.source){
        mat <- mat[mat$from %in% Nuse,]
        idx <- order(mat$value)
        mat$to <- as.character(mat$to)
        mat <- mat[idx,]
        mat$to <- factor(mat$to)
    }else{
        mat <- mat[mat$to %in% Nuse,]
        idx <- order(mat$value)
        mat$from <- as.character(mat$from)
        mat <- mat[idx,]
        mat$from <- factor(mat$from)
    }
    chordDiagram(mat, annotationTrack = c("grid", "axis"), preAllocateTracks = 1,...)
    circos.trackPlotRegion(track.height=track.height, ylim = c(0, 1), panel.fun = function(x, y) {
        xlim = get.cell.meta.data("xlim")
        ylim = get.cell.meta.data("ylim")
        sector.name = get.cell.meta.data("sector.index")
        xplot = get.cell.meta.data("xplot")
        circos.text(mean(xlim), 0.5, sector.name, facing = "clockwise", niceFacing = T, track.index = 3)
    }, bg.border = NA)
    circos.clear()
}

 

pdf(file = 'nV_up_number_of_interactions_fF.pdf', height = 48, width = 24)
par(mfrow = c(3,2), xpd=TRUE)
f_CC_nV_sp(f_CC_nV_o(SS, lc_filter = flt), 'Fibroblasts')
f_CC_nV_sp(f_CC_nV_o(SS, measure = "weight", lc_filter = flt), 'Fibroblasts')
f_CC_nV_sp(f_CC_nV_o(ER, lc_filter = flt), 'Fibroblasts')
f_CC_nV_sp(f_CC_nV_o(ER, measure = "weight", lc_filter = flt), 'Fibroblasts')
f_CC_nV_sp(f_CC_nV_o(CC, lc_filter = flt), 'Fibroblasts')
f_CC_nV_sp(f_CC_nV_o(CC, measure = "weight", lc_filter = flt), 'Fibroblasts')
dev.off()

pdf(file = 'nV_up_number_of_interactions_tF.pdf', height = 48, width = 24)
par(mfrow = c(3,2), xpd=TRUE)
f_CC_nV_sp(f_CC_nV_o(SS, lc_filter = flt), 'Fibroblasts', is.source = F)
f_CC_nV_sp(f_CC_nV_o(SS, measure = "weight", lc_filter = flt), 'Fibroblasts', is.source = F)
f_CC_nV_sp(f_CC_nV_o(ER, lc_filter = flt), 'Fibroblasts', is.source = F)
f_CC_nV_sp(f_CC_nV_o(ER, measure = "weight", lc_filter = flt), 'Fibroblasts', is.source = F)
f_CC_nV_sp(f_CC_nV_o(CC, lc_filter = flt), 'Fibroblasts', is.source = F)
f_CC_nV_sp(f_CC_nV_o(CC, measure = "weight", lc_filter = flt), 'Fibroblasts', is.source = F)
dev.off()

 

饼图

library(RColorBrewer)
library(ggplot2)
library(ggrepel)
library(plyr)
library(dplyr)
library(patchwork)
library(purrr)
blank_theme <- theme_minimal()+
    theme(
        axis.title.x = element_blank(),
        axis.text.x=element_blank(),
        axis.title.y = element_blank(),
        axis.text.y=element_blank(),
        panel.border = element_blank(),
        panel.grid=element_blank(),
        axis.ticks = element_blank(),
        plot.title=element_text(size=14, face="bold",hjust = 0.5)
    )
col_Paired <- colorRampPalette(brewer.pal(12, "Paired"))
f_pie <- function(lc_x, lc_main, lc_x_p = 1.3, lc_r = T){
    lc_cols <- col_Paired(length(lc_x))
    lc_v <- as.vector(100*lc_x)
    lc_df <- data.frame(type = names(lc_x), nums = lc_v)
    lc_df <- lc_df[order(lc_df$type),]
    lc_percent = sprintf('%0.2f%%',lc_df$nums)
    if(lc_r){
        lc_df$pos <- with(lc_df, 100-cumsum(nums)+nums/2)
    }else{
        lc_df$pos <- with(lc_df, cumsum(nums)-nums/2)
    } 
    lc_pie <- ggplot(data = lc_df, mapping = aes(x = 1, y = nums, fill = type)) + geom_bar(stat = 'identity')
#     print(lc_df)
#     print(lc_pie)
    lc_pie <- lc_pie + coord_polar("y", start=0, direction = 1) + scale_fill_manual(values=lc_cols) + blank_theme 
    lc_pie <- lc_pie + geom_text_repel(aes(x = lc_x_p, y=pos),label= lc_percent, force = T, 
                        arrow = arrow(length=unit(0.01, "npc")), segment.color = "#cccccc", segment.size = 0.5)
    lc_pie <- lc_pie + labs(title = lc_main)
    lc_pie
}
 
f_pie_metaN <- function(sObject, lc_group.by=NULL){
    if(!is.null(lc_group.by)){
        sObject = sObject[[lc_group.by]]
    }else{
        lc_group.by = colnames(sObject)
    }
    tp_data <- prop.table(table(sObject))
    f_pie(tp_data, sprintf('Proportion of %s', lc_group.by))
}

 

点图

p <- DotPlot(sce, features = marker$marker)+coord_flip()+theme_bw() 
p <- p + theme(panel.grid=element_blank(), axis.text.x=element_text(angle= 45,hjust = 1,vjust= 0.5))
p <- p + scale_color_gradientn(values= seq(0,1,0.2),colours = c( '#330066', '#336699', '#66CC66', '#FFCC33'))
p <- p + labs(x=NULL, y=NULL)
p <- p +guides(size=guide_legend(order= 3)) 

 

UMAP图

library(Seurat)
library(ggsci)
length(levels(sce@meta.data$cell_type_fig1spA))
p <- DimPlot(sce, reduction = 'umap', group.by = 'cell_type_fig1spA', label = T, repel = T, cols = pal_d3("category20", alpha = 0.6)(19), pt.size = 1)
p
ggsave(p, filename = 'fig1.SpA_12inch.pdf', width = 12, height = 12)

 


医学生