/* glpspx1.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 <float.h>
#include <math.h>
#include <stddef.h>
#include "glprsm.h"
#include "glpspx.h"

/*----------------------------------------------------------------------
-- spx_get_aj - get column of the constraint matrix.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- int spx_get_aj(SPXMAT *A, int j, int rn[], double aj[]);
--
-- *Description*
--
-- The constraint matrix A is a matrix, which defines the system of
-- equality constraints xR = A*xS, where xR is the vector of auxiliary
-- (logical) variables, xS is the vector structural variables.
--
-- The routine spx_get_aj obtains elements of the j-th column of the
-- matrix A and stores their row indices and numerical values to
-- locations rn[1], ..., rn[cnt] and aj[1], ..., aj[cnt] respectively,
-- where 0 <= cnt <= m is the number of non-zero elements in the j-th
-- column, m is the number of rows of the matrix A.
--
-- *Returns*
--
-- The routine returns cnt, the number of stored non-zero elements. */

int spx_get_aj(SPXMAT *A, int j, int rn[], double aj[])
{     int cnt;
      insist(1 <= j && j <= A->n);
      cnt = A->column(A->info, j, rn, aj);
      insist(0 <= cnt && cnt <= A->m);
      return cnt;
}

/*----------------------------------------------------------------------
-- spx_get_ak - get column of the expanded constraint matrix.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- int spx_get_ak(SPXMAT *A, int k, int rn[], double ak[]);
--
-- *Description*
--
-- The system of equality constraints xR = A*xS, where xR is a vector
-- of auxiliary (logical) variables, xS is a vector of structural
-- variables, A is the constraint matrix, can be written in homogeneous
-- form xR - A*xS = A~*x = 0, where x = (xR | xS) is the united vector
-- of variables, A~ = (I | -A) is the expanded constraint matrix, I is
-- the unity matrix.
--
-- The routine spx_get_ak obtains elements of the k-th column of the
-- matrix A~ = (I | -A), where A is the original constraint matrix, and
-- stores their row indices and numerical values to rn[1], ..., rn[cnt]
-- and ak[1], ..., ak[cnt] respectively, where 0 <= cnt <= m is the
-- number of non-zero elements in the k-th column, m is the number of
-- rows in the matrices A and A~.
--
-- *Returns*
--
-- The routine returns cnt, the number of stored non-zero elements. */

int spx_get_ak(SPXMAT *A, int k, int rn[], double ak[])
{     int m = A->m, n = A->n, cnt, t;
      insist(1 <= k && k <= m + n);
      if (k <= m)
      {  /* k-th column of A~ is k-th column of the unity matrix */
         cnt = 1;
         rn[1] = k;
         ak[1] = 1.0;
      }
      else
      {  /* k-th column of A~ is the corresponding column of A with
            opposite sign */
         cnt = spx_get_aj(A, k - m, rn, ak);
         for (t = 1; t <= cnt; t++) ak[t] = - ak[t];
      }
      return cnt;
}

/*----------------------------------------------------------------------
-- spx_get_bi - get column of the basis matrix.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- int spx_get_bi(SPXMAT *A, int indb[], int i, int rn[], double bi[]);
--
-- *Description*
--
-- The basis matrix B is a square non-singular matrix built of columns
-- of the expanded constraint matrix A~ = (I | -A), where I is the unity
-- matrix, A is the original constraint matrix.
--
-- The current set of basic columns of the matrix A~ is specified by the
-- array indb: indb[i] = k if i-th column of the matrix B is k-th column
-- of the matrix A~.
--
-- The routine spx_get_bi obtains elements of the i-th column of the
-- current basis matrix B and stores their row indices and numerical
-- values to rn[1], ..., rn[cnt] and bi[1], ..., bi[cnt] respectively,
-- where 0 <= cnt <= m is the number of non-zero elements in the i-th
-- column, m is the number of rows in the matrices A and A~ and is the
-- order of the matrix B.
--
-- *Returns*
--
-- The routine returns cnt, the number of stored non-zero elements. */

int spx_get_bi(SPXMAT *A, int indb[], int i, int rn[], double bi[])
{     insist(1 <= i && i <= A->m);
      return spx_get_ak(A, indb[i], rn, bi);
}

