src/glpcpx.c
author Alpar Juttner <alpar@cs.elte.hu>
Mon, 06 Dec 2010 13:09:21 +0100
changeset 1 c445c931472f
permissions -rw-r--r--
Import glpk-4.45

- Generated files and doc/notes are removed
alpar@1
     1
/* glpcpx.c (CPLEX LP format routines) */
alpar@1
     2
alpar@1
     3
/***********************************************************************
alpar@1
     4
*  This code is part of GLPK (GNU Linear Programming Kit).
alpar@1
     5
*
alpar@1
     6
*  Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
alpar@1
     7
*  2009, 2010 Andrew Makhorin, Department for Applied Informatics,
alpar@1
     8
*  Moscow Aviation Institute, Moscow, Russia. All rights reserved.
alpar@1
     9
*  E-mail: <mao@gnu.org>.
alpar@1
    10
*
alpar@1
    11
*  GLPK is free software: you can redistribute it and/or modify it
alpar@1
    12
*  under the terms of the GNU General Public License as published by
alpar@1
    13
*  the Free Software Foundation, either version 3 of the License, or
alpar@1
    14
*  (at your option) any later version.
alpar@1
    15
*
alpar@1
    16
*  GLPK is distributed in the hope that it will be useful, but WITHOUT
alpar@1
    17
*  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
alpar@1
    18
*  or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
alpar@1
    19
*  License for more details.
alpar@1
    20
*
alpar@1
    21
*  You should have received a copy of the GNU General Public License
alpar@1
    22
*  along with GLPK. If not, see <http://www.gnu.org/licenses/>.
alpar@1
    23
***********************************************************************/
alpar@1
    24
alpar@1
    25
#include "glpapi.h"
alpar@1
    26
alpar@1
    27
/***********************************************************************
alpar@1
    28
*  NAME
alpar@1
    29
*
alpar@1
    30
*  glp_init_cpxcp - initialize CPLEX LP format control parameters
alpar@1
    31
*
alpar@1
    32
*  SYNOPSIS
alpar@1
    33
*
alpar@1
    34
*  void glp_init_cpxcp(glp_cpxcp *parm):
alpar@1
    35
*
alpar@1
    36
*  The routine glp_init_cpxcp initializes control parameters used by
alpar@1
    37
*  the CPLEX LP input/output routines glp_read_lp and glp_write_lp with
alpar@1
    38
*  default values.
alpar@1
    39
*
alpar@1
    40
*  Default values of the control parameters are stored in the glp_cpxcp
alpar@1
    41
*  structure, which the parameter parm points to. */
alpar@1
    42
alpar@1
    43
void glp_init_cpxcp(glp_cpxcp *parm)
alpar@1
    44
{     xassert(parm != NULL);
alpar@1
    45
      return;
alpar@1
    46
}
alpar@1
    47
alpar@1
    48
static void check_parm(const char *func, const glp_cpxcp *parm)
alpar@1
    49
{     /* check control parameters */
alpar@1
    50
      xassert(func != NULL);
alpar@1
    51
      xassert(parm != NULL);
alpar@1
    52
      return;
alpar@1
    53
}
alpar@1
    54
alpar@1
    55
/***********************************************************************
alpar@1
    56
*  NAME
alpar@1
    57
*
alpar@1
    58
*  glp_read_lp - read problem data in CPLEX LP format
alpar@1
    59
*
alpar@1
    60
*  SYNOPSIS
alpar@1
    61
*
alpar@1
    62
*  int glp_read_lp(glp_prob *P, const glp_cpxcp *parm, const char
alpar@1
    63
*     *fname);
alpar@1
    64
*
alpar@1
    65
*  DESCRIPTION
alpar@1
    66
*
alpar@1
    67
*  The routine glp_read_lp reads problem data in CPLEX LP format from
alpar@1
    68
*  a text file.
alpar@1
    69
*
alpar@1
    70
*  The parameter parm is a pointer to the structure glp_cpxcp, which
alpar@1
    71
*  specifies control parameters used by the routine. If parm is NULL,
alpar@1
    72
*  the routine uses default settings.
alpar@1
    73
*
alpar@1
    74
*  The character string fname specifies a name of the text file to be
alpar@1
    75
*  read.
alpar@1
    76
*
alpar@1
    77
*  Note that before reading data the current content of the problem
alpar@1
    78
*  object is completely erased with the routine glp_erase_prob.
alpar@1
    79
*
alpar@1
    80
*  RETURNS
alpar@1
    81
*
alpar@1
    82
*  If the operation was successful, the routine glp_read_lp returns
alpar@1
    83
*  zero. Otherwise, it prints an error message and returns non-zero. */
alpar@1
    84
alpar@1
    85
struct csa
alpar@1
    86
{     /* common storage area */
alpar@1
    87
      glp_prob *P;
alpar@1
    88
      /* LP/MIP problem object */
alpar@1
    89
      const glp_cpxcp *parm;
alpar@1
    90
      /* pointer to control parameters */
alpar@1
    91
      const char *fname;
alpar@1
    92
      /* name of input CPLEX LP file */
alpar@1
    93
      XFILE *fp;
alpar@1
    94
      /* stream assigned to input CPLEX LP file */
alpar@1
    95
      jmp_buf jump;
alpar@1
    96
      /* label for go to in case of error */
alpar@1
    97
      int count;
alpar@1
    98
      /* line count */
alpar@1
    99
      int c;
alpar@1
   100
      /* current character or XEOF */
alpar@1
   101
      int token;
alpar@1
   102
      /* current token: */
alpar@1
   103
#define T_EOF        0x00  /* end of file */
alpar@1
   104
#define T_MINIMIZE   0x01  /* keyword 'minimize' */
alpar@1
   105
#define T_MAXIMIZE   0x02  /* keyword 'maximize' */
alpar@1
   106
#define T_SUBJECT_TO 0x03  /* keyword 'subject to' */
alpar@1
   107
#define T_BOUNDS     0x04  /* keyword 'bounds' */
alpar@1
   108
#define T_GENERAL    0x05  /* keyword 'general' */
alpar@1
   109
#define T_INTEGER    0x06  /* keyword 'integer' */
alpar@1
   110
#define T_BINARY     0x07  /* keyword 'binary' */
alpar@1
   111
#define T_END        0x08  /* keyword 'end' */
alpar@1
   112
#define T_NAME       0x09  /* symbolic name */
alpar@1
   113
#define T_NUMBER     0x0A  /* numeric constant */
alpar@1
   114
#define T_PLUS       0x0B  /* delimiter '+' */
alpar@1
   115
#define T_MINUS      0x0C  /* delimiter '-' */
alpar@1
   116
#define T_COLON      0x0D  /* delimiter ':' */
alpar@1
   117
#define T_LE         0x0E  /* delimiter '<=' */
alpar@1
   118
#define T_GE         0x0F  /* delimiter '>=' */
alpar@1
   119
#define T_EQ         0x10  /* delimiter '=' */
alpar@1
   120
      char image[255+1];
alpar@1
   121
      /* image of current token */
alpar@1
   122
      int imlen;
alpar@1
   123
      /* length of token image */
alpar@1
   124
      double value;
alpar@1
   125
      /* value of numeric constant */
alpar@1
   126
      int n_max;
alpar@1
   127
      /* length of the following five arrays (enlarged automatically,
alpar@1
   128
         if necessary) */
alpar@1
   129
      int *ind; /* int ind[1+n_max]; */
alpar@1
   130
      double *val; /* double val[1+n_max]; */
alpar@1
   131
      char *flag; /* char flag[1+n_max]; */
alpar@1
   132
      /* working arrays used to construct linear forms */
alpar@1
   133
      double *lb; /* double lb[1+n_max]; */
alpar@1
   134
      double *ub; /* double ub[1+n_max]; */
alpar@1
   135
      /* lower and upper bounds of variables (columns) */
alpar@1
   136
};
alpar@1
   137
alpar@1
   138
#define CHAR_SET "!\"#$%&()/,.;?@_`'{}|~"
alpar@1
   139
/* characters, which may appear in symbolic names */
alpar@1
   140
alpar@1
   141
static void error(struct csa *csa, const char *fmt, ...)
alpar@1
   142
{     /* print error message and terminate processing */
alpar@1
   143
      va_list arg;
alpar@1
   144
      xprintf("%s:%d: ", csa->fname, csa->count);
alpar@1
   145
      va_start(arg, fmt);
alpar@1
   146
      xvprintf(fmt, arg);
alpar@1
   147
      va_end(arg);
alpar@1
   148
      longjmp(csa->jump, 1);
alpar@1
   149
      /* no return */
alpar@1
   150
}
alpar@1
   151
alpar@1
   152
static void warning(struct csa *csa, const char *fmt, ...)
alpar@1
   153
{     /* print warning message and continue processing */
alpar@1
   154
      va_list arg;
alpar@1
   155
      xprintf("%s:%d: warning: ", csa->fname, csa->count);
alpar@1
   156
      va_start(arg, fmt);
alpar@1
   157
      xvprintf(fmt, arg);
alpar@1
   158
      va_end(arg);
alpar@1
   159
      return;
alpar@1
   160
}
alpar@1
   161
