小提琴图差异分析

hx2024

已于 2023-10-17 19:32:38 修改

阅读量392

点赞数 6

文章标签：大数据

于 2023-10-17 14:25:20 首次发布

本文链接：https://blog.csdn.net/hx2024/article/details/133882705

版权

本文介绍了如何使用R语言中的ggplot2、ggpubr和ggstatsplot库，通过小提琴图展示数据集的分布差异，并进行分组对比，同时添加箱线图和P值显著性检验。升级版示例中，还展示了如何在图形中移除散点并自定义颜色映射。

摘要由CSDN通过智能技术生成

基础版

绘制小提琴图差异分析

数据格式：

rm(list = ls())
options(stringsAsFactors = F)

##生成随机数据集
set.seed(123)
# 生成三组随机数据
group1 <- runif(20, 2, 5)
group2 <- runif(20, 6, 9)
group3 <- runif(20, 4, 7)
# 将三组数据合并成一个dataframe
##df <- data.frame(group1, group2, group3)
df <- data.frame(value = c(group1, group2, group3),
                 group = rep(c("group1", "group2", "group3"), each = 20))

##基础版
library(ggpubr)
ggviolin(df,x="group",y="value",fill = "group")

##调色
ggviolin(df,x="group",y="value",fill = "group",
         palette = c('lancet'))

##添加箱线图
ggviolin(df,x="group",y="value",fill = "group",
         palette = c('lancet'),
         add = "boxplot",
         add.params = list(fill="#EABF00"))##  "white" 可以调整箱线图配色

##进行排序
ggviolin(df,x="group",y="value",fill = "group",
         palette = c('lancet'),
         add = "boxplot",
         add.params = list(fill="#EABF00"),
         order = c("group2","group3","group1"))##进行设置排序

##对比
my_comparisons <- list(c("group1","group2"),
                       c("group1","group3"),
                       c("group2","group3"))
ggviolin(df,x="group",y="value",fill = "group",
         palette = c('lancet'),
         add = "boxplot",
         add.params = list(fill="#EABF00"),
         order = c("group2","group3","group1"))+
  stat_compare_means(comparisons = my_comparisons)

# 保存图像
#ggsave("boxViolin.pdf", width = 4.5, height = 4)

升级版

数据格式

rm(list = ls())
options(stringsAsFactors = F)
library(ggplot2)
library(ggpubr)
library(ggstatsplot)

# 生成随机数据
set.seed(123)
group1 <- runif(20, 2, 5)
group2 <- runif(20, 4, 7)
group3 <- runif(20, 6, 9)
group4 <- runif(20, 8, 11)

# 创建dataframe 注意每列的顺序不能乱，避免报错
df <- data.frame(cluster = rep(c("cluster1","cluster2"), 40),
                 value = c(group1, group2, group3, group4),
                 group = rep(c("group1", "group2", "group3","group4"), each = 20))

#split_violin_ggplot.R##封装的函数
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, ...))
}
###############
comparisons = list(c("cluster1", "cluster2"))
df <- transform(df, dist_cat_n = as.numeric(as.factor(df$group)), 
                 scat_adj = ifelse(cluster =="cluster1", -0.15, 0.15))
df$cluster = factor(df$cluster)
head(df)
ggplot(df, aes(x = group, y = value, fill = cluster)) + geom_split_violin(trim = T, draw_quantiles = 0.5) +
  geom_jitter(aes(scat_adj + dist_cat_n, y = value, fill = cluster),
              position = position_jitter(width = 0.1,height = 0), shape = 21, size = 1) + 
  theme_bw() + xlab("")
# 保存图像
#ggsave("boxViolin.pdf", width = 20, height = 6)
dev.off()

添加P值修改颜色等

ggplot(df, aes(x = group, y = value, fill = cluster)) +
  geom_split_violin(trim = T, draw_quantiles = 0.5) +
  geom_jitter(aes(scat_adj + dist_cat_n, y = value, fill = cluster),
              position = position_jitter(width = 0.1,height = 0),
              shape = 21, size = 1) + 
  scale_fill_manual(values = c("#eef2f3","#89c3eb")) + ##修改颜色
  stat_compare_means(data = df, aes(x = group, y = value), ##添加P值
                     #label = "p.format",method = "t.test") +##检验方法
                     label = "p.signif", method = "t.test") +##显示显著性
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +##调整横坐标显示
  xlab("")

#ggsave("boxViolin.pdf", width = 20, height = 6)# 保存图像
dev.off()



########不要散点
ggplot(df, aes(x = group, y = value, fill = cluster)) +
  geom_split_violin(trim = T, draw_quantiles = 0.5) +
  #geom_jitter(aes(scat_adj + dist_cat_n, y = value, fill = cluster),
              #position = position_jitter(width = 0.1,height = 0),
              #shape = 21, size = 1) + ##添加散点
  scale_fill_manual(values = c("#eef2f3","#89c3eb")) + ##修改颜色
  stat_compare_means(data = df, aes(x = group, y = value), ##添加P值
                     #label = "p.format",method = "t.test") +##检验方法
                     label = "p.signif", method = "t.test") +##显示显著性
  theme_bw() +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +##调整横坐标显示
  xlab("")