R : Copyright 2005, The R Foundation for Statistical Computing
Version 2.1.1  (2005-06-20), ISBN 3-900051-07-0

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for a HTML browser interface to help.
Type 'q()' to quit R.

> ### * <HEADER>
> ###
> attach(NULL, name = "CheckExEnv")
> assign(".CheckExEnv", as.environment(2), pos = length(search())) # base
> ## add some hooks to label plot pages for base and grid graphics
> setHook("plot.new", ".newplot.hook")
> setHook("persp", ".newplot.hook")
> setHook("grid.newpage", ".gridplot.hook")
> 
> assign("cleanEx",
+        function(env = .GlobalEnv) {
+ 	   rm(list = ls(envir = env, all.names = TRUE), envir = env)
+            RNGkind("default", "default")
+ 	   set.seed(1)
+    	   options(warn = 1)
+ 	   delayedAssign("T", stop("T used instead of TRUE"),
+ 		  assign.env = .CheckExEnv)
+ 	   delayedAssign("F", stop("F used instead of FALSE"),
+ 		  assign.env = .CheckExEnv)
+ 	   sch <- search()
+ 	   newitems <- sch[! sch %in% .oldSearch]
+ 	   for(item in rev(newitems))
+                eval(substitute(detach(item), list(item=item)))
+ 	   missitems <- .oldSearch[! .oldSearch %in% sch]
+ 	   if(length(missitems))
+ 	       warning("items ", paste(missitems, collapse=", "),
+ 		       " have been removed from the search path")
+        },
+        env = .CheckExEnv)
> assign("..nameEx", "__{must remake R-ex/*.R}__", env = .CheckExEnv) # for now
> assign("ptime", proc.time(), env = .CheckExEnv)
> grDevices::postscript("spc-Examples.ps")
> assign("par.postscript", graphics::par(no.readonly = TRUE), env = .CheckExEnv)
> options(contrasts = c(unordered = "contr.treatment", ordered = "contr.poly"))
> options(warn = 1)    
> library('spc')
> 
> assign(".oldSearch", search(), env = .CheckExEnv)
> assign(".oldNS", loadedNamespaces(), env = .CheckExEnv)
> cleanEx(); ..nameEx <- "xcusum.ad"
> 
> ### * xcusum.ad
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xcusum.ad
> ### Title: Compute steady-state ARLs of CUSUM control charts
> ### Aliases: xcusum.ad
> ### Keywords: ts
> 
> ### ** Examples
> 
> ## comparison of zero-state (= worst case ) and steady-state performance
> ## for one-sided CUSUM control charts
> 
> k <- .5
> h <- xcusum.crit(k,500)
> mu <- c(0,.5,1,1.5,2)
> arl <- sapply(mu,k=k,h=h,xcusum.arl)
> ad <- sapply(mu,k=k,h=h,xcusum.ad)
> round(cbind(mu,arl,ad),digits=2)
     mu    arl     ad
arl 0.0 500.00 495.11
arl 0.5  30.85  29.45
arl 1.0   9.16   8.47
arl 1.5   5.14   4.70
arl 2.0   3.60   3.30
> 
> ## Crosier (1986), Crosier's modified two-sided CUSUM
> ## He introduced the modification and evaluated it by means of
> ## Markov chain approximation
> 
> k <- .5
> h2 <- 4
> hC <- 3.73
> mu <- c(0,.25,.5,.75,1,1.5,2,2.5,3,4,5)
> ad2 <- sapply(mu,k=k,h=h2,sided="two",r=20,xcusum.ad)
> adC <- sapply(mu,k=k,h=hC,sided="Crosier",xcusum.ad)
> round(cbind(mu,ad2,adC),digits=2)
     mu    ad2    adC
