(* Multivariate Analysis Package - Hypotheses Testing Module
   Copyright 1985 Douglas L. Anderton.  This program may be freely
   circulated so long as it is not sold for profit and any charge does
   not exceed costs of reproduction *)

Program Hypoths(Input,Output);
Const
   N=2;
Type
   SUBS = 1..N;
   RVEC = Array [SUBS] Of Real;
   IVEC = Array [SUBS] Of Integer;
   S8 = Array [SUBS] Of String[8];
Var
   dfile, ofile : Text;
   sel : IVEC;
   nc, mu, vr, stdev, sterr, miss, vars, rw1, rw2, drw1, drw2: RVEC;
   varn : S8;
   i, j, k, nv, dv, ot : Integer;
   tt, tmp, df1, df2, dnc, cross, dif : Real;

Procedure openfiles(Var dfile, ofile:Text; Var ot:Integer);
Var
   dfl, ofl:String[12];
Begin
   ClrScr; Writeln(' *** HYPOTHS: MEAN AND VARIANCE HYPOTHESES TESTS ***');
   Writeln; Write('Name of the data file? ');
   Readln(dfl); Assign(dfile,dfl); Reset(dfile);
   Write('Name of the output file? ');
   Readln(ofl); Assign(ofile,ofl); Rewrite(ofile);
   ot:= 0;
   If (ofl='CON:') Or (ofl='con:') Then ot:=1;
   If (ofl='LST:') Or (ofl='lst:') Then ot:=2;
   If (ot=2) Then
      Begin
      Writeln(ofile,'Multivariate Analysis Package (1.6) - ',
         'Program: HYPOTHS, Datafile: ',dfl); Writeln(ofile);
      End;
   End; (* Of openfiles *)

Procedure wait(ot:Integer);
Begin
  If ot=1 Then Begin
    Write('- Press any key to continue -'); While Not KeyPressed Do; ClrScr;
    End;
  End; (* of wait *)

Procedure selectvar(Var sel:IVEC; Var varn:S8; Var miss:RVEC;
                    Var nv, dv:Integer);
Var
   cfile:Text;
   cfl:String[12];
   i,j,f:Integer;
   mis:Real;
   van:String[8];
Begin
   Write('Name of the codebook file (or NONE)? '); Readln(cfl);
   If (cfl<>'NONE') And (cfl<>'none') Then f:=1 Else f:=0;
   If f=1 Then Begin Assign(cfile,cfl); Reset(cfile); End;
   Writeln;
   Write('How many variables in data file? '); Readln(nv);
   Write('Test groups of 1 variable or compare 2 variables (1 or 2)? ');
   Readln(dv);
   For i:=1 To 2 Do
      Begin
      Write('Column number for variable ',i,'? '); Read(sel[i]);
      Str(sel[i]:3,varn[i]); miss[i]:=-1E37;
      If ((dv=1) and (i=1)) Then Begin
         Writeln('Second variable must be a dummy coded (0 or 1) variable');
         Writeln('created by TRANSFRM to identify two groups to compare.');
         End;
      End;
   If f=1 Then Begin
     For j:=1 to nv Do Begin
       mis:=-1E37;
       Readln(cfile,f,van,mis);
       For i:=1 to dv Do
         If f=sel[i] Then Begin
           varn[i]:=van; miss[i]:=mis;
           Writeln('Col: ',sel[i],'  Name: ',varn[i],' Missing: ',miss[i]:6);
           End;     
       End;
     Close(cfile);
     wait(1);
     End;
   End; (* Of selectvar *)

Procedure getcase(Var vars:RVEC; sel:IVEC; nv:Integer; Var dfile:Text);
Var
   i, j:Integer;
   x:Real;
Begin
   For i:=1 To nv Do
      Begin
      Read(dfile,x);
      If sel[1]=i Then vars[1]:=x Else If sel[2]=i Then vars[2]:=x;
      End;
   End; (* Of getcase *)

