R/gglayout.R

In fzwaeustc/pcrfn: Peng's Collection of R Functions at Nielsen

gglayout <-
function(..., plotlist=NULL, mat, widths=rep(1, ncol(mat)),
                     heights=rep(1,nrow(mat)), legend.pos="none", 
                     legend.ratio=0.2){
    #require(grid)
    
    matrix.index <- function(a, value){
      inx <- which(data.frame(a)==value)
      col.num <-ceiling(inx/nrow(a))
      row.num <- inx - (col.num-1)*nrow(a)
      return(rbind(row.num, col.num))
    }
    vplayout <- function(x, y){
      viewport(layout.pos.row = x, layout.pos.col = y)
    }
    subplot <- function(x, y) viewport(layout.pos.row = x,
                                       layout.pos.col = y)
    
    plots <- c(list(...), plotlist)
    
    #if (sum(sapply(plots, class)!="gg")>=1)
      #stop("You probably feeded the function with non-GGPLOT objects")
    
    nplots <- length(plots)
    
    if (legend.pos=="none"){
      plotCols = ncol(mat)
      plotRows = nrow(mat)
      
      grid.newpage()
      pushViewport(viewport(layout = grid.layout(plotRows, plotCols, 
                                                 widths=widths, heights=heights)))
      for (i in 1:nplots){
        i_loc <-matrix.index(mat,i)
        print(plots[[i]], 
              vp = vplayout(min(i_loc[1,]):max(i_loc[1,]), 
                            min(i_loc[2,]):max(i_loc[2,])))
      }      
    } else {  
      #Where legend come
      lg <- ggplotGrob(plots[[1]]+theme(legend.position=legend.pos)) 
      
      # Make the panel
      if (legend.pos=="bottom") {
        plotCols = ncol(mat)                  # Number of columns of plots
        plotRows = nrow(mat)+1
        heights=c(heights, sum(heights)*legend.ratio*0.5)
        legend <- editGrob( getGrob( lg, gPath("guide"), grep=TRUE, global=TRUE ),
                            vp= subplot(plotRows, 1:plotCols) )
      } else if (legend.pos=="right"){
        plotCols = ncol(mat)+1        
        plotRows = nrow(mat)
        widths=c(widths, sum(widths)*legend.ratio)
        legend <- editGrob( getGrob( lg, gPath("guide"), grep=TRUE, global=TRUE ),
                            vp= subplot(1:plotRows, plotCols) )
      } else
        stop('Only two legend position supported, that is "bottom" and "right".')
      
      # Set up the page
      grid.newpage()
      pushViewport(viewport(layout = grid.layout(plotRows, plotCols, 
                                                 widths=widths, heights=heights)))
      
      for (i in 1:nplots){
        i_loc <-matrix.index(mat,i)
        print(plots[[i]], 
              vp = vplayout(min(i_loc[1,]):max(i_loc[1,]), 
                            min(i_loc[2,]):max(i_loc[2,])))
      }
      grid.draw(legend)
    }
  }