gráfico de densidad bidireccional combinado con gráfico de densidad unidireccional con regiones seleccionadas en r

# data set.seed (123) xvar <- c(rnorm (1000, 50, 30), rnorm (1000, 40, 10), rnorm (1000, 70, 10)) yvar <- xvar + rnorm (length (xvar), 0, 20) myd <- data.frame (xvar, yvar) # density plot for xvar upperp = 80 # upper cutoff lowerp = 30 # lower cutoff x <- myd$xvar plot(density(x)) dens <- density(x) x11 <- min(which(dens$x <= lowerp)) x12 <- max(which(dens$x <= lowerp)) x21  upperp)) x22  upperp)) with(dens, polygon(x = c(x[c(x11, x11:x12, x12)]), y = c(0, y[x11:x12], 0), col = "green")) with(dens, polygon(x = c(x[c(x21, x21:x22, x22)]), y = c(0, y[x21:x22], 0), col = "red")) abline(v = c(mean(x)), lwd = 2, lty = 2, col = "red") # density plot with yvar upperp = 70 # upper cutoff lowerp = 30 # lower cutoff x <- myd$yvar plot(density(x)) dens <- density(x) x11 <- min(which(dens$x <= lowerp)) x12 <- max(which(dens$x <= lowerp)) x21  upperp)) x22  upperp)) with(dens, polygon(x = c(x[c(x11, x11:x12, x12)]), y = c(0, y[x11:x12], 0), col = "green")) with(dens, polygon(x = c(x[c(x21, x21:x22, x22)]), y = c(0, y[x21:x22], 0), col = "red")) abline(v = c(mean(x)), lwd = 2, lty = 2, col = "red") 

Necesito trazar la gráfica de densidad bidireccional, no estoy seguro de que haya una mejor manera que la siguiente:

 ggplot(myd,aes(x=xvar,y=yvar))+ stat_density2d(aes(fill=..level..), geom="polygon") + scale_fill_gradient(low="blue", high="green") + theme_bw() 

Quiero combinar los tres tipos en uno (no sabía si puedo crear un gráfico bidireccional en ggplot), no hay preferencia sobre si la solución debe ser en ggplot, base o mixta. Espero que este sea un proyecto factible, considerando la solidez de R. Personalmente prefiero ggplot2.

enter image description here

Nota: el sombreado inferior en este gráfico no es correcto, el rojo debe ser siempre más bajo y el verde superior en los gráficos xvar e yvar, correspondiente a la región sombreada en el gráfico de densidad xy.

Edición: expectativa máxima en el gráfico (agradece a seth y jon por una respuesta muy aproximada) (1) eliminando las tags de espacio y eje, etc. para hacerlo compacto
(2) alineaciones de cuadrículas para que las marcas y cuadrículas de la gráfica media se alineen con las marcas laterales y las tags y el tamaño de las plots tengan el mismo aspecto. enter image description here

Aquí está el ejemplo para combinar múltiples gráficos con alineación:

 library(ggplot2) library(grid) set.seed (123) xvar < - c(rnorm (100, 50, 30), rnorm (100, 40, 10), rnorm (100, 70, 10)) yvar <- xvar + rnorm (length (xvar), 0, 20) myd <- data.frame (xvar, yvar) p1 <- ggplot(myd,aes(x=xvar,y=yvar))+ stat_density2d(aes(fill=..level..), geom="polygon") + coord_cartesian(c(0, 150), c(0, 150)) + opts(legend.position = "none") p2 <- ggplot(myd, aes(x = xvar)) + stat_density() + coord_cartesian(c(0, 150)) p3 <- ggplot(myd, aes(x = yvar)) + stat_density() + coord_flip(c(0, 150)) gt <- ggplot_gtable(ggplot_build(p1)) gt2 <- ggplot_gtable(ggplot_build(p2)) gt3 <- ggplot_gtable(ggplot_build(p3)) gt1 <- ggplot2:::gtable_add_cols(gt, unit(0.3, "null"), pos = -1) gt1 <- ggplot2:::gtable_add_rows(gt1, unit(0.3, "null"), pos = 0) gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "panel")]], 1, 4, 1, 4) gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "axis-l")]], 1, 3, 1, 3, clip = "off") gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "panel")]], 4, 6, 4, 6) gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "axis-b")]], 5, 6, 5, 6, clip = "off") grid.newpage() grid.draw(gt1) 

