Приложение.

Модуль обучения обычного алгоритма обратного распространения.

procedure TForm1.Button3Click(Sender: TObject);

Var Q,L,L1,Wr,I,J,K,C :Integer;

sDW,dW,nW,D :Real;

NetS,OutS,Out :Real;

Con,n,Target :Real;

O1,O2,O3,O4,O5:Real;

NN :String;

begin

{Датчик обучения}

Gauge1.Progress:=0;

Gauge2.Progress:=0;

If Edit9.Text='' Then Edit9.Text:='0';

Val(Edit9.Text,C,Err);

Gauge1.MaxValue:=C;

Gauge2.MaxValue:=100;

{Цикл обучения}

For L1:=1 TO Gauge1.MaxValue DO

Begin

Gauge1.Progress:=Gauge1.Progress+1 ;

Gauge2.Progress:=0;

For Q:=1 TO 100 DO

Begin

Gauge2.Progress:=Gauge2.Progress+1 ;

{Перебор входных обучающих векторов}

For L:=0 TO ListBox1.Items.Count-1 DO

Begin

Edit1.Text:=ListBox1.Items[L];

Edit2.Text:=ListBox2.Items[L];

Edit3.Text:=ListBox3.Items[L];

Edit4.Text:=ListBox4.Items[L];

Edit5.Text:=ListBox5.Items[L];

Edit6.Text:=ListBox6.Items[L];

Edit7.Text:=ListBox7.Items[L];

Edit8.Text:=ListBox8.Items[L];

Edit12.Text:=ListBox9.Items[L];

Edit13.Text:=ListBox10.Items[L];

Edit14.Text:=ListBox11.Items[L];

Edit15.Text:=ListBox12.Items[L];

Edit16.Text:=ListBox13.Items[L];

{Заполнение вх значений}

ZapolnIn;

{первый слой}

For I:=1 To 10 Do

Begin

Element[I,1].Out:=InV[I];

End;

{второй слой}

For I:=1 To 10 Do

Begin

NetS:=0;

For K:=1 To 10 Do NetS:=NetS+Element[K,1].Out*St12[K,I].Weght;

OutS:=1/(1+exp(-NetS));

Element[I,2].Out:=OutS;

End;

{третий слой}

For I:=1 To 10 Do

Begin

NetS:=0;

For K:=1 To 10 Do NetS:=NetS+Element[K,2].Out*St23[K,I].Weght;

OutS:=1/(1+exp(-NetS));

Element[I,3].Out:=OutS;

End;

{четвёртый слой}

For I:=1 To 10 Do

Begin

NetS:=0;

For K:=1 To 10 Do NetS:=NetS+Element[K,3].Out*St34[K,I].Weght;

OutS:=1/(1+exp(-NetS));

Element[I,4].Out:=OutS;

End;

{пятый слой}

For I:=1 To 3 Do

Begin

NetS:=0;

For K:=1 To 10 Do NetS:=NetS+Element[K,4].Out*St45[K,I].Weght;

OutS:=1/(1+exp(-NetS));

Element[I,5].Out:=OutS;

End;

{Конец прямого хода}

{Обратный ход}

{Коэф.скорости обучения}

V:=0;

If Edit10.Text='' Then Edit10.Text:='0';

Val(Edit10.Text,V,Err);

n:=V;

{Подстройка выходного слоя 5}

{Перебор выходных элементов}

For J:=1 To 3 Do

Begin

{Вычесление ошибки}

Out:=Element[J,5].Out;

Target:=OutV[J];

D:=Out*(1-Out)*(Target-Out);

Element[J,5].D:=D;

{Перебор элементов пред. уровня, настройка веса от него}

For I:=1 To 10 Do

Begin

{Поправка к весу}

dW:=n*D*Element[I,4].Out;

St45[I,J].WOld:=St45[I,J].Weght;

St45[I,J].Weght:=St45[I,J].Weght+dW;

End;

End;

{Подстройка выходного слоя 4}

{Перебор элементов 4-го слоя}

For J:=1 To 10 Do

Begin

sDW:=0;

Out:=Element[J,4].Out;

{Перебор элементов вых уровня и суммирование их D*Wold}

For K:=1 To 3 Do sDW:=SDW+St45[J,K].WOld*Element[K,5].D;

D:=Out*(1-Out)*sDW;

Element[J,4].D:=D;

{Перебор элементов пред. уровня(3), настройка веса от него}

For I:=1 To 10 Do

Begin

{Поправка к весу}

dW:=n*D*Element[I,3].Out;

St34[I,J].WOld:=St34[I,J].Weght;

St34[I,J].Weght:=St34[I,J].Weght+dW;

End;

End;

{Подстройка выходного слоя 3}

{Перебор элементов 3-го слоя}

For J:=1 To 10 Do

Begin

sDW:=0;

Out:=Element[J,3].Out;

{Перебор элементов вых уровня и суммирование их D*Wold}

