program Kurs97;

uses crt;

const
  n = 2;
  m = 3;
  Epsilon = 0.000001;

var
  VectorA              : array [1..m, 0..m+n] of real;
  TargetVector         : array [1..m+n]       of real;
  SimplexVector        : array [0..m+n]       of real;
  DigitOfBasisVector   : array [1..m]         of real;
  BasisVector          : array [1..m]         of integer;

  IndexOfEnterVector  : integer;
  IndexOfOutputString : integer;
  MinimumBuffer       : real;

  key   : char;
  FileOfOutput : text;

{ Ž¯¨á ­¨¥ ¯à®æ¥¤ãà }

procedure ReadDates; { áç¨â뢠­¨¥ ¤ ­­ëå ¨§ ä ©«  }
var
  DateFile : text;

  procedure ReadDatesTargetVector; { áç¨â뢠­¨¥ ¤ ­­ëå 楫¥¢®£® ¢¥ªâ®à  }
  var i : integer;
  begin
    for i:=1 to n do Readln(DateFile, TargetVector[i]);
  end;

  procedure ReadDatesVectorA; { áç¨â뢠­¨¥ ¢¥ªâ®à  € ¨ § ¯®«­¥­¨¥ ¥¤¨­¨æ ¬¨ ¤¨ £®­ «¨}
  var i,j : integer;
  begin
    for j:=0 to n do
      for i:=1 to m do
        Readln(DateFile, VectorA[i, j]);
    i:=1;
    for j:=n+1 to n+m do
    begin
      VectorA[i, j]:=1;
      inc(i)
    end;
  end;

  procedure ReadDatesBasisVector;
  var i : integer;
  begin
    for i:=1 to m do BasisVector[i]:=n+i;
  end;

begin
  Assign(DateFile, 'kurs97.dat');
  Reset(DateFile);
  ReadDatesTargetVector;
  ReadDatesVectorA;
  ReadDatesBasisVector;
  Close(DateFile);
end;

procedure CountSimplexVector; { à áç¥â ᨬ¯«¥ª-¢¥ªâ®à  }
var
  i,j      : integer;
  Summa    : real;
  Simplex  : real;
begin
  SimplexVector[0]:=0;
  for i:=1 to m do
    SimplexVector[0]:=SimplexVector[0] + DigitOfBasisVector[i]*VectorA[i, 0];
  for j:=1 to m+n do
  begin
    Summa:=0;
    for i:=1 to m do Summa:=Summa + DigitOfBasisVector[i]*VectorA[i, j];
    SimplexVector[j]:=Summa - TargetVector[j];
    if abs(SimplexVector[j]) <= Epsilon then SimplexVector[j]:=0;
  end;
end;

function GetEnterVector : integer; { ¯®¨áª ¢¢®¤¨¬®£® ¢¥ªâ®à  }
var
  i   : integer;
  Min : real;
begin
  GetEnterVector:=1;
  Min:=SimplexVector[1];
  for i:=2 to m+n do
    if Min > SimplexVector[i]
      then
      begin
        GetEnterVector:=i;
        Min:=SimplexVector[i];
      end;
end;

function GetOutputString : integer; { ¯®¨áª ¢ë¢®¤¨¬®© áâப¨ }
var
  i   : integer;
  Temp : real;
begin
  GetOutputString:=1;
  if VectorA[1, IndexOfEnterVector] > 0 then MinimumBuffer:=VectorA[1, 0] / VectorA[1, IndexOfEnterVector];
  for i:=2 to m do
  begin
    Temp:=VectorA[i, 0] / VectorA[i, IndexOfEnterVector];
    if Temp > 0 then
    if MinimumBuffer >= Temp then
    begin
      MinimumBuffer:=Temp;
      GetOutputString:=i;
    end;
  end;
end;

procedure ReCountOutputString; { ¯¥à¥áç¥â ª®íää¨æ¨¥­â®¢ ¢ë¢®¤¨¬®© áâப¨ }
var
  i,j     : integer;
  Buffer  : real;

  procedure ReCountDigitOfBasisVector;
  begin
    DigitOfBasisVector[IndexOfOutputString]:=TargetVector[IndexOfEnterVector];
  end;

  procedure ReCountBasisVector;
  begin
    BasisVector[IndexOfOutputString]:=IndexOfEnterVector;
  end;

begin
  ReCountDigitOfBasisVector;
  ReCountBasisVector;
  Buffer:=VectorA[IndexOfOutputString, IndexOfEnterVector];
  for i:=0 to m+n do
  begin
    VectorA[IndexOfOutputString, i]:=VectorA[IndexOfOutputString, i] / Buffer;
  end;