alpar@1
   162
static void read_char(struct csa *csa)
alpar@1
   163
{     /* read next character from input file */
alpar@1
   164
      int c;
alpar@1
   165
      xassert(csa->c != XEOF);
alpar@1
   166
      if (csa->c == '\n') csa->count++;
alpar@1
   167
      c = xfgetc(csa->fp);
alpar@1
   168
      if (c < 0)
alpar@1
   169
      {  if (xferror(csa->fp))
alpar@1
   170
            error(csa, "read error - %s\n", xerrmsg());
alpar@1
   171
         else if (csa->c == '\n')
alpar@1
   172
         {  csa->count--;
alpar@1
   173
            c = XEOF;
alpar@1
   174
         }
alpar@1
   175
         else
alpar@1
   176
         {  warning(csa, "missing final end of line\n");
alpar@1
   177
            c = '\n';
alpar@1
   178
         }
alpar@1
   179
      }
alpar@1
   180
      else if (c == '\n')
alpar@1
   181
         ;
alpar@1
   182
      else if (isspace(c))
alpar@1
   183
         c = ' ';
alpar@1
   184
      else if (iscntrl(c))
alpar@1
   185
         error(csa, "invalid control character 0x%02X\n", c);
alpar@1
   186
      csa->c = c;
alpar@1
   187
      return;
alpar@1
   188
}
alpar@1
   189
alpar@1
   190
static void add_char(struct csa *csa)
alpar@1
   191
{     /* append current character to current token */
alpar@1
   192
      if (csa->imlen == sizeof(csa->image)-1)
alpar@1
   193
         error(csa, "token `%.15s...' too long\n", csa->image);
alpar@1
   194
      csa->image[csa->imlen++] = (char)csa->c;
alpar@1
   195
      csa->image[csa->imlen] = '\0';
alpar@1
   196
      read_char(csa);
alpar@1
   197
      return;
alpar@1
   198
}
alpar@1
   199
alpar@1
   200
static int the_same(char *s1, char *s2)
alpar@1
   201
{     /* compare two character strings ignoring case sensitivity */
alpar@1
   202
      for (; *s1 != '\0'; s1++, s2++)
alpar@1
   203
      {  if (tolower((unsigned char)*s1) != tolower((unsigned char)*s2))
alpar@1
   204
            return 0;
alpar@1
   205
      }
alpar@1
   206
      return 1;
alpar@1
   207
}
alpar@1
   208
alpar@1
   209
static void scan_token(struct csa *csa)
alpar@1
   210
{     /* scan next token */
alpar@1
   211
      int flag;
alpar@1
   212
      csa->token = -1;
alpar@1
   213
      csa->image[0] = '\0';
alpar@1
   214
      csa->imlen = 0;
alpar@1
   215
      csa->value = 0.0;
alpar@1
   216
loop: flag = 0;
alpar@1
   217
      /* skip non-significant characters */
alpar@1
   218
      while (csa->c == ' ') read_char(csa);
alpar@1
   219
      /* recognize and scan current token */
alpar@1
   220
      if (csa->c == XEOF)
alpar@1
   221
         csa->token = T_EOF;
alpar@1
   222
      else if (csa->c == '\n')
alpar@1
   223
      {  read_char(csa);
alpar@1
   224
         /* if the next character is letter, it may begin a keyword */
alpar@1
   225
         if (isalpha(csa->c))
alpar@1
   226
         {  flag = 1;
alpar@1
   227
            goto name;
alpar@1
   228
         }
alpar@1
   229
         goto loop;
alpar@1
   230
      }
alpar@1
   231
      else if (csa->c == '\\')
alpar@1
   232
      {  /* comment; ignore everything until end-of-line */
alpar@1
   233
         while (csa->c != '\n') read_char(csa);
alpar@1
   234
         goto loop;
alpar@1
   235
      }
alpar@1
   236
      else if (isalpha(csa->c) || csa->c != '.' && strchr(CHAR_SET,
alpar@1
   237
         csa->c) != NULL)
alpar@1
   238
name: {  /* symbolic name */
alpar@1
   239
         csa->token = T_NAME;
alpar@1
   240
         while (isalnum(csa->c) || strchr(CHAR_SET, csa->c) != NULL)
alpar@1
   241
            add_char(csa);
alpar@1
   242
         if (flag)
alpar@1
   243
         {  /* check for keyword */
alpar@1
   244
            if (the_same(csa->image, "minimize"))
alpar@1
   245
               csa->token = T_MINIMIZE;
alpar@1
   246
            else if (the_same(csa->image, "minimum"))
alpar@1
   247
               csa->token = T_MINIMIZE;
alpar@1
   248
            else if (the_same(csa->image, "min"))
alpar@1
   249
               csa->token = T_MINIMIZE;
alpar@1
   250
            else if (the_same(csa->image, "maximize"))
alpar@1
   251
               csa->token = T_MAXIMIZE;
alpar@1
   252
            else if (the_same(csa->image, "maximum"))
alpar@1
   253
               csa->token = T_MAXIMIZE;
alpar@1
   254
            else if (the_same(csa->image, "max"))
alpar@1
   255
               csa->token = T_MAXIMIZE;
alpar@1
   256
            else if (the_same(csa->image, "subject"))
alpar@1
   257
            {  if (csa->c == ' ')
alpar@1
   258
               {  read_char(csa);
alpar@1
   259
                  if (tolower(csa->c) == 't')
alpar@1
   260
                  {  csa->token = T_SUBJECT_TO;
alpar@1
   261
                     csa->image[csa->imlen++] = ' ';
alpar@1
   262
                     csa->image[csa->imlen] = '\0';
alpar@1
   263
                     add_char(csa);
alpar@1
   264
                     if (tolower(csa->c) != 'o')
alpar@1
   265
                        error(csa, "keyword `subject to' incomplete\n");
alpar@1
   266
                     add_char(csa);
alpar@1
   267
                     if (isalpha(csa->c))
alpar@1
   268
                        error(csa, "keyword `%s%c...' not recognized\n",
alpar@1
   269
                           csa->image, csa->c);
alpar@1
   270
                  }
alpar@1
   271
               }
alpar@1
   272
            }
alpar@1
   273
            else if (the_same(csa->image, "such"))
alpar@1
   274
            {  if (csa->c == ' ')
alpar@1
   275
               {  read_char(csa);
alpar@1
   276
                  if (tolower(csa->c) == 't')
alpar@1
   277
                  {  csa->token = T_SUBJECT_TO;
alpar@1
   278
                     csa->image[csa->imlen++] = ' ';
alpar@1
   279
                     csa->image[csa->imlen] = '\0';
alpar@1
   280
                     add_char(csa);
alpar@1
   281
                     if (tolower(csa->c) != 'h')
alpar@1
   282
err:                    error(csa, "keyword `such that' incomplete\n");
alpar@1
   283
                     add_char(csa);
alpar@1
   284
                     if (tolower(csa->c) != 'a') goto err;
alpar@1
   285
                     add_char(csa);
alpar@1
   286
                     if (tolower(csa->c) != 't') goto err;
alpar@1
   287
                     add_char(csa);
alpar@1
   288
                     if (isalpha(csa->c))
alpar@1
   289
                        error(csa, "keyword `%s%c...' not recognized\n",
alpar@1
   290
                           csa->image, csa->c);
alpar@1
   291
                  }
alpar@1
   292
               }
alpar@1
   293
            }
alpar@1
   294
            else if (the_same(csa->image, "st"))
alpar@1
   295
               csa->token = T_SUBJECT_TO;
alpar@1
   296
            else if (the_same(csa->image, "s.t."))
alpar@1
   297
               csa->token = T_SUBJECT_TO;
alpar@1
   298
            else if (the_same(csa->image, "st."))
alpar@1
   299
               csa->token = T_SUBJECT_TO;
alpar@1
   300
            else if (the_same(csa->image, "bounds"))
alpar@1
   301
               csa->token = T_BOUNDS;
alpar@1
   302
            else if (the_same(csa->image, "bound"))
alpar@1
   303
               csa->token = T_BOUNDS;
alpar@1
   304
            else if (the_same(csa->image, "general"))
alpar@1
   305
               csa->token = T_GENERAL;
alpar@1
   306
            else if (the_same(csa->image, "generals"))
alpar@1
   307
               csa->token = T_GENERAL;
alpar@1
   308
            else if (the_same(csa->image, "gen"))
alpar@1
   309
               csa->token = T_GENERAL;
alpar@1
   310
            else if (the_same(csa->image, "integer"))
alpar@1
   311
               csa->token = T_INTEGER;
alpar@1
   312
            else if (the_same(csa->image, "integers"))
alpar@1
   313
               csa->token = T_INTEGER;
alpar@1
   314
            else if (the_same(csa->image, "int"))
alpar@1
   315
              csa->token = T_INTEGER;
alpar@1
   316
            else if (the_same(csa->image, "binary"))
alpar@1
   317
               csa->token = T_BINARY;
alpar@1
   318
            else if (the_same(csa->image, "binaries"))
alpar@1
   319
               csa->token = T_BINARY;
alpar@1
   320
            else if (the_same(csa->image, "bin"))
alpar@1
   321
               csa->token = T_BINARY;
alpar@1
   322
            else if (the_same(csa->image, "end"))
alpar@1
   323
               csa->token = T_END;
alpar@1
   324
         }
alpar@1
   325
      }
alpar@1
   326
      else if (isdigit(csa->c) || csa->c == '.')
alpar@1
   327
      {  /* numeric constant */
alpar@1
   328
         csa->token = T_NUMBER;
alpar@1
   329
         /* scan integer part */
alpar@1
   330
         while (isdigit(csa->c)) add_char(csa);
alpar@1
   331
         /* scan optional fractional part (it is mandatory, if there is
alpar@1
   332
            no integer part) */
alpar@1
   333
         if (csa->c == '.')
alpar@1
   334
         {  add_char(csa);
alpar@1
   335
            if (csa->imlen == 1 && !isdigit(csa->c))
alpar@1
   336
               error(csa, "invalid use of decimal point\n");
alpar@1
   337
            while (isdigit(csa->c)) add_char(csa);
alpar@1
   338
         }
alpar@1
   339
         /* scan optional decimal exponent */
alpar@1
   340
         if (csa->c == 'e' || csa->c == 'E')
alpar@1
   341
         {  add_char(csa);
alpar@1
   342
            if (csa->c == '+' || csa->c == '-') add_char(csa);
alpar@1
   343
            if (!isdigit(csa->c))
alpar@1
   344
               error(csa, "numeric constant `%s' incomplete\n",
alpar@1
   345
                  csa->image);
alpar@1
   346
            while (isdigit(csa->c)) add_char(csa);
alpar@1
   347
         }
alpar@1
   348
         /* convert the numeric constant to floating-point */
alpar@1
   349
         if (str2num(csa->image, &csa->value))
alpar@1
   350
            error(csa, "numeric constant `%s' out of range\n",
alpar@1
   351
               csa->image);
alpar@1
   352
      }
alpar@1
   353
      else if (csa->c == '+')
alpar@1
   354
         csa->token = T_PLUS, add_char(csa);
alpar@1
   355
      else if (csa->c == '-')
alpar@1
   356
         csa->token = T_MINUS, add_char(csa);
alpar@1
   357
      else if (csa->c == ':')
alpar@1
   358
         csa->token = T_COLON, add_char(csa);
alpar@1
   359
      else if (csa->c == '<')
alpar@1
   360
      {  csa->token = T_LE, add_char(csa);
alpar@1
   361
         if (csa->c == '=') add_char(csa);
alpar@1
   362
      }
alpar@1
   363
      else if (csa->c == '>')
alpar@1
   364
      {  csa->token = T_GE, add_char(csa);
alpar@1
   365
         if (csa->c == '=') add_char(csa);
alpar@1
   366
      }
alpar@1
   367
      else if (csa->c == '=')
alpar@1
   368
      {  csa->token = T_EQ, add_char(csa);
alpar@1
   369
         if (csa->c == '<')
alpar@1
   370
            csa->token = T_LE, add_char(csa);
alpar@1
   371
         else if (csa->c == '>')
alpar@1
   372
            csa->token = T_GE, add_char(csa);
alpar@1
   373
      }
alpar@1
   374
      else
alpar@1
   375
         error(csa, "character `%c' not recognized\n", csa->c);
alpar@1
   376
      /* skip non-significant characters */
alpar@1
   377
      while (csa->c == ' ') read_char(csa);
alpar@1
   378
      return;
alpar@1
   379
}
alpar@1
   380
