如何绘制小提琴散射箱图(R)?

I just came by the following plot:

我想到了下面的情节:

And wondered how can it be done in R? (or other softwares)

想知道怎么用R来做?(或其他软件)

Update 10.03.11: Thank you everyone who participated in answering this question - you gave wonderful solutions! I've compiled all the solution presented here (as well as some others I've came by online) in a post on my blog.

更新10.03.11:感谢所有参与回答这个问题的人——你们提供了很好的解决方案!我在我的博客上发表了一篇文章，把这里介绍的所有解决方案(以及我在网上找到的其他一些解决方案)都汇编了下来。

5 个解决方案

#1

Make.Funny.Plot does more or less what I think it should do. To be adapted according to your own needs, and might be optimized a bit, but this should be a nice start.

Make.Funny。情节或多或少是我认为应该做的。可以根据自己的需要进行调整，也可以进行一些优化，但是这应该是一个良好的开端。

Make.Funny.Plot <- function(x){
    unique.vals <- length(unique(x))
    N <- length(x)
    N.val <- min(N/20,unique.vals)

    if(unique.vals>N.val){
      x <- ave(x,cut(x,N.val),FUN=min)
      x <- signif(x,4)
    }
    # construct the outline of the plot
    outline <- as.vector(table(x))
    outline <- outline/max(outline)

    # determine some correction to make the V shape,
    # based on the range
    y.corr <- diff(range(x))*0.05

    # Get the unique values
    yval <- sort(unique(x))

    plot(c(-1,1),c(min(yval),max(yval)),
        type="n",xaxt="n",xlab="")

    for(i in 1:length(yval)){
        n <- sum(x==yval[i])
        x.plot <- seq(-outline[i],outline[i],length=n)
        y.plot <- yval[i]+abs(x.plot)*y.corr
        points(x.plot,y.plot,pch=19,cex=0.5)
    }
}

N <- 500
x <- rpois(N,4)+abs(rnorm(N))
Make.Funny.Plot(x)

EDIT : corrected so it always works.

编辑:更正，所以它总是有效的。

#2

I recently came upon the beeswarm package, that bears some similarity.

我最近发现了一种与之相似的beeswarm包。

The bee swarm plot is a one-dimensional scatter plot like "stripchart", but with closely-packed, non-overlapping points.

蜜蜂群图是一个一维的散点图，像“条带图”，但是有紧密的填充，没有重叠的点。

Here's an example:

这里有一个例子:

  library(beeswarm)
  beeswarm(time_survival ~ event_survival, data = breast,
    method = 'smile',
    pch = 16, pwcol = as.numeric(ER),
    xlab = '', ylab = 'Follow-up time (months)',
    labels = c('Censored', 'Metastasis'))
  legend('topright', legend = levels(breast$ER),
    title = 'ER', pch = 16, col = 1:2)

http://www.cbs.dtu.dk/~eklund/beeswarm/beeswarm_example_03.png

http://www.cbs.dtu.dk/雷欧/ beeswarm / beeswarm_example_03.png

#3

I have come up with the code similar to Joris, still I think this is more than a stem plot; here I mean that they y value in each series is a absolute value of a distance to the in-bin mean, and x value is more about whether the value is lower or higher than mean.
Example code (sometimes throws warnings but works):

我想到了和Joris相似的代码，但我认为这不仅仅是一个主干图;这里我的意思是每个级数中的y值是到in-bin均值距离的绝对值，x值更多的是关于这个值是低还是高。示例代码(有时抛出警告，但有效):

px<-function(x,N=40,...){
x<-sort(x);

#Cutting in bins
cut(x,N)->p;

#Calculate the means over bins
sapply(levels(p),function(i) mean(x[p==i]))->meansl;
means<-meansl[p];

#Calculate the mins over bins
sapply(levels(p),function(i) min(x[p==i]))->minl;
mins<-minl[p];

#Each dot is one value.
#X is an order of a value inside bin, moved so that the values lower than bin mean go below 0
X<-rep(0,length(x));
for(e in levels(p)) X[p==e]<-(1:sum(p==e))-1-sum((x-means)[p==e]<0);
#Y is a bin minum + absolute value of a difference between value and its bin mean
plot(X,mins+abs(x-means),pch=19,cex=0.5,...);
}

#4

Try the vioplot package:

试试vioplot包:

library(vioplot)
vioplot(rnorm(100))

(with awful default color ;-)

(使用可怕的默认颜色;)

There is also wvioplot() in the wvioplot package, for weighted violin plot, and beanplot, which combines violin and rug plots. They are also available through the lattice package, see ?panel.violin.

wvioplot()中还有wvioplot()，用于加重小提琴情节，beanplot结合了小提琴和地毯情节。它们也可以通过晶格包获得，看?

#5

Since this hasn't been mentioned yet, there is also ggbeeswarm as a relatively new R package based on ggplot2.

由于还没有提到这一点，因此也有一个ggbeeswarm作为一个相对新的基于ggplot2的R包。

Which adds another geom to ggplot to be used instead of geom_jitter or the like.

它将另一个geom添加到ggplot中，而不是使用geom_jitter或类似的东西。

In particular geom_quasirandom (see second example below) produces really good results and I have in fact adapted it as default plot.

特别是geom_准随机(参见下面的第二个示例)产生了非常好的结果，我实际上已经将它改编为默认图。

Noteworthy is also the package vipor (VIolin POints in R) which produces plots using the standard R graphics and is in fact also used by ggbeeswarm behind the scenes.

值得注意的是软件包vipor (R中的小提琴点)，它使用标准的R图形来生成情节，实际上，ggbeeswarm也在幕后使用。

set.seed(12345)
install.packages('ggbeeswarm')
library(ggplot2)
library(ggbeeswarm)

ggplot(iris,aes(Species, Sepal.Length)) + geom_beeswarm()

ggplot(iris,aes(Species, Sepal.Length)) + geom_quasirandom()

#compare to jitter
ggplot(iris,aes(Species, Sepal.Length)) + geom_jitter()