Beeswarm Plot - R With Panels/Overlays

R with Panels or Overlays

This example produces a panelled beeswarm plot with mean overlays. See the R Package example if you are new to beeswarm plots. See this web page if you would like more detailed information about the beeswarm package.

Source Code

R
#############################################################################################
# Library
#############################################################################################     
library(Hmisc)
library(beeswarm)
library(lattice)
library(latticeExtra)
library(grid)


#############################################################################################
# Data
#############################################################################################

b <- read.csv("beeswarm.csv")
names(b) <- tolower(names(b))
levels(b$ridageyr)[1] <- "85"
b$ridageyr <- as.numeric(as.character(b$ridageyr))
b$ridageyr2 <- cut2(b$ridageyr,g=2)

   
#############################################################################################
# Figure 
#############################################################################################

pdf("beeswarm2.pdf",width=8,height=7)

stripplot(lbxige~lbxi_any|ridageyr2,data=b, group=lbxi_any, pch='|', 
          layout=c(2,1), asp=1.5,
          scale=list(y=list(log=10,alternating=3),
                     x=list(labels=c("Atopic","Non-Atopic"))),
          yscale.components = yscale.components.log10ticks,
          main="Relation between Atopy and Total IgE among Asthmatics by Age",
          ylab="Serum total IgE antibody (kU/L)",
          xlab="",
          between=list(x=0.5),
          par.settings=list(box.rectangle=list(lwd=1,lty=1,col='gray50',fill="transparent"),
                            box.umbrella=list(lwd=1,lty=1,col='gray50'),
                            strip.background=list(col="gray90")),
          panel = function(x,y,...) {             
              panel.segments(seq(0.5,1.5,1),tapply(y,x,median,na.rm=T),
                             seq(1.5,2.5,1),tapply(y,x,median,na.rm=T),
                             lwd=2,
                             col=trellis.par.get('superpose.line')$col[1:2])
              panel.superpose(x,y,...)
          },
          panel.group = function(x,y,group.number,...){           
              dd <- beeswarm(y~x,method='swarm',do.plot=F,spacing=5)
              panel.points(dd$x+(group.number-1),dd$y,pch=21,cex=0.8,
                           fill=trellis.par.get('superpose.polygon')$col[group.number],
                           col=trellis.par.get('superpose.line')$col[group.number])
          }
)

dev.off()

Data

The above graph is based on data from the NHANES study. The graph is generated based on a comma-delimited dataset (.CSV file type) where each row is a distinct data point to be plotted. Download

top