alpar@1
   381
static int find_col(struct csa *csa, char *name)
alpar@1
   382
{     /* find column by its symbolic name */
alpar@1
   383
      int j;
alpar@1
   384
      j = glp_find_col(csa->P, name);
alpar@1
   385
      if (j == 0)
alpar@1
   386
      {  /* not found; create new column */
alpar@1
   387
         j = glp_add_cols(csa->P, 1);
alpar@1
   388
         glp_set_col_name(csa->P, j, name);
alpar@1
   389
         /* enlarge working arrays, if necessary */
alpar@1
   390
         if (csa->n_max < j)
alpar@1
   391
         {  int n_max = csa->n_max;
alpar@1
   392
            int *ind = csa->ind;
alpar@1
   393
            double *val = csa->val;
alpar@1
   394
            char *flag = csa->flag;
alpar@1
   395
            double *lb = csa->lb;
alpar@1
   396
            double *ub = csa->ub;
alpar@1
   397
            csa->n_max += csa->n_max;
alpar@1
   398
            csa->ind = xcalloc(1+csa->n_max, sizeof(int));
alpar@1
   399
            memcpy(&csa->ind[1], &ind[1], n_max * sizeof(int));
alpar@1
   400
            xfree(ind);
alpar@1
   401
            csa->val = xcalloc(1+csa->n_max, sizeof(double));
alpar@1
   402
            memcpy(&csa->val[1], &val[1], n_max * sizeof(double));
alpar@1
   403
            xfree(val);
alpar@1
   404
            csa->flag = xcalloc(1+csa->n_max, sizeof(char));
alpar@1
   405
            memset(&csa->flag[1], 0, csa->n_max * sizeof(char));
alpar@1
   406
            memcpy(&csa->flag[1], &flag[1], n_max * sizeof(char));
alpar@1
   407
            xfree(flag);
alpar@1
   408
            csa->lb = xcalloc(1+csa->n_max, sizeof(double));
alpar@1
   409
            memcpy(&csa->lb[1], &lb[1], n_max * sizeof(double));
alpar@1
   410
            xfree(lb);
alpar@1
   411
            csa->ub = xcalloc(1+csa->n_max, sizeof(double));
alpar@1
   412
            memcpy(&csa->ub[1], &ub[1], n_max * sizeof(double));
alpar@1
   413
            xfree(ub);
alpar@1
   414
         }
alpar@1
   415
         csa->lb[j] = +DBL_MAX, csa->ub[j] = -DBL_MAX;
alpar@1
   416
      }
alpar@1
   417
      return j;
alpar@1
   418
}
alpar@1
   419
alpar@1
   420
/***********************************************************************
alpar@1
   421
*  parse_linear_form - parse linear form
alpar@1
   422
*
alpar@1
   423
*  This routine parses the linear form using the following syntax:
alpar@1
   424
*
alpar@1
   425
*  <variable> ::= <symbolic name>
alpar@1
   426
*  <coefficient> ::= <numeric constant>
alpar@1
   427
*  <term> ::= <variable> | <numeric constant> <variable>
alpar@1
   428
*  <linear form> ::= <term> | + <term> | - <term> |
alpar@1
   429
*     <linear form> + <term> | <linear form> - <term>
alpar@1
   430
*
alpar@1
   431
*  The routine returns the number of terms in the linear form. */
alpar@1
   432
alpar@1
   433
static int parse_linear_form(struct csa *csa)
alpar@1
   434
{     int j, k, len = 0, newlen;
alpar@1
   435
      double s, coef;
alpar@1
   436
loop: /* parse an optional sign */
alpar@1
   437
      if (csa->token == T_PLUS)
alpar@1
   438
         s = +1.0, scan_token(csa);
alpar@1
   439
      else if (csa->token == T_MINUS)
alpar@1
   440
         s = -1.0, scan_token(csa);
alpar@1
   441
      else
alpar@1
   442
         s = +1.0;
alpar@1
   443
      /* parse an optional coefficient */
alpar@1
   444
      if (csa->token == T_NUMBER)
alpar@1
   445
         coef = csa->value, scan_token(csa);
alpar@1
   446
      else
alpar@1
   447
         coef = 1.0;
alpar@1
   448
      /* parse a variable name */
alpar@1
   449
      if (csa->token != T_NAME)
alpar@1
   450
         error(csa, "missing variable name\n");
alpar@1
   451
      /* find the corresponding column */
alpar@1
   452
      j = find_col(csa, csa->image);
alpar@1
   453
      /* check if the variable is already used in the linear form */
alpar@1
   454
      if (csa->flag[j])
alpar@1
   455
         error(csa, "multiple use of variable `%s' not allowed\n",
alpar@1
   456
            csa->image);
alpar@1
   457
      /* add new term to the linear form */
alpar@1
   458
      len++, csa->ind[len] = j, csa->val[len] = s * coef;
alpar@1
   459
      /* and mark that the variable is used in the linear form */
alpar@1
   460
      csa->flag[j] = 1;
alpar@1
   461
      scan_token(csa);
alpar@1
   462
      /* if the next token is a sign, there is another term */
alpar@1
   463
      if (csa->token == T_PLUS || csa->token == T_MINUS) goto loop;
alpar@1
   464
      /* clear marks of the variables used in the linear form */
alpar@1
   465
      for (k = 1; k <= len; k++) csa->flag[csa->ind[k]] = 0;
alpar@1
   466
      /* remove zero coefficients */
alpar@1
   467
      newlen = 0;
alpar@1
   468
      for (k = 1; k <= len; k++)
alpar@1
   469
      {  if (csa->val[k] != 0.0)
alpar@1
   470
         {  newlen++;
alpar@1
   471
            csa->ind[newlen] = csa->ind[k];
alpar@1
   472
            csa->val[newlen] = csa->val[k];
alpar@1
   473
         }
alpar@1
   474
      }
alpar@1
   475
      return newlen;
alpar@1
   476
}
alpar@1
   477