/*----------------------------------------------------------------------
-- spx_ini_basis - build an initial basis.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- int spx_ini_basis(SPXMAT *A, int typx[], int indb[]);
--
-- *Description*
--
-- The routine spx_ini_basis builds an initial basis trying to minimize
-- number of basic columns that correspond to fixed auxiliary (logical)
-- and structural variables.
--
-- The parameter A specifies the constraint matrix.
--
-- The array typx specifies types of variables. Location typx[0] is not
-- used. Locations typx[1], ..., typx[m] correspond to the auxiliary
-- (logical) variables xR[1], ..., xR[m]; and locations typx[m+1], ...,
-- typx[m+n] correspond to the structural xS[1], ..., xS[n]. Dimensions
-- m and n are specified implictly by the matrix A. If type[k] is 'S',
-- the variable is considered as fixed; in all other cases the variable
-- is considered as non-fixed. The array typx is not changed on exit.
--
-- The array indb should have at least [1+m] locations. On exit the
-- routine stores into locations indb[1], ..., indb[m] the numbers of
-- columns of the expanded constraint matrix A~ = (I | -A), which form
-- the basis matrix (see also comments to the routine spx_get_bi). The
-- location indb[0] is not used.
--
-- *Returns*
--
-- The routine returns the number of basic columns, which correspond to
-- the fixed auxiliary variables and which the routine couldn't remove
-- from the basis matrix. This number can be from 0 to m. */

int spx_ini_basis(SPXMAT *A, int typx[], int indb[])
{     int m = A->m, n = A->n, i, k, t, cnt, ret, *rn, *tagx;
      double *ak;
      MAT *AA;
      PER *P, *Q;
      /* create expanded constraint matrix A~ = (I | -A) explictly */
      AA = create_mat(m, m+n);
      rn = ucalloc(1+m, sizeof(int));
      ak = ucalloc(1+m, sizeof(double));
      for (k = 1; k <= m+n; k++)
      {  cnt = spx_get_ak(A, k, rn, ak);
         for (t = 1; t <= cnt; t++) new_elem(AA, rn[t], k, ak[t]);
      }
      ufree(rn);
      ufree(ak);
      /* create tags of "non-desirable" variables (in the given case
         such variables are fixed ones) */
      tagx = ucalloc(1+m+n, sizeof(int));
      for (k = 1; k <= m+n; k++)
         tagx[k] = (typx[k] == 'S' ? 1 : 0);
      /* use a heuristic in order to determine permutation matrices P
         and Q such that the first m columns of the matrix P*A~*Q form
         a lower tringular matrix with non-zero diagonal, which can be
         used as the wanted basis matrix */
      P = create_per(m);
      Q = create_per(m+n);
      ret = crash_aa(AA, tagx, P, Q);
#if 0
      /* show the matrix P*A~*Q for visual analysis */
      per_mat(P, AA, NULL);
      mat_per(AA, Q, NULL);
      show_mat(AA, 1, "paq.bmp");
#endif
      /* extract information about the first m columns of P*A~*Q */
      for (i = 1; i <= m; i++) indb[i] = Q->col[i];
      /* free auxiliary data structures and return */
      delete_mat(AA);
      ufree(tagx);
      delete_per(P);
      delete_per(Q);
      return ret;
}

/*----------------------------------------------------------------------
-- spx_eval_xnj - determine value of non-basic variable.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- double spx_eval_xnj(double lb[], double ub[], int indn[], int tagn[],
--    int j);
--
-- *Returns*
--
-- The routine spx_eval_xnj returns the value of the non-basic variable
-- xN[j], 1 <= j <= n, for the specified basic solution. */

double spx_eval_xnj(double lb[], double ub[], int indn[], int tagn[],
      int j)
{     int k;
      double xnj;
      k = indn[j]; /* x[k] = xN[j] */
      switch (tagn[j])
      {  case 'L':
            /* xN[j] is on its lower bound */
            xnj = lb[k];
            break;
         case 'U':
            /* xN[j] is on its upper bound */
            xnj = ub[k];
            break;
         case 'F':
            /* xN[j] is free variable */
            xnj = 0.0;
            break;
         case 'S':
            /* xN[j] is fixed variable */
            xnj = lb[k];
            break;
         default:
            insist(tagn[j] != tagn[j]);
      }
      return xnj;
}

