R/plot_grid.R

In Alik-V/heor: HEOR tools

#' Draw a text label or mathematical expression.
#'
#' This function can draw either a character string or mathematical expression at the given
#' coordinates. It works both on top of \code{ggdraw} and directly with \code{ggplot}, depending
#' on which coordinate system is desired (see examples).
#'
#' By default, the x and y coordinates specify the center of the text box. Set \code{hjust = 0, vjust = 0} to specify
#' the lower left corner, and other values of \code{hjust} and \code{vjust} for any other relative location you want to
#' specify.
#' @param label String or plotmath expression to be drawn.
#' @param x The x location (origin) of the label.
#' @param y The y location (origin) of the label.
#' @param hjust Horizontal justification. Default = 0.5 (centered on x). 0 = flush-left at x, 1 = flush-right.
#' @param vjust Vertical justification. Default = 0.5 (centered on y). 0 = baseline at y, 1 = ascender at y.
#' @param fontfamily The font family
#' @param fontface The font face ("plain", "bold", etc.)
#' @param color,colour Text color
#' @param size Point size of text
#' @param angle Angle at which text is drawn
#' @param lineheight Line height of text
#' @param alpha The alpha value of the text
#' @seealso \code{\link{ggdraw}}
#' @examples
#' library(ggplot2)
#'
#' # setup plot and a label (regression description)
#' p <- ggplot(mtcars, aes(disp, mpg)) +
#'   geom_line(color = "blue") +
#'   theme_half_open() +
#'   background_grid(minor = 'none')
#' out <- cor.test(mtcars$disp, mtcars$mpg, method = 'sp', exact = FALSE)
#' label <- substitute(
#'   paste("Spearman ", rho, " = ", estimate, ", P = ", pvalue),
#'   list(estimate = signif(out$estimate, 2), pvalue = signif(out$p.value, 2))
#' )
#'
#' # Add label to plot, centered on {x,y} (in data coordinates)
#' p + draw_label(label, x = 300, y = 32)
#' # Add label to plot in data coordinates, flush-left at x, baseline at y.
#' p + draw_label(label, x = 100, y = 30, hjust = 0, vjust = 0)
#'
#' # Add labels via ggdraw. Uses ggdraw coordinates.
#' # ggdraw coordinates default to xlim = c(0, 1), ylim = c(0, 1).
#' ggdraw(p) +
#'   draw_label("centered on 70% of x range,\n90% of y range", x = 0.7, y = 0.9)
#'
#' ggdraw(p) +
#'   draw_label("bottom left at (0, 0)", x = 0, y = 0, hjust = 0, vjust = 0) +
#'   draw_label("top right at (1, 1)", x = 1, y = 1, hjust = 1, vjust = 1) +
#'   draw_label("centered on (0.5, 0.5)", x = 0.5, y = 0.5, hjust = 0.5, vjust = 0.5)
#' @export
draw_label <- function(label, x = 0.5, y = 0.5, hjust = 0.5, vjust = 0.5,
                       fontfamily = "", fontface = "plain", color = "black", size = 14,
                       angle = 0, lineheight = 0.9, alpha = 1, colour)
{
  if (!missing(colour)) {
    color <- colour
  }

  text_par <- grid::gpar(col = color,
                         fontsize = size,
                         fontfamily = fontfamily,
                         fontface = fontface,
                         lineheight = lineheight,
                         alpha = alpha)

  # render the label
  text.grob <- grid::textGrob(label, x = grid::unit(0.5, "npc"), y = grid::unit(0.5, "npc"),
                              hjust = hjust, vjust = vjust, rot = angle, gp = text_par)
  annotation_custom(text.grob, xmin = x, xmax = x, ymin = y, ymax = y)
}

#' Draw a (sub)plot.
#'
#' Places a plot somewhere onto the drawing canvas. By default, coordinates run from
#' 0 to 1, and the point (0, 0) is in the lower left corner of the canvas.
#' @param plot The plot to place. Can be a ggplot2 plot, an arbitrary grob or gtable,
#'   or a recorded base-R plot, as in [as_grob()].
#' @param x The x location of the plot. (Left side if `hjust = 0`.)
#' @param y The y location of the plot. (Bottom side if `vjust = 0`.)
#' @param hjust Horizontal justification relative to x.
#' @param vjust Vertical justification relative to y.
#' @param width Width of the plot.
#' @param height Height of the plot.
#' @param scale Scales the grob relative to the rectangle defined by `x`, `y`, `width`, `height`. A setting
#'   of `scale = 1` indicates no scaling.
#' @examples
#' library(ggplot2)
#'
#' # make a plot
#' p <- ggplot(data.frame(x = 1:3, y = 1:3), aes(x, y)) +
#'     geom_point()
#' # draw into the top-right corner of a larger plot area
#' ggdraw() + draw_plot(p, .6, .6, .4, .4)
#' @export
draw_plot <- function(plot, x = 0, y = 0, width = 1, height = 1, scale = 1,
                      hjust = 0, vjust = 0) {
  plot <- as_grob(plot) # convert to grob if necessary
  draw_grob(
    plot, x = x, y = y, width = width, height = height,
    scale = scale, hjust = hjust, vjust = vjust
  )
}

#' Draw a line from connected points
#'
#' Provide a sequence of x values and accompanying y values to draw a line on a plot.
#'
#' This is a convenience function, providing a wrapper around ggplot2's \code{geom_path}.
#'
#' @param x Vector of x coordinates.
#' @param y Vector of y coordinates.
#' @param ... geom_path parameters such as \code{colour}, \code{alpha}, \code{size}, etc.
#' @seealso \code{\link{geom_path}}, \code{\link{ggdraw}}
#' @examples
#' ggdraw() +
#'   draw_line(
#'     x = c(0.2, 0.7, 0.7, 0.3),
#'     y = c(0.1, 0.3, 0.9, 0.8),
#'     color = "blue", size = 2
#'   )
draw_line <- function(x, y, ...){
  geom_path(data = data.frame(x, y),
            aes(x = x, y = y),
            inherit.aes = FALSE,
            ...)
}

