gráfico de densidad de dos vías combinada con la densidad de trama de una manera con las 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 para trazar gráfico de densidad de dos vías, no estoy seguro de que hay 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 esta trama no es correcta, rojo debe ser siempre inferior y superior verde en xvar y Yvar gráficos, correspondiente a la región sombreada en la gráfica de densidad xy.

Editar: último expectativa en el gráfico (Seth gracias y Jon de respuesta muy cerca) (1) Eliminar el espacio y etiquetas de los ejes de garrapatas, etc para que sea compacto
(2) alineaciones de las redes a fin de que parcela media Las marcas y las cuadrículas deben estar alineadas con las marcas laterales y las etiquetas y el tamaño de las parcelas tiene el mismo aspecto.

Answer 1

Aquí está el ejemplo de la combinación de varias parcelas con la 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) 

nota que esto funciona con gglot2 0.9.1, y en la versión futura que puede hacerlo con mayor facilidad .

Y finalmente

se puede hacer eso 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

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

uso 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 simple histograma ggplot; que carece de sus regiones coloreadas, pero son bastante fáciles

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

Hacer una gráfica vacía para llenar 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()) 

A continuación, utilice 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í. ¡Deberá asegurarse de que las básculas coincidan también!

Answer 3

Basándome en la respuesta de Set (gracias 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í, necesito 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 del medio

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

Top histograma con la 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 derecha 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() 

Hacer una gráfica vacía para llenar 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()) 

A continuación, utilice 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.