LazStats: Inherit KMeansUnit from BasicStatisReoortUnit. Some refactoring.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7895 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-11-21 15:45:00 +00:00
parent 35fecc8c8d
commit 905e205bf1
4 changed files with 486 additions and 600 deletions

View File

@ -997,7 +997,7 @@
<Unit111>
<Filename Value="forms\analysis\multivariate\kmeansunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="KMeansFrm"/>
<ComponentName Value="KMeansForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="KMeansUnit"/>

View File

@ -1,243 +1,43 @@
object KMeansFrm: TKMeansFrm
inherited KMeansForm: TKMeansForm
Left = 664
Height = 349
Height = 389
Top = 318
Width = 422
Width = 657
HelpType = htKeyword
HelpKeyword = 'html/KMeansClustering.htm'
AutoSize = True
Caption = 'k Means Clustering '
ClientHeight = 349
ClientWidth = 422
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '2.1.0.0'
object ResetBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 201
Height = 25
Top = 316
Width = 54
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Reset'
OnClick = ResetBtnClick
TabOrder = 3
end
object ComputeBtn: TButton
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 267
Height = 25
Top = 316
Width = 76
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 4
end
object CloseBtn: TButton
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 355
Height = 25
Top = 316
Width = 55
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 5
end
object HelpBtn: TButton
Tag = 129
AnchorSideRight.Control = ResetBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 138
Height = 25
Top = 316
Width = 51
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 2
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
Left = 0
Height = 8
Top = 300
Width = 422
Anchors = [akLeft, akRight, akBottom]
Shape = bsBottomLine
end
object Panel1: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Bevel1
Left = 0
Height = 101
Top = 199
Width = 422
Anchors = [akLeft, akRight, akBottom]
AutoSize = True
BevelOuter = bvNone
ClientHeight = 101
ClientWidth = 422
ClientHeight = 389
ClientWidth = 657
inherited ParamsPanel: TPanel
Height = 373
Width = 329
ClientHeight = 373
ClientWidth = 329
TabOrder = 1
object Label1: TLabel
AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = NoClustersEdit
AnchorSideTop.Side = asrCenter
Left = 8
Height = 15
Top = 12
Width = 120
BorderSpacing.Left = 8
Caption = 'No. of Desired Clusters'
ParentColor = False
inherited CloseBtn: TButton
Left = 274
Top = 348
end
object Label2: TLabel
AnchorSideTop.Control = ItersEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = Label1
AnchorSideRight.Side = asrBottom
Left = 43
Height = 15
Top = 39
Width = 85
Anchors = [akTop, akRight]
Caption = 'No. of Iterations'
ParentColor = False
inherited ComputeBtn: TButton
Left = 190
Top = 348
end
object NoClustersEdit: TEdit
AnchorSideLeft.Control = Label1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
Left = 136
Height = 23
Top = 8
Width = 54
Alignment = taRightJustify
BorderSpacing.Left = 8
BorderSpacing.Top = 8
TabOrder = 0
Text = 'NoClustersEdit'
inherited ResetBtn: TButton
Left = 128
Top = 348
end
object ItersEdit: TEdit
AnchorSideLeft.Control = NoClustersEdit
AnchorSideTop.Control = NoClustersEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = NoClustersEdit
AnchorSideRight.Side = asrBottom
Left = 136
Height = 23
Top = 35
Width = 54
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 4
TabOrder = 1
Text = 'ItersEdit'
inherited HelpBtn: TButton
Tag = 129
Left = 69
Top = 348
end
object GroupBox1: TGroupBox
AnchorSideLeft.Control = NoClustersEdit
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideRight.Side = asrBottom
Left = 206
Height = 93
Top = 8
Width = 159
AutoSize = True
BorderSpacing.Left = 16
BorderSpacing.Top = 8
BorderSpacing.Right = 8
Caption = 'Analysis Optons'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 2
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ClientHeight = 73
ClientWidth = 155
TabOrder = 2
object StdChkBox: TCheckBox
Left = 12
Height = 19
Top = 6
Width = 131
Caption = 'Standardize Variables'
TabOrder = 0
end
object RepChkBox: TCheckBox
Left = 12
Height = 19
Top = 27
Width = 131
Caption = 'Replace Grid Values'
TabOrder = 1
end
object DescChkBox: TCheckBox
Left = 12
Height = 19
Top = 48
Width = 131
Caption = 'Descriptive Statistics'
TabOrder = 2
end
inherited ButtonBevel: TBevel
Top = 332
Width = 329
end
end
object Panel2: TPanel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel1
Left = 0
Height = 191
Top = 8
Width = 422
Anchors = [akTop, akLeft, akRight, akBottom]
AutoSize = True
BorderSpacing.Top = 8
BevelOuter = bvNone
ClientHeight = 191
ClientWidth = 422
TabOrder = 0
object Label3: TLabel
AnchorSideLeft.Control = Panel2
AnchorSideTop.Control = Panel2
object Label3: TLabel[5]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel
Left = 8
Height = 15
Top = 0
@ -246,171 +46,225 @@ object KMeansFrm: TKMeansFrm
Caption = 'Available Variables'
ParentColor = False
end
object VarList: TListBox
AnchorSideLeft.Control = Panel2
object VarList: TListBox[6]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = AllBtn
AnchorSideBottom.Control = Panel2
AnchorSideBottom.Side = asrBottom
Left = 8
Height = 173
Left = 0
Height = 213
Top = 18
Width = 172
Width = 138
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 3
BorderSpacing.Right = 8
BorderSpacing.Right = 6
BorderSpacing.Bottom = 8
ItemHeight = 0
MultiSelect = True
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 0
TabOrder = 4
end
object VarInBtn: TBitBtn
AnchorSideLeft.Control = Panel2
object VarInBtn: TBitBtn[7]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList
Left = 197
Height = 28
Left = 151
Height = 26
Top = 18
Width = 28
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00216324B81D5E2006FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF002A702F38256929F7216324D9FFFFFF00FFFFFF00FFFFFF00FFFFFF0061BE
6DFF5DB868FF58B162FF53A95CFF4DA156FF47994FFF419149FF3B8842FF3580
3BFF3F8845FF59A15EFF448B49FF216324CFFFFFFF00FFFFFF00FFFFFF0065C3
71FFA0D7A9FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6
89FF7EC384FF7AC180FF76BE7CFF458C4AFF216324C4FFFFFF00FFFFFF0068C7
74FFA5DAAEFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA
90FF85C78BFF81C587FF7DC282FF4A9150FF256929C9FFFFFF00FFFFFF0068C7
74FF68C774FF65C371FF61BE6DFF5DB868FF58B162FF53A95CFF4DA156FF4799
4FFF419149FF5AA362FF559D5CFF2F7835D1FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00419149F73B8842DBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF0047994FBB41914906FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
Width = 26
Images = MainDataModule.ImageList
ImageIndex = 1
OnClick = VarInBtnClick
Spacing = 0
TabOrder = 1
TabOrder = 5
end
object VarOutBtn: TBitBtn
AnchorSideLeft.Control = Panel2
object VarOutBtn: TBitBtn[8]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarInBtn
AnchorSideTop.Side = asrBottom
Left = 197
Height = 28
Left = 151
Height = 26
Top = 50
Width = 28
Width = 26
BorderSpacing.Top = 4
Glyph.Data = {
36040000424D3604000000000000360000002800000010000000100000000100
2000000000000004000064000000640000000000000000000000FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF004DA1560647994FB8FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF0053A95CD94DA156F747994F38FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF005DB868CF71BE7BFF7AC183FF5BAA64FF47994FFF419149FF3B8842FF3580
3BFF2F7835FF2A702FFF256929FF216324FF1D5E20FFFFFFFF00FFFFFF0065C3
71C47BC886FF9CD5A5FF98D3A1FF94D09DFF90CE98FF8BCB93FF87C98EFF82C6
89FF7EC384FF7AC180FF76BE7CFF72BD78FF216324FFFFFFFF00FFFFFF0068C7
74C97FCC8AFFA2D8ABFF9ED6A7FF9AD4A3FF96D29FFF93CF9AFF8ECC95FF89CA
90FF85C78BFF81C587FF7DC282FF78C07EFF256929FFFFFFFF00FFFFFF00FFFF
FF0068C774D180CD8BFF7CC987FF5DB868FF58B162FF53A95CFF4DA156FF4799
4FFF419149FF3B8842FF35803BFF2F7835FF2A702FFFFFFFFF00FFFFFF00FFFF
FF00FFFFFF0068C774DB65C371F7FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF0068C7740668C774BBFFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFF
FF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00FFFFFF00
}
Images = MainDataModule.ImageList
ImageIndex = 0
OnClick = VarOutBtnClick
Spacing = 0
TabOrder = 2
TabOrder = 6
end
object AllBtn: TBitBtn
AnchorSideLeft.Control = Panel2
object AllBtn: TBitBtn[9]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarOutBtn
AnchorSideTop.Side = asrBottom
Left = 188
Left = 144
Height = 25
Top = 102
Width = 46
Width = 40
AutoSize = True
BorderSpacing.Top = 24
Caption = 'ALL'
Caption = 'All'
OnClick = AllBtnClick
Spacing = 0
TabOrder = 3
TabOrder = 7
end
object SelList: TListBox
object SelList: TListBox[10]
AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel2
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel2
AnchorSideBottom.Side = asrBottom
Left = 242
Height = 173
Left = 190
Height = 213
Top = 18
Width = 172
Width = 139
Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Left = 6
BorderSpacing.Top = 3
BorderSpacing.Right = 8
ItemHeight = 0
MultiSelect = True
OnDblClick = SelListDblClick
OnSelectionChange = VarListSelectionChange
TabOrder = 4
TabOrder = 8
end
object Label4: TLabel
object Label4: TLabel[11]
AnchorSideLeft.Control = SelList
AnchorSideTop.Control = Panel2
Left = 242
AnchorSideTop.Control = ParamsPanel
Left = 190
Height = 15
Top = 0
Width = 93
Caption = 'Selected Variables'
ParentColor = False
end
object Label1: TLabel[12]
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = NoClustersEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = NoClustersEdit
Left = 185
Height = 30
Top = 243
Width = 81
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'Number of '#13#10'desired clusters'
ParentColor = False
end
object Label2: TLabel[13]
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = ItersEdit
AnchorSideTop.Side = asrCenter
AnchorSideRight.Control = ItersEdit
Left = 181
Height = 15
Top = 286
Width = 85
Anchors = [akTop, akRight]
BorderSpacing.Right = 8
Caption = 'No. of Iterations'
ParentColor = False
end
object NoClustersEdit: TEdit[14]
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = GroupBox1
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
Left = 274
Height = 23
Top = 247
Width = 55
Alignment = taRightJustify
Anchors = [akTop, akRight]
BorderSpacing.Top = 8
TabOrder = 9
Text = 'NoClustersEdit'
end
object ItersEdit: TEdit[15]
AnchorSideLeft.Control = NoClustersEdit
AnchorSideTop.Control = NoClustersEdit
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
Left = 274
Height = 23
Top = 282
Width = 55
Alignment = taRightJustify
Anchors = [akTop, akLeft, akRight]
BorderSpacing.Top = 12
TabOrder = 10
Text = 'ItersEdit'
end
object GroupBox1: TGroupBox[16]
AnchorSideLeft.Control = ParamsPanel
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonBevel
Left = 0
Height = 93
Top = 239
Width = 159
Anchors = [akLeft, akBottom]
AutoSize = True
BorderSpacing.Right = 16
Caption = 'Analysis Optons'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
ChildSizing.VerticalSpacing = 2
ChildSizing.Layout = cclLeftToRightThenTopToBottom
ClientHeight = 73
ClientWidth = 155
TabOrder = 11
object StandardizeChk: TCheckBox
Left = 12
Height = 19
Top = 6
Width = 131
Caption = 'Standardize Variables'
OnChange = StandardizeChkChange
TabOrder = 0
end
object ReplaceChk: TCheckBox
Left = 12
Height = 19
Top = 27
Width = 131
Caption = 'Replace Grid Values'
Enabled = False
TabOrder = 1
end
object DescriptiveChk: TCheckBox
Left = 12
Height = 19
Top = 48
Width = 131
Caption = 'Descriptive Statistics'
Enabled = False
TabOrder = 2
end
end
end
inherited ParamsSplitter: TSplitter
Left = 341
Height = 389
end
object Panel1: TPanel[2]
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = Owner
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ButtonBevel
Left = 0
Height = 0
Top = 340
Width = 657
Anchors = [akLeft, akRight, akBottom]
AutoSize = True
BevelOuter = bvNone
TabOrder = 0
end
end

