glpmpl03.c

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

            break;
         default:
            xassert(type != type);
      }
      return;
}

/**********************************************************************/
/* * *                SYMBOLICALLY INDEXED ARRAYS                 * * */
/**********************************************************************/

/*----------------------------------------------------------------------
-- create_array - create array.
--
-- This routine creates an array of specified type and dimension. Being
-- created the array is initially empty.
--
-- The type indicator determines generic values, which can be assigned
-- to the array members:
--
-- A_NONE     - none (members have no assigned values)
-- A_NUMERIC  - floating-point numbers
-- A_SYMBOLIC - symbols
-- A_ELEMSET  - elemental sets
-- A_ELEMVAR  - elemental variables
-- A_ELEMCON  - elemental constraints
--
-- The dimension may be 0, in which case the array consists of the only
-- member (such arrays represent 0-dimensional objects). */

ARRAY *create_array(MPL *mpl, int type, int dim)
{     ARRAY *array;
      xassert(type == A_NONE || type == A_NUMERIC ||
             type == A_SYMBOLIC || type == A_ELEMSET ||
             type == A_ELEMVAR || type == A_ELEMCON);
      xassert(dim >= 0);
      array = dmp_get_atom(mpl->arrays, sizeof(ARRAY));
      array->type = type;
      array->dim = dim;
      array->size = 0;
      array->head = NULL;
      array->tail = NULL;
      array->tree = NULL;
      array->prev = NULL;
      array->next = mpl->a_list;
      /* include the array in the global array list */
      if (array->next != NULL) array->next->prev = array;
      mpl->a_list = array;
      return array;
}

/*----------------------------------------------------------------------
-- find_member - find array member with given n-tuple.
--
-- This routine finds an array member, which has given n-tuple. If the
-- array is short, the linear search is used. Otherwise the routine
-- autimatically creates the search tree (i.e. the array index) to find
-- members for logarithmic time. */

static int compare_member_tuples(void *info, const void *key1,
      const void *key2)
{     /* this is an auxiliary routine used to compare keys, which are
         n-tuples assigned to array members */
      return compare_tuples((MPL *)info, (TUPLE *)key1, (TUPLE *)key2);
}

MEMBER *find_member
(     MPL *mpl,
      ARRAY *array,           /* not changed */
      TUPLE *tuple            /* not changed */
)
{     MEMBER *memb;
      xassert(array != NULL);
      /* the n-tuple must have the same dimension as the array */
      xassert(tuple_dimen(mpl, tuple) == array->dim);
      /* if the array is large enough, create the search tree and index
         all existing members of the array */
      if (array->size > 30 && array->tree == NULL)
      {  array->tree = avl_create_tree(compare_member_tuples, mpl);
         for (memb = array->head; memb != NULL; memb = memb->next)
avl_set_node_link(avl_insert_node(array->tree, memb->tuple),
               (void *)memb);
      }
      /* find a member, which has the given tuple */
      if (array->tree == NULL)
      {  /* the search tree doesn't exist; use the linear search */
         for (memb = array->head; memb != NULL; memb = memb->next)
            if (compare_tuples(mpl, memb->tuple, tuple) == 0) break;
      }
      else
      {  /* the search tree exists; use the binary search */
         AVLNODE *node;
         node = avl_find_node(array->tree, tuple);
memb = (MEMBER *)(node == NULL ? NULL : avl_get_node_link(node));
      }
      return memb;
}

/*----------------------------------------------------------------------
-- add_member - add new member to array.
--
-- This routine creates a new member with given n-tuple and adds it to
-- specified array.
--
-- For the sake of efficiency this routine doesn't check whether the
-- array already contains a member with the given n-tuple or not. Thus,
-- if necessary, the calling program should use the routine find_member
-- in order to be sure that the array contains no member with the same
-- n-tuple, because members with duplicate n-tuples are not allowed.
--
-- This routine assigns no generic value to the new member, because the
-- calling program must do that. */

MEMBER *add_member
(     MPL *mpl,
      ARRAY *array,           /* modified */
      TUPLE *tuple            /* destroyed */
)
{     MEMBER *memb;
      xassert(array != NULL);
      /* the n-tuple must have the same dimension as the array */
      xassert(tuple_dimen(mpl, tuple) == array->dim);
      /* create new member */
      memb = dmp_get_atom(mpl->members, sizeof(MEMBER));
      memb->tuple = tuple;
      memb->next = NULL;
      memset(&memb->value, '?', sizeof(VALUE));
      /* and append it to the member list */
      array->size++;
      if (array->head == NULL)
         array->head = memb;
      else
         array->tail->next = memb;
      array->tail = memb;
      /* if the search tree exists, index the new member */
      if (array->tree != NULL)
avl_set_node_link(avl_insert_node(array->tree, memb->tuple),
            (void *)memb);
      return memb;
}

