superponer - ¿Cómo trazar dos histogramas juntos en R?

superponer graficas en r ggplot

Question

Estoy usando R y tengo dos marcos de datos: zanahorias y pepinos. Cada marco de datos tiene una sola columna numérica que enumera la longitud de todas las zanahorias medidas (total: 100k zanahorias) y pepinos (total: 50k pepinos).

Deseo trazar dos histogramas, longitud de zanahoria y longitudes de pepino, en la misma parcela. Se superponen, así que creo que también necesito algo de transparencia. También necesito usar frecuencias relativas, no números absolutos, ya que el número de instancias en cada grupo es diferente.

algo como esto estaría bien pero no entiendo cómo crearlo desde mis dos tablas:

Answer 1

@Dirk Eddelbuettel: La idea básica es excelente, pero el código como se muestra se puede mejorar. [Toma mucho tiempo para explicar, por lo tanto, una respuesta por separado y no un comentario.]

La función hist() por defecto dibuja gráficos, por lo que debe agregar la opción plot=FALSE . Además, es más claro establecer el área de trazado mediante un plot(0,0,type="n",...) llamada en la que se pueden agregar las etiquetas de los ejes, el título del trazado, etc. Por último, me gustaría mencionar que también se podría usar sombreado para distinguir entre los dos histogramas. Aquí está el código:

set.seed(42)
p1 <- hist(rnorm(500,4),plot=FALSE)
p2 <- hist(rnorm(500,6),plot=FALSE)
plot(0,0,type="n",xlim=c(0,10),ylim=c(0,100),xlab="x",ylab="freq",main="Two histograms")
plot(p1,col="green",density=10,angle=135,add=TRUE)
plot(p2,col="blue",density=10,angle=45,add=TRUE)

Y aquí está el resultado (un poco demasiado ancho debido a RStudio :-)):

Answer 2

Aquí está la versión como ggplot2 que di solo en la base R. Copié algunos de @nullglob.

generar los datos

carrots <- rnorm(100000,5,2)
cukes <- rnorm(50000,7,2.5)

No necesita colocarlo en un marco de datos como con ggplot2. El inconveniente de este método es que tiene que escribir muchos más detalles de la trama. La ventaja es que tienes control sobre más detalles de la trama.

## calculate the density - don''t plot yet
densCarrot <- density(carrots)
densCuke <- density(cukes)
## calculate the range of the graph
xlim <- range(densCuke$x,densCarrot$x)
ylim <- range(0,densCuke$y, densCarrot$y)
#pick the colours
carrotCol <- rgb(1,0,0,0.2)
cukeCol <- rgb(0,0,1,0.2)
## plot the carrots and set up most of the plot parameters
plot(densCarrot, xlim = xlim, ylim = ylim, xlab = ''Lengths'',
     main = ''Distribution of carrots and cucumbers'', 
     panel.first = grid())
#put our density plots in
polygon(densCarrot, density = -1, col = carrotCol)
polygon(densCuke, density = -1, col = cukeCol)
## add a legend in the corner
legend(''topleft'',c(''Carrots'',''Cucumbers''),
       fill = c(carrotCol, cukeCol), bty = ''n'',
       border = NA)

Answer 3

Aquí hay un ejemplo de cómo puedes hacerlo en gráficos R "clásicos":

## generate some random data
carrotLengths <- rnorm(1000,15,5)
cucumberLengths <- rnorm(200,20,7)
## calculate the histograms - don''t plot yet
histCarrot <- hist(carrotLengths,plot = FALSE)
histCucumber <- hist(cucumberLengths,plot = FALSE)
## calculate the range of the graph
xlim <- range(histCucumber$breaks,histCarrot$breaks)
ylim <- range(0,histCucumber$density,
              histCarrot$density)
## plot the first graph
plot(histCarrot,xlim = xlim, ylim = ylim,
     col = rgb(1,0,0,0.4),xlab = ''Lengths'',
     freq = FALSE, ## relative, not absolute frequency
     main = ''Distribution of carrots and cucumbers'')
