Использование нечеткой искусственной нейронной сети TSK (Takagi, Sugeno, Kang’a) в задаче прогнозирования валютных курсов

if mxj<eps then

mxj:=eps;

if lxj<eps then

lxj:=eps;

// Изменняем cen

sc:=0;

ss:=0;

sb:=0;

for r:=1 to m do

begin

//dw/d(cen)

p1:=1;

for i:=1 to m do

if i<>j then

p1:=p1*(2*b[k,j]/sigma[k,j])*

exp( Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]*(2*b[k,j]-1)) ))*

myu[k,i]/sqr(1+exp(Ln(abs((a[j+num]-cen[k,j])/sigma[k,j]))*2*b[k,j

]) );

if r=k then delta:=0 else delta:=1;

dwc:=(delta*mxj-lxj)/sqr(mxj)*p1;

s1:=p[r,0];

for l:=1 to nac do

s1:=s1+p[r,l]*a[num+l];

sc:=sc+s1*dwc;

//dw/d(sigma)

p2:=1;

for i:=1 to m do

if i<>j then

p2:=p2*(2*b[k,j]/sigma[k,j])*

exp( Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]) ))*

myu[k,i]/sqr(1+exp(Ln(abs((a[j+num]-cen[k,j])/sigma[k,j]))*2*b[k,j]) );

dws:=(delta*mxj-lxj)/sqr(mxj);

ss:=ss+s1*dws;

//dw/d(b)

p3:=1;

for i:=1 to m do

if i<>j then

p3:=p3*(-2*exp( Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]) )*2*b[k,j]))*

Ln( abs( (a[j+num]-cen[k,j])/sigma[k,j]) )*

myu[k,i]/sqr(1+exp(Ln(abs((a[j+num]-cen[k,j])/sigma[k,j]))*2*b[k,j]) );

end;ns(k,j,sc,ss,sb);

dec:=(vihod-a[num+1])*sc;

des:=(vihod-a[num+1])*ss;

deb:=(vihod-a[num+1])*sb;

cen[k,j]:=cen[k,j]-gc*dec;

sigma[k,j]:=sigma[k,j]-gs*des;

b[k,j]:=b[k,j]-gb*deb;

end;//{k}

end;//{j}

end;//adjust_csb

procedure a_p;

var j:integer;norm:real;

begin

for j:=1 to m do norm:=norm+j;

norm:=1/norm;

for i:=1 to m do

for j:=1 to (nac+1) do

begin

p[i,j]:=j*norm;

p3[i,j]:=j*(norm+0.0001*i);

end;

end;

// adjust_p();

procedure adjust_p();

var l_s,l_d,i,j,k,l,r,k1,k2,k3:integer;

dob,sum,dt,w,norm:real;

hth,h,h3,hp:array[1 250,1 100]of real;

dl:array[1 250]of real;

pp,pp3:array[1 200]of real;

htn:matrix;

begin

l:=nst;

norm:=0; for j:=1 to m do norm:=norm+j;

norm:=1/norm;

setsize(htn,l,(nac+1)*m);

// Формируем матрицу h

for r:=1 to l do

begin

for i:=1 to m do

begin

h[r,(i-1)*(nac+1)+1]:=i*norm;

w:=i*norm;

for j:=1 to nac do

begin

dob:=1;sum:=0;

for l_s:=1 to m do

begin

for l_d:=1 to nac do

dob:=dob*1/(1+exp(Ln(abs((a[l_d]-cen[l_s,l_d])/sigma[l_s,l_d]))*2*b[l_s,l_d]) );

sum:=sum+dob;

end;

h[r,(i-1)*(nac+1)+j+1]:=dob/sum;

end;

end;

end;

for r:=1 to l do

for j:=1 to nac do

for i:=1 to m do

h[r,(j-1)*(nac+1)+i+1]:=h[r,(j-1)*(nac+1)+i+1]*a[r+(j-1)*nac+i];

for i:=1 to nst do

dl[i]:=a[nac+i];

for k1:=1 to m*(nac+1) do

for k2:=1 to m*(nac+1)do

begin

hth[k1,k2]:=0;

for k3:=1 to l do

hth[k1,k2]:=hth[k1,k2]+h[k1,k3]*h[k3,k1];

end;

setsize(htn,m*(nac+1),m*(nac+1));

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

htn.data[i-1,j-1]:=hth[i,j];

invers(htn);

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

hth[i,j]:=htn.data[i-1,j-1];

for i:=1 to m*(nac+1)do

for j:=1 to l do

begin

hp[i,j]:=0;

for r:=1 to m do

hp[i,j]:=hp[i,j]+hth[i,r]*h[r,j];

end;

for i:=1 to m*(nac+1) do

pp[i]:=0;

for i:=1 to m*(nac+1) do

begin

for j:=1 to l do

pp[i]:=pp[i]+hp[i,j]*dl[j];

end;

for i:=1 to m do

for j:=0 to (nac)do

p[i,j]:=pp[j+1+(i-1)*m];

