Added simple tester function for tidyeval as well as main function. T…

…ester works, main doesnt

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]] %>%