ggplot utility functions

ggplot_utils.R

# Multiple plot function
#
# ggplot objects can be passed in ..., or to plotlist (as a list of ggplot objects)
# - cols:   Number of columns in layout
# - layout: A matrix specifying the layout. If present, 'cols' is ignored.
#
# If the layout is something like matrix(c(1,2,3,3), nrow=2, byrow=TRUE),
# then plot 1 will go in the upper left, 2 will go in the upper right, and
# 3 will go all the way across the bottom.
#
multiplot <- function(..., plotlist=NULL, file, cols=1, layout=NULL) {
  if (!require(grid)) stop("This function requires the R package 'grid'")

  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)

  numPlots = length(plots)

  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                    ncol = cols, nrow = ceiling(numPlots/cols))
  }

 if (numPlots==1) {
    print(plots[[1]])

  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))

    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))

      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

ggplot.matplot = function(x) {
  require(reshape2)
  x.index = cbind(index = 1:nrow(x), x)
  x.melt = melt(x.index, id.vars = 1)
  ggplot(x.melt,
         aes(x = index, y = value, color = variable)) +
    geom_line(size = 1) +
    theme_bw(base_size = 20)
}

ggplot.freqtable.1d = function(x) {
  freq = data.frame(x); colnames(freq)[1] = "label"
  freq.filtered = droplevels(subset(freq, label != "" & !is.na(label)))
  freq.filtered$label = factor(freq.filtered$label,
                               levels = as.character(freq.filtered[order(freq.filtered$Freq, decreasing = F),]$label),
                               ordered = F)
  ggplot(freq.filtered,
         aes(x = label, y = Freq, fill = label)) +
    geom_bar(stat = 'identity') +
    coord_flip() +
    theme_grey(base_size = 25)
}

ggplot.corplot = function(x, dot = .5) {
  x.melt = melt(x)
  ggplot(x.melt,
         aes(x = Var1, y = Var2)) +
    geom_tile(aes(fill = value), colour = "white") + 
    geom_point(data = subset(x.melt, value >= dot), aes(x = Var1, y = Var2), color = 'red') +
    scale_fill_gradient(low = "white", high = "steelblue") +
    theme(axis.ticks = element_blank(), axis.text.x = element_text(angle = 330, hjust = 0, colour = "grey50"))
}

facetAdjust <- function(x, pos = c("up", "down"))
{
  pos <- match.arg(pos)
  p <- ggplot_build(x)
  gtable <- ggplot_gtable(p); dev.off()
  dims <- apply(p$panel$layout[2:3], 2, max)
  nrow <- dims[1]
  ncol <- dims[2]
  panels <- sum(grepl("panel", names(gtable$grobs)))
  space <- ncol * nrow
  n <- space - panels
  if(panels != space){
    idx <- (space - ncol - n + 1):(space - ncol)
    gtable$grobs[paste0("axis_b",idx)] <- list(gtable$grobs[[paste0("axis_b",panels)]])
    if(pos == "down"){
      rows <- grep(paste0("axis_b\\-[", idx[1], "-", idx[n], "]"), 
                   gtable$layout$name)
      lastAxis <- grep(paste0("axis_b\\-", panels), gtable$layout$name)
      gtable$layout[rows, c("t","b")] <- gtable$layout[lastAxis, c("t")]
    }
  }
  class(gtable) <- c("facetAdjust", "gtable", "ggplot"); gtable
}

print.facetAdjust <- function(x, newpage = is.null(vp), vp = NULL) {
  if(newpage)
    grid.newpage()
  if(is.null(vp)){
    grid.draw(x)
  } else {
    if (is.character(vp)) 
      seekViewport(vp)
    else pushViewport(vp)
    grid.draw(x)
    upViewport()
  }
  invisible(x)
}