Метод золотого сечения
Метод золотого сечения позволяет исключать интервалы, вычисляя только одно значение функции на каждой итерации. В результате двух рассмотренных значений функции определяется интервал, который должен использоваться в дальнейшем. Этот интервал будет содержать одну из предыдущих точек и следующую точку, помещаемую симметрично ей. Точка делит интервал на две части так, что отношение целого к большей части равно отношению большей части к меньшей, т. е. равно так называемому «золотому сечению». Воспользуемся соотношением Lj-1 = Lj + Lj+1. Будем поддерживать постоянными отношения длин интервалов
Lj-1 / Lj = Lj / Lj+1 = τ. Это уравнение имеет единственный положительный корень τ = (1+5^1/2) / 2= 1.618 (рис.9). первые 2 эксперимента
находятся на расстоянии 0.618 от концов отрезка. По результатам экспериментов сохраняется 1 из интервалов, и все повторяется. После n экспериментов
Ln = 1/ τn-1.
Рис.9
Поиск с помощью метода золотого сечения является асимптотически наиболее эффективным способом реализации минимаксной стратегии поиска, так как требует наименьшего числа оценки значения функции для достижения заданной точности по сравнению с другими методами исключения интервалов.
Листинг программы по методу пассивного поиска, методу дихотомии, методу “золотого сечения”, оптимальный поиску
function TMyForm.F(x:real):real;
begin
Result:=(2*x-2)*(2*x-2)+2
end;
function TMyForm.PasPoisk(XMax,XMin,Eps,D:Real):string;
var
N: word;
i: word;
Index: word;
temp: real;
x: array[word] of real;
begin
n:=trunc((2*(XMax-XMin))/Epsilon);
if (frac((2*(XMax-XMin))/Epsilon)<>0) then inc(N);
if odd(N) then inc(N);
x[1]:=XMin;
x[N]:=XMax;
temp:=XMin;
for i:=1 to (N div 2 - 1) do
begin
temp:=temp+(XMax-XMin)/(N/2);
x[2*i]:=temp-D;
x[2*i+1]:=temp+D
end;
Index:=1;
for i:=2 to N do
if (f(x[Index])>f(x[i])) then Index:=i;
for i:=1 to N do chGraph.Series[0].AddXY(x[i],f(x[i]),'',clBlue);
chGraph.Series[1].AddXY(x[Index],f(x[Index]),'',clRed);
Result:=FloatToStr(x[Index])+'; Количество итераций = '+IntToStr(N)+'.'
end;
function TMyForm.Dihotomy(XMax,XMin,Eps,D:Real):string;
var
N: word;
x: array [1..4] of real;
begin
x[1]:=XMin;
x[4]:=XMax;
N:=2;
chGraph.Series[0].AddXY(x[1],f(x[1]),'',clAqua);
chGraph.Series[0].AddXY(x[4],f(x[4]),'',clAqua);
while((abs(x[4]-x[1])/2)>Eps) do
begin
x[2]:=((x[4]-x[1])/2)-D;
x[3]:=((x[4]-x[1])/2)+D;
inc(N,2);
chGraph.Series[0].AddXY(x[2],f(x[2]),'',clAqua);
chGraph.Series[0].AddXY(x[2],f(x[3]),'',clAqua);
if (f(x[3])>f(x[2])) then x[4]:=x[3]
else x[1]:=x[2]
end;
chGraph.Series[1].AddXY((x[1]+x[4])/2,f((x[1]+x[4])/2),'',clRed);
Result:=FloatToStr((x[1]+x[4])/2)+'; Количество итераций = '+IntToStr(N)
end;
function TMyForm.GoldSection(XMax,XMin,Eps,D:Real):string;
const Tau=0.618;
var
i: byte;
N: word;
x: array[1..4] of Real;
y: array[1..4] of Real;
begin
x[1]:=XMin;
x[4]:=XMax;
x[2]:=XMax-Tau*(XMax-XMin);
x[3]:=XMin+Tau*(XMax-XMin);
for i:=1 to 4 do y[i]:=f(x[i]);
for i:=1 to 4 do chGraph.Series[0].AddXY(x[i],f(x[i]),'',clRed);
N:=4;
while (abs(x[4]-x[1])/2)>Eps do
if y[3]>y[2] then
begin
x[4]:=x[3]; y[4]:=y[3];
x[3]:=x[2]; y[3]:=y[2];
x[2]:=x[4]-Tau*(x[4]-x[1]);
y[2]:=f(x[2]);
chGraph.Series[0].AddXY(x[2],y[2],'',clRed);
inc(N)
end
else
begin
x[1]:=x[2]; y[1]:=y[2];
x[2]:=x[3]; y[2]:=y[3];
x[3]:=x[1]-Tau*(x[4]-x[1]);
y[3]:=f(x[3]);
chGraph.Series[0].AddXY(x[3],y[3],'',clRed);
inc(N)
end;
chGraph.Series[1].AddXY((x[1]+x[4])/2,f((x[1]+x[4])/2),'',clBlue);
Result:=FloatToStr((x[4]+x[1])/2)+'; Количество итераций = '+IntToStr(N)
end;
function TMyForm.OptPoisk(XMax,XMin,Eps,D:Real):string;
var fb: array[byte] of word;
x: array[1..4] of real;
L: array[byte] of real;
i: byte;
N: word;
begin
x[1]:=XMin;
fb[0]:=1;
x[4]:=XMax;
fb[1]:=1;
N:=1;
while (fb[N]<((XMax-XMin)/Eps)) do
begin
inc(N);
fb[N]:=fb[N-1]+fb[N-2]
end;
L[N]:=((XMax-XMin)-fb[N-2]*D)/fb[N];
for i:=1 to N-1 do
L[i]:=fb[N-i+1]*L[N]-fb[N-i-1]*D;
for i:=1 to N do
begin
x[2]:=x[4]-L[i];
x[3]:=x[1]+L[i];
chGraph.Series[0].AddXY(x[2],f(x[2]),'',clBlue);
chGraph.Series[0].AddXY(x[3],f(x[3]),'',clBlue);
if f(x[3])>f(x[2]) then
begin
x[4]:=x[3];
x[3]:=x[2]
end
else
begin
x[1]:=x[2];
x[2]:=x[3]
end;
end;
chGraph.Series[1].AddXY((x[1]+x[4])/2,f((x[1]+x[4])/2),'',clRed);
Result:=FloatToStr((x[4]+x[1])/2)+'; Количество итераций = '+IntToStr(N)
end;
procedure TMyForm.ExitClick(Sender: TObject);
begin
close
end;
procedure TMyForm.btExecClick(Sender: TObject);
begin
try
XMin:=StrToFloat(edMin.Text);
XMax:=StrToFloat(edMax.Text);
Epsilon:=StrToFloat(edEps.Text);
delta:=0.25*Epsilon
except
ShowMessage('Данные некорректны');
end;
edMin.Enabled:=False;
edMax.Enabled:=False;
edEps.Enabled:=False;
btExec.Enabled:=False;
rbM1.Enabled:=False;
rbM2.Enabled:=False;
rbM3.Enabled:=False;
rbM4.Enabled:=False;
MyForm.Width:=500;
MyForm.Height:=310;
chGraph.Show;
pnAnswer.Show;
if rbM1.Checked=true then lbX.Caption:=lbX.Caption+(PasPoisk(XMax,XMin,Epsilon,Delta));
if rbM2.Checked=true then lbX.Caption:=lbX.Caption+(Dihotomy(XMax,XMin,Epsilon,Delta));
if rbM3.Checked=true then lbX.Caption:=lbX.Caption+(GoldSection(XMax,XMin,Epsilon,Delta));
if rbM4.Checked=true then lbX.Caption:=lbX.Caption+(OptPoisk(XMax,XMin,Epsilon,Delta));
end;
end.