Как включить результаты статистического теста в качестве выражения plotmath в фасете ggplot2 - PullRequest
Новая
       47

Как включить результаты статистического теста в качестве выражения plotmath в фасете ggplot2

2 голосов
/ 26 апреля 2020

Я хочу включить результаты нескольких статистических тестов в граненый график ggplot.

Я нашел много отличных примеров (например, this ) о том, как включить что-то похожее в заголовок или аннотацию, однако мой интерес заключается в том, чтобы включить его в качестве текстовой аннотации, чтобы Я могу показать результаты многих тестов на одной фигуре.

Я смог сделать это, используя стандартные текстовые аннотации, однако я хочу представить свои результаты, используя polymath / expressions, чтобы я мог производить аннотация, следующая за руководством по стилю APA, реализованная в пакете [ggstatsplot] 1 , см. пример ниже:

enter image description here

I Ниже приведен код для воспроизводимого примера с использованием данных diamonds из ggplot2. Вот некоторые из вещей, которые я пробовал:

  • попытка сохранить объекты 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)

На приведенном ниже рисунке показана суть вывода I w sh для создания ...

enter image description here

1 Ответ

1 голос
/ 26 апреля 2020

Я бы, вероятно, создал выражения, используя paste (tbh, потому что мне проще включать переменные).

Я немного сократил код и также не использовал ваше полное выражение, но, думаю, этого должно хватить, чтобы понять идею. 

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)

Создан в 2020-04-26 по представ пакет (v0.3.0)

...