r - 使用facets将参数传递给geom_qq中的分布

Question

我想使用 ggplot2 的 geom_qq() 函数创建 t 分布的 QQ 图。 Hadley 提供了一个很好的示例来说明如何执行此操作 here ，但它仅适用于单个发行版。我希望将其扩展到多个组，每个组都有一个方面和分布。我发现了一个类似且相关的问题here ，但它并没有真正回答问题。

传递长度大于 1 的列表或向量似乎不起作用。

library(ggplot2)

a <- 1:10
df <- data.frame(a = a, b = rt(1000, df = a))

deg_free <- 
  lapply(a, function(x) {
    return(MASS::fitdistr(subset(df, a == x)$b, 
                          "t")$estimate["df"])
  })

g <- 
  ggplot(data=df, aes(sample=b)) + 
  geom_qq(distribution = qt, dparams = deg_free) + 
  geom_qq_line(distribution = qt, dparams = deg_free) +
  facet_wrap(~a)

有谁知道如何在不计算数据分位数并手动绘制 QQ 点和线的情况下做到这一点？

Answer 1

为了让 ggplot 在构面中考虑自由度，传递到 ggplot() 的数据帧应将其包含为一列:

library(dplyr)

set.seed(123) # for reproducibility
a <- 1:10
df <- data.frame(a = a, b = rt(1000, df = a))
deg_free <- 
  lapply(a, function(x) {
    return(MASS::fitdistr(subset(df, a == x)$b, 
                          "t")$estimate["df"])
  })

df <- df %>%
  left_join(data.frame(d = unlist(deg_free), a = a),
            by = "a")
rm(a, deg_free)

> head(df)
  a          b        d
1 1 -0.2624269 1.526920
2 2 -3.4784976 1.447293
3 3  1.6535141 2.819679
4 4  2.3848622 3.240377
5 5  0.4233105 3.946170
6 6  1.4423866 5.893569

解决了这个问题，我们可以尝试将 geom_qq/geom_qq_line 的修改版本定义为寻找自由度 df映射的美学。结果如下:

ggplot(df,
       aes(sample=b, df = d)) + 
  geom_qq2(distribution = qt) +
  geom_qq_line2(distribution = qt) +
  facet_wrap(~a, scales = "free")

创建geom_qq2/geom_qq_line2的代码:

library(magrittr)
library(ggplot2)

# take reference from the compute_group functions for StatQq / StatQqLine
# but modify the code to include df in dparams, if it's a mapped aesthetic
compute_group_StatQq2 <- environment(StatQq$compute_group)$f
compute_group_StatQqLine2 <- environment(StatQqLine$compute_group)$f

body(compute_group_StatQq2) <- body(compute_group_StatQq2) %>% as.list() %>%
  append(quote(if("df" %in% colnames(data)) dparams <- append(dparams, list("df" = data$df[1]))),
         after = 1L) %>%
  as.call()

body(compute_group_StatQqLine2) <- body(compute_group_StatQqLine2) %>% as.list() %>%
  append(quote(if("df" %in% colnames(data)) dparams <- append(dparams, list("df" = data$df[1]))),
         after = 1L) %>%
  as.call()

# define modified ggproto classes
# which inherit from StatQq / StatQqLine, but use modified compute_group functions
StatQq2 <- ggproto("StatQq2", StatQq, compute_group = compute_group_StatQq2)
StatQqLine2 <- ggproto("StatQqLine2", StatQqLine, compute_group = compute_group_StatQqLine2)

# define modified geom functions
# which are based on geom_qq / geom_qq_line, but use Stat = modified Stat
geom_qq2 <- geom_qq
geom_qq_line2 <- geom_qq_line

body(geom_qq2) <- body(geom_qq) %>% as.list() %>%
  inset2(2, (.) %>% extract2(2) %>% as.list() %>%
           modifyList(val = list(stat = quote(StatQq2))) %>%
           as.call()) %>%
  as.call()

body(geom_qq_line2) <- body(geom_qq_line2) %>% as.list() %>%
  inset2(2, (.) %>% extract2(2) %>% as.list() %>%
           modifyList(val = list(stat = quote(StatQqLine2))) %>%
           as.call()) %>%
  as.call()

用于修改函数体的代码引用了 MrFlick 对 How to insert expression into the body of a function in R 的回答。 .

免责声明:今天之前我从未使用过geom_qq**。如果我在修改 StatQq** 中的计算函数时遗漏了一些内容，请告诉我，我会尽力解决它们。