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

Question

我有 xy 分组数据，我正在使用 R 的 ggplot2 geom_violin 添加回归趋势线：

数据如下：

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()

我的问题是：

如何删除 legend 的 alpha 部分？
我希望 x-axis ticks 是 df$group 而不是 df$group_age，这意味着 tick 每个 group 在group 的中心，标签为 group。考虑并非所有 group 都具有所有 age 的情况 - 例如，如果某个 group 只有两个 age，我很确定 ggplot 只会显示这两个 age，我希望 tick 仍然位于它们的两个 age 之间。

还有一个问题：

最好将每个拟合斜率的 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()

创建下图：

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

Adding trend lines across groups and setting tick labels in a grouped violin plot or box plot

r

legend

ggplot2

axis-labels

ggpmisc