Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.06.2010, 18:23   #1
mimi_mimi
Новичок
Джуниор
 
Аватар для mimi_mimi
 
Регистрация: 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.
mimi_mimi вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Волновой алгоритм (алгоритм Ли) 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