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;
}
void
fmpz_poly_complex_roots_squarefree(const fmpz_poly_t poly,
slong initial_prec,
slong target_prec,
slong print_digits)
{
slong i, j, prec, deg, deg_deflated, isolated, maxiter, deflation;
acb_poly_t cpoly, cpoly_deflated;
fmpz_poly_t poly_deflated;
acb_ptr roots, roots_deflated;
int removed_zero;
if (fmpz_poly_degree(poly) < 1)
return;
fmpz_poly_init(poly_deflated);
acb_poly_init(cpoly);
acb_poly_init(cpoly_deflated);
/* try to write poly as poly_deflated(x^deflation), possibly multiplied by x */
removed_zero = fmpz_is_zero(poly->coeffs);
if (removed_zero)
fmpz_poly_shift_right(poly_deflated, poly, 1);
else
fmpz_poly_set(poly_deflated, poly);
deflation = fmpz_poly_deflation(poly_deflated);
fmpz_poly_deflate(poly_deflated, poly_deflated, deflation);
deg = fmpz_poly_degree(poly);
deg_deflated = fmpz_poly_degree(poly_deflated);
flint_printf("searching for %wd roots, %wd deflated\n", deg, deg_deflated);
roots = _acb_vec_init(deg);
roots_deflated = _acb_vec_init(deg_deflated);
for (prec = initial_prec; ; prec *= 2)
{
acb_poly_set_fmpz_poly(cpoly_deflated, poly_deflated, prec);
maxiter = FLINT_MIN(FLINT_MAX(deg_deflated, 32), prec);
TIMEIT_ONCE_START
flint_printf("prec=%wd: ", prec);
isolated = acb_poly_find_roots(roots_deflated, cpoly_deflated,
prec == initial_prec ? NULL : roots_deflated, maxiter, prec);
flint_printf("%wd isolated roots | ", isolated);
TIMEIT_ONCE_STOP
if (isolated == deg_deflated)
{
if (!check_accuracy(roots_deflated, deg_deflated, target_prec))
continue;
if (deflation == 1)
{
_acb_vec_set(roots, roots_deflated, deg_deflated);
}
else /* compute all nth roots */
{
acb_t w, w2;
acb_init(w);
acb_init(w2);
acb_unit_root(w, deflation, prec);
acb_unit_root(w2, 2 * deflation, prec);
for (i = 0; i < deg_deflated; i++)
{
if (arf_sgn(arb_midref(acb_realref(roots_deflated + i))) > 0)
{
acb_root_ui(roots + i * deflation,
roots_deflated + i, deflation, prec);
}
else
{
acb_neg(roots + i * deflation, roots_deflated + i);
acb_root_ui(roots + i * deflation,
roots + i * deflation, deflation, prec);
acb_mul(roots + i * deflation,
roots + i * deflation, w2, prec);
}
for (j = 1; j < deflation; j++)
{
acb_mul(roots + i * deflation + j,
roots + i * deflation + j - 1, w, prec);
}
}
acb_clear(w);
acb_clear(w2);
}
/* by assumption that poly is squarefree, must be just one */
if (removed_zero)
acb_zero(roots + deg_deflated * deflation);
if (!check_accuracy(roots, deg, target_prec))
continue;
acb_poly_set_fmpz_poly(cpoly, poly, prec);
if (!acb_poly_validate_real_roots(roots, cpoly, prec))
continue;
for (i = 0; i < deg; i++)
{
if (arb_contains_zero(acb_imagref(roots + i)))
arb_zero(acb_imagref(roots + i));
}
flint_printf("done!\n");
break;
}
}
if (print_digits != 0)
{
_acb_vec_sort_pretty(roots, deg);
for (i = 0; i < deg; i++)
{
acb_printn(roots + i, print_digits, 0);
flint_printf("\n");
}
}
fmpz_poly_clear(poly_deflated);
acb_poly_clear(cpoly);
acb_poly_clear(cpoly_deflated);
_acb_vec_clear(roots, deg);
_acb_vec_clear(roots_deflated, deg_deflated);
}
