updated vignettes, ui, readme and examples to new ui. Moved error che…

…ck for highlighting after tidyeval mapping, as it wasn't mapping the column before.

R/funnel_plot.R

@@ -47,6 +47,7 @@
 #' @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).
 #' 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")
+#' @param ... <[`data-masking`][rlang::args_data_masking]> Additional parameters
 #'
 #' @return A fitted `funnelplot` object. A `funnelplot` object is a list containing the following components:\cr
 #' \item{print}{Prints the number of points, outliers and whether the plot has been adjusted, and prints the plot}
@@ -90,8 +91,8 @@
 #' medpar$prds<- predict(mod, type="response")
 #'
 #' # Draw plot, returning just the plot object
-#' fp<-funnel_plot(denominator=medpar$prds, numerator=medpar$los,
-#' group = medpar$provnum, limit=95, title="An example funnel plot")
+#' fp<-funnel_plot(medpar, denominator=prds, numerator=los,
+#' group = provnum, limit=95, title="An example funnel plot")
 #'
 #' # Methods for viewing/extracting
 #' print(fp)
@@ -222,30 +223,7 @@ funnel_plot <- function(.data, numerator, denominator, group
  }
 
 
- # Error handling for highlight argument
- if(!is.na(highlight[1])){
-
- if(!is.character(highlight[1])) {
- stop("Please supply `highlight` in character format, or a character vector")
- }
-
- # check for missing highlight levels
- labs_present <- apply(sapply(X = highlight, FUN = grepl, x=group), 2, any)
- labs_missing <- names(labs_present[labs_present == FALSE])
-
- if (length(labs_missing)>0){
-
- stop(paste0("Value(s):'"
- , paste(labs_missing,collapse=", ")
- , "' specified to `highlight` not found in `group` variable. 
- Are you trying to highlight a group that is missing from your 
- data, or is it a typo?"
- ))
-
- }
- }
-
-
+
  # Define vector for scale colours
  plot_cols<-c(
 
@@ -270,6 +248,29 @@ funnel_plot <- function(.data, numerator, denominator, group
  stop("Numerator and denominator are the same. Please check your inputs")
  }
 
+ # Error handling for highlight argument
+ if(!is.na(highlight[1])){
+
+ if(!is.character(highlight[1])) {
+ stop("Please supply `highlight` in character format, or a character vector")
+ }
+
+ # check for missing highlight levels
+ labs_present <- apply(sapply(X = highlight, FUN = grepl, x=.data[[group]]), 2, any)
+ labs_missing <- names(labs_present[labs_present == FALSE])
+
+ if (length(labs_missing)>0){
+
+ stop(paste0("Value(s):'"
+ , paste(labs_missing,collapse=", ")
+ , "' specified to `highlight` not found in `group` variable. 
+ Are you trying to highlight a group that is missing from your 
+ data, or is it a typo?"
+ ))
+
+ }
+ }
+
  # now make working table
  mod_plot <- data.frame(numerator=as.numeric(.data[[numerator]])
  ,denominator=as.numeric(.data[[denominator]])

README.Rmd

@@ -98,7 +98,7 @@ medpar$prds<- predict(mod, type="response")
 We can build a funnel plot object with standard Poisson limits, and outliers labelled.
 
 ```{r fig.align='center', fig.retina=5, warning=FALSE, collapse=TRUE, funnel1, message=FALSE, eval=TRUE}
-a<-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$provnum, 
+a<-funnel_plot(medpar, numerator=los, denominator=prds, group = provnum, 
  title = 'Length of Stay Funnel plot for `medpar` data', data_type="SR", limit=99,
  draw_unadjusted = TRUE, draw_adjusted = FALSE, label="outlier")
 print(a)
@@ -121,7 +121,7 @@ This suggest the variance is 6.24 times the condition mean, and definitely overd
 This is a huge topic, but applying overdispersed limits using either SHMI or Spiegelhalter methods adjust for this by inflating the limits:
 
 ```{r, funnel2, message=FALSE, fig.align='center', fig.retina=5, collapse=TRUE, warning=FALSE, eval=TRUE}
-b<-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$provnum, data_type = "SR",
+b<-funnel_plot(medpar, numerator=los, denominator=prds, group = provnum, data_type = "SR",
  title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = FALSE,
  draw_adjusted = TRUE, sr_method = "SHMI", label="outlier", limit=99)
 

README.md

@@ -100,10 +100,6 @@ summary(mod)
 #> glm(formula = los ~ hmo + died + age80 + factor(type), family = "poisson", 
 #> data = medpar)
 #> 
-#> Deviance Residuals: 
-#> Min 1Q Median 3Q Max 
-#> -5.7309 -1.9554 -0.5529 0.9717 14.5487 
-#> 
 #> Coefficients:
 #> Estimate Std. Error z value Pr(>|z|) 
 #> (Intercept) 2.26875 0.01246 182.011 < 2e-16 ***
@@ -135,7 +131,7 @@ medpar$prds<- predict(mod, type="response")
 and outliers labelled.
 
 ``` r
-a<-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$provnum, 
+a<-funnel_plot(medpar, numerator=los, denominator=prds, group = provnum, 
  title = 'Length of Stay Funnel plot for `medpar` data', data_type="SR", limit=99,
  draw_unadjusted = TRUE, draw_adjusted = FALSE, label="outlier")
 print(a)
@@ -166,7 +162,7 @@ overdispersed limits using either SHMI or Spiegelhalter methods adjust
 for this by inflating the limits:
 
 ``` r
-b<-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$provnum, data_type = "SR",
+b<-funnel_plot(medpar, numerator=los, denominator=prds, group = provnum, data_type = "SR",
  title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = FALSE,
  draw_adjusted = TRUE, sr_method = "SHMI", label="outlier", limit=99)
 

tests/testthat/test-classes_methods.R

@@ -1,6 +1,9 @@
 test_that("`test the classes return stuff", {
- a<-funnel_plot(c(100, 150,180,80,120, 225), c(108, 112, 165,95,100, 220),
- factor(c("a","b","c", "d","e","f"))
+ a<-funnel_plot(
+ data.frame(num=c(100, 150,180,80,120, 225)
+ , denom=c(108, 112, 165,95,100, 220)
+ , group = factor(c("a","b","c", "d","e","f"))
+ ), num, denom, group
  )
 
  expect_s3_class(a, "funnelplot") 

tests/testthat/test-funnel_plot.R

@@ -1,16 +1,18 @@
 test_that("`funnel_plot()` works with input and returns expected list", {
- a<-funnel_plot(c(100, 150,180,80,120, 225), c(108, 112, 165,95,100, 220),
- factor(c("a","b","c", "d","e","f"))
- )
+ dt <- data.frame(num=c(100, 150,180,80,120, 225)
+ , denom=c(108, 112, 165,95,100, 220)
+ , group = factor(c("a","b","c", "d","e","f"))
+ )
+
+ a<-funnel_plot(dt, num, denom, group)
  expect_type(a, "list")
  expect_type(a[[1]], "list")
  expect_s3_class(a[[2]], "data.frame")
  expect_s3_class(a[[3]], "data.frame")
  expect_length(a[[3]]$group,6)
  expect_length(a[[3]],22)
 
- b<-funnel_plot(numerator=c(100, 150,180,80,120, 225), denominator=c(108, 112, 165,95,100, 220),
- group=factor(c("a","b","c", "d","e","f")), draw_adjusted = FALSE,
+ b<-funnel_plot(dt, num, denom, group, draw_adjusted = FALSE,
  title="My test Funnel Plot", multiplier = 100, x_label = "Expected Values",
  y_label = "Standardised Ratio Test", label = "outlier", limit=95)
  expect_type(b, "list")
@@ -21,8 +23,7 @@ test_that("`funnel_plot()` works with input and returns expected list", {
  expect_length(b[[3]],22)
  expect_gt(b[[3]]$LCL95[5], a[[3]]$OD95LCL[5])
 
- c<-funnel_plot(numerator=c(100, 150,180,80,120, 225), denominator=c(108, 112, 165,95,100, 220),
- group=factor(c("a","b","c", "d","e","f")), draw_adjusted = TRUE, sr_method="CQC", trim_by = 0.05,
+ c<-funnel_plot(dt, num, denom, group, draw_adjusted = TRUE, sr_method="CQC", trim_by = 0.05,
  title="My test Funnel Plot", multiplier = 100, x_label = "Expected Values",
  y_label = "Standardised Ratio Test", label = "highlight", limit=95, highlight="a")
  expect_type(c, "list")
@@ -34,8 +35,7 @@ test_that("`funnel_plot()` works with input and returns expected list", {
  expect_lt(b[[3]]$OD95LCL[5], c[[3]]$OD95LCL[5])
  expect_equal(source_data(c)$highlight[1],"1")
 
- d<-funnel_plot(numerator=c(100, 150,180,80,120, 225), denominator=c(108, 112, 165,95,100, 220),
- group=factor(c("a","b","c", "d","e","f")), draw_adjusted = FALSE, sr_method="CQC", trim_by = 0.05,
+ d<-funnel_plot(dt, num, denom, group, draw_adjusted = FALSE, sr_method="CQC", trim_by = 0.05,
  title="My test Funnel Plot", multiplier = 100, x_label = "Expected Values",
  y_label = "Standardised Ratio Test", label = "both", limit=95, x_range=c(5,250)
  , y_range=c(0, 200), highlight="a")

vignettes/changing_funnel_plot_options.Rmd

@@ -26,7 +26,7 @@ knitr::opts_chunk$set(
 library(FunnelPlotR)
 ```
 
-This brief vignette shows how to go about changing some of the parameters available in the `funnelplotr` package.
+This brief vignette shows how to go about changing some of the parameters available in the `FunnelPlotR` package.
 Firstly, lets set up some data, the same as the README and other vignette:
 
 ```{r dtsetup}
@@ -42,8 +42,8 @@ mod<- glm(los ~ hmo + died + age80 + factor(type), family="poisson", data=medpar
 medpar$prds<- predict(mod, newdata = medpar, type="response")
 
 # Draw plot, returning just the plot object
-funnel_plot(denominator=medpar$prds, numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds, numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE)
 
 ```
@@ -55,20 +55,23 @@ You can pick out data point(s) using the `highlight` option. Here we we use the
 
 ```{r highlight}
 # Draw plot, returning just the plot object
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds, numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE, highlight="030002")
+
+
+
 ```
 
 
 ## Themes
 
-You can alter themes in the `funnelplotr` packages by using the theme argument. There are a couple of options included with the package `funnel_clean` (the default) and `funnel_grey`, but you can write your own theme using any valid `ggplot2` theme and pass it to the plot.
+You can alter themes in the `FunnelPlotR` packages by using the theme argument. There are a couple of options included with the package `funnel_clean` (the default) and `funnel_grey`, but you can write your own theme using any valid `ggplot2` theme and pass it to the plot.
 
 ```{r plottheme1}
 
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE, theme = funnel_grey() )
 
 ```
@@ -86,8 +89,8 @@ new_funnel_theme <-
  )
 
 
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE, theme = new_funnel_theme)
 
 ```
@@ -100,20 +103,20 @@ I have deliberately avoided using red and green colours as defaults because it e
 Here I will change the upper 95% Poisson limit to black ("#000000"):
 
 ```{r colours}
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE, theme = funnel_grey(),
  plot_cols = c("#FF7F0EFF", "#000000", "#1F77B4FF","#1F77B4FF", "#9467BDFF", "#9467BDFF", "#2CA02CFF", "#2CA02CFF"))
 ```
 
 ## Changing scales
 
-`funnelplotr` automatically sets it's scales from the data you present to it but, on occasions, the scale rules might fall down for a particular dataset, or you may want to fix the plot to a particular scale. You can do this using the `xrange` and `yrange` arguments. Each takes a vector of two values, the minimum and the maximum:
+`FunnelPlotR` automatically sets it's scales from the data you present to it but, on occasions, the scale rules might fall down for a particular dataset, or you may want to fix the plot to a particular scale. You can do this using the `xrange` and `yrange` arguments. Each takes a vector of two values, the minimum and the maximum:
 
 ```{r funnelscales}
 ## Changing labels
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE, x_range=c(0, 400), y_range=c(0,2))
 
 ```
@@ -125,31 +128,31 @@ funnel_plot(denominator=medpar$prds,numerator=medpar$los
 You can change the plot labels and axis labels easily using the options: `title`, `x_label` and `y_label`.
 
 ```{r funnellabels1}
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99 ,label = "outlier"
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99 ,label = "outlier"
  , draw_unadjusted = TRUE, title = "Vignette funnel plot"
  , x_label = "x-axis", y_label = "y-axis")
 ```
 
 There are different labelling options for the data points too, using the `label` option. The default is to label outliers, but you can turn labels off, label the highlighted points, or both the highlighted points and the outliers ('both')
 
 ```{r funnellabels2}
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99
  , draw_unadjusted = TRUE, title = "Vignette funnel plot"
  , x_label = "x-axis", y_label = "y-axis"
  , highlight= "030002", label = "highlight")
 ```
 
 ## Cutting out the ggplot object
 
-Since `funnelplotr` uses `ggplot2`, you could always extract the plot and alter it manually like any other `ggplot2` object. The easiest way is to extract it with `plot()`. Below we'll add a (completely useless) vertical line to demonstrate adding more elements:
+Since `FunnelPlotR` uses `ggplot2`, you could always extract the plot and alter it manually like any other `ggplot2` object. The easiest way is to extract it with `plot()`. Below we'll add a (completely useless) vertical line to demonstrate adding more elements:
 
 ```{r cutoutplot}
 # Original funnel plot object
 fp <-
-funnel_plot(denominator=medpar$prds,numerator=medpar$los
- , group = medpar$provnum, limit=99, label = "outlier"
+funnel_plot(medpar, denominator=prds,numerator=los
+ , group = provnum, limit=99, label = "outlier"
  , draw_unadjusted = TRUE)
 
 # Extract just the plot

vignettes/funnel_plots.Rmd

@@ -143,7 +143,7 @@ Now we can build a funnel plot object with standard Poisson limits, and outliers
 
 ```{r, funnel1, message=FALSE, fig.align='center', fig.retina=5, collapse=TRUE}
 
-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$provnum, 
+funnel_plot(medpar, numerator=los, denominator=prds, group = provnum, 
  title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = TRUE,
  draw_adjusted = FALSE,label = "outlier", limit=99)
 ```
@@ -169,7 +169,7 @@ This suggests the variance is 6.24 times the condition mean, and definitely over
 This is a huge topic, but applying overdispersed limits using either SHMI or Spiegelhalter methods adjust for this by inflating the limits:
 
 ```{r, funnel2, message=FALSE, fig.align='center', fig.retina=5, collapse=TRUE}
-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$provnum, 
+funnel_plot(medpar, numerator=los, denominator=prds, group = provnum, 
  title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = FALSE,
  draw_adjusted = TRUE, data_type="SR", sr_method = "SHMI",label = "outlier", limit=99
  )