数据可视化——R语言ggplot2包绘制精美的小提琴图(并箱线图或误差条图组合)
2024-05-19 10:45:48
数据可视化——R语言ggplot2包绘制精美的小提琴图(并箱线图或误差条图组合)
概述：R语言使用ggplot2工具包绘制小提琴图。为了使数据表达更加丰富，同时将小提琴图与箱线图和误差条图相结合。另外，当每个组别有两个属性变量时，分半的小提琴图可节省绘图空间，同时更美观。为了突出小提琴图表达数据的优越性，常规的条形图结合误差条图也被绘制。
小提琴图(Violin Plot)用于显示数据分布及其概率密度，因其形状酷似小提琴而得名。
图1 小提琴图示例
这种图表结合了箱线图和密度图的特征，主要用来显示数据的分布形状。中间的黑色粗条表示四分位数范围，从其延伸的幼细黑线代表95% 置信区间，而白点则为中位数。如果需要，中间的箱线图还可以替换为误差条图。
箱线图或误差条图在数据显示方面受到限制，简单的设计往往隐藏了有关数据分布的重要细节。例如使用箱线图时，我们不能了解数据分布是双模还是多模。小提琴图能够展示数据的真正分布范围和形状。值得注意的是，虽然小提琴图可以显示更多详情，但它们也可能包含较多干扰信息。
使用工具：R语言中的ggplot2工具包
本文的结构与之前一致，主要展示一些我在实践过程中的示例。以下示例依据内容分别介绍，完整的代码详见文章末尾。 数据采用模拟生成的数据。以下示例中的数据包括两个组别(group1和group2)，每个组别共两个属性(Attribute_1和Attribute_1)，每个组别的每个属性各100个测量值。
模拟数据的生成代码如下：
rm(list=ls()) #清除工作区
library(ggplot2)#生成模拟数据
Group <- rep(c("group1","group2"),each=200) #组别变量
Group <- factor(Group) #组别因子化
Attribute <- c(rep("Attribute_1",100),rep("Attribute_2",100),rep("Attribute_1",100),rep("Attribute_2",100)) #每个组别的两个属性
Attribute <- factor(Attribute) #属性因子化
value <- c(rnorm(100)+1,rnorm(100)+2,rnorm(100)+1.2,rnorm(100)+1.5) #随机赋值Data <- data.frame(Group=Group,Attribute=Attribute,value=value) #生成数据框
需要注意的时，绘制条形图和误差条图需要对原始数据进行适当的计算，如求均值，标准差，标准误和置信区间等。可以通过以下函数实现。以下函数来自：
http://www.cookbook-r.com/Manipulating_data/Summarizing_data/
需要确保已经安装好plyr包。如果没有安装，运行以下命令进行安装：install.packages(“plyr”)。plyr包用于数据整理很方便。
#对数据进行统计的函数
#指定分组变量和求值变量后，可计算出不同分组变量(或分组变量间的组合)对应的求值变量的均值，标准差，标准误，置信区间ci#汇总数据
#计算出计数，平均值，标准差，均值的标准误差和置信区间（默认为95％）
#data：一个数据框
#measurevar：包含要汇总的变量的列的名称
#groupvars：包含分组变量的列名称的向量
#na.rm：一个布尔值，表示是否忽略NA
## conf.interval：置信区间的百分比范围（默认为95％）## Summarizes data.
## Gives count, mean, standard deviation, standard error of the mean, and confidence interval (default 95%).
## data: a data frame.
## measurevar: the name of a column that contains the variable to be summariezed
## groupvars: a vector containing names of columns that contain grouping variables
## na.rm: a boolean that indicates whether to ignore NA's
## conf.interval: the percent range of the confidence interval (default is 95%)
summarySE <- function(data=NULL, measurevar, groupvars=NULL, na.rm=FALSE,conf.interval=.95, .drop=TRUE) {library(plyr)# New version of length which can handle NA's: if na.rm==T, don't count themlength2 <- function (x, na.rm=FALSE) {if (na.rm) sum(!is.na(x))else length(x)}# This does the summary. For each group's data frame, return a vector with# N, mean, and sddatac <- ddply(data, groupvars, .drop=.drop,.fun = function(xx, col) {c(N = length2(xx[[col]], na.rm=na.rm),mean = mean (xx[[col]], na.rm=na.rm),sd = sd (xx[[col]], na.rm=na.rm))},measurevar)# Rename the "mean" column datac <- rename(datac, c("mean" = measurevar))datac$se <- datac$sd / sqrt(datac$N) # Calculate standard error of the mean# Confidence interval multiplier for standard error# Calculate t-statistic for confidence interval: # e.g., if conf.interval is .95, use .975 (above/below), and use df=N-1ciMult <- qt(conf.interval/2 + .5, datac$N-1)datac$ci <- datac$se * ciMultreturn(datac)
}
基于summarySE()函数依据数据中的不同组别变量之间的组合对变量value计算对应的计数，均值，标准差，标准误及置信区间。
代码如下：
#依据分组对vale进行统计
Data_summary <- summarySE(Data, measurevar="value", groupvars=c("Group","Attribute"))
执行结果如下：
Group Attribute N value sd se ci
1 group1 Attribute_1 100 1.035840 1.0497560 0.10497560 0.2082944
2 group1 Attribute_2 100 1.918411 0.9575014 0.09575014 0.1899890
3 group2 Attribute_1 100 1.073857 0.9276357 0.09276357 0.1840630
4 group2 Attribute_2 100 1.590875 0.9526457 0.09526457 0.1890256
其中，结果表示Group和Attribute的不同组合下对变量value进行计算，N表示计数，value表示value的均值，sd表示value的标准差，se表示value的标准误，ci可用于计算value的95%的置信区间，value的95%的置信区间为[value的均值-ci, value的均值+ci]。
先使用条形图结合误差条图表达数据，代码如下：
P1 <- ggplot(Data_summary,aes(x=Group, y=value, fill=Attribute)) + #“fill=”设置填充颜色依据Attribute指定geom_point(aes(x=Group, y=value),pch=19,position=position_dodge(0.9),size=2.5)+ #绘制均值为点图geom_bar(stat = "identity",position = "dodge",alpha = 0.7) + #绘制条形图#如果误差条想表示标准差：请设置 ymin = value-sd, ymax=value+sd#如果误差条想表示标准误：请设置 ymin = value-se, ymax=value+segeom_errorbar(aes(ymin = value-ci, ymax=value+ci), #误差条表示95%的置信区间width=0.1, #误差条末端短横线的宽度position=position_dodge(0.9), color="black",alpha = 0.7,size=0.5) +scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P1jpeg(file = "results_Value_1.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存print(P1)dev.off()
效果图如下：
图2 条形图结合误差条图
小提琴图结合箱线图用于表达数据的代码如下：
P2<- ggplot(Data, aes(x=Group, y=value,fill=Attribute)) + geom_violin(trim=FALSE,color="white") + #绘制小提琴图, “color=”设置小提琴图的轮廓线的颜色(以下设为背景为白色，其实表示不要轮廓线)#"trim"如果为TRUE(默认值),则将小提琴的尾部修剪到数据范围。如果为FALSE,不修剪尾部。geom_boxplot(width=0.2,position=position_dodge(0.9))+ #绘制箱线图scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充的颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P2jpeg(file = "results_Value_2.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存
print(P2)
dev.off()
效果图如下：
图3 小提琴图结合箱线图
小提琴图结合误差条图用于表达数据的代码如下：
P3 <- ggplot(Data, aes(x=Group, y=value,fill=Attribute)) + geom_violin(trim=FALSE,color="white") + #绘制小提琴图geom_point(data = Data_summary,aes(x=Group, y=value),pch=19,position=position_dodge(0.9),size=1.5)+ #绘制均值为点图geom_errorbar(data = Data_summary,aes(ymin = value-ci, ymax=value+ci), #误差条表示95%的置信区间width=0.1, #误差条末端短横线的宽度position=position_dodge(0.9), color="black",alpha = 0.7,size=0.5) +scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充的颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P3 jpeg(file = "results_Value_3.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存
print(P3)
dev.off()
效果图如下：
图4 小提琴图结合误差条图
图3与图4同一组别的两个属性分别绘制了两个小提琴样式，且小提琴图的左右对称，如果绘制的小提琴图一半能表述属性一(Attribute_1)的数据分布，另一半能表示属性二的分布(Attribute_2)，这样将减少冗余，同时对属性一和属性二的数据分布比较更方便，图形也跟美观。因此，可以考虑采用分半的小提琴图用于数据表达。绘制分半小提琴图的代码如下，来自于：https://gist.github.com/Karel-Kroeze/746685f5613e01ba820a31e57f87ec87。
GeomSplitViolin <- ggproto("GeomSplitViolin", GeomViolin, draw_group = function(self, data, ..., draw_quantiles = NULL) {data <- transform(data, xminv = x - violinwidth * (x - xmin), xmaxv = x + violinwidth * (xmax - x))grp <- data[1,'group']newdata <- plyr::arrange(transform(data, x = if(grp%%2==1) xminv else xmaxv), if(grp%%2==1) y else -y)newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ])newdata[c(1,nrow(newdata)-1,nrow(newdata)), 'x'] <- round(newdata[1, 'x']) if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))quantiles <- ggplot2:::create_quantile_segment_frame(data, draw_quantiles)aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE]aesthetics$alpha <- rep(1, nrow(quantiles))both <- cbind(quantiles, aesthetics)quantile_grob <- GeomPath$draw_panel(both, ...)ggplot2:::ggname("geom_split_violin", grid::grobTree(GeomPolygon$draw_panel(newdata, ...), quantile_grob))} else {ggplot2:::ggname("geom_split_violin", GeomPolygon$draw_panel(newdata, ...))}}
)geom_split_violin <- function (mapping = NULL, data = NULL, stat = "ydensity", position = "identity", ..., draw_quantiles = NULL, trim = TRUE, scale = "area", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {layer(data = data, mapping = mapping, stat = stat, geom = GeomSplitViolin, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list(trim = trim, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ...))
}
使用geom_split_violin()函数绘制分半的小提琴图代码如下：
P4 <- ggplot(data=Data, aes(x=Group, y=value,fill=Attribute)) + geom_split_violin(trim=FALSE,color="white") + #绘制分半的小提琴图geom_point(data = Data_summary,aes(x=Group, y=value),pch=19,position=position_dodge(0.9),size=1.5)+ #绘制均值为点图geom_errorbar(data = Data_summary,aes(ymin = value-ci, ymax=value+ci), #误差条表示95%的置信区间width=0.1, #误差条末端短横线的宽度position=position_dodge(0.9), color="black",alpha = 0.7,size=0.5) +scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充的颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P4jpeg(file = "results_Value_4.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存
print(P4)
dev.off()
效果图如下：
图5 分半小提琴图结合误差条图
本文展示了用于表达特定类型的数据(含多个组别，每个组别多个属性)的作图方式，包括常规的条形图结合误差条图，小提琴图结合箱线图，小提琴图结合误差条图，以及分半小提琴图结合误差条图。当每个组别有两个属性时，建议采用分半小提琴图结合误差条图的方式表达数据。
完整的代码如下：
rm(list=ls()) #清除工作区
library(ggplot2)#生成模拟数据
Group <- rep(c("group1","group2"),each=200) #组别变量
Group <- factor(Group) #组别因子化
Attribute <- c(rep("Attribute_1",100),rep("Attribute_2",100),rep("Attribute_1",100),rep("Attribute_2",100)) #每个组别的两个属性
Attribute <- factor(Attribute) #属性因子化
value <- c(rnorm(100)+1,rnorm(100)+2,rnorm(100)+1.2,rnorm(100)+1.5) #随机赋值Data <- data.frame(Group=Group,Attribute=Attribute,value=value) #生成数据框#对数据进行统计的函数
#指定分组变量和求值变量后，可计算出不同分组变量(或分组变量间的组合)对应的求值变量的均值，标准差，标准误，置信区间ci#汇总数据
#计算出计数，平均值，标准差，均值的标准误差和置信区间（默认为95％）
#data：一个数据框
#measurevar：包含要汇总的变量的列的名称
#groupvars：包含分组变量的列名称的向量
#na.rm：一个布尔值，表示是否忽略NA
## conf.interval：置信区间的百分比范围（默认为95％）## Summarizes data.
## Gives count, mean, standard deviation, standard error of the mean, and confidence interval (default 95%).
## data: a data frame.
## measurevar: the name of a column that contains the variable to be summariezed
## groupvars: a vector containing names of columns that contain grouping variables
## na.rm: a boolean that indicates whether to ignore NA's
## conf.interval: the percent range of the confidence interval (default is 95%)
summarySE <- function(data=NULL, measurevar, groupvars=NULL, na.rm=FALSE,conf.interval=.95, .drop=TRUE) {library(plyr)# New version of length which can handle NA's: if na.rm==T, don't count themlength2 <- function (x, na.rm=FALSE) {if (na.rm) sum(!is.na(x))else length(x)}# This does the summary. For each group's data frame, return a vector with# N, mean, and sddatac <- ddply(data, groupvars, .drop=.drop,.fun = function(xx, col) {c(N = length2(xx[[col]], na.rm=na.rm),mean = mean (xx[[col]], na.rm=na.rm),sd = sd (xx[[col]], na.rm=na.rm))},measurevar)# Rename the "mean" column datac <- rename(datac, c("mean" = measurevar))datac$se <- datac$sd / sqrt(datac$N) # Calculate standard error of the mean# Confidence interval multiplier for standard error# Calculate t-statistic for confidence interval: # e.g., if conf.interval is .95, use .975 (above/below), and use df=N-1ciMult <- qt(conf.interval/2 + .5, datac$N-1)datac$ci <- datac$se * ciMultreturn(datac)
}#依据分组对vale进行统计
Data_summary <- summarySE(Data, measurevar="value", groupvars=c("Group","Attribute"))P1 <- ggplot(Data_summary,aes(x=Group, y=value, fill=Attribute)) + #“fill=”设置填充颜色依据Attribute指定geom_point(aes(x=Group, y=value),pch=19,position=position_dodge(0.9),size=2.5)+ #绘制均值为点图geom_bar(stat = "identity",position = "dodge",alpha = 0.7) + #绘制条形图#如果误差条想表示标准差：请设置 ymin = value-sd, ymax=value+sd#如果误差条想表示标准误：请设置 ymin = value-se, ymax=value+segeom_errorbar(aes(ymin = value-ci, ymax=value+ci), #误差条表示95%的置信区间width=0.1, #误差条末端短横线的宽度position=position_dodge(0.9), color="black",alpha = 0.7,size=0.5) +scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P1jpeg(file = "results_Value_1.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存print(P1)dev.off()P2<- ggplot(Data, aes(x=Group, y=value,fill=Attribute)) + geom_violin(trim=FALSE,color="white") + #绘制小提琴图, “color=”设置小提琴图的轮廓线的颜色(以下设为背景为白色，其实表示不要轮廓线)#"trim"如果为TRUE(默认值),则将小提琴的尾部修剪到数据范围。如果为FALSE,不修剪尾部。geom_boxplot(width=0.2,position=position_dodge(0.9))+ #绘制箱线图scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充的颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P2jpeg(file = "results_Value_2.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存
print(P2)
dev.off()P3 <- ggplot(Data, aes(x=Group, y=value,fill=Attribute)) + geom_violin(trim=FALSE,color="white") + #绘制小提琴图geom_point(data = Data_summary,aes(x=Group, y=value),pch=19,position=position_dodge(0.9),size=1.5)+ #绘制均值为点图geom_errorbar(data = Data_summary,aes(ymin = value-ci, ymax=value+ci), #误差条表示95%的置信区间width=0.1, #误差条末端短横线的宽度position=position_dodge(0.9), color="black",alpha = 0.7,size=0.5) +scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充的颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P3 jpeg(file = "results_Value_3.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存
print(P3)
dev.off()GeomSplitViolin <- ggproto("GeomSplitViolin", GeomViolin, draw_group = function(self, data, ..., draw_quantiles = NULL) {data <- transform(data, xminv = x - violinwidth * (x - xmin), xmaxv = x + violinwidth * (xmax - x))grp <- data[1,'group']newdata <- plyr::arrange(transform(data, x = if(grp%%2==1) xminv else xmaxv), if(grp%%2==1) y else -y)newdata <- rbind(newdata[1, ], newdata, newdata[nrow(newdata), ], newdata[1, ])newdata[c(1,nrow(newdata)-1,nrow(newdata)), 'x'] <- round(newdata[1, 'x']) if (length(draw_quantiles) > 0 & !scales::zero_range(range(data$y))) {stopifnot(all(draw_quantiles >= 0), all(draw_quantiles <= 1))quantiles <- ggplot2:::create_quantile_segment_frame(data, draw_quantiles)aesthetics <- data[rep(1, nrow(quantiles)), setdiff(names(data), c("x", "y")), drop = FALSE]aesthetics$alpha <- rep(1, nrow(quantiles))both <- cbind(quantiles, aesthetics)quantile_grob <- GeomPath$draw_panel(both, ...)ggplot2:::ggname("geom_split_violin", grid::grobTree(GeomPolygon$draw_panel(newdata, ...), quantile_grob))} else {ggplot2:::ggname("geom_split_violin", GeomPolygon$draw_panel(newdata, ...))}}
)geom_split_violin <- function (mapping = NULL, data = NULL, stat = "ydensity", position = "identity", ..., draw_quantiles = NULL, trim = TRUE, scale = "area", na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) {layer(data = data, mapping = mapping, stat = stat, geom = GeomSplitViolin, position = position, show.legend = show.legend, inherit.aes = inherit.aes, params = list(trim = trim, scale = scale, draw_quantiles = draw_quantiles, na.rm = na.rm, ...))
}P4 <- ggplot(data=Data, aes(x=Group, y=value,fill=Attribute)) + geom_split_violin(trim=FALSE,color="white") + #绘制分半的小提琴图geom_point(data = Data_summary,aes(x=Group, y=value),pch=19,position=position_dodge(0.9),size=1.5)+ #绘制均值为点图geom_errorbar(data = Data_summary,aes(ymin = value-ci, ymax=value+ci), #误差条表示95%的置信区间width=0.1, #误差条末端短横线的宽度position=position_dodge(0.9), color="black",alpha = 0.7,size=0.5) +scale_fill_manual(values = c("#56B4E9", "#E69F00"))+ #设置填充的颜色theme_bw()+ #背景变为白色theme(axis.text.x=element_text(angle=15,hjust = 1,colour="black",family="Times",size=20), #设置x轴刻度标签的字体显示倾斜角度为15度，并向下调整1(hjust = 1)，字体簇为Times大小为20axis.text.y=element_text(family="Times",size=16,face="plain"), #设置y轴刻度标签的字体簇，字体大小，字体样式为plainaxis.title.y=element_text(family="Times",size = 20,face="plain"), #设置y轴标题的字体属性panel.border = element_blank(),axis.line = element_line(colour = "black",size=1), #去除默认填充的灰色，并将x=0轴和y=0轴加粗显示(size=1)legend.text=element_text(face="italic", family="Times", colour="black", #设置图例的子标题的字体属性size=16),legend.title=element_text(face="italic", family="Times", colour="black", #设置图例的总标题的字体属性size=18),panel.grid.major = element_blank(), #不显示网格线panel.grid.minor = element_blank())+ #不显示网格线ylab("Value")+xlab("") #设置x轴和y轴的标题P4jpeg(file = "results_Value_4.jpg",width =1600,height = 2000,units = "px",res =300) #结果保存
print(P4)
dev.off()
References
- 不同画图对数据信息变现的影响——以条形图和小提琴图为例:https://mp.weixin.qq.com/s?__biz=MzUxMTA0ODQ0OA==&mid=2247483919&idx=1&sn=c10bea1ad07543323cc52392a9f66d39&chksm=f978ec60ce0f65762a99baad77b69f93594211209ec12d05d9ac4f7113eb8f2561f21148f6f2&scene=0#rd
- https://gist.github.com/Karel-Kroeze/746685f5613e01ba820a31e57f87ec87
数据可视化——R语言ggplot2包绘制精美的小提琴图(并箱线图或误差条图组合)相关推荐
- 数据可视化——R语言ggplot2包绘制相关矩阵为热图
数据可视化--R语言ggplot2包绘制相关矩阵为热图 概述:R语言软件和数据可视化--ggplot2快速绘制相关矩阵为热图.本文翻译了一篇英文博客,博客原文链接:http://www.sthda.c ...
- 数据可视化——R语言wordcloud2包绘制字云图
数据可视化--R语言wordcloud2包绘制字云图 概述:使用R语言的wordcloud2工具包绘制字云图,并保存为图片格式或网页格式 字云图,也称为标签云图或语言云图.通过使每个字的大小与其出现频 ...
- 使用R语言ggplot2包绘制pathway富集分析气泡图（Bubble图）:数据结构及代码
气泡图是在笛卡尔坐标系同加入大小的参数所形成的可以表示三个变量关系的图例.在对基因完成GO/KEGG分析后,使用气泡图可以直观的展示pathway.pvalue.count之间的关系.下面为使用R语言 ...
- 数据可视化——R语言绘制散点相关图并自动添加相关系数和拟合方程
数据可视化--R语言绘制散点相关图并自动添加相关系数和拟合方程 加载所需的包并设置主题样式 示例数据 基本的散点相关图 添加相关系数和显著性水平(P值) 存在多个组别的散点相关图 自动添加回归曲线的拟 ...
- R语言ggplot2包和ggtext包在可视化图像中的指定位置添加文本框（横向文本框、竖向文本框）
R语言ggplot2包和ggtext包在可视化图像中的指定位置添加文本框(横向文本框.竖向文本框) 目录
- R语言ggplot2包和lattice包可视化改变x轴和y轴的显示位置实战
R语言ggplot2包和lattice包可视化改变.自定义x轴和y轴的显示位置实战 目录 R语言ggplot2包和lattice包可视化改变.自定义x轴和y轴的显示位置实战
- R语言ggplot2包以及lattice包可视化方程、函数的曲线实战：function curve
R语言ggplot2包以及lattice包可视化方程.函数的曲线实战:function curve 目录 R语言ggplot2包以及lattice包可视化方程.函数的曲线实战:function cur ...
- R语言ggplot2包旋转（Rotate）可视化图像轴标签实战
R语言ggplot2包旋转(Rotate)可视化图像轴标签实战 目录 R语言ggplot2包旋转(Rotate)可视化图像轴标签实战
- [置顶]R语言 ggplot2包
R语言 ggplot2包的学习 分析数据要做的第一件事情,就是观察它.对于每个变量,哪些值是最常见的?值域是大是小?是否有异常观测? ggplot2图形之基本语法: ggplot2的核心理念是将绘图 ...
最新文章
- javascript:为string类添加三个成员，实现去左，右，及所有空格
- 【CF671D】 Roads in Yusland（对偶问题，左偏树）
- tomact错误日志是那个_如何查看tomcat启动异常日志详情
- C#应用视频教程3.1 USB工业相机测试
- Mac上最好的Markdown文本编辑器_编辑工具
- Pycharm配置Python虚拟环境与在虚拟环境安装PYQT5
- 漫步微积分二——微积分是什么
- 桂林理工计算机与科学技术,桂林理工大学信息科学与工程学院
- 如何开启开源之旅（一）
- ubuntu 下mongodb安装
- go - str - byte
- BZOJ 1015: [JSOI2008]星球大战starwar 并查集
- 【紫书第五章】String、结构体、部分STL的常见用法
- 解决在编程方式下无法访问Spark Master问题
- 如何解决程序/C++Dll的兼容性问题
- 用计算机技术辅助语文教学,利用计算机技术辅助拼音学习“潜力无限”
- Windows Server 2019/2022域控制器网络位置变为“专用网络”或“公共网络”
- Es6模板字符串条件判断
- 学习@浅墨_毛星云的【OpenCV入门教程】之四
- 赋值，浅拷贝，深拷贝区别和实现方法
热门文章
- Scikit-learn 秘籍 第四章 使用 scikit-learn 对数据分类
- 张瑞敏分享海尔变革实践：借鉴黄金圈法则 革自己的命
- 【LeetCode】77. Combinations 解题报告（Python C++）
- 股票量化对冲策略的发展与展望
- 小黄鸭坤坤（Python高还原绘图）
- vscode中php cs fixer_vscode 中使用php-cs-fixer和PHP Formatter 插件规范化PHP代码
- android图案解锁功能的实现
- Naive script setup写法上传注意
- 程序烧录器STLINK_V2CMSIS_DAP_V2制作——DIY方案分享
- 华三RIF堆叠实验配置