You've already forked lazarus-ccr
e1c5977e0d
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7885 8e941d3f-bd1b-0410-a28a-d453659cc2b4
375 lines
11 KiB
ObjectPascal
375 lines
11 KiB
ObjectPascal
unit PartialsUnit;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
|
StdCtrls, Buttons, MainUnit, MatrixLib, FunctionsLib, OutPutUnit, Globals,
|
|
contexthelpunit;
|
|
|
|
type
|
|
|
|
{ TPartialsFrm }
|
|
|
|
TPartialsFrm = class(TForm)
|
|
DepInBtn: TBitBtn;
|
|
DepOutBtn: TBitBtn;
|
|
HelpBtn: TButton;
|
|
PredInBtn: TBitBtn;
|
|
PredOutBtn: TBitBtn;
|
|
PartInBtn: TBitBtn;
|
|
PartOutBtn: TBitBtn;
|
|
ResetBtn: TButton;
|
|
CancelBtn: TButton;
|
|
ComputeBtn: TButton;
|
|
ReturnBtn: TButton;
|
|
DepVar: TEdit;
|
|
Label1: TLabel;
|
|
Label2: TLabel;
|
|
Label3: TLabel;
|
|
Label4: TLabel;
|
|
PartList: TListBox;
|
|
PredList: TListBox;
|
|
VarList: TListBox;
|
|
procedure ComputeBtnClick(Sender: TObject);
|
|
procedure DepInBtnClick(Sender: TObject);
|
|
procedure DepOutBtnClick(Sender: TObject);
|
|
procedure FormShow(Sender: TObject);
|
|
procedure HelpBtnClick(Sender: TObject);
|
|
procedure PartInBtnClick(Sender: TObject);
|
|
procedure PartOutBtnClick(Sender: TObject);
|
|
procedure PredInBtnClick(Sender: TObject);
|
|
procedure PredOutBtnClick(Sender: TObject);
|
|
procedure ResetBtnClick(Sender: TObject);
|
|
private
|
|
{ private declarations }
|
|
public
|
|
{ public declarations }
|
|
end;
|
|
|
|
var
|
|
PartialsFrm: TPartialsFrm;
|
|
|
|
implementation
|
|
|
|
{ TPartialsFrm }
|
|
|
|
procedure TPartialsFrm.ResetBtnClick(Sender: TObject);
|
|
VAR i : integer;
|
|
begin
|
|
DepVar.Text := '';
|
|
VarList.Clear;
|
|
PartList.Clear;
|
|
PredList.Clear;
|
|
DepInBtn.Visible := true;
|
|
DepOutBtn.Visible := false;
|
|
PredInBtn.Visible := true;
|
|
PredOutBtn.Visible := false;
|
|
PartInBtn.Visible := true;
|
|
PartOutBtn.Visible := false;
|
|
for i := 1 to OS3MainFrm.DataGrid.ColCount - 1 do
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
|
end;
|
|
|
|
procedure TPartialsFrm.FormShow(Sender: TObject);
|
|
begin
|
|
ResetBtnClick(self);
|
|
end;
|
|
|
|
procedure TPartialsFrm.HelpBtnClick(Sender: TObject);
|
|
begin
|
|
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
|
end;
|
|
|
|
procedure TPartialsFrm.PartInBtnClick(Sender: TObject);
|
|
VAR i, index : integer;
|
|
begin
|
|
index := VarList.Items.Count;
|
|
i := 0;
|
|
while i < index do
|
|
begin
|
|
if (VarList.Selected[i]) then
|
|
begin
|
|
PartList.Items.Add(VarList.Items.Strings[i]);
|
|
VarList.Items.Delete(i);
|
|
index := index - 1;
|
|
i := 0;
|
|
end
|
|
else i := i + 1;
|
|
end;
|
|
PartOutBtn.Visible := true;
|
|
end;
|
|
|
|
procedure TPartialsFrm.PartOutBtnClick(Sender: TObject);
|
|
VAR index : integer;
|
|
begin
|
|
index := PartList.ItemIndex;
|
|
VarList.Items.Add(PartList.Items.Strings[index]);
|
|
PartList.Items.Delete(index);
|
|
if PartList.Items.Count = 0 then PartOutBtn.Visible := false;
|
|
end;
|
|
|
|
procedure TPartialsFrm.PredInBtnClick(Sender: TObject);
|
|
VAR i, index : integer;
|
|
begin
|
|
index := VarList.Items.Count;
|
|
i := 0;
|
|
while i < index do
|
|
begin
|
|
if (VarList.Selected[i]) then
|
|
begin
|
|
PredList.Items.Add(VarList.Items.Strings[i]);
|
|
VarList.Items.Delete(i);
|
|
index := index - 1;
|
|
i := 0;
|
|
end
|
|
else i := i + 1;
|
|
end;
|
|
PredOutBtn.Visible:= true;
|
|
end;
|
|
|
|
procedure TPartialsFrm.PredOutBtnClick(Sender: TObject);
|
|
VAR index : integer;
|
|
begin
|
|
index := PredList.ItemIndex;
|
|
VarList.Items.Add(PredList.Items.Strings[index]);
|
|
PredList.Items.Delete(index);
|
|
if PredList.Items.Count = 0 then PredOutBtn.Visible := false;
|
|
end;
|
|
|
|
procedure TPartialsFrm.DepInBtnClick(Sender: TObject);
|
|
VAR index : integer;
|
|
begin
|
|
index := VarList.ItemIndex;
|
|
if index < 0 then exit;
|
|
DepVar.Text := VarList.Items.Strings[index];
|
|
VarList.Items.Delete(index);
|
|
DepOutBtn.Visible := true;
|
|
DepInBtn.Visible := false;
|
|
end;
|
|
|
|
procedure TPartialsFrm.ComputeBtnClick(Sender: TObject);
|
|
var
|
|
rmatrix, workmat : DblDyneMat;
|
|
Means, Variances, StdDevs, W, Betas : DblDyneVec;
|
|
R2Full, R2Cntrl, SemiPart, Partial, df1, df2, F, Prob : double;
|
|
NoPredVars, NoCntrlVars, DepVarNo, TotNoVars, pcnt, ccnt, count : integer;
|
|
PredVars, CntrlVars : IntDyneVec;
|
|
MatVars : IntDyneVec;
|
|
outline, varstring : string;
|
|
i, j, K, L, NCases : integer;
|
|
errorcode : boolean;
|
|
vtimesw, W1, v : DblDyneMat;
|
|
|
|
begin
|
|
DepVarNo := 1;
|
|
errorcode := false;
|
|
|
|
// Get no. of predictor and control variables
|
|
NoPredVars := PredList.Items.Count;
|
|
NoCntrlVars := PartList.Items.Count;
|
|
if (NoPredVars = 0) or (NoCntrlVars = 0) then
|
|
begin
|
|
ShowMessage('You must select at least one predictor and one control variable!');
|
|
exit;
|
|
end;
|
|
TotNoVars := NoPredVars + NoCntrlVars + 1;
|
|
count := NoCases;
|
|
NCases := NoCases;
|
|
|
|
// Allocate space required
|
|
SetLength(vtimesw,NoVariables,NoVariables);
|
|
SetLength(v,NoVariables,NoVariables);
|
|
SetLength(W1,NoVariables,NoVariables);
|
|
SetLength(rmatrix,NoVariables+1,NoVariables+1); // augmented
|
|
SetLength(workmat,NoVariables+1,NoVariables+1); // augmented
|
|
SetLength(PredVars,NoVariables);
|
|
SetLength(CntrlVars,NoVariables);
|
|
SetLength(Means,NoVariables);
|
|
SetLength(Variances,NoVariables);
|
|
SetLength(StdDevs,NoVariables);
|
|
SetLength(W,NoVariables);
|
|
SetLength(Betas,NoVariables);
|
|
SetLength(MatVars,NoVariables);
|
|
|
|
OutPutFrm.RichEdit.Clear;
|
|
OutPutFrm.RichEdit.Lines.Add('Partial and Semi-Partial Correlation Analysis');
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
|
|
// Get column numbers of dependent, predictor and control variables
|
|
pcnt := 1;
|
|
for i := 0 to NoPredVars - 1 do
|
|
begin
|
|
varstring := PredList.Items.Strings[i];
|
|
for j := 1 to NoVariables do
|
|
begin
|
|
if varstring = OS3MainFrm.DataGrid.Cells[j,0] then
|
|
begin
|
|
PredVars[pcnt-1] := j;
|
|
pcnt := pcnt + 1;
|
|
end;
|
|
end;
|
|
end;
|
|
ccnt := 1;
|
|
for i := 0 to NoCntrlVars - 1 do
|
|
begin
|
|
varstring := PartList.Items.Strings[i];
|
|
for j := 1 to NoVariables do
|
|
begin
|
|
if varstring = OS3MainFrm.DataGrid.Cells[j,0] then
|
|
begin
|
|
CntrlVars[ccnt-1] := j;
|
|
ccnt := ccnt + 1;
|
|
end;
|
|
end;
|
|
end;
|
|
varstring := DepVar.Text;
|
|
for i := 1 to NoVariables do
|
|
if varstring = OS3MainFrm.DataGrid.Cells[i,0] then DepVarNo := i;
|
|
|
|
outline := format('Dependent variable = %s',[OS3MainFrm.DataGrid.Cells[DepVarNo,0]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
OutPutFrm.RichEdit.Lines.Add('Predictor Variables:');
|
|
for i := 1 to NoPredVars do
|
|
begin
|
|
outline := format('Variable %d = %s',[i+1,OS3MainFrm.DataGrid.Cells[PredVars[i-1],0]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
OutPutFrm.RichEdit.Lines.Add('Control Variables:');
|
|
for i := 1 to NoCntrlVars do
|
|
begin
|
|
outline := format('Variable %d = %s',[i+1,OS3MainFrm.DataGrid.Cells[CntrlVars[i-1],0]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
if NoPredVars > 1 then
|
|
begin
|
|
outline := format('Higher order partialling at level = %d',[NoPredVars]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
end;
|
|
if NoCntrlVars > 1 then
|
|
begin
|
|
outline := format('Multiple partialling with %d variables.',[NoCntrlVars]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
end;
|
|
|
|
// Now, build the correlation matrix
|
|
MatVars[0] := DepVarNo;
|
|
for i := 1 to NoPredVars do MatVars[i] := PredVars[i-1];
|
|
for i := 1 to NoCntrlVars do MatVars[i + NoPredVars] := CntrlVars[i-1];
|
|
Correlations(TotNoVars, MatVars, rmatrix, Means, Variances, StdDevs, errorcode, count);
|
|
|
|
// Now do Multiple regression models required
|
|
// Full model first
|
|
for i := 2 to TotNoVars do
|
|
for j := 2 to TotNoVars do
|
|
workmat[i-2,j-2] := rmatrix[i-1,j-1];
|
|
|
|
matinv(workmat, vtimesw, v, W1, TotNoVars-1);
|
|
R2Full := 0.0;
|
|
for i := 1 to TotNoVars-1 do // rows
|
|
begin
|
|
W[i-1] := 0.0;
|
|
for j := 1 to TotNoVars - 1 do W[i-1] := W[i-1] + (workmat[i-1,j-1] * rmatrix[0,j]);
|
|
R2Full := R2Full + W[i-1] * rmatrix[0,i];
|
|
end;
|
|
outline := format('Squared Multiple Correlation with all variables = %6.3f',[R2Full]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
OutPutFrm.RichEdit.Lines.Add('Standardized Regression Coefficients:');
|
|
for i := 1 to TotNoVars - 1 do
|
|
begin
|
|
outline := format('%10s = %6.3f',[OS3MainFrm.DataGrid.Cells[MatVars[i],0],W[i-1]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
|
|
// Now do model for Partial and Semi-partial
|
|
for i := 1 to NoCntrlVars do
|
|
begin
|
|
K := i + 1 + NoPredVars;
|
|
for j := 1 to NoCntrlVars do
|
|
begin
|
|
L := j + 1 + NoPredVars;
|
|
workmat[i-1,j-1] := rmatrix[K-1,L-1];
|
|
end;
|
|
end;
|
|
matinv(workmat, vtimesw, v, W1, NoCntrlVars);
|
|
R2Cntrl := 0.0;
|
|
for i := 1 to NoCntrlVars do
|
|
begin
|
|
L := i + 1 + NoPredVars;
|
|
W[i-1] := 0.0;
|
|
for j := 1 to NoCntrlVars do
|
|
begin
|
|
K := j + 1 + NoPredVars;
|
|
W[i-1] := W[i-1] + (workmat[i-1,j-1] * rmatrix[0,K-1]);
|
|
end;
|
|
R2Cntrl := R2Cntrl + W[i-1] * rmatrix[0,L-1];
|
|
end;
|
|
outline := format('Squared Multiple Correlation with control variables = %6.3f',[R2Cntrl]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
OutPutFrm.RichEdit.Lines.Add('Standardized Regression Coefficients:');
|
|
for i := 1 to NoCntrlVars do
|
|
begin
|
|
outline := format('%10s = %6.3f',[OS3MainFrm.DataGrid.Cells[MatVars[i+NoPredVars],0],W[i-1]]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
end;
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
|
|
SemiPart := R2Full - R2Cntrl;
|
|
Partial := SemiPart / (1.0 - R2Cntrl);
|
|
df1 := TotNoVars - 1 - NoCntrlVars;
|
|
df2 := count - TotNoVars;
|
|
F := (SemiPart / (1.0 - R2Full)) * (df2 / df1);
|
|
Prob := probf(F,df1,df2);
|
|
|
|
// Report results
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
outline := format('Partial Correlation = %6.3f',[sqrt(Partial)]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
outline := format('Semi-Partial Correlation = %6.3f',[sqrt(SemiPart)]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
|
outline := format('F = %8.3f with probability = %6.4f, D.F.1 = %3.0f and D.F.2 = %3.0f',[F,Prob,df1,df2]);
|
|
OutPutFrm.RichEdit.Lines.Add(outline);
|
|
OutPutFrm.ShowModal;
|
|
|
|
// clean up the heap
|
|
MatVars := nil;
|
|
Betas := nil;
|
|
W := nil;
|
|
Variances := nil;
|
|
StdDevs := nil;
|
|
Means := nil;
|
|
CntrlVars := nil;
|
|
PredVars := nil;
|
|
workmat := nil;
|
|
rmatrix := nil;
|
|
v := nil;
|
|
W1 := nil;
|
|
vtimesw := nil;
|
|
end;
|
|
|
|
procedure TPartialsFrm.DepOutBtnClick(Sender: TObject);
|
|
begin
|
|
VarList.Items.Add(DepVar.Text);
|
|
DepVar.Text := '';
|
|
DepInBtn.Visible := true;
|
|
DepOutBtn.Visible := false;
|
|
end;
|
|
|
|
initialization
|
|
{$I partialsunit.lrs}
|
|
|
|
end.
|
|
|