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

LazStats: Inherit KMeansUnit from BasicStatisReoortUnit. Some refactoring.

Browse Source 
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
Download Patch File Download Diff File Expand all files Collapse all files

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

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

540
applications/lazstats/source/forms/analysis/multivariate/kmeansunit.lfm
View File

@@ -1,243 +1,43 @@
object KMeansFrm: TKMeansFrm inherited KMeansForm: TKMeansForm
Left = 664 Left = 664
Height = 349 Height = 389
Top = 318 Top = 318
Width = 422 Width = 657
HelpType = htKeyword HelpType = htKeyword
HelpKeyword = 'html/KMeansClustering.htm' HelpKeyword = 'html/KMeansClustering.htm'
AutoSize = True
Caption = 'k Means Clustering ' Caption = 'k Means Clustering '
ClientHeight = 349 ClientHeight = 389
ClientWidth = 422 ClientWidth = 657
OnActivate = FormActivate inherited ParamsPanel: TPanel
OnCreate = FormCreate Height = 373
OnShow = FormShow Width = 329
Position = poMainFormCenter ClientHeight = 373
LCLVersion = '2.1.0.0' ClientWidth = 329
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
TabOrder = 1 TabOrder = 1
object Label1: TLabel inherited CloseBtn: TButton
AnchorSideLeft.Control = Panel1 Left = 274
AnchorSideTop.Control = NoClustersEdit Top = 348
AnchorSideTop.Side = asrCenter
Left = 8
Height = 15
Top = 12
Width = 120
BorderSpacing.Left = 8
Caption = 'No. of Desired Clusters'
ParentColor = False
end end
object Label2: TLabel inherited ComputeBtn: TButton
AnchorSideTop.Control = ItersEdit Left = 190
AnchorSideTop.Side = asrCenter Top = 348
AnchorSideRight.Control = Label1
AnchorSideRight.Side = asrBottom
Left = 43
Height = 15
Top = 39
Width = 85
Anchors = [akTop, akRight]
Caption = 'No. of Iterations'
ParentColor = False
end end
object NoClustersEdit: TEdit inherited ResetBtn: TButton
AnchorSideLeft.Control = Label1 Left = 128
AnchorSideLeft.Side = asrBottom Top = 348
AnchorSideTop.Control = Panel1
Left = 136
Height = 23
Top = 8
Width = 54
Alignment = taRightJustify
BorderSpacing.Left = 8
BorderSpacing.Top = 8
TabOrder = 0
Text = 'NoClustersEdit'
end end
object ItersEdit: TEdit inherited HelpBtn: TButton
AnchorSideLeft.Control = NoClustersEdit Tag = 129
AnchorSideTop.Control = NoClustersEdit Left = 69
AnchorSideTop.Side = asrBottom Top = 348
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'
end end
object GroupBox1: TGroupBox inherited ButtonBevel: TBevel
AnchorSideLeft.Control = NoClustersEdit Top = 332
AnchorSideLeft.Side = asrBottom Width = 329
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
end end
end object Label3: TLabel[5]
object Panel2: TPanel AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Control = Owner AnchorSideTop.Control = ParamsPanel
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
Left = 8 Left = 8
Height = 15 Height = 15
Top = 0 Top = 0
@@ -246,171 +46,225 @@ object KMeansFrm: TKMeansFrm
Caption = 'Available Variables' Caption = 'Available Variables'
ParentColor = False ParentColor = False
end end
object VarList: TListBox object VarList: TListBox[6]
AnchorSideLeft.Control = Panel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = Label3 AnchorSideTop.Control = Label3
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = AllBtn AnchorSideRight.Control = AllBtn
AnchorSideBottom.Control = Panel2
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 8 Left = 0
Height = 173 Height = 213
Top = 18 Top = 18
Width = 172 Width = 138
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8
BorderSpacing.Top = 3 BorderSpacing.Top = 3
BorderSpacing.Right = 8 BorderSpacing.Right = 6
BorderSpacing.Bottom = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnDblClick = VarListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 4
end end
object VarInBtn: TBitBtn object VarInBtn: TBitBtn[7]
AnchorSideLeft.Control = Panel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarList Left = 151
Left = 197 Height = 26
Height = 28
Top = 18 Top = 18
Width = 28 Width = 26
Glyph.Data = { Images = MainDataModule.ImageList
36040000424D3604000000000000360000002800000010000000100000000100 ImageIndex = 1
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
}
OnClick = VarInBtnClick OnClick = VarInBtnClick
Spacing = 0 Spacing = 0
TabOrder = 1 TabOrder = 5
end end
object VarOutBtn: TBitBtn object VarOutBtn: TBitBtn[8]
AnchorSideLeft.Control = Panel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarInBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 197 Left = 151
Height = 28 Height = 26
Top = 50 Top = 50
Width = 28 Width = 26
BorderSpacing.Top = 4 BorderSpacing.Top = 4
Glyph.Data = { Images = MainDataModule.ImageList
36040000424D3604000000000000360000002800000010000000100000000100 ImageIndex = 0
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
}
OnClick = VarOutBtnClick OnClick = VarOutBtnClick
Spacing = 0 Spacing = 0
TabOrder = 2 TabOrder = 6
end end
object AllBtn: TBitBtn object AllBtn: TBitBtn[9]
AnchorSideLeft.Control = Panel2 AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = VarOutBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 188 Left = 144
Height = 25 Height = 25
Top = 102 Top = 102
Width = 46 Width = 40
AutoSize = True AutoSize = True
BorderSpacing.Top = 24 BorderSpacing.Top = 24
Caption = 'ALL' Caption = 'All'
OnClick = AllBtnClick OnClick = AllBtnClick
Spacing = 0 Spacing = 0
TabOrder = 3 TabOrder = 7
end end
object SelList: TListBox object SelList: TListBox[10]
AnchorSideLeft.Control = AllBtn AnchorSideLeft.Control = AllBtn
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Label4 AnchorSideTop.Control = Label4
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Panel2 AnchorSideRight.Control = ParamsPanel
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Panel2
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 242 Left = 190
Height = 173 Height = 213
Top = 18 Top = 18
Width = 172 Width = 139
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 8 BorderSpacing.Left = 6
BorderSpacing.Top = 3 BorderSpacing.Top = 3
BorderSpacing.Right = 8
ItemHeight = 0 ItemHeight = 0
MultiSelect = True MultiSelect = True
OnDblClick = SelListDblClick
OnSelectionChange = VarListSelectionChange OnSelectionChange = VarListSelectionChange
TabOrder = 4 TabOrder = 8
end end
object Label4: TLabel object Label4: TLabel[11]
AnchorSideLeft.Control = SelList AnchorSideLeft.Control = SelList
AnchorSideTop.Control = Panel2 AnchorSideTop.Control = ParamsPanel
Left = 242 Left = 190
Height = 15 Height = 15
Top = 0 Top = 0
Width = 93 Width = 93
Caption = 'Selected Variables' Caption = 'Selected Variables'
ParentColor = False ParentColor = False
end 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
end end

