inst/doc/controlcharts.R

In qicharts: Quality Improvement Charts

## -----------------------------------------------------------------------------
# Load the qicharts package
library(qicharts)

# Lock random number generator to reproduce the charts from this vignette
set.seed(7)

## ----fig1, fig.cap='Figure 1: I chart showing common cause variation'---------
# Create vector of random values to plot
y <- rnorm(24)

# Plot I chart
qic(y, chart = 'i')

## ----fig2, fig.cap='Figure 2: I chart, special cause variation'---------------
# Introduce an outlier at data point number 18
y[18] <- 5

# Plot I chart
qic(y, chart = 'i')

## ----pudata-------------------------------------------------------------------
# Setup parameters
m.beds       <- 300
m.stay       <- 4
m.days       <- m.beds * 7
m.discharges <- m.days / m.stay
p.pu         <- 0.08

# Simulate data
discharges  <- rpois(24, lambda = m.discharges)
patientdays <- round(rnorm(24, mean = m.days, sd = 100))
n.pu        <- rpois(24, lambda = m.discharges * p.pu * 1.5)
n.pat.pu    <- rbinom(24, size = discharges, prob = p.pu)
week        <- seq(as.Date('2014-1-1'),
                    length.out = 24, 
                    by         = 'week') 

# Combine data into a data frame
d <- data.frame(week, discharges, patientdays,n.pu, n.pat.pu)
d

## ----fig3, fig.cap='Figure 3: C chart displaying the number of defects'-------
qic(n.pu,
    x     = week,
    data  = d,
    chart = 'c',
    main  = 'Hospital acquired pressure ulcers (C chart)',
    ylab  = 'Count',
    xlab  = 'Week')

## ----fig4, fig.cap='Figure 4: U chart displaying the rate of defects'---------
qic(n.pu, 
    n        = patientdays,
    x        = week,
    data     = d,
    chart    = 'u',
    multiply = 1000,
    main     = 'Hospital acquired pressure ulcers (U chart)',
    ylab     = 'Count per 1000 patient days',
    xlab     = 'Week')

## ----fig5, fig.cap='Figure 5: P chart displaying the percent of defectives'----
qic(n.pat.pu,
    n        = discharges,
    x        = week,
    data     = d,
    chart    = 'p',
    multiply = 100,
    main     = 'Hospital acquired pressure ulcers (P chart)',
    ylab     = 'Percent patients',
    xlab     = 'Week')

## ----fig6, fig.cap='Figure 6: G chart displaying the number of units produced between defectives'----
# Create vector of random values from a geometric distribution
d <- c(NA, rgeom(23, 0.08))
d

# Plot G chart
qic(d,
    chart = 'g',
    main  = 'Patients between pressure ulcers (G chart)',
    ylab  = 'Count',
    xlab  = 'Discharge no.')

## ----fig7, fig.cap='Figure 7: I chart for individual measurements'------------
# Vector of birth weights from 24 babies
y <- round(rnorm(24, mean = 3400, sd = 400))
y

# Plot I chart of individual birth weights
qic(y,
    chart = 'i',
    main  = 'Birth weight (I chart)',
    ylab  = 'Grams',
    xlab  = 'Baby no.')

## ----fig8, fig.cap='Figure 8: Moving range chart'-----------------------------
# Plot moving ranges
qic(y,
    chart = 'mr',
    main  = 'Pairwise differences in birth weights (MR chart)',
    ylab  = 'Grams',
    xlab  = 'Baby no.')


## ----fig9, fig.cap='Figure 9: Xbar chart of average measurements'-------------
# Vector of 24 subgroup sizes (average = 12)
sizes <- rpois(24, 12)

# Vector of dates identifying subgroups
date <- seq(as.Date('2015-1-1'), length.out = 24, by = 'day')
date <- rep(date, sizes)

# Vector of birth weights
y <- round(rnorm(sum(sizes), 3400, 400))

# Data frame of birth weights and dates
d <- data.frame(y, date)
head(d, 24)

# Plot Xbar chart of average birth weights by date of birth
qic(y, 
    x     = date, 
    data  = d,
    chart = 'xbar',
    main  = 'Average birth weight (Xbar chart)',
    ylab  = 'Grams',
    xlab  = 'Date')

## ----fig10, fig.cap='Figure 10: S chart of within subgroup standard deviations'----
# Plot S chart of within subgroup standard deviation
qic(y, 
    x = date, 
    data = d,
    chart = 's',
    main = 'Standard deviation of birth weight (S chart)',
    ylab = 'Grams',
    xlab = 'Date')

## ----fig11, fig.cap='Figure 11: T chart displaying time between events'-------
# Pick 24 random dates and sort them
dates  <- seq(as.Date('2015-1-1'), as.Date('2015-12-31'), by = 'day')
events <- sort(sample(dates, 24))
events

# Vector of time (days) between events
d <- c(NA, diff(events))
d

# Plot T chart of days between events
qic(d,
    chart = 't',
    main  = 'Days between pressure ulcers (T chart)',
    ylab  = 'Days',
    xlab  = 'Pressure ulcer no.')

## ----fig12, fig.cap='Figure 12: Standardised P chart'-------------------------
# Rebuild data frame from figure 5
d <- data.frame(n.pat.pu, discharges, week)

# Plot standardised P chart
qic(n.pat.pu, 
    n            = discharges,
    x            = week, 
    data         = d,
    chart        = 'p',
    standardised = TRUE,
    main         = 'Patients with hospital acquired pressure ulcers (Standardised P chart)',
    ylab         = 'Standard deviations',
    xlab         = 'Week')

## ----fig13, fig.cap='Figure 13: Prime P chart'--------------------------------
# Plot prime P chart
qic(n.pat.pu, discharges, week, d,
    chart    = 'p',
    multiply = 100,
    main     = 'Prime P chart of patients with pressure ulcer',
    ylab     = 'Percent',
    xlab     = 'Week',
    prime    = TRUE)