#' Draw multiple text-strings in one go.
#'
#' This is a convenience function to plot multiple pieces of text at the same time. It cannot
#' handle mathematical expressions, though. For those, use \code{draw_label}.
#'
#' Note that font sizes are scaled by a factor of 2.85, so sizes agree with those of
#' the theme. This is different from \code{geom_text} in ggplot2.
#'
#' By default, the x and y coordinates specify the center of the text box. Set \code{hjust = 0, vjust = 0} to specify
#' the lower left corner, and other values of \code{hjust} and \code{vjust} for any other relative location you want to
#' specify.
#'
#' For a full list of ... options, see  \code{\link{geom_label}}.
#'
#' @param text A vector of Character (not expressions) specifying the string(s) to be written.
#' @param x Vector of x coordinates.
#' @param y Vector of y coordinates.
#' @param hjust (default = 0.5)
#' @param vjust (default = 0.5)
#' @param size Font size of the text to be drawn.
#' @param ... Style parameters, such as \code{colour}, \code{alpha}, \code{angle}, \code{size}, etc.
#' @seealso \code{\link{draw_label}}
#' @examples
#' # Draw onto a 1*1 drawing surface
#' ggdraw() + draw_text("Hello World!", x = 0.5, y = 0.5)
#' #
#' # Adorn a plot from the Anscombe data set of "identical" data.
#' library(ggplot2)
#'
#' p <- ggplot(anscombe, aes(x1, y1)) + geom_point() + geom_smooth()
#' three_strings <- c("Hello World!", "to be or not to be", "over and out")
#' p + draw_text(three_strings, x = 8:10, y = 5:7, hjust = 0)
draw_text <- function(text, x = 0.5, y = 0.5, size = 14, hjust = 0.5, vjust = 0.5, ...){
  geom_text(data = data.frame(text, x, y),
            aes(x = x, y = y, label = text),
            size = (size / .pt), # scale font size to match size in theme definition
            inherit.aes = FALSE,
            hjust = hjust,
            vjust = vjust,
            ...)
}


#' Draw a text label or mathematical expression.
#'
#' This function can draw either a character string or mathematical expression at the given
#' coordinates. It works both on top of \code{ggdraw} and directly with \code{ggplot}, depending
#' on which coordinate system is desired (see examples).
#'
#' By default, the x and y coordinates specify the center of the text box. Set \code{hjust = 0, vjust = 0} to specify
#' the lower left corner, and other values of \code{hjust} and \code{vjust} for any other relative location you want to
#' specify.
#' @param label String or plotmath expression to be drawn.
#' @param x The x location (origin) of the label.
#' @param y The y location (origin) of the label.
#' @param hjust Horizontal justification. Default = 0.5 (centered on x). 0 = flush-left at x, 1 = flush-right.
#' @param vjust Vertical justification. Default = 0.5 (centered on y). 0 = baseline at y, 1 = ascender at y.
#' @param fontfamily The font family
#' @param fontface The font face ("plain", "bold", etc.)
#' @param color,colour Text color
#' @param size Point size of text
#' @param angle Angle at which text is drawn
#' @param lineheight Line height of text
#' @param alpha The alpha value of the text
#' @seealso \code{\link{ggdraw}}
#' @examples
#' library(ggplot2)
#'
#' # setup plot and a label (regression description)
#' p <- ggplot(mtcars, aes(disp, mpg)) +
#'   geom_line(color = "blue") +
#'   theme_half_open() +
#'   background_grid(minor = 'none')
#' out <- cor.test(mtcars$disp, mtcars$mpg, method = 'sp', exact = FALSE)
#' label <- substitute(
#'   paste("Spearman ", rho, " = ", estimate, ", P = ", pvalue),
#'   list(estimate = signif(out$estimate, 2), pvalue = signif(out$p.value, 2))
#' )
#'
#' # Add label to plot, centered on {x,y} (in data coordinates)
#' p + draw_label(label, x = 300, y = 32)
#' # Add label to plot in data coordinates, flush-left at x, baseline at y.
#' p + draw_label(label, x = 100, y = 30, hjust = 0, vjust = 0)
#'
#' # Add labels via ggdraw. Uses ggdraw coordinates.
#' # ggdraw coordinates default to xlim = c(0, 1), ylim = c(0, 1).
#' ggdraw(p) +
#'   draw_label("centered on 70% of x range,\n90% of y range", x = 0.7, y = 0.9)
#'
#' ggdraw(p) +
#'   draw_label("bottom left at (0, 0)", x = 0, y = 0, hjust = 0, vjust = 0) +
#'   draw_label("top right at (1, 1)", x = 1, y = 1, hjust = 1, vjust = 1) +
#'   draw_label("centered on (0.5, 0.5)", x = 0.5, y = 0.5, hjust = 0.5, vjust = 0.5)
draw_label <- function(label, x = 0.5, y = 0.5, hjust = 0.5, vjust = 0.5,
                       fontfamily = "", fontface = "plain", color = "black", size = 14,
                       angle = 0, lineheight = 0.9, alpha = 1, colour)
{
  if (!missing(colour)) {
    color <- colour
  }

  text_par <- grid::gpar(col = color,
                         fontsize = size,
                         fontfamily = fontfamily,
                         fontface = fontface,
                         lineheight = lineheight,
                         alpha = alpha)

  # render the label
  text.grob <- grid::textGrob(label, x = grid::unit(0.5, "npc"), y = grid::unit(0.5, "npc"),
                              hjust = hjust, vjust = vjust, rot = angle, gp = text_par)
  annotation_custom(text.grob, xmin = x, xmax = x, ymin = y, ymax = y)
}


#' Add a label to a plot
#'
#' This function adds a plot label to the upper left corner of a graph (or an arbitrarily specified position). It takes all the same parameters
#' as \code{draw_text}, but has defaults that make it convenient to label graphs with letters A, B, C, etc. Just like \code{draw_text()},
#' it can handle vectors of labels with associated coordinates.
#' @param label String (or vector of strings) to be drawn as the label.
#' @param x The x position (or vector thereof) of the label(s).
#' @param y The y position (or vector thereof) of the label(s).
#' @param hjust Horizontal adjustment.
#' @param vjust Vertical adjustment.
#' @param size Font size of the label to be drawn.
#' @param fontface Font face of the label to be drawn.
#' @param family (optional) Font family of the plot labels. If not provided, is taken from the current theme.
#' @param color,colour (optional) Color of the plot labels. If not provided, is taken from the current theme.
#' @param ... Other arguments to be handed to \code{draw_text}.
draw_plot_label <- function(label, x = 0, y = 1, hjust = -0.5, vjust = 1.5, size = 16, fontface = 'bold',
                            family = NULL, color = NULL, colour, ...){
  if (is.null(family)) {
    family <- theme_get()$text$family
  }

  if (!missing(colour)) {
    color <- colour
  }

  if (is.null(color)) {
    color <- theme_get()$text$colour
  }

  draw_text(text = label, x = x, y = y, hjust = hjust, vjust = vjust, size = size, fontface = fontface,
            family = family, color = color, ...)
}


