(* Multivariate Analysis Package - Partial Correlation 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 Partial(Input,Output);
Const
   N=30;
Type
   SUBS=1..N;
   RVEC = Array [SUBS] Of Real;
   NBYN = Array [SUBS] Of RVEC;
   IVEC = Array [SUBS] Of Integer;
   S8 = Array [SUBS] Of String[8];
Var
   dfile, ofile : Text;
   sel : IVEC;
   x, y, z: RVEC;
   varn : S8;
   cor, b, t : NBYN;
   i, j, j1, k, l, nv, dv, cv, rv, ot: Integer;
   det, nc: real;
   error: boolean;

Procedure openfiles(Var dfile, ofile:Text; Var nv, dv, cv, ot:Integer);
Var
   dfl, ofl:String[12];
Begin
   ClrScr; Writeln(' *** PARTIAL: PARTIAL CORRELATION ***');
   Writeln; Write('Name of the CORREL 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: PARTIAL, Datafile: ',dfl); Writeln(ofile);
      End;
   Write('How many variables in CORREL matrix? '); Readln(nv);
   Write('Number of variables to use in PARTIAL? '); Readln(dv);
   Write('Number of these to control remaining correlations for? ');
   Readln(cv);
   End; (* Of openfiles *)

Procedure selectvar3(Var sel:IVEC; dv, cv:Integer);
Var
   i:Integer;
Begin
   Writeln;
   For i:=1 To dv Do
      Begin
      If(i<=cv) Then Write('Column number for controlling variable ',i,'? ');
      If(i>cv) Then Write('Column number for partialled variable ',i-cv,'? ');
      Readln(sel[i]);
      End;
   End; (* Of selectvar *)

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 *)

{$I GETCOR.LIB}
{$I MATINV.LIB}

Begin (* main *)
   openfiles(dfile, ofile, nv, dv, cv, ot);
   selectvar3(sel, dv, cv);
   (* read correlation matrix matrix *)
   getcor(cor, x, y, varn, nc, sel, nv, dv, dfile);
   (* invert left side*)
   matinv(cor,cv,det,error);
   (* multiply for coefficients *)
   rv:=dv-cv;
   For j:=1 To rv Do
      Begin
      j1:=j+cv;
      For k:=1 To cv Do Begin
         b[j,k]:=0.0;
         For l:=1 To cv Do b[j,k]:=b[j,k]+(cor[j1,l]*cor[l,k]);
         End;
      End;
   For j:=1 To rv Do
     Begin 
     ClrScr;
     Writeln(ofile,'Regression Coefficients of ',varn[j+cv],' on Controls:');
     Writeln(ofile);
     For i:=1 To cv Do Writeln(ofile,'     ',varn[i],': ',b[j,i]:10:6);
     Writeln(ofile);
     wait(ot);
    End;
  For j:=1 To rv Do
    For k:=1 To rv Do Begin
      j1:=k+cv; t[j,k]:=0.0;
      For l:=1 To cv Do t[j,k]:=t[j,k]+(b[j,l]*cor[l,j1]);
      End;
  For j:=1 To rv Do Begin
    j1:=j+cv;
    For k:=1 To rv Do Begin l:=k+cv; b[j,k]:=cor[j1,l]; End;
    End;
  For j:=1 To rv Do Begin
    x[j]:=t[j,j]; y[j]:=Sqrt(x[j]);
    z[j]:=(x[j]*(nc-cv-1.0))/((1.0-x[j])*cv);
    End;
  ClrScr;
  Writeln(ofile,'Summary of Regression on Controls:');
  Writeln(ofile);
  Writeln(ofile,'Variable:     Mult. R    Mult. R-Sq.   F-Ratio');
  For j:=1 To rv Do
    Writeln(ofile,varn[j+cv]:8,'  ',y[j]:11:5,'  ',x[j]:11:5,'   ',z[j]:9:3);
  Writeln(ofile); Writeln(ofile,'  degrees of freedom: ',cv:3,(nc-cv-1):5);
  Writeln(ofile);
  wait(ot);
  For j:=1 To rv Do
    For k:=1 To rv Do b[j,k]:=b[j,k]-t[j,k];
  For j:=1 To rv Do x[j]:=Sqrt(b[j,j]);
  For j:=1 To rv Do
    For k:=1 To rv Do cor[j,k]:=b[j,k]/(x[j]*x[k]);
  Writeln(ofile,'Residual Covariance and Partial Correlations:');
  Writeln(ofile);
  For j:= 1 To rv Do
    Begin
    For i := j+1 To rv Do
      Begin
      Writeln(ofile,varn[j+cv]:8,' with ',varn[i+cv]:8,'   Resid Covr: ',
        b[j,i]:13,'  Partial Corr:',cor[j,i]:10:6);
      End;
    End;
  Writeln(ofile);
  Close(ofile); Close(dfile);
  Assign(dfile,'MAPSTAT.COM'); Execute(dfile);
End.