Question

I am working on data presentation and i need to plot boxplot with stacked barplot in parallel.

With colored in different shade colors with proportion of points covering area. How can i plot it?

Answer 1

Here a generic solution that you can use to add parallel percent box to a lattice bowplot. It computes the exact percent descrbing parts of boxplot (whisker and main part).

The solution is based on the grid package. Viewport manipulation is easier with lattice than ggplot2, that’s why I choose a bwplot.

I generate some sample data:

df <- data.frame(cond = factor( rep(c("A"), each=200) ), 
                 rating = c(rnorm(200),rnorm(200, mean=.8)))

library(lattice)
bwplot(cond ~ rating, data=df,gp=gpar(fill='blue'),
       par.settings = list( box.umbrella=list(col= c( "red")), 
                            box.dot=list(col= c("green")), 
                            box.rectangle = list(fill= c( "blue"),alpha=0.6)))

I catch the main viewport

downViewport("plot_01.panel.1.1.vp")

Then I store the dimensions of whiskers and positions of extremities boxplot positions.

segs <- grid.get('segments',grep=T)
cap.segs <- grid.get('cap.segments',grep=T)

The function drawBox , draw a rectangle with the text in percent. I Call it 3 times for each box.

drawbox <- function(x0 = segs$x0[1] , col ='red',
                    width.vp = segs$x0[2] - segs$x0[1]){
  vpd <- viewport(
            x = x0 ,
            y = cap.segs$y1[2] + unit(0.5,'native'),
            width  = width.vp,
            height = unit(2,'cm'),
            just   = c('left','bottom'),
            name   = 'vpd')
  pushViewport(vpd)
    grid.rect(gp=(gpar(fill=col)))
    # The compute of percent is a little bit tricky due we can't apply '/'
    value <- as.numeric(convertUnit(width.vp,'native'))
    value <- value/as.numeric(convertUnit(cap.segs$x0[2]- cap.segs$x0[1],'native'))
    grid.text(label = paste(round(value*100),'%',sep='') , gp= gpar(cex=3))
  upViewport(1)
}

The function drawbox is called 3 times:

drawbox()
drawbox(col='yellow',width=segs$x0[1] - cap.segs$x0[1], x0= cap.segs$x0[1])
drawbox(col='green',width.vp= cap.segs$x0[2]- segs$x0[2],x0 = segs$x0[2])