R/cusum_control_plot.R

In cusumcharter: Easier CUSUM Control Charts

#' 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

}