DIPLOM (694757), страница 3

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 3)

Рис. 3.

Рис. 4.

Рис. 5.

Рис. 6.

Рис. 7.

Приложение 2.

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

unit UPerc;

interface

uses

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

Percept_Field, StdCtrls, Buttons, ExtCtrls;

const InputLayerUnits=35;

OutputLayerUnits=2;

eta=0.05;

epsilon=0.000001;

numberpatterns=36;

type

TFrmPerceptron = class(TForm)

Percept_FieldPerc: TPercept_Field;

GroupBoxTrain: TGroupBox;

GroupBoxInit: TGroupBox;

ComboBoxABC: TComboBox;

ComboBoxDigits: TComboBox;

BtnNext: TButton;

BitBtnClose: TBitBtn;

EditNumPat: TEdit;

LabelNumPat: TLabel;

GroupBoxRec: TGroupBox;

LabelInput: TLabel;

BtnOutput: TButton;

LabelOdd: TLabel;

RadioGroupTarget: TRadioGroup;

RadioButtonOdd: TRadioButton;

RadioButtonEven: TRadioButton;

LabelOr: TLabel;

LabelEven: TLabel;

procedure ComboBoxABCChange(Sender: TObject);

procedure ComboBoxDigitsChange(Sender: TObject);

procedure Percept_FieldPercMouseDown(Sender: TObject;

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

procedure BitBtnCloseClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure BtnNextClick(Sender: TObject);

procedure BtnOutputClick(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

FrmPerceptron: TFrmPerceptron;

var

w:array[1..OutputLayerUnits,1..InputLayerUnits] of real;

indexBtnNextClick:byte;

activation:array[1..OutputLayerUnits] of real;

OutputLayerOutput:array[1..OutputLayerUnits] of shortint;

target:array[1..numberpatterns,1..OutputLayerUnits] of shortint;

v:array[1..numberpatterns,1..InputLayerUnits] of shortint;

implementation

{$R *.DFM}

procedure TFrmPerceptron.Percept_FieldPercMouseDown(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_FieldPerc.UnitHorizontal;

V:=Percept_FieldPerc.UnitVertical;

for m :=1 to Percept_FieldPerc.UnitRectVert do

begin

for k :=1 to Percept_FieldPerc.UnitRectHorz do

begin

if (XL) and (YT) then

begin

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

if (Button=mbLeft) and

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

begin

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

end

else

if (Button=mbRight) and

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

begin

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

end;

end;

inc(L,Percept_FieldPerc.UnitHorizontal);

inc(H,Percept_FieldPerc.UnitHorizontal);

end;

inc(T,Percept_FieldPerc.UnitVertical);

inc(V,Percept_FieldPerc.UnitVertical);

L:=0;

H:=Percept_FieldPerc.UnitHorizontal;

end;

end;

procedure TFrmPerceptron.BitBtnCloseClick(Sender: TObject);

begin

Close;

end;

procedure TFrmPerceptron.FormCreate(Sender: TObject);

var i,j:byte;

rand:real;

begin

//numberpatterns:=2;//10;

EditNumPat.Text:=inttostr(numberpatterns);

BtnNext.Font.Color:=clRed;

indexBtnNextClick:=0;

LabelInput.Visible:=False;

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

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

for i := 1 to OutputLayerUnits do

begin

for j := 1 to InputLayerUnits do

begin

rand:=Random-0.5;

w[i,j]:=rand;

end;

end;

end;

procedure TFrmPerceptron.BtnNextClick(Sender: TObject);

var i,j,m:byte;

sum:real;

neterror,err:real;

error:array[1..OutputLayerUnits] of real;

stop:boolean;

krandom:integer;

begin

indexBtnNextClick:=indexBtnNextClick+1;

for m:=1 to InputLayerUnits do begin

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

begin

v[indexBtnNextClick,m]:=1;

end

else

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

begin

v[indexBtnNextClick,m]:=-1;

end;

end;

// ******************ODD or EVEN*********************

if RadioButtonOdd.Checked then

begin

target[indexBtnNextClick,1]:=1;

target[indexBtnNextClick,2]:=-1;

end

else

if RadioButtonEven.Checked then

begin

target[indexBtnNextClick,1]:=-1;

target[indexBtnNextClick,2]:=1;

end;

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

if (indexBtnNextClick+1)=numberpatterns then

begin

BtnNext.Caption:='last';

end

else

begin

if (indexBtnNextClick)=numberpatterns then

begin

BtnNext.Font.Color:=clWindowText;

BtnNext.Caption:='finished';

LabelInput.Font.Color:=clRed;

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

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 (XL) and (YT) 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;

Характеристики

Список файлов реферата