使用 base R,如何创建一个 "joy plot"(又名山脊线图),其中有许多分布在彼此之上并具有垂直偏移?

Using base R, how to create a "joy plot" (aka ridgeline plots), with many distributions on top of each other with vertical offset?

我试图在 R 中实现的情节类型似乎被称为移动分布,as joy plot or as ridgeline plot:

Whosebug 中已经有一个问题,其记录的答案解释了如何使用 ggplot:

但是,出于学习目的,我试图仅使用基础 R 图(没有格子,没有 ggplot,没有任何绘图包)来实现相同的目的。

为了开始,我生成了以下假数据来玩:

set.seed(2020)
shapes <- c(0.1, 0.5, 1, 2, 4, 5, 6)
dat <- lapply(shapes, function(x) rbeta(1000, x, x))
names(dat) <- letters[1:length(shapes)]

然后使用mfrow我可以实现这个:

par(mfrow=c(length(shapes), 1))
par(mar=c(1, 5, 1, 1))
for(i in 1:length(shapes))
{
    values <- density(dat[[names(dat)[i]]])
    plot(NA,
         xlim=c(min(values$x), max(values$x)),
         ylim=c(min(values$y), max(values$y)),
         axes=FALSE,
         main="",
         xlab="",
         ylab=letters[i])
    polygon(values, col="light blue")
}

我得到的结果是:

很明显,这里使用 mfrow(甚至 layout)不够灵活,而且允许分布之间的重叠。

那么,问题是:我怎样才能仅使用基本 R 绘图函数重现那种类型的绘图?

这是一个基本的 R 解决方案。首先,我们计算所有的密度值,然后手动偏移y轴

vals <- Map(function(x, g, i) {
  with(density(x), data.frame(x,y=y+(i-1), g))
}, dat, names(dat), seq_along(dat))

然后,为了绘图,我们计算总体范围,绘制一个空图,然后绘制密度(反向堆叠)

xrange <- range(unlist(lapply(vals, function(d) range(d$x))))
yrange <- range(unlist(lapply(vals, function(d) range(d$y))))
plot(0,0, type="n", xlim=xrange, ylim=yrange, yaxt="n", ylab="", xlab="Value")
for(d in rev(vals)) {
  with(d, polygon(x, y, col="light blue"))
}
axis(2, at=seq_along(dat)-1, names(dat))

d = lapply(dat, function(x){
    tmp = density(x)
    data.frame(x = tmp$x, y = tmp$y)
})

d = lapply(seq_along(d), function(i){
    tmp = d[[i]]
    tmp$grp = names(d)[i]
    tmp
})

d = do.call(rbind, d)

grp = unique(d$grp)
n = length(grp)

spcx = 5
spcy = 3

rx = range(d$x)
ry = range(d$y)

rx[2] = rx[2] + n/spcx
ry[2] = ry[2] + n/spcy

graphics.off()
plot(1, type = "n", xlim = rx, ylim = ry, axes = FALSE, ann = FALSE)

lapply(seq_along(grp), function(i){
    x = grp[i]
    abline(h = (n - i)/spcy, col = "grey")
    axis(2, at = (n - i)/spcy, labels = grp[i])
    polygon(d$x[d$grp == x] + (n - i)/spcx,
            d$y[d$grp == x] + (n - i)/spcy,
            col = rgb(0.5, 0.5, 0.5, 0.5))
})