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

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

我的问题是：

1. 我如何摆脱的alpha部分legend？
2. 我希望x-axis ticks是df$group而不是df$group_age，这意味着tick每个标签所在group的中心都有一个。考虑并非所有s 都具有所有s 的情况 - 例如，如果某个人只有两个s 并且我很确定只会呈现这两个s，我希望 s仍然位于他们的两个s之间.groupgroupgroupagegroupageggplotagetickage

还有一个问题：

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

geom_smooth()适合一条线，同时stat_poly_eqn()发出错误。Afactor是具有无序级别的分类变量。针对某个因素的趋势是不确定的。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()

这将创建下图：

Answer 2

这是一个解决方案。alpha - 图例问题很简单。您放入aes()功能中的任何内容都将放入图例中。当您希望将数据的某个特征用作美学特征时，应使用此特征。放在alphaan 之外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()