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

LazStats: Refactor SingleLinkUnit.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@7372 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2020-04-11 16:36:26 +00:00
parent 29bfc99530
commit dcec975ab4
4 changed files with 555 additions and 572 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
applications/lazstats/docs/HelpNDoc/LazStats.hnd
View File

Binary file not shown.

BIN
applications/lazstats/docs/chm/LazStats.chm
View File

Binary file not shown.

62
applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.lfm
View File

@@ -13,83 +13,65 @@ object SingleLinkFrm: TSingleLinkFrm
Position = poMainFormCenter Position = poMainFormCenter
LCLVersion = '2.1.0.0' LCLVersion = '2.1.0.0'
object ResetBtn: TButton object ResetBtn: TButton
AnchorSideRight.Control = CancelBtn AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 108 Left = 200
Height = 25 Height = 25
Top = 251 Top = 251
Width = 54 Width = 54
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Reset' Caption = 'Reset'
OnClick = ResetBtnClick OnClick = ResetBtnClick
TabOrder = 1 TabOrder = 1
end end
object CancelBtn: TButton
AnchorSideRight.Control = ComputeBtn
AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom
Left = 174
Height = 25
Top = 251
Width = 62
Anchors = [akRight, akBottom]
AutoSize = True
BorderSpacing.Left = 12
BorderSpacing.Top = 8
BorderSpacing.Right = 12
BorderSpacing.Bottom = 8
Caption = 'Cancel'
ModalResult = 2
TabOrder = 2
end
object ComputeBtn: TButton object ComputeBtn: TButton
AnchorSideRight.Control = ReturnBtn AnchorSideRight.Control = CloseBtn
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 248 Left = 262
Height = 25 Height = 25
Top = 251 Top = 251
Width = 76 Width = 76
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Compute' Caption = 'Compute'
OnClick = ComputeBtnClick OnClick = ComputeBtnClick
TabOrder = 3 TabOrder = 2
end end
object ReturnBtn: TButton object CloseBtn: TButton
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = Owner AnchorSideBottom.Control = Owner
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 336 Left = 346
Height = 25 Height = 25
Top = 251 Top = 251
Width = 61 Width = 55
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
AutoSize = True AutoSize = True
BorderSpacing.Left = 12 BorderSpacing.Left = 8
BorderSpacing.Top = 8 BorderSpacing.Top = 8
BorderSpacing.Right = 12 BorderSpacing.Right = 8
BorderSpacing.Bottom = 8 BorderSpacing.Bottom = 8
Caption = 'Return' Caption = 'Close'
ModalResult = 1 ModalResult = 11
TabOrder = 4 TabOrder = 3
end end
object Bevel1: TBevel object Bevel1: TBevel
AnchorSideLeft.Control = Owner AnchorSideLeft.Control = Owner
AnchorSideRight.Control = Owner AnchorSideRight.Control = Owner
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = ReturnBtn AnchorSideBottom.Control = CloseBtn
Left = 0 Left = 0
Height = 8 Height = 8
Top = 235 Top = 235
@@ -124,7 +106,7 @@ object SingleLinkFrm: TSingleLinkFrm
Caption = 'Available Variables' Caption = 'Available Variables'
ParentColor = False ParentColor = False
end end
object ListBox1: TListBox object VarList: TListBox
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = Panel1
AnchorSideTop.Control = Label1 AnchorSideTop.Control = Label1
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
@@ -139,6 +121,7 @@ object SingleLinkFrm: TSingleLinkFrm
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Right = 8 BorderSpacing.Right = 8
ItemHeight = 0 ItemHeight = 0
OnSelectionChange = VarListSelectionChange
TabOrder = 0 TabOrder = 0
end end
object Label2: TLabel object Label2: TLabel
@@ -159,7 +142,7 @@ object SingleLinkFrm: TSingleLinkFrm
object VarInBtn: TBitBtn object VarInBtn: TBitBtn
AnchorSideLeft.Control = Panel1 AnchorSideLeft.Control = Panel1
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = ListBox1 AnchorSideTop.Control = VarList
Left = 182 Left = 182
Height = 28 Height = 28
Top = 17 Top = 17
@@ -274,10 +257,11 @@ object SingleLinkFrm: TSingleLinkFrm
BorderSpacing.Left = 8 BorderSpacing.Left = 8
BorderSpacing.Top = 2 BorderSpacing.Top = 2
BorderSpacing.Bottom = 6 BorderSpacing.Bottom = 6
ReadOnly = True
TabOrder = 3 TabOrder = 3
Text = 'VarSelEdit' Text = 'VarSelEdit'
end end
object GroupBox1: TGroupBox object OptionsGroup: TGroupBox
AnchorSideLeft.Control = VarInBtn AnchorSideLeft.Control = VarInBtn
AnchorSideTop.Control = VarOutBtn AnchorSideTop.Control = VarOutBtn
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom

