////////////////////////////////////////////////////////////////////////////////
// Copyright (c) 2001-2023 Alexey Kuryakin daqgroup@mail.ru under MIT license //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// This file is part of the CRW-DAQ project by DaqGroup - component CRWLIB.   //
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// Purpose:                                                                   //
// Linear programming via modified simplex algorithm.                         //
// Решение задач линейного программирования, модифицированный симплекс алгоритм.
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
// History:                                                                   //
// 20201123 - Created by A.K.                                                 //
// 20020403 - Creation (uses CRW16)                                           //
// 20230508 - Modified for FPC (A.K.)                                         //
////////////////////////////////////////////////////////////////////////////////

unit _crw_simplex; // Linear programming with Simplex algorithm.

{$I _crw_sysdef}

{$IFDEF FPC}{$mode Delphi}{$ENDIF}{$H+}

{$WARN 5023 off : Unit "$1" not used in $2}

interface

uses
 _crw_sharemem, // NB: THIS UNIT MUST BE FIRST !!!
 {$IFDEF UNIX} cthreads, dl, {$ENDIF}
 {$IFDEF WINDOWS} windows, {$ENDIF}
 sysutils, classes, math,
 _crw_alloc, _crw_zm, _crw_dynar, _crw_str;

 {
 *******************************************************************************
 Назначение:
 ***********
 Simplex решает задачу линейного программирования вида:
        F = minimum( F(X)=C(1)*X(1)+C(2)*X(2)+...+C(N)*X(N) )
 либо
        G = maximum( G(X)=-F(X)=-C(1)*X(1)-C(2)*X(2)-...-C(N)*X(N) )
 при ограничениях:
        A(1,1)*X(1)+A(1,2)*X(2)+....+A(1,N)*X(N) (<=,>=,=) B(1)
        ......
        A(M,1)*X(1)+A(M,2)*X(2)+....+A(M,N)*X(N) (<=,>=,=) B(M)
 а также
        X(i) >= 0, i=1..N
 B(i) могут иметь любой знак.
 Входные данные:
 ***************
 Матрица A(i,j) ограничений передается в MatrCoef;
 Коэффициенты С(i)            - в векторе Problem;
 Правые части неравенств B(i) - в векторе RightSide
 Знаки неравенств (<=,>=,=)   - в целом векторе Signums:
  Signum =+1 соответствует знаку '>='
  Signum = 0 соответствует знаку '='
  Signum =-1 соответствует знаку '<='
 Предполагается, что все матрица MatrCoef и векторы Problem, RightSide имеют
 индексацию от 1. Это означает, что свойство Origin этих объектов должно иметь
 значение 1.
 PrintMode-режим вывода: 0-нет вывода; см.флаги pfXXXX
 OutPutFile-файл вывода результата или комментариев.
 Можно использовать файл OutPut(экран) или Null(нет вывода).
 Результат:
 **********
 Функция возвращает матрицу,строки которой заполнены векторами решений задачи
 или nil, если решения не существует или его не удалось получить.
 Если матрица решений содержит более одной сторки, это значит, что
 симплекс-задача имеет бесконечное число решений,а множество решений
 является выпуклой оболочкой строк матрицы решений. Матрица решений также
 индексируется с 1.
 Решение ведется с точностью, хранящейся в константе Zero; если решений
 много, то это значит, что с точностью Zero все они дают оптимальное решение.
 Zero не может быть меньше чем машинная точность MachEps.
 В переменной  ErrorCode возвращается код ошибки,смотри константы siXXXX
 Требования к памяти:
 ********************
 Размещение рабочих массивов внутри Simplex требует порядка M*M + 5(2*M+N)
 дополнительных ячеек кроме входных данных и решения
 *******************************************************************************
 }
function Simplex(
    Problem    : TDoubleVector;    { Вектор[1..N] коэффициентов целевой функции   }
    MatrCoef   : TDoubleMatrix;    { Матрица[1..M,1..N] ограничений на переменные }
    Signums    : TLongIntVector;   { Вектор[1..M] знаков: 1 - >=, 0 - =, -1 - <=  }
    RightSide  : TDoubleVector;    { Вектор[1..M] правых частей ограничений       }
var ErrorCode  : Integer;          { Код ошибки,см. константы siXXXX              }
    PrintMode  : Word;             { Код печати,см. константы pfXXXX              }
var OutPutFile : Text              { Файл для печати или null                     }
             ) : TDoubleMatrix;    { Возвращает матрицу[1..X,1..N] решения,       }
                                   { X строк которой образуют базис решения.      }
                                   { Полное решение-выпуклая оболочка на этих     }
                                   { базисных векторах                            }

 {
 *******************************************************************************
 Константы для кода ошибки ErrorCode
 *******************************************************************************
 }
const
 {
 Возможные "нормальные" результаты решения задачи
 }
 siOk               = 0;  { решение получено, успех                 }
 siSolutionInfinite = 1;  { решение неограничено                    }
 siConditionsError  = 2;  { ограничения несовместны, решения нет    }
 {
 Фатальные ошибки
 }
 siOutOfMemory      = -1; { Нет памяти для рабочих массивов         }
 siInvalidInput     = -2; { среди входных данных есть NIL-указатели }
 siInvalidSignum    = -3; { ошибка в векторе знаков Signums         }
 siInvalidRange     = -4; { ошибка размерности входных матриц       }
 siException        = -5; { возникло исключение                     }

 {
 *******************************************************************************
 Константы для флагов режима печати PrintMode
 *******************************************************************************
 }
const
 pfInput     = $0001; {печать входных данных}
 pfResult    = $0002; {печать результата}
 pfIterBasis = $0004; {печатать базис на каждой итерации}
 pfIterFun   = $0008; {печатать значение функции на каждой итерации}
 pfIterSigm  = $0010; {печать симплекс-множителей}
 pfEcho      = $8000; {вывод на экран сведений о итерации}
 pfIter      = pfIterBasis+pfIterFun+pfIterSigm;

 {
 *******************************************************************************
  Машинно-зависимые константы
 *******************************************************************************
 }
const
 SimplexInfinity  : Double = 1.0E+30; { число, интерпретируемое как 'бесконечность'}
 SimplexPrecision : Double = 1.0E-12; { машинная точность }

 {
 *******************************************************************************
 Простая отладочная процедура для ввода симплекс-задачи с клавиатуры
 *******************************************************************************
 }
