/* glprsm3.c */

/*----------------------------------------------------------------------
-- 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 <stddef.h>
#include <time.h>
#include "glprsm.h"

#define error print

/*----------------------------------------------------------------------
-- rsm1_driver - driver for the revised simplex method.
--
-- *Synopsis*
--
-- #include "glprsm.h"
-- int rsm1_driver(LP *lp, LPSOL *sol, struct rsm1_cp *cp);
--
-- *Description*
--
-- The rsm1_driver routine is a driver to the routines which implement
-- components of the revised simplex method for linear programming.
--
-- The parameter lp points to the LP problem data block. This block
-- specifies the LP problem which should be solved. It is not changed
-- on exit.
--
-- The parameter sol points to the LP problem basis solution block. The
-- rsm1_driver routine stores obtained solution to this block.
--
-- The parameter cp points to the block of control parameters which
-- affect on the behavior of the rsm1_driver routine.
--
-- Since large-scale problems may take a long time, the rsm1_driver
-- routine reports some visual information about current status of the
-- search. This information is sent to stdout approximately once per
-- second and has the following format:
--
--    *nnn:   objval = xxx   infsum = yyy (ddd)
--
-- where nnn is an iteration count, xxx is the current value of the
-- objective function (which is unscaled and has correct sign), yyy is
-- the sum of infeasibilities (which is scaled and therefore it may be
-- used only for visual estimating), ddd is the current number of basis
-- fixed variables. If the asterisk (*) precedes to nnn, the solver is
-- searching for optimal solution (i.e. the feasible solution has been
-- found yet), otherwise the solver is searching for some feasible
-- solution.
--
-- *Returns*
--
-- The rsm1_driver routine returns one of the following codes:
--
-- 0 - no errors. This case means that the solver has successfully
--     finished solving the problem;
-- 1 - iteration limit exceeded. In this case the solver reports the
--     recently obtained basis solution;
-- 2 - numerical problems with basis matrix. This case means that the
--     solver is not able to solve the problem. */

static LP *lp;
/* LP problem data block */

static LPSOL *sol;
/* LP problem solution block */

static struct rsm1_cp *cp;
/* control parameters block */

static int m;
/* number of rows = number of auxiliary variables */

static int n;
/* number of columns = number of structural variables */

static RSM *rsm;
/* simplex method common block */

static double *R; /* double R[1:m]; */
static double *S; /* double S[1:n]; */
/* diagonal scaling matrices; the constraint matrix for the scaling
   problem is R*A*S, where A is the original constraint matrix */

static int phase;
/* phase number:
   1 - searching for feasible solution
   2 - searching for optimal solution */

static clock_t t_last;
/* most recent time at which visual information was displayed */

/*----------------------------------------------------------------------
-- display - display visual information.
--
-- This routine displays visual information which includes iteration
-- number, value of the objective function, sum of infeasibilities, and
-- defect of the basis solution (number of fixed basic variables). */

static void display(void)
{     int i, j, k, def;
      double *bbar, obj, sum;
      /* compute current values of basic variables */
      bbar = ucalloc(1+m, sizeof(double));
      eval_bbar(rsm, bbar);
      /* compute current value of the objective function */
      obj = lp->c[0];
      for (j = 1; j <= n; j++)
      {  double xj;
         k = m+j;
         if (rsm->posx[k] > 0)
            xj = bbar[+rsm->posx[k]];
         else
            xj = eval_xn(rsm, -rsm->posx[k]);
         obj += lp->c[j] * (S[j] * xj);
      }
      /* compute sum of infeasibilities */
      sum = 0.0;
      for (i = 1; i <= m; i++)
      {  k = rsm->indb[i]; /* x[k] = xB[i] */
         if (rsm->type[k] == 'L' ||
             rsm->type[k] == 'D' ||
             rsm->type[k] == 'S')
         {  /* x[k] is basic variable and has lower bound */
            if (bbar[i] < rsm->lb[k]) sum += (rsm->lb[k] - bbar[i]);
         }
         if (rsm->type[k] == 'U' ||
             rsm->type[k] == 'D' ||
             rsm->type[k] == 'S')
         {  /* x[k] is basic variable and has upper bound */
            if (bbar[i] > rsm->ub[k]) sum += (bbar[i] - rsm->ub[k]);
         }
      }
      /* determine defect of the basis solution (which is a number of
         fixed basic variables) */
      def = 0;
      for (i = 1; i <= m; i++)
      {  k = rsm->indb[i]; /* x[k] = xB[i] */
         if (rsm->type[k] == 'S') def++;
      }
      /* display visual information */
      print("%c%6d:   objval = %17.9e   infsum = %17.9e (%d)",
         phase == 1 ? ' ' : '*', rsm->iter, obj, sum, def);
      ufree(bbar);
      return;
}

