在twitter上看到一個圖

image.png

配色很漂亮，代碼和數(shù)據(jù)也是公開的殴俱，今天的推文來學(xué)習(xí)一下他的代碼

代碼來源的鏈接是 https://github.com/NearAndDistant/data_science_with_r

這個鏈接還有很多其他的R語言ggplot2作圖的例子敛摘，代碼和數(shù)據(jù)都是公開的削茁，大家自己有時間可以重復(fù)一下其中的代碼

image.png

這個環(huán)形柱形圖的代碼是以shiny app的形式提供的聪建，這里我們忽略shiny app,只把作圖代碼拆解出來

首先是整理數(shù)據(jù)的代碼

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"))

這部分我們就不介紹了，運(yùn)行完上述代碼可以拿到top_dogs這個數(shù)據(jù)集

如果讀取數(shù)據(jù)的部分不能訪問氧腰，我把數(shù)據(jù)集下載下來了枫浙，可以在公眾號后臺留言20220210獲取

接下來作圖是從top_dogs這個數(shù)據(jù)集開始

首先是讀取數(shù)據(jù)

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

設(shè)置內(nèi)部空心化

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

在內(nèi)部添加圖片

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"))

這里需要注意的一點(diǎn)是 需要把添加狗的品種名的代碼放到添加圖片的代碼的后面，要不然會有遮蓋

image.png

同樣的代碼在話另外一個品種

image.png

最后來一個拼圖

library(patchwork)
p1+p2

image.png

示例數(shù)據(jù)和代碼可以在公眾號后臺留言20220210獲取

歡迎大家關(guān)注我的公眾號

小明的數(shù)據(jù)分析筆記本

小明的數(shù)據(jù)分析筆記本 公眾號 主要分享：1古拴、R語言和python做數(shù)據(jù)分析和數(shù)據(jù)可視化的簡單小例子箩帚；2、園藝植物相關(guān)轉(zhuǎn)錄組學(xué)黄痪、基因組學(xué)紧帕、群體遺傳學(xué)文獻(xiàn)閱讀筆記；3桅打、生物信息學(xué)入門學(xué)習(xí)資料及自己的學(xué)習(xí)筆記是嗜！