前言
上一个帖子《可视化：环状条形图》分享了如何绘制基础的环状条形图，今天接着分享复杂一点的环状条形图如何绘制，例如有分组时如何让图形更加美观大气。下面让我们一起拭目以待。
分组环状条形图
下面就是全部的绘图过程，废话不多说了，先直接来看下面的代码：
library(ggplot2)
library(tidyverse)
set.seed(21)
# 准备数据
data <- data.frame(
individual=paste( "Mister", seq(1,60), sep=""),
group=c( rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)) ,
value=sample( seq(10,100), 60, replace=T)
)
# 为了组间的柱子有间隙
empty_bar <- 3
to_add <- data.frame( matrix(NA, empty_bar *nlevels(data$group), ncol(data)) )
colnames(to_add) <- colnames(data)
to_add$group <- rep(levels(data$group), each=empty_bar )
data <- rbind(data, to_add)
data <- data[order(data$group),]
data$id <- seq(1, nrow(data))
# 每个柱子标签的位置
label_data <- data
angle <- 90 - 360 * (label_data$id-0.5) /nrow(label_data)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
# 组名和下滑线的位置数据
base_data <- data %>%
group_by(group) %>%
summarize(start=min(id), end=max(id) - empty_bar) %>%
rowwise() %>%
mutate(title=mean(c(start, end)))
# 填充组间的间隙数据
grid_data <- data %>%
filter(is.na(individual)) %>%
group_by(group) %>%
summarize(start=min(id), end=max(id)) %>%
slice_head(n = 3)
# 画图
p <- ggplot(data) +
geom_bar(aes(x=as.factor(id), y=value, fill=observation), stat="identity", alpha=0.5) +
ylim(-100,120) +
theme_minimal() +
theme(legend.position = "none",axis.text = element_blank(),axis.title = element_blank(),panel.grid = element_blank()) +
geom_text(data=label_data, aes(x=id, y=tot+10, label=individual, hjust=hjust), color="black", fontface="bold",alpha=0.6, size=5, angle= label_data$angle)+
coord_polar()
# 填充组间间隙
p <- p + geom_segment(data=grid_data, aes(x = start, y = 80, xend = end, yend = 80), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 60, xend = end, yend = 60), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 40, xend = end, yend = 40), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 20, xend = end, yend = 20), colour = "grey", alpha=1, size=0.3)
# 增加Y轴刻度
p <- p + annotate("text", x = rep(max(data$id),4), y = c(20, 40, 60, 80), label = c("20", "40", "60", "80") , color="grey", size=3 , angle=0, fontface="bold", hjust=1)
# 增加组名和下划线
p <- p + geom_segment(data=base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha=0.8, size=0.6) +
geom_text(data=base_data, aes(x = title, y = -18, label=group), hjust=c(1,1,0,0), colour = "black", alpha=0.8, size=4, fontface="bold")
结果如下：
分组的环状条形图是不是比常规的条形图看上去颜值要高很多！从上面的绘图过程可以知道，为了到达美观的效果，在每个分组之间增加了一些间隙(灰色的横线)，怎么实现的呢？其实很简单，就是在每个分组数据的后面增加一些无效数据，这样绘图的时候就会留下空白，然后再在空白区利用geom_segment函数画上几条横线增加一些高级感。不过，需要注意的是不要把所有的空白区都画上线了，第一个空白区留下来画Y轴的刻度，这样更美观。最后就是利用geom_segment和annotate函数添加分组下划线和组名，这样一幅完整的图就呈现在你的眼前了。
堆叠环状条形图
这个图又要复杂一些，因为在每个大的分组下，每个柱子又有小的分组，这样的图该怎么画呢？其实画图的中心思想跟上面一致，只不过在数据处理上面稍微复杂一些，上面的图搞明白了，这个图也就水到渠成了。废话不多说了，还是直接看代码吧：
set.seed(21)
# 准备数据
data <- data.frame(
individual=paste( "Mister", seq(1,60), sep=""),
group=c( rep('A', 10), rep('B', 30), rep('C', 14), rep('D', 6)) ,
value1=sample( seq(10,100), 60, replace=T),
value2=sample( seq(10,100), 60, replace=T),
value3=sample( seq(10,100), 60, replace=T)
)
data <- data %>% gather(key = "observation", value="value", -c(1,2))
# 填充组间的间隙数据
empty_bar <- 2
nobstype <- nlevels(as.factor(data$observation))
to_add <- data.frame( matrix(NA, empty_bar*nlevels(data$group)*nobstype, ncol(data)) )
colnames(to_add) <- colnames(data)
to_add$group <- rep(levels(data$group), each=empty_bar*nobstype)
data <- rbind(data, to_add)
data <- data %>% arrange(group, individual)
data$id <- rep( seq(1, nrow(data)/nobstype) , each=nobstype)
# 每个柱子标签的位置
label_data <- data %>% group_by(id, individual) %>% summarize(tot=sum(value))
angle <- 90 - 360 * (label_data$id-0.5) / nrow(label_data)
label_data$hjust <- ifelse( angle < -90, 1, 0)
label_data$angle <- ifelse(angle < -90, angle+180, angle)
# 组名和下滑线的位置数据
base_data <- data %>%
group_by(group) %>%
summarize(start=min(id), end=max(id) - empty_bar) %>%
rowwise() %>%
mutate(title=mean(c(start, end)))
# 填充组间的间隙数据
grid_data <- data %>%
filter(is.na(individual)) %>%
group_by(group) %>%
summarize(start=min(id), end=max(id)) %>%
slice_head(n = 3)
# 画图
p <- ggplot(data) +
geom_bar(aes(x=as.factor(id), y=value, fill=observation), stat="identity") +
scale_fill_brewer(palette = "Set3")+
ylim(-150,max(data$value)) +
theme_minimal() +
theme(legend.position = "none",axis.text = element_blank(),axis.title = element_blank(),panel.grid = element_blank()) +
geom_text(data=label_data, aes(x=id, y=tot+10, label=individual, hjust=hjust), color="black", fontface="bold",alpha=0.6, size=2.5, angle= label_data$angle) +
coord_polar()
# 填充组间间隙
p <- p + geom_segment(data=grid_data, aes(x = start, y = 0, xend = end, yend = 0), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 50, xend = end, yend = 50), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 100, xend = end, yend = 100), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 150, xend = end, yend = 150), colour = "grey", alpha=1, size=0.3) +
geom_segment(data=grid_data, aes(x = start, y = 200, xend = end, yend = 200), colour = "grey", alpha=1, size=0.3)
# 增加Y轴刻度
p <- p + annotate("text", x = rep(max(data$id),5), y = c(0, 50, 100, 150, 200), label = c("0", "50", "100", "150", "200") , color="grey", size=2.5 , angle=0, fontface="bold", hjust=0.8,vjust=0.1)
# 增加组名和下划线
p <- p + geom_segment(data=base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha=0.8, size=0.6) +
geom_text(data=base_data, aes(x = title, y = -18, label=group), hjust=c(1,1,0,0), colour = "black", alpha=0.8, size=4, fontface="bold")
结果如下：
堆叠的环状条形图看起来跟分组的相比，绘制过程相同，视觉效果也差不多，仅仅是数据上面复杂度增加一些，呈现出的信息量增加一些。
结束语
虽然分组的、堆叠的环状条形图稍微复杂一些，但其实理解了其中的小技巧，只需构造出相应的数据，画图还是很顺利的。美好的事情需要经过一些努力才能获得嘛！哦了，今天就分享到这，后面我们继续分享一些其他图形的绘制~~~
网友评论