## plot the second graph on top of this
opar <- par(new = FALSE)
plot(histCucumber,xlim = xlim, ylim = ylim,
     xaxt = ''n'', yaxt = ''n'', ## don''t add axes
     col = rgb(0,0,1,0.4), add = TRUE,
     freq = FALSE) ## relative, not absolute frequency
## add a legend in the corner
legend(''topleft'',c(''Carrots'',''Cucumbers''),
       fill = rgb(1:0,0,0:1,0.4), bty = ''n'',
       border = NA)
par(opar)

El único problema con esto es que se ve mucho mejor si los saltos de histograma están alineados, lo que puede tener que hacerse manualmente (en los argumentos pasados ​​a hist ).

Answer 4

Aquí hay una función que escribí que usa pseudo transparencia para representar histogramas superpuestos

plotOverlappingHist <- function(a, b, colors=c("white","gray20","gray50"),
                                breaks=NULL, xlim=NULL, ylim=NULL){

  ahist=NULL
  bhist=NULL

  if(!(is.null(breaks))){
    ahist=hist(a,breaks=breaks,plot=F)
    bhist=hist(b,breaks=breaks,plot=F)
  } else {
    ahist=hist(a,plot=F)
    bhist=hist(b,plot=F)

    dist = ahist$breaks[2]-ahist$breaks[1]
    breaks = seq(min(ahist$breaks,bhist$breaks),max(ahist$breaks,bhist$breaks),dist)

    ahist=hist(a,breaks=breaks,plot=F)
    bhist=hist(b,breaks=breaks,plot=F)
  }

  if(is.null(xlim)){
    xlim = c(min(ahist$breaks,bhist$breaks),max(ahist$breaks,bhist$breaks))
  }

  if(is.null(ylim)){
    ylim = c(0,max(ahist$counts,bhist$counts))
  }

  overlap = ahist
  for(i in 1:length(overlap$counts)){
    if(ahist$counts[i] > 0 & bhist$counts[i] > 0){
      overlap$counts[i] = min(ahist$counts[i],bhist$counts[i])
    } else {
      overlap$counts[i] = 0
    }
  }

  plot(ahist, xlim=xlim, ylim=ylim, col=colors[1])
  plot(bhist, xlim=xlim, ylim=ylim, col=colors[2], add=T)
  plot(overlap, xlim=xlim, ylim=ylim, col=colors[3], add=T)
}

Aquí hay otra forma de hacerlo utilizando el soporte de R para colores transparentes

a=rnorm(1000, 3, 1)
b=rnorm(1000, 6, 1)
hist(a, xlim=c(0,10), col="red")
hist(b, add=T, col=rgb(0, 1, 0, 0.5) )

Los resultados terminan pareciéndose a esto:

Answer 5

Aquí hay una solución aún más simple usando gráficos base y mezcla alfa (que no funciona en todos los dispositivos gráficos):

set.seed(42)
p1 <- hist(rnorm(500,4))                     # centered at 4
p2 <- hist(rnorm(500,6))                     # centered at 6
plot( p1, col=rgb(0,0,1,1/4), xlim=c(0,10))  # first histogram
plot( p2, col=rgb(1,0,0,1/4), xlim=c(0,10), add=T)  # second

La clave es que los colores son semitransparentes.

Editar, más de dos años después : como esto acaba de recibir un voto positivo, creo que también puedo agregar una idea visual de lo que produce el código ya que la mezcla alfa es tan útil:

Answer 6

Esa imagen a la que se vinculó fue para curvas de densidad, no histogramas.

Si has estado leyendo en ggplot, tal vez lo único que te hace falta es combinar tus dos marcos de datos en uno largo.

Entonces, comencemos con algo como lo que tiene, dos conjuntos de datos separados y combínelos.

carrots <- data.frame(length = rnorm(100000, 6, 2))
cukes <- data.frame(length = rnorm(50000, 7, 2.5))

#Now, combine your two dataframes into one.  First make a new column in each that will be a variable to identify where they came from later.
carrots$veg <- ''carrot''
cukes$veg <- ''cuke''

#and combine into your new data frame vegLengths
vegLengths <- rbind(carrots, cukes)

Después de eso, lo cual es innecesario si sus datos ya están formalizados desde hace mucho tiempo, solo necesita una línea para hacer su trama.