enter image description here

tenga en cuenta que esto funciona con gglot2 0.9.1, y en la versión futura puede hacerlo más fácilmente.

Y finalmente

puedes hacerlo por:

 library(ggplot2) library(grid) set.seed (123) xvar < - c(rnorm (100, 50, 30), rnorm (100, 40, 10), rnorm (100, 70, 10)) yvar <- xvar + rnorm (length (xvar), 0, 20) myd <- data.frame (xvar, yvar) p1 <- ggplot(myd,aes(x=xvar,y=yvar))+ stat_density2d(aes(fill=..level..), geom="polygon") + geom_polygon(aes(x, y), data.frame(x = c(-Inf, -Inf, 30, 30), y = c(-Inf, 30, 30, -Inf)), alpha = 0.5, colour = NA, fill = "red") + geom_polygon(aes(x, y), data.frame(x = c(Inf, Inf, 80, 80), y = c(Inf, 80, 80, Inf)), alpha = 0.5, colour = NA, fill = "green") + coord_cartesian(c(0, 120), c(0, 120)) + opts(legend.position = "none") xd <- data.frame(density(myd$xvar)[c("x", "y")]) p2 <- ggplot(xd, aes(x, y)) + geom_area(data = subset(xd, x < 30), fill = "red") + geom_area(data = subset(xd, x > 80), fill = "green") + geom_line() + coord_cartesian(c(0, 120)) yd < - data.frame(density(myd$yvar)[c("x", "y")]) p3 <- ggplot(yd, aes(x, y)) + geom_area(data = subset(yd, x < 30), fill = "red") + geom_area(data = subset(yd, x > 80), fill = "green") + geom_line() + coord_flip(c(0, 120)) gt < - ggplot_gtable(ggplot_build(p1)) gt2 <- ggplot_gtable(ggplot_build(p2)) gt3 <- ggplot_gtable(ggplot_build(p3)) gt1 <- ggplot2:::gtable_add_cols(gt, unit(0.3, "null"), pos = -1) gt1 <- ggplot2:::gtable_add_rows(gt1, unit(0.3, "null"), pos = 0) gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "panel")]], 1, 4, 1, 4) gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "axis-l")]], 1, 3, 1, 3, clip = "off") gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "panel")]], 4, 6, 4, 6) gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "axis-b")]], 5, 6, 5, 6, clip = "off") grid.newpage() grid.draw(gt1) 

enter image description here

Como en el ejemplo al que he vinculado anteriormente, necesita el paquete gridExtra. Este es el g que diste.

 g=ggplot(myd,aes(x=xvar,y=yvar))+ stat_density2d(aes(fill=..level..), geom="polygon") + scale_fill_gradient(low="blue", high="green") + theme_bw() 

Usa geom_rect para dibujar las dos regiones

 gbig=g+geom_rect(data=myd, aes( NULL, NULL, xmin=0, xmax=lowerp, ymin=-10, ymax=20), fill='red', alpha=.0051, inherit.aes=F)+ geom_rect(aes( NULL, NULL, xmin=upperp, xmax=100, ymin=upperp, ymax=130), fill='green', alpha=.0051, inherit.aes=F)+ opts(legend.position = "none") 

Este es un histogtwig ggplot simple; le faltan las regiones de color, pero son bastante fáciles

  dens_top < - ggplot()+geom_density(aes(x)) dens_right <- ggplot()+geom_density(aes(x))+coord_flip() 

Haz un gráfico vacío para completar en la esquina

  empty < - ggplot()+geom_point(aes(1,1), colour="white")+ opts(axis.ticks=theme_blank(), panel.background=theme_blank(), axis.text.x=theme_blank(), axis.text.y=theme_blank(), axis.title.x=theme_blank(), axis.title.y=theme_blank()) 