#' Add a label to a figure
#'
#' The main purpose of this function is to add labels specifying extra information about
#' the figure, such as "Figure 1", or "A" - often useful in cowplots with more than
#' one pane. The function is similar to \code{draw_plot_label}.
#' @param label Label to be drawn
#' @param position Position of the label, can be one of "top.left", "top", "top.right", "bottom.left", "bottom", "bottom.right". Default is "top.left"
#' @param size (optional) Size of the label to be drawn. Default is the text size of the current theme
#' @param fontface (optional) Font face of the label to be drawn. Default is the font face of the current theme
#' @param ... other arguments passed to \code{draw_plot_label}
#' @seealso \code{\link{draw_plot_label}}
#' @examples
#' library(ggplot2)
#' df <- data.frame(
#'   x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3, y4 = (1:10)^4
#' )
#'
#' p1 <- ggplot(df, aes(x, y1)) + geom_point()
#' p2 <- ggplot(df, aes(x, y2)) + geom_point()
#' p3 <- ggplot(df, aes(x, y3)) + geom_point()
#' p4 <- ggplot(df, aes(x, y4)) + geom_point()
#'
#' # Create a simple grid
#' p <- plot_grid(p1, p2, p3, p4, align = 'hv')
#'
#' # Default font size and position
#' p + draw_figure_label(label = "Figure 1")
#'
#' # Different position and font size
#' p + draw_figure_label(label = "Figure 1", position = "bottom.right", size = 10)
#'
#' # Using bold font face
#' p + draw_figure_label(label = "Figure 1", fontface = "bold")
#'
#' # Making the label red and slanted
#' p + draw_figure_label(label = "Figure 1", angle = -45, colour = "red")
#'
#' # Labeling an individual plot
#' ggdraw(p2) + draw_figure_label(label = "Figure 1", position = "bottom.right", size = 10)
draw_figure_label <- function(label, position = c("top.left", "top", "top.right", "bottom.left", "bottom", "bottom.right"), size, fontface, ...){
  # Get the position
  position <- match.arg(position)

  # Set default font size and face from the theme
  if(missing(size)){
    size <- theme_get()$text$size
  }
  if(missing(fontface)){
    fontface <- theme_get()$text$face
  }

  # Call draw_plot_label() with appropriate label positions
  switch(position,
         top.left     = draw_plot_label(label, x = 0,   y = 1, hjust = -0.1, vjust = 1.1,  size = size, fontface = fontface, ...),
         top          = draw_plot_label(label, x = 0.5, y = 1, hjust = 0,    vjust = 1.1,  size = size, fontface = fontface, ...),
         top.right    = draw_plot_label(label, x = 1,   y = 1, hjust = 1.1,  vjust = 1.1,  size = size, fontface = fontface, ...),
         bottom.left  = draw_plot_label(label, x = 0,   y = 0, hjust = -0.1, vjust = -0.1, size = size, fontface = fontface, ...),
         bottom       = draw_plot_label(label, x = 0.5, y = 0, hjust = 0,    vjust = -0.1, size = size, fontface = fontface, ...),
         bottom.right = draw_plot_label(label, x = 1,   y = 0, hjust = 1.1,  vjust = -0.1, size = size, fontface = fontface, ...)
  )
}
#' Draw an image
#'
#' Places an image somewhere onto the drawing canvas. By default, coordinates run from
#' 0 to 1, and the point (0, 0) is in the lower left corner of the canvas. Requires the `magick`
#' package to work, and fails gracefully if that package is not installed.
#' @param image The image to place. Can be a file path, a URL, or a raw vector with image data,
#'  as in `magick::image_read()`. Can also be an image previously created by `magick::image_read()` and
#'  related functions.
#' @param x The x location of the image. (Left side if `hjust = 0`.)
#' @param y The y location of the image. (Bottom side if `vjust = 0`.)
#' @param hjust Horizontal justification relative to x.
#' @param vjust Vertical justification relative to y.
#' @param width Width of the image.
#' @param height Height of the image.
#' @param scale Scales the image relative to the rectangle defined by `x`, `y`, `width`, `height`. A setting
#'   of `scale = 1` indicates no scaling.
#' @param clip Set to "on" to clip the image relative to the box into which it is draw (useful for `scale > 1`).
#'   Note that clipping doesn't always work as expected, due to limitations of the grid graphics system.
#' @param interpolate A logical value indicating whether to linearly interpolate the image
#'  (the alternative is to use nearest-neighbour interpolation, which gives a more blocky result).
#' @examples
#' library(ggplot2)
#'
#' # Use image as plot background
#' p <- ggplot(iris, aes(x = Sepal.Length, fill = Species)) +
#'   geom_density(alpha = 0.7) +
#'   scale_y_continuous(expand = expand_scale(mult = c(0, 0.05))) +
#'   theme_half_open(12)
#'
#' logo_file <- system.file("extdata", "logo.png", package = "cowplot")
#' ggdraw() +
#'   draw_image(logo_file, scale = .7) +
#'   draw_plot(p)
#'
#' # Make grid with plot and image
#'
#' cow_file <- system.file("extdata", "cow.jpg", package = "cowplot")
#' p2 <- ggdraw() + draw_image(cow_file, scale = 0.9)
#' plot_grid(
#'   p + theme(legend.position = c(1, 1), legend.justification = c(1, 1)),
#'   p2,
#'   labels = "AUTO"
#' )
#'
#' # Manipulate images and draw in plot coordinates
#' if (requireNamespace("magick", quietly = TRUE)){
#'   img <- magick::image_transparent(
#'     magick::image_read(logo_file),
#'     color = "white"
#'   )
#'   img2 <- magick::image_negate(img)
#'   ggplot(data.frame(x = 1:3, y = 1:3), aes(x, y)) +
#'     geom_point(size = 3) +
#'     geom_abline(slope = 1, intercept = 0, linetype = 2, color = "blue") +
#'     draw_image(img , x = 1, y = 1, scale = .9) +
#'     draw_image(img2, x = 2, y = 2, scale = .9)
#' }
draw_image <- function(image, x = 0, y = 0, width = 1, height = 1, scale = 1, clip = "inherit",
                       interpolate = TRUE, hjust = 0, vjust = 0) {
  if (!requireNamespace("magick", quietly = TRUE)){
    warning("Package `magick` is required to draw images. Image not drawn.", call. = FALSE)
    draw_grob(grid::nullGrob(), x, y, width, height)
  }
  else {
    # if we're given an image, we just use it
    if (methods::is(image, "magick-image")) {
      image_data <- image
    }
    # otherwise we read it in with image_read()
    else {
      image_data <- magick::image_read(image)
    }
    g <- grid::rasterGrob(image_data, interpolate = interpolate)
    draw_grob(
      g, x = x, y = y, width = width, height = height,
      hjust = hjust, vjust = vjust, scale = scale,
      clip = clip
    )
  }
}

#' Draw a (sub)plot.
#'
#' Places a plot somewhere onto the drawing canvas. By default, coordinates run from
#' 0 to 1, and the point (0, 0) is in the lower left corner of the canvas.
#' @param plot The plot to place. Can be a ggplot2 plot, an arbitrary grob or gtable,
#'   or a recorded base-R plot, as in [as_grob()].
#' @param x The x location of the plot. (Left side if `hjust = 0`.)
#' @param y The y location of the plot. (Bottom side if `vjust = 0`.)
#' @param hjust Horizontal justification relative to x.
#' @param vjust Vertical justification relative to y.
#' @param width Width of the plot.
#' @param height Height of the plot.
#' @param scale Scales the grob relative to the rectangle defined by `x`, `y`, `width`, `height`. A setting
#'   of `scale = 1` indicates no scaling.
#' @examples
#' library(ggplot2)
#'
#' # make a plot
#' p <- ggplot(data.frame(x = 1:3, y = 1:3), aes(x, y)) +
#'     geom_point()
#' # draw into the top-right corner of a larger plot area
#' ggdraw() + draw_plot(p, .6, .6, .4, .4)
draw_plot <- function(plot, x = 0, y = 0, width = 1, height = 1, scale = 1,
                      hjust = 0, vjust = 0) {
  plot <- as_grob(plot) # convert to grob if necessary
  draw_grob(
    plot, x = x, y = y, width = width, height = height,
    scale = scale, hjust = hjust, vjust = vjust
  )
}