538
applications/lazstats/source/forms/analysis/multivariate/kmeansunit.pas
View File

@@ -8,28 +8,21 @@ unit KMeansUnit;
interface interface
uses uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons, ExtCtrls,
StdCtrls, Buttons, ExtCtrls, MainUnit, Globals, BasicStatsReportFormUnit;
MainUnit, Globals, DataProcs, OutputUnit, ContextHelpUnit;
type type
{ TKMeansFrm } { TKMeansForm }
TKMeansFrm = class(TForm) TKMeansForm = class(TBasicStatsReportForm)
Bevel1: TBevel; DescriptiveChk: TCheckBox;
DescChkBox: TCheckBox;
HelpBtn: TButton;
Panel1: TPanel; Panel1: TPanel;
Panel2: TPanel;
VarInBtn: TBitBtn; VarInBtn: TBitBtn;
VarOutBtn: TBitBtn; VarOutBtn: TBitBtn;
AllBtn: TBitBtn; AllBtn: TBitBtn;
ResetBtn: TButton; StandardizeChk: TCheckBox;
ComputeBtn: TButton; ReplaceChk: TCheckBox;
CloseBtn: TButton;
StdChkBox: TCheckBox;
RepChkBox: TCheckBox;
GroupBox1: TGroupBox; GroupBox1: TGroupBox;
ItersEdit: TEdit; ItersEdit: TEdit;
Label2: TLabel; Label2: TLabel;
@@ -40,25 +33,21 @@ type
NoClustersEdit: TEdit; NoClustersEdit: TEdit;
Label1: TLabel; Label1: TLabel;
procedure AllBtnClick(Sender: TObject); procedure AllBtnClick(Sender: TObject);
procedure ComputeBtnClick(Sender: TObject); procedure SelListDblClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure StandardizeChkChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
procedure ResetBtnClick(Sender: TObject);
procedure VarInBtnClick(Sender: TObject); procedure VarInBtnClick(Sender: TObject);
procedure VarListDblClick(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean);
procedure VarOutBtnClick(Sender: TObject); procedure VarOutBtnClick(Sender: TObject);
private private
{ private declarations }
FAutoSized: Boolean;
procedure KMNS(VAR A : DblDyneMat; M, N : integer; procedure KMNS(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec; VAR C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec;
VAR IC2 : IntDyneVec; VAR NC : IntDyneVec; VAR IC2 : IntDyneVec; VAR NC : IntDyneVec;
VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec; VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec;
VAR NCP : IntDyneVec; VAR D : DblDyneVec; VAR NCP : IntDyneVec; VAR D : DblDyneVec;
VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec; 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; procedure OPTRA(VAR A : DblDyneMat; M, N : integer;
VAR C : DblDyneMat; K : integer; VAR C : DblDyneMat; K : integer;
VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec;
@@ -73,117 +62,57 @@ type
VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec; VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec;
VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; VAR D : DblDyneVec; VAR ITRAN : IntDyneVec;
INDX : integer); 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
{ public declarations } constructor Create(AOwner: TComponent); override;
procedure Reset; override;
end; end;
var var
KMeansFrm: TKMeansFrm; KMeansForm: TKMeansForm;
implementation implementation
{$R *.lfm}
uses uses
Math, Math,
Utils, MatrixUnit; Utils, GridProcs, MatrixUnit;
{ TKMeansFrm }
procedure TKMeansFrm.ResetBtnClick(Sender: TObject); { TKMeansForm }
var
i: integer; constructor TKMeansForm.Create(AOwner: TComponent);
begin begin
VarList.Clear; inherited;
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;
end; end;
procedure TKMeansFrm.VarInBtnClick(Sender: TObject);
var procedure TKMeansForm.AdjustConstraints;
i: integer;
begin begin
i := 0; inherited;
while i < VarList.Items.Count do
begin ParamsPanel.Constraints.MinHeight := AllBtn.Top + AllBtn.Height +
if VarList.Selected[i] then VarList.BorderSpacing.Bottom + GroupBox1.Height +
begin ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height;
SelList.Items.Add(VarList.Items[i]);
VarList.Items.Delete(i); ParamsPanel.Constraints.MinWidth := Max(
i := 0; 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left,
end else GroupBox1.Width + GroupBox1.BorderSpacing.Right +
i := i + 1; Max(Label1.Width, Label2.Width) + Label1.BorderSpacing.Right +
end; NoClustersEdit.Width
UpdateBtnStates; );
end; end;
procedure TKMeansFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TKMeansFrm.VarOutBtnClick(Sender: TObject); procedure TKMeansForm.AllBtnClick(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);
var var
index: integer; index: integer;
cellstring: string; cellstring: string;
@@ -197,59 +126,38 @@ begin
UpdateBtnStates; UpdateBtnStates;
end; end;
procedure TKMeansFrm.ComputeBtnClick(Sender: TObject);
VAR procedure TKMeansForm.Compute;
i, j, L, Ncols, N, M, K,IFAULT, ITER, col : integer; var
center: integer; i, j, L, Ncols, N, M, K,IFAULT, ITER, col : integer;
IC1, IC2, NC, NCP, ITRAN, LIVE, ColSelected : IntDyneVec; center: integer;
A, C : DblDyneMat; IC1: IntDyneVec = nil;
D, AN1, AN2, WSS: DblDyneVec; IC2: IntDyneVec = nil;
cellstring: string; NC: IntDyneVec = nil;
outline : string; NCP: IntDyneVec = nil;
varlabels, rowlabels : StrDyneVec; ITRAN: IntDyneVec = nil;
Mean, stddev : double; LIVE: IntDyneVec = nil;
lReport: TStrings; 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 begin
Ncols := SelList.Items.Count; Ncols := SelList.Items.Count;
if (Ncols <= 0) then K := StrToInt(NoClustersEdit.Text);
begin ITER := StrToInt(ItersEdit.Text);
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;
IFAULT := 0; IFAULT := 0;
SetLength(varlabels,Ncols); N := NCols;
SetLength(rowlabels,NoCases); M := NoCases;
SetLength(ColSelected,Ncols);
SetLength(A,M+1,N+1); SetLength(A,M+1,N+1);
SetLength(C,K+1,N+1); SetLength(C,K+1,N+1);
SetLength(D,M+1); SetLength(D,M+1);
@@ -263,52 +171,26 @@ begin
SetLength(ITRAN,K+1); SetLength(ITRAN,K+1);
SetLength(LIVE,K+1); SetLength(LIVE,K+1);
// initialize arrays // Get labels and columns of selected variables
for i := 1 to K do SetLength(ColSelected, nCols);
SetLength(varlabels, nCols);
for i := 0 to nCols - 1 do
begin begin
AN1[i] := 0.0; varLabels[i] := SelList.Items[i];
AN2[i] := 0.0; ColSelected[i] := GetVariableIndex(OS3MainFrm.DataGrid, varLabels[i]);
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;
end; end;
// Get labels of rows // Get labels of rows
for i := 0 to NoCases - 1 do SetLength(rowlabels, noCases);
rowlabels[i] := OS3MainFrm.DataGrid.Cells[0,i+1]; 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 for i := 1 to M do
begin begin
if not GoodRecord(i, N, ColSelected) then continue; if not GoodRecord(OS3MainFrm.DataGrid, i, ColSelected) then continue;
for j := 1 to N do for j := 1 to N do
begin A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[ColSelected[j-1],i]);
col := ColSelected[j-1];
A[i,j] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i]);
end;
end; end;
lReport := TStringList.Create; lReport := TStringList.Create;
@@ -317,12 +199,20 @@ begin
lReport.Add('Adapted from AS 136 APPL. STATIST. (1979) VOL.28, NO.1'); lReport.Add('Adapted from AS 136 APPL. STATIST. (1979) VOL.28, NO.1');
lReport.Add(''); lReport.Add('');
lReport.Add('File: %s', [OS3MainFrm.FileNameEdit.Text]); 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(''); lReport.Add('');
// transform to z scores if needed // transform to z scores if needed
if StdChkBox.Checked then if StandardizeChk.Checked then
begin begin
if DescriptiveChk.Checked then
begin
lReport.Add('DESCRIPTIVE STATISTICS');
lReport.Add(' Variable Mean StdDev ');
lReport.Add('------------ ------------ ------------');
end;
for j := 1 to N do for j := 1 to N do
begin begin
Mean := 0.0; Mean := 0.0;
@@ -332,18 +222,19 @@ begin
Mean := Mean + A[i,j]; Mean := Mean + A[i,j];
stddev := stddev + sqr(A[i,j]); stddev := stddev + sqr(A[i,j]);
end; end;
stddev := stddev - Mean * Mean / M; stddev := (stddev - sqr(Mean) / M) / (M - 1);
stddev := stddev / (M - 1);
Mean := Mean / M; 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 for i := 1 to M do
begin begin
A[i,j] := (A[i,j] - Mean) / stddev; A[i,j] := (A[i,j] - Mean) / stddev;
if RepChkBox.Checked then if ReplaceChk.Checked then
begin begin
col := ColSelected[j-1]; 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; end;
end; end;
@@ -390,8 +281,8 @@ begin
lReport.Add(''); lReport.Add('');
lReport.Add('AVERAGE VARIABLE VALUES BY CLUSTER'); lReport.Add('AVERAGE VARIABLE VALUES BY CLUSTER');
lReport.Add(' VARIABLES'); lReport.Add(' Variables');
outline := 'CLUSTER'; outline := 'Cluster';
for j := 1 to N do for j := 1 to N do
outline := outline + Format(' %3d ',[j]); outline := outline + Format(' %3d ',[j]);
lReport.Add(outline); lReport.Add(outline);
@@ -408,7 +299,7 @@ begin
for i := 1 to K do for i := 1 to K do
lReport.Add('Cluster %d: %6.3f', [i, WSS[i]]); lReport.Add('Cluster %d: %6.3f', [i, WSS[i]]);
DisplayReport(lReport); FReportFrame.DisplayReport(lReport);
finally finally
lReport.Free; lReport.Free;
@@ -430,13 +321,13 @@ begin
end; end;
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 C : DblDyneMat; K : integer; VAR IC1 : IntDyneVec;
VAR IC2 : IntDyneVec; VAR NC : IntDyneVec; VAR IC2 : IntDyneVec; VAR NC : IntDyneVec;
VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec; VAR AN1 : DblDyneVec; VAR AN2 : DblDyneVec;
VAR NCP : IntDyneVec; VAR D : DblDyneVec; VAR NCP : IntDyneVec; VAR D : DblDyneVec;
VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec; VAR ITRAN : IntDyneVec; VAR LIVE : IntDyneVec;
ITER : integer; VAR WSS : DblDyneVec; IFAULT : integer); ITER : integer; VAR WSS : DblDyneVec; out IFAULT : integer);
const const
BIG = 1.0E30; BIG = 1.0E30;
ZERO = 0.0; ZERO = 0.0;
@@ -628,7 +519,7 @@ cont150:
end; 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 C : DblDyneMat; K : integer;
VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec;
VAR NC : IntDyneVec; VAR AN1 : DblDyneVec; VAR NC : IntDyneVec; VAR AN1 : DblDyneVec;
@@ -777,48 +668,48 @@ cont90:
end; // 110 CONTINUE end; // 110 CONTINUE
end; 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 C : DblDyneMat; K : integer;
VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec; VAR IC1 : IntDyneVec; VAR IC2 : IntDyneVec;
VAR NC : IntDyneVec; VAR AN1 : DblDyneVec; VAR NC : IntDyneVec; VAR AN1 : DblDyneVec;
VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec; VAR AN2 : DblDyneVec; VAR NCP : IntDyneVec;
VAR D : DblDyneVec; VAR ITRAN : IntDyneVec; VAR D : DblDyneVec; VAR ITRAN : IntDyneVec;
INDX : integer); INDX : integer);
VAR const
BIG, ZERO, ONE, DA, DB, DE, DD, R2, AL1, ALW, AL2, ALT : double; BIG = 1E304;
I, J, ICOUN, ISTEP, L1, L2 : integer; ZERO = 0.0;
label cont10, cont30, cont60; 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 begin
// SUBROUTINE QTRAN(A, M, N, C, K, IC1, IC2, NC, AN1, AN2, NCP, D, ICOUN := 0;
// * ITRAN, INDX) ISTEP := 0;
//
// 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;
cont10: cont10:
for I := 1 to M do for I := 1 to M do
begin begin
@@ -896,15 +787,156 @@ cont60:
goto cont10; goto cont10;
end; end;
procedure TKMeansFrm.UpdateBtnStates;
procedure TKMeansForm.Reset;
var
i: integer;
begin 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); VarInBtn.Enabled := AnySelected(VarList);
VarOutBtn.Enabled := AnySelected(SelList); VarOutBtn.Enabled := AnySelected(SelList);
AllBtn.Enabled := VarList.Items.Count > 0; AllBtn.Enabled := VarList.Items.Count > 0;
end; 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. end.

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

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