home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / MAPSTATF.LBR / HYPOTHS.PZS / HYPOTHS.ÐAS
Text File  |  2000-06-30  |  8KB  |  227 lines
  1. (* Multivariate Analysis Package - Hypotheses Testing Module
  2.    Copyright 1985 Douglas L. Anderton.  This program may be freely
  3.    circulated so long as it is not sold for profit and any charge does
  4.    not exceed costs of reproduction *)
  5.  
  6. Program Hypoths(Input,Output);
  7. Const
  8.    N=2;
  9. Type
  10.    SUBS = 1..N;
  11.    RVEC = Array [SUBS] Of Real;
  12.    IVEC = Array [SUBS] Of Integer;
  13.    S8 = Array [SUBS] Of String[8];
  14. Var
  15.    dfile, ofile : Text;
  16.    sel : IVEC;
  17.    nc, mu, vr, stdev, sterr, miss, vars, rw1, rw2, drw1, drw2: RVEC;
  18.    varn : S8;
  19.    i, j, k, nv, dv, ot : Integer;
  20.    tt, tmp, df1, df2, dnc, cross, dif : Real;
  21.  
  22. Procedure openfiles(Var dfile, ofile:Text; Var ot:Integer);
  23. Var
  24.    dfl, ofl:String[12];
  25. Begin
  26.    ClrScr; Writeln(' *** HYPOTHS: MEAN AND VARIANCE HYPOTHESES TESTS ***');
  27.    Writeln; Write('Name of the data file? ');
  28.    Readln(dfl); Assign(dfile,dfl); Reset(dfile);
  29.    Write('Name of the output file? ');
  30.    Readln(ofl); Assign(ofile,ofl); Rewrite(ofile);
  31.    ot:= 0;
  32.    If (ofl='CON:') Or (ofl='con:') Then ot:=1;
  33.    If (ofl='LST:') Or (ofl='lst:') Then ot:=2;
  34.    If (ot=2) Then
  35.       Begin
  36.       Writeln(ofile,'Multivariate Analysis Package (1.6) - ',
  37.          'Program: HYPOTHS, Datafile: ',dfl); Writeln(ofile);
  38.       End;
  39.    End; (* Of openfiles *)
  40.  
  41. Procedure wait(ot:Integer);
  42. Begin
  43.   If ot=1 Then Begin
  44.     Write('- Press any key to continue -'); While Not KeyPressed Do; ClrScr;
  45.     End;
  46.   End; (* of wait *)
  47.  
  48. Procedure selectvar(Var sel:IVEC; Var varn:S8; Var miss:RVEC;
  49.                     Var nv, dv:Integer);
  50. Var
  51.    cfile:Text;
  52.    cfl:String[12];
  53.    i,j,f:Integer;
  54.    mis:Real;
  55.    van:String[8];
  56. Begin
  57.    Write('Name of the codebook file (or NONE)? '); Readln(cfl);
  58.    If (cfl<>'NONE') And (cfl<>'none') Then f:=1 Else f:=0;
  59.    If f=1 Then Begin Assign(cfile,cfl); Reset(cfile); End;
  60.    Writeln;
  61.    Write('How many variables in data file? '); Readln(nv);
  62.    Write('Test groups of 1 variable or compare 2 variables (1 or 2)? ');
  63.    Readln(dv);
  64.    For i:=1 To 2 Do
  65.       Begin
  66.       Write('Column number for variable ',i,'? '); Read(sel[i]);
  67.       Str(sel[i]:3,varn[i]); miss[i]:=-1E37;
  68.       If ((dv=1) and (i=1)) Then Begin
  69.          Writeln('Second variable must be a dummy coded (0 or 1) variable');
  70.          Writeln('created by TRANSFRM to identify two groups to compare.');
  71.          End;
  72.       End;
  73.    If f=1 Then Begin
  74.      For j:=1 to nv Do Begin
  75.        mis:=-1E37;
  76.        Readln(cfile,f,van,mis);
  77.        For i:=1 to dv Do
  78.          If f=sel[i] Then Begin
  79.            varn[i]:=van; miss[i]:=mis;
  80.            Writeln('Col: ',sel[i],'  Name: ',varn[i],' Missing: ',miss[i]:6);
  81.            End;     
  82.        End;
  83.      Close(cfile);
  84.      wait(1);
  85.      End;
  86.    End; (* Of selectvar *)
  87.  
  88. Procedure getcase(Var vars:RVEC; sel:IVEC; nv:Integer; Var dfile:Text);
  89. Var
  90.    i, j:Integer;
  91.    x:Real;
  92. Begin
  93.    For i:=1 To nv Do
  94.       Begin
  95.       Read(dfile,x);
  96.       If sel[1]=i Then vars[1]:=x Else If sel[2]=i Then vars[2]:=x;
  97.       End;
  98.    End; (* Of getcase *)
  99.  
  100. Begin (* main *)
  101.    openfiles(dfile, ofile, ot);
  102.    selectvar(sel, varn, miss, nv, dv);
  103.    (* intialize *)
  104.    dnc:=0.; cross:=0.;
  105.    For i:=1 To 2 Do
  106.       Begin
  107.       nc[i]:=0.; rw1[i]:=0.; rw2[i]:=0.; drw1[i]:=0.; drw2[i]:=0.;
  108.       End;
  109.    (* accumulate *)
  110.    Writeln;
  111.    k:=0;
  112.    While Not EOF(dfile) Do
  113.       Begin
  114.       k:=k+1;
  115.       getcase(vars, sel, nv, dfile);
  116.       If Frac(k/10)=0.0 Then Write('+');
  117.       If Not EOF(dfile) Then
  118.          Begin
  119.          If(dv=2) Then For j:=1 To 2 Do
  120.             Begin
  121.             If(vars[j]<>miss[j]) Then
  122.                Begin
  123.                nc[j]:=nc[j]+1.0;
  124.                rw1[j]:=rw1[j]+vars[j];
  125.                rw2[j]:=rw2[j]+Sqr(vars[j]);
  126.                End;
  127.             End;
  128.          If(dv=2) Then
  129.             Begin
  130.             If((vars[1]<>miss[1]) and (vars[2]<>miss[2])) Then
  131.                Begin
  132.                For j:=1 To 2 Do
  133.                   Begin
  134.                   drw1[j]:=drw1[j]+vars[j];
  135.                   drw2[j]:=drw2[j]+Sqr(vars[j]);
  136.                   End;
  137.                dnc:=dnc+1.0;
  138.                cross:=cross+(vars[1]*vars[2]);
  139.                End;
  140.             End;
  141.          If((vars[1]<>miss[1]) and (dv=1)) Then
  142.             Begin
  143.             j:=Trunc(vars[2]+0.1)+1;
  144.             nc[j]:=nc[j]+1.0;
  145.             rw1[j]:=rw1[j]+vars[1];
  146.             rw2[j]:=rw2[j]+Sqr(vars[1]);
  147.             End;
  148.          End;
  149.       End;
  150.    (* compute And Output stats*)
  151.       ClrScr;
  152.       Write(ofile,'Hypotheses Tests for ',varn[1]);
  153.       If(dv=2) Then Writeln(ofile,' compared with ',varn[2])
  154.                 Else Writeln(ofile,' comparing two groups');
  155.       Writeln(ofile);
  156.       Write('Hypothesized Difference in Means (0=none, or value)? ');
  157.       Readln(dif); Writeln(ofile);
  158.       For j:=1 To 2 Do If nc[j]>1.0 Then
  159.         Begin
  160.         mu[j]:=rw1[j]/nc[j]; vr[j]:=(rw2[j]-(mu[j]*rw1[j]))/(nc[j]-1.0);
  161.         stdev[j]:=Sqrt(vr[j]); sterr[j]:=Sqrt(vr[j]/nc[j]);
  162.         If(dv=1) Then
  163.            Writeln(ofile,'Descriptive Stats for ',varn[1],' Group ',j-1);
  164.         If(dv=2) Then
  165.            Writeln(ofile,'Descriptive Stats for Variable ',varn[j]);
  166.         Writeln(ofile,'Mean:    ',mu[j]:13:5,'  Std. Error:',sterr[j]:13:5);
  167.         Writeln(ofile,'Variance:',vr[j]:13:5,'  Std. Dev:  ',stdev[j]:13:5);
  168.         Writeln(ofile);
  169.         End;
  170.       wait(ot);
  171.       tmp:=vr[1]/vr[2]; df1:=nc[1]-1.0; df2:=nc[2]-1.0;
  172.       if (vr[2]/vr[1]>vr[1]/vr[2]) Then
  173.          Begin
  174.          tmp:=vr[2]/vr[1]; df1:=nc[2]-1.0; df2:=nc[1]-1.0;
  175.          End;
  176.       Writeln(ofile);
  177.       Write(ofile,'F-test for Equality of Variances: ',tmp:11:4);
  178.       Writeln(ofile,' degrees of freedom:',df1:4:0,',',df2:4:0);
  179.       Writeln(ofile); tmp:=mu[1]-mu[2];
  180.       Writeln(ofile,'Difference of Means: ',tmp:11);Writeln(ofile);
  181.       tmp:=SQRT((vr[1]/nc[1])+(vr[2]/nc[2]));
  182.       Writeln(ofile,'Unpooled Standard Error of Difference: ',tmp:11);
  183.       tt:=(mu[1]-mu[2]-dif)/tmp;
  184.       tmp:=((nc[1]*vr[1])+(nc[2]*vr[2]))/(nc[1]+nc[2]-2.0);
  185.       Writeln(ofile,'Pooled Variance Estimate: ',tmp:11);
  186.       tmp:=SQRT(tmp)*SQRT((1/nc[1])+(1/nc[2]));
  187.       Writeln(ofile,'Pooled Standard Error of Difference: ',tmp:11);
  188.       Writeln(ofile);
  189.       If(dv=2) Then Begin
  190.          Write(ofile,'T-tests for Difference of Means ',varn[1],' and ');
  191.          Writeln(ofile,varn[2],' of ',dif:11:5,': ');
  192.          End;
  193.       If(dv=1) Then Begin
  194.          Write(ofile,'T-tests for Difference of Mean ',varn[1],' group 0');
  195.          Writeln(ofile,' and group 1 of ',dif:11:5,': ');
  196.          End;
  197.       Write(ofile,'     Separate Variance t-test: ',tt:11:5);
  198.       tt:=SQR((vr[1]/nc[1])/((vr[1]/nc[1])+(vr[2]/nc[2])))/(nc[1]-1.0);
  199.       tt:=tt+SQR((vr[1]/nc[2])/((vr[2]/nc[2])+(vr[1]/nc[1])))/(nc[2]-1.0);
  200.       tt:=Int(1/tt);
  201.       Writeln(ofile,' degrees of freedom: ',tt:5:0);
  202.       tt:=(mu[1]-mu[2]-dif)/tmp;
  203.       Write(ofile,'     Pooled Variance t-test: ',tt:11:5);
  204.       tt:=nc[1]+nc[2]-2;
  205.       Writeln(ofile,' degrees of freedom: ',tt:5:0);
  206.       Writeln(ofile);
  207.       If(dv=2) Then Begin
  208.          Write(ofile,'Paired T-test for Difference of Means ',varn[1]);
  209.          Writeln(ofile,' and ',varn[2],' of ',dif:11:5,': ');
  210.          tmp:=(cross-((drw1[1]*drw1[2])/dnc))/(dnc-1.0);
  211.          Writeln(ofile,'     Covariance Estimate: ',tmp:11);
  212.          For j:=1 To 2 Do Begin
  213.             mu[j]:=drw1[j]/dnc;
  214.             vr[j]:=(drw2[j]-(mu[j]*drw1[j]))/(dnc-1.0);
  215.             End;
  216.          tt:=Sqrt((vr[1]+vr[2]-(2*tmp))/dnc);
  217.          Writeln(ofile,'     Std. Error of Paired Difference: ',tt:11);
  218.          tmp:=((drw1[1]/dnc)-(drw1[2]/dnc)-dif)/tt;
  219.          Write(ofile,'     Paired Difference t-test: ',tmp:11:5);
  220.          tmp:=dnc-1;
  221.          Writeln(ofile,' degrees of freedom: ',tmp:5:0);
  222.          Writeln(ofile);
  223.          End;
  224.       Close(dfile); Close(ofile);
  225.       Assign(dfile,'MAPSTAT.COM'); Execute(dfile);
  226.  End.
  227.     Pooled Varia