#' Draw a grob.
#'
#' Places an arbitrary grob somewhere onto the drawing canvas. By default, coordinates run from
#' 0 to 1, and the point (0, 0) is in the lower left corner of the canvas.
#' @param grob The grob to place.
#' @param x The x location of the grob. (Left side if `hjust = 0`.)
#' @param y The y location of the grob. (Bottom side if `vjust = 0`.)
#' @param hjust Horizontal justification relative to x.
#' @param vjust Vertical justification relative to y.
#' @param width Width of the grob.
#' @param height Height of the grob.
#' @param scale Scales the grob relative to the rectangle defined by `x`, `y`, `width`, `height`. A setting
#'   of `scale = 1` indicates no scaling.
#' @param clip Set to "on" to clip the grob or "inherit" to not clip. Note that clipping doesn't always work as
#'   expected, due to limitations of the grid graphics system.
#' @examples
#' # A grid grob (here a blue circle)
#' g <- grid::circleGrob(gp = grid::gpar(fill = "blue"))
#' # place into the middle of the plotting area, at a scale of 50%
#' ggdraw() + draw_grob(g, scale = 0.5)
draw_grob <- function(grob, x = 0, y = 0, width = 1, height = 1, scale = 1, clip = "inherit",
                      hjust = 0, vjust = 0) {
  layer(
    data = data.frame(x = NA),
    stat = StatIdentity,
    position = PositionIdentity,
    geom = GeomDrawGrob,
    inherit.aes = FALSE,
    params = list(
      grob = grob,
      xmin = x - hjust*width,
      xmax = x + (1-hjust)*width,
      ymin = y - vjust*height,
      ymax = y + (1-vjust)*height,
      scale = scale,
      clip = clip
    )
  )
}

#' @rdname draw_grob
#' @format NULL
#' @usage NULL
#' @importFrom ggplot2 ggproto GeomCustomAnn

GeomDrawGrob <- ggproto("GeomDrawGrob", GeomCustomAnn,
                        draw_panel = function(self, data, panel_params, coord, grob, xmin, xmax, ymin, ymax, scale = 1, clip = "inherit") {
                          if (!inherits(coord, "CoordCartesian")) {
                            stop("draw_grob only works with Cartesian coordinates",
                                 call. = FALSE)
                          }
                          corners <- data.frame(x = c(xmin, xmax), y = c(ymin, ymax))
                          data <- coord$transform(corners, panel_params)

                          x_rng <- range(data$x, na.rm = TRUE)
                          y_rng <- range(data$y, na.rm = TRUE)

                          # set up inner and outer viewport for clipping. Unfortunately,
                          # clipping doesn't work properly most of the time, due to
                          # grid limitations
                          vp_outer <- grid::viewport(x = mean(x_rng), y = mean(y_rng),
                                                     width = diff(x_rng), height = diff(y_rng),
                                                     just = c("center", "center"),
                                                     clip = clip)

                          vp_inner <- grid::viewport(width = scale, height = scale,
                                                     just = c("center", "center"))

                          id <- annotation_id()
                          inner_grob <- grid::grobTree(grob, vp = vp_inner, name = paste(grob$name, id))
                          grid::grobTree(inner_grob, vp = vp_outer, name = paste("GeomDrawGrob", id))
                        }
)

annotation_id <- local({
  i <- 1
  function() {
    i <<- i + 1
    i
  }
})


#' Set up a drawing layer on top of a ggplot
#'
#' Set up a drawing layer on top of a ggplot.
#' @param plot The plot to use as a starting point. Can be a ggplot2 plot, an arbitrary
#'   grob or gtable, or a recorded base-R plot, as in [as_grob()].
#' @param xlim The x-axis limits for the drawing layer.
#' @param ylim The y-axis limits for the drawing layer.
#' @param clip Should drawing be clipped to the set limits? The default is no ("off").
#' @examples
#' library(ggplot2)
#'
#' p <- ggplot(mpg, aes(displ, cty)) +
#'   geom_point() +
#'   theme_minimal_grid()
#' ggdraw(p) + draw_label("Draft", colour = "#80404080", size = 120, angle = 45)
#' @export
ggdraw <- function(plot = NULL, xlim = c(0, 1), ylim = c(0, 1), clip = "off") {
  p <- ggplot() + # empty plot
    coord_cartesian(xlim = xlim, ylim = ylim, expand = FALSE, clip = clip) +
    scale_x_continuous(name = NULL) +
    scale_y_continuous(name = NULL) +
    theme_void()

  if (!is.null(plot)){
    p <- p + draw_plot(plot)
  }
  p # return ggplot drawing layer
}


#' Sets the null graphics device
#'
#' The function [as_grob()] needs to open a graphics device to render ggplot objects into
#' grid graphics objects. Unfortunately, there is no universally reliable graphics device available
#' in R that always works. Therefore, this function allows you to switch out the null device.
#'
#' You need to be aware that some graphics devices cause side effects when used as null devices.
#' If you use an interactive device as null device, you may see an empty plot window pop up. Similarly,
#' if you use a graphics device that writes a file, then you may find temporary files associated
#' with the device. The default null device, `pdf(NULL)`, does not cause these side effects. However, it has
#' has other limitations. For example, on OS X, it cannot use all the fonts that are available on the
#' system. The png device can use all fonts, but it will create temporary files.
#'
#' @param null_device Either a string that defines the null device ("pdf", "png", "cairo") or a function
#'   that returns a new graphics device.
#'
#' @examples
#' set_null_device("png") # set the png null device
#'
#' # create a jpeg null device
#' jpeg_null_device <- function(width, height) {
#'   jpeg(
#'     filename = tempfile(pattern = "jpeg_null_plot", fileext = ".jpg"),
#'     width = width, height = height, units = "in", res = 96
#'    )
#'   dev.control("enable")
#'}
#' set_null_device(jpeg_null_device)
#' @seealso
#' Available null devices are: [`pdf_null_device()`], [`png_null_device()`], [`cairo_null_device()`]
# @export
set_null_device <- function(null_device) {
  old <- null_dev_env$current

  if (methods::is(null_device, "function")) {
    null_dev_env$current <- null_device
  } else {
    null_dev_env$current <- switch(null_device,
                                   pdf = pdf_null_device,
                                   png = png_null_device,
                                   cairo = cairo_null_device,
                                   Cairo = cairo_null_device,
                                   {
                                     warning("Null device ", null_device, " not recognized. Substituting grDevices::pdf().", call. = FALSE);
                                     pdf_null_device
                                   }
    )
  }

  invisible(old)
}


