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

2022-02-21 08:38:26 浏览数 (3)

在twitter上看到一个图

image.png

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

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

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

image.png

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

首先是整理数据的代码

代码语言:javascript复制
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这个数据集开始

首先是读取数据

代码语言:javascript复制
top_dogs<-read.csv("top_dogs.csv")
head(top_dogs)

画图代码

首先是背景的圈和文字

代码语言:javascript复制
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") 

然后是添加柱子

代码语言:javascript复制
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

设置内部空心化

代码语言:javascript复制
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

在内部添加图片

代码语言:javascript复制
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

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

代码语言:javascript复制
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

image.png

最后来一个拼图

代码语言:javascript复制
library(patchwork)
p1 p2

image.png

示例数据和代码可以在公众号后台留言20220210获取

0 人点赞