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

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

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