View File

@ -8,28 +8,21 @@ unit KMeansUnit;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, Buttons, ExtCtrls,
MainUnit, Globals, DataProcs, OutputUnit, ContextHelpUnit;
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls,
MainUnit, Globals, BasicStatsReportFormUnit;
type
{ TKMeansFrm }
{ TKMeansForm }
TKMeansFrm = class(TForm)
Bevel1: TBevel;
DescChkBox: TCheckBox;
HelpBtn: TButton;
TKMeansForm = class(TBasicStatsReportForm)
DescriptiveChk: TCheckBox;
Panel1: TPanel;
Panel2: TPanel;
VarInBtn: TBitBtn;
VarOutBtn: TBitBtn;
AllBtn: TBitBtn;
ResetBtn: TButton;
ComputeBtn: TButton;
CloseBtn: TButton;
StdChkBox: TCheckBox;
RepChkBox: TCheckBox;
StandardizeChk: TCheckBox;
ReplaceChk: TCheckBox;
GroupBox1: TGroupBox;
ItersEdit: TEdit;
Label2: TLabel;
@ -40,25 +33,21 @@ type
NoClustersEdit: TEdit;
Label1: TLabel;
procedure AllBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure SelListDblClick(Sender: TObject);
procedure StandardizeChkChange(Sender: TObject);
procedure VarInBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
procedure VarOutBtnClick(Sender: TObject);
private
{ private declarations }
FAutoSized: Boolean;
procedure KMNS(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec;
VAR IC2 : IntDyneVec; VAR NC : IntDyneVec;
VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec;
VAR NCP : IntDyneVec; VAR D : DblDyneVec;
VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec;
ITER : integer; VAR WSS : DblDyneVec; IFAULT : integer);
ITER : integer; VAR WSS : DblDyneVec; out IFAULT : integer);
procedure OPTRA(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer;
VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec;
@ -73,117 +62,57 @@ type
VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec;
VAR D : DblDyneVec; VAR ITRAN : IntDyneVec;
INDX : integer);
procedure UpdateBtnStates;
protected
procedure AdjustConstraints; override;
procedure Compute; override;
procedure UpdateBtnStates; override;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
public
{ public declarations }
constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end;
var
KMeansFrm: TKMeansFrm;
KMeansForm: TKMeansForm;
implementation
{$R *.lfm}
uses
Math,
Utils, MatrixUnit;
Utils, GridProcs, MatrixUnit;
{ TKMeansFrm }
procedure TKMeansFrm.ResetBtnClick(Sender: TObject);
var
i: integer;
{ TKMeansForm }
constructor TKMeansForm.Create(AOwner: TComponent);
begin
VarList.Clear;
SelList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
RepChkBox.Checked := false;
StdChkBox.Checked := true;
DescChkBox.Checked := false;
NoClustersEdit.Text := '';
ItersEdit.Text := '100';
UpdateBtnStates;
inherited;
end;
procedure TKMeansFrm.VarInBtnClick(Sender: TObject);
var
i: integer;
procedure TKMeansForm.AdjustConstraints;
begin
i := 0;
while i < VarList.Items.Count do
begin
if VarList.Selected[i] then
begin
SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
inherited;
ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height +
VarList.BorderSpacing.Bottom + GroupBox1.Height +
ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
ParamsPanel.Constraints.MinWidth := Max(
4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
GroupBox1.Width + GroupBox1.BorderSpacing.Right +
Max(Label1.Width, Label2.Width) + Label1.BorderSpacing.Right +
NoClustersEdit.Width
);
end;
procedure TKMeansFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TKMeansFrm.VarOutBtnClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while i < SelList.Items.Count do
begin
if SelList.Selected[i] then
begin
VarList.Items.Add(SelList.Items[i]);
SelList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TKMeansFrm.FormActivate(Sender: TObject);
var
w: Integer;
begin
if FAutoSized then
exit;
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;
FAutoSized := true;
end;
procedure TKMeansFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
end;
procedure TKMeansFrm.FormShow(Sender: TObject);
begin
ResetBtnClick(self);
end;
procedure TKMeansFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).Tag);
end;
procedure TKMeansFrm.AllBtnClick(Sender: TObject);
procedure TKMeansForm.AllBtnClick(Sender: TObject);
var
index: integer;
cellstring: string;
@ -197,59 +126,38 @@ begin
UpdateBtnStates;
end;
procedure TKMeansFrm.ComputeBtnClick(Sender: TObject);
VAR
i, j, L, Ncols, N, M, K,IFAULT, ITER, col : integer;
center: integer;
IC1, IC2, NC, NCP, ITRAN, LIVE, ColSelected : IntDyneVec;
A, C : DblDyneMat;
D, AN1, AN2, WSS: DblDyneVec;
cellstring: string;
outline : string;
varlabels, rowlabels : StrDyneVec;
Mean, stddev : double;
lReport: TStrings;
procedure TKMeansForm.Compute;
var
i, j, L, Ncols, N, M, K,IFAULT, ITER, col : integer;
center: integer;
IC1: IntDyneVec = nil;
IC2: IntDyneVec = nil;
NC: IntDyneVec = nil;
NCP: IntDyneVec = nil;
ITRAN: IntDyneVec = nil;
LIVE: IntDyneVec = nil;
ColSelected: IntDyneVec = nil;
A: DblDyneMat = nil;
C: DblDyneMat = nil;
D: DblDyneVec = nil;
AN1: DblDyneVec = nil;
AN2: DblDyneVec = nil;
WSS: DblDyneVec = nil;
varlabels: StrDyneVec = nil;
rowlabels: StrDyneVec = nil;
Mean, stddev : double;
outline: string;
lReport: TStrings;
begin
Ncols := SelList.Items.Count;
if (Ncols <= 0) then
begin
MessageDlg('No variables selected to cluster.', mtError, [mbOK], 0);
exit;
end;
if NoClustersEdit.Text = '' then
begin
NoClustersEdit.SetFocus;
MessageDlg('You must enter the desired number of clusters.', mtError, [mbOK], 0);
exit;
end;
if not TryStrToInt(NoClustersEdit.Text, K) or (K <= 0) then
begin
NoClustersEdit.SetFocus;
MessageDlg('You must enter the desired number of clusters as a positive value.', mtError, [mbOK], 0);
exit;
end;
if ItersEdit.Text = '' then
begin
ItersEdit.SetFocus;
MessageDlg('This field cannot be empty.', mtError, [mbOK], 0);
exit;
end;
if not TryStrToInt(ItersEdit.Text, ITER) or (ITER <= 0) then
begin
ItersEdit.SetFocus;
MessageDlg('Invalid input.', mtError, [mbOK], 0);
exit;
end;
N := Ncols;
M := NoCases;
K := StrToInt(NoClustersEdit.Text);
ITER := StrToInt(ItersEdit.Text);
IFAULT := 0;
SetLength(varlabels,Ncols);
SetLength(rowlabels,NoCases);
SetLength(ColSelected,Ncols);
N := NCols;
M := NoCases;
SetLength(A,M+1,N+1);
SetLength(C,K+1,N+1);
SetLength(D,M+1);
@ -263,52 +171,26 @@ begin
SetLength(ITRAN,K+1);
SetLength(LIVE,K+1);
// initialize arrays
for i := 1 to K do
// Get labels and columns of selected variables
SetLength(ColSelected, nCols);
SetLength(varlabels, nCols);
for i := 0 to nCols - 1 do
begin
AN1[i] := 0.0;
AN2[i] := 0.0;
WSS[i] := 0.0;
NC[i] := 0;
NCP[i] := 0;
ITRAN[i] := 0;
LIVE[i] := 0;
for j := 1 to N do C[i,j] := 0.0;
end;
for i := 1 to M do
begin
IC1[i] := 0;
IC2[i] := 0;
D[i] := 0.0;
end;
//Get labels and columns of selected variables
for i := 0 to Ncols - 1 do
begin
cellstring := SelList.Items.Strings[i];
for j := 0 to NoVariables - 1 do
begin
if (cellstring = OS3MainFrm.DataGrid.Cells[j+1,0]) then
begin
varlabels[i] := cellstring;
ColSelected[i] := j+1;
end;
end;
varLabels[i] := SelList.Items[i];
ColSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, varLabels[i]);
end;
// Get labels of rows
for i := 0 to NoCases - 1 do
rowlabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1];
SetLength(rowlabels, noCases);
for i := 0 to noCases - 1 do
rowlabels[i] := OS3MainFrm.DataGrid.Cells[0, i+1];
// read the data
// Read the data
for i := 1 to M do
begin
if not GoodRecord(i, N, ColSelected) then continue;
if not GoodRecord(OS3MainFrm.DataGrid, i, ColSelected) then continue;
for j := 1 to N do
begin
col := ColSelected[j-1];
A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]);
end;
A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[ColSelected[j-1],i]);
end;
lReport := TStringList.Create;
@ -317,12 +199,20 @@ begin
lReport.Add('Adapted from AS 136 APPL. STATIST. (1979) VOL.28, NO.1');
lReport.Add('');
lReport.Add('File: %s', [OS3MainFrm.FileNameEdit.Text]);
lReport.Add('No. Cases: %d, No. Variables: %d, No. Clusters: %d',[M, N, K]);
lReport.Add('No. Cases: %8d', [M]);
lReport.Add('No. Variables: %8d', [N]);
lReport.Add('No. Clusters: %8d', [K]);
lReport.Add('');
// transform to z scores if needed
if StdChkBox.Checked then
if StandardizeChk.Checked then
begin
if DescriptiveChk.Checked then
begin
lReport.Add('DESCRIPTIVE STATISTICS');
lReport.Add(' Variable Mean StdDev ');
lReport.Add('------------ ------------ ------------');
end;
for j := 1 to N do
begin
Mean := 0.0;
@ -332,18 +222,19 @@ begin
Mean := Mean + A[i,j];
stddev := stddev + sqr(A[i,j]);
end;
stddev := stddev - Mean * Mean / M;
stddev := stddev / (M - 1);
stddev := (stddev - sqr(Mean) / M) / (M - 1);
Mean := Mean / M;
if DescChkBox.Checked then
lReport.Add('Mean: %8.3f, Std.Dev.: %8.3f for %s', [Mean, stddev, varlabels[j-1]]);
if DescriptiveChk.Checked then
lReport.Add('%12s %12.3f %12.3f', [varLabels[j-1], mean, stdDev]);
for i := 1 to M do
begin
A[i,j] := (A[i,j] - Mean) / stddev;
if RepChkBox.Checked then
if ReplaceChk.Checked then
begin
col := ColSelected[j-1];
OS3MainFrm.DataGrid.Cells[col,i] := Format('%8.5f', [A[i,j]]);
OS3MainFrm.DataGrid.Cells[col,i] := Format('%.5f', [A[i,j]]);
end;
end;
end;
@ -390,8 +281,8 @@ begin
lReport.Add('');
lReport.Add('AVERAGE VARIABLE VALUES BY CLUSTER');
lReport.Add(' VARIABLES');
outline := 'CLUSTER';
lReport.Add(' Variables');
outline := 'Cluster';
for j := 1 to N do
outline := outline + Format(' %3d ',[j]);
lReport.Add(outline);
@ -408,7 +299,7 @@ begin
for i := 1 to K do
lReport.Add('Cluster %d: %6.3f', [i, WSS[i]]);
DisplayReport(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
@ -430,13 +321,13 @@ begin
end;
end;
procedure TKMeansFrm.KMNS(VAR A : DblDyneMat; M, N : integer;
procedure TKMeansForm.KMNS(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec;
VAR IC2 : IntDyneVec; VAR NC : IntDyneVec;
VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec;
VAR NCP : IntDyneVec; VAR D : DblDyneVec;
VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec;
ITER : integer; VAR WSS : DblDyneVec; IFAULT : integer);
ITER : integer; VAR WSS : DblDyneVec; out IFAULT : integer);
const
BIG = 1.0E30;
ZERO = 0.0;
@ -628,7 +519,7 @@ cont150:
end;
procedure TKMeansFrm.OPTRA(VAR A : DblDyneMat; M, N : integer;
procedure TKMeansForm.OPTRA(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer;
VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec;
VAR NC : IntDyneVec; VAR AN1 : DblDyneVec;
@ -777,48 +668,48 @@ cont90:
end; // 110 CONTINUE
end;
procedure TKMeansFrm.QTRAN(VAR A : DblDyneMat; M, N : integer;
{ SUBROUTINE QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ITRAN, INDX)
ALGORITHM AS 136.2 APPL. STATIST. (1979) VOL.28, NO.1
This is the quick transfer stage.
IC1(I) is the cluster which point I belongs to.
IC2(I) is the cluster which point I is most likely to be transferred to.
For each point I, IC1(I) & IC2(I) are switched, if necessary, to
reduce within-cluster sum of squares. The cluster centres are
updated after each step.
INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K)
REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), ZERO, ONE
Define BIG to be a very large positive number
DATA BIG /1.0E30/, ZERO /0.0/, ONE /1.0/
In the optimal transfer stage, NCP(L) indicates the step at which
cluster L is last updated. In the quick transfer stage, NCP(L)
is equal to the step at which cluster L is last updated plus M. }
procedure TKMeansForm.QTRAN(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer;
VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec;
VAR NC : IntDyneVec; VAR AN1 : DblDyneVec;
VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec;
VAR D : DblDyneVec; VAR ITRAN : IntDyneVec;
INDX : integer);
VAR
BIG, ZERO, ONE, DA, DB, DE, DD, R2, AL1, ALW, AL2, ALT : double;
I, J, ICOUN, ISTEP, L1, L2 : integer;
label cont10, cont30, cont60;
const
BIG = 1E304;
ZERO = 0.0;
ONE = 1.0;
var
DA, DB, DE, DD, R2, AL1, ALW, AL2, ALT: double;
I, J, ICOUN, ISTEP, L1, L2: integer;
label
cont10, cont30, cont60;
begin
// SUBROUTINE QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D,
// * ITRAN, INDX)
//
// ALGORITHM AS 136.2 APPL. STATIST. (1979) VOL.28, NO.1
//
// This is the quick transfer stage.
// IC1(I) is the cluster which point I belongs to.
// IC2(I) is the cluster which point I is most likely to be
// transferred to.
// For each point I, IC1(I) & IC2(I) are switched, if necessary, to
// reduce within-cluster sum of squares. The cluster centres are
// updated after each step.
//
// INTEGER IC1(M), IC2(M), NC(K), NCP(K), ITRAN(K)
// REAL A(M,N), D(M), C(K,N), AN1(K), AN2(K), ZERO, ONE
//
// Define BIG to be a very large positive number
//
// DATA BIG /1.0E30/, ZERO /0.0/, ONE /1.0/
//
// In the optimal transfer stage, NCP(L) indicates the step at which
// cluster L is last updated. In the quick transfer stage, NCP(L)
// is equal to the step at which cluster L is last updated plus M.
//
BIG := 1.0e30;
ZERO := 0.0;
ONE := 1.0;
ICOUN := 0;
ISTEP := 0;
ICOUN := 0;
ISTEP := 0;
cont10:
for I := 1 to M do
begin
@ -896,15 +787,156 @@ cont60:
goto cont10;
end;
procedure TKMeansFrm.UpdateBtnStates;
procedure TKMeansForm.Reset;
var
i: integer;
begin
inherited;
SelList.Clear;
VarList.Clear;
for i := 1 to NoVariables do
VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
ReplaceChk.Checked := false;
StandardizeChk.Checked := true;
DescriptiveChk.Checked := false;
NoClustersEdit.Clear;
ItersEdit.Text := '100';
UpdateBtnStates;
end;
procedure TKMeansForm.SelListDblClick(Sender: TObject);
var
index: Integer;
begin
index := SelList.ItemIndex;
if index > -1 then
begin
VarList.Items.Add(SelList.Items[index]);
SelList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TKMeansForm.StandardizeChkChange(Sender: TObject);
begin
ReplaceChk.Enabled := StandardizeChk.Checked;
DescriptiveChk.Enabled := StandardizeChk.Checked;
end;
procedure TKMeansForm.UpdateBtnStates;
begin
inherited;
VarInBtn.Enabled := AnySelected(VarList);
VarOutBtn.Enabled := AnySelected(SelList);
AllBtn.Enabled := VarList.Items.Count > 0;
end;
initialization
{$I kmeansunit.lrs}
function TKMeansForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean;
var
n: Integer;
begin
Result := false;
if SelList.Items.Count <= 0 then
begin
AMsg := 'No variables selected to cluster.';
AControl := VarList;
exit;
end;
if NoClustersEdit.Text = '' then
begin
AControl := NoClustersEdit;
AMsg := 'You must enter the desired number of clusters.';
exit;
end;
if not TryStrToInt(NoClustersEdit.Text, n) or (n <= 0) then
begin
AControl := NoClustersEdit;
AMsg := 'You must enter the desired number of clusters as a positive value.';
exit;
end;
if ItersEdit.Text = '' then
begin
AControl := ItersEdit;
AMsg := 'This field cannot be empty.';
exit;
end;
if not TryStrToInt(ItersEdit.Text, n) or (n <= 0) then
begin
AControl := ItersEdit;
AMsg := 'Positive number required.';
exit;
end;
Result := true;
end;
procedure TKMeansForm.VarInBtnClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while i < VarList.Items.Count do
begin
if VarList.Selected[i] then
begin
SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
procedure TKMeansForm.VarListDblClick(Sender: TObject);
var
index: Integer;
begin
index := VarList.ItemIndex;
if index > -1 then
begin
SelList.Items.Add(VarList.Items[index]);
VarList.Items.Delete(index);
UpdateBtnStates;
end;
end;
procedure TKMeansForm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TKMeansForm.VarOutBtnClick(Sender: TObject);
var
i: integer;
begin
i := 0;
while i < SelList.Items.Count do
begin
if SelList.Selected[i] then
begin
VarList.Items.Add(SelList.Items[i]);
SelList.Items.Delete(i);
i := 0;
end else
i := i + 1;
end;
UpdateBtnStates;
end;
end.

View File

@ -2160,9 +2160,9 @@ end;
// Menu "Analysis" > "Multivariate" > "K Means Clustering"
procedure TOS3MainFrm.mnuAnalysisMulti_KMeansClick(Sender: TObject);
begin
if KMeansFrm = nil then
Application.CreateForm(TKMeansFrm, KMeansFrm);
kmeansfrm.ShowModal;
if KMeansForm = nil then
Application.CreateForm(TKMeansForm, KMeansForm);
KMeansForm.Show;
end;
// Menu "Analysis" > "Multivariate" > "Single Link Clustering"