📄 pr.pas
字号:
unit PR;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, Grids, ExtCtrls, TeEngine, Series, TeeProcs, Chart, Clipbrd,
Printers, ANN, ComCtrls;
const
CLASS1COUNT = 1000;
CLASS2COUNT = 50;
CLASS3COUNT = 100;
CLASS4COUNT = 500;
{
CLASS1COLOR = clBlue;
CLASS2COLOR = clGreen;
CLASS3COLOR = clRed;
CLASS4COLOR = clYellow;
}
type
TForm1 = class(TForm)
Button1: TButton;
Shape1: TShape;
Shape2: TShape;
Shape3: TShape;
Shape0: TShape;
Button6: TButton;
StringGrid1: TStringGrid;
Chart1: TChart;
Series2: TBarSeries;
Series3: TBarSeries;
Series4: TBarSeries;
Series5: TBarSeries;
Series1: TBarSeries;
Series6: TBarSeries;
Series7: TBarSeries;
Button12: TButton;
Button13: TButton;
Button2: TButton;
Edit1: TEdit;
Label1: TLabel;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Edit2: TEdit;
Edit3: TEdit;
Edit4: TEdit;
Label2: TLabel;
Edit5: TEdit;
Edit6: TEdit;
procedure Button1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
private
{ Private declarations }
CurClassifier: Integer;
Converged : Boolean;
Class1: array[0..CLASS1COUNT - 1] of TFeature;
Class2: array[0..CLASS2COUNT - 1] of TFeature;
Class3: array[0..CLASS3COUNT - 1] of TFeature;
Class4: array[0..CLASS4COUNT - 1] of TFeature;
Colors: array[0..3] of TColor;
Classifications: array[0..3] of TAnalysis;
CenterShapes: array [0..10] of TShape;
CummSet: array
[0..CLASS1COUNT + CLASS2COUNT + CLASS3COUNT + CLASS4COUNT - 1]
of TFeature;
TrainingSet, UnknownSet: array
[0..(CLASS1COUNT + CLASS2COUNT + CLASS3COUNT + CLASS4COUNT)
div 2 - 1]
of TFeature;
{ Classes: array
[0..CLASS1COUNT + CLASS2COUNT + CLASS3COUNT + CLASS4COUNT - 1]
of Integer;
}
NewCentroids,
Centroids: array [0..10] of TFeature;
XOrig, YOrig, XScale, YScale: Integer;
Steps,
NumCentroids,
NumClasses : Integer;
procedure DisplayNet;
procedure DisplaySet( Samples: array of TFeature; ShowErrors: Boolean);
procedure PrintSet( var P: TPrinter;
Samples: array of TFeature;
ShowErrors: Boolean);
procedure PrintSample( var P: TPrinter; Sample: TFeature; ShowError: Boolean);
procedure BuildDataSets;
procedure DisplaySample(Sample: TFeature; ShowError: Boolean);
procedure ClearCanvas;
procedure GenerateSamples;
procedure DisplayResults(Samples: array of TFeature);
procedure DisplayNetwork;
procedure Train;
function TrainEven(ErrorTolerance: Extended): Boolean;
procedure Recall;
public
{ Public declarations }
end;
var
Form1: TForm1;
FeedForward: TFeedForward;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
i: integer;
begin
for i:= 0 to Chart1.SeriesCount -1 do
Chart1.Series[i].Clear;
// HideCenterShapes;
GenerateSamples;
end;
procedure TForm1.GenerateSamples;
begin
ClearCanvas;
ANN.InitClass(Class1, 0, [13.0, 76.0], [8.0, 12.0]);
ANN.InitClass(Class2, 1, [34.0, 123.0], [13.0, 25.0]);
ANN.InitClass(Class3, 2, [21.0, 24.0], [7.0, 8.0]);
ANN.InitClass(Class4, 3, [18.0, 17.0], [7.0, 6.0]);
{
ANN.InitClass(Class1, 0, [5.0, 5.0], [2.0, 2.0]);
ANN.InitClass(Class2, 1, [25.0, 15.0], [3.0, 3.0]);
ANN.InitClass(Class3, 2, [45.0, 25.0], [2.0, 2.0]);
ANN.InitClass(Class4, 3, [65.0, 35.0], [3.0, 3.0]);
}
DisplaySet(Class1, False);
DisplaySet(Class2, False);
DisplaySet(Class3, False);
DisplaySet(Class4, False);
end;
procedure TForm1.DisplaySet( Samples: array of TFeature;
ShowErrors: Boolean);
var
i: Integer;
begin
for i := Low(Samples) to High(Samples) do
DisplaySample(Samples[i], ShowErrors);
end;
procedure TForm1.DisplaySample(Sample: TFeature; ShowError: Boolean);
var
X, Y: Integer;
begin
X := XOrig + Trunc(Sample.Vector[0] * XScale);
Y := YOrig + Trunc(Sample.Vector[1] * YScale);
if ShowError then
//if misclassified, mark it...
if (Sample.OrigClass <> Sample.CompClass) and
(Sample.CompClass >= 0 ) then begin
Self.Canvas.Pen.Color := Colors[Sample.OrigClass];
Self.Canvas.Ellipse(X-1, Y-1, X + 3, Y + 3);
end;
if Sample.CompClass >= 0 then
Self.Canvas.Pen.Color := Colors[Sample.CompClass]
else
Self.Canvas.Pen.Color := Colors[Sample.OrigClass];
Self.Canvas.Ellipse(X, Y, X + 2, Y + 2);
end;
procedure TForm1.FormCreate(Sender: TObject);
var
i: integer;
begin
Show;
XOrig := 200;
YOrig := 30;
XScale := 5;
YSCale := 3;
NumClasses := 4;
Colors[0] := clBlue;
Colors[1] := clWhite;
Colors[2] := clRed;
Colors[3] := clYellow;
(* CenterShapes[0] := Shape0;
CenterShapes[1] := Shape1;
CenterShapes[2] := Shape2;
CenterShapes[3] := Shape3;
*)
for i := 0 to 10 {NumClasses} do begin
if not Assigned(CenterShapes[i]) then begin
CenterShapes[i] := TShape.Create(Self);
CenterShapes[i].Width := 6;
CenterShapes[i].Height := 6;
CenterShapes[i].Brush.Color := clLime;
CenterShapes[i].Shape := stCircle;
CenterShapes[i].Parent := Self;
CenterShapes[i].Visible := False;
end;
end;
//initialize StringGrid headings
for i := 1 to 4 do
StringGrid1.Cells[i, 0] := 'Class ' + IntToStr(i);
StringGrid1.Cells[0, 1] := 'Classified';
StringGrid1.Cells[0, 2] := '% Classified';
StringGrid1.Cells[0, 3] := 'Misclassified';
StringGrid1.Cells[0, 4] := '% Misclassified';
StringGrid1.Cells[0, 5] := '# Members';
end;
procedure TForm1.ClearCanvas;
begin
Self.Canvas.Brush.Color := clSilver;
Refresh;
end;
procedure TForm1.Button6Click(Sender: TObject);
var
i: Integer;
F: TextFile;
begin
AssignFile(F, 'Data.txt');
Rewrite(F);
Writeln(F, 'Training Set');
for i := Low(CummSet) to High(CummSet) do
Writeln(F, FloatToStr(CummSet[i].Vector[0]) + ', ' +
FloatToStr(CummSet[i].Vector[1]) + ' class ' +
IntToStr(CummSet[i].OrigClass)
);
CloseFile(F);
end;
procedure TForm1.BuildDataSets;
var
i : Integer;
C1, C2, C3, C4: Integer;
begin
C1 := CLASS1COUNT div 2;
C2 := CLASS2COUNT div 2;
C3 := CLASS3COUNT div 2;
C4 := CLASS4COUNT div 2;
//build the training set
for i := 0 to C1 - 1 do begin
TrainingSet[i] := Class1[i];
end;
for i := 0 to C2 -1 do begin
TrainingSet[i + C1] := Class2[i];
end;
for i := 0 to C3 - 1 do begin
TrainingSet[i + C1 + C2] := Class3[i];
end;
for i := 0 to C4 -1 do begin
TrainingSet[i + C1 + C2 + C3] := Class4[i];
end;
Refresh; //Clear screen
DisplaySet(TrainingSet, False);
//build the unknown set
for i := 0 to C1 - 1 do begin
UnknownSet[i] := Class1[i + C1];
UnknownSet[i].CompClass := -1;
end;
for i := 0 to C2 - 1 do begin
UnknownSet[i + C1] := Class2[i + C2];
UnknownSet[i + C1].CompClass := -1;
end;
for i := 0 to C3 - 1 do begin
UnknownSet[i + C1 + C2] := Class3[i + C3];
UnknownSet[i + C1 + C2].CompClass := -1;
end;
for i := 0 to C4 - 1 do begin
UnknownSet[i + C1 + C2 + C3] := Class4[i + C4];
UnknownSet[i + C1 + C2 + C3].CompClass := -1;
end;
end;
procedure TForm1.DisplayResults(Samples: array of TFeature);
var
i, j: Integer;
C : array [0..3] of Integer;
F: TextFile;
begin
C[0] := CLASS1COUNT div 2;
C[1] := CLASS2COUNT div 2;
C[2] := CLASS3COUNT div 2;
C[3] := CLASS4COUNT div 2;
ResultAnalysis(Samples, Classifications, C);
for i := 0 to 3 do begin
StringGrid1.Cells[i + 1, 1] := IntToStr(Classifications[i].Classified);
StringGrid1.Cells[i + 1, 2] := FloatToStr(Classifications[i].percentClassified
) + '%';
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -