#' Plot the tidal creek report card matrix
#'
#' Plot the tidal creek report card matrix
#'
#' @param dat input creek score data returned from \code{\link{anlz_tdlcrk}}
#' @param class character vector indicating which creek classes to show, one to many of \code{'3M'}, \code{'2'}, \code{'3F'}, and \code{'1'}. Defaults to marine only (\code{'3M', '2'}).
#' @param score character vector of score categories to include, one to many of \code{'Prioritize'}, \code{'Investigate'}, \code{'Caution'}, and \code{'Monitor'}. Defaults to all.
#' @param family optional chr string indicating font family for text labels
#' @param size numeric for text and line scaling
#'
#' @details The plot shows a matrix with rows for individual creeks and columns for overall creek score. The columns show an overall creek score and the number of years in the prior ten years that nitrogen values at a creek were assigned to each of the four score categories. Number of years is mapped to cell transparency.
#'
#' @return A static \code{\link[ggplot2]{ggplot}} object is returned.
#'
#' @concept show
#'
#' @export
#'
#' @importFrom dplyr "%>%"
#' @import patchwork
#'
#' @examples
#' dat <- anlz_tdlcrk(tidalcreeks, iwrraw, yr = 2024)
#' show_tdlcrkmatrix(dat)
show_tdlcrkmatrix <- function(dat, class = c('3M', '2'), score = c('Prioritize', 'Investigate', 'Caution', 'Monitor'), family = NA, size = 11){
# sanity checks
if(any(!class %in% c('3M', '2', '3F', '1')))
stop('class must be from 3M, 2, 3F, 1')
if(any(!score %in% c('Prioritize', 'Investigate', 'Caution', 'Monitor')))
stop('score must be from Prioritize, Investigate, Caution, Monitor')
# named color vector
cols <- list(Monitor = '#2DC938', Caution = '#E9C318', Investigate = '#EE7600', Prioritize = '#FF4040') # green, yellow, darkorange2, brown1
# overall score categories
toplo2 <- dat %>%
dplyr::filter(class %in% !!class) %>%
dplyr::filter(score %in% !!score) %>%
dplyr::select(-id, -JEI, -class) %>%
dplyr::mutate(
name = dplyr::case_when(
name == '' ~ 'no name',
T ~ name
)
) %>%
tidyr::unite('id', wbid, name, sep = ', ') %>%
dplyr::mutate(
score = factor(score, levels = rev(c('Prioritize', 'Investigate', 'Caution', 'Monitor')))
) %>%
dplyr::filter(!duplicated(id)) %>%
dplyr::arrange(score, id) %>%
dplyr::mutate(
id = factor(id, levels = id)
)
# individual year counts
toplo1 <- toplo2 %>%
tidyr::gather('indyr', 'count', monitor, caution, investigate, prioritize) %>%
dplyr::mutate(
count = dplyr::case_when(
is.na(count) ~ 0L,
T ~ count
),
indyr = factor(indyr, levels = rev(c('prioritize', 'investigate', 'caution', 'monitor')), labels = rev(c('Prioritize', 'Investigate', 'Caution', 'Monitor')))
)
# theme
pthm <- ggplot2::theme_gray(base_size = size, base_family = family) +
ggplot2::theme(
legend.position = 'top',
axis.text.y = ggplot2::element_text(size = 0.6 * size),
panel.background = ggplot2::element_blank(),
axis.text.x = ggplot2::element_text(size = 0.7 * size)
)
# plot for individual year counts
p1 <- ggplot2::ggplot(toplo1, ggplot2::aes(y = id, x = indyr, fill = indyr, alpha = count)) +
ggplot2::scale_fill_manual(values = cols, guide = 'none') +
ggplot2::geom_tile(colour = NA) +
ggplot2::scale_alpha_continuous('Years', range = c(0, 1), limits = c(0, 10), breaks = c(0, 5, 10)) +
ggplot2::scale_x_discrete(expand = c(0,0)) +
ggplot2::scale_y_discrete(expand = c(0,0)) +
ggplot2::labs(
x = 'Individual year results',
y = 'Creek Id, name'
) +
pthm
# plot for overall score categories
p2 <- ggplot2::ggplot(toplo2, ggplot2::aes(y = id, x = 'Final category', fill = score)) +
ggplot2::scale_fill_manual(values = cols, guide = ggplot2::guide_legend(reverse = T)) +
ggplot2::geom_tile(colour = 'black') +
ggplot2::scale_x_discrete(expand = c(0,0)) +
ggplot2::scale_y_discrete(expand = c(0,0)) +
pthm +
ggplot2::theme(
axis.text.y = ggplot2::element_blank(),
legend.title = ggplot2::element_blank(),
legend.position = 'right',
axis.title = ggplot2::element_blank()
)
# combine
out <- p1 + p2 + plot_layout(ncol = 2, widths = c(1, 0.2))
return(out)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.