Begin (* main *)
   openfiles(dfile, ofile, ot);
   selectvar(sel, varn, miss, nv, dv);
   (* intialize *)
   dnc:=0.; cross:=0.;
   For i:=1 To 2 Do
      Begin
      nc[i]:=0.; rw1[i]:=0.; rw2[i]:=0.; drw1[i]:=0.; drw2[i]:=0.;
      End;
   (* accumulate *)
   Writeln;
   k:=0;
   While Not EOF(dfile) Do
      Begin
      k:=k+1;
      getcase(vars, sel, nv, dfile);
      If Frac(k/10)=0.0 Then Write('+');
      If Not EOF(dfile) Then
         Begin
         If(dv=2) Then For j:=1 To 2 Do
            Begin
            If(vars[j]<>miss[j]) Then
               Begin
               nc[j]:=nc[j]+1.0;
               rw1[j]:=rw1[j]+vars[j];
               rw2[j]:=rw2[j]+Sqr(vars[j]);
               End;
            End;
         If(dv=2) Then
            Begin
            If((vars[1]<>miss[1]) and (vars[2]<>miss[2])) Then
               Begin
               For j:=1 To 2 Do
                  Begin
                  drw1[j]:=drw1[j]+vars[j];
                  drw2[j]:=drw2[j]+Sqr(vars[j]);
                  End;
               dnc:=dnc+1.0;
               cross:=cross+(vars[1]*vars[2]);
               End;
            End;
         If((vars[1]<>miss[1]) and (dv=1)) Then
            Begin
            j:=Trunc(vars[2]+0.1)+1;
            nc[j]:=nc[j]+1.0;
            rw1[j]:=rw1[j]+vars[1];
            rw2[j]:=rw2[j]+Sqr(vars[1]);
            End;
         End;
      End;
   (* compute And Output stats*)
      ClrScr;
      Write(ofile,'Hypotheses Tests for ',varn[1]);
      If(dv=2) Then Writeln(ofile,' compared with ',varn[2])
                Else Writeln(ofile,' comparing two groups');
      Writeln(ofile);
      Write('Hypothesized Difference in Means (0=none, or value)? ');
      Readln(dif); Writeln(ofile);
      For j:=1 To 2 Do If nc[j]>1.0 Then
        Begin
        mu[j]:=rw1[j]/nc[j]; vr[j]:=(rw2[j]-(mu[j]*rw1[j]))/(nc[j]-1.0);
        stdev[j]:=Sqrt(vr[j]); sterr[j]:=Sqrt(vr[j]/nc[j]);
        If(dv=1) Then
           Writeln(ofile,'Descriptive Stats for ',varn[1],' Group ',j-1);
        If(dv=2) Then
           Writeln(ofile,'Descriptive Stats for Variable ',varn[j]);
        Writeln(ofile,'Mean:    ',mu[j]:13:5,'  Std. Error:',sterr[j]:13:5);
        Writeln(ofile,'Variance:',vr[j]:13:5,'  Std. Dev:  ',stdev[j]:13:5);
        Writeln(ofile);
        End;
      wait(ot);
      tmp:=vr[1]/vr[2]; df1:=nc[1]-1.0; df2:=nc[2]-1.0;
      if (vr[2]/vr[1]>vr[1]/vr[2]) Then
         Begin
         tmp:=vr[2]/vr[1]; df1:=nc[2]-1.0; df2:=nc[1]-1.0;
         End;
      Writeln(ofile);
      Write(ofile,'F-test for Equality of Variances: ',tmp:11:4);
      Writeln(ofile,' degrees of freedom:',df1:4:0,',',df2:4:0);
      Writeln(ofile); tmp:=mu[1]-mu[2];
      Writeln(ofile,'Difference of Means: ',tmp:11);Writeln(ofile);
      tmp:=SQRT((vr[1]/nc[1])+(vr[2]/nc[2]));
      Writeln(ofile,'Unpooled Standard Error of Difference: ',tmp:11);
      tt:=(mu[1]-mu[2]-dif)/tmp;
      tmp:=((nc[1]*vr[1])+(nc[2]*vr[2]))/(nc[1]+nc[2]-2.0);
      Writeln(ofile,'Pooled Variance Estimate: ',tmp:11);
      tmp:=SQRT(tmp)*SQRT((1/nc[1])+(1/nc[2]));
      Writeln(ofile,'Pooled Standard Error of Difference: ',tmp:11);
      Writeln(ofile);
      If(dv=2) Then Begin
         Write(ofile,'T-tests for Difference of Means ',varn[1],' and ');
         Writeln(ofile,varn[2],' of ',dif:11:5,': ');
         End;
      If(dv=1) Then Begin
         Write(ofile,'T-tests for Difference of Mean ',varn[1],' group 0');
         Writeln(ofile,' and group 1 of ',dif:11:5,': ');
         End;
      Write(ofile,'     Separate Variance t-test: ',tt:11:5);
      tt:=SQR((vr[1]/nc[1])/((vr[1]/nc[1])+(vr[2]/nc[2])))/(nc[1]-1.0);
      tt:=tt+SQR((vr[1]/nc[2])/((vr[2]/nc[2])+(vr[1]/nc[1])))/(nc[2]-1.0);
      tt:=Int(1/tt);
      Writeln(ofile,' degrees of freedom: ',tt:5:0);
      tt:=(mu[1]-mu[2]-dif)/tmp;
      Write(ofile,'     Pooled Variance t-test: ',tt:11:5);
      tt:=nc[1]+nc[2]-2;
      Writeln(ofile,' degrees of freedom: ',tt:5:0);
      Writeln(ofile);
      If(dv=2) Then Begin
         Write(ofile,'Paired T-test for Difference of Means ',varn[1]);
         Writeln(ofile,' and ',varn[2],' of ',dif:11:5,': ');
         tmp:=(cross-((drw1[1]*drw1[2])/dnc))/(dnc-1.0);
         Writeln(ofile,'     Covariance Estimate: ',tmp:11);
         For j:=1 To 2 Do Begin
            mu[j]:=drw1[j]/dnc;
            vr[j]:=(drw2[j]-(mu[j]*drw1[j]))/(dnc-1.0);
            End;
         tt:=Sqrt((vr[1]+vr[2]-(2*tmp))/dnc);
         Writeln(ofile,'     Std. Error of Paired Difference: ',tt:11);
         tmp:=((drw1[1]/dnc)-(drw1[2]/dnc)-dif)/tt;
         Write(ofile,'     Paired Difference t-test: ',tmp:11:5);
         tmp:=dnc-1;
         Writeln(ofile,' degrees of freedom: ',tmp:5:0);
         Writeln(ofile);
         End;
      Close(dfile); Close(ofile);
      Assign(dfile,'MAPSTAT.COM'); Execute(dfile);
 End.