For K:=1 To 10 Do sDW:=SDW+St34[J,K].WOld*Element[K,4].D;

D:=Out*(1-Out)*sDW;

Element[J,3].D:=D;

{Перебор элементов пред. уровня(2), настройка веса от него}

For I:=1 To 10 Do

Begin

{Поправка к весу}

dW:=n*D*Element[I,2].Out;

St23[I,J].WOld:=St23[I,J].Weght;

St23[I,J].Weght:=St23[I,J].Weght+dW;

End;

End;

{Подстройка выходного слоя 2}

{Перебор элементов 2-го слоя}

For J:=1 To 10 Do

Begin

sDW:=0;

Out:=Element[J,2].Out;

{Перебор элементов вых уровня и суммирование их D*Wold}

For K:=1 To 10 Do sDW:=SDW+St23[J,K].WOld*Element[K,3].D;

D:=Out*(1-Out)*sDW;

Element[J,2].D:=D;

{Перебор элементов пред. уровня(1), настройка веса от него}

For I:=1 To 10 Do

Begin

{Поправка к весу}

dW:=n*D*Element[I,1].Out;

St12[I,J].WOld:=St12[I,J].Weght;

St12[I,J].Weght:=St12[I,J].Weght+dW;

End;

End;

{Результаты }

O1:=Element[1,5].out;

O2:=Element[2,5].out;

O3:=Element[3,5].out;

Str(O1:10:4,s);

Label16.Caption:=s;

Str(O2:10:4,s);

Label17.Caption:=s;

Str(O3:10:4,s);

Label18.Caption:=s;

END;{ForL}

END;{ForQ}

{-----Save---------------------}

N3Click(Sender);

{------------------------------}

END;{ForL1}

Gauge1.Progress:=0;

Gauge2.Progress:=0;

end;

Модуль обучения алгоритма нечеткого контроллера.

procedure TForm1.Button3Click(Sender: TObject);

Var I,J,L1,Q,C,L,K:Integer;

DU :Real;

NetS,OutS,Out :Real;

Con,n,Target :Real;

O1,O2,O3,O4,O5:Real;

NN :String;

begin

Stop:=0;

{Датчик обучения}

Gauge1.Progress:=0;

Gauge2.Progress:=0;

If Edit9.Text='' Then Edit9.Text:='0';

Val(Edit9.Text,C,Err);

Gauge1.MaxValue:=C;

Gauge2.MaxValue:=100;

{Цикл обучения}

For L1:=1 TO Gauge1.MaxValue DO

Begin

Gauge1.Progress:=Gauge1.Progress+1 ;

Gauge2.Progress:=0;

For Q:=1 TO 100 DO

Begin

Gauge2.Progress:=Gauge2.Progress+1 ;

{Перебор входных обучающих векторов}

For L:=0 TO ListBox1.Items.Count-1 DO

Begin

Edit1.Text:=ListBox1.Items[L];

Edit2.Text:=ListBox2.Items[L];

Edit3.Text:=ListBox3.Items[L];

Edit4.Text:=ListBox4.Items[L];

Edit5.Text:=ListBox5.Items[L];

Edit6.Text:=ListBox6.Items[L];

Edit7.Text:=ListBox7.Items[L];

Edit8.Text:=ListBox8.Items[L];

{Заполнение вх значений}

ZapolnIn;

{первый слой}

For I:=1 To 5 Do

Element[I,1].Out:=InV[I];

{второй слой}

{Перебор елементов второго слоя}

For J:=1 To 17 Do

{Перевор элементов первого слоя}

For I:=1 To 5 Do

{Проверка наличия связи}

If St12[I,J].C=1 Then

Begin

Element[J,2].Net:=-sqr((Element[I,1].Out-Element[J,2].M)/Element[J,2].D);

Element[J,2].Out:=exp(Element[J,2].Net);

End;

{третий слой}

{Перебор элементов третьего слоя}

For J:=1 To 16 Do

Begin

{ставим выход в 1 (мах выхода колокола=1)}

Element[J,3].Out:=1;

{Перебор елементов второго слоя}

For I:=1 To 17 Do

{Проверка наличия связи}

If St23[I,J].C=1 Then

{Проверка на min}

If Element[I,2].Out<Element[J,3].Out Then

Element[J,3].Out:=Element[I,2].Out;

End;

{четвёртый слой}

{Перебор елементов четвёртого слоя}

For J:=1 To 10 Do

Begin

{Обнуляем сумму от предыдущих проходов}

Element[J,4].Net:=0;

{Перебор элементов третьего слоя}

For I:=1 To 16 Do

{Проверка наличия связи}

If St34[I,J].C=1 Then

Begin

{Суммирование выходов третьего слоя присоединённых к элементу 4-го слоя}

Element[J,4].Net:=Element[J,4].Net+Element[I,3].Out;

{Выбор min Между суммой и 1}

