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)