glpmpl03.c

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

)
{     TUPLE *temp;
      int dim = 0;
      xassert(mpl == mpl);
      for (temp = tuple; temp != NULL; temp = temp->next) dim++;
      return dim;
}

/*----------------------------------------------------------------------
-- copy_tuple - make copy of n-tuple.
--
-- This routine returns an exact copy of n-tuple. */

TUPLE *copy_tuple
(     MPL *mpl,
      TUPLE *tuple            /* not changed */
)
{     TUPLE *head, *tail;
      if (tuple == NULL)
         head = NULL;
      else
      {  head = tail = dmp_get_atom(mpl->tuples, sizeof(TUPLE));
         for (; tuple != NULL; tuple = tuple->next)
         {  xassert(tuple->sym != NULL);
            tail->sym = copy_symbol(mpl, tuple->sym);
            if (tuple->next != NULL)
tail = (tail->next = dmp_get_atom(mpl->tuples, sizeof(TUPLE)));
         }
         tail->next = NULL;
      }
      return head;
}

/*----------------------------------------------------------------------
-- compare_tuples - compare one n-tuple with another.
--
-- This routine compares two given n-tuples, which must have the same
-- dimension (not checked for the sake of efficiency), and returns one
-- of the following codes:
--
-- = 0 - both n-tuples are identical;
-- < 0 - the first n-tuple precedes the second one;
-- > 0 - the first n-tuple follows the second one.
--
-- Note that the linear order, in which n-tuples follow each other, is
-- implementation-dependent. It may be not an alphabetical order. */

int compare_tuples
(     MPL *mpl,
      TUPLE *tuple1,          /* not changed */
      TUPLE *tuple2           /* not changed */
)
{     TUPLE *item1, *item2;
      int ret;
      xassert(mpl == mpl);
      for (item1 = tuple1, item2 = tuple2; item1 != NULL;
           item1 = item1->next, item2 = item2->next)
      {  xassert(item2 != NULL);
         xassert(item1->sym != NULL);
         xassert(item2->sym != NULL);
         ret = compare_symbols(mpl, item1->sym, item2->sym);
         if (ret != 0) return ret;
      }
      xassert(item2 == NULL);
      return 0;
}

/*----------------------------------------------------------------------
-- build_subtuple - build subtuple of given n-tuple.
--
-- This routine builds subtuple, which consists of first dim components
-- of given n-tuple. */

TUPLE *build_subtuple
(     MPL *mpl,
      TUPLE *tuple,           /* not changed */
      int dim
)
{     TUPLE *head, *temp;
      int j;
      head = create_tuple(mpl);
      for (j = 1, temp = tuple; j <= dim; j++, temp = temp->next)
      {  xassert(temp != NULL);
         head = expand_tuple(mpl, head, copy_symbol(mpl, temp->sym));
      }
      return head;
}

/*----------------------------------------------------------------------
-- delete_tuple - delete n-tuple.
--
-- This routine deletes specified n-tuple. */

void delete_tuple
(     MPL *mpl,
      TUPLE *tuple            /* destroyed */
)
{     TUPLE *temp;
      while (tuple != NULL)
      {  temp = tuple;
         tuple = temp->next;
         xassert(temp->sym != NULL);
         delete_symbol(mpl, temp->sym);
         dmp_free_atom(mpl->tuples, temp, sizeof(TUPLE));
      }
      return;
}

/*----------------------------------------------------------------------
-- format_tuple - format n-tuple for displaying or printing.
--
-- This routine converts specified n-tuple to a character string, which
-- is suitable for displaying or printing.
--
-- The resultant string is never longer than 255 characters. If it gets
-- longer, it is truncated from the right and appended by dots. */

char *format_tuple
(     MPL *mpl,
      int c,
      TUPLE *tuple            /* not changed */
)
{     TUPLE *temp;
      int dim, j, len;
      char *buf = mpl->tup_buf, str[255+1], *save;
#     define safe_append(c) \
         (void)(len < 255 ? (buf[len++] = (char)(c)) : 0)
      buf[0] = '\0', len = 0;
      dim = tuple_dimen(mpl, tuple);
      if (c == '[' && dim > 0) safe_append('[');
      if (c == '(' && dim > 1) safe_append('(');
      for (temp = tuple; temp != NULL; temp = temp->next)
      {  if (temp != tuple) safe_append(',');
         xassert(temp->sym != NULL);
         save = mpl->sym_buf;
         mpl->sym_buf = str;
         format_symbol(mpl, temp->sym);
         mpl->sym_buf = save;
         xassert(strlen(str) < sizeof(str));
         for (j = 0; str[j] != '\0'; j++) safe_append(str[j]);
      }
      if (c == '[' && dim > 0) safe_append(']');
      if (c == '(' && dim > 1) safe_append(')');
#     undef safe_append
      buf[len] = '\0';
      if (len == 255) strcpy(buf+252, "...");
      xassert(strlen(buf) <= 255);
      return buf;
}

