home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / KENDL2.DEM < prev    next >
Encoding:
Text File  |  1991-04-29  |  2.2 KB  |  88 lines
  1. PROGRAM d13r19(input,output);
  2. (* driver for routine KENDL2 *)
  3. (* look for 'ones-after-zeros' in irbit1 and irbit2 sequences *)
  4. CONST
  5.    ndat=1000;
  6.    ip=8;
  7.    jp=8;
  8. TYPE
  9.    gldarray = ARRAY [1..ip,1..jp] OF real;
  10.    pattern = PACKED ARRAY [1..3] OF char;
  11. VAR
  12.    ifunc,iseed,i,j,k,l,m,n,twoton : integer;
  13.    prob,tau,z : real;
  14.    tab : gldarray;
  15.    txt : ARRAY [1..8] OF pattern;
  16.  
  17. (*$I MODFILE.PAS *)
  18. (*$I IRBIT1.PAS *)
  19.  
  20. (*$I IRBIT2.PAS *)
  21.  
  22. (*$I ERFCC.PAS *)
  23.  
  24. (*$I KENDL2.PAS *)
  25.  
  26. BEGIN
  27.    txt[1] := '000'; txt[2] := '001';
  28.    txt[3] := '010'; txt[4] := '011';
  29.    txt[5] := '100'; txt[6] := '101';
  30.    txt[7] := '110'; txt[8] := '111';
  31.    i := ip;
  32.    j := jp;
  33.    writeln ('Are ones followed by zeros and vice-versa?');
  34.    FOR ifunc := 1 to 2 DO BEGIN
  35.       iseed := 2468;
  36.       IF (ifunc = 1) THEN BEGIN
  37.          writeln('test of irbit1:')
  38.       END ELSE BEGIN
  39.          writeln('test of irbit2:')
  40.       END;
  41.       FOR k := 1 to i DO BEGIN
  42.          FOR l := 1 to j DO BEGIN
  43.             tab[k,l] := 0.0
  44.          END
  45.       END;
  46.       FOR m := 1 to ndat DO BEGIN
  47.          k := 1;
  48.          twoton := 1;
  49.          FOR n := 0 to 2 DO BEGIN
  50.             IF (ifunc = 1) THEN BEGIN
  51.                k := k+irbit1(iseed)*twoton
  52.             END ELSE BEGIN
  53.                k := k+irbit2(iseed)*twoton
  54.             END;
  55.             twoton := 2*twoton
  56.          END;
  57.          l := 1;
  58.          twoton := 1;
  59.          FOR n := 0 to 2 DO BEGIN
  60.             IF (ifunc = 1) THEN BEGIN
  61.                l := l+irbit1(iseed)*twoton
  62.             END ELSE BEGIN
  63.                l := l+irbit2(iseed)*twoton
  64.             END;
  65.             twoton := 2*twoton
  66.          END;
  67.          tab[k,l] := tab[k,l]+1.0
  68.       END;
  69.       kendl2(tab,i,j,ip,jp,tau,z,prob);
  70.       write(' ':4);
  71.       FOR n := 1 to 8 DO BEGIN
  72.          write(txt[n]:6)
  73.       END;
  74.       writeln;
  75.       FOR n := 1 to 8 DO BEGIN
  76.          write(txt[n]:3);
  77.          FOR m := 1 to 8 DO BEGIN
  78.             write(round(tab[n,m]):6)
  79.          END;
  80.          writeln
  81.       END;
  82.       writeln;
  83.       writeln('kendall tau':17,'std. dev.':14,'probability':16);
  84.       writeln(tau:15:6,z:15:6,prob:15:6);
  85.       writeln
  86.    END
  87. END.
  88.