Extensions

Extensions to other charts and/or estimation procedures

The framework provided in this package can be easily extended to work with different charts and/or estimation procedures. The following are some examples of extensions.

Robust estimation

The following defines a CUSUM chart using normality assumptions to estimate the in-control distribution using Median and MAD. Only the method Pofdata of the data model needs to be modified.

library(spcadjust)
model <- SPCModelNormal(Delta=1)
model$Pofdata
## function (data) 
## {
##     list(mu = mean(data), sd = sd(data), m = length(data))
## }
## <environment: 0x4b1fe30>
model$Pofdata <- function(data){
      list(mu= median(data), sd= mad(data), m=length(data))
}

Properties of this chart can then be computed as before:

X <-  rnorm(100)
chartrobust <- new("SPCCUSUM",model=model)
SPCproperty(data=X,nrep=50,property="calARL",
            chart=chartrobust,params=list(target=100),quiet=TRUE)
## 90 % CI: A threshold of 3.438 gives an in-control ARL of at least
##   100. 
## Unadjusted result:  2.322 
## Based on  50 bootstrap repetitions.

Parametric exponential CUSUM chart

The following defines a class that defines a CUSUM chart for exponentially distributed data with parametric resampling.

SPCModelExponential=function(Delta=1){
    structure(
        list(
            Pofdata=function(data){
                list(lambda=1/mean(data), n=length(data))
            },
            xiofP=function(P) P$lambda,
            resample=function(P) rexp(P$n,rate=P$lambda),
            getcdfupdates=function(P, xi) {
                function(x){ if(Delta<1)
                                 pmax(0,1-exp(-P$lambda*(x-log(Delta))/(xi*(1-Delta))))
                else
                    pmin(1,exp(-P$lambda*(log(Delta)-x)/(xi*(Delta-1))))
                         }
            },
            updates=function(xi,data) log(Delta)-xi*(Delta-1)*data),
        class="SPCDataModel")
}

ExpCUSUMchart=new("SPCCUSUM",model=SPCModelExponential(Delta=1.25))

The following creates some past observations, estimates that chart parameters and runs a chart for 100 steps with new observations.

X <- rexp(1000)
plot(runchart(ExpCUSUMchart, newdata=rexp(100),xi=xiofdata(ExpCUSUMchart,X)),
     ylab=expression(S[t]),xlab="t",type="b")

plot of chunk unnamed-chunk-5

The following computes various properties of the chart. For real applications increase the number of bootstrap replications (the argument nrep) and consider using parallel processing (the argument parallel).

SPCproperty(data=X,nrep=100,property="hitprob",
chart=ExpCUSUMchart,params=list(threshold=1,nsteps=100),
covprob=c(0.5,0.9),quiet=TRUE)
## 50 % CI: A threshold of 1 gives an in-control false alarm
##   probability of at most 0.8855 within 100 steps. 
## 90 % CI: A threshold of 1 gives an in-control false alarm
##   probability of at most 0.9301 within 100 steps. 
## Unadjusted result:  0.8922 
## Based on  100 bootstrap repetitions.
SPCproperty(data=X,nrep=100,property="ARL",
            chart=ExpCUSUMchart,params=list(threshold=3),covprob=c(0.5,0.9),quiet=TRUE)
## 50 % CI: A threshold of 3 gives an in-control ARL of at least
##   873.1. 
## 90 % CI: A threshold of 3 gives an in-control ARL of at least
##   486.9. 
## Unadjusted result:  889.7 
## Based on  100 bootstrap repetitions.
SPCproperty(data=X,nrep=100,property="calARL",chart=ExpCUSUMchart,
            params=list(target=1000),covprob=c(0.5,0.9),quiet=TRUE) 
## 50 % CI: A threshold of 3.214 gives an in-control ARL of at least
##   1000. 
## 90 % CI: A threshold of 3.982 gives an in-control ARL of at least
##   1000. 
## Unadjusted result:  3.165 
## Based on  100 bootstrap repetitions.

To make a CUSUM plot with thresholds:

cal <- SPCproperty(data=X,nrep=1000,property="calARL",chart=ExpCUSUMchart,
                   params=list(target=1000),quiet=TRUE,parallel=1)
S <- runchart(ExpCUSUMchart, newdata=rexp(100),xi=xiofdata(ExpCUSUMchart,X))
par(mfrow=c(1,1),mar=c(4,5,0,0))
plot(S,ylab=expression(S[t]),xlab="t",type="b",ylim=range(S,cal@res+1,cal@raw))
lines(c(0,100),rep(cal@res,2),col="red")
lines(c(0,100),rep(cal@raw,2),col="blue")
legend("topleft",c("Adjusted Threshold","Unadjusted Threshold"),col=c("red","blue"),lty=1)

plot of chunk unnamed-chunk-7