R 如何在几个正态分布下给区域着色？

经过几次尝试，我终于得到了一个具有多个正态分布的唯一图形。在这些分布中，1sd也绘制为垂直矩形。我使用的代码是：

x1<-50:200
a1<-dnorm(x1,134,20)
b1<-dnorm(x1,130,14)
c1<-dnorm(x1,132,12)
d1<-dnorm(x1,105,10)

scale<-range(pretty(range(a1,b1,c1,d1)))

remap<-function(x, to, from=range(x)) {
    (x-from[1]) / (from[2]-from[1]) * (to[2]-to[1]) + to[1] 
}

plot(NA, NA, xaxt="n", yaxt="n", type="n", xlim=scale, ylim=scale, xlab="Variable X", ylab="")
rect(remap(134-20, scale, range(x1)), scale[1],
     remap(134+20, scale, range(x1)), scale[2], col="#ff606025")
rect(remap(130-14, scale, range(x1)), scale[1],
     remap(130+14, scale, range(x1)), scale[2], col="#005ccd40")
rect(remap(132-12, scale, range(x1)), scale[1],
     remap(132+12, scale, range(x1)), scale[2], col="#005ccd40")
rect(remap(105-10, scale, range(x1)), scale[1],
     remap(105+10, scale, range(x1)), scale[2], col="#005ccd40")
#R1429
rect(remap(183, scale, range(x1)), scale[1],
     remap(183, scale, range(x1)), scale[2], col="darkblue", lwd=3,lty=3)

lines(remap(x1,scale), a1, col="#ff6060", lwd=3)
lines(remap(x1,scale), b1, col="#005ccd", lwd=3, lty=3)
lines(remap(x1,scale), c1, col="#005ccd", lwd=3)
lines(remap(x1,scale), d1, col="#005ccd", lwd=3,lty=3)

axis(2);
axis(1, at=remap(pretty(x1), scale), pretty(x1))

---

x1您可以使用
polygon
填充曲线下方

## Some distributions
x1 <- 50:200
means <- c(134, 130, 132, 105)
sds <- c(20, 14, 12, 10)
dists <- lapply(seq_along(means), function(i) dnorm(x1, means[i], sds[i]))

## Some colors
cols <- colorRampPalette(c("red", "blue"))(length(dists))

## Blank plot
plot(c(x1[1], x1[length(x1)]), c(min(unlist(dists)), max(unlist(dists))), 
     type="n", xlab="X", ylab="Density")

## Add polygons
for (i in seq_along(dists))
    polygon(c(x1, rev(x1)), 
            c(numeric(length(x1)), rev(dists[[i]])), 
            col=cols[i],
            density=40)

##一些发行版
x1这里有一种使用Hadley Wickham的一些软件包的方法：

library("dplyr")
library("ggplot2")
library("tidyr")
data.frame(x = 50:200) %>%
  mutate(a = dnorm(x,134,20),
         b = dnorm(x,130,14),
         c = dnorm(x,132,12),
         d = dnorm(x,105,10)) %>%
  gather(group, y, -x) %>%
  ggplot(aes(x, y, fill = group)) %>%
  + geom_area(alpha = 0.3, position = "identity") %>%
  + geom_line() %>%
  print


以下是仅在1 SD内填写的版本：

data.frame(group = letters[1:4],
  m = c(130, 134, 132, 105),
  s = c(20, 14, 12, 10)
) %>%
  group_by(group) %>%
  do(data_frame(group = .$group,
    x = 50:200,
    y = dnorm(x, .$m, .$s),
    withinSd = abs(x - .$m) <= .$s)
  ) %>% {
    ggplot(., aes(x = x, y = y, colour = group)) +
      geom_line() +
      geom_area(aes(fill = group), filter(., withinSd),
        position = "identity", alpha = 0.3) +
      guides(colour = "none")
    }

这是另一个使用base R的版本。这个版本使用
lines（）
中的
type='h'
选项来绘制许多垂直线，这些垂直线太多，以至于最终会对该区域进行着色。请注意，这需要增加
x1
中的采样点数量（尝试将
x1
更改回
50:200
，以查看发生了什么情况）

x1这是另一个使用
ggvis的版本：

library(dplyr)
library(ggvis)

## -- data generation copied from @NickK -- ##
data.frame(group = letters[1:4],
           m = c(130, 134, 132, 105),
           s = c(20, 14, 12, 10)) %>%
  group_by(group) %>%
  do(data_frame(group = .$group,
                x = 50:200,
                y = dnorm(x, .$m, .$s),
                withinSd = abs(x - .$m) <= .$s)) %>%
