Beispiel #1
0
dyret_enum dy_factor (flags *calcflgs)

/*
  This routine orchestrates the LU factorisation of the basis. The glpk
  routines do the grunt work. This routine provides the intelligence.

  If inv_decomp aborts the attempt to factor due to numerical instability, we
  tighten the pivot selection parameters one notch and try again, giving up
  only when no further increase is possible.  The sequence of values for the
  pivot selection parameters are defined in a table at the top of this file.

  If inv_decomp aborts the attempt to factor because the basis is singular,
  we correct the basis with adjust_basis and take another run at factoring.
  In the event that the basis is successfully patched, we have serious work
  to do.  See the comments with adjust_therest for further information. If
  the user has for some reason disabled basis patching, we return
  dyrSINGULAR.

  inv_decomp (actually, luf_decomp) is self-expanding --- if more space is
  needed to hold the factorization, the expansion is handled internally.
  dylp uses ladEXPAND to force basis expansion after a pivot fails due to lack
  of space. In glpk, inv_update will set instructions in the basis structure
  and luf_decomp will handle the expansion, so ladEXPAND is redundant. No
  action need be taken in this routine. It's also not possible to tell if the
  basis has been expanded, so ladEXPAND is not set on output.


  Parameters:
    calcflgs:   (i) ladPRIMALS indicates the primal variables should be
		    recalculated after factoring the basis.
		    ladDUALS indicates the dual variables should be
		    recalculated after factoring the basis.
		    ladEXPAND indicates that the basis should be expanded prior
		    to refactoring.
		(o) flags are set to indicate if the corresponding variables
		    have been recalculated.

  Returns: dyrOK if the basis is factored without incident
	   dyrPATCHED if the basis was singular and has been repaired
	   dyrSINGULAR if the basis was singular and has not been repaired
	   dyrNUMERIC if factoring failed for the strictest pivoting regimen
	   dyrFATAL for other fatal errors

  NOTE: glpinv/glpluf will crash and burn if they encounter what they consider
	to be a fatal error, rather than returning a fatal error code. This
	needs to be addressed at some point. In particular, failure to expand
	the basis, failure to load the basis from the constraint system, and
	various parameter errors fall into this category.
*/

