Added simple tester function for tidyeval as well as main function. Tester works, main doesnt

Author: chrismainey

DESCRIPTION

@@ -18,10 +18,12 @@ License: MIT + file LICENSE
 URL: https://nhs-r-community.github.io/FunnelPlotR/, https://github.com/nhs-r-community/FunnelPlotR
 BugReports: https://github.com/nhs-r-community/FunnelPlotR/issues
 Encoding: UTF-8
-Imports: dplyr,
-         ggrepel,
-         ggplot2,
-         scales
+Imports: 
+    dplyr,
+    ggrepel,
+    ggplot2,
+    scales,
+    rlang
 RoxygenNote: 7.2.3
 Suggests: 
     testthat (>= 3.0.0),

NAMESPACE

@@ -16,6 +16,7 @@ export(outliers)
 export(phi)
 export(source_data)
 export(tau2)
+export(tst_func)
 import(ggplot2)
 importFrom(dplyr,"%>%")
 importFrom(dplyr,arrange)
@@ -32,6 +33,7 @@ importFrom(ggplot2,theme_grey)
 importFrom(ggplot2,theme_minimal)
 importFrom(ggrepel,geom_label_repel)
 importFrom(ggrepel,geom_text_repel)
+importFrom(rlang,.data)
 importFrom(scales,comma)
 importFrom(stats,aggregate)
 importFrom(stats,na.omit)

R/funnel_plot.R

@@ -4,6 +4,7 @@
 #' overdispersed, funnel control limits.  Limits may be inflated for overdispersion based on the methods of DerSimonian & Laird (1986), buy calculating a between unit standard deviation (\eqn{\tau})
 #' and constructing an additive random effects models, originally used for meta-analyses of clinical trials data.
 #' @encoding UTF-8
+#' @param .data A data frame containing a numerator, denominator and grouping field.
 #' @param numerator  A vector of the numerator (observed events/counts) values.  Used as numerator of the Y-axis
 #' @param denominator A vector of denominator (predicted/population etc.)  Used as denominator of the Y-axis and the scale of the x-axis
 #' @param group A vector of group names as character or factor.  Used to aggregate and group points on plots
@@ -106,12 +107,13 @@
 #'
 #'
 #' @importFrom scales comma
+#' @importFrom rlang .data
 #' @importFrom ggrepel geom_text_repel
 #' @importFrom dplyr select filter arrange mutate summarise group_by %>% n
 #' @importFrom stats na.omit
 #' @import ggplot2
 
-funnel_plot <- function(numerator, denominator, group
+funnel_plot <- function(.data, numerator, denominator, group
                         , data_type = "SR", limit = 99, label = "outlier"
                         , highlight = NA, draw_unadjusted = FALSE
                         , draw_adjusted = TRUE, sr_method = "SHMI"
@@ -124,7 +126,8 @@ funnel_plot <- function(numerator, denominator, group
                         , theme = funnel_clean()
                         , label_outliers, Poisson_limits, OD_adjust
                         , xrange, yrange
-                        , SHMI_rounding = TRUE){
+                        , SHMI_rounding = TRUE
+                        , ...){
 
   # Version 0.4 deprecation warnings
   if (!missing(label_outliers)) {
@@ -262,11 +265,16 @@ funnel_plot <- function(numerator, denominator, group
     "99.8% Lower Overdispersed" = plot_cols[7],
     "99.8% Upper Overdispersed" = plot_cols[8]
   )
-
-
-  mod_plot <- data.frame(numerator=as.numeric(numerator)
-                         ,denominator=as.numeric(denominator)
-                         , group=as.factor(group))
+  
+  # map columns for tidyeval compliance
+  
+  numerator <- quo_name(enquo(numerator))
+  denominator <- quo_name(enquo(denominator))
+  group <- quo_name(enquo(group))
+
+  mod_plot <- data.frame(numerator=as.numeric(.data[[numerator]])
+                         ,denominator=as.numeric(.data[[denominator]])
+                         , group=as.factor(.data[[group]]))
 
 
   mod_plot_agg<-aggregate_func(mod_plot)

R/test_func.R

@@ -0,0 +1,36 @@
+
+
+#' Test function
+#'
+#' @param .data data frame
+#' @param numerator tghe numearto
+#' @param denominator denom
+#' @param group the group
+#'
+#' @return a data frame stuck together
+#' @export
+#' 
+#' @importFrom rlang .data
+#'
+tst_func <- function(.data, numerator, denominator, group){
+  
+  numerator <- quo_name(enquo(numerator))
+  denominator <- quo_name(enquo(denominator))
+  group <- quo_name(enquo(group))
+  
+  
+  
+  mod_plot <- data.frame(numerator=as.numeric(.data[[numerator]])
+                         ,denominator=as.numeric(.data[[denominator]])
+                         , group=as.factor(.data[[group]]))
+  
+  return(mod_plot)
+  
+}
+
+
+# medpar
+# 
+tst_func(medpar, los, prds, provnum)
+
+funnel_plot(medpar, los, prds, provnum)

dev/tests.R

@@ -40,7 +40,7 @@ fp2<-funnel_plot(denominator=medpar$prds,numerator=medpar$los, multiplier = 100,
 
                  , sr_method = "SHMI",
                  draw_unadjusted = FALSE, draw_adjusted=TRUE, highlight = c("0300121", "030073"), theme=funnel_grey(),
-                 plot_cols = c("#FF7F0EFF", "#000000", "#1F77B4FF","#1F77B4FF", "#9467BDFF", "#9467BDFF", "#2CA02CFF", "#2CA02CFF"))
+                 plot_cols = c("#000000", "#1F77B4FF", "#9467BDFF", "#2CA02CFF"))
 
 #rm(fp2)
 fp2
@@ -67,6 +67,11 @@ fp<-funnel_plot(numerator=medpar$los, denominator=medpar$prds, group = medpar$pr
             title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = TRUE,
             draw_adjusted = TRUE, limit=99, label = "outlier", sr_method="SHMI")
 
+
+fp<-funnel_plot(medpar, los, prds, provnum,
+                title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = TRUE,
+                draw_adjusted = TRUE, limit=99, label = "outlier", sr_method="SHMI")
+
 fp[[1]]
 
 View(fp[[3]])
@@ -107,6 +112,17 @@ a<-funnel_plot(numerator=medpar$los, denominator=(medpar$prds*10), group = medpa
             title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = FALSE,
             draw_adjusted = TRUE, label_outliers = TRUE, sr_method="SHMI")
 
+
+a<-funnel_plot(numerator=medpar$los, denominator=(medpar$prds*10), group = medpar$provnum,
+               data_type = "RC",#return_elements=c("plot"),
+               title = 'Length of Stay Funnel plot for `medpar` data', draw_unadjusted = FALSE,
+               draw_adjusted = TRUE, label_outliers = TRUE, sr_method="SHMI")
+
+
+
+.data <- medpar
+numerator=los 
+denominator=(medpar$prds*10), group = medpar$provnum,
 a[1]
 
 a[[2]] %>%