diff --git a/applications/lazstats/source/LazStats.lpi b/applications/lazstats/source/LazStats.lpi index 80b533f8b..c4229802b 100644 --- a/applications/lazstats/source/LazStats.lpi +++ b/applications/lazstats/source/LazStats.lpi @@ -862,7 +862,7 @@ - + diff --git a/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm index e7c7a4c12..32331a59c 100644 --- a/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm +++ b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.lfm @@ -1,123 +1,87 @@ -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 - AnchorSideLeft.Side = asrCenter - AnchorSideTop.Control = Owner - Left = 131 - Height = 72 - Top = 8 - Width = 120 - AutoFill = True - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - Caption = 'Matrix Type Is:' - ChildSizing.LeftRightSpacing = 12 - ChildSizing.TopBottomSpacing = 6 - ChildSizing.VerticalSpacing = 2 - ChildSizing.EnlargeHorizontal = crsHomogenousChildResize - ChildSizing.EnlargeVertical = crsHomogenousChildResize - ChildSizing.ShrinkHorizontal = crsScaleChilds - ChildSizing.ShrinkVertical = crsScaleChilds - ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 1 - ClientHeight = 52 - ClientWidth = 116 - Items.Strings = ( - 'Similarities' - 'Dissimilarities' - ) - TabOrder = 0 + 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 = Bevel1 + AnchorSideTop.Side = asrCenter + Left = 69 + Height = 72 + Top = 1 + Width = 120 + AutoFill = True + AutoSize = True + BorderSpacing.Left = 8 + Caption = 'Matrix Type Is:' + ChildSizing.LeftRightSpacing = 12 + ChildSizing.TopBottomSpacing = 6 + ChildSizing.VerticalSpacing = 2 + ChildSizing.EnlargeHorizontal = crsHomogenousChildResize + ChildSizing.EnlargeVertical = crsHomogenousChildResize + ChildSizing.ShrinkHorizontal = crsScaleChilds + ChildSizing.ShrinkVertical = crsScaleChilds + ChildSizing.Layout = cclLeftToRightThenTopToBottom + ChildSizing.ControlsPerLine = 1 + ClientHeight = 52 + ClientWidth = 116 + Items.Strings = ( + 'Similarities' + 'Dissimilarities' + ) + TabOrder = 0 + end + object Bevel1: TBevel[6] + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = ParamsPanel + AnchorSideBottom.Control = ButtonBevel + Left = 0 + Height = 75 + Top = 0 + Width = 18 + Anchors = [akTop, akLeft, akBottom] + Shape = bsSpacer + end 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 - Left = 0 - Height = 8 - Top = 80 - Width = 383 - Anchors = [akTop, akLeft, akRight] - Shape = bsBottomLine + inherited ParamsSplitter: TSplitter + Left = 271 + Height = 132 end end diff --git a/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas index a8de6aed5..3169cdb64 100644 --- a/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas +++ b/applications/lazstats/source/forms/analysis/multivariate/avglinkunit.pas @@ -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; - RX, SAV, SAV2, RRRMIN : double; - NIN, NVAR : IntDyneVec; - I, J, K, L, M, MN, N, CRIT, ITR, LIMIT : integer; - // ROWS : StrDyneVec; - nvalues : integer; +var + X: DblDyneMat = nil; // similarity or dissimilarity matrix + KLUS: IntDyneMat = nil; + LST: IntDyneVec = nil; + RX, SAV, SAV2, RRRMIN: double; + NIN: IntDyneVec = nil; + NVAR: IntDyneVec = nil; + I, J, K, L, M, MN, N, CRIT, ITR, LIMIT: 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,59 +251,54 @@ 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; star := '*'; blank := ' '; - SetLength(ColPos,NoPoints+2); - SetLength(Results,NoPoints*2+3); - //AReport.Add(''); + SetLength(ColPos, NoPoints + 2); + SetLength(Results, NoPoints*2 + 3); // 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,38 +319,45 @@ 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]; - outline[colpos1] := star; + colpos1 := ColPos[j]; + outline[colpos1] := star; end; Results[linecount] := outline; linecount := linecount + 1; @@ -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,23 +401,23 @@ 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; begin // PRETRE procedure - SetLength(JHOLD,NN+1); - SetLength(NIN1,NN+1); + SetLength(JHOLD, NN+1); + SetLength(NIN1, NN+1); // int NN := nvalues; N := NN - 1; AReport.Add('No. of objects: %3d', [NN]); @@ -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. diff --git a/applications/lazstats/source/forms/mainunit.pas b/applications/lazstats/source/forms/mainunit.pas index d06ad70de..b80995a76 100644 --- a/applications/lazstats/source/forms/mainunit.pas +++ b/applications/lazstats/source/forms/mainunit.pas @@ -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"