rplot

How to create mirrored histograms


I would like present propensity score matching stats on 2 groups (unmatched in BW, matched in color) and would like to use mirrored histograms like the following

Is it possible to overlay 4 different histograms in base R? Is there any package providing this functionality?

The x-axis is [0,1] bounded (it is a probability) and the BW columns are always bigger or equal to the colored columns (that is there cannot be BW columns "behind" the colored columns).

Image from http://www.ncbi.nlm.nih.gov/pubmed/22244556


Solution

  • You can use something like the following. You would want to pre-calculate the hist objects to get the correct ylim values, then use axis and mtext or title to properly label your graph.

    set.seed(1234)
    x <- rnorm(100, 0, 1)
    
    plot.new()
    plot.window(ylim = c(-40, 40), xlim = range(x))
    p <- list(axes = FALSE, xlab = "", ylab = "", main = "")
    par(new = TRUE)  
    do.call(hist, c(list(x = x, ylim = c(-40, 40)), p))
    par(new = TRUE)
    do.call(hist, c(list(x = x, ylim = c(40, -40)), p))
    axis(side = 2, 
         at = pretty(par()$usr[3:4]), 
         labels = abs(pretty(par()$usr[3:4])))
    axis(side = 1)
    

    enter image description here

    EDIT

    ## Create some fake data
    set.seed(1234)
    d <- rnorm(250, 0, 1)
    e <- rnorm(250, 1, 1)
    f <- rlnorm(100, 0, .2)
    g <- rlnorm(100, 1, .2)
    
    ## Function for plotting
    multhist <- function(..., bin.width, col, dir, xlab = NULL, ylab = NULL,
                         main = NULL) {
    
      vals <- list(...)
      vrng <- range(vals)
    
      brks <- seq(vrng[1] - abs(vrng[1]*0.1), 
                  vrng[2] + abs(vrng[2]*0.1), 
                  by = bin.width)
    
      yrng <- max(sapply(lapply(vals, hist, breaks = brks), "[[", "counts"))
      yrng <- 1.2*c(-1*yrng, yrng)
    
      plot.new()
      plot.window(ylim = yrng, xlim = vrng)
    
      addhist <- function(x, col, dir) {
        par(new = TRUE)  
        hist(x = x, ylim = dir*yrng, col = col, xlab = "", ylab = "", 
             main = "", axes = FALSE, breaks = brks)
      }
    
      mapply(addhist, x = vals, col = col, dir = dir)
    
      py <- pretty(yrng)
      py <- py[py >= yrng[1] & py <= yrng[2]]
      axis(side = 2, at = py, labels = abs(py))
      axis(side = 1)
      title(main = main, xlab = xlab, ylab = ylab)
    
    }
    

    You can give the function numeric vectors, as well as vectors for the corresponding colors and directions (1 or -1). I did not do the formal checking on the lengths of vals, col, and dir, but it is pretty straight forward.

    ## Use the function
    multhist(d, e, f, g, bin.width = 0.5, 
             col = c("white", "white", "lightgreen", "darkgreen"), 
             dir = c(1, -1, 1, -1), xlab = "xlabel", ylab = "ylabel", 
             main = "title")
    

    enter image description here