在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获取
