glpmpl04.c

著名的大规模线性规划求解器源码GLPK.C语言版本,可以修剪.内有详细帮助文档.

/* glpmpl04.c */

/***********************************************************************
*  This code is part of GLPK (GNU Linear Programming Kit).
*
*  Copyright (C) 2000,01,02,03,04,05,06,07,08,2009 Andrew Makhorin,
*  Department for Applied Informatics, Moscow Aviation Institute,
*  Moscow, Russia. All rights reserved. E-mail: <[e-mail]>.
*
*  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 = fopen(file, "r");
      if (mpl->in_fp == NULL)
         error(mpl, "unable to open %s - %s", file, strerror(errno));
      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 = fgetc(mpl->in_fp);
      if (ferror(mpl->in_fp))
         error(mpl, "read error on %s - %s", mpl->in_file,
            strerror(errno));
      if (feof(mpl->in_fp)) 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);
      fclose(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 = stdout;
      }
      else
      {  mpl->out_fp = fopen(file, "w");
         if (mpl->out_fp == NULL)
            error(mpl, "unable to create %s - %s", file,
               strerror(errno));
      }
      mpl->out_file = xmalloc(strlen(file)+1);
      strcpy(mpl->out_file, file);
      mpl->out_buf = xmalloc(OUTBUF_SIZE);
      mpl->out_cnt = 0;
      return;
}