对称的、类似小提琴图的直方图?

9
如何制作一个直方图,使每个柱子的中心都沿着一个公共轴线?这看起来像是一种具有阶梯状边缘的小提琴图。
我想在Lattice中实现这个功能,而且不介意自定义面板函数等。但我也很乐意使用基本的R图形甚至ggplot2。(虽然我还没有完全掌握ggplot2,但我会在某个时候尝试。)
(为什么要这样做?当数据离散并以几个[5-50]均匀间隔的数字值发生时,我认为它可能是小提琴图的一个有用替代。然后,每个箱表示一个点。当然,我可以只生成一个普通直方图。但我认为有时同时显示盒图和小提琴图是有用的。对于间隔规则的离散数据,与盒图相同方向的对称直方图允许将数据的详细结构与盒图进行比较,就像小提琴图一样。在这种情况下,对称直方图可能比小提琴图更有信息量。(豆形图可能是我刚才描述的另一种选择,但实际上我的数据并不是真正的离散的 - 它只是接近一系列常规值。除非我通过将值映射到最近的常规值来对值进行归一化,否则R的beanplot包对我不是很有用。))
这是某些数据的30个观察子集,由基于代理的模拟生成:
df30 <- data.frame(crime.v=c(0.2069526, 0.2063516, 0.06919754,
0.2080366, -0.06975912, 0.206277, 0.3457634, 0.2058985, 0.3428499,
0.3428159, 0.06746109, -0.07068694, 0.4826098, -0.06910966, 0.06769761,
0.2098732, 0.3482267, 0.3483602, 0.4829777, 0.06844112, 0.2093492,
0.4845478, 0.2093505, 0.3482845, 0.3459249, 0.2106339, 0.2098397,
0.4844956, 0.2108985, 0.2107984), bias=c("beast", "beast", "beast",
"beast", "beast", "beast", "beast", "beast", "beast", "beast", "beast",
"beast", "beast", "beast", "beast", "virus", "virus", "virus", "virus",
"virus", "virus", "virus", "virus", "virus", "virus", "virus", "virus",
"virus", "virus", "virus"))

您可以从以下链接下载一个名为df的数据框,其中包含600个完整的观测值的R数据文件:CVexample.rdata

crime.v值接近以下某个点,我称其为聚焦点:

[1] -0.89115386 -0.75346155 -0.61576924 -0.47807693 -0.34038463 -0.20269232 -0.06500001
[8]  0.07269230  0.21038460  0.34807691  0.48576922  0.62346153  0.76115383  0.89884614

(crime.v 的值实际上是 13 个变量的平均值,这些变量的值可以在 -1 到 1 的范围内变化,但最终会收敛到大约为 0.9 或 -0.9 的值。13 个值在约为 0.9 或 -0.9 的平均值在某种程度上接近于焦点。在实践中,我通过检查数据来确定焦点的适当值,因为涉及一些额外的变化。)

可以使用以下代码生成小提琴图:

require(lattice)
bwplot(crime.v ~ bias, data=df30, ylim=c(-1,1), panel=panel.violin)

如果您运行较大的数据集,则会发现产生的其中一个小提琴图是多峰的,而另一个不是。但是,这似乎并不反映出两个小提琴图底层数据的差异;就我所知,这是由于焦点位置与图形之间的关系而导致的人为因素。通过调整传递给panel.violin的密度参数,我可以平滑掉差异,但更清晰的方法是表示每个聚类中有多少个点。
谢谢!

你试过用这个作为起点并进行相应的调整以适应你的需求吗?http://docs.ggplot2.org/0.9.3/geom_violin.html - Ricardo Saporta
不,但非常感谢您提供的那个信息丰富的页面。我可能会尝试一下。 (看起来ggplot文档在某些方面比lattice文档更易于使用 - 这并不是对lattice的批评。) - Mars
对于这种情况,样本数据会非常有用。因为听起来很有趣。 - Henrik
@Henrik:我现在已经添加了数据。 - Mars
3个回答

7

以下是使用基本图形的一种可能性:

tmp <- tapply( iris$Petal.Length, iris$Species, function(x) hist(x, plot=FALSE) )

plot.new()
tmp.r <- do.call( range, lapply(tmp, `[[`, 'breaks') )
plot.window(xlim=c(1/2,length(tmp)+1/2), ylim=tmp.r)
abline(v=seq_along(tmp))

for( i in seq_along(tmp) ) {
    h <- tmp[[i]]
    rf <- h$counts/sum(h$counts)
    rect( i-rf/2, head(h$breaks, -1), i+rf/2, tail(h$breaks, -1) )
}

axis(1, at=seq_along(tmp), labels=names(tmp))
axis(2)
box()

您可以根据自己的喜好调整不同部分,整个过程可以轻松地封装成一个函数。


哇,太棒了,Greg。感谢您整理出完整的程序包。(对于那些快速浏览Greg的答案的人来说,在for循环内部构建矩形是至关重要的步骤。) - Mars
我将尝试使用相同的基本思路,利用Lattice中的panel.rect构建类似的图形。 - Mars
直到现在,我才知道如何以系统化的方式从基本图形中获得一些晶格效果。谢谢你。 - Mars
1
格雷格·斯诺的代码开始实现了格子面板函数版本,但还需要完善。准备好后会发布答案。 - Mars

