en utilisant grid et ggplot2 pour créer des complots de jointure en utilisant R

Question

Je voudrais savoir ce que je peux faire pour réparer une grille de placettes. Les courbes sont disposées en un tableau de sorte que toutes les courbes d'une rangée aient la même variable d'axe Y et que toutes les courbes d'une colonne aient la même variable d'axe X. Lorsqu'il est joint ensemble dans une grille, cela crée un multiplot. Je désactive les étiquettes sur la plupart des parcelles à l'exception de celles extérieures, puisque les étiquettes internes ont la même variable et l'échelle. Cependant, comme les tracés externes ont des étiquettes et des valeurs d'axe, ils résultent en une taille différente des autres. Je pensais ajouter 2 autres colonnes et lignes à la grille, pour les noms de variable et les valeurs de gamme d'axes ... puis en traçant seulement les noms de variable sur l'espace de grille correspondant et les valeurs d'axe sur un autre espace de grille, donc seulement traçant les points dans l'espace restant et obtenant des tailles égales.

EDIT 1: Merci à rcs pour moi pointant vers align.plot

Edité align.plot pour accepter des valeurs nulles (quand le titre ayant/texte dans le isnt souhaité axe)

Maintenant, je suis plus proche à l'objectif mais les premières parcelles de columun sont encore plus petites que les autres en raison des étiquettes.

exemple de code:

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

image originale:

image actuelle de progression:

Answer 1

Il y a une fonction align.plots dans lePaquet. Vérifiez ce fil de la liste de diffusion de ggplot2: Aligning time series plots

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

Answer 2

Voici une façon simple avec ggplot2 et faire fondre:

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

Résultat:

Vous pouvez visser autour de toutes les options de ggplot2 pour obtenir les onglets à apparaître dans les endroits appropriés, et supprimez la légende.

---

Note: pour les parcelles comme celui-ci, où vous voulez comparer des variables beaucoup par paires, consultez the GGally package. Il y a quelques docs ici: http://rgm2.lab.nig.ac.jp/RGM2/func.php?rd_id=GGally:ggpairs.