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