使用构面将参数传递给geom_qq中的分布

时间:2019-03-08 04:50:25

标签: r ggplot2

我想使用ggplot2的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) 函数创建t分布的QQ图。 Hadley提供了一个很好的示例here的示例,但这仅适用于单个发行版。我希望将其扩展到多个组,每个组都有一个方面和分布。我发现了一个类似且相关的问题here,但它并没有真正回答该问题。

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

{{1}}

有人知道如何做到这一点,而不必求助于数据的分位数并手动绘制QQ点和线?

2 个答案:

答案 0 :(得分:3)

为使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")

plot

创建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**中的计算功能时错过了某些事情,请告诉我,我将尝试对其进行整理。

答案 1 :(得分:1)

我不认为geom_qq被设置为处理每个构面具有不同的参数,所以实现此目的的方法可能是分别为数据的每个子集生成一个图并将它们与{ {1}}:

cowplot::plot_grid

示例输出:

Grid plot