usando grid y ggplot2 para crear gráficos de unión usando R

Question

Me gustaría saber qué puedo hacer para arreglar una grilla de parcelas. Los gráficos se organizan en una matriz de modo que todos los gráficos en una fila tienen la misma variable del eje Y y todos los gráficos en una columna tienen la misma variable del eje X.

Cuando se unen en una cuadrícula esto crea un multiplot. Desactivo las etiquetas en la mayoría de los gráficos excepto en los exteriores, ya que los interiores tienen la misma variable y escala. Sin embargo, dado que las gráficas externas tienen etiquetas y valores de eje, dan como resultado un tamaño diferente de los otros.

Estaba pensando en agregar 2 columnas y filas más a la cuadrícula, para los nombres de las variables y los valores del rango del eje ... y luego graficar solo los nombres de las variables en el espacio de cuadrícula correspondiente y los valores del eje en otro espacio de la cuadrícula por lo tanto, solo trazar los puntos en el espacio restante y obtener tamaños iguales.

EDIT 1: Gracias a RCS para mí apuntando hacia align.plot

align.plot Editado para aceptar valores nulos (para cuando tenga título/texto en la tampoco eje deseado)

Ahora estoy más cerca a la meta, pero las primeras parcelas en columnas tienen un ancho menor que el resto debido a las etiquetas.

código de ejemplo:

grid_test <- function() 
{ 
    dsmall <- diamonds[sample(nrow(diamonds), 100), ] 

    #-----/align function----- 
    align.plots <- function(gl, ...){ 
     # Obtained from http://groups.google.com/group/ggplot2/browse_thread/thread/1b859d6b4b441c90 
     # Adopted from http://ggextra.googlecode.com/svn/trunk/R/align.r 

     # BUGBUG: Does not align horizontally when one has a title. 
     # There seems to be a spacer used when a title is present. Include the 
     # size of the spacer. Not sure how to do this yet. 

     stats.row <- vector("list", gl$nrow) 
     stats.col <- vector("list", gl$ncol) 

     lstAll <- list(...) 

     dots <- lapply(lstAll, function(.g) ggplotGrob(.g[[1]])) 
     #ytitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL)) 
     #ylabels <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL)) 
     #xtitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL)) 
     #xlabels <- lapply(dots, function(.g) editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL)) 
     plottitles <- lapply(dots, function(.g) editGrob(getGrob(.g,"plot.title.text",grep=TRUE), vp=NULL)) 

     xtitles <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.title.x.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.title.x.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     xlabels <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.text.x.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.text.x.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     ytitles <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.title.y.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.title.y.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     ylabels <- lapply(dots, function(.g) if(!is.null(getGrob(.g,"axis.text.y.text",grep=TRUE))) 
         editGrob(getGrob(.g,"axis.text.y.text",grep=TRUE), vp=NULL) else ggplot2:::.zeroGrob) 

     legends <- lapply(dots, function(.g) if(!is.null(.g$children$legends)) 
         editGrob(.g$children$legends, vp=NULL) else ggplot2:::.zeroGrob) 

     widths.left <- mapply(`+`, e1=lapply(ytitles, grobWidth), 
          e2= lapply(ylabels, grobWidth), SIMPLIFY=FALSE) 
     widths.right <- lapply(legends, grobWidth) 
     # heights.top <- lapply(plottitles, grobHeight) 
     heights.top <- lapply(plottitles, function(x) unit(0,"cm")) 
     heights.bottom <- mapply(`+`, e1=lapply(xtitles, grobHeight), e2= lapply(xlabels, grobHeight), SIMPLIFY=FALSE) 

     for (i in seq_along(lstAll)) { 
      lstCur <- lstAll[[i]] 

      # Left 
      valNew <- widths.left[[ i ]] 
      valOld <- stats.col[[ min(lstCur[[3]]) ]]$widths.left.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.col[[ min(lstCur[[3]]) ]]$widths.left.max <- max(do.call(unit.c, list(valOld, valNew))) 

      # Right 
      valNew <- widths.right[[ i ]] 
      valOld <- stats.col[[ max(lstCur[[3]]) ]]$widths.right.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.col[[ max(lstCur[[3]]) ]]$widths.right.max <- max(do.call(unit.c, list(valOld, valNew))) 

      # Top 
      valNew <- heights.top[[ i ]] 
      valOld <- stats.row[[ min(lstCur[[2]]) ]]$heights.top.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.row[[ min(lstCur[[2]]) ]]$heights.top.max <- max(do.call(unit.c, list(valOld, valNew))) 

      # Bottom 
      valNew <- heights.bottom[[ i ]] 
      valOld <- stats.row[[ max(lstCur[[2]]) ]]$heights.bottom.max 
      if (is.null(valOld)) valOld <- unit(0, "cm") 
      stats.row[[ max(lstCur[[2]]) ]]$heights.bottom.max <- max(do.call(unit.c, list(valOld, valNew))) 
     } 

     for(i in seq_along(dots)){ 
      lstCur <- lstAll[[i]] 
      nWidthLeftMax <- stats.col[[ min(lstCur[[ 3 ]]) ]]$widths.left.max 
      nWidthRightMax <- stats.col[[ max(lstCur[[ 3 ]]) ]]$widths.right.max 
      nHeightTopMax <- stats.row[[ min(lstCur[[ 2 ]]) ]]$heights.top.max 
      nHeightBottomMax <- stats.row[[ max(lstCur[[ 2 ]]) ]]$heights.bottom.max 
      pushViewport(viewport(layout.pos.row=lstCur[[2]], 
         layout.pos.col=lstCur[[3]], just=c("left","top"))) 
      pushViewport(viewport(
         x=unit(0, "npc") + nWidthLeftMax - widths.left[[i]], 
         y=unit(0, "npc") + nHeightBottomMax - heights.bottom[[i]], 
         width=unit(1, "npc") - nWidthLeftMax + widths.left[[i]] - 
               nWidthRightMax + widths.right[[i]], 
         height=unit(1, "npc") - nHeightBottomMax + heights.bottom[[i]] - 
               nHeightTopMax + heights.top[[i]], 
         just=c("left","bottom"))) 
      grid.draw(dots[[i]]) 
      upViewport(2) 
     } 

    } 
    #-----\align function----- 

    # edge margins 
    margin1 = 0.1 
    margin2 = -0.9 
    margin3 = 0.5 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = depth, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank()) 
    plot1 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin3,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = depth, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot2 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = depth, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot3 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = price, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank()) 
    plot4 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin3,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = price, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot5 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = price, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.text.x = theme_blank(), axis.ticks = theme_blank(), axis.title.x = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot6 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin2,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = x, y = carat, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.ticks = theme_blank()) 
    plot7 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin3,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = y, y = carat, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.ticks = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot8 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin2,"lines"))) 

    plot <- ggplot(data = dsmall) + geom_point(mapping = aes(x = z, y = carat, colour = cut)) + opts(legend.position="none") 
    plot <- plot + opts(axis.ticks = theme_blank(), axis.text.y = theme_blank(), axis.title.y = theme_blank()) 
    plot9 <- plot + opts(plot.margin=unit.c(unit(margin1, "lines"), unit(margin1,"lines"), unit(margin3,"lines"), unit(margin2,"lines"))) 

    grid_layout <- grid.layout(nrow=3, ncol=3, widths=c(2,2,2), heights=c(2,2,2)) 
    grid.newpage() 
    pushViewport(viewport(layout=grid_layout)) 
    align.plots(grid_layout, 
      list(plot1, 1, 1), 
      list(plot2, 1, 2), 
      list(plot3, 1, 3), 
      list(plot4, 2, 1), 
      list(plot5, 2, 2), 
      list(plot6, 2, 3), 
      list(plot7, 3, 1), 
      list(plot8, 3, 2), 
      list(plot9, 3, 3)) 
} 

