// текст основной программы

program lab7neuro;

uses

Forms,

lab7 in 'lab7. pas' {Form1}, // модуль формы

bkpropag in 'bkpropag. pas'; // модуль нейросети

{$R *. RES}

begin

Application. Initialize;

Application. CreateForm (TForm1, Form1);

Application.run;

end.

// модуль формы

unit lab7;

interface

uses

Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,

bkpropag, Grids, StdCtrls, Spin, ExtCtrls, TeEngine, Series, TeeProcs,

Chart, Menus;

type

TForm1 = class (TForm) // класс формы

// Элементы управление VCL помещенные на форму

SpinEdit1: TSpinEdit; StringGrid1: TStringGrid; Panel1: TPanel; StringGrid2: TStringGrid; SpinEdit2: TSpinEdit; Label1: TLabel;

Label3: TLabel; Label4: TLabel; Chart1: TChart; Series1: TBarSeries;

Series2: TBarSeries; CheckBox1: TCheckBox; Panel2: TPanel;

Button2: TButton; Button1: TButton; SpinEdit3: TSpinEdit;

SpinEdit4: TSpinEdit; Label2: TLabel; Label5: TLabel;

SpinEdit5: TSpinEdit; Label6: TLabel; Button3: TButton;

Edit1: TEdit; Label7: TLabel; RadioButton1: TRadioButton;

RadioButton2: TRadioButton; CheckBox2: TCheckBox; Edit2: TEdit;

Label8: TLabel; Label9: TLabel;

// меню

PopupMenu1: TPopupMenu; N1: TMenuItem;

RANDOM1: TMenuItem; N21: TMenuItem; N2: TMenuItem;

N3: TMenuItem; N4: TMenuItem; N5: TMenuItem; N6: TMenuItem;

N7: TMenuItem; N8: TMenuItem;

// методы, выполняющие сервисные операции

procedure FormCreate (Sender: TObject);

procedure SpinEdit2Change (Sender: TObject);

procedure SpinEdit1Change (Sender: TObject);

procedure CheckBox1Click (Sender: TObject);

procedure Button1Click (Sender: TObject);

procedure Button3Click (Sender: TObject);

procedure FormDestroy (Sender: TObject);

procedure Button2Click (Sender: TObject);

procedure N1Click (Sender: TObject);

procedure RANDOM1Click (Sender: TObject);

procedure N21Click (Sender: TObject);

procedure N2Click (Sender: TObject);

procedure N3Click (Sender: TObject);

procedure N4Click (Sender: TObject);

procedure N5Click (Sender: TObject);

procedure N6Click (Sender: TObject);

procedure N7Click (Sender: TObject);

procedure N8Click (Sender: TObject);

private

{ обособленные методы }

neuro: TBackPropagation; // объект нейросети

CountNeuro: TVesCountNeuro; // количество нейронов в слоях

trend: TTrend; // временной ряд

normal: double;

end;

var

Form1: TForm1; // создаем форму

implementation

{$R *. DFM}

// действия при создании формы

procedure TForm1. FormCreate (Sender: TObject);

var j: word;

al,da: double;

begin

// инициализация

StringGrid2. ColCount: =SpinEdit2. Value+1;

for j: =1 to SpinEdit2. Value+1 do

StringGrid2. Cells [j,0]: =IntToStr (j);

StringGrid2. Cells [0,1]: ='Ряд';

StringGrid2. Cells [0,2]: ='Прогноз';

// Задание ряда

Randomize;

da: =3*pi/ (SpinEdit2. Value); al: =0;

for j: =1 to SpinEdit2. Value do

begin

StringGrid2. Cells [j,1]: =FloatToStr (sqr (sin (al)));

al: =al+da;

end;

// количество нейронов

StringGrid1. RowCount: =SpinEdit1. Value+1;

for j: =1 to SpinEdit1. Value+1 do

StringGrid1. Cells [0,j]: =IntToStr (j);

