glpmpl02.c

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

(     MPL *mpl,
      SET *set,               /* not changed */
      MEMBER *memb,           /* modified */
      SLICE *slice,           /* not changed */
      int tr
)
{     SLICE *list, *col, *temp;
      TUPLE *tuple;
      SYMBOL *row;
      xassert(set != NULL);
      xassert(memb != NULL);
      xassert(slice != NULL);
      xassert(set->dimen == slice_dimen(mpl, slice));
      xassert(memb->value.set->dim == set->dimen);
      xassert(slice_arity(mpl, slice) == 2);
      /* read the matrix heading that contains column symbols (there
         may be no columns at all) */
      list = create_slice(mpl);
      while (mpl->token != T_ASSIGN)
      {  /* read column symbol and append it to the column list */
         if (!is_symbol(mpl))
            error(mpl, "number, symbol, or := missing where expected");
         list = expand_slice(mpl, list, read_symbol(mpl));
      }
      get_token(mpl /* := */);
      /* read zero or more rows that contain matrix data */
      while (is_symbol(mpl))
      {  /* read row symbol (if the matrix has no columns, row symbols
            are just ignored) */
         row = read_symbol(mpl);
         /* read the matrix row accordingly to the column list */
         for (col = list; col != NULL; col = col->next)
         {  int which = 0;
            /* check indicator */
            if (is_literal(mpl, "+"))
               ;
            else if (is_literal(mpl, "-"))
            {  get_token(mpl /* - */);
               continue;
            }
            else
            {  int lack = slice_dimen(mpl, col);
               if (lack == 1)
                  error(mpl, "one item missing in data group beginning "
                     "with %s", format_symbol(mpl, row));
               else
                  error(mpl, "%d items missing in data group beginning "
                     "with %s", lack, format_symbol(mpl, row));
            }
            /* construct complete n-tuple */
            tuple = create_tuple(mpl);
            for (temp = slice; temp != NULL; temp = temp->next)
            {  if (temp->sym == NULL)
               {  /* substitution is needed */
                  switch (++which)
                  {  case 1:
                        /* substitute in the first null position */
                        tuple = expand_tuple(mpl, tuple,
                           copy_symbol(mpl, tr ? col->sym : row));
                        break;
                     case 2:
                        /* substitute in the second null position */
                        tuple = expand_tuple(mpl, tuple,
                           copy_symbol(mpl, tr ? row : col->sym));
                        break;
                     default:
                        xassert(which != which);
                  }
               }
               else
               {  /* copy symbol from the slice */
                  tuple = expand_tuple(mpl, tuple, copy_symbol(mpl,
                     temp->sym));
               }
            }
            xassert(which == 2);
            /* add constructed n-tuple to elemental set */
            check_then_add(mpl, memb->value.set, tuple);
            get_token(mpl /* + */);
         }
         /* delete the row symbol */
         delete_symbol(mpl, row);
      }
      /* delete the column list */
      delete_slice(mpl, list);
      return;
}

/*----------------------------------------------------------------------
-- set_data - read set data.
--
-- This routine reads set data using the syntax:
--
-- <set data> ::= set <set name> <assignments> ;
-- <set data> ::= set <set name> [ <symbol list> ] <assignments> ;
-- <set name> ::= <symbolic name>
-- <assignments> ::= <empty>
-- <assignments> ::= <assignments> , :=
-- <assignments> ::= <assignments> , ( <symbol list> )
-- <assignments> ::= <assignments> , <simple format>
-- <assignments> ::= <assignments> , : <matrix format>
-- <assignments> ::= <assignments> , (tr) <matrix format>
-- <assignments> ::= <assignments> , (tr) : <matrix format>
--
-- Commae in <assignments> are optional and may be omitted anywhere. */

