Come creare istogrammi speculari

Question

Vorrei presente propensione segnare statistiche corrispondenti su 2 gruppi (senza eguali in BW, abbinati a colori) e vorrebbe utilizzare istogrammi a specchio simile al seguente

E 'possibile sovrapporre 4 diversi istogrammi nella base R? C'è qualche pacchetto che fornisce questa funzionalità?

L'asse x è limitato [0,1] (è una probabilità) e le colonne BW sono sempre più grandi o uguali alle colonne colorate (cioè non ci possono essere colonne BW "dietro" le colonne colorate).

Immagine da http://www.ncbi.nlm.nih.gov/pubmed/22244556

Answer 1

È possibile utilizzare qualcosa di simile alla seguente. Si consiglia di precalcolare gli oggetti hist per ottenere i valori ylim corretti, quindi utilizzare axis e mtext o title per etichettare correttamente il proprio grafico.

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) 

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) 

} 

È possibile assegnare la funzione vettori numerici, nonché i vettori per i colori corrispondenti e indicazioni (1 o -1). Non ho fatto il controllo formale delle lunghezze di vals, col e dir, ma è piuttosto semplice.

## 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") 

Answer 2

È possibile utilizzare di base barplot due volte, non vi resta che calcolare i valori negativi per la trama verso il basso per esempio :

upvalues <- data.frame(Green=c(0,10,90,140,30, 20),White=c(70,50,30,20,5, 0)) 
downvalues <- data.frame(Green=c(-80,-70,-10,-60,-10,-10),White=c(0,-100,-60,-5,-15, -10)) 

# barplot accept only matrices 
up <- t(as.matrix(upvalues)) 
down <- t(as.matrix(downvalues)) 

# empty plot to make room for everything 
yspace <- 1.2 # it means 20% of space for the inside labels 
plot(x=c(0,max(ncol(up))), 
    y=c(min(colSums(down))*yspace ,max(colSums(up))*yspace), 
    type='n', xaxt='n', yaxt='n', ann=FALSE) 
a <- barplot(up,col=c('green','white'),space=0,add=T) 
b <- barplot(down,col=c('darkgreen','white'),space=0,add=T,axes=F) 

axis(side=1,at=seq.int(0,by=ncol(up)/10,length.out=11), 
    labels=seq.int(0,by=10,length.out=11)) 
title(xlab = 'x label', ylab='y label', main = 'Title') 
mtext('UP',line=-1,side=3,col='green') 
mtext('DOWN',line=-1,side=1,col='darkgreen')