Is there another control chart library for R that I should be trying instead?
I looked around and could not find an R package for Shewhart control charts. I'll post the function I wrote for my own needs, but note that I am not a statistician, nor am I particularly experienced with R -- so use at your own risk ;-)
It only does X-bar, R, and geometric moving average. I used the "traditional" calculations (i.e. use constants based on sample group size, and range, to calculate UCL/LCL) instead of a more rigorous approach.
Below is the function and an example of how to use it (if anyone has suggestions for improvement, I'd love to hear them).
HTH,
Joe
8<-------------------------
controlChart <- function(xdata, ssize, CLnumGroups = 0) { if (!is.vector(xdata)) stop("Data must be a vector")
if (!is.numeric(xdata)) stop("Data vector must be numeric")
xdatalen <- length(xdata) xdataresid <- xdatalen %% ssize newxdatalen <- xdatalen - xdataresid if (xdataresid != 0) xdata <- xdata[1:newxdatalen]
if (ssize < 1 | ssize > 10) { stop("Sample size must be in the range of 1 to 10") } else if (ssize > 1 & ssize < 11) { # Xbar/R factors ng <- c(2:10) D3 <- c(0,0,0,0,0,0.08,0.14,0.18,0.22) D4 <- c(3.27,2.57,2.28,2.11,2.00,1.92,1.86,1.82,1.78) A2 <- c(1.88,1.02,0.73,0.58,0.48,0.42,0.37,0.34,0.31) d2 <- c(1.13,1.69,2.06,2.33,2.53,2.70,2.85,2.97,3.08) v <- data.frame(ng, D3, D4, A2, d2)
# put into sample groups m <- matrix(xdata, ncol = ssize, byrow = TRUE)
# number of groups numgroups <- nrow(m)
# Adjust number of points used to calculate control limits. if (numgroups < CLnumGroups | CLnumGroups == 0) CLnumGroups = numgroups
# range for each group r <- apply(m, 1, range) r <- r[2,] - r[1,]
# Rbar rb <- mean(r[1:CLnumGroups]) rb <- rep(rb, numgroups)
# R UCL and LCL rucl <- v$D4[match(ssize,v$ng) + 1] * rb rlcl <- v$D3[match(ssize,v$ng) + 1] * rb
# Xbar xb <- apply(m, 1, mean)
# Xbarbar xbb <- mean(xb[1:numgroups]) xbb <- rep(xbb, numgroups)
# X UCL and LCL xucl <- xbb + (v$A2[match(ssize,v$ng) + 1] * rb) xlcl <- xbb - (v$A2[match(ssize,v$ng) + 1] * rb) } else #sample size is 1 { m <- xdata
# number of groups numgroups <- length(m)
# Adjust number of points used to calculate control limits. if (numgroups < CLnumGroups | CLnumGroups == 0) CLnumGroups = numgroups
# set range for each group to 0 r <- rep(0, numgroups)
# Rbar rb <- rep(0, numgroups)
# R UCL and LCL rucl <- rep(0, numgroups) rlcl <- rep(0, numgroups)
# Xbar is a copy of the individual data points xb <- m
# Xbarbar is mean over the data xbb <- mean(xb[1:CLnumGroups]) xbb <- rep(xbb, numgroups)
# standard deviation over the data xsd <- sd(xb[1:CLnumGroups])
# X UCL and LCL xucl <- xbb + 3 * xsd xlcl <- xbb - 3 * xsd }
# geometric moving average if (numgroups > 1) { rg <- 0.25 gma = c(xb[1]) for(i in 2:numgroups) gma[i] = (rg * xb[i]) + ((1 - rg) * gma[i - 1]) } else { gma <- rep(0, numgroups) }
# create a single dataframe with all the plot data
controlChartSummary <- data.frame(1:numgroups, xb, xbb, xucl, xlcl, r, rb, rucl, rlcl, gma)
return(controlChartSummary) }
# sample data xdata <- 12 + 4 * rnorm(90) # sample size ssize <- 3 # get control chart data cc <- controlChart(xdata, ssize) # get number of sample groups numgroups <- length(cc$xb)
# X Bar chart plotxrange <- range(c(1:numgroups)) plotyrange <- range(cc$xb, cc$xucl, cc$xlcl) plotyrange[1] <- plotyrange[1] - (plotyrange[2] - plotyrange[1]) * 0.1 plotyrange[2] <- plotyrange[2] + (plotyrange[2] - plotyrange[1]) * 0.1
plot(c(1:numgroups), xlim = plotxrange, ylim = plotyrange, cc$xb, type = "b", lty = 1)
lines(c(1:numgroups), cc$xbb, lty = 1)
lines(c(1:numgroups), cc$xucl, lty = 1)
lines(c(1:numgroups), cc$xlcl, lty = 1)
# R chart plotxrange <- range(c(1:numgroups)) plotyrange <- range(cc$r, cc$rucl, cc$rlcl) plotyrange[1] <- plotyrange[1] - (plotyrange[2] - plotyrange[1]) * 0.1 plotyrange[2] <- plotyrange[2] + (plotyrange[2] - plotyrange[1]) * 0.1
plot(c(1:numgroups), xlim = plotxrange, ylim = plotyrange, cc$r, type = "b", lty = 1)
lines(c(1:numgroups), cc$rb, lty = 1)
lines(c(1:numgroups), cc$rucl, lty = 1)
lines(c(1:numgroups), cc$rlcl, lty = 1)
# Geometric Moving Average chart plotxrange <- range(c(1:numgroups)) plotyrange <- range(cc$gma) plotyrange[1] <- plotyrange[1] - (plotyrange[2] - plotyrange[1]) * 0.1 plotyrange[2] <- plotyrange[2] + (plotyrange[2] - plotyrange[1]) * 0.1
plot(c(1:numgroups), xlim = plotxrange, ylim = plotyrange, cc$gma, type = "b", lty = 1)
______________________________________________ [EMAIL PROTECTED] mailing list https://www.stat.math.ethz.ch/mailman/listinfo/r-help