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

for j:=1 to nac do

readln(f1,b[i,j]);

for i:=1 to m do

for j:=0 to nac do

if j<=nac then

readln(f1,p[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,cen3[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,sigma3[i,j]);

for i:=1 to m do

for j:=1 to nac do

readln(f1,b3[i,j]);

for i:=1 to m do

for j:=0 to nac do

if j<

=nac then

readln(f1,p3[i,j]);

end;

CloseFile(f1);

end;

end;//Загрузить нейросеть (конец)

procedure TForm1.Button7Click(Sender: TObject);

//Сохранить данные

var i:integer;

begin

SaveData.InitialDir:='D:\CW';

SaveData.DefaultExt:='txt'; i:=1;

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

begin

i:=i+1;

end;

n:=i-1;

if SaveData.Execute then

begin

fname:=SaveData.FileName;

AssignFile(f3,SaveData.FileName);

Rewrite(f3);

writeln(f3,n);

for i:=1 to n do

begin

writeln(f3,stringGrid1.cells[0,i]);

end;

CloseFile(f3);

end;

end; //Сохранить данные (конец)

procedure TForm1.Button11Click(Sender: TObject);

begin // Закрыть форму 1

AssignFile(f3,'1.txt');

Rewrite(f3);

writeln(f3,skoS:10:8);

writeln(f3,sko3S:10:8);

writeln(f3,skoP:10:8);

writeln(f3,sko3P:10:8);

writeln(f3,ms:10:8);

writeln(f3,mp:10:8);

writeln(f3,ms3:10:8);

writeln(f3,mp3:10:8);

for i:=nst to n+3 do

begin

write(f3,stringGrid1.cells[0,i]);

write(f3,stringGrid1.cells[1,i]);

write(f3,stringGrid1.cells[2,i]);

write(f3,stringGrid1.cells[3,i]);

writeln(f3,stringGrid1.cells[4,i]);

end;

CloseFile(f3);

Form1.close;

end;

procedure TForm1.Button3Click(Sender: TObject);

begin //Открыть форму "Настройки"

form2.Show;

end; //Открыть форму "Настройки" (конец)

procedure TForm1.Button5Click(Sender: TObject);

begin

if (stringGrid1.cells[0,1]<>'')and(stringGrid1.cells[0,3]<>'') then

form3.show; // Открыть форму график КВ

end;

procedure TForm1.Button6Click(Sender: TObject);

begin

if (stringGrid1.cells[0,1]<>'')and(stringGrid1.cells[0,3]<>'') then

form4.show; // Открыть форму график пргноза на 3 шага вперед

end;

procedure TForm1.FormCreate(Sender: TObject);

// Создание формы 1

var a:integer;

begin

a:=6;

edit1.Text:='';

edit2.Text:='';

edit3.Text:='';

edit4.Text:='';

edit5.Text:='';

edit6.Text:='';

edit7.Text:='';

edit8.Text:='';

Nst:=0; Nac:=4;Neps:=10;Nrp:=80;m:=5;

end; //Конец создания формы 1

procedure TForm1.FormResize(Sender: TObject);

//Изменение размеров формы 1

var a:integer;

begin

if Form1.Width<500 then

Form1.Width:=500;

if Form1.Height<550 then

Form1.Height:=550;

StringGrid1.Width:=Form1.Width-Button1.Width-80;

StringGrid1.Height:=Form1.Height-280;

a:=6;

StringGrid1.Top:=Form1.ClientHeight-StringGrid1.Height-216;

StringGrid1.Left:=Form1.ClientWidth-StringGrid1.Width-24;

StringGrid1.ColWidths[0]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[1]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[2]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[3]:=trunc(StringGrid1.Width*0.2)-a;

StringGrid1.ColWidths[4]:=trunc(StringGrid1.Width*0.2)-a;

end; // Конец изменения формы 1

procedure TForm1.StringGrid1KeyPress(Sender: TObject; var Key: Char);

begin

if not (Key in [#8,'0' '9',decimalSeparator])then

Key:=#0

end;

procedure TForm1.StringGrid1GetEditText(Sender: TObject; ACol,

ARow: Integer; var Value: String);

var i:integer;

begin

i:=1;

while (stringgrid1.cells[0,i]<>'')do

i:=i+1;

StringGrid1.RowCount:=i+10;

n:=i;

end;

function adjust():boolean;

var wrong,q,r:integer;

//f:boolean;

prognoz,realynoe:real;

begin

wrong:=0;

for q:=nac+2 to nst-1 do

begin

eps:=Neps*a[q]/1000;

realynoe:=a[q+1]-a[q];

prognoz:=0;

for r:=1 to nac do

prognoz:=prognoz+(a[q-nac+r-1]-a[q-nac+r-2])*w[r];

if abs(prognoz-realynoe)<eps then

wrong:=wrong+1;

end;

if wrong/(nst-(nac+2))<(100-Nrp)/100 then

adjust:=true

else

adjust:=false;

end;//adjust

procedure ns(i,j:integer;var a,b,c:real);

const eps=0.01;

begin a:=eps*i/j;b:=eps*i/i;c:=i/j;

end;

procedure adjust_csb3(num:integer;vihod:real);

const eps=0.00001;

var lxj,mxj,mxjs,sum:real;

r,k,j,l,bb,d,delta:integer;

p1,p2,p5,p4:real; // Произведения при вычислении dw/d(cen)(sigma)(b)

s1,sc,ss,sb,dec,deb,des,dwc,dwb,dws:real; // dw/d(cen)(sigma)(b)

begin

for j:=1 to nac do

begin

for k:=1 to m do

begin

lxj:=1;

for l:=1 to nac do

lxj:=lxj*myu3[k,j];

mxj:=1;

for bb:=1 to m do

begin

mxjs:=0;

for d:=1 to nac do

mxjs:=mxjs+myu3[bb,d];

mxj:=mxj*mxjs;

end;

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*b3[k,j]/sigma3[k,j])*

exp( Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]*(2*b3[k,j]-1)) ))*

