⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 pr.pas

📁 ANN And Hopfield Neural Network
💻 PAS
📖 第 1 页 / 共 2 页
字号:
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 + -