Three-Stage Dorfman Screening

 /****************************************************************/
 /*          S A S   S A M P L E   L I B R A R Y                 */
 /*                                                              */
 /*    NAME: IEDORF3                                             */
 /*   TITLE: Three-Stage Dorfman Screening                       */
 /* PRODUCT: QC                                                  */
 /*  SYSTEM: ALL                                                 */
 /*    KEYS: Inspection Sampling,                                */
 /*   PROCS: TABULATE                                            */
 /*    DATA:                                                     */
 /*                                                              */
 /*    MISC:                                                     */
 /*                                                              */
 /*   NOTES: This program tabulates measures of effectiveness    */
 /*          for three-stage Dorfman screening of an infinite    */
 /*          lot under an imperfect inspection model.            */
 /*                                                              */
 /*          Notation:                                           */
 /*                                                              */
 /*          omega   = proportion of nonconforming (defective)   */
 /*                    items in lot                              */
 /*                                                              */
 /*          n0      = number of items in initial group          */
 /*          n1      = number of items in second group           */
 /*          n2      = number of items in third group            */
 /*                                                              */
 /*          h1      = number of subgroups in initial group      */
 /*          h2      = number of subgroups in second group       */
 /*                                                              */
 /*          p0      = Pr[ for initial group, declare NC | at    */
 /*                        least one NC item ]                   */
 /*          p0prime = Pr[ for initial group, declare NC | no    */
 /*                        NC items ]                            */
 /*                                                              */
 /*          p1      = Pr[ for first subgroup,  declare NC | at  */
 /*                        least one NC item ]                   */
 /*          p1prime = Pr[ for first subgroup, declare NC | no   */
 /*                        NC items ]                            */
 /*                                                              */
 /*          p2      = Pr[ for second subgroup, declare NC | at  */
 /*                        least one NC item ]                   */
 /*          p2prime = Pr[ for second subgroup, declare NC | no  */
 /*                        NC items ]                            */
 /*                                                              */
 /*          pcnc    = Pr[ correct classification of defective   */
 /*                        (nonconforming) item ]                */
 /*                                                              */
 /*          pcc     = Pr[ correctly classifying conforming      */
 /*                        item ]                                */
 /*                                                              */
 /*          en      = E[ number of tests ]                      */
 /*                                                              */
 /*          save    = expected percent reduction in number of   */
 /*                    tests (relative to n0)                    */
 /*                                                              */
 /*     REF: Johnson, N. L., Kotz, S., and Rodriguez, R. N.      */
 /*          (1987), Statistical Effects of Imperfect Inspection */
 /*          Sampling:  III. Screening (Group Testing), Journal  */
 /*          of Quality Technology 20, 98-124.  See Table 8.     */
 /*                                                              */
 /*          Johnson, N. L., Kotz, S., and Wu, X. (1991).        */
 /*          Inspection Errors for Attributes in Quality         */
 /*          Control.  London:  Chapman & Hall.  See Chapter 6.  */
 /*                                                              */
 /****************************************************************/

data table;

   keep omega n1 n2 n3 h1 h2 p p1 p2 p3 pprime p1prime p2prime
        p3prime pcc pcnc en save;

   label omega   = 'omega'
         n1      = 'n0'
         n2      = 'n1'
         n3      = 'n2'
         h1      = 'h1'
         h2      = 'h2'
         p       = 'p0'
         p1      = 'p1'
         p2      = 'p2'
         p3      = 'p3'
         pprime  = 'p0'''
         p1prime = 'p1'''
         p2prime = 'p2'''
         p3prime = 'p3'''
         pcc     = 'PC(C)'
         pcnc    = 'PC(NC)'
         en      = 'E(Number Tests)'
         save    = 'Exp Pct Reduction' ;

   format en 5.3 pcc 6.4 pcnc 6.4 save 4.1 ;

   input n1 n2 n3 @;

   /*--- find hi--- */
   h1 = n1 / n2;
   h2 = n1 / ( h1 * n3 );

   /*---additional parameters---*/
   omega   = 0.02;
   p       = 0.90;
   pprime  = 0.05;
   p1      = 0.90;
   p2      = 0.90;
   p3      = 0.90;
   p1prime = 0.05;
   p2prime = 0.05;
   p3prime = 0.05;

   /*---find pcnc = Pr[ correct given nc ]---*/
   pcnc = p * p1 * p2 * p3;

   /*---evaluate p0*(n) and p0(n) for n = n1, n2, n3---*/
   p0starn1 = (1 - omega) ** ( n1 - 1 );
   p0starn2 = (1 - omega) ** ( n2 - 1 );
   p0starn3 = (1 - omega) ** ( n3 - 1 );
   p0n1     = (1 - omega) * p0starn1;
   p0n2     = (1 - omega) * p0starn2;
   p0n3     = (1 - omega) * p0starn3;

   /*---find prob2 = Pr[ correct given non nc ]---*/
   term1 = p0starn1 *
           ( 1 - p1prime * p2prime * p3prime * pprime );
   term2 = ( p0starn2 - p0starn1 ) *
           ( 1 - p1 * p2prime * p3prime * pprime );
   term3 = ( p0starn3 - p0starn2 ) *
           ( 1 - p1 * p2 * p3prime * pprime );
   term4 = ( 1 - p0starn3 ) *
           ( 1 - p1 * p2 *p3 * pprime );
   pcc   = term1 + term2 + term3 + term4;

   /*---find expected number of tests---*/
   term1 = 1 + h1 * ( p0n1 * p1prime + ( 1 - p0n1 ) * p1 ) ;
   term2 = h1 * h2* ( ( p0n2 - p0n1 ) * p1 * p2prime +
           p0n1 * p1prime * p2prime + (1 - p0n2) * p1 * p2 );
   term3 = n1 * ( ( p0n3 - p0n2 ) * p1 * p2 * p3prime +
           ( p0n2 - p0n1 ) * p1 * p2prime * p3prime +
           p0n1 * p1prime * p2prime * p3prime +
           ( 1 - p0n3 ) * p1 * p2 * p3 );
   en = term1 + term2 + term3;

   /*---find ened percent reduction---*/
   save = ( n1 - en) * 100 / n1;

   /* output observation */
   output;

cards;
12    4    2
12    6    2
12    6    3
16    4    2
16    8    2
16    8    4
24    6    2
24    6    3
24    8    2
24    8    4
24   12    3
24   12    4
24   12    6
36    9    3
36   12    3
36   12    4
36   12    6
36   18    6
36   18    9
run;


proc sort data=table;
   by omega p p1 p2 p3 pprime p1prime p2prime p3prime ;

proc print label noobs;
   by omega p p1 p2 p3 pprime p1prime p2prime p3prime ;
   var n1 n2 n3 h1 h2 pcnc pcc en save;
run;