program lab4;
uses crt,graph;

var
x1,x2,eps1,eps2:real;
n,k,r,i,j:integer;
x:array[1..500,1..2] of real;
grad:array[1..2] of real;
l:string;
c:real;

{ Vychislenie funktsii }
function f(x1,x2:real):real;
begin
f:=sqr(x2-sqr(x1))+100*sqr(1-x1);
end;

{ Vychislenie funktsii zavisimosti ot tekuschego shaga }
function h(r:real;k:integer):real;
var x1,x2:real;
begin
x1:=x[k,1]-r*grad[1];
x2:=x[k,2]-r*grad[2];
h:=sqr(x2-sqr(x1))+100*sqr(1-x1);
end;


{ Vychislenie gradienta }
procedure Gradient(x1,x2:real);
var
e:real;
begin
     e:=5e-7;
     grad[1]:=(f(x1+e,x2)-f(x1,x2))/e;
     grad[2]:=(f(x1,x2+e)-f(x1,x2))/e;
end;

{ Vychislenie ekstremuma funktsii }
function Extreme(x:real;var k:integer):real;
var
maxy,miny,ext:real;
begin
maxy:=h(x,k);
miny:=h(x,k);
x:=x+0.001;
while (h(x,k)>maxy) or (h(x,k)<miny) do
                                     begin
                                     if (h(x,k)>maxy) then maxy:=h(x,k);
                                     if (h(x,k)<miny) then miny:=h(x,k);
                                     ext:=x;
                                     x:=x+0.001;
                                     end;
Extreme:=ext;
end;


{ Protsedura Poisk vyvodit na ekran koordinatnuyu setku i traektoriyu poiska tochki
optimuma }

procedure Poisk; { Traetoriya poiska }
var
   DriverVar, ModeVar:integer;
   w,CenterX,CenterY,One,Setka:integer;
   a,b,c,d:real;
begin
     clrscr;
     DriverVar:=Detect;
     InitGraph(DriverVar,ModeVar,'');
     if GraphResult<>grOk then
     begin
          writeln('Proizoshla oshibka initsializatsii grafiki!');
          writeln('Programma budet zakryta!');
	  readln;
          halt(1);
     end;
     Setka:=10;
     w:=2*Setka;
     while w<=GetMaxX-Setka do
     begin
          SetColor(DarkGray);
          Line(w,2*Setka,w,GetMaxY-2*Setka);
          w:=w+Setka;
     end;
     w:=2*Setka;
     while w<=GetMaxY-Setka do
     begin
          SetColor(DarkGray);
          Line(2*Setka,w,GetMaxX-2*Setka,w);
          w:=w+Setka;
     end;
     CenterX:=320;
     CenterY:=240;
     One:=20;
     SetColor(White);
     SetTextStyle(2,0,0);
     OutTextXY(CenterX-3,GetMaxY-12,'0');
     OutTextXY(GetMaxX-12,CenterY-3,'0');
     OutTextXY(CenterX-One*Setka-8,GetMaxY-12,'-1');
     OutTextXY(GetMaxX-12,CenterY-One*Setka-3,'1');
     OutTextXY(CenterX+One*Setka-3,GetMaxY-12,'1');
     OutTextXY(GetMaxX-16,CenterY+One*Setka-3,'-1');
     OutTextXY(20,10, 'Traektoriya poiska');
     OutTextXY(370,10, 'Dlya okonchaniya nazhmite Enter...');
     SetColor(LightCyan);
     Circle(CenterX,CenterY,2);
     SetColor(LightMagenta);
     Circle(CenterX+(One*Setka),CenterY-(One*Setka),2);
     SetColor(LightRed);
     Circle(CenterX+trunc(x[1,1]*One*Setka),CenterY-trunc(x[1,2]*One*Setka),2);
     for w:=2 to n do
     begin
          a:=x[w-1,1];
          b:=x[w-1,2];
          c:=x[w,1];
          d:=x[w,2];
          Line(CenterX+trunc(a*One*Setka),CenterY-trunc(b*One*Setka),CenterX+trunc(c*One*Setka),CenterY-trunc(d*One*Setka));
     end;
     readln;
     CloseGraph;
end;