## ---------------------------------------- ##
  mutate(dash = ifelse(grepl("a|d", group), 5, 0),
         color = ifelse(grepl("a|c|d", group), "blue", "red"))  %>%
  ggvis() %>%
  layer_paths(~x, ~y, stroke := ~color, strokeDash := ~dash) %>%
  filter(withinSd) %>%
  layer_ribbons(~x, ~y, y2 = ~y-y, fill := ~color, fillOpacity := 0.2) %>%
  hide_legend("fill") %>%
  add_axis("y", title_offset = 50)

库（dplyr）
图书馆（ggvis）
##--从@NickK复制的数据生成--##
数据框（组=字母[1:4]，
m=c（130134132105），
s=c（20,14,12,10））%>%
分组依据（分组）%>%
do（数据帧）（组=.$组，
x=50:200，
y=dnorm（x，.$m，.$s），
withinSd=abs（x-.$m）%
## ---------------------------------------- ##
突变（dash=ifelse（grepl（“a | d”，组），5,0），
颜色=ifelse（grepl（“a | c | d”，组），“蓝色”，“红色”））%>%
ggvis（）%>%
层路径（~x，~y，笔划：=~颜色，笔划短线：=~短线）%>%
过滤器（带INSD）%>%
层带（~x，~y，y2=~y-y，填充：=~颜色，填充不透明度：=0.2）%>%
隐藏图例（“填充”）%>%
添加轴（“y”，标题偏移=50）

应该让你开始了。谢谢你的回答Nick K。也许我被误解了，没有明确地写出我想要的。我想要着色的曲线下方的区域只是1sd到整个区域之间的区域。代码中有没有简单的解决方案？@NickK非常好的数据生成技术！我在我的帖子中重复使用了它。有没有可能通过使用样本大小来控制不同正态分布的宽度和高度？我的意思是，我想显示+-2 sd，我意识到，与使用1或2 sd时相比，大小是不同的。这怎么可能解决呢？@antecessor刚刚添加了另一个示例，该示例将每个组的大小缩放到最大值小组感谢你的回答史蒂文。也许我被误解了，没有写清楚我想要的。我想要着色的曲线下的区域只是1sd和整个区域之间的区域。代码中有没有简单的解决方案？谢谢你的回答。也许我被误解了，没有写清楚y我想要的。我想要着色的曲线下面的区域只是1sd之间的区域，而不是整个区域。代码中有没有简单的解决方案？
data.frame(group = letters[1:4],
           m = c(130, 134, 132, 105),
           s = c(20, 14, 12, 10)
) %>%
  group_by(group) %>%
  do(data_frame(group = .$group,
                x = 50:200,
                y = dnorm(x, .$m, .$s),
                withinSd = abs(x - .$m) <= .$s)
  ) %>% 
  group_by(group) %>%
  mutate(y = y / max(y)) %>%
  {
    ggplot(., aes(x = x, y = y, colour = group)) +
      geom_line() +
      geom_area(aes(fill = group), filter(., withinSd),
                position = "identity", alpha = 0.3) +
      guides(colour = "none")
  }

x1 <- seq(50,200,length=1000)
a1 <- dnorm(x1,134,20)
b1 <- dnorm(x1,130,14)
c1 <- dnorm(x1,132,12)
d1 <- dnorm(x1,105,10)

dists <- list(a1,b1,c1,d1)

# specify color names then convert them to RGB+alpha values
col <- c("red","green","blue","yellow")
col.rgba <- rgb(t(col2rgb(col))/255, alpha=0.2)

plot(NA, NA, xlim=range(x1), ylim=range(unlist(dists)), xlab="Variable X", ylab="")

# loop through each distribution
for (i in 1:length(dists)) {
  lines(x1, dists[[i]], type='h', lwd=2, col=col.rgba[i]) # add shaded region
  lines(x1, dists[[i]], type='l') # add solid line at top
}

library(dplyr)
library(ggvis)

## -- data generation copied from @NickK -- ##
data.frame(group = letters[1:4],
           m = c(130, 134, 132, 105),
           s = c(20, 14, 12, 10)) %>%
  group_by(group) %>%
  do(data_frame(group = .$group,
                x = 50:200,
                y = dnorm(x, .$m, .$s),
                withinSd = abs(x - .$m) <= .$s)) %>%
## ---------------------------------------- ##
  mutate(dash = ifelse(grepl("a|d", group), 5, 0),
         color = ifelse(grepl("a|c|d", group), "blue", "red"))  %>%
  ggvis() %>%
  layer_paths(~x, ~y, stroke := ~color, strokeDash := ~dash) %>%
  filter(withinSd) %>%
  layer_ribbons(~x, ~y, y2 = ~y-y, fill := ~color, fillOpacity := 0.2) %>%
  hide_legend("fill") %>%
  add_axis("y", title_offset = 50)