Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Метод золотого сечения

Автор: Catty 11.09.2005 20:39

вот программа которую я написала по тому алгоритму который дал нам препод на лекции
но почему то она не исправно работает! помогите найти ошибку!!

Код

const
e=0.1;
s=0.618;
var
a,b,xz,x1,x2,y1,y2,f1,f2:real;
i:integer;
begin
a:=0;
b:=10;
x1:=a+(1-s)*(b-a);
x2:=a+s*(b-a);
f1:= 5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
f2:= 5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;;
repeat
begin
if f1>f2 then
begin
a:=x1;
b:=b;
x2:=a+s*(b-a);
f1:=f2;
f2:= 5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;;
end
else
begin
b:=x2;
a:=a;
x2:=x1;
x1:=a+(1-s)*(b-a);
f2:=f1;
f1:=   5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
end;
end;
until (b-a)<e;

xz:=(a+b)/2;
y1:=  5*sin(xz)*sin(xz)-1/(sqr(xz)+1)+4;;

Label1.Caption:=FloatToStr(y1);

end;
end.

Автор: Romtek 11.09.2005 23:08

А как должно быть?

Я отформатировал код, а то нифига ничего не понятно...

uses Sysutils;

Const 
  e = 0.1;
  s = 0.618;

Var 
  a,b,xz,x1,x2,y1,y2,f1,f2: real;
  i: integer;
Begin
  a := 0;
  b := 10;
  x1 := a+(1-s)*(b-a);
  x2 := a+s*(b-a);
  f1 := 5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
  f2 := 5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;;
  Repeat
    Begin
      If f1>f2 Then
        Begin
          a := x1;
          b := b;
          x2 := a+s*(b-a);
          f1 := f2;
          f2 := 5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;
        End
      Else
        Begin
          b := x2;
          a := a;
          x2 := x1;
          x1 := a+(1-s)*(b-a);
          f2 := f1;
          f1 :=   5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
        End;
    End;
  Until (b-a)<e;

  xz := (a+b) / 2;
  y1 :=  5*sin(xz)*sin(xz)-1/(sqr(xz)+1)+4;

  writeln (FloatToStr(y1));
  readln;
End.

Автор: Romtek 11.09.2005 23:18

Кстати, а что такое
b := b;
и
a := a; ? smile.gif

Автор: Romtek 11.09.2005 23:22

Есть сомнение также насчёт записи самой функции:
ты уверена, что F(x) = 5 * (sin(x))^2 - (1 / (x^2 + 1)) + 4; ?

Автор: volvo 12.09.2005 2:37

Catty, вот, нашел у себя реализацию "золотого сечения". Эта реализация (при хорошо подобранном интервале [a, b]) дает правильное значение локального минимума функции...

function f(x: double): double;
begin
  result := 5 * sqr(sin(x)) - (1/(sqr(x) + 1)) + 4
end;

var
  a, b, x1, x2: double;
  f_x1, f_x2: double;
  l: double;

const
  sigma = 0.01;
begin

  a := -5;
  b := 10;

  l := b-a;
  x1 := a+l*0.3819660113; x2 := a+l*0.6180339887;
  f_x1 := f(x1); f_x2 := f(x2);

   while(l > sigma) do begin
     if f_x1 < f_x2 then begin
       l := x2-a; b := x2; x2 := x1; x1 := a+l*0.3819660113;
       f_x2 := f_x1; f_x1 := f(x1);
     end
     else begin
       l := b-x1; a := x1; x1 := x2; x2 := a+l*0.6180339887;
       f_x1 := f_x2; f_x2 := f(x2);
     end
   end;
   writeln('x = ', (b+a)*0.5, ' f(x) = ', f((b+a)*0.5));
end.

Автор: Romtek 12.09.2005 15:25

volvo
Это, конечно, хорошо, но ты привёл свой рабочий пример, а Catty просила найти ошибку в её примере. Надо учиться на своих ошибках, иначе никакого результата не будет.

Цитата(Catty)
          a := x1;
          b := b;
          x2 := a+s*(b-a);

          b := x2;
          a := a;
          x2 := x1;

Цитата(моя)
Кстати, а что такое
b := b;
и
a := a; ?

А теперь хорошо взглянуть на реализацию в коде, приведённом volvo. smile.gif

Автор: Catty 12.09.2005 22:40

бррррр так тихо давай те раберемся
Romtek я же сказала что написала прогу по блок-схеме которую дал на лекции препод, так что претензии не ко мне!
Спсибо что отформатировал код! smile.gif
у Volvo хороший код, только я не поняла что такое l := x2-a ??

Автор: volvo 13.09.2005 0:37

Catty, а вот это:

  l := b-a;
ты поняла? ;) 

  l := x2-a;
  ...
  l := b-x1;

- это вычисление длины интервала на каждом очередном шаге, чтобы разбить его на 2 части согласно алгоритму "золотого сечения" :yes:

Автор: Catty 13.09.2005 13:41

да я это поняла после того как написала предыдущее сообщение!! blink.gif
Спасибо всем ребята за помощь! :flowers: :molitva: