You've already forked lazarus-ccr
LazStats: Refactor MultGenUnit. Add pdf help to chm. NOTE: The calculation yields different results than in pdf.
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7406 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
Binary file not shown.
Binary file not shown.
@ -1431,6 +1431,7 @@
|
||||
</Item3>
|
||||
<Item4>
|
||||
<Name Value="EGridException"/>
|
||||
<Enabled Value="False"/>
|
||||
</Item4>
|
||||
<Item5>
|
||||
<Name Value="EConvertError"/>
|
||||
|
@ -4,9 +4,11 @@ object MultGenFrm: TMultGenFrm
|
||||
Top = 254
|
||||
Width = 581
|
||||
ActiveControl = NoVarsEdit
|
||||
AutoSize = True
|
||||
Caption = 'Multivariate Generator'
|
||||
ClientHeight = 396
|
||||
ClientWidth = 581
|
||||
OnActivate = FormActivate
|
||||
OnCreate = FormCreate
|
||||
OnShow = FormShow
|
||||
Position = poMainFormCenter
|
||||
@ -22,8 +24,7 @@ object MultGenFrm: TMultGenFrm
|
||||
Alignment = taRightJustify
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
OnExit = NoVarsEditExit
|
||||
OnKeyPress = NoVarsEditKeyPress
|
||||
OnEditingDone = NoVarsEditEditingDone
|
||||
TabOrder = 0
|
||||
Text = 'NoVarsEdit'
|
||||
end
|
||||
@ -62,10 +63,10 @@ object MultGenFrm: TMultGenFrm
|
||||
Height = 23
|
||||
Top = 35
|
||||
Width = 45
|
||||
Alignment = taRightJustify
|
||||
Anchors = [akTop, akLeft, akRight]
|
||||
BorderSpacing.Top = 4
|
||||
OnExit = NoObsEditExit
|
||||
OnKeyPress = NoObsEditKeyPress
|
||||
OnEditingDone = NoObsEditEditingDone
|
||||
TabOrder = 1
|
||||
Text = 'NoObsEdit'
|
||||
end
|
||||
@ -77,9 +78,9 @@ object MultGenFrm: TMultGenFrm
|
||||
Left = 203
|
||||
Height = 19
|
||||
Top = 10
|
||||
Width = 106
|
||||
Width = 107
|
||||
BorderSpacing.Left = 32
|
||||
Caption = 'Print Parametes:'
|
||||
Caption = 'Print Parameters'
|
||||
TabOrder = 2
|
||||
end
|
||||
object SampleChk: TCheckBox
|
||||
@ -87,13 +88,13 @@ object MultGenFrm: TMultGenFrm
|
||||
AnchorSideLeft.Side = asrBottom
|
||||
AnchorSideTop.Control = ParmsChk
|
||||
AnchorSideTop.Side = asrCenter
|
||||
Left = 333
|
||||
Left = 334
|
||||
Height = 19
|
||||
Top = 10
|
||||
Width = 118
|
||||
Width = 115
|
||||
BorderSpacing.Left = 24
|
||||
BorderSpacing.Right = 8
|
||||
Caption = 'Print Sample Stats:'
|
||||
Caption = 'Print Sample Stats'
|
||||
TabOrder = 3
|
||||
end
|
||||
object PerturbChk: TCheckBox
|
||||
@ -109,72 +110,57 @@ object MultGenFrm: TMultGenFrm
|
||||
TabOrder = 4
|
||||
end
|
||||
object ResetBtn: TButton
|
||||
AnchorSideRight.Control = CancelBtn
|
||||
AnchorSideRight.Control = ComputeBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 284
|
||||
Left = 372
|
||||
Height = 25
|
||||
Top = 363
|
||||
Width = 54
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Left = 8
|
||||
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 = 350
|
||||
Height = 25
|
||||
Top = 363
|
||||
Width = 62
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Cancel'
|
||||
ModalResult = 2
|
||||
OnClick = CancelBtnClick
|
||||
TabOrder = 8
|
||||
end
|
||||
object ComputeBtn: TButton
|
||||
AnchorSideRight.Control = ReturnBtn
|
||||
AnchorSideRight.Control = CloseBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 424
|
||||
Left = 434
|
||||
Height = 25
|
||||
Top = 363
|
||||
Width = 76
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Left = 8
|
||||
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 = 512
|
||||
Left = 518
|
||||
Height = 25
|
||||
Top = 363
|
||||
Width = 61
|
||||
Width = 55
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Return'
|
||||
ModalResult = 1
|
||||
OnClick = ReturnBtnClick
|
||||
TabOrder = 10
|
||||
Caption = 'Close'
|
||||
ModalResult = 11
|
||||
TabOrder = 9
|
||||
end
|
||||
object Grid: TStringGrid
|
||||
AnchorSideLeft.Control = Owner
|
||||
@ -191,6 +177,7 @@ object MultGenFrm: TMultGenFrm
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Top = 8
|
||||
BorderSpacing.Right = 8
|
||||
Constraints.MinHeight = 200
|
||||
Options = [goFixedVertLine, goFixedHorzLine, goVertLine, goHorzLine, goRangeSelect, goEditing, goTabs, goSmoothScroll]
|
||||
TabOrder = 5
|
||||
OnKeyPress = GridKeyPress
|
||||
@ -201,13 +188,14 @@ object MultGenFrm: TMultGenFrm
|
||||
AnchorSideRight.Control = ResetBtn
|
||||
AnchorSideBottom.Control = Owner
|
||||
AnchorSideBottom.Side = asrBottom
|
||||
Left = 221
|
||||
Left = 313
|
||||
Height = 25
|
||||
Top = 363
|
||||
Width = 51
|
||||
Anchors = [akRight, akBottom]
|
||||
AutoSize = True
|
||||
BorderSpacing.Right = 12
|
||||
BorderSpacing.Left = 8
|
||||
BorderSpacing.Right = 8
|
||||
BorderSpacing.Bottom = 8
|
||||
Caption = 'Help'
|
||||
OnClick = HelpBtnClick
|
||||
@ -217,7 +205,7 @@ object MultGenFrm: TMultGenFrm
|
||||
AnchorSideLeft.Control = Owner
|
||||
AnchorSideRight.Control = Owner
|
||||
AnchorSideRight.Side = asrBottom
|
||||
AnchorSideBottom.Control = ReturnBtn
|
||||
AnchorSideBottom.Control = CloseBtn
|
||||
Left = 0
|
||||
Height = 8
|
||||
Top = 347
|
||||
|
@ -1,3 +1,21 @@
|
||||
// No data file needed.
|
||||
//
|
||||
// Test input:
|
||||
// - Number of observables: 3
|
||||
// - Sample Size: 50
|
||||
// - Correlation VAR1/Var2: 0.8
|
||||
// - Correlation VAR1/VAR3: -0.3
|
||||
// - Correlation VAR2/VAR3: 0.5
|
||||
// - Mean VAR1: 50
|
||||
// - Mean VAR2: 20
|
||||
// - Mean VAR3: 100
|
||||
// - Std.Dev VAR1: 15
|
||||
// - Std.Dev VAR2: 10
|
||||
// - Std.Dev VAR3: 15
|
||||
//
|
||||
// NOTE:
|
||||
// THE RESULT OBTAINED DIFFER FROM THE RESULTS IN THE PDF HELP FILE GenMultiVar.pdf
|
||||
|
||||
unit MultGenUnit;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
@ -17,9 +35,8 @@ type
|
||||
Bevel1: TBevel;
|
||||
HelpBtn: TButton;
|
||||
ResetBtn: TButton;
|
||||
CancelBtn: TButton;
|
||||
ComputeBtn: TButton;
|
||||
ReturnBtn: TButton;
|
||||
CloseBtn: TButton;
|
||||
PerturbChk: TCheckBox;
|
||||
SampleChk: TCheckBox;
|
||||
ParmsChk: TCheckBox;
|
||||
@ -28,25 +45,22 @@ type
|
||||
NoVarsEdit: TEdit;
|
||||
Label1: TLabel;
|
||||
Grid: TStringGrid;
|
||||
procedure CancelBtnClick(Sender: TObject);
|
||||
procedure ComputeBtnClick(Sender: TObject);
|
||||
procedure FormActivate(Sender: TObject);
|
||||
procedure FormCreate(Sender: TObject);
|
||||
procedure FormShow(Sender: TObject);
|
||||
procedure GridKeyPress(Sender: TObject; var Key: char);
|
||||
procedure GridSetEditText(Sender: TObject; ACol, ARow: Integer;
|
||||
const Value: string);
|
||||
procedure HelpBtnClick(Sender: TObject);
|
||||
procedure NoObsEditExit(Sender: TObject);
|
||||
procedure NoObsEditKeyPress(Sender: TObject; var Key: char);
|
||||
procedure NoVarsEditExit(Sender: TObject);
|
||||
procedure NoVarsEditKeyPress(Sender: TObject; var Key: char);
|
||||
procedure NoObsEditEditingDone(Sender: TObject);
|
||||
procedure NoVarsEditEditingDone(Sender: TObject);
|
||||
procedure ResetBtnClick(Sender: TObject);
|
||||
procedure ReturnBtnClick(Sender: TObject);
|
||||
private
|
||||
{ private declarations }
|
||||
NoVars : integer;
|
||||
NoObs : integer;
|
||||
gridrow, gridcol : integer;
|
||||
NoVars: integer;
|
||||
NoObs: integer;
|
||||
gridrow, gridcol: integer;
|
||||
|
||||
public
|
||||
{ public declarations }
|
||||
@ -60,281 +74,376 @@ implementation
|
||||
{ TMultGenFrm }
|
||||
|
||||
procedure TMultGenFrm.ResetBtnClick(Sender: TObject);
|
||||
VAR i, j : integer;
|
||||
var
|
||||
i, j: integer;
|
||||
begin
|
||||
NoVarsEdit.Text := '';
|
||||
NoObsEdit.Text := '';
|
||||
ParmsChk.Checked := true;
|
||||
SampleChk.Checked := true;
|
||||
Grid.RowCount := 2;
|
||||
Grid.ColCount := 2;
|
||||
for i := 0 to 1 do
|
||||
for j := 0 to 1 do Grid.Cells[i,j] := '';
|
||||
//CancelBtn.SetFocus; // <-- is this needed?
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.ReturnBtnClick(Sender: TObject);
|
||||
begin
|
||||
exit;
|
||||
NoVarsEdit.Text := '';
|
||||
NoObsEdit.Text := '';
|
||||
ParmsChk.Checked := true;
|
||||
SampleChk.Checked := true;
|
||||
Grid.RowCount := 2;
|
||||
Grid.ColCount := 2;
|
||||
for i := 0 to 1 do
|
||||
for j := 0 to 1 do Grid.Cells[i,j] := '';
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.FormShow(Sender: TObject);
|
||||
begin
|
||||
ResetBtnClick(self);
|
||||
ResetBtnClick(self);
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.ComputeBtnClick(Sender: TObject);
|
||||
var
|
||||
RhoMat : DblDyneMat;
|
||||
SampMat : DblDyneMat;
|
||||
Mus : DblDyneVec;
|
||||
means : DblDyneVec;
|
||||
Sigmas : DblDyneVec;
|
||||
stddevs : DblDyneVec;
|
||||
i, j, k, i1, i2, n2, k1 : integer;
|
||||
determ, n3, r1, s8, s9, d2, x, y, mean : double;
|
||||
linestring : string;
|
||||
cellstring : string;
|
||||
title : string;
|
||||
RowLabels: StrDyneVec;
|
||||
ColLabels: StrDyneVec;
|
||||
RhoMat: DblDyneMat;
|
||||
SampMat: DblDyneMat;
|
||||
Mus: DblDyneVec;
|
||||
means: DblDyneVec;
|
||||
Sigmas: DblDyneVec;
|
||||
stddevs: DblDyneVec;
|
||||
i, j, k, i1, i2, n2, k1: integer;
|
||||
determ, n3, r1, s8, s9, d2, x, y, mean: double;
|
||||
cellstring: string;
|
||||
title: string;
|
||||
RowLabels: StrDyneVec;
|
||||
ColLabels: StrDyneVec;
|
||||
lReport: TStrings;
|
||||
begin
|
||||
OutputFrm.RichEdit.Clear;
|
||||
if (NoVarsEdit.Text = '') then begin
|
||||
NoVarsEdit.SetFocus;
|
||||
MessageDlg('Number of variables must be specified.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not TryStrToInt(NoVarsEdit.Text, NoVars) or (NoVars <= 0) then
|
||||
begin
|
||||
NoVarsEdit.SetFocus;
|
||||
MessageDlg('Positive integer number required for Number of Variables.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// get memory allocations
|
||||
SetLength(RhoMat,NoVars,NoVars);
|
||||
SetLength(SampMat,NoVars,NoVars);
|
||||
SetLength(Mus,NoVars);
|
||||
SetLength(means,NoVars);
|
||||
SetLength(Sigmas,NoVars);
|
||||
SetLength(stddevs,NoVars);
|
||||
SetLength(RowLabels,NoVars);
|
||||
SetLength(ColLabels,NoVars);
|
||||
if (NoObsEdit.Text = '') then
|
||||
begin
|
||||
NoObsEdit.SetFocus;
|
||||
MessageDlg('Sample Size must be specified.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not TryStrToInt(NoObsEdit.Text, NoObs) or (NoObs <= 0) then
|
||||
begin
|
||||
NoObsEdit.SetFocus;
|
||||
MessageDlg('Positive integer value required for Sample Size.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
// get data from grid into arrays
|
||||
for i := 1 to NoVars do
|
||||
for j := 1 to NoVars do
|
||||
begin
|
||||
RhoMat[i-1,j-1] := StrToFloat(Grid.Cells[i,j]);
|
||||
end;
|
||||
for i := 1 to NoVars do
|
||||
for i:=1 to NoVars do
|
||||
begin
|
||||
for j := 1 to NoVars do
|
||||
begin
|
||||
Mus[i-1] := StrToFloat(Grid.Cells[i,NoVars+1]);
|
||||
Sigmas[i-1] := StrToFloat(Grid.Cells[i,NoVars+2]);
|
||||
RowLabels[i-1] := Grid.Cells[i,0];
|
||||
ColLabels[i-1] := RowLabels[i-1];
|
||||
if Grid.Cells[i, j] = '' then
|
||||
begin
|
||||
Grid.SetFocus;
|
||||
Grid.Col := i;
|
||||
Grid.Row := j;
|
||||
MessageDlg('Please specify the correlation between variable ' + Grid.Cells[i, 0] + ' and ' + Grid.Cells[0, j] + '.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not TryStrToFloat(Grid.Cells[i, j], x) or (x < -1) or (x > 1) then begin
|
||||
Grid.SetFocus;
|
||||
grid.Col := i;
|
||||
Grid.Row := j;
|
||||
MessageDlg('The correlation must be a valid number between -1 and 1.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
if Grid.Cells[i, NoVars+1] = '' then
|
||||
begin
|
||||
Grid.SetFocus;
|
||||
Grid.Col := i;
|
||||
Grid.Row := NoVars + 1;
|
||||
MessageDlg('Please specify the mean value of variable ' + Grid.Cells[i, 0] +'.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not TryStrToFloat(Grid.Cells[i, NoVars+1], x) then
|
||||
begin
|
||||
Grid.SetFocus;
|
||||
Grid.Col := i;
|
||||
Grid.Row := NoVars + 1;
|
||||
MessageDlg('Valid number expected.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if Grid.Cells[i, NoVars+2] = '' then
|
||||
begin
|
||||
Grid.SetFocus;
|
||||
Grid.Col := i;
|
||||
Grid.Row := NoVars + 2;
|
||||
MessageDlg('Please specify the std. deviation of variable ' + Grid.Cells[i, 0] +'.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
if not TryStrToFloat(Grid.Cells[i, NoVars+2], x) or (x < 0) then
|
||||
begin
|
||||
Grid.SetFocus;
|
||||
Grid.Col := i;
|
||||
Grid.Row := Novars + 2;
|
||||
MessageDlg('Valid positive number expected.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
|
||||
// get memory allocations
|
||||
SetLength(RhoMat,NoVars,NoVars);
|
||||
SetLength(SampMat,NoVars,NoVars);
|
||||
SetLength(Mus,NoVars);
|
||||
SetLength(means,NoVars);
|
||||
SetLength(Sigmas,NoVars);
|
||||
SetLength(stddevs,NoVars);
|
||||
SetLength(RowLabels,NoVars);
|
||||
SetLength(ColLabels,NoVars);
|
||||
|
||||
// get data from grid into arrays
|
||||
for i := 1 to NoVars do
|
||||
for j := 1 to NoVars do
|
||||
RhoMat[i-1,j-1] := StrToFloat(Grid.Cells[i,j]);
|
||||
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
Mus[i-1] := StrToFloat(Grid.Cells[i,NoVars+1]);
|
||||
Sigmas[i-1] := StrToFloat(Grid.Cells[i,NoVars+2]);
|
||||
RowLabels[i-1] := Grid.Cells[i,0];
|
||||
ColLabels[i-1] := RowLabels[i-1];
|
||||
end;
|
||||
|
||||
// get determinant of Rho matrix, i.e. check for singularity
|
||||
for i := 0 to NoVars-1 do
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin
|
||||
SampMat[i,j] := RhoMat[i,j] * Sigmas[i] * Sigmas[j];
|
||||
RhoMat[i,j] := SampMat[i,j];
|
||||
end;
|
||||
|
||||
// get determinant of Rho matrix, i.e. check for singularity
|
||||
for i := 0 to NoVars-1 do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin
|
||||
SampMat[i,j] := RhoMat[i,j] * Sigmas[i] * Sigmas[j];
|
||||
RhoMat[i,j] := SampMat[i,j];
|
||||
end;
|
||||
end;
|
||||
n2 := 1;
|
||||
i1 := 0;
|
||||
while (n2 < NoVars) do
|
||||
begin
|
||||
for i := n2 to NoVars - 1 do
|
||||
begin
|
||||
n3 := RhoMat[i,i1] / RhoMat[i1,i1];
|
||||
for j := n2 to NoVars - 1 do RhoMat[i,j] := RhoMat[i,j] - (RhoMat[i1,j] * n3);
|
||||
end;
|
||||
i1 := n2;
|
||||
n2 := N2 + 1;
|
||||
end;
|
||||
|
||||
n2 := 1;
|
||||
i1 := 0;
|
||||
while (n2 < NoVars) do
|
||||
begin
|
||||
for i := n2 to NoVars - 1 do
|
||||
begin
|
||||
n3 := RhoMat[i,i1] / RhoMat[i1,i1];
|
||||
for j := n2 to NoVars - 1 do RhoMat[i,j] := RhoMat[i,j] - (RhoMat[i1,j] * n3);
|
||||
end;
|
||||
i1 := n2;
|
||||
n2 := N2 + 1;
|
||||
end;
|
||||
determ := 1.0;
|
||||
for i := 0 to NoVars - 1 do determ := determ * RhoMat[i,i];
|
||||
linestring := format('Determinant of the population matrix = %10.4f',[determ]);
|
||||
OutputFrm.RichEdit.Lines.Add(linestring);
|
||||
determ := 1.0;
|
||||
for i := 0 to NoVars - 1 do
|
||||
determ := determ * RhoMat[i,i];
|
||||
|
||||
// triangular factorization
|
||||
if (abs(determ) > 0.00001) then
|
||||
begin
|
||||
if (SampMat[0,0] < 0.0) then SampMat[0,0] := 1.0;
|
||||
r1 := sqrt(SampMat[0,0]);
|
||||
for i := 0 to NoVars - 1 do
|
||||
lReport := TStringList.Create;
|
||||
try
|
||||
lReport.Add('Determinant of the population matrix: %.4f', [determ]);
|
||||
|
||||
// triangular factorization
|
||||
if (abs(determ) > 0.00001) then
|
||||
begin
|
||||
if (SampMat[0,0] < 0.0) then
|
||||
SampMat[0,0] := 1.0;
|
||||
r1 := sqrt(SampMat[0,0]);
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
RhoMat[i,0] := SampMat[i,0] / r1;
|
||||
for j := 1 to NoVars - 1 do RhoMat[i,j] := 0.0;
|
||||
end;
|
||||
for i := 1 to NoVars - 1 do
|
||||
begin
|
||||
s9 := 0.0;
|
||||
k1 := i - 1;
|
||||
for k := 0 to k1 - 1 do s9 := s9 + (RhoMat[i,k] * RhoMat[i,k]);
|
||||
d2 := SampMat[i,i] - s9;
|
||||
if (d2 > 0.0) then
|
||||
begin
|
||||
RhoMat[i,0] := SampMat[i,0] / r1;
|
||||
for j := 1 to NoVars - 1 do RhoMat[i,j] := 0.0;
|
||||
end;
|
||||
for i := 1 to NoVars - 1 do
|
||||
begin
|
||||
s9 := 0.0;
|
||||
k1 := i - 1;
|
||||
for k := 0 to k1 - 1 do s9 := s9 + (RhoMat[i,k] * RhoMat[i,k]);
|
||||
d2 := SampMat[i,i] - s9;
|
||||
if (d2 > 0.0) then
|
||||
RhoMat[i,i] := sqrt(d2);
|
||||
for j := 1 to i - 1 do
|
||||
begin
|
||||
if (j <> i) then
|
||||
begin
|
||||
RhoMat[i,i] := sqrt(d2);
|
||||
for j := 1 to i - 1 do
|
||||
begin
|
||||
if (j <> i) then
|
||||
begin
|
||||
s8 := 0.0;
|
||||
k1 := j - 1;
|
||||
for k := 0 to k1 - 1 do s8 := s8 + (RhoMat[i,k] * RhoMat[j,k]);
|
||||
RhoMat[i,j] := (SampMat[i,j] - s8) / RhoMat[j,j];
|
||||
end;
|
||||
end; // end j loop
|
||||
end; // end if d2 > 0
|
||||
end; // end i loop
|
||||
s8 := 0.0;
|
||||
k1 := j - 1;
|
||||
for k := 0 to k1 - 1 do
|
||||
s8 := s8 + (RhoMat[i,k] * RhoMat[j,k]);
|
||||
RhoMat[i,j] := (SampMat[i,j] - s8) / RhoMat[j,j];
|
||||
end;
|
||||
end; // end j loop
|
||||
end; // end if d2 > 0
|
||||
end; // end i loop
|
||||
|
||||
// title := 'Triangularized Matrix';
|
||||
// MAT_PRINT(RhoMat,NoVars,NoVars,title,RowLabels,ColLabels,NoObs);
|
||||
|
||||
// initialize variables for mainform grid
|
||||
NoVariables := 0;
|
||||
DictionaryFrm.DictGrid.RowCount := 1;
|
||||
DictionaryFrm.DictGrid.ColCount := 8;
|
||||
if not PerturbChk.Checked then
|
||||
// initialize variables for mainform grid
|
||||
NoVariables := 0;
|
||||
DictionaryFrm.DictGrid.RowCount := 1;
|
||||
DictionaryFrm.DictGrid.ColCount := 8;
|
||||
if not PerturbChk.Checked then
|
||||
begin
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
DictionaryFrm.NewVar(i);
|
||||
DictionaryFrm.NewVar(i);
|
||||
// NoVariables := NoVariables + 1;
|
||||
end;
|
||||
NoCases := NoObs;
|
||||
OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVars);
|
||||
OS3MainFrm.NoCasesEdit.Text := IntToStr(NoObs);
|
||||
end else
|
||||
begin
|
||||
for i := 1 to NoVars*2 do
|
||||
begin
|
||||
DictionaryFrm.NewVar(i);
|
||||
// NoVariables := NoVariables + 1;
|
||||
end;
|
||||
NoCases := NoObs;
|
||||
OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVars*2);
|
||||
OS3MainFrm.NoCasesEdit.Text := IntToStr(NoObs);
|
||||
end;
|
||||
|
||||
// Now generate score vectors
|
||||
for i2 := 0 to NoObs - 1 do // rows
|
||||
begin // label case heading
|
||||
cellstring := format('Case%d',[i2+1]);
|
||||
OS3MainFrm.DataGrid.Cells[0,i2+1] := cellstring;
|
||||
for i := 0 to NoVars -1 do stddevs[i] := RandG(0.0,1.0);
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
x := 0.0;
|
||||
for j := 0 to i do x := x + (RhoMat[i,j] * stddevs[j]);
|
||||
mean := StrToFloat(Grid.Cells[i+1,NoVars+1]);
|
||||
cellstring := format('%10.3f',[x+mean]);
|
||||
OS3MainFrm.DataGrid.Cells[i+1,i2+1] := cellstring;
|
||||
end; // next variable
|
||||
end; // next observation
|
||||
end; // if abs(determ > .00001)
|
||||
NoCases := NoObs;
|
||||
OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVars);
|
||||
OS3MainFrm.NoCasesEdit.Text := IntToStr(NoObs);
|
||||
end else
|
||||
begin
|
||||
for i := 1 to NoVars*2 do
|
||||
begin
|
||||
DictionaryFrm.NewVar(i);
|
||||
// NoVariables := NoVariables + 1;
|
||||
end;
|
||||
|
||||
// if perturbation elected, convert generated data to z scores and perturb
|
||||
// with the selected perturbation coefficients
|
||||
if PerturbChk.Checked then
|
||||
begin
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
means[i-1] := 0.0;
|
||||
stddevs[i-1] := 0.0;
|
||||
end;
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
for j := 1 to NoObs do
|
||||
begin
|
||||
x := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]);
|
||||
means[i-1] := means[i-1] + x;
|
||||
stddevs[i-1] := stddevs[i-1] + (x * x);
|
||||
end;
|
||||
stddevs[i-1] := stddevs[i-1] - (means[i-1] * means[i-1] / NoObs);
|
||||
stddevs[i-1] := stddevs[i-1] / (NoObs - 1);
|
||||
stddevs[i-1] := sqrt(stddevs[i-1]);
|
||||
means[i-1] := means[i-1] / NoObs;
|
||||
OS3MainFrm.DataGrid.Cells[NoVars+i,0] := OS3MainFrm.DataGrid.Cells[i,0] + 'Z';
|
||||
end;
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
for j := 1 to NoObs do
|
||||
begin
|
||||
x := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]);
|
||||
x := (x - means[i-1]) / stddevs[i-1];
|
||||
OS3MainFrm.DataGrid.Cells[NoVars+i,j] := FloatToStr(x);
|
||||
end;
|
||||
end;
|
||||
// Now, show perturbation options form and select coefficients
|
||||
NoCases := NoObs;
|
||||
OS3MainFrm.NoVarsEdit.Text := IntToStr(NoVars*2);
|
||||
OS3MainFrm.NoCasesEdit.Text := IntToStr(NoObs);
|
||||
end;
|
||||
|
||||
// Now generate score vectors
|
||||
for i2 := 0 to NoObs - 1 do // rows
|
||||
begin // label case heading
|
||||
cellstring := format('Case%d',[i2+1]);
|
||||
OS3MainFrm.DataGrid.Cells[0,i2+1] := cellstring;
|
||||
for i := 0 to NoVars -1 do
|
||||
stddevs[i] := RandG(0.0,1.0);
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
x := 0.0;
|
||||
for j := 0 to i do
|
||||
x := x + (RhoMat[i,j] * stddevs[j]);
|
||||
mean := StrToFloat(Grid.Cells[i+1,NoVars+1]);
|
||||
cellstring := format('%10.3f',[x+mean]);
|
||||
OS3MainFrm.DataGrid.Cells[i+1,i2+1] := cellstring;
|
||||
end; // next variable
|
||||
end; // next observation
|
||||
end; // if abs(determ > .00001)
|
||||
|
||||
// if perturbation elected, convert generated data to z scores and perturb
|
||||
// with the selected perturbation coefficients
|
||||
if PerturbChk.Checked then
|
||||
begin
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
means[i-1] := 0.0;
|
||||
stddevs[i-1] := 0.0;
|
||||
end;
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
for j := 1 to NoObs do
|
||||
begin
|
||||
x := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]);
|
||||
means[i-1] := means[i-1] + x;
|
||||
stddevs[i-1] := stddevs[i-1] + (x * x);
|
||||
end;
|
||||
stddevs[i-1] := stddevs[i-1] - (means[i-1] * means[i-1] / NoObs);
|
||||
stddevs[i-1] := stddevs[i-1] / (NoObs - 1);
|
||||
stddevs[i-1] := sqrt(stddevs[i-1]);
|
||||
means[i-1] := means[i-1] / NoObs;
|
||||
OS3MainFrm.DataGrid.Cells[NoVars+i,0] := OS3MainFrm.DataGrid.Cells[i,0] + 'Z';
|
||||
end;
|
||||
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
for j := 1 to NoObs do
|
||||
begin
|
||||
x := StrToFloat(OS3MainFrm.DataGrid.Cells[i,j]);
|
||||
x := (x - means[i-1]) / stddevs[i-1];
|
||||
OS3MainFrm.DataGrid.Cells[NoVars+i,j] := FloatToStr(x);
|
||||
end;
|
||||
end;
|
||||
|
||||
// Now, show perturbation options form and select coefficients
|
||||
end; // end if perturbchk is checked
|
||||
|
||||
// print parameters if checked
|
||||
if ParmsChk.Checked then
|
||||
begin
|
||||
for i := 1 to NoVars do
|
||||
for j := 1 to NoVars do RhoMat[i-1,j-1] := StrToFloat(Grid.Cells[i,j]);
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
Mus[i-1] := StrToFloat(Grid.Cells[i,NoVars+1]);
|
||||
Sigmas[i-1] := StrToFloat(Grid.Cells[i,NoVars+2]);
|
||||
end;
|
||||
title := 'Rho Matrix';
|
||||
MAT_PRINT(RhoMat,NoVars,NoVars,title,RowLabels,ColLabels,NoObs);
|
||||
title := 'Population Means';
|
||||
DynVectorPrint(Mus,NoVars,title,RowLabels,NoObs);
|
||||
title := 'Sigmas';
|
||||
DynVectorPrint(Sigmas,NoVars,title,RowLabels,NoObs);
|
||||
OutputFrm.ShowModal;
|
||||
for i := 1 to NoVars do
|
||||
for j := 1 to NoVars do RhoMat[i-1,j-1] := StrToFloat(Grid.Cells[i,j]);
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
Mus[i-1] := StrToFloat(Grid.Cells[i,NoVars+1]);
|
||||
Sigmas[i-1] := StrToFloat(Grid.Cells[i,NoVars+2]);
|
||||
end;
|
||||
|
||||
title := 'Rho Matrix';
|
||||
MatPrint(RhoMat, NoVars, NoVars, title, RowLabels, ColLabels, NoObs, lReport);
|
||||
lReport.Add('');
|
||||
|
||||
title := 'Population Means';
|
||||
DynVectorPrint(Mus, NoVars, title, RowLabels, NoObs, lReport);
|
||||
|
||||
title := 'Sigmas';
|
||||
DynVectorPrint(Sigmas, NoVars, title, RowLabels, NoObs, lReport);
|
||||
|
||||
lReport.Add('');
|
||||
lReport.Add(DIVIDER);
|
||||
lReport.Add('');
|
||||
end;
|
||||
|
||||
// do sample values if checked
|
||||
if SampleChk.Checked then
|
||||
begin
|
||||
OutputFrm.RichEdit.Clear;
|
||||
for i := 1 to NoVars do
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
for j := 1 to NoVars do SampMat[i-1,j-1] := 0.0;
|
||||
means[i-1] := 0.0;
|
||||
stddevs[i-1] := 0.0;
|
||||
end;
|
||||
|
||||
for i := 1 to NoObs do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin
|
||||
for j := 1 to NoVars do SampMat[i-1,j-1] := 0.0;
|
||||
means[i-1] := 0.0;
|
||||
stddevs[i-1] := 0.0;
|
||||
x := StrToFloat(OS3MainFrm.DataGrid.Cells[j+1,i]);
|
||||
for k := 0 to NoVars - 1 do
|
||||
begin // cross-products matrix
|
||||
y := StrToFloat(OS3MainFrm.DataGrid.Cells[k+1,i]);
|
||||
SampMat[j,k] := SampMat[j,k] + (x * y);
|
||||
end;
|
||||
means[j] := means[j] + x;
|
||||
end;
|
||||
for i := 1 to NoObs do
|
||||
end;
|
||||
|
||||
// variance - covariance matrix
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin
|
||||
x := StrToFloat(OS3MainFrm.DataGrid.Cells[j+1,i]);
|
||||
for k := 0 to NoVars - 1 do
|
||||
begin // cross-products matrix
|
||||
y := StrToFloat(OS3MainFrm.DataGrid.Cells[k+1,i]);
|
||||
SampMat[j,k] := SampMat[j,k] + (x * y);
|
||||
end;
|
||||
means[j] := means[j] + x;
|
||||
end;
|
||||
SampMat[i,j] := SampMat[i,j] - (means[i] * means[j] / NoObs);
|
||||
SampMat[i,j] := SampMat[i,j] / (NoObs - 1.0);
|
||||
end;
|
||||
// variance - covariance matrix
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin
|
||||
SampMat[i,j] := SampMat[i,j] - (means[i] * means[j] / NoObs);
|
||||
SampMat[i,j] := SampMat[i,j] / (NoObs - 1.0);
|
||||
end;
|
||||
stddevs[i] := sqrt(SampMat[i][i]);
|
||||
stddevs[i] := sqrt(SampMat[i][i]);
|
||||
end;
|
||||
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin // correlation matrix
|
||||
SampMat[i,j] := SampMat[i,j] / (stddevs[i] * stddevs[j]);
|
||||
end;
|
||||
for i := 0 to NoVars - 1 do
|
||||
begin
|
||||
for j := 0 to NoVars - 1 do
|
||||
begin // correlation matrix
|
||||
SampMat[i,j] := SampMat[i,j] / (stddevs[i] * stddevs[j]);
|
||||
end;
|
||||
means[i] := means[i] / NoObs;
|
||||
end;
|
||||
title := 'Sample r Matrix';
|
||||
MAT_PRINT(SampMat,NoVars,NoVars,title,RowLabels,ColLabels,NoObs);
|
||||
title := 'Sample Means';
|
||||
DynVectorPrint(means,NoVars,title,RowLabels,NoObs);
|
||||
title := 'Standard Deviations';
|
||||
DynVectorPrint(stddevs,NoVars,title,RowLabels,NoObs);
|
||||
OutputFrm.ShowModal;
|
||||
means[i] := means[i] / NoObs;
|
||||
end;
|
||||
|
||||
title := 'Sample r Matrix';
|
||||
MatPrint(SampMat, NoVars, NoVars, title, RowLabels, ColLabels, NoObs, lReport);
|
||||
|
||||
title := 'Sample Means';
|
||||
DynVectorPrint(means, NoVars, title, RowLabels, NoObs, lReport);
|
||||
|
||||
title := 'Standard Deviations';
|
||||
DynVectorPrint(stddevs, NoVars, title, RowLabels, NoObs, lReport);
|
||||
end;
|
||||
|
||||
// dispose of arrays
|
||||
DisplayReport(lReport);
|
||||
|
||||
finally
|
||||
lReport.Free;
|
||||
ColLabels := nil;
|
||||
RowLabels := nil;
|
||||
stddevs := nil;
|
||||
@ -343,42 +452,45 @@ begin
|
||||
Mus := nil;
|
||||
SampMat := nil;
|
||||
RhoMat := nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.FormActivate(Sender: TObject);
|
||||
var
|
||||
w: Integer;
|
||||
begin
|
||||
w := MaxValue([HelpBtn.Width, ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
|
||||
HelpBtn.Constraints.MinWidth := w;
|
||||
ResetBtn.Constraints.MinWidth := w;
|
||||
ComputeBtn.Constraints.MinWidth := w;
|
||||
CloseBtn.constraints.MinWidth := w;
|
||||
|
||||
Constraints.MinWidth := Width;
|
||||
Constraints.MinHeight := Height;
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.FormCreate(Sender: TObject);
|
||||
begin
|
||||
Assert(OS3MainFrm <> nil);
|
||||
if OutputFrm = nil then
|
||||
Application.CreateForm(TOutputFrm, OutputFrm);
|
||||
if DictionaryFrm = nil then
|
||||
Application.CreateForm(TDictionaryFrm, DictionaryFrm);
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.CancelBtnClick(Sender: TObject);
|
||||
begin
|
||||
exit;
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.GridKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
gridrow := Grid.Row;
|
||||
gridcol := Grid.Col;
|
||||
if ord(Key) = 13 then
|
||||
begin
|
||||
if (gridrow <= gridcol) then
|
||||
begin
|
||||
grid.Cells[gridrow,gridcol] := grid.Cells[gridcol,gridrow];
|
||||
end;
|
||||
end;
|
||||
gridrow := Grid.Row;
|
||||
gridcol := Grid.Col;
|
||||
if ord(Key) = 13 then
|
||||
if gridrow <= NoVars then
|
||||
grid.Cells[gridrow, gridcol] := grid.Cells[gridcol, gridrow];
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.GridSetEditText(Sender: TObject; ACol, ARow: Integer;
|
||||
const Value: string);
|
||||
begin
|
||||
if (gridrow <= gridcol) then
|
||||
begin
|
||||
grid.Cells[gridrow,gridcol] := grid.Cells[gridcol,gridrow];
|
||||
end;
|
||||
if (gridRow <= NoVars) then
|
||||
// if (gridrow <= gridcol) then
|
||||
grid.Cells[gridrow, gridcol] := grid.Cells[gridcol, gridrow];
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.HelpBtnClick(Sender: TObject);
|
||||
@ -388,72 +500,51 @@ begin
|
||||
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.NoObsEditExit(Sender: TObject);
|
||||
procedure TMultGenFrm.NoObsEditEditingDone(Sender: TObject);
|
||||
var
|
||||
i, j : integer;
|
||||
cellstring : string;
|
||||
i, j: integer;
|
||||
begin
|
||||
NoObs := StrToInt(NoObsEdit.Text);
|
||||
if NoObs > 0 then
|
||||
begin
|
||||
OS3MainFrm.DataGrid.RowCount := NoObs + 1;
|
||||
OS3MainFrm.DataGrid.ColCount := NoVars + 1;
|
||||
for i := 1 to NoObs do
|
||||
begin
|
||||
for j := 1 to NoVars do
|
||||
begin
|
||||
OS3MainFrm.DataGrid.Cells[j,i] := '';
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
if not TryStrToInt(NoObsEdit.Text, NoObs) or (NoObs <= 0) then
|
||||
begin
|
||||
MessageDlg('Valid positive number required for Sample Size.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
for j := 1 to NoVars do
|
||||
begin
|
||||
cellstring := format('VAR%d',[j]);
|
||||
OS3MainFrm.DataGrid.Cells[j,0] := cellstring;
|
||||
end;
|
||||
OS3MainFrm.DataGrid.RowCount := NoObs + 1;
|
||||
OS3MainFrm.DataGrid.ColCount := NoVars + 1;
|
||||
for i := 1 to NoObs do
|
||||
for j := 1 to NoVars do
|
||||
OS3MainFrm.DataGrid.Cells[j,i] := '';
|
||||
|
||||
Grid.Cells[0,0] := 'Variable';
|
||||
Grid.Cells[0,NoVars+1] := 'Mean';
|
||||
Grid.Cells[0,NoVars+2] := 'Std.Dev.';
|
||||
for j := 1 to NoVars do
|
||||
OS3MainFrm.DataGrid.Cells[j,0] := Format('VAR%d',[j]);
|
||||
|
||||
DictionaryFrm.DictGrid.RowCount := NoVars + 1;
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.NoObsEditKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if ord(Key) = 13 then NoObsEditExit(self);
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.NoVarsEditExit(Sender: TObject);
|
||||
procedure TMultGenFrm.NoVarsEditEditingDone(Sender: TObject);
|
||||
var
|
||||
i: integer;
|
||||
cellstring : string;
|
||||
i: integer;
|
||||
cellstring: string;
|
||||
begin
|
||||
NoVars := StrToInt(NoVarsEdit.Text);
|
||||
if NoVars > 0 then
|
||||
begin
|
||||
Grid.RowCount := NoVars + 3;
|
||||
Grid.ColCount := NoVars + 1;
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
Grid.Cells[i,i] := FloatToStr(1.0);
|
||||
cellstring := format('VAR%d',[i]);
|
||||
Grid.Cells[i,0] := cellstring;
|
||||
{ for j := 1 to NoVars do
|
||||
begin
|
||||
if i <> j then
|
||||
begin
|
||||
Grid.Cells[i,j] := '';
|
||||
Grid.Cells[j,i] := '';
|
||||
end;
|
||||
end; // for j := 1 to NoVars }
|
||||
end; // for i := 1 to NoVars
|
||||
if not TryStrToInt(NoVarsEdit.Text, NoVars) or (NoVars <= 0) then
|
||||
begin
|
||||
MessageDlg('Positive number required for Number of Variables.', mtError, [mbOK], 0);
|
||||
exit;
|
||||
end;
|
||||
|
||||
end; // if NoVars > 0
|
||||
end;
|
||||
|
||||
procedure TMultGenFrm.NoVarsEditKeyPress(Sender: TObject; var Key: char);
|
||||
begin
|
||||
if ord(Key) = 13 then NoVarsEditExit(self);
|
||||
Grid.RowCount := NoVars + 3;
|
||||
Grid.ColCount := NoVars + 1;
|
||||
for i := 1 to NoVars do
|
||||
begin
|
||||
cellstring := Format('VAR%d', [i]);
|
||||
Grid.Cells[i, i] := FloatToStr(1.0);
|
||||
Grid.Cells[i, 0] := cellstring;
|
||||
Grid.Cells[0, i] := cellstring;
|
||||
end;
|
||||
Grid.Cells[0, 0] := 'Variable';
|
||||
Grid.Cells[0, NoVars+1] := 'Mean';
|
||||
Grid.Cells[0, NoVars+2] := 'Std.Dev.';
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
Reference in New Issue
Block a user