alpar@1
   478
/***********************************************************************
alpar@1
   479
*  parse_objective - parse objective function
alpar@1
   480
*
alpar@1
   481
*  This routine parses definition of the objective function using the
alpar@1
   482
*  following syntax:
alpar@1
   483
*
alpar@1
   484
*  <obj sense> ::= minimize | minimum | min | maximize | maximum | max
alpar@1
   485
*  <obj name> ::= <empty> | <symbolic name> :
alpar@1
   486
*  <obj function> ::= <obj sense> <obj name> <linear form> */
alpar@1
   487
alpar@1
   488
static void parse_objective(struct csa *csa)
alpar@1
   489
{     /* parse objective sense */
alpar@1
   490
      int k, len;
alpar@1
   491
      /* parse the keyword 'minimize' or 'maximize' */
alpar@1
   492
      if (csa->token == T_MINIMIZE)
alpar@1
   493
         glp_set_obj_dir(csa->P, GLP_MIN);
alpar@1
   494
      else if (csa->token == T_MAXIMIZE)
alpar@1
   495
         glp_set_obj_dir(csa->P, GLP_MAX);
alpar@1
   496
      else
alpar@1
   497
         xassert(csa != csa);
alpar@1
   498
      scan_token(csa);
alpar@1
   499
      /* parse objective name */
alpar@1
   500
      if (csa->token == T_NAME && csa->c == ':')
alpar@1
   501
      {  /* objective name is followed by a colon */
alpar@1
   502
         glp_set_obj_name(csa->P, csa->image);
alpar@1
   503
         scan_token(csa);
alpar@1
   504
         xassert(csa->token == T_COLON);
alpar@1
   505
         scan_token(csa);
alpar@1
   506
      }
alpar@1
   507
      else
alpar@1
   508
      {  /* objective name is not specified; use default */
alpar@1
   509
         glp_set_obj_name(csa->P, "obj");
alpar@1
   510
      }
alpar@1
   511
      /* parse linear form */
alpar@1
   512
      len = parse_linear_form(csa);
alpar@1
   513
      for (k = 1; k <= len; k++)
alpar@1
   514
         glp_set_obj_coef(csa->P, csa->ind[k], csa->val[k]);
alpar@1
   515
      return;
alpar@1
   516
}
alpar@1
   517
alpar@1
   518
/***********************************************************************
alpar@1
   519
*  parse_constraints - parse constraints section
alpar@1
   520
*
alpar@1
   521
*  This routine parses the constraints section using the following
alpar@1
   522
*  syntax:
alpar@1
   523
*
alpar@1
   524
*  <row name> ::= <empty> | <symbolic name> :
alpar@1
   525
*  <row sense> ::= < | <= | =< | > | >= | => | =
alpar@1
   526
*  <right-hand side> ::= <numeric constant> | + <numeric constant> |
alpar@1
   527
*     - <numeric constant>
alpar@1
   528
*  <constraint> ::= <row name> <linear form> <row sense>
alpar@1
   529
*     <right-hand side>
alpar@1
   530
*  <subject to> ::= subject to | such that | st | s.t. | st.
alpar@1
   531
*  <constraints section> ::= <subject to> <constraint> |
alpar@1
   532
*     <constraints section> <constraint> */
alpar@1
   533
alpar@1
   534
static void parse_constraints(struct csa *csa)
alpar@1
   535
{     int i, len, type;
alpar@1
   536
      double s;
alpar@1
   537
      /* parse the keyword 'subject to' */
alpar@1
   538
      xassert(csa->token == T_SUBJECT_TO);
alpar@1
   539
      scan_token(csa);
alpar@1
   540
loop: /* create new row (constraint) */
alpar@1
   541
      i = glp_add_rows(csa->P, 1);
alpar@1
   542
      /* parse row name */
alpar@1
   543
      if (csa->token == T_NAME && csa->c == ':')
alpar@1
   544
      {  /* row name is followed by a colon */
alpar@1
   545
         if (glp_find_row(csa->P, csa->image) != 0)
alpar@1
   546
            error(csa, "constraint `%s' multiply defined\n",
alpar@1
   547
               csa->image);
alpar@1
   548
         glp_set_row_name(csa->P, i, csa->image);
alpar@1
   549
         scan_token(csa);
alpar@1
   550
         xassert(csa->token == T_COLON);
alpar@1
   551
         scan_token(csa);
alpar@1
   552
      }
alpar@1
   553
      else
alpar@1
   554
      {  /* row name is not specified; use default */
alpar@1
   555
         char name[50];
alpar@1
   556
         sprintf(name, "r.%d", csa->count);
alpar@1
   557
         glp_set_row_name(csa->P, i, name);
alpar@1
   558
      }
alpar@1
   559
      /* parse linear form */
alpar@1
   560
      len = parse_linear_form(csa);
alpar@1
   561
      glp_set_mat_row(csa->P, i, len, csa->ind, csa->val);
alpar@1
   562
      /* parse constraint sense */
alpar@1
   563
      if (csa->token == T_LE)
alpar@1
   564
         type = GLP_UP, scan_token(csa);
alpar@1
   565
      else if (csa->token == T_GE)
alpar@1
   566
         type = GLP_LO, scan_token(csa);
alpar@1
   567
      else if (csa->token == T_EQ)
alpar@1
   568
         type = GLP_FX, scan_token(csa);
alpar@1
   569
      else
alpar@1
   570
         error(csa, "missing constraint sense\n");
alpar@1
   571
      /* parse right-hand side */
alpar@1
   572
      if (csa->token == T_PLUS)
alpar@1
   573
         s = +1.0, scan_token(csa);
alpar@1
   574
      else if (csa->token == T_MINUS)
alpar@1
   575
         s = -1.0, scan_token(csa);
alpar@1
   576
      else
alpar@1
   577
         s = +1.0;
alpar@1
   578
      if (csa->token != T_NUMBER)
alpar@1
   579
         error(csa, "missing right-hand side\n");
alpar@1
   580
      glp_set_row_bnds(csa->P, i, type, s * csa->value, s * csa->value);
alpar@1
   581
      /* the rest of the current line must be empty */
alpar@1
   582
      if (!(csa->c == '\n' || csa->c == XEOF))
alpar@1
   583
         error(csa, "invalid symbol(s) beyond right-hand side\n");
alpar@1
   584
      scan_token(csa);
alpar@1
   585
      /* if the next token is a sign, numeric constant, or a symbolic
alpar@1
   586
         name, here is another constraint */
alpar@1
   587
      if (csa->token == T_PLUS || csa->token == T_MINUS ||
alpar@1
   588
          csa->token == T_NUMBER || csa->token == T_NAME) goto loop;
alpar@1
   589
      return;
alpar@1
   590
}
alpar@1
   591
alpar@1
   592
static void set_lower_bound(struct csa *csa, int j, double lb)
alpar@1
   593
{     /* set lower bound of j-th variable */
alpar@1
   594
      if (csa->lb[j] != +DBL_MAX)
alpar@1
   595
      {  warning(csa, "lower bound of variable `%s' redefined\n",
alpar@1
   596
            glp_get_col_name(csa->P, j));
alpar@1
   597
      }
alpar@1
   598
      csa->lb[j] = lb;
alpar@1
   599
      return;
alpar@1
   600
}
alpar@1
   601
alpar@1
   602
static void set_upper_bound(struct csa *csa, int j, double ub)
alpar@1
   603
{     /* set upper bound of j-th variable */
alpar@1
   604
      if (csa->ub[j] != -DBL_MAX)
alpar@1
   605
      {  warning(csa, "upper bound of variable `%s' redefined\n",
alpar@1
   606
            glp_get_col_name(csa->P, j));
alpar@1
   607
      }
alpar@1
   608
      csa->ub[j] = ub;
alpar@1
   609
      return;
alpar@1
   610
}
alpar@1
   611
alpar@1
   612
/***********************************************************************
alpar@1
   613
*  parse_bounds - parse bounds section
alpar@1
   614
*
alpar@1
   615
*  This routine parses the bounds section using the following syntax:
alpar@1
   616
*
alpar@1
   617
*  <variable> ::= <symbolic name>
alpar@1
   618
*  <infinity> ::= infinity | inf
alpar@1
   619
*  <bound> ::= <numeric constant> | + <numeric constant> |
alpar@1
   620
*     - <numeric constant> | + <infinity> | - <infinity>
alpar@1
   621
*  <lt> ::= < | <= | =<
alpar@1
   622
*  <gt> ::= > | >= | =>
alpar@1
   623
*  <bound definition> ::= <bound> <lt> <variable> <lt> <bound> |
alpar@1
   624
*     <bound> <lt> <variable> | <variable> <lt> <bound> |
alpar@1
   625
*     <variable> <gt> <bound> | <variable> = <bound> | <variable> free
alpar@1
   626
*  <bounds> ::= bounds | bound
alpar@1
   627
*  <bounds section> ::= <bounds> |
alpar@1
   628
*     <bounds section> <bound definition> */
alpar@1
   629