/*----------------------------------------------------------------------
-- delete_array - delete array.
--
-- This routine deletes specified array.
--
-- Generic values assigned to the array members are not deleted by this
-- routine. The calling program itself must delete all assigned generic
-- values before deleting the array. */

void delete_array
(     MPL *mpl,
      ARRAY *array            /* destroyed */
)
{     MEMBER *memb;
      xassert(array != NULL);
      /* delete all existing array members */
      while (array->head != NULL)
      {  memb = array->head;
         array->head = memb->next;
         delete_tuple(mpl, memb->tuple);
         dmp_free_atom(mpl->members, memb, sizeof(MEMBER));
      }
      /* if the search tree exists, also delete it */
      if (array->tree != NULL) avl_delete_tree(array->tree);
      /* remove the array from the global array list */
      if (array->prev == NULL)
         mpl->a_list = array->next;
      else
         array->prev->next = array->next;
      if (array->next == NULL)
         ;
      else
         array->next->prev = array->prev;
      /* delete the array descriptor */
      dmp_free_atom(mpl->arrays, array, sizeof(ARRAY));
      return;
}

/**********************************************************************/
/* * *                 DOMAINS AND DUMMY INDICES                  * * */
/**********************************************************************/

/*----------------------------------------------------------------------
-- assign_dummy_index - assign new value to dummy index.
--
-- This routine assigns new value to specified dummy index and, that is
-- important, invalidates all temporary resultant values, which depends
-- on that dummy index. */

void assign_dummy_index
(     MPL *mpl,
      DOMAIN_SLOT *slot,      /* modified */
      SYMBOL *value           /* not changed */
)
{     CODE *leaf, *code;
      xassert(slot != NULL);
      xassert(value != NULL);
      /* delete the current value assigned to the dummy index */
      if (slot->value != NULL)
      {  /* if the current value and the new one are identical, actual
            assignment is not needed */
         if (compare_symbols(mpl, slot->value, value) == 0) goto done;
         /* delete a symbol, which is the current value */
         delete_symbol(mpl, slot->value), slot->value = NULL;
      }
      /* now walk through all the pseudo-codes with op = O_INDEX, which
         refer to the dummy index to be changed (these pseudo-codes are
         leaves in the forest of *all* expressions in the database) */
      for (leaf = slot->list; leaf != NULL; leaf = leaf->arg.index.
         next)
      {  xassert(leaf->op == O_INDEX);
         /* invalidate all resultant values, which depend on the dummy
            index, walking from the current leaf toward the root of the
            corresponding expression tree */
         for (code = leaf; code != NULL; code = code->up)
         {  if (code->valid)
            {  /* invalidate and delete resultant value */
               code->valid = 0;
               delete_value(mpl, code->type, &code->value);
            }
         }
      }
      /* assign new value to the dummy index */
      slot->value = copy_symbol(mpl, value);
done: return;
}

/*----------------------------------------------------------------------
-- update_dummy_indices - update current values of dummy indices.
--
-- This routine assigns components of "backup" n-tuple to dummy indices
-- of specified domain block. If no "backup" n-tuple is defined for the
-- domain block, values of the dummy indices remain untouched. */

void update_dummy_indices
(     MPL *mpl,
      DOMAIN_BLOCK *block     /* not changed */
)
{     DOMAIN_SLOT *slot;
      TUPLE *temp;
      if (block->backup != NULL)
      {  for (slot = block->list, temp = block->backup; slot != NULL;
            slot = slot->next, temp = temp->next)
         {  xassert(temp != NULL);
            xassert(temp->sym != NULL);
            assign_dummy_index(mpl, slot, temp->sym);
         }
      }
      return;
}

/*----------------------------------------------------------------------
-- enter_domain_block - enter domain block.
--
-- Let specified domain block have the form:
--
--    { ..., (j1, j2, ..., jn) in J, ... }
--
-- where j1, j2, ..., jn are dummy indices, J is a basic set.
--
-- This routine does the following:
--
-- 1. Checks if the given n-tuple is a member of the basic set J. Note
--    that J being *out of the scope* of the domain block cannot depend
--    on the dummy indices in the same and inner domain blocks, so it
--    can be computed before the dummy indices are assigned new values.
--    If this check fails, the routine returns with non-zero code.
--
-- 2. Saves current values of the dummy indices j1, j2, ..., jn.
--
-- 3. Assigns new values, which are components of the given n-tuple, to
--    the dummy indices j1, j2, ..., jn. If dimension of the n-tuple is
--    larger than n, its extra components n+1, n+2, ... are not used.
--
-- 4. Calls the formal routine func which either enters the next domain
--    block or evaluates some code within the domain scope.
--
-- 5. Restores former values of the dummy indices j1, j2, ..., jn.
--
-- Since current values assigned to the dummy indices on entry to this
-- routine are restored on exit, the formal routine func is allowed to
-- call this routine recursively. */

