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

LazStats: Inherit AvgLinkUnit from BasicStatsReportFormUnit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7932 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-12-16 23:08:59 +00:00
parent ac7ba200e2
commit b6459daccb
4 changed files with 202 additions and 241 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -862,7 +862,7 @@
<Unit94>
<Filename Value="forms\analysis\multivariate\avglinkunit.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="AvgLinkFrm"/>
<ComponentName Value="AvgLinkForm"/>
<HasResources Value="True"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="AvgLinkUnit"/>

138
applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm
View File

@ -1,32 +1,55 @@
object AvgLinkFrm: TAvgLinkFrm
inherited AvgLinkForm: TAvgLinkForm
Left = 589
Height = 132
Top = 409
Width = 383
HelpType = htKeyword
HelpKeyword = 'html/AverageLinkClustering.htm'
AutoSize = True
BorderStyle = bsDialog
Caption = 'Average Linkage Hierarchical Clustering'
ClientHeight = 132
ClientWidth = 383
OnActivate = FormActivate
OnCreate = FormCreate
OnShow = FormShow
Position = poMainFormCenter
LCLVersion = '2.1.0.0'
object MatrixTypeGroup: TRadioGroup
AnchorSideLeft.Control = Owner
inherited ParamsPanel: TPanel
Height = 116
Width = 259
ClientHeight = 116
ClientWidth = 259
inherited CloseBtn: TButton
Left = 204
Top = 91
TabOrder = 4
end
inherited ComputeBtn: TButton
Left = 120
Top = 91
TabOrder = 3
end
inherited ResetBtn: TButton
Left = 58
Top = 91
Visible = False
end
inherited HelpBtn: TButton
Tag = 105
Left = -1
Top = 91
TabOrder = 1
end
inherited ButtonBevel: TBevel
Top = 75
Width = 259
end
object MatrixTypeGroup: TRadioGroup[5]
AnchorSideLeft.Control = ParamsPanel
AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = Owner
Left = 131
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrCenter
Left = 69
Height = 72
Top = 8
Top = 1
Width = 120
AutoFill = True
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
Caption = 'Matrix Type Is:'
ChildSizing.LeftRightSpacing = 12
ChildSizing.TopBottomSpacing = 6
@ -45,79 +68,20 @@ object AvgLinkFrm: TAvgLinkFrm
)
TabOrder = 0
end
object ComputeBtn: TButton
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Side = asrBottom
Left = 236
Height = 25
Top = 96
Width = 76
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Compute'
OnClick = ComputeBtnClick
TabOrder = 2
end
object CloseBtn: TButton
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Side = asrBottom
Left = 320
Height = 25
Top = 96
Width = 55
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Close'
ModalResult = 11
TabOrder = 3
end
object HelpBtn: TButton
Tag = 105
AnchorSideTop.Control = Bevel1
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Side = asrBottom
Left = 177
Height = 25
Top = 96
Width = 51
Anchors = [akTop, akRight]
AutoSize = True
BorderSpacing.Left = 8
BorderSpacing.Top = 8
BorderSpacing.Right = 8
BorderSpacing.Bottom = 8
Caption = 'Help'
OnClick = HelpBtnClick
TabOrder = 1
end
object Bevel1: TBevel
AnchorSideLeft.Control = Owner
AnchorSideTop.Control = MatrixTypeGroup
AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = CloseBtn
object Bevel1: TBevel[6]
AnchorSideLeft.Control = ParamsPanel
AnchorSideTop.Control = ParamsPanel
AnchorSideBottom.Control = ButtonBevel
Left = 0
Height = 8
Top = 80
Width = 383
Anchors = [akTop, akLeft, akRight]
Shape = bsBottomLine
Height = 75
Top = 0
Width = 18
Anchors = [akTop, akLeft, akBottom]
Shape = bsSpacer
end
end
inherited ParamsSplitter: TSplitter
Left = 271
Height = 132
end
end

233
applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas
View File

