double spy_eval_gamma_i(SPXLP *lp, SPYSE *se, int i)
{ int m = lp->m;
int n = lp->n;
int *head = lp->head;
char *refsp = se->refsp;
double *rho = se->work;
int j, k;
double gamma_i, t_ij;
xassert(se->valid);
xassert(1 <= i && i <= m);
k = head[i]; /* x[k] = xB[i] */
gamma_i = (refsp[k] ? 1.0 : 0.0);
spx_eval_rho(lp, i, rho);
for (j = 1; j <= n-m; j++)
{ k = head[m+j]; /* x[k] = xN[j] */
if (refsp[k])
{ t_ij = spx_eval_tij(lp, rho, j);
gamma_i += t_ij * t_ij;
}
}
return gamma_i;
}
int spx_dual_opt(SPX *spx)
{ /* find optimal solution (dual simplex) */
int m = spx->m;
int n = spx->n;
int ret;
double start = utime(), spent = 0.0, obj;
/* the initial basis should be "warmed up" */
if (spx->b_stat != LPX_B_VALID ||
spx->p_stat == LPX_P_UNDEF || spx->d_stat == LPX_D_UNDEF)
{ ret = LPX_E_BADB;
goto done;
}
/* the initial basic solution should be dual feasible */
if (spx->d_stat != LPX_D_FEAS)
{ ret = LPX_E_INFEAS;
goto done;
}
/* if the initial basic solution is primal feasible, nothing to
search for */
if (spx->p_stat == LPX_P_FEAS)
{ ret = LPX_E_OK;
goto done;
}
/* allocate the working segment */
insist(spx->meth == 0);
spx->meth = 'D';
spx->p = 0;
spx->p_tag = 0;
spx->q = 0;
spx->zeta = ucalloc(1+m, sizeof(double));
spx->ap = ucalloc(1+n, sizeof(double));
spx->aq = ucalloc(1+m, sizeof(double));
spx->gvec = NULL;
spx->dvec = ucalloc(1+m, sizeof(double));
spx->refsp = (spx->price ? ucalloc(1+m+n, sizeof(int)) : NULL);
spx->count = 0;
spx->work = ucalloc(1+m+n, sizeof(double));
spx->orig_typx = NULL;
spx->orig_lb = spx->orig_ub = NULL;
spx->orig_dir = 0;
spx->orig_coef = NULL;
beg: /* compute initial value of the objective function */
obj = spx_eval_obj(spx);
/* initialize weights of basic variables */
if (!spx->price)
{ /* textbook pricing will be used */
int i;
for (i = 1; i <= m; i++) spx->dvec[i] = 1.0;
}
else
{ /* steepest edge pricing will be used */
spx_reset_refsp(spx);
}
/* display information about the initial basic solution */
if (spx->msg_lev >= 2 && spx->it_cnt % spx->out_frq != 0 &&
spx->out_dly <= spent) dual_opt_dpy(spx);
/* main loop starts here */
for (;;)
{ /* determine the spent amount of time */
spent = utime() - start;
/* display information about the current basic solution */
if (spx->msg_lev >= 2 && spx->it_cnt % spx->out_frq == 0 &&
spx->out_dly <= spent) dual_opt_dpy(spx);
/* if the objective function should be minimized, check if it
has reached its upper bound */
if (spx->dir == LPX_MIN && obj >= spx->obj_ul)
{ ret = LPX_E_OBJUL;
break;
}
/* if the objective function should be maximized, check if it
has reached its lower bound */
if (spx->dir == LPX_MAX && obj <= spx->obj_ll)
{ ret = LPX_E_OBJLL;
break;
}
/* check if the iterations limit has been exhausted */
if (spx->it_lim == 0)
{ ret = LPX_E_ITLIM;
break;
}
/* check if the time limit has been exhausted */
if (spx->tm_lim >= 0.0 && spx->tm_lim <= spent)
{ ret = LPX_E_TMLIM;
break;
}
/* choose basic variable */
spx_dual_chuzr(spx, spx->tol_bnd);
/* if no xB[p] has been chosen, the current basic solution is
primal feasible and therefore optimal */
if (spx->p == 0)
{ ret = LPX_E_OK;
break;
}
/* compute the p-th row of the inverse inv(B) */
spx_eval_rho(spx, spx->p, spx->zeta);
/* compute the p-th row of the current simplex table */
spx_eval_row(spx, spx->zeta, spx->ap);
/* choose non-basic variable xN[q] */
if (spx_dual_chuzc(spx, spx->relax * spx->tol_dj))
{ /* the basis matrix should be reinverted, because the p-th
row of the simplex table is unreliable */
insist("not implemented yet" == NULL);
}
/* if no xN[q] has been chosen, there is no primal feasible
solution (the dual problem has unbounded solution) */
if (spx->q == 0)
{ ret = LPX_E_NOFEAS;
break;
}
/* compute the q-th column of the current simplex table (later
this column will enter the basis) */
spx_eval_col(spx, spx->q, spx->aq, 1);
/* update values of basic variables and value of the objective
function */
spx_update_bbar(spx, &obj);
/* update simplex multipliers */
spx_update_pi(spx);
/* update reduced costs of non-basic variables */
spx_update_cbar(spx, 0);
/* update weights of basic variables */
if (spx->price) spx_update_dvec(spx);
/* if xB[p] is fixed variable, adjust its non-basic tag */
if (spx->typx[spx->indx[spx->p]] == LPX_FX)
spx->p_tag = LPX_NS;
/* jump to the adjacent vertex of the LP polyhedron */
if (spx_change_basis(spx))
{ /* the basis matrix should be reinverted */
if (spx_invert(spx) != 0)
{ /* numerical problems with the basis matrix */
spx->p_stat = LPX_P_UNDEF;
spx->d_stat = LPX_D_UNDEF;
ret = LPX_E_SING;
goto done;
}
/* compute the current basic solution components */
spx_eval_bbar(spx);
obj = spx_eval_obj(spx);
spx_eval_pi(spx);
spx_eval_cbar(spx);
/* check dual feasibility */
if (spx_check_cbar(spx, spx->tol_dj) != 0.0)
{ /* the current solution became dual infeasible due to
round-off errors */
ret = LPX_E_INSTAB;
break;
}
}
#if 0
/* check accuracy of main solution components after updating
(for debugging purposes only) */
{ double ae_bbar = spx_err_in_bbar(spx);
double ae_pi = spx_err_in_pi(spx);
double ae_cbar = spx_err_in_cbar(spx, 0);
double ae_dvec = spx->price ? spx_err_in_dvec(spx) : 0.0;
print("bbar: %g; pi: %g; cbar: %g; dvec: %g",
ae_bbar, ae_pi, ae_cbar, ae_dvec);
if (ae_bbar > 1e-9 || ae_pi > 1e-9 || ae_cbar > 1e-9 ||
ae_dvec > 1e-3)
insist("solution accuracy too low" == NULL);
}
#endif
}
/* compute the final basic solution components */
spx_eval_bbar(spx);
obj = spx_eval_obj(spx);
spx_eval_pi(spx);
spx_eval_cbar(spx);
if (spx_check_bbar(spx, spx->tol_bnd) == 0.0)
spx->p_stat = LPX_P_FEAS;
else
spx->p_stat = LPX_P_INFEAS;
if (spx_check_cbar(spx, spx->tol_dj) == 0.0)
spx->d_stat = LPX_D_FEAS;
else
spx->d_stat = LPX_D_INFEAS;
/* display information about the final basic solution */
if (spx->msg_lev >= 2 && spx->it_cnt % spx->out_frq != 0 &&
spx->out_dly <= spent) dual_opt_dpy(spx);
/* correct the preliminary diagnosis */
switch (ret)
{ case LPX_E_OK:
/* assumed LPX_P_FEAS and LPX_D_FEAS */
if (spx->d_stat != LPX_D_FEAS)
ret = LPX_E_INSTAB;
else if (spx->p_stat != LPX_P_FEAS)
{ /* it seems we need to continue the search */
goto beg;
}
break;
case LPX_E_OBJLL:
case LPX_E_OBJUL:
/* assumed LPX_P_INFEAS and LPX_D_FEAS */
if (spx->d_stat != LPX_D_FEAS)
ret = LPX_E_INSTAB;
else if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
else if (spx->dir == LPX_MIN && obj < spx->obj_ul ||
spx->dir == LPX_MAX && obj > spx->obj_ll)
{ /* it seems we need to continue the search */
goto beg;
}
break;
case LPX_E_ITLIM:
case LPX_E_TMLIM:
/* assumed LPX_P_INFEAS and LPX_D_FEAS */
if (spx->d_stat != LPX_D_FEAS)
ret = LPX_E_INSTAB;
else if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
break;
case LPX_E_NOFEAS:
/* assumed LPX_P_INFEAS and LPX_D_FEAS */
if (spx->d_stat != LPX_D_FEAS)
ret = LPX_E_INSTAB;
else if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
else
spx->p_stat = LPX_P_NOFEAS;
break;
case LPX_E_INSTAB:
/* assumed LPX_D_INFEAS */
if (spx->d_stat == LPX_D_FEAS)
{ if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
else
{ /* it seems we need to continue the search */
goto beg;
}
}
break;
default:
insist(ret != ret);
}
done: /* deallocate the working segment */
if (spx->meth != 0)
{ spx->meth = 0;
ufree(spx->zeta);
ufree(spx->ap);
ufree(spx->aq);
ufree(spx->dvec);
if (spx->price) ufree(spx->refsp);
ufree(spx->work);
}
/* determine the spent amount of time */
spent = utime() - start;
/* decrease the time limit by the spent amount */
if (spx->tm_lim >= 0.0)
{ spx->tm_lim -= spent;
if (spx->tm_lim < 0.0) spx->tm_lim = 0.0;
}
/* return to the calling program */
return ret;
}
int spx_prim_feas(SPX *spx)
{ /* find primal feasible solution (primal simplex) */
int m = spx->m;
int n = spx->n;
int i, k, ret;
double sum_0;
double start = utime(), spent = 0.0;
/* the initial basis should be "warmed up" */
if (spx->b_stat != LPX_B_VALID ||
spx->p_stat == LPX_P_UNDEF || spx->d_stat == LPX_D_UNDEF)
{ ret = LPX_E_BADB;
goto done;
}
/* if the initial basic solution is primal feasible, nothing to
search for */
if (spx->p_stat == LPX_P_FEAS)
{ ret = LPX_E_OK;
goto done;
}
/* allocate the working segment */
insist(spx->meth == 0);
spx->meth = 'P';
spx->p = 0;
spx->p_tag = 0;
spx->q = 0;
spx->zeta = ucalloc(1+m, sizeof(double));
spx->ap = ucalloc(1+n, sizeof(double));
spx->aq = ucalloc(1+m, sizeof(double));
spx->gvec = ucalloc(1+n, sizeof(double));
spx->dvec = NULL;
spx->refsp = (spx->price ? ucalloc(1+m+n, sizeof(int)) : NULL);
spx->count = 0;
spx->work = ucalloc(1+m+n, sizeof(double));
spx->orig_typx = ucalloc(1+m+n, sizeof(int));
spx->orig_lb = ucalloc(1+m+n, sizeof(double));
spx->orig_ub = ucalloc(1+m+n, sizeof(double));
spx->orig_dir = 0;
spx->orig_coef = ucalloc(1+m+n, sizeof(double));
/* save components of the original LP problem, which are changed
by the routine */
memcpy(spx->orig_typx, spx->typx, (1+m+n) * sizeof(int));
memcpy(spx->orig_lb, spx->lb, (1+m+n) * sizeof(double));
memcpy(spx->orig_ub, spx->ub, (1+m+n) * sizeof(double));
spx->orig_dir = spx->dir;
memcpy(spx->orig_coef, spx->coef, (1+m+n) * sizeof(double));
/* build an artificial basic solution, which is primal feasible,
and also build an auxiliary objective function to minimize the
sum of infeasibilities (residuals) for the original problem */
spx->dir = LPX_MIN;
for (k = 0; k <= m+n; k++) spx->coef[k] = 0.0;
for (i = 1; i <= m; i++)
{ int typx_k;
double lb_k, ub_k, bbar_i;
double eps = 0.10 * spx->tol_bnd;
k = spx->indx[i]; /* x[k] = xB[i] */
typx_k = spx->orig_typx[k];
lb_k = spx->orig_lb[k];
ub_k = spx->orig_ub[k];
bbar_i = spx->bbar[i];
if (typx_k == LPX_LO || typx_k == LPX_DB || typx_k == LPX_FX)
{ /* in the original problem x[k] has an lower bound */
if (bbar_i < lb_k - eps)
{ /* and violates it */
spx->typx[k] = LPX_UP;
spx->lb[k] = 0.0;
spx->ub[k] = lb_k;
spx->coef[k] = -1.0; /* x[k] should be increased */
}
}
if (typx_k == LPX_UP || typx_k == LPX_DB || typx_k == LPX_FX)
{ /* in the original problem x[k] has an upper bound */
if (bbar_i > ub_k + eps)
{ /* and violates it */
spx->typx[k] = LPX_LO;
spx->lb[k] = ub_k;
spx->ub[k] = 0.0;
spx->coef[k] = +1.0; /* x[k] should be decreased */
}
}
}
/* now the initial basic solution should be primal feasible due
to changes of bounds of some basic variables, which turned to
implicit artifical variables */
insist(spx_check_bbar(spx, spx->tol_bnd) == 0.0);
/* compute the initial sum of infeasibilities for the original
problem */
sum_0 = orig_infsum(spx, 0.0);
/* it can't be zero, because the initial basic solution is primal
infeasible */
insist(sum_0 != 0.0);
/* compute simplex multipliers and reduced costs of non-basic
variables once again (because the objective function has been
changed) */
spx_eval_pi(spx);
spx_eval_cbar(spx);
/* initialize weights of non-basic variables */
if (!spx->price)
{ /* textbook pricing will be used */
int j;
for (j = 1; j <= n; j++) spx->gvec[j] = 1.0;
}
else
{ /* steepest edge pricing will be used */
spx_reset_refsp(spx);
}
/* display information about the initial basic solution */
if (spx->msg_lev >= 2 && spx->it_cnt % spx->out_frq != 0 &&
spx->out_dly <= spent) prim_feas_dpy(spx, sum_0);
/* main loop starts here */
for (;;)
{ /* determine the spent amount of time */
spent = utime() - start;
/* display information about the current basic solution */
if (spx->msg_lev >= 2 && spx->it_cnt % spx->out_frq == 0 &&
spx->out_dly <= spent) prim_feas_dpy(spx, sum_0);
/* we needn't to wait until all artificial variables leave the
basis */
if (orig_infsum(spx, spx->tol_bnd) == 0.0)
{ /* the sum of infeasibilities is zero, therefore the current
solution is primal feasible for the original problem */
ret = LPX_E_OK;
break;
}
/* check if the iterations limit has been exhausted */
if (spx->it_lim == 0)
{ ret = LPX_E_ITLIM;
break;
}
/* check if the time limit has been exhausted */
if (spx->tm_lim >= 0.0 && spx->tm_lim <= spent)
{ ret = LPX_E_TMLIM;
break;
}
/* choose non-basic variable xN[q] */
if (spx_prim_chuzc(spx, spx->tol_dj))
{ /* basic solution components were recomputed; check primal
feasibility (of the artificial solution) */
if (spx_check_bbar(spx, spx->tol_bnd) != 0.0)
{ /* the current solution became primal infeasible due to
round-off errors */
ret = LPX_E_INSTAB;
break;
}
}
/* if no xN[q] has been chosen, the sum of infeasibilities is
minimal but non-zero; therefore the original problem has no
primal feasible solution */
if (spx->q == 0)
{ ret = LPX_E_NOFEAS;
break;
}
/* compute the q-th column of the current simplex table (later
this column will enter the basis) */
spx_eval_col(spx, spx->q, spx->aq, 1);
/* choose basic variable xB[p] */
if (spx_prim_chuzr(spx, spx->relax * spx->tol_bnd))
{ /* the basis matrix should be reinverted, because the q-th
column of the simplex table is unreliable */
insist("not implemented yet" == NULL);
}
/* the sum of infeasibilities can't be negative, therefore the
modified problem can't have unbounded solution */
insist(spx->p != 0);
/* update values of basic variables */
spx_update_bbar(spx, NULL);
if (spx->p > 0)
{ /* compute the p-th row of the inverse inv(B) */
spx_eval_rho(spx, spx->p, spx->zeta);
/* compute the p-th row of the current simplex table */
spx_eval_row(spx, spx->zeta, spx->ap);
/* update simplex multipliers */
spx_update_pi(spx);
/* update reduced costs of non-basic variables */
spx_update_cbar(spx, 0);
/* update weights of non-basic variables */
if (spx->price) spx_update_gvec(spx);
}
/* xB[p] is leaving the basis; if it is implicit artificial
variable, the corresponding residual vanishes; therefore
bounds of this variable should be restored to the original
ones */
if (spx->p > 0)
{ k = spx->indx[spx->p]; /* x[k] = xB[p] */
if (spx->typx[k] != spx->orig_typx[k])
{ /* x[k] is implicit artificial variable */
spx->typx[k] = spx->orig_typx[k];
spx->lb[k] = spx->orig_lb[k];
spx->ub[k] = spx->orig_ub[k];
insist(spx->p_tag == LPX_NL || spx->p_tag == LPX_NU);
spx->p_tag = (spx->p_tag == LPX_NL ? LPX_NU : LPX_NL);
if (spx->typx[k] == LPX_FX) spx->p_tag = LPX_NS;
/* nullify the objective coefficient at x[k] */
spx->coef[k] = 0.0;
/* since coef[k] has been changed, we need to compute
new reduced cost of x[k], which it will have in the
adjacent basis */
/* the formula d[j] = cN[j] - pi' * N[j] is used (note
that the vector pi is not changed, because it depends
on objective coefficients at basic variables, but in
the adjacent basis, for which the vector pi has been
just recomputed, x[k] is non-basic) */
if (k <= m)
{ /* x[k] is auxiliary variable */
spx->cbar[spx->q] = - spx->pi[k];
}
else
{ /* x[k] is structural variable */
int ptr = spx->aa_ptr[k];
int end = ptr + spx->aa_len[k] - 1;
double d = 0.0;
for (ptr = ptr; ptr <= end; ptr++)
d += spx->pi[spx->aa_ind[ptr]] * spx->aa_val[ptr];
spx->cbar[spx->q] = d;
}
}
}
/* jump to the adjacent vertex of the LP polyhedron */
if (spx_change_basis(spx))
{ /* the basis matrix should be reinverted */
if (spx_invert(spx))
{ /* numerical problems with the basis matrix */
ret = LPX_E_SING;
break;
}
/* compute the current basic solution components */
spx_eval_bbar(spx);
spx_eval_pi(spx);
spx_eval_cbar(spx);
/* check primal feasibility */
if (spx_check_bbar(spx, spx->tol_bnd) != 0.0)
{ /* the current solution became primal infeasible due to
excessive round-off errors */
ret = LPX_E_INSTAB;
break;
}
}
#if 0
/* check accuracy of main solution components after updating
(for debugging purposes only) */
{ double ae_bbar = spx_err_in_bbar(spx);
double ae_pi = spx_err_in_pi(spx);
double ae_cbar = spx_err_in_cbar(spx, 0);
double ae_gvec = spx->price ? spx_err_in_gvec(spx) : 0.0;
print("bbar: %g; pi: %g; cbar: %g; gvec: %g",
ae_bbar, ae_pi, ae_cbar, ae_gvec);
if (ae_bbar > 1e-7 || ae_pi > 1e-7 || ae_cbar > 1e-7 ||
ae_gvec > 1e-3) fault("solution accuracy too low");
}
#endif
}
/* restore components of the original problem, which were changed
by the routine */
memcpy(spx->typx, spx->orig_typx, (1+m+n) * sizeof(int));
memcpy(spx->lb, spx->orig_lb, (1+m+n) * sizeof(double));
memcpy(spx->ub, spx->orig_ub, (1+m+n) * sizeof(double));
spx->dir = spx->orig_dir;
memcpy(spx->coef, spx->orig_coef, (1+m+n) * sizeof(double));
/* if there are numerical problems with the basis matrix, the
latter must be repaired; mark the basic solution as undefined
and exit immediately */
if (ret == LPX_E_SING)
{ spx->p_stat = LPX_P_UNDEF;
spx->d_stat = LPX_D_UNDEF;
goto done;
}
/* compute the final basic solution components */
spx_eval_bbar(spx);
spx_eval_pi(spx);
spx_eval_cbar(spx);
if (spx_check_bbar(spx, spx->tol_bnd) == 0.0)
spx->p_stat = LPX_P_FEAS;
else
spx->p_stat = LPX_P_INFEAS;
if (spx_check_cbar(spx, spx->tol_dj) == 0.0)
spx->d_stat = LPX_D_FEAS;
else
spx->d_stat = LPX_D_INFEAS;
/* display information about the final basic solution */
if (spx->msg_lev >= 2 && spx->it_cnt % spx->out_frq != 0 &&
spx->out_dly <= spent) prim_feas_dpy(spx, sum_0);
/* correct the preliminary diagnosis */
switch (ret)
{ case LPX_E_OK:
/* assumed LPX_P_FEAS */
if (spx->p_stat != LPX_P_FEAS)
ret = LPX_E_INSTAB;
break;
case LPX_E_ITLIM:
case LPX_E_TMLIM:
/* assumed LPX_P_INFEAS */
if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
break;
case LPX_E_NOFEAS:
/* assumed LPX_P_INFEAS */
if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
else
spx->p_stat = LPX_P_NOFEAS;
break;
case LPX_E_INSTAB:
/* assumed LPX_P_INFEAS */
if (spx->p_stat == LPX_P_FEAS)
ret = LPX_E_OK;
break;
default:
insist(ret != ret);
}
done: /* deallocate the working segment */
if (spx->meth != 0)
{ spx->meth = 0;
ufree(spx->zeta);
ufree(spx->ap);
ufree(spx->aq);
ufree(spx->gvec);
if (spx->price) ufree(spx->refsp);
ufree(spx->work);
ufree(spx->orig_typx);
ufree(spx->orig_lb);
ufree(spx->orig_ub);
ufree(spx->orig_coef);
}
/* determine the spent amount of time */
spent = utime() - start;
/* decrease the time limit by the spent amount */
if (spx->tm_lim >= 0.0)
{ spx->tm_lim -= spent;
if (spx->tm_lim < 0.0) spx->tm_lim = 0.0;
}
/* return to the calling program */
return ret;
}
static void choose_pivot(struct csa *csa)
{ SPXLP *lp = csa->lp;
int m = lp->m;
int n = lp->n;
double *l = lp->l;
int *head = lp->head;
SPXAT *at = csa->at;
SPXNT *nt = csa->nt;
double *beta = csa->beta;
double *d = csa->d;
SPYSE *se = csa->se;
int *list = csa->list;
double *rho = csa->work;
double *trow = csa->work1;
int nnn, try, k, p, q, t;
xassert(csa->beta_st);
xassert(csa->d_st);
/* initial number of eligible basic variables */
nnn = csa->num;
/* nothing has been chosen so far */
csa->p = 0;
try = 0;
try: /* choose basic variable xB[p] */
xassert(nnn > 0);
try++;
if (se == NULL)
{ /* dual Dantzig's rule */
p = spy_chuzr_std(lp, beta, nnn, list);
}
else
{ /* dual projected steepest edge */
p = spy_chuzr_pse(lp, se, beta, nnn, list);
}
xassert(1 <= p && p <= m);
/* compute p-th row of inv(B) */
spx_eval_rho(lp, p, rho);
/* compute p-th row of the simplex table */
if (at != NULL)
spx_eval_trow1(lp, at, rho, trow);
else
spx_nt_prod(lp, nt, trow, 1, -1.0, rho);
/* choose non-basic variable xN[q] */
k = head[p]; /* x[k] = xB[p] */
if (!csa->harris)
q = spy_chuzc_std(lp, d, beta[p] < l[k] ? +1. : -1., trow,
csa->tol_piv, .30 * csa->tol_dj, .30 * csa->tol_dj1);
else
q = spy_chuzc_harris(lp, d, beta[p] < l[k] ? +1. : -1., trow,
csa->tol_piv, .35 * csa->tol_dj, .35 * csa->tol_dj1);
/* either keep previous choice or accept new choice depending on
* which one is better */
if (csa->p == 0 || q == 0 ||
fabs(trow[q]) > fabs(csa->trow[csa->q]))
{ csa->p = p;
memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double));
csa->q = q;
}
/* check if current choice is acceptable */
if (csa->q == 0 || fabs(csa->trow[csa->q]) >= 0.001)
goto done;
if (nnn == 1)
goto done;
if (try == 5)
goto done;
/* try to choose other xB[p] and xN[q] */
/* find xB[p] in the list */
for (t = 1; t <= nnn; t++)
if (list[t] == p) break;
xassert(t <= nnn);
/* move xB[p] to the end of the list */
list[t] = list[nnn], list[nnn] = p;
/* and exclude it from consideration */
nnn--;
/* repeat the choice */
goto try;
done: /* the choice has been made */
return;
}
/***********************************************************************
* display - display search progress
*
* This routine displays some information about the search progress
* that includes:
*
* search phase;
*
* number of simplex iterations performed by the solver;
*
* original objective value (only on phase II);
*
* sum of (scaled) dual infeasibilities for original bounds;
*
* number of dual infeasibilities (phase I) or primal infeasibilities
* (phase II);
*
* number of basic factorizations since last display output. */
static void display(struct csa *csa, int spec)
{ SPXLP *lp = csa->lp;
int m = lp->m;
int n = lp->n;
int *head = lp->head;
char *flag = lp->flag;
double *l = csa->l; /* original lower bounds */
double *u = csa->u; /* original upper bounds */
double *beta = csa->beta;
double *d = csa->d;
int j, k, nnn;
double sum;
/* check if the display output should be skipped */
if (csa->msg_lev < GLP_MSG_ON) goto skip;
if (csa->out_dly > 0 &&
1000.0 * xdifftime(xtime(), csa->tm_beg) < csa->out_dly)
goto skip;
if (csa->it_cnt == csa->it_dpy) goto skip;
if (!spec && csa->it_cnt % csa->out_frq != 0) goto skip;
/* display search progress depending on search phase */
switch (csa->phase)
{ case 1:
/* compute sum and number of (scaled) dual infeasibilities
* for original bounds */
sum = 0.0, nnn = 0;
for (j = 1; j <= n-m; j++)
{ k = head[m+j]; /* x[k] = xN[j] */
if (d[j] > 0.0)
{ /* xN[j] should have lower bound */
if (l[k] == -DBL_MAX)
{ sum += d[j];
if (d[j] > +1e-7)
nnn++;
}
}
else if (d[j] < 0.0)
{ /* xN[j] should have upper bound */
if (u[k] == +DBL_MAX)
{ sum -= d[j];
if (d[j] < -1e-7)
nnn++;
}
}
}
/* on phase I variables have artificial bounds which are
* meaningless for original LP, so corresponding objective
* function value is also meaningless */
xprintf(" %6d: %23s inf = %11.3e (%d)",
csa->it_cnt, "", sum, nnn);
break;
case 2:
/* compute sum of (scaled) dual infeasibilities */
sum = 0.0, nnn = 0;
for (j = 1; j <= n-m; j++)
{ k = head[m+j]; /* x[k] = xN[j] */
if (d[j] > 0.0)
{ /* xN[j] should have its lower bound active */
if (l[k] == -DBL_MAX || flag[j])
sum += d[j];
}
else if (d[j] < 0.0)
{ /* xN[j] should have its upper bound active */
if (l[k] != u[k] && !flag[j])
sum -= d[j];
}
}
/* compute number of primal infeasibilities */
nnn = spy_chuzr_sel(lp, beta, csa->tol_bnd, csa->tol_bnd1,
NULL);
xprintf("#%6d: obj = %17.9e inf = %11.3e (%d)",
csa->it_cnt, (double)csa->dir * spx_eval_obj(lp, beta),
sum, nnn);
break;
default:
xassert(csa != csa);
}
if (csa->inv_cnt)
{ /* number of basis factorizations performed */
xprintf(" %d", csa->inv_cnt);
csa->inv_cnt = 0;
}
xprintf("\n");
csa->it_dpy = csa->it_cnt;
skip: return;
}
/***********************************************************************
* spy_dual - driver to dual simplex method
*
* This routine is a driver to the two-phase dual simplex method.
*
* On exit this routine returns one of the following codes:
*
* 0 LP instance has been successfully solved.
*
* GLP_EOBJLL
* Objective lower limit has been reached (maximization).
*
* GLP_EOBJUL
* Objective upper limit has been reached (minimization).
*
* GLP_EITLIM
* Iteration limit has been exhausted.
*
* GLP_ETMLIM
* Time limit has been exhausted.
*
* GLP_EFAIL
* The solver failed to solve LP instance. */
static int dual_simplex(struct csa *csa)
{ /* dual simplex method main logic routine */
SPXLP *lp = csa->lp;
int m = lp->m;
int n = lp->n;
double *l = lp->l;
double *u = lp->u;
int *head = lp->head;
SPXNT *nt = csa->nt;
double *beta = csa->beta;
double *d = csa->d;
SPYSE *se = csa->se;
int *list = csa->list;
double *trow = csa->trow;
double *tcol = csa->tcol;
double *pi = csa->work;
int msg_lev = csa->msg_lev;
double tol_bnd = csa->tol_bnd;
double tol_bnd1 = csa->tol_bnd1;
double tol_dj = csa->tol_dj;
double tol_dj1 = csa->tol_dj1;
int j, k, p_flag, refct, ret;
check_flags(csa);
loop: /* main loop starts here */
/* compute factorization of the basis matrix */
if (!lp->valid)
{ double cond;
ret = spx_factorize(lp);
csa->inv_cnt++;
if (ret != 0)
{ if (msg_lev >= GLP_MSG_ERR)
xprintf("Error: unable to factorize the basis matrix (%d"
")\n", ret);
csa->p_stat = csa->d_stat = GLP_UNDEF;
ret = GLP_EFAIL;
goto fini;
}
/* check condition of the basis matrix */
cond = bfd_condest(lp->bfd);
if (cond > 1.0 / DBL_EPSILON)
{ if (msg_lev >= GLP_MSG_ERR)
xprintf("Error: basis matrix is singular to working prec"
"ision (cond = %.3g)\n", cond);
csa->p_stat = csa->d_stat = GLP_UNDEF;
ret = GLP_EFAIL;
goto fini;
}
if (cond > 0.001 / DBL_EPSILON)
{ if (msg_lev >= GLP_MSG_ERR)
xprintf("Warning: basis matrix is ill-conditioned (cond "
"= %.3g)\n", cond);
}
/* invalidate basic solution components */
csa->beta_st = csa->d_st = 0;
}
/* compute reduced costs of non-basic variables d = (d[j]) */
if (!csa->d_st)
{ spx_eval_pi(lp, pi);
for (j = 1; j <= n-m; j++)
d[j] = spx_eval_dj(lp, pi, j);
csa->d_st = 1; /* just computed */
/* determine the search phase, if not determined yet (this is
* performed only once at the beginning of the search for the
* original bounds) */
if (!csa->phase)
{ j = check_feas(csa, 0.97 * tol_dj, 0.97 * tol_dj1, 1);
if (j > 0)
{ /* initial basic solution is dual infeasible and cannot
* be recovered */
/* start to search for dual feasible solution */
set_art_bounds(csa);
csa->phase = 1;
}
else
{ /* initial basic solution is either dual feasible or its
* dual feasibility has been recovered */
/* start to search for optimal solution */
csa->phase = 2;
}
}
/* make sure that current basic solution is dual feasible */
j = check_feas(csa, tol_dj, tol_dj1, 0);
if (j)
{ /* dual feasibility is broken due to excessive round-off
* errors */
if (bfd_get_count(lp->bfd))
{ /* try to provide more accuracy */
lp->valid = 0;
goto loop;
}
if (msg_lev >= GLP_MSG_ERR)
xprintf("Warning: numerical instability (dual simplex, p"
"hase %s)\n", csa->phase == 1 ? "I" : "II");
if (csa->dualp)
{ /* do not continue the search; report failure */
csa->p_stat = csa->d_stat = GLP_UNDEF;
ret = -1; /* special case of GLP_EFAIL */
goto fini;
}
/* try to recover dual feasibility */
j = check_feas(csa, 0.97 * tol_dj, 0.97 * tol_dj1, 1);
if (j > 0)
{ /* dual feasibility cannot be recovered (this may happen
* only on phase II) */
xassert(csa->phase == 2);
/* restart to search for dual feasible solution */
set_art_bounds(csa);
csa->phase = 1;
}
}
}
/* at this point the search phase is determined */
xassert(csa->phase == 1 || csa->phase == 2);
/* compute values of basic variables beta = (beta[i]) */
if (!csa->beta_st)
{ spx_eval_beta(lp, beta);
csa->beta_st = 1; /* just computed */
}
/* reset the dual reference space, if necessary */
if (se != NULL && !se->valid)
spy_reset_refsp(lp, se), refct = 1000;
/* at this point the basis factorization and all basic solution
* components are valid */
xassert(lp->valid && csa->beta_st && csa->d_st);
check_flags(csa);
#if CHECK_ACCURACY
/* check accuracy of current basic solution components (only for
* debugging) */
check_accuracy(csa);
#endif
/* check if the objective limit has been reached */
if (csa->phase == 2 && csa->obj_lim != DBL_MAX
&& spx_eval_obj(lp, beta) >= csa->obj_lim)
{ if (csa->beta_st != 1)
csa->beta_st = 0;
if (csa->d_st != 1)
csa->d_st = 0;
if (!(csa->beta_st && csa->d_st))
goto loop;
display(csa, 1);
if (msg_lev >= GLP_MSG_ALL)
xprintf("OBJECTIVE %s LIMIT REACHED; SEARCH TERMINATED\n",
csa->dir > 0 ? "UPPER" : "LOWER");
csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list);
csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS);
csa->d_stat = GLP_FEAS;
ret = (csa->dir > 0 ? GLP_EOBJUL : GLP_EOBJLL);
goto fini;
}
/* check if the iteration limit has been exhausted */
if (csa->it_cnt - csa->it_beg >= csa->it_lim)
{ if (csa->beta_st != 1)
csa->beta_st = 0;
if (csa->d_st != 1)
csa->d_st = 0;
if (!(csa->beta_st && csa->d_st))
goto loop;
display(csa, 1);
if (msg_lev >= GLP_MSG_ALL)
xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED\n");
if (csa->phase == 1)
{ set_orig_bounds(csa);
check_flags(csa);
spx_eval_beta(lp, beta);
}
csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list);
csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS);
csa->d_stat = (csa->phase == 1 ? GLP_INFEAS : GLP_FEAS);
ret = GLP_EITLIM;
goto fini;
}
/* check if the time limit has been exhausted */
if (1000.0 * xdifftime(xtime(), csa->tm_beg) >= csa->tm_lim)
{ if (csa->beta_st != 1)
csa->beta_st = 0;
if (csa->d_st != 1)
csa->d_st = 0;
if (!(csa->beta_st && csa->d_st))
goto loop;
display(csa, 1);
if (msg_lev >= GLP_MSG_ALL)
xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n");
if (csa->phase == 1)
{ set_orig_bounds(csa);
check_flags(csa);
spx_eval_beta(lp, beta);
}
csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list);
csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS);
csa->d_stat = (csa->phase == 1 ? GLP_INFEAS : GLP_FEAS);
ret = GLP_EITLIM;
goto fini;
}
/* display the search progress */
display(csa, 0);
/* select eligible basic variables */
switch (csa->phase)
{ case 1:
csa->num = spy_chuzr_sel(lp, beta, 1e-8, 0.0, list);
break;
case 2:
csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list);
break;
default:
xassert(csa != csa);
}
/* check for optimality */
if (csa->num == 0)
{ if (csa->beta_st != 1)
csa->beta_st = 0;
if (csa->d_st != 1)
csa->d_st = 0;
if (!(csa->beta_st && csa->d_st))
goto loop;
/* current basis is optimal */
display(csa, 1);
switch (csa->phase)
{ case 1:
/* check for dual feasibility */
set_orig_bounds(csa);
check_flags(csa);
if (check_feas(csa, tol_dj, tol_dj1, 0) == 0)
{ /* dual feasible solution found; switch to phase II */
csa->phase = 2;
xassert(!csa->beta_st);
goto loop;
}
/* no dual feasible solution exists */
if (msg_lev >= GLP_MSG_ALL)
xprintf("LP HAS NO DUAL FEASIBLE SOLUTION\n");
spx_eval_beta(lp, beta);
csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1,
list);
csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS);
csa->d_stat = GLP_NOFEAS;
ret = 0;
goto fini;
case 2:
/* optimal solution found */
if (msg_lev >= GLP_MSG_ALL)
xprintf("OPTIMAL LP SOLUTION FOUND\n");
csa->p_stat = csa->d_stat = GLP_FEAS;
ret = 0;
goto fini;
default:
xassert(csa != csa);
}
}
/* choose xB[p] and xN[q] */
choose_pivot(csa);
/* check for dual unboundedness */
if (csa->q == 0)
{ if (csa->beta_st != 1)
csa->beta_st = 0;
if (csa->d_st != 1)
csa->d_st = 0;
if (!(csa->beta_st && csa->d_st))
goto loop;
display(csa, 1);
switch (csa->phase)
{ case 1:
/* this should never happen */
if (msg_lev >= GLP_MSG_ERR)
xprintf("Error: dual simplex failed\n");
csa->p_stat = csa->d_stat = GLP_UNDEF;
ret = GLP_EFAIL;
goto fini;
case 2:
/* dual unboundedness detected */
if (msg_lev >= GLP_MSG_ALL)
xprintf("LP HAS NO PRIMAL FEASIBLE SOLUTION\n");
csa->p_stat = GLP_NOFEAS;
csa->d_stat = GLP_FEAS;
ret = 0;
goto fini;
default:
xassert(csa != csa);
}
}
/* compute q-th column of the simplex table */
spx_eval_tcol(lp, csa->q, tcol);
/* FIXME: tcol[p] and trow[q] should be close to each other */
xassert(tcol[csa->p] != 0.0);
/* update values of basic variables for adjacent basis */
k = head[csa->p]; /* x[k] = xB[p] */
p_flag = (l[k] != u[k] && beta[csa->p] > u[k]);
spx_update_beta(lp, beta, csa->p, p_flag, csa->q, tcol);
csa->beta_st = 2;
/* update reduced costs of non-basic variables for adjacent
* basis */
if (spx_update_d(lp, d, csa->p, csa->q, trow, tcol) <= 1e-9)
{ /* successful updating */
csa->d_st = 2;
}
else
{ /* new reduced costs are inaccurate */
csa->d_st = 0;
}
/* update steepest edge weights for adjacent basis, if used */
if (se != NULL)
{ if (refct > 0)
{ if (spy_update_gamma(lp, se, csa->p, csa->q, trow, tcol)
<= 1e-3)
{ /* successful updating */
refct--;
}
else
{ /* new weights are inaccurate; reset reference space */
se->valid = 0;
}
}
else
{ /* too many updates; reset reference space */
se->valid = 0;
}
}
/* update matrix N for adjacent basis, if used */
if (nt != NULL)
spx_update_nt(lp, nt, csa->p, csa->q);
/* change current basis header to adjacent one */
spx_change_basis(lp, csa->p, p_flag, csa->q);
/* and update factorization of the basis matrix */
if (csa->p > 0)
spx_update_invb(lp, csa->p, head[csa->p]);
/* dual simplex iteration complete */
csa->it_cnt++;
goto loop;
fini: return ret;
}
