R中的图片注释神包aplot

aplot(https://github.com/YuLab-SMU/aplot)是Y叔开发的一个基于主图，在其四周注释的神包，它与一般的patchwork、cowplot包略有不同，这2款在我看来属于将图片进行拼接，图与图之间无主次之分，虽然可以调整参数突出主图，但也是较为繁琐；而aplot包的出现正好解决了对主图进行注释这一痛点，值得一提的是Y叔曾对aplot包写了详细的说明文档，但是某一天突然间发现已经404，所幸之前有过学习使用，下面进行几个绘图案例，希望对大家有所帮助

案例一、heatmap

rm(list = ls())
pacman::p_load(tidyverse,ggtree,aplot,reshape,ggExtra)

d <- matrix(rnorm(25), ncol=5) %>% data.frame()

rownames(d) <- paste0('g', 1:5)
colnames(d) <- paste0('t', 1:5)

hc <- hclust(dist(d))  
hcc <- hclust(dist(t(d))) 
phr <- ggtree(hc)  #行聚类树
phc <- ggtree(hcc) + layout_dendrogram() #列聚类树

#d <- data.frame(d)

d$gene <- rownames(d) 
dd <- melt(d)

p <- ggplot(dd, aes(variable,gene,fill=value)) + geom_tile() + 
  scale_fill_viridis_c() +
  scale_y_discrete(position="right") +
  theme_minimal() + 
  xlab(NULL) + ylab(NULL) 

g <- ggplot(dplyr::filter(dd, gene != 'g2'), 
            aes(gene, value, 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) 

ca <- data.frame(variable = 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(variable, 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) 

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=.3)  %>% 
  insert_right(g, width=.4) %>% 
  insert_top(pc, height=.1) %>% 
  insert_top(phc, height=.2)

heatmap.jpeg
看着很复杂，但是逻辑很简单，基本就是ggplot2绘制出所有图，在通过aplot包再四周进行注释，理论上也可用于拼图，但是我本人目前拼图主要还是基于patchwork

案例二、散点图+边际密度图(1)

pp <- ggplot(iris,aes(Sepal.Length,Sepal.Width,color=Species))+
  geom_point()+theme_bw()+scale_color_lancet()

x <- ggplot(iris, aes(Sepal.Length, fill=Species)) + 
  geom_density(alpha=.5) +
  scale_fill_lancet()+
  expand_limits(x=0,y=0)+scale_y_continuous(expand=c(0,0))+
  theme_classic()+
  theme(axis.title.x =element_blank(),
        axis.text.x=element_blank(),
        axis.ticks.x=element_blank())+guides(fill=FALSE)

y <- ggplot(iris, aes(Sepal.Width, fill=Species)) + 
  geom_density(alpha=.5) +
  scale_fill_lancet() +
  expand_limits(x=0,y=0)+scale_y_continuous(expand=c(0,0))+
  theme_classic()+
  theme(axis.title.y =element_blank(),
        axis.text.y=element_blank(),
        axis.ticks.y=element_blank())+guides(fill=FALSE)+coord_flip()

pp %>%insert_right(y,width=.2) %>% insert_top(x,height=.3)

point.jpeg

散点图+边际密度图 (2)

install.packages("ggExtra")
library(ggExtra)
p <- ggplot(iris,aes(Sepal.Length,Sepal.Width,color=Species))+ 
  geom_point()+guides(color=FALSE)+theme_bw()
 
ggMarginal(p,type="density",groupFill=T)

point2.jpeg

aplot拼图的确是很方便，此外建议大家不要再用ggpubr包，它的存在很大一部分是制造混乱，希望以上内容对大家有帮助