StringGrid1. Cells [1,0]: ='Нейронов';

StringGrid1. Cells [1,1]: ='4';

StringGrid1. Cells [1,2]: ='5';

StringGrid1. Cells [1,3]: ='1';

// нормирование

normal: =1;

end; // конец функции

// обработчик изменения количество элементов во временном ряду

procedure TForm1. SpinEdit2Change (Sender: TObject);

var j: word;

begin

StringGrid2. ColCount: =SpinEdit2. Value+1;

for j: =1 to SpinEdit2. Value+1 do

StringGrid2. Cells [j,0]: =IntToStr (j);

StringGrid2. Cells [0,1]: ='Ряд';

StringGrid2. Cells [0,2]: ='Прогноз';

end;

// обработчик изменения количества нейронов

procedure TForm1. SpinEdit1Change (Sender: TObject);

var j: word;

begin

StringGrid1. RowCount: =SpinEdit1. Value+1;

for j: =1 to SpinEdit1. Value+1 do

StringGrid1. Cells [0,j]: =IntToStr (j);

StringGrid1. Cells [1,0]: ='Нейронов';

end;

// подписывать данные в диаграмме

procedure TForm1. CheckBox1Click (Sender: TObject);

var i: integer;

begin

for i: =1 to 2 do

Chart1. Series [i-1]. Marks. Visible: =CheckBox1. Checked;

end;

// изобразить диаграмму

procedure TForm1. Button1Click (Sender: TObject);

var i,j: word;

AValue: double;

begin

for i: =1 to 2 do

begin

Chart1. SeriesList [i-1]. Clear;

for j: =1 to SpinEdit2. Value do

begin

if StringGrid2. Cells [j, i] ='' then AValue: =0 else AValue: =StrToFloat (StringGrid2. Cells [j, i]);

if (j>SpinEdit4. Value) and (i=2) then Chart1. SeriesList [i-1]. Add (AValue,'',rgb (0, 200,0))

else Chart1. SeriesList [i-1]. Add (AValue,'',Chart1. Series [i-1]. SeriesColor);

end;

end;

end;

// создание и обучение нейросети

procedure TForm1. Button3Click (Sender: TObject);

// обучение

var i,j: word;

Save_Cursor: TCursor;

maxn: double;

begin

Save_Cursor: = Screen. Cursor; Screen. Cursor: = crHourglass;

try

neuro. free; neuro: =TBackPropagation. Create; // создали нейросеть

// задаем количество слоев в нейросети и количество нейронов в каждом слое

// а также размер входного окна

for i: =1 to SpinEdit1. Value do CountNeuro [i]: =StrToInt (StringGrid1. Cells [1, i]);

neuro. SetArrayVesCount (SpinEdit1. Value,SpinEdit3. Value,CountNeuro);

// задаем временной ряд

for j: =1 to SpinEdit4. Value do if StringGrid2. Cells [j,1] ='' then trend [j]: =0 else trend [j]: =StrToFloat (StringGrid2. Cells [j,1]);

// выполняем нормализацию временного ряда

maxn: =trend [1];

for j: =2 to SpinEdit4. Value do if trend [j] >maxn then maxn: =trend [j];

if maxn>1 then normal: =1.2*maxn else normal: =1;

if CheckBox2. Checked then for j: =1 to SpinEdit4. Value do trend [j]: =trend [j] /normal;

neuro. SetTrend (SpinEdit4. Value,trend);

neuro.education (StrToFloat (Edit1. text),StrToFloat (Edit2. text)); // обучение

finally

Screen. Cursor: = Save_Cursor; { восстанавливаем форму курсора }

end;

end;

// закрытие формы

procedure TForm1. FormDestroy (Sender: TObject);

begin

neuro. free;

end;

// прогнозирование

procedure TForm1. Button2Click (Sender: TObject);

var X: TTrend; i,j: word;

begin

// прогнозирование

SpinEdit2. Value: =SpinEdit4. Value+SpinEdit5. Value;

