pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity
Files
79a85d3e590f1e5d35b86bc6eb4c1103534b48db
lazarus-ccr/applications/lazstats/source/forms/simulations/multgenunit.pas

555 lines
15 KiB
ObjectPascal
Raw Blame History

// 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+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Grids, ExtCtrls, Math,
Globals, MainUnit, OutputUnit, DictionaryUnit, MatrixLib, ContextHelpUnit;
type
{ TMultGenFrm }
TMultGenFrm = class(TForm)
Bevel1: TBevel;
HelpBtn: TButton;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
PerturbChk: TCheckBox;
SampleChk: TCheckBox;
ParmsChk: TCheckBox;
NoObsEdit: TEdit;
Label2: TLabel;
NoVarsEdit: TEdit;
Label1: TLabel;
Grid: TStringGrid;
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 NoObsEditEditingDone(Sender: TObject);
procedure NoVarsEditEditingDone(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
private
{ private declarations }
NoVars: integer;
NoObs: integer;
gridrow, gridcol: integer;
public
{ public declarations }
end;
var
MultGenFrm: TMultGenFrm;
implementation
{ TMultGenFrm }
procedure TMultGenFrm.ResetBtnClick(Sender: TObject);
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] := '';
end;
procedure TMultGenFrm.FormShow(Sender: TObject);
begin
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;
cellstring: string;
title: string;
RowLabels: StrDyneVec;
ColLabels: StrDyneVec;
lReport: TStrings;
begin
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;
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;
for i:=1 to NoVars do
begin
for j := 1 to NoVars do
begin
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;
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];
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,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
// 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
begin
for i := 1 to NoVars do
begin
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)
// 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';
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
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
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;
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]);
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';
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;
DisplayReport(lReport);
finally
lReport.Free;
ColLabels := nil;
RowLabels := nil;
stddevs := nil;
Sigmas := nil;
means := nil;
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 DictionaryFrm = nil then
Application.CreateForm(TDictionaryFrm, DictionaryFrm);
end;
procedure TMultGenFrm.GridKeyPress(Sender: TObject; var Key: char);
begin
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 <= NoVars) then
// if (gridrow <= gridcol) then
grid.Cells[gridrow, gridcol] := grid.Cells[gridcol, gridrow];
end;
procedure TMultGenFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
procedure TMultGenFrm.NoObsEditEditingDone(Sender: TObject);
var
i, j: integer;
begin
if not TryStrToInt(NoObsEdit.Text, NoObs) or (NoObs <= 0) then
begin
MessageDlg('Valid positive number required for Sample Size.', mtError, [mbOK], 0);
exit;
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] := '';
for j := 1 to NoVars do
OS3MainFrm.DataGrid.Cells[j,0] := Format('VAR%d',[j]);
DictionaryFrm.DictGrid.RowCount := NoVars + 1;
end;
procedure TMultGenFrm.NoVarsEditEditingDone(Sender: TObject);
var
i: integer;
cellstring: string;
begin
if not TryStrToInt(NoVarsEdit.Text, NoVars) or (NoVars <= 0) then
begin
MessageDlg('Positive number required for Number of Variables.', mtError, [mbOK], 0);
exit;
end;
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
{$I multgenunit.lrs}
end.
Reference in New Issue View Git Blame Copy Permalink