ad 0.00 162.29 164.65
ad 0.25  71.51  69.07
ad 0.50  25.24  24.37
ad 0.75  12.37  12.17
ad 1.00   7.72   7.70
ad 1.50   4.33   4.40
ad 2.00   3.05   3.12
ad 2.50   2.39   2.47
ad 3.00   2.01   2.07
ad 4.00   1.55   1.60
ad 5.00   1.22   1.29
> 
> ## results in the original paper are (in Table 5)
> ## 0.00 163.   164.
> ## 0.25  71.6   69.0
> ## 0.50  25.2   24.3
> ## 0.75  12.3   12.1
> ## 1.00   7.68   7.69
> ## 1.50   4.31   4.39
> ## 2.00   3.03   3.12
> ## 2.50   2.38   2.46
> ## 3.00   2.00   2.07
> ## 4.00   1.55   1.60
> ## 5.00   1.22   1.29.
> 
> 
> 
> cleanEx(); ..nameEx <- "xcusum.arl"
> 
> ### * xcusum.arl
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xcusum.arl
> ### Title: Compute ARLs of CUSUM control charts
> ### Aliases: xcusum.arl
> ### Keywords: ts
> 
> ### ** Examples
> 
> ## Brook/Evans (1972), one-sided CUSUM
> ## Their results are based on the less accurate Markov chain approach.
> 
> k <- .5
> h <- 3
> round(c( xcusum.arl(k,h,0), xcusum.arl(k,h,1.5) ),digits=2)
   arl    arl 
117.60   3.75 
> 
> ## results in the original paper are L0 = 117.59, L1 = 3.75 (in Subsection 4.3).
> 
> ## Lucas, Crosier (1982)
> ## (one- and) two-sided CUSUM with possible headstarts
> 
> k <- .5
> h <- 4
> mu <- c(0,.25,.5,.75,1,1.5,2,2.5,3,4,5)
> arl1 <- sapply(mu,k=k,h=h,sided="two",xcusum.arl)
> arl2 <- sapply(mu,k=k,h=h,hs=h/2,sided="two",xcusum.arl)
> round(cbind(mu,arl1,arl2),digits=2)
      mu   arl1   arl2
arl 0.00 167.68 148.70
arl 0.25  74.22  62.70
arl 0.50  26.63  20.06
arl 0.75  13.29   8.97
arl 1.00   8.38   5.29
arl 1.50   4.75   2.86
arl 2.00   3.34   2.01
arl 2.50   2.62   1.59
arl 3.00   2.19   1.33
arl 4.00   1.71   1.07
arl 5.00   1.31   1.01
> 
> ## results in the original paper are (in Table 1)
> ## 0.00 168.   149.
> ## 0.25  74.2   62.7
> ## 0.50  26.6   20.1
> ## 0.75  13.3    8.97
> ## 1.00   8.38   5.29
> ## 1.50   4.75   2.86
> ## 2.00   3.34   2.01
> ## 2.50   2.62   1.59
> ## 3.00   2.19   1.32
> ## 4.00   1.71   1.07
> ## 5.00   1.31   1.01.
> 
> ## Vance (1986), one-sided CUSUM
> ## The first paper on using Nyström method and Gauss-Legendre quadrature
> ## for solving the ARL integral equation (see as well Goel/Wu, 1971)
> 
> k <- 0
> h <- 10
> mu <- c(-.25,-.125,0,.125,.25,.5,.75,1)
> round(cbind(mu,sapply(mu,k=k,h=h,xcusum.arl)),digits=2)
       mu        
arl -0.25 2071.57
arl -0.12  400.28
arl  0.00  124.66
arl  0.12   59.30
arl  0.25   36.71
arl  0.50   20.37
arl  0.75   14.06
arl  1.00   10.75
> 
> ## results in the original paper are (in Table 1 incl. Goel/Wu (1971) results)
> ##  -0.25  2071.51
> ##  -0.125  400.28
> ##   0.0    124.66
> ##   0.125   59.30
> ##   0.25    36.71
> ##   0.50    20.37
> ##   0.75    14.06
> ##   1.00    10.75.
> 
> ## Waldmann (1986),
> ## one- and two-sided CUSUM
> 
> ## one-sided case
> 
> k <- .5
> h <- 3
> mu <- c(-.5,0,.5)
> round(sapply(mu,k=k,h=h,xcusum.arl),digits=2)
    arl     arl     arl 
1962.79  117.60   17.35 
> 
> ## results in the original paper are 1963, 117.4, and 17.35, resp.
> ## (in Tables 3, 1, and 5, resp.).
> 
> ## two-sided case
> 
> k <- .6
> h <- 3
> round(xcusum.arl(k,h,-.2,sided="two"),digits=1)  # fits to Waldmann's setup
 arl 
