home *** CD-ROM | disk | FTP | other *** search
/ World of Shareware - Software Farm 2 / wosw_2.zip / wosw_2 / PASCAL / NRPAS13.ZIP / KSTWO.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  2KB  |  61 lines
  1. PROCEDURE kstwo(VAR data1: glarray1; n1: integer;
  2.       VAR data2: glarray2; n2: integer;
  3.       VAR d,prob: real);
  4. (* Programs using routine KSTWO must define the types
  5. TYPE
  6.    glarray1 = ARRAY [1..n1] OF real;
  7.    glarray2 = ARRAY [1..n2] OF real;
  8. in the main routine.   *)
  9. VAR
  10.    i,j2,j1: integer;
  11.    dum,en1,en2,fo2,fo1,fn2,fn1,dt: real;
  12. BEGIN
  13.    IF (n2 > n1) THEN BEGIN
  14.       writeln('pause in routine KSTWO');
  15.       writeln('first input array must be the larger'); readln
  16.    END;
  17.    sort(n1,data1);
  18.    FOR i := 1 TO n2 DO BEGIN
  19.       dum := data1[i];
  20.       data1[i] := data2[i];
  21.       data2[i] := dum
  22.    END;
  23.    sort(n2,data1);
  24.    FOR i := 1 TO n2 DO BEGIN
  25.       dum := data1[i];
  26.       data1[i] := data2[i];
  27.       data2[i] := dum
  28.    END;
  29.    en1 := n1;
  30.    en2 := n2;
  31.    j1 := 1;
  32.    j2 := 1;
  33.    fo1 := 0.0;
  34.    fo2 := 0.0;
  35.    d := 0.0;
  36.    WHILE ((j1 <= n1) AND (j2 <= n2)) DO BEGIN
  37.       IF (data1[j1] < data2[j2]) THEN BEGIN
  38.          fn1 := j1/en1;
  39.          IF (abs(fn1-fo2) > abs(fo1-fo2)) THEN BEGIN
  40.             dt := abs(fn1-fo2)
  41.          END ELSE BEGIN
  42.             dt := abs(fo1-fo2)
  43.          END;
  44.          IF (dt > d) THEN d := dt;
  45.          fo1 := fn1;
  46.          j1 := j1+1;
  47.       END ELSE BEGIN
  48.          fn2 := j2/en2;
  49.          IF (abs(fn2-fo1) > abs(fo2-fo1)) THEN BEGIN
  50.             dt := abs(fn2-fo1)
  51.          END ELSE BEGIN
  52.             dt := abs(fo2-fo1)
  53.          END;
  54.          IF (dt > d) THEN d := dt;
  55.          fo2 := fn2;
  56.          j2 := j2+1
  57.       END
  58.    END;
  59.    prob := probks(sqrt(en1*en2/(en1+en2))*d)
  60. END;
  61.