DIPLOM (Сравнительный анализ нейросетевых реализаций алгоритмов распознавания образов), страница 4
Описание файла
Документ из архива "Сравнительный анализ нейросетевых реализаций алгоритмов распознавания образов", который расположен в категории "". Всё это находится в предмете "кибернетика" из , которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "рефераты, доклады и презентации", в предмете "кибернетика" в общих файлах.
Онлайн просмотр документа "DIPLOM"
Текст 4 страницы из документа "DIPLOM"
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;
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 neterror begin stop:=true; end; end;//*** for m:=..... ****** //****************обучение************** if not stop then begin Randomize; for krandom:=1 to 10*numberpatterns do begin m:=1+Round(Random(numberpatterns)); //***********PROPAGATION************ 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; //*********BACKPROPAGATION************** for i := 1 to SecondLayerUnits do begin output:=OutputSecond[i]; err:=0; for j := 1 to ThirdLayerUnits do begin err:=err+wSecondThird[j,i]*OutLayerError[j]; end; SecondLayerError[i]:=output*(1-output)*err; end; for i := 1 to FirstLayerUnits do begin output:=v[m,i]; err:=0; for j := 1 to SecondLayerUnits do begin err:=err+wFirstSecond[j,i]*SecondLayerError[j]; end; FirstLayerError[i]:=output*(1-output)*err; end; //*********** for i := 1 to SecondLayerUnits do begin for j := 1 to FirstLayerUnits do begin dWeightFirstSecond[i,j]:=0; end; end; for i := 1 to ThirdLayerUnits do begin for j := 1 to SecondLayerUnits do begin dWeightSecondThird[i,j]:=0; end; end; //*********** dWeight:=0; for i := 1 to SecondLayerUnits do begin for j := 1 to FirstLayerUnits do begin output:=v[m,j]; err:=SecondLayerError[i]; dWeight:=dWeightFirstSecond[i,j]; wFirstSecond[i,j]:=wFirstSecond[i,j]+eta*err*output+alpha*dWeight; dWeightFirstSecond[i,j]:=eta*err*output; end; end; dWeight:=0; for i := 1 to ThirdLayerUnits do begin for j := 1 to SecondLayerUnits do begin output:=OutputSecond[j]; err:=OutLayerError[i]; dWeight:=dWeightSecondThird[i,j]; wSecondThird[i,j]:=wSecondThird[i,j]+eta*err*output+alpha*dWeight; dWeightSecondThird[i,j]:=eta*err*output; end; end; end;//****for krandom:=.......*********** end; until stop; end;//*** IF ******** end; procedure TFrmBack.ButtonOutClick(Sender: TObject); var m,i,j:byte; z:array[1..FirstLayerUnits] of shortint; sumFirstSecond,sumSecondThird:real; OutputSecond:array[1..SecondLayerUnits] of real; OutputThird:array[1..ThirdLayerUnits] of real; begin for m:=1 to FirstLayerUnits do begin if (Percept_FieldBack.Brushes[m]=Percept_FieldBack.RectBrush) then begin z[m]:=1; end else if (Percept_FieldBack.Brushes[m]=Percept_FieldBack.BackGroundBrush) then begin z[m]:=-1; end; end; for i := 1 to SecondLayerUnits do begin sumFirstSecond:=0; for j := 1 to FirstLayerUnits do begin sumFirstSecond:=sumFirstSecond+wFirstSecond[i,j]*z[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; if (OutputThird[1]>OutputThird[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; 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 { Private declarations } public { Public declarations } end; var FrmHop: TFrmHop; var numberpatterns,threshold:shortint; w:array[1..numberneurons,1..numberneurons] of shortint; iindex,jindex,indexBtnNextClick:byte; stop:boolean; implementation {$R *.DFM} procedure TFrmHop.Percept_FieldHopMouseDown(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_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.BackGroundBrush) then begin Percept_FieldHop.Brushes[correctRect]:=Percept_FieldHop.RectBrush; end else if (Button=mbRight) and (Percept_FieldHop.Brushes[correctRect]=Percept_FieldHop.RectBrush)then begin Percept_FieldHop.Brushes[correctRect]:=Percept_FieldHop.BackGroundBrush; end; end; inc(L,Percept_FieldHop.UnitHorizontal); inc(H,Percept_FieldHop.UnitHorizontal); end; inc(T,Percept_FieldHop.UnitVertical); inc(V,Percept_FieldHop.UnitVertical); L:=0; H:=Percept_FieldHop.UnitHorizontal; end; 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; EditNumPat.Text:=inttostr(numberpatterns); 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; begin 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 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; end; 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 i<>j 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 i<=numberneurons do begin if z[i]=y[i] then begin y[i]:=z[i]; indicator:=1; i:=i+1; end else begin indicator:=0; repeat y[i]:=z[i]; i:=i+1; until i>numberneurons; 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.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; BtnNext.Caption:='first'; for i := 1 to numberneurons do begin Percept_FieldHop.Brushes[i]:=Percept_FieldHop.BackGroundBrush; end; 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; end; end.