function SimplexProblemFromKeyBoard(
          var Problem   : TDoubleVector;
          var MatrCoef  : TDoubleMatrix;
          var Signums   : TLongIntVector;
          var RightSide : TDoubleVector
                      ) : Boolean;
 {
 *******************************************************************************
 Простая отладочная процедура для ввода симплекс-задачи
 из текстового файла определенного формата.
 *******************************************************************************
 }
function SimplexProblemFromFile(
          var F         : Text;
          var Problem   : TDoubleVector;
          var MatrCoef  : TDoubleMatrix;
          var Signums   : TLongIntVector;
          var RightSide : TDoubleVector
                      ) : Boolean;
const
 ScanLine   : Integer     = 0;
 ScanResult : ShortString = '';

 {
 *******************************************************************************
 Функция генерирует пример текста для чтения процедурой SimplexProblemFromFile
 *******************************************************************************
 }
function GetSimplexExample:LongString;

 {
 *******************************************************************************
 Функция InternalSimplex используется внутри Simplex.
 Она не предназначена для прямого вызова.
 *******************************************************************************
 Функция решает нормализованную задачу линейного программирования:
  Найти минимум целевой ф-ции
        Problem(X) = Problem(1)*X1+..+Problem(n)*Xn
  при наличии ограничений
        A[i,1]*x1+..+A[i,N]*xN (>=,=,<=) b[i],1<=i<=M
  где
        M=GC+EC+LC,b[i]>=0, x[i]>=0
 В матрицу A помещают матрицу ограничений A[i,j]-коеффициент при j-й переменной
 в i-m ограничении,1<=i<=M,1<=j<=N),причем порядок ограничений фиксирован:
 сначала все (GC) ограничения типа >=, потом все(EC) ограничения типа =, потом
 все ограничения(LC) типа <=;
 В столбец A[i,0],1<=i<=M помещают правые части b[i] ограничений, которые должны
 быть неотрицательны
 В строку A[M+1,j],1<=j<=N помещают коеффициенты C[j] целевой функции
 Процедура Simplex выполняет всю предварительную подготовку данных перед вызовом
 InternalSimplex.
 *******************************************************************************
 }
function InternalSimplex(
          GC         : LongInt;       { число ограничений типа >=               }
          EC         : LongInt;       { число ограничений типа  =               }
          LC         : LongInt;       { число ограничений типа <=               }
          N          : LongInt;       { число переменных                        }
          Problem    : TDoubleVector; { вектор[1..N] коэффициентов целевой ф-ции}
          MatrCoef   : TDoubleMatrix; { матрица[1..GC+EC+LC,1..N] коэффициентов }
                                      { при i-м ограничении для j-й переменной  }
                                      { Матрица должна быть упорядочена так,что }
                                      { сначала идут GC ограничений ">=", потом }
                                      { EC ограничений "=", потом LC "<="       }
          RightSide  : TDoubleVector; { вектор[1..GC+EC+LC] задает правые части }
                                      { ограничений,должны быть неотрицательными}
      var ErrorCode  : Integer;       { возвращает код ошибки, siXXXX           }
          PrintMode  : Word;          { режим вывода в файл, pfXXXX             }
      var OutPutFile : Text           { файл отладочного вывода                 }
                   ) : TDoubleMatrix; { матрица[1..X,1..N] решений, см.Simplex  }

 {
 *******************************************************************************
 Исключение при ошибке в Simplex
 *******************************************************************************
 }
type
 ESimplexFails = class(ESoftException);

implementation

function SimplexProblemFromKeyBoard(
          var Problem   : TDoubleVector;
          var MatrCoef  : TDoubleMatrix;
          var Signums   : TLongIntVector;
          var RightSide : TDoubleVector
                      ) : Boolean;
var
  M,N,i,j:LongInt; c:char; v:Double;
begin
 Result:=false;
 Problem:=nil;
 MatrCoef:=nil;
 Signums:=nil;
 RightSide:=nil;
 writeln(StringOfChar('*',80));
 writeln('Решить задачу линейного программирования вида:');
 writeln('F=minimum( F(X)=C(1)*X(1)+C(2)*X(2)+...+C(N)*X(N) )');
 writeln('при ограничениях:');
 writeln('   A(1,1)*X(1)+A(1,2)*X(2)+....+A(1,N)*X(N) (<=,>=,=) B(1)');
 writeln('    ......');
 writeln('   A(M,1)*X(1)+A(M,2)*X(2)+....+A(M,N)*X(N) (<=,>=,=) B(M)');
 writeln('а также');
 writeln('   X(i) >= 0, i=1..N');
 writeln('B(i) могут иметь любой знак.');
 writeln(StringOfChar('*',80));
 writeln('Продолжить? (Y/N)');
 readln(c);
 if (c='Y') or (c='y') then begin
  write('Ввести число переменных N='); readln(N);
  write('Ввести число ограничений M='); readln(M);
  if (M>0) and (N>0) then begin
   Problem:=NewDoubleVector(N,1);
   MatrCoef:=NewDoubleMatrix(M,N,1);
   Signums:=NewLongIntVector(M,1);
   RightSide:=NewDoubleVector(M,1);
   writeln('Ввести коэффициенты целевой функции');
   for i:=1 to N do begin
    write('C(',i,')=');
    readln(v);
    Problem[i]:=v;
   end;
   for i:=1 to M do begin
    writeln('Ограничение ',i,' :');
    writeln('Ввести строку матрицы ограничений:');
    for j:=1 to N do begin
     write('A(',i,',',j,')=');
     readln(v);
     MatrCoef[i,j]:=v;
    end;
    write('Ввести тип ограничения: 1--">="; 0--"="; -1--"<=" :');
    readln(j);
    signums[i]:=j;
    write('Ввести правую часть B(',i,')=');
    readln(v);
    RightSide[i]:=v;
   end;
   Result:=true;
  end;
 end;
end;

