/* The Poker Test[of Old FIPS 140-1] for 01 random sequence (full version required) */
/* Notice: This program does not work on Light version of GAUSS.   */
new; cls;
x=rndu(20000,1);
x=(x.>0.5);          /* x=rev(x); if you need the reverse order of it. */
call poker(x);


proc poker(x);
   local binm,i,j,c,count,stat;
   if ismiss(x);
      errorlog "Warning: missing data found.";
      x=packr(x);
   endif;
   if rows(x)<20000;
      errorlog "Error: This test requires the sample of at least 20000.";
      retp(".");
   endif;
   x=x[1:20000];            /* Use the first 20000. */
   let binm[4,16]=
   0 1 0 1 0 1 0 1 0 1 0 1 0 1 0 1
   0 0 1 1 0 0 1 1 0 0 1 1 0 0 1 1
   0 0 0 0 1 1 1 1 0 0 0 0 1 1 1 1
   0 0 0 0 0 0 0 0 1 1 1 1 1 1 1 1
   ;
   c=zeros(5000,1);
   j=0;
   do while j<=15;
      i=1;
      do while i<=5000;
         if x[4*(i-1)+1:4*i]==binm[.,j+1];
            c[i]=j;
         endif;
         i=i+1;
      endo;
      j=j+1;
   endo;
   count=zeros(16,1);
   j=0;
   do while j<=15;
      count[j+1]=sumc(c.==j);
      j=j+1;
   endo;
   stat=16/5000*sumc(count^2)-5000;
   print "The Poker Test:";
   print/lz "stat=" stat;;
   if stat>1.03 and stat<57.4;
      print "Pass";
   else;
      print "Fail";
   endif;
   retp(stat);
endp;