|
1 /* glpmps.c (MPS format routines) */ |
|
2 |
|
3 /*********************************************************************** |
|
4 * This code is part of GLPK (GNU Linear Programming Kit). |
|
5 * |
|
6 * Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
|
7 * 2009, 2010 Andrew Makhorin, Department for Applied Informatics, |
|
8 * Moscow Aviation Institute, Moscow, Russia. All rights reserved. |
|
9 * E-mail: <mao@gnu.org>. |
|
10 * |
|
11 * GLPK is free software: you can redistribute it and/or modify it |
|
12 * under the terms of the GNU General Public License as published by |
|
13 * the Free Software Foundation, either version 3 of the License, or |
|
14 * (at your option) any later version. |
|
15 * |
|
16 * GLPK is distributed in the hope that it will be useful, but WITHOUT |
|
17 * ANY WARRANTY; without even the implied warranty of MERCHANTABILITY |
|
18 * or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public |
|
19 * License for more details. |
|
20 * |
|
21 * You should have received a copy of the GNU General Public License |
|
22 * along with GLPK. If not, see <http://www.gnu.org/licenses/>. |
|
23 ***********************************************************************/ |
|
24 |
|
25 #include "glpapi.h" |
|
26 |
|
27 /*********************************************************************** |
|
28 * NAME |
|
29 * |
|
30 * glp_init_mpscp - initialize MPS format control parameters |
|
31 * |
|
32 * SYNOPSIS |
|
33 * |
|
34 * void glp_init_mpscp(glp_mpscp *parm); |
|
35 * |
|
36 * DESCRIPTION |
|
37 * |
|
38 * The routine glp_init_mpscp initializes control parameters, which are |
|
39 * used by the MPS input/output routines glp_read_mps and glp_write_mps, |
|
40 * with default values. |
|
41 * |
|
42 * Default values of the control parameters are stored in the glp_mpscp |
|
43 * structure, which the parameter parm points to. */ |
|
44 |
|
45 void glp_init_mpscp(glp_mpscp *parm) |
|
46 { parm->blank = '\0'; |
|
47 parm->obj_name = NULL; |
|
48 parm->tol_mps = 1e-12; |
|
49 return; |
|
50 } |
|
51 |
|
52 static void check_parm(const char *func, const glp_mpscp *parm) |
|
53 { /* check control parameters */ |
|
54 if (!(0x00 <= parm->blank && parm->blank <= 0xFF) || |
|
55 !(parm->blank == '\0' || isprint(parm->blank))) |
|
56 xerror("%s: blank = 0x%02X; invalid parameter\n", |
|
57 func, parm->blank); |
|
58 if (!(parm->obj_name == NULL || strlen(parm->obj_name) <= 255)) |
|
59 xerror("%s: obj_name = \"%.12s...\"; parameter too long\n", |
|
60 func, parm->obj_name); |
|
61 if (!(0.0 <= parm->tol_mps && parm->tol_mps < 1.0)) |
|
62 xerror("%s: tol_mps = %g; invalid parameter\n", |
|
63 func, parm->tol_mps); |
|
64 return; |
|
65 } |
|
66 |
|
67 /*********************************************************************** |
|
68 * NAME |
|
69 * |
|
70 * glp_read_mps - read problem data in MPS format |
|
71 * |
|
72 * SYNOPSIS |
|
73 * |
|
74 * int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, |
|
75 * const char *fname); |
|
76 * |
|
77 * DESCRIPTION |
|
78 * |
|
79 * The routine glp_read_mps reads problem data in MPS format from a |
|
80 * text file. |
|
81 * |
|
82 * The parameter fmt specifies the version of MPS format: |
|
83 * |
|
84 * GLP_MPS_DECK - fixed (ancient) MPS format; |
|
85 * GLP_MPS_FILE - free (modern) MPS format. |
|
86 * |
|
87 * The parameter parm is a pointer to the structure glp_mpscp, which |
|
88 * specifies control parameters used by the routine. If parm is NULL, |
|
89 * the routine uses default settings. |
|
90 * |
|
91 * The character string fname specifies a name of the text file to be |
|
92 * read. |
|
93 * |
|
94 * Note that before reading data the current content of the problem |
|
95 * object is completely erased with the routine glp_erase_prob. |
|
96 * |
|
97 * RETURNS |
|
98 * |
|
99 * If the operation was successful, the routine glp_read_mps returns |
|
100 * zero. Otherwise, it prints an error message and returns non-zero. */ |
|
101 |
|
102 struct csa |
|
103 { /* common storage area */ |
|
104 glp_prob *P; |
|
105 /* pointer to problem object */ |
|
106 int deck; |
|
107 /* MPS format (0 - free, 1 - fixed) */ |
|
108 const glp_mpscp *parm; |
|
109 /* pointer to control parameters */ |
|
110 const char *fname; |
|
111 /* name of input MPS file */ |
|
112 XFILE *fp; |
|
113 /* stream assigned to input MPS file */ |
|
114 jmp_buf jump; |
|
115 /* label for go to in case of error */ |
|
116 int recno; |
|
117 /* current record (card) number */ |
|
118 int recpos; |
|
119 /* current record (card) position */ |
|
120 int c; |
|
121 /* current character */ |
|
122 int fldno; |
|
123 /* current field number */ |
|
124 char field[255+1]; |
|
125 /* current field content */ |
|
126 int w80; |
|
127 /* warning 'record must not be longer than 80 chars' issued */ |
|
128 int wef; |
|
129 /* warning 'extra fields detected beyond field 6' issued */ |
|
130 int obj_row; |
|
131 /* objective row number */ |
|
132 void *work1, *work2, *work3; |
|
133 /* working arrays */ |
|
134 }; |
|
135 |
|
136 static void error(struct csa *csa, const char *fmt, ...) |
|
137 { /* print error message and terminate processing */ |
|
138 va_list arg; |
|
139 xprintf("%s:%d: ", csa->fname, csa->recno); |
|
140 va_start(arg, fmt); |
|
141 xvprintf(fmt, arg); |
|
142 va_end(arg); |
|
143 longjmp(csa->jump, 1); |
|
144 /* no return */ |
|
145 } |
|
146 |
|
147 static void warning(struct csa *csa, const char *fmt, ...) |
|
148 { /* print warning message and continue processing */ |
|
149 va_list arg; |
|
150 xprintf("%s:%d: warning: ", csa->fname, csa->recno); |
|
151 va_start(arg, fmt); |
|
152 xvprintf(fmt, arg); |
|
153 va_end(arg); |
|
154 return; |
|
155 } |
|
156 |
|
157 static void read_char(struct csa *csa) |
|
158 { /* read next character */ |
|
159 int c; |
|
160 if (csa->c == '\n') |
|
161 csa->recno++, csa->recpos = 0; |
|
162 csa->recpos++; |
|
163 read: c = xfgetc(csa->fp); |
|
164 if (c < 0) |
|
165 { if (xferror(csa->fp)) |
|
166 error(csa, "read error - %s\n", xerrmsg()); |
|
167 else if (csa->c == '\n') |
|
168 error(csa, "unexpected end of file\n"); |
|
169 else |
|
170 { warning(csa, "missing final end of line\n"); |
|
171 c = '\n'; |
|
172 } |
|
173 } |
|
174 else if (c == '\n') |
|
175 ; |
|
176 else if (csa->c == '\r') |
|
177 { c = '\r'; |
|
178 goto badc; |
|
179 } |
|
180 else if (csa->deck && c == '\r') |
|
181 { csa->c = '\r'; |
|
182 goto read; |
|
183 } |
|
184 else if (c == ' ') |
|
185 ; |
|
186 else if (isspace(c)) |
|
187 { if (csa->deck) |
|
188 badc: error(csa, "in fixed MPS format white-space character 0x%02" |
|
189 "X is not allowed\n", c); |
|
190 c = ' '; |
|
191 } |
|
192 else if (iscntrl(c)) |
|
193 error(csa, "invalid control character 0x%02X\n", c); |
|
194 if (csa->deck && csa->recpos == 81 && c != '\n' && csa->w80 < 1) |
|
195 { warning(csa, "in fixed MPS format record must not be longer th" |
|
196 "an 80 characters\n"); |
|
197 csa->w80++; |
|
198 } |
|
199 csa->c = c; |
|
200 return; |
|
201 } |
|
202 |
|
203 static int indicator(struct csa *csa, int name) |
|
204 { /* skip comment records and read possible indicator record */ |
|
205 int ret; |
|
206 /* reset current field number */ |
|
207 csa->fldno = 0; |
|
208 loop: /* read the very first character of the next record */ |
|
209 xassert(csa->c == '\n'); |
|
210 read_char(csa); |
|
211 if (csa->c == ' ' || csa->c == '\n') |
|
212 { /* data record */ |
|
213 ret = 0; |
|
214 } |
|
215 else if (csa->c == '*') |
|
216 { /* comment record */ |
|
217 while (csa->c != '\n') |
|
218 read_char(csa); |
|
219 goto loop; |
|
220 } |
|
221 else |
|
222 { /* indicator record */ |
|
223 int len = 0; |
|
224 while (csa->c != ' ' && csa->c != '\n' && len < 12) |
|
225 { csa->field[len++] = (char)csa->c; |
|
226 read_char(csa); |
|
227 } |
|
228 csa->field[len] = '\0'; |
|
229 if (!(strcmp(csa->field, "NAME") == 0 || |
|
230 strcmp(csa->field, "ROWS") == 0 || |
|
231 strcmp(csa->field, "COLUMNS") == 0 || |
|
232 strcmp(csa->field, "RHS") == 0 || |
|
233 strcmp(csa->field, "RANGES") == 0 || |
|
234 strcmp(csa->field, "BOUNDS") == 0 || |
|
235 strcmp(csa->field, "ENDATA") == 0)) |
|
236 error(csa, "invalid indicator record\n"); |
|
237 if (!name) |
|
238 { while (csa->c != '\n') |
|
239 read_char(csa); |
|
240 } |
|
241 ret = 1; |
|
242 } |
|
243 return ret; |
|
244 } |
|
245 |
|
246 static void read_field(struct csa *csa) |
|
247 { /* read next field of the current data record */ |
|
248 csa->fldno++; |
|
249 if (csa->deck) |
|
250 { /* fixed MPS format */ |
|
251 int beg, end, pos; |
|
252 /* determine predefined field positions */ |
|
253 if (csa->fldno == 1) |
|
254 beg = 2, end = 3; |
|
255 else if (csa->fldno == 2) |
|
256 beg = 5, end = 12; |
|
257 else if (csa->fldno == 3) |
|
258 beg = 15, end = 22; |
|
259 else if (csa->fldno == 4) |
|
260 beg = 25, end = 36; |
|
261 else if (csa->fldno == 5) |
|
262 beg = 40, end = 47; |
|
263 else if (csa->fldno == 6) |
|
264 beg = 50, end = 61; |
|
265 else |
|
266 xassert(csa != csa); |
|
267 /* skip blanks preceding the current field */ |
|
268 if (csa->c != '\n') |
|
269 { pos = csa->recpos; |
|
270 while (csa->recpos < beg) |
|
271 { if (csa->c == ' ') |
|
272 ; |
|
273 else if (csa->c == '\n') |
|
274 break; |
|
275 else |
|
276 error(csa, "in fixed MPS format positions %d-%d must " |
|
277 "be blank\n", pos, beg-1); |
|
278 read_char(csa); |
|
279 } |
|
280 } |
|
281 /* skip possible comment beginning in the field 3 or 5 */ |
|
282 if ((csa->fldno == 3 || csa->fldno == 5) && csa->c == '$') |
|
283 { while (csa->c != '\n') |
|
284 read_char(csa); |
|
285 } |
|
286 /* read the current field */ |
|
287 for (pos = beg; pos <= end; pos++) |
|
288 { if (csa->c == '\n') break; |
|
289 csa->field[pos-beg] = (char)csa->c; |
|
290 read_char(csa); |
|
291 } |
|
292 csa->field[pos-beg] = '\0'; |
|
293 strtrim(csa->field); |
|
294 /* skip blanks following the last field */ |
|
295 if (csa->fldno == 6 && csa->c != '\n') |
|
296 { while (csa->recpos <= 72) |
|
297 { if (csa->c == ' ') |
|
298 ; |
|
299 else if (csa->c == '\n') |
|
300 break; |
|
301 else |
|
302 error(csa, "in fixed MPS format positions 62-72 must " |
|
303 "be blank\n"); |
|
304 read_char(csa); |
|
305 } |
|
306 while (csa->c != '\n') |
|
307 read_char(csa); |
|
308 } |
|
309 } |
|
310 else |
|
311 { /* free MPS format */ |
|
312 int len; |
|
313 /* skip blanks preceding the current field */ |
|
314 while (csa->c == ' ') |
|
315 read_char(csa); |
|
316 /* skip possible comment */ |
|
317 if (csa->c == '$') |
|
318 { while (csa->c != '\n') |
|
319 read_char(csa); |
|
320 } |
|
321 /* read the current field */ |
|
322 len = 0; |
|
323 while (!(csa->c == ' ' || csa->c == '\n')) |
|
324 { if (len == 255) |
|
325 error(csa, "length of field %d exceeds 255 characters\n", |
|
326 csa->fldno++); |
|
327 csa->field[len++] = (char)csa->c; |
|
328 read_char(csa); |
|
329 } |
|
330 csa->field[len] = '\0'; |
|
331 /* skip anything following the last field (any extra fields |
|
332 are considered to be comments) */ |
|
333 if (csa->fldno == 6) |
|
334 { while (csa->c == ' ') |
|
335 read_char(csa); |
|
336 if (csa->c != '$' && csa->c != '\n' && csa->wef < 1) |
|
337 { warning(csa, "some extra field(s) detected beyond field " |
|
338 "6; field(s) ignored\n"); |
|
339 csa->wef++; |
|
340 } |
|
341 while (csa->c != '\n') |
|
342 read_char(csa); |
|
343 } |
|
344 } |
|
345 return; |
|
346 } |
|
347 |
|
348 static void patch_name(struct csa *csa, char *name) |
|
349 { /* process embedded blanks in symbolic name */ |
|
350 int blank = csa->parm->blank; |
|
351 if (blank == '\0') |
|
352 { /* remove emedded blanks */ |
|
353 strspx(name); |
|
354 } |
|
355 else |
|
356 { /* replace embedded blanks by specified character */ |
|
357 for (; *name != '\0'; name++) |
|
358 if (*name == ' ') *name = (char)blank; |
|
359 } |
|
360 return; |
|
361 } |
|
362 |
|
363 static double read_number(struct csa *csa) |
|
364 { /* read next field and convert it to floating-point number */ |
|
365 double x; |
|
366 char *s; |
|
367 /* read next field */ |
|
368 read_field(csa); |
|
369 xassert(csa->fldno == 4 || csa->fldno == 6); |
|
370 if (csa->field[0] == '\0') |
|
371 error(csa, "missing numeric value in field %d\n", csa->fldno); |
|
372 /* skip initial spaces of the field */ |
|
373 for (s = csa->field; *s == ' '; s++); |
|
374 /* perform conversion */ |
|
375 if (str2num(s, &x) != 0) |
|
376 error(csa, "cannot convert `%s' to floating-point number\n", |
|
377 s); |
|
378 return x; |
|
379 } |
|
380 |
|
381 static void skip_field(struct csa *csa) |
|
382 { /* read and skip next field (assumed to be blank) */ |
|
383 read_field(csa); |
|
384 if (csa->field[0] != '\0') |
|
385 error(csa, "field %d must be blank\n", csa->fldno); |
|
386 return; |
|
387 } |
|
388 |
|
389 static void read_name(struct csa *csa) |
|
390 { /* read NAME indicator record */ |
|
391 if (!(indicator(csa, 1) && strcmp(csa->field, "NAME") == 0)) |
|
392 error(csa, "missing NAME indicator record\n"); |
|
393 /* this indicator record looks like a data record; simulate that |
|
394 fields 1 and 2 were read */ |
|
395 csa->fldno = 2; |
|
396 /* field 3: model name */ |
|
397 read_field(csa), patch_name(csa, csa->field); |
|
398 if (csa->field[0] == '\0') |
|
399 warning(csa, "missing model name in field 3\n"); |
|
400 else |
|
401 glp_set_prob_name(csa->P, csa->field); |
|
402 /* skip anything following field 3 */ |
|
403 while (csa->c != '\n') |
|
404 read_char(csa); |
|
405 return; |
|
406 } |
|
407 |
|
408 static void read_rows(struct csa *csa) |
|
409 { /* read ROWS section */ |
|
410 int i, type; |
|
411 loop: if (indicator(csa, 0)) goto done; |
|
412 /* field 1: row type */ |
|
413 read_field(csa), strspx(csa->field); |
|
414 if (strcmp(csa->field, "N") == 0) |
|
415 type = GLP_FR; |
|
416 else if (strcmp(csa->field, "G") == 0) |
|
417 type = GLP_LO; |
|
418 else if (strcmp(csa->field, "L") == 0) |
|
419 type = GLP_UP; |
|
420 else if (strcmp(csa->field, "E") == 0) |
|
421 type = GLP_FX; |
|
422 else if (csa->field[0] == '\0') |
|
423 error(csa, "missing row type in field 1\n"); |
|
424 else |
|
425 error(csa, "invalid row type in field 1\n"); |
|
426 /* field 2: row name */ |
|
427 read_field(csa), patch_name(csa, csa->field); |
|
428 if (csa->field[0] == '\0') |
|
429 error(csa, "missing row name in field 2\n"); |
|
430 if (glp_find_row(csa->P, csa->field) != 0) |
|
431 error(csa, "row `%s' multiply specified\n", csa->field); |
|
432 i = glp_add_rows(csa->P, 1); |
|
433 glp_set_row_name(csa->P, i, csa->field); |
|
434 glp_set_row_bnds(csa->P, i, type, 0.0, 0.0); |
|
435 /* fields 3, 4, 5, and 6 must be blank */ |
|
436 skip_field(csa); |
|
437 skip_field(csa); |
|
438 skip_field(csa); |
|
439 skip_field(csa); |
|
440 goto loop; |
|
441 done: return; |
|
442 } |
|
443 |
|
444 static void read_columns(struct csa *csa) |
|
445 { /* read COLUMNS section */ |
|
446 int i, j, f, len, kind = GLP_CV, *ind; |
|
447 double aij, *val; |
|
448 char name[255+1], *flag; |
|
449 /* allocate working arrays */ |
|
450 csa->work1 = ind = xcalloc(1+csa->P->m, sizeof(int)); |
|
451 csa->work2 = val = xcalloc(1+csa->P->m, sizeof(double)); |
|
452 csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); |
|
453 memset(&flag[1], 0, csa->P->m); |
|
454 /* no current column exists */ |
|
455 j = 0, len = 0; |
|
456 loop: if (indicator(csa, 0)) goto done; |
|
457 /* field 1 must be blank */ |
|
458 if (csa->deck) |
|
459 { read_field(csa); |
|
460 if (csa->field[0] != '\0') |
|
461 error(csa, "field 1 must be blank\n"); |
|
462 } |
|
463 else |
|
464 csa->fldno++; |
|
465 /* field 2: column or kind name */ |
|
466 read_field(csa), patch_name(csa, csa->field); |
|
467 strcpy(name, csa->field); |
|
468 /* field 3: row name or keyword 'MARKER' */ |
|
469 read_field(csa), patch_name(csa, csa->field); |
|
470 if (strcmp(csa->field, "'MARKER'") == 0) |
|
471 { /* process kind data record */ |
|
472 /* field 4 must be blank */ |
|
473 if (csa->deck) |
|
474 { read_field(csa); |
|
475 if (csa->field[0] != '\0') |
|
476 error(csa, "field 4 must be blank\n"); |
|
477 } |
|
478 else |
|
479 csa->fldno++; |
|
480 /* field 5: keyword 'INTORG' or 'INTEND' */ |
|
481 read_field(csa), patch_name(csa, csa->field); |
|
482 if (strcmp(csa->field, "'INTORG'") == 0) |
|
483 kind = GLP_IV; |
|
484 else if (strcmp(csa->field, "'INTEND'") == 0) |
|
485 kind = GLP_CV; |
|
486 else if (csa->field[0] == '\0') |
|
487 error(csa, "missing keyword in field 5\n"); |
|
488 else |
|
489 error(csa, "invalid keyword in field 5\n"); |
|
490 /* field 6 must be blank */ |
|
491 skip_field(csa); |
|
492 goto loop; |
|
493 } |
|
494 /* process column name specified in field 2 */ |
|
495 if (name[0] == '\0') |
|
496 { /* the same column as in previous data record */ |
|
497 if (j == 0) |
|
498 error(csa, "missing column name in field 2\n"); |
|
499 } |
|
500 else if (j != 0 && strcmp(name, csa->P->col[j]->name) == 0) |
|
501 { /* the same column as in previous data record */ |
|
502 xassert(j != 0); |
|
503 } |
|
504 else |
|
505 { /* store the current column */ |
|
506 if (j != 0) |
|
507 { glp_set_mat_col(csa->P, j, len, ind, val); |
|
508 while (len > 0) flag[ind[len--]] = 0; |
|
509 } |
|
510 /* create new column */ |
|
511 if (glp_find_col(csa->P, name) != 0) |
|
512 error(csa, "column `%s' multiply specified\n", name); |
|
513 j = glp_add_cols(csa->P, 1); |
|
514 glp_set_col_name(csa->P, j, name); |
|
515 glp_set_col_kind(csa->P, j, kind); |
|
516 if (kind == GLP_CV) |
|
517 glp_set_col_bnds(csa->P, j, GLP_LO, 0.0, 0.0); |
|
518 else if (kind == GLP_IV) |
|
519 glp_set_col_bnds(csa->P, j, GLP_DB, 0.0, 1.0); |
|
520 else |
|
521 xassert(kind != kind); |
|
522 } |
|
523 /* process fields 3-4 and 5-6 */ |
|
524 for (f = 3; f <= 5; f += 2) |
|
525 { /* field 3 or 5: row name */ |
|
526 if (f == 3) |
|
527 { if (csa->field[0] == '\0') |
|
528 error(csa, "missing row name in field 3\n"); |
|
529 } |
|
530 else |
|
531 { read_field(csa), patch_name(csa, csa->field); |
|
532 if (csa->field[0] == '\0') |
|
533 { /* if field 5 is blank, field 6 also must be blank */ |
|
534 skip_field(csa); |
|
535 continue; |
|
536 } |
|
537 } |
|
538 i = glp_find_row(csa->P, csa->field); |
|
539 if (i == 0) |
|
540 error(csa, "row `%s' not found\n", csa->field); |
|
541 if (flag[i]) |
|
542 error(csa, "duplicate coefficient in row `%s'\n", |
|
543 csa->field); |
|
544 /* field 4 or 6: coefficient value */ |
|
545 aij = read_number(csa); |
|
546 if (fabs(aij) < csa->parm->tol_mps) aij = 0.0; |
|
547 len++, ind[len] = i, val[len] = aij, flag[i] = 1; |
|
548 } |
|
549 goto loop; |
|
550 done: /* store the last column */ |
|
551 if (j != 0) |
|
552 glp_set_mat_col(csa->P, j, len, ind, val); |
|
553 /* free working arrays */ |
|
554 xfree(ind); |
|
555 xfree(val); |
|
556 xfree(flag); |
|
557 csa->work1 = csa->work2 = csa->work3 = NULL; |
|
558 return; |
|
559 } |
|
560 |
|
561 static void read_rhs(struct csa *csa) |
|
562 { /* read RHS section */ |
|
563 int i, f, v, type; |
|
564 double rhs; |
|
565 char name[255+1], *flag; |
|
566 /* allocate working array */ |
|
567 csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); |
|
568 memset(&flag[1], 0, csa->P->m); |
|
569 /* no current RHS vector exists */ |
|
570 v = 0; |
|
571 loop: if (indicator(csa, 0)) goto done; |
|
572 /* field 1 must be blank */ |
|
573 if (csa->deck) |
|
574 { read_field(csa); |
|
575 if (csa->field[0] != '\0') |
|
576 error(csa, "field 1 must be blank\n"); |
|
577 } |
|
578 else |
|
579 csa->fldno++; |
|
580 /* field 2: RHS vector name */ |
|
581 read_field(csa), patch_name(csa, csa->field); |
|
582 if (csa->field[0] == '\0') |
|
583 { /* the same RHS vector as in previous data record */ |
|
584 if (v == 0) |
|
585 { warning(csa, "missing RHS vector name in field 2\n"); |
|
586 goto blnk; |
|
587 } |
|
588 } |
|
589 else if (v != 0 && strcmp(csa->field, name) == 0) |
|
590 { /* the same RHS vector as in previous data record */ |
|
591 xassert(v != 0); |
|
592 } |
|
593 else |
|
594 blnk: { /* new RHS vector */ |
|
595 if (v != 0) |
|
596 error(csa, "multiple RHS vectors not supported\n"); |
|
597 v++; |
|
598 strcpy(name, csa->field); |
|
599 } |
|
600 /* process fields 3-4 and 5-6 */ |
|
601 for (f = 3; f <= 5; f += 2) |
|
602 { /* field 3 or 5: row name */ |
|
603 read_field(csa), patch_name(csa, csa->field); |
|
604 if (csa->field[0] == '\0') |
|
605 { if (f == 3) |
|
606 error(csa, "missing row name in field 3\n"); |
|
607 else |
|
608 { /* if field 5 is blank, field 6 also must be blank */ |
|
609 skip_field(csa); |
|
610 continue; |
|
611 } |
|
612 } |
|
613 i = glp_find_row(csa->P, csa->field); |
|
614 if (i == 0) |
|
615 error(csa, "row `%s' not found\n", csa->field); |
|
616 if (flag[i]) |
|
617 error(csa, "duplicate right-hand side for row `%s'\n", |
|
618 csa->field); |
|
619 /* field 4 or 6: right-hand side value */ |
|
620 rhs = read_number(csa); |
|
621 if (fabs(rhs) < csa->parm->tol_mps) rhs = 0.0; |
|
622 type = csa->P->row[i]->type; |
|
623 if (type == GLP_FR) |
|
624 { if (i == csa->obj_row) |
|
625 glp_set_obj_coef(csa->P, 0, rhs); |
|
626 else if (rhs != 0.0) |
|
627 warning(csa, "non-zero right-hand side for free row `%s'" |
|
628 " ignored\n", csa->P->row[i]->name); |
|
629 } |
|
630 else |
|
631 glp_set_row_bnds(csa->P, i, type, rhs, rhs); |
|
632 flag[i] = 1; |
|
633 } |
|
634 goto loop; |
|
635 done: /* free working array */ |
|
636 xfree(flag); |
|
637 csa->work3 = NULL; |
|
638 return; |
|
639 } |
|
640 |
|
641 static void read_ranges(struct csa *csa) |
|
642 { /* read RANGES section */ |
|
643 int i, f, v, type; |
|
644 double rhs, rng; |
|
645 char name[255+1], *flag; |
|
646 /* allocate working array */ |
|
647 csa->work3 = flag = xcalloc(1+csa->P->m, sizeof(char)); |
|
648 memset(&flag[1], 0, csa->P->m); |
|
649 /* no current RANGES vector exists */ |
|
650 v = 0; |
|
651 loop: if (indicator(csa, 0)) goto done; |
|
652 /* field 1 must be blank */ |
|
653 if (csa->deck) |
|
654 { read_field(csa); |
|
655 if (csa->field[0] != '\0') |
|
656 error(csa, "field 1 must be blank\n"); |
|
657 } |
|
658 else |
|
659 csa->fldno++; |
|
660 /* field 2: RANGES vector name */ |
|
661 read_field(csa), patch_name(csa, csa->field); |
|
662 if (csa->field[0] == '\0') |
|
663 { /* the same RANGES vector as in previous data record */ |
|
664 if (v == 0) |
|
665 { warning(csa, "missing RANGES vector name in field 2\n"); |
|
666 goto blnk; |
|
667 } |
|
668 } |
|
669 else if (v != 0 && strcmp(csa->field, name) == 0) |
|
670 { /* the same RANGES vector as in previous data record */ |
|
671 xassert(v != 0); |
|
672 } |
|
673 else |
|
674 blnk: { /* new RANGES vector */ |
|
675 if (v != 0) |
|
676 error(csa, "multiple RANGES vectors not supported\n"); |
|
677 v++; |
|
678 strcpy(name, csa->field); |
|
679 } |
|
680 /* process fields 3-4 and 5-6 */ |
|
681 for (f = 3; f <= 5; f += 2) |
|
682 { /* field 3 or 5: row name */ |
|
683 read_field(csa), patch_name(csa, csa->field); |
|
684 if (csa->field[0] == '\0') |
|
685 { if (f == 3) |
|
686 error(csa, "missing row name in field 3\n"); |
|
687 else |
|
688 { /* if field 5 is blank, field 6 also must be blank */ |
|
689 skip_field(csa); |
|
690 continue; |
|
691 } |
|
692 } |
|
693 i = glp_find_row(csa->P, csa->field); |
|
694 if (i == 0) |
|
695 error(csa, "row `%s' not found\n", csa->field); |
|
696 if (flag[i]) |
|
697 error(csa, "duplicate range for row `%s'\n", csa->field); |
|
698 /* field 4 or 6: range value */ |
|
699 rng = read_number(csa); |
|
700 if (fabs(rng) < csa->parm->tol_mps) rng = 0.0; |
|
701 type = csa->P->row[i]->type; |
|
702 if (type == GLP_FR) |
|
703 warning(csa, "range for free row `%s' ignored\n", |
|
704 csa->P->row[i]->name); |
|
705 else if (type == GLP_LO) |
|
706 { rhs = csa->P->row[i]->lb; |
|
707 glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB, |
|
708 rhs, rhs + fabs(rng)); |
|
709 } |
|
710 else if (type == GLP_UP) |
|
711 { rhs = csa->P->row[i]->ub; |
|
712 glp_set_row_bnds(csa->P, i, rhs == 0.0 ? GLP_FX : GLP_DB, |
|
713 rhs - fabs(rng), rhs); |
|
714 } |
|
715 else if (type == GLP_FX) |
|
716 { rhs = csa->P->row[i]->lb; |
|
717 if (rng > 0.0) |
|
718 glp_set_row_bnds(csa->P, i, GLP_DB, rhs, rhs + rng); |
|
719 else if (rng < 0.0) |
|
720 glp_set_row_bnds(csa->P, i, GLP_DB, rhs + rng, rhs); |
|
721 } |
|
722 else |
|
723 xassert(type != type); |
|
724 flag[i] = 1; |
|
725 } |
|
726 goto loop; |
|
727 done: /* free working array */ |
|
728 xfree(flag); |
|
729 csa->work3 = NULL; |
|
730 return; |
|
731 } |
|
732 |
|
733 static void read_bounds(struct csa *csa) |
|
734 { /* read BOUNDS section */ |
|
735 GLPCOL *col; |
|
736 int j, v, mask, data; |
|
737 double bnd, lb, ub; |
|
738 char type[2+1], name[255+1], *flag; |
|
739 /* allocate working array */ |
|
740 csa->work3 = flag = xcalloc(1+csa->P->n, sizeof(char)); |
|
741 memset(&flag[1], 0, csa->P->n); |
|
742 /* no current BOUNDS vector exists */ |
|
743 v = 0; |
|
744 loop: if (indicator(csa, 0)) goto done; |
|
745 /* field 1: bound type */ |
|
746 read_field(csa); |
|
747 if (strcmp(csa->field, "LO") == 0) |
|
748 mask = 0x01, data = 1; |
|
749 else if (strcmp(csa->field, "UP") == 0) |
|
750 mask = 0x10, data = 1; |
|
751 else if (strcmp(csa->field, "FX") == 0) |
|
752 mask = 0x11, data = 1; |
|
753 else if (strcmp(csa->field, "FR") == 0) |
|
754 mask = 0x11, data = 0; |
|
755 else if (strcmp(csa->field, "MI") == 0) |
|
756 mask = 0x01, data = 0; |
|
757 else if (strcmp(csa->field, "PL") == 0) |
|
758 mask = 0x10, data = 0; |
|
759 else if (strcmp(csa->field, "LI") == 0) |
|
760 mask = 0x01, data = 1; |
|
761 else if (strcmp(csa->field, "UI") == 0) |
|
762 mask = 0x10, data = 1; |
|
763 else if (strcmp(csa->field, "BV") == 0) |
|
764 mask = 0x11, data = 0; |
|
765 else if (csa->field[0] == '\0') |
|
766 error(csa, "missing bound type in field 1\n"); |
|
767 else |
|
768 error(csa, "invalid bound type in field 1\n"); |
|
769 strcpy(type, csa->field); |
|
770 /* field 2: BOUNDS vector name */ |
|
771 read_field(csa), patch_name(csa, csa->field); |
|
772 if (csa->field[0] == '\0') |
|
773 { /* the same BOUNDS vector as in previous data record */ |
|
774 if (v == 0) |
|
775 { warning(csa, "missing BOUNDS vector name in field 2\n"); |
|
776 goto blnk; |
|
777 } |
|
778 } |
|
779 else if (v != 0 && strcmp(csa->field, name) == 0) |
|
780 { /* the same BOUNDS vector as in previous data record */ |
|
781 xassert(v != 0); |
|
782 } |
|
783 else |
|
784 blnk: { /* new BOUNDS vector */ |
|
785 if (v != 0) |
|
786 error(csa, "multiple BOUNDS vectors not supported\n"); |
|
787 v++; |
|
788 strcpy(name, csa->field); |
|
789 } |
|
790 /* field 3: column name */ |
|
791 read_field(csa), patch_name(csa, csa->field); |
|
792 if (csa->field[0] == '\0') |
|
793 error(csa, "missing column name in field 3\n"); |
|
794 j = glp_find_col(csa->P, csa->field); |
|
795 if (j == 0) |
|
796 error(csa, "column `%s' not found\n", csa->field); |
|
797 if ((flag[j] & mask) == 0x01) |
|
798 error(csa, "duplicate lower bound for column `%s'\n", |
|
799 csa->field); |
|
800 if ((flag[j] & mask) == 0x10) |
|
801 error(csa, "duplicate upper bound for column `%s'\n", |
|
802 csa->field); |
|
803 xassert((flag[j] & mask) == 0x00); |
|
804 /* field 4: bound value */ |
|
805 if (data) |
|
806 { bnd = read_number(csa); |
|
807 if (fabs(bnd) < csa->parm->tol_mps) bnd = 0.0; |
|
808 } |
|
809 else |
|
810 read_field(csa), bnd = 0.0; |
|
811 /* get current column bounds */ |
|
812 col = csa->P->col[j]; |
|
813 if (col->type == GLP_FR) |
|
814 lb = -DBL_MAX, ub = +DBL_MAX; |
|
815 else if (col->type == GLP_LO) |
|
816 lb = col->lb, ub = +DBL_MAX; |
|
817 else if (col->type == GLP_UP) |
|
818 lb = -DBL_MAX, ub = col->ub; |
|
819 else if (col->type == GLP_DB) |
|
820 lb = col->lb, ub = col->ub; |
|
821 else if (col->type == GLP_FX) |
|
822 lb = ub = col->lb; |
|
823 else |
|
824 xassert(col != col); |
|
825 /* change column bounds */ |
|
826 if (strcmp(type, "LO") == 0) |
|
827 lb = bnd; |
|
828 else if (strcmp(type, "UP") == 0) |
|
829 ub = bnd; |
|
830 else if (strcmp(type, "FX") == 0) |
|
831 lb = ub = bnd; |
|
832 else if (strcmp(type, "FR") == 0) |
|
833 lb = -DBL_MAX, ub = +DBL_MAX; |
|
834 else if (strcmp(type, "MI") == 0) |
|
835 lb = -DBL_MAX; |
|
836 else if (strcmp(type, "PL") == 0) |
|
837 ub = +DBL_MAX; |
|
838 else if (strcmp(type, "LI") == 0) |
|
839 { glp_set_col_kind(csa->P, j, GLP_IV); |
|
840 lb = ceil(bnd); |
|
841 } |
|
842 else if (strcmp(type, "UI") == 0) |
|
843 { glp_set_col_kind(csa->P, j, GLP_IV); |
|
844 ub = floor(bnd); |
|
845 } |
|
846 else if (strcmp(type, "BV") == 0) |
|
847 { glp_set_col_kind(csa->P, j, GLP_IV); |
|
848 lb = 0.0, ub = 1.0; |
|
849 } |
|
850 else |
|
851 xassert(type != type); |
|
852 /* set new column bounds */ |
|
853 if (lb == -DBL_MAX && ub == +DBL_MAX) |
|
854 glp_set_col_bnds(csa->P, j, GLP_FR, lb, ub); |
|
855 else if (ub == +DBL_MAX) |
|
856 glp_set_col_bnds(csa->P, j, GLP_LO, lb, ub); |
|
857 else if (lb == -DBL_MAX) |
|
858 glp_set_col_bnds(csa->P, j, GLP_UP, lb, ub); |
|
859 else if (lb != ub) |
|
860 glp_set_col_bnds(csa->P, j, GLP_DB, lb, ub); |
|
861 else |
|
862 glp_set_col_bnds(csa->P, j, GLP_FX, lb, ub); |
|
863 flag[j] |= (char)mask; |
|
864 /* fields 5 and 6 must be blank */ |
|
865 skip_field(csa); |
|
866 skip_field(csa); |
|
867 goto loop; |
|
868 done: /* free working array */ |
|
869 xfree(flag); |
|
870 csa->work3 = NULL; |
|
871 return; |
|
872 } |
|
873 |
|
874 int glp_read_mps(glp_prob *P, int fmt, const glp_mpscp *parm, |
|
875 const char *fname) |
|
876 { /* read problem data in MPS format */ |
|
877 glp_mpscp _parm; |
|
878 struct csa _csa, *csa = &_csa; |
|
879 int ret; |
|
880 xprintf("Reading problem data from `%s'...\n", fname); |
|
881 if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE)) |
|
882 xerror("glp_read_mps: fmt = %d; invalid parameter\n", fmt); |
|
883 if (parm == NULL) |
|
884 glp_init_mpscp(&_parm), parm = &_parm; |
|
885 /* check control parameters */ |
|
886 check_parm("glp_read_mps", parm); |
|
887 /* initialize common storage area */ |
|
888 csa->P = P; |
|
889 csa->deck = (fmt == GLP_MPS_DECK); |
|
890 csa->parm = parm; |
|
891 csa->fname = fname; |
|
892 csa->fp = NULL; |
|
893 if (setjmp(csa->jump)) |
|
894 { ret = 1; |
|
895 goto done; |
|
896 } |
|
897 csa->recno = csa->recpos = 0; |
|
898 csa->c = '\n'; |
|
899 csa->fldno = 0; |
|
900 csa->field[0] = '\0'; |
|
901 csa->w80 = csa->wef = 0; |
|
902 csa->obj_row = 0; |
|
903 csa->work1 = csa->work2 = csa->work3 = NULL; |
|
904 /* erase problem object */ |
|
905 glp_erase_prob(P); |
|
906 glp_create_index(P); |
|
907 /* open input MPS file */ |
|
908 csa->fp = xfopen(fname, "r"); |
|
909 if (csa->fp == NULL) |
|
910 { xprintf("Unable to open `%s' - %s\n", fname, xerrmsg()); |
|
911 ret = 1; |
|
912 goto done; |
|
913 } |
|
914 /* read NAME indicator record */ |
|
915 read_name(csa); |
|
916 if (P->name != NULL) |
|
917 xprintf("Problem: %s\n", P->name); |
|
918 /* read ROWS section */ |
|
919 if (!(indicator(csa, 0) && strcmp(csa->field, "ROWS") == 0)) |
|
920 error(csa, "missing ROWS indicator record\n"); |
|
921 read_rows(csa); |
|
922 /* determine objective row */ |
|
923 if (parm->obj_name == NULL || parm->obj_name[0] == '\0') |
|
924 { /* use the first row of N type */ |
|
925 int i; |
|
926 for (i = 1; i <= P->m; i++) |
|
927 { if (P->row[i]->type == GLP_FR) |
|
928 { csa->obj_row = i; |
|
929 break; |
|
930 } |
|
931 } |
|
932 if (csa->obj_row == 0) |
|
933 warning(csa, "unable to determine objective row\n"); |
|
934 } |
|
935 else |
|
936 { /* use a row with specified name */ |
|
937 int i; |
|
938 for (i = 1; i <= P->m; i++) |
|
939 { xassert(P->row[i]->name != NULL); |
|
940 if (strcmp(parm->obj_name, P->row[i]->name) == 0) |
|
941 { csa->obj_row = i; |
|
942 break; |
|
943 } |
|
944 } |
|
945 if (csa->obj_row == 0) |
|
946 error(csa, "objective row `%s' not found\n", |
|
947 parm->obj_name); |
|
948 } |
|
949 if (csa->obj_row != 0) |
|
950 { glp_set_obj_name(P, P->row[csa->obj_row]->name); |
|
951 xprintf("Objective: %s\n", P->obj); |
|
952 } |
|
953 /* read COLUMNS section */ |
|
954 if (strcmp(csa->field, "COLUMNS") != 0) |
|
955 error(csa, "missing COLUMNS indicator record\n"); |
|
956 read_columns(csa); |
|
957 /* set objective coefficients */ |
|
958 if (csa->obj_row != 0) |
|
959 { GLPAIJ *aij; |
|
960 for (aij = P->row[csa->obj_row]->ptr; aij != NULL; aij = |
|
961 aij->r_next) glp_set_obj_coef(P, aij->col->j, aij->val); |
|
962 } |
|
963 /* read optional RHS section */ |
|
964 if (strcmp(csa->field, "RHS") == 0) |
|
965 read_rhs(csa); |
|
966 /* read optional RANGES section */ |
|
967 if (strcmp(csa->field, "RANGES") == 0) |
|
968 read_ranges(csa); |
|
969 /* read optional BOUNDS section */ |
|
970 if (strcmp(csa->field, "BOUNDS") == 0) |
|
971 read_bounds(csa); |
|
972 /* read ENDATA indicator record */ |
|
973 if (strcmp(csa->field, "ENDATA") != 0) |
|
974 error(csa, "invalid use of %s indicator record\n", |
|
975 csa->field); |
|
976 /* print some statistics */ |
|
977 xprintf("%d row%s, %d column%s, %d non-zero%s\n", |
|
978 P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", |
|
979 P->nnz, P->nnz == 1 ? "" : "s"); |
|
980 if (glp_get_num_int(P) > 0) |
|
981 { int ni = glp_get_num_int(P); |
|
982 int nb = glp_get_num_bin(P); |
|
983 if (ni == 1) |
|
984 { if (nb == 0) |
|
985 xprintf("One variable is integer\n"); |
|
986 else |
|
987 xprintf("One variable is binary\n"); |
|
988 } |
|
989 else |
|
990 { xprintf("%d integer variables, ", ni); |
|
991 if (nb == 0) |
|
992 xprintf("none"); |
|
993 else if (nb == 1) |
|
994 xprintf("one"); |
|
995 else if (nb == ni) |
|
996 xprintf("all"); |
|
997 else |
|
998 xprintf("%d", nb); |
|
999 xprintf(" of which %s binary\n", nb == 1 ? "is" : "are"); |
|
1000 } |
|
1001 } |
|
1002 xprintf("%d records were read\n", csa->recno); |
|
1003 /* problem data has been successfully read */ |
|
1004 glp_delete_index(P); |
|
1005 glp_sort_matrix(P); |
|
1006 ret = 0; |
|
1007 done: if (csa->fp != NULL) xfclose(csa->fp); |
|
1008 if (csa->work1 != NULL) xfree(csa->work1); |
|
1009 if (csa->work2 != NULL) xfree(csa->work2); |
|
1010 if (csa->work3 != NULL) xfree(csa->work3); |
|
1011 if (ret != 0) glp_erase_prob(P); |
|
1012 return ret; |
|
1013 } |
|
1014 |
|
1015 /*********************************************************************** |
|
1016 * NAME |
|
1017 * |
|
1018 * glp_write_mps - write problem data in MPS format |
|
1019 * |
|
1020 * SYNOPSIS |
|
1021 * |
|
1022 * int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, |
|
1023 * const char *fname); |
|
1024 * |
|
1025 * DESCRIPTION |
|
1026 * |
|
1027 * The routine glp_write_mps writes problem data in MPS format to a |
|
1028 * text file. |
|
1029 * |
|
1030 * The parameter fmt specifies the version of MPS format: |
|
1031 * |
|
1032 * GLP_MPS_DECK - fixed (ancient) MPS format; |
|
1033 * GLP_MPS_FILE - free (modern) MPS format. |
|
1034 * |
|
1035 * The parameter parm is a pointer to the structure glp_mpscp, which |
|
1036 * specifies control parameters used by the routine. If parm is NULL, |
|
1037 * the routine uses default settings. |
|
1038 * |
|
1039 * The character string fname specifies a name of the text file to be |
|
1040 * written. |
|
1041 * |
|
1042 * RETURNS |
|
1043 * |
|
1044 * If the operation was successful, the routine glp_read_mps returns |
|
1045 * zero. Otherwise, it prints an error message and returns non-zero. */ |
|
1046 |
|
1047 #define csa csa1 |
|
1048 |
|
1049 struct csa |
|
1050 { /* common storage area */ |
|
1051 glp_prob *P; |
|
1052 /* pointer to problem object */ |
|
1053 int deck; |
|
1054 /* MPS format (0 - free, 1 - fixed) */ |
|
1055 const glp_mpscp *parm; |
|
1056 /* pointer to control parameters */ |
|
1057 char field[255+1]; |
|
1058 /* field buffer */ |
|
1059 }; |
|
1060 |
|
1061 static char *mps_name(struct csa *csa) |
|
1062 { /* make problem name */ |
|
1063 char *f; |
|
1064 if (csa->P->name == NULL) |
|
1065 csa->field[0] = '\0'; |
|
1066 else if (csa->deck) |
|
1067 { strncpy(csa->field, csa->P->name, 8); |
|
1068 csa->field[8] = '\0'; |
|
1069 } |
|
1070 else |
|
1071 strcpy(csa->field, csa->P->name); |
|
1072 for (f = csa->field; *f != '\0'; f++) |
|
1073 if (*f == ' ') *f = '_'; |
|
1074 return csa->field; |
|
1075 } |
|
1076 |
|
1077 static char *row_name(struct csa *csa, int i) |
|
1078 { /* make i-th row name */ |
|
1079 char *f; |
|
1080 xassert(0 <= i && i <= csa->P->m); |
|
1081 if (i == 0 || csa->P->row[i]->name == NULL || |
|
1082 csa->deck && strlen(csa->P->row[i]->name) > 8) |
|
1083 sprintf(csa->field, "R%07d", i); |
|
1084 else |
|
1085 { strcpy(csa->field, csa->P->row[i]->name); |
|
1086 for (f = csa->field; *f != '\0'; f++) |
|
1087 if (*f == ' ') *f = '_'; |
|
1088 } |
|
1089 return csa->field; |
|
1090 } |
|
1091 |
|
1092 static char *col_name(struct csa *csa, int j) |
|
1093 { /* make j-th column name */ |
|
1094 char *f; |
|
1095 xassert(1 <= j && j <= csa->P->n); |
|
1096 if (csa->P->col[j]->name == NULL || |
|
1097 csa->deck && strlen(csa->P->col[j]->name) > 8) |
|
1098 sprintf(csa->field, "C%07d", j); |
|
1099 else |
|
1100 { strcpy(csa->field, csa->P->col[j]->name); |
|
1101 for (f = csa->field; *f != '\0'; f++) |
|
1102 if (*f == ' ') *f = '_'; |
|
1103 } |
|
1104 return csa->field; |
|
1105 } |
|
1106 |
|
1107 static char *mps_numb(struct csa *csa, double val) |
|
1108 { /* format floating-point number */ |
|
1109 int dig; |
|
1110 char *exp; |
|
1111 for (dig = 12; dig >= 6; dig--) |
|
1112 { if (val != 0.0 && fabs(val) < 0.002) |
|
1113 sprintf(csa->field, "%.*E", dig-1, val); |
|
1114 else |
|
1115 sprintf(csa->field, "%.*G", dig, val); |
|
1116 exp = strchr(csa->field, 'E'); |
|
1117 if (exp != NULL) |
|
1118 sprintf(exp+1, "%d", atoi(exp+1)); |
|
1119 if (strlen(csa->field) <= 12) break; |
|
1120 } |
|
1121 xassert(strlen(csa->field) <= 12); |
|
1122 return csa->field; |
|
1123 } |
|
1124 |
|
1125 int glp_write_mps(glp_prob *P, int fmt, const glp_mpscp *parm, |
|
1126 const char *fname) |
|
1127 { /* write problem data in MPS format */ |
|
1128 glp_mpscp _parm; |
|
1129 struct csa _csa, *csa = &_csa; |
|
1130 XFILE *fp; |
|
1131 int out_obj, one_col = 0, empty = 0; |
|
1132 int i, j, recno, marker, count, gap, ret; |
|
1133 xprintf("Writing problem data to `%s'...\n", fname); |
|
1134 if (!(fmt == GLP_MPS_DECK || fmt == GLP_MPS_FILE)) |
|
1135 xerror("glp_write_mps: fmt = %d; invalid parameter\n", fmt); |
|
1136 if (parm == NULL) |
|
1137 glp_init_mpscp(&_parm), parm = &_parm; |
|
1138 /* check control parameters */ |
|
1139 check_parm("glp_write_mps", parm); |
|
1140 /* initialize common storage area */ |
|
1141 csa->P = P; |
|
1142 csa->deck = (fmt == GLP_MPS_DECK); |
|
1143 csa->parm = parm; |
|
1144 /* create output MPS file */ |
|
1145 fp = xfopen(fname, "w"), recno = 0; |
|
1146 if (fp == NULL) |
|
1147 { xprintf("Unable to create `%s' - %s\n", fname, xerrmsg()); |
|
1148 ret = 1; |
|
1149 goto done; |
|
1150 } |
|
1151 /* write comment records */ |
|
1152 xfprintf(fp, "* %-*s%s\n", P->name == NULL ? 1 : 12, "Problem:", |
|
1153 P->name == NULL ? "" : P->name), recno++; |
|
1154 xfprintf(fp, "* %-12s%s\n", "Class:", glp_get_num_int(P) == 0 ? |
|
1155 "LP" : "MIP"), recno++; |
|
1156 xfprintf(fp, "* %-12s%d\n", "Rows:", P->m), recno++; |
|
1157 if (glp_get_num_int(P) == 0) |
|
1158 xfprintf(fp, "* %-12s%d\n", "Columns:", P->n), recno++; |
|
1159 else |
|
1160 xfprintf(fp, "* %-12s%d (%d integer, %d binary)\n", |
|
1161 "Columns:", P->n, glp_get_num_int(P), glp_get_num_bin(P)), |
|
1162 recno++; |
|
1163 xfprintf(fp, "* %-12s%d\n", "Non-zeros:", P->nnz), recno++; |
|
1164 xfprintf(fp, "* %-12s%s\n", "Format:", csa->deck ? "Fixed MPS" : |
|
1165 "Free MPS"), recno++; |
|
1166 xfprintf(fp, "*\n", recno++); |
|
1167 /* write NAME indicator record */ |
|
1168 xfprintf(fp, "NAME%*s%s\n", |
|
1169 P->name == NULL ? 0 : csa->deck ? 10 : 1, "", mps_name(csa)), |
|
1170 recno++; |
|
1171 #if 1 |
|
1172 /* determine whether to write the objective row */ |
|
1173 out_obj = 1; |
|
1174 for (i = 1; i <= P->m; i++) |
|
1175 { if (P->row[i]->type == GLP_FR) |
|
1176 { out_obj = 0; |
|
1177 break; |
|
1178 } |
|
1179 } |
|
1180 #endif |
|
1181 /* write ROWS section */ |
|
1182 xfprintf(fp, "ROWS\n"), recno++; |
|
1183 for (i = (out_obj ? 0 : 1); i <= P->m; i++) |
|
1184 { int type; |
|
1185 type = (i == 0 ? GLP_FR : P->row[i]->type); |
|
1186 if (type == GLP_FR) |
|
1187 type = 'N'; |
|
1188 else if (type == GLP_LO) |
|
1189 type = 'G'; |
|
1190 else if (type == GLP_UP) |
|
1191 type = 'L'; |
|
1192 else if (type == GLP_DB || type == GLP_FX) |
|
1193 type = 'E'; |
|
1194 else |
|
1195 xassert(type != type); |
|
1196 xfprintf(fp, " %c%*s%s\n", type, csa->deck ? 2 : 1, "", |
|
1197 row_name(csa, i)), recno++; |
|
1198 } |
|
1199 /* write COLUMNS section */ |
|
1200 xfprintf(fp, "COLUMNS\n"), recno++; |
|
1201 marker = 0; |
|
1202 for (j = 1; j <= P->n; j++) |
|
1203 { GLPAIJ cj, *aij; |
|
1204 int kind; |
|
1205 kind = P->col[j]->kind; |
|
1206 if (kind == GLP_CV) |
|
1207 { if (marker % 2 == 1) |
|
1208 { /* close current integer block */ |
|
1209 marker++; |
|
1210 xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n", |
|
1211 csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", |
|
1212 csa->deck ? 17 : 1, ""), recno++; |
|
1213 } |
|
1214 } |
|
1215 else if (kind == GLP_IV) |
|
1216 { if (marker % 2 == 0) |
|
1217 { /* open new integer block */ |
|
1218 marker++; |
|
1219 xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTORG'\n", |
|
1220 csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", |
|
1221 csa->deck ? 17 : 1, ""), recno++; |
|
1222 } |
|
1223 } |
|
1224 else |
|
1225 xassert(kind != kind); |
|
1226 if (out_obj && P->col[j]->coef != 0.0) |
|
1227 { /* make fake objective coefficient */ |
|
1228 aij = &cj; |
|
1229 aij->row = NULL; |
|
1230 aij->val = P->col[j]->coef; |
|
1231 aij->c_next = P->col[j]->ptr; |
|
1232 } |
|
1233 else |
|
1234 aij = P->col[j]->ptr; |
|
1235 #if 1 /* FIXME */ |
|
1236 if (aij == NULL) |
|
1237 { /* empty column */ |
|
1238 empty++; |
|
1239 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", |
|
1240 csa->deck ? 8 : 1, col_name(csa, j)); |
|
1241 /* we need a row */ |
|
1242 xassert(P->m > 0); |
|
1243 xfprintf(fp, "%*s%-*s", |
|
1244 csa->deck ? 2 : 1, "", csa->deck ? 8 : 1, |
|
1245 row_name(csa, 1)); |
|
1246 xfprintf(fp, "%*s0%*s$ empty column\n", |
|
1247 csa->deck ? 13 : 1, "", csa->deck ? 3 : 1, ""), recno++; |
|
1248 } |
|
1249 #endif |
|
1250 count = 0; |
|
1251 for (aij = aij; aij != NULL; aij = aij->c_next) |
|
1252 { if (one_col || count % 2 == 0) |
|
1253 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", |
|
1254 csa->deck ? 8 : 1, col_name(csa, j)); |
|
1255 gap = (one_col || count % 2 == 0 ? 2 : 3); |
|
1256 xfprintf(fp, "%*s%-*s", |
|
1257 csa->deck ? gap : 1, "", csa->deck ? 8 : 1, |
|
1258 row_name(csa, aij->row == NULL ? 0 : aij->row->i)); |
|
1259 xfprintf(fp, "%*s%*s", |
|
1260 csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, |
|
1261 mps_numb(csa, aij->val)), count++; |
|
1262 if (one_col || count % 2 == 0) |
|
1263 xfprintf(fp, "\n"), recno++; |
|
1264 } |
|
1265 if (!(one_col || count % 2 == 0)) |
|
1266 xfprintf(fp, "\n"), recno++; |
|
1267 } |
|
1268 if (marker % 2 == 1) |
|
1269 { /* close last integer block */ |
|
1270 marker++; |
|
1271 xfprintf(fp, "%*sM%07d%*s'MARKER'%*s'INTEND'\n", |
|
1272 csa->deck ? 4 : 1, "", marker, csa->deck ? 2 : 1, "", |
|
1273 csa->deck ? 17 : 1, ""), recno++; |
|
1274 } |
|
1275 #if 1 |
|
1276 if (empty > 0) |
|
1277 xprintf("Warning: problem has %d empty column(s)\n", empty); |
|
1278 #endif |
|
1279 /* write RHS section */ |
|
1280 xfprintf(fp, "RHS\n"), recno++; |
|
1281 count = 0; |
|
1282 for (i = (out_obj ? 0 : 1); i <= P->m; i++) |
|
1283 { int type; |
|
1284 double rhs; |
|
1285 if (i == 0) |
|
1286 rhs = P->c0; |
|
1287 else |
|
1288 { type = P->row[i]->type; |
|
1289 if (type == GLP_FR) |
|
1290 rhs = 0.0; |
|
1291 else if (type == GLP_LO) |
|
1292 rhs = P->row[i]->lb; |
|
1293 else if (type == GLP_UP) |
|
1294 rhs = P->row[i]->ub; |
|
1295 else if (type == GLP_DB || type == GLP_FX) |
|
1296 rhs = P->row[i]->lb; |
|
1297 else |
|
1298 xassert(type != type); |
|
1299 } |
|
1300 if (rhs != 0.0) |
|
1301 { if (one_col || count % 2 == 0) |
|
1302 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", |
|
1303 csa->deck ? 8 : 1, "RHS1"); |
|
1304 gap = (one_col || count % 2 == 0 ? 2 : 3); |
|
1305 xfprintf(fp, "%*s%-*s", |
|
1306 csa->deck ? gap : 1, "", csa->deck ? 8 : 1, |
|
1307 row_name(csa, i)); |
|
1308 xfprintf(fp, "%*s%*s", |
|
1309 csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, |
|
1310 mps_numb(csa, rhs)), count++; |
|
1311 if (one_col || count % 2 == 0) |
|
1312 xfprintf(fp, "\n"), recno++; |
|
1313 } |
|
1314 } |
|
1315 if (!(one_col || count % 2 == 0)) |
|
1316 xfprintf(fp, "\n"), recno++; |
|
1317 /* write RANGES section */ |
|
1318 for (i = P->m; i >= 1; i--) |
|
1319 if (P->row[i]->type == GLP_DB) break; |
|
1320 if (i == 0) goto bnds; |
|
1321 xfprintf(fp, "RANGES\n"), recno++; |
|
1322 count = 0; |
|
1323 for (i = 1; i <= P->m; i++) |
|
1324 { if (P->row[i]->type == GLP_DB) |
|
1325 { if (one_col || count % 2 == 0) |
|
1326 xfprintf(fp, "%*s%-*s", csa->deck ? 4 : 1, "", |
|
1327 csa->deck ? 8 : 1, "RNG1"); |
|
1328 gap = (one_col || count % 2 == 0 ? 2 : 3); |
|
1329 xfprintf(fp, "%*s%-*s", |
|
1330 csa->deck ? gap : 1, "", csa->deck ? 8 : 1, |
|
1331 row_name(csa, i)); |
|
1332 xfprintf(fp, "%*s%*s", |
|
1333 csa->deck ? 2 : 1, "", csa->deck ? 12 : 1, |
|
1334 mps_numb(csa, P->row[i]->ub - P->row[i]->lb)), count++; |
|
1335 if (one_col || count % 2 == 0) |
|
1336 xfprintf(fp, "\n"), recno++; |
|
1337 } |
|
1338 } |
|
1339 if (!(one_col || count % 2 == 0)) |
|
1340 xfprintf(fp, "\n"), recno++; |
|
1341 bnds: /* write BOUNDS section */ |
|
1342 for (j = P->n; j >= 1; j--) |
|
1343 if (!(P->col[j]->type == GLP_LO && P->col[j]->lb == 0.0)) |
|
1344 break; |
|
1345 if (j == 0) goto endt; |
|
1346 xfprintf(fp, "BOUNDS\n"), recno++; |
|
1347 for (j = 1; j <= P->n; j++) |
|
1348 { int type, data[2]; |
|
1349 double bnd[2]; |
|
1350 char *spec[2]; |
|
1351 spec[0] = spec[1] = NULL; |
|
1352 type = P->col[j]->type; |
|
1353 if (type == GLP_FR) |
|
1354 spec[0] = "FR", data[0] = 0; |
|
1355 else if (type == GLP_LO) |
|
1356 { if (P->col[j]->lb != 0.0) |
|
1357 spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb; |
|
1358 if (P->col[j]->kind == GLP_IV) |
|
1359 spec[1] = "PL", data[1] = 0; |
|
1360 } |
|
1361 else if (type == GLP_UP) |
|
1362 { spec[0] = "MI", data[0] = 0; |
|
1363 spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub; |
|
1364 } |
|
1365 else if (type == GLP_DB) |
|
1366 { if (P->col[j]->lb != 0.0) |
|
1367 spec[0] = "LO", data[0] = 1, bnd[0] = P->col[j]->lb; |
|
1368 spec[1] = "UP", data[1] = 1, bnd[1] = P->col[j]->ub; |
|
1369 } |
|
1370 else if (type == GLP_FX) |
|
1371 spec[0] = "FX", data[0] = 1, bnd[0] = P->col[j]->lb; |
|
1372 else |
|
1373 xassert(type != type); |
|
1374 for (i = 0; i <= 1; i++) |
|
1375 { if (spec[i] != NULL) |
|
1376 { xfprintf(fp, " %s %-*s%*s%-*s", spec[i], |
|
1377 csa->deck ? 8 : 1, "BND1", csa->deck ? 2 : 1, "", |
|
1378 csa->deck ? 8 : 1, col_name(csa, j)); |
|
1379 if (data[i]) |
|
1380 xfprintf(fp, "%*s%*s", csa->deck ? 2 : 1, "", |
|
1381 csa->deck ? 12 : 1, mps_numb(csa, bnd[i])); |
|
1382 xfprintf(fp, "\n"), recno++; |
|
1383 } |
|
1384 } |
|
1385 } |
|
1386 endt: /* write ENDATA indicator record */ |
|
1387 xfprintf(fp, "ENDATA\n"), recno++; |
|
1388 xfflush(fp); |
|
1389 if (xferror(fp)) |
|
1390 { xprintf("Write error on `%s' - %s\n", fname, xerrmsg()); |
|
1391 ret = 1; |
|
1392 goto done; |
|
1393 } |
|
1394 /* problem data has been successfully written */ |
|
1395 xprintf("%d records were written\n", recno); |
|
1396 ret = 0; |
|
1397 done: if (fp != NULL) xfclose(fp); |
|
1398 return ret; |
|
1399 } |
|
1400 |
|
1401 /* eof */ |