function GetSimplexExample:LongString;
var List:TStringList;
begin
 Result:='';
 List:=TStringList.Create;
 try
  List.Add('Для решения задачи линейного программирования:');
  List.Add('   Найти минимум или максимум линейной функции:');
  List.Add('   Z(X)=C1*X1+C2*X2+...+Cn*Xn');
  List.Add('   при линейных ограничениях на область переменных:');
  List.Add('   A(1,1)*X1+A(1,2)*X2+...+A(1,n)*Xn <=,>=,= B1');
  List.Add('   ............................................');
  List.Add('   A(M,1)*X1+A(M,2)*X2+...+A(M,n)*Xn <=,>=,= BM');
  List.Add(' На входе требуется текстовый файл по примеру следующего:');
  List.Add('');
  List.Add('% Комментарий отделен знаком ''%''');
  List.Add('BEGIN                   % Ключевое слово:Маркер начала задания');
  List.Add('DIMENSION:2             % Ключевое слово: число переменных n');
  List.Add('MINIMIZE FUNCTION Z(X)= % Ключевое слово: начало описания функции');
  List.Add('                        % Z(X) для которой требуется найти:');
  List.Add('                        % минимум(MINIMIZE) или максимум(MAXIMIZE)');
  List.Add(' X1+X2;                 % конкретная целевая функция n переменных.');
  List.Add('CONDITIONS:             % Ключевое слово: начало описания ограничений.');
  List.Add(' 2*X1+X2>=10;           % ограничение 1');
  List.Add(' X1+2*X2<=8;            % ограничение 2 и т.д.');
  List.Add('END                     % Ключевое слово:конец задания');
  List.Add('');
  List.Add('Подставляйте свои данные по аналогии.');
  Result:=List.Text;
 finally
  Kill(List);
 end;
end;

function SimplexProblemFromFile(
          var F         : Text;
          var Problem   : TDoubleVector;
          var MatrCoef  : TDoubleMatrix;
          var Signums   : TLongIntVector;
          var RightSide : TDoubleVector
                      ) : Boolean;
label
 Error;
var
 N,M,Index,Row,Num,CurPos:LongInt; S:ShortString; c:Char; Val,Mult:Double;
 Work:TDoubleVector;
 Col:TObjectStorage;
 { }
 function ReadLine:Boolean;
 var res:Boolean; p:byte;
 begin
  ReadLine:=false;
  if eof(F) then exit;
  repeat
   readln(F,S);
   Inc(ScanLine);
   res:=IOResult=0;
   ReadLine:=res;
   if not res then Break;
   p:=pos('%',S);
   if p>0 then S:=Copy(S,1,p-1);
   S:=Trim(S); {remove comment,lead and trail spaces}
  until (S<>'') or (eof(F));
  for p:=1 to Length(S) do S[p]:=UpCase(S[p]);
  CurPos:=1;
  c:=' ';
 end;
 { }
 function ReadChar:Boolean;
 begin
  ReadChar:=false;
  if CurPos>Length(S) then if not ReadLine then exit;
  c:=S[CurPos];
  Inc(CurPos);
  ReadChar:=true;
 end;
 { }
 function ReadVal:Boolean;
 var SV:ShortString;
 begin
  SV:='';
  Val:=0;
  ReadVal:=false;
  repeat
   case c of
    ' ':;
    '0'..'9','.','E','e','+','-':SV:=SV+c;
    else break;
   end;
   if not ReadChar then exit;
  until false;
  if (SV='') or (SV='+') then SV:='1' else if SV='-' then SV:='-1';
  ReadVal:=TryStrToFloat(SV,Val);
 end;
 { }
 function ReadNum:Boolean;
 var SN:ShortString;
 begin
  SN:='';
  Num:=0;
  ReadNum:=false;
  repeat
   case c of
    ' ':;
    '0'..'9':SN:=SN+c;
    else break;
   end;
   if not ReadChar then exit;
  until false;
  ReadNum:=TryStrToInt(SN,Num);
 end;
 { }
 function SearchFor(const SearchStr:ShortString):Boolean;
 begin
  SearchFor:=false;
  repeat
   if Pos(SearchStr,S)>0 then begin
    SearchFor:=true;
    CurPos:=Pos(SearchStr,S)+Length(SearchStr);
    c:=' ';
    break;
   end;
  until not ReadLine;
 end;
 { }
 procedure Pass(AChars:TCharSet);
 begin
  while (c in AChars) and ReadChar do;
 end;
 { }
begin
 { }
 Problem  :=nil;
 MatrCoef :=nil;
 Signums  :=nil;
 RightSide:=nil;
 Col      :=nil;
 S:='';
 c:=' ';
 CurPos:=1;
 ScanLine:=0;
 { }
 ScanResult:='BEGIN не найден.';
 if not SearchFor('BEGIN') then goto error;
 { }
 ScanResult:='Описание DIMENSION не найдено или некорректно.';
 if not SearchFor('DIMENSION') then  goto error;
 Pass([' ',':']);
 if not ReadNum then goto error;
 N:=Num;
 if (N<1) then goto error;
 { }
 ScanResult:='Описание FUNCTION не найдено.';
 if not SearchFor('FUNCTION') then goto error;
 if Pos('MAXIMIZE',S) > 0 then Mult:=-1 else Mult:=1;
 ReadLine;
 ScanResult:='Нехватка памяти.';
 Problem:=NewDoubleVector(N,1);
 if (Problem=nil) then goto error;
 { }
 ScanResult:='Описание FUNCTION некорректно.';
 CurPos:=1;
 c:=' ';
 repeat
  pass([' ']);
  if not ReadVal then goto error;
  pass([' ','X','x','*']);
  if not ReadNum then goto error;
  if (Num=0) or (Num>N) then goto error;
  Problem[Num]:=Val*Mult;
  pass([' ']);
 until (c in [';'{,'О'}]) or (eof(F));
 { }
 ScanResult:='Описание CONDITIONS не найдено.';
 if not SearchFor('CONDITIONS') then goto error;
 ReadLine;
 { }
 Col:=NewObjectStorage(true);
 Row:=0;
 repeat
  Inc(Row);
  pass([' ',':',';']);
  if Pos('END',S)>0  then Break;
  ScanResult:='Нехватка памяти';
  Work:=NewDoubleVector(N+2,1);
  if Work=nil then goto error;
  Col.Add(Work);
  ScanResult:='Ошибка чтения ограничения номер '+IntToStr(Row);
  repeat
   pass([' ']);
   if not ReadVal then goto error;
   pass([' ','X','x','*']);
   if not ReadNum then goto error;
   if Num>N then goto error;
   Work[Num]:=Val;
   pass ([' ']);
   case c of
    '>': begin
          Work[N+1]:=+1;
          pass([c,' ','=']);
          if ReadVal then Work[N+2]:=Val else goto error;
          pass([' ',';']);
          break;
         end;
    '<': begin
          Work[N+1]:=-1;
          pass([c,' ','=']);
          if ReadVal then Work[N+2]:=Val else goto error;
          pass([' ',';']);
          break;
         end;
    '=': begin
          Work[N+1]:=0;
          pass([c,' ','=']);
          if ReadVal then Work[N+2]:=Val else goto error;
          pass([' ',';']);
          break;
         end;
    '+','-',' ':continue;
   else goto error;
   end;
  until false;
 until false;
 if Col=nil then goto error;
 M:=Col.Count;
 if M<1 then goto error;
 ScanResult:='Нехватка памяти.';
 RightSide:=NewDoubleVector(M,1);
 MatrCoef:=NewDoubleMatrix(M,N,1);
 Signums:=NewLongIntVector(M,1);
 if RightSide = nil then goto error;
 if MatrCoef  = nil then goto error;
 if Signums   = nil then goto error;
 for Row:=1 to M do begin
  Work:=TDoubleVector(Col[Row-1]);
  for Index:=1 to N do MatrCoef[Row,Index]:=Work[Index];
  Signums[Row]:=round(Work[N+1]);
  RightSide[Row]:=Work[N+2];
 end;
 Kill(Col);
 SimplexProblemFromFile:=true;
 ScanResult:='Данные прочитаны.';
 exit;
