R: t.test 在 facet_grid (ggplot)

Question

这是一个非常具体的问题，但我已经拥有并使用了这个详细且运行良好的代码，所以我希望找到调整它所需的微小更改，并使其适用于下一个复杂级别。 我得到了什么：

library(ggplot2)
library(ggpubr)
head(ToothGrowth)
ToothGrowth$dose <- as.factor(ToothGrowth$dose)
# add a grouping ID for measured individuals:
ToothGrowth$ID <- rep(c(1:30),2)

# The code I am using now (basically a solution I got from my former question answered by Allan Cameron (user:12500315)):
ggplot(ToothGrowth, aes(supp, len, fill = dose, alpha = supp)) +
  geom_boxplot() +
  scale_fill_manual(name   = "Dosis", 
                    labels = c("0.5", "1", "2"), 
                    values = c("darkorange2", "olivedrab", "cadetblue4")) +
  scale_alpha_discrete(range = c(0.5, 1), 
                       guide = guide_none()) +
  geom_line(inherit.aes = FALSE, 
            aes(supp, len, group = ID), 
            color = "gray75") +
  geom_text(data = data.frame(
    x    = 1.5, 
    y    = 40, 
    dose = c("0.5", "1", "2"),
    pval = sapply(c("0.5", "1", "2"), function(x) {
      round(t.test(len ~ supp, 
                   data = ToothGrowth[ToothGrowth$dose == x,],
                   paired = TRUE)$p.val, 4)})), 
    inherit.aes = FALSE,
    aes(x = 1.5, y = 40, label = paste("T test: p value =", pval)), 
    check_overlap = TRUE) +
  facet_grid(~dose) +
  theme_classic() +
  theme(legend.position = "top",
        strip.background = element_rect(fill = "gray95", size = 0.25))

# Follow-up question:
# What I want to do next: having another facetting variable ('researcher')
ToothGrowth_1 <- ToothGrowth
# create a random numerical factor to multiply measures with and then enlarge the dataset by a second set of measurements from a different 'researcher':
r <- runif(60, min=0, max=3)
ToothGrowth_1$len <- ToothGrowth_1$len*r
ToothGrowth$researcher <- "A"
ToothGrowth_1$researcher <- "B"
ToothGrowth_total <- rbind(ToothGrowth, ToothGrowth_1)

现在，我想 plot 与上面相同的 plot ，但对两个“研究人员”组（A 与 B）进行水平切面拆分。 我通过创建和交互术语“researcher”和“dose”并用 facet_wrap 替换 facet_grid 找到了一个解决方法，但我更愿意看到 facet_grid 的解决方案，因为它使其他一切变得更容易。 感谢您的帮助，非常感谢！

Answer 1

感谢您发布后续。

做到这一点的自然方法是map两个级别，尽管我认为与其完全重写来实现这一点，我可能只会使用 2 个sapply调用 - 一个用于新因素的每个级别：

ggplot(ToothGrowth_total, aes(supp, len, fill = dose, alpha = supp)) +
  geom_boxplot() +
  scale_fill_manual(name   = "Dosis", 
                    labels = c("0.5", "1", "2"), 
                    values = c("darkorange2", "olivedrab", "cadetblue4")) +
  scale_alpha_discrete(range = c(0.5, 1), 
                       guide = guide_none()) +
  geom_line(inherit.aes = FALSE, 
            aes(supp, len, group = ID), 
            color = "gray75") +
  geom_text(data = data.frame(
    x    = 1.5, 
    y    = c(40, 40, 40, 70, 70, 70), 
    researcher = c("A", "A", "A", "B", "B", "B"),
    dose = c("0.5", "1", "2", "0.5", "1", "2"),
    pval = c(sapply(c("0.5", "1", "2"), function(x) {
            round(t.test(len ~ supp, 
            data = subset(ToothGrowth_total, dose == x & researcher == "A"),
            paired = TRUE)$p.val, 4)}), 
            sapply(c("0.5", "1", "2"), function(x) {
            round(t.test(len ~ supp, 
            data = subset(ToothGrowth_total, dose == x & researcher == "B"),
            paired = TRUE)$p.val, 4)}))),
    inherit.aes = FALSE,
    aes(x = x, y = y, label = paste("T test: p value =", pval)), 
    check_overlap = TRUE) +
  facet_grid(researcher~dose, scales = "free_y") +
  theme_classic() +
  theme(legend.position = "top",
        strip.background = element_rect(fill = "gray95", size = 0.25))

Answer 2

如果我没记错的话，我实际上找到了一种更简单的方法：

ToothGrowth_total$researcher_dose <- interaction(ToothGrowth_total$researcher, ToothGrowth_total$dose)

ggplot(ToothGrowth_total, aes(supp, len, fill = dose, alpha = supp)) +
  geom_boxplot() +
  scale_fill_manual(name   = "Dosis", 
                    labels = c("0.5", "1", "2"), 
                    values = c("darkorange2", "olivedrab", "cadetblue4")) +
  scale_alpha_discrete(range = c(0.5, 1), 
                       guide = guide_none()) +
  geom_line(inherit.aes = FALSE, 
            aes(supp, len, group = ID), 
            color = "gray75") +
  # geom_text(data = data.frame(
  #   x    = 1.5, 
  #   y    = c(40, 40, 40, 70, 70, 70), 
  #   researcher = c("A", "A", "A", "B", "B", "B"),
  #   dose = c("0.5", "1", "2", "0.5", "1", "2"),
  #   pval = c(sapply(c("0.5", "1", "2"), function(x) {
  #     round(t.test(len ~ supp, 
  #                  data = subset(ToothGrowth_total, dose == x & researcher == "A"),
  #                  paired = TRUE)$p.val, 4)}), 
  #     sapply(c("0.5", "1", "2"), function(x) {
  #       round(t.test(len ~ supp, 
  #                    data = subset(ToothGrowth_total, dose == x & researcher == "B"),
  #                    paired = TRUE)$p.val, 4)}))),
  #   inherit.aes = FALSE,
  #   aes(x = x, y = y, label = paste("T test: p value =", pval)), 
  #   check_overlap = TRUE) +
# => instead subsituted by: 
  stat_compare_means(aes(x="researcher_dose"), method = "t.test", paired = TRUE)+ 
  facet_grid(researcher~dose, scales = "free_y") +
  theme_classic() +
  theme(legend.position = "top",
        strip.background = element_rect(fill = "gray95", size = 0.25))

我希望我在这里没有遗漏任何重要的东西，但它会产生相同的t.test结果，因此我认为它是正确的。 如果没有，请告诉我。 唯一的区别是“researcher_dose”现在也显示为 x 轴标签。