/*----------------------------------------------------------------------
-- spx_eval_bbar - compute values of basic variables.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_eval_bbar(SPXMAT *A, SPXBAS *B, double lb[], double ub[],
--    int indn[], int tagn[], double bbar[], int rn[], double ak[]);
--
-- *Description*
--
-- The routine spx_eval_bbar computes values of basic variables
--
--    xB = beta = (beta_1, ..., beta_m)
--
-- for the specified basis and stores components of the vector beta to
-- the locations bbar[1], ..., bbar[m] respectively.
--
-- The vector beta is computed using the following formula:
--
--    beta = - inv(B) * (N * xN) =
--
--         = inv(B) * (- N[1]*xN[1] - ... - N[n]*xN[n]),
--
-- where N[j] is the column of the expanded constrint matrix A~, which
-- corresponds to the non-basic variable xN[j]. */

void spx_eval_bbar(SPXMAT *A, SPXBAS *B, double lb[], double ub[],
      int indn[], int tagn[], double bbar[], int _rn[], double _ak[])
{     int m = A->m, n = A->n, *rn = _rn, i, j, k, t, cnt;
      double *u = bbar, *ak = _ak, xnj;
      /* allocate working arrays */
      if (_rn == NULL) rn = ucalloc(1+m, sizeof(int));
      if (_ak == NULL) ak = ucalloc(1+m, sizeof(double));
      /* u := - N*xN = - N[1]*xN[1] - ... - N[n]*xN[n] */
      for (i = 1; i <= m; i++) u[i] = 0.0;
      for (j = 1; j <= n; j++)
      {  xnj = spx_eval_xnj(lb, ub, indn, tagn, j);
         if (xnj == 0.0) continue;
         k = indn[j]; /* x[k] = xN[j] */
         cnt = spx_get_ak(A, k, rn, ak);
         for (t = 1; t <= cnt; t++) u[rn[t]] -= ak[t] * xnj;
      }
      /* free working arrays */
      if (_rn == NULL) ufree(rn);
      if (_ak == NULL) ufree(ak);
      /* bbar := inv(B) * u */
      spx_ftran(B, u, 0);
      return;
}

/*----------------------------------------------------------------------
-- spx_eval_zeta - compute row of the inverse.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_eval_zeta(int m, SPXBAS *B, int i, double zeta[]);
--
-- *Description*
--
-- The routine spx_eval_zeta computes the i-th row of the matrix inv(B),
-- where B is the specified basis matrix, and stores elements of the row
-- to locations zeta[1], ..., zeta[m].
--
-- The i-th row of inv(B) is computed using the following formula:
--
--    zeta = inv(B') * e[i],
--
-- where B' is a matrix transposed to B, e[i] is the unity vector, which
-- contains one in the i-th position. */

void spx_eval_zeta(int m, SPXBAS *B, int i, double zeta[])
{     int j;
      for (j = 1; j <= m; j++) zeta[j] = 0.0;
      zeta[i] = 1.0;
      spx_btran(B, zeta);
      return;
}

/*----------------------------------------------------------------------
-- spx_eval_row - compute row of the simplex table.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_eval_row(SPXMAT *A, int indn[], double zeta[], double ai[],
--    int rn[], double ak[]);
--
-- *Description*
--
-- The routine spx_eval_row computes i-th row of the specified simplex
-- table, i.e. of the matrix A^ = -inv(B)*N, and stores elements of the
-- row to locations ai[1], ..., ai[n].
--
-- On entry the array zeta should contain the i-th row of the inverse
-- inv(B), where B is the corresponding basis matrix, computed by means
-- the routine spx_eval_zeta. This array is not changed on exit.
--
-- The i-th row of the simplex table is computed using the following
-- formula:
--
--    a^[i] = - N' * zeta,
--
-- where N' is a matrix transposed to N, which is a matrix consisting
-- of the non-basic columns of the expanded matrix A~ = (I | -A), zeta
-- is the i-th row of the inverse inv(B). */

