/* glpmpl04.c */

/***********************************************************************

*  This code is part of GLPK (GNU Linear Programming Kit).

*

*  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,

*  2009, 2010 Andrew Makhorin, Department for Applied Informatics,

*  Moscow Aviation Institute, Moscow, Russia. All rights reserved.

*  E-mail: <mao@gnu.org>.

*

*  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 3 of the License, 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. If not, see <http://www.gnu.org/licenses/>.

***********************************************************************/

#define _GLPSTD_ERRNO

#define _GLPSTD_STDIO

#include "glpmpl.h"

#define xfault xerror

#define dmp_create_poolx(size) dmp_create_pool()

/**********************************************************************/

/* * *              GENERATING AND POSTSOLVING MODEL              * * */

/**********************************************************************/

/*----------------------------------------------------------------------

-- alloc_content - allocate content arrays for all model objects.

--

-- This routine allocates content arrays for all existing model objects

-- and thereby finalizes creating model.

--

-- This routine must be called immediately after reading model section,

-- i.e. before reading data section or generating model. */

void alloc_content(MPL *mpl)

{     STATEMENT *stmt;

      /* walk through all model statements */

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  switch (stmt->type)

         {  case A_SET:

               /* model set */

               xassert(stmt->u.set->array == NULL);

               stmt->u.set->array = create_array(mpl, A_ELEMSET,

                  stmt->u.set->dim);

               break;

            case A_PARAMETER:

               /* model parameter */

               xassert(stmt->u.par->array == NULL);

               switch (stmt->u.par->type)

               {  case A_NUMERIC:

                  case A_INTEGER:

                  case A_BINARY:

                     stmt->u.par->array = create_array(mpl, A_NUMERIC,

                        stmt->u.par->dim);

                     break;

                  case A_SYMBOLIC:

                     stmt->u.par->array = create_array(mpl, A_SYMBOLIC,

                        stmt->u.par->dim);

                     break;

                  default:

                     xassert(stmt != stmt);

               }

               break;

            case A_VARIABLE:

               /* model variable */

               xassert(stmt->u.var->array == NULL);

               stmt->u.var->array = create_array(mpl, A_ELEMVAR,

                  stmt->u.var->dim);

               break;

            case A_CONSTRAINT:

               /* model constraint/objective */

               xassert(stmt->u.con->array == NULL);

               stmt->u.con->array = create_array(mpl, A_ELEMCON,

                  stmt->u.con->dim);

               break;

#if 1 /* 11/II-2008 */

            case A_TABLE:

#endif

            case A_SOLVE:

            case A_CHECK:

            case A_DISPLAY:

            case A_PRINTF:

            case A_FOR:

               /* functional statements have no content array */

               break;

            default:

               xassert(stmt != stmt);

         }

      }

      return;

}

/*----------------------------------------------------------------------

-- generate_model - generate model.

--

-- This routine executes the model statements which precede the solve

-- statement. */

void generate_model(MPL *mpl)

{     STATEMENT *stmt;

      xassert(!mpl->flag_p);

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  execute_statement(mpl, stmt);

         if (mpl->stmt->type == A_SOLVE) break;

      }

      mpl->stmt = stmt;

      return;

}

/*----------------------------------------------------------------------

-- build_problem - build problem instance.

--

-- This routine builds lists of rows and columns for problem instance,

-- which corresponds to the generated model. */

void build_problem(MPL *mpl)

