Распознавание образов по методу Хебба

Автор Administrator

01:08:2008 г.

Образы для распознавания:

101 010

010 101

101 010

Листинг программы:
program HEBB;
uses CRT;
type mas=array [1..5,1..5] of real;
{vec=array [1..2] of real;}
bit = 0..1;{0-белая клетка, 1-черная клетка}

const ETA = 0.01; {коэффициент обучения}
NUM_TRAINING_PATTERNS = 2;
ipt:array [1..NUM_TRAINING_PATTERNS,1..4,1..3] of bit=
( ((1,0,1),(0,1,0),(0,1,0),(1,0,1)), {Крестик}
((0,1,0),(1,0,1),(1,0,1),(0,1,0)));{Нолик}
opt:array [1..2] of real=((0.9),(0.1));
var
strengths: mas;
ipt_TEST : mas;
train_type : integer;
training_run,Epoch,i: integer;
t:byte;
procedure initialise_strengths{инициализация связей};
var i,j : integer;
begin
for i:=1 to 4 do
for j:=1 to 3 do
strengths[i,j]:=random(1000)/1000
end;
procedure Show_strengths{вывод на экран матрицы весовых коэффициентов};
var i: integer;
begin
for i:=1 to 4 do
Writeln ('W[',i,',1]=',strengths[i,1]:3:2,' W[',i,',2]=',strengths[i,2]:3:2,' W[',i,',3]=',strengths[i,3]:3:2);
end;

procedure update_strengths{процедура обновления весовых коэффициентов};
var i,j,k : integer;
begin
for k:=1 to NUM_TRAINING_PATTERNS do
for i:=1 to 4 do
for j:=1 to 3 do strengths[i,j]:=strengths[i,j]+ ETA * ipt[k,i,j] * (2*opt[k]-1);
if strengths[i,j] > 1 then strengths[i,j]:=1;
if strengths[i,j] < 0 then strengths[i,j]:=0;
end;
procedure run_net{получение результата};
var i,j : integer;
sum : real;
begin
sum:=0;
for i:=1 to 4 do
for j:=1 to 3 do sum := sum + strengths[i,j] * ipt_TEST[i,j];
writeln('Ответ сети',sum);
if sum > 0.5 then writeln('сеть классифицирует образ как "Крестик"')
else writeln('сеть классифицирует образ как "Нолик"')
end;

procedure input_pattern {Ввод образа для тестирования сети};
var i,j: integer;
begin
Writeln('Введите образ для распознавания (0-белая клетка,1-черная клетка)');
for i:=1 to 4 do
for j:=1 to 3 do
begin
Writeln ('ВВЕДИТЕ ipt_TEST[',i,',',j,']');
Read (ipt_TEST[i,j]);
end;
end;
Begin
CLRSCR;
initialise_strengths;
Writeln('Матрица весовых коэффициентов после инициализации');
Writeln;
Show_strengths;
Writeln('Введите количество циклов обучения (10000)');
Read(Epoch);
for training_run := 1 to Epoch do update_strengths;
Writeln;
Writeln('Матрица весовых коэффициентов после процесса обучения');
Writeln;
Show_strengths;
repeat
input_pattern;
run_net;
writeln;
Write('Завершить программу? 1-да, 2-нет :');
Readln(t);
UNTIL t = 1;
end.

японское порно на сайте . Купить шкафы. гидра зеркало, onion