kendl2.dem

来自「Delphi Pascal 数据挖掘领域算法包 数值算法大全」· DEM 代码 · 共 88 行

PROGRAM d13r19(input,output);
(* driver for routine KENDL2 *)
(* look for 'ones-after-zeros' in irbit1 and irbit2 sequences *)
CONST
   ndat=1000;
   ip=8;
   jp=8;
TYPE
   gldarray = ARRAY [1..ip,1..jp] OF real;
   pattern = PACKED ARRAY [1..3] OF char;
VAR
   ifunc,iseed,i,j,k,l,m,n,twoton : integer;
   prob,tau,z : real;
   tab : gldarray;
   txt : ARRAY [1..8] OF pattern;

(*$I MODFILE.PAS *)
(*$I IRBIT1.PAS *)

(*$I IRBIT2.PAS *)

(*$I ERFCC.PAS *)

(*$I KENDL2.PAS *)

BEGIN
   txt[1] := '000'; txt[2] := '001';
   txt[3] := '010'; txt[4] := '011';
   txt[5] := '100'; txt[6] := '101';
   txt[7] := '110'; txt[8] := '111';
   i := ip;
   j := jp;
   writeln ('Are ones followed by zeros and vice-versa?');
   FOR ifunc := 1 to 2 DO BEGIN
      iseed := 2468;
      IF (ifunc = 1) THEN BEGIN
         writeln('test of irbit1:')
      END ELSE BEGIN
         writeln('test of irbit2:')
      END;
      FOR k := 1 to i DO BEGIN
         FOR l := 1 to j DO BEGIN
            tab[k,l] := 0.0
         END
      END;
      FOR m := 1 to ndat DO BEGIN
         k := 1;
         twoton := 1;
         FOR n := 0 to 2 DO BEGIN
            IF (ifunc = 1) THEN BEGIN
               k := k+irbit1(iseed)*twoton
            END ELSE BEGIN
               k := k+irbit2(iseed)*twoton
            END;
            twoton := 2*twoton
         END;
         l := 1;
         twoton := 1;
         FOR n := 0 to 2 DO BEGIN
            IF (ifunc = 1) THEN BEGIN
               l := l+irbit1(iseed)*twoton
            END ELSE BEGIN
               l := l+irbit2(iseed)*twoton
            END;
            twoton := 2*twoton
         END;
         tab[k,l] := tab[k,l]+1.0
      END;
      kendl2(tab,i,j,ip,jp,tau,z,prob);
      write(' ':4);
      FOR n := 1 to 8 DO BEGIN
         write(txt[n]:6)
      END;
      writeln;
      FOR n := 1 to 8 DO BEGIN
         write(txt[n]:3);
         FOR m := 1 to 8 DO BEGIN
            write(round(tab[n,m]):6)
         END;
         writeln
      END;
      writeln;
      writeln('kendall tau':17,'std. dev.':14,'probability':16);
      writeln(tau:15:6,z:15:6,prob:15:6);
      writeln
   END
END.