65.5 
> 
> ## result in the original paper is 65.4 (in Table 6).
> 
> ## Crosier (1986), Crosier's modified two-sided CUSUM
> ## He introduced the modification and evaluated it by means of
> ## Markov chain approximation
> 
> k <- .5
> h <- 3.73
> mu <- c(0,.25,.5,.75,1,1.5,2,2.5,3,4,5)
> round(cbind(mu,sapply(mu,k=k,h=h,sided="Crosier",xcusum.arl)),digits=2)
      mu       
arl 0.00 167.97
arl 0.25  70.67
arl 0.50  25.05
arl 0.75  12.53
arl 1.00   7.92
arl 1.50   4.49
arl 2.00   3.17
arl 2.50   2.49
arl 3.00   2.09
arl 4.00   1.60
arl 5.00   1.22
> 
> ## results in the original paper are (in Table 3)
> ## 0.00 168.
> ## 0.25  70.7
> ## 0.50  25.1
> ## 0.75  12.5
> ## 1.00   7.92
> ## 1.50   4.49
> ## 2.00   3.17
> ## 2.50   2.49
> ## 3.00   2.09
> ## 4.00   1.60
> ## 5.00   1.22.
> 
> ## SAS/QC manual 1999
> ## one- and two-sided CUSUM schemes
> 
> ## one-sided
> 
> k <- .25
> h <- 8
> mu <- 2.5
> print(xcusum.arl(k,h,mu),digits=12)
          arl 
4.15008372612 
> print(xcusum.arl(k,h,mu,hs=.1),digits=12)
          arl 
4.10615883504 
> 
> ## original results are 4.1500836225 and 4.1061588131.
> 
> ## two-sided
> 
> print(xcusum.arl(k,h,mu,sided="two"),digits=12)
          arl 
4.15008372612 
> 
> ## original result is 4.1500826715.
> 
> 
> 
> cleanEx(); ..nameEx <- "xcusum.crit"
> 
> ### * xcusum.crit
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xcusum.crit
> ### Title: Compute decision intervals of CUSUM control charts
> ### Aliases: xcusum.crit
> ### Keywords: ts
> 
> ### ** Examples
> 
> k <- .5
> incontrolARL <- c(500,5000,50000)
> sapply(incontrolARL,k=k,xcusum.crit,r=10) # accuracy with 10 nodes
       h        h        h 
4.389130 6.668984 8.916362 
> sapply(incontrolARL,k=k,xcusum.crit,r=20) # accuracy with 20 nodes
       h        h        h 
4.389130 6.669267 8.968762 
> sapply(incontrolARL,k=k,xcusum.crit)      # accuracy with 30 nodes
       h        h        h 
4.389130 6.669267 8.968762 
> 
> 
> 
> cleanEx(); ..nameEx <- "xewma.ad"
> 
> ### * xewma.ad
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xewma.ad
> ### Title: Compute steady-state ARLs of EWMA control charts
> ### Aliases: xewma.ad
> ### Keywords: ts
> 
> ### ** Examples
> 
> ## comparison of zero-state (= worst case ) and steady-state performance
> ## for two-sided EWMA control charts
> 
> l <- .1
> c <- xewma.crit(l,500,sided="two")
> mu <- c(0,.5,1,1.5,2)
> arl <- sapply(mu,l=l,c=c,sided="two",xewma.arl)
> ad <- sapply(mu,l=l,c=c,sided="two",xewma.ad)
> round(cbind(mu,arl,ad),digits=2)
     mu    arl     ad
arl 0.0 500.00 492.26
arl 0.5  31.31  30.58
arl 1.0  10.33  10.12
arl 1.5   6.08   5.99
arl 2.0   4.36   4.31
> 
> ## Lucas/Saccucci (1990)
> ## Lucas/Saccucci (1990)
> ## two-sided EWMA
> 
> ## with fixed limits
> l1 <- .5
> l2 <- .03
> c1 <- 3.071
> c2 <- 2.437
> mu <- c(0,.25,.5,.75,1,1.5,2,2.5,3,3.5,4,5)
> ad1 <- sapply(mu,l=l1,c=c1,sided="two",xewma.ad)
> ad2 <- sapply(mu,l=l2,c=c2,sided="two",xewma.ad)
> round(cbind(mu,ad1,ad2),digits=2)
     mu    ad1    ad2
