R绘图 | 哑铃图+区域放大

R绘图 | 哑铃图+区域放大

bang_zoom.jpg

整个新系列。目前的几个系列， #R实战 以生信分析为主， #跟着CNS学作图 以复现顶刊Figure为主，而本系列 #R绘图 则是学习不在文章中但同样很好看的图，致力于给同学们在数据可视化中提供新的思路和方法。

22

本期图片

final.png

本图的几个难点：

1. 右侧坐标轴的建立及标签的添加
2. 背景虚线网格的绘制
3. 区域放大

示例数据和代码领取

详见：https://mp.weixin.qq.com/s/W6c2DiiTD_TA3adoD8DXjg

绘制

rm(list = ls())
library(tidyverse)
library(patchwork)
library(ggtext)
library(showtext)

pumpkins_clean = read.csv('pumpkins_clean.csv')

# 为了绘制虚线背景建立的数据 根据实际数据调整
axis_wl <- tibble(x = c(0, 3500, 8000, 10000, 10000, 13000),
                  xend = 15000,
                  y = seq(0,2500,500),
                  yend = seq(0,2500,500))

giant_pumpkins <- ggplot(pumpkins_clean)+
  geom_segment(data = axis_wl, 
               aes(x= x, xend = xend, y =y, yend = yend), 
               linetype = "13", color = "black") + # 虚线背景
  geom_text(data = axis_wl, 
            aes(x = xend, y = y, label = glue::glue("{y} lbs")),  # 添加单位
            hjust = 1, nudge_y = 100, color = "black") + # 虚线上的标签
  geom_segment(aes(x = idx, xend = idx, y = weight_lbs, yend = est_weight),  
               alpha = 1, size = 0.2, color = "#e4eff8")+
  geom_point(aes(x = idx, y = weight_lbs), 
             color = "#9bbaf1", alpha = 0.8, size = 1) +
  geom_point(aes(x = idx, y = est_weight), 
             color = "#fe929a", alpha = 0.4, size = 1) +
  annotate("segment", x = 7000, xend = 10000, y = 1200, yend=1500, # 区域放大的虚线
           color = "black", linetype = "13") +
  annotate("segment", x = 7000, xend = 10000, y = 2700, yend=2000, 
           color = "black", linetype = "13") +
  scale_y_continuous(limits = c(0,2700)) +
  theme_void()+
  theme(plot.background = element_rect(color = NA))

giant_pumpkins

#Zoom on 1500 - 2000 lbs
# 提取放大区域的数据
zoom_data <- pumpkins_clean %>%
  filter(between(weight_lbs, 1500, 2000))%>%
  arrange(weight_lbs) %>%
  mutate(idx = row_number())

zoom_plt <- zoom_data %>%
  ggplot()+
  geom_segment(aes(x = idx, xend = idx, y = weight_lbs, yend = est_weight),
               alpha = 1, size = 0.4, color = "#e4eff8")+
  geom_point(aes(x = idx, y = weight_lbs), 
             color = "#9bbaf1", alpha = 1, size = 1.5) +
  geom_point(aes(x = idx, y = est_weight), 
             color = "#fe929a", alpha = 1, size = 1.5) +
  scale_y_continuous(limits = c(1500, 2000)) +
  theme_void()+
  theme(plot.background = element_rect(fill = NA, color = "grey80", size = 2))

zoom_plt

# 合并图片
final <- giant_pumpkins + inset_element(zoom_plt, 0.05, 0.45, 0.465, 0.96)+ # 调整位置
  plot_annotation(
    title = "Great Pumpkins Commonwealth Weigh-off",
    theme=theme(
      plot.title = element_text( size = 12, color = "black", hjust = 0.5, margin = margin(5,0,10,0)),
    )
  )


final
# 保存图片为png
ggsave("final.png", 
       final, 
       height = 4, width = 6,
       dpi = 300,
       bg = "white")

[图片上传失败...(image-dceda9-1652152880196)]

参考

• cnicault/tidytuesday: My contribution to the #TidyTuesday challenge, with the visualizations and code (github.com)

往期内容

1. (免费教程+代码领取)|跟着Cell学作图系列合集
2. Q&A | 如何在论文中画出漂亮的插图？
3. Front Immunol 复现 | 1. GEO数据下载及sva批次校正(PCA可视化)
4. R绘图 | 气泡散点图+拟合曲线
5. 跟着 Cell 学作图 | 桑葚图(ggalluvial)
6. R绘图 | 对比条形图+连线
7. R绘图 | 一幅小提琴图的美化之旅

---

[图片上传失败...(image-a773e3-1652152880196)]