基于象限的R ggplot2中散点图的统计摘要

Question

我想绘制一个带有分面和象限的散点图 - 我想在每个分面 + 象限上显示基本统计数据，例如平均值、中位数、每个象限中的点数等。我的搜索引导我找到 ggpubr 包中的 stat_mean() 函数、ggpp 包中的 geom_quadrant_lines 和 stat_quadrant_counts()

但是，使用 stat_mean 函数，我只能打印整个方面的“平均值”，但无法绘制每个象限的平均值。 我也无法找出正确的方法来获取其他统计数据，如中位数、相关性等——无论是在方面还是在象限方面。

对此的任何帮助都非常感谢！

library(ggplot2)
library(ggpubr)
library(ggpp)
#> 
#> Attaching package: 'ggpp'
#> The following object is masked from 'package:ggplot2':
#> 
#>     annotate

data <- data.frame(
  xlabel = c(1, 2, 3, 4, 5, 6, 7, 8, 9, 10), ylabel = c(10, 12, 14, 16, 18, 6, 5, 4, 3, 2),
  facets = c("a", "a", "a", "a", "a", "b", "b", "b", "b", "b")
)


ggplot(data = data, aes(x = xlabel, y = ylabel, color = facets)) +
  geom_point() +
  facet_wrap(facets ~ ., ) +
  stat_mean(color = "black") +
  stat_quadrant_counts(xintercept = 3, yintercept = 9) +
  geom_quadrant_lines(xintercept = 3, yintercept = 9)

^{由reprex package (v2.0.1) 于 2021 年 11 月 17 日创建}

Answer 1

这个包里隐藏着一个非常尴尬的函数which_quadrant，它有助于根据你的x/y坐标和截距找到象限。此信息可用于您所谓的“均值”（更确切地说：质心）的简单计算。

另一方面，如果我是包维护者，我会将函数分开，而不是作为 Stat$compute_panel 层的一部分，因为这对调试来说真的很痛苦。

library(tidyverse)
library(ggpp)

data <- data.frame(xlabel = 1:10, ylabel = c(seq(10,18,2), 6:2), 
                   facets= rep(letters[1:2], each = 5))

## modified from StatQuadrantCounts$compute_panel
which_quadrant <- function(x, y, xintercept, yintercept, pool.along = "none") {
  z <- ifelse(x >= xintercept & y >= yintercept,
              1L, 
              ifelse(x >= xintercept & y < yintercept,
                     2L,
                     ifelse(x < xintercept & y < yintercept,
                            3L,
                            4L
                     )
              )
  )
  if (pool.along == "x") {
    z <- ifelse(z %in% c(1L, 4L), 1L, 2L)
  } else if (pool.along == "y") {
    z <- ifelse(z %in% c(1L, 2L), 1L, 4L)
  }
  z
}

quad_summary <- 
  data %>%
  mutate(quadrant = which_quadrant(x = xlabel, y=  ylabel, xintercept = 3, yintercept =9)) %>%
  group_by(facets, quadrant) %>%
  mutate(across(contains("label"), mean))

ggplot(data, aes(x=xlabel, y = ylabel)) + 
  geom_point(aes(color = facets)) +
  facet_wrap(facets~.,) +
  stat_quadrant_counts(xintercept = 3, yintercept =9) +
  geom_quadrant_lines(xintercept = 3, yintercept =9) +
  geom_point(data = quad_summary, shape = 2, size = 2, aes(xlabel, ylabel))

^{由reprex package (v2.0.1) 于 2021 年 11 月 17 日创建}