Как создать зеркальные гистограммы

Я хотел бы представить статистику соответствия склонности по 2 группам (непревзойденную в BW, подобранную по цвету) и хотел бы использовать зеркальные гистограммы, такие как

можно ли наложить 4 разные гистограммы в базе R? Есть ли пакет, предоставляющий эту функциональность?

ось x ограничена [0,1] (это вероятность), а столбцы BW всегда больше или равны цветным столбцам (то есть не может быть BW колонны " за " цветными колоннами).

изображение из http://www.ncbi.nlm.nih.gov/pubmed/22244556

7
plot r

2 ответов

вы можете использовать что-то вроде следующего. Вы хотели бы предварительно вычислить hist объекты, чтобы получить правильные значения ylim, а затем использовать axis и mtext или title чтобы правильно обозначить ваш график.

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

редактировать

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

}

вы можете дать функции числовые векторы, а также векторы для соответствующих цветов и направлений (1 или -1). Я не проводил формальной проверки длины валса, кола и реж., но это довольно прямолинейно.

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

9

вы можете использовать base barplot в два раза, вам просто нужно вычислить отрицательные значения для сюжета, например :

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

enter image description here

4