ggplot(vegLengths, aes(length, fill = veg)) + geom_density(alpha = 0.2)

Ahora, si realmente quiere histogramas, lo siguiente funcionará. Tenga en cuenta que debe cambiar la posición del argumento predeterminado "apilar". Es posible que te lo pierdas si realmente no tienes una idea de cómo deberían ser tus datos. Un alfa superior se ve mejor allí. También tenga en cuenta que hice histogramas de densidad. Es fácil eliminar y = ..density.. para volver a contar.

ggplot(vegLengths, aes(length, fill = veg)) + geom_histogram(alpha = 0.5, aes(y = ..density..), position = ''identity'')

Answer 7

Ya hay respuestas hermosas, pero pensé en agregar esto. Me parece bien. (Números aleatorios copiados de @Dirk). library(scales) es necesaria`

set.seed(42)
hist(rnorm(500,4),xlim=c(0,10),col=''skyblue'',border=F)
hist(rnorm(500,6),add=T,col=scales::alpha(''red'',.5),border=F)

El resultado es...

Actualización: esta función de superposición también puede ser útil para algunos.

hist0 <- function(...,col=''skyblue'',border=T) hist(...,col=col,border=border) 

Siento que el resultado de hist0 es más bonito que el hist

hist2 <- function(var1, var2,name1='''',name2='''',
              breaks = min(max(length(var1), length(var2)),20), 
              main0 = "", alpha0 = 0.5,grey=0,border=F,...) {    

library(scales)
  colh <- c(rgb(0, 1, 0, alpha0), rgb(1, 0, 0, alpha0))
  if(grey) colh <- c(alpha(grey(0.1,alpha0)), alpha(grey(0.9,alpha0)))

  max0 = max(var1, var2)
  min0 = min(var1, var2)

  den1_max <- hist(var1, breaks = breaks, plot = F)$density %>% max
  den2_max <- hist(var2, breaks = breaks, plot = F)$density %>% max
  den_max <- max(den2_max, den1_max)*1.2
  var1 %>% hist0(xlim = c(min0 , max0) , breaks = breaks,
                 freq = F, col = colh[1], ylim = c(0, den_max), main = main0,border=border,...)
  var2 %>% hist0(xlim = c(min0 , max0),  breaks = breaks,
                 freq = F, col = colh[2], ylim = c(0, den_max), add = T,border=border,...)
  legend(min0,den_max, legend = c(
    ifelse(nchar(name1)==0,substitute(var1) %>% deparse,name1),
    ifelse(nchar(name2)==0,substitute(var2) %>% deparse,name2),
    "Overlap"), fill = c(''white'',''white'', colh[1]), bty = "n", cex=1,ncol=3)

  legend(min0,den_max, legend = c(
    ifelse(nchar(name1)==0,substitute(var1) %>% deparse,name1),
    ifelse(nchar(name2)==0,substitute(var2) %>% deparse,name2),
    "Overlap"), fill = c(colh, colh[2]), bty = "n", cex=1,ncol=3) }

El resultado de

par(mar=c(3, 4, 3, 2) + 0.1) 
set.seed(100) 
hist2(rnorm(10000,2),rnorm(10000,3),breaks = 50)

es

Answer 8

La API R de Plotly podría ser útil para usted. El siguiente gráfico está here .

library(plotly)
#add username and key
p <- plotly(username="Username", key="API_KEY")
#generate data
x0 = rnorm(500)
x1 = rnorm(500)+1
#arrange your graph
data0 = list(x=x0,
         name = "Carrots",
         type=''histogramx'',
         opacity = 0.8)

data1 = list(x=x1,
         name = "Cukes",
         type=''histogramx'',
         opacity = 0.8)
#specify type as ''overlay''
layout <- list(barmode=''overlay'',
               plot_bgcolor = ''rgba(249,249,251,.85)'')  
#format response, and use ''browseURL'' to open graph tab in your browser.
response = p$plotly(data0, data1, kwargs=list(layout=layout))

url = response$url
filename = response$filename

browseURL(response$url)

Divulgación completa: estoy en el equipo.