/*----------------------------------------------------------------------
-- monit - monitoring routine.
--
-- This routine is called by the simplex method routines each time
-- before the next iteration. It displays visual information (once per
-- second) and also checks for maximal number of iterations (non-zero
-- return code tells the simplex routines to terimnate the search). */

static int monit(void)
{     int ret = 0;
      /* display visual information */
      if (t_last == 0 || clock() - t_last > CLOCKS_PER_SEC)
      {  display();
         t_last = clock();
      }
      /* check for maximal number of iterations */
      if (cp->iter_max != 0 && rsm->iter > cp->iter_max) ret = 1;
      return ret;
}

/*----------------------------------------------------------------------
-- store_sol - store basis solution.
--
-- This routine stores the basis solution specified by the block RSM
-- into LP solution block LPSOL. */

static void store_sol(int status)
{     int i, j, k;
      double *bbar, *c, *pi, *cbar;
      bbar = ucalloc(1+m, sizeof(double));
      c = ucalloc(1+m+n, sizeof(double));
      pi = ucalloc(1+m, sizeof(double));
      cbar = ucalloc(1+n, sizeof(double));
      /* compute current values of basic variables */
      eval_bbar(rsm, bbar);
      /* build the expanded vector of coefficients of the original
         objective function */
      for (i = 1; i <= m; i++) c[i] = 0.0;
      for (j = 1; j <= n; j++) c[m+j] = S[j] * lp->c[j];
      /* compute simplex multipliers */
      eval_pi(rsm, c, pi);
      /* compute reduced costs of non-basic variables */
      eval_cbar(rsm, c, pi, cbar);
      /* store unscaled values and reduced costs of variables */
      for (k = 1; k <= m+n; k++)
      {  if (rsm->posx[k] > 0)
         {  i = +rsm->posx[k]; /* x[k] = xB[i] */
            sol->tagx[k] = 'B';
            if (cp->round && fabs(bbar[i]) < cp->tol_bnd) bbar[i] = 0.0;
            sol->valx[k] = bbar[i];
            sol->dx[k] = 0.0;
         }
         else
         {  j = -rsm->posx[k]; /* x[k] = xN[j] */
            sol->tagx[k] = rsm->tagn[j];
            sol->valx[k] = eval_xn(rsm, j);
            if (cp->round && fabs(cbar[j]) < cp->tol_dj) cbar[j] = 0.0;
            sol->dx[k] = cbar[j];
         }
         /* unscale */
         if (k <= m)
         {  /* auxiliary variable */
            sol->valx[k] /= R[k];
            sol->dx[k]   *= R[k];
         }
         else
         {  /* structural variable */
            sol->valx[k] *= S[k-m];
            sol->dx[k]   /= S[k-m];
         }
      }
      /* set solution status */
      sol->status = status;
      /* compute value of the objective function */
      sol->objval = lp->c[0];
      for (j = 1; j <= n; j++) sol->objval += lp->c[j] * sol->valx[m+j];
      ufree(bbar);
      ufree(c);
      ufree(pi);
      ufree(cbar);
      return;
}

/*----------------------------------------------------------------------
-- rsm1_driver - driver routine.
--
-- This routine is a driver for the revised simplex method. */