{ int retval,patchcnt ;
  bool try_again,patched ;
  dyret_enum retcode ;
  patch_struct *patches ;

  const char *rtnnme = "dy_factor" ;

#ifdef DYLP_PARANOIA
  if (dy_sys == NULL)
  { errmsg(2,rtnnme,"dy_sys") ;
    return (dyrFATAL) ; }
  if (dy_basis == NULL)
  { errmsg(2,rtnnme,"basis") ;
    return (dyrFATAL) ; }
#endif

# ifdef DYLP_STATISTICS
  if (dy_stats != NULL)
  { int pivcnt ;
    pivcnt = dy_lp->tot.pivs-dy_stats->factor.prevpiv ;
    dy_stats->factor.avgpivs = dy_stats->factor.avgpivs*dy_stats->factor.cnt ;
    dy_stats->factor.avgpivs += pivcnt ;
    dy_stats->factor.cnt++ ;
    dy_stats->factor.avgpivs /= dy_stats->factor.cnt ;
    if (pivcnt > dy_stats->factor.maxpivs) dy_stats->factor.maxpivs = pivcnt ;
    dy_stats->factor.prevpiv = dy_lp->tot.pivs ; }
# endif

  retcode = dyrINV ;
  patchcnt = 0 ;
  patches = NULL ;

/*
  Call luf_adjustsize to set the actual size of the basis. If the allocated
  capacity is too small, it will be expanded.
*/
  luf_adjustsize() ;
/*
  Open a loop for factorisation attempts. We'll persist in the face of
  numerical stability problems as long as there's room to tighten the pivot
  selection.

  At present, glpinv/glpluf will crash and burn if they encounter fatal
  problems. The basis load is implicit --- the routine factor_loadcol is
  called from luf_decomp to load up the coefficients.
*/
  try_again = TRUE ;
  patched = FALSE ;
  while (try_again)
  { retval = inv_decomp(luf_basis,dy_sys,factor_loadcol) ;
#   ifndef DYLP_NDEBUG
    if ((retval == 0 && dy_opts->print.basis >= 4) ||
	(retval > 0 && dy_opts->print.basis >= 2))
    { dyio_outfmt(dy_logchn,dy_gtxecho,
		  "\n    (%s)%d: factored with %s, basis stability %g.",
		  dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
		  dy_prtpivparms(-1),luf_basis->min_vrratio) ; }
#   endif
/*
  Deal with the result. A return code of 0 means there were no difficulties;
  1 says the basis was singular and had to be patched before the
  factorisation could be completed. Either is success, and we're done.
*/
    switch (retval)
    { case 0:
      { try_again = FALSE ;
	retcode = dyrOK ;
	break ; }
/*
  Alas, the failures.

  If the problem is a singular basis (retval = 1), fix up the basis structures
  as indicated in the luf_basis structure and try again to factor the basis,
  unless the user has forbidden it.

  If the problem is numerical instability (retval = 2) try to make the pivot
  selection more stringent, and keep trying until we can try no more, at
  which point we'll return numeric instability to the caller.

  What's left is fatal confusion; pass the buck back to the caller.
*/
      case 1:
      { if (dy_opts->patch == FALSE)
	{ errmsg(308,rtnnme,dy_sys->nme,dy_prtlpphase(dy_lp->phase,TRUE),
		 dy_lp->tot.iters,dy_prtdyret(dyrSINGULAR)) ;
	  clrflg(*calcflgs,ladPRIMALS|ladDUALS) ;
	  return (dyrSINGULAR) ; }
#	ifndef DYLP_NDEBUG
	if (dy_opts->print.basis >= 2)
	{ dyio_outfmt(dy_logchn,dy_gtxecho,
		      "\n    (%s)%d: attempting to patch singular basis.",
		      dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters) ; }
#	endif
	adjust_basis(&patchcnt,&patches) ;
	patched = TRUE ;
	break ; }
      case 2:
      { retcode = dyrNUMERIC ;
#	ifndef DYLP_NDEBUG
	if (dy_opts->print.basis >= 2)
	{ dyio_outfmt(dy_logchn,dy_gtxecho,
		  "\n    (%s)%d: factor failed at %s, numerical instability,",
		  dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
		  dy_prtpivparms(-1)) ;
	  dyio_outfmt(dy_logchn,dy_gtxecho," max = %g, gro = %g.",
		      luf_basis->luf->big_v,luf_basis->luf->max_gro) ; }
# 	endif
	if (dy_setpivparms(+1,0) == FALSE)
	{ errmsg(307,rtnnme,dy_sys->nme,dy_prtlpphase(dy_lp->phase,TRUE),
		 dy_lp->tot.iters,dy_prtpivparms(-1)) ;
	  return (retcode) ; }
#	ifndef DYLP_NDEBUG
	if (dy_opts->print.basis >= 2)
	{ dyio_outfmt(dy_logchn,dy_gtxecho,"\n\ttrying again with %s.",
		      dy_prtpivparms(-1)) ; }
#	endif
	break ; }
      default:
      { errmsg(7,rtnnme,__LINE__,"inv_decomp return code",retval) ;
	return (dyrFATAL) ; } }
  }
/*
  If we reach here, we managed to factor the basis.  Reset the count of
  pivots since the last refactor.  If the basis was patched, we have some
  serious cleanup to do, so call adjust_therest to deal with the details.
  Otherwise, turn to the requests to calculate values for the primal and/or
  dual variables.
*/
  dy_lp->basis.etas = 0 ;
  if (patched == TRUE)
  { retcode = adjust_therest(patchcnt,patches) ;
    FREE(patches) ;
    if (retcode == dyrFATAL)
    { errmsg(306,rtnnme,dy_sys->nme,dy_prtlpphase(dy_lp->phase,TRUE),
	     dy_lp->tot.iters) ;
      return (dyrFATAL) ; }
#   ifndef DYLP_NDEBUG
    if (dy_opts->print.basis >= 1)
    { dyio_outfmt(dy_logchn,dy_gtxecho,
		  "\n\t[%s]: compensated for basis correction.",
		  dy_sys->nme) ; }
#   endif
    if (!(dy_lp->phase == dyINIT))
    { setflg(*calcflgs,ladPRIMALS|ladDUALS) ;
      if (retcode == dyrLOSTDFEAS) setflg(*calcflgs,ladDUALFEAS) ; }
    retcode = dyrPATCHED ; }
  else
  { if (flgon(*calcflgs,ladPRIMALS))
    { if (dy_calcprimals() == FALSE)
      { clrflg(*calcflgs,ladPRIMALS) ;
	return (dyrFATAL) ; } }
    if (flgon(*calcflgs,ladDUALS)) dy_calcduals() ; }

  return (retcode) ; }
Beispiel #2
0
bool dy_clrpivrej (int *entries)

/*
  This routine removes variables from rejected pivot list. As far as the rest
  of dylp is concerned, all that needs to be done is to clear the NOPIVOT
  qualifier from the variable's status entry.

  Internally, there are really two modes: clear specified entries, and clear
  the entire list. If the client supplies an array of indices in the entries
  parameter, selective removal is performed, otherwise the entire list is
  cleared.

  Parameters:
    entries:	an array with indices of entries to be removed
		entries[0] is expected to contain the number of entries

  Returns: TRUE if the clearing operation is successful, FALSE otherwise.
*/

