home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / PROG / PASCAL / NRPAS13.ZIP / CNTAB1.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-29  |  1.3 KB  |  52 lines
  1. PROCEDURE cntab1(nn: narray; ni,nj: integer;
  2.        VAR chisq,df,prob,cramrv,ccc: real);
  3. (* Programs using routine CNTAB1 must define type
  4. TYPE
  5.    narray = ARRAY [1..ni,1..nj] OF integer;
  6. in the calling routine. *)
  7. CONST
  8.    maxi=100;
  9.    maxj=100;
  10.    tiny=1.0e-30;
  11. VAR
  12.    nnj,nni,j,i,min: integer;
  13.    sum,expctd: real;
  14.    sumi: ARRAY[1..maxi] OF real;
  15.    sumj: ARRAY[1..maxj] OF real;
  16. BEGIN
  17.    sum := 0;
  18.    nni := ni;
  19.    nnj := nj;
  20.    FOR i := 1 TO ni DO BEGIN
  21.       sumi[i] := 0.0;
  22.       FOR j := 1 TO nj DO BEGIN
  23.          sumi[i] := sumi[i]+nn[i,j];
  24.          sum := sum+nn[i,j];
  25.       END;
  26.       IF (sumi[i] = 0.0) THEN nni := nni-1;
  27.    END;
  28.    FOR j := 1 TO nj DO BEGIN
  29.       sumj[j] := 0.0;
  30.       FOR i := 1 TO ni DO BEGIN
  31.          sumj[j] := sumj[j]+nn[i,j];
  32.       END;
  33.       IF (sumj[j] = 0.0) THEN nnj := nnj-1;
  34.    END;
  35.    df := nni*nnj-nni-nnj+1;
  36.    chisq := 0.0;
  37.    FOR i := 1 TO ni DO BEGIN
  38.       FOR j := 1 TO nj DO BEGIN
  39.          expctd := sumj[j]*sumi[i]/sum;
  40.          chisq := chisq+sqr(nn[i,j]-expctd)/(expctd+tiny)
  41.       END
  42.    END;
  43.    prob := gammq(0.5*df,0.5*chisq);
  44.    IF ((nni-1) < (nnj-1)) THEN BEGIN
  45.       min := nni-1
  46.    END ELSE BEGIN
  47.       min := nnj-1
  48.    END;
  49.    cramrv := sqrt(chisq/(sum*min));
  50.    ccc := sqrt(chisq/(chisq+sum))
  51. END;
  52.