COIN-OR::LEMON - Graph Library

source: lemon-project-template-glpk/deps/glpk/src/glpmpl02.c @ 9:33de93886c88

subpack-glpk
Last change on this file since 9:33de93886c88 was 9:33de93886c88, checked in by Alpar Juttner <alpar@…>, 12 years ago

Import GLPK 4.47

File size: 44.5 KB
Line 
1/* glpmpl02.c */
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, 2011 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#define _GLPSTD_STDIO
26#include "glpenv.h"
27#include "glpmpl.h"
28
29/**********************************************************************/
30/* * *                  PROCESSING DATA SECTION                   * * */
31/**********************************************************************/
32
33/*----------------------------------------------------------------------
34-- create_slice - create slice.
35--
36-- This routine creates a slice, which initially has no components. */
37
38SLICE *create_slice(MPL *mpl)
39{     SLICE *slice;
40      xassert(mpl == mpl);
41      slice = NULL;
42      return slice;
43}
44
45/*----------------------------------------------------------------------
46-- expand_slice - append new component to slice.
47--
48-- This routine expands slice appending to it either a given symbol or
49-- null component, which becomes the last component of the slice. */
50
51SLICE *expand_slice
52(     MPL *mpl,
53      SLICE *slice,           /* destroyed */
54      SYMBOL *sym             /* destroyed */
55)
56{     SLICE *tail, *temp;
57      /* create a new component */
58      tail = dmp_get_atom(mpl->tuples, sizeof(SLICE));
59      tail->sym = sym;
60      tail->next = NULL;
61      /* and append it to the component list */
62      if (slice == NULL)
63         slice = tail;
64      else
65      {  for (temp = slice; temp->next != NULL; temp = temp->next);
66         temp->next = tail;
67      }
68      return slice;
69}
70
71/*----------------------------------------------------------------------
72-- slice_dimen - determine dimension of slice.
73--
74-- This routine returns dimension of slice, which is number of all its
75-- components including null ones. */
76
77int slice_dimen
78(     MPL *mpl,
79      SLICE *slice            /* not changed */
80)
81{     SLICE *temp;
82      int dim;
83      xassert(mpl == mpl);
84      dim = 0;
85      for (temp = slice; temp != NULL; temp = temp->next) dim++;
86      return dim;
87}
88
89/*----------------------------------------------------------------------
90-- slice_arity - determine arity of slice.
91--
92-- This routine returns arity of slice, i.e. number of null components
93-- (indicated by asterisks) in the slice. */
94
95int slice_arity
96(     MPL *mpl,
97      SLICE *slice            /* not changed */
98)
99{     SLICE *temp;
100      int arity;
101      xassert(mpl == mpl);
102      arity = 0;
103      for (temp = slice; temp != NULL; temp = temp->next)
104         if (temp->sym == NULL) arity++;
105      return arity;
106}
107
108/*----------------------------------------------------------------------
109-- fake_slice - create fake slice of all asterisks.
110--
111-- This routine creates a fake slice of given dimension, which contains
112-- asterisks in all components. Zero dimension is allowed. */
113
114SLICE *fake_slice(MPL *mpl, int dim)
115{     SLICE *slice;
116      slice = create_slice(mpl);
117      while (dim-- > 0) slice = expand_slice(mpl, slice, NULL);
118      return slice;
119}
120
121/*----------------------------------------------------------------------
122-- delete_slice - delete slice.
123--
124-- This routine deletes specified slice. */
125
126void delete_slice
127(     MPL *mpl,
128      SLICE *slice            /* destroyed */
129)
130{     SLICE *temp;
131      while (slice != NULL)
132      {  temp = slice;
133         slice = temp->next;
134         if (temp->sym != NULL) delete_symbol(mpl, temp->sym);
135xassert(sizeof(SLICE) == sizeof(TUPLE));
136         dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE));
137      }
138      return;
139}
140
141/*----------------------------------------------------------------------
142-- is_number - check if current token is number.
143--
144-- If the current token is a number, this routine returns non-zero.
145-- Otherwise zero is returned. */
146
147int is_number(MPL *mpl)
148{     return
149         mpl->token == T_NUMBER;
150}
151
152/*----------------------------------------------------------------------
153-- is_symbol - check if current token is symbol.
154--
155-- If the current token is suitable to be a symbol, the routine returns
156-- non-zero. Otherwise zero is returned. */
157
158int is_symbol(MPL *mpl)
159{     return
160         mpl->token == T_NUMBER ||
161         mpl->token == T_SYMBOL ||
162         mpl->token == T_STRING;
163}
164
165/*----------------------------------------------------------------------
166-- is_literal - check if current token is given symbolic literal.
167--
168-- If the current token is given symbolic literal, this routine returns
169-- non-zero. Otherwise zero is returned.
170--
171-- This routine is used on processing the data section in the same way
172-- as the routine is_keyword on processing the model section. */
173
174int is_literal(MPL *mpl, char *literal)
175{     return
176         is_symbol(mpl) && strcmp(mpl->image, literal) == 0;
177}
178
179/*----------------------------------------------------------------------
180-- read_number - read number.
181--
182-- This routine reads the current token, which must be a number, and
183-- returns its numeric value. */
184
185double read_number(MPL *mpl)
186{     double num;
187      xassert(is_number(mpl));
188      num = mpl->value;
189      get_token(mpl /* <number> */);
190      return num;
191}
192
193/*----------------------------------------------------------------------
194-- read_symbol - read symbol.
195--
196-- This routine reads the current token, which must be a symbol, and
197-- returns its symbolic value. */
198
199SYMBOL *read_symbol(MPL *mpl)
200{     SYMBOL *sym;
201      xassert(is_symbol(mpl));
202      if (is_number(mpl))
203         sym = create_symbol_num(mpl, mpl->value);
204      else
205         sym = create_symbol_str(mpl, create_string(mpl, mpl->image));
206      get_token(mpl /* <symbol> */);
207      return sym;
208}
209
210/*----------------------------------------------------------------------
211-- read_slice - read slice.
212--
213-- This routine reads slice using the syntax:
214--
215-- <slice> ::= [ <symbol list> ]
216-- <slice> ::= ( <symbol list> )
217-- <symbol list> ::= <symbol or star>
218-- <symbol list> ::= <symbol list> , <symbol or star>
219-- <symbol or star> ::= <symbol>
220-- <symbol or star> ::= *
221--
222-- The bracketed form of slice is used for members of multi-dimensional
223-- objects while the parenthesized form is used for elemental sets. */
224
225SLICE *read_slice
226(     MPL *mpl,
227      char *name,             /* not changed */
228      int dim
229)
230{     SLICE *slice;
231      int close;
232      xassert(name != NULL);
233      switch (mpl->token)
234      {  case T_LBRACKET:
235            close = T_RBRACKET;
236            break;
237         case T_LEFT:
238            xassert(dim > 0);
239            close = T_RIGHT;
240            break;
241         default:
242            xassert(mpl != mpl);
243      }
244      if (dim == 0)
245         error(mpl, "%s cannot be subscripted", name);
246      get_token(mpl /* ( | [ */);
247      /* read slice components */
248      slice = create_slice(mpl);
249      for (;;)
250      {  /* the current token must be a symbol or asterisk */
251         if (is_symbol(mpl))
252            slice = expand_slice(mpl, slice, read_symbol(mpl));
253         else if (mpl->token == T_ASTERISK)
254         {  slice = expand_slice(mpl, slice, NULL);
255            get_token(mpl /* * */);
256         }
257         else
258            error(mpl, "number, symbol, or asterisk missing where expec"
259               "ted");
260         /* check a token that follows the symbol */
261         if (mpl->token == T_COMMA)
262            get_token(mpl /* , */);
263         else if (mpl->token == close)
264            break;
265         else
266            error(mpl, "syntax error in slice");
267      }
268      /* number of slice components must be the same as the appropriate
269         dimension */
270      if (slice_dimen(mpl, slice) != dim)
271      {  switch (close)
272         {  case T_RBRACKET:
273               error(mpl, "%s must have %d subscript%s, not %d", name,
274                  dim, dim == 1 ? "" : "s", slice_dimen(mpl, slice));
275               break;
276            case T_RIGHT:
277               error(mpl, "%s has dimension %d, not %d", name, dim,
278                  slice_dimen(mpl, slice));
279               break;
280            default:
281               xassert(close != close);
282         }
283      }
284      get_token(mpl /* ) | ] */);
285      return slice;
286}
287
288/*----------------------------------------------------------------------
289-- select_set - select set to saturate it with elemental sets.
290--
291-- This routine selects set to saturate it with elemental sets provided
292-- in the data section. */
293
294SET *select_set
295(     MPL *mpl,
296      char *name              /* not changed */
297)
298{     SET *set;
299      AVLNODE *node;
300      xassert(name != NULL);
301      node = avl_find_node(mpl->tree, name);
302      if (node == NULL || avl_get_node_type(node) != A_SET)
303         error(mpl, "%s not a set", name);
304      set = (SET *)avl_get_node_link(node);
305      if (set->assign != NULL || set->gadget != NULL)
306         error(mpl, "%s needs no data", name);
307      set->data = 1;
308      return set;
309}
310
311/*----------------------------------------------------------------------
312-- simple_format - read set data block in simple format.
313--
314-- This routine reads set data block using the syntax:
315--
316-- <simple format> ::= <symbol> , <symbol> , ... , <symbol>
317--
318-- where <symbols> are used to construct a complete n-tuple, which is
319-- included in elemental set assigned to the set member. Commae between
320-- symbols are optional and may be omitted anywhere.
321--
322-- Number of components in the slice must be the same as dimension of
323-- n-tuples in elemental sets assigned to the set members. To construct
324-- complete n-tuple the routine replaces null positions in the slice by
325-- corresponding <symbols>.
326--
327-- If the slice contains at least one null position, the current token
328-- must be symbol. Otherwise, the routine reads no symbols to construct
329-- the n-tuple, so the current token is not checked. */
330
331void simple_format
332(     MPL *mpl,
333      SET *set,               /* not changed */
334      MEMBER *memb,           /* modified */
335      SLICE *slice            /* not changed */
336)
337{     TUPLE *tuple;
338      SLICE *temp;
339      SYMBOL *sym, *with = NULL;
340      xassert(set != NULL);
341      xassert(memb != NULL);
342      xassert(slice != NULL);
343      xassert(set->dimen == slice_dimen(mpl, slice));
344      xassert(memb->value.set->dim == set->dimen);
345      if (slice_arity(mpl, slice) > 0) xassert(is_symbol(mpl));
346      /* read symbols and construct complete n-tuple */
347      tuple = create_tuple(mpl);
348      for (temp = slice; temp != NULL; temp = temp->next)
349      {  if (temp->sym == NULL)
350         {  /* substitution is needed; read symbol */
351            if (!is_symbol(mpl))
352            {  int lack = slice_arity(mpl, temp);
353               /* with cannot be null due to assertion above */
354               xassert(with != NULL);
355               if (lack == 1)
356                  error(mpl, "one item missing in data group beginning "
357                     "with %s", format_symbol(mpl, with));
358               else
359                  error(mpl, "%d items missing in data group beginning "
360                     "with %s", lack, format_symbol(mpl, with));
361            }
362            sym = read_symbol(mpl);
363            if (with == NULL) with = sym;
364         }
365         else
366         {  /* copy symbol from the slice */
367            sym = copy_symbol(mpl, temp->sym);
368         }
369         /* append the symbol to the n-tuple */
370         tuple = expand_tuple(mpl, tuple, sym);
371         /* skip optional comma *between* <symbols> */
372         if (temp->next != NULL && mpl->token == T_COMMA)
373            get_token(mpl /* , */);
374      }
375      /* add constructed n-tuple to elemental set */
376      check_then_add(mpl, memb->value.set, tuple);
377      return;
378}
379
380/*----------------------------------------------------------------------
381-- matrix_format - read set data block in matrix format.
382--
383-- This routine reads set data block using the syntax:
384--
385-- <matrix format> ::= <column> <column> ... <column> :=
386--               <row>   +/-      +/-    ...   +/-
387--               <row>   +/-      +/-    ...   +/-
388--                 .  .  .  .  .  .  .  .  .  .  .
389--               <row>   +/-      +/-    ...   +/-
390--
391-- where <rows> are symbols that denote rows of the matrix, <columns>
392-- are symbols that denote columns of the matrix, "+" and "-" indicate
393-- whether corresponding n-tuple needs to be included in the elemental
394-- set or not, respectively.
395--
396-- Number of the slice components must be the same as dimension of the
397-- elemental set. The slice must have two null positions. To construct
398-- complete n-tuple for particular element of the matrix the routine
399-- replaces first null position of the slice by the corresponding <row>
400-- (or <column>, if the flag tr is on) and second null position by the
401-- corresponding <column> (or by <row>, if the flag tr is on). */
402
403void matrix_format
404(     MPL *mpl,
405      SET *set,               /* not changed */
406      MEMBER *memb,           /* modified */
407      SLICE *slice,           /* not changed */
408      int tr
409)
410{     SLICE *list, *col, *temp;
411      TUPLE *tuple;
412      SYMBOL *row;
413      xassert(set != NULL);
414      xassert(memb != NULL);
415      xassert(slice != NULL);
416      xassert(set->dimen == slice_dimen(mpl, slice));
417      xassert(memb->value.set->dim == set->dimen);
418      xassert(slice_arity(mpl, slice) == 2);
419      /* read the matrix heading that contains column symbols (there
420         may be no columns at all) */
421      list = create_slice(mpl);
422      while (mpl->token != T_ASSIGN)
423      {  /* read column symbol and append it to the column list */
424         if (!is_symbol(mpl))
425            error(mpl, "number, symbol, or := missing where expected");
426         list = expand_slice(mpl, list, read_symbol(mpl));
427      }
428      get_token(mpl /* := */);
429      /* read zero or more rows that contain matrix data */
430      while (is_symbol(mpl))
431      {  /* read row symbol (if the matrix has no columns, row symbols
432            are just ignored) */
433         row = read_symbol(mpl);
434         /* read the matrix row accordingly to the column list */
435         for (col = list; col != NULL; col = col->next)
436         {  int which = 0;
437            /* check indicator */
438            if (is_literal(mpl, "+"))
439               ;
440            else if (is_literal(mpl, "-"))
441            {  get_token(mpl /* - */);
442               continue;
443            }
444            else
445            {  int lack = slice_dimen(mpl, col);
446               if (lack == 1)
447                  error(mpl, "one item missing in data group beginning "
448                     "with %s", format_symbol(mpl, row));
449               else
450                  error(mpl, "%d items missing in data group beginning "
451                     "with %s", lack, format_symbol(mpl, row));
452            }
453            /* construct complete n-tuple */
454            tuple = create_tuple(mpl);
455            for (temp = slice; temp != NULL; temp = temp->next)
456            {  if (temp->sym == NULL)
457               {  /* substitution is needed */
458                  switch (++which)
459                  {  case 1:
460                        /* substitute in the first null position */
461                        tuple = expand_tuple(mpl, tuple,
462                           copy_symbol(mpl, tr ? col->sym : row));
463                        break;
464                     case 2:
465                        /* substitute in the second null position */
466                        tuple = expand_tuple(mpl, tuple,
467                           copy_symbol(mpl, tr ? row : col->sym));
468                        break;
469                     default:
470                        xassert(which != which);
471                  }
472               }
473               else
474               {  /* copy symbol from the slice */
475                  tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
476                     temp->sym));
477               }
478            }
479            xassert(which == 2);
480            /* add constructed n-tuple to elemental set */
481            check_then_add(mpl, memb->value.set, tuple);
482            get_token(mpl /* + */);
483         }
484         /* delete the row symbol */
485         delete_symbol(mpl, row);
486      }
487      /* delete the column list */
488      delete_slice(mpl, list);
489      return;
490}
491
492/*----------------------------------------------------------------------
493-- set_data - read set data.
494--
495-- This routine reads set data using the syntax:
496--
497-- <set data> ::= set <set name> <assignments> ;
498-- <set data> ::= set <set name> [ <symbol list> ] <assignments> ;
499-- <set name> ::= <symbolic name>
500-- <assignments> ::= <empty>
501-- <assignments> ::= <assignments> , :=
502-- <assignments> ::= <assignments> , ( <symbol list> )
503-- <assignments> ::= <assignments> , <simple format>
504-- <assignments> ::= <assignments> , : <matrix format>
505-- <assignments> ::= <assignments> , (tr) <matrix format>
506-- <assignments> ::= <assignments> , (tr) : <matrix format>
507--
508-- Commae in <assignments> are optional and may be omitted anywhere. */
509
510void set_data(MPL *mpl)
511{     SET *set;
512      TUPLE *tuple;
513      MEMBER *memb;
514      SLICE *slice;
515      int tr = 0;
516      xassert(is_literal(mpl, "set"));
517      get_token(mpl /* set */);
518      /* symbolic name of set must follows the keyword 'set' */
519      if (!is_symbol(mpl))
520         error(mpl, "set name missing where expected");
521      /* select the set to saturate it with data */
522      set = select_set(mpl, mpl->image);
523      get_token(mpl /* <symbolic name> */);
524      /* read optional subscript list, which identifies member of the
525         set to be read */
526      tuple = create_tuple(mpl);
527      if (mpl->token == T_LBRACKET)
528      {  /* subscript list is specified */
529         if (set->dim == 0)
530            error(mpl, "%s cannot be subscripted", set->name);
531         get_token(mpl /* [ */);
532         /* read symbols and construct subscript list */
533         for (;;)
534         {  if (!is_symbol(mpl))
535               error(mpl, "number or symbol missing where expected");
536            tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
537            if (mpl->token == T_COMMA)
538               get_token(mpl /* , */);
539            else if (mpl->token == T_RBRACKET)
540               break;
541            else
542               error(mpl, "syntax error in subscript list");
543         }
544         if (set->dim != tuple_dimen(mpl, tuple))
545            error(mpl, "%s must have %d subscript%s rather than %d",
546               set->name, set->dim, set->dim == 1 ? "" : "s",
547               tuple_dimen(mpl, tuple));
548         get_token(mpl /* ] */);
549      }
550      else
551      {  /* subscript list is not specified */
552         if (set->dim != 0)
553            error(mpl, "%s must be subscripted", set->name);
554      }
555      /* there must be no member with the same subscript list */
556      if (find_member(mpl, set->array, tuple) != NULL)
557         error(mpl, "%s%s already defined",
558            set->name, format_tuple(mpl, '[', tuple));
559      /* add new member to the set and assign it empty elemental set */
560      memb = add_member(mpl, set->array, tuple);
561      memb->value.set = create_elemset(mpl, set->dimen);
562      /* create an initial fake slice of all asterisks */
563      slice = fake_slice(mpl, set->dimen);
564      /* read zero or more data assignments */
565      for (;;)
566      {  /* skip optional comma */
567         if (mpl->token == T_COMMA) get_token(mpl /* , */);
568         /* process assignment element */
569         if (mpl->token == T_ASSIGN)
570         {  /* assignment ligature is non-significant element */
571            get_token(mpl /* := */);
572         }
573         else if (mpl->token == T_LEFT)
574         {  /* left parenthesis begins either new slice or "transpose"
575               indicator */
576            int is_tr;
577            get_token(mpl /* ( */);
578            is_tr = is_literal(mpl, "tr");
579            unget_token(mpl /* ( */);
580            if (is_tr) goto left;
581            /* delete the current slice and read new one */
582            delete_slice(mpl, slice);
583            slice = read_slice(mpl, set->name, set->dimen);
584            /* each new slice resets the "transpose" indicator */
585            tr = 0;
586            /* if the new slice is 0-ary, formally there is one 0-tuple
587               (in the simple format) that follows it */
588            if (slice_arity(mpl, slice) == 0)
589               simple_format(mpl, set, memb, slice);
590         }
591         else if (is_symbol(mpl))
592         {  /* number or symbol begins data in the simple format */
593            simple_format(mpl, set, memb, slice);
594         }
595         else if (mpl->token == T_COLON)
596         {  /* colon begins data in the matrix format */
597            if (slice_arity(mpl, slice) != 2)
598err1:          error(mpl, "slice currently used must specify 2 asterisk"
599                  "s, not %d", slice_arity(mpl, slice));
600            get_token(mpl /* : */);
601            /* read elemental set data in the matrix format */
602            matrix_format(mpl, set, memb, slice, tr);
603         }
604         else if (mpl->token == T_LEFT)
605left:    {  /* left parenthesis begins the "transpose" indicator, which
606               is followed by data in the matrix format */
607            get_token(mpl /* ( */);
608            if (!is_literal(mpl, "tr"))
609err2:          error(mpl, "transpose indicator (tr) incomplete");
610            if (slice_arity(mpl, slice) != 2) goto err1;
611            get_token(mpl /* tr */);
612            if (mpl->token != T_RIGHT) goto err2;
613            get_token(mpl /* ) */);
614            /* in this case the colon is optional */
615            if (mpl->token == T_COLON) get_token(mpl /* : */);
616            /* set the "transpose" indicator */
617            tr = 1;
618            /* read elemental set data in the matrix format */
619            matrix_format(mpl, set, memb, slice, tr);
620         }
621         else if (mpl->token == T_SEMICOLON)
622         {  /* semicolon terminates the data block */
623            get_token(mpl /* ; */);
624            break;
625         }
626         else
627            error(mpl, "syntax error in set data block");
628      }
629      /* delete the current slice */
630      delete_slice(mpl, slice);
631      return;
632}
633
634/*----------------------------------------------------------------------
635-- select_parameter - select parameter to saturate it with data.
636--
637-- This routine selects parameter to saturate it with data provided in
638-- the data section. */
639
640PARAMETER *select_parameter
641(     MPL *mpl,
642      char *name              /* not changed */
643)
644{     PARAMETER *par;
645      AVLNODE *node;
646      xassert(name != NULL);
647      node = avl_find_node(mpl->tree, name);
648      if (node == NULL || avl_get_node_type(node) != A_PARAMETER)
649         error(mpl, "%s not a parameter", name);
650      par = (PARAMETER *)avl_get_node_link(node);
651      if (par->assign != NULL)
652         error(mpl, "%s needs no data", name);
653      if (par->data)
654         error(mpl, "%s already provided with data", name);
655      par->data = 1;
656      return par;
657}
658
659/*----------------------------------------------------------------------
660-- set_default - set default parameter value.
661--
662-- This routine sets default value for specified parameter. */
663
664void set_default
665(     MPL *mpl,
666      PARAMETER *par,         /* not changed */
667      SYMBOL *altval          /* destroyed */
668)
669{     xassert(par != NULL);
670      xassert(altval != NULL);
671      if (par->option != NULL)
672         error(mpl, "default value for %s already specified in model se"
673            "ction", par->name);
674      xassert(par->defval == NULL);
675      par->defval = altval;
676      return;
677}
678
679/*----------------------------------------------------------------------
680-- read_value - read value and assign it to parameter member.
681--
682-- This routine reads numeric or symbolic value from the input stream
683-- and assigns to new parameter member specified by its n-tuple, which
684-- (the member) is created and added to the parameter array. */
685
686MEMBER *read_value
687(     MPL *mpl,
688      PARAMETER *par,         /* not changed */
689      TUPLE *tuple            /* destroyed */
690)
691{     MEMBER *memb;
692      xassert(par != NULL);
693      xassert(is_symbol(mpl));
694      /* there must be no member with the same n-tuple */
695      if (find_member(mpl, par->array, tuple) != NULL)
696         error(mpl, "%s%s already defined",
697            par->name, format_tuple(mpl, '[', tuple));
698      /* create new parameter member with given n-tuple */
699      memb = add_member(mpl, par->array, tuple);
700      /* read value and assigns it to the new parameter member */
701      switch (par->type)
702      {  case A_NUMERIC:
703         case A_INTEGER:
704         case A_BINARY:
705            if (!is_number(mpl))
706               error(mpl, "%s requires numeric data", par->name);
707            memb->value.num = read_number(mpl);
708            break;
709         case A_SYMBOLIC:
710            memb->value.sym = read_symbol(mpl);
711            break;
712         default:
713            xassert(par != par);
714      }
715      return memb;
716}
717
718/*----------------------------------------------------------------------
719-- plain_format - read parameter data block in plain format.
720--
721-- This routine reads parameter data block using the syntax:
722--
723-- <plain format> ::= <symbol> , <symbol> , ... , <symbol> , <value>
724--
725-- where <symbols> are used to determine a complete subscript list for
726-- parameter member, <value> is a numeric or symbolic value assigned to
727-- the parameter member. Commae between data items are optional and may
728-- be omitted anywhere.
729--
730-- Number of components in the slice must be the same as dimension of
731-- the parameter. To construct the complete subscript list the routine
732-- replaces null positions in the slice by corresponding <symbols>. */
733
734void plain_format
735(     MPL *mpl,
736      PARAMETER *par,         /* not changed */
737      SLICE *slice            /* not changed */
738)
739{     TUPLE *tuple;
740      SLICE *temp;
741      SYMBOL *sym, *with = NULL;
742      xassert(par != NULL);
743      xassert(par->dim == slice_dimen(mpl, slice));
744      xassert(is_symbol(mpl));
745      /* read symbols and construct complete subscript list */
746      tuple = create_tuple(mpl);
747      for (temp = slice; temp != NULL; temp = temp->next)
748      {  if (temp->sym == NULL)
749         {  /* substitution is needed; read symbol */
750            if (!is_symbol(mpl))
751            {  int lack = slice_arity(mpl, temp) + 1;
752               xassert(with != NULL);
753               xassert(lack > 1);
754               error(mpl, "%d items missing in data group beginning wit"
755                  "h %s", lack, format_symbol(mpl, with));
756            }
757            sym = read_symbol(mpl);
758            if (with == NULL) with = sym;
759         }
760         else
761         {  /* copy symbol from the slice */
762            sym = copy_symbol(mpl, temp->sym);
763         }
764         /* append the symbol to the subscript list */
765         tuple = expand_tuple(mpl, tuple, sym);
766         /* skip optional comma */
767         if (mpl->token == T_COMMA) get_token(mpl /* , */);
768      }
769      /* read value and assign it to new parameter member */
770      if (!is_symbol(mpl))
771      {  xassert(with != NULL);
772         error(mpl, "one item missing in data group beginning with %s",
773            format_symbol(mpl, with));
774      }
775      read_value(mpl, par, tuple);
776      return;
777}
778
779/*----------------------------------------------------------------------
780-- tabular_format - read parameter data block in tabular format.
781--
782-- This routine reads parameter data block using the syntax:
783--
784-- <tabular format> ::= <column> <column> ... <column> :=
785--                <row> <value>  <value>  ... <value>
786--                <row> <value>  <value>  ... <value>
787--                  .  .  .  .  .  .  .  .  .  .  .
788--                <row> <value>  <value>  ... <value>
789--
790-- where <rows> are symbols that denote rows of the table, <columns>
791-- are symbols that denote columns of the table, <values> are numeric
792-- or symbolic values assigned to the corresponding parameter members.
793-- If <value> is specified as single point, no value is provided.
794--
795-- Number of components in the slice must be the same as dimension of
796-- the parameter. The slice must have two null positions. To construct
797-- complete subscript list for particular <value> the routine replaces
798-- the first null position of the slice by the corresponding <row> (or
799-- <column>, if the flag tr is on) and the second null position by the
800-- corresponding <column> (or by <row>, if the flag tr is on). */
801
802void tabular_format
803(     MPL *mpl,
804      PARAMETER *par,         /* not changed */
805      SLICE *slice,           /* not changed */
806      int tr
807)
808{     SLICE *list, *col, *temp;
809      TUPLE *tuple;
810      SYMBOL *row;
811      xassert(par != NULL);
812      xassert(par->dim == slice_dimen(mpl, slice));
813      xassert(slice_arity(mpl, slice) == 2);
814      /* read the table heading that contains column symbols (the table
815         may have no columns) */
816      list = create_slice(mpl);
817      while (mpl->token != T_ASSIGN)
818      {  /* read column symbol and append it to the column list */
819         if (!is_symbol(mpl))
820            error(mpl, "number, symbol, or := missing where expected");
821         list = expand_slice(mpl, list, read_symbol(mpl));
822      }
823      get_token(mpl /* := */);
824      /* read zero or more rows that contain tabular data */
825      while (is_symbol(mpl))
826      {  /* read row symbol (if the table has no columns, these symbols
827            are just ignored) */
828         row = read_symbol(mpl);
829         /* read values accordingly to the column list */
830         for (col = list; col != NULL; col = col->next)
831         {  int which = 0;
832            /* if the token is single point, no value is provided */
833            if (is_literal(mpl, "."))
834            {  get_token(mpl /* . */);
835               continue;
836            }
837            /* construct complete subscript list */
838            tuple = create_tuple(mpl);
839            for (temp = slice; temp != NULL; temp = temp->next)
840            {  if (temp->sym == NULL)
841               {  /* substitution is needed */
842                  switch (++which)
843                  {  case 1:
844                        /* substitute in the first null position */
845                        tuple = expand_tuple(mpl, tuple,
846                           copy_symbol(mpl, tr ? col->sym : row));
847                        break;
848                     case 2:
849                        /* substitute in the second null position */
850                        tuple = expand_tuple(mpl, tuple,
851                           copy_symbol(mpl, tr ? row : col->sym));
852                        break;
853                     default:
854                        xassert(which != which);
855                  }
856               }
857               else
858               {  /* copy symbol from the slice */
859                  tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
860                     temp->sym));
861               }
862            }
863            xassert(which == 2);
864            /* read value and assign it to new parameter member */
865            if (!is_symbol(mpl))
866            {  int lack = slice_dimen(mpl, col);
867               if (lack == 1)
868                  error(mpl, "one item missing in data group beginning "
869                     "with %s", format_symbol(mpl, row));
870               else
871                  error(mpl, "%d items missing in data group beginning "
872                     "with %s", lack, format_symbol(mpl, row));
873            }
874            read_value(mpl, par, tuple);
875         }
876         /* delete the row symbol */
877         delete_symbol(mpl, row);
878      }
879      /* delete the column list */
880      delete_slice(mpl, list);
881      return;
882}
883
884/*----------------------------------------------------------------------
885-- tabbing_format - read parameter data block in tabbing format.
886--
887-- This routine reads parameter data block using the syntax:
888--
889-- <tabbing format> ::=  <prefix> <name>  , ... , <name>  , := ,
890--    <symbol> , ... , <symbol> , <value> , ... , <value> ,
891--    <symbol> , ... , <symbol> , <value> , ... , <value> ,
892--     .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .  .
893--    <symbol> , ... , <symbol> , <value> , ... , <value>
894-- <prefix> ::= <empty>
895-- <prefix> ::= <set name> :
896--
897-- where <names> are names of parameters (all the parameters must be
898-- subscripted and have identical dimensions), <symbols> are symbols
899-- used to define subscripts of parameter members, <values> are numeric
900-- or symbolic values assigned to the corresponding parameter members.
901-- Optional <prefix> may specify a simple set, in which case n-tuples
902-- built of <symbols> for each row of the data table (i.e. subscripts
903-- of parameter members) are added to the specified set. Commae between
904-- data items are optional and may be omitted anywhere.
905--
906-- If the parameter altval is not NULL, it specifies a default value
907-- provided for all the parameters specified in the data block.  */
908
909void tabbing_format
910(     MPL *mpl,
911      SYMBOL *altval          /* not changed */
912)
913{     SET *set = NULL;
914      PARAMETER *par;
915      SLICE *list, *col;
916      TUPLE *tuple;
917      int next_token, j, dim = 0;
918      char *last_name = NULL;
919      /* read the optional <prefix> */
920      if (is_symbol(mpl))
921      {  get_token(mpl /* <symbol> */);
922         next_token = mpl->token;
923         unget_token(mpl /* <symbol> */);
924         if (next_token == T_COLON)
925         {  /* select the set to saturate it with data */
926            set = select_set(mpl, mpl->image);
927            /* the set must be simple (i.e. not set of sets) */
928            if (set->dim != 0)
929               error(mpl, "%s must be a simple set", set->name);
930            /* and must not be defined yet */
931            if (set->array->head != NULL)
932               error(mpl, "%s already defined", set->name);
933            /* add new (the only) member to the set and assign it empty
934               elemental set */
935            add_member(mpl, set->array, NULL)->value.set =
936               create_elemset(mpl, set->dimen);
937            last_name = set->name, dim = set->dimen;
938            get_token(mpl /* <symbol> */);
939            xassert(mpl->token == T_COLON);
940            get_token(mpl /* : */);
941         }
942      }
943      /* read the table heading that contains parameter names */
944      list = create_slice(mpl);
945      while (mpl->token != T_ASSIGN)
946      {  /* there must be symbolic name of parameter */
947         if (!is_symbol(mpl))
948            error(mpl, "parameter name or := missing where expected");
949         /* select the parameter to saturate it with data */
950         par = select_parameter(mpl, mpl->image);
951         /* the parameter must be subscripted */
952         if (par->dim == 0)
953            error(mpl, "%s not a subscripted parameter", mpl->image);
954         /* the set (if specified) and all the parameters in the data
955            block must have identical dimension */
956         if (dim != 0 && par->dim != dim)
957         {  xassert(last_name != NULL);
958            error(mpl, "%s has dimension %d while %s has dimension %d",
959               last_name, dim, par->name, par->dim);
960         }
961         /* set default value for the parameter (if specified) */
962         if (altval != NULL)
963            set_default(mpl, par, copy_symbol(mpl, altval));
964         /* append the parameter to the column list */
965         list = expand_slice(mpl, list, (SYMBOL *)par);
966         last_name = par->name, dim = par->dim;
967         get_token(mpl /* <symbol> */);
968         /* skip optional comma */
969         if (mpl->token == T_COMMA) get_token(mpl /* , */);
970      }
971      if (slice_dimen(mpl, list) == 0)
972         error(mpl, "at least one parameter name required");
973      get_token(mpl /* := */);
974      /* skip optional comma */
975      if (mpl->token == T_COMMA) get_token(mpl /* , */);
976      /* read rows that contain tabbing data */
977      while (is_symbol(mpl))
978      {  /* read subscript list */
979         tuple = create_tuple(mpl);
980         for (j = 1; j <= dim; j++)
981         {  /* read j-th subscript */
982            if (!is_symbol(mpl))
983            {  int lack = slice_dimen(mpl, list) + dim - j + 1;
984               xassert(tuple != NULL);
985               xassert(lack > 1);
986               error(mpl, "%d items missing in data group beginning wit"
987                  "h %s", lack, format_symbol(mpl, tuple->sym));
988            }
989            /* read and append j-th subscript to the n-tuple */
990            tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
991            /* skip optional comma *between* <symbols> */
992            if (j < dim && mpl->token == T_COMMA)
993               get_token(mpl /* , */);
994         }
995         /* if the set is specified, add to it new n-tuple, which is a
996            copy of the subscript list just read */
997         if (set != NULL)
998            check_then_add(mpl, set->array->head->value.set,
999               copy_tuple(mpl, tuple));
1000         /* skip optional comma between <symbol> and <value> */
1001         if (mpl->token == T_COMMA) get_token(mpl /* , */);
1002         /* read values accordingly to the column list */
1003         for (col = list; col != NULL; col = col->next)
1004         {  /* if the token is single point, no value is provided */
1005            if (is_literal(mpl, "."))
1006            {  get_token(mpl /* . */);
1007               continue;
1008            }
1009            /* read value and assign it to new parameter member */
1010            if (!is_symbol(mpl))
1011            {  int lack = slice_dimen(mpl, col);
1012               xassert(tuple != NULL);
1013               if (lack == 1)
1014                  error(mpl, "one item missing in data group beginning "
1015                     "with %s", format_symbol(mpl, tuple->sym));
1016               else
1017                  error(mpl, "%d items missing in data group beginning "
1018                     "with %s", lack, format_symbol(mpl, tuple->sym));
1019            }
1020            read_value(mpl, (PARAMETER *)col->sym, copy_tuple(mpl,
1021               tuple));
1022            /* skip optional comma preceding the next value */
1023            if (col->next != NULL && mpl->token == T_COMMA)
1024               get_token(mpl /* , */);
1025         }
1026         /* delete the original subscript list */
1027         delete_tuple(mpl, tuple);
1028         /* skip optional comma (only if there is next data group) */
1029         if (mpl->token == T_COMMA)
1030         {  get_token(mpl /* , */);
1031            if (!is_symbol(mpl)) unget_token(mpl /* , */);
1032         }
1033      }
1034      /* delete the column list (it contains parameters, not symbols,
1035         so nullify it before) */
1036      for (col = list; col != NULL; col = col->next) col->sym = NULL;
1037      delete_slice(mpl, list);
1038      return;
1039}
1040
1041/*----------------------------------------------------------------------
1042-- parameter_data - read parameter data.
1043--
1044-- This routine reads parameter data using the syntax:
1045--
1046-- <parameter data> ::= param <default value> : <tabbing format> ;
1047-- <parameter data> ::= param <parameter name> <default value>
1048--                      <assignments> ;
1049-- <parameter name> ::= <symbolic name>
1050-- <default value> ::= <empty>
1051-- <default value> ::= default <symbol>
1052-- <assignments> ::= <empty>
1053-- <assignments> ::= <assignments> , :=
1054-- <assignments> ::= <assignments> , [ <symbol list> ]
1055-- <assignments> ::= <assignments> , <plain format>
1056-- <assignemnts> ::= <assignments> , : <tabular format>
1057-- <assignments> ::= <assignments> , (tr) <tabular format>
1058-- <assignments> ::= <assignments> , (tr) : <tabular format>
1059--
1060-- Commae in <assignments> are optional and may be omitted anywhere. */
1061
1062void parameter_data(MPL *mpl)
1063{     PARAMETER *par;
1064      SYMBOL *altval = NULL;
1065      SLICE *slice;
1066      int tr = 0;
1067      xassert(is_literal(mpl, "param"));
1068      get_token(mpl /* param */);
1069      /* read optional default value */
1070      if (is_literal(mpl, "default"))
1071      {  get_token(mpl /* default */);
1072         if (!is_symbol(mpl))
1073            error(mpl, "default value missing where expected");
1074         altval = read_symbol(mpl);
1075         /* if the default value follows the keyword 'param', the next
1076            token must be only the colon */
1077         if (mpl->token != T_COLON)
1078            error(mpl, "colon missing where expected");
1079      }
1080      /* being used after the keyword 'param' or the optional default
1081         value the colon begins data in the tabbing format */
1082      if (mpl->token == T_COLON)
1083      {  get_token(mpl /* : */);
1084         /* skip optional comma */
1085         if (mpl->token == T_COMMA) get_token(mpl /* , */);
1086         /* read parameter data in the tabbing format */
1087         tabbing_format(mpl, altval);
1088         /* on reading data in the tabbing format the default value is
1089            always copied, so delete the original symbol */
1090         if (altval != NULL) delete_symbol(mpl, altval);
1091         /* the next token must be only semicolon */
1092         if (mpl->token != T_SEMICOLON)
1093            error(mpl, "symbol, number, or semicolon missing where expe"
1094               "cted");
1095         get_token(mpl /* ; */);
1096         goto done;
1097      }
1098      /* in other cases there must be symbolic name of parameter, which
1099         follows the keyword 'param' */
1100      if (!is_symbol(mpl))
1101         error(mpl, "parameter name missing where expected");
1102      /* select the parameter to saturate it with data */
1103      par = select_parameter(mpl, mpl->image);
1104      get_token(mpl /* <symbol> */);
1105      /* read optional default value */
1106      if (is_literal(mpl, "default"))
1107      {  get_token(mpl /* default */);
1108         if (!is_symbol(mpl))
1109            error(mpl, "default value missing where expected");
1110         altval = read_symbol(mpl);
1111         /* set default value for the parameter */
1112         set_default(mpl, par, altval);
1113      }
1114      /* create initial fake slice of all asterisks */
1115      slice = fake_slice(mpl, par->dim);
1116      /* read zero or more data assignments */
1117      for (;;)
1118      {  /* skip optional comma */
1119         if (mpl->token == T_COMMA) get_token(mpl /* , */);
1120         /* process current assignment */
1121         if (mpl->token == T_ASSIGN)
1122         {  /* assignment ligature is non-significant element */
1123            get_token(mpl /* := */);
1124         }
1125         else if (mpl->token == T_LBRACKET)
1126         {  /* left bracket begins new slice; delete the current slice
1127               and read new one */
1128            delete_slice(mpl, slice);
1129            slice = read_slice(mpl, par->name, par->dim);
1130            /* each new slice resets the "transpose" indicator */
1131            tr = 0;
1132         }
1133         else if (is_symbol(mpl))
1134         {  /* number or symbol begins data in the plain format */
1135            plain_format(mpl, par, slice);
1136         }
1137         else if (mpl->token == T_COLON)
1138         {  /* colon begins data in the tabular format */
1139            if (par->dim == 0)
1140err1:          error(mpl, "%s not a subscripted parameter",
1141                  par->name);
1142            if (slice_arity(mpl, slice) != 2)
1143err2:          error(mpl, "slice currently used must specify 2 asterisk"
1144                  "s, not %d", slice_arity(mpl, slice));
1145            get_token(mpl /* : */);
1146            /* read parameter data in the tabular format */
1147            tabular_format(mpl, par, slice, tr);
1148         }
1149         else if (mpl->token == T_LEFT)
1150         {  /* left parenthesis begins the "transpose" indicator, which
1151               is followed by data in the tabular format */
1152            get_token(mpl /* ( */);
1153            if (!is_literal(mpl, "tr"))
1154err3:          error(mpl, "transpose indicator (tr) incomplete");
1155            if (par->dim == 0) goto err1;
1156            if (slice_arity(mpl, slice) != 2) goto err2;
1157            get_token(mpl /* tr */);
1158            if (mpl->token != T_RIGHT) goto err3;
1159            get_token(mpl /* ) */);
1160            /* in this case the colon is optional */
1161            if (mpl->token == T_COLON) get_token(mpl /* : */);
1162            /* set the "transpose" indicator */
1163            tr = 1;
1164            /* read parameter data in the tabular format */
1165            tabular_format(mpl, par, slice, tr);
1166         }
1167         else if (mpl->token == T_SEMICOLON)
1168         {  /* semicolon terminates the data block */
1169            get_token(mpl /* ; */);
1170            break;
1171         }
1172         else
1173            error(mpl, "syntax error in parameter data block");
1174      }
1175      /* delete the current slice */
1176      delete_slice(mpl, slice);
1177done: return;
1178}
1179
1180/*----------------------------------------------------------------------
1181-- data_section - read data section.
1182--
1183-- This routine reads data section using the syntax:
1184--
1185-- <data section> ::= <empty>
1186-- <data section> ::= <data section> <data block> ;
1187-- <data block> ::= <set data>
1188-- <data block> ::= <parameter data>
1189--
1190-- Reading data section is terminated by either the keyword 'end' or
1191-- the end of file. */
1192
1193void data_section(MPL *mpl)
1194{     while (!(mpl->token == T_EOF || is_literal(mpl, "end")))
1195      {  if (is_literal(mpl, "set"))
1196            set_data(mpl);
1197         else if (is_literal(mpl, "param"))
1198            parameter_data(mpl);
1199         else
1200            error(mpl, "syntax error in data section");
1201      }
1202      return;
1203}
1204
1205/* eof */
Note: See TracBrowser for help on using the repository browser.