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

LazStats: Inherit HierarchUnit from BasicStatsReportAndChartUnit. Use TAChart.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7871 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-11-15 23:31:39 +00:00
parent a79a11251f
commit 3c8055a908
9 changed files with 627 additions and 519 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
applications/lazstats/source/LazStats.lpi
View File

@ -453,7 +453,7 @@
<Unit43> <Unit43>
<Filename Value="forms\analysis\correlation\autocorunit.pas"/> <Filename Value="forms\analysis\correlation\autocorunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="AutoCorrFrm"/> <ComponentName Value="AutoCorrForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="AutoCorUnit"/> <UnitName Value="AutoCorUnit"/>
@ -581,7 +581,7 @@
<Unit59> <Unit59>
<Filename Value="forms\analysis\multivariate\hierarchunit.pas"/> <Filename Value="forms\analysis\multivariate\hierarchunit.pas"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<ComponentName Value="HierarchFrm"/> <ComponentName Value="HierarchForm"/>
<HasResources Value="True"/> <HasResources Value="True"/>
<ResourceBaseClass Value="Form"/> <ResourceBaseClass Value="Form"/>
<UnitName Value="HierarchUnit"/> <UnitName Value="HierarchUnit"/>

22
applications/lazstats/source/forms/analysis/correlation/autocorunit.lfm
View File

@ -1,4 +1,4 @@
object AutoCorrFrm: TAutoCorrFrm object AutoCorrForm: TAutoCorrForm
Left = 456 Left = 456
Height = 459 Height = 459
Top = 145 Top = 145
@ -13,20 +13,20 @@ object AutoCorrFrm: TAutoCorrFrm
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
Position = poMainFormCenter Position = poMainFormCenter
LCLVersion = '2.1.0.0' LCLVersion = '2.0.10.0'
object GroupBox1: TGroupBox object GroupBox1: TGroupBox
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 8 Left = 8
Height = 68 Height = 68
Top = 8 Top = 8
Width = 137 Width = 126
AutoSize = True AutoSize = True
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'The series is code in:' Caption = 'The series is code in:'
ClientHeight = 48 ClientHeight = 48
ClientWidth = 133 ClientWidth = 122
TabOrder = 0 TabOrder = 0
object ColBtn: TRadioButton object ColBtn: TRadioButton
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = GroupBox1
@ -34,9 +34,9 @@ object AutoCorrFrm: TAutoCorrFrm
Left = 16 Left = 16
Height = 19 Height = 19
Top = 0 Top = 0
Width = 99 Width = 94
BorderSpacing.Left = 16 BorderSpacing.Left = 16
Caption = 'A Grid Column' Caption = 'a grid column'
Checked = True Checked = True
OnClick = ColBtnClick OnClick = ColBtnClick
TabOrder = 0 TabOrder = 0
@ -49,11 +49,11 @@ object AutoCorrFrm: TAutoCorrFrm
Left = 16 Left = 16
Height = 19 Height = 19
Top = 21 Top = 21
Width = 109 Width = 73
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'A row of the grid' Caption = 'a grid row'
OnClick = RowBtnClick OnClick = RowBtnClick
TabOrder = 1 TabOrder = 1
end end
@ -62,7 +62,7 @@ object AutoCorrFrm: TAutoCorrFrm
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = GroupBox1
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
Left = 169 Left = 158
Height = 68 Height = 68
Top = 8 Top = 8
Width = 275 Width = 275
@ -216,7 +216,7 @@ object AutoCorrFrm: TAutoCorrFrm
OnClick = HelpBtnClick OnClick = HelpBtnClick
TabOrder = 4 TabOrder = 4
end end
object Bevel1: TBevel object ButtonBevel: TBevel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
@ -233,7 +233,7 @@ object AutoCorrFrm: TAutoCorrFrm
AnchorSideTop.Control = GroupBox2 AnchorSideTop.Control = GroupBox2
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel2 AnchorSideRight.Control = Panel2
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
Left = 8 Left = 8
Height = 326 Height = 326
Top = 84 Top = 84

68
applications/lazstats/source/forms/analysis/correlation/autocorunit.pas
View File