#' Null devices
#'
#' Null devices to be used when rendering graphics in the background. See
#' [`set_null_device()`] for details.
#'
#' @param width Device width in inch
#' @param height Device height in inch
# @export
png_null_device <- function(width, height) {
  grDevices::png(
    filename = tempfile(pattern = "cowplot_null_plot", fileext = ".png"),
    width = width, height = height,
    units = "in", res = 96
  )
  grDevices::dev.control("enable")
}

#' @rdname png_null_device
# @export
pdf_null_device <- function(width, height) {
  grDevices::pdf(NULL, width = width, height = height)
  grDevices::dev.control("enable")
}

#' @rdname png_null_device
# @export
cairo_null_device <- function(width, height) {
  if (requireNamespace("Cairo", quietly = TRUE)) {
    Cairo::Cairo(
      type = "raster",
      width = width, height = height,
      units = "in"
    )
    grDevices::dev.control("enable")
  } else {
    warning("Package `Cairo` is required to use the Cairo null device. Substituting grDevices::pdf(NULL).", call. = FALSE)
    pdf_null_device(width, height)
  }
}

# the null device is stored in an environment
# default upon start up is pdf null device
null_dev_env <- new.env(parent = emptyenv())
null_dev_env$current <- pdf_null_device

#' Convert a base plot or a ggplot2 plot into a grob
#'
#' This function does its best attempt to take whatever you provide it and turn it into a grob.
#' It is primarily meant to convert ggplot plots into grobs, but it will also take any grid
#' object (grob), a recorded base R plot, a formula specifying a base R plot, a function that
#' generates a base R plot, or a trellis object.
#'
#' @param plot The plot to convert
#' @param device A function that creates an appropriate null device. See [`set_null_device()`]
#'   for details. If set to `NULL`, will use the cowplot-wide default.
#'
#' @examples
#' library(grid)
#' x <- 1:10
#' y <- (1:10)^2
#'
#' p <- ~plot(x, y)
#' grid.newpage()
#' grid.draw(as_grob(p))
# @export
as_grob <- function(plot, device = NULL) {
  UseMethod("as_grob")
}

# @export
as_grob.recordedplot <- function(plot, device = NULL) {
  if (!requireNamespace("gridGraphics", quietly = TRUE)){
    warning("Package `gridGraphics` is required to handle base-R plots. Substituting empty plot.", call. = FALSE)
    grid::nullGrob()
  }
  else {
    if (is.null(device)) {
      device <- null_dev_env$current
    }
    gridGraphics::echoGrob(plot, device = device)
  }
}

# @export
as_grob.trellis <- function(plot, device = NULL) {
  if (is.null(device)) {
    device <- null_dev_env$current
  }
  grid::recordGrob(
    tryCatch(
      print(plot, newpage=FALSE),
      error = function(e) {
        grid::grid.text(e$message)
      }
    ), list(plot = plot, device = device))
}

# @export
as_grob.function <- function(plot, device = NULL) {
  # functions are handled just like recorded plots:
  as_grob.recordedplot(plot, device)
}

# @export
as_grob.formula <- function(plot, device = NULL) {
  expr <- plot[[2]]
  env <- parent.frame()
  f <- function() {eval(expr, envir = env)}

  # functions are handled just like recorded plots:
  as_grob.recordedplot(f, device)
}

# @export
as_grob.grob <- function(plot, device = NULL) {
  # grobs don't have to be converted
  plot
}

# @export
as_grob.gList <- function(plot, device = NULL) {
  # gLists need to be wrapped in a grob tree
  grid::grobTree(plot)
}

# @export
as_grob.ggplot <- function(plot, device = NULL) {
  # Convert ggplot plot to grob
  #
  # To be safe this works as expected, we have to do some graphics-device gymnastics.
  # We need to save and restore the current graphics device, and we also need to open
  # a null device. If we don't do this, things may go wrong, in particular in R Studio
  # or shiny, such as plots popping up in the wrong location or spurious empty plots
  # appearing in knitr. Also, depending on which null device we choose, non-standard
  # fonts may or may not work. Different null devices work best in different environments,
  # that's why the null device is configurable. (`pdf(NULL)` is the most robust but
  # can't handle all fonts, `png()` works well on OS X but creates spurious output files,
  # `Cairo(type = "raster")` works well on Windows but font-handling is broken on OS X.)

  if (is.null(device)) {
    device <- null_dev_env$current
  }

  cur_dev <- grDevices::dev.cur()   # store current device
  device(width = 6, height = 6)     # open null device
  null_dev <- grDevices::dev.cur()  # store null device

  # make sure we always clean up properly, even if something causes an error
  on.exit({
    grDevices::dev.off(null_dev)
    if (cur_dev > 1) grDevices::dev.set(cur_dev) # only set cur device if not null device
  })

  ggplot2::ggplotGrob(plot)  # convert plot to grob
}

# comment out until patchwork is officially released and on CRAN
# @export
as_grob.patchwork <- function(plot, device = NULL) {
  if (!requireNamespace("patchwork", quietly = TRUE)){
    warning("Package `patchwork` is required to handle object of class patchwork. Substituting empty plot.", call. = FALSE)
    return(grid::nullGrob())
  }

  # Convert patchwork ggassemble to grob
  #
  # To be safe this works as expected, we have to do some graphics-device gymnastics.
  # We need to save and restore the current graphics device, and we also need to open
  # a null device. If we don't do this, things may go wrong, in particular in R Studio
  # or shiny, such as plots popping up in the wrong location or spurious empty plots
  # appearing in knitr. Also, depending on which null device we choose, non-standard
  # fonts may or may not work. Different null devices work best in different environments,
  # that's why the null device is configurable. (`pdf(NULL)` is the most robust but
  # can't handle all fonts, `png()` works well on OS X but creates spurious output files,
  # `Cairo(type = "raster")` works well on Windows but font-handling is broken on OS X.)

  if (is.null(device)) {
    device <- null_dev_env$current
  }

  cur_dev <- grDevices::dev.cur()   # store current device
  device(width = 6, height = 6)     # open null device
  null_dev <- grDevices::dev.cur()  # store null device

  # make sure we always clean up properly, even if something causes an error
  on.exit({
    grDevices::dev.off(null_dev)
    if (cur_dev > 1) grDevices::dev.set(cur_dev) # only set cur device if not null device
  })

  patchwork::patchworkGrob(plot)    # convert plot to grob
}


# @export
as_grob.default <- function(plot, device = NULL) {
  warning("Cannot convert object of class ", class(plot), " into a grob.")
  grid::nullGrob()
}