alpar@1
   630
static void parse_bounds(struct csa *csa)
alpar@1
   631
{     int j, lb_flag;
alpar@1
   632
      double lb, s;
alpar@1
   633
      /* parse the keyword 'bounds' */
alpar@1
   634
      xassert(csa->token == T_BOUNDS);
alpar@1
   635
      scan_token(csa);
alpar@1
   636
loop: /* bound definition can start with a sign, numeric constant, or
alpar@1
   637
         a symbolic name */
alpar@1
   638
      if (!(csa->token == T_PLUS || csa->token == T_MINUS ||
alpar@1
   639
            csa->token == T_NUMBER || csa->token == T_NAME)) goto done;
alpar@1
   640
      /* parse bound definition */
alpar@1
   641
      if (csa->token == T_PLUS || csa->token == T_MINUS)
alpar@1
   642
      {  /* parse signed lower bound */
alpar@1
   643
         lb_flag = 1;
alpar@1
   644
         s = (csa->token == T_PLUS ? +1.0 : -1.0);
alpar@1
   645
         scan_token(csa);
alpar@1
   646
         if (csa->token == T_NUMBER)
alpar@1
   647
            lb = s * csa->value, scan_token(csa);
alpar@1
   648
         else if (the_same(csa->image, "infinity") ||
alpar@1
   649
                  the_same(csa->image, "inf"))
alpar@1
   650
         {  if (s > 0.0)
alpar@1
   651
               error(csa, "invalid use of `+inf' as lower bound\n");
alpar@1
   652
            lb = -DBL_MAX, scan_token(csa);
alpar@1
   653
         }
alpar@1
   654
         else
alpar@1
   655
            error(csa, "missing lower bound\n");
alpar@1
   656
      }
alpar@1
   657
      else if (csa->token == T_NUMBER)
alpar@1
   658
      {  /* parse unsigned lower bound */
alpar@1
   659
         lb_flag = 1;
alpar@1
   660
         lb = csa->value, scan_token(csa);
alpar@1
   661
      }
alpar@1
   662
      else
alpar@1
   663
      {  /* lower bound is not specified */
alpar@1
   664
         lb_flag = 0;
alpar@1
   665
      }
alpar@1
   666
      /* parse the token that should follow the lower bound */
alpar@1
   667
      if (lb_flag)
alpar@1
   668
      {  if (csa->token != T_LE)
alpar@1
   669
            error(csa, "missing `<', `<=', or `=<' after lower bound\n")
alpar@1
   670
               ;
alpar@1
   671
         scan_token(csa);
alpar@1
   672
      }
alpar@1
   673
      /* parse variable name */
alpar@1
   674
      if (csa->token != T_NAME)
alpar@1
   675
         error(csa, "missing variable name\n");
alpar@1
   676
      j = find_col(csa, csa->image);
alpar@1
   677
      /* set lower bound */
alpar@1
   678
      if (lb_flag) set_lower_bound(csa, j, lb);
alpar@1
   679
      scan_token(csa);
alpar@1
   680
      /* parse the context that follows the variable name */
alpar@1
   681
      if (csa->token == T_LE)
alpar@1
   682
      {  /* parse upper bound */
alpar@1
   683
         scan_token(csa);
alpar@1
   684
         if (csa->token == T_PLUS || csa->token == T_MINUS)
alpar@1
   685
         {  /* parse signed upper bound */
alpar@1
   686
            s = (csa->token == T_PLUS ? +1.0 : -1.0);
alpar@1
   687
            scan_token(csa);
alpar@1
   688
            if (csa->token == T_NUMBER)
alpar@1
   689
            {  set_upper_bound(csa, j, s * csa->value);
alpar@1
   690
               scan_token(csa);
alpar@1
   691
            }
alpar@1
   692
            else if (the_same(csa->image, "infinity") ||
alpar@1
   693
                     the_same(csa->image, "inf"))
alpar@1
   694
            {  if (s < 0.0)
alpar@1
   695
                  error(csa, "invalid use of `-inf' as upper bound\n");
alpar@1
   696
               set_upper_bound(csa, j, +DBL_MAX);
alpar@1
   697
               scan_token(csa);
alpar@1
   698
            }
alpar@1
   699
            else
alpar@1
   700
               error(csa, "missing upper bound\n");
alpar@1
   701
         }
alpar@1
   702
         else if (csa->token == T_NUMBER)
alpar@1
   703
         {  /* parse unsigned upper bound */
alpar@1
   704
            set_upper_bound(csa, j, csa->value);
alpar@1
   705
            scan_token(csa);
alpar@1
   706
         }
alpar@1
   707
         else
alpar@1
   708
            error(csa, "missing upper bound\n");
alpar@1
   709
      }
alpar@1
   710
      else if (csa->token == T_GE)
alpar@1
   711
      {  /* parse lower bound */
alpar@1
   712
         if (lb_flag)
alpar@1
   713
         {  /* the context '... <= x >= ...' is invalid */
alpar@1
   714
            error(csa, "invalid bound definition\n");
alpar@1
   715
         }
alpar@1
   716
         scan_token(csa);
alpar@1
   717
         if (csa->token == T_PLUS || csa->token == T_MINUS)
alpar@1
   718
         {  /* parse signed lower bound */
alpar@1
   719
            s = (csa->token == T_PLUS ? +1.0 : -1.0);
alpar@1
   720
            scan_token(csa);
alpar@1
   721
            if (csa->token == T_NUMBER)
alpar@1
   722
            {  set_lower_bound(csa, j, s * csa->value);
alpar@1
   723
               scan_token(csa);
alpar@1
   724
            }
alpar@1
   725
            else if (the_same(csa->image, "infinity") ||
alpar@1
   726
                     the_same(csa->image, "inf") == 0)
alpar@1
   727
            {  if (s > 0.0)
alpar@1
   728
                  error(csa, "invalid use of `+inf' as lower bound\n");
alpar@1
   729
               set_lower_bound(csa, j, -DBL_MAX);
alpar@1
   730
               scan_token(csa);
alpar@1
   731
            }
alpar@1
   732
            else
alpar@1
   733
               error(csa, "missing lower bound\n");
alpar@1
   734
         }
alpar@1
   735
         else if (csa->token == T_NUMBER)
alpar@1
   736
         {  /* parse unsigned lower bound */
alpar@1
   737
            set_lower_bound(csa, j, csa->value);
alpar@1
   738
            scan_token(csa);
alpar@1
   739
         }
alpar@1
   740
         else
alpar@1
   741
            error(csa, "missing lower bound\n");
alpar@1
   742
      }
alpar@1
   743
      else if (csa->token == T_EQ)
alpar@1
   744
      {  /* parse fixed value */
alpar@1
   745
         if (lb_flag)
alpar@1
   746
         {  /* the context '... <= x = ...' is invalid */
alpar@1
   747
            error(csa, "invalid bound definition\n");
alpar@1
   748
         }
alpar@1
   749
         scan_token(csa);
alpar@1
   750
         if (csa->token == T_PLUS || csa->token == T_MINUS)
alpar@1
   751
         {  /* parse signed fixed value */
alpar@1
   752
            s = (csa->token == T_PLUS ? +1.0 : -1.0);
alpar@1
   753
            scan_token(csa);
alpar@1
   754
            if (csa->token == T_NUMBER)
alpar@1
   755
            {  set_lower_bound(csa, j, s * csa->value);
alpar@1
   756
               set_upper_bound(csa, j, s * csa->value);
alpar@1
   757
               scan_token(csa);
alpar@1
   758
            }
alpar@1
   759
            else
alpar@1
   760
               error(csa, "missing fixed value\n");
alpar@1
   761
         }
alpar@1
   762
         else if (csa->token == T_NUMBER)
alpar@1
   763
         {  /* parse unsigned fixed value */
alpar@1
   764
            set_lower_bound(csa, j, csa->value);
alpar@1
   765
            set_upper_bound(csa, j, csa->value);
alpar@1
   766
            scan_token(csa);
alpar@1
   767
         }
alpar@1
   768
         else
alpar@1
   769
            error(csa, "missing fixed value\n");
alpar@1
   770
      }
alpar@1
   771
      else if (the_same(csa->image, "free"))
alpar@1
   772
      {  /* parse the keyword 'free' */
alpar@1
   773
         if (lb_flag)
alpar@1
   774
         {  /* the context '... <= x free ...' is invalid */
alpar@1
   775
            error(csa, "invalid bound definition\n");
alpar@1
   776
         }
alpar@1
   777
         set_lower_bound(csa, j, -DBL_MAX);
alpar@1
   778
         set_upper_bound(csa, j, +DBL_MAX);
alpar@1
   779
         scan_token(csa);
alpar@1
   780
      }
alpar@1
   781
      else if (!lb_flag)
alpar@1
   782
      {  /* neither lower nor upper bounds are specified */
alpar@1
   783
         error(csa, "invalid bound definition\n");
alpar@1
   784
      }
alpar@1
   785
      goto loop;
alpar@1
   786
done: return;
alpar@1
   787
}
alpar@1
   788
