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
 
 
 
 
 
 点个在看吧各位~ ✐.ɴɪᴄᴇ ᴅᴀʏ 〰
📍 🤩 LASSO | 不来看看怎么美化你的LASSO结果吗!?
 📍 🤣 chatPDF | 别再自己读文献了!让chatGPT来帮你读吧!~
 📍 🤩 WGCNA | 值得你深入学习的生信分析方法!~
 📍 🤩 ComplexHeatmap | 颜狗写的高颜值热图代码!
 📍 🤥 ComplexHeatmap | 你的热图注释还挤在一起看不清吗!?
 📍 🤨 Google | 谷歌翻译崩了我们怎么办!?(附完美解决方案)
 📍 🤩 scRNA-seq | 吐血整理的单细胞入门教程
 📍 🤣 NetworkD3 | 让我们一起画个动态的桑基图吧~
 📍 🤩 RColorBrewer | 再多的配色也能轻松搞定!~
 📍 🧐 rms | 批量完成你的线性回归
 📍 🤩 CMplot | 完美复刻Nature上的曼哈顿图
 📍 🤠 Network | 高颜值动态网络可视化工具
 📍 🤗 boxjitter | 完美复刻Nature上的高颜值统计图
 📍 🤫 linkET | 完美解决ggcor安装失败方案(附教程)
 📍 ......
本文由 mdnice 多平台发布



















