paweld/lazarus-ccr
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki 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
Show Stats 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); procedure TPartialsFrm.ComputeBtnClick(Sender: TObject);
var var
rmatrix, workmat: DblDyneMat; rmatrix, workmat: DblDyneMat;
Means, Variances, StdDevs, W, Betas: DblDyneVec; Means, Variances, StdDevs, W: DblDyneVec;
R2Full, R2Cntrl, SemiPart, Partial, df1, df2, F, Prob: double; R2Full, R2Cntrl, SemiPart, Partial, df1, df2, F, Prob: double;
NoPredVars, NoCntrlVars, DepVarNo, TotNoVars, pcnt, ccnt, count: integer; NoPredVars, NoCntrlVars, DepVarNo, TotNoVars, pcnt, ccnt, count: integer;
PredVars, CntrlVars: IntDyneVec; PredVars, CntrlVars: IntDyneVec;
MatVars: IntDyneVec; MatVars: IntDyneVec;
outline, varstring: string; varstring: string;
i, j, K, L: integer; i, j, K, L: integer;
errorcode: boolean; errorcode: boolean;
vtimesw, W1, v: DblDyneMat; vtimesw, W1, v: DblDyneMat;
@ -264,7 +264,6 @@ begin
SetLength(Variances,NoVariables); SetLength(Variances,NoVariables);
SetLength(StdDevs,NoVariables); SetLength(StdDevs,NoVariables);
SetLength(W,NoVariables); SetLength(W,NoVariables);
SetLength(Betas,NoVariables);
SetLength(MatVars,NoVariables); SetLength(MatVars,NoVariables);
lReport := TStringList.Create; lReport := TStringList.Create;
@ -405,7 +404,6 @@ begin
finally finally
lReport.Free; lReport.Free;
MatVars := nil; MatVars := nil;
Betas := nil;
W := nil; W := nil;
Variances := nil; Variances := nil;
StdDevs := nil; StdDevs := nil;

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

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

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

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

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

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

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

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