error:
 Kill(Col);
 Kill(Problem);
 Kill(MatrCoef);
 Kill(RightSide);
 Kill(Signums);
 SimplexProblemFromFile:=false;
end;

function Simplex(
    Problem    : TDoubleVector;    { Вектор[1..N] коэффициентов целевой функции   }
    MatrCoef   : TDoubleMatrix;    { Матрица[1..M,1..N] ограничений на переменные }
    Signums    : TLongIntVector;   { Вектор[1..M] знаков: 1 - >=, 0 - =, -1 - <=  }
    RightSide  : TDoubleVector;    { Вектор[1..M] правых частей ограничений       }
var ErrorCode  : Integer;          { Код ошибки,см. константы siXXXX              }
    PrintMode  : Word;             { Код печати,см. константы pfXXXX              }
var OutPutFile : Text              { Файл для печати или null                     }
             ) : TDoubleMatrix;    { Возвращает матрицу[1..X,1..N] решения,       }
                                   { X строк которой образуют базис решения.      }
                                   { Полное решение-выпуклая оболочка на этих     }
                                   { базисных векторах                            }
label
 Error,Quit;
var
 s:Double;
 N,M,LC,GC,EC,i,j,k:LongInt;
 function Sign(x:LongInt): LongInt;
 begin
  if x>0 then Result:=+1 else if x<0 then Result:=-1 else Result:=0
 end;
begin
 Result:=nil;
 try
  {
  Проверка на допустимость указателей
  }
  ErrorCode:=siInvalidInput;
  if Problem   = nil then goto Error;
  if MatrCoef  = nil then goto Error;
  if Signums   = nil then goto Error;
  if RightSide = nil then goto Error;
  {
  Проверка на соответствие размерностей.
  }
  M:=MatrCoef.Rows;
  N:=MatrCoef.Columns;
  ErrorCode:=siInvalidRange;
  if RightSide.Length <> M then goto Error;
  if Problem.Length   <> N then goto Error;
  if Signums.Length   <> M then goto Error;
  {
  Изменим знак неравенства, если правая часть < 0, так как в InternalSimplex
  правая часть предполагается всегда >= 0.
  }
  for i:=1 to M do
  if RightSide[i]<0 then begin
   for j:=1 to N do MatrCoef[i,j]:=-MatrCoef[i,j];
   RightSide[i]:=-RightSide[i];
   Signums[i]:=-Signums[i];
  end;
  {
  Найдем число ограничений >=,<=,= по значениям signums[i]:
   +1 значит >=
    0 значит  =
   -1 значит <=
  }
  LC:=0;
  GC:=0;
  EC:=0;
  ErrorCode:=siInvalidSignum;
  for i:=1 to M do begin
   Signums[i]:=Sign(Signums[i]);
   case Signums[i] of
    -1: LC:=LC+1;
     0: EC:=EC+1;
    +1: GC:=GC+1;
    else goto Error;
   end;
  end;
  {
  Упорядочение матрицы так,что:
   сначала идут уравнения со знаком >=
   потом                             =
   потом                            <=
  }
  for i:=1 to GC do
  for j:=i+1 to M do
  if Signums[j]=1 then begin
   s:=RightSide[i];
   RightSide[i]:=RightSide[j];
   RightSide[j]:=s;
   for k:=1 to N do begin
    s:=MatrCoef[i,k];
    MatrCoef[i,k]:=MatrCoef[j,k];
    MatrCoef[j,k]:=s;
   end;
   k:=Signums[i];
   Signums[i]:=Signums[j];
   Signums[j]:=k;
  end;
  for i:=GC+1 to GC+EC do
  for j:=i+1 to M do
  if Signums[j]=0 then begin
   s:=RightSide[i];
   RightSide[i]:=RightSide[j];
   RightSide[j]:=s;
   for k:=1 to N do begin
    s:=MatrCoef[i,k];
    MatrCoef[i,k]:=MatrCoef[j,k];
    MatrCoef[j,k]:=s;
   end;
   k:=Signums[i];
   Signums[i]:=Signums[j];
   Signums[j]:=k;
  end;
  {
  Данные готовы для вызова основного алгоритма
  }
  Result:=InternalSimplex(GC, EC, LC, N, Problem, MatrCoef, RightSide,
                          ErrorCode, PrintMode, OutPutFile);
  goto Quit;
  {
  Сюда попадаем при ошибке
  }
Error:
  if PrintMode>0 then begin
   writeln(OutPutFile,'');
   writeln(OutPutFile,StringOfChar('*',80));
   case ErrorCode of
    siInvalidSignum: writeln(OutPutFile,'Simplex:Ошибка задания знака.');
    siInvalidInput:  writeln(OutPutFile,'Simplex:Недопустимые данные.');
    siInvalidRange:  writeln(OutPutFile,'Simplex:Несоответствие размерностей.');
    siException:     writeln(OutPutFile,'Simplex:Возникло исключение.');
   end;
   writeln(OutPutFile,StringOfChar('*',80));
   writeln(OutPutFile,'');
  end;
  goto Quit;
Quit:
 except
  on E:Exception do begin
   Kill(Result);
   ErrorCode:=siException;
  end;
 end;
end;