ad 0.00 498.77 479.52
ad 0.25 254.07  74.03
ad 0.50  88.41  28.55
ad 0.75  35.68  17.29
ad 1.00  17.32  12.40
ad 1.50   6.44   7.98
ad 2.00   3.58   5.94
ad 2.50   2.47   4.77
ad 3.00   1.91   4.01
ad 3.50   1.58   3.48
ad 4.00   1.36   3.09
ad 5.00   1.10   2.55
> 
> ## original results are (in Table 3)
> ## 0.00 499.   480.  
> ## 0.25 254.    74.1
> ## 0.50  88.4   28.6
> ## 0.75  35.7   17.3
> ## 1.00  17.3   12.5
> ## 1.50   6.44   8.00
> ## 2.00   3.58   5.95
> ## 2.50   2.47   4.78
> ## 3.00   1.91   4.02
> ## 3.50   1.58   3.49
> ## 4.00   1.36   3.09
> ## 5.00   1.10   2.55.
> 
> 
> 
> cleanEx(); ..nameEx <- "xewma.arl"
> 
> ### * xewma.arl
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xewma.arl
> ### Title: Compute ARLs of EWMA control charts
> ### Aliases: xewma.arl
> ### Keywords: ts
> 
> ### ** Examples
> 
> ## Waldmann (1986), one-sided EWMA
> l <- .75
> round(xewma.arl(l,2*sqrt((2-l)/l),0,zr=-4*sqrt((2-l)/l)),digits=1)
  arl 
209.3 
> l <- .5
> round(xewma.arl(l,2*sqrt((2-l)/l),0,zr=-4*sqrt((2-l)/l)),digits=1)
   arl 
3906.1 
> ## original values are 209.3 and 3907.5 (in Table 2).
> 
> ## Waldmann (1986), two-sided EWMA with fixed control limits
> l <- .75
> round(xewma.arl(l,2*sqrt((2-l)/l),0,sided="two"),digits=1)
arl 
104 
> l <- .5
> round(xewma.arl(l,2*sqrt((2-l)/l),0,sided="two"),digits=1)
   arl 
1951.6 
> ## original values are 104.0 and 1952 (in Table 1).
> 
> ## Crowder (1987), two-sided EWMA with fixed control limits
> l1 <- .5
> l2 <- .05
> c <- 2
> mu <- (0:16)/4
> arl1 <- sapply(mu,l=l1,c=c,sided="two",xewma.arl)
> arl2 <- sapply(mu,l=l2,c=c,sided="two",xewma.arl)
> round(cbind(mu,arl1,arl2),digits=2)
      mu  arl1   arl2
arl 0.00 26.45 127.53
arl 0.25 20.12  43.94
arl 0.50 11.89  18.97
arl 0.75  7.29  11.64
arl 1.00  4.91   8.38
arl 1.25  3.59   6.56
arl 1.50  2.80   5.41
arl 1.75  2.29   4.62
arl 2.00  1.95   4.04
arl 2.25  1.70   3.61
arl 2.50  1.51   3.26
arl 2.75  1.37   2.99
arl 3.00  1.26   2.76
arl 3.25  1.18   2.56
arl 3.50  1.12   2.39
arl 3.75  1.08   2.26
arl 4.00  1.05   2.15
> 
> ## original results are (in Table 1)
> ## 0.00 26.45 127.53
> ## 0.25 20.12  43.94
> ## 0.50 11.89  18.97
> ## 0.75  7.29  11.64
> ## 1.00  4.91   8.38
> ## 1.25  3.95*  6.56
> ## 1.50  2.80   5.41
> ## 1.75  2.29   4.62
> ## 2.00  1.94   4.04
> ## 2.25  1.70   3.61
> ## 2.50  1.51   3.26
> ## 2.75  1.37   2.99
> ## 3.00  1.26   2.76
> ## 3.25  1.18   2.56
> ## 3.50  1.12   2.39
> ## 3.75  1.08   2.26
> ## 4.00  1.05   2.15  (* -- in Crowder (1987) typo!?). 
> 
> ## Lucas/Saccucci (1990)
> ## two-sided EWMA
> 
> ## with fixed limits
> l1 <- .5
> l2 <- .03
> c1 <- 3.071
> c2 <- 2.437
> mu <- c(0,.25,.5,.75,1,1.5,2,2.5,3,3.5,4,5)
> arl1 <- sapply(mu,l=l1,c=c1,sided="two",xewma.arl)
> arl2 <- sapply(mu,l=l2,c=c2,sided="two",xewma.arl)
> round(cbind(mu,arl1,arl2),digits=2)
      mu   arl1   arl2
