diff --git a/applications/lazstats/source/LazStats.lpi b/applications/lazstats/source/LazStats.lpi index b82915baf..78097c0e0 100644 --- a/applications/lazstats/source/LazStats.lpi +++ b/applications/lazstats/source/LazStats.lpi @@ -1005,7 +1005,7 @@ - + diff --git a/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas b/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas index a88b648d6..9daa78110 100644 --- a/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas +++ b/applications/lazstats/source/forms/analysis/comparisons/ancovaunit.pas @@ -6,6 +6,7 @@ unit ANCOVAUnit; {$mode objfpc}{$H+} +{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} {.$DEFINE ANCOVA_DEBUG} interface @@ -1044,7 +1045,7 @@ end; procedure TAncovaForm.GenCovInteracts; var - i, j, l, m, vect1col, vect2col, col: integer; + i, j, k, m, vect1col, vect2col, col: integer; value: double; labelstr, cell1, cell2: string; startcol, endcol, novectors, oldnovars: integer; @@ -1064,9 +1065,9 @@ begin vect1col := Block[i-1,2]; for j := firstblock to lastblock do begin - for l := 1 to Block[j-1,4] do + for k := 1 to Block[j-1,4] do begin - vect2col := Block[j-1,2] + l - 1; // first vector col. of B + vect2col := Block[j-1,2] + k - 1; // first vector col. of B col := col + 1; novectors := novectors + 1; NoTestVecs := NoTestVecs + 1; @@ -1350,7 +1351,7 @@ end; procedure TAncovaForm.SelectPlot(Sender: TObject); var - fixedIdx, i: Integer; + fixedIdx: Integer; isAdjusted: Boolean; ser: TChartSeries; clr: TColor; diff --git a/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm index 655111735..59bd77fbe 100644 --- a/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm +++ b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm @@ -1,106 +1,41 @@ -object SingleLinkFrm: TSingleLinkFrm +inherited SingleLinkForm: TSingleLinkForm Left = 579 - Height = 284 + Height = 364 Top = 362 - Width = 409 + Width = 715 HelpType = htKeyword HelpKeyword = 'html/SingleLinkClustering.htm' - AutoSize = True Caption = 'Single Linkage Cluster Analysis' - ClientHeight = 284 - ClientWidth = 409 - 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 = 200 - Height = 25 - Top = 251 - Width = 54 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Reset' - OnClick = ResetBtnClick - TabOrder = 1 - end - object ComputeBtn: TButton - AnchorSideRight.Control = CloseBtn - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 262 - Height = 25 - Top = 251 - Width = 76 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Compute' - OnClick = ComputeBtnClick - TabOrder = 2 - end - object CloseBtn: TButton - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = Owner - AnchorSideBottom.Side = asrBottom - Left = 346 - Height = 25 - Top = 251 - Width = 55 - Anchors = [akRight, akBottom] - AutoSize = True - BorderSpacing.Left = 8 - BorderSpacing.Top = 8 - BorderSpacing.Right = 8 - BorderSpacing.Bottom = 8 - Caption = 'Close' - ModalResult = 11 - TabOrder = 3 - end - object Bevel1: TBevel - AnchorSideLeft.Control = Owner - AnchorSideRight.Control = Owner - AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = CloseBtn - Left = 0 - Height = 8 - Top = 235 - Width = 409 - 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 = 8 - Height = 219 - Top = 8 - Width = 393 - Anchors = [akTop, akLeft, akRight, akBottom] - AutoSize = True - BorderSpacing.Around = 8 - BevelOuter = bvNone - ClientHeight = 219 - ClientWidth = 393 - TabOrder = 0 - object Label1: TLabel - AnchorSideLeft.Control = Panel1 - AnchorSideTop.Control = Panel1 + ClientHeight = 364 + ClientWidth = 715 + inherited ParamsPanel: TPanel + Height = 348 + Width = 315 + ClientHeight = 348 + ClientWidth = 315 + inherited CloseBtn: TButton + Left = 260 + Top = 323 + end + inherited ComputeBtn: TButton + Left = 176 + Top = 323 + end + inherited ResetBtn: TButton + Left = 114 + Top = 323 + end + inherited HelpBtn: TButton + Left = 55 + Top = 323 + end + inherited ButtonBevel: TBevel + Top = 307 + Width = 315 + end + object Label1: TLabel[5] + AnchorSideLeft.Control = ParamsPanel + AnchorSideTop.Control = ParamsPanel Left = 0 Height = 15 Top = 0 @@ -108,220 +43,175 @@ object SingleLinkFrm: TSingleLinkFrm Caption = 'Available Variables' ParentColor = False end - object VarList: TListBox - AnchorSideLeft.Control = Panel1 + object VarList: TListBox[6] + AnchorSideLeft.Control = ParamsPanel AnchorSideTop.Control = Label1 AnchorSideTop.Side = asrBottom AnchorSideRight.Control = VarInBtn - AnchorSideBottom.Control = Panel1 - AnchorSideBottom.Side = asrBottom + AnchorSideBottom.Control = OptionsGroup Left = 0 - Height = 202 + Height = 189 Top = 17 - Width = 174 + Width = 138 Anchors = [akTop, akLeft, akRight, akBottom] BorderSpacing.Top = 2 - BorderSpacing.Right = 8 + BorderSpacing.Right = 6 + BorderSpacing.Bottom = 8 ItemHeight = 0 + OnDblClick = VarListDblClick OnSelectionChange = VarListSelectionChange - TabOrder = 0 + TabOrder = 4 end - object Label2: TLabel + object Label2: TLabel[7] AnchorSideLeft.Control = VarSelEdit + AnchorSideTop.Control = VarInBtn AnchorSideRight.Control = VarSelEdit AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = VarSelEdit - Left = 218 - Height = 15 - Top = 31 - Width = 175 - Anchors = [akLeft, akRight, akBottom] + Left = 176 + Height = 30 + Top = 17 + Width = 139 + Anchors = [akTop, akLeft, akRight] BorderSpacing.Bottom = 2 Caption = 'Variable Selected for Analysis' ParentColor = False WordWrap = True end - object VarInBtn: TBitBtn - AnchorSideLeft.Control = Panel1 + object VarInBtn: TBitBtn[8] + AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = VarList - Left = 182 - Height = 28 + Left = 144 + Height = 26 Top = 17 - 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 = Panel1 + object VarOutBtn: TBitBtn[9] + AnchorSideLeft.Control = ParamsPanel AnchorSideLeft.Side = asrCenter AnchorSideTop.Control = VarInBtn AnchorSideTop.Side = asrBottom - Left = 182 - Height = 28 - Top = 49 - Width = 28 + Left = 144 + Height = 26 + Top = 47 + 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 VarSelEdit: TEdit + object VarSelEdit: TEdit[10] AnchorSideLeft.Control = VarInBtn AnchorSideLeft.Side = asrBottom + AnchorSideTop.Control = Label2 AnchorSideTop.Side = asrBottom - AnchorSideRight.Control = Panel1 + AnchorSideRight.Control = ParamsPanel AnchorSideRight.Side = asrBottom - AnchorSideBottom.Control = VarOutBtn AnchorSideBottom.Side = asrBottom - Left = 218 + Left = 176 Height = 23 - Top = 48 - Width = 175 - Anchors = [akLeft, akRight, akBottom] - BorderSpacing.Left = 8 + Top = 49 + Width = 139 + Anchors = [akTop, akLeft, akRight] + BorderSpacing.Left = 6 BorderSpacing.Top = 2 - BorderSpacing.Bottom = 6 + BorderSpacing.Bottom = 12 ReadOnly = True - TabOrder = 3 + TabOrder = 7 Text = 'VarSelEdit' end - object OptionsGroup: TGroupBox - AnchorSideLeft.Control = VarInBtn - AnchorSideTop.Control = VarOutBtn + object OptionsGroup: TGroupBox[11] + AnchorSideLeft.Control = ParamsPanel AnchorSideTop.Side = asrBottom - Left = 182 - Height = 135 - Top = 93 - Width = 178 + AnchorSideBottom.Control = ButtonBevel + Left = 0 + Height = 93 + Top = 214 + Width = 305 + Anchors = [akLeft, akBottom] AutoSize = True - BorderSpacing.Top = 16 Caption = 'Analysis Options:' ChildSizing.LeftRightSpacing = 12 ChildSizing.TopBottomSpacing = 6 ChildSizing.VerticalSpacing = 2 ChildSizing.Layout = cclLeftToRightThenTopToBottom - ChildSizing.ControlsPerLine = 1 - ClientHeight = 115 - ClientWidth = 174 - TabOrder = 4 - object StdChkBox: TCheckBox + ChildSizing.ControlsPerLine = 2 + ClientHeight = 73 + ClientWidth = 301 + TabOrder = 8 + object StandardizeChk: TCheckBox Left = 12 Height = 19 Top = 6 Width = 150 Caption = 'Standardize Variable' + OnChange = StandardizeChkChange TabOrder = 0 end - object RepChkBox: TCheckBox + object ReplaceChk: TCheckBox + Left = 162 + Height = 19 + Top = 6 + Width = 127 + Caption = 'Replace Grid Values' + Enabled = False + TabOrder = 1 + end + object CombinationsChk: TCheckBox Left = 12 Height = 19 Top = 27 Width = 150 - Caption = 'Replace Grid Values' - TabOrder = 1 - end - object DescChkBox: TCheckBox - Left = 12 - Height = 19 - Top = 48 - Width = 150 Caption = 'Show Each Combination' TabOrder = 2 end - object PlotChkBox: TCheckBox - Left = 12 + object PlotChk: TCheckBox + Left = 162 Height = 19 - Top = 69 - Width = 150 - Caption = 'Groups Vs Error Plot' + Top = 27 + Width = 127 + Caption = 'Groups vs. Error Plot' TabOrder = 3 end - object DendoChk: TCheckBox + object DendogramChk: TCheckBox Left = 12 Height = 19 - Top = 90 + Top = 48 Width = 150 Caption = 'Dendogram Plot' TabOrder = 4 end end end + inherited ParamsSplitter: TSplitter + Left = 327 + Height = 364 + end + inherited PageControl: TPageControl + Left = 336 + Height = 348 + Width = 371 + TabOrder = 1 + inherited ReportPage: TTabSheet + Caption = 'Results' + end + inherited ChartPage: TTabSheet + Caption = 'Groups vs Error Plot' + end + object CombinationsPage: TTabSheet[2] + Caption = 'Combinations' + TabVisible = False + end + object DendogramPage: TTabSheet[3] + Caption = 'Dendogram' + TabVisible = False + end + end end diff --git a/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas index 846f0d702..2ac655659 100644 --- a/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas +++ b/applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas @@ -1,189 +1,145 @@ unit SingleLinkUnit; {$mode objfpc}{$H+} +{$WARN 6058 off : Call to subroutine "$1" marked as inline is not inlined} interface uses - Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs, - StdCtrls, Buttons, ExtCtrls, - MainUnit, Globals, OutputUnit; + Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, Buttons, ExtCtrls, ComCtrls, + MainUnit, Globals, ReportFrameUnit, BasicStatsReportAndChartFormUnit; type - { TSingleLinkFrm } + { TSingleLinkForm } - TSingleLinkFrm = class(TForm) - Bevel1: TBevel; - Panel1: TPanel; - ResetBtn: TButton; - ComputeBtn: TButton; - CloseBtn: TButton; - StdChkBox: TCheckBox; - RepChkBox: TCheckBox; - DescChkBox: TCheckBox; - PlotChkBox: TCheckBox; - DendoChk: TCheckBox; + TSingleLinkForm = class(TBasicStatsReportAndChartForm) + StandardizeChk: TCheckBox; + ReplaceChk: TCheckBox; + CombinationsChk: TCheckBox; + PlotChk: TCheckBox; + DendogramChk: TCheckBox; OptionsGroup: TGroupBox; + CombinationsPage: TTabSheet; + DendogramPage: TTabSheet; VarSelEdit: TEdit; Label2: TLabel; VarInBtn: TBitBtn; VarOutBtn: TBitBtn; Label1: TLabel; VarList: TListBox; - procedure ComputeBtnClick(Sender: TObject); - procedure FormActivate(Sender: TObject); - procedure FormCreate(Sender: TObject); - procedure FormShow(Sender: TObject); + procedure StandardizeChkChange(Sender: TObject); + procedure VarListDblClick(Sender: TObject); procedure VarListSelectionChange(Sender: TObject; {%H-}User: boolean); - procedure ResetBtnClick(Sender: TObject); procedure VarInBtnClick(Sender: TObject); procedure VarOutBtnClick(Sender: TObject); - private - { private declarations } - FAutoSized: Boolean; - procedure UpdateBtnStates; - procedure ScatPlot(const x, y: DblDyneVec; NoCases: Integer; - ATitleStr, XAxisStr, YAxisStr: string; - x_min, x_max, y_min, y_max : double; const VarLabels: StrDyneVec; - AReport: TStrings); + private + procedure PlotGroupsVsError(const AGroupErrors: DblDyneVec; + ANumGroups: Integer); + + procedure ShowCombinations(const ASubjectIDs, ANumInGroup: IntDyneVec; + const AScores, AGroupErrors: DblDyneVec; const ADistance: DblDyneMat; + const AGroups, AClusters: IntDyneMat; + ANumScores, ANumCases: Integer; out ANumGroups: Integer); + + procedure ShowStatistics(AVarLabel: String; ANumCases: Integer; + AMean, AVariance, AStdDev: Double); + procedure TreePlot(const Clusters: IntDyneMat; const Lst: IntDyneVec; - NoPoints: integer; AReport: TStrings); + NoPoints: integer); + + private + FCombinationsReportFrame: TReportFrame; + FDendogramReportFrame: TReportFrame; + + 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 - SingleLinkFrm: TSingleLinkFrm; + SingleLinkForm: TSingleLinkForm; implementation +{$R *.lfm} + uses - Math, - {%H-}Utils, MatrixUnit; + Math, TAChartUtils, TACustomSeries, + GridProcs, MatrixUnit, ChartFrameUnit; -{ TSingleLinkFrm } -procedure TSingleLinkFrm.ResetBtnClick(Sender: TObject); +{ TSingleLinkForm } + +constructor TSingleLinkForm.Create(AOwner: TComponent); +begin + inherited; + + FCombinationsReportFrame := TReportFrame.Create(self); + FCombinationsReportFrame.Parent := CombinationsPage; + FCombinationsReportFrame.Align := alClient; + + FDendogramReportFrame := TReportFrame.Create(self); + FDendogramReportFrame.Parent := DendogramPage; + FDendogramReportFrame.Align := alClient; + + ChartPage.PageIndex := PageControl.PageCount-1; + PageControl.ActivePageIndex := 0; +end; + + +procedure TSingleLinkForm.AdjustConstraints; +begin + inherited; + ParamsPanel.Constraints.MinWidth := Max( + 4*CloseBtn.Width + 3*CloseBtn.BorderSpacing.Left, + OptionsGroup.Width + ); + ParamsPanel.Constraints.MinHeight := + Max(VarOutBtn.Top + VarOutBtn.Height, VarSelEdit.Top + VarSelEdit.Height) + + VarList.BorderSpacing.Bottom + OptionsGroup.Height + + ButtonBevel.Height + CloseBtn.BorderSpacing.Top + CloseBtn.Height; +end; + + +procedure TSingleLinkForm.Compute; var - i: integer; -begin - VarList.Clear; - VarSelEdit.Text := ''; - for i := 1 to NoVariables do - VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); - RepChkBox.Checked := false; - StdChkBox.Checked := false; - DescChkBox.Checked := false; - PlotChkBox.Checked := false; - UpdateBtnStates; -end; - -procedure TSingleLinkFrm.VarInBtnClick(Sender: TObject); -var - index: integer; -begin - index := VarList.ItemIndex; - if (index > -1) and (VarSelEdit.Text = '') then - begin - VarSelEdit.Text := VarList.Items.Strings[index]; - VarList.Items.Delete(index); - end; - UpdateBtnStates; -end; - -procedure TSingleLinkFrm.VarOutBtnClick(Sender: TObject); -begin - if VarSelEdit.Text <> '' then - begin - VarList.Items.Add(VarSelEdit.Text); - VarSelEdit.Text := ''; - end; - UpdateBtnStates; -end; - -procedure TSingleLinkFrm.FormActivate(Sender: TObject); -var - w: Integer; -begin - if FAutoSized then - exit; - - w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]); - ResetBtn.Constraints.MinWidth := w; - ComputeBtn.Constraints.MinWidth := w; - CloseBtn.Constraints.MinWidth := w; - - Constraints.MinWidth := OptionsGroup.Width * 2; - Constraints.MinHeight := Height; - - FAutoSized := true; -end; - -procedure TSingleLinkFrm.FormCreate(Sender: TObject); -begin - Assert(OS3MainFrm <> nil); -end; - -procedure TSingleLinkFrm.FormShow(Sender: TObject); -begin - ResetBtnClick(self); -end; - -procedure TSingleLinkFrm.VarListSelectionChange(Sender: TObject; User: boolean); -begin - UpdateBtnStates; -end; - -procedure TSingleLinkFrm.ComputeBtnClick(Sender: TObject); -var - NoInGrp : IntDyneVec; // no. of subjects in a grouping - i, j, NoGroups, ID1, ID2, col, startAt, endAt: integer; + NoInGrp : IntDyneVec = nil; // no. of subjects in a grouping + i, j, NoGroups: integer; ColSelected : integer; NoScores : integer; varlabel : string; // outline : array[1..501] of char; // astring : array[0..5] of char; - outline : string; - Scores : DblDyneVec; // subject scores - Distance : DblDyneMat; // distance between objects - SubjectIDs : IntDyneVec; // subject ids - sorted with Distance - Groups : IntDyneMat; // subjects in each group - GrpErrors : DblDyneVec; - Smallest, Mean, Variance, StdDev : double; - clusters : IntDyneMat; - Lst : IntDyneVec; - done : boolean; - average : double; - XAxis, YAxis : DblDyneVec; - MaxError : double; - GrpLabels : StrDyneVec; - lReport: TStrings; - -label - labels1, labels2; + Scores : DblDyneVec = nil; // subject scores + Distance : DblDyneMat = nil; // distance between objects + SubjectIDs : IntDyneVec = nil; // subject ids - sorted with Distance + Groups : IntDyneMat = nil; // subjects in each group + GrpErrors : DblDyneVec = nil; + Mean, Variance, StdDev: double; + clusters : IntDyneMat = nil; + Lst : IntDyneVec = nil; +// XAxis: DblDyneVec = nil; +// YAxis: DblDyneVec = nil; +// MaxError : double; +// GrpLabels : StrDyneVec = nil; begin NoScores := NoCases; - Mean := 0.0; - Variance := 0.0; - varlabel := VarSelEdit.Text; //Get selected variable - ColSelected := 0; - for j := 1 to NoVariables do - if (VarSelEdit.Text = OS3MainFrm.DataGrid.Cells[j,0]) then ColSelected := j; - if (ColSelected = 0) then - begin - MessageDlg('No variable selected to analyze.', mtError, [mbOK], 0); - exit; - end; + ColSelected := GetVariableIndex(OS3MainFrm.DataGrid, VarSelEdit.Text); // Allocate memory - SetLength(Distance,NoCases+1,NoCases+1); + SetLength(Distance,NoCases+1,NoCases+1); // wp: why always +1? SetLength(SubjectIDs,NoCases+1); SetLength(NoInGrp,NoCases+1); SetLength(Groups,NoCases+1,NoCases+1); @@ -191,36 +147,18 @@ begin SetLength(GrpErrors,NoCases+1); SetLength(clusters,NoCases+1,3); SetLength(Lst,NoCases+1); - - // initialize arrays for i := 0 to NoCases-1 do begin NoInGrp[i] := 1; SubjectIDs[i] := i+1; - for j := 0 to NoCases-1 do - begin - Groups[i,j] := 0; - Distance[i,j] := 0.0; - end; - for j := 0 to 2 do - clusters[i,j] := 0; end; - NoGroups := 0; + varlabel := VarSelEdit.Text; // Get data into the distance matrix - for i := 0 to NoCases - 1 do - begin - col := ColSelected; - Scores[i] := StrToFloat(OS3MainFrm.DataGrid.Cells[col,i+1]); - Mean := Mean + Scores[i]; - Variance := Variance + (Scores[i] * Scores[i]); - end; - Variance := Variance - ((Mean * Mean) / NoCases); - Variance := Variance / (NoCases - 1); - StdDev := sqrt(Variance); - Mean := Mean / NoCases; + Scores := CollectVecValues(OS3MainFrm.DataGrid, colSelected); + VecMeanVarStdDev(Scores, mean, variance, stdDev); - // sort the scores and ids in distance and subjed ids + // Sort the scores and ids in distance and subjed ids for i := 0 to NoCases - 2 do begin for j := i+1 to NoCases - 1 do @@ -235,210 +173,309 @@ begin for i := 0 to NoCases - 1 do Lst[i+1] := SubjectIDs[i]; - // Show results + // Standardize the distance scores if elected + if StandardizeChk.Checked then + begin + for i := 0 to NoCases - 1 do + Scores[i] := (Scores[i] - Mean) / StdDev; + if ReplaceChk.Checked then // replace original values in DataGrid with z scores if elected + for i := 0 to NoCases - 1 do + OS3MainFrm.DataGrid.Cells[ColSelected, i+1] := Format('%6.4f', [Scores[i]]); + end; + + // Show statistics results + ShowStatistics(varLabel, NoCases, Mean, Variance, StdDev); + + // Calculate and show combinations + CombinationsPage.TabVisible := CombinationsChk.Checked; + ShowCombinations(subjectIDs, noInGrp, scores, grpErrors, distance, groups, clusters, + NoScores, NoCases, NoGroups); + + // Plot groups vs error + if PlotChk.Checked then + begin + ChartPage.TabVisible := true; + PlotGroupsVsError(GrpErrors, NoGroups); + end else + ChartPage.TabVisible := false; + + // Dendogram plot + if DendogramChk.Checked then + begin + DendogramPage.TabVisible := true; + TreePlot(clusters, Lst, NoGroups+1); + end else + DendogramPage.TabVisible := false; + +end; + + +procedure TSingleLinkForm.PlotGroupsVsError(const AGroupErrors: DblDyneVec; + ANumGroups: Integer); +var + xData: DblDyneVec = nil; + yData: DblDyneVec = nil; + labels: StrDyneVec = nil; + i: Integer; + ser: TChartSeries; +begin + SetLength(xData, ANumGroups); + SetLength(yData, ANumGroups); + SetLength(labels, ANumGroups); + + for i := 0 to ANumGroups-1 do + begin + xData[i] := ANumGroups - i; + yData[i] := AGroupErrors[i]; + labels[i] := IntToStr(i+1); + end; + + FChartFrame.Clear; + FChartFrame.SetTitle('Plot of Error vs Group Number'); + FChartFrame.SetXTitle('Group number'); + FChartFrame.SetYTitle('Size of Error'); + + ser := FChartFrame.PlotXY(ptSymbols, xData, yData, labels, nil, '', DATA_COLORS[0]); + + FChartFrame.Chart.BottomAxis.Marks.Source := ser.Source; + FChartFrame.Chart.BottomAxis.Marks.Style := smsXValue; + FChartFrame.Chart.Legend.Visible := false; + (* + SetLength(XAxis,NoCases); + SetLength(YAxis,NoCases); + SetLength(GrpLabels,NoGroups+1); + for i := 0 to NoGroups - 1 do + begin + XAxis[i] := NoGroups - i; + YAxis[i] := GrpErrors[i]; + GrpLabels[i] := IntToStr(i + 1); + end; + ScatPlot(XAxis, YAxis, NoGroups, 'Plot of Error vs No. of Groups', + 'No. of Groups', 'Size of Error', 2.0, NoCases, 0.0, MaxError,GrpLabels, lReport); + GrpLabels := nil; + YAxis := nil; + XAxis := nil; + *) +end; + + +procedure TSingleLinkForm.Reset; +var + i: integer; +begin + inherited; + + if FCombinationsReportFrame <> nil then + FCombinationsReportFrame.Clear; + if FDendogramReportFrame <> nil then + FDendogramReportFrame.Clear; + + VarSelEdit.Clear; + VarList.Clear; + for i := 1 to NoVariables do + VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]); + + ReplaceChk.Checked := false; + StandardizeChk.Checked := false; + CombinationsChk.Checked := false; + PlotChk.Checked := false; + + UpdateBtnStates; +end; + + +procedure TSingleLinkForm.ShowCombinations( + const ASubjectIDs, ANumInGroup: IntDyneVec; + const AScores, AGroupErrors: DblDyneVec; const ADistance: DblDyneMat; + const AGroups, AClusters: IntDyneMat; + ANumScores, ANumCases: Integer; out ANumGroups: Integer); +var + lReport: TStrings; + done: Boolean; + startAt, endAt: Integer; + outline: String; + smallest: Double; + average: Double; + i, j, ID1, ID2: Integer; +begin + ANumGroups := 0; + lReport := TStringList.Create; try - lReport.Add('SINGLE LINKAGE CLUSTERING by Bill Miller'); - lReport.Add(''); - lReport.Add('FILE: %s', [OS3MainFrm.FileNameEdit.Text]); - lReport.Add('Variable: %s', [varlabel]); - lReport.Add('Number of cases: %8d', [NoCases]); - lReport.Add('Mean: %8.3f', [Mean]); - lReport.Add('Variance: %8.3f', [Variance]); - lReport.Add('Std.Dev.: %8.3f', [StdDev]); - lReport.Add(''); - - // Standardize the distance scores if elected - if StdChkBox.Checked then + if CombinationsChk.Checked then begin - for i := 0 to NoCases - 1 do - Scores[i] := (Scores[i] - Mean) / StdDev; - if RepChkBox.Checked then // replace original values in DataGrid with z scores if elected - begin - for i := 0 to NoCases - 1 do - begin - col := ColSelected; - OS3MainFrm.DataGrid.Cells[col,i+1] := Format('%6.4f', [Scores[i]]); - end; - end; - end; + lReport.Add('SINGLE LINKAGE CLUSTERING by Bill Miller'); + lReport.Add(''); - if DescChkBox.Checked then - begin done := false; - startat := 0; - endat := NoScores; - if (endat > 20) then endat := 20; + startAt := 0; + endAt := ANumScores; + if (endAt > 20) then endAt := 20; + while (not done) do begin outline := 'GROUP ID'; - for i := startat to endat - 1 do - outline := outline + Format('%4d', [SubjectIDs[i]]); + for i := startAt to endAt - 1 do + outline := outline + Format('%4d', [ASubjectIDs[i]]); lReport.Add(outline); - startat := endat; - if (startat >= NoScores) then done := true; - endat := startat + 20; - if (endat > NoScores) then endat := NoScores; + + startAt := endAt; + if (startAt >= ANumScores) then + done := true; + + endAt := startAt + 20; + if (endAt > ANumScores) then + endAt := ANumScores; end; end; - // calculate Distances and smallest Distance -labels1: - - Smallest := abs(Scores[0] - Scores[1]); // initial values - for i := 0 to NoScores - 2 do - begin - for j := i+1 to NoScores - 1 do + // Calculate distances and smallest distance + repeat + smallest := abs(AScores[0] - AScores[1]); // Initial values + for i := 0 to ANumScores - 2 do begin - Distance[i,j] := abs(Scores[i] - Scores[j]); - Distance[j,i] := Distance[i,j]; - if (Distance[i,j] <= Smallest) then + for j := i+1 to ANumScores - 1 do begin - Smallest := Distance[i,j]; - ID1 := i; - ID2 := j; - end; - end; - end; - - if (NoGroups < NoCases-1) then - begin - if DescChkBox.Checked then - begin - lReport.Add(' Group %d is combined with Group %d', [SubjectIDs[ID1], SubjectIDs[ID2]]); - lReport.Add(''); - end; - end; - - // eliminate second score and replace first with average - NoInGrp[ID1] := NoInGrp[ID1] + 1; - NoInGrp[ID2] := NoInGrp[ID2] - 1; - clusters[NoGroups+1,1] := SubjectIDs[ID1]; - clusters[NoGroups+1,2] := SubjectIDs[ID2]; - - // record results for this grouping -labels2: - Groups[NoGroups,ID1] := 1; // set flags for those objects grouped - Groups[NoGroups,ID2] := 1; - - if (NoGroups < NoCases-1) then // eliminate second score and replace first with average - begin - average := abs(Scores[ID1] + Scores[ID2]) / 2.0; - Scores[ID1] := average; - for i := ID2 to NoScores - 2 do - begin - Scores[i] := Scores[i+1]; - SubjectIDs[i] := SubjectIDs[i+1]; - end; - NoScores := NoScores - 1; - for i := 0 to NoScores - 1 do Groups[NoGroups,SubjectIDs[i]] := 1; - if DescChkBox.Checked then - begin - done := false; - startat := 0; - endat := NoScores; - if (endat > 20) then endat := 20; - while (not done) do - begin - outline := 'GROUP ID'; - for i := startat to endat - 1 do - outline := outline + Format('%4d',[SubjectIDs[i]]); - lReport.Add(outline); - startat := endat; - if (startat >= NoScores) then done := true; - endat := startat + 20; - if (endat > NoScores) then endat := NoScores; + ADistance[i, j] := abs(AScores[i] - AScores[j]); + ADistance[j, i] := ADistance[i, j]; + if (ADistance[i, j] <= smallest) then + begin + smallest := ADistance[i, j]; + ID1 := i; + ID2 := j; + end; end; end; - // get errors - GrpErrors[NoGroups] := GrpErrors[NoGroups] + Distance[ID1,ID2]; - NoGroups := NoGroups + 1; - goto labels1; - end; + if (ANumGroups < ANumCases-1) then + begin + if CombinationsChk.Checked then + begin + lReport.Add(' Group %d is combined with Group %d', [ASubjectIDs[ID1], ASubjectIDs[ID2]]); + lReport.Add(''); + end; + end; - // show errors - if DescChkBox.Checked then + // Eliminate second score and replace first with average + ANumInGroup[ID1] := ANumInGroup[ID1] + 1; + ANumInGroup[ID2] := ANumInGroup[ID2] - 1; + AClusters[ANumGroups+1, 1] := ASubjectIDs[ID1]; + AClusters[ANumGroups+1, 2] := ASubjectIDs[ID2]; + + // Record results for this grouping + + // Set flags for those objects grouped + AGroups[ANumGroups, ID1] := 1; + AGroups[ANumGroups, ID2] := 1; + + // Eliminate second score and replace first with average + if (ANumGroups < ANumCases-1) then + begin + average := abs(AScores[ID1] + AScores[ID2]) / 2.0; + AScores[ID1] := average; + for i := ID2 to ANumScores - 2 do + begin + AScores[i] := AScores[i+1]; + ASubjectIDs[i] := ASubjectIDs[i+1]; + end; + ANumScores := ANumScores - 1; + for i := 0 to ANumScores - 1 do + AGroups[ANumGroups, ASubjectIDs[i]] := 1; + if CombinationsChk.Checked then + begin + done := false; + startAt := 0; + endat := ANumScores; + if (endAt > 20) then endAt := 20; + while (not done) do + begin + outline := 'GROUP ID'; + for i := startAt to endAt - 1 do + outline := outline + Format('%4d', [ASubjectIDs[i]]); + lReport.Add(outline); + startAt := endAt; + if (startAt >= ANumScores) then done := true; + endAt := startAt + 20; + if (endAt > ANumScores) then endAt := ANumScores; + end; + end; + + // Get errors + AGroupErrors[ANumGroups] := AGroupErrors[ANumGroups] + ADistance[ID1, ID2]; + ANumGroups := ANumGroups + 1; + end; + until (ANumGroups = ANumCases-1); + + // Show errors + if CombinationsChk.Checked then begin lReport.Add(''); lReport.Add('GROUPING STEP ERROR'); lReport.Add('------------- --------'); - for i := 0 to NoGroups - 1 do - lReport.Add('%8d %8.3f', [i+1, GrpErrors[i]]); + for i := 0 to ANumGroups - 1 do + lReport.Add('%8d %8.3f', [i+1, AGroupErrors[i]]); + + FCombinationsReportFrame.DisplayReport(lReport); end; - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - - if PlotChkBox.Checked then - begin - MaxError := GrpErrors[NoGroups-1]; - SetLength(XAxis,NoCases); - SetLength(YAxis,NoCases); - SetLength(GrpLabels,NoGroups+1); - for i := 0 to NoGroups - 1 do - begin - XAxis[i] := NoGroups - i; - YAxis[i] := GrpErrors[i]; - GrpLabels[i] := IntToStr(i + 1); - end; - ScatPlot(XAxis, YAxis, NoGroups, 'Plot of Error vs No. of Groups', - 'No. of Groups', 'Size of Error', 2.0, NoCases, 0.0, MaxError,GrpLabels, lReport); - GrpLabels := nil; - YAxis := nil; - XAxis := nil; - end; - - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - - if DendoChk.Checked then - begin - TreePlot(clusters,Lst,NoGroups+1, lReport); - lReport.Add(''); - lReport.Add(DIVIDER); - lReport.Add(''); - end; - - DisplayReport(lReport); - finally lReport.Free; - Lst := nil; - clusters := nil; - GrpErrors := nil; - Scores := nil; - Groups := nil; - NoInGrp := nil; - SubjectIDs := nil; - Distance := nil; end; end; -procedure TSingleLinkFrm.TreePlot(const Clusters: IntDyneMat; - const Lst: IntDyneVec; NoPoints: integer; AReport: TStrings); + +procedure TSingleLinkForm.ShowStatistics(AVarLabel: String; ANumCases: Integer; + AMean, AVariance, AStdDev: Double); var + lReport: TStrings; +begin + lReport := TStringList.Create; + try + lReport.Add('SINGLE LINKAGE CLUSTERING by Bill Miller'); + lReport.Add(''); + lReport.Add('File: %-s', [OS3MainFrm.FileNameEdit.Text]); + lReport.Add('Variable: %-s', [AVarLabel]); + lReport.Add(''); + lReport.Add('Number of cases: %12d', [ANumCases]); + lReport.Add('Mean: %12.3f', [AMean]); + lReport.Add('Variance: %12.3f', [AVariance]); + lReport.Add('Std.Dev.: %12.3f', [AStdDev]); + + FReportFrame.DisplayReport(lReport); + finally + lReport.Free; + end; +end; + + +procedure TSingleLinkForm.StandardizeChkChange(Sender: TObject); +begin + ReplaceChk.Enabled := StandardizeChk.Checked; +end; + + +procedure TSingleLinkForm.TreePlot(const Clusters: IntDyneMat; + const Lst: IntDyneVec; NoPoints: integer); +const + STAR: Char = '*'; + BLANK: Char = ' '; +var + lReport: TStrings; 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); - OutputFrm.RichEdit.Lines.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); @@ -502,173 +539,131 @@ 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 = 1) then // simply print the list - for i := 0 to linecount - 1 do - AReport.Add(Results[i]) - else // break lines into strings of 15 units - begin - startcol := 0; - endcol := 80; - for i := 1 to noparts do + lReport := TStringList.Create; + try + lReport.Add('SINGLE LINKAGE CLUSTERING by Bill Miller'); + lReport.Add(''); + + noparts := 0; + howlong := Length(Results[1]); + noparts := round(howlong / 80.0); + if (noparts <= 0) then + noparts := 1; + if (noparts = 1) then // simply print the list + for i := 0 to linecount - 1 do + lReport.Add(Results[i]) + else // break lines into strings of 15 units begin - AReport.Add('PART %d OUTPUT', [i]); - for j := 0 to 80 do - aline[j] := blank; - for j := 0 to linecount - 1 do + startcol := 0; + endcol := 80; + for i := 1 to noparts do begin - count := 0; - outline := Results[j]; - for k := startcol to endcol do + lReport.Add('PART %d OUTPUT', [i]); + for j := 0 to 80 do + aline[j] := blank; + for j := 0 to linecount - 1 do begin - aline[count] := outline[k]; - count := count + 1; + count := 0; + outline := Results[j]; + for k := startcol to endcol do + begin + aline[count] := outline[k]; + count := count + 1; + end; + aline[count+1] := #0; + lReport.Add(aline); end; - aline[count+1] := #0; - AReport.Add(aline); + lReport.Add(''); + startcol := endcol + 1; + endcol := endcol + 80; + if (endcol > howlong) then endcol := howlong; end; - AReport.Add(''); - startcol := endcol + 1; - endcol := endcol + 80; - if (endcol > howlong) then endcol := howlong; end; + + FDendogramReportFrame.DisplayReport(lReport); + + finally + lReport.Free; end; - Results := nil; - ColPos := nil; end; -procedure TSingleLinkFrm.ScatPlot(const x, y: DblDyneVec; NoCases: Integer; - ATitleStr, XAxisStr, YAxisStr: string; x_min, x_max, y_min, y_max: double; - const VarLabels: StrDyneVec; AReport: TStrings); -var - i, j, l, row, xslot : integer; - maxy: double; - incrementx, incrementy, rangex, rangey, swap : double; - plotstring: array[0..51,0..61] of char; - aheight: integer; - overlap: boolean; - valuestring: string[2]; - howlong: integer; - outline: string; - Labels: StrDyneVec; + +procedure TSingleLinkForm.UpdateBtnStates; begin - SetLength(Labels,nocases); - for i := 1 to nocases do Labels[i-1] := VarLabels[i-1]; - aheight := 40; - rangex := x_max - x_min ; - incrementx := rangex / 15.0; - rangey := y_max - y_min; - incrementy := rangey / aheight; + inherited; - { sort in descending order } - for i := 1 to (nocases - 1) do - begin - for j := (i + 1) to nocases do - begin - if y[i-1] < y[j-1] then - begin - swap := y[i-1]; - y[i-1] := y[j-1]; - y[j-1] := swap; - swap := x[i-1]; - x[i-1] := x[j-1]; - x[j-1] := swap; - outline := Labels[i-1]; - Labels[i-1] := Labels[j-1]; - Labels[j-1] := outline; - end; - end; - end; + if FCombinationsReportFrame <> nil then + FCombinationsReportFrame.UpdateBtnStates; + if FDendogramReportFrame <> nil then + FDendogramReportFrame.UpdateBtnStates; - AReport.Add(' SCATTERPLOT - ' + ATitleStr); - AReport.Add(''); - AReport.Add(YAxisStr); - maxy := y_max; - for i := 1 to 60 do - for j := 1 to aheight+1 do plotstring[j,i] := ' '; - - { Set up the plot strings with the data } - row := 0; - while maxy > y_min do - begin - row := row + 1; - plotstring[row,30] := '|'; - if (row = (aheight / 2)) then - for i := 1 to 60 do plotstring[row,i] := '-'; - for i := 1 to nocases do - begin - if ((maxy >= y[i-1]) and (y[i-1] > (maxy - incrementy))) then - begin - xslot := round(((x[i-1] - x_min) / rangex) * 60); - if xslot < 1 then xslot := 1; - if xslot > 60 then xslot := 60; - overlap := false; - str(i:2,valuestring); - howlong := 1; - if (valuestring[1] <> ' ') then howlong := 2; - for l := xslot to (xslot + howlong - 1) do - if (plotstring[row,l] = '*') then overlap := true; - if (overlap) then - plotstring[row,xslot] := '*' - else - begin - if (howlong < 2) then - plotstring[row,xslot] := valuestring[2] - else for l := 1 to 2 do - plotstring[row,xslot + l - 1] := valuestring[l]; - end; - end; - end; - maxy := maxy - incrementy; - end; - - { print the plot } - for i := 1 to row do - begin - outline := ' |'; - for j := 1 to 60 do - outline := outline + Format('%1s', [plotstring[i,j]]); - outline := outline + Format('|-%6.2f-%.2f', [ - y_max - i * incrementy, - y_max - i * incrementy + incrementy - ]); - AReport.Add(outline); - end; - - outline := ''; - for i := 1 to 63 do outline := outline + '-'; - AReport.Add(outline); - - outline := ''; - for i := 1 to 16 do outline := outline + ' | '; - outline := outline + XAxisStr; - AReport.Add(outline); - - outline := ''; - for i := 1 to 16 do - outline := outline + Format('%4.1f', [x_min + i * incrementx - incrementx]); - AReport.Add(outline); - AReport.Add(''); - AReport.Add('Labels:'); - for i := 1 to nocases do - AReport.Add('%4d: %s', [i, Labels[i-1]]); - - Labels := nil; -end; { of scatplot procedure } - -procedure TSingleLinkFrm.UpdateBtnStates; -begin VarInBtn.Enabled := (VarList.ItemIndex > -1) and (VarSelEdit.Text = ''); VarOutBtn.Enabled := (VarSelEdit.Text <> ''); end; -initialization - {$I singlelinkunit.lrs} +function TSingleLinkForm.Validate(out AMsg: String; out AControl: TWinControl): Boolean; +begin + Result := false; + + if VarSelEdit.Text = '' then + begin + AMsg := 'No variable selected for analysis.'; + AControl := VarList; + exit; + end; + + Result := true; +end; + + +procedure TSingleLinkForm.VarInBtnClick(Sender: TObject); +var + index: integer; +begin + index := VarList.ItemIndex; + if (index > -1) and (VarSelEdit.Text = '') then + begin + VarSelEdit.Text := VarList.Items.Strings[index]; + VarList.Items.Delete(index); + end; + UpdateBtnStates; +end; + +procedure TSingleLinkForm.VarOutBtnClick(Sender: TObject); +begin + if VarSelEdit.Text <> '' then + begin + VarList.Items.Add(VarSelEdit.Text); + VarSelEdit.Text := ''; + end; + UpdateBtnStates; +end; + + +procedure TSingleLinkForm.VarListDblClick(Sender: TObject); +var + index: Integer; +begin + index := VarList.ItemIndex; + if index > -1 then + begin + if VarSelEdit.Text = '' then + begin + VarSelEdit.Text := VarList.Items[index]; + VarList.Items.Delete(index); + UpdateBtnStates; + end; + end; +end; + + +procedure TSingleLinkForm.VarListSelectionChange(Sender: TObject; User: boolean); +begin + UpdateBtnStates; +end; + + end. diff --git a/applications/lazstats/source/forms/mainunit.pas b/applications/lazstats/source/forms/mainunit.pas index 1a5594cf9..e46db871a 100644 --- a/applications/lazstats/source/forms/mainunit.pas +++ b/applications/lazstats/source/forms/mainunit.pas @@ -2168,9 +2168,9 @@ end; // Menu "Analysis" > "Multivariate" > "Single Link Clustering" procedure TOS3MainFrm.mnuAnalysisMulti_SingleLinkClick(Sender: TObject); begin - if SingleLinkFrm = nil then - Application.CreateForm(TSingleLinkFrm, SingleLinkFrm); - SingleLinkFrm.ShowModal; + if SingleLinkForm = nil then + Application.CreateForm(TSingleLinkForm, SingleLinkForm); + SingleLinkForm.Show; end; // Menu "Analysis" > "Multivariate" > "MANOVA / Discriminant Function"