Метод Розенброка
Таблица итераций
(точность eps=10e-3)
| Номер итерации | |
|
| 1 | (-0.559,1.236) | 111.127 |
| 2 | (-0.174,-0.125) | 56.656 |
| 3 | (-0.864,-1.359) | 10.428 |
| 4 | (-1.125,-2.359) | -13.188 |
| 5 | (-1.754,-3.228) | -28.805 |
| 6 | (-2.087,-4.222) | -35.658 |
| 7 | (-2.232,-4.463) | -36.000 |
| 8 | (-2.236,-4.472) | -36.000
 |
procedure TFrmMain.Rosenbrouke(eps:double;fp:TWorldPoint);
const n=2;
var wavex,curx:TWorldPoint;
basis,a,b:array [1..n] of TWorldPoint;
screen:TScreenPoint;
gamma:double;
cappa:array[1..n] of double;
k,j,i:integer;
begin
basis[1].x:=1;basis[1].y:=0;//сначала базис совпадает со стандартным
basis[2].x:=0;basis[2].y:=1;
curx:=fp;{нормальные к-ые точки (используются после исчерпывающего спуска)}
wavex:=fp;{x с волной и с нижним индексом-промежуточные точки}
k:=1;
while true do
begin
for j:=1 to n do
begin
xk:=wavex;
uk:=basis[j];
cappa[j]:=MakeDichotomy(-1,1,1e-5,eps/100,Pseudo1D);
wavex.x:=wavex.x+cappa[j]*basis[j].x;
wavex.y:=wavex.y+cappa[j]*basis[j].y;
World2Screen(Area,CopyScr.Canvas.ClipRect,wavex,Screen);
Copyscr.Canvas.LineTo(Screen.x,Screen.y);
end; {for j}
if sqrt(sqr(wavex.x-curx.x)+sqr(wavex.y-curx.y))<eps then break
else curx:=wavex;
World2Screen(Area,CopyScr.Canvas.ClipRect,curx,Screen);
Copyscr.Canvas.LineTo(Screen.x,Screen.y);
SetPoint(curx);
BuiltReport(curx,curx,k,0);
for j:=1 to n do
begin
if abs(cappa[j])<eps*0.01 then
a[j]:=basis[j]
else
begin
a[j].x:=0;a[j].y:=0;
for i:=j to n do
begin
a[j].x:=a[j].x+cappa[i]*basis[i].x;
a[j].y:=a[j].y+cappa[i]*basis[i].y;
end;
end;
end;{for j}
b[1]:=a[1];
gamma:=sqrt(sqr(b[1].x)+sqr(b[1].y));
basis[1].x:=b[1].x/gamma;
basis[1].y:=b[1].y/gamma;
for j:=2 to n do
begin
b[j]:=a[j];
for i:=1 to j-1 do
begin
gamma:=(a[j].x*basis[i].x+a[j].y*basis[i].y);
b[j].x:=b[j].x-gamma*basis[i].x;
b[j].y:=b[j].y-gamma*basis[i].y;
end;
gamma:=sqrt(sqr(b[j].x)+sqr(b[j].y));
basis[j].x:=b[j].x/gamma;
basis[j].y:=b[j].y/gamma;
end; {for j}
inc(k);
wavex:=curx;
end; {while}
end;
