[R] Need help installing qtoolbox

[Joe Conway]

Toby Popenfoose wrote:
> 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)