/**********************************************************************/
/* * *                       ELEMENTAL SETS                       * * */
/**********************************************************************/

/*----------------------------------------------------------------------
-- create_elemset - create elemental set.
--
-- This routine creates an elemental set, whose members are n-tuples of
-- specified dimension. Being created the set is initially empty. */

ELEMSET *create_elemset(MPL *mpl, int dim)
{     ELEMSET *set;
      xassert(dim > 0);
      set = create_array(mpl, A_NONE, dim);
      return set;
}

/*----------------------------------------------------------------------
-- find_tuple - check if elemental set contains given n-tuple.
--
-- This routine finds given n-tuple in specified elemental set in order
-- to check if the set contains that n-tuple. If the n-tuple is found,
-- the routine returns pointer to corresponding array member. Otherwise
-- null pointer is returned. */

MEMBER *find_tuple
(     MPL *mpl,
      ELEMSET *set,           /* not changed */
      TUPLE *tuple            /* not changed */
)
{     xassert(set != NULL);
      xassert(set->type == A_NONE);
      xassert(set->dim == tuple_dimen(mpl, tuple));
      return find_member(mpl, set, tuple);
}

/*----------------------------------------------------------------------
-- add_tuple - add new n-tuple to elemental set.
--
-- This routine adds given n-tuple to specified elemental set.
--
-- For the sake of efficiency this routine doesn't check whether the
-- set already contains the same n-tuple or not. Therefore the calling
-- program should use the routine find_tuple (if necessary) in order to
-- make sure that the given n-tuple is not contained in the set, since
-- duplicate n-tuples within the same set are not allowed. */

MEMBER *add_tuple
(     MPL *mpl,
      ELEMSET *set,           /* modified */
      TUPLE *tuple            /* destroyed */
)
{     MEMBER *memb;
      xassert(set != NULL);
      xassert(set->type == A_NONE);
      xassert(set->dim == tuple_dimen(mpl, tuple));
      memb = add_member(mpl, set, tuple);
      memb->value.none = NULL;
      return memb;
}

/*----------------------------------------------------------------------
-- check_then_add - check and add new n-tuple to elemental set.
--
-- This routine is equivalent to the routine add_tuple except that it
-- does check for duplicate n-tuples. */

MEMBER *check_then_add
(     MPL *mpl,
      ELEMSET *set,           /* modified */
      TUPLE *tuple            /* destroyed */
)
{     if (find_tuple(mpl, set, tuple) != NULL)
         error(mpl, "duplicate tuple %s detected", format_tuple(mpl,
            '(', tuple));
      return add_tuple(mpl, set, tuple);
}

/*----------------------------------------------------------------------
-- copy_elemset - make copy of elemental set.
--
-- This routine makes an exact copy of elemental set. */

ELEMSET *copy_elemset
(     MPL *mpl,
      ELEMSET *set            /* not changed */
)
{     ELEMSET *copy;
      MEMBER *memb;
      xassert(set != NULL);
      xassert(set->type == A_NONE);
      xassert(set->dim > 0);
      copy = create_elemset(mpl, set->dim);
      for (memb = set->head; memb != NULL; memb = memb->next)
         add_tuple(mpl, copy, copy_tuple(mpl, memb->tuple));
      return copy;
}

/*----------------------------------------------------------------------
-- delete_elemset - delete elemental set.
--
-- This routine deletes specified elemental set. */

void delete_elemset
(     MPL *mpl,
      ELEMSET *set            /* destroyed */
)
{     xassert(set != NULL);
      xassert(set->type == A_NONE);
      delete_array(mpl, set);
      return;
}