@ -9,19 +9,18 @@ unit AutoCorUnit;
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, ExtCtrls, Buttons,
StdCtrls, ExtCtrls, Buttons,
MainUnit, FunctionsLib, OutputUnit, Globals, GraphLib, DataProcs, MatrixLib, MainUnit, FunctionsLib, OutputUnit, Globals, GraphLib, DataProcs, MatrixLib,
PointsUnit, DifferenceUnit, PointsUnit, DifferenceUnit,
ContextHelpUnit; ContextHelpUnit;
type type
{ TAutoCorrFrm } { TAutoCorrForm }
TAutoCorrFrm = class(TForm) TAutoCorrForm = class(TForm)
AlphaEdit: TEdit; AlphaEdit: TEdit;
Bevel1: TBevel; ButtonBevel: TBevel;
Bevel2: TBevel; Bevel2: TBevel;
HelpBtn: TButton; HelpBtn: TButton;
Panel1: TPanel; Panel1: TPanel;
@ -107,17 +106,19 @@ type
end; end;
var var
AutoCorrFrm: TAutoCorrFrm; AutoCorrForm: TAutoCorrForm;
implementation implementation
{$R *.lfm}
uses uses
Math, Math,
MathUnit, MoveAvgUnit, AutoPlotUnit, PolynomialUnit, ExpSmoothUnit, FFTUnit; MathUnit, MoveAvgUnit, AutoPlotUnit, PolynomialUnit, ExpSmoothUnit, FFTUnit;
{ TAutoCorrFrm } { TAutoCorrForm }
procedure TAutoCorrFrm.ResetBtnClick(Sender: TObject); procedure TAutoCorrForm.ResetBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -159,12 +160,12 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TAutoCorrFrm.CloseBtnClick(Sender: TObject); procedure TAutoCorrForm.CloseBtnClick(Sender: TObject);
begin begin
Close; Close;
end; end;
procedure TAutoCorrFrm.RowBtnClick(Sender: TObject); procedure TAutoCorrForm.RowBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -176,7 +177,7 @@ begin
OnlyCasesBtn.Caption := 'Only Columns From:'; OnlyCasesBtn.Caption := 'Only Columns From:';
end; end;
procedure TAutoCorrFrm.FormActivate(Sender: TObject); procedure TAutoCorrForm.FormActivate(Sender: TObject);
var var
w: Integer; w: Integer;
begin begin
@ -199,25 +200,25 @@ begin
FAutoSized := true; FAutoSized := true;
end; end;
procedure TAutoCorrFrm.FormCreate(Sender: TObject); procedure TAutoCorrForm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if PointsFrm = nil then Application.CreateForm(TPointsFrm, PointsFrm); if PointsFrm = nil then Application.CreateForm(TPointsFrm, PointsFrm);
end; end;
procedure TAutoCorrFrm.FormShow(Sender: TObject); procedure TAutoCorrForm.FormShow(Sender: TObject);
begin begin
ResetBtnClick(nil); ResetBtnClick(nil);
end; end;
procedure TAutoCorrFrm.HelpBtnClick(Sender: TObject); procedure TAutoCorrForm.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 TAutoCorrFrm.ComputeBtnClick(Sender: TObject); procedure TAutoCorrForm.ComputeBtnClick(Sender: TObject);
var var
X, Y, count, covzero, mean: double; X, Y, count, covzero, mean: double;
uplimit, lowlimit, varresid, StdErr, lAlpha: double; uplimit, lowlimit, varresid, StdErr, lAlpha: double;
@ -682,7 +683,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.ColBtnClick(Sender: TObject); procedure TAutoCorrForm.ColBtnClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -694,7 +695,7 @@ begin
OnlyCasesBtn.Caption := 'Only Cases From:'; OnlyCasesBtn.Caption := 'Only Cases From:';
end; end;
procedure TAutoCorrFrm.InBtnClick(Sender: TObject); procedure TAutoCorrForm.InBtnClick(Sender: TObject);
var var
index: integer; index: integer;
begin begin
@ -707,7 +708,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.OutBtnClick(Sender: TObject); procedure TAutoCorrForm.OutBtnClick(Sender: TObject);
begin begin
if DepVarEdit.Text <> '' then if DepVarEdit.Text <> '' then
begin begin
@ -717,7 +718,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.Four1(var data: DblDyneVec; nn: longword; isign: integer); procedure TAutoCorrForm.Four1(var data: DblDyneVec; nn: longword; isign: integer);
var var
n, mmax, m, j, istep, i: longword; n, mmax, m, j, istep, i: longword;
wtemp, wr, wpr, wpi, wi, theta: double; wtemp, wr, wpr, wpi, wi, theta: double;
@ -780,7 +781,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.RealFt(var data: DblDyneVec; n: longword; isign: integer); procedure TAutoCorrForm.RealFt(var data: DblDyneVec; n: longword; isign: integer);
var var
i,i1,i2,i3,i4,np3 : integer; // was: longword; i,i1,i2,i3,i4,np3 : integer; // was: longword;
c1,c2,h1r,h1i,h2r,h2i : double; c1,c2,h1r,h1i,h2r,h2i : double;
@ -836,7 +837,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.Fourier(var data: DblDyneVec; n, npts: integer); procedure TAutoCorrForm.Fourier(var data: DblDyneVec; n, npts: integer);
var var
nmin, m, mo2, i, k, j: integer; nmin, m, mo2, i, k, j: integer;
yn, y1, rn1, fac, cnst: double; yn, y1, rn1, fac, cnst: double;
@ -893,7 +894,7 @@ begin
y := nil; y := nil;
end; end;
procedure TAutoCorrFrm.PolyFit(const pts: DblDyneVec; var avg: DblDyneVec; procedure TAutoCorrForm.PolyFit(const pts: DblDyneVec; var avg: DblDyneVec;
NoPts, Order: integer); NoPts, Order: integer);
var var
X: DblDyneMat; X: DblDyneMat;
@ -1012,13 +1013,13 @@ begin
X := nil; X := nil;
end; end;
procedure TAutoCorrFrm.UpdateBtnStates; procedure TAutoCorrForm.UpdateBtnStates;
begin begin
InBtn.Enabled := (VarList.ItemIndex > -1) and (DepVarEdit.Text = ''); InBtn.Enabled := (VarList.ItemIndex > -1) and (DepVarEdit.Text = '');
OutBtn.Enabled := (DepVarEdit.Text <> ''); OutBtn.Enabled := (DepVarEdit.Text <> '');
end; end;
procedure TAutoCorrFrm.VarListSelectionChange(Sender: TObject; User: boolean); procedure TAutoCorrForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
@ -1026,7 +1027,7 @@ end;
{ Routines called from ComputeBtnClick } { Routines called from ComputeBtnClick }
function TAutoCorrFrm.CalcMean(const Pts: DblDyneVec; NoPts: Integer): Double; function TAutoCorrForm.CalcMean(const Pts: DblDyneVec; NoPts: Integer): Double;
var var
i: Integer; i: Integer;
begin begin
@ -1036,7 +1037,7 @@ begin
Result := Result / NoPts; Result := Result / NoPts;
end; end;
procedure TAutoCorrFrm.ExponentialSmooth(var Pts: DblDyneVec; NoPts: Integer); procedure TAutoCorrForm.ExponentialSmooth(var Pts: DblDyneVec; NoPts: Integer);
var var
F: TExpSmoothFrm; F: TExpSmoothFrm;
noProj: Integer; noProj: Integer;
@ -1117,7 +1118,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.FourierSmooth(var Pts: DblDyneVec; NoPts: Integer); procedure TAutoCorrForm.FourierSmooth(var Pts: DblDyneVec; NoPts: Integer);
var var
F: TFFTFrm; F: TFFTFrm;
avg: DblDyneVec; avg: DblDyneVec;
@ -1194,7 +1195,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.GetPts(var Pts: DblDyneVec; var NoPts: Integer; procedure TAutoCorrForm.GetPts(var Pts: DblDyneVec; var NoPts: Integer;
Depvar: Integer); Depvar: Integer);
var var
i: Integer; i: Integer;
@ -1241,7 +1242,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.MovingAverage(var Pts: DblDyneVec; NoPts: Integer); procedure TAutoCorrForm.MovingAverage(var Pts: DblDyneVec; NoPts: Integer);
var var
F: TMoveAvgFrm; F: TMoveAvgFrm;
i, j: Integer; i, j: Integer;
@ -1346,7 +1347,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.PlotDifferencesForLag(var Pts: DblDyneVec; NoPts: Integer); procedure TAutoCorrForm.PlotDifferencesForLag(var Pts: DblDyneVec; NoPts: Integer);
var var
F: TDifferenceFrm; F: TDifferenceFrm;
lag: Integer; lag: Integer;
@ -1415,7 +1416,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.PolynomialSmooth(var Pts: DblDyneVec; NoPts: Integer); procedure TAutoCorrForm.PolynomialSmooth(var Pts: DblDyneVec; NoPts: Integer);
var var
F: TPolynomialFrm; F: TPolynomialFrm;
noProj: Integer; noProj: Integer;
@ -1494,7 +1495,7 @@ begin
end; end;
end; end;
procedure TAutoCorrFrm.RemoveMeans(var Pts: DblDyneVec; NoPts: Integer; AMean: Double); procedure TAutoCorrForm.RemoveMeans(var Pts: DblDyneVec; NoPts: Integer; AMean: Double);
var var
i: Integer; i: Integer;
begin begin
@ -1503,8 +1504,5 @@ begin
end; end;
initialization
{$I autocorunit.lrs}
end. end.