alpar@1
   789
/***********************************************************************
alpar@1
   790
*  parse_integer - parse general, integer, or binary section
alpar@1
   791
*
alpar@1
   792
*  <variable> ::= <symbolic name>
alpar@1
   793
*  <general> ::= general | generals | gen
alpar@1
   794
*  <integer> ::= integer | integers | int
alpar@1
   795
*  <binary> ::= binary | binaries | bin
alpar@1
   796
*  <section head> ::= <general> <integer> <binary>
alpar@1
   797
*  <additional section> ::= <section head> |
alpar@1
   798
*     <additional section> <variable> */
alpar@1
   799
alpar@1
   800
static void parse_integer(struct csa *csa)
alpar@1
   801
{     int j, binary;
alpar@1
   802
      /* parse the keyword 'general', 'integer', or 'binary' */
alpar@1
   803
      if (csa->token == T_GENERAL)
alpar@1
   804
         binary = 0, scan_token(csa);
alpar@1
   805
      else if (csa->token == T_INTEGER)
alpar@1
   806
         binary = 0, scan_token(csa);
alpar@1
   807
      else if (csa->token == T_BINARY)
alpar@1
   808
         binary = 1, scan_token(csa);
alpar@1
   809
      else
alpar@1
   810
         xassert(csa != csa);
alpar@1
   811
      /* parse list of variables (may be empty) */
alpar@1
   812
      while (csa->token == T_NAME)
alpar@1
   813
      {  /* find the corresponding column */
alpar@1
   814
         j = find_col(csa, csa->image);
alpar@1
   815
         /* change kind of the variable */
alpar@1
   816
         glp_set_col_kind(csa->P, j, GLP_IV);
alpar@1
   817
         /* set 0-1 bounds for the binary variable */
alpar@1
   818
         if (binary)
alpar@1
   819
         {  set_lower_bound(csa, j, 0.0);
alpar@1
   820
            set_upper_bound(csa, j, 1.0);
alpar@1
   821
         }
alpar@1
   822
         scan_token(csa);
alpar@1
   823
      }
alpar@1
   824
      return;
alpar@1
   825
}
alpar@1
   826
alpar@1
   827
int glp_read_lp(glp_prob *P, const glp_cpxcp *parm, const char *fname)
alpar@1
   828
{     /* read problem data in CPLEX LP format */
alpar@1
   829
      glp_cpxcp _parm;
alpar@1
   830
      struct csa _csa, *csa = &_csa;
alpar@1
   831
      int ret;
alpar@1
   832
      xprintf("Reading problem data from `%s'...\n", fname);
alpar@1
   833
      if (parm == NULL)
alpar@1
   834
         glp_init_cpxcp(&_parm), parm = &_parm;
alpar@1
   835
      /* check control parameters */
alpar@1
   836
      check_parm("glp_read_lp", parm);
alpar@1
   837
      /* initialize common storage area */
alpar@1
   838
      csa->P = P;
alpar@1
   839
      csa->parm = parm;
alpar@1
   840
      csa->fname = fname;
alpar@1
   841
      csa->fp = NULL;
alpar@1
   842
      if (setjmp(csa->jump))
alpar@1
   843
      {  ret = 1;
alpar@1
   844
         goto done;
alpar@1
   845
      }
alpar@1
   846
      csa->count = 0;
alpar@1
   847
      csa->c = '\n';
alpar@1
   848
      csa->token = T_EOF;
alpar@1
   849
      csa->image[0] = '\0';
alpar@1
   850
      csa->imlen = 0;
alpar@1
   851
      csa->value = 0.0;
alpar@1
   852
      csa->n_max = 100;
alpar@1
   853
      csa->ind = xcalloc(1+csa->n_max, sizeof(int));
alpar@1
   854
      csa->val = xcalloc(1+csa->n_max, sizeof(double));
alpar@1
   855
      csa->flag = xcalloc(1+csa->n_max, sizeof(char));
alpar@1
   856
      memset(&csa->flag[1], 0, csa->n_max * sizeof(char));
alpar@1
   857
      csa->lb = xcalloc(1+csa->n_max, sizeof(double));
alpar@1
   858
      csa->ub = xcalloc(1+csa->n_max, sizeof(double));
alpar@1
   859
      /* erase problem object */
alpar@1
   860
      glp_erase_prob(P);
alpar@1
   861
      glp_create_index(P);
alpar@1
   862
      /* open input CPLEX LP file */
alpar@1
   863
      csa->fp = xfopen(fname, "r");
alpar@1
   864
      if (csa->fp == NULL)
alpar@1
   865
      {  xprintf("Unable to open `%s' - %s\n", fname, xerrmsg());
alpar@1
   866
         ret = 1;
alpar@1
   867
         goto done;
alpar@1
   868
      }
alpar@1
   869
      /* scan very first token */
alpar@1
   870
      scan_token(csa);
alpar@1
   871
      /* parse definition of the objective function */
alpar@1
   872
      if (!(csa->token == T_MINIMIZE || csa->token == T_MAXIMIZE))
alpar@1
   873
         error(csa, "`minimize' or `maximize' keyword missing\n");
alpar@1
   874
      parse_objective(csa);
alpar@1
   875
      /* parse constraints section */
alpar@1
   876
      if (csa->token != T_SUBJECT_TO)
alpar@1
   877
         error(csa, "constraints section missing\n");
alpar@1
   878
      parse_constraints(csa);
alpar@1
   879
      /* parse optional bounds section */
alpar@1
   880
      if (csa->token == T_BOUNDS) parse_bounds(csa);
alpar@1
   881
      /* parse optional general, integer, and binary sections */
alpar@1
   882
      while (csa->token == T_GENERAL ||
alpar@1
   883
             csa->token == T_INTEGER ||
alpar@1
   884
             csa->token == T_BINARY) parse_integer(csa);
alpar@1
   885
      /* check for the keyword 'end' */
alpar@1
   886
      if (csa->token == T_END)
alpar@1
   887
         scan_token(csa);
alpar@1
   888
      else if (csa->token == T_EOF)
alpar@1
   889
         warning(csa, "keyword `end' missing\n");
alpar@1
   890
      else
alpar@1
   891
         error(csa, "symbol `%s' in wrong position\n", csa->image);
alpar@1
   892
      /* nothing must follow the keyword 'end' (except comments) */
alpar@1
   893
      if (csa->token != T_EOF)
alpar@1
   894
         error(csa, "extra symbol(s) detected beyond `end'\n");
alpar@1
   895
      /* set bounds of variables */
alpar@1
   896
      {  int j, type;
alpar@1
   897
         double lb, ub;
alpar@1
   898
         for (j = 1; j <= P->n; j++)
alpar@1
   899
         {  lb = csa->lb[j];
alpar@1
   900
            ub = csa->ub[j];
alpar@1
   901
            if (lb == +DBL_MAX) lb = 0.0;      /* default lb */
alpar@1
   902
            if (ub == -DBL_MAX) ub = +DBL_MAX; /* default ub */
alpar@1
   903
            if (lb == -DBL_MAX && ub == +DBL_MAX)
alpar@1
   904
               type = GLP_FR;
alpar@1
   905
            else if (ub == +DBL_MAX)
alpar@1
   906
               type = GLP_LO;
alpar@1
   907
            else if (lb == -DBL_MAX)
alpar@1
   908
               type = GLP_UP;
alpar@1
   909
            else if (lb != ub)
alpar@1
   910
               type = GLP_DB;
alpar@1
   911
            else
alpar@1
   912
               type = GLP_FX;
alpar@1
   913
            glp_set_col_bnds(csa->P, j, type, lb, ub);
alpar@1
   914
         }
alpar@1
   915
      }
alpar@1
   916
      /* print some statistics */
alpar@1
   917
      xprintf("%d row%s, %d column%s, %d non-zero%s\n",
alpar@1
   918
         P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s",
alpar@1
   919
         P->nnz, P->nnz == 1 ? "" : "s");
alpar@1
   920
      if (glp_get_num_int(P) > 0)
alpar@1
   921
      {  int ni = glp_get_num_int(P);
alpar@1
   922
         int nb = glp_get_num_bin(P);
alpar@1
   923
         if (ni == 1)
alpar@1
   924
         {  if (nb == 0)
alpar@1
   925
               xprintf("One variable is integer\n");
alpar@1
   926
            else
alpar@1
   927
               xprintf("One variable is binary\n");
alpar@1
   928
         }
alpar@1
   929
         else
alpar@1
   930
         {  xprintf("%d integer variables, ", ni);
alpar@1
   931
            if (nb == 0)
alpar@1
   932
               xprintf("none");
alpar@1
   933
            else if (nb == 1)
alpar@1
   934
               xprintf("one");
alpar@1
   935
            else if (nb == ni)
alpar@1
   936
               xprintf("all");
alpar@1
   937
            else
alpar@1
   938
               xprintf("%d", nb);
alpar@1
   939
            xprintf(" of which %s binary\n", nb == 1 ? "is" : "are");
alpar@1
   940
         }
alpar@1
   941
      }
alpar@1
   942
      xprintf("%d lines were read\n", csa->count);
alpar@1
   943
      /* problem data has been successfully read */
alpar@1
   944
      glp_delete_index(P);
alpar@1
   945
      glp_sort_matrix(P);
alpar@1
   946
      ret = 0;
alpar@1
   947
done: if (csa->fp != NULL) xfclose(csa->fp);
alpar@1
   948
      xfree(csa->ind);
alpar@1
   949
      xfree(csa->val);
alpar@1
   950
      xfree(csa->flag);
alpar@1
   951
      xfree(csa->lb);
alpar@1
   952
      xfree(csa->ub);
alpar@1
   953
      if (ret != 0) glp_erase_prob(P);
alpar@1
   954
      return ret;
alpar@1
   955
}
alpar@1
   956