arl 0.00 499.91 499.86
arl 0.25 254.78  76.73
arl 0.50  88.80  29.32
arl 0.75  35.91  17.63
arl 1.00  17.48  12.60
arl 1.50   6.53   8.07
arl 2.00   3.63   5.99
arl 2.50   2.50   4.80
arl 3.00   1.93   4.03
arl 3.50   1.58   3.49
arl 4.00   1.34   3.11
arl 5.00   1.07   2.55
> 
> ## original results are (in Table 3)
> ## 0.00 500.   500.
> ## 0.25 255.    76.7
> ## 0.50  88.8   29.3
> ## 0.75  35.9   17.6
> ## 1.00  17.5   12.6
> ## 1.50   6.53   8.07
> ## 2.00   3.63   5.99
> ## 2.50   2.50   4.80
> ## 3.00   1.93   4.03
> ## 3.50   1.58   3.49
> ## 4.00   1.34   3.11
> ## 5.00   1.07   2.55.
> 
> ## with fir feature
> l1 <- .5
> l2 <- .03
> c1 <- 3.071
> c2 <- 2.437
> hs1 <- c1/2
> hs2 <- c2/2
> mu <- c(0,.5,1,2,3,5)
> arl1 <- sapply(mu,l=l1,c=c1,hs=hs1,sided="two",limits="fir",xewma.arl)
> arl2 <- sapply(mu,l=l2,c=c2,hs=hs2,sided="two",limits="fir",xewma.arl)
> round(cbind(mu,arl1,arl2),digits=2)
     mu   arl1   arl2
arl 0.0 493.03 404.59
arl 0.5  85.89  18.40
arl 1.0  15.91   7.34
arl 2.0   2.87   3.43
arl 3.0   1.45   2.34
arl 5.0   1.01   1.57
> 
> ## original results are (in Table 5)
> ## 0.0 487.   406.
> ## 0.5  86.1   18.4
> ## 1.0  15.9    7.36
> ## 2.0   2.87   3.43
> ## 3.0   1.45   2.34
> ## 5.0   1.01   1.57.
> 
> ## Chandrasekaran, English, Disney (1995)
> ## two-sided EWMA with fixed and variance adjusted limits (vacl)
> 
> l1 <- .25
> l2 <- .1
> c1s <- 2.9985
> c1n <- 3.0042
> c2s <- 2.8159
> c2n <- 2.8452
> mu <- c(0,.25,.5,.75,1,2)
> arl1s <- sapply(mu,l=l1,c=c1s,sided="two",xewma.arl)
> arl1n <- sapply(mu,l=l1,c=c1n,sided="two",limits="vacl",xewma.arl)
> arl2s <- sapply(mu,l=l2,c=c2s,sided="two",xewma.arl)
> arl2n <- sapply(mu,l=l2,c=c2n,sided="two",limits="vacl",xewma.arl)
> round(cbind(mu,arl1s,arl1n,arl2s,arl2n),digits=2)
      mu  arl1s  arl1n  arl2s  arl2n
