close

Вход

Забыли?

вход по аккаунту

?

Лаб1 (4)

код для вставкиСкачать
Балтийский государственный технический университет "Военмех" им. Д.Ф. Устинова.
Лабораторная работа №1
по дисциплине:
Представление знаний в информационных системах
на тему: Обучение нейронной сети методом обратного распространения ошибки Выполнил: Студент группы Н-293 Иванов М.В.
Проверил:
Преподаватель кафедры И3
Войнов С.Б.
Санкт-Петербург 2013г.
Задание на лабораторную работу: Разработать программу, реализующую алгоритм обучения нейронной сети методом обратного распространения ошибки.
Описание варианта задания: В данном варианте лабораторной работы в качестве обучающих образов используются следующие рисунки (рис.1):
4.2.3
Объезд препятствия справа или слева
4.3
Круговое движение
4.4
Велосипедная дорожка
4.5
Пешеходная дорожка
Рис.1 Обучающие образы
Параметры обучаемой сети: Общая конфигурация нейронной сети представлена на рисунке 2:
Обучаемая сеть состоит из 3-х слоев. 1-й слой содержит 6 нейронов, 2-й слой - 5 нейронов, 3-й слой - 4 нейрона.
Значения наклонов сигмоид функций активаций на каждом уровне нейросети: 0.6 - 1-й слой; 0.8 - 2-й слой; 2 - 3-й слой.
Скорость обучения нейросети равна 0.5.
Максимальное количество эпох обучения: 500;
Параметры обучаемой сети:
График изменения ошибки обучения и ошибки тестирования представлен на рисунке 3:
Рис.3 График изменений значений ошибок обучения и тестирования Приложение:
Программная реализация обучения нейронной сети методом обратного распространения ошибок выполнена в среде Turbo Pascal 7.0 на эмуляторе ОС MS-DOS DosBox v0.74.
Программный код реализации:
PROGRAM ObrOsh;
USES CRT;
CONST X=16; {Razmernost matrizy kartinki}
TYPE
Arr=array[1..X] of real; {tip massiv}
Matr=array[1..X] of Arr; {tip matriza, dlya predstavleniya obrazov}
TTeachPics=array[1..4] of Matr; {4 obu4ayushix obraza}
TTestPics=array[1..8] of Matr; {8 testovyx obrazcov}
Arr2=array[1..X*X] of real; {tip massiv, dlya preobrazovaniy}
Arr3=array[1..4] of real; {tip massiv dlya kontrolya oshibok}
Matr2=array[1..4] of Arr3; {Matriza gelaemyx vyxodov}
Tarr=array[1..1] of real; {tip massiv iz odnogo elementa}
Tarr2=array[1..1] of integer; {dlya razmernostey neiroseti}
Tdarr=^Tarr; {dinami4eskiy massiv}
Tdarr2=^Tarr2;
Tmatr=array[1..1] of Tdarr;{tip matriza iz odnogo elementa}
Tdmatr=^Tmatr; {dinami4eskaya matriza}
TNeuron = record
w:Tdarr; {Vesa signalov}
sum:real; {Summa signalov}
comp:Tdarr; {Proizvedenie signalov i vesov}
y:real; {Vyxodnoy signal}
Mistake:real; {Oshibka oby4eniya (dlya algoritma obratnoy oshibki)}
Locked:boolean;{Indikator blokirovki neirona}
end;
TNeurArr=array[1..1] of TNeuron; {tip massiv iz odnogo elementa}
TdNeurArr=^TNeurArr; {dynami4eskiy massiv Neironov}
TNeurMatr=array[1..1] of TdNeurArr;{tip matriza iz odnogo elementa}
TdNeurMatr=^TNeurMatr; {dynami4eskaya matriza Neironov,}
{voploshenie Neiroseti}
VAR M,N:integer; {Razmernost matrizy}
i,j,k,l:integer; {iterazii}
disruption:integer; {Stepen povregdeniya kartinki}
No:integer; {No obrazca}
Count:integer; {Koli4estvo epox obu4eniya}
Speed:real; {Skorost obu4eniya}
Bord:real; {Minimalnaya oshibka seti}
Aligns:Tdarr; {Massiv naklonov sigmoid}
Outputs:Matr2; {Gelaemye vyxody}
Dimensions:Tdarr2; {Koli4estvo neironov na kagdom urovne}
EntrySignals:Arr2; {Preobrazovannaya kartinka v signaly
na vxode neiroseti}
Nerve:TdNeurMatr; {Neiroset}
TeachPics:TTeachPics; {Obu4ayushie obrazy}
TestPics:TTestPics; {Testovye obrazy}
F:text; {file dlya 4teniya}
F2:text; {file dlya vyvoda}
Eteach:Arr3; {Oshibka obu4eniya}
ETest:Arr3; {Oshibka testirovaniya}
Esumteach:real; {Summarnaya oshibka obu4eniya}
Esumtest:real; {Summarnaya oshibka testirovaniya}
Esumteachbuf:real; {Dlya kontrolya obu4eniya}
Esumtestbuf:real; {Dlya kontrolya testa}
Mode:boolean; {flag pereklu4eniya regima obu4eniya/testa}
flag:boolean; {flag ostanovki algoritma}
procedure seePicture(Teach:Boolean; N:integer); {Vyvodim kartinku na ekran}
var i,j:integer;
begin
clrscr;
if Teach then writeln('Obu4ayushiy obraz No',N,':')
else writeln('Testoviy obraz No',N,':');
for i:=1 to X do
begin
writeln;
for j:=1 to X do
begin
if Teach then {Esli kartinka iz Obu4ayusheiy vyborki}
begin
if (TeachPics[N,i,j] = 0) then {Esli belyi zvet}
textcolor(White)
else if (TeachPics[N,i,j] = 1) then {Esli 4erniy zvet}
textcolor(DarkGray)
else if (TeachPics[N,i,j] <> 0.7) then {Esli siniy zvet}
textcolor(Blue);
end
else {Esli kartinka iz testovoy vyborki}
begin
if (TestPics[N,i,j] = 0) then {Esli belyi zvet}
textcolor(White)
else if (TestPics[N,i,j] = 1) then {Esli 4erniy zvet}
textcolor(DarkGray)
else if (TestPics[N,i,j] <> 0.7) then {Esli siniy zvet}
textcolor(Blue);
end;
write('0 ');
end;
end;
textcolor(LightGray);
writeln; readkey;
end;
procedure MakeTestPicture(Disr,NumTeach,NumTest:integer);
{Delaem testoviy obraz}
var i,x,y:integer;
begin
randomize;
TestPics[NumTest]:=TeachPics[NumTeach]; {Kopiruem kartinku
dlya posleduyushego sozdaniya testovyx obrazov}
for i:=1 to Disr do {Iteraziya po stepeni povregdeniya obraza}
begin
x:=random(16)+1; y:=random(16)+1;
if(TestPics[NumTest,x,y] = 0) then i:=i-1
else TestPics[Numtest,x,y]:= 0;
end;
end;
procedure MakeEntrySignals(Picture:Matr); {Preobrazovanie kartinki v signaly}
var i,j,k:integer;
begin
k:=0;
for i:=1 to X do
for j:=1 to X do
begin
k:=k+1;
EntrySignals[k]:=Picture[i,j];
end;
end;
Procedure seeWeights;
var i,j,k:integer;
begin
for j:=1 to N do {Idem po stolbzam (urovnyam neiroseti)}
for i:=1 to M do {Idem po strokam (neiro-uzlam)}
if (not Nerve^[i]^[j].Locked) then {Esli neiron ne zablokirovan}
begin
if (j=1) then {esli sloy - 1-y}
for k:=1 to X*X do
begin
writeln('[',i,',',j,',',k,']:',Nerve^[i]^[j].w^[k]:1:1);
delay(5);
end
else {esli sloy - ne 1-y}
for k:=1 to Dimensions^[j-1] do
{do razmernosti predydushego sloya}
writeln('[',i,',',j,',',k,']:',Nerve^[i]^[j].w^[k]:1:1);
writeln;
readkey;
end;
end;
Procedure seeOutput(No:integer);
var i:integer;
begin
writeln('Signaly obraza No ',No,' na vyxode neiroseti:');
for i:=1 to Dimensions^[N] do
write(Nerve^[i]^[N].y:1:1,' ');
writeln;
readkey;
end;
function FuncAct(sum:real; a:real):real; {Funkziya aktivazii neirona}
begin FuncAct:=1/(1+exp(-a*sum));
end;
function delta(y,a,t:real):real;{Vy4islenie oshibki obu4eniya/testa}
{dlya vyxodnogo sloya}
begin delta:=(y-t)*a*y*(1-y);
end;
function delta2(sum,y,a,t:real):real;
{Vy4islenie oshibki obu4eniya/testa}
{dlya sloev posle vyxodnogo}
begin delta2:=sum*a*y*(1-y);
end;
procedure ForwardAlg; {Algoritm pryamogo rasprostraneniya}
var i,j,k:integer;
begin
for j:=1 to N do {Idem po stolbzam (urovnyam neiroseti)}
for i:=1 to M do {Idem po strokam (neiro-uzlam)}
if (not Nerve^[i]^[j].Locked) then {Esli neiron ne zablokirovan}
begin
Nerve^[i]^[j].sum:=0;
if (j=1) then {esli sloy - 1-y}
for k:=1 to X*X do
begin
Nerve^[i]^[j].sum:=Nerve^[i]^[j].sum+EntrySignals[k]*Nerve^[i]^[j].w^[k];
{Polu4aem summarniy signal}
Nerve^[i]^[j].comp^[k]:=0;
end
else {esli sloy - ne 1-y}
for k:=1 to Dimensions^[j-1] do
{do razmernosti predydushego sloya}
begin
Nerve^[i]^[j].sum:=Nerve^[i]^[j].sum+Nerve^[k]^[j-1].y*Nerve^[i]^[j].w^[k];
{Polu4aem summarniy signal}
Nerve^[i]^[j].comp^[k]:=0;
end;
Nerve^[i]^[j].y:=FuncAct(Nerve^[i]^[j].sum,Aligns^[j]);
{Propuskaem summarniy signal 4erez funkziyu aktivazii,}
{Polu4aem vyxodnoy signal}
end;
end;
procedure AlgBackMis(No:integer);
{Algoritm obratnogo pasprostraneniya oshibki}
var i,j,k:integer;
buf:real;
begin
for j:=N downto 1 do
for i:=1 to M do
if (not Nerve^[i]^[j].Locked) then {Esli neiron ne zablokirovan}
begin
Nerve^[i]^[j].sum:=0;
if (j=N) then {esli sloy - vyxodnoy}
Nerve^[i]^[j].Mistake:=delta(Nerve^[i]^[j].y,Aligns^[j],Outputs[i,No])
else {esli sloy - ne vyxodnoy}
begin
for k:=1 to Dimensions^[j+1] do
{Berem dannye iz vyshestoyashego urovnya}
Nerve^[i]^[j].sum:=Nerve^[i]^[j].sum+Nerve^[k]^[j+1].comp^[i];
{S4itaem summu proizvedeniy}
Nerve^[i]^[j].Mistake:=delta2(Nerve^[i]^[j].sum,Nerve^[i]^[j].y,Aligns^[j],Outputs[i,No]);
{Oshibka vy4islena}
end;
{Polu4aem predvaritelnoe proizvedenie dlya posleduyushego rass4eta}
if (j<>1) then {Esli sloy - ne 1-y}
for k:=1 to Dimensions^[j-1] do
{Smotrim na razmernost sleduyushego urovnya}
Nerve^[i]^[j].comp^[k]:=Nerve^[i]^[j].Mistake*Nerve^[i]^[j].w^[k];
end;
end;
Procedure CorrectW; {Korrektirovka vesov posle 2-x algoritmov}
var i,j,k:integer;
begin
for j:=1 to N do {Idem po stolbzam (urovnyam neiroseti)}
for i:=1 to M do {Idem po strokam (neiro-uzlam)}
if (not Nerve^[i]^[j].Locked) then {Esli neiron ne zablokirovan}
if (j=1) then {esli sloy - 1-y}
for k:=1 to X*X do
Nerve^[i]^[j].w^[k]:=Nerve^[i]^[j].w^[k]-(Speed*Nerve^[i]^[j].Mistake*EntrySignals[k])
{Korrektiruem signal}
else {esli sloy - ne 1-y}
for k:=1 to Dimensions^[j-1] do
{do razmernosti predydushego sloya}
Nerve^[i]^[j].w^[k]:=Nerve^[i]^[j].w^[k]-(Speed*Nerve^[i]^[j].Mistake*Nerve^[k]^[j-1].y);
{Korrektiruem signal}
end;
procedure Prepare; {Vydelenie pamyati pod struktury i}
{Zapolnenie vesov slu4ainymi 4islami}
var i,j,k,Z:integer;
begin
writeln('Zadayte Razmernost NeiroSeti: N x M,');
writeln('gde N - 4islo urovney, M - Max. 4islo neironov na urovne');
readln(N,M);
randomize;
getmem(Aligns,N*sizeof(Tarr));
getmem(Dimensions,N*sizeof(Tarr2));
getmem(Nerve,N*10*sizeof(TNeurMatr));
for i:=1 to M do
getmem(Nerve^[i],M*10*sizeof(TNeuron));
writeln('Ukagite 4islo neironov na kagdom iz sloev:');
for j:=1 to N do
begin
if (j=N) then Dimensions^[j]:=4
else
begin
writeln('Sloy ',j,':');
readln(Z);
Dimensions^[j]:=Z;
end;
for i:=1 to M do
if (i>Dimensions^[j]) then Nerve^[i]^[j].Locked:=true
else
begin
Nerve^[i]^[j].Locked:=false;
Nerve^[i]^[j].y:=0;
Nerve^[i]^[j].Mistake:=0;
if (j=1) then
begin
getmem(Nerve^[i]^[j].w,X*X*10*sizeof(Tarr));
getmem(Nerve^[i]^[j].comp,X*X*10*sizeof(Tarr));
for k:=1 to X*X do
Nerve^[i]^[j].w^[k]:=random*2-1;
end
else
begin
getmem(Nerve^[i]^[j].w,Dimensions^[j]*10*sizeof(Tarr));
getmem(Nerve^[i]^[j].comp,Dimensions^[j]*10*sizeof(Tarr));
for k:=1 to Dimensions^[j-1] do
Nerve^[i]^[j].w^[k]:=random*2-1;
end;
end;
end;
writeln('Vvedite Koeffizienty naklona sigmoidy na urovnyax neiroseti:');
for j:=1 to N do
begin
writeln('Uroven ',j);
readln(Aligns^[j]);
end;
for j:=1 to 4 do {Zadaem gelaemye vyxody}
for i:=1 to 4 do
if (i=j) then Outputs[i,j]:=1
else Outputs[i,j]:=0;
writeln('Skorost obu4eniya= ?');
readln(Speed);
Esumteach:=0;
Esumtest:=0;
Esumteachbuf:=99;
Esumtestbuf:=99;
end;
procedure sumMistakes(Mode:boolean; No:integer);
{Vy4islenie summarnoy oshibki seti po odnomu obrazu}
var i,j,k:integer;
sum:real;
buf:real;
begin
sum:=0; {Promeguto4naya summa po vsem 4-m vyxodam neiroseti}
if Mode then {Esli obu4enie}
begin
for i:=1 to Dimensions^[N] do
begin
Eteach[i]:=Nerve^[i]^[N].y-Outputs[i,No]; {Oshibka odnogo vyxoda}
buf:=sum;
sum:=sum+Eteach[i];
end;
Esumteach:=Esumteach+sum; {Polnaya summa po vsem 4-m obrazam,}
{Ispolzuetsya vne podprogrammy}
end
else {Esli testirovanie}
begin
for i:=1 to Dimensions^[N] do
begin
Etest[i]:=Nerve^[i]^[N].y-Outputs[i,No]; {Oshibka odnogo vyxoda}
buf:=sum;
sum:=sum+Etest[i];
end;
Esumtest:=Esumtest+sum; {Polnaya summa po vsem 8-mi obrazam,}
{Ispolzuetsya vne podprogrammy}
end;
end;
function ExitGoal:boolean; {Kriteriy ostanova algoritma 1}
begin
if ((Esumteachbuf<Esumteach) or (Esumtestbuf<Esumtest)) then
begin
writeln('Set pereobu4ena');
readkey;
ExitGoal:=true;
end {Zakan4ivaem algoritm, esli predydushaya oshibka bolshe tekushey}
else
ExitGoal:=false {Ina4e prodolgaem algoritm}
end;
function ExitGoal2(Border:real):boolean;
{Kriteriy ostanova algoritma 2}
begin
if ((abs(Esumteach)<Border) or (abs(Esumtest)<Border)) then
begin
writeln('Set pereobu4ena');
readkey;
ExitGoal2:=true;
end {Zakan4ivaem algoritm, esli predydushaya oshibka bolshe tekushey}
else
ExitGoal2:=false {Ina4e prodolgaem algoritm}
end;
BEGIN {*******************************GLAVNAYA PROGRAMMA}
{******************************S4ityvaem kartinki iz failov}
clrscr;
assign(F,'pic1-423.txt');
reset(F);
for i:=1 to X do
for j:=1 to X do
read(F,TeachPics[1,i,j]);
close(F);
assign(F,'pic2-43.txt');
reset(F);
for i:=1 to X do
for j:=1 to X do
read(F,TeachPics[2,i,j]);
close(F);
assign(F,'pic3-44.txt');
reset(F);
for i:=1 to X do
for j:=1 to X do
read(F,TeachPics[3,i,j]);
close(F);
assign(F,'pic4-45.txt');
reset(F);
for i:=1 to X do
for j:=1 to X do
read(F,TeachPics[4,i,j]);
close(F);
{************************************Prosmatrivaem kartinki}
for i:=1 to 4 do
seepicture(true,i);
{************************************Sozdaem 8 testovyx obrazov}
l:=1;
for i:=1 to 4 do
for j:=1 to 2 do
begin
clrscr;
writeln('SOZDANIE TESTOVOGO OBRAZA No',l);
writeln('IZ OBU4AYUSHEGO OBRAZA No',i);
writeln('Ukagite stepen povregdeniya kartinki(1-125)');
readln(disruption);
MakeTestPicture(disruption,i,l);
seepicture(true,i);
seepicture(false,l);
l:=l+1;
end;
{******************Vydelenie pamyati pod strukturu neiroseti}
prepare;
{writeln('Zadayte minimalnoe zna4enie oshibki seti');
readln(Bord);}
writeln('Ukagite koli4estvo epox obu4eniya (Max.=500):');
readln(Count);
{******************Algoritm}
assign(F2,'Graphic.txt');
rewrite(F2);
flag:=false;
for i:=1 to Count do {Max. koli4estvo epox obu4eniya: 500}
begin
write(F2,i,' ');
clrscr;
Mode:=true;
writeln('EPOHA OBU4ENIYA No ',i,':');
for No:=1 to 4 do {Obu4ayushaya vyborka}
begin
{************************************Pryamoy algoritm}
MakeEntrySignals(TeachPics[No]);
ForwardAlg;
{seeOutput(No);}
{*************************Vy4islyaem oshibku obu4eniya i testirovaniya}
sumMistakes(Mode,No);
{***************************Algoritm obratnogo rasprostraneniya oshibki}
AlgBackMis(No);
{************************************Korrektiruem vesa}
CorrectW;
end;
write(F2,Esumteach:1:2,' ');
Mode:=false;
for No:=1 to 8 do {Testovaya vyborka}
begin
{************************************Pryamoy algoritm}
MakeEntrySignals(TestPics[No]);
ForwardAlg;
{seeOutput(No);}
{*************************Vy4islyaem oshibku obu4eniya i testirovaniya}
sumMistakes(Mode,No);
end;
writeln(F2,Esumtest:1:2);
{if ExitGoal2(Bord) then break {Kriteriy ostanova algoritma}
{else
begin
Esumteach:=0;
Esumtest:=0;
end;}
Esumteach:=0;
Esumtest:=0;
end;
{*************************Poslednyaa proverka sistemy}
writeln('FINALNOE TESTIROVANIE');
writeln('Pokagite sisteme 4 obraza');
for j:=1 to 4 do
begin
writeln('Obraz: ',j,' iz 4');
writeln('Pokazat sisteme obraz No:');
readln(No);
{************************************Pryamoy algoritm}
MakeEntrySignals(TeachPics[No]);
ForwardAlg;
seeOutput(No);
end;
{************************************Zavershaem programmu}
close(F2);
writeln('Rass4et okon4en');
readkey;
freemem(Aligns,N*sizeof(Tarr));
freemem(Dimensions,N*sizeof(Tarr2));
freemem(Nerve,N*10*sizeof(TNeurMatr));
END.
Программное представление рисунков выполнено с помощью числовых матриц, находящихся в отдельных файлах (0 - белый пиксель, 1 - черный, 0.7 - синий ).
Вывод графиков изменений ошибок обучения и тестирования выполнен в среде Borland Delphi 7.0.
Программный код реализации вывода графиков:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, TeEngine, Series, ExtCtrls, TeeProcs, Chart, StdCtrls;
type
TForm1 = class(TForm)
Chart1: TChart;
Series1: TLineSeries;
Series2: TLineSeries;
Label1: TLabel;
Label2: TLabel;
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
Age:integer;
Esumteach,Esumtest:real;
F:text;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
AssignFile(F,'GRAPHIC.txt');
reset(F);
while not EOF(F) do
begin
readln(F,Age,Esumteach,Esumtest);
Series1.AddXY(Age,Esumteach);
Series2.AddXY(Age,Esumtest);
end;
end;
end.
Документ
Категория
Рефераты
Просмотров
24
Размер файла
142 Кб
Теги
лаб1
1/--страниц
Пожаловаться на содержимое документа