backprop.pas

ANN And Hopfield Neural Network

//Copyright Ramesh Sabeti - [e-mail]

unit Backprop;

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;


type
  TFormBackpropTest = class(TForm)
    ButtonGRandom: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    Shape0: TShape;
    ButtonSaveData: TButton;
    StringGrid1: TStringGrid;
    Chart1: TChart;
    Series1: TBarSeries;
    ButtonSaveGraph: TButton;
    ButtonPrint: TButton;
    ButtonCreateANN: TButton;
    EditTrials: TEdit;
    Label1: TLabel;
    ButtonTrainOne: TButton;
    ButtonRecall: TButton;
    ButtonTrainAll: TButton;
    Label2: TLabel;
    EditError: TEdit;
    ProgressBar1: TProgressBar;
    Button7: TButton;
    Button8: TButton;
    LabelTrials: TLabel;
    LabelLegend1: TLabel;
    LabelLegend2: TLabel;
    LabelLegend3: TLabel;
    LabelLegend4: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    procedure ButtonGRandomClick(Sender: TObject);
    procedure ButtonSaveDataClick(Sender: TObject);
    procedure ButtonSaveGraphClick(Sender: TObject);
    procedure ButtonPrintClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure ButtonCreateANNClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure ButtonTrainOneClick(Sender: TObject);
    procedure ButtonRecallClick(Sender: TObject);
    procedure ButtonTrainAllClick(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button7Click(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;


    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 TrainEvenly(ErrorTolerance: Extended; Indx: Integer): Boolean;
    function TrainAgent(ErrorTolerance: Extended; Indx: Integer): Boolean;
    procedure Recall;
  public
    { Public declarations }
  end;

var
  FormBackpropTest: TFormBackpropTest;
  FeedForward: TFeedForward;

implementation

{$R *.DFM}

procedure TFormBackpropTest.ButtonGRandomClick(Sender: TObject);
var
  i: integer;
begin
  for i:= 0 to Chart1.SeriesCount -1 do
    Chart1.Series[i].Clear;

  GenerateSamples;
end;

procedure TFormBackpropTest.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]);

  DisplaySet(Class1, False);
  DisplaySet(Class2, False);
  DisplaySet(Class3, False);
  DisplaySet(Class4, False);

end;

procedure TFormBackpropTest.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 TFormBackpropTest.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 + 5, Y + 5);
    end;

  if Sample.CompClass >= 0 then
    Self.Canvas.Pen.Color := Colors[Sample.CompClass]
  else
    Self.Canvas.Pen.Color := Colors[Sample.OrigClass];

  self.Canvas.Brush.Color := Self.Canvas.Pen.Color;
  Self.Canvas.Ellipse(X, Y, X + 4, Y + 4);

end;

procedure TFormBackpropTest.FormCreate(Sender: TObject);
var
  i: integer;
begin
  Show;
  XOrig := 200;
  YOrig := 30;
  XScale := 5;
  YSCale := 3;

  NumClasses := 4;

  Colors[0] := clRed;
  Colors[1] := clOlive;
  Colors[2] := clBlue;
  Colors[3] := clGreen;

  labelLegend1.Color := Colors[0];
  labelLegend2.Color := Colors[1];
  labelLegend3.Color := Colors[2];
  labelLegend4.Color := Colors[3];

  for i := 0 to 10 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 TFormBackpropTest.ClearCanvas;
begin
  Self.Canvas.Brush.Color := clSilver;
  Refresh;
end;
procedure TFormBackpropTest.ButtonSaveDataClick(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 TFormBackpropTest.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 TFormBackpropTest.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
                                              ) + '%';
    StringGrid1.Cells[i + 1, 3] := IntToStr(Classifications[i].Misclassified);
    StringGrid1.Cells[i + 1, 4] := FloatToStr(Classifications[i].PercentMisclassified
                                              ) + '%';
    StringGrid1.Cells[i + 1, 5] := IntToStr(Classifications[i].Total);
  end;
    StringGrid1.Cells[5, 2] :=FloatToStr(
                              (Classifications[0].Classified +
                               Classifications[1].Classified +
                               Classifications[2].Classified +
                               Classifications[3].Classified) /
                               8.25) + '%';

  if CurClassifier < 10 then begin
    with  Chart1.Series[ CurClassifier ] do begin
      Clear;
      for j := 0 to NumClasses - 1 do begin
        AddY( Classifications[j].PercentClassified,
              'Class ' + IntToStr(j + 1),
              clTeeColor);
      end;

      //Show the overall classification
      AddY((Classifications[0].Classified +
            Classifications[1].Classified +
            Classifications[2].Classified +
            Classifications[3].Classified) /
            8.25,
            'Overall',
            clTeeColor);

    end;
  end;