116-R可视化36-把你长长的坐标轴弄短
- 参考：
- Line segments and curves — geom_segment • ggplot2 (tidyverse.org)[1]
前言
最近发现一张有意思的umap 图：
看起来，比传统的umap 好看一点？
正好来复习一下前面[[111-R可视化35-结合grid与ggplot输出]] 的用法。
这里可以用任意的umap 结果作为绘图输入。
准备工作
我们先来把ggplot 给“脱光”：
pacman::p_load(ggplot2, tidyverse, grid)
median_df <- cell_reduction_df %>% group_by(cell_anno) %>%
summarise(median.1 = median(UMAP_1),
median.2 = median(UMAP_2))
(p1 <- ggplot() + scattermore::geom_scattermore(data = cell_reduction_df,
aes_string(x = "UMAP_1", y = "UMAP_2",
color = "cell_anno")) +
theme_bw() +
theme(
panel.grid = element_blank(),
plot.background = element_blank(),
panel.border = element_blank(),
plot.title = element_text(hjust = 0.5,
size = 16),
axis.ticks = element_blank(),
axis.line = element_blank(),
axis.text = element_blank(),
legend.title = element_blank(),
legend.text = element_text(size = 12)
) +
labs(title = "Example_Umap", x = NULL, y = NULL) +
guides(color = "none")
+ ggrepel::geom_text_repel(data = median_df,
aes(median.1,
median.2, label = cell_anno),
min.segment.length = 0, size = 5))
ggplot 自带方法
主要利用的是ggplot 自带的geom_segment 方法。
umap1_range <- range(cell_reduction_df$UMAP_1)
umap2_range <- range(cell_reduction_df$UMAP_2)
segment.df <- data.frame(x=c(umap1_range[1] - 2, umap1_range[1] - 2),
xend=c(umap1_range[1] + 5, umap1_range[1] - 2),
y=c(umap2_range[1] - 2, umap2_range[1] - 2),
yend=c(umap2_range[1] - 2, umap2_range[1] + 5))
ggplot() + geom_segment(data = segment.df,
mapping = aes(x=x,xend=xend,
y=y,yend=yend),
arrow = arrow(length=unit(0.3, "cm")),size=1)
得到了等长的线段。
这时候直接把这个geom_segment结果添加到原本的ggplot 图层上：
p1 + geom_segment(data = segment.df,
mapping = aes(x=x,xend=xend,
y=y,yend=yend),
arrow = arrow(length=unit(0.3, "cm")),size=1)
可见这个segment 映射到umap 的结果里，画出来的感觉就非常奇怪了。二者的长度忽然并不相等了。
我们来看看umap 坐标的范围：
> range(cell_reduction_df$UMAP_1)
[1] -7.486754 11.550125
> range(cell_reduction_df$UMAP_2)
[1] -11.96239 15.23803
umap1的长度为18左右，而umap2 则为26左右。而因为二者的长度并不相同，如果在图上显示等长的线段，因为比例的差异，UMAP_1 上显示的长度相对较长，就会让我们错以为二者并非是等长的。
首先计算二者的长度：
> umap1_len <- max(cell_reduction_df$UMAP_1)-min(cell_reduction_df$UMAP_1)
> umap2_len <- max(cell_reduction_df$UMAP_2)-min(cell_reduction_df$UMAP_2)
> umap1_len
[1] 19.03688
> umap2_len
[1] 27.20042
然后计算其比值，让其中一组segment数据乘这个比值，就可以让它们在同一比例下变化了。
segment.df <- data.frame(x=c(umap1_range[1] - 2, umap1_range[1] - 2),
xend=c(umap1_range[1] - 2 + 7*umap_prop, umap1_range[1] - 2),
y=c(umap2_range[1] - 2, umap2_range[1] - 2),
yend=c(umap2_range[1] - 2, umap2_range[1] + 5))
不难发现，这个方法还是蛮麻烦的。
而且如果我想要给小坐标图坐标轴加点文字，就得用geom_text 在坐标里寻找它们的位置了。
如果是拼图呢？
可直接拼接的话，是没有办法得到这种覆盖的效果。
把图层叠加上去
在[[111-R可视化35-结合grid与ggplot输出]] 我们提过结合不同输出的各种方法，同时也提到了可以通过annotation_custom 或是grid_panel的方法直接实现不同ggplot 图层的叠加：
但问题是，这种方法是无法在坐标框以外的位置添加的。
看来只能是使用newpage = F 的思路。
因为只需要把新的图层堆上去，我们也无需有坐标长度的负担，直接建立一个 1,1 长度的segment 即可。
segment.df <- data.frame(x=c(0,0),
xend=c(1,0),
y=c(0,0),
yend=c(0,1))
(p2 <- ggplot() + geom_segment(data = segment.df,
mapping = aes(x=x,xend=xend,
y=y,yend=yend),
arrow = arrow(length=unit(0.3, "cm")),size=1) +
theme_bw() +
theme(
panel.grid = element_blank(),
plot.background = element_blank(),
panel.border = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_text(size = 30)
) + labs(x = "UMAP1", y = "UMAP2"))
先让字稍微大点吧，防近视。
其实这里x,y 距离看着蛮难受的，但反正p2 是用来堆上去的。无所谓。
segment.df <- data.frame(x=c(0,0),
xend=c(1,0),
y=c(0,0),
yend=c(0,1))
(p2 <- ggplot() + geom_segment(data = segment.df,
mapping = aes(x=x,xend=xend,
y=y,yend=yend),
arrow = arrow(length=unit(0.3, "cm")),size=1) +
theme_bw() +
theme(
panel.grid = element_blank(),
plot.background = element_blank(),
panel.border = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_text(size = 10)
) + labs(x = "UMAP1", y = "UMAP2"))
p1
md_inset <- viewport(x = 0.02, y = 0.02,
just = c("left", "bottom"),
width = 0.15, height = 0.15)
pushViewport(md_inset)
print(p2, newpage = F)
不过这个也有问题，如果存在细胞分群在下面的位置呢？
直接压上去似乎也并不好看。
改善一下位置
其实使用[[57-R可视化6-ggplot2三部曲最终之进阶为菜鸟]] 就多次提及的coord_cartesian 调整坐标轴的操作即可：
expand_y <- c(umap2_range[1]*1.3,umap2_range[2])
expand_x <- c(umap1_range[1]*1.3,umap2_range[2])
pp1 <- p1 + theme_bw()
pp2 <- p1 + coord_cartesian(ylim = expand_y, xlim = expand_x) + theme_bw()
cowplot::plot_grid(pp1, pp2)
这位置不就空出来给segment 了吗？
p1_expand <- p1 + coord_cartesian(ylim = expand_y, xlim = expand_x)
(p2 <- ggplot() + geom_segment(data = segment.df,
mapping = aes(x=x,xend=xend,
y=y,yend=yend),
arrow = arrow(length=unit(0.3, "cm")),size=1) +
theme_bw() +
theme(
panel.grid = element_blank(),
plot.background = element_blank(),
panel.border = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_text(size = 10)
) + labs(x = "UMAP1", y = "UMAP2"))
p1_expand
md_inset <- viewport(x = 0.02, y = 0.02,
just = c("left", "bottom"),
width = 0.15, height = 0.15)
pushViewport(md_inset)
print(p2, newpage = F)
唯一的麻烦就在于，不能快乐的使用ggsave 保存对象了。
似乎左下角的箭头被遮住了似的。
用图层叠放函数方法
反正坐标空隙都已经出来了，即使是在坐标轴的图层位置叠放，也不难看的。
再尝试一下annotation_custom 方法：
(p2 <- ggplot() + geom_segment(data = segment.df,
mapping = aes(x=x,xend=xend,
y=y,yend=yend),
arrow = arrow(length=unit(0.3, "cm")),size=1) +
theme_bw() +
theme(
panel.grid = element_blank(),
plot.background = element_blank(),
panel.border = element_blank(),
axis.ticks = element_blank(),
axis.line = element_blank(),
axis.text = element_blank(),
axis.title = element_text(size = 10)
) + labs(x = "UMAP1", y = "UMAP2"))
p2 <- ggplotGrob(p2)
p1_expand <- p1 + coord_cartesian(ylim = expand_y, xlim = expand_x)
(p_all <- p1_expand + annotation_custom(p2, xmin=0.02,xmax=0.17,ymin=0.02,ymax=0.17))
似乎annotation_custom 并不吃这一套。
而没有位置参数的grid_panel 也吃瘪了。
拆成grob是我最后的倔强
(p1_expand <- p1 + coord_cartesian(ylim = expand_y, xlim = expand_x))
md_inset <- viewport(x = 0.02, y = 0.02,
just = c("left", "bottom"),
width = 0.15, height = 0.15)
pushViewport(md_inset)
grid.draw(ggplotGrob(p2))
另外也发现，上面的箭头遮挡问题，仅仅是Rstudio 预览视图的相对压缩造成的。
所以newpage 方法，也没问题。
其他包
之前也看过一个 magick 包。
The magick package: Advanced Image-Processing in R • magick (ropensci.org)[2]
直接从图片而非绘图对象的层面把内容添加上去：
也是一个比较自由的解决方案。
实在不行，还是ppt吧
你懂我意思吧。
好久没有像今天这样专注于写推送了，真快乐。
参考资料
[1]
Line segments and curves — geom_segment • ggplot2 (tidyverse.org): https://ggplot2.tidyverse.org/reference/geom_segment.html
[2]
The magick package: Advanced Image-Processing in R • magick (ropensci.org): https://docs.ropensci.org/magick/articles/intro.html
腾讯云开发者
