R繪圖 | 啞鈴圖+區(qū)域放大

bang_zoom.jpg

整個(gè)新系列。目前的幾個(gè)系列， #R實(shí)戰(zhàn) 以生信分析為主， #跟著CNS學(xué)作圖 以復(fù)現(xiàn)頂刊Figure為主，而本系列 #R繪圖 則是學(xué)習(xí)不在文章中但同樣很好看的圖，致力于給同學(xué)們?cè)跀?shù)據(jù)可視化中提供新的思路和方法。

22

本期圖片

final.png

本圖的幾個(gè)難點(diǎn)：

1. 右側(cè)坐標(biāo)軸的建立及標(biāo)簽的添加
2. 背景虛線網(wǎng)格的繪制
3. 區(qū)域放大

示例數(shù)據(jù)和代碼領(lǐng)取

詳見(jiàn)：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')

# 為了繪制虛線背景建立的數(shù)據(jù) 根據(jù)實(shí)際數(shù)據(jù)調(diào)整
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") + # 虛線上的標(biāo)簽
  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, # 區(qū)域放大的虛線
           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
# 提取放大區(qū)域的數(shù)據(jù)
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)+ # 調(diào)整位置
  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)

往期內(nèi)容

1. (免費(fèi)教程+代碼領(lǐng)取)|跟著Cell學(xué)作圖系列合集
2. Q&A | 如何在論文中畫(huà)出漂亮的插圖？
3. Front Immunol 復(fù)現(xiàn) | 1. GEO數(shù)據(jù)下載及sva批次校正(PCA可視化)
4. R繪圖 | 氣泡散點(diǎn)圖+擬合曲線
5. 跟著 Cell 學(xué)作圖 | 桑葚圖(ggalluvial)
6. R繪圖 | 對(duì)比條形圖+連線
7. R繪圖 | 一幅小提琴圖的美化之旅

[圖片上傳失敗...(image-a773e3-1652152880196)]