pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

Lazstats: Refactor RMatUnit. Add pdf help file to chm.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7402 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-25 15:23:33 +00:00
parent 8c760eb862
commit 1151b80f90
7 changed files with 404 additions and 397 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
applications/lazstats/docs/HelpNDoc/LazStats.hnd
View File

Binary file not shown.

BIN
applications/lazstats/docs/chm/LazStats.chm
View File

Binary file not shown.

6
applications/lazstats/source/forms/analysis/correlation/partialsunit.pas
View File

@ -220,12 +220,12 @@ end;
procedure TPartialsFrm.ComputeBtnClick(Sender: TObject);
var
rmatrix, workmat: DblDyneMat;
Means, Variances, StdDevs, W, Betas: DblDyneVec;
Means, Variances, StdDevs, W: 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;
varstring: string;
i, j, K, L: integer;
errorcode: boolean;
vtimesw, W1, v: DblDyneMat;
@ -264,7 +264,6 @@ begin
SetLength(Variances,NoVariables);
SetLength(StdDevs,NoVariables);
SetLength(W,NoVariables);
SetLength(Betas,NoVariables);
SetLength(MatVars,NoVariables);
lReport := TStringList.Create;
@ -405,7 +404,6 @@ begin
finally
lReport.Free;
MatVars := nil;
Betas := nil;
W := nil;
Variances := nil;
StdDevs := nil;

65
applications/lazstats/source/forms/analysis/correlation/rmatunit.lfm
View File

@ -25,7 +25,7 @@ object RMatFrm: TRMatFrm
ParentColor = False
end
object Label2: TLabel
AnchorSideLeft.Control = ListBox1
AnchorSideLeft.Control = SelList
AnchorSideTop.Control = Owner
Left = 235
Height = 15
@ -166,7 +166,7 @@ object RMatFrm: TRMatFrm
Spacing = 0
TabOrder = 3
end
object ListBox1: TListBox
object SelList: TListBox
AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2
@ -184,6 +184,7 @@ object RMatFrm: TRMatFrm
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
ItemHeight = 0
MultiSelect = True
TabOrder = 4
end
object GroupBox1: TGroupBox
@ -283,92 +284,74 @@ object RMatFrm: TRMatFrm
end
end
object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 108
Left = 200
Height = 25
Top = 449
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 7
end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 174
Height = 25
Top = 449
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 8
end
object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 248
Left = 262
Height = 25
Top = 449
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 9
TabOrder = 8
end
object ReturnBtn: TButton
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 336
Left = 346
Height = 25
Top = 449
Width = 61
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Return'
ModalResult = 1
TabOrder = 10
Caption = 'Close'
ModalResult = 11
TabOrder = 9
end
object HelpBtn: TButton
Tag = 144
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 45
Left = 141
Height = 25
Top = 449
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
@ -378,7 +361,7 @@ object RMatFrm: TRMatFrm
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 433

653
applications/lazstats/source/forms/analysis/correlation/rmatunit.pas
View File

