You've already forked lazarus-ccr
443 lines
14 KiB
ObjectPascal
443 lines
14 KiB
ObjectPascal
|
unit RMatUnit;
|
||
|
|
|
||
|
|
{$mode objfpc}{$H+}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
|
||
|
|
StdCtrls, Buttons, MainUnit, Globals, MatrixLib, OutPutUnit, DataProcs,
|
||
|
|
FunctionsLib, contexthelpunit;
|
||
|
|
|
||
|
|
type
|
||
|
|
|
||
|
|
{ TRMatFrm }
|
||
|
|
|
||
|
|
TRMatFrm = class(TForm)
|
||
|
|
GridMatChk: TCheckBox;
|
||
|
|
HelpBtn: TButton;
|
||
|
|
InBtn: TBitBtn;
|
||
|
|
OutBtn: TBitBtn;
|
||
|
|
AllBtn: TBitBtn;
|
||
|
|
AugmentChk: TCheckBox;
|
||
|
|
ResetBtn: TButton;
|
||
|
|
CancelBtn: TButton;
|
||
|
|
ComputeBtn: TButton;
|
||
|
|
ReturnBtn: TButton;
|
||
|
|
CPChkBox: TCheckBox;
|
||
|
|
CovChkBox: TCheckBox;
|
||
|
|
CorrsChkBox: TCheckBox;
|
||
|
|
MeansChkBox: TCheckBox;
|
||
|
|
VarChkBox: TCheckBox;
|
||
|
|
SDChkBox: TCheckBox;
|
||
|
|
PairsChkBox: TCheckBox;
|
||
|
|
GroupBox1: TGroupBox;
|
||
|
|
Label1: TLabel;
|
||
|
|
Label2: TLabel;
|
||
|
|
ListBox1: TListBox;
|
||
|
|
VarList: TListBox;
|
||
|
|
procedure AllBtnClick(Sender: TObject);
|
||
|
|
procedure ComputeBtnClick(Sender: TObject);
|
||
|
|
procedure FormShow(Sender: TObject);
|
||
|
|
procedure HelpBtnClick(Sender: TObject);
|
||
|
|
procedure InBtnClick(Sender: TObject);
|
||
|
|
procedure OutBtnClick(Sender: TObject);
|
||
|
|
procedure ResetBtnClick(Sender: TObject);
|
||
|
|
private
|
||
|
|
{ private declarations }
|
||
|
|
procedure PairsCalc(NoVars : integer;
|
||
|
|
VAR ColNoSelected : IntDyneVec;
|
||
|
|
VAR Matrix : DblDyneMat;
|
||
|
|
VAR ColLabels : StrDyneVec);
|
||
|
|
|
||
|
|
public
|
||
|
|
{ public declarations }
|
||
|
|
end;
|
||
|
|
|
||
|
|
var
|
||
|
|
RMatFrm: TRMatFrm;
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
{ TRMatFrm }
|
||
|
|
|
||
|
|
procedure TRMatFrm.ResetBtnClick(Sender: TObject);
|
||
|
|
VAR i : integer;
|
||
|
|
begin
|
||
|
|
VarList.Clear;
|
||
|
|
ListBox1.Clear;
|
||
|
|
for i := 1 to NoVariables do
|
||
|
|
begin
|
||
|
|
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
|
||
|
|
end;
|
||
|
|
InBtn.Enabled := true;
|
||
|
|
OutBtn.Enabled := false;
|
||
|
|
AugmentChk.Checked := false;
|
||
|
|
PairsChkBox.Checked := false;
|
||
|
|
CPChkBox.Checked := false;
|
||
|
|
CovChkBox.Checked := false;
|
||
|
|
CorrsChkBox.Checked := true;
|
||
|
|
MeansChkBox.Checked := true;
|
||
|
|
VarChkBox.Checked := false;
|
||
|
|
SDChkBox.Checked := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.FormShow(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ResetBtnClick(Self);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.HelpBtnClick(Sender: TObject);
|
||
|
|
begin
|
||
|
|
ContextHelpForm.HelpMessage((Sender as TButton).tag);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.AllBtnClick(Sender: TObject);
|
||
|
|
VAR count, index : integer;
|
||
|
|
begin
|
||
|
|
count := VarList.Items.Count;
|
||
|
|
for index := 0 to count-1 do
|
||
|
|
begin
|
||
|
|
ListBox1.Items.Add(VarList.Items.Strings[index]);
|
||
|
|
end;
|
||
|
|
VarList.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.ComputeBtnClick(Sender: TObject);
|
||
|
|
label cleanit;
|
||
|
|
var
|
||
|
|
i, j : integer;
|
||
|
|
cellstring : string;
|
||
|
|
NoVars : integer;
|
||
|
|
ColNoSelected : IntDyneVec;
|
||
|
|
Matrix : DblDyneMat;
|
||
|
|
TestMat : DblDyneMat;
|
||
|
|
Means : DblDyneVec;
|
||
|
|
Variances : DblDyneVec;
|
||
|
|
StdDevs : DblDyneVec;
|
||
|
|
RowLabels, ColLabels : StrDyneVec;
|
||
|
|
Augment : boolean;
|
||
|
|
title : string;
|
||
|
|
errorcode : boolean;
|
||
|
|
Ngood : integer;
|
||
|
|
t, Sr, Probr, N, z : double;
|
||
|
|
begin
|
||
|
|
errorcode := false;
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
NoVars := ListBox1.Items.Count;
|
||
|
|
Augment := false;
|
||
|
|
Ngood := 0;
|
||
|
|
|
||
|
|
SetLength(ColNoSelected,NoVars+1);
|
||
|
|
SetLength(Matrix,NoVars+1,NoVars+1); // 1 more for possible augmentation
|
||
|
|
SetLength(TestMat,NoVars,NoVars);
|
||
|
|
SetLength(Means,NoVars+1);
|
||
|
|
SetLength(Variances,NoVars+1);
|
||
|
|
SetLength(StdDevs,NoVars+1);
|
||
|
|
SetLength(RowLabels,NoVars+1);
|
||
|
|
SetLength(ColLabels,NoVars+1);
|
||
|
|
|
||
|
|
// identify the included variable locations and their labels
|
||
|
|
for i := 1 to NoVars do
|
||
|
|
begin
|
||
|
|
cellstring := ListBox1.Items.Strings[i-1];
|
||
|
|
for j := 1 to NoVariables do
|
||
|
|
begin
|
||
|
|
if cellstring = OS3MainFrm.DataGrid.Cells[j,0] then
|
||
|
|
begin
|
||
|
|
ColNoSelected[i-1] := j;
|
||
|
|
RowLabels[i-1] := cellstring;
|
||
|
|
ColLabels[i-1] := cellstring;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if PairsChkBox.Checked then
|
||
|
|
begin
|
||
|
|
PairsCalc(NoVars,ColNoSelected,Matrix,ColLabels);
|
||
|
|
goto cleanit;
|
||
|
|
end;
|
||
|
|
|
||
|
|
if AugmentChk.Checked then
|
||
|
|
begin
|
||
|
|
Augment := true;
|
||
|
|
ColLabels[NoVars] := 'Intercept';
|
||
|
|
RowLabels[NoVars] := 'Intercept';
|
||
|
|
end;
|
||
|
|
|
||
|
|
// get cross-products if elected
|
||
|
|
if CPChkBox.Checked = true then
|
||
|
|
begin
|
||
|
|
GridXProd(NoVars,ColNoSelected,Matrix,Augment,Ngood);
|
||
|
|
title := 'Cross-Products Matrix';
|
||
|
|
if NOT Augment then
|
||
|
|
MAT_PRINT(Matrix,NoVars,NoVars,title,RowLabels,ColLabels,Ngood)
|
||
|
|
else
|
||
|
|
MAT_PRINT(Matrix,NoVars+1,NoVars+1,title,RowLabels,ColLabels,Ngood);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if CovChkBox.Checked = true then // get variance-covariance mat. if elected
|
||
|
|
begin
|
||
|
|
title := 'Variance-Covariance Matrix';
|
||
|
|
GridCovar(NoVars,ColNoSelected,Matrix,Means,Variances,StdDevs,errorcode, Ngood);
|
||
|
|
MAT_PRINT(Matrix,NoVars,NoVars,title,RowLabels,ColLabels,Ngood);
|
||
|
|
end;
|
||
|
|
|
||
|
|
if CorrsChkBox.Checked = true then // get correlations
|
||
|
|
begin
|
||
|
|
title := 'Product-Moment Correlations Matrix';
|
||
|
|
Correlations(NoVars,ColNoSelected,Matrix,Means,Variances,StdDevs,errorcode,Ngood);
|
||
|
|
MAT_PRINT(Matrix,NoVars,NoVars,title,RowLabels,ColLabels,Ngood);
|
||
|
|
N := Ngood;
|
||
|
|
for i := 1 to NoVars do
|
||
|
|
begin
|
||
|
|
for j := i+1 to NoVars do
|
||
|
|
begin
|
||
|
|
t := Matrix[i-1][j-1] * (sqrt((N-2.0) /
|
||
|
|
(1.0 - (Matrix[i-1][j-1] * Matrix[i-1][j-1]))));
|
||
|
|
TestMat[i-1,j-1] := t;
|
||
|
|
Probr := probt(t,N - 2.0);
|
||
|
|
TestMat[j-1,i-1] := Probr;
|
||
|
|
TestMat[i-1,i-1] := 0.0;
|
||
|
|
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
title := 't-test values (upper) and probabilities of t (lower)';
|
||
|
|
MAT_PRINT(TestMat,NoVars,NoVars,title,RowLabels,ColLabels,Ngood);
|
||
|
|
end;
|
||
|
|
|
||
|
|
title := 'Means';
|
||
|
|
if MeansChkBox.Checked = true then
|
||
|
|
DynVectorPrint(Means,NoVars,title,ColLabels,Ngood);
|
||
|
|
|
||
|
|
title := 'Variances';
|
||
|
|
if VarChkBox.Checked = true then
|
||
|
|
DynVectorPrint(Variances,NoVars,title,ColLabels,Ngood);
|
||
|
|
|
||
|
|
title := 'Standard Deviations';
|
||
|
|
if SDChkBox.Checked = true then
|
||
|
|
DynVectorPrint(StdDevs,NoVars,title,ColLabels,Ngood);
|
||
|
|
|
||
|
|
if errorcode then
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('One or more correlations could not be computed due to zero variance of a variable.');
|
||
|
|
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
|
||
|
|
if GridMatChk.Checked then MatToGrid(Matrix,NoVars);
|
||
|
|
// clean up the heap
|
||
|
|
cleanit:
|
||
|
|
ColLabels := nil;
|
||
|
|
RowLabels := nil;
|
||
|
|
StdDevs := nil;
|
||
|
|
Variances := nil;
|
||
|
|
Means := nil;
|
||
|
|
Matrix := nil;
|
||
|
|
ColNoSelected := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.InBtnClick(Sender: TObject);
|
||
|
|
VAR i, index : integer;
|
||
|
|
begin
|
||
|
|
index := VarList.Items.Count;
|
||
|
|
i := 0;
|
||
|
|
while i < index do
|
||
|
|
begin
|
||
|
|
if (VarList.Selected[i]) then
|
||
|
|
begin
|
||
|
|
ListBox1.Items.Add(VarList.Items.Strings[i]);
|
||
|
|
VarList.Items.Delete(i);
|
||
|
|
index := index - 1;
|
||
|
|
i := 0;
|
||
|
|
end
|
||
|
|
else i := i + 1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
OutBtn.Enabled := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.OutBtnClick(Sender: TObject);
|
||
|
|
VAR index : integer;
|
||
|
|
begin
|
||
|
|
index := ListBox1.ItemIndex;
|
||
|
|
VarList.Items.Add(ListBox1.Items.Strings[index]);
|
||
|
|
ListBox1.Items.Delete(index);
|
||
|
|
InBtn.Enabled := true;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TRMatFrm.PairsCalc(NoVars: integer; var ColNoSelected: IntDyneVec;
|
||
|
|
var Matrix: DblDyneMat; var ColLabels: StrDyneVec);
|
||
|
|
Label nextpart;
|
||
|
|
var
|
||
|
|
i, j, k, XCol, YCol, Npairs, N : integer;
|
||
|
|
X, Y, XMean, XVar, XSD, YMean, YVar, YSD, pmcorr, z, rprob : double;
|
||
|
|
strout : string;
|
||
|
|
NMatrix : IntDyneMat;
|
||
|
|
tMatrix : DblDyneMat;
|
||
|
|
ProbMat : DblDyneMat;
|
||
|
|
startpos, endpos : integer;
|
||
|
|
|
||
|
|
begin
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
SetLength(NMatrix,NoVars,NoVars);
|
||
|
|
SetLength(tMatrix,NoVars,NoVars);
|
||
|
|
SetLength(ProbMat,NoVars,NoVars);
|
||
|
|
|
||
|
|
for i := 1 to NoVars - 1 do
|
||
|
|
begin
|
||
|
|
for j := i + 1 to NoVars do
|
||
|
|
begin
|
||
|
|
XMean := 0.0;
|
||
|
|
XVar := 0.0;
|
||
|
|
XCol := ColNoSelected[i-1];
|
||
|
|
YMean := 0.0;
|
||
|
|
YVar := 0.0;
|
||
|
|
YCol := ColNoSelected[j-1];
|
||
|
|
pmcorr := 0.0;
|
||
|
|
Npairs := 0;
|
||
|
|
strout := ColLabels[i-1];
|
||
|
|
strout := strout + ' vs ';
|
||
|
|
strout := strout + ColLabels[j-1];
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
for k := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if not ValidValue(k,XCol) then continue;
|
||
|
|
if not ValidValue(k,YCol) then continue;
|
||
|
|
X := StrToFloat(OS3MainFrm.DataGrid.Cells[XCol,k]);
|
||
|
|
Y := StrToFloat(OS3MainFrm.DataGrid.Cells[YCol,k]);
|
||
|
|
pmcorr := pmcorr + (X * Y);
|
||
|
|
XMean := XMean + X;
|
||
|
|
YMean := YMean + Y;
|
||
|
|
XVar := XVar + (X * X);
|
||
|
|
YVar := YVar + (Y * Y);
|
||
|
|
Npairs := NPairs + 1;
|
||
|
|
end;
|
||
|
|
if CPChkBox.Checked then
|
||
|
|
begin
|
||
|
|
strout := format('CrossProducts[%d,%d]=%6.4f, N cases = %d',[i,j,pmcorr,Npairs]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
end;
|
||
|
|
pmcorr := pmcorr - (XMean * YMean) / Npairs;
|
||
|
|
pmcorr := pmcorr / (Npairs - 1);
|
||
|
|
if CovChkBox.Checked then
|
||
|
|
begin
|
||
|
|
strout := format('Covariance[%d,%d]=%6.4f, N cases = %d',[i,j,pmcorr,Npairs]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
end;
|
||
|
|
XVar := XVar - (XMean * XMean) / Npairs;
|
||
|
|
XVar := XVar / (Npairs - 1);
|
||
|
|
XSD := sqrt(XVar);
|
||
|
|
YVar := YVar - (YMean * YMean) / Npairs;
|
||
|
|
YVar := YVar / (Npairs - 1);
|
||
|
|
YSD := sqrt(YVar);
|
||
|
|
XMean := XMean / Npairs;
|
||
|
|
YMean := YMean / Npairs;
|
||
|
|
pmcorr := pmcorr / (XSD * YSD);
|
||
|
|
Matrix[i-1,j-1] := pmcorr;
|
||
|
|
Matrix[j-1,i-1] := pmcorr;
|
||
|
|
NMatrix[i-1,j-1] := Npairs;
|
||
|
|
NMatrix[j-1,i-1] := NPairs;
|
||
|
|
if CorrsChkBox.Checked then
|
||
|
|
begin
|
||
|
|
N := Npairs - 2;
|
||
|
|
z := abs(pmcorr) * (sqrt((N-2)/(1.0 - (pmcorr * pmcorr))));
|
||
|
|
rprob := probt(z,N);
|
||
|
|
// Using Fisher's z transform below gives SPSS results
|
||
|
|
// N := Npairs - 3;
|
||
|
|
// z := 0.5 * ln( (1.0 + pmcorr)/(1.0 - pmcorr) );
|
||
|
|
// z := z / sqrt(1.0/N);
|
||
|
|
// rprob := probz(z);
|
||
|
|
strout := format('r[%d,%d]=%6.4f, N cases = %d',[i,j,pmcorr,Npairs]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
strout := format('t value with d.f. %d = %8.4f with Probability > t = %6.4f',[Npairs-2,z,rprob]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
tMatrix[i-1,j-1] := z;
|
||
|
|
tMatrix[j-1,i-1] := z;
|
||
|
|
ProbMat[i-1,j-1] := rprob;
|
||
|
|
ProbMat[j-1,i-1] := rprob;
|
||
|
|
end;
|
||
|
|
if MeansChkBox.Checked or VarChkBox.Checked or SDChkBox.Checked then
|
||
|
|
begin
|
||
|
|
strout := format('Mean X = %8.4f, Variance X = %8.4f, Std.Dev. X = %8.4f',[XMean,XVar,XSD]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
strout := format('Mean Y = %8.4f, Variance Y = %8.4f, Std.Dev. Y = %8.4f',[YMean,YVar,YSD]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
end;
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
end; // next j variable
|
||
|
|
Matrix[i-1,i-1] := 1.0;
|
||
|
|
end; // next i variable
|
||
|
|
Matrix[NoVars-1,NoVars-1] := 1.0;
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
OutPutFrm.RichEdit.Clear;
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('Intercorrelation Matrix and Statistics');
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
// strout := 'Correlation Matrix Summary (Ns in lower triangle)';
|
||
|
|
// MAT_PRINT(Matrix,NoVars,NoVars,strout,ColLabels,ColLabels,NoCases);
|
||
|
|
startpos := 1;
|
||
|
|
endpos := 6;
|
||
|
|
if endpos > NoVars then endpos := NoVars;
|
||
|
|
for i := 1 to NoVars do
|
||
|
|
begin
|
||
|
|
nextpart:
|
||
|
|
strout := ' ';
|
||
|
|
for j := startpos to endpos do
|
||
|
|
strout := strout + format(' %5d',[j]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
strout := format('%2d PMCorr.',[i]);
|
||
|
|
for j := startpos to endpos do
|
||
|
|
strout := strout + format(' %7.4f',[Matrix[i-1,j-1]]);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
strout := format('%2d N Size ',[i]);
|
||
|
|
for j := startpos to endpos do
|
||
|
|
begin
|
||
|
|
if j <> i then
|
||
|
|
strout := strout + format(' %3d ',[NMatrix[i-1,j-1]])
|
||
|
|
else begin
|
||
|
|
Npairs := 0;
|
||
|
|
for k := 1 to NoCases do
|
||
|
|
begin
|
||
|
|
if ValidValue(k,ColNoSelected[j-1])
|
||
|
|
then Npairs := Npairs + 1;
|
||
|
|
end;
|
||
|
|
strout := strout + format(' %3d ',[Npairs]);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
strout := format('%2d t Value',[i]);
|
||
|
|
for j := startpos to endpos do
|
||
|
|
begin
|
||
|
|
if j <> i then
|
||
|
|
strout := strout + format(' %7.4f',[tMatrix[i-1,j-1]])
|
||
|
|
else strout := strout + ' ';
|
||
|
|
end;
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
strout := format('%2d Prob. t',[i]);
|
||
|
|
for j := startpos to endpos do
|
||
|
|
begin
|
||
|
|
if j <> i then
|
||
|
|
strout := strout + format(' %7.4f',[ProbMat[i-1,j-1]])
|
||
|
|
else strout := strout + ' ';
|
||
|
|
end;
|
||
|
|
OutPutFrm.RichEdit.Lines.Add(strout);
|
||
|
|
OutPutFrm.RichEdit.Lines.Add('');
|
||
|
|
if endpos < NoVars then
|
||
|
|
begin
|
||
|
|
startpos := endpos + 1;
|
||
|
|
endpos := endpos + 6;
|
||
|
|
if endpos > NoVars then endpos := NoVars;
|
||
|
|
goto nextpart;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
OutPutFrm.ShowModal;
|
||
|
|
|
||
|
|
ProbMat := nil;
|
||
|
|
tMatrix := nil;
|
||
|
|
NMatrix := nil;
|
||
|
|
end;
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$I rmatunit.lrs}
|
||
|
|
|
||
|
|
end.
|
||
|
|
|