--with text_io,integer_io;                use text_io,integer_io;
--with Integer_Vectors_io;                use Integer_Vectors_io;
--with Float_Vectors_io;                  use Float_Vectors_io;
--with Float_Matrices_io;                 use Float_Matrices_io;

with Mathematical_Functions;              use Mathematical_Functions;
with Givens_Rotations;                    use Givens_Rotations;

package body Farkas_Lemma is

--  use Floating_Point_Numbers.double_float_io;

-- USAGE OF LP :

  procedure Is_In_Cone ( tab : in out matrix; lastcol : in integer;
                         rhs : in out vector;
                         tol : in double_float; solution : out vector;
                         columns : out Integer_Vectors.Vector;
                         feasible : out boolean ) is

  -- ALGORITHM:
  --   The following linear program will be solved:
  --
  --    min u_1 + .. + u_n
  --
  --        l_1*p_1i + l_2*p_2i + .. + l_m*p_mi + u_i*q_i = q_i   i=1,2,..,n
  --
  --  to determine whether q belongs to the cone spanned by the
  --  vectors p_1,p_2,..,p_m.
  --  If all u_i are zero and all constraints are satisfied,
  --  then q belongs to the cone spanned by the vectors.

  -- CONSTANTS :

    n  : constant natural := rhs'last;
    m  : constant natural := 2*n;             -- number of constraints
    nb : constant natural := lastcol+n;       -- number of unknowns

  -- VARIABLES :

    mat : matrix(0..m,0..nb);
    sol : Float_Vectors.vector(1..nb) := (1..nb => 0.0);
    bas : Integer_Vectors.Vector(1..m) := (1..m => 0);
    slk : Integer_Vectors.Vector(1..nb) := (1..nb => 0);

    cnt : natural;
    s : double_float;

  begin

   -- INITIALIZATION OF THE TARGET :

    for i in 0..(nb-n) loop
      mat(0,i) := 0.0;              -- sum of the lambda's
    end loop;
    for i in (nb-n+1)..nb loop
      mat(0,i) := -1.0;             -- sum of the mu's
    end loop;

   -- INITIALIZATION OF THE CONSTRAINTS :

    for i in 1..n loop
      for j in (nb-n+1)..nb loop
        if i /= j-nb+n
         then mat(i,j)   := 0.0;
              mat(i+n,j) := 0.0;
        end if;
      end loop;
    end loop;

    for j in tab'first(2)..lastcol loop
      for i in tab'range(1) loop
        mat(i,j)   := -tab(i,j);
        mat(i+n,j) :=  tab(i,j);
      end loop;
    end loop;

    for i in rhs'range loop
      mat(i,0)   := -rhs(i);
      mat(i+n,0) :=  rhs(i);
      mat(i,i+nb-n)   := -rhs(i);
      mat(i+n,i+nb-n) :=  rhs(i);
    end loop;

  -- SOLVE THE LINEAR PROGRAM :

   -- New_Tableau.Init_Basis(nb,bas,slk);
   -- Dual_Simplex(mat,sol,bas,slk,tol,false);

  -- RETURN AND CHECK THE SOLUTION :

    cnt := 0;
    for i in tab'first(2)..lastcol loop
      if abs(sol(i)) > tol
       then cnt := cnt + 1;
            solution(cnt) := sol(i);
            columns(cnt) := i;
      end if;
    end loop;

    s := 0.0;
    for i in (nb-n+1)..nb loop
      s := s + sol(i);
    end loop;
    if abs(s) > tol
     then feasible := false; return;
    end if;
    feasible := true;

  end Is_In_Cone;