alpar@1
   957
/***********************************************************************
alpar@1
   958
*  NAME
alpar@1
   959
*
alpar@1
   960
*  glp_write_lp - write problem data in CPLEX LP format
alpar@1
   961
*
alpar@1
   962
*  SYNOPSIS
alpar@1
   963
*
alpar@1
   964
*  int glp_write_lp(glp_prob *P, const glp_cpxcp *parm, const char
alpar@1
   965
*     *fname);
alpar@1
   966
*
alpar@1
   967
*  DESCRIPTION
alpar@1
   968
*
alpar@1
   969
*  The routine glp_write_lp writes problem data in CPLEX LP format to
alpar@1
   970
*  a text file.
alpar@1
   971
*
alpar@1
   972
*  The parameter parm is a pointer to the structure glp_cpxcp, which
alpar@1
   973
*  specifies control parameters used by the routine. If parm is NULL,
alpar@1
   974
*  the routine uses default settings.
alpar@1
   975
*
alpar@1
   976
*  The character string fname specifies a name of the text file to be
alpar@1
   977
*  written.
alpar@1
   978
*
alpar@1
   979
*  RETURNS
alpar@1
   980
*
alpar@1
   981
*  If the operation was successful, the routine glp_write_lp returns
alpar@1
   982
*  zero. Otherwise, it prints an error message and returns non-zero. */
alpar@1
   983
alpar@1
   984
#define csa csa1
alpar@1
   985
alpar@1
   986
struct csa
alpar@1
   987
{     /* common storage area */
alpar@1
   988
      glp_prob *P;
alpar@1
   989
      /* pointer to problem object */
alpar@1
   990
      const glp_cpxcp *parm;
alpar@1
   991
      /* pointer to control parameters */
alpar@1
   992
};
alpar@1
   993
alpar@1
   994
static int check_name(char *name)
alpar@1
   995
{     /* check if specified name is valid for CPLEX LP format */
alpar@1
   996
      if (*name == '.') return 1;
alpar@1
   997
      if (isdigit((unsigned char)*name)) return 1;
alpar@1
   998
      for (; *name; name++)
alpar@1
   999
      {  if (!isalnum((unsigned char)*name) &&
alpar@1
  1000
             strchr(CHAR_SET, (unsigned char)*name) == NULL) return 1;
alpar@1
  1001
      }
alpar@1
  1002
      return 0; /* name is ok */
alpar@1
  1003
}
alpar@1
  1004
alpar@1
  1005
static void adjust_name(char *name)
alpar@1
  1006
{     /* attempt to adjust specified name to make it valid for CPLEX LP
alpar@1
  1007
         format */
alpar@1
  1008
      for (; *name; name++)
alpar@1
  1009
      {  if (*name == ' ')
alpar@1
  1010
            *name = '_';
alpar@1
  1011
         else if (*name == '-')
alpar@1
  1012
            *name = '~';
alpar@1
  1013
         else if (*name == '[')
alpar@1
  1014
            *name = '(';
alpar@1
  1015
         else if (*name == ']')
alpar@1
  1016
            *name = ')';
alpar@1
  1017
      }
alpar@1
  1018
      return;
alpar@1
  1019
}
alpar@1
  1020
alpar@1
  1021
static char *row_name(struct csa *csa, int i, char rname[255+1])
alpar@1
  1022
{     /* construct symbolic name of i-th row (constraint) */
alpar@1
  1023
      const char *name;
alpar@1
  1024
      if (i == 0)
alpar@1
  1025
         name = glp_get_obj_name(csa->P);
alpar@1
  1026
      else
alpar@1
  1027
         name = glp_get_row_name(csa->P, i);
alpar@1
  1028
      if (name == NULL) goto fake;
alpar@1
  1029
      strcpy(rname, name);
alpar@1
  1030
      adjust_name(rname);
alpar@1
  1031
      if (check_name(rname)) goto fake;
alpar@1
  1032
      return rname;
alpar@1
  1033
fake: if (i == 0)
alpar@1
  1034
         strcpy(rname, "obj");
alpar@1
  1035
      else
alpar@1
  1036
         sprintf(rname, "r_%d", i);
alpar@1
  1037
      return rname;
alpar@1
  1038
}
alpar@1
  1039
alpar@1
  1040
static char *col_name(struct csa *csa, int j, char cname[255+1])
alpar@1
  1041
{     /* construct symbolic name of j-th column (variable) */
alpar@1
  1042
      const char *name;
alpar@1
  1043
      name = glp_get_col_name(csa->P, j);
alpar@1
  1044
      if (name == NULL) goto fake;
alpar@1
  1045
      strcpy(cname, name);
alpar@1
  1046
      adjust_name(cname);
alpar@1
  1047
      if (check_name(cname)) goto fake;
alpar@1
  1048
      return cname;
alpar@1
  1049
fake: sprintf(cname, "x_%d", j);
alpar@1
  1050
      return cname;
alpar@1
  1051
}
alpar@1
  1052
alpar@1
  1053
