/* glpapi7.c (glp_simplex2) */

/*----------------------------------------------------------------------
-- Copyright (C) 2000, 2001, 2002 Andrew Makhorin <mao@mai2.rcnet.ru>,
--               Department for Applied Informatics, Moscow Aviation
--               Institute, Moscow, Russia. All rights reserved.
--
-- This file is a part of GLPK (GNU Linear Programming Kit).
--
-- GLPK is free software; you can redistribute it and/or modify it
-- under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- GLPK is distributed in the hope that it will be useful, but WITHOUT
-- ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
-- License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with GLPK; see the file COPYING. If not, write to the Free
-- Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-- 02111-1307, USA.
----------------------------------------------------------------------*/

#include <math.h>
#include <string.h>
#include "glpapi.h"
#include "glpmat.h"
#include "glpspx.h"

/*----------------------------------------------------------------------
-- glp_init_spx2 - initialize parameter block by default values.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_init_spx2(struct spx2 *parm);
--
-- *Description*
--
-- The routine glp_init_spx2 initializes parameter block passed to the
-- simplex method routine by default values. */

void glp_init_spx2(struct spx2 *parm)
{     parm->scale    = 1;
      parm->initb    = 1;
      parm->round    = 1;
      parm->tol_bnd  = 1e-7;
      parm->tol_dj   = 1e-7;
      parm->tol_piv  = 1e-9;
      return;
}

/*----------------------------------------------------------------------
-- glp_simplex2 - solve LP problem using primal simplex method.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_simplex2(LPI *lp, struct spx2 *parm);
--
-- *Description*
--
-- The routine glp_simplex2 is an LP problem solver, which is based on
-- the two-phase primal simplex method.
--
-- This routine obtains problem data from a problem object, which the
-- parameter lp points to, solves the problem, and stores the computed
-- solution back to the problem object.
--
-- The parameter parm is a pointer to the parameter block used by the
-- solver. This block may be initialized by the routine glp_init_spx2
-- by standard default values. It is allowed to specify NULL, in which
-- case standard default values are used. If the problem is not very
-- hard, the standard default values fit for most cases.
--
-- Since large-scale problems may take a long time, the solver reports
-- some visual information about current status of the search. This
-- information is sent to stdout once per 100 simplex iterations using
-- the following format:
--
--    nnn:   objval = xxx   infeas = yyy (ddd)
--
-- where nnn is the iteration count, xxx is the current value of the
-- objective function (which is unscaled and has correct sign), yyy is
-- a measure of primal infeasibility (which is the current value of the
-- artificial variable introduced on the phase I), ddd is the number of
-- basic fixed variables.
--
-- Please note that this solver is not perfect. Although it has been
-- successfully tested on a wide set of real LP problems, there are so
-- called hard problems, which can't be resolved by this solver.
--
-- *Returns*
--
-- The routine glp_simplex2 returns one of the following codes:
--
-- 0 - no errors. This case means that the solver has successfully
--     finished solving the problem. (Note, for example, if the problem
--     has no feasible solution, the solver returns zero code);
-- 1 - (reserved for future use);
-- 2 - numerical problems with basis matrix. This case means that the
--     solver is not able to solve the problem. */

#define prefix "glp_simplex2: "