-- AUXILIARIES :

  function Index_of_Maximum ( v : vector; lst : integer ) return integer is

  -- DESCRIPTION :
  --   Returns the index in the vector v(v'first..lst) for which the maximum
  --   is obtained.

    res : integer := v'first;
    max : double_float := v(res);

  begin
    for i in v'first+1..lst loop
      if v(i) > max
       then max := v(i); res := i;
      end if;
    end loop;
    return res;
  end Index_of_Maximum;

  function Norm ( v : vector ) return double_float is

  -- DESCRIPTION :
  --   Returns the 2-norm of the vector.

    res : double_float := 0.0;

  begin
    for j in v'range loop
      res := res + v(j)*v(j);
    end loop;
    if res + 1.0 = 1.0
     then return 0.0;
     else return SQRT(res);
    end if;
  end Norm;

  function Norm ( v : vector; frst : integer ) return double_float is

  -- DESCRIPTION :
  --   Returns the 2-norm of the vector v(frst..v'last).

    res : double_float := 0.0;
 
  begin
    for j in frst..v'last loop
      res := res + v(j)*v(j);
    end loop;
    if res + 1.0 = 1.0
     then return 0.0;
     else return SQRT(res);
    end if;
  end Norm;

  procedure Scale ( v : in out vector ) is

  -- DESCRIPTION :
  --   Returns the normed vector, i.e. v/Norm(v).

    nrm : double_float := Norm(v);

  begin
    if nrm + 1.0 /= 1.0
     then for i in v'range loop
            v(i) := v(i)/nrm;
          end loop;
    end if;
  end Scale;

  function Norm ( mat : matrix; i : integer ) return double_float is

  -- DESCRIPTION :
  --   Returns the 2-norm of the ith column in the matrix.

    res : double_float := 0.0;

  begin
    for j in mat'range(1) loop
      res := res + mat(j,i)*mat(j,i);
    end loop;
    if res + 1.0 = 1.0
     then return 0.0;
     else return SQRT(res);
    end if;
  end Norm;

  procedure Scale ( mat : in out matrix; lastcolumn : in integer ) is

  -- DESCRIPTION :
  --   Scales the columns in the matrix, by dividing by their norm.

    nrm : double_float;

  begin
    for i in mat'first(2)..lastcolumn loop
      nrm := Norm(mat,i);
      if nrm + 1.0 /= 1.0
       then for j in mat'range(1) loop
              mat(j,i) := mat(j,i)/nrm;
            end loop;
      end if;
    end loop;
  end Scale;

  function Inner_Product ( mat : matrix; i : integer; v : vector )
                         return double_float is
  -- DESCRIPTION :
  --   Computes the inner product of the given vector v and the vector
  --   in the ith column of the matrix.

    res : double_float := 0.0;

  begin
    for k in mat'range(1) loop
      res := res + mat(k,i)*v(k);
    end loop;
    return res;
  end Inner_Product;

  function Maximal_Product ( mat : matrix; i : integer;
                             v : vector; frst : integer ) return integer is
  -- DESCRIPTION :
  --   Returns the index in v(frst..v'last) for which mat(index,i)*v(index)
  --   becomes maximal.

    res : integer := frst;
    max : double_float := mat(res,i)*v(res);
    tmp : double_float;

  begin
    for j in frst+1..v'last loop
      tmp := mat(j,i)*v(j);
      if tmp > max
       then max := tmp; res := j;
      end if;
    end loop;
    return res;
  end Maximal_Product;

  function Inner_Product ( mat : matrix; i,j : integer ) return double_float is

  -- DESCRIPTION :
  --   Computes the inner product of the vectors in the columns i and j
  --   of the matrix.

    res : double_float := 0.0;

  begin
    for k in mat'range(1) loop
      res := res + mat(k,i)*mat(k,j);
    end loop;
    return res;
  end Inner_Product;

  function Inner_Products ( mat : matrix; lastcol : integer; v : vector )
                            return vector is

  -- DESCRIPTION :
  --   Returns a vector with all inner products of the given vector
  --   and the column vectors of the matrix.

    res : vector(mat'first(2)..lastcol);

  begin
    for i in res'range loop
      res(i) := Inner_Product(mat,i,v);
    end loop;
    return res;
  end Inner_Products;

  function Positive ( v : vector; lst : integer; tol : double_float )
                    return boolean is
  -- DESCRIPTION :
  --   Returns true if all elements in v(v'first..lst) are >= 0.

  begin
    for i in v'first..lst loop
      if abs(v(i)) > tol and then (v(i) < 0.0)
       then return false;
      end if;
    end loop;
    return true;
  end Positive;

  function Positive
               ( mat : matrix; rhs : vector; ind,col : integer;
                 solind : double_float; tol : double_float ) return boolean is

  -- DESCRIPTION :
  --   The given matrix is upper triangular up to the column indicated
  --   by ind.  This function returns true when by replacing column ind
  --   by column col, a positive solution would be obtained.
  --   The number solind is sol(ind) in the solution vector.

    sol : vector(1..ind) := (1..ind => 0.0);

  begin
    sol(ind) := solind;
    for i in reverse mat'first(1)..(ind-1) loop
      for j in i+1..(ind-1) loop
        sol(i) := sol(i) + mat(i,j)*sol(j);
      end loop;
      sol(i) := sol(i) + mat(i,col)*sol(ind);
      sol(i) := (rhs(i) - sol(i))/mat(i,i);
      if (abs(sol(i)) > tol) and then (sol(i) < 0.0)
       then --put_line("The solution before returning false : ");
            --put(sol,3,3,3); new_line;
            return false;
      end if;
    end loop;
    --put_line("The solution before returning true : ");
    --put(sol,3,3,3); new_line;
    return true;
  end Positive; 

  function Positive_Diagonal
               ( mat : matrix; rhs : vector; ind,col : integer;
                 solind : double_float; tol : double_float ) return boolean is

  -- DESCRIPTION :
  --   The given matrix is diagonal up to the column indicated
  --   by ind.  This function returns true when by replacing column ind
  --   by column col, a positive solution would be obtained.
  --   The number solind is sol(ind) in the solution vector.

    sol : vector(1..ind) := (1..ind => 0.0);

  begin
    sol(ind) := solind;
    for i in reverse mat'first(1)..(ind-1) loop
      sol(i) := (rhs(i) - mat(i,col)*sol(ind))/mat(i,i);
      if (abs(sol(i)) > tol) and then (sol(i) < 0.0)
       then --put_line("The solution before returning false : ");
            --put(sol,3,3,3); new_line;
            return false;
      end if;
    end loop;
    --put_line("The solution before returning true : ");
    --put(sol,3,3,3); new_line;
    return true;
  end Positive_Diagonal;

-- PIVOTING PROCEDURES :

  procedure Interchange ( v : in out vector; i,j : in integer ) is

  -- DESCRIPTION :
  --   The entries v(i) and v(j) are interchanged.

    temp : double_float;

  begin
    temp := v(i); v(i) := v(j); v(j) := temp;
  end Interchange;

  procedure Interchange_Columns ( mat : in out matrix; i,j : in integer ) is

  -- DESCRIPTION :
  --   The columns i and j of the given matrix are interchanged.

    temp : double_float;

  begin
    for k in mat'range(1) loop
      temp := mat(k,i); mat(k,i) := mat(k,j); mat(k,j) := temp;
    end loop;
  end Interchange_Columns;

  procedure Interchange_Rows
                 ( mat : in out matrix; lastcol : in integer;
                   v : in out vector; i,j : in integer ) is

  -- DESCRIPTION :
  --   The rows i and j of the given matrix and vector are interchanged.

    temp : double_float;

  begin
    for k in mat'first(2)..lastcol loop
      temp := mat(i,k); mat(i,k) := mat(j,k); mat(j,k) := temp;
    end loop;
    temp := v(i); v(i) := v(j); v(j) := temp;
  end Interchange_Rows;

  procedure Rotate ( mat : in out matrix; lastcol,i : in integer;
                     v : in out vector; tol : in double_float ) is

  -- DESCRIPTION :
  --   Performs Givens rotations on the matrix and vector such that 
  --   mat(j,i) = 0, for all j > i.

  -- NOTE :
  --   A diagonalization procedure constructs an orthonormal basis
  --   and does not preserve the angles between the vectors.

    cosi,sine : double_float;

  begin
    for j in i+1..mat'last(1) loop
      if abs(mat(j,i)) > tol
       then Givens_Factors(mat,i,j,cosi,sine);
            Givens_Rotation(mat,lastcol,i,j,cosi,sine);
            Givens_Rotation(v,i,j,cosi,sine);
      end if;
    end loop;
  end Rotate;

  procedure Upper_Triangulate ( mat : in out matrix; lastcol,i : in integer;
                                v : in out vector; tol : in double_float ) is

  -- DESCRIPTION :
  --   Makes the upper diagonal elements of the ith colume zero:
  --   mat(j,i) = 0, for all j /= i.

    fac : double_float;

  begin
    for j in mat'first(1)..(i-1) loop
      if (abs(mat(j,i)) > tol)
       then fac := mat(j,i)/mat(i,i);
            for k in i..lastcol loop
              mat(j,k) := mat(j,k) - fac*mat(i,k);
            end loop;
      end if;
    end loop;
  end Upper_Triangulate;

-- INITIALIZE : COMPUTE CLOSEST VECTOR TO RHS

  procedure Initialize
              ( tableau : in out matrix; lastcol : in integer;
                rhs,sol : in out vector;
                tol : in double_float; columns : in out Integer_Vectors.Vector;
                cosines : out vector; feasible : out boolean ) is

  -- DESCRIPTION :
  --   Scales the tableau and right hand side by dividing by its norm. 
  --   Then computes the vector of cosines.
  --   If no vector with positive cosine with the right hand side vector
  --   can be found, then the problem is not feasible, otherwise,
  --   the vector with largest positive cosine will be the first column.
  --   At last, this first column will be transformed to the unit vector,
  --   by means of Givens rotations.
  --   Then the first solution component equals the first component of
  --   the transformed right hand side vector.

    ips : vector(tableau'first(2)..lastcol);
    index : integer;

  begin
    Scale(tableau,lastcol); Scale(rhs);
   -- put_line("The tableau after scaling : "); put(tableau,3,3,3);
   -- put_line(" with scaled right hand side : "); put(rhs,3,3,3); new_line;
    ips := Inner_Products(tableau,lastcol,rhs);
    index := Index_of_Maximum(ips,lastcol);
    if (abs(ips(index)) < tol) or else (ips(index) < 0.0)
     then if index <= rhs'last
           then feasible := (abs(rhs(index)) < tol);
           else feasible := false;
          end if;
     else feasible := true;
          columns(columns'first) := index;
          columns(index) := columns'first;
          Interchange_Columns(tableau,tableau'first(2),index);
          Interchange(ips,tableau'first(2),index);
          index := Maximal_Product(tableau,tableau'first(2),rhs,rhs'first);
          if index /= tableau'first(2)
           then Interchange_Rows(tableau,lastcol,rhs,tableau'first(2),index);
          end if;
          Rotate(tableau,lastcol,tableau'first(2),rhs,tol);
         -- Upper_Triangulate(tableau,lastcol,tableau'first(2),rhs,tol);
          sol(sol'first) := rhs(rhs'first);
    end if;
    cosines := ips;
   -- put_line("At the end of Initialize : ");
   -- put(" cosines : "); put(ips,3,3,3); new_line;
   -- put_line("The tableau : "); put(tableau,3,3,3);
   -- put_line(" with right hand side : "); put(rhs,3,3,3); new_line;
   -- put(" and last column "); put(lastcol,1); new_line;
  end Initialize;

  procedure Initialize
              ( tableau : in out matrix; lastcol : in integer;
                rhs,sol : in out vector;
                tol : in double_float; columns : in out Integer_Vectors.Vector;
                feasible : out boolean ) is

  -- DESCRIPTION :
  --   Scales the tableau and right hand side by dividing by its norm. 
  --   Then computes the vector of cosines.
  --   If no vector with positive cosine with the right hand side vector
  --   can be found, then the problem is not feasible, otherwise,
  --   the vector with largest positive cosine will be the first column.
  --   At last, this first column will be transformed to the unit vector,
  --   by means of Givens rotations.
  --   Then the first solution component equals the first component of
  --   the transformed right hand side vector.

    ips : vector(tableau'first(2)..lastcol);
    index : integer;

  begin
    Scale(tableau,lastcol); Scale(rhs);
   -- put_line("The tableau after scaling : "); put(tableau,3,3,3);
   -- put_line(" with scaled right hand side : "); put(rhs,3,3,3); new_line;
    ips := Inner_Products(tableau,lastcol,rhs);
    index := Index_of_Maximum(ips,lastcol);
    if (abs(ips(index)) < tol) or else (ips(index) < 0.0)
     then if index <= rhs'last
           then feasible := (abs(rhs(index)) < tol);
           else feasible := false;
          end if;
     else feasible := true;
          columns(columns'first) := index;
          columns(index) := columns'first;
          Interchange_Columns(tableau,tableau'first(2),index);
          index := Maximal_Product(tableau,tableau'first(2),rhs,rhs'first);
          if index /= tableau'first(2)
           then Interchange_Rows(tableau,lastcol,rhs,tableau'first(2),index);
          end if;
          Rotate(tableau,lastcol,tableau'first(2),rhs,tol);
         -- Upper_Triangulate(tableau,lastcol,tableau'first(2),rhs,tol);
          sol(sol'first) := rhs(rhs'first);
    end if;
   -- put_line("At the end of Initialize : ");
   -- put_line("The tableau : "); put(tableau,3,3,3);
   -- put_line(" with right hand side : "); put(rhs,3,3,3); new_line;
   -- put(" and last column "); put(lastcol,1); new_line;
  end Initialize;

-- PERFORM THE NEXT STEPS :

  procedure Select_Column 
                  ( mat : in matrix; lastcol : in integer; 
                    rhs,cosines : in vector; index : in integer;
                    tol : in double_float; row,col : out integer ) is
  -- DESCRIPTION :
  --   Selects a column col with in matrix for which
  --    1) the cosine is maximal and
  --    2) row = Maximal_Product(mat,col,rhs,index), with mat(row,col) > 0.0
  --   If the resulting column is smaller than index, then no such column
  --   has been found.

    cl : integer := index;
    maxcos,prod : double_float;
    rw : integer := Maximal_Product(mat,cl,rhs,index);
    mp : integer;

  begin
   -- put_line("The tableau when Select_Column :"); put(mat,3,3,3);
   -- put_line(" with right hand side : "); put(rhs,3,3,3); new_line;
   -- put_line("and vector of cosines : "); put(cosines,3,3,3); new_line;
   -- put("The index : "); put(index,1); new_line;
    prod := mat(rw,cl)*rhs(rw);
    if prod > tol
      and then Positive(mat,rhs,index,cl,rhs(rw)/mat(rw,cl),tol)
              -- Positive_Diagonal(mat,rhs,index,cl,rhs(rw)/mat(rw,cl),tol)
     then maxcos := cosines(cl);
     else maxcos := -2.0;
    end if;
    for i in index+1..lastcol loop
      mp := Maximal_Product(mat,i,rhs,index);
     -- put("mp : "); put(mp,1); put(" when testing "); put(i,1);
     -- put_line("th column");
      prod := mat(mp,i)*rhs(mp);
      if prod > tol and then cosines(i) > maxcos
       then if Positive(mat,rhs,index,i,rhs(mp)/mat(mp,i),tol)
              -- Positive_Diagonal(mat,rhs,index,i,rhs(mp)/mat(mp,i),tol)
             then cl := i; rw := mp; maxcos := cosines(i);
            end if;
      end if;
    end loop;
   -- put("maximal cosine : "); put(maxcos,3,3,3); new_line;
    if maxcos >= -1.0
     then col := cl; row := rw;
         -- put("column : "); put(cl,1);
         -- put(" and row : "); put(rw,1); new_line;
     else col := index-1; row := index-1;
         -- put("column : "); put(index-1,1);
         -- put(" and row : "); put(index-1,1); new_line;
    end if;
  end Select_Column;

  procedure Select_Column 
                  ( mat : in matrix; lastcol : in integer; 
                    rhs : in vector; index,column : in integer;
                    tol : in double_float; row,col : out integer ) is
  -- DESCRIPTION :
  --   Selects first column col with in matrix for which
  --    row = Maximal_Product(mat,col,rhs,index), with mat(row,col) > 0.0.
  --   If the resulting column is smaller than index, then no such column
  --   has been found.

    cl : integer := index-1;
    prod : double_float;
    rw,mp : integer;

  begin
   -- put_line("The tableau when Select_Column :"); put(mat,3,3,3);
   -- put_line(" with right hand side : "); put(rhs,3,3,3); new_line;
   -- put("The index : "); put(index,1); new_line;
    for i in column..lastcol loop
      mp := Maximal_Product(mat,i,rhs,index);
     -- put("mp : "); put(mp,1); put(" when testing "); put(i,1);
     -- put_line("th column");
      prod := mat(mp,i)*rhs(mp);
      if prod > tol
        and then Positive(mat,rhs,index,i,rhs(mp)/mat(mp,i),tol)
                -- Positive_Diagonal(mat,rhs,index,i,rhs(mp)/mat(mp,i),tol)
       then cl := i; rw := mp;
      end if;
      exit when (cl >= index);
    end loop;
    if cl >= index
     then col := cl; row := rw;
         -- put("column : "); put(cl,1);
         -- put(" and row : "); put(rw,1); new_line;
     else col := index-1; row := index-1;
         -- put("column : "); put(index-1,1);
         -- put(" and row : "); put(index-1,1); new_line;
    end if;
  end Select_Column;

  procedure Next ( tableau : in out matrix; lastcol : in integer;
                   rhs,sol,cosines : in out vector;
                   pivots : in out Integer_Vectors.Vector;
                   tol : in double_float;
                   index : in integer; feasi : in out boolean ) is

  -- DESCRIPTION :
  --   Selects one new column out of the tableau.

  -- ON ENTRY :
  --   tableau     upper triangular up to the row and column index-1;
  --   lastcol     index of the last column of interest in the tableau;
  --   rhs         right hand side vector;
  --   sol         solution vector for the components 1..index;
  --   cosines     vector of cosines;
  --   pivots      vector of column interchangements;
  --   tol         tolerance to decide whether a number equals zero;
  --   index       indicator of the current step;
  --   feasi       must be true on entry.

  -- ON RETURN :
  --   tableau     upper triangular up to the row and column index,
  --               under the condition that feasi remains true;
  --   rhs         transformed right hand side vector;
  --   sol         new solution, with additional meaningful component
  --               sol(index);
  --   cosines     eventually permuted vector of cosines:
  --               cosines(index) is the cosine of the (new) column,
  --               indicated by index, and the right hand side vector;
  --   pivots      updated vector of column interchangements;
  --   feasi       if true, then a new column which yields a positive
  --               contribution of the right hand side vector has been 
  --               found, if this was not the case, then feasi is false;

    col,row,tmp : integer;

  begin
    Select_Column(tableau,lastcol,rhs,cosines,index,tol,row,col);
    if col < index
     then feasi := false;
     else feasi := true;
          if col /= index
           then tmp := pivots(col); pivots(col) := pivots(index);
                pivots(index) := tmp;
                Interchange_Columns(tableau,col,index);
                Interchange(cosines,col,index);
          end if;
          if row /= index
           then Interchange_Rows(tableau,lastcol,rhs,row,index);
          end if;
          Rotate(tableau,lastcol,index,rhs,tol);
         -- Upper_Triangulate(tableau,lastcol,index,rhs,tol);
         -- Solve(tableau,rhs,tol,index,sol);  -- only needed at end
         -- feasi := Positive(sol,index,tol);  -- double check...
    end if;
  end Next;

  procedure Next ( tableau : in out matrix; lastcol : in integer;
                   rhs,sol : in out vector;
                   pivots : in out Integer_Vectors.Vector;
                   tol : in double_float;
                   index : in integer; rank : out integer;
                   feasi : in out boolean ) is

  -- DESCRIPTION :
  --   Lexicographic enumeration of the candidates, stops when a feasible
  --   solution is encountered.

  -- ON ENTRY :
  --   tableau     upper triangular up to the row and column index-1;
  --   lastcol     index of the last column of interest in the tableau;
  --   rhs         right hand side vector;
  --   sol         solution vector for the components 1..index;
  --   pivots      vector of column interchangements;
  --   tol         tolerance to decide whether a number equals zero;
  --   index       indicator of the current step;
  --   feasi       must be true on entry.

  -- ON RETURN :
  --   tableau     upper triangular up to the row and column index,
  --               under the condition that feasi remains true;
  --   rhs         transformed right hand side vector;
  --   sol         new solution, with additional meaningful component
  --               sol(index);
  --   pivots      updated vector of column interchangements;
  --   rank        rank of the current tableau;
  --   feasi       if true, then a new column which yields a positive
  --               contribution of the right hand side vector has been 
  --               found, if this was not the case, then feasi is false;

    column,col,row,tmp : integer;
    stop : boolean := false;

  begin
    column := index;
    loop
      Select_Column(tableau,lastcol,rhs,index,column,tol,row,col);
      if col < column
       then feasi := false; stop := true;
       else
         feasi := true;
         if col /= index
          then tmp := pivots(col); pivots(col) := pivots(index);
               pivots(index) := tmp;
               Interchange_Columns(tableau,col,index);
         end if;
         if row /= index
          then Interchange_Rows(tableau,lastcol,rhs,row,index);
         end if;
         Rotate(tableau,lastcol,index,rhs,tol);
        -- Upper_Triangulate(tableau,lastcol,index,rhs,tol);
         if (index = lastcol) or else (index = tableau'last(1))
                              or else (Norm(rhs,index+1) < tol)
          then stop := true; rank := index;
          else
            Next(tableau,lastcol,rhs,sol,pivots,tol,index+1,rank,feasi);
            if feasi
             then stop := true;
             else column := col+1;
            end if;
         end if;
      end if;
      exit when stop;
    end loop;
  end Next;

  procedure Complementary_Slackness
                 ( tableau : in out matrix; rhs : in out vector;
                   tol : in double_float; solution : out vector;
                   columns : out Integer_Vectors.Vector;
                   feasible : out boolean ) is
  begin
    Complementary_Slackness
       (tableau,tableau'last(2),rhs,tol,solution,columns,feasible);
  end Complementary_Slackness;

  procedure Complementary_Slackness1
                 ( tableau : in out matrix; lastcol : in integer;
                   rhs : in out vector; tol : in double_float; 
                   solution : out vector; columns : out Integer_Vectors.Vector;
                   feasible : out boolean ) is

  -- NOTE :
  --   This version is a straigth forward search and finds not always
  --   the feasible solution.

    feasi : boolean;
    pivots : Integer_Vectors.Vector(tableau'first(2)..lastcol);
    cosis : vector(tableau'first(2)..lastcol);
    sol : Vector(rhs'range) := (rhs'range => 0.0);
    rank : integer;

  begin
    for i in pivots'range loop  -- initialize vector of pivots
      pivots(i) := i;
    end loop;
    Initialize(tableau,lastcol,rhs,sol,tol,pivots,cosis,feasi);
    if feasi
     then
       if Norm(rhs,rhs'first+1) > tol  -- check whether residual > 0
        then
          if tableau'first(1)+1 > lastcol
           then feasi := false;
           else
             rank := 1;
             for i in tableau'first(1)+1..tableau'last(1) loop
               Next(tableau,lastcol,rhs,sol,cosis,pivots,tol,i,feasi);
               exit when not feasi;
               exit when (i = lastcol);
               rank := rank + 1;
               exit when (Norm(rhs,i+1) < tol);
             end loop;
             if feasi
              then Solve(tableau,rhs,tol,rank,sol);
             end if;
          end if;
       end if;
       if feasi and then (tableau'last(1) > lastcol)
        then feasi := (Norm(rhs,lastcol+1) < tol);
       end if;
       if feasi and then (Norm(sol) < tol)
        then feasi := (Norm(rhs) < tol);
       end if;
       solution := sol;
       if tableau'last(1) <= lastcol
        then
          for i in tableau'range(1) loop
            columns(i) := pivots(i);
          end loop;
        else
          for i in tableau'first(2)..lastcol loop
            columns(i) := pivots(i);
          end loop;
       end if;
    end if;
    feasible := feasi;
  end Complementary_Slackness1;

  procedure Complementary_Slackness
                 ( tableau : in out matrix; lastcol : in integer;
                   rhs : in out vector; tol : in double_float;
                   solution : out vector; columns : out Integer_Vectors.Vector;
                   feasible : out boolean ) is

  -- NOTE :
  --   This version enumerates in a lexicographic order all candidates
  --   for entering the basis and stops when a feasible solution has been
  --   found.

    feasi : boolean;
    pivots : Integer_Vectors.Vector(tableau'first(2)..lastcol);
    sol : Vector(rhs'range) := (rhs'range => 0.0);
    ind,rank : integer;

  begin
    for i in pivots'range loop  -- initialize vector of pivots
      pivots(i) := i;
    end loop;
    Initialize(tableau,lastcol,rhs,sol,tol,pivots,feasi);
    if feasi
     then
       if Norm(rhs,rhs'first+1) > tol  -- check whether residual > 0
        then
          if tableau'first(1)+1 > lastcol
           then feasi := false;
           else
             ind := tableau'first(1)+1;
             Next(tableau,lastcol,rhs,sol,pivots,tol,ind,rank,feasi);
             if feasi
              then Solve(tableau,rhs,tol,rank,sol);
             end if;
          end if;
       end if;
       if feasi and then (tableau'last(1) > lastcol)
        then feasi := (Norm(rhs,lastcol+1) < tol);
       end if;
       if feasi and then (Norm(sol) < tol)
        then feasi := (Norm(rhs) < tol);
       end if;
       solution := sol;
       if tableau'last(1) <= lastcol
        then
          for i in tableau'range(1) loop
            columns(i) := pivots(i);
          end loop;
        else
          for i in tableau'first(2)..lastcol loop
            columns(i) := pivots(i);
          end loop;
       end if;
    end if;
    feasible := feasi;
  end Complementary_Slackness;

  procedure Complementary_Slackness2
                 ( tableau : in out matrix; lastcol : in integer;
                   rhs : in out vector; tol : in double_float;
                   solution : out vector; columns : out Integer_Vectors.Vector;
                   feasible : out boolean ) is

  -- NOTE :
  --   This version explicitly uses linear programming.

  begin
    Is_In_Cone(tableau,lastcol,rhs,tol,solution,columns,feasible);
  end Complementary_Slackness2;

end Farkas_Lemma;
