20240208_超越传统柱形图：双向叠加柱形图的设计与实现

双向叠加柱形图是一种独特的数据可视化工具，专门设计用于揭示和比较两组数据之间的对比关系。它通过在一个共同的基线上向相反方向展示柱形图的方式，有效地展现了数据集之间的正负差异或对比情况。与传统柱形图只能在单一方向上展示数据的局限性不同，双向叠加柱形图能够同时处理正向和负向数据，从而提供更全面的视角来观察数据之间的动态关系。

示例一：

> library(ggplot2) # Create Elegant Data Visualisations Using the Grammar of Graphics
> df <- read.table("data.txt",header = T,sep='\t')
> df$group <- factor(df$group,levels = c("HPRC.EAS","CPC"))
> df$sample <- factor(df$sample,levels = c("OR4K2","OR4K1","GRPIN2","OR9G1","SULT1A3","OR4Q3",
+                                          "PDPR","CYP2D6","PRAMEF18"))
> df$value <- ifelse(df$group=="HPRC.EAS",-df$value,df$value)
> df
     sample    group value
1  PRAMEF18 HPRC.EAS -0.20
2    CYP2D6 HPRC.EAS -0.05
3      PDPR HPRC.EAS -0.50
4     OR4Q3 HPRC.EAS -0.90
5   SULT1A3 HPRC.EAS -0.70
6     OR9G1 HPRC.EAS -0.30
7    GRPIN2 HPRC.EAS -0.40
8     OR4K1 HPRC.EAS -0.05
9     OR4K2 HPRC.EAS -0.10
10 PRAMEF18      CPC  0.70
11   CYP2D6      CPC  0.60
12     PDPR      CPC  0.20
13    OR4Q3      CPC  0.40
14  SULT1A3      CPC  0.10
15    OR9G1      CPC  0.05
16   GRPIN2      CPC  0.90
17    OR4K1      CPC  0.80
18    OR4K2      CPC  0.25
> col <- c("#f89f68","#4b84b3")
> ggplot(df,aes(sample,value,fill=group))+
+   geom_col(width = 0.8)+
+   coord_flip()+
+   scale_fill_manual(values = col)+
+   theme_bw()+
+   theme(panel.grid = element_blank(),
+         axis.text.x = element_text(color = "black", size = 13),
+         axis.text.y = element_text(color = "black",size = 14,face = "italic"),
+         axis.title = element_text(color = "black",size = 16),
+         legend.position = "top",
+         legend.title = element_blank(),
+         legend.text = element_text(color = "black",size = 15))+
+   labs(x=NULL,y="CNV Frequency")+
+   scale_y_continuous(breaks = seq(-1, 1, 0.5), 
+                      labels = as.character(abs(seq(-1, 1, 0.5))),
+                      limits = c(-1, 1))

示例二：

> df3 <- read.table("for_plot_100-10000-dark-light.txt", header = TRUE, sep = '\t', comment.char = "")
> sample_column <- df3$sample
> df3$sample <- factor(sample_column, levels = rev(unique(sample_column)))
> manual_color =  df3$Color
> manual_color = rev(unique(manual_color))
> df3
    sample           group       cutoff value   Color