function InternalSimplex(
          GC         : LongInt;       { число ограничений типа >=               }
          EC         : LongInt;       { число ограничений типа  =               }
          LC         : LongInt;       { число ограничений типа <=               }
          N          : LongInt;       { число переменных                        }
          Problem    : TDoubleVector; { вектор[1..N] коэффициентов целевой ф-ции}
          MatrCoef   : TDoubleMatrix; { матрица[1..GC+EC+LC,1..N] коэффициентов }
                                      { при i-м ограничении для j-й переменной  }
                                      { Матрица должна быть упорядочена так,что }
                                      { сначала идут GC ограничений ">=", потом }
                                      { EC ограничений "=", потом LC "<="       }
          RightSide  : TDoubleVector; { вектор[1..GC+EC+LC] задает правые части }
                                      { ограничений,должны быть неотрицательными}
      var ErrorCode  : Integer;       { возвращает код ошибки, siXXXX           }
          PrintMode  : Word;          { режим вывода в файл, pfXXXX             }
      var OutPutFile : Text           { файл отладочного вывода                 }
                   ) : TDoubleMatrix; { матрица[1..X,1..N] решений, см.Simplex  }
label
 BeginIterations, 820, 870, 1000, Infinite, BadConditions, NormalExit,
 OutOfMemory, RangeError, InputError, Quit;
const
 Zero : Double = 1.0E-12;
 NoBasic       = 0;
 Basic         = 1;