end;//adjust_p();

// adjust_p3();

procedure adjust_p3();

var l_d,l_s,i,j,k,l,r,k1,k2,k3:integer;

dob,sum,dt,w,norm:real;

hth,h,h3,hp:array[1 250,1 100]of real;

dl:array[1 250]of real;

pp:array[1 200]of real;

htn:matrix;

begin

l:=nst;

norm:=0; for j:=1 to m do norm:=norm+j;

norm:=1/norm;

setsize(htn,l,(nac+1)*m);

// Формируем матрицу h

for r:=1 to l do

begin

for i:=1 to m do

begin

h[r,(i-1)*(nac+1)+1]:=i*norm;

w:=i*norm;

for j:=1 to nac do

begin

dob:=1;sum:=0;

for l_s:=1 to m do

begin

for l_d:=1 to nac do

dob:=dob*1/(1+exp(Ln(abs((a[l_d] cen[l_s,l_d])/sigma[l_s,l_d]))*2*b[l_s,l_d]) );

sum:=sum+dob;

end;

h[r,(i-1)*(nac+1)+j+1]:=dob/sum;

end;

end;

end;

for r:=1 to l do

for j:=1 to nac do

for i:=1 to m do

h[r,(j-1)*(nac+1)+i+1]:=h[r,(j-1)*(nac+1)+i+1]*a[r+(j-1)*nac+i];

for i:=1 to nst do

dl[i]:=a[nac+i+3];

for k1:=1 to m*(nac+1) do

for k2:=1 to m*(nac+1)do

begin

hth[k1,k2]:=0;

for k3:=1 to l do

hth[k1,k2]:=hth[k1,k2]+h[k1,k3]*h[k3,k1];

end;

setsize(htn,m*(nac+1),m*(nac+1));

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

htn.data[i-1,j-1]:=hth[i,j];

invers(htn);

for i:=1 to m*(nac+1) do

for j:=1 to m*(nac+1) do

hth[i,j]:=htn.data[i-1,j-1];

for i:=1 to m*(nac+1)do

for j:=1 to l do

begin

hp[i,j]:=0;

for r:=1 to m do

hp[i,j]:=hp[i,j]+hth[i,r]*h[r,j];

end;

for i:=1 to m*(nac+1) do

pp[i]:=0;

for i:=1 to m*(nac+1) do

begin

for j:=1 to l do

pp[i]:=pp[i]+hp[i,j]*dl[j];

end;

for i:=1 to m do

for j:=0 to (nac)do

p3[i,j]:=pp[j+1+(i-1)*m];

end;//adjust_p3();

// обучить нейросеть (START)

procedure TForm1.Button4Click(Sender: TObject);

const maxNit=1000;//Максимальное количество итераций

eps=0.000000001;

var l,nc:integer;//l - номер центра; nc - количество центров;

num,q:integer;//Количество итераций

nIt:longint;

sum,gama,pz,pz1,d,yP,x,sk:real; //y прогнозированное

tsk_w,tsk_w3,tsk,tsk3:array[1 mM]of real;//отвечает за третий слой

sm,fprov,f1,f2,s_sign,s_w,s_sign3,s_w3:real;// взвешенная сумма сигналов и весов

begin// обучить нейросеть

if stringGrid1.cells[0,1]<>''then

begin

//Проверка на введные вручную значения

i:=1;

while (stringGrid1.cells[0,i]<>'')and(i<10000) do

begin

i:=i+1;

s:=stringGrid1.cells[0,i];

end;

n:=i-1;

// Проверка на знак десятичного разделителя -

// меняем "." или "," на decimalSeparator

while stringGrid1.cells[0,n]='' do

n:=n-1;

n:=i-1;

s:='';

for q:=1 to n do

begin

s:=StringGrid1.Cells[0,q];

for k:=1 to Length(s) do

if (s[k]='.')or(s[k]=',') then s[k]:=decimalSeparator;

a[q]:=strToFloat(s);

end;

//---------------------------------------

// нелинейные параметры

gc:=u;

gs:=u;

gb:=u;

//линейные параметры

for j:=1 to m do

begin

p[j,0]:=0;

p3[j,0]:=0;

end;

for i:=1 to m do

for j:=1 to nac do

begin

p[i,j]:=1/nac;

p3[i,j]:=1/nac;

end;

//Задаем начальные условия (Начало)

for i:=1 to m do // по количеству входов

for j:=1 to nac do // по количеству правил

begin

cen[i,j]:=0.5*(a[j]+a[i]);

sigma[i,j]:=abs((a[j+1]-a[j])*(a[i+1]-a[i]));

b[i,j]:=1+0.01*a[i]/a[j];

cen3[i,j]:=0.5*(a[j]+a[i]);

sigma3[i,j]:=abs((a[j+1]-a[j])*(a[i+1]-a[i]));

b3[i,j]:=1+0.01*a[i]/a[j];

end;

//Задаем начальные условия (Конец)

nIt:=maxNit-10; // Отвечает за количество итераций

 Скачать реферат