{     STATEMENT *stmt;

      MEMBER *memb;

      VARIABLE *v;

      CONSTRAINT *c;

      FORMULA *t;

      int i, j;

      xassert(mpl->m == 0);

      xassert(mpl->n == 0);

      xassert(mpl->row == NULL);

      xassert(mpl->col == NULL);

      /* check that all elemental variables has zero column numbers */

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  if (stmt->type == A_VARIABLE)

         {  v = stmt->u.var;

            for (memb = v->array->head; memb != NULL; memb = memb->next)

               xassert(memb->value.var->j == 0);

         }

      }

      /* assign row numbers to elemental constraints and objectives */

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  if (stmt->type == A_CONSTRAINT)

         {  c = stmt->u.con;

            for (memb = c->array->head; memb != NULL; memb = memb->next)

            {  xassert(memb->value.con->i == 0);

               memb->value.con->i = ++mpl->m;

               /* walk through linear form and mark elemental variables,

                  which are referenced at least once */

               for (t = memb->value.con->form; t != NULL; t = t->next)

               {  xassert(t->var != NULL);

                  t->var->memb->value.var->j = -1;

               }

            }

         }

      }

      /* assign column numbers to marked elemental variables */

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  if (stmt->type == A_VARIABLE)

         {  v = stmt->u.var;

            for (memb = v->array->head; memb != NULL; memb = memb->next)

               if (memb->value.var->j != 0) memb->value.var->j =

                  ++mpl->n;

         }

      }

      /* build list of rows */

      mpl->row = xcalloc(1+mpl->m, sizeof(ELEMCON *));

      for (i = 1; i <= mpl->m; i++) mpl->row[i] = NULL;

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  if (stmt->type == A_CONSTRAINT)

         {  c = stmt->u.con;

            for (memb = c->array->head; memb != NULL; memb = memb->next)

            {  i = memb->value.con->i;

               xassert(1 <= i && i <= mpl->m);

               xassert(mpl->row[i] == NULL);

               mpl->row[i] = memb->value.con;

            }

         }

      }

      for (i = 1; i <= mpl->m; i++) xassert(mpl->row[i] != NULL);

      /* build list of columns */

      mpl->col = xcalloc(1+mpl->n, sizeof(ELEMVAR *));

      for (j = 1; j <= mpl->n; j++) mpl->col[j] = NULL;

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

      {  if (stmt->type == A_VARIABLE)

         {  v = stmt->u.var;

            for (memb = v->array->head; memb != NULL; memb = memb->next)

            {  j = memb->value.var->j;

               if (j == 0) continue;

               xassert(1 <= j && j <= mpl->n);

               xassert(mpl->col[j] == NULL);

               mpl->col[j] = memb->value.var;

            }

         }

      }

      for (j = 1; j <= mpl->n; j++) xassert(mpl->col[j] != NULL);

      return;

}

/*----------------------------------------------------------------------

-- postsolve_model - postsolve model.

--

-- This routine executes the model statements which follow the solve

-- statement. */

void postsolve_model(MPL *mpl)

{     STATEMENT *stmt;

      xassert(!mpl->flag_p);

      mpl->flag_p = 1;

      for (stmt = mpl->stmt; stmt != NULL; stmt = stmt->next)

         execute_statement(mpl, stmt);

      mpl->stmt = NULL;

      return;

}

/*----------------------------------------------------------------------

-- clean_model - clean model content.

--

-- This routine cleans the model content that assumes deleting all stuff

-- dynamically allocated on generating/postsolving phase.

--

-- Actually cleaning model content is not needed. This function is used

-- mainly to be sure that there were no logical errors on using dynamic

-- memory pools during the generation phase.

--

-- NOTE: This routine must not be called if any errors were detected on

--       the generation phase. */

void clean_model(MPL *mpl)

{     STATEMENT *stmt;

      for (stmt = mpl->model; stmt != NULL; stmt = stmt->next)

         clean_statement(mpl, stmt);

      /* check that all atoms have been returned to their pools */

      if (dmp_in_use(mpl->strings).lo != 0)

         error(mpl, "internal logic error: %d string segment(s) were lo"

            "st", dmp_in_use(mpl->strings).lo);

      if (dmp_in_use(mpl->symbols).lo != 0)

         error(mpl, "internal logic error: %d symbol(s) were lost",

            dmp_in_use(mpl->symbols).lo);

      if (dmp_in_use(mpl->tuples).lo != 0)

         error(mpl, "internal logic error: %d n-tuple component(s) were"

            " lost", dmp_in_use(mpl->tuples).lo);

      if (dmp_in_use(mpl->arrays).lo != 0)

         error(mpl, "internal logic error: %d array(s) were lost",

            dmp_in_use(mpl->arrays).lo);

      if (dmp_in_use(mpl->members).lo != 0)

         error(mpl, "internal logic error: %d array member(s) were lost"

            , dmp_in_use(mpl->members).lo);

      if (dmp_in_use(mpl->elemvars).lo != 0)

         error(mpl, "internal logic error: %d elemental variable(s) wer"

            "e lost", dmp_in_use(mpl->elemvars).lo);

      if (dmp_in_use(mpl->formulae).lo != 0)

         error(mpl, "internal logic error: %d linear term(s) were lost",

            dmp_in_use(mpl->formulae).lo);

      if (dmp_in_use(mpl->elemcons).lo != 0)

         error(mpl, "internal logic error: %d elemental constraint(s) w"

            "ere lost", dmp_in_use(mpl->elemcons).lo);

      return;

}

