PROSAGA码农传奇-模型可视化-将参数传递给geom

<div class =“post-text”itemprop =“text”>
  <P>
    我不认为
     <code>
      geom_qq
    </code>
     设置为处理每个方面具有不同的参数，因此这样做的方法可能是为数据的每个子集单独生成一个图并将它们与类似的东西组合
     <code>
      cowplot::plot_grid
    </code>
    ：
  </p>
   <pre>
    <code>
      library(tidyverse)

plots = df %>%
    group_by(a) %>%
    mutate(deg_free = MASS::fitdistr(b, "t")$estimate["df"]) %>%
    # This second group_by is just used to keep the deg_free value
    # in the final dataframe, could be removed
    group_by(a, deg_free) %>%
    do(
        plot = ggplot(data=., aes(sample=b)) + 
            geom_qq(distribution = qt, dparams = list(.$deg_free)) + 
            geom_qq_line(distribution = qt, dparams = list(.$deg_free)) +
            ggtitle(.$a)
    )

# Using map to unpack the list-column into a list, there's
#   probably a better way
cowplot::plot_grid(plotlist=map(plots$plot,  ~ .))

</code>
  </pre>
  <P>
    示例输出：
  </p>
  <P>
    <a href="https://i.stack.imgur.com/Kw25R.png" rel="nofollow noreferrer">
      <img src =“https://i.stack.imgur.com/Kw25R.png”alt =“网格图”/>
    </A>
  </p>
</DIV>

<div class =“post-text”itemprop =“text”>
  <P>
    对于ggplot在facet中考虑自由度，数据帧被传入
     <code>
      ggplot()
    </code>
     应该包含该列：
  </p>
   <pre>
    <code>
      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

</code>
  </pre>
  <P>
    有了这个，我们可以尝试定义修改后的版本
     <code>
      geom_qq
    </code>
     /
     <code>
      geom_qq_line
    </code>
     寻找自由度
     <code>
      df
    </code>
     作为一种映射的美学。结果如下：
  </p>
   <pre>
    <code>
      ggplot(df,
       aes(sample=b, df = d)) + 
  geom_qq2(distribution = qt) +
  geom_qq_line2(distribution = qt) +
  facet_wrap(~a, scales = "free")

</code>
  </pre>
  <P>
    <a href="https://i.stack.imgur.com/MPCMN.png" rel="nofollow noreferrer">
      <img src =“https://i.stack.imgur.com/MPCMN.png”alt =“plot”/>
    </A>
  </p>
  <P>
    要创建的代码
     <code>
      geom_qq2
    </code>
     /
     <code>
      geom_qq_line2
    </code>
    ：
  </p>
   <pre>
    <code>
      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()

</code>
  </pre>
  <P>
    用于修改函数体的代码参考了MrFlick的回答
    <a href="https://stackoverflow.com/a/38733185/8449629">
      如何在R中的函数体中插入表达式
    </A>
    。
  </p>
  <P>
    免责声明：我从未使用过
     <code>
      geom_qq**
    </code>
     在今天之前。如果我在修改计算功能时错过了一些东西
     <code>
      StatQq**
    </code>
    ，让我知道＆amp;我会尝试解决它们。
  </p>
</DIV>

将参数传递给geom_qq中的facet分布