{ Protsedura Graphic vyvodit na ekran zavisimost' rasstoyaniya ot tekuschei tochki do
tochki optimuma ot nomera iteratsii. Po okonchanii na ekran vyvoditsya menyu s
pomosch'yu protsedury Draw_Menu}

procedure Graphic;  {Postroenie grafika}
var
   DriverVar, ModeVar:integer;
   w:integer;
   tmp1,tmp2,func: real;
begin
     clrscr;
     DriverVar:=Detect;
     InitGraph(DriverVar,ModeVar,'');
     if GraphResult<>grOk then
     begin
          writeln('Proizoshla oshibka initsializatsii grafiki!');
          writeln('Programma budet zakryta!');
          readln;
          halt(1);
     end;
     for w:=1 to n-1 do
     begin
          tmp1:=sqr(x[w,1]-x[201,1]);
          tmp2:=sqr(x[w,2]-x[201,1]);
          func:=f(x[w,1],x[w,2])-f(x[201,1],x[201,2]);
          SetColor(Green);
          PutPixel(w*50+20,trunc(sqrt(tmp1)*100)+20,LightGreen);
          SetColor(Yellow);
          PutPixel(w*50+20,trunc(sqrt(tmp2)*100)+20,Yellow);
          SetColor(LightRed);
          PutPixel(w*50+20,trunc(func*100)+200,LightRed);
     end;
     SetColor(White);
     Line(20,0,20,GetMaxY);{Y}
     Line(0,20,GetMaxX,20);{X}
     Line(20,GetMaxY-17,20,GetMaxY-3);
     Line(20,GetMaxY-23,20,GetMaxY-3);
     Line(GetMaxX,20,GetMaxX-3,17);
     Line(GetMaxX,20,GetMaxX-3,23);
     SetTextStyle(0,1,1);
     OutTextXY(10,230, 'Rasstoyanie do tochki optimuma');
     SetTextStyle(0,0,1);
     OutTextXY(480,10, 'Kolichestvo iteratsii');
     OutTextXY(8,8,'0');
     PutPixel(400,200,Green);
     PutPixel(405,200,Green);
     PutPixel(410,200,Green);
     OutTextXY(415,200, 'Rasstoyanie dlya x1');
     PutPixel(400,210,Yellow);
     PutPixel(405,210,Yellow);
     PutPixel(410,210,Yellow);
     OutTextXY(415,210, 'Rasstoyanie dlya x2');
     PutPixel(400,220,LightRed);
     PutPixel(405,220,LightRed);
     PutPixel(410,220,LightRed);
     OutTextXY(415,220, 'Rasstoyanie dlya f');
     OutTextXY(350,435,'Grafik zavisimosti rasstoyaniya do');
     OutTextXY(350,443,'tochki optimuma ot nomera iteratsii');
     OutTextXY(350,452,'Nazhmite Enter dlya prodolzheniya...');
     readln;
     CloseGraph;
     Poisk;
end;

procedure menu2;
begin
writeln('Dlya prosmotra grafika nazhmite Enter...');
readln;
graphic;
end;


procedure Ostanov(n:integer;d:real);
begin
TextColor(magenta);
writeln;
if (d<eps1) and (grad[1]<eps2) and (grad[2]<eps2) then
   begin
   writeln('Nachalnaya tochka yavlyaetsya tochkoi optimuma');
   writeln;
   TextColor(LightMagenta);
   writeln('Rasstoyanie mezhdu tochkami: ',d);
   writeln('Znachenie gradienta (pervaya komponenta): ',grad[1]);
   writeln('Znachenie gradienta (vtoraya komponenta): ',grad[2]);
   end
else begin
     if (d<eps1) then begin
                      writeln('Vyhod proizoshel po usloviyu 1');
                      writeln;
                      TextColor(LightMagenta);
                      writeln('Rasstoyanie mezhdu tochkami: ',d);
                      writeln('Zadannaya pogreshnost: ',eps1);
                      end;

     if (grad[1]<eps2) and (grad[2]<eps2) then
                       begin
                       writeln('Vyhod proizoshel po usloviyu 2');
                       writeln;
                       TextColor(LightMagenta);
                       writeln('Znachenie gradienta (pervaya komponenta): ',grad[1]);
                       writeln('Znachenie gradienta (vtoraya komponenta): ',grad[2]);
                       end;
     end;
writeln('Chislo iteratsii: ',n-1);
writeln('Optimum: (',x[n,1]:r:r,', ', x[n,2]:r:r,')');
writeln;
menu2;
end;

procedure spysk(x1,x2:real;var k:integer);
var
d,r:real;
begin
x[k,1]:=x1;
x[k,2]:=x2;
Gradient(x[k,1],x[k,2]);
r:=Extreme(-0.01,k);{r-shag}
x[k+1,1]:=x[k,1]-r*grad[1];
x[k+1,2]:=x[k,2]-r*grad[2];
k:=k+1;
Gradient(x[k,1],x[k,2]);
d:=sqrt(sqr(x[k,1]-x[k-1,1])+sqr(x[k,2]-x[k-1,2]));
while  (d>eps1) and ((abs(grad[1])>eps2) and (abs(grad[2])>eps2))   do
       begin
       Gradient(x[k,1],x[k,2]);
       r:=Extreme(-0.01,k);
       x[k+1,1]:=x[k,1]-r*grad[1];
       x[k+1,2]:=x[k,2]-r*grad[2];
       k:=k+1;
       d:=sqrt(sqr(x[k,1]-x[k-1,1])+sqr(x[k,2]-x[k-1,2]));
       end;
Ostanov(k,d);
end;

procedure str_x;
var
   code:integer;
begin
     while (code<>0) do
     begin
          for i:=1 to length(l) do
          begin
               if l[i]='.' then l[i]:='q';
               if l[i]=',' then l[i]:='.';
          end;
          val(l,c,code);
          if (code<>0) then
          begin
                    TextColor(White);
                    writeln('Povtorite vvod soglasno ukazannym kriteriyam');
                    TextColor(LightGreen);
                    readln(l);
          end;
     end;
end;

procedure str_alpha;
var
   code:integer;
begin
     while (code<>0) do
     begin
          for i:=1 to length(l) do
          begin
               if l[i]='.' then l[i]:='q';
               if l[i]=',' then l[i]:='.';
          end;
          val(l,c,code);
          if (code<>0) then
          begin
                    TextColor(White);
                    writeln('Povtorite vvod soglasno ukazannym kriteriyam');
                    TextColor(LightGreen);
                    readln(l);
          end;
     end;
end;

procedure menu1;
var s:char;
label 10,20,30;
begin
TextColor(white);
writeln('Dlya nachala raboty nazhmite 1');
writeln('Dlya prosmotra spravki nazhmite 2');
writeln('Dlya vyhoda iz programmy nazhmite 3');
repeat
s:=readkey;
case s of
'1': begin
   clrscr;
10:writeln('Koordinaty nachalnoi tochki (x1,x2): ');
   write('Razmernost argumenta: ');
   readln(l);
   if length(l)=0 then
   begin
         r:=2;
         TextColor(lightred);
         writeln('razmernost 2 po umolchaniyu');
         writeln;
         TextColor(white);
   end
   else
   begin
   str_x;
   r:=trunc(c);
   end;
   write('Pervaya koordinata: ');
   readln(l);
   if length(l)=0 then
   begin
         x1:=-1.2;
         TextColor(lightred);
         writeln('x1=-1.2 po umolchaniyu');
         writeln;
         TextColor(white);
   end
   else
   begin
   str_x;
   x1:=c;
   end;
   write('Vtoraya koordinata: ');
   readln(l);
   if length(l)=0 then
   begin
         x2:=1;
         TextColor(lightred);
         writeln('x2=1 po umolchaniyu');
         writeln;
         TextColor(white);
   end
   else
   begin
   str_x;
   x2:=c;
   end;

   write('Pogreshnost dlya otsenki rasstoyaniya mezhdu tochkami: ');
     readln(l);
     if length(l)=0 then
     begin
               eps1:=0.005;
               TextColor(lightred);
               writeln('alfa:=0,005 po umolchaniyu');
               writeln;
               TextColor(white);
     end
     else
     begin
     str_alpha;
     eps1:=c;
     if (eps1<=0) or (eps1>1) then
     begin
          eps1:=0.005;
               TextColor(lightred);
          writeln('V rezultate nevernogo vvoda alfa ustanovlena po umolchaniyu = ',eps1:2);
               writeln;
               TextColor(white);
     end;
     end;
   write('Pogreshnost dlya otsenki velichiny gradienta: ');
     readln(l);
     if length(l)=0 then
     begin
               eps2:=0.005;
               TextColor(lightred);
               writeln('beta:=0,005 po umolchaniyu');
               writeln;
               TextColor(white);
     end
     else
     begin
     str_alpha;
     eps2:=c;
     if (eps2<=0) or (eps2>1) then
     begin
          eps2:=0.005;
               TextColor(lightred);
          writeln('V rezultate nevernogo vvoda beta ustanovlena po umolchaniyu = ',eps2:2);
               writeln;
               TextColor(white);
     end;
     end;
   spysk(x1,x2,n);
   end;
'2': begin
   20: clrscr;
       TextColor(white);
       writeln('Programma realizatsii metoda naiskoreishego spuska.');
       TextColor(LightRed);
       writeln('Testovaya funktsiya (x2-x1^2)^2+100(1-x1)^2.');
       TextColor(white);
       writeln('Usloviya ostanova:');
       writeln('Rasstoyanie mezhdu tochkami menshe zadannoi pogreshnosti.');
       writeln('Znachenie gradienta menshe zadannoi pogreshnosti');
       writeln;
       writeln;
       writeln('Dlya nachala raboty nazhmite 1');
       writeln('Dlya vyhoda iz programmy nazhmite 3');
       s:=readkey;
       case s of
              '1': begin
                 clrscr;
                 goto 10;
                 end;
              '3': goto 30;
              end;
       end;
'3': begin
   30: exit;
   end;

else exit;
end;
until s=#13
end;

BEGIN
n:=1;
clrscr;
menu1;
END.