StringGrid2. ColCount: =SpinEdit4. Value+SpinEdit5. Value+1;

for i: =1 to StringGrid2. ColCount do StringGrid2. Cells [i,2]: ='';

if RadioButton1. Checked then

begin // одношаговое предсказание

for i: =1 to SpinEdit4. Value+ (SpinEdit5. Value-SpinEdit3. Value) do

begin

for j: =1 to SpinEdit3. Value do

if StringGrid2. Cells [i+j-1,1] ='' then x [j]: =0 else x [j]: =StrToFloat (StringGrid2. Cells [i+j-1,1]) /normal;

StringGrid2. Cells [i+SpinEdit3. Value,2]: =FloatToStr (neuro. doprognoz (x) *normal);

end;

end

else // многошаговое прогнозирование

begin

// переписываем реальные данные в начало

for i: =1 to SpinEdit3. Value do StringGrid2. Cells [SpinEdit4. Value-i,2]: =StringGrid2. Cells [SpinEdit4. Value-i,1];

for i: =SpinEdit4. Value-SpinEdit3. Value to SpinEdit4. Value+SpinEdit5. Value-SpinEdit3. Value do

begin

for j: =1 to SpinEdit3. Value do

if StringGrid2. Cells [i+j-1,2] ='' then x [j]: =0 else x [j]: =StrToFloat (StringGrid2. Cells [i+j-1,2]) /normal;

StringGrid2. Cells [i+SpinEdit3. Value,2]: =FloatToStr (neuro. doprognoz (x) *normal);

end;

end;

end; // procedure

// задание стандартных зависимостей временного ряда

procedure TForm1. N1Click (Sender: TObject);

var da,al: double;

j: word;

begin

da: =pi/ (SpinEdit2. Value); al: =0;

for j: =1 to SpinEdit2. Value do

begin

StringGrid2. Cells [j,1]: =FloatToStr (sqr (sin (al)));

al: =al+da;

end;

Button1Click (sender);

end;

// аналогично работают другие пункты меню

….

procedure TForm1. N8Click (Sender: TObject);

var da,al: double;

j: word;

begin

da: =1/ (SpinEdit2. Value); al: =1;

for j: =1 to SpinEdit2. Value do

begin

StringGrid2. Cells [j,1]: =FloatToStr (1/al);

al: =al+da;

end;

Button1Click (sender);

end;

end. // конец модуля lab7

// модуль bkpropag

{*Модуль реализующий нейросеть обратного распространения *}

unit bkpropag;

interface

const MAXLAYERS=100; // максимальное количество слоев

const MAXVES=300; // максимальное количество нейронов в слое

const MAXINPUT=300; // максимальное количество входов нейросети

const MAXTRAND=300; // количество значений во временном ряду

type

TVesCountNeuro=array [0. MAXLAYERS] of word; // тип количество нейронов в слоях

TVesNeuro=array [1. MAXLAYERS,1. MAXVES,1. MAXVES] of double; // тип значений весов нейросети

TTrend=array [1. MAXTRAND] of double; // временной ряд

TOutPromezh=array [0. MAXLAYERS,1. MAXVES] of double; // промежуточные выходные сигналы

type

TBackPropagation=class // описание класса

private

fCountLayer: word; // количество слоев в нейросети

fArrayVesCount: TVesCountNeuro; // количество нейронов в слоях

fArrayVes: TVesNeuro; // значения весов нейросети

fXCount: word; // количество входных сигналов

fY: double; // выходной сигнал нейросети

fCountTrend: word; // количество чисел во временном ряду

fTrend: TTrend; // временной ряд

fYPromezh: TOutPromezh; // промежуточные выходные сигналы

procedure RandomVes; // задание весов случайным образом

function activation (g: double): double; // функция активации

function activation_diff (g: Double): double; // производная функции активации

public

constructor Create;

function Education (epsilon: double; alpha: double): boolean;