imagen original:

imagen progreso actual:

Answer 1

hay una función align.plots en el ggExtra paquete. Marque este hilo de la lista de correo ggplot2: Aligning time series plots

aligned plots http://img138.imageshack.us/img138/6786/aligngrid.png

Answer 2

Aquí está una manera sencilla con ggplot2 y derretir:

diamonds_sample <- diamonds[sample(nrow(diamonds), 100), ] 

melted_diamonds <- melt(diamonds_sample, measure.vars=c('x','y','z'), 
    variable_name='letter') 
# rename the melt results to avoid confusion with next melt 
# (bug in melt means you can't rename the value during melt) 
names(melted_diamonds)[9] <- 'letter.value' 

melted_diamonds <- melt(melted_diamonds, 
    measure.vars=c('depth', 'price', 'carat'), variable_name='variables') 

ggplot(melted_diamonds, aes(x=letter.value, y=value, colour=cut)) + 
    geom_point() + facet_grid(variables~letter, scale='free') 

Resultado:

se puede atornillar con todas las opciones de ggplot2 para que aparezcan las pestañas en los lugares apropiados, y eliminar la leyenda.

---

Nota: para las parcelas de este tipo, en las que desee comparar un montón de variables de dos a dos, echa un vistazo a the GGally package. Hay algunos documentos aquí: http://rgm2.lab.nig.ac.jp/RGM2/func.php?rd_id=GGally:ggpairs.