/*----------------------------------------------------------------------
-- arelset_size - compute size of "arithmetic" elemental set.
--
-- This routine computes the size of "arithmetic" elemental set, which
-- is specified in the form of arithmetic progression:
--
--    { t0 .. tf by dt }.
--
-- The size is computed using the formula:
--
--    n = max(0, floor((tf - t0) / dt) + 1). */

int arelset_size(MPL *mpl, double t0, double tf, double dt)
{     double temp;
      if (dt == 0.0)
         error(mpl, "%.*g .. %.*g by %.*g; zero stride not allowed",
            DBL_DIG, t0, DBL_DIG, tf, DBL_DIG, dt);
      if (tf > 0.0 && t0 < 0.0 && tf > + 0.999 * DBL_MAX + t0)
         temp = +DBL_MAX;
      else if (tf < 0.0 && t0 > 0.0 && tf < - 0.999 * DBL_MAX + t0)
         temp = -DBL_MAX;
      else
         temp = tf - t0;
      if (fabs(dt) < 1.0 && fabs(temp) > (0.999 * DBL_MAX) * fabs(dt))
      {  if (temp > 0.0 && dt > 0.0 || temp < 0.0 && dt < 0.0)
            temp = +DBL_MAX;
         else
            temp = 0.0;
      }
      else
      {  temp = floor(temp / dt) + 1.0;
         if (temp < 0.0) temp = 0.0;
      }
      xassert(temp >= 0.0);
      if (temp > (double)(INT_MAX - 1))
         error(mpl, "%.*g .. %.*g by %.*g; set too large",
            DBL_DIG, t0, DBL_DIG, tf, DBL_DIG, dt);
      return (int)(temp + 0.5);
}

/*----------------------------------------------------------------------
-- arelset_member - compute member of "arithmetic" elemental set.
--
-- This routine returns a numeric value of symbol, which is equivalent
-- to j-th member of given "arithmetic" elemental set specified in the
-- form of arithmetic progression:
--
--    { t0 .. tf by dt }.
--
-- The symbol value is computed with the formula:
--
--    j-th member = t0 + (j - 1) * dt,
--
-- The number j must satisfy to the restriction 1 <= j <= n, where n is
-- the set size computed by the routine arelset_size. */

double arelset_member(MPL *mpl, double t0, double tf, double dt, int j)
{     xassert(1 <= j && j <= arelset_size(mpl, t0, tf, dt));
      return t0 + (double)(j - 1) * dt;
}

/*----------------------------------------------------------------------
-- create_arelset - create "arithmetic" elemental set.
--
-- This routine creates "arithmetic" elemental set, which is specified
-- in the form of arithmetic progression:
--
--    { t0 .. tf by dt }.
--
-- Components of this set are 1-tuples. */

ELEMSET *create_arelset(MPL *mpl, double t0, double tf, double dt)
{     ELEMSET *set;
      int j, n;
      set = create_elemset(mpl, 1);
      n = arelset_size(mpl, t0, tf, dt);
      for (j = 1; j <= n; j++)
      {  add_tuple
         (  mpl,
            set,
            expand_tuple
            (  mpl,
               create_tuple(mpl),
               create_symbol_num
               (  mpl,
                  arelset_member(mpl, t0, tf, dt, j)
               )
            )
         );
      }
      return set;
}

/*----------------------------------------------------------------------
-- set_union - union of two elemental sets.
--
-- This routine computes the union:
--
--    X U Y = { j | (j in X) or (j in Y) },
--
-- where X and Y are given elemental sets (destroyed on exit). */

ELEMSET *set_union
(     MPL *mpl,
      ELEMSET *X,             /* destroyed */
      ELEMSET *Y              /* destroyed */
)
{     MEMBER *memb;
      xassert(X != NULL);
      xassert(X->type == A_NONE);
      xassert(X->dim > 0);
      xassert(Y != NULL);
      xassert(Y->type == A_NONE);
      xassert(Y->dim > 0);
      xassert(X->dim == Y->dim);
      for (memb = Y->head; memb != NULL; memb = memb->next)
      {  if (find_tuple(mpl, X, memb->tuple) == NULL)
            add_tuple(mpl, X, copy_tuple(mpl, memb->tuple));
      }
      delete_elemset(mpl, Y);
      return X;
}

/*----------------------------------------------------------------------
-- set_diff - difference between two elemental sets.
--
-- This routine computes the difference:
--
--    X \ Y = { j | (j in X) and (j not in Y) },
--
-- where X and Y are given elemental sets (destroyed on exit). */