/* glpapi1.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 <ctype.h>
#include <errno.h>
#include <float.h>
#include <math.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include "glpapi.h"
#include "glplang.h"
#include "glpmps.h"

#define error print

/*----------------------------------------------------------------------
-- glp_check_data - turn on/off data consistency checking flag.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_check_data(LPI *lp, int check);
--
-- *Description*
--
-- If the parameter check is non-zero, the routine glp_check_data turn
-- on data consistency checking flag, in which case some other GLPK API
-- routines perform additional checking input data. If the parameter
-- check is zero, the routine turn the flag off. */

void glp_check_data(LPI *lp, int check)
{     lp->check = check;
      return;
}

/*----------------------------------------------------------------------
-- glp_check_name - check symbolic name for correctness.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_check_name(char *name);
--
-- *Description*
--
-- The routine glp_check_name checks the given symbolic name for
-- correctness.
--
-- Symbolic name is considered as correct if it consists of 1 up to 255
-- graphic characters.
--
-- *Returns*
--
-- If the given symbolic name is correct, the routine returns zero.
-- Otherwise the routine returns non-zero. */

int glp_check_name(char *name)
{     int t;
      for (t = 0; name[t] != '\0'; t++)
         if (t == 255 || !isgraph(name[t])) return 1;
      return 0;
}

/*----------------------------------------------------------------------
-- glp_clear_mat_cols - nullify columns of constraint matrix.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_clear_mat_cols(LPI *lp, int flag[]);
--
-- *Description*
--
-- The routine glp_clear_mat_cols deletes all elements from specified
-- columns of the constraint matrix.
--
-- The array flag should have at least 1+n locations, where n is number
-- of columns in the problem object. The location flag[0] is not used.
-- If flag[j] is non-zero, the routine deletes all elements of the j-th
-- column. If flag[j] is zero, the j-th column is not changed.
--
-- *Complexity*
--
-- The time complexity is O(nz), where nz is total number of elements
-- in the constraint matrix before operation. */

void glp_clear_mat_cols(LPI *lp, int flag[])
{     int i, j;
      for (j = 1; j <= lp->n; j++)
         if (flag[j]) lp->col[j]->ptr = NULL;
      for (i = 1; i <= lp->m; i++)
      {  ELEM *ptr = NULL, *e;
         while (lp->row[i]->ptr != NULL)
         {  e = lp->row[i]->ptr;
            lp->row[i]->ptr = e->row;
            if (flag[e->j])
               free_atom(lp->elem_pool, e);
            else
               e->row = ptr, ptr = e;
         }
         lp->row[i]->ptr = ptr;
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_clear_mat_rows - nullify rows of constraint matrix.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_clear_mat_rows(LPI *lp, int flag[]);
--
-- *Description*
--
-- The routine glp_clear_mat_rows deletes all elements from specified
-- rows of the constraint matrix.
--
-- The array flag should have at least 1+m locations, where m is number
-- of rows in the problem object. The location flag[0] is not used.
-- If flag[i] is non-zero, the routine deletes all elements of the i-th
-- row. If flag[i] is zero, the i-th row is not changed.
--
-- *Complexity*
--
-- The time complexity is O(nz), where nz is total number of elements
-- in the constraint matrix before operation. */

void glp_clear_mat_rows(LPI *lp, int flag[])
{     int i, j;
      for (i = 1; i <= lp->m; i++)
         if (flag[i]) lp->row[i]->ptr = NULL;
      for (j = 1; j <= lp->n; j++)
      {  ELEM *ptr = NULL, *e;
         while (lp->col[j]->ptr != NULL)
         {  e = lp->col[j]->ptr;
            lp->col[j]->ptr = e->col;
            if (flag[e->i])
               free_atom(lp->elem_pool, e);
            else
               e->col = ptr, ptr = e;
         }
         lp->col[j]->ptr = ptr;
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_create_prob - create problem instance.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- LPI *glp_create_prob(char *name);
--
-- *Description*
--
-- The routine glp_create_prob creates and initializes a new problem
-- instance, which is "empty", i.e. has no rows and no columns.
--
-- The parameter name specifies a symbolic name, which is assigned to
-- the new problem. If this parameter is NULL, no name is assigned.
--
-- *Returns*
--
-- The routine returns a pointer to the created problem instance. */

LPI *glp_create_prob(char *name)
{     LPI *lp;
      lp = umalloc(sizeof(LPI));
      lp->row_pool = create_pool(sizeof(LPIROW));
      lp->col_pool = create_pool(sizeof(LPICOL));
      lp->elem_pool = create_pool(sizeof(ELEM));
      lp->str_pool = create_str_pool();
      lp->check = 0;
      lp->name = NULL;
      lp->m_max = 100;
      lp->n_max = 100;
      lp->m = 0;
      lp->n = 0;
      lp->row = ucalloc(1+lp->m_max, sizeof(LPIROW *));
      lp->col = ucalloc(1+lp->n_max, sizeof(LPICOL *));
      lp->row_tree = create_avl((int (*)(void *, void *))compare_str);
      lp->col_tree = create_avl((int (*)(void *, void *))compare_str);
      lp->c0 = 0.0;
      lp->sense = '-';
      lp->basis = '?';
      lp->status = GLP_UNDEF;
      lp->objval = 0.0;
      /* assign problem name */
      if (name != NULL)
      {  if (glp_check_name(name))
            fault("glp_create_prob: invalid problem name");
         lp->name = create_str(lp->str_pool);
         set_str(lp->name, name);
      }
      return lp;
}

/*----------------------------------------------------------------------
-- glp_delete_cols - delete columns from problem instance.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_delete_cols(LPI *lp, int flag[]);
--
-- *Description*
--
-- The routine glp_delete_cols deletes specified subset of columns from
-- the problem object.
--
-- The array flag should have at least 1+n locations, where n is number
-- of columns in the problem object. The location flag[0] is not used.
-- If flag[j] (1 <= j <= n) is non-zero, the routine deletes the j-th
-- column. Otherwise, if flag[j] is zero, the j-th column is kept.
--
-- *Complexity*
--
-- The time complexity is O(nz), where nz is total number of elements
-- in the constraint matrix before operation. */

void glp_delete_cols(LPI *lp, int flag[])
{     int j, n;
      glp_clear_mat_cols(lp, flag);
      n = 0;
      for (j = 1; j <= lp->n; j++)
      {  if (flag[j])
         {  glp_set_col_name(lp, j, NULL);
            free_atom(lp->col_pool, lp->col[j]);
         }
         else
         {  ELEM *e;
            n++;
            lp->col[n] = lp->col[j];
            lp->col[n]->seqn = n;
            for (e = lp->col[n]->ptr; e != NULL; e = e->col) e->j = n;
         }
      }
      lp->n = n;
      return;
}

/*----------------------------------------------------------------------
-- glp_delete_prob - delete problem instance.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_delete_prob(LPI *lp);
--
-- *Description*
--
-- The routine glp_delete_prob deletes the problem instance, which
-- the parameter lp points to, freeing all the memory allocated to this
-- program object. */

void glp_delete_prob(LPI *lp)
{     delete_pool(lp->row_pool);
      delete_pool(lp->col_pool);
      delete_pool(lp->elem_pool);
      delete_pool(lp->str_pool);
      ufree(lp->row);
      ufree(lp->col);
      delete_avl(lp->row_tree);
      delete_avl(lp->col_tree);
      ufree(lp);
      return;
}

/*----------------------------------------------------------------------
-- glp_delete_rows - delete rows from problem instance.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_delete_rows(LPI *lp, int flag[]);
--
-- *Description*
--
-- The routine glp_delete_rows deletes specified subset of rows from
-- the problem object.
--
-- The array flag should have at least 1+m locations, where m is number
-- of rows in the problem object. The location flag[0] is not used.
-- If flag[i] (1 <= i <= n) is non-zero, the routine deletes the i-th
-- row. Otherwise, if flag[i] is zero, the i-th row is kept.
--
-- *Complexity*
--
-- The time complexity is O(nz), where nz is total number of elements
-- in the constraint matrix before operation. */

void glp_delete_rows(LPI *lp, int flag[])
{     int i, m;
      glp_clear_mat_rows(lp, flag);
      m = 0;
      for (i = 1; i <= lp->m; i++)
      {  if (flag[i])
         {  glp_set_row_name(lp, i, NULL);
            free_atom(lp->row_pool, lp->row[i]);
         }
         else
         {  ELEM *e;
            m++;
            lp->row[m] = lp->row[i];
            lp->row[m]->seqn = m;
            for (e = lp->row[m]->ptr; e != NULL; e = e->row) e->i = m;
         }
      }
      lp->m = m;
      return;
}

/*----------------------------------------------------------------------
-- glp_find_col - find column by name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_find_col(LPI *lp, char *name);
--
-- *Description*
--
-- The routine glp_find_col finds a column that has the given symbolic
-- name.
--
-- *Complexity*
--
-- The time complexity is O(log n'), where n' is number of named columns
-- in the column list.
--
-- *Returns*
--
-- If a column with the given name has been found, the routine returns
-- its sequential number. Otherwise, the routine returns zero. */

int glp_find_col(LPI *lp, char *name)
{     AVLNODE *node;
      STR *key;
      if (name == NULL || glp_check_name(name))
         fault("glp_find_col: invalid column name");
      key = create_str(lp->str_pool);
      set_str(key, name);
      node = find_by_key(lp->col_tree, key);
      delete_str(key);
      return node == NULL ? 0 : ((LPICOL *)node->link)->seqn;
}

/*----------------------------------------------------------------------
-- glp_find_row - find row by name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_find_row(LPI *lp, char *name);
--
-- *Description*
--
-- The routine glp_find_row finds a row that has the given symbolic
-- name.
--
-- *Complexity*
--
-- The time complexity is O(log m'), where m' is number of named rows
-- in the row list.
--
-- *Returns*
--
-- If a row with the given name has been found, the routine returns its
-- sequential number. Otherwise, the routine returns zero. */

int glp_find_row(LPI *lp, char *name)
{     AVLNODE *node;
      STR *key;
      if (name == NULL || glp_check_name(name))
         fault("glp_find_row: invalid row name");
      key = create_str(lp->str_pool);
      set_str(key, name);
      node = find_by_key(lp->row_tree, key);
      delete_str(key);
      return node == NULL ? 0 : ((LPIROW *)node->link)->seqn;
}

/*----------------------------------------------------------------------
-- glp_get_bstat - determine basis status.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_bstat(LPI *lp);
--
-- *Returns*
--
-- The routine glp_get_bstat returns one of the following codes that
-- shows current status of the problem basis:
--
-- '?' - basis is undefined;
-- 'N' - basis is neither primal nor dual feasible;
-- 'P' - basis is primal feasible, but dual infeasible;
-- 'D' - basis is primal infeasible, but dual feasible;
-- 'O' - basis is primal and dual feasible (optimal). */

int glp_get_bstat(LPI *lp)
{     return lp->basis;
}

/*----------------------------------------------------------------------
-- glp_get_col_bnds - determine column bounds.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_get_col_bnds(LPI *lp, int j, int *type, double *lb,
--    double *ub);
--
-- *Description*
--
-- The routine glp_get_col_bnds stores the type, the lower bound, and
-- the upper bound of the j-th column to locations, which the parameters
-- type, lb, and ub point to, respectively.
--
-- If some of the parameters type, lb, or ub is NULL, the corresponding
-- value is not stored.
--
-- Types and bounds have the following meaning:
--
--    Type        Bounds            Note
--    ----------------------------------------
--    'F'   -inf <  x <  +inf   free variable
--    'L'     lb <= x <  +inf   lower bound
--    'U'   -inf <  x <=  ub    upper bound
--    'D'     lb <= x <=  ub    double bound
--    'S'           x  =  lb    fixed variable
--
-- where x is the corresponding structural variable.
--
-- If the column has no lower bound, *lb is set to zero. If the column
-- has no upper bound, *ub is set to zero. If the column is of fixed
-- type, *lb and *ub are set to the same value. */

void glp_get_col_bnds(LPI *lp, int j, int *type, double *lb, double *ub)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_get_col_bnds: j = %d; invalid column number", j);
      if (type != NULL) *type = lp->col[j]->type;
      if (lb != NULL) *lb = lp->col[j]->lb;
      if (ub != NULL) *ub = lp->col[j]->ub;
      return;
}

/*----------------------------------------------------------------------
-- glp_get_col_coef - get column of constraint matrix.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_col_coef(LPI *lp, int j, int rn[], double aj[]);
--
-- *Description*
--
-- The routine glp_get_col_coef scans elements of the j-th column of
-- the constraint matrix and stores their row indices and values to
-- locations rn[1], ..., rn[nz'] and aj[1], ..., aj[nz'] respectively,
-- where 0 <= nz' <= m is number of elements in the j-th column, m is
-- number of rows.
--
-- *Returns*
--
-- The routine returns nz', which is the number of stored elements. */

int glp_get_col_coef(LPI *lp, int j, int rn[], double aj[])
{     ELEM *e;
      int nz = 0;
      if (!(1 <= j && j <= lp->n))
         fault("glp_get_col_coef: j = %d; invalid column number", j);
      for (e = lp->col[j]->ptr; e != NULL; e = e->col)
      {  nz++;
         if (nz > lp->m)
            fault("glp_get_col_coef: j = %d; nultiplets detected", j);
         rn[nz] = e->i;
         aj[nz] = e->val;
      }
      return nz;
}

/*----------------------------------------------------------------------
-- glp_get_col_fctr - query column scale factor.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- double glp_get_col_fctr(LPI *lp, int j);
--
-- *Returns*
--
-- The routine glp_get_col_fctr returns a scale factor assigned to the
-- j-th column. */

double glp_get_col_fctr(LPI *lp, int j)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_get_col_fctr: j = %d; invalid column number", j);
      return lp->col[j]->fctr;
}

/*----------------------------------------------------------------------
-- glp_get_col_kind - get column kind.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_col_kind(LPI *lp, int j);
--
-- *Returns*
--
-- The routine glp_get_col_kind returns kind of the structural variable
-- that corresponds to the j-th column:
--
-- 'C' - continuous variable;
-- 'I' - integer variable. */

int glp_get_col_kind(LPI *lp, int j)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_get_col_kind: j = %d; invalid column number", j);
      return lp->col[j]->kind;
}

/*----------------------------------------------------------------------
-- glp_get_col_name - obtain column name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- char *glp_get_col_name(LPI *lp, int j);
--
-- *Returns*
--
-- The routine glp_get_col_name returns a pointer to a static buffer
-- that contains symbolic name of the j-th column. However, if the j-th
-- column has no assigned name, the routine returns NULL. */

char *glp_get_col_name(LPI *lp, int j)
{     static char name[255+1];
      if (!(1 <= j && j <= lp->n))
         fault("glp_get_col_name: j = %d; invalid column number", j);
      return lp->col[j]->name == NULL ?
         NULL : get_str(name, lp->col[j]->name);
}

/*----------------------------------------------------------------------
-- glp_get_col_soln - obtain column solution information.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_get_col_soln(LPI *lp, int j, int *tagx, double *valx,
--    double *dx);
--
-- *Description*
--
-- The routine glp_get_col_soln stores status, primal value, and dual
-- value of the j-th column (structural variable) to locations, which
-- the parameters tagx, valx, and dx point to, respectively.
--
-- If some of the pointers tagx, valx, or dx is NULL, the corresponding
-- value is not stored.
--
-- The status code has the following meaning:
--
-- 'B' - basic variable;
-- 'L' - non-basic variable on its lower bound;
-- 'U' - non-basic variable on its upper bound;
-- 'F' - non-basic free (unbounded) variable;
-- 'S' - non-basic fixed variable.
--
-- Should note that if the routine glp_get_bstat reports that the basis
-- is undefined, the status code is not applicable. Analogously, if the
-- routine glp_get_status reports that the solution is undefined, primal
-- and dual values are meaningless. */

void glp_get_col_soln(LPI *lp, int j, int *tagx, double *valx,
      double *dx)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_get_col_soln: j = %d; invalid column number", j);
      if (tagx != NULL) *tagx = lp->col[j]->tagx;
      if (valx != NULL) *valx = lp->col[j]->valx;
      if (dx != NULL) *dx = lp->col[j]->dx;
      return;
}

