program  SiB;


       const m=5; n=8;  {  значения для параметров задачи }
             e0=1e-8;      { сравнение с нулем, процудура Excl }
             ed=1e-7;      { проверка на оптимальность в процедуре OPT}
             e1=1e-7;      { нет планов, если  mu(x) > e1 }
             ITER=1000;    { ограничение числа итераций }

       procedure SimplBlend;

       label mkopt, mkres, mkend;
     var
      A: array[1..m,1..n]   of real;
      D: array[1..m,1..m+1] of real;
      b,cb,z: array[1..m] of real;
      u: array[1..m+1] of real;
      c,w: array[1..n] of real;
      c1,x: array[1..m+n] of real;
      bas,num: array[0..m+1] of integer;
      kay,i,j,nn,k,nk,it,j0,s0: integer;
      del,t,f,r: real;
      vad,vid:   text;

     procedure VVOD;
             var i,j:integer;

             begin     assign(vad, 'RESULT.txt'); rewrite(vad);
                    writeln(vad, 'SimplBlend.pas    DAN.txt   ');
                       writeln(vad);

                       assign(vid,'DAN.txt'); reset(vid);

                       for i:=1 to m do
                       for j:=1 to n do
                           read(vid,A[i,j]);

                       for i:=1 to m do  read(vid,b[i]);

                       for j:=1 to n do  read(vid,c[j]);

                             close(vid);

      end;

      procedure Start;

               var i,j:integer;
             begin
                       kay:=1;
               for i:=1 to m do begin
                  D[i,m+1]:=abs(b[i]);  cb[i]:=1;
                  for j:=1 to m do D[i,j]:=0;
                  if b[i]< 0 then D[i,i]:=-1 else D[i,i]:=1;
                  bas[i]:=n+i; num[i]:=i;
                  c1[i+n]:=1;
               end;
                for i:=1 to n do c1[i]:=0;

             end;

      procedure Opt(var j0:integer; var del:real);

         var i,j: integer; r:real;
         begin
                    for j:=1 to m+1 do begin
                      r:=0;
                      for i:=1 to m do r:=r+cb[i]*D[i,j];
                      u[j]:=r;
                    end;   f:=u[m+1];

                 j0:=0; del:=ed;
                 for j:=1 to n do begin
                   r:=-c1[j];
                   for i:=1 to m do r:=r+u[i]*A[i,j];
                   w[j]:=r;
                   if r >= del  then begin  j0:=j;  end;
                 end;

         end;

      procedure Excl(var t:real; var nn,s0:integer);
                var i,j,k:integer; r,t0:real;
              begin
                   nn:=0; s0:=0; t:=1e10;
                  for k:=1 to m do begin
                    i:=num[k];
                    r:=0;
                    for j:=1 to m do r:=r+D[i,j]*A[j,j0];
                    z[i]:=r;
                    if r > e0 then begin
                       t0:=D[i,m+1]/r;
                       if t0 <= t then begin t:=t0; nn:=i; nk:=k end;
                    end;
                  end;
                  if nn > 0 then  s0:=bas[nn];

              end;

      procedure Per(nn,nk:integer);
         var i,j:integer;
               r:real;
              begin
                  cb[nn]:=c1[j0];
                 for j:=1 to m+1 do begin
                   r:=D[nn,j]/z[nn];
                   for i:=1 to m do D[i,j]:=D[i,j]-r*z[i];
                   D[nn,j]:=r;
                 end;

                  k:=1;
                  while  (j0 > bas[num[k]]) and ( k <nk) do k:=k+1;


                  if k=nk then  begin
                    k:=nk+1;
                    while ( j0 > bas[num[k]]) and ( k<m+1) do k:=k+1;
                    k:=k-1;
                  end;

                  bas[nn]:=j0;

                  if k=nk then begin num[k]:=nn; exit end;

                  if k<nk then begin
                     for i:=nk downto k+1 do num[i]:=num[i-1];
                     num[k]:=nn;
                     exit
                  end;

                  if k>nk then begin
                     for i:=nk  to k-1 do num[i]:=num[i+1];
                     num[k]:=nn;
                     exit
                  end;

              end;

      procedure PEREHOD;
          var i,j:integer;

              begin
                     kay:=2;
                     for i:=1 to n do c1[i]:=c[i];

                     for i:=1 to m do begin
                       c1[n+i]:=0; j:=bas[i];

                       if j > n then begin
                          for  j:=1 to m do D[i,j]:=-D[i,j];
                          c1[n+1]:=0; cb[i]:=0;

                       end else cb[i]:=c1[j];
                     end;
              end;

      BEGIN    VVOD;
               Start;
               it:=0;

      mkopt:   Opt(j0,del);

               it:=it+1; if it=ITER then begin
                         writeln(vad,'Число итераций превысило ITER=',ITER);
                            goto mkend;
                         end;

               if j0=0 then  begin

                      if (kay=1) and (f > e1) then begin
                          writeln(vad,'НЕТ  ПЛАНОВ   f=',f );
                          goto  mkend
                      end;

                      if kay=2 then goto mkres;

                      Perehod;  goto mkopt;
               end;

               EXCL(t,nn,s0);


               if nn=0 then begin
          writeln(vad,'НЕТ РЕШЕНИЯ.');
                 goto mkend;
               end;

               PER(nn,nk);
               goto  mkopt;

      mkres:
                   for i:=1 to n do x[i]:=0;

                   for i:=1 to m do
                     if bas[i] < n+1 then x[bas[i]]:=D[i,m+1];

                      writeln(vad,'     RESULT.tex');
                      writeln(vad);

                      writeln(vad, 'За ',it,' итераций получено решение:');
                      writeln(vad);
                   for i:=1 to n do   writeln(vad, 'x[',i,']=',x[i]);
                                      writeln(vad);
                                      writeln(vad, 'Двойственный вектор:');
                                      writeln(vad);
                   for i:=1 to m do   writeln(vad, 'u[',i,']=',u[i]);
                                      writeln(vad);

                   writeln(vad,'Значение целевой функции  f=',u[m+1]);
                   writeln(vad);
                   writeln(vad,'Контроль:');
                   writeln(vad);


                   del:=0;
                   for i:=1 to m do begin
                      r:=-b[i];
                      for j:=1 to n do r:=r+A[i,j]*x[j];
                      if abs(r) > del then del:=abs(r);
                   end;
                   writeln(vad, '| Ax-b |=',del);
                   r:=-f;
                   for i:=1 to m do r:=r+u[i]*b[i];
                   writeln(vad, '<u,b>-f=',r);
                   del:=0 ;
                   for i:=1 to n do begin
                       r:=c[i];
                       for j:=1 to m do r:=r-u[j]*A[j,i];
                       if r < del then del:=r;
                   end;

                   writeln(vad, 'uA-c<=',-del);

        mkend: close(vad);

      END;

      BEGIN

      SimplBlend;

      END.