function DoOnePrognoz: double; // выполняет одношаговый прогноз

function DoPrognoz (X: TTrend): double;

// входные данные

// задание количество нейронов в слоях

function SetArrayVesCount (Count: word; XCount: word; AVC: TVesCountNeuro): boolean; // задание количество нейронов в слоях

function GetArrayVesCount (var Count: word; var XCount: word): TVesCountNeuro;

// задать временной ряд

function SetTrend (Count: word; ST: TTrend): boolean; // задать временной ряд

function GetTrend (var Count: word): TTrend;

property CountLayer: word read fCountLayer; // количество слоев

end; // конец описания класса

implementation

uses Forms,Dialogs,SysUtils;

{ TBackPropagation }

procedure TBackPropagation. RandomVes;

// задание весов нейросети случайным образом

var i,j,k: word;

begin

for i: =1 to MAXLAYERS do

for j: =1 to MAXVES do

for k: =1 to MAXVES do

fArrayVes [i,j,k]: =Random (800) /1000;

end;

// функция активации

function TBackPropagation. activation (g: double): double;

begin

activation: =1/ (1+Exp (-g));

end;

// производная функции активации

function TBackPropagation. activation_diff (g: Double): double;

begin

activation_diff: =g* (1-g);

end;

constructor TBackPropagation. Create;

// конструктор

begin

// инициализируем все значения

fCountLayer: =0;

fCountTrend: =0;

fXCount: =0;

fY: =0;

Randomize;

RandomVes; // задание весов случайным образом

end;

function TBackPropagation. DoOnePrognoz: double;

// одношаговый прогноз

var i,j,k: word;

s: double;

begin

// задаем входные сигналы - нулевая строка в промежуточных выходах

for i: =1 to fXCount do fYPromezh [0, i]: =fTrend [fCountTrend-fXCount+i];

// выполняем расчет

for i: =1 to fCountLayer do // для каждого слоя

for j: =1 to fArrayVesCount [i] do // для кождого нейрона в слое

begin

s: =0;

for k: =1 to fArrayVesCount [i-1] do // каждый вес

s: =s+fArrayVes [i,j,k] *fYPromezh [i-1,k]; // умножаем на соответствующий выход предыдущего слоя

fYPromezh [i,j]: =activation (s); // функция активации

end;

DoOnePrognoz: =fYPromezh [fCountLayer,1]; // на последнем слое - один нейрон

end;

function TBackPropagation. DoPrognoz (X: TTrend): double;

// прогноз

var i,j,k: word;

s: double;

begin

// задаем входные сигналы - нулевая строка в промежуточных выходах

for i: =1 to fXCount do fYPromezh [0, i]: =X [i];

// выполняем расчет

for i: =1 to fCountLayer do // для каждого слоя

for j: =1 to fArrayVesCount [i] do // для каждого нейрона в слое

begin

s: =0;

for k: =1 to fArrayVesCount [i-1] do // каждый вес

s: =s+fArrayVes [i,j,k] *fYPromezh [i-1,k]; // умножаем на соответствующий выход предыдущего слоя

fYPromezh [i,j]: =activation (s); // функция активации

end;

DoPrognoz: =fYPromezh [fCountLayer,1]; // на последнем слое - один нейрон

end;

function TBackPropagation.education (epsilon: double; alpha: double): boolean;

// обучение

var ArrayDelta: TOutPromezh; // массив дельта-величин

i,j,k,m: word;

s,d,delta: double;

nach: word;

neuro_epsilon,neuro_epsilon2,d_epsilon: double;

kol: longint;

begin

d: =100; nach: =1; neuro_epsilon: =0; d_epsilon: =100;

kol: =0;

while (d_epsilon>epsilon) and (kol<200000000) do

begin {while}

inc (kol);

Application. ProcessMessages;

if nach<=fCountTrend-fXCount then

for i: =1 to fXCount do fYPromezh [0, i]: =fTrend [nach+i-1]

