/*****************************************************************************
 *                                                                           *
 * ************************************************************************* *
 * ***                                                                   *** *
 * ***                         ~*~ SIMPLEX ~*~                           *** *
 * ***                                                                   *** *
 * ***               A simple implementation of the simplex              *** *
 * ***             algorithm for Linear Programming for Maxima.          *** *
 * ***                                                                   *** *
 * ***   This file provides functions minimize_lp and maximize_lp. This  *** *
 * ***   file is part of the simplex package for Maxima.                 *** *
 * ***                                                                   *** *
 * ***                                                                   *** *
 * ***   Copyright:  Andrej Vodopivec <andrejv@users.sourceforge.net>    *** *
 * ***   Version:    1.01                                                *** *
 * ***   License:    GPL                                                 *** *
 * ***                                                                   *** *
 * ************************************************************************* *
 *                                                                           *
 * Demo                                                                      *
 * =====                                                                     *
 *                                                                           *
 * 1) We want to minimize x with constraints y>=x-1, y>=-x-1, y<=x+1, y<=1-x *
 *    and y=x/2                                                              *
 *                                                                           *
 * Solution:                                                                 *
 *                                                                           *
 * load("simplex");                                                          *
 * minimize_lp(x, [y>=x-1, y>=-x-1, y<=x+1, y<=1-x, y=x/2]);                 *
 * => [-2/3, [x=-2/3, y=-1/3]]                                               *
 *                                                                           *
 *                                                                           *
 * 2) If any variable is known to be positive, you should add an optional    *
 *    argument to minimize_lp/maximize_lp.                                   *
 *    We want to maximize x+y subject to x>=0, y>=0, y<=-x/2+3, y<=-x+4.     *
 *                                                                           *
 * Solution:                                                                 *
 *                                                                           *
 * maximize_lp(x+y, [y<=-x/2+3, y<=-x+4], [x, y])                            *
 * => [4, [x = 2, y = 2]]                                                    *
 *                                                                           *
 *****************************************************************************/

define_variable(nonnegative_lp,   false, boolean,
               "Assume all variables are non-negative!")$
alias(nonegative_lp, nonnegative_lp)$
define_variable(return_input_lp, false, boolean,
               "Return the input to linear program, not solution!")$

/*****************************************************************************
 *                                                                           *
 * The minimize_lp function.                                                 *
 *                                                                           *
 *****************************************************************************/

minimize_lp(target, constraints, [pozitive]) := block(
  [var : [], A, b, c, inequalities:0, count, eq, t:expand(target), sol, s,
   nonpozitive : 0, j, tmpvar, keepfloat:true],

/*******************************************************************
 * Get the list of variables                                       *
 *******************************************************************/

  for e in constraints do (
    tmpvar : listofvars(e),
    for v in tmpvar do
      if not(member(v, var)) then var : cons(v, var),
    if op(e)#"=" then inequalities : inequalities+1
  ),

  if length(pozitive)>0 then (
    if listp(pozitive[1]) then pozitive : pozitive[1]
    else if pozitive[1]='all then pozitive : copylist(var)
  )
  else if nonnegative_lp=true then
    pozitive : copylist(var),

  for v in var do
    if not(member(v,pozitive)) then nonpozitive : nonpozitive+1,

/*******************************************************************
 * Setup A and b for linear program                                *
 *******************************************************************/
 
  b : makelist(0, i, 1, length(constraints)),
  A : zeromatrix(length(constraints), length(var)+nonpozitive+inequalities),
  count : 0,
  for i:1 thru length(constraints) do (
    eq : lhs(part(constraints,i))-rhs(part(constraints,i)),
    j : 1,
    for v in var do (
      A[i,j] : ratcoeff(eq, v),
      if not(constantp(A[i,j])) then
        error("Error: constraint not linear (1).",A[i,j]),
      eq : subst(v=0,eq),
      j : j+1,
      if not(member(v,pozitive)) then (
        A[i,j] : -A[i,j-1],
        j : j+1
      )
    ),
    if op(constraints[i])="<=" or op(constraints[i])="<" then (
      count : count+1,
      A[i, length(var)+nonpozitive+count] : 1
    )
    else if op(constraints[i])=">=" or op(constraints[i])=">" then (
      count : count+1,
      A[i, length(var)+nonpozitive+count] : -1
    )
    else if op(constraints[i])#"=" then
      error("Error: not a proper constraint:", constraints[i]),
    b[i] : -eq,
    if not(constantp(b[i])) then
      error("Error: constraint not linear (2).",b[i])
  ),
  
/*******************************************************************
 * Setup c for linear program                                      *
 *******************************************************************/
 
  c : makelist(0, i, 1, length(var)+nonpozitive+count),
  j : 1,
  for v in var do (
    c[j] : ratcoeff(t, v),
    if not(constantp(c[j])) then
      error("Error: cost function not linear."),
    t : subst(v=0,t),
    j : j+1,
    if not(member(v,pozitive)) then (
      c[j] : -c[j-1],
      j : j+1
    )
  ),

  if not(constantp(t)) then
    error("Error: cost function not linear in constrained variables."),

  if return_input_lp then return([A, b, c]),

/*******************************************************************
 * Solve the linear program                                        *
 *******************************************************************/

  sol : linear_program(A, b, c),
  
  if not(listp(sol)) then sol
  else (
    if sol[2]=-inf then [-inf, []]
    else (
      s : [],
      j : 1,
      for v in var do (
        if member(v,pozitive) then (
          s : append(s, [v=sol[1][j]]),
          j : j+1
        )
        else (
          s : append(s, [v=sol[1][j]-sol[1][j+1]]),
          j : j+2
        )
      ),
      [sol[2]+t, s]
    )
  )
)$