void set_data(MPL *mpl)
{     SET *set;
      TUPLE *tuple;
      MEMBER *memb;
      SLICE *slice;
      int tr = 0;
      xassert(is_literal(mpl, "set"));
      get_token(mpl /* set */);
      /* symbolic name of set must follows the keyword 'set' */
      if (!is_symbol(mpl))
         error(mpl, "set name missing where expected");
      /* select the set to saturate it with data */
      set = select_set(mpl, mpl->image);
      get_token(mpl /* <symbolic name> */);
      /* read optional subscript list, which identifies member of the
         set to be read */
      tuple = create_tuple(mpl);
      if (mpl->token == T_LBRACKET)
      {  /* subscript list is specified */
         if (set->dim == 0)
            error(mpl, "%s cannot be subscripted", set->name);
         get_token(mpl /* [ */);
         /* read symbols and construct subscript list */
         for (;;)
         {  if (!is_symbol(mpl))
               error(mpl, "number or symbol missing where expected");
            tuple = expand_tuple(mpl, tuple, read_symbol(mpl));
            if (mpl->token == T_COMMA)
               get_token(mpl /* , */);
            else if (mpl->token == T_RBRACKET)
               break;
            else
               error(mpl, "syntax error in subscript list");
         }
         if (set->dim != tuple_dimen(mpl, tuple))
            error(mpl, "%s must have %d subscript%s rather than %d",
               set->name, set->dim, set->dim == 1 ? "" : "s",
               tuple_dimen(mpl, tuple));
         get_token(mpl /* ] */);
      }
      else
      {  /* subscript list is not specified */
         if (set->dim != 0)
            error(mpl, "%s must be subscripted", set->name);
      }
      /* there must be no member with the same subscript list */
      if (find_member(mpl, set->array, tuple) != NULL)
         error(mpl, "%s%s already defined",
            set->name, format_tuple(mpl, '[', tuple));
      /* add new member to the set and assign it empty elemental set */
      memb = add_member(mpl, set->array, tuple);
      memb->value.set = create_elemset(mpl, set->dimen);
      /* create an initial fake slice of all asterisks */
      slice = fake_slice(mpl, set->dimen);
      /* read zero or more data assignments */
      for (;;)
      {  /* skip optional comma */
         if (mpl->token == T_COMMA) get_token(mpl /* , */);
         /* process assignment element */
         if (mpl->token == T_ASSIGN)
         {  /* assignment ligature is non-significant element */
            get_token(mpl /* := */);
         }
         else if (mpl->token == T_LEFT)
         {  /* left parenthesis begins either new slice or "transpose"
               indicator */
            int is_tr;
            get_token(mpl /* ( */);
            is_tr = is_literal(mpl, "tr");
            unget_token(mpl /* ( */);
            if (is_tr) goto left;
            /* delete the current slice and read new one */
            delete_slice(mpl, slice);
            slice = read_slice(mpl, set->name, set->dimen);
            /* each new slice resets the "transpose" indicator */
            tr = 0;
            /* if the new slice is 0-ary, formally there is one 0-tuple
               (in the simple format) that follows it */
            if (slice_arity(mpl, slice) == 0)
               simple_format(mpl, set, memb, slice);
         }
         else if (is_symbol(mpl))
         {  /* number or symbol begins data in the simple format */
            simple_format(mpl, set, memb, slice);
         }
         else if (mpl->token == T_COLON)
         {  /* colon begins data in the matrix format */
            if (slice_arity(mpl, slice) != 2)
err1:          error(mpl, "slice currently used must specify 2 asterisk"
                  "s, not %d", slice_arity(mpl, slice));
            get_token(mpl /* : */);
            /* read elemental set data in the matrix format */
            matrix_format(mpl, set, memb, slice, tr);
         }
         else if (mpl->token == T_LEFT)
left:    {  /* left parenthesis begins the "transpose" indicator, which
               is followed by data in the matrix format */
            get_token(mpl /* ( */);
            if (!is_literal(mpl, "tr"))
err2:          error(mpl, "transpose indicator (tr) incomplete");
            if (slice_arity(mpl, slice) != 2) goto err1;
            get_token(mpl /* tr */);
            if (mpl->token != T_RIGHT) goto err2;
            get_token(mpl /* ) */);
            /* in this case the colon is optional */
            if (mpl->token == T_COLON) get_token(mpl /* : */);
            /* set the "transpose" indicator */
            tr = 1;
            /* read elemental set data in the matrix format */
            matrix_format(mpl, set, memb, slice, tr);
         }
         else if (mpl->token == T_SEMICOLON)
         {  /* semicolon terminates the data block */
            get_token(mpl /* ; */);
            break;
         }
         else
            error(mpl, "syntax error in set data block");
      }
      /* delete the current slice */
      delete_slice(mpl, slice);
      return;
}

/*----------------------------------------------------------------------
-- select_parameter - select parameter to saturate it with data.
--
-- This routine selects parameter to saturate it with data provided in
-- the data section. */

PARAMETER *select_parameter
(     MPL *mpl,
      char *name              /* not changed */
)
{     PARAMETER *par;
      AVLNODE *node;
      xassert(name != NULL);
      node = avl_find_node(mpl->tree, name);
      if (node == NULL || avl_get_node_type(node) != A_PARAMETER)
         error(mpl, "%s not a parameter", name);
      par = (PARAMETER *)avl_get_node_link(node);
      if (par->assign != NULL)
         error(mpl, "%s needs no data", name);
      if (par->data)
         error(mpl, "%s already provided with data", name);
      par->data = 1;
      return par;
}

/*----------------------------------------------------------------------
-- set_default - set default parameter value.
--
-- This routine sets default value for specified parameter. */