/**********************************************************************/

/* * *                        INPUT/OUTPUT                        * * */

/**********************************************************************/

/*----------------------------------------------------------------------

-- open_input - open input text file.

--

-- This routine opens the input text file for scanning. */

void open_input(MPL *mpl, char *file)

{     mpl->line = 0;

      mpl->c = '\n';

      mpl->token = 0;

      mpl->imlen = 0;

      mpl->image[0] = '\0';

      mpl->value = 0.0;

      mpl->b_token = T_EOF;

      mpl->b_imlen = 0;

      mpl->b_image[0] = '\0';

      mpl->b_value = 0.0;

      mpl->f_dots = 0;

      mpl->f_scan = 0;

      mpl->f_token = 0;

      mpl->f_imlen = 0;

      mpl->f_image[0] = '\0';

      mpl->f_value = 0.0;

      memset(mpl->context, ' ', CONTEXT_SIZE);

      mpl->c_ptr = 0;

      xassert(mpl->in_fp == NULL);

      mpl->in_fp = xfopen(file, "r");

      if (mpl->in_fp == NULL)

         error(mpl, "unable to open %s - %s", file, xerrmsg());

      mpl->in_file = file;

      /* scan the very first character */

      get_char(mpl);

      /* scan the very first token */

      get_token(mpl);

      return;

}

/*----------------------------------------------------------------------

-- read_char - read next character from input text file.

--

-- This routine returns a next ASCII character read from the input text

-- file. If the end of file has been reached, EOF is returned. */

int read_char(MPL *mpl)

{     int c;

      xassert(mpl->in_fp != NULL);

      c = xfgetc(mpl->in_fp);

      if (c < 0)

      {  if (xferror(mpl->in_fp))

            error(mpl, "read error on %s - %s", mpl->in_file,

               xerrmsg());

         c = EOF;

      }

      return c;

}

/*----------------------------------------------------------------------

-- close_input - close input text file.

--

-- This routine closes the input text file. */

void close_input(MPL *mpl)

{     xassert(mpl->in_fp != NULL);

      xfclose(mpl->in_fp);

      mpl->in_fp = NULL;

      mpl->in_file = NULL;

      return;

}

/*----------------------------------------------------------------------

-- open_output - open output text file.

--

-- This routine opens the output text file for writing data produced by

-- display and printf statements. */

void open_output(MPL *mpl, char *file)

{     xassert(mpl->out_fp == NULL);

      if (file == NULL)

      {  file = "<stdout>";

         mpl->out_fp = (void *)stdout;

      }

      else

      {  mpl->out_fp = xfopen(file, "w");

         if (mpl->out_fp == NULL)

            error(mpl, "unable to create %s - %s", file, xerrmsg());

      }

      mpl->out_file = xmalloc(strlen(file)+1);

      strcpy(mpl->out_file, file);

      return;

}

/*----------------------------------------------------------------------

-- write_char - write next character to output text file.

--

-- This routine writes an ASCII character to the output text file. */

void write_char(MPL *mpl, int c)

{     xassert(mpl->out_fp != NULL);

      if (mpl->out_fp == (void *)stdout)

         xprintf("%c", c);

      else

         xfprintf(mpl->out_fp, "%c", c);

      return;

}

/*----------------------------------------------------------------------

-- write_text - format and write text to output text file.

--

-- This routine formats a text using the format control string and then

-- writes this text to the output text file. */

