我希望在多面 ggplot 图表中包含多个统计测试的结果。
我发现了很多关于如何在标题或注释中包含类似内容的优秀示例(如 this ),但是,我的兴趣在于将其作为文本注释包含在内,以便我可以显示许多结果对一个图形进行测试。
我已经能够使用标准文本注释来做到这一点,但是我想使用 polymath
/expressions
来展示我的结果,这样我就可以生成一个跟随在包 [ggstatsplot]
中实现的 APA 风格指南 1 , 请参见下面的示例:
我在下面包含了一个使用 ggplot2
中的 diamonds
数据的可重现示例的代码。我尝试过的一些事情包括:
- 尝试将
bquote
和expression
对象作为列存储在wilcox_stats
对象中 — 然而 dplyr 似乎不喜欢它 - 试图从
ggplot
中调用这一切——然而,试图排除geom_text
想要打印的所有注释变得相当困惑
如果您能提供任何帮助或指点,我们将不胜感激。
# LOAD REQUIRED PACKAGES
library(ggplot2)
library(tidyverse)
library(rstatix)
# CREATE SAMPLE DATA
sample_data <- diamonds %>%
select(cut, color, table) %>%
filter(color == c("E","J")) %>%
mutate(time = factor(case_when(
table %% 2 == 0 ~ "Before",
TRUE ~ "After"))) %>%
group_by(color, time) %>%
sample_n(100) %>%
ungroup() %>%
mutate(numeric_cut = case_when(
cut == "Ideal" ~ 1,
cut == "Premium" ~ 2,
cut == "Very Good" ~ 3,
cut == "Good" ~ 4,
cut == "Fair" ~ 5))
# STAT TESTS
wilcox_test <- sample_data %>%
group_by(color) %>%
wilcox_test(numeric_cut ~ time, paired = TRUE, detailed = TRUE) %>%
select(color, statistic, p, n1)
wilcox_es <- sample_data %>%
group_by(color) %>%
wilcox_effsize(numeric_cut ~ time, paired = TRUE, ci = TRUE) %>%
select(color, effsize, conf.low, conf.high)
## EXTRACT ELEMENTS OF STAT TESTS AND USE THEM TO CREATE ANNOTATION
wilcox_stats <- left_join(wilcox_test, wilcox_es) %>%
mutate(statistic = round(statistic, 1)) %>%
mutate(effsize = round(effsize, 2)) %>%
mutate(p = round(p, 3)) %>%
mutate(result = deparse(bquote(
V[Wilcoxon]==.(statistic)~ #this code does not work
italics(p)==.p~
hat(r) == .effsize~
"CI"["95%"]~
.conf.low~.conf.high~
n[pairs]==.n1)))
## PREPARE PLOT DATA
plot_data <- sample_data %>%
group_by(time, cut, color) %>%
tally() %>%
ungroup() %>%
group_by(color) %>%
mutate(total_n = sum(n)) %>%
mutate(percent = (n/total_n)*100) %>%
mutate(percent = round(percent, 1)) %>%
ungroup() %>%
left_join(wilcox_stats) %>%
mutate(result = case_when(
time == "Before" & cut == "Ideal" ~ "",
time == "After" & cut == "Ideal" ~ "",
time == "Before" & cut == "Premium" ~ "",
time == "After" & cut == "Premium" ~ "",
time == "Before" & cut == "Very Good" ~ "",
time == "After" & cut == "Very Good" ~ result,
time == "Before" & cut == "Good" ~ "",
time == "After" & cut == "Good" ~ "",
time == "Before" & cut == "Fair" ~ "",
time == "After" & cut == "Fair" ~ "")) %>%
mutate(time = factor(time, levels = c("Before", "After", ordered = TRUE)))
## PLOT RESULTS
plot <- plot_data %>%
ggplot() +
aes(x = cut, y = percent, fill = cut) +
geom_bar(stat = "identity") +
geom_text(aes(label = result, y = 30), size = 5, parse = TRUE) +
facet_grid(color ~ time)
下图显示了我希望创建的输出的要点...
最佳答案
我可能会使用粘贴创建表达式,(老实说,因为我发现包含变量更容易)。
我略微缩短了代码,也没有使用您的完整表达,但我认为它应该足以理解这个想法。
library(tidyverse)
sample_data <- diamonds %>%
select(cut, color, table) %>%
filter(color == c("E","J")) %>%
mutate(time = if_else(table %% 2 == 0, "Before", "After")) %>%
group_by(color, time) %>%
sample_n(100) %>%
ungroup() %>%
mutate(numeric_cut = as.numeric(cut))
wilcox_test <- sample_data %>%
group_by(color) %>%
rstatix::wilcox_test(numeric_cut ~ time, paired = TRUE, detailed = TRUE) %>%
select(color, statistic, p, n1)
wilcox_es <- sample_data %>%
group_by(color) %>%
rstatix::wilcox_effsize(numeric_cut ~ time, paired = TRUE, ci = TRUE) %>%
select(color, effsize, conf.low, conf.high)
这里是关键点
wilcox_stats <- left_join(wilcox_test, wilcox_es) %>%
mutate(statistic = round(statistic, 1),
effsize = round(effsize, 2),
p = round(p, 3),
label = paste('V[Wilcoxon]==', statistic, '~italic(p)==~', p))
#> Joining, by = "color"
plot_data <- sample_data %>%
count(time, cut, color) %>%
group_by(color) %>%
mutate(total_n = sum(n),
percent = round((n/total_n)*100,1)) %>%
ungroup() %>%
left_join(wilcox_stats) %>%
mutate(result = if_else(time == "After" & cut == "Very Good", label, ""))
#> Joining, by = "color"
plot_data %>%
ggplot() +
aes(x = cut, y = percent, fill = cut) +
geom_bar(stat = "identity") +
geom_text(aes(label = result, y = 30), parse = TRUE) +
facet_grid(color ~ time)
由 reprex package 创建于 2020-04-26 (v0.3.0)
关于r - 如何将统计测试的结果作为绘图数学表达式包含在 ggplot2 facet 中,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/61437467/