环状柱形图
1 简介
一般而言，普通柱状图可以直观展示单个混合暴露回归模型（如加权分位数和回归模型，WQS）中各变量对总混合效应的贡献。
然而，当我们需要同时可视化展示多组模型中各变量在混合效应中的贡献时，需要同时展示多个普通柱状图而占用过多空间。这种情况下可以使用环状柱形图提高空间的使用效率，提高信息密度。
本文以负向约束的WQS模型举例，具体代码如下。文末附加原始文件信息截图。
2.1 加载包并导入数据
本次演示以22种污染物（DPHP，BBOEP，BDCIPP，BEHP，MeP，TCS，BPC，BPAF，BPS，BP3，MMP，MBP，MEHP，MHINP，MCMHP，MEOHP，MECPP，MCPP，BHA，BHT，BHTCOOH，BHTQ）对4种结局的混合暴露模型（负向约束的WQS）为例，展示22种污染物对各个结局的贡献。数据结构包括三部分，其中individual是需要展示的污染物名字，group为四种不同结局，value为单个污染物对各个结局的贡献（权重）。
#安装并加载包library(ggplot2)library(tidyverse)library(RColorBrewer)#设置工作路径setwd("")#您的数据所在路径#导入数据data<- readxl::read_xlsx("WQS.xlsx")head(data)data$value <- round(data$value,4) #保留四位小数
注：由于篇幅限制，无法展示数据集中所有内容，截图仅呈现其中前6行数据，分析以实际为准。 下文同理。
2.2 绘图前的处理
2.2.1 在每组之间添加间隔，并且添加各变量在图中的定位信息
#每组之间留2个空行作隔断empty_bar <- 2#将数据集中的group列转换为因子变量。data$group <- as.factor(data$group)#创建一个空的数据框to_add，行数为每组之间空行数量乘以组别数，列数与原数据集相同。to_add <- data.frame( matrix(NA, empty_bar*nlevels(data$group), ncol(data)) )#创建一个空的数据框to_add，行数为每组之间空行数量乘以组别数，列数与原数据集相同。colnames(to_add) <- colnames(data)#为to_add数据框的group列赋值，使得每个组别之间2个空行。to_add$group <- rep(levels(data$group), each=empty_bar)#将to_add数据框添加到原数据集data中，实现在每组之间插入空行的效果。data <- rbind(data, to_add)#对数据集按照group列进行排序。data <- data %>% arrange(group)#为数据集添加一个新的列id，用来重新编号数据集的行data$id <- seq(1, nrow(data))head(data)
2.2.2添加各个变量标签在图中的角度信息和对齐方式
# 对数据集data按照group列和value列进行排序，确保每个组内的数据按照value的大小顺序排列。data = data %>% arrange(group, value)#为数据集添加一个新的列id，用来重新编号数据集的行。data$id <- seq(1, nrow(data))# 设置添加label标签信息label_data <- data#计算数据集中的总行数，用于后续计算标签在图中的角度信息。number_of_bar <- nrow(label_data)#根据数据集中每行的编号计算标签在图中的角度信息，使得标签可以环绕图片。角度的计算公式可以根据具体需求进行调整。angle <- 90 - 360 * (label_data$id-0.5) /number_of_bar#根据角度信息判断标签的对齐方式，如果角度大于-90度，则左对齐；否则右对齐。label_data$hjust <- ifelse( angle < -90, 1, 0)#根据角度信息调整标签的角度，使得标签在不同位置可以正确显示。label_data$angle <- ifelse(angle < -90, angle+180, angle)
2.2.3 添加各组数据在图片上的起止位置，用于刻度线等的定位
# 按照group列对数据集进行分组，然后对每个组计算起始位置和结束位置的定位信息，并计算每个组的标题位置。base_data <- data %>%group_by(group) %>%#对每个组计算起始位置和结束位置，起始位置为该组中id列的最小值，结束位置为该组中id列的最大值减去空行数量。summarize(start=min(id), end=max(id) - empty_bar) %>%#将数据集转换为逐行操作的形式。rowwise() %>%#计算每个组的标题位置，取起始位置和结束位置的平均值作为标题位置mutate(title=mean(c(start, end)))
2.2.4 添加各组数据在图片上的间隔定位信息，用于刻度线等的定位
#将之前计算得到的base_data数据框赋值给grid_data，用于添加间隔的起始和结束位置信息。grid_data <- base_data#将grid_data数据框中end列的值向下平移一行，并加上0.7，用于确定间隔的结束位置。grid_data$end <- grid_data$end[ c( nrow(grid_data), 1:nrow(grid_data)-1)] + 0.7#将grid_data数据框中start列的值向上平移0.7，用于确定间隔的起始位置。grid_data$start <- grid_data$start - 0.7#删除grid_data数据框中的第一行，因为第一行的起始位置和结束位置已经确定，不需要再添加间隔信息。grid_data <- grid_data[-1,]
2.3 绘图
# 绘制分组环状条形图#创建一个ggplot对象，设置x轴为id列，y轴为-value列（因为是从边缘向圆心的图，所以value值前加“-”），并按照group列进行填充。p <- ggplot(data, aes(x=as.factor(id), y=-value, fill=group)) +#添加条形图层，stat="identity"表示使用原始数据值，alpha=0.3表示设置透明度为0.3。geom_bar(stat="identity", alpha=0.3) +#设置填充颜色为Dark2调色板。scale_fill_brewer(type = "qual", palette = "Dark2")+ #这里调用上面的调色板更改柱形图的颜色ylim(-0.3,0.17) + #限制Y轴的上下限，用于调节图片的显示效果#添加刻度线段，用于显示间隔位置。#和上面原因一致，y前也加“-” x,y,xend,yend为线段的起始位置和长度的定位，需要自行摸索geom_segment(data=grid_data, aes(x = end, y = -0.15, xend = start, yend = -0.15), colour = "black", alpha=1, size=0.8 , inherit.aes = FALSE ) +geom_segment(data=grid_data, aes(x = end, y = -0.1, xend = start, yend = -0.1), colour = "black", alpha=1, size=0.8 , inherit.aes = FALSE ) +geom_segment(data=grid_data, aes(x = 1, y = -0.045, xend = 94.7, yend = -0.045), linetype="dashed",colour = "red", alpha=0.1, size=0.5 , inherit.aes = FALSE ) +geom_segment(data=grid_data, aes(x = end, y = 0, xend = start, yend = 0), colour = "black", alpha=1, size=0.8 , inherit.aes = FALSE ) +geom_segment(data=grid_data, aes(x = end, y = -0.045, xend = start, yend = -0.045), colour = "black", alpha=1, size=0.8 , inherit.aes = FALSE ) +#增加刻度标识 具体参数需要实际情况而定annotate("text", x = rep(23.8,4), y = c(-0.145, -0.095, -0.042, 0.005), label = c("0.15", "0.1", "0.045", "0") , family="A", color="grey", size=2.8 , angle=0, fontface="bold", hjust=0) +theme_minimal() +theme(legend.position=c(.5,.5), #图例居中axis.text = element_blank(), #隐藏轴标签文本axis.title = element_blank(), #隐藏轴标题文本panel.grid = element_blank(),plot.margin = unit(rep(0,8), "cm")) +labs(family="A",fill = "Reproductive Outcomes")+ #修改中间图例的标题coord_polar() +#增加一圈装饰线条 具体参数需要实际情况而定geom_segment(data=base_data, aes(x = start-0.7, y = 0.007, xend = end+0.7, yend = 0.007), colour = "black", alpha=0.5, size=2 , inherit.aes = FALSE ) +geom_segment(data=base_data , aes(x = start-0.7, y = 0.07, xend = end+0.7, yend = 0.07), colour = brewer.pal(4,"Dark2"), alpha=0.3, size=31 , inherit.aes = FALSE )+#添加变量名字，这里增大了小于临界值的变量文本的透明度，凸显有意义变量geom_text(data=label_data, aes(x=id, y=0.02, label=individual, hjust=hjust), color="black", fontface="bold",alpha=ifelse(label_data$value > 0.045, 0.9, 0.3), size=2.5, angle= label_data$angle, inherit.aes = FALSE )p
2.4 图片解释
这个图片展示四个负向约束的WQS模型中22个污染物对总混合效应的贡献。Retrieved oocytes组为例，权重从大到小排列，对总混合效应贡献最大的物质为MEOHP，最小的为BDCIPP。在WQS模型中，其权重大于1/N（这里为1/22）的变量认为对总效应的贡献是有意义的，所以在图中增大了对总效应贡献无意义的变量文本透明度，以凸显有意义变量。
