How to plot bar plot in parallel to horizontal to

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

One possibility is to combine boxplot() and rect() functions. Coordinates for rect() are calculated as quantiles you are interested in. For this example I used quantile 25% and 60 % (sum of 25% and 35%). Function text() used to set names.

  set.seed(123)
  x<-rnorm(100)
  boxplot(x,horizontal=TRUE,axes=FALSE)
  rect(min(x),1.5,quantile(x,0.25),1.4,col="red")
  rect(quantile(x,0.25),1.5,quantile(x,0.60),1.4,col="green")
  rect(quantile(x,0.60),1.4,max(x),1.5,col="yellow")
  text(-1.5,1.45,"25%")
  text(0,1.45,"35%")
  text(1.1,1.45,"40%")

Answer 2

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