arl 0.00 500.60 505.47 502.16 530.77
arl 0.25 170.49 170.77 106.64 107.10
arl 0.50  48.33  47.64  31.35  29.46
arl 0.75  20.13  19.40  15.87  13.84
arl 1.00  11.14  10.44  10.34   8.33
arl 2.00   3.61   2.94   4.37   2.69
> 
> ## original results are (in Table 2)
> ## 0.00 500.   500.   500.   500.
> ## 0.25 170.09 167.54 105.90  96.6
> ## 0.50  48.14  45.65  31.08  24.35
> ## 0.75  20.02  19.72  15.71  10.74
> ## 1.00  11.07   9.37  10.23   6.35
> ## 2.00   3.59   2.64   4.32   2.73.
> 
> ## The results in Chandrasekaran, English, Disney (1995) are not
> ## that accurate. Let us consider the more appropriate comparison
> 
> c1s <- xewma.crit(l1,500,sided="two")
> c1n <- xewma.crit(l1,500,sided="two",limits="vacl")
> c2s <- xewma.crit(l2,500,sided="two")
> c2n <- xewma.crit(l2,500,sided="two",limits="vacl")
> mu <- c(0,.25,.5,.75,1,2)
> arl1s <- sapply(mu,l=l1,c=c1s,sided="two",xewma.arl)
> arl1n <- sapply(mu,l=l1,c=c1n,sided="two",limits="vacl",xewma.arl)
> arl2s <- sapply(mu,l=l2,c=c2s,sided="two",xewma.arl)
> arl2n <- sapply(mu,l=l2,c=c2n,sided="two",limits="vacl",xewma.arl)
> round(cbind(mu,arl1s,arl1n,arl2s,arl2n),digits=2)
      mu  arl1s  arl1n  arl2s  arl2n
arl 0.00 500.00 500.00 500.00 500.00
arl 0.25 170.34 169.34 106.37 103.32
arl 0.50  48.30  47.36  31.31  28.81
arl 0.75  20.12  19.31  15.85  13.61
arl 1.00  11.14  10.41  10.33   8.21
arl 2.00   3.61   2.94   4.36   2.66
> 
> ## which demonstrate the abilities of the variance-adjusted limits
> ## scheme more explicitely.
> 
> ## Rhoads, Montgomery, Mastrangelo (1996)
> ## two-sided EWMA with fixed and variance adjusted limits (vacl),
> ## with fir and both features
> 
> l <- .03
> c <- 2.437
> mu <- c(0,.5,1,1.5,2,3,4)
> sl <- sqrt(l*(2-l))
> arlfix  <- sapply(mu,l=l,c=c,sided="two",xewma.arl)
> arlvacl <- sapply(mu,l=l,c=c,sided="two",limits="vacl",xewma.arl)
> arlfir  <- sapply(mu,l=l,c=c,hs=c/2,sided="two",limits="fir",xewma.arl)
> arlboth <- sapply(mu,l=l,c=c,hs=c/2*sl,sided="two",limits="both",xewma.arl)
> round(cbind(mu,arlfix,arlvacl,arlfir,arlboth),digits=1)
     mu arlfix arlvacl arlfir arlboth
arl 0.0  499.9   445.0  404.6   305.4
arl 0.5   29.3    20.4   18.4    12.6
arl 1.0   12.6     6.4    7.3     3.7
arl 1.5    8.1     3.4    4.6     1.9
arl 2.0    6.0     2.2    3.4     1.3
arl 3.0    4.0     1.3    2.3     1.0
arl 4.0    3.1     1.1    1.9     1.0
> 
> ## original results are (in Table 1)
> ## 0.0 477.3* 427.9* 383.4* 286.2*
> ## 0.5  29.7   20.0   18.6   12.8
> ## 1.0  12.5    6.5    7.4    3.6
> ## 1.5   8.1    3.3    4.6    1.9
> ## 2.0   6.0    2.2    3.4    1.4
> ## 3.0   4.0    1.3    2.4    1.0
> ## 4.0   3.1    1.1    1.9    1.0
> ## * -- the in-control values differ sustainably from the true values!
> 
> ## Steiner (1999)
> ## two-sided EWMA control charts with various modifications
> 
> ## fixed vs. variance adjusted limits
> 
> l <- .05
> c <- 3
> mu <- c(0,.25,.5,.75,1,1.5,2,2.5,3,3.5,4)
> arlfix <- sapply(mu,l=l,c=c,sided="two",xewma.arl)
> arlvacl <- sapply(mu,l=l,c=c,sided="two",limits="vacl",xewma.arl)
> round(cbind(mu,arlfix,arlvacl),digits=1)
     mu arlfix arlvacl