else

begin nach: =1; d_epsilon: =neuro_epsilon; neuro_epsilon: =0; continue; end; // анализируем временной ряд сначала

// выполняем прямой проход

for i: =1 to fCountLayer do // для каждого слоя

for j: =1 to fArrayVesCount [i] do // для каждого нейрона в слое

begin

s: =0;

for k: =1 to fArrayVesCount [i-1] do // каждый вес

s: =s+fArrayVes [i,j,k] *fYPromezh [i-1,k]; // умножаем на соответствующий выход предыдущего слоя

fYPromezh [i,j]: =activation (s); // функция активации

end;

// выполняем обратный проход

// для выходного слоя

for j: =1 to fArrayVesCount [fCountLayer] do // для каждого нейрона последнего слоя

begin

neuro_epsilon2: = (fTrend [nach+fXCount] - fYPromezh [fCountLayer,j]);

delta: =neuro_epsilon2*activation_diff (fYPromezh [fCountLayer,j]); // дельта-величина

ArrayDelta [fCountLayer,j]: =delta;

for k: =1 to fArrayVesCount [fCountLayer-1] do // для каждого веса нейрона последнего слоя

fArrayVes [fCountLayer,j,k]: =fArrayVes [fCountLayer,j,k] +alpha*delta*fYPromezh [fCountLayer-1,k];

end;

neuro_epsilon: =neuro_epsilon+abs (neuro_epsilon2);

// для скрытых слоев

for i: =fCountLayer-1 downto 1 do // для каждого слоя

for j: =1 to fArrayVesCount [i] do // для каждого нейрона в слое

begin // 1

// вычисляем ошибку скрытого слоя i

s: =0;

for m: =1 to fArrayVesCount [i+1] do // для каждого нейрона в следующем слое

s: =s+ArrayDelta [i+1,m] *fArrayVes [i+1,m,j];

// вычисляем дельта величину для слоя i

delta: =activation_diff (fYPromezh [i,j]) *s;

ArrayDelta [i,j]: =delta;

// корректируем веса для нейрона j слоя i

for k: =1 to fArrayVesCount [i-1] do // для каждого веса в нейроне

fArrayVes [i,j,k]: =fArrayVes [i,j,k] +alpha*delta*fYpromezh [i-1,k];

end; // 1

// определяем совокупную ошибку дельта-величины

d: =0;

for i: =1 to fCountLayer do // для каждого слоя

for j: =1 to fArrayVesCount [i] do // для каждого нейрона в слое

d: =d+abs (ArrayDelta [i,j]);

// переходим на следующее окно

inc (nach);

end; {while}

MessageDlg ('Нейросеть обучилась согласно заданным параметрам'#13+

'за '+IntToStr (kol) +' итераций'#13+

'с совокупной погрешностью '+FloatToStr (d_epsilon), mtInformation, [mbOk], 0);

end;

function TBackPropagation. GetArrayVesCount (

var Count: word; var XCount: word): TVesCountNeuro;

begin

// считываем значения

XCount: =fXCount;

Count: =fCountLayer;

GetArrayVesCount: =fArrayVesCount;

end;

// считываем тренд

function TBackPropagation. GetTrend (var Count: word): TTrend;

begin

Count: =fCountTrend;

GetTrend: =fTrend;

end;

// устанавливаем значения

function TBackPropagation. SetArrayVesCount (Count: word; XCount: word;

AVC: TVesCountNeuro): boolean;

begin

fXcount: =XCount;

fCountLayer: =Count;

fArrayVesCount: =AVC;

fArrayVesCount [0]: =fXCount; // количество входных сигналов

SetArrayVesCount: =true;

end;

// устанавливаем тренд

function TBackPropagation. SetTrend (Count: word; ST: TTrend): boolean;

begin

fCountTrend: =Count;

fTrend: =ST;

SetTrend: =true;

end;

end. // конец модуля bkpropag

Размещено на Allbest.ru