Luego usa la función grid.arrange:

 library(gridExtra) grid.arrange(dens_top, empty , gbig, dens_right, ncol=2, nrow=2, widths=c(4, 1), heights=c(1, 4)) 

enter image description here

No es muy bonito, pero la idea está ahí. ¡Tendrás que asegurarte de que las escalas coincidan también!

Basándose en la respuesta de Seth (gracias a Seth, y usted merece todos los créditos), mejoré algunas de las cuestiones planteadas por el interrogador. Como los comentarios son demasiado cortos para responder a todos los problemas, elijo usar esto como respuesta. Un par de problemas siguen ahí, necesita su ayuda :

 # data set.seed (123) xvar < - c(rnorm (1000, 50, 30), rnorm (1000, 40, 10), rnorm (1000, 70, 10)) yvar <- xvar + rnorm (length (xvar), 0, 20) myd <- data.frame (xvar, yvar) require(ggplot2) # density plot for xvar upperp = 80 # upper cutoff lowerp = 30 

figura media

  g=ggplot(myd,aes(x=xvar,y=yvar))+ stat_density2d(aes(fill=..level..), geom="polygon") + scale_fill_gradient(low="blue", high="green") + scale_x_continuous(limits = c(0, 110)) + scale_y_continuous(limits = c(0, 110)) + theme_bw() 

geom_rect dos regiones

 gbig=g+ geom_rect(data=myd, aes( NULL, NULL, xmin=0, xmax=lowerp,ymin=0, ymax=20), fill='red', alpha=.0051,inherit.aes=F)+ geom_rect(aes(NULL, NULL, xmin=upperp, xmax=110, ymin=upperp, ymax=110), fill='green', alpha=.0051, inherit.aes=F)+ opts(legend.position = "none", plot.margin = unit(rep(0, 4), "lines")) 

Histogtwig superior con región sombreada

  x.dens < - density(myd$xvar) df.dens <- data.frame(x = x.dens$x, y = x.dens$y) dens_top <- ggplot()+geom_density(aes(myd$xvar, y = ..density..)) + scale_x_continuous(limits = c(0, 110)) + geom_area(data = subset(df.dens, x <= lowerp), aes(x=x,y=y), fill = 'red') + geom_area(data = subset(df.dens, x >= upperp), aes(x=x,y=y), fill = 'green') + opts (axis.text.x=theme_blank(), axis.title.x=theme_blank(), plot.margin = unit(rep(0, 4), "lines")) + xlab ("") + ylab ("") + theme_bw() 

histogtwig derecho con región sombreada

  y.dens < - density(myd$yvar) df.dens.y <- data.frame(x = y.dens$x, y = y.dens$y) dens_right <- ggplot()+geom_density(aes(myd$yvar, y = ..density..)) + scale_x_continuous(limits = c(0, 110)) + geom_area(data = subset(df.dens.y, x <= lowerp), aes(x=x,y=y), fill = 'red') + geom_area(data = subset(df.dens.y, x >= upperp), aes(x=x,y=y), fill = 'green') + coord_flip() + opts (axis.text.x=theme_blank(), axis.title.x=theme_blank(), plot.margin = unit(rep(0, 4), "lines")) + xlab ("") + ylab ("") + theme_bw() 

Haz un gráfico vacío para completar en la esquina

  empty < - ggplot()+geom_point(aes(1,1), colour="white")+ scale_x_continuous(breaks = NA) + scale_y_continuous(breaks = NA) + opts(axis.ticks=theme_blank(), panel.background=theme_blank(), axis.text.x=theme_blank(), axis.text.y=theme_blank(), axis.title.x=theme_blank(), axis.title.y=theme_blank()) 

Luego usa la función grid.arrange:

 library(gridExtra) grid.arrange(dens_top, empty , gbig, dens_right, ncol=2,nrow=2, widths=c(2, 1), heights=c(1, 2)) 

enter image description here

PD: (1) ¿Alguien puede ayudar a alinear los gráficos perfectamente? (2) ¿Alguien puede ayudar a eliminar el espacio adicional entre las plots, traté de ajustar los márgenes, pero hay espacio entre la gráfica de densidad x e y la gráfica central.