normal - superponer graficas en r ggplot

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

Question

# 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 <- min(which(dens$x > upperp))
x22 <- max(which(dens$x > 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 <- min(which(dens$x > upperp))
x22 <- max(which(dens$x > 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.

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 etiquetas 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 etiquetas y el tamaño de las parcelas tengan el mismo aspecto.

Answer 1

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)

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)

Answer 2

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

Histograma 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()

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

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

Answer 3

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

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