void spx_eval_row(SPXMAT *A, int indn[], double zeta[], double ai[],
      int _rn[], double _ak[])
{     int m = A->m, n = A->n, *rn = _rn, j, k, t, cnt;
      double *ak = _ak, sum;
      /* allocate working arrays */
      if (_rn == NULL) rn = ucalloc(1+m, sizeof(int));
      if (_ak == NULL) ak = ucalloc(1+m, sizeof(double));
      /* compute the i-th row of the simplex table */
      for (j = 1; j <= n; j++)
      {  k = indn[j]; /* x[k] = xN[j] */
         cnt = spx_get_ak(A, k, rn, ak);
         sum = 0.0;
         for (t = 1; t <= cnt; t++) sum -= ak[t] * zeta[rn[t]];
         ai[j] = sum;
      }
      /* free working arrays */
      if (_rn == NULL) ufree(rn);
      if (_ak == NULL) ufree(ak);
      return;
}

/*----------------------------------------------------------------------
-- spx_eval_pi - compute simplex multipliers.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_eval_pi(int m, SPXBAS *B, int indb[], double c[],
--    double pi[]);
--
-- *Description*
--
-- The routine spx_eval_pi computes simplex multipliers (i.e. Lagrange
-- multiplers that correspond to the equality constraints)
--
--    pi = (pi_1, ..., pi_m)
--
-- for the specified basis and stores components of the vector pi into
-- the locations pi[1], ..., pi[m] respectively.
--
-- On entry the array c should contain objective coefficients for all
-- (auxiliary and structural) variables in locations c[1], ..., c[m+n].
-- This array is not changed on exit.
--
-- The vector pi is computed using the following formula:
--
--    pi = inv(B') * cB,
--
-- where B' is a matrix transposed to the specified basis matrix B, cB
-- is the vector of objective coefficients at basic variables xB. */

void spx_eval_pi(int m, SPXBAS *B, int indb[], double c[], double pi[])
{     int i, k;
      double *cb = pi;
      /* extract the vector cB */
      for (i = 1; i <= m; i++)
      {  k = indb[i]; /* x[k] = xB[i] */
         cb[i] = c[k];
      }
      /* compute the simplex multipliers */
      spx_btran(B, cb);
      return;
}

/*----------------------------------------------------------------------
-- spx_eval_col - compute column of the simplex table.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_eval_col(SPXMAT *A, SPXBAS *B, int indn[], int j,
--    double aj[], int save, int rn[], double ak[]);
--
-- *Description*
--
-- The routine spx_eval_col computes j-th column of the specified
-- simplex table, i.e. of the matrix A^ = -inv(B)*N, and stores elements
-- of the column to locations aj[1], ..., aj[m].
--
-- The parameter save is a flag. If this flag is set, it means that the
-- computed column is the column of non-basic variable (xN)q which has
-- been chosen to enter the basis (i.e. j = q). This flag is used by the
-- routine spx_ftran in order to save and pass the corresponding column
-- to the routine spx_update.
--
-- The j-th column of the simplex table is computed using the formula:
--
--    A^[j] = - inv(B) * N[j],
--
-- where B is the basis matrix, N[j] is a column of the expanded matrix
-- A^, which corresponds to the non-basic variable xN[j]. */

void spx_eval_col(SPXMAT *A, SPXBAS *B, int indn[], int j, double aj[],
      int save, int _rn[], double _ak[])
{     int m = A->m, *rn = _rn, i, k, t, cnt;
      double *u = aj, *ak = _ak;
      /* allocate working arrays */
      if (_rn == NULL) rn = ucalloc(1+m, sizeof(int));
      if (_ak == NULL) ak = ucalloc(1+m, sizeof(double));
      /* u := N[j], which is the column of the expanded constraint
              matrix A~ = (I | -A) that correspond to xN[j] = x[k] */
      k = indn[j];
      for (i = 1; i <= m; i++) u[i] = 0.0;
      cnt = spx_get_ak(A, k, rn, ak);
      for (t = 1; t <= cnt; t++) u[rn[t]] = + ak[t];
      /* free working arrays */
      if (_rn == NULL) ufree(rn);
      if (_ak == NULL) ufree(ak);
      /* A^[j] := - inv(B) * N[j] */
      spx_ftran(B, u, save);
      for (i = 1; i <= m; i++) aj[i] = - u[i];
      return;
}

