R语言ggplot2画漂亮的环形柱形图的一个实例

用户7010445

发布于 2022-02-21 08:38:26

1.1K0

发布于 2022-02-21 08:38:26

文章被收录于专栏：小明的数据分析笔记本小明的数据分析笔记本

在twitter上看到一个图

image.png

配色很漂亮，代码和数据也是公开的，今天的推文来学习一下他的代码

代码来源的链接是 https://github.com/NearAndDistant/data_science_with_r

这个链接还有很多其他的R语言ggplot2作图的例子，代码和数据都是公开的，大家自己有时间可以重复一下其中的代码

image.png

这个环形柱形图的代码是以shiny app的形式提供的，这里我们忽略shiny app,只把作图代码拆解出来

首先是整理数据的代码

library(tidyverse)
# import data for project
breed_traits_raw      <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-02-01/breed_traits.csv')
breed_rank_all_raw    <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/master/data/2022/2022-02-01/breed_rank.csv')
### Clean and Wrangle 
# dogs rank clean
dogs_rank_long <- 
  breed_rank_all_raw %>%
  pivot_longer(cols = c(`2013 Rank`:`2020 Rank`), names_to = "year", values_to = "rank") %>%
  mutate(year = as.numeric(str_remove(year, " Rank"))) %>%
  select(Breed, year, rank, everything()) %>%
  janitor::clean_names() %>%
  mutate(breed = str_squish(breed))
# dog traits clean
dogs_trait_long <-
  breed_traits_raw %>%
  select(-`Coat Type`, -`Coat Length`) %>%
  pivot_longer(cols = c(`Affectionate With Family` : `Mental Stimulation Needs`), names_to = "attribute", values_to = "value") %>%
  janitor::clean_names() %>%
  mutate(breed = str_squish(breed))
# transform
top_dogs <-
dogs_rank_long %>%
  left_join(dogs_trait_long) %>%
  filter(year == 2020) %>%
  mutate(breed = as_factor(breed)) %>%
  group_by(attribute) %>%
    mutate(attribute = str_remove(attribute, " Level"),
           attribute = case_when(attribute == "Affectionate With Family"   ~ "Affectionate",
                                 attribute == "Good With Young Children"   ~ "Child-Friendly",
                                 attribute == "Good With Other Dogs"       ~ "Combativeness",
                                 attribute == "Openness To Strangers"      ~ "Openness",
                                 attribute == "Watchdog/Protective Nature" ~ "Protective",
                                 attribute == "Coat Grooming Frequency"    ~ "Grooming",
                                 attribute == "Mental Stimulation Needs"   ~ "Stimulation",
                                 TRUE ~ attribute)) %>%
    mutate(attribute = factor(attribute)) %>%
  ungroup() %>%
  group_by(breed) %>%
    arrange(desc(value)) %>%
    mutate(id = row_number()) %>%
  ungroup() %>% #2 Pissaro #1 Signac
  mutate(fill = case_when(attribute == "Affectionate"   ~  "#fbe183",
                          attribute == "Child-Friendly" ~  "#2b9b81",
                          attribute == "Combativeness"  ~  "#d8443c",
                          attribute == "Openness"       ~  "#e6a2a6",
                          attribute == "Playfulness"    ~  "#9f5691",
                          attribute == "Adaptability"   ~  "#f4c40f",
                          attribute == "Trainability"   ~  "#aa7aa1",
                          attribute == "Energy"         ~  "#fe9b00",
                          attribute == "Protective"     ~  "#e87b89",
                          attribute == "Stimulation"    ~  "#de597c",
                          attribute == "Barking"        ~  "#9b3441",
                          attribute == "Grooming"       ~  "#92c051",
                          attribute == "Shedding"       ~  "#633372",
                          attribute == "Drooling"       ~  "#1f6e9c"))

这部分我们就不介绍了，运行完上述代码可以拿到top_dogs这个数据集

如果读取数据的部分不能访问，我把数据集下载下来了，可以在公众号后台留言20220210获取

接下来作图是从top_dogs这个数据集开始

首先是读取数据

top_dogs<-read.csv("top_dogs.csv")
head(top_dogs)

画图代码

首先是背景的圈和文字

top_dogs %>% 
  filter(breed == "Russell Terriers") %>% 
  ggplot() +
  geom_segment(data = data.frame(y=seq(0,5,1)), 
               aes(x = -0.5, xend = 15, y=y, yend=y), 
               linetype = "ff", color = "grey90") +
  geom_text(data = data.frame(y=seq(0,5,1)), 
            aes(x = -0.15 , y = y + 0.5, label = y), 
            family = "serif", 
            size = 3, fontface = "bold") +
  coord_polar(clip = "off") +
  geom_text(aes(x = id, y = 7, label = attribute), 
            size = 3, fontface = 'bold', 
            family = "serif") +
  geom_text(aes(label = breed),
            x = -0.5, y = -1.7, size = 4, 
            fontface = 'bold', 
            family = "serif")

