R/facet_multiple.R

In guiastrennec/ggplus: Set of additional functions for ggplot2

#' Use \code{facet_wrap()} over multiple pages
#'
#' @description Allows \code{ggplot2} panels to be plotted over multiple pages.
#'
#' @param plot a ggplot object
#' @param facets variables to facet by
#' @param nrow number of rows
#' @param ncol number of columns
#' @param page integer to select the page to be drawn
#' @param scales should scales be fixed ("fixed", the default), free ("free"), 
#' or free in one dimension ("free_x", "free_y")
#'
#' @seealso \code{\link{facet_wrap}}, \code{\link{facet_layout}} or 
#' \code{gridExtra::marrangeGrob}
#' @examples
#' \dontrun{
#' p <- ggplot(diamonds, aes(x = price, y = carat, color = cut)) + 
#' geom_point(alpha = 0.5) + 
#' labs(x = 'Price', y = 'Carat', title = 'Diamonds')
#' 
#' facet_multiple(plot = p, facets = 'color', ncol = 2, nrow = 2)
#' }
#' @import ggplot2
#' @export
#'
facet_multiple <- function(plot = NULL, facets = NULL, ncol = 2, nrow = 2, page = NULL, scales = 'fixed') {
  
  if (is.null(plot)) {   # Check plot argument
    stop('Argument \"plot\" required')
  }
  
  if (is.null(facets)) {   # Check facets argument
    message('Argument \"facets\" not provided. Ploting single panel')
    return(plot)
  }
  
  if (!all(facets %in% colnames(plot$data))) {   # Ensure facets exists
    stop('The facet variable ', paste(facets, collapse = ', '), ' not found')
  }
  
  if (is.null(ncol) | is.null(nrow)) {   # Check ncol and nrow arguments
    stop('Arguments \"ncol\" and \"nrow\" required')
  }
  
  # Get info on layout
  n_panel_tot <- nrow(unique(plot$data[, facets, drop = FALSE]))
  n_layout    <- ncol*nrow
  n_pages     <- ceiling(n_panel_tot/n_layout)
  
  if (!is.null(page) && page > n_pages) {
    stop('Argument \"page\" > last page (p=', n_pages, ')')  
  }
  
  plot <- plot + facet_wrap(facets = facets, ncol = ncol, scales = scales)
  
  # When no multiple page needed
  if (n_pages == 1) {
    return(plot)
  }
  
  # Extract ggplot2 data and title
  data   <- plot$data
  title  <- plot$labels$title
  
  # Work with the scales
  if (!scales %in% c('free', 'free_x') &&                             # if scale fixed on x
      is.numeric(eval(plot$mapping$x, data)) &&                       # and x is numeric
      length(grep('xmax', plot$scales$scales, fixed = TRUE)) == 0) {  # and x-scale hasn't been defined in ggplot2
    plot$coordinates$limits$x <- range(eval(plot$mapping$x, data))
  }
  
  if (!scales %in% c('free', 'free_y') &&                             # if scale fixed on y
      is.numeric(eval(plot$mapping$y, data)) &&                       # and y is numeric
      length(grep('ymax', plot$scales$scales, fixed = TRUE)) == 0) {  # and y-scale hasn't been defined in ggplot2
    plot$coordinates$limits$y <- range(eval(plot$mapping$y, data))
  }
  
  # Prepare the grouping
  data$groups <- findInterval(unclass(interaction(data[,facets])),
                              seq(from = 1, by = n_layout, length.out = n_pages)[-1]) + 1
  
  # Get pages to be drawn
  if (is.null(page)) {
    draw_page <- seq_along(1:n_pages)
  } else {
    draw_page <- page
  }
  
  # Draw each pages
  for (i in draw_page) {
    plot <- plot %+% data[data$groups == i,] + 
      ggtitle(label = bquote(atop(bold(.(title)), atop(italic(Page~.(i)~of~.(n_pages))))))
    
    # For last page call facet_layout
    if (i == n_pages) {
      plot <- facet_layout(plot = plot, facets = facets, ncol = ncol, nrow = nrow, scales = scales)
    }
    
    # Print plots
    if (!is.null(plot)) {
      print(plot)
    }
  } # End for loop
  
} # End facet_multiple