If Element[J,4].Net>1 Then

Element[J,4].Out:=1

Else

Element[J,4].Out:=Element[J,4].Net;

End;

End;

{пятый слой}

{Перебор елементов пятого слоя}

For J:=1 To 3 Do

Begin

{Обнуляем сумму от предыдущих проходов}

Element[J,5].Net:=0;

Element[J,5].DU:=0;

{Перебор елементов четвёртого слоя}

For I:=1 To 10 Do

{Проверка наличия связи}

If St45[I,J].C=1 Then

Begin

Element[J,5].Net:=Element[J,5].Net+Element[I,4].M*Element[I,4].D*Element[I,4].Out;

Element[J,5].DU:=Element[J,5].DU+Element[I,4].D*Element[I,4].Out;

End;

Element[J,5].Out:=Element[J,5].Net/Element[J,5].DU;

End;

{Конец прямого хода}

{Обратный ход}

{Коэф.скорости обучения}

V:=0;

If Edit10.Text='' Then Edit10.Text:='0';

Val(Edit10.Text,V,Err);

n:=V;

{Подстройка выходного слоя 5 и слоя4(центра и ширины дефудзификатора 4-го слоя)}

{Перебор выходных элементов}

For J:=1 To 3 Do

{Вычесление ошибки}

{Перебор элементов 4-го уровня}

Begin

Element[J,5].Q:=(OutV[J]-Element[J,5].Out);

For I:=1 To 10 Do

{Проверка наличия связи}

If St45[I,J].C=1 Then

Begin

Element[I,4].M1:=Element[I,4].M+n*(OutV[J]-Element[J,5].Out)*

(Element[I,4].D*Element[I,4].Out/Element[J,5].DU);

Element[I,4].D1:=Element[I,4].D+n*(OutV[J]-Element[J,5].Out)*

Element[I,4].Out*(Element[I,4].M*Element[J,5].DU-Element[J,5].Net)/

sqr(Element[J,5].DU);

{Одновременно рассчтаем ошибку в 4-ом слое}

Element[I,4].Q:=Element[J,5].Q*

Element[I,4].Out*(Element[I,4].M*Element[J,5].DU-Element[J,5].Net)/

sqr(Element[J,5].DU);

End;

End;

{Подстройка слоя 3}

{Перебор элементов 3-го слоя}

For J:=1 To 16 Do

{Перебор элементов 4-го слоя}

Begin

Element[J,3].Q:=0;

For I:=1 To 10 Do

{Проверка наличия связи}

If St34[J,I].C=1 Then

Begin

Element[J,3].Q:=Element[J,3].Q+Element[I,4].Q;

End;

End;

{Подстройка выходного слоя 2}

{Перебор элементов 2-го слоя}

For J:=1 To 17 Do

{Перебор элементов 1-го уровня}

Begin

Element[J,2].Q:=0;

{Перебор елементов 3-го слоя и проверка на =min}

For K:=1 To 16 Do

Begin

{Проверка наличия связи}

If St23[J,K].C=1 Then

If Element[K,3].Out=Element[J,2].Out Then

Element[J,2].Q:=Element[J,2].Q+Element[K,3].Q;

End;

Element[J,2].M1:=Element[J,2].M-n*Element[J,2].Q*Element[J,2].Out*

2*(Element[I,1].Out-Element[J,2].M)/

sqr(Element[J,2].D);

Element[J,2].D1:=Element[J,2].D-n*Element[J,2].Q*Element[J,2].Out*

2*sqr(Element[I,1].Out-Element[J,2].M)/

Element[J,2].D*sqr(Element[J,2].D);

End;

{Перенесение t+1 шага на t}

{Перебор элементов 4-го слоя}

For I:=1 To 10 Do

Begin

Element[I,4].M:=Element[I,4].M1;

Element[I,4].D:=Element[I,4].D1;

End;

{Перебор элементов 2-го слоя}

For I:=1 To 17 Do

Begin

Element[I,2].M:=Element[I,2].M1;

Element[I,2].D:=Element[I,2].D1;

End;

{Обнуление вычеслений}

{Перебор элементов 5-го слоя}

For I:=1 To 10 Do

Begin

Element[I,4].M1:=0;

Element[I,4].D1:=0;

End;

{Результаты }

O1:=Element[1,5].out;

O2:=Element[2,5].out;

O3:=Element[3,5].out;

Str(O1:10:4,s);

Label16.Caption:=s;

Str(O2:10:4,s);

Label17.Caption:=s;

Str(O3:10:4,s);

Label18.Caption:=s;

{------------Update------------}

Label16.Update;

Label17.Update;

Label18.Update;

{------------------------------}

END;{ForL}

END;{ForQ}

{-----Save---------------------}

N3Click(Sender);

{------------------------------}

END;{ForL1}

Gauge1.Progress:=0;

Gauge2.Progress:=0;

end;

14