LabelInput.Visible:=True;

end

else

begin

BtnNext.Caption:='next';

end;

end;

//*********************MAIN*******************************

if (indexBtnNextClick)=numberpatterns then

begin

repeat

stop:=false;

for m := 1 to numberpatterns do

begin

for i := 1 to OutputLayerUnits do

begin

sum:=0;

for j := 1 to InputLayerUnits do

begin

sum:=sum+w[i,j]*v[m,j];

end;

activation[i]:=sum;

if sum>=0 then

begin

OutputLayerOutput[i]:=1;

end

else

begin

OutputLayerOutput[i]:=-1;

end;

end;

neterror:=0;

for i := 1 to OutputLayerUnits do

begin

err:=target[m,i]-activation[i];

error[i]:=err;

neterror:=neterror+0.5*sqr(err);

end;

if neterror<epsilon then

begin

stop:=true;

end;

end;

if not stop then //обучение

begin

Randomize;

for krandom := 1 to 10*numberpatterns do

begin

m:=1+Round(Random(numberpatterns));

for i := 1 to OutputLayerUnits do

begin

sum:=0;

for j := 1 to InputLayerUnits do

begin

sum:=sum+w[i,j]*v[m,j];

end;

activation[i]:=sum;

if sum>=0 then

begin

OutputLayerOutput[i]:=1;

end

else

begin

OutputLayerOutput[i]:=-1;

end;

end;

neterror:=0;

for i := 1 to OutputLayerUnits do

begin

err:=target[m,i]-activation[i];

error[i]:=err;

neterror:=neterror+0.5*sqr(err);

end;

for i := 1 to OutputLayerUnits do

begin

for j := 1 to InputLayerUnits do

begin

w[i,j]:=w[i,j]+eta*error[i]*v[m,j];

end;

end;

end;

end;//if

until stop;//end;

end; // if

end;

procedure TFrmPerceptron.BtnOutputClick(Sender: TObject);

var z:array[1 InputLayerUnits] of shortint;

m,i,j:byte;

Output:array[1 InputLayerUnits] of real;

sum:real;

begin

for m:=1 to InputLayerUnits do begin

if (Percept_FieldPerc.Brushes[m]=Percept_FieldPerc.RectBrush) then

begin

z[m]:=1;

end

else

if (Percept_FieldPerc.Brushes[m]=Percept_FieldPerc.BackGroundBrush) then

begin

z[m]:=-1;

end;

end;

for i := 1 to OutputLayerUnits do

begin

sum:=0;

for j := 1 to InputLayerUnits do

begin

sum:=sum+w[i,j]*z[j];

end;

Output[i]:=sum;

end;

if (Output[1]>Output[2]) then

begin

LabelOdd.Font.Color:=clRed;

LabelEven.Font.Color:=clWindowText;

end

else begin

if (Output[2]>Output[1]) then

begin

LabelEven.Font.Color:=clRed;

LabelOdd.Font.Color:=clWindowText;

end;

end;

end;

end.

Программа, моделирующая сеть обратного распространения

unit UBack;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

StdCtrls, Percept_Field, Buttons, ExtCtrls;

const FirstLayerUnits=35;

SecondLayerUnits=20;

ThirdLayerUnits=2;

numberpatterns=36;

NumLayers=3;

epsilon=0.000001;

eta=0.05;

alpha=0.5;

type

TFrmBack = class(TForm)

BitBtnClose: TBitBtn;

Percept_FieldBack: TPercept_Field;

GroupBoxTrain: TGroupBox;

ComboBoxABC: TComboBox;

ComboBoxDigits: TComboBox;

GroupBoxInit: TGroupBox;

EditNumPat: TEdit;

LabelNumPat: TLabel;

BtnNext: TButton;

GroupBoxRec: TGroupBox;

LabelInput: TLabel;

RadioGroupTarget: TRadioGroup;

RadioButtonLetter: TRadioButton;

RadioButtonFigure: TRadioButton;

ButtonOut: TButton;

LabelFigure: TLabel;

LabelOr: TLabel;

LabelLetter: TLabel;

procedure BitBtnCloseClick(Sender: TObject);

procedure ComboBoxABCChange(Sender: TObject);

procedure ComboBoxDigitsChange(Sender: TObject);

procedure Percept_FieldBackMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure FormCreate(Sender: TObject);

procedure BtnNextClick(Sender: TObject);

procedure ButtonOutClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmBack: TFrmBack;

var

wFirstSecond:array[1 SecondLayerUnits,1 FirstLayerUnits] of real;

wSecondThird:array[1 ThirdLayerUnits,1 SecondLayerUnits] of real;

indexBtnNextClick:byte;

target:array[1 numberpatterns,1 ThirdLayerUnits] of real;

v:array[1 numberpatterns,1 FirstLayerUnits] of real;

implementation

{$R *.DFM}

procedure TFrmBack.BitBtnCloseClick(Sender: TObject);

begin

Close;

end;

procedure TFrmBack.Percept_FieldBackMouseDown(Sender: TObject;

Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

var m,k:BYTE;

correctRect:shortint;

L,T,H,V:INTEGER;

begin

L:=0;

T:=0;

H:=Percept_FieldBack.UnitHorizontal;

V:=Percept_FieldBack.UnitVertical;

for m :=1 to Percept_FieldBack.UnitRectVert do

begin

for k :=1 to Percept_FieldBack.UnitRectHorz do

begin

if (X<H) and (X>L) and (Y<V) and (Y>T) then

begin

correctRect:=k+Percept_FieldBack.UnitRectHorz*(m-1);

if (Button=mbLeft) and

(Percept_FieldBack.Brushes[correctRect]=Percept_FieldBack.BackGroundBrush) then

begin

Percept_FieldBack.Brushes[correctRect]:=Percept_FieldBack.RectBrush;

end

else

if (Button=mbRight) and

(Percept_FieldBack.Brushes[correctRect]=Percept_FieldBack.RectBrush)then

begin

Percept_FieldBack.Brushes[correctRect]:=Percept_FieldBack.BackGroundBrush;

end;

end;

inc(L,Percept_FieldBack.UnitHorizontal);

inc(H,Percept_FieldBack.UnitHorizontal);

end;

inc(T,Percept_FieldBack.UnitVertical);

inc(V,Percept_FieldBack.UnitVertical);

L:=0;

H:=Percept_FieldBack.UnitHorizontal;

end;

end;

procedure TFrmBack.FormCreate(Sender: TObject);

var i,j:byte;

rand:real;

begin

EditNumPat.Text:=inttostr(numberpatterns);

BtnNext.Font.Color:=clRed;

indexBtnNextClick:=0;

LabelInput.Visible:=False;

// *********************************************

Randomize;// случайные веса (-0.5,0.5)

for i := 1 to SecondLayerUnits do

begin

for j := 1 to FirstLayerUnits do

begin

rand:=Random-0.5;

wFirstSecond[i,j]:=rand;

end;

end;

for i := 1 to ThirdLayerUnits do

begin

for j := 1 to SecondLayerUnits do

begin

rand:=Random-0.5;

wSecondThird[i,j]:=rand;

end;

end;

end;

procedure TFrmBack.BtnNextClick(Sender: TObject);

var i,j,m:byte;

sumFirstSecond,

sumSecondThird:real;

stop:boolean;

OutputSecond:array[1 SecondLayerUnits] of real;

OutputThird:array[1 ThirdLayerUnits] of real;

output,err,neterror:real;

OutLayerError:array[1 ThirdLayerUnits] of real;

SecondLayerError:array[1 SecondLayerUnits] of real;