在ggplot中填充两个密度曲线之间的区域

Question

在ggplot中填充两个密度曲线之间的区域

3

我正在尝试重新创建这个图形（来自维基百科）：

这是我目前的进展：

data <- distribution_normal(n = 100, mean = 0, sd = 1) %>%
  density() %>%
  as.data.frame() %>%
  mutate(e = lag(y, 100))

ggplot(data) +
  geom_line(aes(x=x, y=y)) +
  geom_line(aes(x=x, y=e)) +
  geom_vline(aes(xintercept=0)) +
  geom_ribbon(data = subset(data, x<0), aes(x=x, ymin=0, ymax=y), fill = "blue", alpha = .3) +
  geom_ribbon(data = subset(data, e<y & x<0), aes(x=x, ymin=0, ymax=e), fill = "light blue", alpha = .5) +
  geom_ribbon(data = subset(data, y>e & x>0), aes(x=x, ymin=e, ymax=y), fill = "pink", alpha = .3) +
  geom_ribbon(data = subset(data, e<y & x>0), aes(x=x, ymin=0, ymax=e), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, y<=e & x>0), aes(x=x, ymin=0, ymax=y), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, e>y & x>0), aes(x=x, ymin=y, ymax=e), fill = "red", alpha = .3)

这让我来到这里：

我的使用lag的方法可以使第二条曲线的尾部被切掉。 有没有更好的方法可以让我展示完整的尾部？ 我还需要解决下面紫色部分的不一致性问题，在两条曲线相交处和x=0处左侧。

- braden

3个回答

1

这里是基于您原始代码的基本R方法。

library(bayestestR)
data <- distribution_normal(n = 100, mean = 0, sd = 1) %>%
  density() %>%
  as.data.frame()

original_length <- nrow(data)
step_size <- diff(data[1:2,1])
data <- rbind(data, data.frame(x = (step_size * 1:100) + max(data$x), y = 0))
data$e <- 0
data$e[seq(100,original_length+99)] <- data$y[seq(1,original_length)]

- Ian Campbell

谢谢！还有请看下面的回答 - 我找到了如何消除geom_ribbon中跳过的带区间。 - undefined

0

感谢以上贡献者提供的解决方案。我的解决方案基于Olly Beagley的解决方案，并展示了我如何消除geom_ribbon中奇怪的空白。

我使用了正态分布的实际公式，而不是使用dnorm(x)或distribution_normal()生成值。

sigma <- 1
mean <- 0

sigma_2 <- 1
mean_2 <- 1

data <- data.frame(x = seq(-10,10,.001))

data <- data %>%
  mutate(y = 1/(sigma*sqrt(2*pi))*exp(-((x-mean)^2/(2*sigma^2))),
         y2 = 1/(sigma_2*sqrt(2*pi))*exp(-((x-mean_2)^2/(2*sigma_2^2)))
         )

ggplot(data) +
  geom_vline(aes(xintercept=0), size=1) +
  geom_line(aes(x=x, y=y)) +
  geom_line(aes(x=x, y=y2)) +
  geom_ribbon(data=subset(data, y>y2 & x <  0), aes(x=x, ymin=y2, ymax=y), fill = "blue", alpha = .3) +
  geom_ribbon(data = subset(data, y2<y & x< 0), aes(x=x, ymin=0, ymax=y2), fill = "light blue", alpha = .5) +
  geom_ribbon(data = subset(data, y>y2 & x> 0), aes(x=x, ymin=y2, ymax=y), fill = "pink", alpha = .3) +
  geom_ribbon(data = subset(data, y2<y & x>=0), aes(x=x, ymin=0, ymax=y2), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, y<=y2 & x>0), aes(x=x, ymin=0, ymax=y), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, y2>y & x>=x_intercept), aes(x=x, ymin=y, ymax=y2), fill = "red", alpha = .3) +
  xlim(-5,5)

这在每个x值上为每条曲线生成了一个y值：

- braden

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Olly Beagley · Accepted Answer

这里的问题在于滞后，它会沿着一个向量移动值，但会剪掉一端并用NA填充另一端，例如：

library(dplyr)
x <- 1:10
x
#>  [1]  1  2  3  4  5  6  7  8  9 10
lag(x, 2)
#>  [1] NA NA  1  2  3  4  5  6  7  8

你需要做的是为不同的正态分布生成新的密度值，其中x值已经发生了移位（或者等效地说，均值已经移位），下面我将其向右移动了一个单位。

不确定你在代码中使用了哪些包，因此我用基础包中的dnorm替换了数据生成部分，它返回给定x值向量的密度值。

library(dplyr)
library(ggplot2)

data <- data.frame(x = seq(-5, 5, length.out = 100)) %>%
  mutate(
    y = dnorm(x),
    e = dnorm(x - 1)
  )

ggplot(data) +
  geom_line(aes(x=x, y=y)) +
  geom_line(aes(x=x, y=e)) +
  geom_vline(aes(xintercept=0)) +
  geom_ribbon(data = subset(data, x<0), aes(x=x, ymin=0, ymax=y), fill = "blue", alpha = .3) +
  geom_ribbon(data = subset(data, e<y & x<0), aes(x=x, ymin=0, ymax=e), fill = "light blue", alpha = .5) +
  geom_ribbon(data = subset(data, y>e & x>0), aes(x=x, ymin=e, ymax=y), fill = "pink", alpha = .3) +
  geom_ribbon(data = subset(data, e<y & x>0), aes(x=x, ymin=0, ymax=e), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, y<=e & x>0), aes(x=x, ymin=0, ymax=y), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, e>y & x>0), aes(x=x, ymin=y, ymax=e), fill = "red", alpha = .3)

为了创建data的代码，可能是这样的：

library(dplyr)
library(ggplot2)

data <- distribution_normal(n = 100, mean = 0, sd = 1) %>%
  density() %>%
  as.data.frame()

shifted <- distribution_normal(n = 100, mean = 1, sd = 1) %>%
  density() %>%
  as.data.frame()

data <- data %>%
  mutate(e = shifted$y)

ggplot(data) +
  geom_line(aes(x=x, y=y)) +
  geom_line(aes(x=x, y=e)) +
  geom_vline(aes(xintercept=0)) +
  geom_ribbon(data = subset(data, x<0), aes(x=x, ymin=0, ymax=y), fill = "blue", alpha = .3) +
  geom_ribbon(data = subset(data, e<y & x<0), aes(x=x, ymin=0, ymax=e), fill = "light blue", alpha = .5) +
  geom_ribbon(data = subset(data, y>e & x>0), aes(x=x, ymin=e, ymax=y), fill = "pink", alpha = .3) +
  geom_ribbon(data = subset(data, e<y & x>0), aes(x=x, ymin=0, ymax=e), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, y<=e & x>0), aes(x=x, ymin=0, ymax=y), fill = "purple", alpha = .3) +
  geom_ribbon(data = subset(data, e>y & x>0), aes(x=x, ymin=y, ymax=e), fill = "red", alpha = .3)

我不能确定这对你是否有效，因为我不知道你使用了哪些软件包。

在我的代码中比你的更明显，但是在带状图的截距/边界处存在一些垂直间隙。这是由于这些点上没有确切的值，因此要确保它们不出现就需要在这些点上准确计算x值和密度值，这可能在密度拦截处会很复杂，因为您需要计算发生的确切x值，然后是相应的密度值。暴力的替代方法是绘制比所需更多的值，以使其超出注意范围（即更改density中的默认n值，或将我的length.out值变得更大，例如20000）。