void write_text(MPL *mpl, char *fmt, ...)

{     va_list arg;

      char buf[OUTBUF_SIZE], *c;

      va_start(arg, fmt);

      vsprintf(buf, fmt, arg);

      xassert(strlen(buf) < sizeof(buf));

      va_end(arg);

      for (c = buf; *c != '\0'; c++) write_char(mpl, *c);

      return;

}

/*----------------------------------------------------------------------

-- flush_output - finalize writing data to output text file.

--

-- This routine finalizes writing data to the output text file. */

void flush_output(MPL *mpl)

{     xassert(mpl->out_fp != NULL);

      if (mpl->out_fp != (void *)stdout)

      {  xfflush(mpl->out_fp);

         if (xferror(mpl->out_fp))

            error(mpl, "write error on %s - %s", mpl->out_file,

               xerrmsg());

      }

      return;

}

/**********************************************************************/

/* * *                      SOLVER INTERFACE                      * * */

/**********************************************************************/

/*----------------------------------------------------------------------

-- error - print error message and terminate model processing.

--

-- This routine formats and prints an error message and then terminates

-- model processing. */

void error(MPL *mpl, char *fmt, ...)

{     va_list arg;

      char msg[4095+1];

      va_start(arg, fmt);

      vsprintf(msg, fmt, arg);

      xassert(strlen(msg) < sizeof(msg));

      va_end(arg);

      switch (mpl->phase)

      {  case 1:

         case 2:

            /* translation phase */

            xprintf("%s:%d: %s\n",

               mpl->in_file == NULL ? "(unknown)" : mpl->in_file,

               mpl->line, msg);

            print_context(mpl);

            break;

         case 3:

            /* generation/postsolve phase */

            xprintf("%s:%d: %s\n",

               mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file,

               mpl->stmt == NULL ? 0 : mpl->stmt->line, msg);

            break;

         default:

            xassert(mpl != mpl);

      }

      mpl->phase = 4;

      longjmp(mpl->jump, 1);

      /* no return */

}

/*----------------------------------------------------------------------

-- warning - print warning message and continue model processing.

--

-- This routine formats and prints a warning message and returns to the

-- calling program. */

void warning(MPL *mpl, char *fmt, ...)

{     va_list arg;

      char msg[4095+1];

      va_start(arg, fmt);

      vsprintf(msg, fmt, arg);

      xassert(strlen(msg) < sizeof(msg));

      va_end(arg);

      switch (mpl->phase)

      {  case 1:

         case 2:

            /* translation phase */

            xprintf("%s:%d: warning: %s\n",

               mpl->in_file == NULL ? "(unknown)" : mpl->in_file,

               mpl->line, msg);

            break;

         case 3:

            /* generation/postsolve phase */

            xprintf("%s:%d: warning: %s\n",

               mpl->mod_file == NULL ? "(unknown)" : mpl->mod_file,

               mpl->stmt == NULL ? 0 : mpl->stmt->line, msg);

            break;

         default:

            xassert(mpl != mpl);

      }

      return;

}

/*----------------------------------------------------------------------

-- mpl_initialize - create and initialize translator database.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- MPL *mpl_initialize(void);

--

-- *Description*

--

-- The routine mpl_initialize creates and initializes the database used

-- by the GNU MathProg translator.

--

-- *Returns*

--

-- The routine returns a pointer to the database created. */

MPL *mpl_initialize(void)