/*----------------------------------------------------------------------
-- spx_reset_gvec - reset the reference space and the vector gamma.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_reset_gvec(int m, int n, int indn[], int ref[],
--    double gvec[]);
--
-- *Description*
--
-- The routine spx_reset_gvec resets the reference space and the vector
-- gamma used in the primal projected steepest edge method.
--
-- On exit the reference space defined by the array ref corresponds to
-- the current set of non-basic variables, and therefore all components
-- of the vector gamma are equal to one (by the definition). */

void spx_reset_gvec(int m, int n, int indn[], int ref[], double gvec[])
{     int j, k;
      for (k = 1; k <= m+n; k++) ref[k] = 0;
      for (j = 1; j <= n; j++)
      {  k = indn[j]; /* x[k] = xN[j] */
         ref[k] = 1;
         gvec[j] = 1.0;
      }
      return;
}

/*----------------------------------------------------------------------
-- spx_update_gvec - update the vector gamma for adjacent basis.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_update_gvec(SPXMAT *A, SPXBAS *B, int typx[], int ref[],
--    int indb[], int indn[], int p, int q, double ap[], double aq[],
--    double gvec[], int _rn[], double _ak[], double _w[]);
--
-- *Description*
--
-- The routine spx_update_gvec replaces the vector gamma (used in the
-- primal steepest edge method), which corresponds to the current basis,
-- by the updated vector, which corresponds to the adjacent basis.
--
-- The array ref specifies the used reference space: if the variable
-- x[k] belongs the reference space, ref[k] is set, otherwise ref[k] is
-- clear, 1 <= k <= m+n.
--
-- On entry the matrix B and the arrays indb and indn should correspond
-- to the current basis. They are not changed on exit.
--
-- The parameter p specifies the basic variable (xB)p, which has been
-- chosen to leave the basis. The parameter q specifies the non-basic
-- variable (xN)q, which has been chosen to enter the basis.
--
-- On entry the arrays ap and aq should contain the p-th row and the
-- q-th column of the current simplex table, respectively. They are not
-- changed on exit.
--
-- On entry the array gvec should contain elements of the vector gamma
-- for the current basis in the locations gvec[1], ..., gvec[n]. On exit
-- this array will contain elements of the vector gamma for the adjacent
-- basis in the same locations. */

void spx_update_gvec(SPXMAT *A, SPXBAS *B, int typx[], int ref[],
      int indb[], int indn[], int p, int q, double ap[], double aq[],
      double gvec[], int _rn[], double _ak[], double _w[])
{     int m = A->m, n = A->n, *rn = _rn, i, j, t, cnt;
      double *ak = _ak, *w = _w, sj, t1, t2, t3, aiq;
      /* allocate working arrays */
      if (_rn == NULL) rn = ucalloc(1+m, sizeof(int));
      if (_ak == NULL) ak = ucalloc(1+m, sizeof(double));
      if (_w == NULL) w = ucalloc(1+m, sizeof(double));
      /* compute t1 and w */
      t1 = 0.0;
      for (i = 1; i <= m; i++)
      {  if (i != p && ref[indb[i]])
         {  w[i] = aq[i];
            t1 += w[i] * w[i];
         }
         else
            w[i] = 0.0;
      }
      spx_btran(B, w);
      /* update the vector gamma */
      for (j = 1; j <= n; j++)
      {  /* gvec[q] will be computed later */
         if (j == q) continue;
         /* if xN[j] is fixed variable, its weight is not used, because
            fixed variables never enter the basis */
         if (typx[indn[j]] == 'S')
         {  gvec[j] = 1.0;
            continue;
         }
         /* compute s[j] */
         sj = gvec[j];
         if (ref[indb[p]]) sj -= ap[j] * ap[j];
         if (ref[indn[j]]) sj -= 1.0;
         if (ap[j] == 0.0)
            t3 = 0.0;
         else
         {  t2 = 0.0;
            cnt = spx_get_ak(A, indn[j], rn, ak);
            for (t = 1; t <= cnt; t++) t2 += ak[t] * w[rn[t]];
            t3 = ap[j] / ap[q];
            sj += 2.0 * t2 * t3 + t1 * t3 * t3;
         }
         /* update gvec[j] */
         gvec[j] = sj;
         if (ref[indn[j]]) gvec[j] += 1.0;
         if (ref[indn[q]]) gvec[j] += t3 * t3;
         /* reset gvec[j] if its value is non-positive due to round-off
            errors */
         if (gvec[j] < DBL_EPSILON) gvec[j] = 1.0;
      }
      /* compute exact value of gvec[q] */
      gvec[q] = (ref[indb[p]] ? 1.0 : 0.0);
      for (i = 1; i <= m; i++)
      {  if (i != p && ref[indb[i]] || i == p && ref[indn[q]])
         {  aiq = (i == p ? 1.0 / aq[p] : aq[i] / aq[p]);
            gvec[q] += aiq * aiq;
         }
      }
      /* free working arrays */
      if (_rn == NULL) ufree(rn);
      if (_ak == NULL) ufree(ak);
      if (_w == NULL) ufree(w);
      return;
}