myu3[k,i]/sqr(1+exp(Ln(abs((a[j+num+3]-cen3[k,j])/sigma3[k,j]))*2*b3[k,j]) );

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

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

s1:=p3[r,0];

for l:=1 to nac do

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

sc:=sc+s1*dwc;

//dw/d(sigma)

p2:=1;

for i:=1 to m do

if i<>j then

p2:=p2*(2*b3[k,j]/sigma3[k,j])*

exp( Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]) ))*

myu3[k,i]/sqr(1+exp(Ln(abs((a[j+num+3]-cen3[k,j])/sigma3[k,j]))*2*b3[k,j]) );

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

ss:=ss+s1*dws;

//dw/d(b)

p5:=1;

for i:=1 to m do

if i<>j then

p5:=p5*(-2*exp( Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]) )*2*b3[k,j]))*

Ln( abs( (a[j+num+3]-cen3[k,j])/sigma3[k,j]) )*

myu3[k,i]/sqr(1+exp(Ln(abs((a[j+num+3]-cen3[k,j])/sigma3[k,j]))*2*b3[k,j]) );

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

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

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

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

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

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

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

end;//{k}

end;//{j}

end;//adjust_csb3

//adjust_csb

procedure adjust_csb(num:integer;vihod:real);

const eps=0.00001;

var lxj,mxj,mxjs,sum:real;

r,k,j,l,bb,d,delta:integer;

p1,p2,p3,p4:real; // Произведения при вычислении dw/d(cen)(sigma)(b)

s1,sc,ss,sb,dec,deb,des,dwc,dwb,dws:real; // dw/d(cen)(sigma)(b)

begin

for j:=1 to nac do

begin

for k:=1 to m do

begin

lxj:=1;

for l:=1 to nac do

lxj:=lxj*myu[k,j];

mxj:=1;

for bb:=1 to m do

begin

mxjs:=0;

for d:=1 to nac do

mxjs:=mxjs+myu[bb,d];

mxj:=mxj*mxjs;

end;

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