8
applications/lazstats/source/forms/analysis/multivariate/discrimunit.lfm
View File

@ -13,7 +13,7 @@ object DiscrimFrm: TDiscrimFrm
OnCreate = FormCreate OnCreate = FormCreate
OnShow = FormShow OnShow = FormShow
Position = poMainFormCenter Position = poMainFormCenter
LCLVersion = '2.1.0.0' LCLVersion = '2.0.10.0'
object ResetBtn: TButton object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
@ -73,7 +73,7 @@ object DiscrimFrm: TDiscrimFrm
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
AnchorSideRight.Control = Panel2 AnchorSideRight.Control = Panel2
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
Left = 8 Left = 8
Height = 400 Height = 400
Top = 8 Top = 8
@ -371,7 +371,7 @@ object DiscrimFrm: TDiscrimFrm
TabOrder = 6 TabOrder = 6
end end
end end
object Bevel1: TBevel object ButtonBevel: TBevel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
@ -387,7 +387,7 @@ object DiscrimFrm: TDiscrimFrm
AnchorSideTop.Control = Owner AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
Left = 412 Left = 412
Height = 408 Height = 408
Top = 0 Top = 0

2
applications/lazstats/source/forms/analysis/multivariate/discrimunit.pas
View File

@ -17,7 +17,7 @@ type
{ TDiscrimFrm } { TDiscrimFrm }
TDiscrimFrm = class(TForm) TDiscrimFrm = class(TForm)
Bevel1: TBevel; ButtonBevel: TBevel;
Panel1: TPanel; Panel1: TPanel;
Panel2: TPanel; Panel2: TPanel;
ResetBtn: TButton; ResetBtn: TButton;

288
applications/lazstats/source/forms/analysis/multivariate/hierarchunit.lfm
View File