/*----------------------------------------------------------------------
-- spx_exact_gvec - compute exact value of gamma[j].
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- double spx_exact_gvec(SPXMAT *A, SPXBAS *B, int ref[], int indb[],
--    int indn[], int j);
--
-- *Description*
--
-- The routine spx_exact_gvec computes exact value of gamma[j] (used
-- in the primal projected steepest edge method) for the specified basis
-- and the reference space.
--
-- This operation is extremely inefficient and therefore intended only
-- for debugging purposes.
--
-- *Returns*
--
-- The routine returns the computed exact value of gamma[j]. */

double spx_exact_gvec(SPXMAT *A, SPXBAS *B, int ref[], int indb[],
      int indn[], int j)
{     int m = A->m, i;
      double *aj, sum;
      aj = ucalloc(1+m, sizeof(double));
      spx_eval_col(A, B, indn, j, aj, 0, NULL, NULL);
      sum = (ref[indn[j]] ? 1.0 : 0.0);
      for (i = 1; i <= m; i++)
         if (ref[indb[i]]) sum += aj[i] * aj[i];
      ufree(aj);
      return sum;
}

/*----------------------------------------------------------------------
-- spx_check_gvec - check accuracy of the vector gamma.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- double spx_check_gvec(SPXMAT *A, SPXBAS *B, int typx[], int ref[],
--    int indb[], int indn[], double gvec[]);
--
-- *Description*
--
-- The routine spx_check_gvec is intended for checking accuracy of the
-- vector gamma. It computes the absolute error
--
--    e = max |gamma'[j] - gamma[j]|,
--
-- where gamma' is the exact vector computed by means of the routine
-- spx_exact_gvec, gamma is the approximate vector given in the array
-- gvec.
--
-- This operation is extremely inefficient and therefore intended only
-- for debugging purposes.
--
-- *Returns*
--
-- The routine returns the computed absolute error e. */

double spx_check_gvec(SPXMAT *A, SPXBAS *B, int typx[], int ref[],
      int indb[], int indn[], double gvec[])
{     int n = A->n, j;
      double dmax = 0.0, d, temp;
      for (j = 1; j <= n; j++)
      {  if (typx[indn[j]] == 'S') continue;
         temp = spx_exact_gvec(A, B, ref, indb, indn, j);
         d = fabs(temp - gvec[j]);
         if (dmax < d) dmax = d;
      }
      return dmax;
}

