Nothing
#' cusum_control_plot
#'
#' @param df input data frame generated by cusum_control function
#' @param xvar the variable on the x axis, typically an obervation number or date/time
#' @param show_below whether to highlight points below the LCL, default is FALSE
#' @param pos_col line and point colour for positive values
#' @param centre_col line colour for centre line
#' @param neg_col line nd point colour for negative values
#' @param highlight_col - point colour for values outside UCL and (optionally) LCL
#' @param facet_var - the grouping variable to facet the charts by. If not supplied a non faceted plot is generated
#' @param facet_scales defaults to "free_y", but any of the usual ggplot2 facet values can be supplied e.g. "fixed" or "free_x"
#' @param scale_type if you need a date or datetime scale, specify either "date" or "datetime" here. Otherwise, leave as NULL and ggplot2 will pick an appropriate scale for you
#' @param datebreaks a character string specifying the breaks as text e.g "2 days" or "3 weeks". See ggplot2 date_breaks for further details
#' @param title_text optional title for chart
#' @param ... further arguments passed on to ggplot2
#'
#' @return ggplot2 object suited for further amendments if required.
#'
#' @importFrom rlang .data enquo
#' @importFrom ggplot2 aes ggplot geom_line geom_point geom_segment geom_ribbon
#' @importFrom ggplot2 theme element_text element_blank labs theme_minimal
#' @importFrom ggplot2 ggtitle facet_wrap vars scale_x_date scale_x_datetime
#' @export
#'
#' @examples
#' test_vec3 <- c(1,1,2,3,5,7,11,7,5,7,8,9,5)
#' controls <- cusum_control(test_vec3, target = 4)
#' cusum_control_plot(controls, xvar = obs)
#'
cusum_control_plot <- function(df,
xvar,
show_below = FALSE,
pos_col = "#385581", #blue
centre_col = "black", # black
neg_col = "#6dbac6", # aqua
highlight_col = "#c9052c", # red
facet_var = NULL,
facet_scales = "free_y",
scale_type = NULL, # date or datetime
datebreaks = NULL,
title_text = NULL,
...) {
# points outside upper limits
above_ucl <- df[df[["cplus"]] > df[["ucl"]],]
below_ucl <- df[df[["cneg"]] < df[["lcl"]],]
# upper and lower limits block
p <- ggplot2::ggplot(df, ggplot2::aes(x = {{xvar}},
ymin = .data$lcl,
ymax = .data$ucl)) +
ggplot2::geom_ribbon(fill = "grey90")
# blue lines / points for the cplus variable
p <- p + ggplot2::geom_line(ggplot2::aes(x = {{xvar}},
y = .data$cplus,
group = 1), colour = pos_col) +
ggplot2::geom_point(ggplot2::aes(x = {{xvar}},
y = .data$cplus,
group = 1), colour = pos_col)
# points above ucl are always highlighted otherwise the layers get messed up
if (dim(above_ucl)[1] >= 1) {
p <- p + ggplot2::geom_point(data = above_ucl,
ggplot2::aes(x = {{xvar}},
y = .data$cplus, group = 1),
colour = highlight_col)
}
# aqua line for cneg variable
p <- p + ggplot2::geom_line(ggplot2::aes({{xvar}},.data$cneg, group = 1),
colour = neg_col)
p <- p + ggplot2::geom_point(ggplot2::aes({{xvar}},.data$cneg, group = 1),
colour = neg_col)
# red points for those below ucl
if (isTRUE(show_below)) {
if (dim(below_ucl)[1] >= 1) {
p <- p + ggplot2::geom_point(data = below_ucl,
ggplot2::aes(x = {{xvar}},
y = .data$cneg, group = 1),
colour = highlight_col)
}
}
# default lines for centre
p <- p + ggplot2::geom_line(ggplot2::aes({{xvar}},.data$centre, group = 1),
colour = centre_col)
# tidy up and labels
p <- p + ggplot2::theme_minimal()
p <- p + ggplot2::theme(panel.grid.major = ggplot2::element_blank(),
panel.grid.minor = ggplot2::element_blank())
p <- p + ggplot2::labs(title = title_text, x = NULL, y = NULL)
#facet if necessary
facet_quo <- enquo(facet_var)
if (!rlang::quo_is_null(facet_quo)) {
facet <- ggplot2::facet_wrap(vars(!!facet_quo), scales = facet_scales)
p <- p + facet
}
if (!is.null(scale_type)) {
# date scales if necessary
if (scale_type == 'date') {
p <- p + ggplot2::scale_x_date(date_breaks = datebreaks)
#print(p)
}
# datetime scales if necessary
if (scale_type == 'datetime') {
p <- p + ggplot2::scale_x_datetime(date_breaks = datebreaks)
#print(p)
}
}
p
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.