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;
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;
procedure TFrmBack.Percept_FieldBackMouseDown(Sender: TObject;
var m,k:BYTE;
correctRect:shortint;
L,T,H,V:INTEGER;
L:=0;
T:=0;
H:=Percept_FieldBack.UnitHorizontal;
V:=Percept_FieldBack.UnitVertical;
for m :=1 to Percept_FieldBack.UnitRectVert do
for k :=1 to Percept_FieldBack.UnitRectHorz do
if (XL) and (YT) then
correctRect:=k+Percept_FieldBack.UnitRectHorz*(m-1);
if (Button=mbLeft) and
(Percept_FieldBack.Brushes[correctRect]=Percept_FieldBack.BackGroundBr
ush) then
Percept_FieldBack.Brushes[correctRect]:=Percept_FieldBack.RectBrush;
end
else
if (Button=mbRight) and
(Percept_FieldBack.Brushes[correctRect]=Percept_FieldBack.RectBrush)th
en
Percept_FieldBack.Brushes[correctRect]:=Percept_FieldBack.BackGroundBr
ush;
inc(L,Percept_FieldBack.UnitHorizontal);
inc(H,Percept_FieldBack.UnitHorizontal);
inc(T,Percept_FieldBack.UnitVertical);
inc(V,Percept_FieldBack.UnitVertical);
procedure TFrmBack.FormCreate(Sender: TObject);
var i,j:byte;
rand:real;
EditNumPat.Text:=inttostr(numberpatterns);
BtnNext.Font.Color:=clRed;
indexBtnNextClick:=0;
LabelInput.Visible:=False;
// *********************************************
Randomize;// случайные веса (-0.5,0.5)
for i := 1 to SecondLayerUnits do
for j := 1 to FirstLayerUnits do
rand:=Random-0.5;
wFirstSecond[i,j]:=rand;
for i := 1 to ThirdLayerUnits do
for j := 1 to SecondLayerUnits do
wSecondThird[i,j]:=rand;
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;
FirstLayerError:array[1..FirstLayerUnits] of real;
dWeightSecondThird:array[1..ThirdLayerUnits,1..SecondLayerUnits]
of real;
dWeightFirstSecond:array[1..SecondLayerUnits,1..FirstLayerUnits]
dWeight:real;
krandom:integer;
indexBtnNextClick:=indexBtnNextClick+1;
for m:=1 to FirstLayerUnits do begin
if (Percept_FieldBack.Brushes[m]=Percept_FieldBack.RectBrush)
then
v[indexBtnNextClick,m]:=1;
if
(Percept_FieldBack.Brushes[m]=Percept_FieldBack.BackGroundBrush) then
v[indexBtnNextClick,m]:=-1;
// ******************ODD or EVEN*********************
if RadioButtonFigure.Checked then
target[indexBtnNextClick,1]:=0.9;//1;
target[indexBtnNextClick,2]:=0.1;//-1;
if RadioButtonLetter.Checked then
target[indexBtnNextClick,1]:=0.1;//-1;
target[indexBtnNextClick,2]:=0.9;//1;
// ***************************************************
if (indexBtnNextClick+1)=numberpatterns then
BtnNext.Caption:='last';
if (indexBtnNextClick)=numberpatterns then
BtnNext.Font.Color:=clWindowText;
BtnNext.Caption:='finished';
LabelInput.Font.Color:=clRed;
LabelInput.Visible:=True;
BtnNext.Caption:='next';
//***********************MAIN**************************
repeat
stop:=false;
for m := 1 to numberpatterns do
sumFirstSecond:=0;
sumFirstSecond:=sumFirstSecond+wFirstSecond[i,j]*v[m,j];
OutputSecond[i]:=1/(1+exp(-sumFirstSecond));
sumSecondThird:=0;
sumSecondThird:=sumSecondThird+wSecondThird[i,j]*OutputSecond[j];
OutputThird[i]:=1/(1+exp(-sumSecondThird));
neterror:=0;
output:=OutputThird[i];
err:=target[m,i]-output;
OutLayerError[i]:=output*(1-output)*err;
neterror:=neterror+0.5*sqr(err);
if neterrorOutputThird[2]) then
LabelFigure.Font.Color:=clRed;
LabelLetter.Font.Color:=clWindowText;
else begin
if (OutputThird[2]>OutputThird[1]) then
LabelLetter.Font.Color:=clRed;
LabelFigure.Font.Color:=clWindowText;
end.
Программа, моделирующая сеть Хопфилда
unit UHop;
interface
uses
Windows, Messages, SysUtils,
Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls, Buttons, Percept_Field;
const numberneurons=35;
TFrmHop = class(TForm)
GrpBoxTraining: TGroupBox;
GrpBoxInitial: TGroupBox;
EditThres: TEdit;
LabelThres: TLabel;
GrpBoxRec: TGroupBox;
BtnOutput: TButton;
BitBtnCancel: TBitBtn;
ButtonDelay: TButton;
Percept_FieldHop: TPercept_Field;
ButtonRetrain: TButton;
procedure Percept_FieldHopMouseDown(Sender: TObject;
procedure EditNumPatChange(Sender: TObject);
procedure EditThresChange(Sender: TObject);
procedure BtnOutputClick(Sender: TObject);
procedure BitBtnCancelClick(Sender: TObject);
procedure ButtonDelayClick(Sender: TObject);
procedure ButtonRetrainClick(Sender: TObject);
FrmHop: TFrmHop;
var numberpatterns,threshold:shortint;
w:array[1..numberneurons,1..numberneurons] of shortint;
iindex,jindex,indexBtnNextClick:byte;
procedure TFrmHop.Percept_FieldHopMouseDown(Sender: TObject;
H:=Percept_FieldHop.UnitHorizontal;
V:=Percept_FieldHop.UnitVertical;
for m :=1 to Percept_FieldHop.UnitRectVert do
for k :=1 to Percept_FieldHop.UnitRectHorz do
correctRect:=k+Percept_FieldHop.UnitRectHorz*(m-1);
(Percept_FieldHop.Brushes[correctRect]=Percept_FieldHop.BackGroundBrus
h) then
Percept_FieldHop.Brushes[correctRect]:=Percept_FieldHop.RectBrush;
(Percept_FieldHop.Brushes[correctRect]=Percept_FieldHop.RectBrush)then
Percept_FieldHop.Brushes[correctRect]:=Percept_FieldHop.BackGroundBrus
h;
inc(L,Percept_FieldHop.UnitHorizontal);
inc(H,Percept_FieldHop.UnitHorizontal);
inc(T,Percept_FieldHop.UnitVertical);
inc(V,Percept_FieldHop.UnitVertical);
procedure TFrmHop.BitBtnCloseClick(Sender: TObject);
procedure TFrmHop.EditThresChange(Sender: TObject);
threshold:=strtoint(EditThres.Text);
procedure TFrmHop.EditNumPatChange(Sender: TObject);
numberpatterns:=strtoint(EditNumPat.Text);
procedure TFrmHop.FormCreate(Sender: TObject);
threshold:=0;
EditThres.Text:=inttostr(threshold);
numberpatterns:=3;
for i:=1 to numberneurons do begin
for j:=1 to numberneurons do begin
w[i,j]:=0;
procedure TFrmHop.BtnNextClick(Sender: TObject);
v:array[1..numberneurons] of shortint;
for m:=1 to numberneurons do begin
if (Percept_FieldHop.Brushes[m]=Percept_FieldHop.RectBrush) then
v[m]:=1;
if (Percept_FieldHop.Brushes[m]=Percept_FieldHop.BackGroundBrush)
v[m]:=0;
for i:=1 to numberneurons-1 do begin
for j:=i+1 to numberneurons do begin
w[i,j]:=w[i,j]+(2*v[i]-1)*(2*v[j]-1);
w[j,i]:=w[i,j];
procedure TFrmHop.BtnOutputClick(Sender: TObject);
var i,j,m,indicator:byte;
y,z:array[1..numberneurons] of shortint;
wij,wijthres:shortint;
k:longint;
z[m]:=1;
z[m]:=0;
for m := 1 to numberneurons do
y[m]:=z[m];
indicator:=0;
while indicator=0 do begin
wij:=0;
if i<>j then
wij:=wij+w[i,j]*z[j];
wijthres:=wij-threshold;
if wijthres>=0 then
z[i]:=1
z[i]:=0;
i:=1;
while inumberneurons;
end;{while}
if z[m]=1 then
Percept_FieldHop.Brushes[m]:=Percept_FieldHop.RectBrush;
if z[m]=0 then
Percept_FieldHop.Brushes[m]:=Percept_FieldHop.BackGroundBrush;
Application.ProcessMessages;
until stop;
procedure TFrmHop.BitBtnCancelClick(Sender: TObject);
BtnNext.Caption:='first';
for i := 1 to numberneurons do
Percept_FieldHop.Brushes[i]:=Percept_FieldHop.BackGroundBrush;
procedure TFrmHop.ButtonDelayClick(Sender: TObject);
stop:=true;
procedure TFrmHop.ButtonRetrainClick(Sender: TObject);
w[i,j]:=w[i,j]-(2*v[i]-1)*(2*v[j]-1);
Страницы: 1, 2, 3, 4, 5