dyret_enum dy_dealWithPunt (void)
/*
This routine decides on the appropriate action(s) when a simplex decides to
punt. The algorithm is this:
1) Sort the entries in pivrejlst into two sets: iter == basis.pivs
(current) and iter != basis.pivs (old). In the current set, count
the number of mad and singular entries.
2) If there are any entries in old, remove them from pivrejlst and
return with an indication to resume pivoting (dyrRESELECT).
3) If all entries in current are of type singular, return with an
indication to abort this simplex phase (dyrPUNT) and hope that we can
alter the constraint system.
4) For each permissible reduction in pivot tolerance, check for entries
of type MADPIV that might become acceptable. If there are any, remove
them from pivrejlst and return dyrRESELECT.
5) If 4) failed to identify pivots, return dyrPUNT.
Parameters: none
Returns: dyrRESELECT if pivoting can resume
dyrPUNT to abort this simplex phase
dyrFATAL if something goes wrong
*/
{ int j,ndx,last,oldcnt,curcnt,curmad,brk ;
double maxratio,pivmul ;
bool clr_retval ;
dyret_enum retval ;
int *old,*current ;
pivrej_struct *pivrej ;
# ifndef DYLP_NDEBUG
const char *rtnnme = "dy_dealWithPunt" ;
# endif
# ifdef DYLP_STATISTICS
if (dy_stats != NULL) dy_stats->pivrej.puntcall++ ;
# endif
retval = dyrINV ;
/*
If there are no rejected pivots, the punt stands.
*/
if (pivrej_ctl.cnt == 0)
{
# ifdef DYLP_STATISTICS
if (dy_stats != NULL) dy_stats->pivrej.puntret++ ;
# endif
return (dyrPUNT) ; }
/*
Setup and scan pivrejlst as indicated above.
*/
last = pivrej_ctl.cnt ;
brk = dy_lp->basis.pivs ;
old = (int *) MALLOC((last+1)*sizeof(int)) ;
current = (int *) MALLOC((last+1)*sizeof(int)) ;
oldcnt = 0 ;
curcnt = 0 ;
curmad = 0 ;
maxratio = 0 ;
for (ndx = 0 ; ndx < last ; ndx++)
{ pivrej = &pivrejlst[ndx] ;
if (pivrej->iter != brk)
{ old[++oldcnt] = ndx ; }
else
{ current[++curcnt] = ndx ;
if (pivrej->why == dyrMADPIV)
{ curmad++ ;
if (maxratio < pivrej->ratio) maxratio = pivrej->ratio ; } } }
/*
If there are old entries, we can always hope the intervening pivots have
cured the problem. It happens.
*/
if (oldcnt > 0)
{ old[0] = oldcnt ;
clr_retval = dy_clrpivrej(old) ;
if (clr_retval == TRUE)
{ retval = dyrRESELECT ; }
else
{ retval = dyrFATAL ; }
# ifndef DYLP_NDEBUG
if (dy_opts->print.pivreject >= 1)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n restored %d entries queued before iter = %d.",
old[0],brk) ; }
# endif
}
/*
Are there any mad pivots that we can press into service by reducing the pivot
tolerance?
*/
else
if (curmad > 0 && maxratio > dy_tols->zero)
{ pivmul = 1/dy_tols->pivot ;
while (maxratio*pivmul < 1.0) pivmul *= pivrej_ctl.pivmul ;
if (1/pivmul >= dy_tols->zero*100)
{
# ifndef DYLP_NDEBUG
if (dy_opts->print.pivreject >= 1)
{ warn(376,rtnnme,
dy_sys->nme,dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
dy_tols->pivot,1/pivmul) ; }
# endif
dy_tols->pivot = 1/pivmul ;
# ifdef DYLP_STATISTICS
if (dy_stats != NULL)
{ dy_stats->pivrej.pivtol_red++ ;
if (dy_tols->pivot < dy_stats->pivrej.min_pivtol)
{ dy_stats->pivrej.min_pivtol = dy_tols->pivot ; } }
# endif
j = 0 ;
for (ndx = 1 ; ndx <= curcnt ; ndx++)
{ pivrej = &pivrejlst[current[ndx]] ;
if (pivrej->ratio*pivmul > 1.0)
{ current[++j] = current[ndx] ; } }
current[0] = j ;
clr_retval = dy_clrpivrej(current) ;
if (clr_retval == TRUE)
{ retval = dyrRESELECT ; }
else
{ retval = dyrFATAL ; }
# ifndef DYLP_NDEBUG
if (dy_opts->print.pivreject >= 1)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n restored %d entries queued at iter = %d at piv. tol = %g",
current[0],brk,dy_tols->pivot) ; }
# endif
}
else
{
# ifndef DYLP_NDEBUG
if (dy_opts->print.pivreject >= 1)
{ warn(383,rtnnme,dy_sys->nme,
dy_prtlpphase(dy_lp->phase,TRUE),dy_lp->tot.iters,
dy_tols->zero,dy_prtdyret(dyrPUNT)) ; }
# endif
retval = dyrPUNT ; } }
else
{ retval = dyrPUNT ; }
/*
That's it, we've done our best. Free the old and current arrays and return.
*/
FREE(old) ;
FREE(current) ;
# ifndef DYLP_NDEBUG
if (retval == dyrPUNT && dy_opts->print.pivreject >= 1)
{ dyio_outfmt(dy_logchn,dy_gtxecho,"\n PUNT! mad = %d, singular = %d.",
pivrej_ctl.mad,pivrej_ctl.sing) ; }
# endif
# ifdef DYLP_STATISTICS
if (dy_stats != NULL && retval == dyrPUNT) dy_stats->pivrej.puntret++ ;
# endif
return (retval) ; }
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) ; }
dyret_enum dy_addtopivrej (int j, dyret_enum why,
double abarij, double maxabarij)
/*
This routine adds x<j> to the rejected pivot list by adding an entry to
pivrejlst and adding the NOPIVOT qualifier to x<j>'s status.
If necessary, it expands the size of the list.
Parameter:
j: the variable x<j>
why: the reason it's going on the pivot reject list; one of
dyrSINGULAR or dyrMADPIV
abarij: (why == dyrMADPIV) the pivot element
maxabarij: (why == dyrMADPIV) the maximum pivot element in the pivot
column (primal) or row (dual).
Returns: dyrOK if the entry is added without error, dyrFATAL if we can't
get more space, or if a paranoid check fails.
*/
{ int n,ndx,newsze ;
double ratio ;
const char *rtnnme = "dy_addtopivrej" ;
# ifndef DYLP_NDEBUG
int saveprint ;
saveprint = dy_opts->print.pivoting ;
dy_opts->print.pivoting = 0 ;
# endif
/*
We don't actually need the pivot ratio until further down, but it's handy
to do it here where we can easily suppress the internal print, then restore
the print level.
*/
ratio = dy_chkpiv(abarij,maxabarij) ;
n = dy_sys->varcnt ;
# ifndef DYLP_NDEBUG
dy_opts->print.pivoting = saveprint ;
# endif
# ifdef DYLP_PARANOIA
if (j < 1 || j > n)
{ errmsg(102,rtnnme,dy_sys->nme,"variable",j,1,n) ;
return (dyrFATAL) ; }
if (!(why == dyrSINGULAR || why == dyrMADPIV))
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; }
# endif
# ifndef DYLP_NDEBUG
/*
The default case in this switch is needed to suppress GCC warnings --- it
doesn't grok the paranoid check.
*/
if (dy_opts->print.pivreject >= 2)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n marking %s (%d) ineligible for pivoting ",
consys_nme(dy_sys,'v',j,TRUE,NULL),j) ;
switch (why)
{ case dyrSINGULAR:
{ dyio_outfmt(dy_logchn,dy_gtxecho,"(%s).",dy_prtdyret(why)) ;
break ; }
case dyrMADPIV:
{ dyio_outfmt(dy_logchn,dy_gtxecho,"(%s = %g).",dy_prtdyret(why),ratio) ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; } } }
# endif
/*
Flag the culprit --- the extent of externally visible activity. Then make
the entry in the pivot reject list. Check for adequate list length and
expand if necessary.
*/
setflg(dy_status[j],vstatNOPIVOT) ;
ndx = pivrej_ctl.cnt++ ;
if (ndx >= pivrej_ctl.sze)
{ newsze = minn(2*pivrej_ctl.sze,n+1) ;
# ifndef DYLP_NDEBUG
if (dy_opts->print.pivreject >= 3)
{ dyio_outfmt(dy_logchn,dy_gtxecho,
"\n%s: expanding pivot reject list from %d to %d entries.",
rtnnme,pivrej_ctl.sze,newsze) ; }
# endif
pivrejlst =
(pivrej_struct *) REALLOC(pivrejlst,newsze*sizeof(pivrej_struct)) ;
if (pivrejlst == NULL)
{ errmsg(337,rtnnme,dy_sys->nme,pivrej_ctl.sze,newsze) ;
return (dyrFATAL) ; }
pivrej_ctl.sze = newsze ; }
pivrejlst[ndx].ndx = j ;
pivrejlst[ndx].iter = dy_lp->basis.pivs ;
pivrejlst[ndx].why = why ;
switch (why)
{ case dyrSINGULAR:
{ pivrej_ctl.sing++ ;
break ; }
case dyrMADPIV:
{ pivrej_ctl.mad++ ;
ratio = dy_chkpiv(abarij,maxabarij) ;
pivrejlst[ndx].ratio = ratio*dy_tols->pivot ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; } }
# ifdef DYLP_STATISTICS
if (dy_stats != NULL)
{ switch (why)
{ case dyrSINGULAR:
{ dy_stats->pivrej.sing++ ;
break ; }
case dyrMADPIV:
{ dy_stats->pivrej.mad++ ;
break ; }
default:
{ errmsg(1,rtnnme,__LINE__) ;
return (dyrFATAL) ; } }
if (pivrej_ctl.cnt > dy_stats->pivrej.max)
{ dy_stats->pivrej.max = pivrej_ctl.cnt ; } }
# endif
return (dyrOK) ; }