{     MPL *mpl;

      mpl = xmalloc(sizeof(MPL));

      /* scanning segment */

      mpl->line = 0;

      mpl->c = 0;

      mpl->token = 0;

      mpl->imlen = 0;

      mpl->image = xcalloc(MAX_LENGTH+1, sizeof(char));

      mpl->image[0] = '\0';

      mpl->value = 0.0;

      mpl->b_token = 0;

      mpl->b_imlen = 0;

      mpl->b_image = xcalloc(MAX_LENGTH+1, sizeof(char));

      mpl->b_image[0] = '\0';

      mpl->b_value = 0.0;

      mpl->f_dots = 0;

      mpl->f_scan = 0;

      mpl->f_token = 0;

      mpl->f_imlen = 0;

      mpl->f_image = xcalloc(MAX_LENGTH+1, sizeof(char));

      mpl->f_image[0] = '\0';

      mpl->f_value = 0.0;

      mpl->context = xcalloc(CONTEXT_SIZE, sizeof(char));

      memset(mpl->context, ' ', CONTEXT_SIZE);

      mpl->c_ptr = 0;

      mpl->flag_d = 0;

      /* translating segment */

      mpl->pool = dmp_create_poolx(0);

      mpl->tree = avl_create_tree(avl_strcmp, NULL);

      mpl->model = NULL;

      mpl->flag_x = 0;

      mpl->as_within = 0;

      mpl->as_in = 0;

      mpl->as_binary = 0;

      mpl->flag_s = 0;

      /* common segment */

      mpl->strings = dmp_create_poolx(sizeof(STRING));

      mpl->symbols = dmp_create_poolx(sizeof(SYMBOL));

      mpl->tuples = dmp_create_poolx(sizeof(TUPLE));

      mpl->arrays = dmp_create_poolx(sizeof(ARRAY));

      mpl->members = dmp_create_poolx(sizeof(MEMBER));

      mpl->elemvars = dmp_create_poolx(sizeof(ELEMVAR));

      mpl->formulae = dmp_create_poolx(sizeof(FORMULA));

      mpl->elemcons = dmp_create_poolx(sizeof(ELEMCON));

      mpl->a_list = NULL;

      mpl->sym_buf = xcalloc(255+1, sizeof(char));

      mpl->sym_buf[0] = '\0';

      mpl->tup_buf = xcalloc(255+1, sizeof(char));

      mpl->tup_buf[0] = '\0';

      /* generating/postsolving segment */

      mpl->rand = rng_create_rand();

      mpl->flag_p = 0;

      mpl->stmt = NULL;

#if 1 /* 11/II-2008 */

      mpl->dca = NULL;

#endif

      mpl->m = 0;

      mpl->n = 0;

      mpl->row = NULL;

      mpl->col = NULL;

      /* input/output segment */

      mpl->in_fp = NULL;

      mpl->in_file = NULL;

      mpl->out_fp = NULL;

      mpl->out_file = NULL;

      mpl->prt_fp = NULL;

      mpl->prt_file = NULL;

      /* solver interface segment */

      if (setjmp(mpl->jump)) xassert(mpl != mpl);

      mpl->phase = 0;

      mpl->mod_file = NULL;

      mpl->mpl_buf = xcalloc(255+1, sizeof(char));

      mpl->mpl_buf[0] = '\0';

      return mpl;

}

/*----------------------------------------------------------------------

-- mpl_read_model - read model section and optional data section.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_read_model(MPL *mpl, char *file, int skip_data);

--

-- *Description*

--

-- The routine mpl_read_model reads model section and optionally data

-- section, which may follow the model section, from the text file,

-- whose name is the character string file, performs translating model

-- statements and data blocks, and stores all the information in the

-- translator database.

--

-- The parameter skip_data is a flag. If the input file contains the

-- data section and this flag is set, the data section is not read as

-- if there were no data section and a warning message is issued. This

-- allows reading the data section from another input file.

--

-- This routine should be called once after the routine mpl_initialize

-- and before other API routines.

--

-- *Returns*

--

-- The routine mpl_read_model returns one the following codes:

--

-- 1 - translation successful. The input text file contains only model

--     section. In this case the calling program may call the routine

--     mpl_read_data to read data section from another file.

-- 2 - translation successful. The input text file contains both model

--     and data section.

-- 4 - processing failed due to some errors. In this case the calling

--     program should call the routine mpl_terminate to terminate model

--     processing. */

int mpl_read_model(MPL *mpl, char *file, int skip_data)

