File: xewma.ad.R

package info (click to toggle)
r-cran-spc 1%3A0.7.1-1
  • links: PTS, VCS
  • area: main
  • in suites: forky, sid, trixie
  • size: 1,888 kB
  • sloc: ansic: 22,279; makefile: 2
file content (31 lines) | stat: -rw-r--r-- 1,262 bytes parent folder | download | duplicates (6)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
# Computation of EWMA steady-state ARLs (mean monitoring)
xewma.ad <- function(l, c, mu1, mu0=0, zr=0, z0=0, sided="one", limits="fix", steady.state.mode="conditional", r=40) { 
  if ( l<=0 || l>1 ) 		stop("l has to be between 0 and 1")
  
  if ( c<=0 )			warning("usually, c has to be positive")
  
  if ( zr>c & sided=="one" )    stop("wrong reflexion border")
  
  if ( r<4 )			stop("r is too small")
  
  ctyp <- pmatch(sided, c("one", "two")) - 1
  if (is.na(ctyp))		stop("invalid ewma type")
  
  ltyp <- pmatch(limits, c("fix","vacl","fir","both","Steiner","stat")) - 1
  if ( is.na(ltyp) )		stop("invalid limits type")
  
  if ( (sided=="one") & !(limits %in% c("fix", "vacl", "stat")) )
				stop("not supported for one-sided EWMA (not reasonable or not implemented yet")

  styp <- pmatch(steady.state.mode, c("conditional", "cyclical")) - 1
  if (is.na(styp))		stop("invalid steady.state.mode")
  
  if ( abs(z0) > abs(c) ) 	stop("wrong restarting value")
  
  ad <- .C("xewma_ad", as.integer(ctyp), as.double(l),
           as.double(c), as.double(zr), as.double(mu0), as.double(mu1), as.double(z0),
           as.integer(ltyp), as.integer(styp), as.integer(r),
           ans=double(length=1), PACKAGE="spc")$ans 
  names(ad) <- "ad"
  return (ad)
}