/*----------------------------------------------------------------------
-- glp_get_num_bin - determine number of binary columns.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_num_bin(LPI *lp);
--
-- *Complexity*
--
-- The time complexity is O(n), where n is total number of columns in
-- the problem.
--
-- *Returns*
--
-- The routine glp_get_num_bin returns number of columns that marked as
-- integer and have zero lower bound and unity upper bound. */

int glp_get_num_bin(LPI *lp)
{     int count = 0, j;
      for (j = 1; j <= lp->n; j++)
      {  if (lp->col[j]->kind == 'I' && lp->col[j]->type == 'D' &&
             lp->col[j]->lb == 0.0 && lp->col[j]->ub == 1.0) count++;
      }
      return count;
}

/*----------------------------------------------------------------------
-- glp_get_num_cols - determine number of columns.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_num_cols(LPI *lp);
--
-- *Complexity*
--
-- The time complexity is O(1).
--
-- *Returns*
--
-- The routine glp_get_num_cols returns total number of columns in the
-- problem. */

int glp_get_num_cols(LPI *lp)
{     return lp->n;
}

/*----------------------------------------------------------------------
-- glp_get_num_int - determine number of integer columns.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_num_int(LPI *lp);
--
-- *Complexity*
--
-- The time complexity is O(n), where n is total number of columns in
-- the problem.
--
-- *Returns*
--
-- The routine glp_get_num_int returns number of columns that marked as
-- integer. */

int glp_get_num_int(LPI *lp)
{     int count = 0, j;
      for (j = 1; j <= lp->n; j++)
         if (lp->col[j]->kind == 'I') count++;
      return count;
}

/*----------------------------------------------------------------------
-- glp_get_num_nz - determine number of constraint coefficients.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_num_nz(LPI *lp);
--
-- *Complexity*
--
-- The time complexity is O(1).
--
-- *Returns*
--
-- The routine glp_get_num_nz returns total number of elements in the
-- constraint matrix. */

int glp_get_num_nz(LPI *lp)
{     return lp->elem_pool->count;
}

/*----------------------------------------------------------------------
-- glp_get_num_rows - determine number of rows.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_num_rows(LPI *lp);
--
-- *Complexity*
--
-- The time complexity is O(1).
--
-- *Returns*
--
-- The routine glp_get_num_rows returns total number of rows in the
-- problem. */

int glp_get_num_rows(LPI *lp)
{     return lp->m;
}

/*----------------------------------------------------------------------
-- glp_get_obj_coef - determine objective function coefficient.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- double glp_get_obj_coef(LPI *lp, int j);
--
-- *Returns*
--
-- The routine glp_get_obj_coef returns a coefficient of the objective
-- function at the j-th structural variable.
--
-- If the parameter j is zero, the routine returns the constant term of
-- the objective function. */

double glp_get_obj_coef(LPI *lp, int j)
{     if (!(0 <= j && j <= lp->n))
         fault("glp_get_obj_coef: j = %d; invalid column number", j);
      return j == 0 ? lp->c0 : lp->col[j]->coef;
}

/*----------------------------------------------------------------------
-- glp_get_obj_sense - get objective function sense.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_obj_sense(LPI *lp);
--
-- *Returns*
--
-- The routine glp_get_obj_sense returns the sense of the objective
-- function:
--
-- '-' - problem is minimization;
-- '+' - problem is maximization. */

int glp_get_obj_sense(LPI *lp)
{     return lp->sense;
}

/*----------------------------------------------------------------------
-- glp_get_obj_val - obtain objective function value.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- double glp_get_obj_val(LPI *lp);
--
-- *Returns*
--
-- The routine glp_get_obj_val returns computed value of the objective
-- function. Should note that if the routine glp_get_status reports that
-- the solution is undefined, the returned value is meaningless. */

double glp_get_obj_val(LPI *lp)
{     return lp->objval;
}

/*----------------------------------------------------------------------
-- glp_get_prob_name - obtain problem name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- char *glp_get_prob_name(LPI *lp);
--
-- *Returns*
--
-- The routine glp_get_prob_name returns a pointer to a static buffer
-- that contains symbolic name of the problem. However, if the problem
-- has no assigned name, the routine returns NULL. */

char *glp_get_prob_name(LPI *lp)
{     static char name[255+1];
      return lp->name == NULL ? NULL : get_str(name, lp->name);
}

/*----------------------------------------------------------------------
-- glp_get_row_bnds - determine row bounds.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_get_row_bnds(LPI *lp, int i, int *type, double *lb,
--    double *ub);
--
-- *Description*
--
-- The routine glp_get_row_bnds stores the type, the lower bound, and
-- the upper bound of the i-th row to locations, which parameters type,
-- lb, and ub point to, respectively.
--
-- If some of the parameters type, lb, or ub is NULL, the corresponding
-- value is not stored.
--
-- Types and bounds have the following meaning:
--
--    Type        Bounds            Note
--    ----------------------------------------
--    'F'   -inf <  x <  +inf   free variable
--    'L'     lb <= x <  +inf   lower bound
--    'U'   -inf <  x <=  ub    upper bound
--    'D'     lb <= x <=  ub    double bound
--    'S'           x  =  lb    fixed variable
--
-- where x is the corresponding auxiliary variable.
--
-- If the row has no lower bound, *lb is set to zero. If the row has no
-- upper bound, *ub is set to zero. If the row is of fixed type, *lb and
-- *ub are set to the same value. */