{     if (mpl->phase != 0)

         xfault("mpl_read_model: invalid call sequence\n");

      if (file == NULL)

         xfault("mpl_read_model: no input filename specified\n");

      /* set up error handler */

      if (setjmp(mpl->jump)) goto done;

      /* translate model section */

      mpl->phase = 1;

      xprintf("Reading model section from %s...\n", file);

      open_input(mpl, file);

      model_section(mpl);

      if (mpl->model == NULL)

         error(mpl, "empty model section not allowed");

      /* save name of the input text file containing model section for

         error diagnostics during the generation phase */

      mpl->mod_file = xcalloc(strlen(file)+1, sizeof(char));

      strcpy(mpl->mod_file, mpl->in_file);

      /* allocate content arrays for all model objects */

      alloc_content(mpl);

      /* optional data section may begin with the keyword 'data' */

      if (is_keyword(mpl, "data"))

      {  if (skip_data)

         {  warning(mpl, "data section ignored");

            goto skip;

         }

         mpl->flag_d = 1;

         get_token(mpl /* data */);

         if (mpl->token != T_SEMICOLON)

            error(mpl, "semicolon missing where expected");

         get_token(mpl /* ; */);

         /* translate data section */

         mpl->phase = 2;

         xprintf("Reading data section from %s...\n", file);

         data_section(mpl);

      }

      /* process end statement */

      end_statement(mpl);

skip: xprintf("%d line%s were read\n",

         mpl->line, mpl->line == 1 ? "" : "s");

      close_input(mpl);

done: /* return to the calling program */

      return mpl->phase;

}

/*----------------------------------------------------------------------

-- mpl_read_data - read data section.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_read_data(MPL *mpl, char *file);

--

-- *Description*

--

-- The routine mpl_read_data reads data section from the text file,

-- whose name is the character string file, performs translating data

-- blocks, and stores the data read in the translator database.

--

-- If this routine is used, it should be called once after the routine

-- mpl_read_model and if the latter returned the code 1.

--

-- *Returns*

--

-- The routine mpl_read_data returns one of the following codes:

--

-- 2 - data section has been successfully processed.

-- 4 - processing failed due to some errors. In this case the calling

--     program should call the routine mpl_terminate to terminate model

--     processing. */

int mpl_read_data(MPL *mpl, char *file)

#if 0 /* 02/X-2008 */

