跨组添加趋势线并在分组小提琴图或箱线图中设置刻度标签

Question

我使用R 的ggplot2 geom_violin 添加回归趋势线来绘制xy 分组数据：

以下是数据：

library(dplyr)
library(plotly)
library(ggplot2)

set.seed(1)
df <- data.frame(value = c(rnorm(500,8,1),rnorm(600,6,1.5),rnorm(400,4,0.5),rnorm(500,2,2),rnorm(400,4,1),rnorm(600,7,0.5),rnorm(500,3,1),rnorm(500,3,1),rnorm(500,3,1)),
                 age = c(rep("d3",500),rep("d8",600),rep("d24",400),rep("d3",500),rep("d8",400),rep("d24",600),rep("d3",500),rep("d8",500),rep("d24",500)),
                 group = c(rep("A",1500),rep("B",1500),rep("C",1500))) %>%
  dplyr::mutate(time = as.integer(age)) %>%
  dplyr::arrange(group,time) %>%
  dplyr::mutate(group_age=paste0(group,"_",age))

df$group_age <- factor(df$group_age,levels=unique(df$group_age))

还有我目前的情节：

ggplot(df,aes(x=group_age,y=value,fill=age,color=age,alpha=0.5)) + 
  geom_violin() + geom_boxplot(width=0.1,aes(fill=age,color=age,middle=mean(value))) + 
  geom_smooth(data=df,mapping=aes(x=group_age,y=value,group=group),color="black",method='lm',size=1,se=T) + theme_minimal()

我的问题是：

1. 如何去掉legend 中的alpha 部分？
2. 我希望x-axis ticks 是df$group 而不是df$group_age，这意味着tick 每个group 在group 的中心，其中标签是group .考虑一种情况，并非所有groups 都具有所有ages - 例如，如果某个group 只有两个ages，我很确定ggplot 只会出现这两个ages，我希望 tick 仍然位于它们的两个 ages 之间。

还有一个问题：

最好将每个拟合斜率的 p 值绘制在每个 group 的顶部。

我试过了：

library(ggpmisc)
my.formula <- value ~ group_age
ggplot(df,aes(x=group_age,y=value,fill=age,color=age,alpha=0.5)) + 
  geom_violin() + geom_boxplot(width=0.1,aes(fill=age,color=age,middle=mean(value))) + 
  geom_smooth(data=df,mapping=aes(x=group_age,y=value,group=group),color="black",method='lm',size=1,se=T) + theme_minimal() +
  stat_poly_eq(formula = my.formula,aes(label=stat(p.value.label)),parse=T)

但我得到与上面相同的情节，并带有以下warning 消息：

Warning message:
Computation failed in `stat_poly_eq()`:
argument "x" is missing, with no default 

Answer 1

这里有一个解决方案。 alpha - 图例问题很简单。您放入aes() 功能的任何内容都将被放入图例中。当您希望将数据的某个特征用作美学特征时，应使用此特征。将 alpha 放在 aes 之外会将其从图例中删除。

我不确定 x 图例是您想要的，但我是手动完成的，所以应该很容易配置。

关于 p.values，我做了单独的线性回归并将 p.value 存储在三个不同的向量中，这些向量可以使用注释调用到 ggplot 中。对于其中两个组，p.value 为 <.001>round 函数会将其舍入为 0。因此，我只是添加了 p. <.001

祝你好运！

library(dplyr)
library(ggplot2)

set.seed(1)
df <- data.frame(value = c(rnorm(500,8,1),rnorm(600,6,1.5),rnorm(400,4,0.5),rnorm(500,2,2),rnorm(400,4,1),rnorm(600,7,0.5),rnorm(500,3,1),rnorm(500,3,1),rnorm(500,3,1)),
                 age = c(rep("d3",500),rep("d8",600),rep("d24",400),rep("d3",500),rep("d8",400),rep("d24",600),rep("d3",500),rep("d8",500),rep("d24",500)),
                 group = c(rep("A",1500),rep("B",1500),rep("C",1500))) %>%
  dplyr::mutate(time = as.integer(age)) %>%
  dplyr::arrange(group,time) %>%
  dplyr::mutate(group_age=paste0(group,"_",age))

df$group_age <- factor(df$group_age,levels=unique(df$group_age))

mod1 <- lm(value ~ time,df\[df$group == 'A',\])
mod1 <- summary(mod1)$coefficients\[8\] %>% round(2)

mod2 <- lm(value ~ time,df\[df$group == 'B',\])
mod2 <- summary(mod2)$coefficients\[8\] %>% round(2)

mod3 <- lm(value ~ time,df\[df$group == 'C',\])
mod3 <- summary(mod3)$coefficients\[8\] %>% round(2)



ggplot(df,aes(x=group_age,y=value,fill=age,color=age)) + 
  geom_violin(alpha=0.5) + 
  geom_boxplot(width=0.1,aes(fill=age,color=age,middle=mean(value))) + 
  geom_smooth(mapping=aes(x=group_age,y=value,group=group),color="black",method='lm',size=1,se=T) + 
  scale_x_discrete(labels = c('','A','','','B','','','C','')) +
  annotate('text',x = 2,y = -1,label = paste('pvalue: <.001')) +
  annotate('text',x = 6,y = 10,label = paste('pvalue: <.001')) +
  annotate('text',x = 8,y = -1.2,label = paste('pvalue:',mod3))+
  theme_minimal()

Answer 2

geom_smooth() 适合一行，而stat_poly_eqn() 发出错误。 factor 是具有无序级别的分类变量。针对某个因素的趋势是不确定的。 geom_smooth() 可能正在获取级别并将它们转换为“任意”数值，但这些值只是索引而不是有意义的值。

要获得类似于问题中描述的图，但使用提供正确线性回归线和相应 p 值的代码，我将使用下面的代码。主要变化是数值变量time 映射到x，使得回归拟合成为有效操作。为了实现线性拟合，我们使用了带有 log10 变换的 x 尺度，并在数据可用的年龄处添加了中断和标签。

library(dplyr)
library(ggplot2)
library(ggpmisc)

set.seed(1)
df <-
  data.frame(
    value = c(
      rnorm(500, 8, 1), rnorm(600, 6, 1.5), rnorm(400, 4, 0.5),
      rnorm(500, 2, 2), rnorm(400, 4, 1), rnorm(600, 7, 0.5),
      rnorm(500, 3, 1), rnorm(500, 3, 1), rnorm(500, 3, 1)
    ),
    age = c(
      rep("d3", 500), rep("d8", 600), rep("d24", 400),
      rep("d3", 500), rep("d8", 400), rep("d24", 600),
      rep("d3", 500), rep("d8", 500), rep("d24", 500)
    ),
    group = c(rep("A", 1500), rep("B", 1500), rep("C", 1500))
  ) %>%
  mutate(time = as.integer(gsub("d", "", age))) %>%
  arrange(group, time) %>%
  mutate(age = factor(age, levels = c("d3", "d8", "d24")),
         group = factor(group))

my_formula = y ~ x

ggplot(df, aes(x = time, y = value)) +
  geom_violin(aes(fill = age, color = age), alpha = 0.3) + 
  geom_boxplot(width = 0.1,
               aes(color = age), fill = NA) +
  geom_smooth(color = "black", formula = my_formula, method = 'lm') + 
  stat_poly_eq(aes(label = stat(p.value.label)), 
               formula = my_formula, parse = TRUE,
               npcx = "center", npcy = "bottom") +
  scale_x_log10(name = "Age", breaks = c(3, 8, 24)) +
  facet_wrap(~group) +
  theme_minimal()

创建下图：