void glp_get_row_bnds(LPI *lp, int i, int *type, double *lb, double *ub)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_get_row_bnds: i = %d; invalid row number", i);
      if (type != NULL) *type = lp->row[i]->type;
      if (lb != NULL) *lb = lp->row[i]->lb;
      if (ub != NULL) *ub = lp->row[i]->ub;
      return;
}

/*----------------------------------------------------------------------
-- glp_get_row_coef - get row of constraint matrix.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_row_coef(LPI *lp, int i, int cn[], double ai[]);
--
-- *Description*
--
-- The routine glp_get_row_coef scans elements of the i-th row of the
-- constraint matrix and stores their column indices and values to
-- locations cn[1], ..., cn[nz'] and ai[1], ..., ai[nz'] respectively,
-- where 0 <= nz' <= n is number of elements in the i-th row, n is
-- number of columns.
--
-- *Returns*
--
-- The routine returns nz', which is the number of stored elements. */

int glp_get_row_coef(LPI *lp, int i, int cn[], double ai[])
{     ELEM *e;
      int nz = 0;
      if (!(1 <= i && i <= lp->m))
         fault("glp_get_row_coef: i = %d; invalid row number", i);
      for (e = lp->row[i]->ptr; e != NULL; e = e->row)
      {  nz++;
         if (nz > lp->n)
            fault("glp_get_row_coef: i = %d; multiplets detected", i);
         cn[nz] = e->j;
         ai[nz] = e->val;
      }
      return nz;
}

/*----------------------------------------------------------------------
-- glp_get_row_fctr - query row scale factor.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- double glp_get_row_fctr(LPI *lp, int i);
--
-- *Returns*
--
-- The routine glp_get_row_fctr returns a scale factor assigned to the
-- i-th row. */

double glp_get_row_fctr(LPI *lp, int i)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_get_row_fctr: i = %d; invalid row number", i);
      return lp->row[i]->fctr;
}

/*----------------------------------------------------------------------
-- glp_get_row_name - obtain row name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- char *glp_get_row_name(LPI *lp, int i);
--
-- *Returns*
--
-- The routine glp_get_row_name returns a pointer to a static buffer
-- that contains symbolic name of the i-th row. However, if the i-th
-- row has no assigned name, the routine returns NULL. */

char *glp_get_row_name(LPI *lp, int i)
{     static char name[255+1];
      if (!(1 <= i && i <= lp->m))
         fault("glp_get_row_name: i = %d; invalid row number", i);
      return lp->row[i]->name == NULL ?
         NULL : get_str(name, lp->row[i]->name);
}

/*----------------------------------------------------------------------
-- glp_get_row_soln - obtain row solution information.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_get_row_soln(LPI *lp, int i, int *tagx, double *valx,
--    double *dx);
--
-- *Description*
--
-- The routine glp_get_row_soln stores status, primal value, and dual
-- value of the i-th row (auxiliary variable) to locations, which the
-- parameters tagx, valx, and dx point to, respectively.
--
-- If some of the pointers tagx, valx, or dx is NULL, the corresponding
-- value is not stored.
--
-- The status code has the following meaning:
--
-- 'B' - basic variable;
-- 'L' - non-basic variable on its lower bound;
-- 'U' - non-basic variable on its upper bound;
-- 'F' - non-basic free (unbounded) variable;
-- 'S' - non-basic fixed variable.
--
-- Should note that if the routine glp_get_bstat reports that the basis
-- is undefined, the status code is not applicable. Analogously, if the
-- routine glp_get_status reports that the solution is undefined, primal
-- and dual values are meaningless. */

void glp_get_row_soln(LPI *lp, int i, int *tagx, double *valx,
      double *dx)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_get_row_soln: i = %d; invalid row number", i);
      if (tagx != NULL) *tagx = lp->row[i]->tagx;
      if (valx != NULL) *valx = lp->row[i]->valx;
      if (dx != NULL) *dx = lp->row[i]->dx;
      return;
}

/*----------------------------------------------------------------------
-- glp_get_status - determine solution status.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_get_status(LPI *lp);
--
-- *Returns*
--
-- The routine glp_get_status returns one of the following codes that
-- shows current status of the problem solution:
--
-- GLP_UNDEF   - solution is undefined;
-- GLP_OPT     - solution is optimal;
-- GLP_FEAS    - solution is feasible;
-- GLP_INFEAS  - solution is infeasible;
-- GLP_NOFEAS  - problem has no feasible solution;
-- GLP_UNBND   - problem has unbounded solution;
-- GLP_INTOPT  - solution is integer optimal;
-- GLP_INTSOL  - solution is integer feasible;
-- GLP_DISINT  - solution is integer infeasible;
-- GLP_NOINT   - problem has no integer solution. */

int glp_get_status(LPI *lp)
{     return lp->status;
}

/*----------------------------------------------------------------------
-- glp_new_aij - create new constraint coefficient.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_new_aij(LPI *lp, int i, int j, double aij);
--
-- *Description*
--
-- The routine glp_new_aij creates new constraint coefficient that is
-- placed in the i-th row and the j-th column of the constraint matrix
-- and has the value aij.
--
-- Note that multiplets, i.e. elements with identical row and column
-- indices, are not allowed. However, the routine check for multiplets
-- only if the data consistency checking flag is on.
--
-- *Complexity*
--
-- If the data consistency checking flag is off, the time complexity is
-- O(1). Otherwise, the time complexity is O(nz'), where nz' is number
-- of existing non-zero elements in the j-th column. */

void glp_new_aij(LPI *lp, int i, int j, double aij)
{     ELEM *e;
      if (!(1 <= i && i <= lp->m))
         fault("glp_new_elem: i = %d; invalid row number", i);
      if (!(1 <= j && j <= lp->n))
         fault("glp_new_elem: j = %d; invalid column number", j);
      if (lp->check)
      {  for (e = lp->col[j]->ptr; e != NULL; e = e->col)
         {  if (e->i == i)
               fault("glp_new_elem: i = %d, j = %d; duplicate element",
                  i, j);
         }
      }
      e = get_atom(lp->elem_pool);
      e->i = i;
      e->j = j;
      e->val = aij;
      e->row = lp->row[i]->ptr, lp->row[i]->ptr = e;
      e->col = lp->col[j]->ptr, lp->col[j]->ptr = e;
      return;
}

/*----------------------------------------------------------------------
-- glp_new_col - create new column.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_new_col(LPI *lp, char *name);
--
-- *Description*
--
-- The routine glp_new_col creates a new column and adds it to the end
-- of the column list (thus, sequential number of the existing columns
-- remain unchanged). Initially the new column is empty, corresponds to
-- a continuous non-negative variable, and has zero coefficient in the
-- objective function.
--
-- The parameter name specifies a symbolic name, which is assigned to
-- the new column. If this parameter is NULL, no name is assigned.
--
-- *Complexity*
--
-- If the parameter name is not NULL, the time complexity is O(log n'),
-- where n' is number of named columns in the column list. Otherwise,
-- the time complexity is O(1). */