end;

procedure ReCountVectorA;
var i,j  : integer;
begin
  for j:=0 to m+n do
  begin
    for i:=1 to m do
    begin
      if i <> IndexOfOutputString then
        if j <> IndexOfEnterVector
          then VectorA[i, j]:=VectorA[i, j] - VectorA[i, IndexOfEnterVector]*VectorA[IndexOfOutputString, j];
    end;
  end;
  for i:=1 to m do
    if i <> IndexOfOutputString then VectorA[i, IndexOfEnterVector]:=0;
end;

function AllIsPositiv : boolean;
var i : integer;
begin
  AllIsPositiv:=True;
  for i:=1 to m+n do
    if SimplexVector[i] < 0 then AllIsPositiv:=False;
end;

function ToStr(const D : real) : string;
var S : string;
begin
  str(D:6:2, S);
  ToStr:=' ' + S + ' ';
end;

procedure WriteMatrixs;

  procedure WriteTargetMatrix;
  var i : integer;
  begin
    writeln('                   ÚÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄ¿');
    write  ('                   ³ Target ³');
    for i:=1 to n+m do write(ToStr(TargetVector[i]),'³');  writeln;
  end;

  procedure WriteMatrixA;
  var i,j  : integer;
  begin
    writeln(' ÚÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
    writeln(' ³ Basis  ³ D.Basis³   A 0  ³   A 1  ³   A 2  ³   A 3  ³   A 4  ³   A 5  ³');
    writeln(' ÃÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
    for i:=1 to m do
    begin
      write(' ³  A ',BasisVector[i],'   ³',ToStr(DigitOfBasisVector[i]),'³');
      for j:=0 to m+n do write(ToStr(VectorA[i, j]),'³');  writeln;
      if i = m then writeln(' ÀÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´')
               else writeln(' ÃÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
    end;
  end;

  procedure WriteMatrixSimplex;
  var i : integer;
  begin
    write('          ³ Simplex³');
    for i:=0 to m+n do write(ToStr(SimplexVector[i]),'³'); writeln;
    writeln('          ÀÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÙ');
  end;

begin
  clrscr;
  WriteTargetMatrix;
  WriteMatrixA;
  WriteMatrixSimplex;
end;

procedure WriteMatrixsInFile;

  procedure WriteTargetMatrix;
  var i : integer;
  begin
    writeln(FileOfOutput, '                   ÚÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄ¿');
    write  (FileOfOutput, '                   ³ Target ³');
    for i:=1 to n+m do write(FileOfOutput, ToStr(TargetVector[i]),'³');  writeln(FileOfOutput);
  end;

  procedure WriteMatrixA;
  var i,j  : integer;
  begin
    writeln(FileOfOutput, ' ÚÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
    writeln(FileOfOutput, ' ³ Basis  ³ D.Basis³   A 0  ³   A 1  ³   A 2  ³   A 3  ³   A 4  ³   A 5  ³');
    writeln(FileOfOutput, ' ÃÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
    for i:=1 to m do
    begin
      write(FileOfOutput, ' ³  A ',BasisVector[i],'   ³',ToStr(DigitOfBasisVector[i]),'³');
      for j:=0 to m+n do write(FileOfOutput, ToStr(VectorA[i, j]),'³');  writeln(FileOfOutput);
      if i = m then writeln(FileOfOutput, ' ÀÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´')
               else writeln(FileOfOutput, ' ÃÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄ´');
    end;
  end;

  procedure WriteMatrixSimplex;
  var i : integer;
  begin
    write(FileOfOutput, '          ³ Simplex³');
    for i:=0 to m+n do write(FileOfOutput, ToStr(SimplexVector[i]),'³'); writeln(FileOfOutput);
    writeln(FileOfOutput, '          ÀÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÙ');
  end;

begin
  clrscr;
  WriteTargetMatrix;
  WriteMatrixA;
  WriteMatrixSimplex;
end;

{ ƒ®«®¢­ ï ¯à®£à ¬¬  }
BEGIN
  ClrScr;
  ReadDates;
  Assign(FileOfOutput, 'kurs97.res');
  Rewrite(FileOfOutput);
  CountSimplexVector;
  WriteMatrixs;
  while not AllIsPositiv do
  begin
    IndexOfEnterVector:=GetEnterVector;
    IndexOfOutputString:=GetOutputString;
    ReCountOutputString;
    ReCountVectorA;
    CountSimplexVector;
    WriteMatrixsInFile;
    WriteMatrixs;
    if key=#0 then key:=readkey; key:=#0;
  end;
  Close(FileOfOutput);
END.