maximize_lp(target, constraints, [pozitive]) := block(
  [sol : apply(minimize_lp, append([-target], [constraints], pozitive))],
  if not(listp(sol)) then sol
  else [-sol[1], sol[2]]
)$


/*****************************************************************************
*                                                                           *
* %functions are for debugging purposes.                                    *
*                                                                           *
*****************************************************************************/

%prepare_standard_form_lp(target,constraints,pozitive) := block([listconstvars : false,
  vars, slack_vars, nonpozitive_vars, nonpozitive_vars0, nonpozitive_subs, slack_vars0, nonpozitive_subs0, vars0],
  vars : listofvars(append([target],constraints)),
  slack_vars : map(lambda([e],gensym()), constraints),
  nonpozitive_vars : sublist(vars,lambda([e], not(member(e,pozitive)))),
  nonpozitive_subs : block([mgensym : lambda([x], gensym(printf(false,"~a_",x)))],
    map(lambda([x], x=mgensym(x)-mgensym(x)), nonpozitive_vars)),
  constraints : block([ltoreq : lambda([l,r], -l >= -r)],
    subst(["<"=ltoreq, "<="=ltoreq], constraints)),
  constraints : map(lambda([e,s], if op(e)="=" then e else lhs(e)-s-rhs(e)),constraints,slack_vars),
  slack_vars0 : block([cv:listofvars(constraints)],
    sublist(slack_vars, lambda([x],member(x,cv)))),
  nonpozitive_vars0 : listofvars(map('rhs,nonpozitive_subs)),
  vars0 : block([vars:vars,nonpozitive_subs1:map('lhs,nonpozitive_subs)],
    for v in nonpozitive_subs1 do vars:delete(v,vars), vars),
  [target, constraints] : subst("="="-", subst(nonpozitive_subs, [target,constraints])),
  [target, constraints, vars0, nonpozitive_subs, nonpozitive_vars0, slack_vars0]
  )$
%minimize_lp(target, constraints, [pozitive]) := block([A, b, c, vars0, vars, tgt, vals, lp,
  nonpozitive_subs, nonpozitive_vars0, slack_vars0, mcoefmatrix],
  local(mcoefmatrix),
  mcoefmatrix(l,v) := apply('matrix,outermap(coeff,l,v)),
  pozitive : if pozitive=[] then [] else if listp(part(pozitive,1)) then part(pozitive,1) else if part(pozitive,1)='all or nonnegative_lp then copylist(block([listconstvars:false], listofvars(constraints))) else error("Unrecognized input."),
  [target, constraints, vars0, nonpozitive_subs, nonpozitive_vars0, slack_vars0] : %prepare_standard_form_lp(target, constraints, pozitive),
  vars : append(vars0, nonpozitive_vars0, slack_vars0),
  lp : linear_program(mcoefmatrix(constraints,vars), -subst(map(lambda([x],x=0),vars), constraints), first(args(mcoefmatrix([target],vars)))),
  if atom(lp) then lp else ([vals,tgt] : lp,
    block([maperror:false, mapprint:false],
      [tgt, append(map("=",vars0,vals),subst(map("=",nonpozitive_vars0,rest(vals,length(vars0))),nonpozitive_subs))])));
%maximize_lp(target, constraints, [pozitive]) := block([tgt, vals, lp],
  lp : %minimize_lp(-target, constraints,first(pozitive)),
  if atom(lp) then lp else ([tgt,vals] : lp,
    [-tgt, vals]))$