@ -23,9 +23,8 @@ type
AllBtn: TBitBtn;
AugmentChk: TCheckBox;
ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton;
ReturnBtn: TButton;
CloseBtn: TButton;
CPChkBox: TCheckBox;
CovChkBox: TCheckBox;
CorrsChkBox: TCheckBox;
@ -36,7 +35,7 @@ type
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
ListBox1: TListBox;
SelList: TListBox;
VarList: TListBox;
procedure AllBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
@ -50,10 +49,9 @@ type
private
{ private declarations }
FAutoSized: Boolean;
procedure PairsCalc(NoVars : integer;
VAR ColNoSelected : IntDyneVec;
VAR Matrix : DblDyneMat;
VAR ColLabels : StrDyneVec);
procedure PairsCalc(NoVars: integer; const ColNoSelected: IntDyneVec;
const Matrix: DblDyneMat; const ColLabels: StrDyneVec; AReport: TStrings);
procedure UpdateBtnStates;
public
{ public declarations }
@ -65,7 +63,7 @@ var
implementation
uses
Math;
Math, Utils;
{ TRMatFrm }
@ -73,7 +71,7 @@ procedure TRMatFrm.ResetBtnClick(Sender: TObject);
VAR i : integer;
begin
VarList.Clear;
ListBox1.Clear;
SelList.Clear;
for i := 1 to NoVariables do
begin
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
@ -102,12 +100,11 @@ begin
if FAutoSized then
exit;
w := MaxValue([HelpBtn.Width, ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]);
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinHeight := Height;
@ -118,358 +115,386 @@ end;
procedure TRMatFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if OutputFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm);
end;
procedure TRMatFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).tag);
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
procedure TRMatFrm.AllBtnClick(Sender: TObject);
VAR count, index : integer;
var
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;
for index := 0 to VarList.Items.Count-1 do
SelList.Items.Add(VarList.Items[index]);
VarList.Clear;
UpdateBtnStates;
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, Probr, N: double;
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, Probr, N: double;
lReport: TStrings;
begin
errorcode := false;
OutputFrm.RichEdit.Clear;
NoVars := ListBox1.Items.Count;
Augment := false;
Ngood := 0;
errorcode := false;
NoVars := SelList.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);
if NoVars = 0 then
begin
MessageDlg('No variable(s) selected.', mtError, [mbOK], 0);
exit;
end;
// 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;
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);
if PairsChkBox.Checked then
begin
PairsCalc(NoVars,ColNoSelected,Matrix,ColLabels);
goto cleanit;
end;
// identify the included variable locations and their labels
for i := 1 to NoVars do
begin
cellstring := SelList.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 AugmentChk.Checked then
begin
Augment := true;
ColLabels[NoVars] := 'Intercept';
RowLabels[NoVars] := 'Intercept';
end;
lReport := TStringList.Create;
try
if PairsChkBox.Checked then
begin
PairsCalc(NoVars, ColNoSelected, Matrix, ColLabels, lReport);
exit;
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 AugmentChk.Checked then
begin
Augment := true;
ColLabels[NoVars] := 'Intercept';
RowLabels[NoVars] := 'Intercept';
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;
// get cross-products if elected
if CPChkBox.Checked then
begin
GridXProd(NoVars, ColNoSelected, Matrix, Augment, Ngood);
title := 'Cross-Products Matrix';
if not Augment then
MatPrint(Matrix, NoVars, NoVars, title, RowLabels, ColLabels, Ngood, lReport)
else
MatPrint(Matrix, NoVars+1, NoVars+1, title, RowLabels, ColLabels, Ngood, lReport);
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;
// get variance-covariance mat. if elected
if CovChkBox.Checked then
begin
title := 'Variance-Covariance Matrix';
GridCovar(NoVars, ColNoSelected, Matrix, Means, Variances, StdDevs, errorcode, Ngood);
MatPrint(Matrix, NoVars, NoVars, title, RowLabels, ColLabels, Ngood, lReport);
end;
end;
end;
title := 't-test values (upper) and probabilities of t (lower)';
MAT_PRINT(TestMat,NoVars,NoVars,title,RowLabels,ColLabels,Ngood);
end;
// get correlations
if CorrsChkBox.Checked then
begin
title := 'Product-Moment Correlations Matrix';
Correlations(NoVars, ColNoSelected, Matrix, Means, Variances, StdDevs, errorcode, Ngood);
MatPrint(Matrix, NoVars, NoVars, title, RowLabels, ColLabels, Ngood, lReport);
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)';
MatPrint(TestMat, NoVars, NoVars, title, RowLabels, ColLabels, Ngood, lReport);
end;
title := 'Means';
if MeansChkBox.Checked = true then
DynVectorPrint(Means,NoVars,title,ColLabels,Ngood);
if MeansChkBox.Checked then
begin
title := 'Means';
DynVectorPrint(Means, NoVars, title, ColLabels, Ngood, lReport);
end;
title := 'Variances';
if VarChkBox.Checked = true then
DynVectorPrint(Variances,NoVars,title,ColLabels,Ngood);
if VarChkBox.Checked then
begin
title := 'Variances';
DynVectorPrint(Variances, NoVars, title, ColLabels, Ngood, lReport);
end;
title := 'Standard Deviations';
if SDChkBox.Checked = true then
DynVectorPrint(StdDevs,NoVars,title,ColLabels,Ngood);
if SDChkBox.Checked then
begin
title := 'Standard Deviations';
DynVectorPrint(StdDevs, NoVars, title, ColLabels, Ngood, lReport);
end;
if errorcode then
OutputFrm.RichEdit.Lines.Add('One or more correlations could not be computed due to zero variance of a variable.');
if errorcode then
lReport.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);
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;
DisplayReport(lReport);
finally
lReport.Free;
ColLabels := nil;
RowLabels := nil;
StdDevs := nil;
Variances := nil;
Means := nil;
Matrix := nil;
ColNoSelected := nil;
end;
end;
procedure TRMatFrm.InBtnClick(Sender: TObject);
VAR i, index : integer;
var
i: 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;
i := 0;
while i < VarList.Items.Count do
begin
if VarList.Selected[i] then
begin
SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TRMatFrm.OutBtnClick(Sender: TObject);
VAR index : integer;
var
i: integer;
begin
index := ListBox1.ItemIndex;
VarList.Items.Add(ListBox1.Items.Strings[index]);
ListBox1.Items.Delete(index);
InBtn.Enabled := true;
i := 0;
while i < SelList.Items.Count do
begin
if SelList.Selected[i] then
begin
VarList.Items.Add(SelList.Items[i]);
SelList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TRMatFrm.PairsCalc(NoVars: integer; var ColNoSelected: IntDyneVec;
var Matrix: DblDyneMat; var ColLabels: StrDyneVec);
Label nextpart;
procedure TRMatFrm.PairsCalc(NoVars: integer; const ColNoSelected: IntDyneVec;
const Matrix: DblDyneMat; const ColLabels: StrDyneVec; AReport: TStrings);
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;
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);
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);
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;
AReport.Add(ColLabels[i-1] + ' vs ' + ColLabels[j-1]);
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
AReport.Add('CrossProducts[%d,%d]: %6.4f, N cases: %d', [i, j, pmcorr, Npairs]);
pmcorr := pmcorr - (XMean * YMean) / Npairs;
pmcorr := pmcorr / (Npairs - 1);
if CovChkBox.Checked then
AReport.Add('Covariance[%d,%d]: %6.4f, N cases: %d', [i, j, pmcorr, Npairs]);
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('');
AReport.Add('r[%d, %d]: %6.4f, N cases: %d', [i, j, pmcorr, Npairs]);
AReport.Add('t value with d.f. %d: %8.4f with Probability > t %6.4f', [Npairs - 2, z, rprob]);
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
AReport.Add('Mean X: %8.4f, Variance X: %8.4f, Std.Dev. X: %8.4f', [XMean, XVar, XSD]);
AReport.Add('Mean Y: %8.4f, Variance Y: %8.4f, Std.Dev. Y: %8.4f', [YMean, YVar, YSD]);
end;
AReport.Add('');
end; // next j variable
Matrix[i-1,i-1] := 1.0;
end; // next i variable
Matrix[NoVars-1,NoVars-1] := 1.0;
AReport.Add('');
AReport.Add(DIVIDER);
AReport.Add('');
AReport.Add('Intercorrelation Matrix and Statistics');
AReport.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;
startpos := 1;
endpos := 6;
if endpos > NoVars then endpos := NoVars;
ProbMat := nil;
tMatrix := nil;
NMatrix := nil;
for i := 1 to NoVars do
begin
strout := ' ';
for j := startpos to endpos do
strout := strout + Format(' %5d', [j]);
AReport.Add(strout);
strout := format('%2d PMCorr.',[i]);
for j := startpos to endpos do
strout := strout + Format(' %7.4f', [Matrix[i-1,j-1]]);
AReport.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;
AReport.Add(strout);
strout := Format('%2d t Value', [i]);
for j := startpos to endpos do
if j <> i then
strout := strout + Format(' %7.4f', [tMatrix[i-1, j-1]])
else
strout := strout + ' ';
AReport.Add(strout);
strout := Format('%2d Prob. t', [i]);
for j := startpos to endpos do
if j <> i then
strout := strout + Format(' %7.4f', [ProbMat[i-1, j-1]])
else
strout := strout + ' ';
AReport.Add(strout);
AReport.Add('');
if endpos < NoVars then
begin
startpos := endpos + 1;
endpos := endpos + 6;
if endpos > NoVars then endpos := NoVars;
Continue;
end;
end;
AReport.Add('');
AReport.Add(DIVIDER);
AReport.Add('');
ProbMat := nil;
tMatrix := nil;
NMatrix := nil;
end;
procedure TRMatFrm.UpdateBtnStates;
begin
InBtn.Enabled := AnySelected(VarList);
OutBtn.Enabled := AnySelected(SelList);
AllBtn.Enabled := Varlist.Count > 0;
end;
initialization