int glp_simplex2(LPI *lp, struct spx2 *parm)
{     int m = glp_get_num_rows(lp);
      int n = glp_get_num_cols(lp);
      struct spx2 my_parm;
      LPX *lpx;
      double *R, *S;
      int i, j, k, ret;
      if (m == 0) fault(prefix "problem has no rows");
      if (n == 0) fault(prefix "problem has no columns");
      /* reset solution information */
      glp_put_soln_info(lp, 'N', GLP_UNDEF, 0.0);
      /* if parameter block is not specified, use the dummy one */
      if (parm == NULL)
      {  parm = &my_parm;
         glp_init_spx2(parm);
      }
      /* check control parameters for correctness */
      if (!(parm->scale == 0 || parm->scale == 1 || parm->scale == 2))
         fault(prefix "scale = %d; invalid parameter", parm->scale);
      if (!(parm->initb == 0 || parm->initb == 1 || parm->initb == 2))
         fault(prefix "initb = %d; invalid parameter", parm->initb);
      if (!(parm->round == 0 || parm->round == 1))
         fault(prefix "round = %d; invalid parameter", parm->round);
      if (!(0.0 < parm->tol_bnd && parm->tol_bnd < 1.0))
         fault(prefix "tol_bnd = %g; invalid parameter", parm->tol_bnd);
      if (!(0.0 < parm->tol_dj && parm->tol_dj < 1.0))
         fault(prefix "tol_dj = %g; invalid parameter", parm->tol_dj);
      if (!(0.0 < parm->tol_piv && parm->tol_piv < 1.0))
         fault(prefix "tol_piv = %g; invalid parameter", parm->tol_piv);
      /* compute the scaling matrices R and S */
      R = ucalloc(1+m, sizeof(double));
      S = ucalloc(1+n, sizeof(double));
      switch (parm->scale)
      {  case 0:
            /* do not scale the problem */
            for (i = 1; i <= m; i++) R[i] = 1.0;
            for (j = 1; j <= n; j++) S[j] = 1.0;
            break;
         case 1:
            /* scale the problem */
            {  MAT *A = create_mat(m, n);
               int *rn = ucalloc(1+m, sizeof(int));
               double *aj = ucalloc(1+m, sizeof(double));
               int t, cnt;
               for (j = 1; j <= n; j++)
               {  cnt = glp_get_col_coef(lp, j, rn, aj);
                  for (t = 1; t <= cnt; t++)
                     new_elem(A, rn[t], j, aj[t]);
               }
               for (i = 1; i <= m; i++) R[i] = 1.0;
               for (j = 1; j <= n; j++) S[j] = 1.0;
               gm_scaling(A, R, S, 0, 0.01, 20);
               eq_scaling(A, R, S, 0);
               delete_mat(A);
               ufree(rn);
               ufree(aj);
            }
            break;
         case 2:
            /* scale the problem using scale factors specified in the
               problem object */
            /* obtain row scale factors */
            for (i = 1; i <= m; i++)
            {  R[i] = glp_get_row_fctr(lp, i);
               if (R[i] <= 0.0)
                  fault(prefix "row %d; invalid scale factor", i);
            }
            /* obtain column scale factors */
            for (j = 1; j <= n; j++)
            {  S[j] = glp_get_col_fctr(lp, j);
               if (S[j] <= 0.0)
                  fault(prefix "col %d; invalid scale factor", j);
            }
            break;
         default:
            insist(parm->scale != parm->scale);
      }
      /* create low-level LP problem object */
      lpx = lpx_create_prob();
      lpx_add_rows(lpx, m);
      lpx_add_cols(lpx, n);
      /* store row and column scaling matrices */
      memcpy(&lpx->rs[1], &R[1], m * sizeof(double));
      memcpy(&lpx->rs[m+1], &S[1], n * sizeof(double));
      /* set row bounds */
      for (i = 1; i <= m; i++)
      {  int typx;
         double lb, ub;
         glp_get_row_bnds(lp, i, &typx, &lb, &ub);
         switch (typx)
         {  case 'F': typx = LPX_FR; break;
            case 'L': typx = LPX_LO; break;
            case 'U': typx = LPX_UP; break;
            case 'D': typx = LPX_DB; break;
            case 'S': typx = LPX_FX; break;
            default: insist(typx != typx);
         }
         lpx_set_row_bnds(lpx, i, typx, lb, ub);
      }
      /* set column bounds */
      for (j = 1; j <= n; j++)
      {  int typx;
         double lb, ub;
         glp_get_col_bnds(lp, j, &typx, &lb, &ub);
         switch (typx)
         {  case 'F': typx = LPX_FR; break;
            case 'L': typx = LPX_LO; break;
            case 'U': typx = LPX_UP; break;
            case 'D': typx = LPX_DB; break;
            case 'S': typx = LPX_FX; break;
            default: insist(typx != typx);
         }
         lpx_set_col_bnds(lpx, j, typx, lb, ub);
      }
      /* set the objective function */
      switch (glp_get_obj_sense(lp))
      {  case '-':
            lpx_set_obj_dir(lpx, LPX_MIN);
            break;
         case '+':
            lpx_set_obj_dir(lpx, LPX_MAX);
            break;
         default:
            insist(lp != lp);
      }
      for (j = 1; j <= n; j++)
         lpx_set_col_coef(lpx, j, glp_get_obj_coef(lp, j));
      /* create the constraint matrix */
      {  int *rn = ucalloc(1+m, sizeof(int)), len;
         double *aj = ucalloc(1+m, sizeof(double));
         for (j = 1; j <= n; j++)
         {  int t;
            len = glp_get_col_coef(lp, j, rn, aj);
            /* remove zero coefficients */
            t = 1;
            while (t <= len)
            {  if (aj[t] == 0.0)
               {  rn[t] = rn[len];
                  aj[t] = aj[len];
                  len--;
               }
               else
                  t++;
            }
            lpx_set_mat_col(lpx, j, len, rn, aj);
         }
         ufree(rn);
         ufree(aj);
      }
      /* copy the basis information */
      for (k = 1; k <= m+n; k++)
      {  int tagx;
         if (k <= m)
            glp_get_row_soln(lp, k, &tagx, NULL, NULL);
         else
            glp_get_col_soln(lp, k-m, &tagx, NULL, NULL);
         if (tagx == 'B')
            lpx->tagx[k] = LPX_BS;
         else
         {  switch (lpx->typx[k])
            {  case LPX_FR:
                  lpx->tagx[k] = LPX_NF; break;
               case LPX_LO:
                  lpx->tagx[k] = LPX_NL; break;
               case LPX_UP:
                  lpx->tagx[k] = LPX_NU; break;
               case LPX_DB:
                  switch (tagx)
                  {  case 'L':
                        lpx->tagx[k] = LPX_NL; break;
                     case 'U':
                        lpx->tagx[k] = LPX_NU; break;
                     default:
                        if (fabs(lpx->lb[k]) <= fabs(lpx->ub[k]))
                           lpx->tagx[k] = LPX_NL;
                        else
                           lpx->tagx[k] = LPX_NU;
                        break;
                  }
                  break;
               case LPX_FX:
                  lpx->tagx[k] = LPX_NS; break;
               default:
                  insist(lpx->typx != lpx->typx);
            }
         }
      }
      /* solve the LP problem */
      lpx->msg_lev = 3;
      lpx->start = parm->initb;
      lpx->tol_bnd = parm->tol_bnd;
      lpx->tol_dj = parm->tol_dj;
      lpx->tol_piv = parm->tol_piv;
      ret = lpx_simplex(lpx);
      /* analyze return code */
      switch (ret)
      {  case LPX_E_OK:
            ret = 0; break;
         case LPX_E_BADB:
            fault(prefix "invalid basis information");
         case LPX_E_SING:
            ret = 2; break;
         default:
            insist(ret != ret);
      }
      /* store unscaled values and reduced costs of variables */
      for (k = 1; k <= m+n; k++)
      {  int tagx;
         double valx, dx;
         switch (lpx->tagx[k])
         {  case LPX_BS:
               tagx = 'B'; break;
            case LPX_NL:
               tagx = 'L'; break;
            case LPX_NU:
               tagx = 'U'; break;
            case LPX_NF:
               tagx = 'F'; break;
            case LPX_NS:
               tagx = 'S'; break;
            default:
               insist(lpx->tagx[k] != lpx->tagx[k]);
         }
         if (tagx == 'B')
         {  valx = lpx->bbar[lpx->posx[k]];
            if (parm->round && fabs(valx) <= parm->tol_bnd) valx = 0.0;
            dx = 0.0;
         }
         else
         {  valx = spx_eval_xn_j(lpx, lpx->posx[k] - m);
            dx = lpx->cbar[lpx->posx[k] - m];
            if (parm->round && fabs(dx) <= parm->tol_dj) dx = 0.0;
         }
         if (k <= m)
            glp_put_row_soln(lp, k, tagx, valx / R[k], dx * R[k]);
         else
            glp_put_col_soln(lp, k-m, tagx, valx * S[k-m], dx / S[k-m]);
      }
      /* store solution information */
      {  int b_stat = lpx->b_stat;
         int p_stat = lpx->p_stat;
         int d_stat = lpx->d_stat;
         int bstat, status;
         if (b_stat != LPX_B_VALID)
            bstat = '?', status = GLP_UNDEF;
         else if (p_stat == LPX_P_FEAS && d_stat == LPX_D_FEAS)
            bstat = 'O', status = GLP_OPT;
         else if (p_stat == LPX_P_FEAS && d_stat == LPX_D_INFEAS)
            bstat = 'P', status = GLP_FEAS;
         else if (p_stat == LPX_P_INFEAS)
            bstat = 'N', status = GLP_INFEAS;
         else if (p_stat == LPX_P_NOFEAS)
            bstat = 'N', status = GLP_NOFEAS;
         else if (p_stat == LPX_P_FEAS && d_stat == LPX_D_NOFEAS)
            bstat = 'P', status = GLP_UNBND;
         else
            bstat = '?', status = GLP_UNDEF;
         glp_put_soln_info(lp, bstat, status, spx_eval_obj(lpx));
      }
      /* free scaling matrices */
      ufree(R);
      ufree(S);
      /* delete LP problem object */
      lpx_delete_prob(lpx);
      /* return to the calling program */
      return ret;
}

/* eof */