1    l_100 maplength_ratio    m_0-0.001   -77 #ADD8E6
2    l_100 maplength_ratio m_0.001-0.01  -296 #8AADD4
3    l_100 maplength_ratio   m_0.01-0.1  -274 #6882C2
4    l_100 maplength_ratio    m_0.1-0.5   -55 #4556AF
5    l_100 maplength_ratio      m_0.5-1   -11 #232B9D
6    l_500 maplength_ratio    m_0-0.001    -7 #ADD8E6
7    l_500 maplength_ratio m_0.001-0.01  -174 #8AADD4
8    l_500 maplength_ratio   m_0.01-0.1  -249 #6882C2
9    l_500 maplength_ratio    m_0.1-0.5   -55 #4556AF
10   l_500 maplength_ratio      m_0.5-1   -11 #232B9D
11  l_1000 maplength_ratio    m_0-0.001    -1 #ADD8E6
12  l_1000 maplength_ratio m_0.001-0.01  -141 #8AADD4
13  l_1000 maplength_ratio   m_0.01-0.1  -236 #6882C2
14  l_1000 maplength_ratio    m_0.1-0.5   -53 #4556AF
15  l_1000 maplength_ratio      m_0.5-1   -11 #232B9D
16  l_5000 maplength_ratio    m_0-0.001     0 #ADD8E6
17  l_5000 maplength_ratio m_0.001-0.01   -59 #8AADD4
18  l_5000 maplength_ratio   m_0.01-0.1  -140 #6882C2
19  l_5000 maplength_ratio    m_0.1-0.5   -25 #4556AF
20  l_5000 maplength_ratio      m_0.5-1    -9 #232B9D
21 l_10000 maplength_ratio    m_0-0.001     0 #ADD8E6
22 l_10000 maplength_ratio m_0.001-0.01   -31 #8AADD4
23 l_10000 maplength_ratio   m_0.01-0.1   -65 #6882C2
24 l_10000 maplength_ratio    m_0.1-0.5    -8 #4556AF
25 l_10000 maplength_ratio      m_0.5-1    -7 #232B9D
26   l_100     depth_ratio    d_0-0.001     0 #FEE6DA
27   l_100     depth_ratio d_0.001-0.01   360 #FCBCA2
28   l_100     depth_ratio   d_0.01-0.1   338 #FC9373
29   l_100     depth_ratio     d_0.1-10    15 #FB6A49
30   l_500     depth_ratio    d_0-0.001     0 #FEE6DA
31   l_500     depth_ratio d_0.001-0.01   223 #FCBCA2
32   l_500     depth_ratio   d_0.01-0.1   260 #FC9373
33   l_500     depth_ratio     d_0.1-10    13 #FB6A49
34  l_1000     depth_ratio    d_0-0.001     0 #FEE6DA
35  l_1000     depth_ratio d_0.001-0.01   192 #FCBCA2
36  l_1000     depth_ratio   d_0.01-0.1   237 #FC9373
37  l_1000     depth_ratio     d_0.1-10    13 #FB6A49
38  l_5000     depth_ratio    d_0-0.001     0 #FEE6DA
39  l_5000     depth_ratio d_0.001-0.01    78 #FCBCA2
40  l_5000     depth_ratio   d_0.01-0.1   148 #FC9373
41  l_5000     depth_ratio     d_0.1-10     7 #FB6A49
42 l_10000     depth_ratio    d_0-0.001     0 #FEE6DA
43 l_10000     depth_ratio d_0.001-0.01    21 #FCBCA2
44 l_10000     depth_ratio   d_0.01-0.1    84 #FC9373
45 l_10000     depth_ratio     d_0.1-10     6 #FB6A49
> P2 <- ggplot(df3, aes(x = sample, y = value, fill = cutoff)) +
+   geom_col(width=0.5) +
+   #facet_grid(. ~ group, scales = "free", space = "free") +
+   coord_flip() +
+   #scale_fill_manual(values = c("small" = "#f89f68", "medium" = "#4b84b3", "large" = "#6d6d6d")) +
+   #scale_fill_manual(values = c("small_1" = "#ADD8E6", "medium_1" = "#8AADD4", "large_1" = "#6882C2","small" = "#FEE6DA", "medium" = "#FCBCA2", "large" = "#FC9373")) +
+   scale_fill_manual(values = c(manual_color)) +
+   theme_bw() +
+   theme(panel.grid = element_blank(),
+         axis.text.x = element_text(color = "black", size = 13),
+         axis.text.y = element_text(color = "black", size = 14, face = "italic"),
+         axis.title = element_text(color = "black", size = 16),
+         legend.position = "top",
+         legend.title = element_blank(),
+         legend.text = element_text(color = "black", size = 15)) +
+   labs(x = NULL, y = "Contig counts") + 
+   geom_hline(yintercept = 0, linetype = "dashed", color = "black") +  # 添加水平线
+   scale_y_continuous(labels = abs,breaks = seq(-max(1000), max(abs(1000)), by = 400))
> P2