inst/doc/funnel_plots.R

In FunnelPlotR: Funnel Plots for Comparing Institutional Performance

## ----include = FALSE, echo=FALSE, fig.height= 5, fig.width=7------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  fig.height= 5, 
  fig.width=7
)

## ----basicfunnel, warning=FALSE, error=FALSE, message=FALSE, fig.height= 5, fig.width=7----
library(ggplot2)
library(tidyr)

# Make up some data, as if it was from a regression model with observed and predicted (expected) events.
dt <- data.frame(observed = c( 15,40,72,28,50, 66, 75),
                 expected = c( 13,32,75,33,54, 60, 72),
                 unit = factor(c("A","B","c","D","E", "F", "G"))
)

# Add a ratio (SR) of observed to expected, our indicator 
dt$SR <- dt$observed / dt$expected

# Scatter plot in ggplot
a<-ggplot(dt, aes(x=expected, y= SR))+
  geom_point()

a

# Now add a central line, in a ration like this, 1 is the average/expected value.
a<- a+geom_hline(aes(yintercept=1))
a

# Add a 95% Poisson limit, by using the density function to get the quantile value for each 'expected'.
lkup<-data.frame(id=seq(1, max(dt$expected), 1))
lkup$Upper<-(qpois(0.975,lambda = lkup$id) - 0.025) / lkup$id
lkup$lower<-(qpois(0.025,lambda = lkup$id) - 0.975) / lkup$id

lkup<-gather(lkup, key, value,-id)

a+ geom_line(aes(x=id, y=value, col=key), data=lkup)


## ----install, eval=FALSE------------------------------------------------------
#  devtools::install_github("https://github.com/nhs-r-community/FunnelPlotR")

## ----data, warning=FALSE, message=FALSE---------------------------------------
library(FunnelPlotR)
library(COUNT)
library(ggplot2)

data(medpar)
medpar$provnum<-factor(medpar$provnum)
medpar$los<-as.numeric(medpar$los)

mod<- glm(los ~ hmo + died + age80 + factor(type), family="poisson", data=medpar)
summary(mod)


## ----prediction---------------------------------------------------------------

medpar$prds<- predict(mod, type="response")


## ----funnel1, message=FALSE, fig.align='center', fig.retina=5, collapse=TRUE----

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)

## ----ODcheck, message=FALSE---------------------------------------------------

sum(mod$weights * mod$residuals^2)/mod$df.residual


## ----funnel2, message=FALSE, fig.align='center', fig.retina=5, collapse=TRUE----
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
            )