对称，小提琴情节直方图？

Question

如何制作一个直方图，其中每个小节的中心位于一个公共轴上？这看起来像一个带有阶梯形边缘的小提琴剧情。

我想在Lattice中做到这一点，并不介意自定义面板函数等，但会很乐意使用基础R图形甚至ggplot2。 （我还没有把自己投入到ggplot2中，但会在某些时候冒险）

（为什么我要这样做？我认为这可能是一个有用的替代小提琴情节，当数据是离散的并发生在几个[5-50]均匀间隔的数值上，每个bin代表一个点，当然，我可以生成一个正常的直方图，但我认为有时显示box-and-whisker小提琴情节和小提琴情节对于有规律间隔的离散数据，一个与盒状图方向相同的对称直方图允许比较数据的详细结构和盒状图，就像小提琴情节一样，在这种情况下，对称直方图可以比小提琴的情节更具信息性（一个beanplot可能是我刚刚描述的另一种选择，尽管事实上我的数据并不是字面上的离散 - 它只是收敛到一系列的正常值。这使得R的beanplot软件包对我来说用处不大，除非我通过将值映射到最接近的常规值来规范化值。））基于模拟：

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在一个RDATA文件全套600个观察一个数据帧可以从这个链接下载：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或-9附近的值，在.9或-.9附近的13个值的平均值稍微接近焦点，实际上我通过检查焦点来确定焦点的适当值数据，因为涉及到一些额外的变化。）

小提琴情节可以用：

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

如果使用较大的数据集运行此操作，则会看到其中一个小提琴绘图是多模式的，而另一个则不是。但是，这似乎并不反映两个小提琴剧情的数据差异;据我所知，这是由于焦点相对于情节的位置而造成的一种人为因素。我可以通过调整传递给panel.violin的density的参数来平滑差异，但只需表示每个群集中有多少个点就会更清楚。

谢谢！

Answer 1

下面是使用基本图形一种可能性：

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() 

您可以将不同的部分调整你的喜好和整个事情很容易被包裹成一个功能。

Answer 2

这是一个基于@ GregSnow的答案的莱迪思面板函数，它使用基础图形。如果没有格雷格提供一个坚实的起点，我无法做到这一点，因此所有的荣誉都归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。 pch和coef影响bwplot的外观。这个例子还使用了如下定义围绕着在我的数据点往往会说谎的位置河内情节的每一个盒（见原题）：

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) 
    } 
}