R/plotDots.R

In CamFreshwater/samSim: Closed-loop salmon dynamics simulator

#' CU-specific dot plot
#'
#' This function generates dot plots with credible intervals for performance
#' metrics.
#'
#' @importFrom dplyr everything filter mutate select
#' @importFrom ggplot2 aes facet_wrap geom_pointrange
#' ggplot guides labs scale_fill_manual theme
#' @importFrom tidyr gather spread unite
#'
#' @param cuDat Dataframe generated by \code{buildCUDat}.
#' @param plotVar A character value corresponding to PM in cuDat$vars (can be
#' either catch- or conservation-based).
#' @param group A character value that can take the values: \code{"mp", "om"}
#' and specifies along which categorical variable dot plots should be grouped.
#' @param legendLab A character representing the legend title.
#' @param xLab A character representing the x axis label.
#' @param yLab A character representing the y axis label.
#' @param plotTitle A character representing the main plot title.
#' @return Returns a ggplot object.
#'
#' @examples
#'
#' plotCUDot(cuPlottingDF, plotVar = "medCatch", group = "om",
#'          legendLab = "Secondary MPs", xLab = "Proportion Mixed Stock TAC",
#'          yLab = "Median Catch", axisSize = 14, dotSize = 4, lineSize = 1,
#'          legendSize = 14)
#'
#' @export
plotCUDot <- function(cuDat, plotVar, group = "om", legendLab = NULL,
                      xLab = NULL, yLab = NULL, plotTitle = NULL, axisSize = 14,
                      dotSize = 4, lineSize = 1, legendSize = 14) {
  if (is.null(xLab) | is.null(yLab)) {
    warning("Suggest adding axis labels before interpreting plots")
  }
  #save index variables
  nCU <- length(unique(cuDat$cuName))
  colPal <- viridis::viridis(nCU, begin = 0, end = 1)

  dum <- cuDat %>%
    filter(var == plotVar) %>% #remove variables except one of interest
    dplyr::select(keyVar = 1, everything()) %>%
    mutate(keyVar = as.factor(keyVar))

  #identify faceting
  if (group == "mp") {
    dum <- dum %>%
      mutate(groupingVar = as.factor(mp))
  }
  if (group == "om") {
    dum <- dum %>%
      mutate(groupingVar = as.factor(om))
  }
  colPal <- viridis::viridis(length(levels(dum$groupingVar)), begin = 0,
                             end = 1)
  names(colPal) <- levels(dum$groupingVar)

  p <- ggplot(dum, aes(x = keyVar, y = avg, ymin = lowQ, ymax = highQ,
                       fill = groupingVar)) +
    labs(x = xLab, y = yLab, title = plotTitle) +
    geom_pointrange(shape = 21, fatten = dotSize, size = lineSize,
                    position = position_dodge(width = 0.65)) +
    theme_sleekX() +
    theme(strip.text = element_text(size = axisSize),
          axis.text = element_text(size = 0.85 * axisSize),
          axis.title = element_text(size = axisSize),
          legend.text = element_text(size = 0.95 * legendSize),
          legend.title = element_text(size = legendSize)) +
    facet_wrap(~ cuName, scales = "free_y")
  #remove legend if no grouping variables
  if (length(unique(dum$groupingVar)) < 2) {
    p <- p  +
      scale_fill_manual(values = colPal, guide = FALSE) +
      geom_pointrange(position = position_dodge(width = 0))
  } else {
    p <- p +
      scale_fill_manual(name = legendLab, values = colPal)
  }
  return(p)
}

#______________________________________________________________________________

#' Aggregate dot plot
#'
#' This function generates dot plots with credible intervals for performance
#' metrics. Note that for aggregate data, variables should be filtered from
#' dataframe before it is passed as an argument (i.e. plots all variables by
#' default).
#'
#' @importFrom dplyr everything filter mutate select
#' @importFrom ggplot2 aes facet_wrap geom_pointrange
#' ggplot guides labs scale_fill_manual theme
#' @importFrom tidyr gather spread unite
#'
#' @param agDat Dataframe generated by \code{buildCUDat}.
#' @param group A character value that can take the values: \code{"mp", "om"}
#' and specifies along which categorical variable dot plots should be grouped.
#' @param legendLab A character representing the legend title.
#' @param xLab A character representing the x axis label.
#' @param yLab A character representing the y axis label.
#' @param plotTitle A character representing the main plot title.
#' @return Returns a ggplot object.
#'
#' @examples
#' trimDat <- agPlottingDF %>%
#' dplyr::filter(var %in% c("medSpawners", "medCatch", "ppnCULower", "ppnCUExtinct"))
#'
#' plotAgDot(trimDat, group = "om",
#'          legendLab = "Secondary MPs", xLab = "Proportion Mixed Stock TAC",
#'          yLab = "Median Catch", axisSize = 14, dotSize = 4, lineSize = 1,
#'          legendSize = 14)
#'
#' @export
plotAgDot <- function(agDat, group = "om", legendLab = "Operating\nModel",
                      xLab = NULL, yLab = NULL, plotTitle = NULL, axisSize = 14,
                      dotSize = 4, lineSize = 1, legendSize = 14) {
  if (is.null(xLab) | is.null(yLab)) {
    warning("Suggest adding axis labels before interpreting plots")
  }

  dum <- agDat %>%
    dplyr::select(keyVar = 1, everything()) %>%
    mutate(keyVar = as.factor(keyVar))

  #identify faceting
  if (group == "mp") {
    dum <- dum %>%
      mutate(groupVar = as.factor(mp))
  }
  if (group == "om") {
    dum <- dum %>%
      mutate(groupVar = as.factor(om))
  }
  colPal <- viridis::viridis(length(levels(dum$groupVar)), begin = 0, end = 1)
  names(colPal) <- levels(dum$groupVar)

  p <- ggplot(dum, aes(x = keyVar, y = avg, ymin = lowQ, ymax = highQ,
                       fill = groupVar)) +
    labs(x = xLab, y = yLab, title = plotTitle) +
    geom_pointrange(shape = 21, fatten = dotSize, size = lineSize,
                    position = position_dodge(width = 0.65)) +
    theme_sleekX() +
    theme(strip.text = element_text(size = axisSize),
          axis.text = element_text(size = 0.85 * axisSize),
          axis.title = element_text(size = axisSize),
          legend.text = element_text(size = 0.95 * legendSize),
          legend.title = element_text(size = legendSize)) +
    # scale_shape_discrete(name = legendLab) +
    facet_wrap(~ var, scales = "free_y")
  #remove legend if no grouping variables
  if (length(unique(dum$groupVar)) < 2) {
    p <- p  +
      scale_fill_manual(values = colPal, guide = FALSE) +
      geom_pointrange(position = position_dodge(width = 0))
  } else {
    p <- p +
      scale_fill_manual(name = legendLab, values = colPal)
  }
  return(p)
}