@ -1,84 +1,59 @@
object HierarchFrm: THierarchFrm inherited HierarchForm: THierarchForm
Left = 415 Left = 415
Height = 319 Height = 437
Top = 211 Top = 211
Width = 442 Width = 717
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/HierarchicalAnalysis.htm' HelpKeyword = 'html/HierarchicalAnalysis.htm'
AutoSize = True
Caption = 'Hierarchical Cluster Analysis' Caption = 'Hierarchical Cluster Analysis'
ClientHeight = 319 ClientHeight = 437
ClientWidth = 442 ClientWidth = 717
OnActivate = FormActivate inherited ParamsPanel: TPanel
OnCreate = FormCreate Height = 421
OnShow = FormShow ClientHeight = 421
Position = poMainFormCenter inherited CloseBtn: TButton
LCLVersion = '2.1.0.0' Top = 396
object Label1: TLabel TabOrder = 8
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
Left = 8
Height = 15
Top = 8
Width = 97
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Available Variables'
ParentColor = False
end end
object Label2: TLabel inherited ComputeBtn: TButton
AnchorSideLeft.Control = PredList Top = 396
AnchorSideTop.Control = Owner TabOrder = 7
Left = 228
Height = 15
Top = 8
Width = 97
BorderSpacing.Top = 8
Caption = 'Predictor Variables'
ParentColor = False
end end
object VarList: TListBox inherited ResetBtn: TButton
AnchorSideLeft.Control = Owner Top = 396
AnchorSideTop.Control = Label1 TabOrder = 6
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = PredIn
AnchorSideBottom.Control = Bevel1
Left = 8
Height = 245
Top = 25
Width = 176
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 2
BorderSpacing.Right = 8
ItemHeight = 0
MultiSelect = True
OnSelectionChange = VarListSelectionChange
TabOrder = 0
end end
object PredIn: TBitBtn inherited HelpBtn: TButton
Top = 396
TabOrder = 5
end
inherited ButtonBevel: TBevel
Top = 380
end
object PredIn: TBitBtn[5]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList AnchorSideTop.Control = VarList
AnchorSideRight.Control = GroupBox1 AnchorSideRight.Control = OptionsGroup
Left = 192 Left = 132
Height = 28 Height = 26
Top = 25 Top = 17
Width = 28 Width = 26
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 1 ImageIndex = 1
OnClick = PredInClick OnClick = PredInClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 1
end end
object PredOut: TBitBtn object PredOut: TBitBtn[6]
AnchorSideLeft.Control = PredIn AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = PredIn AnchorSideTop.Control = PredIn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 192 Left = 132
Height = 28 Height = 26
Top = 57 Top = 47
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Images = MainDataModule.ImageList Images = MainDataModule.ImageList
ImageIndex = 0 ImageIndex = 0
@ -86,46 +61,87 @@ object HierarchFrm: THierarchFrm
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 2
end end
object PredList: TListBox object Label1: TLabel[7]
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label2 AnchorSideTop.Control = ParamsPanel
Left = 0
Height = 15
Top = 0
Width = 97
Caption = 'Available Variables'
ParentColor = False
end
object Label2: TLabel[8]
AnchorSideLeft.Control = PredList
AnchorSideTop.Control = ParamsPanel
Left = 164
Height = 15
Top = 0
Width = 97
Caption = 'Predictor Variables'
ParentColor = False
end
object VarList: TListBox[9]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = PredIn
AnchorSideRight.Side = asrBottom AnchorSideBottom.Control = OptionsGroup
AnchorSideBottom.Control = GroupBox1 Left = 0
Left = 228 Height = 180
Height = 62 Top = 17
Top = 25 Width = 126
Width = 206
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 6
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 0
end
object PredList: TListBox[10]
AnchorSideLeft.Control = PredIn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label2
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = VarList
AnchorSideBottom.Side = asrBottom
Left = 164
Height = 180
Top = 17
Width = 127
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 6
BorderSpacing.Top = 2
ItemHeight = 0
MultiSelect = True
OnDblClick = PredListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 3 TabOrder = 3
end end
object GroupBox1: TGroupBox object OptionsGroup: TGroupBox[11]
AnchorSideLeft.Control = PredIn AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrBottom
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1 AnchorSideBottom.Control = ButtonBevel
Left = 228 Left = 0
Height = 175 Height = 175
Top = 95 Top = 205
Width = 206 Width = 226
Anchors = [akRight, akBottom] Anchors = [akLeft, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Right = 8 BorderSpacing.Right = 8
Caption = 'Options' Caption = 'Options'
ClientHeight = 155 ClientHeight = 155
ClientWidth = 202 ClientWidth = 222
TabOrder = 4 TabOrder = 4
object STDChk: TCheckBox object STDChk: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = OptionsGroup
AnchorSideTop.Control = GroupBox1 AnchorSideTop.Control = OptionsGroup
Left = 12 Left = 12
Height = 19 Height = 19
Top = 2 Top = 2
@ -139,16 +155,17 @@ object HierarchFrm: THierarchFrm
AnchorSideLeft.Control = STDChk AnchorSideLeft.Control = STDChk
AnchorSideTop.Control = STDChk AnchorSideTop.Control = STDChk
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 32
Height = 19 Height = 19
Top = 23 Top = 23
Width = 123 Width = 123
BorderSpacing.Left = 20
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Replace Grid Values' Caption = 'Replace Grid Values'
TabOrder = 1 TabOrder = 1
end end
object StatsChk: TCheckBox object StatsChk: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = OptionsGroup
AnchorSideTop.Control = ReplaceChk AnchorSideTop.Control = ReplaceChk
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
@ -161,7 +178,7 @@ object HierarchFrm: THierarchFrm
TabOrder = 2 TabOrder = 2
end end
object PlotChk: TCheckBox object PlotChk: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = OptionsGroup
AnchorSideTop.Control = StatsChk AnchorSideTop.Control = StatsChk
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
@ -174,20 +191,20 @@ object HierarchFrm: THierarchFrm
TabOrder = 3 TabOrder = 3
end end
object MaxGrpsChk: TCheckBox object MaxGrpsChk: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = OptionsGroup
AnchorSideTop.Control = PlotChk AnchorSideTop.Control = PlotChk
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
Height = 19 Height = 19
Top = 86 Top = 86
Width = 141 Width = 148
BorderSpacing.Left = 12 BorderSpacing.Left = 12
BorderSpacing.Top = 2 BorderSpacing.Top = 2
Caption = 'Maximum No. Groups:' Caption = 'Max Number of Groups:'
TabOrder = 4 TabOrder = 4
end end
object MembersChk: TCheckBox object MembersChk: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = OptionsGroup
AnchorSideTop.Control = MaxGrpsChk AnchorSideTop.Control = MaxGrpsChk
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
@ -200,7 +217,7 @@ object HierarchFrm: THierarchFrm
TabOrder = 6 TabOrder = 6
end end
object VarChk: TCheckBox object VarChk: TCheckBox
AnchorSideLeft.Control = GroupBox1 AnchorSideLeft.Control = OptionsGroup
AnchorSideTop.Control = MembersChk AnchorSideTop.Control = MembersChk
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 12 Left = 12
@ -218,10 +235,10 @@ object HierarchFrm: THierarchFrm
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = MaxGrpsChk AnchorSideTop.Control = MaxGrpsChk
AnchorSideTop.Side = asrCenter AnchorSideTop.Side = asrCenter
Left = 157 Left = 164
Height = 23 Height = 23
Top = 84 Top = 84
Width = 37 Width = 50
Alignment = taRightJustify Alignment = taRightJustify
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -229,71 +246,24 @@ object HierarchFrm: THierarchFrm
Text = 'MaxGrps' Text = 'MaxGrps'
end end
end end
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 233
Height = 25
Top = 286
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 5
end end
object ComputeBtn: TButton inherited ParamsSplitter: TSplitter
AnchorSideRight.Control = CloseBtn Height = 437
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 295
Height = 25
Top = 286
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 6
end end
object CloseBtn: TButton inherited PageControl: TPageControl
AnchorSideRight.Control = Owner Height = 421
AnchorSideRight.Side = asrBottom Width = 397
AnchorSideBottom.Control = Owner ActivePage = StatsPage
AnchorSideBottom.Side = asrBottom inherited ReportPage: TTabSheet
Left = 379 Caption = 'Results'
Height = 25 end
Top = 286 object StatsPage: TTabSheet[1]
Width = 55 Caption = 'Descriptive Stats'
Anchors = [akRight, akBottom] TabVisible = False
AutoSize = True end
BorderSpacing.Left = 8 inherited ChartPage: TTabSheet[2]
BorderSpacing.Top = 8 Caption = 'Groups Count vs. Errors Plot'
BorderSpacing.Right = 8 TabVisible = False
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 7
end end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 270
Width = 442
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end end
end end

444
applications/lazstats/source/forms/analysis/multivariate/hierarchunit.pas
View File

@ -1,25 +1,27 @@
// Sample file for testing: cansas.laz, use all variiables. // Sample file for testing: cansas.laz, use all variiables.
// WARNING: THE OUTPUT OF THIS FORM DOES NOT AGREE WITH THE SAME FORM OF
// OPENSTAT OR STATS4U
unit HierarchUnit; unit HierarchUnit;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$DEFINE OLD_PLOT}
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls, StdCtrls, Buttons, ExtCtrls, ComCtrls,
MainUnit, OutputUnit, Globals, MatrixLib, GraphLib, DataProcs; {$IFDEF OLD_PLOT} GraphLib, {$ENDIF}
MainUnit, Globals, MatrixLib, ReportFrameUnit, BasicStatsReportAndChartFormUnit;
type type
{ THierarchFrm } { THierarchForm }
THierarchFrm = class(TForm) THierarchForm = class(TBasicStatsReportAndChartForm)
Bevel1: TBevel;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
MaxGrps: TEdit; MaxGrps: TEdit;
STDChk: TCheckBox; STDChk: TCheckBox;
ReplaceChk: TCheckBox; ReplaceChk: TCheckBox;
@ -27,117 +29,111 @@ type
PlotChk: TCheckBox; PlotChk: TCheckBox;
MaxGrpsChk: TCheckBox; MaxGrpsChk: TCheckBox;
MembersChk: TCheckBox; MembersChk: TCheckBox;
StatsPage: TTabSheet;
VarChk: TCheckBox; VarChk: TCheckBox;
GroupBox1: TGroupBox; OptionsGroup: TGroupBox;
PredIn: TBitBtn; PredIn: TBitBtn;
PredOut: TBitBtn; PredOut: TBitBtn;
Label1: TLabel; Label1: TLabel;
Label2: TLabel; Label2: TLabel;
PredList: TListBox; PredList: TListBox;
VarList: TListBox; VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure PredInClick(Sender: TObject); procedure PredInClick(Sender: TObject);
procedure PredListDblClick(Sender: TObject);
procedure PredOutClick(Sender: TObject); procedure PredOutClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject); procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
private private
{ private declarations } FStatsReportFrame: TReportFrame;
FAutoSized: Boolean;
procedure UpdateBtnStates; procedure Plot_GroupCount_Error(const AGrpCount, AError: DblDyneVec;
ADataCount: Integer);
procedure ShowDescriptiveStats(const AMeans, AVars, AStdDevs: DblDyneVec;
ANumCols, ANumCases: Integer; const AVarLabels: StrDyneVec);
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
function Validate(out AMsg: String; out AControl: TWincontrol): Boolean; override;
public public
{ public declarations } constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end; end;
var var
HierarchFrm: THierarchFrm; HierarchForm: THierarchForm;
implementation implementation
{$R *.lfm}
uses uses
Math, Utils; TAChartUtils, TACustomSeries,
Utils, DataProcs, ChartFrameUnit;
{ THierarchFrm }
procedure THierarchFrm.ResetBtnClick(Sender: TObject); { THierarchForm }
var
i: integer; constructor THierarchForm.Create(AOwner: TComponent);
begin begin
VarList.Clear; inherited;
PredList.Clear;
StdChk.Checked := false;
ReplaceChk.Checked := false;
StatsChk.Checked := false;
PlotChk.Checked := false;
MaxGrpsChk.Checked := false;
VarChk.Checked := false;
MaxGrps.Text := '';
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
UpdateBtnStates;
end;
procedure THierarchFrm.FormActivate(Sender: TObject); InitToolbar(FReportFrame.ReportToolbar, tpTop);
var FReportFrame.ClearBorderSpacings;
w: Integer;
begin
if FAutoSized then
exit;
w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); FStatsReportFrame := TReportFrame.Create(self);
ResetBtn.Constraints.MinWidth := w; FStatsReportFrame.Parent := StatsPage;
ComputeBtn.Constraints.MinWidth := w; FStatsReportFrame.Align := alClient;
CloseBtn.Constraints.MinWidth := w; StatsPage.PageIndex := 1;
VarList.Constraints.MinWidth := PredList.Width;
Constraints.MinWidth := Width; {$IFDEF OLD_PLOTS}
Constraints.MinHeight := Height;
FAutoSized := true;
end;
procedure THierarchFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
if GraphFrm = nil then if GraphFrm = nil then
Application.CreateForm(TGraphFrm, GraphFrm); Application.CreateForm(TGraphFrm, GraphFrm);
{$ENDIF}
PageControl.ActivePageIndex := 0;
end; end;
procedure THierarchFrm.FormShow(Sender: TObject);
procedure THierarchForm.AdjustConstraints;
begin begin
ResetBtnClick(self); inherited;
ParamsPanel.Constraints.MinWidth := 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left;
ParamsPanel.Constraints.MinHeight := PredOut.Top + PredOut.Height +
VarList.BorderSpacing.Bottom + OptionsGroup.Height +
ButtonBevel.Height + CloseBtn.Height;
end; end;
procedure THierarchFrm.ComputeBtnClick(Sender: TObject);
procedure THierarchForm.Compute;
label next1; label next1;
var var
varlabels, rowlabels : StrDyneVec; varLabels: StrDyneVec = nil;
cellstring : string; rowLabels: StrDyneVec = nil;
w2: IntDyneVec = nil;
k4: IntDyneVec = nil;
k5: IntDyneVec = nil;
L1: IntDyneVec = nil;
ColSelected: IntDyneVec = nil;
W: DblDyneVec = nil;
XAxis: DblDyneVec = nil;
YAxis: DblDyneVec = nil;
means: DblDyneVec = nil;
variances: DblDyneVec = nil;
stddevs: DblDyneVec = nil;
Distance : DblDyneMat = nil;
cellstring: string;
i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer; i, j, k, k1, k3, L, w3, n3, n4, n5, M, col, count: integer;
GrpCnt, Nrows, Ncols, NoSelected: integer; GrpCnt, Nrows, Ncols, NoSelected: integer;
w2, k4, k5, L1 : IntDyneVec; X, Y, d1, x1, MaxError: double;
ColSelected : IntDyneVec = nil;
X, Y, d1, x1, MaxError : double;
W, XAxis, YAxis, means, variances, stddevs : DblDyneVec;
Distance : DblDyneMat = nil;
lReport: TStrings; lReport: TStrings;
begin begin
if MaxGrpsChk.Checked then
begin
if MaxGrps.Text = '' then
begin
MessageDlg('Maximum number of groups not specified.', mtError, [mbOK], 0);
exit;
end;
if not TryStrToInt(MaxGrps.Text, k1) or (k1 < 1) then
begin
Messagedlg('No valid number of groups given.', mtError, [mbOK], 0);
exit;
end;
end;
MaxError := 0.0; MaxError := 0.0;
GrpCnt := 0; GrpCnt := 0;
NoSelected := PredList.Items.Count; NoSelected := PredList.Items.Count;
@ -157,9 +153,10 @@ begin
SetLength(varlabels,NoSelected); SetLength(varlabels,NoSelected);
SetLength(rowlabels,NoCases); SetLength(rowlabels,NoCases);
SetLength(ColSelected,NoSelected); SetLength(ColSelected,NoSelected);
Ncols := NoSelected; nCols := NoSelected;
Nrows := NoCases; nRows := NoCases;
for i := 0 to Ncols - 1 do
for i := 0 to nCols - 1 do
begin begin
cellstring := PredList.Items.Strings[i]; cellstring := PredList.Items.Strings[i];
for j := 1 to NoVariables do for j := 1 to NoVariables do
@ -191,7 +188,7 @@ begin
Ncols := NoCases; Ncols := NoCases;
Nrows := NoSelected; Nrows := NoSelected;
//Get labels of selected variables //Get labels of selected variables
for i := 0 to Nrows - 1 do for i := 0 to nRows - 1 do
begin begin
cellstring := PredList.Items.Strings[i]; cellstring := PredList.Items.Strings[i];
for j := 1 to NoVariables do for j := 1 to NoVariables do
@ -207,23 +204,29 @@ begin
varlabels[i] := IntToStr(i); varlabels[i] := IntToStr(i);
end; end;
if MembersChk.Checked then k3 := 1 else k3 := 0; if MaxGrpsChk.Checked then
k1 := StrToInt(MaxGrps.Text);
for j := 0 to Ncols-1 do if MembersChk.Checked then
k3 := 1
else
k3 := 0;
for j := 0 to nCols-1 do
begin begin
means[j] := 0.0; means[j] := 0.0;
variances[j] := 0.0; variances[j] := 0.0;
stddevs[j] := 0.0; stddevs[j] := 0.0;
end; end;
if VarChk.Checked = false then if not VarChk.Checked then
begin begin
// Get labels of rows // Get labels of rows
// for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[0,i]; // for i := 1 to Nrows do rowlabels[i-1] := MainFrm.Grid.Cells[0,i];
// Get data into the distance matrix // Get data into the distance matrix
count := 0; count := 0;
for i := 1 to Nrows do for i := 1 to nRows do
begin begin
if (not GoodRecord(i,NoSelected,ColSelected)) then continue; if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1; count := count + 1;
@ -243,31 +246,38 @@ begin
// Get data into the distance matrix // Get data into the distance matrix
count := 0; count := 0;
for i := 1 to Nrows do // actually grid column in this case for i := 0 to nRows-1 do // actually grid column in this case
begin begin
// if (not GoodRecord(i,NoSelected,ColSelected)) then continue; // if (not GoodRecord(i,NoSelected,ColSelected)) then continue;
count := count + 1; count := count + 1;
for j := 1 to Ncols do // actually grid rows in this case for j := 0 to Ncols-1 do // actually grid rows in this case
begin begin
// if (not GoodRecord(j,NoSelected,ColSelected)) then continue; // if (not GoodRecord(j,NoSelected,ColSelected)) then continue;
col := ColSelected[i-1]; col := ColSelected[i];
X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col,j])); X := StrToFloat(Trim(OS3MainFrm.DataGrid.Cells[col, j+1]));
means[j-1] := means[j-1] + X; means[j] := means[j] + X;
variances[j-1] := variances[j-1] + (X * X); variances[j] := variances[j] + (X * X);
Distance[i-1,j-1] := X; Distance[i, j] := X;
end; end;
end; end;
end; end;
// Calculate means and standard deviations of variables // Calculate means and standard deviations of variables
for j := 0 to Ncols-1 do for j := 0 to nCols-1 do
begin begin
variances[j] := variances[j] - (means[j] * means[j] / count); variances[j] := (variances[j] - sqr(means[j]) / count) / (count - 1);
variances[j] := variances[j] / (count - 1);
stddevs[j] := sqrt(variances[j]); stddevs[j] := sqrt(variances[j]);
means[j] := means[j] / count; means[j] := means[j] / count;
end; end;
// Report descriptive statistics
if StatsChk.Checked then
begin
StatsPage.TabVisible := true;
ShowDescriptiveStats(means, variances, stddevs, nCols, count, varlabels);
end else
StatsPage.TabVisible := false;
// Ready the output form // Ready the output form
lReport := TStringList.Create; lReport := TStringList.Create;
try try
@ -276,33 +286,24 @@ begin
lReport.Add('Number of objects to cluster: %d on %d variables.', [Nrows, Ncols]); lReport.Add('Number of objects to cluster: %d on %d variables.', [Nrows, Ncols]);
lReport.Add(''); lReport.Add('');
if StatsChk.Checked then
begin
DynVectorPrint(means, Ncols, 'Variable Means', varlabels, count, lReport);
DynVectorPrint(variances, Ncols, 'Variable Variances', varlabels, count, lReport);
DynVectorPrint(stddevs, Ncols, 'Variable Standard Deviations', varlabels, count, lReport);
lReport.Add(DIVIDER);
lReport.Add('');
end;
// Standardize the distance scores if elected // Standardize the distance scores if elected
if StdChk.Checked then if StdChk.Checked then
begin begin
for j := 0 to Ncols-1 do for j := 0 to nCols-1 do
for i := 0 to Nrows-1 do for i := 0 to nRows-1 do
Distance[i,j] := (Distance[i,j] - means[j]) / stddevs[j]; Distance[i,j] := (Distance[i,j] - means[j]) / stddevs[j];
end; end;
// replace original values in grid with z scores if elected // replace original values in grid with z scores if elected
if ReplaceChk.Checked then if ReplaceChk.Checked then
begin begin
for i := 1 to Nrows do for i := 0 to nRows-1 do
begin begin
if not GoodRecord(i,NoSelected,ColSelected) then continue; if not GoodRecord(i+1, NoSelected, ColSelected) then continue;
for j := 1 to Ncols do for j := 0 to nCols-1 do
begin begin
col := ColSelected[j-1]; col := ColSelected[j];
OS3MainFrm.DataGrid.Cells[col,i] := Format('%6.4f', [Distance[i-1,j-1]]); OS3MainFrm.DataGrid.Cells[col, i+1] := Format('%6.4f', [Distance[i, j]]);
end; end;
end; end;
end; end;
@ -327,14 +328,10 @@ begin
// Now, group the cases for maximum groups down // Now, group the cases for maximum groups down
if MaxGrpsChk.Checked then if MaxGrpsChk.Checked then
begin k1 := StrToInt(MaxGrps.Text)
k1 := StrToInt(MaxGrps.Text); else
n3 := Nrows;
end else
begin
k1 := 2; k1 := 2;
n3 := Nrows; n3 := nRows;
end;
// Initialize group membership and group-n vectors // Initialize group membership and group-n vectors
for i := 0 to Nrows-1 do for i := 0 to Nrows-1 do
@ -346,11 +343,15 @@ begin
// Locate optimal combination, if more than 2 groups remain // Locate optimal combination, if more than 2 groups remain
next1: next1:
n3 := n3 - 1; n3 := n3 - 1;
if (n3 > 1) then if (n3 > 1) then
begin begin
//repeat;
// n3 := n3 - 1;
x1 := 100000000000.0; x1 := 100000000000.0;
for i := 1 to Nrows do for i := 1 to Nrows do
begin begin
@ -374,9 +375,10 @@ next1:
n4 := w2[L-1]; n4 := w2[L-1];
n5 := w2[M-1]; n5 := w2[M-1];
XAxis[GrpCnt] := n3;
YAxis[GrpCnt] := x1;
GrpCnt := GrpCnt + 1; GrpCnt := GrpCnt + 1;
XAxis[GrpCnt-1] := n3;
YAxis[GrpCnt-1] := x1;
if (x1 > MaxError) then MaxError := x1; if (x1 > MaxError) then MaxError := x1;
lReport.Add('%2.d groups after combining group %2.d (n = %2.d) and group %2.d (n = %2.d), error: %7.3f', [n3, L, n4, M, n5, x1]); lReport.Add('%2.d groups after combining group %2.d (n = %2.d) and group %2.d (n = %2.d), error: %7.3f', [n3, L, n4, M, n5, x1]);
@ -406,10 +408,13 @@ next1:
end; end;
end; end;
w2[L-1] := w3; w2[L-1] := w3;
if (n3 > k1) then goto next1; if (n3 > k1) then
//Continue;
goto next1;
// print group memberships of all objects, if optioned // Print group memberships of all objects, if optioned
for i := 1 to Nrows do lReport.Add('');
for i := 1 to nRows do
begin begin
if (k5[i-1] = i) then if (k5[i-1] = i) then
begin begin
@ -431,13 +436,19 @@ next1:
end; // end if end; // end if
end; // end if end; // end if
end; // next i end; // next i
lReport.Add('');
goto next1; goto next1;
//until n3 = 2;
end; // end if end; // end if
DisplayReport(lReport); FReportFrame.DisplayReport(lReport);
if PlotChk.Checked then if PlotChk.Checked then
begin begin
ChartPage.TabVisible := true;
Plot_GroupCount_Error(XAxis, YAxis, GrpCnt);
{$IFDEF OLD_PLOTS}
SetLength(GraphFrm.Ypoints,1,GrpCnt); SetLength(GraphFrm.Ypoints,1,GrpCnt);
SetLength(GraphFrm.Xpoints,1,GrpCnt); SetLength(GraphFrm.Xpoints,1,GrpCnt);
for i := 1 to GrpCnt do for i := 1 to GrpCnt do
@ -458,30 +469,38 @@ next1:
GraphFrm.BackColor := clCream; GraphFrm.BackColor := clCream;
GraphFrm.ShowBackWall := true; GraphFrm.ShowBackWall := true;
GraphFrm.ShowModal; GraphFrm.ShowModal;
end; {$ENDIF}
end else
ChartPage.TabVisible := false;
finally finally
lReport.Free; lReport.Free;
ColSelected := nil;
rowlabels := nil;
varlabels := nil;
Distance := nil;
stddevs := nil;
variances := nil;
means := nil;
YAxis := nil;
XAxis := nil;
W := nil;
L1 := nil;
k5 := nil;
k4 := nil;
w2 := nil;
GraphFrm.Xpoints := nil;
GraphFrm.Ypoints := nil;
end; end;
end; end;
procedure THierarchFrm.PredInClick(Sender: TObject);
procedure THierarchForm.Plot_GroupCount_Error(const AGrpCount, AError: DblDyneVec;
ADataCount: Integer);
var
ser: TChartSeries;
i: Integer;
begin
FChartFrame.Clear;
FChartFrame.SetTitle('Number of Groups vs. Grouping Error');
FChartFrame.SetXTitle('Number of Groups');
FChartFrame.SetYTitle('Grouping Error');
ser := FChartFrame.PlotXY(ptSymbols, nil, nil, nil, nil, '', DATA_COLORS[0]);
for i := 0 to ADataCount-1 do
ser.AddXY(i, AError[i], Format('%.0f', [AGrpCount[i]]));
FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source;
FChartFrame.Chart.BottomAxis.Marks.Style := smsLabel;
FChartFrame.Chart.Legend.Visible := false;
end;
procedure THierarchForm.PredInClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -499,7 +518,22 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure THierarchFrm.PredOutClick(Sender: TObject);
procedure THierarchForm.PredListDblClick(Sender: TObject);
var
index: Integer;
begin
index := PredList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(PredList.Items[index]);
PredList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure THierarchForm.PredOutClick(Sender: TObject);
var var
i: integer; i: integer;
begin begin
@ -517,19 +551,125 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure THierarchFrm.UpdateBtnStates;
procedure THierarchForm.Reset;
var
i: integer;
begin begin
inherited;
if FStatsReportFrame <> nil then
FStatsReportFrame.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
PredList.Clear;
StdChk.Checked := false;
ReplaceChk.Checked := false;
StatsChk.Checked := false;
PlotChk.Checked := false;
MaxGrpsChk.Checked := false;
VarChk.Checked := false;
MaxGrps.Clear;
UpdateBtnStates;
end;
procedure THierarchForm.ShowDescriptiveStats(const AMeans, AVars, AStdDevs: DblDyneVec;
ANumCols, ANumCases: Integer; const AVarLabels: StrDyneVec);
var
lReport: TStrings;
begin
lReport := TStringList.Create;
try
DynVectorPrint(AMeans, ANumCols, 'Variable Means', AVarLabels, ANumCases, lReport);
lReport.Add(DIVIDER_SMALL_AUTO);
lReport.Add('');
DynVectorPrint(AVars, ANumCols, 'Variable Variances', AVarLabels, ANumCases, lReport);
lReport.Add(DIVIDER_SMALL_AUTO);
lReport.Add('');
DynVectorPrint(AStdDevs, ANumCols, 'Variable Standard Deviations', AVarLabels, ANumCases, lReport);
FStatsReportFrame.DisplayReport(lReport);
finally
lReport.Free;
end;
end;
procedure THierarchForm.UpdateBtnStates;
begin
inherited;
if FStatsReportFrame <> nil then
FStatsReportFrame.UpdateBtnStates;
PredIn.Enabled := AnySelected(VarList); PredIn.Enabled := AnySelected(VarList);
PredOut.Enabled := AnySelected(PredList); PredOut.Enabled := AnySelected(PredList);
end; end;
procedure THierarchFrm.VarListSelectionChange(Sender: TObject; User: boolean);
function THierarchForm.Validate(out AMsg: String; out AControl: TWincontrol): Boolean;
var
n: Integer;
begin
Result := false;
if PredList.Items.Count = 0 then
begin
AMsg := 'No Predictor Variables selected.';
AControl := VarList;
exit;
end;
if MaxGrpsChk.Checked then
begin
if MaxGrps.Text = '' then
begin
AMsg := 'Maximum number of groups not specified.';
AControl := MaxGrps;
exit;
end;
if not TryStrToInt(MaxGrps.Text, n) or (n < 1) then
begin
AMsg := 'No valid number of groups given.';
AControl := MaxGrps;
exit;
end;
end;
Result := true;
end;
procedure THierarchForm.VarListDblClick(Sender: TObject);
var
index: Integer;
s: String;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
PredList.Items.Add(VarList.Items[index]);
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure THierarchForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin begin
UpdateBtnStates; UpdateBtnStates;
end; end;
initialization
{$I hierarchunit.lrs}
end. end.