1
applications/lazstats/source/forms/mainunit.pas
View File

@ -527,6 +527,7 @@ begin
CUMSUMFrm.ShowModal;
end;
// Menu "Correlation" > "Product-Moment"
procedure TOS3MainFrm.MenuItem71Click(Sender: TObject);
begin
if RMatFrm = nil then

76
applications/lazstats/source/units/dataprocs.pas
View File

@ -53,7 +53,7 @@ procedure ClearGrid;
procedure CopyIt;
procedure PasteIt;
procedure RowColSwap;
procedure MatToGrid(VAR mat : DblDyneMat; nsize : integer);
procedure MatToGrid(const mat: DblDyneMat; nsize: integer);
procedure GetTypes;
function StringsToInt(strcol : integer; VAR newcol : integer; prompt : boolean) : boolean;
@ -465,7 +465,7 @@ var
col, i, j : integer;
buf : pchar;
size : integer;
strarray : array[0..100000] of char;
strarray : array[0..100000] of char; // wp: Wow! What's this?
begin
col := OS3MainFrm.DataGrid.Col;
@ -483,7 +483,7 @@ begin
// NoVariables := NoVariables + 1;
OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVariables);
end;
buf := strarray;
buf := strarray; // wp: Is this needed?
size := 100000;
ClipBoard.GetTextBuf(buf,size);
OS3MainFrm.DataGrid.Cols[col].SetText(buf);
@ -535,7 +535,7 @@ procedure PasteaRow;
var
row, i, j : integer;
buf : pchar;
strarray : array[0..100000] of char;
strarray : array[0..100000] of char; // wp: Like above
size : integer;
begin
@ -549,7 +549,7 @@ begin
OS3MainFrm.DataGrid.Cells[j,i+1] := OS3MainFrm.DataGrid.Cells[j,i];
end;
OS3MainFrm.DataGrid.Row := row;
buf := strarray;
buf := strarray; // wp: is this needed?
size := 100000;
ClipBoard.GetTextBuf(buf,size);
OS3MainFrm.DataGrid.Rows[row].SetText(buf);
@ -1530,48 +1530,48 @@ begin
tempgrid := nil;
end;
procedure MatToGrid(VAR mat : DblDyneMat; nsize : integer);
procedure MatToGrid(const mat: DblDyneMat; nsize: integer);
VAR
i, j : integer;
Begin
Assert(OS3MainFrm <> nil);
Assert(DictionaryFrm <> nil);
// clear grid
ClearGrid;
// clear grid
ClearGrid;
// clear dictionary
DictionaryFrm.DictGrid.ColCount := 8;
DictionaryFrm.DictGrid.RowCount := 1;
OS3MainFrm.FileNameEdit.Text := '';
// clear dictionary
DictionaryFrm.DictGrid.ColCount := 8;
DictionaryFrm.DictGrid.RowCount := 1;
OS3MainFrm.FileNameEdit.Text := '';
// create new variables = NoCases
NoVariables := 0;
for i := 1 to nsize do
begin
OS3MainFrm.DataGrid.ColCount := i;
DictionaryFrm.NewVar(i);
NoVariables := i;
end;
// store matrix into the grid rows
OS3MainFrm.DataGrid.RowCount := nsize + 1;
for i := 0 to nsize-1 do
begin
for j := 0 to nsize-1 do
begin
// create new variables = NoCases
NoVariables := 0;
for i := 1 to nsize do
begin
OS3MainFrm.DataGrid.ColCount := i;
DictionaryFrm.NewVar(i);
NoVariables := i;
end;
// store matrix into the grid rows
OS3MainFrm.DataGrid.RowCount := nsize + 1;
for i := 0 to nsize-1 do
begin
for j := 0 to nsize-1 do
OS3MainFrm.DataGrid.Cells[i+1,j+1] := FloatToStr(mat[i,j]);
end;
end;
for i := 1 to nsize do
begin
OS3MainFrm.DataGrid.Cells[0,i] := 'VAR ' + IntToStr(i);
OS3MainFrm.DataGrid.Cells[i,0] := 'VAR ' + IntToStr(i);
end;
// finish up
NoCases := nsize;
OS3MainFrm.FileNameEdit.Text := 'MATtemp.LAZ';
OS3MainFrm.NoCasesEdit.Text := IntToStr(nsize);
OS3MainFrm.NoVarsEdit.Text := IntToStr(nsize);
end;
for i := 1 to nsize do
begin
OS3MainFrm.DataGrid.Cells[0,i] := 'VAR ' + IntToStr(i);
OS3MainFrm.DataGrid.Cells[i,0] := 'VAR ' + IntToStr(i);
end;
// finish up
NoCases := nsize;
OS3MainFrm.FileNameEdit.Text := 'MATtemp.laz';
OS3MainFrm.NoCasesEdit.Text := IntToStr(nsize);
OS3MainFrm.NoVarsEdit.Text := IntToStr(nsize);
end;
procedure GetTypes;