#' 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)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.