uses crt;

const E=0.001; l=0.1;

var  x1, x2, y1, y2, a, a1, b, b1, xmin: Extended;
    n, k, it: Word;
{---------------------------}
function f(n: Word): Comp;
var fa, fb, fc: Comp;
   i:Integer;
begin
   fa:=0; fb:=1;
   for i:= 3 to n do begin
                     fc:=fa+fb;
                     fa:=fb;
                     fb:=fc;
                     f:=fc;
                     end;
end;
{---------------------------}
BEGIN   clrscr;
       a:=2; b:=4; a1:=a; b1:=b; n:=3;
       While f(n)< (b1-a1)/l do n:=n+1;
       Writeln('n= ',n,'   f(n)= ',f(n):3:0);
       x1:= a+f(n-2)/f(n)*(b-a);
       x2:= a+f(n-1)/f(n)*(b-a);
       y1:= 5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
       y2:= 5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;
        k:= 1; it:=0;
       Repeat
       it:=it+1;
       if y1>y2 then begin
                     a:=x1;
                     x1:=x2;
                     x2:=a+f(n-k-1)/f(n-k)*(b-a);
                     y2:=5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;
                     k:=k+1;
                     end
       else  begin
                     b:=x2;
                     x2:=x1;
                     x1:=a+f(n-k-2)/f(n-k)*(b-a);
                     y1:=5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
                     k:=k+1;
                     end;
       Until k=n-2;
       x2:=x1+E;
       y1:=5*sin(x1)*sin(x1)-1/(sqr(x1)+1)+4;
       y2:=5*sin(x2)*sin(x2)-1/(sqr(x2)+1)+4;
       if y1<y2 then b:=x2
                else a:=x1;
       Writeln ('Optimalnoe reshenie v intervale [',a1:6:2,',', b1:6:2,']');
       Writeln  ('Kilkist iteracij', it:6);
       if a=a1 then xmin:= a1 else
       if b=b1 then xmin:= b1 else xmin:=(a+b)/2;
  Writeln ('Pri x=',xmin:7:2,' funkcija prinimaet min znachenie ',
           (5*sin(xmin)*sin(xmin)-1/(sqr(xmin)+1)+4):8:3);
  Readln;
END.