{     if (mpl->phase != 1)

#else

{     if (!(mpl->phase == 1 || mpl->phase == 2))

#endif

         xfault("mpl_read_data: invalid call sequence\n");

      if (file == NULL)

         xfault("mpl_read_data: no input filename specified\n");

      /* set up error handler */

      if (setjmp(mpl->jump)) goto done;

      /* process data section */

      mpl->phase = 2;

      xprintf("Reading data section from %s...\n", file);

      mpl->flag_d = 1;

      open_input(mpl, file);

      /* in this case the keyword 'data' is optional */

      if (is_literal(mpl, "data"))

      {  get_token(mpl /* data */);

         if (mpl->token != T_SEMICOLON)

            error(mpl, "semicolon missing where expected");

         get_token(mpl /* ; */);

      }

      data_section(mpl);

      /* process end statement */

      end_statement(mpl);

      xprintf("%d line%s were read\n",

         mpl->line, mpl->line == 1 ? "" : "s");

      close_input(mpl);

done: /* return to the calling program */

      return mpl->phase;

}

/*----------------------------------------------------------------------

-- mpl_generate - generate model.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_generate(MPL *mpl, char *file);

--

-- *Description*

--

-- The routine mpl_generate generates the model using its description

-- stored in the translator database. This phase means generating all

-- variables, constraints, and objectives, executing check and display

-- statements, which precede the solve statement (if it is presented),

-- and building the problem instance.

--

-- The character string file specifies the name of output text file, to

-- which output produced by display statements should be written. It is

-- allowed to specify NULL, in which case the output goes to stdout via

-- the routine print.

--

-- This routine should be called once after the routine mpl_read_model

-- or mpl_read_data and if one of the latters returned the code 2.

--

-- *Returns*

--

-- The routine mpl_generate returns one of the following codes:

--

-- 3 - model has been successfully generated. In this case the calling

--     program may call other api routines to obtain components of the

--     problem instance from the translator database.

-- 4 - processing failed due to some errors. In this case the calling

--     program should call the routine mpl_terminate to terminate model

--     processing. */

int mpl_generate(MPL *mpl, char *file)

{     if (!(mpl->phase == 1 || mpl->phase == 2))

         xfault("mpl_generate: invalid call sequence\n");

      /* set up error handler */

      if (setjmp(mpl->jump)) goto done;

      /* generate model */

      mpl->phase = 3;

      open_output(mpl, file);

      generate_model(mpl);

      flush_output(mpl);

      /* build problem instance */

      build_problem(mpl);

      /* generation phase has been finished */

      xprintf("Model has been successfully generated\n");

done: /* return to the calling program */

      return mpl->phase;

}

/*----------------------------------------------------------------------

-- mpl_get_prob_name - obtain problem (model) name.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- char *mpl_get_prob_name(MPL *mpl);

--

-- *Returns*

--

-- The routine mpl_get_prob_name returns a pointer to internal buffer,

-- which contains symbolic name of the problem (model).

--

-- *Note*

--

-- Currently MathProg has no feature to assign a symbolic name to the

-- model. Therefore the routine mpl_get_prob_name tries to construct

-- such name using the name of input text file containing model section,

-- although this is not a good idea (due to portability problems). */

char *mpl_get_prob_name(MPL *mpl)

{     char *name = mpl->mpl_buf;

      char *file = mpl->mod_file;

      int k;

      if (mpl->phase != 3)

         xfault("mpl_get_prob_name: invalid call sequence\n");

      for (;;)

      {  if (strchr(file, '/') != NULL)

            file = strchr(file, '/') + 1;

         else if (strchr(file, '\\') != NULL)

            file = strchr(file, '\\') + 1;

         else if (strchr(file, ':') != NULL)

            file = strchr(file, ':') + 1;

         else

            break;

      }

      for (k = 0; ; k++)

      {  if (k == 255) break;

         if (!(isalnum((unsigned char)*file) || *file == '_')) break;

         name[k] = *file++;

      }

      if (k == 0)

         strcpy(name, "Unknown");

      else

         name[k] = '\0';

      xassert(strlen(name) <= 255);

      return name;

}

/*----------------------------------------------------------------------

-- mpl_get_num_rows - determine number of rows.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_get_num_rows(MPL *mpl);

--

-- *Returns*

--

-- The routine mpl_get_num_rows returns total number of rows in the

-- problem, where each row is an individual constraint or objective. */

int mpl_get_num_rows(MPL *mpl)

{     if (mpl->phase != 3)

         xfault("mpl_get_num_rows: invalid call sequence\n");

      return mpl->m;

}

/*----------------------------------------------------------------------

-- mpl_get_num_cols - determine number of columns.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_get_num_cols(MPL *mpl);

--

-- *Returns*

--

-- The routine mpl_get_num_cols returns total number of columns in the

-- problem, where each column is an individual variable. */

int mpl_get_num_cols(MPL *mpl)

{     if (mpl->phase != 3)

         xfault("mpl_get_num_cols: invalid call sequence\n");

      return mpl->n;

}

/*----------------------------------------------------------------------

-- mpl_get_row_name - obtain row name.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- char *mpl_get_row_name(MPL *mpl, int i);

--

-- *Returns*

--

-- The routine mpl_get_row_name returns a pointer to internal buffer,

-- which contains symbolic name of i-th row of the problem. */

char *mpl_get_row_name(MPL *mpl, int i)

{     char *name = mpl->mpl_buf, *t;

      int len;

      if (mpl->phase != 3)

         xfault("mpl_get_row_name: invalid call sequence\n");

      if (!(1 <= i && i <= mpl->m))

         xfault("mpl_get_row_name: i = %d; row number out of range\n",

            i);

      strcpy(name, mpl->row[i]->con->name);

      len = strlen(name);

      xassert(len <= 255);

      t = format_tuple(mpl, '[', mpl->row[i]->memb->tuple);

      while (*t)

      {  if (len == 255) break;

         name[len++] = *t++;

      }

      name[len] = '\0';

      if (len == 255) strcpy(name+252, "...");

      xassert(strlen(name) <= 255);

      return name;

}

/*----------------------------------------------------------------------

-- mpl_get_row_kind - determine row kind.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_get_row_kind(MPL *mpl, int i);

--

-- *Returns*

--

-- The routine mpl_get_row_kind returns the kind of i-th row, which can

-- be one of the following:

--

-- MPL_ST  - non-free (constraint) row;

-- MPL_MIN - free (objective) row to be minimized;

-- MPL_MAX - free (objective) row to be maximized. */

int mpl_get_row_kind(MPL *mpl, int i)

{     int kind;

      if (mpl->phase != 3)

         xfault("mpl_get_row_kind: invalid call sequence\n");

      if (!(1 <= i && i <= mpl->m))

         xfault("mpl_get_row_kind: i = %d; row number out of range\n",

            i);

      switch (mpl->row[i]->con->type)

      {  case A_CONSTRAINT:

            kind = MPL_ST; break;

         case A_MINIMIZE:

            kind = MPL_MIN; break;

         case A_MAXIMIZE:

            kind = MPL_MAX; break;

         default:

            xassert(mpl != mpl);

      }

      return kind;

}

/*----------------------------------------------------------------------

-- mpl_get_row_bnds - obtain row bounds.

--

-- *Synopsis*

--

-- #include "glpmpl.h"

-- int mpl_get_row_bnds(MPL *mpl, int i, double *lb, double *ub);

--

-- *Description*

--

-- The routine mpl_get_row_bnds stores lower and upper bounds of i-th

-- row of the problem to the locations, which the parameters lb and ub

-- point to, respectively. Besides the routine returns the type of the

-- i-th row.

--

-- If some of the parameters lb and ub is NULL, the corresponding bound

-- value is not stored.

--

-- Types and bounds have the following meaning:

--

--     Type           Bounds          Note

--    -----------------------------------------------------------

--    MPL_FR   -inf <  f(x) <  +inf   Free linear form

--    MPL_LO     lb <= f(x) <  +inf   Inequality f(x) >= lb

--    MPL_UP   -inf <  f(x) <=  ub    Inequality f(x) <= ub

--    MPL_DB     lb <= f(x) <=  ub    Inequality lb <= f(x) <= ub

--    MPL_FX           f(x)  =  lb    Equality f(x) = lb

--

-- where f(x) is the corresponding linear form of the i-th row.

--

-- If the row has no lower bound, *lb is set to zero; if the row has

-- no upper bound, *ub is set to zero; and if the row is of fixed type,

-- both *lb and *ub are set to the same value.

--

-- *Returns*

--

-- The routine returns the type of the i-th row as it is stated in the

-- table above. */

int mpl_get_row_bnds(MPL *mpl, int i, double *_lb, double *_ub)

{     ELEMCON *con;

      int type;

      double lb, ub;

      if (mpl->phase != 3)

         xfault("mpl_get_row_bnds: invalid call sequence\n");

      if (!(1 <= i && i <= mpl->m))

         xfault("mpl_get_row_bnds: i = %d; row number out of range\n",

            i);

      con = mpl->row[i];

#if 0 /* 21/VII-2006 */

      if (con->con->lbnd == NULL && con->con->ubnd == NULL)

         type = MPL_FR, lb = ub = 0.0;

      else if (con->con->ubnd == NULL)

         type = MPL_LO, lb = con->lbnd, ub = 0.0;

      else if (con->con->lbnd == NULL)

         type = MPL_UP, lb = 0.0, ub = con->ubnd;

      else if (con->con->lbnd != con->con->ubnd)

         type = MPL_DB, lb = con->lbnd, ub = con->ubnd;

      else

         type = MPL_FX, lb = ub = con->lbnd;

#else

      lb = (con->con->lbnd == NULL ? -DBL_MAX : con->lbnd);

      ub = (con->con->ubnd == NULL ? +DBL_MAX : con->ubnd);

      if (lb == -DBL_MAX && ub == +DBL_MAX)

         type = MPL_FR, lb = ub = 0.0;

      else if (ub == +DBL_MAX)

         type = MPL_LO, ub = 0.0;

      else if (lb == -DBL_MAX)

         type = MPL_UP, lb = 0.0;

      else if (con->con->lbnd != con->con->ubnd)