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;
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
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.
Программа, моделирующая сеть обратного распространения
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)
Рефераты и/или содержимое рефератов предназначено исключительно для ознакомления, без целей коммерческого использования. Все права в отношении рефератов и/или содержимого рефератов принадлежат их законным правообладателям. Любое их использование возможно лишь с согласия законных правообладателей. Администрация сайта не несет ответственности за возможный вред и/или убытки, возникшие или полученные в связи с использованием рефератов и/или содержимого рефератов.