var
 MM,M,MK,N1,P,M1,ML,M2,N0,L,S,R,k,IterationNumber,i,j:LongInt;
 DF,RT,pv,min,D1:Double;
 Stack:TObjectStorage;
 {
 B[i,j], i=0..M2, j=0..M1
 B(i,j),i=1..M,j=1..M-матрица обращения базиса
 B(i,0),i=1..M-значения базисных переменных
 -B(M1,0)-значение целевой функции
 -B(M2,0)-значение искуственной функции
 B(M1,i),i=1..M-симплекс-множители целевой функции
 B(M2,i),i=1..M-симплекс-множители искуственной функции
 }
 B:TDoubleMatrix;
 {
 IsBasis[i], i=0..P
 IsBasis[i], i=1..P  - Целый вектор, в котором хранится флаг переменной базисная/небазисная
 IsBasis[0] не используется
 }
 IsBasis:TLongIntVector;
 {
 Basis[i], i=0..M
 Basis[i], i=1..M - Целый вектор, в котором хранятся номера базисных переменных
 Basis[0] не используется
 }
 Basis:TLongIntVector;
 {
 C[i], i=0..P - рабочий вектор для коэффициентов целевой или искуственной функции
 }
 C:TDoubleVector;
 {
 C1[i], i=0..P - рабочий вектор для хранения коэффициентов целевой функции
 }
 C1:TDoubleVector;
 {
 V[i], i=0..P - рабочий вектор
 }
 V:TDoubleVector;
 {
 X[i], i=1..N - рабочий вектор
 }
 X:TDoubleVector;
 {
 Функция A единым образом дает доступ к элементам матрицы ограничений, правой
 части ограничений и коэффициентам целевой функции.
 Для дополнительных и искуственных переменных она вычисляется, чтобы сократить
 требуемую память.
 A(i,0),i=1..M  ----возвращает правую часть ограничений;
 A(М1,j),j=1..P ----возвращает коэффициенты целевой функции которые равны:
   A=ZCoeff(j),j=1..N;
   A=0,j=N+1..P
 A(M2,j),j=1..P ----возвращает коэффициенты искуственной функции:
  A=0,j=1..N1;
  A=1,j=N1+1..P
 A(i,j),i=1..M,j=1..P-----матрица ограничений:
  A=MatrCoef(i,j),j=1..N
  A=1, i=1..GC,j=N1+i или i=GC+1..MM,j=N1+i или i=MM+1..M,j=N+i-EC
  A=-1,i=1..GC,j=N+i
  A=0 в других случаях
 }
 function A(i,j:LongInt):Double;
  procedure RangeError;
  begin
   A:=0;
   raise ESimplexFails.CreateFmt('Simplex range error detected. i=%d, j=%d',[i,j]);
  end;
 begin
  if (i<1) or (j<0) or (i>M2) or (j>P) then RangeError;
  if j=0 then begin                {j=0,i=1..M---правые части ограничений}
   if i<=M then A:=RightSide[i] else RangeError;
  end else begin                   {j=1..P}
   if i=M2 then begin              {i=M2,j=1..P---Коэффициенты искуственной целевой функции}
    if j>N1 then A:=1 else A:=0;
   end else begin                  {i=1..M1,j=1..P}
    if i=M1 then begin             {i=M1,j=1..P--коэффициенты целевой функции}
     if j<=N then A:=Problem[j] else A:=0;
    end else begin{i=1..M,j=1..P}
     if j<=N then A:=MatrCoef[i,j] { A(1..M,1..N-исходная матрица ограничений}
     else begin                    {i=1..M,j=N+1..P-Матрица коэффициентов доп. и иск. переменных}
      if i<=GC then begin          {i=1..GC,j=N+1..P}
       if j=N+i then A:=-1 else begin
        if j=N1+i then A:=1 else A:=0;
       end;
      end else begin               {i=GC+1..M,j=N+1..P}
       if i<=MM then begin
        if j=N1+i then A:=1 else A:=0;
       end else begin              {i=MM+1..M,j=N+1..P}
        if j=N+i-EC then A:=1 else A:=0;
       end;{elsei<=MM}
      end;{elsei<=GC}
     end;{elsej<=N}
    end;{elsei=M2}
   end;{elsei=M1}
  end;{else j=0}
 end;{function A}
 {
 Проверка векторов на равенство
 }
 function VectorEquals(X,Y:TDoubleVector; zero:Double):Boolean;
 var
  i  : LongInt;
  s1 : Double;
  s2 : Double;
 begin
  VectorEquals:=false;
  if Assigned(X) and Assigned(Y) and (X.Length=Y.Length) then begin
   s1:=0;
   s2:=0;
   for i:=1 to X.Length do s1:=s1+sqr(X[i])+sqr(Y[i]);
   for i:=1 to X.Length do s2:=s2+sqr(X[i]-Y[i]);
   VectorEquals:=(s2<=zero*s1);
  end;
 end;
 {
 *********************************
 Процедуры вывода и форматирования
 *********************************
 }
 procedure TextOut(const aText:ShortString);
 begin
  if PrintMode<>0 then System.Writeln(OutPutFile,aText);
 end;
 function d2s(d:LongInt):ShortString;
 begin
  d2s:=Format('%d',[d]);
 end;
 function f2s(X:Double):ShortString;
 begin
  f2s:=Format('%-g',[X]);
 end;
 function intstr(X:LongInt):ShortString;
 begin
  intstr:=Format('%-6d',[X]);
 end;
 {
 *******************************************
 Процедуры вывода промежуточных результатов.
 *******************************************
 }
 procedure Report1Stage;
 begin
  if PrintMode and pfIter <> 0 then begin
   TextOut('Этап 1 минимизации искуственной целевой функции завершен.');
   TextOut('Найдено допустимое базисное решение.');
  end;
 end;
 {
 }
 procedure ReportNo1Stage;
 begin
  if PrintMode and pfIter <> 0 then TextOut('Отсутствует 1 этап задачи.');
 end;
 {
 }
 procedure ReportInput;
 var i,j:LongInt;  SF:Boolean; St:ShortString;
 begin
  if PrintMode and pfInput <> 0 then begin
   TextOut('BEGIN');
   TextOut('DIMENSION:'+d2s(N));
   TextOut('MINIMIZE FUNCTION Z(X)=');
   St:='';
   SF:=false;
   for j:=1 to N do begin
     D1:=A(M1,j);
     if D1=0 then continue;
     if (D1<0) then begin
      if D1=-1 then St:=St+'-X'+d2s(j)
               else St:=St+f2s(D1)+'*X'+d2s(j);
     end else begin
      if D1=1 then begin
       if SF=false then St:=St+'X'+d2s(j)
                   else St:=St+'+X'+d2s(j);
      end else begin
       if SF=false then St:=St+f2s(D1)+'*X'+d2s(j)
                   else St:=St+'+'+f2s(D1)+'*X'+d2s(j);
      end;
     end;
     if Length(St)>70 then begin TextOut(St); St:=''; end;
     SF:=true;
   end;
   St:=St+';';
   TextOut(St);
   St:='';
   {}
   TextOut('CONDITIONS:');
   for i:=1 to M do begin
    St:='';
    SF:=false;
    for j:=1 to N do begin
     D1:=A(i,j);
     if D1=0 then continue;
     if (D1<0) then begin
      if D1=-1 then St:=St+'-X'+d2s(j)
               else St:=St+f2s(D1)+'*X'+d2s(j);
     end
     else begin
      if D1=1 then begin
       if SF=false then St:=St+'X'+d2s(j)
                   else St:=St+'+X'+d2s(j);
      end
      else begin
       if SF=false then St:=St+f2s(D1)+'*X'+d2s(j)
                   else St:=St+'+'+f2s(D1)+'*X'+d2s(j);
      end;
     end;
     if Length(St)>70 then begin TextOut(St); St:=''; end;
     SF:=true;
    end;
    if i<=GC then St:=St+'>=' else if i<=MM then St:=St+'=' else St:=St+'<=';
    if Length(St)>70 then begin TextOut(St); St:=''; end;
    St:=St+f2s(A(i,0))+'; % condition '+d2s(i);
    TextOut(St);
    St:='';
   end;
  end;
  TextOut('END');
  TextOut('');
  TextOut('');
 end;
 {
 }
 procedure ReportBasis(S,R:LongInt);
 begin
  if PrintMode and pfIter <> 0 then TextOut(Format('X%d выведен из базиса, X%d введен в базис.',[R,S]));
 end;
 {
 }
 procedure ReportIteration;
 var i:LongInt;
 begin
  if PrintMode and pfEcho <> 0 then begin
   TextOut('I='+d2s(IterationNumber)+'  F='+f2s(-B[ML,0]));
  end;
  if PrintMode and pfIter <> 0 then begin
   TextOut(StringOfChar('*',36));
   TextOut('Итерация номер '+d2s(IterationNumber));
   TextOut(StringOfChar('*',36));
   if L=1 then TextOut('Минимизируется искусственная целевая функция.');
   TextOut('Текущее число переменных '+d2s(N0));
   if PrintMode and pfIterBasis <> 0 then begin
    TextOut('Текущий базис:');
    for i:=1 to M do TextOut('X'+intstr(Basis[i])+'='+f2s(B[i,0]));
   end;
   if PrintMode and pfIterFun <> 0 then begin
    TextOut('Целевая функция='+f2s(-B[ML,0]));
   end;
   if PrintMode and pfIterSigm <> 0 then begin
    TextOut('Симплекс-множители:');
    for i:=1 to M do TextOut('S'+intstr(i)+'='+f2s(B[ML,i]));
   end;
  end;
 end;
begin {-------------------INTERNALSIMPLEX-------------------------}
 {
 Инициализировать рабочие массивы
 }
 Result:=nil;
 B:=nil;
 C:=nil;
 V:=nil;
 C1:=nil;
 Stack:=nil;
 Basis:=nil;
 IsBasis:=nil;
 try
  {
  Проверить входные данные
  }
  if MatrCoef  = nil then goto InputError;
  if RightSide = nil then goto InputError;
  if Problem   = nil then goto InputError;
  {
  Инициализировать переменные размерности
  }
  MM:=GC+EC;      { число искуственных переменных }
  M:=MM+LC;       { число ограничений }
  MK:=GC+LC;      { число дополнительных переменных }
  N1:=MK+N;       { число основных+дополнительных переменных ( для 2 этапа ) }
  P:=N1+MM;       { число переменных для первого этапа }
  M1:=M+1;        { номер строки целевой ф-ции }
  M2:=M+2;        { номер строки искуственной ф-ции }
  {
  Найти уровень "нуля", используемый при сравнении чисел.
  Этот уровень не может быть ниже машинной точности
  }
  Zero:=max(Abs(SimplexPrecision),10*MachEps*(M+N));
  {
   N0-текущее число переменных,т.е. N1 для 2 и P для 1 этапа
  }
  N0:=N1;
  {
   Проверка допустимости размерностей входных массивов
  }
  if MatrCoef.Rows    <> M then goto RangeError;
  if RightSide.Length <> M then goto RangeError;
  if MatrCoef.Columns <> N then goto RangeError;
  if Problem.Length   <> N then goto RangeError;
  {
  Выделение памяти для рабочего массива
  инициализация и зануление переменных
  }
  B:=NewDoubleMatrix(M+3,M+3,0);       if B       = nil then goto OutOfMemory;
  C:=NewDoubleVector(P+1,0);           if C       = nil then goto OutOfMemory;
  V:=NewDoubleVector(P+1,0);           if V       = nil then goto OutOfMemory;
  C1:=NewDoubleVector(P+1,0);          if C1      = nil then goto OutOfMemory;
  Stack:=NewObjectStorage(true);       if Stack   = nil then goto OutOfMemory;
  Basis:=NewLongIntVector(M+1,0);      if Basis   = nil then goto OutOfMemory;
  IsBasis:=NewLongIntVector(P+1,0);    if IsBasis = nil then goto OutOfMemory;
  {
  Инициализировать номер итерации
  }
  IterationNumber:=0;
  {
  Номер этапа: L=0-второй,L=1-первый
  На первом этапе минимизируется искуственная целевая функция для того,
  чтобы отыскать допустимый базис для второго этапа;
  На втором этапе минимизируется целевая функция.
  }
  L:=0;
  {
  присвоить начальные значения базисным переменным
  }
  for i:=1 to M do B[i,0]:=A(i,0);
  {
  присвоить начальное обращение базиса
  }
  for i:=1 to M do B[i,i]:=1;
  {
  присвоить начальные симплекс-множители искуственной функции
  }
  for i:=1 to MM do B[M2,i]:=-1;
  {
  выбрать начальный базис
  }
  for i:=1 to MM do Basis[i]:=n1+i;
  for i:=MM+1 to M do Basis[i]:=N+i-EC;
  {
  Пометим базисные переменные.
  Если j-базисная ,то IsBasis[j]=Basic, else IsBasis[j]=NoBasic.
  }
  for i:=1 to M do IsBasis[Basis[i]]:=Basic;
  {
  Печать начальных данных
  }
  ReportInput;
  {
  Есть ли первый этап (нахождение допустимого базиса)?
  }
  if (MM=0) then ReportNo1Stage;
  {
  Инициировать первый этап
  }
  if (MM>0) then begin
   L:=1;
   N0:=P;
   for i:=1 to MM do B[M2,0]:=B[M2,0]-B[i,0];
  end;
  {
  **********************************************
  НАЧАЛО ИТЕРАЦИЙ
  **********************************************
  }
BeginIterations :
  {
  ML-номер строки коэффициентов целевой функции для данного этапа
  ML=M+2 для этапа 1;   ML=M+1 для этапа 2
  }
  ML:=M1+L;
  ReportIteration;{отчет о текущей итерации}
  Inc(IterationNumber);
  min:=-zero;
  s:=0;
  {
  найдем новые коэффициенты  в целевой (при L=0) или искуственной
  (при L=1) функции, а также наименьший коэффициент C[s] в строке
  целевой (искуственной) функции.S определяет номер переменной,
  которая будет включена в базис.Если S=0 то минимум достигнут.
  }
  for j:=1 to N0 do begin
   C[j]:=0.0;
   if (IsBasis[j]=NoBasic) then begin
     for i:=1 to M do
      C[j]:=C[j]+B[ML,i]*A(i,j);
     C[j]:=C[j]+A(ML,j);
     if C[j]<min then
     begin
      min:=C[j];
      S:=j;
     end;
   end;{ifnotIsBasis}
  end; {do j}
  {
  если первый этап,то C[i]=коеффициенты искуственной ф-ции и надо
  вычислить и поместить в C1[i] коэффициенты целевой функции
  }
  if L=1 then
  for j:=1 to N0 do begin
   C1[j]:=0;
   if (IsBasis[j]=NoBasic) then
   begin
    for i:=1 to M do
     C1[j]:=C1[j]+B[M1,i]*A(i,j);
    C1[j]:=C1[j]+A(M1,j);
   end;{ifnotIsBasis}
  end; {do j}
  {
  *****************************************************
  Проверка на достижение минимума для выхода или смены
  этапа если минимизируется искуственная функция
  *****************************************************
  }
  if S=0 then begin {если все C[i] >=-Zero то минимум  найден}
   {для первого этапа проверить совместимость ограничений}
   if L=1 then begin
    if abs(B[ML,0])>=zero then goto BadConditions;
     {выход по причине несовместимости ограничений(решения не сущ.)}
    Report1Stage;
    L:=0;
    N0:=N1;
    goto BeginIterations; { перейти к 2 этапу }
   end;
   {-----------нормальный выход для 2 этапа(решение найдено)-----------------}
   if L=0 then begin
    {выделить память для очередного решения;при инициализации заполнен нулями}
    X:=NewDoubleVector(N,1);
    if X=nil then goto OutOfMemory;{нехватка памяти}
    { переписать решение в рабочий вектор }
    for i:=1 to M do
     if Basis[i]<=N then X[Basis[i]]:=B[i,0];
    { проверка,есть ли это решение среди найденных }
    for i:=0 to Stack.Count-1 do
    if VectorEquals(TDoubleVector(Stack[i]),X,zero*2*N) then begin
     { такое решение уже есть, надо выходить, иначе произойдет зацикливание }
     Kill(X);
     goto NormalExit;
    end;
    { такого решения еще нет, занести очередное решение в коллекцию решений }
    Stack.Add(X);
    { проверка,есть ли еще 'нулевые' коеффициенты C[s] }
    min:=zero;
    s:=0;
    for j:=1 to N0 do
    if (IsBasis[j]=NoBasic) and (C[j]<min) then
    begin
     min:=C[j];
     s:=j;
    end;
    if s=0 then goto NormalExit;
    { все коеффициенты стали существенно положительны,решение завершено }
   end;{ if L=1 }
  end;{ if s=0 }
  {
   ************************************************
    Hайти и исключить из базиса строку.
    R-номер строки.
    Basis(R)-номер исключаемой переменной.
   ************************************************
  }
  min:=SimplexInfinity;
  R:=0;
  for i:=1 to M1 do begin  { НАЙТИ V[i]=AIS }
   V[i]:=0;
   for k:=1 to M1 do
    V[i]:=V[i]+B[i,k]*A(k,s);
  end; {do i}
  V[ML]:=C[S];
  for i:=1 to M do begin
   if (V[i]<=zero) then goto 1000;
   k:=0;
820:
   RT:=B[i,k]/V[i];
   DF:=RT-min;
   if (DF>=0) then goto 870;
   R:=i;
   min:=B[i,0]/V[i];
   goto 1000;
870:
   if (DF<>0) then goto 1000;
   k:=k+1;
   min:=B[R,k]/V[R];
   goto 820;
1000:
  end;{do i}
  {--------------------------------------------------------------------}
  if R=0 then goto Infinite;{ выход по причине неoграниченного решения }
  ReportBasis(S,Basis[R]);
  {
  *************************************************
  найти новые симплекс-множители и обращение базиса
  *************************************************
  }
  PV:=V[R];
  for j:=0 to M1 do B[R,j]:=B[R,j]/PV;
  for i:=1 to M do begin
   if i<>R then
   for j:=0  to M do B[i,j]:=B[i,j]-V[i]*B[R,j];
  end;
  {
  Коррекция симплекс-множителей основной функции на 1 этапе
  }
  if L=1 then
  for j:=0 to M do B[M1,j]:=B[M1,j]-C1[S]*B[R,j];
  {
  Коррекция симплекс-множителей для данного этапа
  }
  for j:=0  to M do B[ML,j]:=B[ML,j]-C[S]*B[R,j];
  {
  ************************************************
  пометить новый базис и перейти к началу итераций
  ************************************************
  }
  IsBasis[Basis[R]]:=NoBasic;
  IsBasis[S]:=Basic;
  Basis[R]:=S;
  goto BeginIterations;
  {
  *****************************************
  РАЗЛИЧНЫЕ ВАРИАНТЫ ВЫХОДА:
  ПО ОШИБКЕ ДАННЫХ,ПО НЕОГРАНИЧЕННОСТИ ИЛИ
  ОТСУТСТВИЮ РЕШЕНИЯ,НОРМАЛЬНЫЙ ВЫХОД
  *****************************************
  }
  {
  *****************************************
  НОРМАЛЬНЫЙ ВЫХОД
  решение найдено:переписать решение из
  коллекции в матрицу решения и выйти
  *****************************************
  }
NormalExit:
  Dec(IterationNumber);
  if PrintMode and pfResult <> 0 then begin
   TextOut('');
   TextOut('');
   TextOut(StringOfChar('*',36));
   TextOut('Simplex:РЕШЕНИЕ УСПЕШНО ЗАВЕРШЕНО.');
   TextOut(StringOfChar('*',36));
   TextOut('число итераций='+d2s(IterationNumber));
   if Stack.Count=1 then begin
    TextOut('Решение единственно:');
    min:=0;
    for i:=1 to N do begin
     TextOut('X'+intstr(i)+'='+f2s(TDoubleVector(Stack[0])[i]));
     min:=min+TDoubleVector(Stack[0])[i]*A(M1,i);
    end;
    TextOut('Целевая функция='+f2s(min));
   end else begin
    TextOut('Решение неединственно.');
    TextOut('Оно является выпуклой оболочкой '+d2s(Stack.Count)+' векторов:');
    for i:=0 to Stack.Count-1 do begin
     TextOut('Вектор решения номер '+d2s(i+1));
     min:=0;
     for j:=1 to N do begin
      TextOut('X'+intstr(j)+'='+f2s(TDoubleVector(Stack[i])[j]));
      min:=min+TDoubleVector(Stack[i])[j]*A(M1,j);
     end;
     TextOut('Целевая функция='+f2s(min));
    end;
   end;
  end;
  Result:=NewDoubleMatrix(Stack.Count,N,1);
  if Result=nil then begin
   if PrintMode and pfResult <> 0 then TextOut('Нет памяти для решения');
   goto OutOfMemory;
  end;
  for i:=1 to Stack.Count do
  for j:=1 to N do Result[i,j]:=TDoubleVector(Stack[i-1])[j];
  if PrintMode and pfResult <> 0 then begin
   TextOut('');
   TextOut('');
  end;
  ErrorCode:=siOk;
  goto Quit;
  {
   выход по причине неoграниченного решения
  }
Infinite:
  if PrintMode and pfResult <> 0 then begin
   TextOut(StringOfChar('*',50));
   TextOut('Simplex:ВЫХОД ПО ПРИЧИНЕ НЕОГРАНИЧЕННОГО РЕШЕНИЯ:');
   TextOut(StringOfChar('*',50));
   TextOut('Переменная номер '+d2s(S)+' не имеет ограничений.');
   TextOut('');
   TextOut('');
  end;
  Kill(Result);
  ErrorCode:=siSolutionInfinite;
  goto Quit;
  {
  }
BadConditions:
  {выход по причине несовместимости ограничений(решения не сущ.)}
  if PrintMode and pfResult <> 0 then begin
   TextOut(StringOfChar('*',52));
   TextOut('Simplex:ВЫХОД ПО ПРИЧИНЕ НЕСОВМЕСТНОСТИ ОГРАНИЧЕНИЙ:');
   TextOut(StringOfChar('*',52));
   TextOut('Ограничения не имеют допустимого решения.');
   TextOut('Сумма искусств. переменных='+f2s(-B[ML,0]));
   TextOut('');
   TextOut('');
  end;
  Kill(Result);
  ErrorCode:=siConditionsError;
  goto Quit;
  {
  }
InputError:
  if PrintMode and pfResult <> 0 then begin
   TextOut('******************************');
   TextOut('Simplex:ошибка входных данных.');
   TextOut('******************************');
   TextOut('');
   TextOut('');
  end;
  Kill(Result);
  ErrorCode:=siInvalidInput;
  goto Quit;
  {
  }
RangeError:
  if PrintMode and pfResult <> 0 then begin
   TextOut('*******************************************');
   TextOut('Simplex:ошибка размерностей входных данных.');
   TextOut('*******************************************');
   TextOut('');
   TextOut('');
  end;
  Kill(Result);
  ErrorCode:=siInvalidRange;
  goto Quit;
  {
  }
OutOfMemory:
  if PrintMode and pfResult <> 0 then begin
   TextOut('************************');
   TextOut('Simplex:нехватка памяти.');
   TextOut('************************');
   TextOut('');
   TextOut('');
  end;
  Kill(Result);
  ErrorCode:=siOutOfMemory;
  goto Quit;
Quit:
 except
  on E:Exception do begin
   Kill(Result);
   ErrorCode:=siException;
  end;
 end;
 Kill(B);
 Kill(C);
 Kill(V);
 Kill(C1);
 Kill(Stack);
 Kill(Basis);
 Kill(IsBasis);
end;

///////////////////////////////////////
// Unit initialization and finalization
///////////////////////////////////////

procedure Init_crw_simplex;
begin
end;

procedure Free_crw_simplex;
begin
end;

initialization

 Init_crw_simplex;

finalization

 Free_crw_simplex;

end.

//////////////
// END OF FILE
//////////////