#' Convert plot or other graphics object into a gtable
#'
#' This function does its best attempt to take whatever you provide it and turn it into a gtable.
#' It is primarily meant to convert ggplot plots into gtables, but it will also take any grid
#' object (grob), a recorded R base plot, or a function that generates an R base plot.
#'
#' To convert ggplot plots, the function needs to use a null graphics device. This can be set
#' with [set_null_device()].
#'
#' @param plot The plot or other graphics object to convert into a gtable. Here, `plot` can be
#'   any object handled by [`as_grob()`].
# @export
as_gtable <- function(plot) {
  UseMethod("as_gtable")
}

# @export
as_gtable.gtable <- function(plot) {
  # gtables don't have to be converted
  plot
}

# @export
as_gtable.grob <- function(plot) {
  # we can handle basic grobs of any kind by wrapping them into a gtable
  u <- grid::unit(1, "null")
  gt <- gtable::gtable_col(NULL, list(plot), u, u)
  # fix gtable clip setting
  gt$layout$clip <- "inherit"
  gt
}

# @export
as_gtable.default <- function(plot) {
  # hope that as_grob() function can produce a grob
  grob <- as_grob(plot)
  as_gtable(grob)
}

#' @rdname as_gtable
# @export
plot_to_gtable <- function(plot) {
  # this version is deprecated
  UseMethod("as_gtable")
}



#' Align multiple plots along a specified margin
#'
#' The function aligns the dimensions of multiple plots along a specified axis, and is solely a helper function
#' for [align_plots()] to reduce redundancy. Each element of the \code{sizes}
#' list corresponds to the dimensions of a plot being aligned. They should be vectors created from calls to
#' \code{grob$heights} or \code{grob$widths} depending on whether you are aligning vertically or horizontally.
#' The list of dimensions is generated automatically by the [align_plots()] function, but see examples.
#' If the same number of elements exist for all plots for the specified
#' margin, the function will align individual elements on the margin. Otherwise, it aligns the plot by adding
#' white space to plot margins so that all margins have the same dimensions.
#'
#' @param sizes list of dimensions for each plot being aligned. Each element of list
#'  obtained by a call to \code{grob$heights} or \code{grob$widths} (see example).
#' @param margin_to_align string either "first" or "last" for which part of plot area should be aligned.
#'  If vertically aligning, "first" aligns left margin and "last" aligns right margin. If horizontally aligning
#'  "first" aligns top margin and "last" aligns bottom margin.
#' @param greedy if `TRUE`, alignment is always achieved by adjusting the most extreme
#'   margin; if `FALSE`, and the number of dimensions for each plot are the same, then
#'   all dimensions are jointly adjusted.
#' @examples
#' library(ggplot2)
#'
#' # Example for how to utilize, though align_plots() does this internally and automatically
#' df <- data.frame(
#'   x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3
#' )
#'
#' p1 <- ggplot(df, aes(x, y1)) + geom_point()
#' p2 <- ggplot(df, aes(x, y2)) + geom_point()
#' p3 <- ggplot(df, aes(x, y3)) + geom_point()
#' plots <- list(p1, p2, p3)
#' grobs <- lapply(plots, as_grob)
#' plot_widths <- lapply(grobs, function(x) {x$widths})
#' # Aligning the left margins of all plots
#' aligned_widths <- align_margin(plot_widths, "first")
#' # Aligning the right margins of all plots as well
#' aligned_widths <- align_margin(aligned_widths, "last")
#' # Setting the dimensions of plots to the aligned dimensions
#' for (i in seq_along(plots)) {
#'   grobs[[i]]$widths <- aligned_widths[[i]]
#' }
#' # Draw aligned plots
#' plot_grid(plotlist = grobs, ncol = 1)
#' @keywords internal
# @export
align_margin <- function(sizes, margin_to_align, greedy = TRUE) {

  # finds the indices being aligned for each of the plots
  # "first" aligns all lengths up to but excluding the first "null"; "last" aligns all lengths past the first "null"
  list_indices <- switch(
    margin_to_align,
    first = lapply(sizes, function(x) 1:(grep("null", x)[1] - 1)),
    last = lapply(sizes, function(x) (grep("null", x)[length(grep("null", x))] + 1):length(x)),
    stop("Invalid margin input, should be either 'first' or 'last'")
  )

  # Either 1 or length of the sizes for each plot, but used for flexible case handling
  extreme_margin <- switch(
    margin_to_align,
    first = lapply(sizes, function(x) 1),
    last = lapply(sizes, function(x) length(x))
  )

  grob_seq <- seq_along(list_indices)
  num <- unique(unlist(lapply(list_indices, function(x) length(x))))
  num[num == 0] <- NULL # remove entry for missing graphs

  if (greedy || length(num) > 1) { # Align if different number of items in margin
    margins <- lapply(grob_seq, function(x) {sum(sizes[[x]][list_indices[[x]] ])})
    largest_margin <- max(do.call(grid::unit.c, margins))
    # For each grob, make the size of the extreme margin equal to the largest margin minus the sum of the remaining margins
    lapply(
      grob_seq,
      function(x) {
        sizes[[x]][extreme_margin[[x]] ] <-
          largest_margin - sum(sizes[[x]][list_indices[[x]][which(list_indices[[x]] != extreme_margin[[x]])] ])
        sizes[[x]]
      }
    )
  } else{ # If margins have same number of items, then make all the same length
    max_margins <- do.call(grid::unit.pmax, lapply(grob_seq, function(x) sizes[[x]][list_indices[[x]] ]))
    lapply(
      grob_seq,
      function(x) {
        sizes[[x]][list_indices[[x]] ] <- max_margins
        sizes[[x]]
      }
    )
  }
}


