r - ggplot 线条和线段填充

Question

我想创建一个看起来类似于 this one on David Robinson's variance explained blog 的图:

除了可信区间之间和后曲线下方的填充外，我认为我已经完成了。如果有人知道如何做到这一点，那么得到一些建议会很棒。

下面是一些示例代码:

library(ebbr)
library(ggplot2)
library(dplyr)

sample<- data.frame(id=factor(1:10), yes=c(20, 33, 44, 51, 50, 50, 66, 41, 91, 59), 
                total=rep(100, 10))

sample<-
  sample %>%
  mutate(rate=yes/total)

pri<-
  sample %>%
  ebb_fit_prior(yes, total)

sam.pri<- augment(pri, data=sample)

post<- function(ID){
  a<-
    sam.pri %>%
    filter(id==ID)

  ggplot(data=a, aes(x=rate))+
    stat_function(geom="line", col="black",  size=1.1, fun=function(x) 
      dbeta(x, a$.alpha1, a$.beta1))+
    stat_function(geom="line", lty=2, size=1.1,
                  fun=function(x) dbeta(x, pri$parameters$alpha,     pri$parameters$beta))+
    geom_segment(aes(x=a$.low, y=0, xend=a$.low, yend=.5), col="red", size=1.05)+
    geom_segment(aes(x = a$.high, y=0, xend=a$.high, yend=.5), col="red", size=1.05)+
    geom_segment(aes(x=a$.low, y=.25, xend=a$.high, yend=.25), col="red", size=1.05)+
xlim(0,1)
}

post("10")

Answer 1

我通常通过手动生成数据来描述曲线，为阴影区域的最小值和最大值添加零 y 值，并使用 geom_polygon() 来做到这一点。

library(ebbr)
library(ggplot2)
library(dplyr)

sample <- data.frame(id = factor(1:10), yes = c(20, 33, 44, 51, 50, 50, 66, 41, 91, 59), 
                    total = rep(100, 10)) %>%
  mutate(rate=yes/total)

pri <- sample %>%
  ebb_fit_prior(yes, total)

sam.pri <- augment(pri, data = sample)

a <- sam.pri %>%
  filter(id == 10)

# Make the x values for the shaded region
x <- seq(from = a$.low, to = a$.high, length.out = 100)

# Make the y values for the shaded region
y <- dbeta(x, a$.alpha1, a$.beta1)

# Make a data.frame for the shaded region, including zeroes
shaded <- data.frame(x = c(x, a$.high, a$.low), y = c(y, 0, 0))

ggplot(data = a, aes(x = rate)) +
  stat_function(geom = "line", col = "black", size = 1.1, 
                fun = function(x)  dbeta(x, a$.alpha1, a$.beta1)) +
  geom_polygon(data = shaded, aes(x, y),
               fill = "red", alpha = 0.1) +
  stat_function(geom = "line", lty = 2, size = 1.1,
                fun = function(x ) dbeta(x, pri$parameters$alpha,     pri$parameters$beta)) +
  geom_segment(aes(x = a$.low, y = 0, xend = a$.low, yend = 0.5), col = "red", size = 1.05) +
  geom_segment(aes(x = a$.high, y = 0, xend = a$.high, yend = .5), col = "red", size = 1.05) +
  geom_segment(aes(x = a$.low, y = .25, xend = a$.high, yend = .25), col = "red", size = 1.05) +
  xlim(0,1)