R/bcat_plt_point.R

In Rbearcat: University of Cincinnati Themes and Utilities for Econometrics and Data Science

#' Scatter plot utility
#'
#' Create a scatter plot using ggplot2 graphics. This function is a wrapper to create
#' commonly used styles of scatter plots. Additional layers can be added to this plot
#' as needed. More complicated scatter plots can be creating using individual ggplot2 layers.
#'
#' @param df The data to be displayed
#' @param x Variable to map to the x-axis
#' @param y Variable to map to the y-axis
#' @param color Variable to map to the color aesthetic
#' @param size Variable to map to the size aesthetic
#' @param facet Facetting variable(s). Note: must wrap in \code{vars()}, e.g, \code{facet = vars(var1, var2)}
#' @param jitter Set to \code{TRUE} to enable jittering.
#' @param jitter_width Set the jitter width. Leave as \code{NULL} to use the default ggplot2 settings
#' @param smooth Add fit line to plot
#' @param method Method to use for fit line. "lm" is default
#' @param se Set to \code{FALSE} to remove standard error band around fit line
#' @param x_lab Label for x-axis
#' @param y_lab Label for y-axis
#' @param title Plot title
#' @param subtitle Plot subtitle
#' @param caption Plot caption
#' @param legend_lab Legend title
#' @param legend_position legend position. "bottom" or "right"
#' @param legend_hide Set to \code{TRUE} to hide the legend
#' @param x_scale \code{scale_x_} function to apply to x-axis.
#' @param y_scale \code{scale_y_} function to apply to y-axis.
#' @param color_scale \code{scale_color_} function to apply to colors.
#' @param fill_scale \code{scale_fill_} function to apply to colors.
#' only applicable if \code{smooth = TRUE}`
#' @param facet_scale Shoud facet scales be fixed ("fixed", the default), free ("free"),
#'                    or free in one dimension ("free_x", "free_y")?
#' @param alpha level of point transparency. lower alpha leads to more transparency.
#' @param nrow Number of facet rows
#' @param ncol Number of facet columns
#' @param x_refline Vector of x-values at which to draw vertical reference lines
#' @param y_refline Vector of y-values at which to draw horizontal reference lines
#' @param identity_line Set to \code{TRUE} to draw 45 degree identity line
#' @param x_highlight_min Vector of min x-values at which to start draw rectangle annotation
#' @param x_highlight_max Vector of max x-values at which to end rectangle annotation
#' @param y_highlight_min Vector of min y-values at which to start draw rectangle annotation
#' @param y_highlight_max Vector of max y-values at which to end rectangle annotation
#' @param y_error_min Variable to use as minimum values for error bars around y at each value of x
#' @param y_error_max Variable to use as maximum values for error bars around y at each value of x
#' @param y_error_width Width of error bars
#' @return A \code{ggplot2} plot object.
#' @author Saannidhya Rawat
#' @family plots
#' @export
#'
#' @examples
#' library(ggplot2)
#'
#' # basic scatter plot
#' bcat_plt_point(df = iris,
#'                x = Sepal.Length,
#'                y = Sepal.Width,
#'                x_lab = "Length",
#'                y_lab = "Width",
#'                title = "Sepal Width vs Length")
#'
#' # scatter plot with LOESS fit line
#' bcat_plt_point(df = iris,
#'                x = Sepal.Length,
#'                y = Sepal.Width,
#'                x_lab = "Length",
#'                y_lab = "Width",
#'                smooth = TRUE,
#'                method = "loess",
#'                title = "Sepal Width vs Length",
#'                subtitle = "Loess Fit")
#'
#'  # scatter plot with faceting and LM fit lines
#'  bcat_plt_point(df = iris,
#'                 x = Sepal.Length,
#'                 y = Sepal.Width,
#'                 color = Species,
#'                 facet = vars(Species),
#'                 smooth = TRUE,
#'                 x_lab = "Length",
#'                 y_lab = "Width",
#'                 legend_lab = NULL,
#'                 title = "Sepal Width vs Length by Species",
#'                 subtitle = "Linear Fit",
#'                 nrow = 1)
bcat_plt_point <- function(df,
                           x,
                           y,
                           color = NULL,
                           size = NULL,
                           facet = NULL,
                           jitter = FALSE,
                           jitter_width = NULL,
                           smooth = FALSE,
                           method = "lm",
                           se = TRUE,
                           x_lab = ggplot2::waiver(),
                           y_lab = ggplot2::waiver(),
                           title = ggplot2::waiver(),
                           subtitle = ggplot2::waiver(),
                           caption = ggplot2::waiver(),
                           legend_lab = ggplot2::waiver(),
                           legend_position = "bottom",
                           legend_hide = FALSE,
                           x_scale = NULL,
                           y_scale = NULL,
                           color_scale = Rbearcat::scale_colour_UC(),
                           fill_scale = Rbearcat::scale_fill_UC(),
                           facet_scale = c("fixed", "free_y", "free_x", "free"),
                           alpha = 0.60,
                           nrow = NULL,
                           ncol = NULL,
                           x_refline = NULL,
                           y_refline = NULL,
                           identity_line = FALSE,
                           x_highlight_min = NULL,
                           x_highlight_max = NULL,
                           y_highlight_min = NULL,
                           y_highlight_max = NULL,
                           y_error_min = NULL,
                           y_error_max = NULL,
                           y_error_width = 1){

  # validation --------------------------------------------------------------

  .validate_df(df)

  # prelims -----------------------------------------------------------------

  facet_scale <- match.arg(facet_scale)

  y_err_min <- deparse(substitute(y_error_min))
  y_err_max <- deparse(substitute(y_error_max))

  # plot-base ---------------------------------------------------------------

  p <- ggplot2::ggplot(data = df,
                       mapping = ggplot2::aes(x = {{x}},
                                              y = {{y}},
                                              color = {{color}},
                                              size = {{size}}))

  # fit-lines ---------------------------------------------------------------

  if(smooth){

    p <- p + ggplot2::geom_smooth(mapping = ggplot2::aes(fill = {{color}}),
                                  method = method,
                                  se = se)
  }

  # error-bar-layer ---------------------------------------------------------

  if(!is.null(df[[y_err_min]]) & !is.null(df[[y_err_max]])){

    p <- p + ggplot2::geom_errorbar(mapping = ggplot2::aes(ymin = {{y_error_min}},
                                                           ymax = {{y_error_max}}),
                                    width = y_error_width,
                                    size = 0.75)

  }

  # point-layer-and-scales --------------------------------------------------

  if(jitter){

    layer <- ggplot2::geom_jitter(width = jitter_width,
                                  alpha = alpha)

  } else{

    layer <- ggplot2::geom_point(alpha = alpha)

  }

  p <- p + layer +
    # scale options
    x_scale +
    y_scale +
    color_scale +
    fill_scale

  # facets ------------------------------------------------------------------

  if(!is.null(facet)){

    p <- p + ggplot2::facet_wrap(facets = facet,
                                 nrow = nrow,
                                 ncol = ncol,
                                 scales = facet_scale)

  }

  # labels ------------------------------------------------------------------

  p <- p + ggplot2::labs(x = x_lab,
                         y = y_lab,
                         title = title,
                         subtitle = subtitle,
                         caption = caption,
                         color = legend_lab,
                         fill = legend_lab)

  # reference-lines ---------------------------------------------------------

  if(!is.null(x_refline)){

    p <- p + ggplot2::geom_vline(xintercept = x_refline)

  }

  if(!is.null(y_refline)){

    p <- p + ggplot2::geom_hline(yintercept = y_refline)

  }

  if(identity_line){

    p <- p + ggplot2::geom_abline(slope=1, intercept = 0) +
      ggplot2::coord_cartesian(xlim = c(0, NA), ylim = c(0,NA))

  }

  # highlight-regions -------------------------------------------------------

  # if all provided, map all to args
  if(!is.null(x_highlight_min) &
     !is.null(x_highlight_max) &
     !is.null(y_highlight_min) &
     !is.null(y_highlight_max)){

    p <- p + ggplot2::annotate("rect",
                               xmin = x_highlight_min,
                               xmax = x_highlight_max,
                               ymin = y_highlight_min,
                               ymax = y_highlight_max,
                               alpha = 0.40,
                               fill = .uc_highlight_fill()
    )

  }

  # if only x-region provided, extend y-min and max to full range
  if(!is.null(x_highlight_min) &
     !is.null(x_highlight_max) &
     is.null(y_highlight_min) &
     is.null(y_highlight_max)){

    p <- p + ggplot2::annotate("rect",
                               xmin = x_highlight_min,
                               xmax = x_highlight_max,
                               ymin = -Inf,
                               ymax = Inf,
                               alpha = 0.40,
                               fill = .uc_highlight_fill()
    )

  }

  # if only y-region provided, extend x-min and max to full range
  if(is.null(x_highlight_min) &
     is.null(x_highlight_max) &
     !is.null(y_highlight_min) &
     !is.null(y_highlight_max)){

    p <- p + ggplot2::annotate("rect",
                               ymin = y_highlight_min,
                               ymax = y_highlight_max,
                               xmin = -Inf,
                               xmax = Inf,
                               alpha = 0.40,
                               fill = .uc_highlight_fill()
    )

  }

  # add-theme-and-print -----------------------------------------------------

  p + Rbearcat::theme_UC(legend_position = legend_position,
                        legend_hide = legend_hide)

}