116-R可视化36-把你长长的坐标轴弄短

• 参考：
  • Line segments and curves — geom_segment • ggplot2 (tidyverse.org)[1]

前言

最近发现一张有意思的umap 图：

看起来，比传统的umap 好看一点？

正好来复习一下前面[[111-R可视化35-结合grid与ggplot输出]] 的用法。

这里可以用任意的umap 结果作为绘图输入。

准备工作

我们先来把ggplot 给“脱光”：

代码语言：javascript复制

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 方法。

代码语言：javascript复制

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 图层上：

代码语言：javascript复制

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 坐标的范围：

代码语言：javascript复制

> 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 上显示的长度相对较长，就会让我们错以为二者并非是等长的。

首先计算二者的长度：

代码语言：javascript复制

> 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数据乘这个比值，就可以让它们在同一比例下变化了。

代码语言：javascript复制

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 即可。

代码语言：javascript复制

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 是用来堆上去的。无所谓。

代码语言：javascript复制

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 调整坐标轴的操作即可：

代码语言：javascript复制

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 了吗？

代码语言：javascript复制

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 方法：

代码语言：javascript复制

(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是我最后的倔强

代码语言：javascript复制

(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

processing https html 网络安全

0 人点赞