突然发觉今年是奥运年，本节我们使用 TidyTuesday 第31周的项目数据集来绘制1920-2016奥运会射箭项目的获奖情况，后台回复20210730获取本文数据及代码;喜欢的小伙伴欢迎扫描文末二维码加入我的交流群更多精彩内容为您而准备

加载R包

library(tidyverse)
library(ggpubr)

加载数据

olympics <- readr::read_csv('olympics.csv')

自定义颜色

col2 <-c("#FF0000","#F98400","#5BBCD6")

数据清洗

dat <- olympics %>%
  filter(sport == "Archery") %>%
  group_by(team) %>%
  count(medal) %>%
  mutate(freq = n / sum(n)*100) 

绘制韩国获奖图

p <- dat %>%
  filter(team == "South Korea") %>%
  drop_na() %>% 
  ggdonutchart("freq",label = "medal", fill="medal") +
  theme_void() +
  theme(legend.position = "none",
        plot.title = element_text(family="Lato",hjust=0.5, vjust=-48, size=14),
        plot.margin = margin(-3,-3,-3,-3,"cm")) + 
  xlim(c(-2, 4)) + 
  scale_fill_manual(values = col2) +
  ggtitle("South Korea")

绘制比利时获奖图

p2 <- dat %>%
  filter(team == "Belgium") %>%
  drop_na() %>% 
  ggdonutchart("freq",label="medal",fill="medal") +
  theme_void() +
  theme(legend.position="none",
        plot.title = element_text(family="Lato",hjust=0.5, vjust=-48, size=14),
        plot.margin = margin(-3,-3,-3,-3,"cm")) +
  xlim(c(-2, 4)) +
  scale_fill_manual(values = col2) +
  ggtitle("Belgium")

绘制法国获奖图

p3 <- dat %>%
  filter(team == "France") %>%
  drop_na() %>% 
  ggdonutchart("freq",label="medal",fill="medal") +
  theme_void() +
  theme(legend.position = "none",
        plot.title = element_text(family="Lato", hjust=0.5, vjust=-48, size=14),
        plot.margin = margin(-3,-3,-3,-3,"cm")) +
  xlim(c(-2, 4)) +
  scale_fill_manual(values = col2) +
  ggtitle("France")

绘制美国获奖图

p4 <- dat %>%
  filter(team == "United States") %>%
  drop_na() %>% 
  ggdonutchart("freq", label = "medal", fill="medal") +
  theme_void() +
  theme(legend.position = "none",
        plot.title = element_text(family="Lato", hjust=0.5, vjust=-107, size=14),
        plot.margin = margin(-7,-3.5,0,0,"cm")) +
  xlim(c(-2, 4)) +
  scale_fill_manual(values = col2) +
  ggtitle("USA")

中国获奖图

p5 <- dat %>%
  filter(team == "China") %>%
  drop_na() %>% 
  ggdonutchart("freq",label = "medal", fill="medal") +
  theme_void() +
  theme(legend.position = "none",
        plot.title = element_text(family="Lato", hjust=0.5, vjust=-107, size=14),
        plot.margin = margin(-7,0,0,-3.5,"cm")) +
  xlim(c(-2, 4)) + 
  scale_fill_manual(values = col2) +
  ggtitle("China")

拼图

a1 <- ggarrange(p, p2, p3, ncol = 3)
a2 <- ggarrange(p4, p5)

ggarrange(a1, a2, ncol = 1,nrow = 2) %>% 
annotate_figure(rings,
                top = text_grob("1920-2016 年奥运会射箭奖牌",
                                x=0.5, y=-16, family="Lato Semibold", size = 20))

关注下方公众号，获取更多优质资源，如需要加入微信交流群，请在菜单栏处添加作者微信，即可邀您进群