|
|
Регистрация Восстановить пароль |
Повторная активизация e-mail |
Регистрация | Задать вопрос |
Заплачу за решение |
Новые сообщения |
Сообщения за день |
Расширенный поиск |
Правила |
Всё прочитано |
|
Опции темы | Поиск в этой теме |
20.06.2010, 18:23 | #1 |
Новичок
Джуниор
Регистрация: 20.06.2010
Сообщений: 1
|
алгоритм покоординатного спуска
работает, но препод не принимает...что-то не так, не могу понять, что...
program pooksp; uses crt; const n=3; type matrix=array[1..n,1..n] of real; vector=array[1..n] of real; function F(ZZ:vector):real; var x,y,z,S:real; begin x:=ZZ[1]; y:=ZZ[2]; z:=ZZ[3]; S:=exp(x+y+z)+cos(z)+sin(x)+x*x+y*y +4*z*z; F:=S; end; procedure spusk (eps:real); var i,k,l,j:integer; basis,Z:matrix; ZZ,Z1,Zk,Zn,X:vector; a,a0,FF:real; flag4,flag6,flag7,flag9:boolean; begin flag4:=false; flag6:=true; flag7:=false; flag9:=false; basis[1,1]:=1; basis[1,2]:=0; basis[1,3]:=0; basis[2,1]:=0; basis[2,2]:=1; basis[2,3]:=0; basis[3,1]:=0; basis[3,2]:=0; basis[3,3]:=1; k:=1; a0:=1; a:=a0; Z1[1]:=1; Z1[2]:=1; Z1[3]:=1; {vibrala na4alnoe priblizhenie takim} Z[1,1]:=0; Z[1,2]:=0; Z[1,3]:=0; Z[2,1]:=0; Z[2,2]:=0; Z[2,3]:=0; Z[3,1]:=0; Z[3,2]:=0; Z[3,3]:=0; while 2*a>eps do begin if flag6=true then {wag3} for i:=1 to n do begin ZZ[i]:=Z[i,k]+a*basis[k,i]; Zk[i]:=Z[i,k]; flag6:=false; end; if F(ZZ)<F(Zk) then {wag4} begin flag4:=true; for i:=1 to n do Z[k,i+1]:=ZZ[i]; end else for i:=1 to n do ZZ[i]:=Z[k,i]-a*basis[k,i]; if flag4=true then {wag5} if F(ZZ)<F(Zk) then begin for i:=1 to n do Z[k+1,i]:=ZZ[i]; end else for i:=1 to n do Z[k,i]:=Z[k+1,i]; if k<n then {wag6} begin k:=k+1; flag6:=true; end else flag6:=false; if flag6=false then begin if a<eps then {wag7} flag7:=true; for i:=1 to n do {wag8} Zn[i]:=Z[i,k+1]; if (Zn[1]=Z1[1]) and (Zn[2]=Z1[2]) and (Zn[3]=Z1[3]) then a:=a/2 else Z1:=Zn; k:=0; {wag9} end; if flag7=true then begin X:=Zn; FF:=F(Zn); for i:=1 to n do begin for j:=1 to n do write(Z[i,j],' '); writeln; end; writeln; for i:=1 to n do writeln(ZZ[i]); writeln; writeln(FF); readln; exit; end; end; end; var eps:real; Begin clrscr; writeln ('vvedite eps: '); readln (eps); spusk (eps); End. |
Опции темы | Поиск в этой теме |
Похожие темы | ||||
Тема | Автор | Раздел | Ответов | Последнее сообщение |
Волновой алгоритм (алгоритм Ли) | MrRockchip | Общие вопросы C/C++ | 4 | 10.05.2010 13:26 |
Алгоритм?! | Spartaner | Фриланс | 2 | 28.05.2009 03:22 |
Алгоритм наискорейшего спуска для любого количества аргументов целевой функции | Evil Sun | Общие вопросы C/C++ | 5 | 08.05.2009 13:18 |
Метод градиентного спуска | varvara16 | Мультимедиа в Delphi | 0 | 25.10.2008 19:38 |