🤩 Circular lollipop | 哇咔咔！！！环形棒棒糖图好吃又好玩！~

生信漫卷

发布于 2023-09-04 15:17:56

24200

代码可运行

文章被收录于专栏：R语言及实用科研软件R语言及实用科研软件

运行总次数：0

代码可运行

1写在前面

今天不想废话了，直接看图吧。👇

复现代码step by step，自己看吧。🤪

2用到的包

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

3示例数据

df_pw <- read.csv("./passwords.csv",row.names = 1)

DT::datatable(df_pw)

4整理数据

4.1 统一时间单位

由于时间单位不统一，这里我们转化一下，把单位都统一起来，都转成seconds。🥳

df_pw_time <- 
  df_pw %>% 
  mutate(
    time = case_when(
      time_unit == "seconds" ~ value,
      time_unit == "minutes" ~ value * 60,
      time_unit == "hours" ~ value * 60 * 60,
      time_unit == "days" ~ value * 60 * 24,
      time_unit == "weeks" ~ value * 60 * 24 * 7,
      time_unit == "months" ~ value * 60 * 24 * 30,
      time_unit == "years" ~ value * 60 * 24 * 365,
      TRUE ~ NA_real_
    )
  )

4.2 增加画图空间

接下来，将固定值1000添加到所有时间，为圆圈内的标签留下所需的额外空间。

plus <- 1000
df_pw_plot <-
  df_pw_time %>% 
  mutate(time = time + plus) %>% 
  add_row(rank = 501, time = 1)

4.3 提取难以破解的密码

创建一个data frame，包含为确实难以破解的密码放置标签所需的所有信息。🥰

后面会用到的。🤒

labels <-
  df_pw_plot %>% 
  filter(value > 90) %>% 
  mutate(label = glue::glue("<b>{password}</b><br><span style='font-size:18pt'>Rank: {rank}</span>")) %>% 
  add_column(
    x = c(33, 332, 401, 492),
    y = c(75000000, 90000000, 45000000, 48498112)
  )

5开始绘图

5.1 基础绘图

p <- ggplot(df_pw_plot, aes(rank, time, color = category)) +
  # 垂直线
  geom_segment(
    aes(x = rank, xend = rank, y = 0, yend = time), 
    size = 1.2
  ) +
  # 放置文本处
  geom_rect(
    aes(xmin = 1, xmax = 501, ymin = 0, ymax = plus), 
    fill = "grey97", color = "grey97"
  ) + 
  
  # 圈内线，分别为1天，1周，1月，1年。
  geom_hline(aes(yintercept = (1 * 24 * 60 + plus)), color = "grey88") +
  geom_hline(aes(yintercept = (7 * 24 * 60 + plus)), color = "grey85") +
  geom_hline(aes(yintercept = (30 * 24 * 60 + plus)), color = "grey82") +
  geom_hline(aes(yintercept = (365 * 24 * 60 + plus)), color = "grey79") +
  
  # 为每条线终点添加棒棒糖头！~
  geom_point(aes(size = time)) +
  
  # log10 scale
  scale_y_log10(expand = c(0, 0)) +
  
  # Prism color 
  rcartocolor::scale_color_carto_d(palette = "Prism", guide = "none") +
  
  # dots大小范围
  scale_size(
    range = c(1, 8), 
    limits = c(plus, max(df_pw_plot$time)), 
    guide = "none"
  ) +
  
  # 坐标转成圆圈
  coord_polar() 

p

5.2 添加文本注释

p <- p + 
  # 用`geom_richtext()`添加之前准备好的label
  geom_richtext(
    data = labels,
    aes(x = x, y = y, label = label, color = category),
    lineheight = 0.8,
    size = 8,
    label.color = NA
  ) +
  # 用`geom_text()`添加普通文本，放置在圈圈的中心
  geom_text(
    x = 500, y = 1.2,
    label = "********\nCracking\nYour Favorite\nPassword",
    size = 20,
    lineheight = 0.87,
    color = "grey60"
  ) +
  geom_text(
    x = 250, y = 0.25,
    label = "********",
    size = 20,
    lineheight = 0.87,
    color = "grey60"
  ) +
  geom_text(
    x = 250, y = 1.1,
    label = "Time it takes to crack the 500 most\ncommon passwords by online guessing.\nSorted by rank and colored by category.",
    size = 7,
    lineheight = 0.87,
    color = "grey73"
  ) +
  geom_text(
    x = 250, y = 1.95,
    label = "Time is displayed on a logarithmic scale\nwith the rings representing one day,\none week, one month, and one year\n(from inner to outer ring).",
    size = 6,
    lineheight = 0.87,
    color = "grey73"
  )
  
p

6分面视图

6.1 数据整理

首先，我们要为一些category添加换行符，适合内圈的大小。😏

facet_data <- 
  df_pw_plot %>% 
  add_row(rank = 501, time = 1, category = unique(df_pw_plot$category)) %>% 
  # This is where we add line breaks
  mutate(
    cat_label = case_when(
      category == "cool-macho" ~ "cool-\nmacho",
      category == "nerdy-pop" ~ "nerdy-\npop",
      category == "password-related" ~ "password-\nrelated",
      category == "rebellious-rude" ~ "rebel-\nlious-\nrude",
      category == "simple-alphanumeric" ~ "simple-\nalpha-\nnumeric",
      TRUE ~ category
    )
  ) %>% 
  filter(!is.na(category))

6.2 开始绘图

facet <- ggplot(facet_data, aes(rank, time, color = category)) +
  geom_segment(
    aes(x = rank, xend = rank, y = 0, yend = time), 
    size = 0.6
  ) +
  geom_rect(
    aes(xmin = 1, xmax = 501, ymin = 0, ymax = plus), 
    fill = "grey97", color = "grey97"
  ) + 
  geom_hline(aes(yintercept = (1 * 24 * 60 + plus)), color = "grey82", size = 0.2) +
  geom_hline(aes(yintercept = (7 * 24 * 60 + plus)), color = "grey79", size = 0.2) +
  geom_hline(aes(yintercept = (30 * 24 * 60 + plus)), color = "grey76", size = 0.2) +
  geom_hline(aes(yintercept = (365 * 24 * 60 + plus)), color = "grey73", size = 0.2) +
  geom_point(aes(size = time)) +
  
  # 添加每个圈内的laebl
  geom_text(
    aes(label = cat_label, color = category),
    x = 500, y = 0,
    size = 8,
    lineheight = 0.87
  ) +
  # 分面并分为2行
  facet_wrap(~ category, nrow = 2) +
  coord_polar() + 
  scale_y_log10(expand = c(0, 0)) + 
  rcartocolor::scale_color_carto_d(palette = "Prism", guide = "none") +
  scale_size(
    range = c(0.5, 7), 
    limits = c(plus, max(df_pw_plot$time)), 
    guide = "none"
  ) + 
  theme(
    strip.text = element_blank(), 
  )
  
facet

7最终绘图

p <- p + 
  theme_void() + 
  theme(
    plot.margin = margin(-50, -180, -70, -180, "lines"),
  )

facet <- facet + 
  theme_void() +
  theme(
    panel.spacing = unit(-8, "lines"),
    plot.margin = margin(-40, 50, 10, 50)
  ) + 
  # caption的主题
  theme(
    plot.caption = element_text(
      size = 20, 
      color = "grey60", 
      hjust = 0.5, 
      margin = margin(-50, 10, 30, 10)
    )
  ) + 
  # 添加caption
  labs(caption = "")


# 拼图
p_final <- (p + facet) + 
  plot_layout(
    ncol = 1,
    heights = c(1, 0.28) 
  )

p_final