R-可视化--ggplot绘制散点图添加边际图

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12

data("mtcars")
df <- mtcars
df$name <- rownames(df)
df$cyl <- as.factor(df$cyl)
head(df[,c("name","cyl","mpg","wt")])
#                                name cyl  mpg    wt
# Mazda RX4                 Mazda RX4   6 21.0 2.620
# Mazda RX4 Wag         Mazda RX4 Wag   6 21.0 2.875
# Datsun 710               Datsun 710   4 22.8 2.320
# Hornet 4 Drive       Hornet 4 Drive   6 21.4 3.215
# Hornet Sportabout Hornet Sportabout   8 18.7 3.440
# Valiant                     Valiant   6 18.1 3.460

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

library(cowplot) 
p_main = ggplot(df, aes(x = wt, y = mpg, color = cyl))+
  geom_point()

p_right = axis_canvas(p_main, axis = "x")+
  geom_density(data = df, aes(x = wt, fill = cyl),
              alpha = 0.7, size = 0.2)

p_top = axis_canvas(p_main, axis = "y", coord_flip = TRUE)+
  geom_density(data = df, aes(x = mpg, fill = cyl),
                alpha = 0.7, size = 0.2)+
  coord_flip()

p1 = insert_xaxis_grob(p_main, p_right, grid::unit(.2, "null"), position = "top")
p2 =  insert_yaxis_grob(p1, p_top, grid::unit(.2, "null"), position = "right")
ggdraw(p2)

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

library(patchwork)

p_main = ggplot(df, aes(x = wt, y = mpg, color = cyl)) + 
	geom_point() +
	theme(legend.position="bottom")
  
p_top = ggplot(df, aes(x = wt, color = cyl)) + 
	geom_boxplot() + theme_void() +
	theme(legend.position = "none")


p_right = ggplot(df, aes(x = mpg, color = cyl)) + 
	geom_boxplot() + theme_void() +
	theme(legend.position = "none") +
	coord_flip()

p = p_top + plot_spacer() + p_main + p_right +
    plot_layout(ncol = 2, nrow = 2, 
    			heights = c(1, 5),  
    			widths = c(5, 1))

1
2
3
4
5
6
7

library(ggpubr)
ggscatterhist(
	df, x = "wt", y = "mpg",
	color = "cyl",
	margin.plot = "density",  # ("density", "histogram", "boxplot"),
	margin.params = list(color = "black",fill="cyl")
)

 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

d <- group_by(mtcars, cyl) %>% summarize(mean=mean(disp), sd=sd(disp)) 
d2 <- dplyr::filter(mtcars, cyl != 8) %>% rename(var = cyl)

p1 <- ggplot(d, aes(x=cyl, y=mean)) + 
  geom_col(aes(fill=factor(cyl)), width=1) + 
  theme(legend.position='none')
p2 <- ggplot(d2, aes(var, disp)) +  #有意缺失cyl=8的数据
  geom_jitter(aes(color=factor(var)), width=.5) + 
  theme(legend.position='none')
p3 <- ggplot(filter(d, cyl != 4), aes(cyl, mean)) + #有意缺失cyl=4的数据
  geom_col(aes(fill=factor(cyl)), width=.6) + 
  theme(legend.position='none')

# (1) 左图：x轴未对齐
pp <- list(p1, p2, p3)
wrap_plots(pp, ncol=1) 
# (2) 中图：统一设置坐标轴范围
pp2 = list(
  p1 = p1 + xlim2(limits=c(3, 11)),
  p2 = p2 + xlim2(limits=c(3, 11)),
  p3 = p3 + xlim2(limits=c(3, 11))
)
wrap_plots(pp2, ncol=1)
# (3) 右图：统一匹配成P1的坐标轴范围
pp3 = list(
  p1 = p1,
  p2 = p2 + xlim2(p1),
  p3 = p3 + xlim2(p1)
)
wrap_plots(pp3, ncol=1)

 1
 2
 3
 4
 5
 6
 7
 8
 9
10

p <- ggplot(mtcars, aes(mpg, disp)) + geom_point()
p2 <- ggplot(mtcars, aes(mpg)) + 
  geom_density(fill='steelblue', alpha=.5) + 
  ggtree::theme_dendrogram()
p3 <- ggplot(mtcars, aes(x=1, y=disp)) + 
  geom_boxplot(fill='firebrick', alpha=.5) + 
  theme_void()
p %>% 
  insert_top(p2, height=.3) %>% 
  insert_right(p3, width=.1)

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

library(ggtree)
x <- rtree(10)
d <- data.frame(taxa=x$tip.label, value = abs(rnorm(10)))

# 树图
p <- ggtree(x) + geom_tiplab(align = TRUE) + xlim(NA, 3)
# 主图
p2 <- ggplot(d, aes(value, taxa)) +
  geom_col() +
  scale_x_continuous(expand=c(0,0)) 

p2 %>% insert_left(p)
# insert_left(p2, p)

 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

