ggplot2 BeanPlots

beanplots.R

## reproduce the figures from http://www.jstatsoft.org/v28/c01/paper using ggplot2

library(ggplot2)

## parameters
set.seed(2710)

## Figure 1
d <- rnorm(50)

plot(density(d <− rnorm(50))); rug(d)

ggplot(data=data.frame(value=d))+
	stat_density(aes(x=value))+
	geom_segment(aes(x=value,xend=value),y=0,yend=0.025,col='white')

## Figure 2
mu <- 2
si <- 0.6
c <- 500

ylim <- c(-7, 7)

bimodal <- c(rnorm(c/2, -mu, si), rnorm(c/2, mu, si))
uniform <- runif(c, -4, 4)
normal <- rnorm(c, 0, 1.5)

boxplot(bimodal, uniform, normal, ylim = ylim, main = "boxplot",names = 1:3)

d2 <- data.frame(
	Distribution=factor(
		c(rep('bimodal',c),rep('uniform',c),rep('normal',c)),
		levels=c('bimodal','uniform','normal')
	),
	Value=c(bimodal,uniform,normal)
)

ggplot(data=d2)+
	geom_boxplot(aes(x=Distribution,y=Value))

ggplot(data=d2)+
	geom_violin(aes(x=Distribution,y=Value),fill='grey',trim=F)+
	geom_segment(aes(
		x=match(Distribution,levels(Distribution))-0.1,
			xend=match(Distribution,levels(Distribution))+0.1,
		y=Value,yend=Value),
		col='black'
	)

## Figure 3
data("singer", package = "lattice")

ylim <- c(55, 80)

ggplot(data=singer)+
	geom_violin(aes(x=voice.part,y=height),fill='grey',trim=F)+
	geom_segment(aes(
		x=match(voice.part,levels(voice.part))-0.1,
			xend=match(voice.part,levels(voice.part))+0.1,
		y=height,yend=height),
		col='black'
	)

## Figure 4

## Figure 5
OrchardSprays$log_decrease <- log(OrchardSprays$decrease)

ggplot(data=OrchardSprays)+
	geom_violin(aes(x=treatment,y=log_decrease),fill='grey',trim=F)+
	geom_segment(aes(
		x=match(treatment,levels(treatment))-0.1,
			xend=match(treatment,levels(treatment))+0.1,
		y=log_decrease,yend=log_decrease),
		col='black'
	)

Thanks for the code snippet, I've been looking for how to implement beanplots using ggplot2. I noticed that your Fig 3 reproduction does not have the varying width line segments, so I came up with some code that provides it:

ggplot(data=singer)+
        geom_violin(aes(x=voice.part,y=height),fill='grey',trim=F)+
        geom_segment(aes(x = as.numeric(voice.part) - V1/max(V1)/2,
                        xend = as.numeric(voice.part) + V1/max(V1)/2,
                        y = height,
                        yend = height),
                col='black', data = ddply(singer, .(voice.part, height), nrow)
        )

I noticed that Figure 4 was skipped. Here was my quick attempt, with thanks to http://mbjoseph.github.io/blog/2013/06/24/violin/ and the commentators therein.

## try beanplots in ggplot()
## http://www.jstatsoft.org/v28/c01/paper
library(ggplot2)
library(beanplot)
data("singer", package="lattice")
## figure 4 from paper using beanplot():
beanplot(height~voice.part, data=singer, side="both", border=NA, col=list("black",c("grey","white")), ll=.04)
## can we get this Figure 4 into ggplot2?
## 1. need to modify data: parse "voice.part" into "group" and "class"
## 2. need to use layers with ggplot() call
ggsinger=singer
ggsinger$group=as.numeric(gsub("[^0-9]","",sapply(strsplit(as.character(ggsinger$voice.part)," "),"[",2)))
ggsinger$class=sapply(strsplit(as.character(ggsinger$voice.part)," "),"[",1)
ggsinger$class <- factor(ggsinger$class, levels=c("Bass","Tenor","Alto","Soprano"))
head(ggsinger)
ggplot(data=ggsinger)+
  geom_density(data=subset(ggsinger,group == 2), aes(x=height,y=-..density..,fill=factor(group)), trim=F)+
  geom_density(data=subset(ggsinger,group == 1), aes(x=height,y= ..density..,fill=factor(group)), trim=F)+
  coord_flip() + xlab("body height (inch)") + ylab("Smoothed Density") + facet_grid(~class) 

I wish there was an option to turn off the symmetry from geom_violin():

## replace _density with _violin, comment-out a few lines pertaining to _density approach:
ggplot(data=ggsinger)+
  geom_violin(data=subset(ggsinger,group == 2), aes(x=factor(class),y=height,fill=factor(group)), trim=F, alpha=.3)+
  geom_violin(data=subset(ggsinger,group == 1), aes(x=factor(class),y=height,fill=factor(group)), trim=F, alpha=.3)+
  ##coord_flip() + 
  ##xlab("body height (inch)") + ylab("Smoothed Density") ##+ facet_grid(~class) 
  xlab("")+ylab("body height (inch)")