18
applications/lazstats/source/forms/mainunit.lfm
View File

@ -599,23 +599,23 @@ object OS3MainFrm: TOS3MainFrm
OnClick = mnuAnalysisComp_LatinSquaresClick OnClick = mnuAnalysisComp_LatinSquaresClick
end end
end end
object mnuAnalysisCorrel: TMenuItem object mnuAnalysisCorr: TMenuItem
Caption = 'Correlation' Caption = 'Correlation'
object mnuAnalysisCorrel_ProductMoment: TMenuItem object mnuAnalysisCorr_ProductMoment: TMenuItem
Caption = 'Product-Moment' Caption = 'Product-Moment'
OnClick = mnuAnalysisCorrel_ProductMomentClick OnClick = mnuAnalysisCorr_ProductMomentClick
end end
object mnuAnalysisCorrel_Partial: TMenuItem object mnuAnalysisCorr_Partial: TMenuItem
Caption = 'Partial, Semipartial' Caption = 'Partial, Semipartial'
OnClick = mnuAnalysisCorrel_PartialClick OnClick = mnuAnalysisCorr_PartialClick
end end
object mnuAnalysisCorrel_AutoCorr: TMenuItem object mnuAnalysisCorr_AutoCorr: TMenuItem
Caption = 'Autocorrelation' Caption = 'Autocorrelation'
OnClick = mnuAnalysisCorrel_AutoCorrClick OnClick = mnuAnalysisCorr_AutoCorrClick
end end
object mnuAnalysisCorrel_Canonical: TMenuItem object mnuAnalysisCorr_Canonical: TMenuItem
Caption = 'Canonical' Caption = 'Canonical'
OnClick = mnuAnalysisCorrel_CanonicalClick OnClick = mnuAnalysisCorr_CanonicalClick
end end
end end
object mnuAnalysisMultReg: TMenuItem object mnuAnalysisMultReg: TMenuItem

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

