/
stat_kruskal_test.R
122 lines (118 loc) · 4.5 KB
/
stat_kruskal_test.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
#' @include utilities.R utils_stat_test_label.R stat_anova_test.R
NULL
#'Add Kruskal-Wallis Test P-values to a GGPlot
#'@description Add Kruskal-Wallis test p-values to a ggplot, such as
#' box blots, dot plots and stripcharts.
#'@inheritParams ggplot2::layer
#'@inheritParams stat_pvalue_manual
#'@inheritParams stat_anova_test
#'
#'@section Computed variables: \itemize{
#' \item{statistic}: the Kruskal-Wallis rank sum chi-squared statistic used to compute the p-value.
#' \item{p}: p-value.
#' \item{p.adj}: Adjusted p-values.
#' \item{p.signif}: P-value significance.
#' \item{p.adj.signif}: Adjusted p-value significance.
#' \item{p.format}: Formated p-value.
#' \item{p.adj.format}: Formated adjusted p-value.
#' \item{n}: number of samples.
#' }
#'
#' @examples
#' # Data preparation
#' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#' # Transform `dose` into factor variable
#' df <- ToothGrowth
#' df$dose <- as.factor(df$dose)
#' # Add a random grouping variable
#' set.seed(123)
#' df$group <- sample(factor(rep(c("grp1", "grp2", "grp3"), 20)))
#' df$len <- ifelse(df$group == "grp2", df$len+2, df$len)
#' df$len <- ifelse(df$group == "grp3", df$len+7, df$len)
#' head(df, 3)
#'
#'
#' # Basic boxplot
#' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#' # Create a basic boxplot
#' # Add 5% and 10% space to the plot bottom and the top, respectively
#' bxp <- ggboxplot(df, x = "dose", y = "len") +
#' scale_y_continuous(expand = expansion(mult = c(0.05, 0.1)))
#'
#' # Add the p-value to the boxplot
#' bxp + stat_kruskal_test()
#'
#' # Change the label position
#' # Using coordinates in data units
#' bxp + stat_kruskal_test(label.x = "1", label.y = 10, hjust = 0)
#'
#' # Format the p-value differently
#' custom_p_format <- function(p) {
#' rstatix::p_format(p, accuracy = 0.0001, digits = 3, leading.zero = FALSE)
#' }
#' bxp + stat_kruskal_test(
#' label = "Kruskal-Wallis, italic(p) = {custom_p_format(p)}{p.signif}"
#' )
#'
#' # Show a detailed label in italic
#' bxp + stat_kruskal_test(label = "as_detailed_italic")
#'
#'
#' # Faceted plots
#' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#' # Create a ggplot facet
#' bxp <- ggboxplot(df, x = "dose", y = "len", facet.by = "supp") +
#' scale_y_continuous(expand = expansion(mult = c(0.05, 0.1)))
#' # Add p-values
#' bxp + stat_kruskal_test()
#'
#'
#' # Grouped plots
#' #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
#' bxp2 <- ggboxplot(df, x = "group", y = "len", color = "dose", palette = "npg")
#'
#' # For each x-position, computes tests between legend groups
#' bxp2 + stat_kruskal_test(aes(group = dose), label = "p = {p.format}{p.signif}")
#'
#' # For each legend group, computes tests between x variable groups
#' bxp2 + stat_kruskal_test(aes(group = dose, color = dose), group.by = "legend.var")
#'
#' @export
stat_kruskal_test <- function(mapping = NULL, data = NULL, group.by = NULL,
label = "{method}, p = {p.format}",
label.x.npc = "left", label.y.npc = "top",
label.x = NULL, label.y = NULL, step.increase = 0.1,
p.adjust.method = "holm", significance = list(),
geom = "text", position = "identity", na.rm = FALSE, show.legend = FALSE,
inherit.aes = TRUE, parse = FALSE, ...) {
label <- get_kruskal_test_label_template(label)
if(missing(parse) & is_plotmath_expression(label)){
parse <- TRUE
}
layer(
stat = StatCompareMultipleMeans, data = data, mapping = mapping, geom = geom,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(
method = "kruskal_test",
group.by = group.by,
method.args = list(),
correction = "none",
na.rm = na.rm, stat.label = label,
label.x.npc = label.x.npc , label.y.npc = label.y.npc,
label.x = label.x, label.y = label.y, parse = parse,
is.group.specified = is_group_aes_specified(mapping),
step.increase = step.increase, p.adjust.method = p.adjust.method,
significance = fortify_signif_symbols_encoding(significance), ...
)
)
}
get_kruskal_test_label_template <- function(label){
switch(
label,
as_italic = "{method}, italic(p) = {p.format}",
as_detailed = "{method}, X2({df}) = {statistic}, p = {p.format}, n = {n}",
as_detailed_italic = "{method}, italic(chi)^2 ({df}) = {statistic}, italic(p) = {p.format}, italic(n) = {n}",
as_detailed_expression = "{method}, italic(chi)^2({df}) = {statistic}, italic(p) = {p.format}, italic(n) = {n}",
label
)
}