/*----------------------------------------------------------------------
-- spx_eval_cbar - compute reduced costs of non-basic variables.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_eval_cbar(SPXMAT *A, int indn[], double c[], double pi[],
--    double cbar[], int rn[], double ak[]);
--
-- *Description*
--
-- The routine spx_eval_cbar computes reduced costs
--
--    d = (d_1, ..., d_n)
--
-- of non-basic variables for the specified basis and stores components
-- of the vector d to locations cbar[1], ..., cbar[n] respectively.
--
-- On entry the array c should contain the vector of coefficients of the
-- objective function in locations c[1], ..., c[m+n]. The array c is not
-- changed on exit.
--
-- On entry the array pi should contain the vector of simplex (Lagrange)
-- multipliers pi computed using the routine spx_eval_pi routine for the
-- same vector c. The array pi is not changed on exit.
--
-- The vector d is computed using the following formula:
--
--    d[j] = cN[j] - pi' * N[j], j = 1, 2, ..., n,
--
-- where cN[j] is coefficient of the objective function at the variable
-- xN[j], pi is the vector of simplex multipliers, N[j] is the column of
-- the expanded constraint matrix A~, which corresponds to the variable
-- xN[j]. */

void spx_eval_cbar(SPXMAT *A, int indn[], double c[], double pi[],
      double cbar[], int _rn[], double _ak[])
{     int m = A->m, n = A->n, *rn = _rn, j, k, t, cnt;
      double *ak = _ak, sum;
      /* allocate working arrays */
      if (_rn == NULL) rn = ucalloc(1+m, sizeof(int));
      if (_ak == NULL) ak = ucalloc(1+m, sizeof(double));
      /* compute reduced costs */
      for (j = 1; j <= n; j++)
      {  k = indn[j]; /* x[k] = xN[j] */
         sum = c[k];
         cnt = spx_get_ak(A, k, rn, ak);
         for (t = 1; t <= cnt; t++) sum -= pi[rn[t]] * ak[t];
         cbar[j] = sum;
      }
      /* free working arrays */
      if (_rn == NULL) ufree(rn);
      if (_ak == NULL) ufree(ak);
      return;
}

/*----------------------------------------------------------------------
-- spx_scale_mat - scale matrix of constraint coefficients.
--
-- *Synopsis*
--
-- #include "glpspx.h"
-- void spx_scale_mat(SPXMAT *A, int how, double R[], double S[]);
--
-- *Description*
--
-- The routine spx_scale_mat performs implicit scaling of the matrix A
-- (the matrix of constraint coefficients).
--
-- The parameter how specifies the type of scaling:
--
-- 0 - equilibration scaling;
-- 1 - geometric mean scaling;
-- 2 - geometric mean scaling, then equilibration scaling.
--
-- The result of scaling is diagonal matrices R and S, whose diagonal
-- elements are stored on exit in the arrays with the same names. These
-- matrices define the scaled matrix R*A*S, which is expected to have
-- better numerical properties than the original matrix A. Elements of
-- the matrix R are stored in locations R[1], ..., R[m], and elements
-- of the matrix S are stored in locations S[1], ..., S[n], where m is
-- number of rows and n is number of columns of the matrix A. */

void spx_scale_mat(SPXMAT *A, int how, double R[], double S[])
{     MAT *AA;
      int m = A->m, n = A->n, i, j;
      /* create the constraint matrix explicitly */
      AA = create_mat(m, n);
      {  int t, cnt;
         int *rn = ucalloc(1+m, sizeof(int));
         double *aj = ucalloc(1+m, sizeof(double));
         for (j = 1; j <= n; j++)
         {  cnt = spx_get_aj(A, j, rn, aj);
            for (t = 1; t <= cnt; t++)
               new_elem(AA, rn[t], j, aj[t]);
         }
         ufree(rn);
         ufree(aj);
      }
      /* compute the scaling matrices */
      for (i = 1; i <= m; i++) R[i] = 1.0;
      for (j = 1; j <= n; j++) S[j] = 1.0;
      switch (how)
      {  case 0:
            /* equilibration scaling */
            eq_scaling(AA, R, S, 0);
            break;
         case 1:
            /* geometric mean scaling */
            gm_scaling(AA, R, S, 0, 0.01, 20);
            break;
         case 2:
            /* geometric mean scaling, then equilibration scaling */
            gm_scaling(AA, R, S, 0, 0.01, 20);
            eq_scaling(AA, R, S, 0);
            break;
         default:
            fault("spx_scale_mat: how = %d; invalid parameter", how);
      }
      delete_mat(AA);
      return;
}

/* eof */