{ int n,j,ndx,last,endx,elast ;
  flags statj ;

  const char *rtnnme = "dy_clrpivrej" ;

# ifdef DYLP_PARANOIA
  flags chkflgs ;

/*
  For dual simplex, only out-of-bound basic variables are considered for
  pivoting, but subsequent dual pivots could change that to pretty much
  any basic status. For primal simplex, any nonbasic status is ok, including
  the exotic ones.
*/
  if (dy_lp->phase == dyDUAL)
  { chkflgs = vstatBASIC ; }
  else
  { chkflgs = vstatNONBASIC|vstatEXOTIC ; }
# endif

/*
  Are we clearing the entire list? If so, also restore the default pivot
  tolerance. If we're being selective about clearing, leave the tolerance
  unchanged and assume the client will take care of it. If there are no
  entries in pivrejlst, that's all we need to do.
*/
  if (entries == NULL)
  { dy_tols->pivot = pivrej_ctl.savedtol ;
    pivrej_ctl.iter_reduced = -1 ; }
  if (pivrej_ctl.cnt == 0) return (TRUE) ;

# ifndef DYLP_NDEBUG
  if (dy_opts->print.pivreject >= 1)
  { dyio_outfmt(dy_logchn,dy_gtxecho,"\n    %s pivot reject list ... ",
	        (entries == NULL)?"clearing":"winnowing") ; }
# endif

  n = dy_sys->varcnt ;
  last = pivrej_ctl.cnt-1 ;

/*
  If the client hasn't supplied entries, we're clearing the entire list.
*/
  if (entries == NULL)
  { 
    for (ndx = 0 ; ndx <= last ; ndx++)
    { j = pivrejlst[ndx].ndx ;
      statj = dy_status[j] ;
#     ifdef DYLP_PARANOIA
      if (j < 1 || j > n)
      { errmsg(102,rtnnme,dy_sys->nme,"rejected variable",j,1,n) ;
	return (FALSE) ; }
      if (flgoff(statj,vstatNOPIVOT) || flgoff(statj,chkflgs))
      { errmsg(329,rtnnme,
	       dy_sys->nme,dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
	       consys_nme(dy_sys,'v',j,FALSE,NULL),j,ndx,dy_prtvstat(statj),
	       (dy_lp->phase == dyDUAL)?"basic":"nonbasic") ;
	return (FALSE) ; }
#     endif
#     ifndef DYLP_NDEBUG
      if (dy_opts->print.pivreject >= 2)
	dyio_outfmt(dy_logchn,dy_gtxecho,
		    "\n\trestoring %s (%d) as eligible for pivoting.",
		    consys_nme(dy_sys,'v',j,TRUE,NULL),j) ;
#     endif
      clrflg(dy_status[j],vstatNOPIVOT) ; }

    last = -1 ;
    pivrej_ctl.mad = 0 ;
    pivrej_ctl.sing = 0 ; }
/*
  The more complicated case: Remove the set of entries specified by the
  client. The sort is necessary so that we can compress in place, moving the
  last entry to replace the deleted entry.
*/
  else
  { elast = entries[0] ;
    if (elast > 1)
    { qsort(&entries[1],elast,sizeof(int),int_nonincreasing) ; }
    for (endx = 1 ; endx <= elast ; endx++)
    { ndx = entries[endx] ;
#     ifdef DYLP_PARANOIA
      if (ndx < 0 || ndx >= pivrej_ctl.cnt)
      { errmsg(102,rtnnme,dy_sys->nme,"pivrej list index",ndx,
	       0,pivrej_ctl.cnt-1) ;
	return (FALSE) ; }
#     endif
      j = pivrejlst[ndx].ndx ;
      statj = dy_status[j] ;
#     ifdef DYLP_PARANOIA
      if (j < 1 || j > n)
      { errmsg(102,rtnnme,dy_sys->nme,"rejected variable",j,1,n) ;
	return (FALSE) ; }
      if (flgoff(statj,vstatNOPIVOT) || flgoff(statj,chkflgs))
      { errmsg(329,rtnnme,
	       dy_sys->nme,dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
	       consys_nme(dy_sys,'v',j,FALSE,NULL),j,ndx,dy_prtvstat(statj),
	       (dy_lp->phase == dyDUAL)?"basic":"nonbasic") ;
	return (FALSE) ; }
#     endif
      clrflg(dy_status[j],vstatNOPIVOT) ;
#     ifndef DYLP_NDEBUG
      if (dy_opts->print.pivreject >= 2)
	dyio_outfmt(dy_logchn,dy_gtxecho,
		    "\n\trestoring %s (%d) as eligible for pivoting.",
		    consys_nme(dy_sys,'v',j,TRUE,NULL),j) ;
#     endif
      if (ndx < last)
      { pivrejlst[ndx] = pivrejlst[last] ;
	switch (pivrejlst[ndx].why)
	{ case dyrSINGULAR:
	  { pivrej_ctl.sing-- ;
	    break ; }
	  case dyrMADPIV:
	  { pivrej_ctl.mad-- ;
	    break ; }
	  default:
	  { errmsg(1,rtnnme,__LINE__) ;
	    return (FALSE) ; } } }
      last-- ; } }

    last++ ;
#   ifndef DYLP_NDEBUG
    if (dy_opts->print.pivreject >= 1)
    { if (dy_opts->print.pivreject >= 2)
      { dyio_outfmt(dy_logchn,dy_gtxecho,"\n      ") ; }
      dyio_outfmt(dy_logchn,dy_gtxecho,"restored %d variables.",
		  pivrej_ctl.cnt-last) ; }
#   endif
    pivrej_ctl.cnt = last ;

  return (TRUE) ; }