319
applications/lazstats/source/forms/analysis/multivariate/singlelinkunit.pas
View File

@@ -17,41 +17,39 @@ type
Bevel1: TBevel; Bevel1: TBevel;
Panel1: TPanel; Panel1: TPanel;
ResetBtn: TButton; ResetBtn: TButton;
CancelBtn: TButton;
ComputeBtn: TButton; ComputeBtn: TButton;
ReturnBtn: TButton; CloseBtn: TButton;
StdChkBox: TCheckBox; StdChkBox: TCheckBox;
RepChkBox: TCheckBox; RepChkBox: TCheckBox;
DescChkBox: TCheckBox; DescChkBox: TCheckBox;
PlotChkBox: TCheckBox; PlotChkBox: TCheckBox;
DendoChk: TCheckBox; DendoChk: TCheckBox;
GroupBox1: TGroupBox; OptionsGroup: TGroupBox;
VarSelEdit: TEdit; VarSelEdit: TEdit;
Label2: TLabel; Label2: TLabel;
VarInBtn: TBitBtn; VarInBtn: TBitBtn;
VarOutBtn: TBitBtn; VarOutBtn: TBitBtn;
Label1: TLabel; Label1: TLabel;
ListBox1: TListBox; VarList: TListBox;
procedure ComputeBtnClick(Sender: TObject); procedure ComputeBtnClick(Sender: TObject);
procedure FormActivate(Sender: TObject); procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject); procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject); procedure FormShow(Sender: TObject);
procedure VarListSelectionChange(Sender: TObject; User: boolean);
procedure ResetBtnClick(Sender: TObject); procedure ResetBtnClick(Sender: TObject);
procedure VarInBtnClick(Sender: TObject); procedure VarInBtnClick(Sender: TObject);
procedure VarOutBtnClick(Sender: TObject); procedure VarOutBtnClick(Sender: TObject);
private private
{ private declarations } { private declarations }
FAutoSized: Boolean; FAutoSized: Boolean;
procedure TreePlot(VAR Clusters : IntDyneMat; procedure UpdateBtnStates;
VAR Lst : IntDyneVec;
NoPoints : integer); procedure ScatPlot(const x, y: DblDyneVec; NoCases: Integer;
procedure scatplot(var x : DblDyneVec; ATitleStr, XAxisStr, YAxisStr: string;
var y : DblDyneVec; x_min, x_max, y_min, y_max : double; const VarLabels: StrDyneVec;
nocases : integer; AReport: TStrings);
titlestr : string; procedure TreePlot(const Clusters: IntDyneMat; const Lst: IntDyneVec;
x_axis, y_axis : string; NoPoints: integer; AReport: TStrings);
x_min, x_max, y_min, y_max : double;
VAR VarLabels : StrDyneVec);
public public
{ public declarations } { public declarations }
@@ -63,41 +61,47 @@ var
implementation implementation
uses uses
Math; Math, Utils;
{ TSingleLinkFrm } { TSingleLinkFrm }
procedure TSingleLinkFrm.ResetBtnClick(Sender: TObject); procedure TSingleLinkFrm.ResetBtnClick(Sender: TObject);
VAR i : integer; var
cellstring : string; i: integer;
begin begin
ListBox1.Clear; VarList.Clear;
VarSelEdit.Text := ''; VarSelEdit.Text := '';
for i := 1 to NoVariables do for i := 1 to NoVariables do
begin VarList.Items.Add(OS3MainFrm.DataGrid.Cells[i,0]);
cellstring := OS3MainFrm.DataGrid.Cells[i,0];
ListBox1.Items.Add(cellstring);
end;
RepChkBox.Checked := false; RepChkBox.Checked := false;
StdChkBox.Checked := false; StdChkBox.Checked := false;
VarOutBtn.Enabled := false;
DescChkBox.Checked := false; DescChkBox.Checked := false;
PlotChkBox.Checked := false; PlotChkBox.Checked := false;
UpdateBtnStates;
end; end;
procedure TSingleLinkFrm.VarInBtnClick(Sender: TObject); procedure TSingleLinkFrm.VarInBtnClick(Sender: TObject);
VAR index : integer; var
index: integer;
begin begin
index := ListBox1.ItemIndex; index := VarList.ItemIndex;
VarSelEdit.Text := ListBox1.Items.Strings[index]; if (index > -1) and (VarSelEdit.Text = '') then
VarOutBtn.Enabled := true; begin
VarSelEdit.Text := VarList.Items.Strings[index];
VarList.Items.Delete(index);
end;
UpdateBtnStates;
end; end;
procedure TSingleLinkFrm.VarOutBtnClick(Sender: TObject); procedure TSingleLinkFrm.VarOutBtnClick(Sender: TObject);
begin begin
ListBox1.Items.Add(VarSelEdit.Text); if VarSelEdit.Text <> '' then
begin
VarList.Items.Add(VarSelEdit.Text);
VarSelEdit.Text := ''; VarSelEdit.Text := '';
end; end;
UpdateBtnStates;
end;
procedure TSingleLinkFrm.FormActivate(Sender: TObject); procedure TSingleLinkFrm.FormActivate(Sender: TObject);
var var
@@ -106,12 +110,12 @@ begin
if FAutoSized then if FAutoSized then
exit; exit;
w := MaxValue([ResetBtn.Width, CancelBtn.Width, ComputeBtn.Width, ReturnBtn.Width]); w := MaxValue([ResetBtn.Width, ComputeBtn.Width, CloseBtn.Width]);
ResetBtn.Constraints.MinWidth := w; ResetBtn.Constraints.MinWidth := w;
CancelBtn.Constraints.MinWidth := w;
ComputeBtn.Constraints.MinWidth := w; ComputeBtn.Constraints.MinWidth := w;
ReturnBtn.Constraints.MinWidth := w; CloseBtn.Constraints.MinWidth := w;
Constraints.MinWidth := Width;
Constraints.MinWidth := OptionsGroup.Width * 2;
Constraints.MinHeight := Height; Constraints.MinHeight := Height;
FAutoSized := true; FAutoSized := true;
@@ -120,8 +124,6 @@ end;
procedure TSingleLinkFrm.FormCreate(Sender: TObject); procedure TSingleLinkFrm.FormCreate(Sender: TObject);
begin begin
Assert(OS3MainFrm <> nil); Assert(OS3MainFrm <> nil);
if OutputFrm = nil then
Application.CreateForm(TOutputFrm, OutputFrm);
end; end;
procedure TSingleLinkFrm.FormShow(Sender: TObject); procedure TSingleLinkFrm.FormShow(Sender: TObject);
@@ -129,21 +131,24 @@ begin
ResetBtnClick(self); ResetBtnClick(self);
end; end;
procedure TSingleLinkFrm.VarListSelectionChange(Sender: TObject; User: boolean);
begin
UpdateBtnStates;
end;
procedure TSingleLinkFrm.ComputeBtnClick(Sender: TObject); procedure TSingleLinkFrm.ComputeBtnClick(Sender: TObject);
VAR var
NoInGrp : IntDyneVec; // no. of subjects in a grouping NoInGrp : IntDyneVec; // no. of subjects in a grouping
i, j, NoGroups, ID, ID1, ID2, col, startat, endat : integer; i, j, NoGroups, ID1, ID2, col, startAt, endAt: integer;
ColSelected : integer; ColSelected : integer;
NoScores : integer; NoScores : integer;
varlabel : string; varlabel : string;
// outline : array[1..501] of char; // outline : array[1..501] of char;
// astring : array[0..5] of char; // astring : array[0..5] of char;
outline : string; outline : string;
astring : string;
Scores : DblDyneVec; // subject scores Scores : DblDyneVec; // subject scores
Distance : DblDyneMat; // distance between objects Distance : DblDyneMat; // distance between objects
SubjectIDs : IntDyneVec; // subject ids - sorted with Distance SubjectIDs : IntDyneVec; // subject ids - sorted with Distance
X1: double; // grid values of two subjects
Groups : IntDyneMat; // subjects in each group Groups : IntDyneMat; // subjects in each group
GrpErrors : DblDyneVec; GrpErrors : DblDyneVec;
Smallest, Mean, Variance, StdDev : double; Smallest, Mean, Variance, StdDev : double;
@@ -154,8 +159,10 @@ VAR
XAxis, YAxis : DblDyneVec; XAxis, YAxis : DblDyneVec;
MaxError : double; MaxError : double;
GrpLabels : StrDyneVec; GrpLabels : StrDyneVec;
lReport: TStrings;
label labels1, labels2; label
labels1, labels2;
begin begin
NoScores := NoCases; NoScores := NoCases;
@@ -169,7 +176,7 @@ begin
if (VarSelEdit.Text = OS3MainFrm.DataGrid.Cells[j,0]) then ColSelected := j; if (VarSelEdit.Text = OS3MainFrm.DataGrid.Cells[j,0]) then ColSelected := j;
if (ColSelected = 0) then if (ColSelected = 0) then
begin begin
ShowMessage('ERROR! No variable selected to analyze.'); MessageDlg('No variable selected to analyze.', mtError, [mbOK], 0);
exit; exit;
end; end;
@@ -193,7 +200,8 @@ begin
Groups[i,j] := 0; Groups[i,j] := 0;
Distance[i,j] := 0.0; Distance[i,j] := 0.0;
end; end;
for j := 0 to 2 do clusters[i,j] := 0; for j := 0 to 2 do
clusters[i,j] := 0;
end; end;
NoGroups := 0; NoGroups := 0;
@@ -217,61 +225,54 @@ begin
begin begin
if (Scores[i] > Scores[j]) then // swap if (Scores[i] > Scores[j]) then // swap
begin begin
X1 := Scores[i]; Exchange(Scores[i], Scores[j]);
Scores[i] := Scores[j]; Exchange(SubjectIDs[i], SubjectIDs[j]);
Scores[j] := X1;
ID := SubjectIDs[i];
SubjectIDs[i] := SubjectIDs[j];
SubjectIDs[j] := ID;
end; end;
end; end;
end; end;
for i := 0 to NoCases - 1 do Lst[i+1] := SubjectIDs[i]; for i := 0 to NoCases - 1 do
Lst[i+1] := SubjectIDs[i];
// Show results // Show results
OutputFrm.RichEdit.Lines.Add('Single Linkage Clustering by Bill Miller'); lReport := TStringList.Create;
outline := format('FILE: %s',[OS3MainFrm.FileNameEdit.Text]); try
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('SINGLE LINKAGE CLUSTERING by Bill Miller');
outline := format('Variable := %s',[varlabel]); lReport.Add('');
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('FILE: %s', [OS3MainFrm.FileNameEdit.Text]);
outline := format('Number of cases := %d',[NoCases]); lReport.Add('Variable: %s', [varlabel]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('Number of cases: %8d', [NoCases]);
outline := format('Mean := %8.3f, Variance := %8.3f, Std.Dev. := %8.3f',[Mean, Variance, StdDev]); lReport.Add('Mean: %8.3f', [Mean]);
OutputFrm.RichEdit.Lines.Add(outline); lReport.Add('Variance: %8.3f', [Variance]);
lReport.Add('Std.Dev.: %8.3f', [StdDev]);
lReport.Add('');
// Standardize the distance scores if elected // Standardize the distance scores if elected
if (StdChkBox.Checked) then if StdChkBox.Checked then
begin begin
for i := 0 to NoCases - 1 do Scores[i] := (Scores[i] - Mean) / StdDev; for i := 0 to NoCases - 1 do
if (RepChkBox.Checked) then // replace original values in DataGrid with z scores if elected Scores[i] := (Scores[i] - Mean) / StdDev;
if RepChkBox.Checked then // replace original values in DataGrid with z scores if elected
begin begin
for i := 0 to NoCases - 1 do for i := 0 to NoCases - 1 do
begin begin
col := ColSelected; col := ColSelected;
outline := format('%6.4f',[Scores[i]]); OS3MainFrm.DataGrid.Cells[col,i+1] := Format('%6.4f', [Scores[i]]);
OS3MainFrm.DataGrid.Cells[col,i+1] := outline;
end; end;
end; end;
end; end;
OutputFrm.RichEdit.Lines.Add(''); if DescChkBox.Checked then
if (DescChkBox.Checked) then
begin begin
done := false; done := false;
startat := 0; startat := 0;
endat := NoScores; endat := NoScores;
if (endat > 20) then endat := 20; if (endat > 20) then endat := 20;
// ptr := outline;
while (not done) do while (not done) do
begin begin
outline := 'GROUP ID'; outline := 'GROUP ID';
for i := startat to endat - 1 do for i := startat to endat - 1 do
begin outline := outline + Format('%4d', [SubjectIDs[i]]);
astring := format('%4d',[SubjectIDs[i]]); lReport.Add(outline);
outline := outline + astring;
// strcat(@outline,@astring);
end;
OutputFrm.RichEdit.Lines.Add(outline);
startat := endat; startat := endat;
if (startat >= NoScores) then done := true; if (startat >= NoScores) then done := true;
endat := startat + 20; endat := startat + 20;
@@ -281,6 +282,7 @@ begin
// calculate Distances and smallest Distance // calculate Distances and smallest Distance
labels1: labels1:
Smallest := abs(Scores[0] - Scores[1]); // initial values Smallest := abs(Scores[0] - Scores[1]); // initial values
for i := 0 to NoScores - 2 do for i := 0 to NoScores - 2 do
begin begin
@@ -299,12 +301,10 @@ labels1:
if (NoGroups < NoCases-1) then if (NoGroups < NoCases-1) then
begin begin
if (DescChkBox.Checked) then if DescChkBox.Checked then
begin begin
outline := format(' Group %d is combined with Group %d', lReport.Add(' Group %d is combined with Group %d', [SubjectIDs[ID1], SubjectIDs[ID2]]);
[SubjectIDs[ID1],SubjectIDs[ID2]]); lReport.Add('');
OutputFrm.RichEdit.Lines.Add(outline);
OutputFrm.RichEdit.Lines.Add('');
end; end;
end; end;
@@ -330,7 +330,7 @@ labels2:
end; end;
NoScores := NoScores - 1; NoScores := NoScores - 1;
for i := 0 to NoScores - 1 do Groups[NoGroups,SubjectIDs[i]] := 1; for i := 0 to NoScores - 1 do Groups[NoGroups,SubjectIDs[i]] := 1;
if (DescChkBox.Checked) then if DescChkBox.Checked then
begin begin
done := false; done := false;
startat := 0; startat := 0;
@@ -340,11 +340,8 @@ labels2:
begin begin
outline := 'GROUP ID'; outline := 'GROUP ID';
for i := startat to endat - 1 do for i := startat to endat - 1 do
begin outline := outline + Format('%4d',[SubjectIDs[i]]);
astring := format('%4d',[SubjectIDs[i]]); lReport.Add(outline);
outline := outline + astring;
end;
OutputFrm.RichEdit.Lines.Add(outline);
startat := endat; startat := endat;
if (startat >= NoScores) then done := true; if (startat >= NoScores) then done := true;
endat := startat + 20; endat := startat + 20;
@@ -359,20 +356,20 @@ labels2:
end; end;
// show errors // show errors
if (DescChkBox.Checked) then if DescChkBox.Checked then
begin begin
OutputFrm.RichEdit.Lines.Add(''); lReport.Add('');
OutputFrm.RichEdit.Lines.Add('GROUPING STEP ERROR'); lReport.Add('GROUPING STEP ERROR');
lReport.Add('------------- --------');
for i := 0 to NoGroups - 1 do for i := 0 to NoGroups - 1 do
begin lReport.Add('%8d %8.3f', [i+1, GrpErrors[i]]);
outline := format(' %3d %10.3f',[i+1,GrpErrors[i]]);
OutputFrm.RichEdit.Lines.Add(outline);
end;
end; end;
OutputFrm.ShowModal; lReport.Add('');
OutputFrm.RichEdit.Clear; lReport.Add(DIVIDER);
if (PlotChkBox.Checked) then lReport.Add('');
if PlotChkBox.Checked then
begin begin
MaxError := GrpErrors[NoGroups-1]; MaxError := GrpErrors[NoGroups-1];
SetLength(XAxis,NoCases); SetLength(XAxis,NoCases);
@@ -384,22 +381,29 @@ labels2:
YAxis[i] := GrpErrors[i]; YAxis[i] := GrpErrors[i];
GrpLabels[i] := IntToStr(i + 1); GrpLabels[i] := IntToStr(i + 1);
end; end;
scatplot(XAxis, YAxis, NoGroups, 'Plot of Error vs No. of Groups', ScatPlot(XAxis, YAxis, NoGroups, 'Plot of Error vs No. of Groups',
'No. of Groups', 'Size of Error', 2.0, NoCases, 0.0, MaxError,GrpLabels); 'No. of Groups', 'Size of Error', 2.0, NoCases, 0.0, MaxError,GrpLabels, lReport);
GrpLabels := nil; GrpLabels := nil;
YAxis := nil; YAxis := nil;
XAxis := nil; XAxis := nil;
end; end;
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear; lReport.Add('');
if (DendoChk.Checked) then lReport.Add(DIVIDER);
lReport.Add('');
if DendoChk.Checked then
begin begin
OutputFrm.RichEdit.Clear; TreePlot(clusters,Lst,NoGroups+1, lReport);
TreePlot(clusters,Lst,NoGroups+1); lReport.Add('');
OutputFrm.ShowModal; lReport.Add(DIVIDER);
lReport.Add('');
end; end;
OutputFrm.RichEdit.Clear;
//clean up the memory DisplayReport(lReport);
finally
lReport.Free;
Lst := nil; Lst := nil;
clusters := nil; clusters := nil;
GrpErrors := nil; GrpErrors := nil;
@@ -409,11 +413,11 @@ labels2:
SubjectIDs := nil; SubjectIDs := nil;
Distance := nil; Distance := nil;
end; end;
end;
procedure TSingleLinkFrm.TreePlot(VAR Clusters : IntDyneMat; procedure TSingleLinkFrm.TreePlot(const Clusters: IntDyneMat;
VAR Lst : IntDyneVec; const Lst: IntDyneVec; NoPoints: integer; AReport: TStrings);
NoPoints : integer); var
VAR
outline: array[0..501] of char; outline: array[0..501] of char;
aline: array[0..82] of char; aline: array[0..82] of char;
valstr: string; valstr: string;
@@ -426,7 +430,6 @@ VAR
Results: StrDyneVec; Results: StrDyneVec;
ColPos: IntDyneVec; ColPos: IntDyneVec;
i, j, k, L, linecount, newcol, howlong, count: integer; i, j, k, L, linecount, newcol, howlong, count: integer;
done : boolean;
begin begin
linecount := 1; linecount := 1;
star := '*'; star := '*';
@@ -434,7 +437,6 @@ begin
SetLength(ColPos,NoPoints+2); SetLength(ColPos,NoPoints+2);
SetLength(Results,NoPoints*2+3); SetLength(Results,NoPoints*2+3);
OutputFrm.RichEdit.Lines.Add(''); OutputFrm.RichEdit.Lines.Add('');
done := false;
// store initial column positions of vertical linkages // store initial column positions of vertical linkages
for i := 1 to NoPoints do ColPos[Lst[i]] := 4 + (i * 5); for i := 1 to NoPoints do ColPos[Lst[i]] := 4 + (i * 5);
@@ -458,18 +460,20 @@ begin
for i := 1 to NoPoints - 1 do for i := 1 to NoPoints - 1 do
begin begin
outline := ''; outline := '';
valstr := format('%5d',[i]); // put step no. first valstr := Format('%5d', [i]); // put step no. first
outline := valstr; outline := valstr;
// clear remainder of outline // clear remainder of outline
for j := 5 to (5 + NoPoints * 5) do outline[j] := ' '; for j := 5 to (5 + NoPoints * 5) do outline[j] := ' ';
outline[6 + NoPoints * 5] := #0; outline[6 + NoPoints * 5] := #0;
col1 := Clusters[i,1]; col1 := Clusters[i,1];
col2 := Clusters[i,2]; col2 := Clusters[i,2];
// find column positions for each variable // find column positions for each variable
colpos1 := ColPos[col1]; colpos1 := ColPos[col1];
colpos2 := ColPos[col2]; 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 // change column positions 1/2 way between the matched ones
newcol := colpos1 + ((colpos2 - colpos1) div 2); newcol := colpos1 + ((colpos2 - colpos1) div 2);
for k := 1 to NoPoints do for k := 1 to NoPoints do
@@ -499,25 +503,20 @@ begin
noparts := 0; noparts := 0;
howlong := Length(Results[1]); howlong := Length(Results[1]);
noparts := round(howlong / 80.0); 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 if (noparts = 1) then // simply print the list
begin
for i := 0 to linecount - 1 do for i := 0 to linecount - 1 do
begin AReport.Add(Results[i])
OutputFrm.RichEdit.Lines.Add(Results[i]);
end;
end
else // break lines into strings of 15 units else // break lines into strings of 15 units
begin begin
startcol := 0; startcol := 0;
endcol := 80; endcol := 80;
for i := 1 to noparts do for i := 1 to noparts do
begin begin
outline := format('PART %d OUTPUT',[i]); AReport.Add('PART %d OUTPUT', [i]);
OutputFrm.RichEdit.Lines.Add(outline); for j := 0 to 80 do
for j := 0 to 80 do aline[j] := blank; aline[j] := blank;
for j := 0 to linecount - 1 do for j := 0 to linecount - 1 do
begin begin
count := 0; count := 0;
@@ -528,9 +527,9 @@ begin
count := count + 1; count := count + 1;
end; end;
aline[count+1] := #0; aline[count+1] := #0;
OutputFrm.RichEdit.Lines.Add(aline); AReport.Add(aline);
end; end;
OutputFrm.RichEdit.Lines.Add(''); AReport.Add('');
startcol := endcol + 1; startcol := endcol + 1;
endcol := endcol + 80; endcol := endcol + 80;
if (endcol > howlong) then endcol := howlong; if (endcol > howlong) then endcol := howlong;
@@ -540,20 +539,14 @@ begin
ColPos := nil; ColPos := nil;
end; end;
procedure TSingleLinkFrm.scatplot(var x : DblDyneVec; procedure TSingleLinkFrm.ScatPlot(const x, y: DblDyneVec; NoCases: Integer;
var y : DblDyneVec; ATitleStr, XAxisStr, YAxisStr: string; x_min, x_max, y_min, y_max: double;
nocases : integer; const VarLabels: StrDyneVec; AReport: TStrings);
titlestr : string;
x_axis, y_axis : string;
x_min, x_max, y_min, y_max : double;
VAR VarLabels : StrDyneVec);
var var
i, j, l, row, xslot : integer; i, j, l, row, xslot : integer;
xdelta, maxy: double; maxy: double;
incrementx, incrementy, rangex, rangey, swap : double; incrementx, incrementy, rangex, rangey, swap : double;
plotstring: array[0..51,0..61] of char; plotstring: array[0..51,0..61] of char;
ymed, xmed : double;
aheight: integer; aheight: integer;
overlap: boolean; overlap: boolean;
valuestring: string[2]; valuestring: string[2];
@@ -566,11 +559,8 @@ begin
aheight := 40; aheight := 40;
rangex := x_max - x_min ; rangex := x_max - x_min ;
incrementx := rangex / 15.0; incrementx := rangex / 15.0;
xdelta := rangex / 60;
xmed := rangex / 2;
rangey := y_max - y_min; rangey := y_max - y_min;
incrementy := rangey / aheight; incrementy := rangey / aheight;
ymed := rangey / 2;
{ sort in descending order } { sort in descending order }
for i := 1 to (nocases - 1) do for i := 1 to (nocases - 1) do
@@ -591,10 +581,10 @@ begin
end; end;
end; end;
end; end;
outline := ' SCATTERPLOT - ' + titlestr;
OutputFrm.RichEdit.Lines.Add(outline); AReport.Add(' SCATTERPLOT - ' + ATitleStr);
OutputFrm.RichEdit.Lines.Add(''); AReport.Add('');
OutputFrm.RichEdit.Lines.Add(y_axis); AReport.Add(YAxisStr);
maxy := y_max; maxy := y_max;
for i := 1 to 60 do for i := 1 to 60 do
for j := 1 to aheight+1 do plotstring[j,i] := ' '; for j := 1 to aheight+1 do plotstring[j,i] := ' ';
@@ -606,9 +596,7 @@ begin
row := row + 1; row := row + 1;
plotstring[row,30] := '|'; plotstring[row,30] := '|';
if (row = (aheight / 2)) then if (row = (aheight / 2)) then
begin
for i := 1 to 60 do plotstring[row,i] := '-'; for i := 1 to 60 do plotstring[row,i] := '-';
end;
for i := 1 to nocases do for i := 1 to nocases do
begin begin
if ((maxy >= y[i-1]) and (y[i-1] > (maxy - incrementy))) then if ((maxy >= y[i-1]) and (y[i-1] > (maxy - incrementy))) then
@@ -622,7 +610,8 @@ begin
if (valuestring[1] <> ' ') then howlong := 2; if (valuestring[1] <> ' ') then howlong := 2;
for l := xslot to (xslot + howlong - 1) do for l := xslot to (xslot + howlong - 1) do
if (plotstring[row,l] = '*') then overlap := true; if (plotstring[row,l] = '*') then overlap := true;
if (overlap) then plotstring[row,xslot] := '*' if (overlap) then
plotstring[row,xslot] := '*'
else else
begin begin
if (howlong < 2) then if (howlong < 2) then
@@ -634,37 +623,47 @@ begin
end; end;
maxy := maxy - incrementy; maxy := maxy - incrementy;
end; end;
{ print the plot } { print the plot }
for i := 1 to row do for i := 1 to row do
begin begin
outline := ' |'; outline := ' |';
for j := 1 to 60 do outline := outline + format('%1s',[plotstring[i,j]]); for j := 1 to 60 do
outline := outline + format('|-%6.2f-%6.2f', outline := outline + Format('%1s', [plotstring[i,j]]);
[(y_max - i * incrementy),(y_max - i * incrementy + incrementy)]); outline := outline + Format('|-%6.2f-%.2f', [
OutputFrm.RichEdit.Lines.Add(outline); y_max - i * incrementy,
y_max - i * incrementy + incrementy
]);
AReport.Add(outline);
end; end;
outline := ''; outline := '';
for i := 1 to 63 do outline := outline + '-'; for i := 1 to 63 do outline := outline + '-';
OutputFrm.RichEdit.Lines.Add(outline); AReport.Add(outline);
outline := ''; outline := '';
for i := 1 to 16 do outline := outline + ' | '; for i := 1 to 16 do outline := outline + ' | ';
outline := outline + x_axis; outline := outline + XAxisStr;
OutputFrm.RichEdit.Lines.Add(outline); AReport.Add(outline);
outline := ''; outline := '';
for i := 1 to 16 do outline := outline + format('%4.1f',[(x_min + i * incrementx - incrementx)]); for i := 1 to 16 do
OutputFrm.RichEdit.Lines.Add(outline); outline := outline + Format('%4.1f', [x_min + i * incrementx - incrementx]);
OutputFrm.RichEdit.Lines.Add(''); AReport.Add(outline);
OutputFrm.RichEdit.Lines.Add('Labels:'); AReport.Add('');
AReport.Add('Labels:');
for i := 1 to nocases do for i := 1 to nocases do
begin AReport.Add('%4d: %s', [i, Labels[i-1]]);
outline := format('%2d = %s',[i,Labels[i-1]]);
OutputFrm.RichEdit.Lines.Add(outline);
end;
OutputFrm.ShowModal;
OutputFrm.RichEdit.Clear;
Labels := nil; Labels := nil;
end; { of scatplot procedure } end; { of scatplot procedure }
procedure TSingleLinkFrm.UpdateBtnStates;
begin
VarInBtn.Enabled := (VarList.ItemIndex > -1) and (VarSelEdit.Text = '');
VarOutBtn.Enabled := (VarSelEdit.Text <> '');
end;
initialization initialization
{$I singlelinkunit.lrs} {$I singlelinkunit.lrs}