#' Align multiple plots vertically and/or horizontally
#'
#' Align the plot area of multiple plots. Inputs are a list of plots plus alignment parameters.
#' Horizontal or vertical alignment or both are possible. In the simplest case the function will align all
#' elements of each plot, but it can handle more complex cases as long as the axis parameter is defined. In this case,
#' alignment is done through a call to [align_margin()]. The function `align_plots` is called by the [plot_grid()] function
#' and is usually not called directly, though direct calling of the function is useful if plots with
#' multiple y-axes are desired (see example).
#'
#' @param ... List of plots to be aligned.
#' @param plotlist (optional) List of plots to display. Alternatively, the plots can be provided
#'  individually as the first n arguments of the function align_plots (see plot_grid examples).
#' @param align (optional) Specifies whether graphs in the grid should be horizontally ("h") or
#'  vertically ("v") aligned. Options are \code{align="none"} (default), "hv" (align in both directions), "h", and "v".
#' @param axis (optional) Specifies whether graphs should be aligned by the left ("l"), right ("r"), top ("t"), or bottom ("b")
#'  margins. Options are \code{axis="none"} (default), or a string of any combination of "l", "r", "t", and/or "b" in any order
#'  (e.g. \code{axis="tblr"} or \code{axis="rlbt"} for aligning all margins)
#' @param greedy (optional) Defines the alignment policy when alignment axes are specified via the
#'  `axis` option. `greedy = TRUE` tries to always align by adjusting the outmost margin. `greedy = FALSE`
#'  aligns all columns/rows in the gtable if possible.
#' @examples
#' library(ggplot2)
#'
#' p1 <- ggplot(mpg, aes(manufacturer, hwy)) + stat_summary(fun.y="median", geom = "bar") +
#'   theme_half_open() +
#'   theme(axis.text.x = element_text(angle = 45, hjust = 1, vjust= 1))
#' p2 <- ggplot(mpg, aes(manufacturer, displ)) + geom_point(color="red") +
#'   scale_y_continuous(position = "right") +
#'   theme_half_open() + theme(axis.text.x = element_blank())
#'
#' # manually align and plot on top of each other
#' aligned_plots <- align_plots(p1, p2, align="hv", axis="tblr")
#'
#' # Note: In most cases two y-axes should not be used, but this example
#' # illustrates how one could accomplish it.
#' ggdraw(aligned_plots[[1]]) + draw_plot(aligned_plots[[2]])
#' @export
align_plots <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"),
                        axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"),
                        greedy = TRUE){
  # browser()
  plots <- c(list(...), plotlist)
  num_plots <- length(plots)

  # convert list of plots into list of grobs / gtables
  grobs <- lapply(plots, function(x) {if (!is.null(x)) as_gtable(x) else NULL})

  #aligning graphs.
  halign <- switch(
    align[1],
    h = TRUE,
    vh = TRUE,
    hv = TRUE,
    FALSE
  )
  valign <- switch(
    align[1],
    v = TRUE,
    vh = TRUE,
    hv = TRUE,
    FALSE
  )

  vcomplex_align <- hcomplex_align <- FALSE
  # calculate the maximum widths and heights over all graphs, and find out whether
  # they can be aligned if necessary
  if (valign) {
    num_widths <- unique(lapply(grobs, function(x) {length(x$widths)})) # count number of unique lengths
    num_widths[num_widths == 0] <- NULL # remove entry for missing graphs
    if (length(num_widths) > 1 || length(grep("l|r", axis[1])) > 0) {
      # Complex aligns are ones that don't have the same number of elements that have sizes
      # or for which explicit axis alignment is requested
      vcomplex_align = TRUE
      if(axis[1] == "none") {
        warning(
          "Graphs cannot be vertically aligned unless the axis parameter is set. Placing graphs unaligned.",
          call. = FALSE
        )
        valign <- FALSE
      }

      max_widths <- lapply(grobs, function(x) {x$widths})
      #
      # Aligning the Left margins
      if (length(grep("l", axis[1])) > 0) {
        max_widths <- align_margin(max_widths, "first", greedy = greedy)
      }
      if (length(grep("r", axis[1])) > 0) {
        max_widths <- align_margin(max_widths, "last", greedy = greedy)
      }
    } else {
      max_widths <- list(do.call(grid::unit.pmax, lapply(grobs, function(x){x$widths})))
    }
  }

  if (halign) {
    num_heights <- unique(lapply(grobs, function(x) {length(x$heights)})) # count number of unique lengths
    num_heights[num_heights == 0] <- NULL # remove entry for missing graphs
    if (length(num_heights) > 1 || length(grep("t|b", axis[1])) > 0) {
      # Complex aligns are ones that don't have the same number of elements that have sizes
      # or for which explicit axis alignment is requested
      hcomplex_align = TRUE
      if (axis[1] == "none"){
        warning(
          "Graphs cannot be horizontally aligned unless the axis parameter is set. Placing graphs unaligned.",
          call. = FALSE
        )
        halign <- FALSE
      }

      max_heights <- lapply(grobs, function(x) {x$heights})

      if (length(grep("t", axis[1])) > 0) {
        max_heights <- align_margin(max_heights, "first", greedy = greedy)
      }
      if (length(grep("b", axis[1])) > 0) {
        max_heights <- align_margin(max_heights, "last", greedy = greedy)
      }

    } else {
      max_heights <- list(do.call(grid::unit.pmax, lapply(grobs, function(x){x$heights})))
    }
  }

  # now assign to all graphs
  for (i in 1:num_plots) {
    if (!is.null(grobs[[i]])) {
      if (valign) {
        if(vcomplex_align) {
          grobs[[i]]$widths <- max_widths[[i]]
        } else{
          grobs[[i]]$widths <- max_widths[[1]]
        }
      }
      if (halign) {
        if(hcomplex_align){
          grobs[[i]]$heights <- max_heights[[i]]
        } else{
          grobs[[i]]$heights <- max_heights[[1]]
        }
      }
    }
  }
  grobs
}