void set_default
(     MPL *mpl,
      PARAMETER *par,         /* not changed */
      SYMBOL *altval          /* destroyed */
)
{     xassert(par != NULL);
      xassert(altval != NULL);
      if (par->option != NULL)
         error(mpl, "default value for %s already specified in model se"
            "ction", par->name);
      xassert(par->defval == NULL);
      par->defval = altval;
      return;
}

/*----------------------------------------------------------------------
-- read_value - read value and assign it to parameter member.
--
-- This routine reads numeric or symbolic value from the input stream
-- and assigns to new parameter member specified by its n-tuple, which
-- (the member) is created and added to the parameter array. */

MEMBER *read_value
(     MPL *mpl,
      PARAMETER *par,         /* not changed */
      TUPLE *tuple            /* destroyed */
)
{     MEMBER *memb;
      xassert(par != NULL);
      xassert(is_symbol(mpl));
      /* there must be no member with the same n-tuple */
      if (find_member(mpl, par->array, tuple) != NULL)
         error(mpl, "%s%s already defined",
            par->name, format_tuple(mpl, '[', tuple));
      /* create new parameter member with given n-tuple */
      memb = add_member(mpl, par->array, tuple);
      /* read value and assigns it to the new parameter member */
      switch (par->type)
      {  case A_NUMERIC:
         case A_INTEGER:
         case A_BINARY:
            if (!is_number(mpl))
               error(mpl, "%s requires numeric data", par->name);
            memb->value.num = read_number(mpl);
            break;
         case A_SYMBOLIC:
            memb->value.sym = read_symbol(mpl);
            break;
         default:
            xassert(par != par);
      }
      return memb;
}

/*----------------------------------------------------------------------
-- plain_format - read parameter data block in plain format.
--
-- This routine reads parameter data block using the syntax:
--
-- <plain format> ::= <symbol> , <symbol> , ... , <symbol> , <value>
--
-- where <symbols> are used to determine a complete subscript list for
-- parameter member, <value> is a numeric or symbolic value assigned to
-- the parameter member. Commae between data items are optional and may
-- be omitted anywhere.
--
-- Number of components in the slice must be the same as dimension of
-- the parameter. To construct the complete subscript list the routine
-- replaces null positions in the slice by corresponding <symbols>. */

void plain_format
(     MPL *mpl,
      PARAMETER *par,         /* not changed */
      SLICE *slice            /* not changed */
)
{     TUPLE *tuple;
      SLICE *temp;
      SYMBOL *sym, *with = NULL;
      xassert(par != NULL);
      xassert(par->dim == slice_dimen(mpl, slice));
      xassert(is_symbol(mpl));
      /* read symbols and construct complete subscript list */
      tuple = create_tuple(mpl);
      for (temp = slice; temp != NULL; temp = temp->next)
      {  if (temp->sym == NULL)
         {  /* substitution is needed; read symbol */
            if (!is_symbol(mpl))
            {  int lack = slice_arity(mpl, temp) + 1;
               xassert(with != NULL);
               xassert(lack > 1);
               error(mpl, "%d items missing in data group beginning wit"
                  "h %s", lack, format_symbol(mpl, with));
            }
            sym = read_symbol(mpl);
            if (with == NULL) with = sym;
         }
         else
         {  /* copy symbol from the slice */
            sym = copy_symbol(mpl, temp->sym);
         }
         /* append the symbol to the subscript list */
         tuple = expand_tuple(mpl, tuple, sym);
         /* skip optional comma */
         if (mpl->token == T_COMMA) get_token(mpl /* , */);
      }
      /* read value and assign it to new parameter member */
      if (!is_symbol(mpl))
      {  xassert(with != NULL);
         error(mpl, "one item missing in data group beginning with %s",
            format_symbol(mpl, with));
      }
      read_value(mpl, par, tuple);
      return;
}

/*----------------------------------------------------------------------
-- tabular_format - read parameter data block in tabular format.
--
-- This routine reads parameter data block using the syntax:
--
-- <tabular format> ::= <column> <column> ... <column> :=
--                <row> <value>  <value>  ... <value>
--                <row> <value>  <value>  ... <value>
--                  .  .  .  .  .  .  .  .  .  .  .
--                <row> <value>  <value>  ... <value>
--
-- where <rows> are symbols that denote rows of the table, <columns>
-- are symbols that denote columns of the table, <values> are numeric
-- or symbolic values assigned to the corresponding parameter members.
-- If <value> is specified as single point, no value is provided.
--
-- Number of components in the slice must be the same as dimension of
-- the parameter. The slice must have two null positions. To construct
-- complete subscript list for particular <value> the routine replaces
-- the first null position of the slice by the corresponding <row> (or
-- <column>, if the flag tr is on) and the second null position by the
-- corresponding <column> (or by <row>, if the flag tr is on). */

void tabular_format
(     MPL *mpl,
      PARAMETER *par,         /* not changed */
      SLICE *slice,           /* not changed */