對稱，小提琴情節直方圖？

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