@ -85,11 +85,11 @@ type
mnuAnalysisComp_WithinAnova: TMenuItem; mnuAnalysisComp_WithinAnova: TMenuItem;
// Menu "Analysis" > "Correlation" // Menu "Analysis" > "Correlation"
mnuAnalysisCorrel: TMenuItem; mnuAnalysisCorr: TMenuItem;
mnuAnalysisCorrel_ProductMoment: TMenuItem; mnuAnalysisCorr_ProductMoment: TMenuItem;
mnuAnalysisCorrel_Partial: TMenuItem; mnuAnalysisCorr_Partial: TMenuItem;
mnuAnalysisCorrel_AutoCorr: TMenuItem; mnuAnalysisCorr_AutoCorr: TMenuItem;
mnuAnalysisCorrel_Canonical: TMenuItem; mnuAnalysisCorr_Canonical: TMenuItem;
// Menu "Analysis" > "Descriptive" // Menu "Analysis" > "Descriptive"
mnuAnalysisDescr: TMenuItem; mnuAnalysisDescr: TMenuItem;
@ -351,10 +351,10 @@ type
procedure mnuAnalysisComp_WithinAnovaClick(Sender: TObject); procedure mnuAnalysisComp_WithinAnovaClick(Sender: TObject);
// Menu "Analysis" > "Correlation" // Menu "Analysis" > "Correlation"
procedure mnuAnalysisCorrel_AutoCorrClick(Sender: TObject); procedure mnuAnalysisCorr_AutoCorrClick(Sender: TObject);
procedure mnuAnalysisCorrel_CanonicalClick(Sender: TObject); procedure mnuAnalysisCorr_CanonicalClick(Sender: TObject);
procedure mnuAnalysisCorrel_PartialClick(Sender: TObject); procedure mnuAnalysisCorr_PartialClick(Sender: TObject);
procedure mnuAnalysisCorrel_ProductMomentClick(Sender: TObject); procedure mnuAnalysisCorr_ProductMomentClick(Sender: TObject);
// Menu "Analysis" > "Descriptive" // Menu "Analysis" > "Descriptive"
procedure mnuAnalysisDescr_BoxPlotClick(Sender: TObject); procedure mnuAnalysisDescr_BoxPlotClick(Sender: TObject);
@ -768,9 +768,9 @@ end;
// Menu "Analysis" > "Multivariate" > "Hierarchical Analysis" // Menu "Analysis" > "Multivariate" > "Hierarchical Analysis"
procedure TOS3MainFrm.mnuAnalysisMulti_HierarchicalClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisMulti_HierarchicalClick(Sender: TObject);
begin begin
if HierarchFrm = nil then if HierarchForm = nil then
Application.CreateForm(THierarchFrm, HierarchFrm); Application.CreateForm(THierarchForm, HierarchForm);
HierarchFrm.ShowModal; HierarchForm.Show;
end; end;
// Menu "Analysis" > "Multivariate" > "Path analysis" // Menu "Analysis" > "Multivariate" > "Path analysis"
@ -1665,7 +1665,7 @@ end;
{ "Correlation" commands } { "Correlation" commands }
// Menu "Correlation" > "Product-Moment" // Menu "Correlation" > "Product-Moment"
procedure TOS3MainFrm.mnuAnalysisCorrel_ProductMomentClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisCorr_ProductMomentClick(Sender: TObject);
begin begin
if RMatForm = nil then if RMatForm = nil then
Application.CreateForm(TRMatForm, RMatForm); Application.CreateForm(TRMatForm, RMatForm);
@ -1673,7 +1673,7 @@ begin
end; end;
// Menu "Correlation" > "Partial, Semipartial" // Menu "Correlation" > "Partial, Semipartial"
procedure TOS3MainFrm.mnuAnalysisCorrel_PartialClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisCorr_PartialClick(Sender: TObject);
begin begin
if PartialsForm = nil then if PartialsForm = nil then
Application.CreateForm(TPartialsForm, PartialsForm); Application.CreateForm(TPartialsForm, PartialsForm);
@ -1681,15 +1681,15 @@ begin
end; end;
// Menu "Correlation" > "Autocorrelation" // Menu "Correlation" > "Autocorrelation"
procedure TOS3MainFrm.mnuAnalysisCorrel_AutoCorrClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisCorr_AutoCorrClick(Sender: TObject);
begin begin
if AutoCorrFrm = nil then if AutoCorrForm = nil then
Application.CreateForm(TAutoCorrFrm, AutoCorrFrm); Application.CreateForm(TAutoCorrForm, AutoCorrForm);
AutocorrFrm.Show; AutocorrForm.Show;
end; end;
// Menu "Correlation" > "Canonical" // Menu "Correlation" > "Canonical"
procedure TOS3MainFrm.mnuAnalysisCorrel_CanonicalClick(Sender: TObject); procedure TOS3MainFrm.mnuAnalysisCorr_CanonicalClick(Sender: TObject);
begin begin
if CanonicalForm = nil then if CanonicalForm = nil then
Application.CreateForm(TCanonicalForm, CanonicalForm); Application.CreateForm(TCanonicalForm, CanonicalForm);