int glp_write_lp(glp_prob *P, const glp_cpxcp *parm, const char *fname)
alpar@1
  1054
{     /* write problem data in CPLEX LP format */
alpar@1
  1055
      glp_cpxcp _parm;
alpar@1
  1056
      struct csa _csa, *csa = &_csa;
alpar@1
  1057
      XFILE *fp;
alpar@1
  1058
      GLPROW *row;
alpar@1
  1059
      GLPCOL *col;
alpar@1
  1060
      GLPAIJ *aij;
alpar@1
  1061
      int i, j, len, flag, count, ret;
alpar@1
  1062
      char line[1000+1], term[500+1], name[255+1];
alpar@1
  1063
      xprintf("Writing problem data to `%s'...\n", fname);
alpar@1
  1064
      if (parm == NULL)
alpar@1
  1065
         glp_init_cpxcp(&_parm), parm = &_parm;
alpar@1
  1066
      /* check control parameters */
alpar@1
  1067
      check_parm("glp_write_lp", parm);
alpar@1
  1068
      /* initialize common storage area */
alpar@1
  1069
      csa->P = P;
alpar@1
  1070
      csa->parm = parm;
alpar@1
  1071
      /* create output CPLEX LP file */
alpar@1
  1072
      fp = xfopen(fname, "w"), count = 0;
alpar@1
  1073
      if (fp == NULL)
alpar@1
  1074
      {  xprintf("Unable to create `%s' - %s\n", fname, xerrmsg());
alpar@1
  1075
         ret = 1;
alpar@1
  1076
         goto done;
alpar@1
  1077
      }
alpar@1
  1078
      /* write problem name */
alpar@1
  1079
      xfprintf(fp, "\\* Problem: %s *\\\n",
alpar@1
  1080
         P->name == NULL ? "Unknown" : P->name), count++;
alpar@1
  1081
      xfprintf(fp, "\n"), count++;
alpar@1
  1082
      /* the problem should contain at least one row and one column */
alpar@1
  1083
      if (!(P->m > 0 && P->n > 0))
alpar@1
  1084
      {  xprintf("Warning: problem has no rows/columns\n");
alpar@1
  1085
         xfprintf(fp, "\\* WARNING: PROBLEM HAS NO ROWS/COLUMNS *\\\n"),
alpar@1
  1086
            count++;
alpar@1
  1087
         xfprintf(fp, "\n"), count++;
alpar@1
  1088
         goto skip;
alpar@1
  1089
      }
alpar@1
  1090
      /* write the objective function definition */
alpar@1
  1091
      if (P->dir == GLP_MIN)
alpar@1
  1092
         xfprintf(fp, "Minimize\n"), count++;
alpar@1
  1093
      else if (P->dir == GLP_MAX)
alpar@1
  1094
         xfprintf(fp, "Maximize\n"), count++;
alpar@1
  1095
      else
alpar@1
  1096
         xassert(P != P);
alpar@1
  1097
      row_name(csa, 0, name);
alpar@1
  1098
      sprintf(line, " %s:", name);
alpar@1
  1099
      len = 0;
alpar@1
  1100
      for (j = 1; j <= P->n; j++)
alpar@1
  1101
      {  col = P->col[j];
alpar@1
  1102
         if (col->coef != 0.0 || col->ptr == NULL)
alpar@1
  1103
         {  len++;
alpar@1
  1104
            col_name(csa, j, name);
alpar@1
  1105
            if (col->coef == 0.0)
alpar@1
  1106
               sprintf(term, " + 0 %s", name); /* empty column */
alpar@1
  1107
            else if (col->coef == +1.0)
alpar@1
  1108
               sprintf(term, " + %s", name);
alpar@1
  1109
            else if (col->coef == -1.0)
alpar@1
  1110
               sprintf(term, " - %s", name);
alpar@1
  1111
            else if (col->coef > 0.0)
alpar@1
  1112
               sprintf(term, " + %.*g %s", DBL_DIG, +col->coef, name);
alpar@1
  1113
            else
alpar@1
  1114
               sprintf(term, " - %.*g %s", DBL_DIG, -col->coef, name);
alpar@1
  1115
            if (strlen(line) + strlen(term) > 72)
alpar@1
  1116
               xfprintf(fp, "%s\n", line), line[0] = '\0', count++;
alpar@1
  1117
            strcat(line, term);
alpar@1
  1118
         }
alpar@1
  1119
      }
alpar@1
  1120
      if (len == 0)
alpar@1
  1121
      {  /* empty objective */
alpar@1
  1122
         sprintf(term, " 0 %s", col_name(csa, 1, name));
alpar@1
  1123
         strcat(line, term);
alpar@1
  1124
      }
alpar@1
  1125
      xfprintf(fp, "%s\n", line), count++;
alpar@1
  1126
      if (P->c0 != 0.0)
alpar@1
  1127
         xfprintf(fp, "\\* constant term = %.*g *\\\n", DBL_DIG, P->c0),
alpar@1
  1128
            count++;
alpar@1
  1129
      xfprintf(fp, "\n"), count++;
alpar@1
  1130
      /* write the constraints section */
alpar@1
  1131
      xfprintf(fp, "Subject To\n"), count++;
alpar@1
  1132
      for (i = 1; i <= P->m; i++)
alpar@1
  1133
      {  row = P->row[i];
alpar@1
  1134
         if (row->type == GLP_FR) continue; /* skip free row */
alpar@1
  1135
         row_name(csa, i, name);
alpar@1
  1136
         sprintf(line, " %s:", name);
alpar@1
  1137
         /* linear form */
alpar@1
  1138
         for (aij = row->ptr; aij != NULL; aij = aij->r_next)
alpar@1
  1139
         {  col_name(csa, aij->col->j, name);
alpar@1
  1140
            if (aij->val == +1.0)
alpar@1
  1141
               sprintf(term, " + %s", name);
alpar@1
  1142
            else if (aij->val == -1.0)
alpar@1
  1143
               sprintf(term, " - %s", name);
alpar@1
  1144
            else if (aij->val > 0.0)
alpar@1
  1145
               sprintf(term, " + %.*g %s", DBL_DIG, +aij->val, name);
alpar@1
  1146
            else
alpar@1
  1147
               sprintf(term, " - %.*g %s", DBL_DIG, -aij->val, name);
alpar@1
  1148
            if (strlen(line) + strlen(term) > 72)
alpar@1
  1149
               xfprintf(fp, "%s\n", line), line[0] = '\0', count++;
alpar@1
  1150
            strcat(line, term);
alpar@1
  1151
         }
alpar@1
  1152
         if (row->type == GLP_DB)
alpar@1
  1153
         {  /* double-bounded (ranged) constraint */
alpar@1
  1154
            sprintf(term, " - ~r_%d", i);
alpar@1
  1155
            if (strlen(line) + strlen(term) > 72)
alpar@1
  1156
               xfprintf(fp, "%s\n", line), line[0] = '\0', count++;
alpar@1
  1157
            strcat(line, term);
alpar@1
  1158
         }
alpar@1
  1159
         else if (row->ptr == NULL)
alpar@1
  1160
         {  /* empty constraint */
alpar@1
  1161
            sprintf(term, " 0 %s", col_name(csa, 1, name));
alpar@1
  1162
            strcat(line, term);
alpar@1
  1163
         }
alpar@1
  1164
         /* right hand-side */
alpar@1
  1165
         if (row->type == GLP_LO)
alpar@1
  1166
            sprintf(term, " >= %.*g", DBL_DIG, row->lb);
alpar@1
  1167
         else if (row->type == GLP_UP)
alpar@1
  1168
            sprintf(term, " <= %.*g", DBL_DIG, row->ub);
alpar@1
  1169
         else if (row->type == GLP_DB || row->type == GLP_FX)
alpar@1
  1170
            sprintf(term, " = %.*g", DBL_DIG, row->lb);
alpar@1
  1171
         else
alpar@1
  1172
            xassert(row != row);
alpar@1
  1173
         if (strlen(line) + strlen(term) > 72)
alpar@1
  1174
            xfprintf(fp, "%s\n", line), line[0] = '\0', count++;
alpar@1
  1175
         strcat(line, term);
alpar@1
  1176
         xfprintf(fp, "%s\n", line), count++;
alpar@1
  1177
      }
alpar@1
  1178
      xfprintf(fp, "\n"), count++;
alpar@1
  1179
      /* write the bounds section */
alpar@1
  1180
      flag = 0;
alpar@1
  1181
      for (i = 1; i <= P->m; i++)
alpar@1
  1182
      {  row = P->row[i];
alpar@1
  1183
         if (row->type != GLP_DB) continue;
alpar@1
  1184
         if (!flag)
alpar@1
  1185
            xfprintf(fp, "Bounds\n"), flag = 1, count++;
alpar@1
  1186
         xfprintf(fp, " 0 <= ~r_%d <= %.*g\n",
alpar@1
  1187
            i, DBL_DIG, row->ub - row->lb), count++;
alpar@1
  1188
      }
alpar@1
  1189
      for (j = 1; j <= P->n; j++)
alpar@1
  1190
      {  col = P->col[j];
alpar@1
  1191
         if (col->type == GLP_LO && col->lb == 0.0) continue;
alpar@1
  1192
         if (!flag)
alpar@1
  1193
            xfprintf(fp, "Bounds\n"), flag = 1, count++;
alpar@1
  1194
         col_name(csa, j, name);
alpar@1
  1195
         if (col->type == GLP_FR)
alpar@1
  1196
            xfprintf(fp, " %s free\n", name), count++;
alpar@1
  1197
         else if (col->type == GLP_LO)
alpar@1
  1198
            xfprintf(fp, " %s >= %.*g\n",
alpar@1
  1199
               name, DBL_DIG, col->lb), count++;
alpar@1
  1200
         else if (col->type == GLP_UP)
alpar@1
  1201
            xfprintf(fp, " -Inf <= %s <= %.*g\n",
alpar@1
  1202
               name, DBL_DIG, col->ub), count++;
alpar@1
  1203
         else if (col->type == GLP_DB)
alpar@1
  1204
            xfprintf(fp, " %.*g <= %s <= %.*g\n",
alpar@1
  1205
               DBL_DIG, col->lb, name, DBL_DIG, col->ub), count++;
alpar@1
  1206
         else if (col->type == GLP_FX)
alpar@1
  1207
            xfprintf(fp, " %s = %.*g\n",
alpar@1
  1208
               name, DBL_DIG, col->lb), count++;
alpar@1
  1209
         else
alpar@1
  1210
            xassert(col != col);
alpar@1
  1211
      }
alpar@1
  1212
      if (flag) xfprintf(fp, "\n"), count++;
alpar@1
  1213
      /* write the integer section */
alpar@1
  1214
      flag = 0;
alpar@1
  1215
      for (j = 1; j <= P->n; j++)
alpar@1
  1216
      {  col = P->col[j];
alpar@1
  1217
         if (col->kind == GLP_CV) continue;
alpar@1
  1218
         xassert(col->kind == GLP_IV);
alpar@1
  1219
         if (!flag)
alpar@1
  1220
            xfprintf(fp, "Generals\n"), flag = 1, count++;
alpar@1
  1221
         xfprintf(fp, " %s\n", col_name(csa, j, name)), count++;
alpar@1
  1222
      }
alpar@1
  1223
      if (flag) xfprintf(fp, "\n"), count++;
alpar@1
  1224
skip: /* write the end keyword */
alpar@1
  1225
      xfprintf(fp, "End\n"), count++;
alpar@1
  1226
      xfflush(fp);
alpar@1
  1227
      if (xferror(fp))
alpar@1
  1228
      {  xprintf("Write error on `%s' - %s\n", fname, xerrmsg());
alpar@1
  1229
         ret = 1;
alpar@1
  1230
         goto done;
alpar@1
  1231
      }
alpar@1
  1232
      /* problem data has been successfully written */
alpar@1
  1233
      xprintf("%d lines were written\n", count);
alpar@1
  1234
      ret = 0;
alpar@1
  1235
done: if (fp != NULL) xfclose(fp);
alpar@1
  1236
      return ret;
alpar@1
  1237
}
alpar@1
  1238
alpar@1
  1239
/* eof */