#' Arrange multiple plots into a grid
#'
#' Arrange multiple plots into a grid. Taken from cowplot.
#' @param ... List of plots to be arranged into the grid. The plots can be any objects that
#'   the function [as_gtable()] can handle (see also examples).
#' @param plotlist (optional) List of plots to display. Alternatively, the plots can be provided
#' individually as the first n arguments of the function plot_grid (see examples).
#' @param align (optional) Specifies whether graphs in the grid should be horizontally ("h") or
#'  vertically ("v") aligned. Options are "none" (default), "hv" (align in both directions), "h", and "v".
#' @param axis (optional) Specifies whether graphs should be aligned by the left ("l"), right ("r"), top ("t"), or bottom ("b")
#'  margins. Options are "none" (default), or a string of any combination of l, r, t, and b in any order (e.g. "tblr" or "rlbt" for aligning all margins).
#'  Must be specified if any of the graphs are complex (e.g. faceted) and alignment is specified and desired. See [align_plots()] for details.
#' @param greedy (optional) How should margins be adjusted during alignment. See [align_plots()] for details.
#' @param nrow (optional) Number of rows in the plot grid.
#' @param ncol (optional) Number of columns in the plot grid.
#' @param rel_widths (optional) Numerical vector of relative columns widths. For example, in a two-column
#'              grid, \code{rel_widths = c(2, 1)} would make the first column twice as wide as the
#'              second column.
#' @param rel_heights (optional) Numerical vector of relative rows heights. Works just as
#'              \code{rel_widths} does, but for rows rather than columns.
#' @param labels (optional) List of labels to be added to the plots. You can also set \code{labels="AUTO"} to
#'              auto-generate upper-case labels or \code{labels="auto"} to auto-generate lower-case labels.
#' @param label_size (optional) Numerical value indicating the label size. Default is 14.
#' @param label_fontfamily (optional) Font family of the plot labels. If not provided, is taken from the current theme.
#' @param label_fontface (optional) Font face of the plot labels. Default is "bold".
#' @param label_colour (optional) Color of the plot labels. If not provided, is taken from the current theme.
#' @param label_x (optional) Single value or vector of x positions for plot labels, relative to each subplot.
#'   Defaults to 0 for all labels. (Each label is placed all the way to the left of each plot.)
#' @param label_y (optional) Single value or vector of y positions for plot labels, relative to each subplot.
#'   Defaults to 1 for all labels. (Each label is placed all the way to the top of each plot.)
#' @param hjust Adjusts the horizontal position of each label. More negative values move the label further
#'   to the right on the plot canvas. Can be a single value (applied to all labels) or a vector of values
#'   (one for each label). Default is -0.5.
#' @param vjust Adjusts the vertical position of each label. More positive values move the label further
#'   down on the plot canvas. Can be a single value (applied to all labels) or a vector of values
#'   (one for each label). Default is 1.5.
#' @param scale Individual number or vector of numbers greater than 0. Enables you to scale the size of all or
#'   select plots. Usually it's preferable to set margins instead of using `scale`, but `scale` can
#'   sometimes be more powerful.
#' @examples
#' library(ggplot2)
#'
#' df <- data.frame(
#'   x = 1:10, y1 = 1:10, y2 = (1:10)^2, y3 = (1:10)^3, y4 = (1:10)^4
#' )
#'
#' p1 <- ggplot(df, aes(x, y1)) + geom_point()
#' p2 <- ggplot(df, aes(x, y2)) + geom_point()
#' p3 <- ggplot(df, aes(x, y3)) + geom_point()
#' p4 <- ggplot(df, aes(x, y4)) + geom_point()
#' p5 <- ggplot(mpg, aes(as.factor(year), hwy)) +
#'         geom_boxplot() +
#'         facet_wrap(~class, scales = "free_y")
#' # simple grid
#' plot_grid(p1, p2, p3, p4)
#'
#' # simple grid with labels and aligned plots
#' plot_grid(
#'   p1, p2, p3, p4,
#'   labels = c('A', 'B', 'C', 'D'),
#'   align="hv"
#' )
#'
#' # manually setting the number of rows, auto-generate upper-case labels
#' plot_grid(p1, p2, p3,
#'   nrow = 3,
#'   labels = "AUTO",
#'   label_size = 12,
#'   align = "v"
#' )
#'
#' # making rows and columns of different widths/heights
#' plot_grid(
#'   p1, p2, p3, p4,
#'   align = 'hv',
#'   rel_heights = c(2,1),
#'   rel_widths = c(1,2)
#' )
#'
#' # aligning complex plots in a grid
#' plot_grid(
#'   p1, p5,
#'   align = "h", axis = "b", nrow = 1, rel_widths = c(1, 2)
#' )
#'
#' # more examples
#' \donttest{
#' #' # missing plots in some grid locations, auto-generate lower-case labels
#' plot_grid(
#'  p1, NULL, NULL, p2, p3, NULL,
#'  ncol = 2,
#'  labels = "auto",
#'  label_size = 12,
#'  align = "v"
#' )
#'
#' # can align top of plotting area as well as bottom
#' plot_grid(
#'   p1, p5,
#'   align = "h", axis = "tb",
#'   nrow = 1, rel_widths = c(1, 2)
#' )
#'
#' # other types of plots not generated with ggplot
#' p6 <- ~{
#'   par(
#'     mar = c(3, 3, 1, 1),
#'     mgp = c(2, 1, 0)
#'   )
#'   plot(sqrt)
#' }
#'
#' p7 <- function() {
#'   par(
#'     mar = c(2, 2, 1, 1),
#'     mgp = c(2, 1, 0)
#'   )
#'   image(volcano)
#' }
#' p8 <- grid::circleGrob()
#'
#' plot_grid(p1, p6, p7, p8, labels = "AUTO", scale = c(1, .9, .9, .7))
#' }
#' @export
plot_grid <- function(..., plotlist = NULL, align = c("none", "h", "v", "hv"),
                      axis = c("none", "l", "r", "t", "b", "lr", "tb", "tblr"),
                      nrow = NULL, ncol = NULL, rel_widths = 1,
                      rel_heights = 1, labels = NULL, label_size = 14,
                      label_fontfamily = NULL, label_fontface = "bold", label_colour = NULL,
                      label_x = 0, label_y = 1,
                      hjust = -0.5, vjust = 1.5, scale = 1., greedy = TRUE,
                      cols = NULL, rows = NULL ) {

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

  if (!is.null(cols)){
    warning("Argument 'cols' is deprecated. Use 'ncol' instead.")
  }

  if (!is.null(rows)){
    warning("Argument 'rows' is deprecated. Use 'nrow' instead.")
  }

  scale <- rep_len(scale, num_plots)
  if (sum(scale <= 0) > 1){
    stop("Argument 'scale' needs to be greater than 0.")
  }

  # internally, this function operates with variables cols and rows instead of ncol and nrow
  if (!is.null(ncol)){
    cols <- ncol
  }
  if (!is.null(nrow)){
    rows <- nrow
  }

  # Align the plots (if specified)
  grobs <- align_plots(plotlist = plots, align = align, axis = axis, greedy = greedy)

  # calculate grid dimensions
  if (is.null(cols) && is.null(rows)){
    # if neither rows nor cols are given, we make a square grid
    cols <- ceiling(sqrt(num_plots))
    rows <- ceiling(num_plots/cols)
  }
  # alternatively, we know at least how many rows or how many columns we need
  if (is.null(cols)) cols <- ceiling(num_plots/rows)
  if (is.null(rows)) rows <- ceiling(num_plots/cols)

  if ("AUTO" %in% labels)
    labels <- LETTERS[1:num_plots]
  else if ("auto" %in% labels)
    labels <- letters[1:num_plots]

  # label adjustments can be provided globally for all labels
  # or individually for each label
  hjust <- rep_len(hjust, length(labels))
  vjust <- rep_len(vjust, length(labels))
  label_x <- rep_len(label_x, length(labels))
  label_y <- rep_len(label_y, length(labels))

  # calculate appropriate vectors of rel. heights and widths
  rel_heights <- rep(rel_heights, length.out = rows)
  rel_widths <- rep(rel_widths, length.out = cols)
  # calculate the appropriate coordinates and deltas for each row and column
  x_deltas <- rel_widths/sum(rel_widths)
  y_deltas <- rel_heights/sum(rel_heights)
  xs <- cumsum(rel_widths)/sum(rel_widths) - x_deltas
  ys <- 1 - cumsum(rel_heights)/sum(rel_heights)

  # now place all the plots
  p <- ggdraw() # start with nothing
  col_count <- 0
  row_count <- 1
  for (i in 1:(rows*cols)){
    if (i > num_plots) break

    x_delta <- x_deltas[col_count+1]
    y_delta <- y_deltas[row_count]
    x <- xs[col_count+1]
    y <- ys[row_count]

    # place the plot
    p_next <- grobs[[i]]
    if (!is.null(p_next)){
      p <- p + draw_grob(p_next, x, y, x_delta, y_delta, scale[i])
    }
    # place a label if we have one
    if (i <= length(labels)){
      p <- p + draw_plot_label(labels[i], x + label_x[i]*x_delta, y + label_y[i]*y_delta, size = label_size,
                               family = label_fontfamily, fontface = label_fontface, colour = label_colour,
                               hjust = hjust[i], vjust = vjust[i])
    }
    # move on to next grid position
    col_count <- col_count + 1
    if (col_count >= cols){
      col_count <- 0
      row_count <- row_count + 1
    }
  }
  p
}