【奇技淫巧】：单细胞monocle2结果添加类似RNA velocity 的箭头指示拟时方向

这是一篇修饰作图的内容，算是“奇技淫巧”，有一定的用处。小伙伴的脑洞和需求真的是无奇不有，是这样的，小伙伴没有跑速率（如果有了RNA 速率结果，这个修饰也不需要了），想使用类似于RNA速率的箭头指示自己monocle2的结果，也就是在monocle2拟时结果上加箭头。思路也简单，就是加箭头，指示方向就可以了（箭头没有任何意义）。这里我们使用metR包添加。这个包的初衷是供大气科学研究人员使用，这里我们借用借用。

metR github：https://github.com/eliocamp/metR

安装包：

install.packages("metR")
citation("metR")
#> To cite metR in publications use:
#> 
#> 
#> 
#> A BibTeX entry for LaTeX users is
#> 
#>   @Manual{,
#>     title = {metR: Tools for Easier Analysis of Meteorological Fields},
#>     author = {Elio Campitelli},
#>     year = {2021},
#>     note = {R package version 0.18.0},
#>     url = {https://eliocamp.github.io/metR/},
#>     doi = {10.5281/zenodo.2593516},
#>   }

首先我们跑一个monocle2流程结果：参考（(视频教程): Monocle2安装包测试、分析流程及可视化修饰）。自己数据按照流程跑就可以了。

library(monocle)

#先跑一下monocle构建cds object
#按照monocle流程即可
#run monocle2
sce_CDS <- ks_run_Monocle2(object = cytotrace2_sce,
                           layer = 'counts',
                           assay = "RNA",
                           VARgenesM="dispersionTable",
                           cellAnno = "cluster")

# plot_cell_trajectory(sce_CDS,show_branch_points = F,color_by = "Pseudotime",cell_size = 3)+
#   scale_color_gradientn(colours = colorRampPalette(c('blue','green','yellow','red'))(100))
# 
# plot_cell_trajectory(sce_CDS,show_branch_points = T,color_by = "State",cell_size = 3)
# 
# plot_cell_trajectory(sce_CDS,show_branch_points = F,color_by = "cluster",cell_size = 3)+
#   theme_dr(arrow = grid::arrow(length = unit(0, "inches")))+
#   theme(panel.grid.major = element_blank(),
#         panel.grid.minor = element_blank())+
#   scale_color_manual(values = c("#E69253", "#EDB931", "#E4502E", "#4378A0"))

# plot_cell_trajectory(sce_CDS,show_branch_points = F,color_by = "Pseudotime",cell_size = 3)+
#   scale_color_gradientn(colours = colorRampPalette(c('blue','green','yellow','red'))(100))
# 
# plot_cell_trajectory(sce_CDS,show_branch_points = T,color_by = "State",cell_size = 3)
# 
# plot_cell_trajectory(sce_CDS,show_branch_points = F,color_by = "cluster",cell_size = 3)+
#   theme_dr(arrow = grid::arrow(length = unit(0, "inches")))+
#   theme(panel.grid.major = element_blank(),
#         panel.grid.minor = element_blank())+
#   scale_color_manual(values = c("#E69253", "#EDB931", "#E4502E", "#4378A0"))

image.png

#提取坐标信息，ggplot作图修饰
library(ggplot2)
library(dplyr)
library(tibble)


data_df <- t(reducedDimS(sce_CDS)) %>% as.data.frame() %>% 
  select(Component_1 = 1, Component_2 = 2) %>% 
  rownames_to_column("cells") %>% 
  mutate(pData(sce_CDS)$State) %>% 
  mutate(pData(sce_CDS)$Pseudotime, 
         pData(sce_CDS)$orig.ident, 
         pData(sce_CDS)$cluster)

colnames(data_df) <- c("cells","Component_1","Component_2","State",
                       "Pseudotime","orig.ident","cluster")

plot：

ggplot(data_df, aes(x=Component_1,y=Component_2)) +
  geom_point(aes(color=Pseudotime))+
  scale_color_gradientn(colours = colorRampPalette(c('blue','green','yellow','red'))(100))+

  geom_arrow(data = data_df %>% filter(State=='1'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1-90, Component_2-90)),
             skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='3'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1-90, Component_2-90)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='4'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1, Component_2)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='5'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1+2, Component_2+2)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='6'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1, Component_2)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='8'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1+3, Component_2+3)),skip=0.8)+

  #主题修饰
  theme_dr(arrow = grid::arrow(length = unit(0, "inches")))+
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

image.png

结合celltype展示可能更好：

ggplot(data_df, aes(x=Component_1,y=Component_2)) +
  geom_point(aes(color=cluster),size=2)+
  scale_color_manual(values = c("#E69253", "#EDB931", "#E4502E", "#4378A0"))+

  geom_arrow(data = data_df %>% filter(State=='1'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1-90, Component_2-90)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='3'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1-90, Component_2-90)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='4'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1, Component_2)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='5'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1+2, Component_2+2)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='6'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1, Component_2)),skip=0.8)+

  geom_arrow(data = data_df %>% filter(State=='8'),
             aes(mag = Mag(Component_1, Component_2), 
                 angle = Angle(Component_1+3, Component_2+3)),skip=0.8)+
  #主题修饰
  theme_dr(arrow = grid::arrow(length = unit(0, "inches")))+
  theme(panel.grid.major = element_blank(),
        panel.grid.minor = element_blank())

image.png

这样就完成了，满足了我的虚荣心！