# 模拟表达矩阵
d <- matrix(rnorm(25), ncol=5)
rownames(d) <- paste0('g', 1:5)
colnames(d) <- paste0('t', 1:5)
## 宽变长
dd <- data.frame(d)
dd$gene <- rownames(d)
dd <- gather(dd, 1:5, key="condition", value='expr')

# 主图：表达热图
p <- ggplot(dd, aes(condition,gene, fill=expr)) + geom_tile() + 
  scale_fill_viridis_c() +
  scale_y_discrete(position="right") +
  theme_minimal() + 
  xlab(NULL) + ylab(NULL) 

# 聚类热图：分别对基因(行)/样本(列)
hc <- hclust(dist(d)) # 基因
phr <- ggtree(hc)
hcc <- hclust(dist(t(d))) # 样本
phc <- ggtree(hcc) + layout_dendrogram()

# 样本注释
ca <- data.frame(condition = paste0('t', 1:5), 
                 A1 = rep(LETTERS[1:2], times=c(3, 2)),
                 A2 = rep(letters[3:5], times=c(1, 3, 1))
)
cad <- gather(ca, A1, A2, key='anno', value='type')
pc <- ggplot(cad, aes(condition, y=anno, fill=type)) + geom_tile() + 
  scale_y_discrete(position="right") +
  theme_minimal() + 
  theme(axis.text.x = element_blank(), 
        axis.ticks.x = element_blank()) +
  xlab(NULL) + ylab(NULL) 
# 基因注释1：表达范围
g <- ggplot(dplyr::filter(dd, gene != 'g2'), aes(gene, expr, fill=gene)) + 
  geom_boxplot() + coord_flip() +
  scale_fill_brewer(palette = 'Set1') +
  theme_minimal() + 
  theme(axis.text.y = element_blank(), 
        axis.ticks.y = element_blank(),
        panel.grid.minor = element_blank(),
        panel.grid.major.y = element_blank()) +
  xlab(NULL) + ylab(NULL) 

# 基因注释2：所属通路
dp <- data.frame(gene=factor(rep(paste0('g', 1:5), 2)), 
                 pathway = sample(paste0('pathway', 1:5), 10, replace = TRUE))
pp <- ggplot(dp, aes(pathway, gene)) + 
  geom_point(size=5, color='steelblue') +
  theme_minimal() +
  theme(axis.text.x=element_text(angle=90, hjust=0),
        axis.text.y = element_blank(), 
        axis.ticks.y = element_blank()) +
  xlab(NULL) + ylab(NULL) 

p %>% insert_left(phr, width=.3) %>% 
  insert_right(pp, width=.4)  %>% 
  insert_right(g, width=.4) %>% 
  insert_top(pc, height=.1) %>% 
  insert_top(phc, height=.2)

 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

file <- system.file("extdata", "scRNA_dotplot_data.tsv.gz", package="aplot")
gene_cluster <- readr::read_tsv(file)
gene_cluster = gene_cluster %>% 
  dplyr::filter(Gene %in% sample(unique(gene_cluster$Gene),20))
head(gene_cluster)
# 每个基因在每个cluster的表达信息
# cell_ct 表示cluster的细胞数
# cell_exp_ct 表示cluster中表达该基因的细胞数
# count 表示cluster对于该基因的平均表达水平

# 主图Dotplot
dot_plot <- gene_cluster %>% 
  mutate(`% Expressing` = (cell_exp_ct/cell_ct) * 100) %>% # 计算基因表达百分比
  filter(count > 0, `% Expressing` > 1) %>% # 过滤低表达基因
  ggplot(aes(x=cluster, y = Gene, color = count, size = `% Expressing`)) + 
  geom_point() + 
  cowplot::theme_cowplot() + 
  theme(axis.line  = element_blank(),
        axis.ticks = element_blank()) +
  theme(axis.text.x = element_text(angle = 90, vjust = 0.5, hjust=1)) +
  ylab(NULL) +
  scale_color_gradientn(colours = viridis::viridis(20), limits = c(0,4), 
                        oob = scales::squish, name = 'log2 (count + 1)') +
  scale_y_discrete(position = "right")  # y轴基因名放右边

# 根据cluster--gene表达矩阵的聚类图
## 长变宽
mat <- gene_cluster %>% 
  select(Gene, cluster, count) %>%
  pivot_wider(names_from = cluster, values_from = count) %>% 
  data.frame() 
row.names(mat) <- mat$Gene  
mat <- mat[,-1] 

clust <- hclust(dist(mat %>% as.matrix()))  # 对基因(行)聚类
ggtree_plot <- ggtree::ggtree(clust)
v_clust <- hclust(dist(mat %>% as.matrix() %>% t())) # 对样本(列)聚类
ggtree_plot_col <- ggtree(v_clust) + layout_dendrogram()

## 注释样本类别
labels= ggplot(gene_cluster, aes(cluster, y=1, fill=Group)) + geom_tile() +
  scale_fill_brewer(palette = 'Set1',name="Cell Type") + 
  theme_void() 

dot_plot %>% 
  insert_left(ggtree_plot, width=.2) %>%
  insert_top(labels, height=.05) %>%
  insert_top(ggtree_plot_col, height=.1)