I've been the recipient of a fair amount of help in this forum, so I thought I
would contribute
something instead of just ask questions. Over the years I have found it
helpful to implement
an Xbar/R Control Chart using the AT&T rules for marking out-of-control points.
I've done this in
various languages going all the way back to a Commodore 64, using it to monitor
video & audio tape
quality at the BASF manufacturing plant where I worked. Continuing that
tradition I implemented
it also using J. Here is the code, which I contribute for anyone to use as
desired. If so desired,
feel free to add it as a script on the web site.
-Ed Cox
NB. QCC.ijs Quality Control Charts
NB. This implements a X-bar/R Control Chart with markers for out of control
points as defined
NB. by the "AT&T Quality Control Handbook".
load 'statfns'
load 'plot'
NB. Make some test data with a level shift to demo the use...
data=: |:50 5$((60$10),(100$20),(90$_20))+?250$(90$100),(60$110),100$100
qcc_xbar_r=: 3 : 0 NB. right arg is such that: 'sample_size num_samples'=:$y
xbar=: mean data
range=: (>./-<./)y
X=: i. grps=:#xbar
N=: 0{$data
ni=: 2+i.24 NB. Index for factor tables
NB. Factor tables - D3 & D4 are filled with 0s beyond N=15 and need valid
values to replace
A2=: 1.880 1.023 0.729 0.577 0.483 0.419 0.373 0.337 0.308 0.285 0.266 0.249
0.0235 0.223 0.212 0.203 0.194 0.187 0.180 0.173 0.167 0.162 0.157 0.153
D3=: 0 0 0 0 0 0.076 0.136 0.184 0.223 0.256 0.284 0.308 0.329 0.348 0 0 0 0 0
0 0 0 0 0
D4=: 3.268 2.574 2.282 2.114 2.004 1.924 1.864 1.816 1.777 1.744 1.717 1.692
1.671 1.652 0 0 0 0 0 0 0 0 0 0
Xmean=: mean xbar
Rmean=: mean range
Xucl=: Xmean + Rmean*(N=ni)#A2
Xlcl=: Xmean - Rmean*(N=ni)#A2
Rucl=: Rmean * (N=ni)#D4
Rlcl=: Rmean * (N=ni)#D3
NB. Create threhold matricies for rules: top 3 rows flag >3 2 1 0 sigma, bottom
3 rows flag <0 1 2 3 sigma
Xthrsh=: (|:xbar>/Xmean+(%3)*3 2 1 0*+/Xucl-Xmean),|:xbar</Xmean+(%3)*0 1 2
3*+/Xlcl-Xmean
Rthrsh=: (|:range>/Rmean+(%3)*3 2 1 0*+/Rucl-Rmean),|:range</Rmean+(%3)*0 1 2
3*+/Rlcl-Rmean
X1=: rule_1 Xthrsh
R1=: rule_1 Rthrsh
X2=: rule_2 Xthrsh
R2=: rule_2 Rthrsh
X3=: rule_3 Xthrsh
R3=: rule_3 Rthrsh
X4=: rule_4 Xthrsh
R4=: rule_4 Rthrsh
X5=: rule_5 xbar
R5=: rule_5 range
X6=: rule_6 xbar
R6=: rule_6 range
Xrule=:posfloor "1 |: (1+i. 6)*"0 Xptm=: >X1;X2;X3;X4;X5;X6
Rrule=:posfloor "1 |: (1+i. 6)*"0 Rptm=: >R1;R2;R3;R4;R5;R6
Xpts=: +./Xptm
Rpts=: +./Rptm
pd 'reset'
pd 'new'
pd 'sub 10 10 _10x _10x'
pd 'sub 3 2,8'
pd 'backcolor 222 222 206'
pd 'framebackcolor white'
pd 'title Xbar/R Control Chart'
pd 'ycaption Xbar'
pd 'type line;color gray;pensize 1'
pd X;grps$Xucl
pd X;grps$Xmean
pd X;grps$Xlcl
pd 'type dot;color blue;pensize 3'
pd X;xbar
pd 'type line;color blue;pensize 1'
pd X;xbar
pd 'type marker;markers times;markersize 1.5;color red'
if. 0<+/Xpts do. pd (Xpts#X);Xpts#xbar end. NB. IF avoids crash if no points
to plot
pd 'new'
pd 'backcolor 222 222 206'
pd 'framebackcolor white'
pd 'xcaption Observation Group'
pd 'ycaption R'
pd 'type line;color gray;pensize 1'
pd X;grps$Rucl
pd X;grps$Rmean
pd X;grps$Rlcl
pd 'type dot;color blue;pensize 3'
pd X;range
pd 'type line;color blue;pensize 1'
pd X;range
pd 'type dot;markers times;color red;markersize 10'
if. 0<+/Rpts do. pd (Rpts#X);Rpts#range end. NB. IF avoids crash if no points
to plot
pd 'show'
)
rule_1=: 3 : 0 NB. Any single point outside +/-3 sigma
NB. right arg is threshold matrix
+./0 7{y
)
rule_2=: 3 : 0 NB. 2 out of last 3 points outside +/-2 sigma
NB. right arg is threshold matrix
G=:_1{$y NB. get number of groups
mask=: 2>|(-i.G)+/i.G NB. make the mask of sliding windows
T2s=: 1 6{y NB. get the 2 sigma thresholds, boxed
tmp1=: T2s *"1/ mask NB. apply thresholds to mask
tmp2=: (cumsum tmp1)*."2 mask NB. cumulative sum and then mask
+./ T2s *. 2 <: >./"2 tmp2 NB. Mask cumsum and reduce
)
rule_3=: 3 : 0 NB. 4 out of last 5 points outside +/-1 sigma
NB. right arg is threshold matrix
G=:_1{$y NB. get number of groups
mask=: 3>|(-i.G)+/i.G NB. make the mask of sliding windows
T1s=: 2 5{y NB. get the 1 sigma thresholds, boxed
tmp1=: T1s *"1/ mask NB. apply thresholds to mask
tmp2=: (cumsum tmp1)*."2 mask NB. cumulative sum and then mask
+./ T2s *. 4 <: >./"2 tmp2 NB. Mask cumsum and reduce
)
rule_4=: 3 : 0 NB. 8 consecutive points on one side of center
NB. right arg is threshold matrix
G=:_1{$y NB. get number of groups
mask=: 4>|(-i.G)+/0.5+i.G NB. make the mask of sliding windows
T0s=: 3 4{y NB. get the upper/lower of center thresholds,
boxed
tmp1=: T0s *"1/ mask NB. apply thresholds to mask
tmp2=: (cumsum tmp1)*."2 mask NB. cumulative sum and then mask
+./ T2s *. 8 <: >./"2 tmp2 NB. Mask cumsum and reduce
)
rule_5=: 3 : 0 NB. 6 in a row trending up or down
NB. right arg is xbar or range
G=:_1{$y NB. get number of groups
mask=: 3>|(-i.G)+/0.5+i.G NB. make the mask of sliding windows
T1=: trend y
tmp1=: T1 *"1/ mask
tmp2=: (cumsum tmp1)*."2 mask
+./ T1 *. 6 <: >./"2 tmp2
)
rule_6=: 3 : 0 NB. 14 in a row alternating up and down
NB. right arg is xbar or range
G=:_1{$y NB. get number of groups
mask=: 7>|(-i.G)+/0.5+i.G NB. make the mask of sliding windows
T1=: alter y
tmp1=: T1 *"1/ mask
tmp2=: (cumsum tmp1)*."2 mask
T1 *. 14 <: >./"2 tmp2
)
cumsum=: +/\"1 NB. Cumulative horizontal sum
trend=: 3 : 0 NB. 1st row=1 if num>than previous, 2nd row=1 if num<than
provious
NB. Argument is xbar or range
>(0,(_1}.y)<1}.y);0,(_1}.y)>1}.y
)
alter=: 3 : 0 NB. Flags alternating numerical sequence
0,(_1}.1{T)=1}.0{T=.trend y
)
posfloor=: 3 : 0
(_,1+i.$,y)i. <./(0<,y)#,y
)
qcc_xbar_r data
_________________________________________________
This message is for the designated recipient only and may contain privileged,
proprietary
or otherwise private information. If you have received it in error, please
notify the sender
immediately and delete the original. Any other use of the email by you is
prohibited.
Dansk - Deutsch - Espanol - Francais - Italiano - Japanese - Nederlands - Norsk
- Portuguese
Svenska: www.carefusion.com/legal/email
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm
