slimmed down colouring to 4 options

Author: chrismainey

DESCRIPTION

@@ -24,7 +24,7 @@ Imports:
     ggplot2,
     scales,
     rlang
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Suggests: 
     testthat (>= 3.0.0),
     knitr,

R/draw_plot.R

@@ -86,7 +86,7 @@ draw_plot<-function(mod_plot_agg, limits, x_label, y_label, title, label, multip
         geom_line(aes(x = number.seq, y = ul95, col = "95%", linetype = "95%"), linewidth = 1,  data = limits, na.rm = TRUE) +
         geom_line(aes(x = number.seq, y = ll998, col = "99.8%", linetype = "99.8%"), linewidth = 1, data = limits, na.rm = TRUE) +
         geom_line(aes(x = number.seq, y = ul998, col = "99.8%", linetype = "99.8%"), linewidth = 1, data = limits, na.rm = TRUE) +
-        scale_color_manual(values = plot_cols[1:4], name = "Control limits")+
+        scale_color_manual(values = plot_cols, name = "Control limits")+
         scale_linetype_manual(values = c("95%"=2
                                          , "99.8%" = 1), guide = "none")+
         guides(colour = guide_legend(title.theme = element_text(
@@ -104,7 +104,7 @@ draw_plot<-function(mod_plot_agg, limits, x_label, y_label, title, label, multip
         geom_line(aes(x = number.seq, y = odul95, col = "95% Overdispersed", linetype = "95% Overdispersed"), linewidth = 1, data = limits, na.rm = TRUE) +
         geom_line(aes(x = number.seq, y = odll998, col = "99.8% Overdispersed", linetype = "99.8% Overdispersed"), linewidth = 1, data = limits, na.rm = TRUE) +
         geom_line(aes(x = number.seq, y = odul998, col = "99.8% Overdispersed", linetype = "99.8% Overdispersed"), linewidth = 1, data = limits, na.rm = TRUE) +
-        scale_color_manual(values = plot_cols[5:8], name = "Control limits")+
+        scale_color_manual(values = plot_cols, name = "Control limits")+
         scale_linetype_manual(values = c("95% Overdispersed"=2
                                          , "99.8% Overdispersed" = 1), guide = "none")+
         guides(colour = guide_legend(title.theme = element_text(
@@ -115,7 +115,7 @@ draw_plot<-function(mod_plot_agg, limits, x_label, y_label, title, label, multip
         ), override.aes = list(linetype = c(2,1)) ))
     }
     if (draw_unadjusted == FALSE &  draw_adjusted == FALSE){
-    funnel_p 
+    funnel_p
    }
   }
 
@@ -132,25 +132,25 @@ draw_plot<-function(mod_plot_agg, limits, x_label, y_label, title, label, multip
 
 
 
- 
+
 
  # Label points
   if(!is.na(label)){
-    
+
     if(label=="highlight"){
       funnel_p <- funnel_p +
         geom_label_repel(aes(label = ifelse(highlight == 1,
                                             as.character(group), NA))
                          , size=2.5, point.padding=0, direction = "both", force = 2
                          , min.segment.length=0, na.rm=TRUE, max.overlaps = max.overlaps)
     }
-    
+
     if(draw_adjusted == FALSE & draw_unadjusted == FALSE){
       funnel_p
     }
-    
-    
-    
+
+
+
     if(label=="outlier"){
 
       funnel_p <- funnel_p +
@@ -178,7 +178,7 @@ draw_plot<-function(mod_plot_agg, limits, x_label, y_label, title, label, multip
                          , min.segment.length=1, na.rm=TRUE, max.overlaps = max.overlaps)
     }
 
-    
+
     if(label=="both"){
       funnel_p <- funnel_p +
         geom_label_repel(aes(label = ifelse((highlight == 1 | outlier == 1) ,

R/funnel_plot.R

@@ -44,9 +44,9 @@
 #' @param yrange Deprecated.  Please use the `y_range` argument instead.
 #' @param y_range Manually specify the y-axis min and max, in form c(min, max), e.g. c(0.7, 1.3). Default, "auto", allows function to estimate range.
 #' @param theme a ggplot theme function.  This can be a canned theme such as theme_bw(), a theme() with arguments, or your own custom theme function. Default is new funnel_clean(), but funnel_classic() is original format.
-#' @param plot_cols A vector of 8 colours for funnel limits, in order: 95\% Poisson (lower/upper), 99.8\% Poisson (lower/upper), 95\% OD-adjusted (lower/upper), 99.8\% OD-adjusted (lower/upper).
+#' @param plot_cols A vector of 4 colours for funnel limits, in order: 95\% Poisson (lower/upper), 99.8\% Poisson (lower/upper), 95\% OD-adjusted (lower/upper), 99.8\% OD-adjusted (lower/upper).
 #' Default has been chosen to avoid red and green which can lead to subconscious value judgements of good or bad.
-#' Default is hex colours: c("#FF7F0EFF", "#FF7F0EFF", "#1F77B4FF","#1F77B4FF", "#9467BDFF", "#9467BDFF", "#2CA02CFF", "#2CA02CFF")
+#' Default is hex colours: c("#FF7F0EFF", "#1F77B4FF", "#9467BDFF", "#2CA02CFF")
 #' @param SHMI_rounding TRUE/FALSE, for SHMI calculation (standardised ratio, with SHMI truncation etc.), should you round the expected values to 2 decimal places (TRUE) or not (FALSE)
 #' @param max.overlaps 	Exclude text labels that overlap too many things. Defaults to 10. (inherited from geom_label_repel)
 #'
@@ -122,8 +122,7 @@ funnel_plot <- function(.data, numerator, denominator, group
                         , multiplier = 1, x_label = "Expected"
                         , y_label , x_range = "auto", y_range = "auto"
                         , plot_cols =
-                          c("#FF7F0EFF", "#FF7F0EFF", "#1F77B4FF","#1F77B4FF",
-                            "#9467BDFF", "#9467BDFF", "#2CA02CFF", "#2CA02CFF")
+                          c("#FF7F0EFF", "#1F77B4FF", "#9467BDFF", "#2CA02CFF")
                         , theme = funnel_clean()
                         , label_outliers, Poisson_limits, OD_adjust
                         , xrange, yrange
@@ -193,10 +192,9 @@ funnel_plot <- function(.data, numerator, denominator, group
 
 
 
-  if(length(plot_cols) < 8){
-    stop("Please supply a vector of 8 colours for funnel limits, in order: 95% Lower Poisson, 95% Upper Poisson
-         , 99.8% Lower Poisson, 99.8% Upper Poisson, 95% Upper OD-adjusted, 95% Lower OD-adjusted,
-         99.8% Lower OD-adjusted, 99.8% Upper OD-adjusted, even if you are only using one set of limits.")
+  if(length(plot_cols) != 4){
+    stop("Please supply a vector of 4 colours for funnel limits, in order: 95% Poisson, 99.8% Poisson
+    , 95% OD-adjusted, 99.8% OD-adjusted, even if you are only using one set of limits.")
   }
 
   if(!(label %in% c("outlier", "outlier_lower", "outlier_upper", "highlight"
@@ -233,6 +231,8 @@ funnel_plot <- function(.data, numerator, denominator, group
     "99.8% Overdispersed" = plot_cols[4]
   )
 
+  plot_cols
+
   # map columns for tidyeval compliance
 
   numerator <- quo_name(enquo(numerator))

dev/manual_test.R

@@ -13,14 +13,18 @@ mod_plot <-
   LOS_model %>%
   group_by(Organisation) %>%
   summarise(observed = sum(Death),
-            predicted = sum(preds)) 
+            predicted = sum(preds))
 
 # install.packages("C:/Users/Christopher/Documents/R/FunnelPlotR_0.2.3.tar.gz", repos=NULL)
 
+library(COUNT)
+data(medpar)
 for (i in seq_len(ncol(medpar))) {
   if (any(class(medpar[,i]) == "labelled")) {
     #browser()
     ind = which(class(medpar[,i])=="labelled")
     attr(medpar[,i],"class")[ind] <- "labelled_ch"
   }
 }
+
+funnel_plot(.data = mod_plot, observed, predicted, Organisation, draw_unadjusted = TRUE, x_range = c(0,20), y_range = c(0,2))

man/funnel_plot.Rd

@@ -100,7 +100,7 @@ funnel_plot(medpar, denominator=prds,numerator=los
 You can change the colours of the limits.  I am aiming to allow better colour theme support in future versions, but at present they are supplied as a vector of four hex colours to the `plot_cols` argument, in the order 95% Poisson, 99.8% Poisson, 95% OD and 99.8% OD.  At present all four values are required, whether you are plotting all four limits or not.
 I have deliberately avoided using red and green colours as defaults because it encourages value judgements about 'good' v.s. 'bad' which may be unreasonable for a given data set.  Default colours are paired for both low and high: `c("#FF7F0EFF", "#1F77B4FF", "#9467BDFF", "#2CA02CFF")`
 
-Here I will change the upper 95% limit to black ("#000000"):
+Here I will change the 95% limit to black ("#000000"):
 
 ```{r colours}
 funnel_plot(medpar, denominator=prds,numerator=los
@@ -162,4 +162,4 @@ my_plot <- plot(fp)
 my_plot +
   geom_vline(aes(xintercept=400), linetype = "dashed", colour="red", linewidth=2)
 
-```
+```