int enter_domain_block
(     MPL *mpl,
      DOMAIN_BLOCK *block,    /* not changed */
      TUPLE *tuple,           /* not changed */
      void *info, void (*func)(MPL *mpl, void *info)
)
{     TUPLE *backup;
      int ret = 0;
      /* check if the given n-tuple is a member of the basic set */
      xassert(block->code != NULL);
      if (!is_member(mpl, block->code, tuple))
      {  ret = 1;
         goto done;
      }
      /* save reference to "backup" n-tuple, which was used to assign
         current values of the dummy indices (it is sufficient to save
         reference, not value, because that n-tuple is defined in some
         outer level of recursion and therefore cannot be changed on
         this and deeper recursive calls) */
      backup = block->backup;
      /* set up new "backup" n-tuple, which defines new values of the
         dummy indices */
      block->backup = tuple;
      /* assign new values to the dummy indices */
      update_dummy_indices(mpl, block);
      /* call the formal routine that does the rest part of the job */
      func(mpl, info);
      /* restore reference to the former "backup" n-tuple */
      block->backup = backup;
      /* restore former values of the dummy indices; note that if the
         domain block just escaped has no other active instances which
         may exist due to recursion (it is indicated by a null pointer
         to the former n-tuple), former values of the dummy indices are
         undefined; therefore in this case the routine keeps currently
         assigned values of the dummy indices that involves keeping all
         dependent temporary results and thereby, if this domain block
         is not used recursively, allows improving efficiency */
      update_dummy_indices(mpl, block);
done: return ret;
}

/*----------------------------------------------------------------------
-- eval_within_domain - perform evaluation within domain scope.
--
-- This routine assigns new values (symbols) to all dummy indices of
-- specified domain and calls the formal routine func, which is used to
-- evaluate some code in the domain scope. Each free dummy index in the
-- domain is assigned a value specified in the corresponding component
-- of given n-tuple. Non-free dummy indices are assigned values, which
-- are computed by this routine.
--
-- Number of components in the given n-tuple must be the same as number
-- of free indices in the domain.
--
-- If the given n-tuple is not a member of the domain set, the routine
-- func is not called, and non-zero code is returned.
--
-- For the sake of convenience it is allowed to specify domain as NULL
-- (then n-tuple also must be 0-tuple, i.e. empty), in which case this
-- routine just calls the routine func and returns zero.
--
-- This routine allows recursive calls from the routine func providing
-- correct values of dummy indices for each instance.
--
-- NOTE: The n-tuple passed to this routine must not be changed by any
--       other routines called from the formal routine func until this
--       routine has returned. */

struct eval_domain_info
{     /* working info used by the routine eval_within_domain */
      DOMAIN *domain;
      /* domain, which has to be entered */
      DOMAIN_BLOCK *block;
      /* domain block, which is currently processed */
      TUPLE *tuple;
      /* tail of original n-tuple, whose components have to be assigned
         to free dummy indices in the current domain block */
      void *info;
      /* transit pointer passed to the formal routine func */
      void (*func)(MPL *mpl, void *info);
      /* routine, which has to be executed in the domain scope */
      int failure;
      /* this flag indicates that given n-tuple is not a member of the
         domain set */
};

static void eval_domain_func(MPL *mpl, void *_my_info)
{     /* this routine recursively enters into the domain scope and then
         calls the routine func */
      struct eval_domain_info *my_info = _my_info;
      if (my_info->block != NULL)
      {  /* the current domain block to be entered exists */
         DOMAIN_BLOCK *block;
         DOMAIN_SLOT *slot;
         TUPLE *tuple = NULL, *temp = NULL;
         /* save pointer to the current domain block */
         block = my_info->block;
         /* and get ready to enter the next block (if it exists) */
         my_info->block = block->next;
         /* construct temporary n-tuple, whose components correspond to
            dummy indices (slots) of the current domain; components of
            the temporary n-tuple that correspond to free dummy indices
            are assigned references (not values!) to symbols specified
            in the corresponding components of the given n-tuple, while
            other components that correspond to non-free dummy indices
            are assigned symbolic values computed here */
         for (slot = block->list; slot != NULL; slot = slot->next)
         {  /* create component that corresponds to the current slot */
            if (tuple == NULL)