arl 0.0 1379.3  1347.2
arl 0.2  133.6   126.0
arl 0.5   37.3    32.2
arl 0.8   20.0    15.3
arl 1.0   13.5     9.2
arl 1.5    8.3     4.6
arl 2.0    6.0     2.9
arl 2.5    4.8     2.1
arl 3.0    4.0     1.6
arl 3.5    3.4     1.3
arl 4.0    3.0     1.2
> 
> ## original results are (in Table 2)
> ## 0.00 1379.0   1353.0
> ## 0.25  135.0    127.0
> ## 0.50   37.4     32.5 
> ## 0.75   20.0     15.6
> ## 1.00   13.5      9.0
> ## 1.50    8.3      4.5
> ## 2.00    6.0      2.8
> ## 2.50    4.8      2.0
> ## 3.00    4.0      1.6
> ## 3.50    3.4      1.3
> ## 4.00    3.0      1.1.
> 
> ## fir, both, and Steiner's modification
> 
> l <- .03
> cfir <- 2.44
> cboth <- 2.54
> cstein <- 2.55
> hsfir <- cfir/2
> hsboth <- cboth/2*sqrt(l*(2-l))
> mu <- c(0,.5,1,1.5,2,3,4)
> arlfir <- sapply(mu,l=l,c=cfir,hs=hsfir,sided="two",limits="fir",xewma.arl)
> arlboth <- sapply(mu,l=l,c=cboth,hs=hsboth,sided="two",limits="both",xewma.arl)
> arlstein <- sapply(mu,l=l,c=cstein,sided="two",limits="Steiner",xewma.arl)
> round(cbind(mu,arlfir,arlboth,arlstein),digits=1)
     mu arlfir arlboth arlstein
arl 0.0  407.8   413.0    420.9
arl 0.5   18.4    14.1     14.7
arl 1.0    7.3     4.0      3.8
arl 1.5    4.6     2.0      1.9
arl 2.0    3.4     1.4      1.3
arl 3.0    2.3     1.0      1.0
arl 4.0    1.9     1.0      1.0
> 
> ## original values are (in Table 5)
> ## 0.0 383.0   384.0   391.0
> ## 0.5  18.6    14.9    13.8
> ## 1.0   7.4     3.9     3.6
> ## 1.5   4.6     2.0     1.8
> ## 2.0   3.4     1.4     1.3
> ## 3.0   2.4     1.1     1.0
> ## 4.0   1.9     1.0     1.0.
> 
> ## SAS/QC manual 1999
> ## two-sided EWMA control charts with fixed limits
> 
> l <- .25
> c <- 3
> mu <- 1
> print(xewma.arl(l,c,mu,sided="two"),digits=11)
         arl 
11.154267016 
> 
> # original value is 11.154267016.
> 
> 
> 
> cleanEx(); ..nameEx <- "xewma.crit"
> 
> ### * xewma.crit
> 
> flush(stderr()); flush(stdout())
> 
> ### Name: xewma.crit
> ### Title: Compute critical values of EWMA control charts
> ### Aliases: xewma.crit
> ### Keywords: ts
> 
> ### ** Examples
> 
> l <- .1
> incontrolARL <- c(500,5000,50000)
> sapply(incontrolARL,l=l,sided="two",xewma.crit,r=30) # accuracy with 30 nodes
       c        c        c 
2.814310 3.556763 4.158594 
> sapply(incontrolARL,l=l,sided="two",xewma.crit)      # accuracy with 40 nodes
       c        c        c 
2.814310 3.556763 4.158607 
> sapply(incontrolARL,l=l,sided="two",xewma.crit,r=50) # accuracy with 50 nodes
       c        c        c 
2.814310 3.556763 4.158607 
> 
> ## Crowder (1989)
> ## two-sided EWMA control charts with fixed limits
> 
> l <- c(.05,.1,.15,.2,.25)
> L0 <- 250
> round(sapply(l,L0=L0,sided="two",xewma.crit),digits=2)
   c    c    c    c    c 
2.32 2.55 2.65 2.72 2.76 
> 
> ## original values are 2.32, 2.55, 2.65, 2.72, and 2.76.
> 
> 
> 
> ### * <FOOTER>
> ###
> cat("Time elapsed: ", proc.time() - get("ptime", env = .CheckExEnv),"\n")
Time elapsed:  6.88 0.12 7.04 0 0 
> grDevices::dev.off()
null device 
          1 
> ###
> ### Local variables: ***
> ### mode: outline-minor ***
> ### outline-regexp: "\\(> \\)?### [*]+" ***
> ### End: ***
> quit('no')