然后是添加柱子

top_dogs %>% 
  filter(breed == "Russell Terriers") %>% 
  ggplot() +
  geom_segment(data = data.frame(y=seq(0,5,1)), 
               aes(x = -0.5, xend = 15, y=y, yend=y), 
               linetype = "ff", color = "grey90") +
  geom_text(data = data.frame(y=seq(0,5,1)), 
            aes(x = -0.15 , y = y + 0.5, label = y), 
            family = "serif", 
            size = 3, fontface = "bold") +
  coord_polar(clip = "off") +
  geom_text(aes(x = id, y = 7, label = attribute), 
            size = 3, fontface = 'bold', 
            family = "serif") +
  geom_text(aes(label = breed),
            x = -0.5, y = -1.7, size = 4, 
            fontface = 'bold', 
            family = "serif") +
  geom_col(aes(id, value, fill = fill), 
           show.legend = FALSE)

image.png

设置内部空心化

top_dogs %>% 
  filter(breed == "Russell Terriers") %>% 
  ggplot() +
  geom_segment(data = data.frame(y=seq(0,5,1)), 
               aes(x = -0.5, xend = 15, y=y, yend=y), 
               linetype = "ff", color = "grey90") +
  geom_text(data = data.frame(y=seq(0,5,1)), 
            aes(x = -0.15 , y = y + 0.5, label = y), 
            family = "serif", 
            size = 3, fontface = "bold") +
  coord_polar(clip = "off") +
  geom_text(aes(x = id, y = 7, label = attribute), 
            size = 3, fontface = 'bold', 
            family = "serif") +
  geom_text(aes(label = breed),
            x = -0.5, y = -1.7, size = 4, 
            fontface = 'bold', 
            family = "serif") +
  geom_col(aes(id, value, fill = fill), 
           show.legend = FALSE) +
  scale_fill_identity() +
  scale_y_continuous(limits = c(-5.5, 7), breaks = seq(0,5,1)) +
  scale_x_continuous(limits = c(-0.5, max(top_dogs$id)+1))

image.png

在内部添加图片

top_dogs %>% 
  filter(breed == "Russell Terriers") %>% 
  ggplot() +
  geom_segment(data = data.frame(y=seq(0,5,1)), 
               aes(x = -0.5, xend = 15, y=y, yend=y), 
               linetype = "ff", color = "grey90") +
  geom_text(data = data.frame(y=seq(0,5,1)), 
            aes(x = -0.15 , y = y + 0.5, label = y), 
            family = "serif", 
            size = 3, fontface = "bold") +
  coord_polar(clip = "off") +
  geom_text(aes(x = id, y = 7, label = attribute), 
            size = 3, fontface = 'bold', 
            family = "serif") +

  geom_col(aes(id, value, fill = fill), 
           show.legend = FALSE) +
  scale_fill_identity() +
  scale_y_continuous(limits = c(-5.5, 7), breaks = seq(0,5,1)) +
  scale_x_continuous(limits = c(-0.5, max(top_dogs$id)+1)) +
  ggimage::geom_image(aes(x = -0.5, y = -5.5, 
                          image = image), 
                      size = 0.24) +
  geom_text(aes(label = breed),
            x = -0.5, y = -1.7, size = 4, 
            fontface = 'bold', 
            family = "serif") +
  theme_void() +
  theme(plot.margin = margin(1.5,0,0,0, unit = "cm"))

这里需要注意的一点是需要把添加狗的品种名的代码放到添加图片的代码的后面，要不然会有遮盖

image.png

同样的代码在话另外一个品种

top_dogs %>% 
  filter(breed == "Yorkshire Terriers") %>% 
  ggplot() +
  geom_segment(data = data.frame(y=seq(0,5,1)), 
               aes(x = -0.5, xend = 15, y=y, yend=y), 
               linetype = "ff", color = "grey90") +
  geom_text(data = data.frame(y=seq(0,5,1)), 
            aes(x = -0.15 , y = y + 0.5, label = y), 
            family = "serif", 
            size = 3, fontface = "bold") +
  coord_polar(clip = "off") +
  geom_text(aes(x = id, y = 7, label = attribute), 
            size = 3, fontface = 'bold', 
            family = "serif") +
  
  geom_col(aes(id, value, fill = fill), 
           show.legend = FALSE) +
  scale_fill_identity() +
  scale_y_continuous(limits = c(-5.5, 7), breaks = seq(0,5,1)) +
  scale_x_continuous(limits = c(-0.5, max(top_dogs$id)+1)) +
  ggimage::geom_image(aes(x = -0.5, y = -5.5, 
                          image = image), 
                      size = 0.24) +
  geom_text(aes(label = breed),
            x = -0.5, y = -1.7, size = 4, 
            fontface = 'bold', 
            family = "serif") +
  theme_void()  -> p2