@ -11,130 +11,110 @@ unit AvgLinkUnit;
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics,
Dialogs, StdCtrls, ExtCtrls,
MainUnit, Globals, OutputUnit, ContextHelpUnit;
Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, ExtCtrls,
MainUnit, Globals, BasicStatsReportFormUnit;
type
{ TAvgLinkFrm }
{ TAvgLinkForm }
TAvgLinkFrm = class(TForm)
TAvgLinkForm = class(TBasicStatsReportForm)
Bevel1: TBevel;
ComputeBtn: TButton;
HelpBtn: TButton;
CloseBtn: TButton;
MatrixTypeGroup: TRadioGroup;
procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure HelpBtnClick(Sender: TObject);
private
{ private declarations }
procedure PreTree(NN, CRIT: integer; LST: IntDyneVec; KLUS: IntDyneMat; AReport: TStrings);
procedure TreePlot(Clusters: IntDyneMat; Lst: IntDyneVec; NoPoints: integer; AReport: TStrings);
protected
procedure AdjustConstraints; override;
procedure Compute; override;
function Validate(out AMsg: String; out AControl: TWinControl): Boolean; override;
public
{ public declarations }
end;
var
AvgLinkFrm: TAvgLinkFrm;
AvgLinkForm: TAvgLinkForm;
implementation
{$R *.lfm}
uses
Math;
{ TAvgLinkFrm }
{ TAvgLinkForm }
procedure TAvgLinkFrm.FormActivate(Sender: TObject);
var
w: Integer;
procedure TAvgLinkForm.AdjustConstraints;
begin
w := MaxValue([HelpBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
HelpBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w;
CloseBtn.Constraints.MinWidth := w;
inherited;
ParamsPanel.Constraints.MinWidth := Max(
3*CloseBtn.Width + 2*CloseBtn.BorderSpacing.Left,
MatrixTypeGroup.Width
);
ParamsPanel.Constraints.MinHeight :=
MatrixTypeGroup.Height + ButtonBevel.Height + CloseBtn.BorderSpacing.Top +
CloseBtn.Height;
end;
procedure TAvgLinkFrm.FormCreate(Sender: TObject);
begin
Assert(OS3MainFrm <> nil);
end;
procedure TAvgLinkFrm.FormShow(Sender: TObject);
begin
MatrixTypeGroup.ItemIndex := 0;
end;
{ Reference: Anderberg, M. R. (1973). Cluster analysis for applications.
New York: Academic press.
procedure TAvgLinkFrm.HelpBtnClick(Sender: TObject);
begin
if ContextHelpForm = nil then
Application.CreateForm(TContextHelpForm, ContextHelpForm);
ContextHelpForm.HelpMessage((Sender as TButton).tag);
end;
Almost any text on cluster analysis should have a good description of the
average-linkage hierarchical clustering algorithm.
The algorithm begins with an initial similarity or dissimilarity matrix
between pairs of objects.
The algorithm proceeds in an iterative way. At each iteration the two
most similar (we assume similarities for explanation) objects are combined
into one group.
At each successive iteration, the two most similar objects or groups of
objects are merged. Similarity between groups is defined as the average
similarity between objects in one group with objects in the other.
procedure TAvgLinkFrm.ComputeBtnClick(Sender: TObject);
INPUT: A correlation matrix (or some other similarity or
dissimilarity matrix) in a file named MATRIX.DAT
This must contain all the elements of a full
(n x n), symmetrical matrix. Any format is
allowable, as long as numbers are separated by
blanks.
OUTPUT: Output consists of a cluster history and a tree
diagram (dendogram). The cluster history
indicates, for each iteration, the objects
or clusters merged, and the average pairwise
similarity or dissimilarity in the resulting
cluster.
Author: John Uebersax
}
procedure TAvgLinkForm.Compute;
const
SIM_DIS: array[0..1] of String = ('Similarity', 'Dissimilarity');
VAR
X : DblDyneMat; // similarity or dissimilarity matrix
KLUS : IntDyneMat;
LST : IntDyneVec;
var
X: DblDyneMat = nil; // similarity or dissimilarity matrix
KLUS: IntDyneMat = nil;
LST: IntDyneVec = nil;
RX, SAV, SAV2, RRRMIN: double;
NIN, NVAR : IntDyneVec;
NIN: IntDyneVec = nil;
NVAR: IntDyneVec = nil;
I, J, K, L, M, MN, N, CRIT, ITR, LIMIT: integer;
// ROWS : StrDyneVec;
nvalues : integer;
nValues: integer;
lReport: TStrings;
label
label300, label60, label70;
begin
// Reference: Anderberg, M. R. (1973). Cluster analysis for
// applications. New York: Academic press.
//
// Almost any text on cluster analysis should have a good
// description of the average-linkage hierarchical clustering
// algorithm. The algorithm begins with an initial similarity
// or dissimilarity matrix between pairs of objects. The
// algorithm proceeds in an iterative way. At each iteration
// the two most similar (we assume similarities for explanation)
// objects are combined into one group. At each successive
// iteration, the two most similar objects or groups of objects are
// merged. Similarity between groups is defined as the average
// similarity between objects in one group with objects in the other.
//
// INPUT: A correlation matrix (or some other similarity or
// dissimilarity matrix) in a file named MATRIX.DAT
// This must contain all the elements of a full
// (n x n), symmetrical matrix. Any format is
// allowable, as long as numbers are separated by
// blanks.
//
// OUTPUT: Output consists of a cluster history and a tree
// diagram (dendogram). The cluster history
// indicates, for each iteration, the objects
// or clusters merged, and the average pairwise
// similarity or dissimilarity in the resulting
// cluster.
//
// Author: John Uebersax
if (NoVariables <= 0) then
begin
MessageDlg('You must first load a matrix into the grid.', mtError, [mbOK], 0);
exit;
end;
nvalues := NoVariables;
SetLength(X,nvalues+1,nvalues+1);
SetLength(KLUS,nvalues+1,3);
SetLength(LST,nvalues+1);
SetLength(NIN,nvalues+1);
SetLength(NVAR,nvalues+1);
nValues := NoVariables;
SetLength(X, nValues+1, nvalues+1);
SetLength(KLUS, nValues+1, 3);
SetLength(LST, nValues+1);
SetLength(NIN, nValues+1);
SetLength(NVAR, nValues+1);
lReport := TStringList.Create;
try
@ -252,9 +232,11 @@ label300:
NIN[K] := NIN[K] + NIN[L];
for I := L to MN do NIN[I] := NIN[I+1];
goto label70;
label60:
// Update number of objects in each cluster
NIN[K] := NIN[K] + NIN[L];
label70: // end of ARRANGE procedure
// continuation of CLUSV1 procedure
@ -269,51 +251,47 @@ label70: // end of ARRANGE procedure
KLUS[ITR,1] := NVAR[K]; // save in KLUS rather than write out to file as in
KLUS[ITR,2] := NVAR[L]; // original program
if not(L = M) then
if (L <> M) then
begin
MN := M - 1;
for i := L to MN do NVAR[i] := NVAR[i+1];
end;
M := M - 1;
if (ITR < LIMIT) then goto label300;
lReport.Add('');
// End of CLUSV1 procedure
// do pre-tree processing
PreTree(nvalues, CRIT, LST, KLUS, lReport);
lReport.Add('');
lReport.Add(DIVIDER);
lReport.Add(DIVIDER_AUTO);
lReport.Add('');
// do TREE procedure
TreePlot(KLUS, LST, nvalues, lReport);
DisplayReport(lReport);
FReportFrame.DisplayReport(lReport);
finally
lReport.Free;
NVAR := nil;
NIN := nil;
LST := nil;
KLUS := nil;
X := nil;
end;
end;
procedure TAvgLinkFrm.TreePlot(Clusters: IntDyneMat; Lst: IntDyneVec;
procedure TAvgLinkForm.TreePlot(Clusters: IntDyneMat; Lst: IntDyneVec;
NoPoints: integer; AReport: TStrings);
VAR
outline : array[0..501] of char;
aline : array[0..82] of char;
valstr : string;
tempstr : string;
plotline : string;
star : char;
blank : char;
col1, col2, colpos1, colpos2 : integer;
noparts, startcol, endcol : integer;
Results : StrDyneVec;
ColPos : IntDyneVec;
Results : StrDyneVec = nil;
ColPos : IntDyneVec = nil;
i, j, k, L, linecount, newcol, howlong, count: integer;
begin
linecount := 1;
@ -321,7 +299,6 @@ begin
blank := ' ';
SetLength(ColPos, NoPoints + 2);
SetLength(Results, NoPoints*2 + 3);
//AReport.Add('');
// store initial column positions of vertical linkages
for i := 1 to NoPoints do ColPos[Lst[i]] := 4 + (i * 5);
@ -329,10 +306,7 @@ begin
// create column heading indented 10 spaces
tempstr := 'UNIT ';
for i := 1 to NoPoints do
begin
valstr := format('%5d',[Lst[i]]);
tempstr := tempstr + valstr;
end;
tempstr := tempstr + Format('%5d', [Lst[i]]);
Results[linecount] := tempstr;
linecount := linecount + 1;
@ -345,34 +319,41 @@ begin
// start dendoplot
for i := 1 to NoPoints - 1 do
begin
outline := '';
valstr := Format('%5d',[i]); // put step no. first
outline := valstr;
// put step no. first
outline := Format('%5d', [i]);
// clear remainder of outline
for j := 5 to (5 + NoPoints * 5) do outline[j] := ' ';
outline[6 + NoPoints * 5] := #0;
col1 := Clusters[i,1];
col2 := Clusters[i,2];
// find column positions for each variable
colpos1 := ColPos[col1];
colpos2 := ColPos[col2];
for k := colpos1 to colpos2 do outline[k] := star;
for k := colpos1 to colpos2 do
outline[k] := star;
// change column positions 1/2 way between the matched ones
newcol := colpos1 + ((colpos2 - colpos1) div 2);
for k := 1 to NoPoints do
if ((ColPos[k] = colpos1) or (ColPos[k] = colpos2)) then ColPos[k] := newcol;
if ((ColPos[k] = colpos1) or (ColPos[k] = colpos2)) then
ColPos[k] := newcol;
for k := 1 to NoPoints do
begin
L := ColPos[k];
if ((L <> colpos1) and (L <> colpos2)) then outline[L] := star;
if ((L <> colpos1) and (L <> colpos2)) then
outline[L] := star;
end;
Results[linecount] := outline;
linecount := linecount + 1;
// add a line of connectors to next grouping
outline := ' ';
for j := 5 to (5 + NoPoints * 5) do outline[j] := blank;
for j := 5 to (5 + NoPoints * 5) do
outline[j] := blank;
for j := 1 to NoPoints do
begin
colpos1 := ColPos[j];
@ -384,10 +365,10 @@ begin
// output the Results in parts
// determine number of pages needed for whole plot
noparts := 0;
howlong := Length(Results[1]);
noparts := round(howlong / 80.0);
if (noparts <= 0) then noparts := 1;
if (noparts <= 0) then
noparts := 1;
if (noparts = 1) then // simply print the list
for i := 0 to linecount - 1 do
@ -420,16 +401,16 @@ begin
if (endcol > howlong) then endcol := howlong;
end;
end;
Results := nil;
ColPos := nil;
end;
procedure TAvgLinkFrm.PreTree(NN, CRIT: integer; LST: IntDyneVec;
procedure TAvgLinkForm.PreTree(NN, CRIT: integer; LST: IntDyneVec;
KLUS: IntDyneMat; AReport: TStrings);
VAR
I, II, J, NI, NJ, L, M, N, Ina, INEND, NHOLD, NLINES, INDX, ICOL, JCOL: integer;
KSH, JEND, MSH: integer;
JHOLD, NIN1: IntDyneVec;
JHOLD: IntDyneVec = nil;
NIN1: IntDyneVec = nil;
outline: string;
label
label2015, label2020, label2030, label2040, label2055, label2060;
@ -459,19 +440,23 @@ begin
NI := NIN1[I];
NJ := NIN1[J];
L := 1;
label2015:
if (LST[L] = I) then goto label2020;
L := L + 1;
if (L <= NN) then goto label2015;
label2020:
ICOL := L;
Ina := ICOL + NI;
INEND := Ina + NJ - 1;
L := L + 1;
label2030:
if (LST[L] = J) then goto label2040;
L := L + 1;
if (L <= NN) then goto label2030;
label2040:
JCOL := L;
JEND := JCOL + NJ - 1;
@ -523,8 +508,20 @@ label2060:
// End of PRETRE procedure
end;
initialization
{$I avglinkunit.lrs}
function TAvgLinkForm.Validate(out AMsg: String; out AControl: TWinControl): boolean;
begin
Result := false;
if (NoVariables <= 0) then
begin
AControl := MatrixTypeGroup;
AMsg := 'You must first load a matrix into the grid.';
exit;
end;
Result := true;
end;
end.

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

@ -2162,9 +2162,9 @@ end;
// Menu" "Analysis" > "Multivariate" > "Average Link Clustering"
procedure TOS3MainFrm.mnuAnalysisMulti_AvgLinkClick(Sender: TObject);
begin
if AvgLinkFrm = nil then
Application.CreateForm(TAvgLinkFrm, AvgLinkFrm);
AvgLinkFrm.ShowModal;
if AvgLinkForm = nil then
Application.CreateForm(TAvgLinkForm, AvgLinkForm);
AvgLinkForm.Show;
end;
// Menu "Analysis" > "Multivariate" > "K Means Clustering"