int rsm1_driver(LP *_lp, LPSOL *_sol, struct rsm1_cp *_cp)
{     int i, j, k, ret;
      double *gvec = NULL, *dvec = NULL;
      lp = _lp;
      sol = _sol;
      cp = _cp;
      m = lp->m;
      n = lp->n;
      if (!(sol->m == m && sol->n == n))
         fault("rsm1_driver: inconsistent dimension");
      /* create RSM */
      rsm = umalloc(sizeof(RSM));
      rsm->m = m;
      rsm->n = n;
      rsm->type = ucalloc(1+m+n, sizeof(int));
      rsm->lb = ucalloc(1+m+n, sizeof(double));
      rsm->ub = ucalloc(1+m+n, sizeof(double));
      rsm->A = create_mat(m, m+n);
      rsm->posx = ucalloc(1+m+n, sizeof(int));
      rsm->indb = ucalloc(1+m, sizeof(int));
      rsm->indn = ucalloc(1+n, sizeof(int));
      rsm->tagn = ucalloc(1+n, sizeof(int));
      rsm->inv = inv_create(m, 100);
      rsm->iter = 0;
      /* copy types and bounds of variables */
      for (k = 1; k <= m+n; k++)
      {  rsm->type[k] = lp->type[k];
         rsm->lb[k] = lp->lb[k];
         rsm->ub[k] = lp->ub[k];
      }
      /* build the expanded matrix A = (I | -A'), where I is the unity
         matrix, A' is the original matrix of constraint coefficients */
      for (i = 1; i <= m; i++) new_elem(rsm->A, i, i, +1.0);
      for (j = 1; j <= n; j++)
      {  ELEM *e;
         for (e = lp->A->col[j]; e != NULL; e = e->col)
            new_elem(rsm->A, e->i, m+j, -e->val);
      }
      /* construct initial basis, where all auxiliary variables are
         basic and all structural variables are non-basic (in this case
         B = I and N = -A') */
      for (i = 1; i <= m; i++)
      {  k = i; /* x[k] = xB[i] */
         rsm->posx[k] = +i;
         rsm->indb[i] =  k;
      }
      for (j = 1; j <= n; j++)
      {  k = m+j; /* x[k] = xN[j] */
         rsm->posx[k] = -j;
         rsm->indn[j] =  k;
         switch (rsm->type[k])
         {  case 'F': rsm->tagn[j] = 'F'; break;
            case 'L': rsm->tagn[j] = 'L'; break;
            case 'U': rsm->tagn[j] = 'U'; break;
            case 'D': rsm->tagn[j] = 'L'; break;
            case 'S': rsm->tagn[j] = 'S'; break;
            default:  insist(rsm->type[k] != rsm->type[k]);
         }
      }
      /* create scaling matrices */
      R = ucalloc(1+m, sizeof(double));
      for (i = 1; i <= m; i++) R[i] = 1.0;
      S = ucalloc(1+n, sizeof(double));
      for (j = 1; j <= n; j++) S[j] = 1.0;
      /* scale the problem (if required) */
      if (cp->scale)
      {  /* compute scaling matrices */
         gm_scaling(lp->A, R, S, 0, 0.01, 20);
         eq_scaling(lp->A, R, S, 0);
         /* scale bounds of auxiliary variables */
         for (i = 1; i <= m; i++)
         {  k = i;
            rsm->lb[k] *= R[i];
            rsm->ub[k] *= R[i];
         }
         /* scale bounds of structural variables */
         for (j = 1; j <= n; j++)
         {  k = m+j;
            rsm->lb[k] /= S[j];
            rsm->ub[k] /= S[j];
         }
         /* scale the original matrix of constraint coefficients (unity
            submatrix is not changed) */
         for (j = 1; j <= n; j++)
         {  ELEM *e;
            for (e = rsm->A->col[m+j]; e != NULL; e = e->col)
            {  i = e->i;
               e->val *= (R[i] * S[j]);
            }
         }
      }
      /* check RSM for correctness */
      check_rsm(rsm);
      /* compute the initial basis solution */
      {  int status;
         double *bbar = ucalloc(1+m, sizeof(double));
         /* compute current values of basic variables */
         eval_bbar(rsm, bbar);
         /* check if the initial solution is primal feasible */
         status = (check_bbar(rsm, bbar, cp->tol_bnd) ? 'I' : 'F');
         ufree(bbar);
         /* store the initial basis solution */
         store_sol(status);
      }
      /* if only the initial solution is required, print an appropriate
         message and return */
      if (cp->what == 0)
      {  switch (sol->status)
         {  case 'F':
               phase = 1;
               display();
               print("Initial solution is FEASIBLE");
               break;
            case 'I':
               phase = 2;
               display();
               print("Initial solution is INFEASIBLE");
               break;
            default:
               insist(sol->status != sol->status);
         }
         ret = 0;
         goto done;
      }
      /* if the steepest edge technique is used, initialize the vectors
         gamma and delta */
      if (cp->steep)
      {  gvec = ucalloc(1+n, sizeof(double));
         if (!cp->dual)
            init_gvec(rsm, gvec);
         else
         {  for (j = 1; j <= n; j++) gvec[j] = 1.0;
            dvec = ucalloc(1+m, sizeof(double));
            init_dvec(rsm, dvec);
         }
      }
feas: /* search for feasible solution */
      print("Searching for feasible solution...");
      phase = 1;
      /* reinvert the current basis matrix (this usually helps to
         improve accuracy of the representation) */
      if (invert_b(rsm))
sing: {  error("Numerical problems with basis matrix");
         error("Sorry, basis recovery procedure not implemented");
         ret = 2;
         goto done;
      }
      if (!cp->dual)
      {  /* use primal simplex method and implicit artificial variables
            technique */
         ret = rsm_feas(rsm, monit, cp->tol_bnd, cp->tol_dj,
            cp->tol_piv, gvec, cp->relax);
      }
      else
      {  /* use dual simplex method and artificial objective function */
         double *c = ucalloc(1+m+n, sizeof(double));
         for (k = 1; k <= m+n; k++) c[k] = 0.0;
         for (j = 1; j <= n; j++)
         {  k = rsm->indn[j]; /* x[k] = xN[j] */
            switch (rsm->tagn[j])
            {  case 'F': c[k] =  0.0; break;
               case 'L': c[k] = +1.0; break;
               case 'U': c[k] = -1.0; break;
               case 'S': c[k] =  0.0; break;
               default:  insist(rsm->tagn[j] != rsm->tagn[j]);
            }
         }
         ret = rsm_dual(rsm, monit, c, 0.30 * cp->tol_bnd, cp->tol_dj,
            cp->tol_piv, dvec, cp->relax);
         ufree(c);
      }
      /* analyze return code */
      switch (ret)
      {  case 0:
            display();
            store_sol('F');
            break;
         case 1:
            display();
            store_sol('N');
            print("PROBLEM HAS NO FEASIBLE SOLUTION");
            ret = 0;
            goto done;
         case 2:
            print("Numerical stability lost");
            goto feas;
         case 3:
            /* numerical problems with basis matrix */
            goto sing;
         case 4:
            display();
            store_sol('I');
            print("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = 1;
            goto done;
         default:
            insist(ret != ret);
      }
      /* if only some primal feasible solution is required, print an
         appropriate message and return */
      if (cp->what == 1)
      {  print("FEASIBLE SOLUTION FOUND");
         ret = 0;
         goto done;
      }
      /* search for optimal solution */
      insist(cp->what == 2);
      print("Searching for optimal solution...");
      phase = 2;
      {  double *c = ucalloc(1+m+n, sizeof(double));
         for (i = 1; i <= m; i++) c[i] = 0.0;
         for (j = 1; j <= n; j++)
            c[m+j] = (lp->dir == '-' ? +1.0 : -1.0) * S[j] * lp->c[j];
         ret = rsm_primal(rsm, monit, c, cp->tol_bnd, cp->tol_dj,
            cp->tol_piv, gvec, cp->relax);
         ufree(c);
      }
      /* analyze return code */
      switch (ret)
      {  case 0:
            display();
            store_sol('O');
            print("OPTIMAL SOLUTION FOUND");
            ret = 0;
            break;
         case 1:
            display();
            store_sol('U');
            print("PROBLEM HAS UNBOUNDED SOLUTION");
            ret = 0;
            break;
         case 2:
            print("Numerical stability lost");
            goto feas;
         case 3:
            /* numerical problems with basis matrix */
            goto sing;
         case 4:
            display();
            store_sol('F');
            print("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED");
            ret = 1;
            break;
         default:
            insist(ret != ret);
      }
done: /* free working data structures */
      ufree(rsm->type);
      ufree(rsm->lb);
      ufree(rsm->ub);
      delete_mat(rsm->A);
      ufree(rsm->posx);
      ufree(rsm->indb);
      ufree(rsm->indn);
      ufree(rsm->tagn);
      inv_delete(rsm->inv);
      ufree(rsm);
      ufree(R);
      ufree(S);
      if (gvec != NULL) ufree(gvec);
      if (dvec != NULL) ufree(dvec);
      /* return to the calling program */
      return ret;
}

/* eof */
