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:
wp_xxyyzz
2020-04-26 20:13:12 +00:00
parent f3982ea95b
commit 8d5974168a
5 changed files with 441 additions and 361 deletions

View File

@ -1431,6 +1431,7 @@
</Item3>
<Item4>
<Name Value="EGridException"/>
<Enabled Value="False"/>
</Item4>
<Item5>
<Name Value="EConvertError"/>

View File

@ -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

View File

@ -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