using grid and ggplot2 to create join plots using R

Question

I would like to know what can I do to fix a grid of plots. The plots are arranged in an array so that all the plots in a row have the same Y axis variable and all the plots in a column have the same X axis variable.

When joined together in a grid this creates a multiplot. I disable the labels on most of the plots excepting the outer ones, since the inner ones have the same variable and scale. However, since the outer plots have labels and axis values, they result in a different size from the other ones.

I was thinking of adding 2 more columns and rows to the grid, for the variable names and the axis range values... then plotting only the variable names on the corresponding grid space and the axis values on another grid space, therefore only plotting the points in the remaining space and getting equal sizes.

EDIT 1: Thanks to rcs for pointing me toward align.plot

Edited align.plot to accept null values (for when having title/text in the axis isnt desired)

Now I'm closer to the goal but the first columun plots are still smaller width than the rest due to the labels.

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

original image:

current progress image:

Answer 1

Here's a simple way with ggplot2 and melt:

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

Result:

You can screw around with all of the ggplot2 options to get the tabs to appear in the appropriate places, and remove the legend.

---

Note: for plots like this, where you want to compare lots of variables pairwise, check out the GGally package. There are some docs here: http://rgm2.lab.nig.ac.jp/RGM2/func.php?rd_id=GGally:ggpairs.