5
这是一个基于 @GregSnow 的答案的 Lattice 面板函数,使用基本图形。没有 Greg 提供坚实的起点,我无法做到这一点,所以所有的荣誉归于 Greg。我的面板函数不是非常复杂,可能会在一些简单的东西上出现问题,但它可以处理水平和垂直方向,并允许您提供间断向量或将其省略。它还会移除为空的末尾箱子。该面板函数使用 hist 的默认行为来获取 breaks 而不是 histogram 的行为,后者更加复杂。欢迎发表有关更好方法的评论。
由于对称或中心直方图没有现成的名称,据我所知,而且它们让人想起汉诺塔玩具,因此它们应该被称为“汉诺塔直方图”。因此,该函数被称为panel.hanoi
以下是一个简单的使用示例,使用上面定义的 df30:
bwplot(crime.v ~ bias, data=df30, panel=panel.hanoi)

以下是一个更加复杂的示例,使用问题链接提供的数据(答案末尾的图形)。

bwplot(crime.v ~ bias, data=df, ylim=c(-1,1), pch="|", coef=0, panel=function(...){panel.hanoi(col="pink", breaks=cv.ints, ...); panel.bwplot(...)})

这个例子添加了ylim来指定图应该从-1到1,并在汉诺塔图的顶部叠加了一个bwplot。 pchcoef影响bwplot的外观。此示例还使用以下定义,以使Hanoi图的每个框围绕我的数据点倾向于位于的位置居中(请参见原始问题):

cv.ints <- c(-1.000000000, -0.960000012, -0.822307704, -0.684615396, -0.546923088, -0.409230781, -0.271538473, -0.133846165, 0.003846142, 0.141538450, 0.279230758, 0.416923065, 0.554615373, 0.692307681, 0.829999988, 0.967692296, 1.000000000)

这是面板功能:

panel.hanoi <- function(x, y, horizontal, breaks="Sturges", ...) {  # "Sturges" is hist()'s default

  if (horizontal) {
    condvar <- y # conditioning ("independent") variable
    datavar <- x # data ("dependent") variable
  } else {
    condvar <- x
    datavar <- y
  }

  conds <- sort(unique(condvar))

  # loop through the possible values of the conditioning variable
  for (i in seq_along(conds)) {

      h <- hist(datavar[condvar == conds[i]], plot=F, breaks) # use base hist(ogram) function to extract some information

    # strip outer counts == 0, and corresponding bins
    brks.cnts <- stripOuterZeros(h$breaks, h$counts)
    brks <- brks.cnts[[1]]
    cnts <- brks.cnts[[2]]

    halfrelfs <- (cnts/sum(cnts))/2  # i.e. half of the relative frequency
    center <- i

    # All of the variables passed to panel.rec will usually be vectors, and panel.rect will therefore make multiple rectangles.
    if (horizontal) {
      panel.rect(head(brks, -1), center - halfrelfs, tail(brks, -1), center + halfrelfs, ...)
    } else {
      panel.rect(center - halfrelfs, head(brks, -1), center + halfrelfs, tail(brks, -1), ...)
    }
  }
}

# function to strip counts that are all zero on ends of data, along with the corresponding breaks
stripOuterZeros <- function(brks, cnts) { do.call("stripLeftZeros", stripRightZeros(brks, cnts)) }

stripLeftZeros <- function(brks, cnts) {
  if (cnts[1] == 0) {
    stripLeftZeros(brks[-1], cnts[-1])
  } else {
    list(brks, cnts)
  }
}

stripRightZeros <- function(brks, cnts) {
  len <- length(cnts)
  if (cnts[len] ==0) {
    stripRightZeros(brks[-(len+1)], cnts[-len])
  } else {
    list(brks, cnts)
  }
}

Tower of Hanoi histograms with overlaid bwplots


我无法复制您脚本中的图像,请您再次检查是否一切正确。这些图形看起来非常有趣,我想尝试一些数据并查看这些图像的实用性。您能否修改您的脚本并添加一些步骤,以使其更加实用?(当我复制您的脚本到上述数据时,我得到一个空图表,并显示错误信息“Error using packet 1 could not find function "butlast"”)。 - bala
现在已经修复了。我用headtail重新定义了两个实用函数butlastbutfirst,它们原本是在别处定义的。对此我感到很抱歉,也非常感谢@bala的提问。我还稍微修改了第一个示例,并添加了注释以阐明第二个更复杂的示例的工作原理。 - Mars
你能把这个转化成 ggplot 的几何图形吗? - thc
感谢@thc的提问。我没有用过ggplot,但我认为它应该是可以实现的。如果您(或其他任何人)成功实现了,欢迎在这里发布答案。 - Mars
或者如果您不确定如何开始尝试实现ggplot版本,您可以发起一个新的问题。 - Mars

0

这里, 现在有lvplot包可以让你在 ggplot 中使用 geom_lv。geom_lv 看起来恰好符合你的需求。


1
欢迎来到 Stack Overflow。回答问题时,请添加相关代码,而不仅仅是链接。链接可能会失效。 - Roar S.
太好了。我还没有使用过ggplot(现在也没有时间去尝试它)。我看到Hadley Wickham本人声称该软件包将提供类似于汉诺塔图的东西,但该软件包的描述并没有说明清楚。如果您有兴趣,如果您发布如何使用lvplot实现类似功能的示例,那么对其他人来说肯定会很有帮助。 - Mars

网页内容由stack overflow 提供, 点击上面的
可以查看英文原文,
原文链接