如何根據 p 值表獲得字母分離以表示顯着的最小二乘均值

Question

我正在嘗試使用以下數據執行混合 model 擬合。

df.urbana <- structure(list(Location = structure(c(2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("Monmouth", 
"Urbana"), class = "factor"), treatment = structure(c(1L, 1L, 
1L, 1L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L), .Label = c("CC", 
"CCS", "CS", "SCS"), class = "factor"), block = structure(c(1L, 
2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L, 1L, 2L, 3L, 4L), .Label = c("1", 
"2", "3", "4"), class = "factor"), B.glucosidase = c(0.845077, 
1.011463, 0.857032, 0.989803, 0.859022, 0.919467, 1.01717, 0.861689, 
0.972332, 0.952922, 0.804431, 0.742634, 1.195837, 1.267285, 1.08571, 
1.20097), Protein = c(7933.333333, 7000, 6352.982456, 8153.684211, 
6077.894737, 4939.649123, 5002.807018, 6489.122807, 4694.035088, 
5901.052632, 4303.859649, 6768.421053, 6159.298246, 6090.526316, 
4939.649123, 5262.45614), POX.C = c(683.3528, 595.9173, 635.4315, 
672.4234, 847.2944, 745.5665, 778.3548, 735.8141, 395.2647, 570.4148, 
458.0383, 535.3851, 678.0293, 670.7419, 335.2923, 562.5674), 
    yield = c(5583L, 5442L, 5693L, 5739L, 5045L, 4902L, 5006L, 
    5086L, 4639L, 4781L, 4934L, 4857L, 4537L, 4890L, 4842L, 4608L
    )), row.names = 17:32, class = "data.frame")

然后，我計算了數據中所有四種處理（CC、CCS、CS 和 SCS）的成對 p 值，得到 p 值表（ p-table ），如下所示：

mod.yield.U <- lmerTest::lmer(yield ~ treatment + (1|block),data=df.urbana)
summary(mod.yield.U)
p.value.yield.U <- emmeans::emmeans(mod.yield.U, pairwise ~ treatment)
p.value.yield.U <- (summary(p.value.yield.U, adjust = "none") %>%   # default adjust is tukey
                      purrr::pluck("contrasts") %>% 
                      as.data.frame())[c(1,6)]
colnames(p.value.yield.U) <- c("contrasts.contrast", "Yield_Urbana")

mod.B.glucosidase.U <- lmerTest::lmer(B.glucosidase ~ treatment + (1|block),data=df.urbana)
summary(mod.B.glucosidase.U)
p.value.B.glucosidase.U <- emmeans::emmeans(mod.B.glucosidase.U, pairwise ~ treatment)
p.value.B.glucosidase.U <- (summary(p.value.B.glucosidase.U, adjust = "none") %>%   # default adjust is tukey
                              purrr::pluck("contrasts") %>% 
                              as.data.frame())[c(1,6)]
colnames(p.value.B.glucosidase.U) <- c("contrasts.contrast", "B.glucosidase_Urbana")

mod.Protein.U <- lmerTest::lmer(Protein ~ treatment + (1|block), data=df.urbana)
summary(mod.Protein.U)
p.value.Protein.U <- emmeans::emmeans(mod.Protein.U, pairwise ~ treatment)
p.value.Protein.U <- (summary(p.value.Protein.U, adjust = "none") %>%   # default adjust is tukey
                        purrr::pluck("contrasts") %>% 
                        as.data.frame())[c(1,6)]
colnames(p.value.Protein.U) <- c("contrasts.contrast", "Protein_Urbana")
mod.POX.C.U <- lmerTest::lmer(POX.C ~ treatment + (1|block),data=df.urbana)
summary(mod.POX.C.U)
p.value.POX.C.U <- emmeans::emmeans(mod.POX.C.U, pairwise ~ treatment)
p.value.POX.C.U <- (summary(p.value.POX.C.U, adjust = "none") %>%   # default adjust is tukey
                      purrr::pluck("contrasts") %>% 
                      as.data.frame())[c(1,6)]
colnames(p.value.POX.C.U) <- c("contrasts.contrast", "POX.C_Urbana")

# merge all
p_table <- Reduce(
  function(x, y, ...) merge(x, y, by = "contrasts.contrast", ...),
  list(p.value.yield.U, p.value.Protein.U, p.value.POX.C.U, p.value.B.glucosidase.U)
)

我還計算了最小二乘均值（ LS_MEAN表），如下所示：

mod.yield.U <- lmerTest::lmer(yield ~ treatment + (1|block),data=df.urbana)
summary(mod.yield.U)
LS_MEAN.yield.U <- emmeans::emmeans(mod.yield.U, pairwise ~ treatment)
LS_MEAN.yield.U <- as.data.frame(LS_MEAN.yield.U[1])
LS_MEAN.yield.U <- as.data.frame(LS_MEAN.yield.U[c("emmeans.treatment", "emmeans.emmean")])
colnames(LS_MEAN.yield.U) <- c("emmeans.treatment", "Yield_Urbana")

mod.B.glucosidase.U <- lmerTest::lmer(B.glucosidase ~ treatment + (1|block),data=df.urbana)
summary(mod.B.glucosidase.U)
LS_MEAN.B.glucosidase.U <- emmeans::emmeans(mod.B.glucosidase.U, pairwise ~ treatment)
LS_MEAN.B.glucosidase.U <- as.data.frame(LS_MEAN.B.glucosidase.U[1])
LS_MEAN.B.glucosidase.U <- as.data.frame(LS_MEAN.B.glucosidase.U[c("emmeans.treatment", "emmeans.emmean")])
colnames(LS_MEAN.B.glucosidase.U) <- c("emmeans.treatment", "B.glucosidase_Urbana")

mod.Protein.U <- lmerTest::lmer(Protein ~ treatment + (1|block), data=df.urbana)
summary(mod.Protein.U)
LS_MEAN.Protein.U <- emmeans::emmeans(mod.Protein.U, pairwise ~ treatment)
LS_MEAN.Protein.U <- as.data.frame(LS_MEAN.Protein.U[1])
LS_MEAN.Protein.U <- as.data.frame(LS_MEAN.Protein.U[c("emmeans.treatment", "emmeans.emmean")])
colnames(LS_MEAN.Protein.U) <- c("emmeans.treatment", "Protein_Urbana")

mod.POX.C.U <- lmerTest::lmer(POX.C ~ treatment + (1|block),data=df.urbana)
summary(mod.POX.C.U)
LS_MEAN.POX.C.U <- emmeans::emmeans(mod.POX.C.U, pairwise ~ treatment)
LS_MEAN.POX.C.U <- as.data.frame(LS_MEAN.POX.C.U[1])
LS_MEAN.POlX.C.U <- as.data.frame(LS_MEAN.POX.C.U[c("emmeans.treatment", "emmeans.emmean")])
colnames(LS_MEAN.POX.C.U) <- c("emmeans.treatment", "POX.C_Urbana")

# merge all
LS_MEAN <- Reduce(
  function(x, y, ...) merge(x, y, by = "emmeans.treatment", ...),
  list(LS_MEAN.yield.U, LS_MEAN.Protein.U, LS_MEAN.POX.C.U, LS_MEAN.B.glucosidase.U)
)

我想要的最終結果類似於帶有字母符號的最小二乘均值表，以表示如下所示的重要治療組（注意：我在下面的預期表格中沒有產量數據）。 我該怎么做才能得到這種格式的最小二乘均值？ 提前感謝您的幫助！

Answer 1

如果您將過程自動化，這可能會更有趣。 您可以使用lapply()遍歷不同的因變量。

將因變量名稱放入向量Y並創建基本公式fo 。 在每次迭代中，使用update()更改公式中的因變量。 lapply()將遍歷四個y ，結果是一個列表Mod.U 。

Y <- c("yield", "Protein", "POX.C", "B.glucosidase")
fo <- y ~ treatment + (1|block)
Mod.U <- lapply(Y, function(y) lmerTest::lmer(update(fo, paste(y, "~ .")), data=df.urbana))

（請注意，有一個消息boundary (singular) fit: see?isSingular並且您可能在某處有一個單數擬合。）

p 值和均值計算可以用相同的方式完成。 lapply()現在將遍歷列表Mod.U的元素。 setNames()創建您的列名。 （名稱有點隱藏，但str(Mod.U)表明它們可以在names(mod.U@frame)[1]中找到）。

P.value.U <- lapply(Mod.U, function(mod.U)
  (emmeans::emmeans(mod.U, pairwise ~ treatment) %>% 
     summary(adjust = "none") %>%
     purrr::pluck("contrasts") %>% 
     as.data.frame)[c(1, 6)] %>%
    setNames(c("contrasts.contrast", paste0(names(mod.U@frame)[1], "_urbana"))))

現在Reduce()也很容易，因為我們已經有了一個列表。

p_table <- Reduce(function(x, y, ...) merge(x, y, by = "contrasts.contrast", ...), P.value.U)
#   contrasts.contrast yield_urbana Protein_urbana POX.C_urbana B.glucosidase_urbana
# 1           CC - CCS 7.977935e-05    0.005002692  0.084083738         0.8581554114
# 2            CC - CS 7.676418e-06    0.002530699  0.043628964         0.3799550686
# 3           CC - SCS 3.416131e-06    0.004771013  0.235380612         0.0023712583
# 4           CCS - CS 4.505872e-02    0.664550854  0.002028628         0.4785341647
# 5          CCS - SCS 9.777084e-03    0.976231386  0.010602656         0.0018094630
# 6           CS - SCS 3.726498e-01    0.685994660  0.310848786         0.0006411248

我們以類似的方式處理手段。

LS_MEAN.U <- lapply(Mod.U, function(mod.U) 
  (emmeans::emmeans(mod.U, pairwise ~ treatment)[1] %>%
     as.data.frame)[c("emmeans.treatment", "emmeans.emmean")] %>%
    setNames(c("emmeans.treatment", paste0(names(mod.U@frame)[1], "_urbana"))))

LS_MEAN <- Reduce(function(x, y, ...) merge(x, y, by = "emmeans.treatment", ...), LS_MEAN.U)
#   emmeans.treatment yield_urbana Protein_urbana POX.C_urbana B.glucosidase_urbana
# 1                CC      5614.25       7360.000     646.7812            0.9258438
# 2               CCS      5009.75       5627.368     776.7575            0.9143370
# 3                CS      4802.75       5416.842     489.7757            0.8680797
# 4               SCS      4719.25       5612.982     561.6577            1.1874505

現在，我仍然不確定預期結果表（讓out稱之為）如何引用p_table表，但您可以隨意使用paste0()創建后綴。 formatC()修剪到所需的位數。

out <- LS_MEAN[-2]
out$Protein_urbana <- paste0(formatC(LS_MEAN$Protein_urbana, format="f", digits=1), 
                             c("a", "ab", "b", "ab"))
out$POX.C_urbana <- paste0(formatC(LS_MEAN$POX.C_urbana, format="f", digits=2), 
                           c("ab", "a", "b", "b"))
out$B.glucosidase_urbana <- paste0(formatC(LS_MEAN$B.glucosidase_urbana, format="f", digits=3), 
                                   c("b", "b", "b", "a"))

names(out) <- c("Treatment", "Protein_U", "POX.C_U", "B.glucosidase_U")
out
#   Treatment Protein_U  POX.C_U B.glucosidase_U
# 1        CC   7360.0a 646.78ab          0.926b
# 2       CCS  5627.4ab  776.76a          0.914b
# 3        CS   5416.8b  489.78b          0.868b
# 4       SCS  5613.0ab  561.66b          1.187a