program HuDjMody;

label 0,1,2,3,4,5,6,7;

var
  k,h,z,ps,bs,fb,fi :real;
  i,j,n,fe :integer;
  x,y,b,p :array[1..10] of real;

procedure calculate;
begin
  z:=3*sqr(x[1]-5) + 3*sqr(x[2]-5) + 2*x[1]*x[2];
  if (x[1]<0) or (x[2]<0) or ((x[1]+x[2])<4) then
    z:=1.7e+38;
  fe:=fe+1;
end;

begin
  n := 2;
  x[1] := 0;
  x[2] := 0;
  h := 1;

  k:=h;
  fe:=0;

  for i:=1 to n do
  begin
    y[i]:=x[i];
    p[i]:=x[i];
    b[i]:=x[i];
  end;

  calculate;
  fi:=z;

  writeln('Начальное значение функции: ', z:2:3);
  for i:=1 to n do
    writeln('x[',i,'] = ', x[i]:2:3);

  ps:=0;
  bs:=1;
  j:=1;
  fb:=fi;

0: x[j]:=y[j]+k;
  calculate;
  if z<fi then goto 1;
  x[j]:=y[j]-k;
  calculate;
  if z<fi then goto 1;
  x[j]:=y[j];
  goto 2;

1: y[j]:=x[j];

2: calculate;
  fi:=z;
  writeln('Пробный шаг ', z:2:3);
  for i:=1 to n do
    writeln(x[i]:2:3);
  if j=n then goto 3;
  j:=j+1;
  goto 0;

3: if fi<fb-1e-08 then goto 6;
  if (ps=1) and (bs=0) then goto 4;
  goto 5;

4: for i:=1 to n do
    begin
      p[i]:=b[i];
      y[i]:=b[i];
      x[i]:=b[i];
    end;
  calculate;
  bs:=1;
  ps:=0;
  fi:=z;
  fb:=z;
  writeln('Замена базисной точки ', z:2:3);
  for i:=1 to n do
    writeln(x[i]:1:3);
  j:=1;
  goto 0;

5: k:=k/10;
  writeln('Уменьшить длину шага');
  if k<1e-08 then goto 7;
  j:=1;
  goto 0;

6: for i:=1 to n do
    begin
      p[i]:=2*y[i]-b[i];
      b[i]:=y[i];
      x[i]:=p[i];
      y[i]:=x[i];
    end;
  calculate;
  fb:=fi;
  ps:=1;
  bs:=0;
  fi:=z;
  writeln('Поиск по образцу ', z:2:3);
  for i:=1 to n do
    writeln(x[i]:2:3);
  j:=1;
  goto 0;

7: writeln('Минимум найден');
  for i:=1 to n do
    writeln('x(',i,')=',p[i]:2:3);
  writeln;
  writeln('Минимум функции равен ', fb:2:3);
  writeln('Количество вычислений функции равно ', fe);
end.