void glp_new_col(LPI *lp, char *name)
{     LPICOL *col;
      /* create new column */
      col = get_atom(lp->col_pool);
      col->seqn = lp->n+1;
      col->name = NULL;
      col->kind = 'C';
      col->type = 'L';
      col->lb = 0.0;
      col->ub = 0.0;
      col->fctr = 1.0;
      col->ptr = NULL;
      col->coef = 0.0;
      col->tagx = 'L';
      col->valx = 0.0;
      col->dx = 0.0;
      /* add new column to the end of the column list */
      if (lp->n == lp->n_max)
      {  /* enlarge the column list */
         LPICOL **temp;
         int j;
         lp->n_max += lp->n_max;
         temp = ucalloc(1+lp->n_max, sizeof(LPICOL *));
         for (j = 1; j <= lp->n; j++) temp[j] = lp->col[j];
         ufree(lp->col);
         lp->col = temp;
      }
      lp->n++;
      lp->col[lp->n] = col;
      /* assign column name */
      if (name != NULL)
      {  AVLNODE *node;
         if (glp_check_name(name))
            fault("glp_new_col: invalid column name");
         lp->col[lp->n]->name = create_str(lp->str_pool);
         set_str(lp->col[lp->n]->name, name);
         if (find_by_key(lp->col_tree, lp->col[lp->n]->name) != NULL)
            fault("glp_new_col: duplicate column name `%s'", name);
         node = insert_by_key(lp->col_tree, lp->col[lp->n]->name);
         node->link = lp->col[lp->n];
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_new_row - create new row.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_new_row(LPI *lp, char *name);
--
-- *Description*
--
-- The routine glp_new_row creates a new row and adds it to the end of
-- the row list (thus, sequential numbers of existing rows remain
-- unchanged). Initially the created row is empty and corresponds to an
-- equality constraint with zero right-hand side.
--
-- The parameter name specifies a symbolic name, which is assigned to
-- the new row. If this parameter is NULL, no name is assigned.
--
-- *Complexity*
--
-- If the parameter name is not NULL, the time complexity is O(log m'),
-- where m' is number of named rows in the row list. Otherwise, the time
-- complexity is O(1). */

void glp_new_row(LPI *lp, char *name)
{     LPIROW *row;
      /* create new row */
      row = get_atom(lp->row_pool);
      row->seqn = lp->m+1;
      row->name = NULL;
      row->type = 'S';
      row->lb = 0.0;
      row->ub = 0.0;
      row->fctr = 1.0;
      row->ptr = NULL;
      row->tagx = 'B';
      row->valx = 0.0;
      row->dx = 0.0;
      /* add new row to the end of the row list */
      if (lp->m == lp->m_max)
      {  /* enlarge the row list */
         LPIROW **temp;
         int i;
         lp->m_max += lp->m_max;
         temp = ucalloc(1+lp->m_max, sizeof(LPIROW *));
         for (i = 1; i <= lp->m; i++) temp[i] = lp->row[i];
         ufree(lp->row);
         lp->row = temp;
      }
      lp->m++;
      lp->row[lp->m] = row;
      /* assign row name */
      if (name != NULL)
      {  AVLNODE *node;
         if (glp_check_name(name))
            fault("glp_new_row: invalid row name");
         lp->row[lp->m]->name = create_str(lp->str_pool);
         set_str(lp->row[lp->m]->name, name);
         if (find_by_key(lp->row_tree, lp->row[lp->m]->name) != NULL)
            fault("glp_new_row: duplicate row name `%s'", name);
         node = insert_by_key(lp->row_tree, lp->row[lp->m]->name);
         node->link = lp->row[lp->m];
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_print_soln - write problem solution using printable format.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_print_soln(LPI *lp, char *fname);
--
-- *Description*
--
-- The routine glp_print_soln writes the problem solution associated
-- with the problem instance lp to the text file fname.
--
-- Information reported by the routine corresponds to the final simplex
-- table found by the solver. This information is intended mainly for
-- the visual analysis and has the meaning only if the problem has been
-- successfully solved.
--
-- *Returns*
--
-- The routine glp_print_soln returns one of the following codes:
--
-- 0 - no errors;
-- 1 - the operation failed because of errors. All diagnostics was sent
--     to stderr. */

int glp_print_soln(LPI *lp, char *fname)
{     FILE *fp;
      int what;
      print("glp_print_soln: writing problem solution to `%s'...",
         fname);
      fp = fopen(fname, "w");
      if (fp == NULL)
      {  error("glp_print_soln: can't create `%s' - %s", fname,
            strerror(errno));
         goto fail;
      }
      /* problem name */
      {  char *name;
         name = glp_get_prob_name(lp);
         if (name == NULL) name = "";
         fprintf(fp, "%-12s%s\n", "Problem:", name);
      }
      /* number of rows (auxiliary variables) */
      {  int nr;
         nr = glp_get_num_rows(lp);
         fprintf(fp, "%-12s%d\n", "Rows:", nr);
      }
      /* number of columns (structural variables) */
      {  int nc, nc_int, nc_bin;
         nc = glp_get_num_cols(lp);
         nc_int = glp_get_num_int(lp);
         nc_bin = glp_get_num_bin(lp);
         fprintf(fp, "%-12s%d", "Columns:", nc);
         if (nc_int)
            fprintf(fp, " (%d integer, %d binary)", nc_int, nc_bin);
         fprintf(fp, "\n");
      }
      /* number of non-zeros (constraint coefficients) */
      {  int nz;
         nz = glp_get_num_nz(lp);
         fprintf(fp, "%-12s%d\n", "Non-zeros:", nz);
      }
      /* problem status */
      {  int status;
         status = glp_get_status(lp);
         fprintf(fp, "%-12s%s\n", "Status:",
            status == GLP_UNDEF  ? "UNDEFINED" :
            status == GLP_OPT    ? "OPTIMAL" :
            status == GLP_FEAS   ? "FEASIBLE" :
            status == GLP_INFEAS ? "INFEASIBLE (INTERMEDIATE)" :
            status == GLP_NOFEAS ? "INFEASIBLE (FINAL)" :
            status == GLP_UNBND  ? "UNBOUNDED" :
            status == GLP_INTOPT ? "INTEGER OPTIMAL" :
            status == GLP_INTSOL ? "INTEGER FEASIBLE" :
            status == GLP_DISINT ? "INTEGER INFEASIBLE (INTERMEDIATE)" :
            status == GLP_NOINT  ? "INTEGER INFEASIBLE (FINAL)" : "???")
            ;
      }
      /* objective function */
      {  int dir;
         double val;
         val = glp_get_obj_val(lp);
         dir = glp_get_obj_sense(lp);
         fprintf(fp, "%-12s%.6g %s\n", "Objective:", val,
            dir == '-'  ? "(MINimization)" :
            dir == '+'  ? "(MAXimization)" : "(???)");
      }
      /* main sheet */
      for (what = 1; what <= 2; what++)
      {  int mn, ij;
         fprintf(fp, "\n");
         fprintf(fp, "  No. %-12s   St   Activity     Lower bound   Upp"
            "er bound    Marginal\n",
            what == 1 ? "  Row name" : "Column name");
         fprintf(fp, "----- ------------   -- ------------- -----------"
            "-- ------------- -------------\n");
         mn = (what == 1 ? glp_get_num_rows(lp) : glp_get_num_cols(lp));
         for (ij = 1; ij <= mn; ij++)
         {  char *name;
            int kind, type, tagx;
            double lb, ub, valx, dx;
            if (what == 1)
            {  name = glp_get_row_name(lp, ij);
               if (name == NULL) name = "";
               kind = 0;
               glp_get_row_bnds(lp, ij, &type, &lb, &ub);
               glp_get_row_soln(lp, ij, &tagx, &valx, &dx);
            }
            else
            {  name = glp_get_col_name(lp, ij);
               if (name == NULL) name = "";
               kind = (glp_get_col_kind(lp, ij) == 'C' ? 0 : 1);
               glp_get_col_bnds(lp, ij, &type, &lb, &ub);
               glp_get_col_soln(lp, ij, &tagx, &valx, &dx);
            }
            /* row/column sequential number */
            fprintf(fp, "%5d ", ij);
            /* row column/name */
            if (strlen(name) <= 12)
               fprintf(fp, "%-12s ", name);
            else
               fprintf(fp, "%s\n%19s", name, "");
            /* row/column kind */
            fprintf(fp, "%s ", kind ? "*" : " ");
            /* row/column status */
            if (tagx == 'B')
            {  if (type == 'L' && valx < lb ||
                   type == 'D' && valx < lb ||
                   type == 'S' && valx < lb)
                  fprintf(fp, "B- ");
               else if (type == 'U' && valx > ub ||
                        type == 'D' && valx > ub ||
                        type == 'S' && valx > ub)
                  fprintf(fp, "B+ ");
               else if (kind && valx != floor(valx + 0.5))
                  fprintf(fp, "B* ");
               else
                  fprintf(fp, "B  ");
            }
            else if (tagx == 'L')
               fprintf(fp, "NL ");
            else if (tagx == 'U')
               fprintf(fp, "NU ");
            else if (tagx == 'F')
               fprintf(fp, "NF ");
            else if (tagx == 'S')
               fprintf(fp, "NS ");
            else
               fprintf(fp, "??");
            /* row/column primal activity */
            fprintf(fp, "%13.6g ", valx);
            /* row/column lower bound */
            if (type == 'L' || type == 'D' || type == 'S')
               fprintf(fp, "%13.6g ", lb);
            else
               fprintf(fp, "%13s ", "");
            /* row/column upper bound */
            if (type == 'U' || type == 'D')
               fprintf(fp, "%13.6g ", ub);
            else if (type == 'S')
               fprintf(fp, "%13s ", "=");
            else
               fprintf(fp, "%13s ", "");
            /* row/column dual activity */
            if (tagx != 'B')
            {  if (dx == 0.0)
                  fprintf(fp, "%13s", "< eps");
               else
                  fprintf(fp, "%13.6g", dx);
            }
            fprintf(fp, "\n");
         }
      }
      fprintf(fp, "\n");
      fprintf(fp, "End of output\n");
      fflush(fp);
      if (ferror(fp))
      {  error("glp_print_soln: can't write to `%s' - %s", fname,
            strerror(errno));
         goto fail;
      }
      fclose(fp);
      return 0;
fail: if (fp != NULL) fclose(fp);
      return 1;
}

/*----------------------------------------------------------------------
-- glp_put_col_soln - store column solution information.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_put_col_soln(LPI *lp, int j, int tagx, double valx,
--    double dx);
--
-- *Description*
--
-- The routine glp_put_col_soln stores solution information for the
-- j-th column (structural variable) to the problem object.
--
-- The parameters tagx, valx, and dx specify status, primal value, and
-- dual value of the j-th structural variable, respectively.
--
-- This routine is intended for using by the solver. */

void glp_put_col_soln(LPI *lp, int j, int tagx, double valx, double dx)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_put_col_soln: j = %d; invalid column number", j);
      if (!(tagx == 'B' || tagx == 'L' || tagx == 'U' || tagx == 'F' ||
            tagx == 'S'))
         fault("glp_put_col_soln: tagx = %d; invalid column status",
            tagx);
      lp->col[j]->tagx = tagx;
      lp->col[j]->valx = valx;
      lp->col[j]->dx = dx;
      return;
}

/*----------------------------------------------------------------------
-- glp_put_row_soln - store row solution information.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_put_row_soln(LPI *lp, int i, int tagx, double valx,
--    double dx);
--
-- *Description*
--
-- The routine glp_put_row_soln stores solution information for the
-- i-th row (auxiliary variable) to the problem object.
--
-- The parameters tagx, valx, and dx specify status, primal value, and
-- dual value of the i-th auxiliary variable, respectively.
--
-- This routine is intended for using by the solver. */

void glp_put_row_soln(LPI *lp, int i, int tagx, double valx, double dx)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_put_row_soln: i = %d; invalid row number", i);
      if (!(tagx == 'B' || tagx == 'L' || tagx == 'U' || tagx == 'F' ||
            tagx == 'S'))
         fault("glp_put_row_soln: tagx = %d; invalid row status", tagx);
      lp->row[i]->tagx = tagx;
      lp->row[i]->valx = valx;
      lp->row[i]->dx = dx;
      return;
}

/*----------------------------------------------------------------------
-- glp_put_soln_info - store main solution information.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_put_soln_info(LPI *lp, int bstat, int status, double objv);
--
-- *Description*
--
-- The routine glp_put_soln_info stores main solution information to the
-- problem object.
--
-- The parameters bstat, status, and objv specify basis status, solution
-- status, and value of the objective function, respectively.
--
-- This routine is intended for using by the solver. */

void glp_put_soln_info(LPI *lp, int bstat, int status, double objv)
{     if (!(bstat == '?' || bstat == 'N' || bstat == 'P' ||
            bstat == 'D' || bstat == 'O'))
         fault("glp_put_soln_info: bstat = %d; invalid basis status",
            bstat);
      if (!(status == GLP_UNDEF || status == GLP_OPT ||
            status == GLP_FEAS || status == GLP_INFEAS ||
            status == GLP_NOFEAS || status == GLP_UNBND ||
            status == GLP_INTOPT || status == GLP_INTSOL ||
            status == GLP_DISINT || status == GLP_NOINT))
         fault("glp_put_soln_info: status = %d; invalid solution status"
            , status);
      lp->basis = bstat;
      lp->status = status;
      lp->objval = objv;
      return;
}

/*----------------------------------------------------------------------
-- glp_read_lpm1 - read linear programming model written in GLPK/L.
--
-- *Synopsis*
--
-- #include "glpk.h:
-- LPI *glp_read_lpm1(char *infile, char *outfile);
--
-- *Description*
--
-- The glp_read_lpm1 routine reads an LP model written in the modeling
-- language GLPK/L from a text file whose name is infile.
--
-- If the parameter outfile is not NULL, the routine writes generated
-- LP/MIP problem to a text file whose name is outfile.
--
-- For detailed description of GLPK/L modeling language see the program
-- documentation.
--
-- *Returns*
--
-- If the operation was successful, the routine returns a pointer to the
-- created problem object. Otherwise the routine returns NULL. */

LPI *glp_read_lpm1(char *infile, char *outfile)
{     LPI *lp = NULL;
      struct prob *prob = NULL;
      int m, n, i, j;
      /* initialize the language processor environment */
      if (initialize(infile) != 0) goto fail;
      /* set error handling */
      pdb->flag = 1;
      if (setjmp(pdb->jump)) goto fail;
      /* parse model description */
      load_model();
      /* output generated LP/MIP problem to the specified file in plain
         text format (if required) */
      if (outfile != NULL)
      {  int ret;
         ret = gener_lp(outfile);
         if (ret != 0) goto fail;
      }
      /* create data structure for generating LP/MIP */
      prob = create_prob();
      m = prob->m;
      n = prob->n;
      /* create problem instance */
      lp = glp_create_prob(pdb->model_name);
      /* create columns that correspond model variables */
      for (j = 1; j <= n; j++)
      {  VAR *var = prob->memb[m+j]->link;
         char *name = gener_name(prob, m+j);
         glp_new_col(lp, name);
         if (var->kind) glp_set_col_kind(lp, j, 'I');
         glp_set_col_bnds(lp, j, var->type, var->lb, var->ub);
      }
      /* create rows that correspond model constraints; build the
         constraint matrix */
      for (i = 1; i <= m; i++)
      {  CONS *cons = prob->memb[i]->link;
         char *name = gener_name(prob, i);
         struct elem *form, *e;
         glp_new_row(lp, name);
         form = build_form(prob, i);
         if (form == NULL) goto fail;
         for (e = form; e != NULL; e = e->next)
         {  if (e->j == 0)
            {  if (cons->type == 'F')
               {  error("glp_read_lpm1: free row `%s' has constant term"
                     , name);
                  goto fail;
               }
               cons->lb -= e->val, cons->ub -= e->val;
            }
            else
               glp_new_aij(lp, i, e->j, e->val);
            /* set coefficient of the objective function */
            if (prob->obj_row == i)
               glp_set_obj_coef(lp, e->j, e->val);
         }
         erase_form(prob, form);
         glp_set_row_bnds(lp, i, cons->type, cons->lb, cons->ub);
      }
      /* set the objective function */
      glp_set_obj_sense(lp, prob->obj_dir);
      /* free auxiliary data structure */
      delete_prob(prob);
      /* terminate the language processor environment */
      terminate();
      /* model has been read successfully */
      return lp;
fail: /* the operation failed */
      error("glp_read_lpm1: processing terminated due to errors");
      if (lp != NULL) glp_delete_prob(lp);
      if (prob != NULL) delete_prob(prob);
      if (pdb != NULL) terminate();
      return NULL;
}

/*----------------------------------------------------------------------
-- glp_read_mps1 - read problem data using MPS format.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- LPI *glp_read_mps1(char *fname);
--
-- *Description*
--
-- The routine glp_read_mps1 reads LP problem data using MPS format from
-- a text file whose name is fname.
--
-- *Returns*
--
-- If the operation was successful, the routine returns a pointer to the
-- created problem object. Otherwise the routine returns NULL. */

LPI *glp_read_mps1(char *fname)
{     LPI *lp = NULL;
      MPS *mps;
      int m, n, obj, i, j;
      /* read MPS data block */
      mps = load_mps(fname);
      if (mps == NULL) goto fail;
      m = mps->n_row;
      n = mps->n_col;
      obj = 0;
      /* create problem object */
      lp = glp_create_prob(mps->name);
      /* process ROW section */
      for (i = 1; i <= m; i++)
      {  MPSROW *row;
         int type;
         row = mps->row[i];
         glp_new_row(lp, row->name);
         if (strcmp(row->type, "N") == 0)
         {  type = 'F';
            if (obj == 0) obj = i;
         }
         else if (strcmp(row->type, "L") == 0)
            type = 'U';
         else if (strcmp(row->type, "G") == 0)
            type = 'L';
         else if (strcmp(row->type, "E") == 0)
            type = 'S';
         else
         {  error("glp_read_mps1: row `%s' has unknown type `%s'",
               row->name, row->type);
            goto fail;
         }
         glp_set_row_bnds(lp, i, type, 0.0, 0.0);
      }
      if (obj == 0)
      {  error("glp_read_mps1: objective row not found");
         goto fail;
      }
      /* process COLUMN section */
      for (j = 1; j <= n; j++)
      {  MPSCOL *col;
         MPSCQE *cqe;
         col = mps->col[j];
         glp_new_col(lp, col->name);
         glp_set_col_kind(lp, j, col->flag ? 'I' : 'C');
         for (cqe = col->ptr; cqe != NULL; cqe = cqe->next)
         {  glp_new_aij(lp, cqe->ind, j, cqe->val);
            if (cqe->ind == obj) glp_set_obj_coef(lp, j, cqe->val);
         }
      }
      /* process RHS section */
      if (mps->n_rhs > 0)
      {  MPSCQE *cqe;
         for (cqe = mps->rhs[1]->ptr; cqe != NULL; cqe = cqe->next)
         {  int type;
            double lb, ub;
            glp_get_row_bnds(lp, cqe->ind, &type, NULL, NULL);
            switch (type)
            {  case 'F':
                  /* if the current row is the objective function row,
                     specified right-hand side is considered as the
                     constant term of the objective function with
                     opposite sign; in other cases specified right-hand
                     side is ignored */
                  if (cqe->ind == obj)
                     glp_set_obj_coef(lp, 0, -cqe->val);
                  lb = ub = 0.0;
                  break;
               case 'L':
                  lb = cqe->val, ub = 0.0;
                  break;
               case 'U':
                  lb = 0.0, ub = cqe->val;
                  break;
               case 'S':
                  lb = ub = cqe->val;
                  break;
               default:
                  insist(type != type);
            }
            glp_set_row_bnds(lp, cqe->ind, type, lb, ub);
         }
      }
      /* process RANGES section */
      if (mps->n_rng > 0)
      {  MPSCQE *cqe;
         for (cqe = mps->rng[1]->ptr; cqe != NULL; cqe = cqe->next)
         {  int type;
            double lb, ub;
            glp_get_row_bnds(lp, cqe->ind, &type, &lb, &ub);
            switch (type)
            {  case 'F':
                  error("glp_read_mps1: range vector entry refers to ro"
                     "w `%s' of N type", mps->row[cqe->ind]->name);
                  goto fail;
               case 'L':
                  ub = lb + fabs(cqe->val);
                  break;
               case 'U':
                  lb = ub - fabs(cqe->val);
                  break;
               case 'S':
                  if (cqe->val >= 0.0)
                     ub += fabs(cqe->val);
                  else
                     lb -= fabs(cqe->val);
                  break;
               default:
                  insist(type != type);
            }
            glp_set_row_bnds(lp, cqe->ind, lb == ub ? 'S' : 'D', lb, ub)
               ;
         }
      }
      /* process BOUNDS section */
      if (mps->n_bnd > 0)
      {  MPSBQE *bqe;
         for (bqe = mps->bnd[1]->ptr; bqe != NULL; bqe = bqe->next)
         {  int type;
            double lb, ub;
            glp_get_col_bnds(lp, bqe->ind, &type, &lb, &ub);
            if (type == 'F' || type == 'U') lb = -DBL_MAX;
            if (type == 'F' || type == 'L') ub = +DBL_MAX;
            if (strcmp(bqe->type, "LO") == 0)
               lb = bqe->val;
            else if (strcmp(bqe->type, "UP") == 0)
               ub = bqe->val;
            else if (strcmp(bqe->type, "FX") == 0)
               lb = ub = bqe->val;
            else if (strcmp(bqe->type, "FR") == 0)
               lb = -DBL_MAX, ub = +DBL_MAX;
            else if (strcmp(bqe->type, "MI") == 0)
               lb = -DBL_MAX;
            else if (strcmp(bqe->type, "PL") == 0)
               ub = +DBL_MAX;
            else if (strcmp(bqe->type, "UI") == 0)
            {  /* integer structural variable with upper bound */
               glp_set_col_kind(lp, bqe->ind, 'I');
               ub = bqe->val;
            }
            else if (strcmp(bqe->type, "BV") == 0)
            {  /* binary structural variable */
               glp_set_col_kind(lp, bqe->ind, 'I');
               lb = 0.0, ub = 1.0;
            }
            else
            {  error("glp_read_mps1: bound vector entry for column `%s'"
                  " has unknown type `%s'",
                  mps->col[bqe->ind]->name, bqe->type);
               goto fail;
            }
            if (lb == -DBL_MAX && ub == +DBL_MAX)
               type = 'F';
            else if (ub == +DBL_MAX)
               type = 'L';
            else if (lb == -DBL_MAX)
               type = 'U';
            else if (lb != ub)
               type = 'D';
            else
               type = 'S';
            glp_set_col_bnds(lp, bqe->ind, type, lb, ub);
         }
      }
      /* free MPS data block */
      free_mps(mps);
      /* return to the application program */
      return lp;
fail: /* the operation failed */
      if (lp != NULL) glp_delete_prob(lp);
      if (mps != NULL) free_mps(mps);
      return NULL;
}

/*----------------------------------------------------------------------
-- glp_scale_prob - scale problem.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_scale_prob(LPI *lp, int how);
--
-- *Description*
--
-- The routine glp_scale_prob performs scaling the problem instance
-- depending on the parameter how:
--
-- 0 - equilibration scaling;
-- 1 - geometric mean scaling;
-- 2 - geometric mean scaling, then equilibration scaling.
--
-- In order to scale the problem the routine uses current coefficients
-- of the constrint matrix.
--
-- A result of this operation are row and column scale factors that are
-- stored by the routine into the problem object. */

void glp_scale_prob(LPI *lp, int how)
{     MAT *A;
      int m, n, i, j;
      double *R, *S;
      /* determine dimension of the constraint matrix */
      m = glp_get_num_rows(lp);
      if (m == 0) fault("glp_scale_prob: problem has no rows");
      n = glp_get_num_cols(lp);
      if (n == 0) fault("glp_scale_prob: problem has no columns");
      /* obtain the constraint matrix */
      A = create_mat(m, n);
      {  int *cn = ucalloc(1+n, sizeof(int));
         double *ai = ucalloc(1+n, sizeof(double));
         for (i = 1; i <= m; i++)
         {  int nz = glp_get_row_coef(lp, i, cn, ai);
            for (j = 1; j <= nz; j++)
               new_elem(A, i, cn[j], ai[j]);
         }
         ufree(cn);
         ufree(ai);
      }
      /* compute scaling matrices */
      R = ucalloc(1+m, sizeof(double));
      S = ucalloc(1+n, sizeof(double));
      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(A, R, S, 0);
            break;
         case 1:
            /* geometric mean scaling */
            gm_scaling(A, R, S, 0, 0.01, 20);
            break;
         case 2:
            /* geometric mean scaling, then equilibration scaling */
            gm_scaling(A, R, S, 0, 0.01, 20);
            eq_scaling(A, R, S, 0);
            break;
         default:
            fault("glp_scale_prob: how = %d; invalid parameter", how);
      }
      /* store scale factors into the problem object */
      for (i = 1; i <= m; i++) glp_set_row_fctr(lp, i, R[i]);
      for (j = 1; j <= n; j++) glp_set_col_fctr(lp, j, S[j]);
      /* free working arrays and return */
      delete_mat(A);
      ufree(R);
      ufree(S);
      return;
}

/*----------------------------------------------------------------------
-- glp_set_col_bnds - set column bounds.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_col_bnds(LPI *lp, int j, int type, double lb,
--    double ub);
--
-- *Description*
--
-- The routine glp_set_col_bnds sets (changes) type and bounds of the
-- j-th column.
--
-- Parameters type, lb, and ub specify respectively the type, the lower
-- bound, and the upper bound, which should be set for the j-th column:
--
--    Type        Bounds            Note
--    ----------------------------------------
--    'F'   -inf <  x <  +inf   free variable
--    'L'     lb <= x <  +inf   lower bound
--    'U'   -inf <  x <=  ub    upper bound
--    'D'     lb <= x <=  ub    double bound
--    'S'           x  =  lb    fixed variable
--
-- where x is the corresponding structural variable.
--
-- If the column has no lower bound, the parameter lb is ignored. If
-- the column has no upper bound, the parameter ub is ignored. If the
-- column is of fixed type, the parameter lb is used, and the parameter
-- ub is ignored. */

void glp_set_col_bnds(LPI *lp, int j, int type, double lb, double ub)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_set_col_bnds: j = %d; invalid column number", j);
      lp->col[j]->type = type;
      switch (type)
      {  case 'F':
            lp->col[j]->lb = lp->col[j]->ub = 0.0;
            break;
         case 'L':
            lp->col[j]->lb = lb, lp->col[j]->ub = 0.0;
            break;
         case 'U':
            lp->col[j]->lb = 0.0, lp->col[j]->ub = ub;
            break;
         case 'D':
            lp->col[j]->lb = lb, lp->col[j]->ub = ub;
            break;
         case 'S':
            lp->col[j]->lb = lp->col[j]->ub = lb;
            break;
         default:
            fault("glp_set_col_bnds: type = %d; invalid column type",
               type);
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_set_col_fctr - set column scale factor.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_col_fctr(LPI *lp, int j, double fctr);
--
-- *Description*
--
-- The routine glp_set_col_fctr sets (changes) scale factor of the j-th
-- column specified by the parameter fctr (should be positive).
--
-- Column scale factor is an optional quantity, which may be used by the
-- solver in order to scale the problem. */

void glp_set_col_fctr(LPI *lp, int j, double fctr)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_set_col_fctr: j = %d; invalid column number", j);
      if (fctr <= 0.0)
         fault("glp_set_col_fctr: fctr = %g; invalid scale factor",
            fctr);
      lp->col[j]->fctr = fctr;
      return;
}

/*----------------------------------------------------------------------
-- glp_set_col_kind - set column kind.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_col_kind(LPI *lp, int j, int kind);
--
-- *Description*
--
-- The routine glp_set_col_kind sets (changes) kind of the structural
-- variable that corresponds to the j-th column of the problem:
--
-- 'C' - continuous variable;
-- 'I' - integer variable. */

void glp_set_col_kind(LPI *lp, int j, int kind)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_set_col_kind: j = %d; invalid column number", j);
      if (!(kind == 'C' || kind == 'I'))
         fault("glp_set_col_kind: kind = %d; invalid column kind",
            kind);
      lp->col[j]->kind = kind;
      return;
}

/*----------------------------------------------------------------------
-- glp_set_col_name - assign (change) column name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_col_name(LPI *lp, int j, char *name);
--
-- *Description*
--
-- The routine glp_set_col_name assigns the given symbolic name to the
-- j-th column (structural variable).
--
-- If the parameter name is NULL, the routine just erases an existing
-- name of the j-th column.
--
-- *Complexity*
--
-- Time complexity is O(log n'), where n' is number of named columns in
-- the problem object. */

void glp_set_col_name(LPI *lp, int j, char *name)
{     if (!(1 <= j && j <= lp->n))
         fault("glp_set_col_name: j = %d; invalid column number", j);
      /* erase existing name */
      if (lp->col[j]->name != NULL)
      {  AVLNODE *node;
         node = find_by_key(lp->col_tree, lp->col[j]->name);
         insist(node != NULL);
         delete_node(lp->col_tree, node);
         delete_str(lp->col[j]->name), lp->col[j]->name = NULL;
      }
      /* assign new name */
      if (name != NULL)
      {  AVLNODE *node;
         if (glp_check_name(name))
            fault("glp_set_col_name: invalid column name");
         lp->col[j]->name = create_str(lp->str_pool);
         set_str(lp->col[j]->name, name);
         if (find_by_key(lp->col_tree, lp->col[j]->name) != NULL)
            fault("glp_set_col_name: duplicate column name `%s'", name);
         node = insert_by_key(lp->col_tree, lp->col[j]->name);
         node->link = lp->col[j];
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_set_obj_coef - set objective function coefficient.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_obj_coef(LPI *lp, int j, double coef);
--
-- *Description*
--
-- The routine glp_set_obj_coef sets (changes) a coefficient of the
-- objective function at the j-th structural variable.
--
-- If the parameter j is zero, the routine sets (changes) the constant
-- term of the objective function. */

void glp_set_obj_coef(LPI *lp, int j, double coef)
{     if (!(0 <= j && j <= lp->n))
         fault("glp_set_obj_coef: j = %d; invalid column number", j);
      if (j == 0)
         lp->c0 = coef;
      else
         lp->col[j]->coef = coef;
      return;
}

/*----------------------------------------------------------------------
-- glp_set_obj_sense - set objective function sense.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_obj_sense(LPI *lp, int sense);
--
-- *Description*
--
-- The routine glp_set_obj_sense sets (changes) the sense (optimization
-- direction) of the objective function:
--
-- '-' - problem is minimization;
-- '+' - problem is maximization. */

void glp_set_obj_sense(LPI *lp, int sense)
{     if (!(sense == '-' || sense == '+'))
         fault("glp_set_obj_sense: sense = %d; invalid sense", sense);
      lp->sense = sense;
      return;
}

/*----------------------------------------------------------------------
-- glp_set_prob_name - assign problem name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_prob_name(LPI *lp, char *name);
--
-- *Description*
--
-- The routine glp_set_prob_name assigns the given symbolic name to the
-- problem.
--
-- If the parameter name is NULL, the routine erases the existing name
-- of the problem. */

void glp_set_prob_name(LPI *lp, char *name)
{     /* erase existing name */
      if (lp->name != NULL)
         delete_str(lp->name), lp->name = NULL;
      /* assign new name */
      if (name != NULL)
      {  if (glp_check_name(name))
            fault("glp_set_prob_name: invalid problem name");
         lp->name = create_str(lp->str_pool);
         set_str(lp->name, name);
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_set_row_bnds - set row bounds.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_row_bnds(LPI *lp, int i, int type, double lb,
--    double ub);
--
-- *Description*
--
-- The routine glp_set_row_bnds sets (changes) type and bounds of the
-- i-th row.
--
-- Parameters type, lb, and ub specify respectively the type, the lower
-- bound, and the upper bound, which should be set for the i-th row:
--
--    Type        Bounds            Note
--    ----------------------------------------
--    'F'   -inf <  x <  +inf   free variable
--    'L'     lb <= x <  +inf   lower bound
--    'U'   -inf <  x <=  ub    upper bound
--    'D'     lb <= x <=  ub    double bound
--    'S'           x  =  lb    fixed variable
--
-- where x is the corresponding auxiliary variable.
--
-- If the row has no lower bound, the parameter lb is ignored. If the
-- row has no upper bound, the parameter ub is ignored. If the row is
-- of fixed type, the parameter lb is used, and the parameter ub is
-- ignored. */

void glp_set_row_bnds(LPI *lp, int i, int type, double lb, double ub)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_set_row_bnds: i = %d; invalid row number", i);
      lp->row[i]->type = type;
      switch (type)
      {  case 'F':
            lp->row[i]->lb = lp->row[i]->ub = 0.0;
            break;
         case 'L':
            lp->row[i]->lb = lb, lp->row[i]->ub = 0.0;
            break;
         case 'U':
            lp->row[i]->lb = 0.0, lp->row[i]->ub = ub;
            break;
         case 'D':
            lp->row[i]->lb = lb, lp->row[i]->ub = ub;
            break;
         case 'S':
            lp->row[i]->lb = lp->row[i]->ub = lb;
            break;
         default:
            fault("glp_set_row_bnds: type = %d; invalid row type",
               type);
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_set_row_fctr - set row scale factor.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_row_fctr(LPI *lp, int i, double fctr);
--
-- *Description*
--
-- The routine glp_set_row_fctr sets (changes) scale factor of the i-th
-- row specified by the parameter fctr (should be positive).
--
-- Row scale factor is an optional quantity, which may be used by the
-- solver in order to scale the problem. */

void glp_set_row_fctr(LPI *lp, int i, double fctr)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_set_row_fctr: i = %d; invalid row number", i);
      if (fctr <= 0.0)
         fault("glp_set_row_fctr: fctr = %g; invalid scale factor",
            fctr);
      lp->row[i]->fctr = fctr;
      return;
}

/*----------------------------------------------------------------------
-- glp_set_row_name - assign (change) row name.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void glp_set_row_name(LPI *lp, int i, char *name);
--
-- *Description*
--
-- The routine glp_set_row_name assigns the given symbolic name to the
-- i-th row (auxiliary variable).
--
-- If the parameter name is NULL, the routine just erases an existing
-- name of the i-th row.
--
-- *Complexity*
--
-- Time complexity is O(log m'), where m' is number of named rows in the
-- problem object. */

void glp_set_row_name(LPI *lp, int i, char *name)
{     if (!(1 <= i && i <= lp->m))
         fault("glp_set_row_name: i = %d; invalid row number", i);
      /* erase existing name */
      if (lp->row[i]->name != NULL)
      {  AVLNODE *node;
         node = find_by_key(lp->row_tree, lp->row[i]->name);
         insist(node != NULL);
         delete_node(lp->row_tree, node);
         delete_str(lp->row[i]->name), lp->row[i]->name = NULL;
      }
      /* assign new name */
      if (name != NULL)
      {  AVLNODE *node;
         if (glp_check_name(name))
            fault("glp_set_row_name: invalid row name");
         lp->row[i]->name = create_str(lp->str_pool);
         set_str(lp->row[i]->name, name);
         if (find_by_key(lp->row_tree, lp->row[i]->name) != NULL)
            fault("glp_set_row_name: duplicate row name `%s'", name);
         node = insert_by_key(lp->row_tree, lp->row[i]->name);
         node->link = lp->row[i];
      }
      return;
}

/*----------------------------------------------------------------------
-- glp_to_lpx - convert LP problem instance to low-level object.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- void *glp_to_lpx(LPI *lpi, int all);
--
-- *Description*
--
-- The routine glp_to_lpx converts the LP problem instance, which the
-- parameter lpi points to, to an low-level LP problem object.
--
-- If the flag all is set, the routine also copies all symbolic names
-- to the low-level object. Otherwise no symbolic names are copied.
--
-- *Returns*
--
-- The routine glp_to_lpx returns a pointer to the created low-level
-- object. */

void *glp_to_lpx(LPI *lpi, int all)
{     LPX *lpx;
      int m = glp_get_num_rows(lpi);
      int n = glp_get_num_cols(lpi);
      int i, j, k, typx, tagx, len, *rn;
      double lb, ub, *aj;
      /* create low-level LP problem object */
      lpx = lpx_create_prob();
      lpx_add_rows(lpx, m);
      lpx_add_cols(lpx, n);
      /* copy symbolic names (if req'd) */
      if (all)
      {  lpx_set_prob_name(lpx, glp_get_prob_name(lpi));
         for (i = 1; i <= m; i++)
            lpx_set_row_name(lpx, i, glp_get_row_name(lpi, i));
         for (j = 1; j <= n; j++)
            lpx_set_col_name(lpx, j, glp_get_col_name(lpi, j));
      }
      /* copy row scale factors */
      for (i = 1; i <= m; i++)
      {  lpx->rs[i] = glp_get_row_fctr(lpi, i);
         insist(lpx->rs[i] > 0.0);
      }
      /* copy column scale factors */
      for (j = 1; j <= n; j++)
      {  lpx->rs[m+j] = glp_get_col_fctr(lpi, j);
         insist(lpx->rs[m+j] > 0.0);
      }
      /* copy row bounds */
      for (i = 1; i <= m; i++)
      {  glp_get_row_bnds(lpi, 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);
      }
      /* copy column bounds */
      for (j = 1; j <= n; j++)
      {  glp_get_col_bnds(lpi, 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);
      }
      /* copy the objective function */
      switch (glp_get_obj_sense(lpi))
      {  case '-':
            lpx_set_obj_dir(lpx, LPX_MIN);
            break;
         case '+':
            lpx_set_obj_dir(lpx, LPX_MAX);
            break;
         default:
            insist(lpi != lpi);
      }
      lpx_set_obj_c0(lpx, glp_get_obj_coef(lpi, 0));
      for (j = 1; j <= n; j++)
         lpx_set_col_coef(lpx, j, glp_get_obj_coef(lpi, j));
      /* copy the constraint matrix */
      rn = ucalloc(1+m, sizeof(int));
      aj = ucalloc(1+m, sizeof(double));
      for (j = 1; j <= n; j++)
      {  len = glp_get_col_coef(lpi, j, rn, aj);
         /* remove zero coefficients */
         k = 1;
         while (k <= len)
         {  if (aj[k] == 0.0)
            {  rn[k] = rn[len];
               aj[k] = aj[len];
               len--;
            }
            else
               k++;
         }
         lpx_set_mat_col(lpx, j, len, rn, aj);
      }
      ufree(rn);
      ufree(aj);
      /* copy the basis information */
      for (k = 1; k <= m+n; k++)
      {  if (k <= m)
            glp_get_row_soln(lpi, k, &tagx, NULL, NULL);
         else
            glp_get_col_soln(lpi, 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);
            }
         }
      }
      return lpx;
}

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

void glp_init_wmps(struct wmps *parm)
{     parm->prob_info = 1;
      parm->make_obj = 2;
      parm->use_names = 1;
      parm->one_entry = 0;
      parm->pedantic = 0;
      parm->skip_empty = 0;
      return;
}

/*----------------------------------------------------------------------
-- glp_write_mps - write problem data using MPS format.
--
-- *Synopsis*
--
-- #include "glpk.h"
-- int glp_write_mps(LPI *lp, char *fname, struct wmps *parm);
--
-- *Description*
--
-- The routine glp_write_mps() writes LP problem data using MPS format
-- to the output text file whose name is the character string parm.
--
-- The parameter parm is a pointer to the parameter block used by the
-- routine. On entry this block should be initialized using the routine
-- glp_init_wmps(). It is allowed to specify NULL, in which case default
-- values are used.
--
-- Description of MPS format can be found in the document "GLPK User's
-- Guide".
--
-- *Returns*
--
-- 0 - no errors;
-- 1 - invalid control parameters;
-- 2 - operation failed due to errors.
--
-- In case of non-zero return code the routine sends all diagnostics to
-- stderr. */

typedef char mps_name[8+1];
/* standard MPS names (contain 1 up to 8 characters) */

static char *plain_name(int what, int ij);
/* generate plain row/column name */

static void make_names(LPI *lp, int what, mps_name alias[]);
/* generate standard MPS names using original names */

static char *mps_number(double val);
/* convert number to standard 12-character MPS format */

int glp_write_mps(LPI *lp, char *fname, struct wmps *parm)
{     struct wmps _parm;
      FILE *fp;
      mps_name *row_name = NULL, *col_name = NULL;
      int marker = 0; /* intorg/intend marker count */
      int nrows, ncols, make_obj, i, j, flag, *rn;
      double *aj;
      /* if parameter block is not specified, create the dummy one */
      if (parm == NULL)
      {  parm = &_parm;
         glp_init_wmps(parm);
      }
      /* check control parameters for correctness */
      if (!(parm->prob_info == 0 || parm->prob_info == 1))
      {  error("glp_write_mps: prob_info = %d; invalid parameter",
            parm->prob_info);
         return 1;
      }
      if (!(0 <= parm->make_obj && parm->make_obj <= 2))
      {  error("glp_write_mps: make_obj = %d; invalid parameter",
            parm->make_obj);
         return 1;
      }
      if (!(parm->use_names == 0 || parm->use_names == 1))
      {  error("glp_write_mps: use_names = %d; invalid parameter",
            parm->use_names);
         return 1;
      }
      if (!(parm->one_entry == 0 || parm->one_entry == 1))
      {  error("glp_write_mps: one_entry = %d; invalid parameter",
            parm->one_entry);
         return 1;
      }
      if (!(parm->pedantic == 0 || parm->pedantic == 1))
      {  error("glp_write_mps: pedantic = %d; invalid parameter",
            parm->pedantic);
         return 1;
      }
      if (!(parm->skip_empty == 0 || parm->skip_empty == 1))
      {  error("glp_write_mps: prob_info = %d; invalid parameter",
            parm->skip_empty);
         return 1;
      }
      /* control parameters are correct */
      print("glp_write_mps: writing problem data to `%s'...", fname);
      /* open the output text file */
      fp = fopen(fname, "w");
      if (fp == NULL)
      {  error("glp_write_mps: can't create `%s' - %s", fname,
            strerror(errno));
         goto fail;
      }
      /* determine number of rows and number of columns */
      nrows = glp_get_num_rows(lp);
      ncols = glp_get_num_cols(lp);
      /* the problem should contain at least one row and one column */
      if (nrows == 0)
      {  error("glp_write_mps: problem has no rows");
         goto fail;
      }
      if (ncols == 0)
      {  error("glp_write_mps: problem has no columns");
         goto fail;
      }
      /* determine whether the routine should output objective function
         row */
      make_obj = parm->make_obj;
      if (make_obj == 2)
      {  for (i = 1; i <= nrows; i++)
         {  int type;
            glp_get_row_bnds(lp, i, &type, NULL, NULL);
            if (type == 'F')
            {  make_obj = 0;
               break;
            }
         }
      }
      /* allocate arrays for 8-character row and column names */
      row_name = ucalloc(1+nrows, sizeof(mps_name));
      col_name = ucalloc(1+ncols, sizeof(mps_name));
      /* generate 8-character name for the objective function row */
      strcpy(row_name[0], plain_name('R', 0));
      /* generate 8-character names for rows and columns */
      if (parm->use_names)
      {  /* use original row and column names as templates */
         make_names(lp, 'R', row_name);
         make_names(lp, 'C', col_name);
      }
      else
      {  /* generate plain names based on sequential numbers */
         for (i = 1; i <= nrows; i++)
            strcpy(row_name[i], plain_name('R', i));
         for (j = 1; j <= ncols; j++)
            strcpy(col_name[j], plain_name('C', j));
      }
      /* write comments cards (if required) */
      if (parm->prob_info)
      {  char *name = glp_get_prob_name(lp);
         int ni = glp_get_num_int(lp);
         int nb = glp_get_num_bin(lp);
         int nz = glp_get_num_nz(lp);
         if (name == NULL) name = "UNKNOWN";
         fprintf(fp, "* Problem:    %.31s\n", name);
         fprintf(fp, "* Rows:       %d\n", nrows);
         if (glp_get_num_int(lp) == 0)
         fprintf(fp, "* Columns:    %d\n", ncols);
         else
         fprintf(fp, "* Columns:    %d (%d integer, %d binary)\n",
            ncols, ni, nb);
         if (make_obj)
         {  for (j = 1; j <= ncols; j++)
               if (glp_get_obj_coef(lp, j) != 0.0) nz++;
         }
         fprintf(fp, "* Non-zeros:  %d\n", nz);
         fprintf(fp, "*\n");
      }
      /* write NAME indicator card */
      {  char *name = glp_get_prob_name(lp);
         if (name == NULL)
            fprintf(fp, "NAME");
         else
            fprintf(fp, "NAME          %.8s\n", name);
      }
      /* write ROWS section */
      fprintf(fp, "ROWS\n");
      if (make_obj)
         fprintf(fp, " %c  %s\n", 'N', row_name[0]);
      for (i = 1; i <= nrows; i++)
      {  int type;
         glp_get_row_bnds(lp, i, &type, NULL, NULL);
         switch (type)
         {  case 'F': type = 'N'; break;
            case 'L': type = 'G'; break;
            case 'U': type = 'L'; break;
            case 'D': type = 'E'; break;
            case 'S': type = 'E'; break;
            default: insist(type != type);
         }
         fprintf(fp, " %c  %s\n", type, row_name[i]);
      }
      /* write COLUMNS section */
      fprintf(fp, "COLUMNS\n");
      rn = ucalloc(1+nrows, sizeof(int));
      aj = ucalloc(1+nrows, sizeof(double));
      for (j = 1; j <= ncols; j++)
      {  int nl = 1, kind, nz, t;
         char *name;
         name = col_name[j];
         kind = glp_get_col_kind(lp, j);
         insist(kind == 'C' || kind == 'I');
         if (kind == 'I' && marker % 2 == 0)
         {  /* open new intorg/intend group */
            marker++;
            fprintf(fp, "    MARK%04d  'MARKER'                 'INTORG"
               "'\n" , marker);
         }
         else if (kind == 'C' && marker % 2 == 1)
         {  /* close the current intorg/intend group */
            marker++;
            fprintf(fp, "    MARK%04d  'MARKER'                 'INTEND"
               "'\n" , marker);
         }
         /* obtain j-th column of the constraint matrix */
         nz = glp_get_col_coef(lp, j, rn, aj);
         rn[0] = 0;
         aj[0] = (make_obj ? glp_get_obj_coef(lp, j) : 0.0);
         if (nz == 0 && aj[0] == 0.0 && !parm->skip_empty)
            fprintf(fp, "    %-8s  %-8s  %12s   $ empty column\n",
               name, row_name[1], mps_number(0.0));
         for (t = aj[0] != 0.0 ? 0 : 1; t <= nz; t++)
         {  if (nl)
               fprintf(fp, "    %-8s  ", name);
            else
               fprintf(fp, "   ");
            fprintf(fp, "%-8s  %12s",
               row_name[rn[t]], mps_number(aj[t]));
            if (!parm->one_entry) nl = 1 - nl;
            if (nl) fprintf(fp, "\n");
            if (!parm->pedantic) name = "";
         }
         if (!nl) fprintf(fp, "\n");
      }
      if (marker % 2 == 1)
      {  /* close the last intorg/intend group (if not closed) */
         marker++;
         fprintf(fp, "    MARK%04d  'MARKER'                 'INTEND'\n"
            , marker);
      }
      ufree(rn);
      ufree(aj);
      /* write RHS section */
      flag = 0;
      {  int nl = 1;
         char *name = (parm->pedantic ? "RHS1" : "");
         for (i = make_obj ? 0 : 1; i <= nrows; i++)
         {  int type;
            double lb, ub, rhs;
            if (i == 0)
               type = 'F', lb = ub = 0.0;
            else
               glp_get_row_bnds(lp, i, &type, &lb, &ub);
            switch (type)
            {  case 'F':
                  /* if the current row is the objective function row,
                     right-hand side is set to the constant term of the
                     objective function with opposite sign; in other
                     cases right-hand side is not used */
                  rhs = (i == 0 ? - glp_get_obj_coef(lp, 0) : 0.0);
                  break;
               case 'L':
                  rhs = lb; break;
               case 'U':
                  rhs = ub; break;
               case 'D':
                  rhs = (ub > 0.0 ? lb : ub); break;
               case 'S':
                  rhs = lb; break;
               default:
                  insist(type != type);
            }
            if (rhs == 0.0) continue;
            if (!flag) fprintf(fp, "RHS\n"), flag = 1;
            if (nl)
                fprintf(fp, "    %-8s  ", name);
            else
                fprintf(fp, "   ");
            fprintf(fp, "%-8s  %12s", row_name[i], mps_number(rhs));
            if (!parm->one_entry) nl = 1 - nl;
            if (nl) fprintf(fp, "\n");
         }
         if (!nl) fprintf(fp, "\n");
      }
      /* write RANGES section */
      flag = 0;
      {  int nl = 1;
         char *name = (parm->pedantic ? "RNG1" : "");
         for (i = 1; i <= nrows; i++)
         {  int type;
            double lb, ub, rng;
            glp_get_row_bnds(lp, i, &type, &lb, &ub);
            if (type != 'D') continue;
            if (!flag) fprintf(fp, "RANGES\n"), flag = 1;
            if (nl)
                fprintf(fp, "    %-8s  ", name);
            else
                fprintf(fp, "   ");
            rng = (ub > 0.0 ? ub - lb : lb - ub);
            fprintf(fp, "%-8s  %12s", row_name[i], mps_number(rng));
            if (!parm->one_entry) nl = 1 - nl;
            if (nl) fprintf(fp, "\n");
         }
         if (!nl) fprintf(fp, "\n");
      }
      /* write BOUNDS section */
      flag = 0;
      {  char *name = (parm->pedantic ? "BND1" : "");
         for (j = 1; j <= ncols; j++)
         {  int type;
            double lb, ub;
            glp_get_col_bnds(lp, j, &type, &lb, &ub);
            if (type == 'L' && lb == 0.0) continue;
            if (!flag) fprintf(fp, "BOUNDS\n"), flag = 1;
            switch (type)
            {  case 'F':
                  fprintf(fp, " FR %-8s  %-8s\n", name, col_name[j]);
                  break;
               case 'L':
                  fprintf(fp, " LO %-8s  %-8s  %12s\n", name,
                     col_name[j], mps_number(lb));
                  break;
               case 'U':
                  fprintf(fp, " MI %-8s  %-8s\n", name, col_name[j]);
                  fprintf(fp, " UP %-8s  %-8s  %12s\n", name,
                     col_name[j], mps_number(ub));
                  break;
               case 'D':
                  if (lb != 0.0)
                  fprintf(fp, " LO %-8s  %-8s  %12s\n", name,
                     col_name[j], mps_number(lb));
                  fprintf(fp, " UP %-8s  %-8s  %12s\n", name,
                     col_name[j], mps_number(ub));
                  break;
               case 'S':
                  fprintf(fp, " FX %-8s  %-8s  %12s\n", name,
                     col_name[j], mps_number(lb));
                  break;
               default:
                  insist(type != type);
            }
         }
      }
      /* write ENDATA indicator card */
      fprintf(fp, "ENDATA\n");
      /* free working arrays */
      ufree(row_name), row_name = NULL;
      ufree(col_name), col_name = NULL;
      /* close the output text file */
      fflush(fp);
      if (ferror(fp))
      {  error("glp_write_mps: can't write to `%s' - %s", fname,
            strerror(errno));
         goto fail;
      }
      fclose(fp);
      /* returns to the calling program */
      return 0;
fail: /* the operation failed */
      if (row_name != NULL) ufree(row_name);
      if (col_name != NULL) ufree(col_name);
      if (fp != NULL) fclose(fp);
      return 2;
}

/*----------------------------------------------------------------------
-- plain_name - generate plain row/column name.
--
-- This routine returns a pointer to a static buffer that contains name
-- of i-th row (if what = 'R') or of j-th column (if what == 'C'). */

static char *plain_name(int what, int ij)
{     static mps_name name;
      char *t;
      sprintf(name, "%c%7d", what, ij);
      for (t = name; *t; t++) if (*t == ' ') *t = '_';
      return name;
}

/*----------------------------------------------------------------------
-- make_names - generate standard MPS names using original names.
--
-- This routine tries to make names of rows (if what = 'R') or columns
-- (if what = 'C'), whose length doesn't exceed 8 chars, using original
-- row and column names as templates. The result names are placed in
-- alias[1], ..., alias[n], where n is the number of rows/columns. */

static void make_names(LPI *lp, int what, mps_name alias[])
{     AVLTREE *tree;
      int mn, ij;
      tree = create_avl((int (*)(void *, void *))strcmp);
      switch (what)
      {  case 'R':
            mn = glp_get_num_rows(lp); break;
         case 'C':
            mn = glp_get_num_cols(lp); break;
         default:
            insist(what != what);
      }
      for (ij = 1; ij <= mn; ij++)
      {  char *name;
         int len;
         if (what == 'R')
         {  name = glp_get_row_name(lp, ij);
            if (name == NULL) name = plain_name('R', ij);
         }
         else
         {  name = glp_get_col_name(lp, ij);
            if (name == NULL) name = plain_name('C', ij);
         }
         if (name[0] == '$') goto alas;
         len = strlen(name);
         if (len <= 8)
         {  strcpy(alias[ij], name);
            if (find_by_key(tree, alias[ij]) == NULL) goto fini;
            goto alas;
         }
         /* the first try: abc~wxyz */
         memcpy(alias[ij]+0, name+0, 3);
         memcpy(alias[ij]+3, "~", 1);
         memcpy(alias[ij]+4, name+(len-4), 4);
         if (find_by_key(tree, alias[ij]) == NULL) goto fini;
         /* the second try: abcd~xyz */
         memcpy(alias[ij]+0, name+0, 4);
         memcpy(alias[ij]+4, "~", 1);
         memcpy(alias[ij]+5, name+(len-3), 3);
         if (find_by_key(tree, alias[ij]) == NULL) goto fini;
         /* the third try: abcde~yz */
         memcpy(alias[ij]+0, name+0, 5);
         memcpy(alias[ij]+4, "~", 1);
         memcpy(alias[ij]+6, name+(len-2), 2);
         if (find_by_key(tree, alias[ij]) == NULL) goto fini;
         /* the fourth try: abcdef~z */
         memcpy(alias[ij]+0, name+0, 6);
         memcpy(alias[ij]+4, "~", 1);
         memcpy(alias[ij]+7, name+(len-1), 1);
         if (find_by_key(tree, alias[ij]) == NULL) goto fini;
alas:    /* hmm... nothing came of it :+( */
         strcpy(alias[ij], plain_name(what, ij));
         insist(find_by_key(tree, alias[ij]) == NULL);
fini:    /* enter the generated name to the symbol table */
         insist(strlen(alias[ij]) <= 8);
         insert_by_key(tree, alias[ij]);
      }
      delete_avl(tree);
      return;
}

/*----------------------------------------------------------------------
-- mps_number - convert number to standard 12-character MPS format.
--
-- This routine converts the given floating point value val to the
-- standard 12-character MPS format. It tries to provide maximal number
-- of significan digits. */

static char *mps_number(double val)
{     static char numb[255+1];
      int n;
      char *e;
      for (n = 12; n >= 6; n--)
      {  if (val != 0.0 && fabs(val) < 0.002)
            sprintf(numb, "%.*E", n, val);
         else
            sprintf(numb, "%.*G", n, val);
         insist(strlen(numb) <= 255);
         e = strrchr(numb, 'E');
         if (e != NULL) sprintf(e+1, "%d", atoi(e+1));
         if (strlen(numb) <= 12) return numb;
      }
      fault("glp_write_mps: can't convert floating point number '%g' to"
         " character string", val);
      return NULL; /* to relax compiler */
}

/* eof */
