diff options
Diffstat (limited to 'test/monniaux/glpk-4.65/src/simplex')
19 files changed, 8909 insertions, 0 deletions
diff --git a/test/monniaux/glpk-4.65/src/simplex/simplex.h b/test/monniaux/glpk-4.65/src/simplex/simplex.h new file mode 100644 index 00000000..9a5acdb2 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/simplex.h @@ -0,0 +1,39 @@ +/* simplex.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SIMPLEX_H +#define SIMPLEX_H + +#include "prob.h" + +#define spx_primal _glp_spx_primal +int spx_primal(glp_prob *P, const glp_smcp *parm); +/* driver to the primal simplex method */ + +#define spy_dual _glp_spy_dual +int spy_dual(glp_prob *P, const glp_smcp *parm); +/* driver to the dual simplex method */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxat.c b/test/monniaux/glpk-4.65/src/simplex/spxat.c new file mode 100644 index 00000000..3570a18c --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxat.c @@ -0,0 +1,265 @@ +/* spxat.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spxat.h" + +/*********************************************************************** +* spx_alloc_at - allocate constraint matrix in sparse row-wise format +* +* This routine allocates the memory for arrays needed to represent the +* constraint matrix in sparse row-wise format. */ + +void spx_alloc_at(SPXLP *lp, SPXAT *at) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + at->ptr = talloc(1+m+1, int); + at->ind = talloc(1+nnz, int); + at->val = talloc(1+nnz, double); + at->work = talloc(1+n, double); + return; +} + +/*********************************************************************** +* spx_build_at - build constraint matrix in sparse row-wise format +* +* This routine builds sparse row-wise representation of the constraint +* matrix A using its sparse column-wise representation stored in the +* lp object, and stores the result in the at object. */ + +void spx_build_at(SPXLP *lp, SPXAT *at) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int *AT_ptr = at->ptr; + int *AT_ind = at->ind; + double *AT_val = at->val; + int i, k, ptr, end, pos; + /* calculate AT_ptr[i] = number of non-zeros in i-th row */ + memset(&AT_ptr[1], 0, m * sizeof(int)); + for (k = 1; k <= n; k++) + { ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + AT_ptr[A_ind[ptr]]++; + } + /* set AT_ptr[i] to position after last element in i-th row */ + AT_ptr[1]++; + for (i = 2; i <= m; i++) + AT_ptr[i] += AT_ptr[i-1]; + xassert(AT_ptr[m] == nnz+1); + AT_ptr[m+1] = nnz+1; + /* build row-wise representation and re-arrange AT_ptr[i] */ + for (k = n; k >= 1; k--) + { /* copy elements from k-th column to corresponding rows */ + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + { pos = --AT_ptr[A_ind[ptr]]; + AT_ind[pos] = k; + AT_val[pos] = A_val[ptr]; + } + } + xassert(AT_ptr[1] == 1); + return; +} + +/*********************************************************************** +* spx_at_prod - compute product y := y + s * A'* x +* +* This routine computes the product: +* +* y := y + s * A'* x, +* +* where A' is a matrix transposed to the mxn-matrix A of constraint +* coefficients, x is a m-vector, s is a scalar, y is a n-vector. +* +* The routine uses the row-wise representation of the matrix A and +* computes the product as a linear combination: +* +* y := y + s * (A'[1] * x[1] + ... + A'[m] * x[m]), +* +* where A'[i] is i-th row of A, 1 <= i <= m. */ + +void spx_at_prod(SPXLP *lp, SPXAT *at, double y[/*1+n*/], double s, + const double x[/*1+m*/]) +{ int m = lp->m; + int *AT_ptr = at->ptr; + int *AT_ind = at->ind; + double *AT_val = at->val; + int i, ptr, end; + double t; + for (i = 1; i <= m; i++) + { if (x[i] != 0.0) + { /* y := y + s * (i-th row of A) * x[i] */ + t = s * x[i]; + ptr = AT_ptr[i]; + end = AT_ptr[i+1]; + for (; ptr < end; ptr++) + y[AT_ind[ptr]] += AT_val[ptr] * t; + } + } + return; +} + +/*********************************************************************** +* spx_nt_prod1 - compute product y := y + s * N'* x +* +* This routine computes the product: +* +* y := y + s * N'* x, +* +* where N' is a matrix transposed to the mx(n-m)-matrix N composed +* from non-basic columns of the constraint matrix A, x is a m-vector, +* s is a scalar, y is (n-m)-vector. +* +* If the flag ign is non-zero, the routine ignores the input content +* of the array y assuming that y = 0. */ + +void spx_nt_prod1(SPXLP *lp, SPXAT *at, double y[/*1+n-m*/], int ign, + double s, const double x[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + double *work = at->work; + int j, k; + for (k = 1; k <= n; k++) + work[k] = 0.0; + if (!ign) + { for (j = 1; j <= n-m; j++) + work[head[m+j]] = y[j]; + } + spx_at_prod(lp, at, work, s, x); + for (j = 1; j <= n-m; j++) + y[j] = work[head[m+j]]; + return; +} + +/*********************************************************************** +* spx_eval_trow1 - compute i-th row of simplex table +* +* This routine computes i-th row of the current simplex table +* T = (T[i,j]) = - inv(B) * N, 1 <= i <= m, using representation of +* the constraint matrix A in row-wise format. +* +* The vector rho = (rho[j]), which is i-th row of the basis inverse +* inv(B), should be previously computed with the routine spx_eval_rho. +* It is assumed that elements of this vector are stored in the array +* locations rho[1], ..., rho[m]. +* +* There exist two ways to compute the simplex table row. +* +* 1. T[i,j], j = 1,...,n-m, is computed as inner product: +* +* m +* T[i,j] = - sum a[i,k] * rho[i], +* i=1 +* +* where N[j] = A[k] is a column of the constraint matrix corresponding +* to non-basic variable xN[j]. The estimated number of operations in +* this case is: +* +* n1 = (n - m) * (nnz(A) / n), +* +* (n - m) is the number of columns of N, nnz(A) / n is the average +* number of non-zeros in one column of A and, therefore, of N. +* +* 2. The simplex table row is computed as part of a linear combination +* of rows of A with coefficients rho[i] != 0. The estimated number +* of operations in this case is: +* +* n2 = nnz(rho) * (nnz(A) / m), +* +* where nnz(rho) is the number of non-zeros in the vector rho, +* nnz(A) / m is the average number of non-zeros in one row of A. +* +* If n1 < n2, the routine computes the simples table row using the +* first way (like the routine spx_eval_trow). Otherwise, the routine +* uses the second way calling the routine spx_nt_prod1. +* +* On exit components of the simplex table row are stored in the array +* locations trow[1], ... trow[n-m]. */ + +void spx_eval_trow1(SPXLP *lp, SPXAT *at, const double rho[/*1+m*/], + double trow[/*1+n-m*/]) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + int i, j, nnz_rho; + double cnt1, cnt2; + /* determine nnz(rho) */ + nnz_rho = 0; + for (i = 1; i <= m; i++) + { if (rho[i] != 0.0) + nnz_rho++; + } + /* estimate the number of operations for both ways */ + cnt1 = (double)(n - m) * ((double)nnz / (double)n); + cnt2 = (double)nnz_rho * ((double)nnz / (double)m); + /* compute i-th row of simplex table */ + if (cnt1 < cnt2) + { /* as inner products */ + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int *head = lp->head; + int k, ptr, end; + double tij; + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* compute t[i,j] = - N'[j] * pi */ + tij = 0.0; + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + tij -= A_val[ptr] * rho[A_ind[ptr]]; + trow[j] = tij; + } + } + else + { /* as linear combination */ + spx_nt_prod1(lp, at, trow, 1, -1.0, rho); + } + return; +} + +/*********************************************************************** +* spx_free_at - deallocate constraint matrix in sparse row-wise format +* +* This routine deallocates the memory used for arrays of the program +* object at. */ + +void spx_free_at(SPXLP *lp, SPXAT *at) +{ xassert(lp == lp); + tfree(at->ptr); + tfree(at->ind); + tfree(at->val); + tfree(at->work); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxat.h b/test/monniaux/glpk-4.65/src/simplex/spxat.h new file mode 100644 index 00000000..98d5b003 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxat.h @@ -0,0 +1,80 @@ +/* spxat.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPXAT_H +#define SPXAT_H + +#include "spxlp.h" + +typedef struct SPXAT SPXAT; + +struct SPXAT +{ /* mxn-matrix A of constraint coefficients in sparse row-wise + * format */ + int *ptr; /* int ptr[1+m+1]; */ + /* ptr[0] is not used; + * ptr[i], 1 <= i <= m, is starting position of i-th row in + * arrays ind and val; note that ptr[1] is always 1; + * ptr[m+1] indicates the position after the last element in + * arrays ind and val, i.e. ptr[m+1] = nnz+1, where nnz is the + * number of non-zero elements in matrix A; + * the length of i-th row (the number of non-zero elements in + * that row) can be calculated as ptr[i+1] - ptr[i] */ + int *ind; /* int ind[1+nnz]; */ + /* column indices */ + double *val; /* double val[1+nnz]; */ + /* non-zero element values */ + double *work; /* double work[1+n]; */ + /* working array */ +}; + +#define spx_alloc_at _glp_spx_alloc_at +void spx_alloc_at(SPXLP *lp, SPXAT *at); +/* allocate constraint matrix in sparse row-wise format */ + +#define spx_build_at _glp_spx_build_at +void spx_build_at(SPXLP *lp, SPXAT *at); +/* build constraint matrix in sparse row-wise format */ + +#define spx_at_prod _glp_spx_at_prod +void spx_at_prod(SPXLP *lp, SPXAT *at, double y[/*1+n*/], double s, + const double x[/*1+m*/]); +/* compute product y := y + s * A'* x */ + +#define spx_nt_prod1 _glp_spx_nt_prod1 +void spx_nt_prod1(SPXLP *lp, SPXAT *at, double y[/*1+n-m*/], int ign, + double s, const double x[/*1+m*/]); +/* compute product y := y + s * N'* x */ + +#define spx_eval_trow1 _glp_spx_eval_trow1 +void spx_eval_trow1(SPXLP *lp, SPXAT *at, const double rho[/*1+m*/], + double trow[/*1+n-m*/]); +/* compute i-th row of simplex table */ + +#define spx_free_at _glp_spx_free_at +void spx_free_at(SPXLP *lp, SPXAT *at); +/* deallocate constraint matrix in sparse row-wise format */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxchuzc.c b/test/monniaux/glpk-4.65/src/simplex/spxchuzc.c new file mode 100644 index 00000000..c60ccabc --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxchuzc.c @@ -0,0 +1,381 @@ +/* spxchuzc.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spxchuzc.h" + +/*********************************************************************** +* spx_chuzc_sel - select eligible non-basic variables +* +* This routine selects eligible non-basic variables xN[j], whose +* reduced costs d[j] have "wrong" sign, i.e. changing such xN[j] in +* feasible direction improves (decreases) the objective function. +* +* Reduced costs of non-basic variables should be placed in the array +* locations d[1], ..., d[n-m]. +* +* Non-basic variable xN[j] is considered eligible if: +* +* d[j] <= -eps[j] and xN[j] can increase +* +* d[j] >= +eps[j] and xN[j] can decrease +* +* for +* +* eps[j] = tol + tol1 * |cN[j]|, +* +* where cN[j] is the objective coefficient at xN[j], tol and tol1 are +* specified tolerances. +* +* On exit the routine stores indices j of eligible non-basic variables +* xN[j] to the array locations list[1], ..., list[num] and returns the +* number of such variables 0 <= num <= n-m. (If the parameter list is +* specified as NULL, no indices are stored.) */ + +int spx_chuzc_sel(SPXLP *lp, const double d[/*1+n-m*/], double tol, + double tol1, int list[/*1+n-m*/]) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, k, num; + double ck, eps; + num = 0; + /* walk thru list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == u[k]) + { /* xN[j] is fixed variable; skip it */ + continue; + } + /* determine absolute tolerance eps[j] */ + ck = c[k]; + eps = tol + tol1 * (ck >= 0.0 ? +ck : -ck); + /* check if xN[j] is eligible */ + if (d[j] <= -eps) + { /* xN[j] should be able to increase */ + if (flag[j]) + { /* but its upper bound is active */ + continue; + } + } + else if (d[j] >= +eps) + { /* xN[j] should be able to decrease */ + if (!flag[j] && l[k] != -DBL_MAX) + { /* but its lower bound is active */ + continue; + } + } + else /* -eps < d[j] < +eps */ + { /* xN[j] does not affect the objective function within the + * specified tolerance */ + continue; + } + /* xN[j] is eligible non-basic variable */ + num++; + if (list != NULL) + list[num] = j; + } + return num; +} + +/*********************************************************************** +* spx_chuzc_std - choose non-basic variable (Dantzig's rule) +* +* This routine chooses most eligible non-basic variable xN[q] +* according to Dantzig's ("standard") rule: +* +* d[q] = max |d[j]|, +* j in J +* +* where J <= {1, ..., n-m} is the set of indices of eligible non-basic +* variables, d[j] is the reduced cost of non-basic variable xN[j] in +* the current basis. +* +* Reduced costs of non-basic variables should be placed in the array +* locations d[1], ..., d[n-m]. +* +* Indices of eligible non-basic variables j in J should be placed in +* the array locations list[1], ..., list[num], where num = |J| > 0 is +* the total number of such variables. +* +* On exit the routine returns q, the index of the non-basic variable +* xN[q] chosen. */ + +int spx_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], int num, + const int list[]) +{ int m = lp->m; + int n = lp->n; + int j, q, t; + double abs_dj, abs_dq; + xassert(0 < num && num <= n-m); + q = 0, abs_dq = -1.0; + for (t = 1; t <= num; t++) + { j = list[t]; + abs_dj = (d[j] >= 0.0 ? +d[j] : -d[j]); + if (abs_dq < abs_dj) + q = j, abs_dq = abs_dj; + } + xassert(q != 0); + return q; +} + +/*********************************************************************** +* spx_alloc_se - allocate pricing data block +* +* This routine allocates the memory for arrays used in the pricing +* data block. */ + +void spx_alloc_se(SPXLP *lp, SPXSE *se) +{ int m = lp->m; + int n = lp->n; + se->valid = 0; + se->refsp = talloc(1+n, char); + se->gamma = talloc(1+n-m, double); + se->work = talloc(1+m, double); + return; +} + +/*********************************************************************** +* spx_reset_refsp - reset reference space +* +* This routine resets (re-initializes) the reference space composing +* it from variables which are non-basic in the current basis, and sets +* all weights gamma[j] to 1. */ + +void spx_reset_refsp(SPXLP *lp, SPXSE *se) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *refsp = se->refsp; + double *gamma = se->gamma; + int j, k; + se->valid = 1; + memset(&refsp[1], 0, n * sizeof(char)); + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + refsp[k] = 1; + gamma[j] = 1.0; + } + return; +} + +/*********************************************************************** +* spx_eval_gamma_j - compute projected steepest edge weight directly +* +* This routine computes projected steepest edge weight gamma[j], +* 1 <= j <= n-m, for the current basis directly with the formula: +* +* m +* gamma[j] = delta[j] + sum eta[i] * T[i,j]**2, +* i=1 +* +* where T[i,j] is element of the current simplex table, and +* +* ( 1, if xB[i] is in the reference space +* eta[i] = { +* ( 0, otherwise +* +* ( 1, if xN[j] is in the reference space +* delta[j] = { +* ( 0, otherwise +* +* NOTE: For testing/debugging only. */ + +double spx_eval_gamma_j(SPXLP *lp, SPXSE *se, int j) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *refsp = se->refsp; + double *tcol = se->work; + int i, k; + double gamma_j; + xassert(se->valid); + xassert(1 <= j && j <= n-m); + k = head[m+j]; /* x[k] = xN[j] */ + gamma_j = (refsp[k] ? 1.0 : 0.0); + spx_eval_tcol(lp, j, tcol); + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + if (refsp[k]) + gamma_j += tcol[i] * tcol[i]; + } + return gamma_j; +} + +/*********************************************************************** +* spx_chuzc_pse - choose non-basic variable (projected steepest edge) +* +* This routine chooses most eligible non-basic variable xN[q] +* according to the projected steepest edge method: +* +* d[q]**2 d[j]**2 +* -------- = max -------- , +* gamma[q] j in J gamma[j] +* +* where J <= {1, ..., n-m} is the set of indices of eligible non-basic +* variable, d[j] is the reduced cost of non-basic variable xN[j] in +* the current basis, gamma[j] is the projected steepest edge weight. +* +* Reduced costs of non-basic variables should be placed in the array +* locations d[1], ..., d[n-m]. +* +* Indices of eligible non-basic variables j in J should be placed in +* the array locations list[1], ..., list[num], where num = |J| > 0 is +* the total number of such variables. +* +* On exit the routine returns q, the index of the non-basic variable +* xN[q] chosen. */ + +int spx_chuzc_pse(SPXLP *lp, SPXSE *se, const double d[/*1+n-m*/], + int num, const int list[]) +{ int m = lp->m; + int n = lp->n; + double *gamma = se->gamma; + int j, q, t; + double best, temp; + xassert(se->valid); + xassert(0 < num && num <= n-m); + q = 0, best = -1.0; + for (t = 1; t <= num; t++) + { j = list[t]; + /* FIXME */ + if (gamma[j] < DBL_EPSILON) + temp = 0.0; + else + temp = (d[j] * d[j]) / gamma[j]; + if (best < temp) + q = j, best = temp; + } + xassert(q != 0); + return q; +} + +/*********************************************************************** +* spx_update_gamma - update projected steepest edge weights exactly +* +* This routine updates the vector gamma = (gamma[j]) of projected +* steepest edge weights exactly, for the adjacent basis. +* +* On entry to the routine the content of the se object should be valid +* and should correspond to the current basis. +* +* The parameter 1 <= p <= m specifies basic variable xB[p] which +* becomes non-basic variable xN[q] in the adjacent basis. +* +* The parameter 1 <= q <= n-m specified non-basic variable xN[q] which +* becomes basic variable xB[p] in the adjacent basis. +* +* It is assumed that the array trow contains elements of p-th (pivot) +* row T'[p] of the simplex table in locations trow[1], ..., trow[n-m]. +* It is also assumed that the array tcol contains elements of q-th +* (pivot) column T[q] of the simple table in locations tcol[1], ..., +* tcol[m]. (These row and column should be computed for the current +* basis.) +* +* For details about the formulae used see the program documentation. +* +* The routine also computes the relative error: +* +* e = |gamma[q] - gamma'[q]| / (1 + |gamma[q]|), +* +* where gamma'[q] is the weight for xN[q] on entry to the routine, +* and returns e on exit. (If e happens to be large enough, the calling +* program may reset the reference space, since other weights also may +* be inaccurate.) */ + +double spx_update_gamma(SPXLP *lp, SPXSE *se, int p, int q, + const double trow[/*1+n-m*/], const double tcol[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *refsp = se->refsp; + double *gamma = se->gamma; + double *u = se->work; + int i, j, k, ptr, end; + double gamma_q, delta_q, e, r, s, t1, t2; + xassert(se->valid); + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + /* compute gamma[q] in current basis more accurately; also + * compute auxiliary vector u */ + k = head[m+q]; /* x[k] = xN[q] */ + gamma_q = delta_q = (refsp[k] ? 1.0 : 0.0); + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + if (refsp[k]) + { gamma_q += tcol[i] * tcol[i]; + u[i] = tcol[i]; + } + else + u[i] = 0.0; + } + bfd_btran(lp->bfd, u); + /* compute relative error in gamma[q] */ + e = fabs(gamma_q - gamma[q]) / (1.0 + gamma_q); + /* compute new gamma[q] */ + gamma[q] = gamma_q / (tcol[p] * tcol[p]); + /* compute new gamma[j] for all j != q */ + for (j = 1; j <= n-m; j++) + { if (j == q) + continue; + if (-1e-9 < trow[j] && trow[j] < +1e-9) + { /* T[p,j] is close to zero; gamma[j] is not changed */ + continue; + } + /* compute r[j] = T[p,j] / T[p,q] */ + r = trow[j] / tcol[p]; + /* compute inner product s[j] = N'[j] * u, where N[j] = A[k] + * is constraint matrix column corresponding to xN[j] */ + s = 0.0; + k = head[m+j]; /* x[k] = xN[j] */ + ptr = lp->A_ptr[k]; + end = lp->A_ptr[k+1]; + for (; ptr < end; ptr++) + s += lp->A_val[ptr] * u[lp->A_ind[ptr]]; + /* compute new gamma[j] */ + t1 = gamma[j] + r * (r * gamma_q + s + s); + t2 = (refsp[k] ? 1.0 : 0.0) + delta_q * r * r; + gamma[j] = (t1 >= t2 ? t1 : t2); + } + return e; +} + +/*********************************************************************** +* spx_free_se - deallocate pricing data block +* +* This routine deallocates the memory used for arrays in the pricing +* data block. */ + +void spx_free_se(SPXLP *lp, SPXSE *se) +{ xassert(lp == lp); + tfree(se->refsp); + tfree(se->gamma); + tfree(se->work); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxchuzc.h b/test/monniaux/glpk-4.65/src/simplex/spxchuzc.h new file mode 100644 index 00000000..c09cca9a --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxchuzc.h @@ -0,0 +1,85 @@ +/* spxchuzc.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPXCHUZC_H +#define SPXCHUZC_H + +#include "spxlp.h" + +#define spx_chuzc_sel _glp_spx_chuzc_sel +int spx_chuzc_sel(SPXLP *lp, const double d[/*1+n-m*/], double tol, + double tol1, int list[/*1+n-m*/]); +/* select eligible non-basic variables */ + +#define spx_chuzc_std _glp_spx_chuzc_std +int spx_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], int num, + const int list[]); +/* choose non-basic variable (Dantzig's rule) */ + +typedef struct SPXSE SPXSE; + +struct SPXSE +{ /* projected steepest edge and Devex pricing data block */ + int valid; + /* content validity flag */ + char *refsp; /* char refsp[1+n]; */ + /* refsp[0] is not used; + * refsp[k], 1 <= k <= n, is the flag meaning that variable x[k] + * is in the reference space */ + double *gamma; /* double gamma[1+n-m]; */ + /* gamma[0] is not used; + * gamma[j], 1 <= j <= n-m, is the weight for reduced cost d[j] + * of non-basic variable xN[j] in the current basis */ + double *work; /* double work[1+m]; */ + /* working array */ +}; + +#define spx_alloc_se _glp_spx_alloc_se +void spx_alloc_se(SPXLP *lp, SPXSE *se); +/* allocate pricing data block */ + +#define spx_reset_refsp _glp_spx_reset_refsp +void spx_reset_refsp(SPXLP *lp, SPXSE *se); +/* reset reference space */ + +#define spx_eval_gamma_j _glp_spx_eval_gamma_j +double spx_eval_gamma_j(SPXLP *lp, SPXSE *se, int j); +/* compute projeted steepest edge weight directly */ + +#define spx_chuzc_pse _glp_spx_chuzc_pse +int spx_chuzc_pse(SPXLP *lp, SPXSE *se, const double d[/*1+n-m*/], + int num, const int list[]); +/* choose non-basic variable (projected steepest edge) */ + +#define spx_update_gamma _glp_spx_update_gamma +double spx_update_gamma(SPXLP *lp, SPXSE *se, int p, int q, + const double trow[/*1+n-m*/], const double tcol[/*1+m*/]); +/* update projected steepest edge weights exactly */ + +#define spx_free_se _glp_spx_free_se +void spx_free_se(SPXLP *lp, SPXSE *se); +/* deallocate pricing data block */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxchuzr.c b/test/monniaux/glpk-4.65/src/simplex/spxchuzr.c new file mode 100644 index 00000000..8bef77ba --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxchuzr.c @@ -0,0 +1,594 @@ +/* spxchuzr.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015-2018 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spxchuzr.h" + +/*********************************************************************** +* spx_chuzr_std - choose basic variable (textbook ratio test) +* +* This routine implements an improved textbook ratio test to choose +* basic variable xB[p]. +* +* The parameter phase specifies the search phase: +* +* 1 - searching for feasible basic solution. In this case the routine +* uses artificial bounds of basic variables that correspond to +* breakpoints of the penalty function: +* +* ( lB[i], if cB[i] = 0 +* ( +* lB'[i] = { uB[i], if cB[i] > 0 +* ( +* ( -inf, if cB[i] < 0 +* +* ( uB[i], if cB[i] = 0 +* ( +* uB'[i] = { +inf, if cB[i] > 0 +* ( +* ( lB[i], if cB[i] < 0 +* +* where lB[i] and uB[i] are original bounds of variable xB[i], +* cB[i] is the penalty (objective) coefficient of that variable. +* +* 2 - searching for optimal basic solution. In this case the routine +* uses original bounds of basic variables. +* +* Current values of basic variables should be placed in the array +* locations beta[1], ..., beta[m]. +* +* The parameter 1 <= q <= n-m specifies the index of non-basic +* variable xN[q] chosen. +* +* The parameter s specifies the direction in which xN[q] changes: +* s = +1.0 means xN[q] increases, and s = -1.0 means xN[q] decreases. +* (Thus, the corresponding ray parameter is theta = s (xN[q] - f[q]), +* where f[q] is the active bound of xN[q] in the current basis.) +* +* Elements of q-th simplex table column T[q] = (t[i,q]) corresponding +* to non-basic variable xN[q] should be placed in the array locations +* tcol[1], ..., tcol[m]. +* +* The parameter tol_piv specifies a tolerance for elements of the +* simplex table column T[q]. If |t[i,q]| < tol_piv, basic variable +* xB[i] is skipped, i.e. it is assumed that it does not depend on the +* ray parameter theta. +* +* The parameters tol and tol1 specify tolerances used to increase the +* choice freedom by simulating an artificial degeneracy as follows. +* If beta[i] <= lB[i] + delta[i], where delta[i] = tol + tol1 |lB[i]|, +* it is assumed that beta[i] is exactly the same as lB[i]. Similarly, +* if beta[i] >= uB[i] - delta[i], where delta[i] = tol + tol1 |uB[i]|, +* it is assumed that beta[i] is exactly the same as uB[i]. +* +* The routine determines the index 1 <= p <= m of basic variable xB[p] +* that reaches its (lower or upper) bound first on increasing the ray +* parameter theta, stores the bound flag (0 - lower bound or fixed +* value, 1 - upper bound) to the location pointed to by the pointer +* p_flag, and returns the index p. If non-basic variable xN[q] is +* double-bounded and reaches its opposite bound first, the routine +* returns (-1). And if the ray parameter may increase unlimitedly, the +* routine returns zero. +* +* Should note that the bound flag stored to the location pointed to by +* p_flag corresponds to the original (not artficial) bound of variable +* xB[p] and defines the active bound flag lp->flag[q] to be set in the +* adjacent basis for that basic variable. */ + +int spx_chuzr_std(SPXLP *lp, int phase, const double beta[/*1+m*/], + int q, double s, const double tcol[/*1+m*/], int *p_flag, + double tol_piv, double tol, double tol1) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int i, i_flag, k, p; + double alfa, biga, delta, lk, uk, teta, teta_min; + xassert(phase == 1 || phase == 2); + xassert(1 <= q && q <= n-m); + xassert(s == +1.0 || s == -1.0); + /* determine initial teta_min */ + k = head[m+q]; /* x[k] = xN[q] */ + if (l[k] == -DBL_MAX || u[k] == +DBL_MAX) + { /* xN[q] has no opposite bound */ + p = 0, *p_flag = 0, teta_min = DBL_MAX, biga = 0.0; + } + else + { /* xN[q] have both lower and upper bounds */ + p = -1, *p_flag = 0, teta_min = fabs(l[k] - u[k]), biga = 1.0; + } + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + /* determine alfa such that delta xB[i] = alfa * teta */ + alfa = s * tcol[i]; + if (alfa <= -tol_piv) + { /* xB[i] decreases */ + /* determine actual lower bound of xB[i] */ + if (phase == 1 && c[k] < 0.0) + { /* xB[i] has no actual lower bound */ + continue; + } + else if (phase == 1 && c[k] > 0.0) + { /* actual lower bound of xB[i] is its upper bound */ + lk = u[k]; + xassert(lk != +DBL_MAX); + i_flag = 1; + } + else + { /* actual lower bound of xB[i] is its original bound */ + lk = l[k]; + if (lk == -DBL_MAX) + continue; + i_flag = 0; + } + /* determine teta on which xB[i] reaches its lower bound */ + delta = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] <= lk + delta) + teta = 0.0; + else + teta = (lk - beta[i]) / alfa; + } + else if (alfa >= +tol_piv) + { /* xB[i] increases */ + /* determine actual upper bound of xB[i] */ + if (phase == 1 && c[k] < 0.0) + { /* actual upper bound of xB[i] is its lower bound */ + uk = l[k]; + xassert(uk != -DBL_MAX); + i_flag = 0; + } + else if (phase == 1 && c[k] > 0.0) + { /* xB[i] has no actual upper bound */ + continue; + } + else + { /* actual upper bound of xB[i] is its original bound */ + uk = u[k]; + if (uk == +DBL_MAX) + continue; + i_flag = 1; + } + /* determine teta on which xB[i] reaches its upper bound */ + delta = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] >= uk - delta) + teta = 0.0; + else + teta = (uk - beta[i]) / alfa; + } + else + { /* xB[i] does not depend on teta */ + continue; + } + /* choose basic variable xB[p] for which teta is minimal */ + xassert(teta >= 0.0); + alfa = (alfa >= 0.0 ? +alfa : -alfa); + if (teta_min > teta || (teta_min == teta && biga < alfa)) + p = i, *p_flag = i_flag, teta_min = teta, biga = alfa; + } + /* if xB[p] is fixed variable, adjust its bound flag */ + if (p > 0) + { k = head[p]; + if (l[k] == u[k]) + *p_flag = 0; + } + return p; +} + +/*********************************************************************** +* spx_chuzr_harris - choose basic variable (Harris' ratio test) +* +* This routine implements Harris' ratio test to choose basic variable +* xB[p]. +* +* All the parameters, except tol and tol1, as well as the returned +* value have the same meaning as for the routine spx_chuzr_std (see +* above). +* +* The parameters tol and tol1 specify tolerances on bound violations +* for basic variables. For the lower bound of basic variable xB[i] the +* tolerance is delta[i] = tol + tol1 |lB[i]|, and for the upper bound +* the tolerance is delta[i] = tol + tol1 |uB[i]|. */ + +int spx_chuzr_harris(SPXLP *lp, int phase, const double beta[/*1+m*/], + int q, double s, const double tcol[/*1+m*/], int *p_flag, + double tol_piv, double tol, double tol1) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int i, i_flag, k, p; + double alfa, biga, delta, lk, uk, teta, teta_min; + xassert(phase == 1 || phase == 2); + xassert(1 <= q && q <= n-m); + xassert(s == +1.0 || s == -1.0); + /*--------------------------------------------------------------*/ + /* first pass: determine teta_min for relaxed bounds */ + /*--------------------------------------------------------------*/ + teta_min = DBL_MAX; + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + /* determine alfa such that delta xB[i] = alfa * teta */ + alfa = s * tcol[i]; + if (alfa <= -tol_piv) + { /* xB[i] decreases */ + /* determine actual lower bound of xB[i] */ + if (phase == 1 && c[k] < 0.0) + { /* xB[i] has no actual lower bound */ + continue; + } + else if (phase == 1 && c[k] > 0.0) + { /* actual lower bound of xB[i] is its upper bound */ + lk = u[k]; + xassert(lk != +DBL_MAX); + } + else + { /* actual lower bound of xB[i] is its original bound */ + lk = l[k]; + if (lk == -DBL_MAX) + continue; + } + /* determine teta on which xB[i] reaches its relaxed lower + * bound */ + delta = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] < lk) + teta = - delta / alfa; + else + teta = ((lk - delta) - beta[i]) / alfa; + } + else if (alfa >= +tol_piv) + { /* xB[i] increases */ + /* determine actual upper bound of xB[i] */ + if (phase == 1 && c[k] < 0.0) + { /* actual upper bound of xB[i] is its lower bound */ + uk = l[k]; + xassert(uk != -DBL_MAX); + } + else if (phase == 1 && c[k] > 0.0) + { /* xB[i] has no actual upper bound */ + continue; + } + else + { /* actual upper bound of xB[i] is its original bound */ + uk = u[k]; + if (uk == +DBL_MAX) + continue; + } + /* determine teta on which xB[i] reaches its relaxed upper + * bound */ + delta = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] > uk) + teta = + delta / alfa; + else + teta = ((uk + delta) - beta[i]) / alfa; + } + else + { /* xB[i] does not depend on teta */ + continue; + } + xassert(teta >= 0.0); + if (teta_min > teta) + teta_min = teta; + } + /*--------------------------------------------------------------*/ + /* second pass: choose basic variable xB[p] */ + /*--------------------------------------------------------------*/ + k = head[m+q]; /* x[k] = xN[q] */ + if (l[k] != -DBL_MAX && u[k] != +DBL_MAX) + { /* xN[q] has both lower and upper bounds */ + if (fabs(l[k] - u[k]) <= teta_min) + { /* and reaches its opposite bound */ + p = -1, *p_flag = 0; + goto done; + } + } + if (teta_min == DBL_MAX) + { /* teta may increase unlimitedly */ + p = 0, *p_flag = 0; + goto done; + } + /* nothing is chosen so far */ + p = 0, *p_flag = 0, biga = 0.0; + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + /* determine alfa such that delta xB[i] = alfa * teta */ + alfa = s * tcol[i]; + if (alfa <= -tol_piv) + { /* xB[i] decreases */ + /* determine actual lower bound of xB[i] */ + if (phase == 1 && c[k] < 0.0) + { /* xB[i] has no actual lower bound */ + continue; + } + else if (phase == 1 && c[k] > 0.0) + { /* actual lower bound of xB[i] is its upper bound */ + lk = u[k]; + xassert(lk != +DBL_MAX); + i_flag = 1; + } + else + { /* actual lower bound of xB[i] is its original bound */ + lk = l[k]; + if (lk == -DBL_MAX) + continue; + i_flag = 0; + } + /* determine teta on which xB[i] reaches its lower bound */ + teta = (lk - beta[i]) / alfa; + } + else if (alfa >= +tol_piv) + { /* xB[i] increases */ + /* determine actual upper bound of xB[i] */ + if (phase == 1 && c[k] < 0.0) + { /* actual upper bound of xB[i] is its lower bound */ + uk = l[k]; + xassert(uk != -DBL_MAX); + i_flag = 0; + } + else if (phase == 1 && c[k] > 0.0) + { /* xB[i] has no actual upper bound */ + continue; + } + else + { /* actual upper bound of xB[i] is its original bound */ + uk = u[k]; + if (uk == +DBL_MAX) + continue; + i_flag = 1; + } + /* determine teta on which xB[i] reaches its upper bound */ + teta = (uk - beta[i]) / alfa; + } + else + { /* xB[i] does not depend on teta */ + continue; + } + /* choose basic variable for which teta is not greater than + * teta_min determined for relaxed bounds and which has best + * (largest in magnitude) pivot */ + alfa = (alfa >= 0.0 ? +alfa : -alfa); + if (teta <= teta_min && biga < alfa) + p = i, *p_flag = i_flag, biga = alfa; + } + /* something must be chosen */ + xassert(1 <= p && p <= m); + /* if xB[p] is fixed variable, adjust its bound flag */ + k = head[p]; + if (l[k] == u[k]) + *p_flag = 0; +done: return p; +} + +#if 1 /* 22/VI-2017 */ +/*********************************************************************** +* spx_ls_eval_bp - determine penalty function break points +* +* This routine determines break points of the penalty function (which +* is the sum of primal infeasibilities). +* +* The parameters lp, beta, q, dq, tcol, and tol_piv have the same +* meaning as for the routine spx_chuzr_std (see above). +* +* The routine stores the break-points determined to the array elements +* bp[1], ..., bp[nbp] in *arbitrary* order, where 0 <= nbp <= 2*m+1 is +* the number of break-points returned by the routine on exit. */ + +int spx_ls_eval_bp(SPXLP *lp, const double beta[/*1+m*/], + int q, double dq, const double tcol[/*1+m*/], double tol_piv, + SPXBP bp[/*1+2*m+1*/]) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int i, k, nbp; + double s, alfa; + xassert(1 <= q && q <= n-m); + xassert(dq != 0.0); + s = (dq < 0.0 ? +1.0 : -1.0); + nbp = 0; + /* if chosen non-basic variable xN[q] is double-bounded, include + * it in the list, because it can cross its opposite bound */ + k = head[m+q]; /* x[k] = xN[q] */ + if (l[k] != -DBL_MAX && u[k] != +DBL_MAX) + { nbp++; + bp[nbp].i = 0; + xassert(l[k] < u[k]); /* xN[q] cannot be fixed */ + bp[nbp].teta = u[k] - l[k]; + bp[nbp].dc = s; + } + /* build the list of all basic variables xB[i] that can cross + * their bound(s) for the ray parameter 0 <= teta < teta_max */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + xassert(l[k] <= u[k]); + /* determine alfa such that (delta xB[i]) = alfa * teta */ + alfa = s * tcol[i]; + if (alfa >= +tol_piv) + { /* xB[i] increases on increasing teta */ + if (l[k] == u[k]) + { /* xB[i] is fixed at lB[i] = uB[i] */ + if (c[k] <= 0.0) + { /* increasing xB[i] can cross its fixed value lB[i], + * because currently xB[i] <= lB[i] */ + nbp++; + bp[nbp].i = +i; + bp[nbp].teta = (l[k] - beta[i]) / alfa; + /* if xB[i] > lB[i] then cB[i] = +1 */ + bp[nbp].dc = +1.0 - c[k]; + } + } + else + { if (l[k] != -DBL_MAX && c[k] < 0.0) + { /* increasing xB[i] can cross its lower bound lB[i], + * because currently xB[i] < lB[i] */ + nbp++; + bp[nbp].i = +i; + bp[nbp].teta = (l[k] - beta[i]) / alfa; + bp[nbp].dc = +1.0; + } + if (u[k] != +DBL_MAX && c[k] <= 0.0) + { /* increasing xB[i] can cross its upper bound uB[i], + * because currently xB[i] does not violate it */ + nbp++; + bp[nbp].i = -i; + bp[nbp].teta = (u[k] - beta[i]) / alfa; + bp[nbp].dc = +1.0; + } + } + } + else if (alfa <= -tol_piv) + { /* xB[i] decreases on increasing teta */ + if (l[k] == u[k]) + { /* xB[i] is fixed at lB[i] = uB[i] */ + if (c[k] >= 0.0) + { /* decreasing xB[i] can cross its fixed value lB[i], + * because currently xB[i] >= lB[i] */ + nbp++; + bp[nbp].i = +i; + bp[nbp].teta = (l[k] - beta[i]) / alfa; + /* if xB[i] < lB[i] then cB[i] = -1 */ + bp[nbp].dc = -1.0 - c[k]; + } + } + else + { if (l[k] != -DBL_MAX && c[k] >= 0.0) + { /* decreasing xB[i] can cross its lower bound lB[i], + * because currently xB[i] does not violate it */ + nbp++; + bp[nbp].i = +i; + bp[nbp].teta = (l[k] - beta[i]) / alfa; + bp[nbp].dc = -1.0; + } + if (u[k] != +DBL_MAX && c[k] > 0.0) + { /* decreasing xB[i] can cross its upper bound uB[i], + * because currently xB[i] > uB[i] */ + nbp++; + bp[nbp].i = -i; + bp[nbp].teta = (u[k] - beta[i]) / alfa; + bp[nbp].dc = -1.0; + } + } + } + else + { /* xB[i] does not depend on teta within a tolerance */ + continue; + } + /* teta < 0 may happen only due to round-off errors when the + * current value of xB[i] is *close* to its (lower or upper) + * bound; in this case we replace teta by exact zero */ + if (bp[nbp].teta < 0.0) + bp[nbp].teta = 0.0; + } + xassert(nbp <= 2*m+1); + return nbp; +} +#endif + +#if 1 /* 22/VI-2017 */ +/*********************************************************************** +* spx_ls_select_bp - select and process penalty function break points +* +* This routine selects a next portion of the penalty function break +* points and processes them. +* +* On entry to the routine it is assumed that break points bp[1], ..., +* bp[num] are already processed, and slope is the penalty function +* slope to the right of the last processed break point bp[num]. +* (Initially, when num = 0, slope should be specified as -fabs(d[q]), +* where d[q] is the reduced cost of chosen non-basic variable xN[q].) +* +* The routine selects break points among bp[num+1], ..., bp[nbp], for +* which teta <= teta_lim, and moves these break points to the array +* elements bp[num+1], ..., bp[num1], where num <= num1 <= 2*m+1 is the +* new number of processed break points returned by the routine on +* exit. Then the routine sorts the break points by ascending teta and +* computes the change of the penalty function relative to its value at +* teta = 0. +* +* On exit the routine also replaces the parameter slope with a new +* value that corresponds to the new last break-point bp[num1]. */ + +static int CDECL fcmp(const void *v1, const void *v2) +{ const SPXBP *p1 = v1, *p2 = v2; + if (p1->teta < p2->teta) + return -1; + else if (p1->teta > p2->teta) + return +1; + else + return 0; +} + +int spx_ls_select_bp(SPXLP *lp, const double tcol[/*1+m*/], + int nbp, SPXBP bp[/*1+m+m+1*/], int num, double *slope, double + teta_lim) +{ int m = lp->m; + int i, t, num1; + double teta, dz; + xassert(0 <= num && num <= nbp && nbp <= m+m+1); + /* select a new portion of break points */ + num1 = num; + for (t = num+1; t <= nbp; t++) + { if (bp[t].teta <= teta_lim) + { /* move break point to the beginning of the new portion */ + num1++; + i = bp[num1].i, teta = bp[num1].teta, dz = bp[num1].dc; + bp[num1].i = bp[t].i, bp[num1].teta = bp[t].teta, + bp[num1].dc = bp[t].dc; + bp[t].i = i, bp[t].teta = teta, bp[t].dc = dz; + } + } + /* sort new break points bp[num+1], ..., bp[num1] by ascending + * the ray parameter teta */ + if (num1 - num > 1) + qsort(&bp[num+1], num1 - num, sizeof(SPXBP), fcmp); + /* calculate the penalty function change at the new break points + * selected */ + for (t = num+1; t <= num1; t++) + { /* calculate the penalty function change relative to its value + * at break point bp[t-1] */ + dz = (*slope) * (bp[t].teta - (t == 1 ? 0.0 : bp[t-1].teta)); + /* calculate the penalty function change relative to its value + * at teta = 0 */ + bp[t].dz = (t == 1 ? 0.0 : bp[t-1].dz) + dz; + /* calculate a new slope of the penalty function to the right + * of the current break point bp[t] */ + i = (bp[t].i >= 0 ? bp[t].i : -bp[t].i); + xassert(0 <= i && i <= m); + if (i == 0) + *slope += fabs(1.0 * bp[t].dc); + else + *slope += fabs(tcol[i] * bp[t].dc); + } + return num1; +} +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxchuzr.h b/test/monniaux/glpk-4.65/src/simplex/spxchuzr.h new file mode 100644 index 00000000..3ec90050 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxchuzr.h @@ -0,0 +1,77 @@ +/* spxchuzr.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015-2017 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPXCHUZR_H +#define SPXCHUZR_H + +#include "spxlp.h" + +#define spx_chuzr_std _glp_spx_chuzr_std +int spx_chuzr_std(SPXLP *lp, int phase, const double beta[/*1+m*/], + int q, double s, const double tcol[/*1+m*/], int *p_flag, + double tol_piv, double tol, double tol1); +/* choose basic variable (textbook ratio test) */ + +#define spx_chuzr_harris _glp_spx_chuzr_harris +int spx_chuzr_harris(SPXLP *lp, int phase, const double beta[/*1+m*/], + int q, double s, const double tcol[/*1+m*/], int *p_flag, + double tol_piv, double tol, double tol1); +/* choose basic variable (Harris' ratio test) */ + +#if 1 /* 22/VI-2017 */ +typedef struct SPXBP SPXBP; + +struct SPXBP +{ /* penalty function (sum of infeasibilities) break point */ + int i; + /* basic variable xB[i], 1 <= i <= m, that intersects its bound + * at this break point + * i > 0 if xB[i] intersects its lower bound (or fixed value) + * i < 0 if xB[i] intersects its upper bound + * i = 0 if xN[q] intersects its opposite bound */ + double teta; + /* ray parameter value, teta >= 0, at this break point */ + double dc; + /* increment of the penalty function coefficient cB[i] at this + * break point */ + double dz; + /* increment, z[t] - z[0], of the penalty function at this break + * point */ +}; + +#define spx_ls_eval_bp _glp_spx_ls_eval_bp +int spx_ls_eval_bp(SPXLP *lp, const double beta[/*1+m*/], + int q, double dq, const double tcol[/*1+m*/], double tol_piv, + SPXBP bp[/*1+2*m+1*/]); +/* determine penalty function break points */ + +#define spx_ls_select_bp _glp_spx_ls_select_bp +int spx_ls_select_bp(SPXLP *lp, const double tcol[/*1+m*/], + int nbp, SPXBP bp[/*1+m+m+1*/], int num, double *slope, double + teta_lim); +/* select and process penalty function break points */ +#endif + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxlp.c b/test/monniaux/glpk-4.65/src/simplex/spxlp.c new file mode 100644 index 00000000..90ce2636 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxlp.c @@ -0,0 +1,819 @@ +/* spxlp.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spxlp.h" + +/*********************************************************************** +* spx_factorize - compute factorization of current basis matrix +* +* This routine computes factorization of the current basis matrix B. +* +* If the factorization has been successfully computed, the routine +* validates it and returns zero. Otherwise, the routine invalidates +* the factorization and returns the code provided by the factorization +* driver (bfd_factorize). */ + +static int jth_col(void *info, int j, int ind[], double val[]) +{ /* provide column B[j] */ + SPXLP *lp = info; + int m = lp->m; + int *A_ptr = lp->A_ptr; + int *head = lp->head; + int k, ptr, len; + xassert(1 <= j && j <= m); + k = head[j]; /* x[k] = xB[j] */ + ptr = A_ptr[k]; + len = A_ptr[k+1] - ptr; + memcpy(&ind[1], &lp->A_ind[ptr], len * sizeof(int)); + memcpy(&val[1], &lp->A_val[ptr], len * sizeof(double)); + return len; +} + +int spx_factorize(SPXLP *lp) +{ int ret; + ret = bfd_factorize(lp->bfd, lp->m, jth_col, lp); + lp->valid = (ret == 0); + return ret; +} + +/*********************************************************************** +* spx_eval_beta - compute current values of basic variables +* +* This routine computes vector beta = (beta[i]) of current values of +* basic variables xB = (xB[i]). (Factorization of the current basis +* matrix should be valid.) +* +* First the routine computes a modified vector of right-hand sides: +* +* n-m +* y = b - N * f = b - sum N[j] * f[j], +* j=1 +* +* where b = (b[i]) is the original vector of right-hand sides, N is +* a matrix composed from columns of the original constraint matrix A, +* which (columns) correspond to non-basic variables, f = (f[j]) is the +* vector of active bounds of non-basic variables xN = (xN[j]), +* N[j] = A[k] is a column of matrix A corresponding to non-basic +* variable xN[j] = x[k], f[j] is current active bound lN[j] = l[k] or +* uN[j] = u[k] of non-basic variable xN[j] = x[k]. The matrix-vector +* product N * f is computed as a linear combination of columns of N, +* so if f[j] = 0, column N[j] can be skipped. +* +* Then the routine performs FTRAN to compute the vector beta: +* +* beta = inv(B) * y. +* +* On exit the routine stores components of the vector beta to array +* locations beta[1], ..., beta[m]. */ + +void spx_eval_beta(SPXLP *lp, double beta[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + double *b = lp->b; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, k, ptr, end; + double fj, *y; + /* compute y = b - N * xN */ + /* y := b */ + y = beta; + memcpy(&y[1], &b[1], m * sizeof(double)); + /* y := y - N * f */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* f[j] := active bound of xN[j] */ + fj = flag[j] ? u[k] : l[k]; + if (fj == 0.0 || fj == -DBL_MAX) + { /* either xN[j] has zero active bound or it is unbounded; + * in the latter case its value is assumed to be zero */ + continue; + } + /* y := y - N[j] * f[j] */ + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + y[A_ind[ptr]] -= A_val[ptr] * fj; + } + /* compute beta = inv(B) * y */ + xassert(lp->valid); + bfd_ftran(lp->bfd, beta); + return; +} + +/*********************************************************************** +* spx_eval_obj - compute current value of objective function +* +* This routine computes the value of the objective function in the +* current basic solution: +* +* z = cB'* beta + cN'* f + c[0] = +* +* m n-m +* = sum cB[i] * beta[i] + sum cN[j] * f[j] + c[0], +* i=1 j=1 +* +* where cB = (cB[i]) is the vector of objective coefficients at basic +* variables, beta = (beta[i]) is the vector of current values of basic +* variables, cN = (cN[j]) is the vector of objective coefficients at +* non-basic variables, f = (f[j]) is the vector of current active +* bounds of non-basic variables, c[0] is the constant term of the +* objective function. +* +* It as assumed that components of the vector beta are stored in the +* array locations beta[1], ..., beta[m]. */ + +double spx_eval_obj(SPXLP *lp, const double beta[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int i, j, k; + double fj, z; + /* compute z = cB'* beta + cN'* f + c0 */ + /* z := c0 */ + z = c[0]; + /* z := z + cB'* beta */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + z += c[k] * beta[i]; + } + /* z := z + cN'* f */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* f[j] := active bound of xN[j] */ + fj = flag[j] ? u[k] : l[k]; + if (fj == 0.0 || fj == -DBL_MAX) + { /* either xN[j] has zero active bound or it is unbounded; + * in the latter case its value is assumed to be zero */ + continue; + } + z += c[k] * fj; + } + return z; +} + +/*********************************************************************** +* spx_eval_pi - compute simplex multipliers in current basis +* +* This routine computes vector pi = (pi[i]) of simplex multipliers in +* the current basis. (Factorization of the current basis matrix should +* be valid.) +* +* The vector pi is computed by performing BTRAN: +* +* pi = inv(B') * cB, +* +* where cB = (cB[i]) is the vector of objective coefficients at basic +* variables xB = (xB[i]). +* +* On exit components of vector pi are stored in the array locations +* pi[1], ..., pi[m]. */ + +void spx_eval_pi(SPXLP *lp, double pi[/*1+m*/]) +{ int m = lp->m; + double *c = lp->c; + int *head = lp->head; + int i; + double *cB; + /* construct cB */ + cB = pi; + for (i = 1; i <= m; i++) + cB[i] = c[head[i]]; + /* compute pi = inv(B) * cB */ + bfd_btran(lp->bfd, pi); + return; +} + +/*********************************************************************** +* spx_eval_dj - compute reduced cost of j-th non-basic variable +* +* This routine computes reduced cost d[j] of non-basic variable +* xN[j] = x[k], 1 <= j <= n-m, in the current basic solution: +* +* d[j] = c[k] - A'[k] * pi, +* +* where c[k] is the objective coefficient at x[k], A[k] is k-th column +* of the constraint matrix, pi is the vector of simplex multipliers in +* the current basis. +* +* It as assumed that components of the vector pi are stored in the +* array locations pi[1], ..., pi[m]. */ + +double spx_eval_dj(SPXLP *lp, const double pi[/*1+m*/], int j) +{ int m = lp->m; + int n = lp->n; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int k, ptr, end; + double dj; + xassert(1 <= j && j <= n-m); + k = lp->head[m+j]; /* x[k] = xN[j] */ + /* dj := c[k] */ + dj = lp->c[k]; + /* dj := dj - A'[k] * pi */ + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + dj -= A_val[ptr] * pi[A_ind[ptr]]; + return dj; +} + +/*********************************************************************** +* spx_eval_tcol - compute j-th column of simplex table +* +* This routine computes j-th column of the current simplex table +* T = (T[i,j]) = - inv(B) * N, 1 <= j <= n-m. (Factorization of the +* current basis matrix should be valid.) +* +* The simplex table column is computed by performing FTRAN: +* +* tcol = - inv(B) * N[j], +* +* where B is the current basis matrix, N[j] = A[k] is a column of the +* constraint matrix corresponding to non-basic variable xN[j] = x[k]. +* +* On exit components of the simplex table column are stored in the +* array locations tcol[1], ... tcol[m]. */ + +void spx_eval_tcol(SPXLP *lp, int j, double tcol[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int *head = lp->head; + int i, k, ptr, end; + xassert(1 <= j && j <= n-m); + k = head[m+j]; /* x[k] = xN[j] */ + /* compute tcol = - inv(B) * N[j] */ + for (i = 1; i <= m; i++) + tcol[i] = 0.0; + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + tcol[A_ind[ptr]] = -A_val[ptr]; + bfd_ftran(lp->bfd, tcol); + return; +} + +/*********************************************************************** +* spx_eval_rho - compute i-th row of basis matrix inverse +* +* This routine computes i-th row of the matrix inv(B), where B is +* the current basis matrix, 1 <= i <= m. (Factorization of the current +* basis matrix should be valid.) +* +* The inverse row is computed by performing BTRAN: +* +* rho = inv(B') * e[i], +* +* where e[i] is i-th column of unity matrix. +* +* On exit components of the row are stored in the array locations +* row[1], ..., row[m]. */ + +void spx_eval_rho(SPXLP *lp, int i, double rho[/*1+m*/]) +{ int m = lp->m; + int j; + xassert(1 <= i && i <= m); + /* compute rho = inv(B') * e[i] */ + for (j = 1; j <= m; j++) + rho[j] = 0.0; + rho[i] = 1.0; + bfd_btran(lp->bfd, rho); + return; +} + +#if 1 /* 31/III-2016 */ +void spx_eval_rho_s(SPXLP *lp, int i, FVS *rho) +{ /* sparse version of spx_eval_rho */ + int m = lp->m; + xassert(1 <= i && i <= m); + /* compute rho = inv(B') * e[i] */ + xassert(rho->n == m); + fvs_clear_vec(rho); + rho->nnz = 1; + rho->ind[1] = i; + rho->vec[i] = 1.0; + bfd_btran_s(lp->bfd, rho); + return; +} +#endif + +/*********************************************************************** +* spx_eval_tij - compute element T[i,j] of simplex table +* +* This routine computes element T[i,j] of the current simplex table +* T = - inv(B) * N, 1 <= i <= m, 1 <= j <= n-m, with the following +* formula: +* +* T[i,j] = - N'[j] * rho, (1) +* +* where N[j] = A[k] is a column of the constraint matrix corresponding +* to non-basic variable xN[j] = x[k], rho is i-th row of the inverse +* matrix inv(B). +* +* It as assumed that components of the inverse row rho = (rho[j]) are +* stored in the array locations rho[1], ..., rho[m]. */ + +double spx_eval_tij(SPXLP *lp, const double rho[/*1+m*/], int j) +{ int m = lp->m; + int n = lp->n; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int k, ptr, end; + double tij; + xassert(1 <= j && j <= n-m); + k = lp->head[m+j]; /* x[k] = xN[j] */ + /* compute t[i,j] = - N'[j] * pi */ + tij = 0.0; + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + tij -= A_val[ptr] * rho[A_ind[ptr]]; + return tij; +} + +/*********************************************************************** +* spx_eval_trow - compute i-th row of simplex table +* +* This routine computes i-th row of the current simplex table +* T = (T[i,j]) = - inv(B) * N, 1 <= i <= m. +* +* Elements of the row T[i] = (T[i,j]), j = 1, ..., n-m, are computed +* directly with the routine spx_eval_tij. +* +* The vector rho = (rho[j]), which is i-th row of the basis inverse +* inv(B), should be previously computed with the routine spx_eval_rho. +* It is assumed that elements of this vector are stored in the array +* locations rho[1], ..., rho[m]. +* +* On exit components of the simplex table row are stored in the array +* locations trow[1], ... trow[n-m]. +* +* NOTE: For testing/debugging only. */ + +void spx_eval_trow(SPXLP *lp, const double rho[/*1+m*/], double + trow[/*1+n-m*/]) +{ int m = lp->m; + int n = lp->n; + int j; + for (j = 1; j <= n-m; j++) + trow[j] = spx_eval_tij(lp, rho, j); + return; +} + +/*********************************************************************** +* spx_update_beta - update values of basic variables +* +* This routine updates the vector beta = (beta[i]) of values of basic +* variables xB = (xB[i]) for the adjacent basis. +* +* On entry to the routine components of the vector beta in the current +* basis should be placed in array locations beta[1], ..., beta[m]. +* +* The parameter 1 <= p <= m specifies basic variable xB[p] which +* becomes non-basic variable xN[q] in the adjacent basis. The special +* case p < 0 means that non-basic variable xN[q] goes from its current +* active bound to opposite one in the adjacent basis. +* +* If the flag p_flag is set, the active bound of xB[p] in the adjacent +* basis is set to its upper bound. (In this case xB[p] should have its +* upper bound and should not be fixed.) +* +* The parameter 1 <= q <= n-m specifies non-basic variable xN[q] which +* becomes basic variable xB[p] in the adjacent basis (if 1 <= p <= m), +* or goes to its opposite bound (if p < 0). (In the latter case xN[q] +* should have both lower and upper bounds and should not be fixed.) +* +* It is assumed that the array tcol contains elements of q-th (pivot) +* column T[q] of the simple table in locations tcol[1], ..., tcol[m]. +* (This column should be computed for the current basis.) +* +* First, the routine determines the increment of basic variable xB[p] +* in the adjacent basis (but only if 1 <= p <= m): +* +* ( - beta[p], if -inf < xB[p] < +inf +* ( +* delta xB[p] = { lB[p] - beta[p], if p_flag = 0 +* ( +* ( uB[p] - beta[p], if p_flag = 1 +* +* where beta[p] is the value of xB[p] in the current basis, lB[p] and +* uB[p] are its lower and upper bounds. Then, the routine determines +* the increment of non-basic variable xN[q] in the adjacent basis: +* +* ( delta xB[p] / T[p,q], if 1 <= p <= m +* ( +* delta xN[q] = { uN[q] - lN[q], if p < 0 and f[q] = lN[q] +* ( +* ( lN[q] - uN[q], if p < 0 and f[q] = uN[q] +* +* where T[p,q] is the pivot element of the simplex table, f[q] is the +* active bound of xN[q] in the current basis. +* +* If 1 <= p <= m, in the adjacent basis xN[q] becomes xB[p], so: +* +* new beta[p] = f[q] + delta xN[q]. +* +* Values of other basic variables xB[i] for 1 <= i <= m, i != p, are +* updated as follows: +* +* new beta[i] = beta[i] + T[i,q] * delta xN[q]. +* +* On exit the routine stores updated components of the vector beta to +* the same locations, where the input vector beta was stored. */ + +void spx_update_beta(SPXLP *lp, double beta[/*1+m*/], int p, + int p_flag, int q, const double tcol[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int i, k; + double delta_p, delta_q; + if (p < 0) + { /* special case: xN[q] goes to its opposite bound */ + xassert(1 <= q && q <= n-m); + /* xN[q] should be double-bounded variable */ + k = head[m+q]; /* x[k] = xN[q] */ + xassert(l[k] != -DBL_MAX && u[k] != +DBL_MAX && l[k] != u[k]); + /* determine delta xN[q] */ + if (flag[q]) + { /* xN[q] goes from its upper bound to its lower bound */ + delta_q = l[k] - u[k]; + } + else + { /* xN[q] goes from its lower bound to its upper bound */ + delta_q = u[k] - l[k]; + } + } + else + { /* xB[p] leaves the basis, xN[q] enters the basis */ + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + /* determine delta xB[p] */ + k = head[p]; /* x[k] = xB[p] */ + if (p_flag) + { /* xB[p] goes to its upper bound */ + xassert(l[k] != u[k] && u[k] != +DBL_MAX); + delta_p = u[k] - beta[p]; + } + else if (l[k] == -DBL_MAX) + { /* unbounded xB[p] becomes non-basic (unusual case) */ + xassert(u[k] == +DBL_MAX); + delta_p = 0.0 - beta[p]; + } + else + { /* xB[p] goes to its lower bound or becomes fixed */ + delta_p = l[k] - beta[p]; + } + /* determine delta xN[q] */ + delta_q = delta_p / tcol[p]; + /* compute new beta[p], which is the value of xN[q] in the + * adjacent basis */ + k = head[m+q]; /* x[k] = xN[q] */ + if (flag[q]) + { /* xN[q] has its upper bound active */ + xassert(l[k] != u[k] && u[k] != +DBL_MAX); + beta[p] = u[k] + delta_q; + } + else if (l[k] == -DBL_MAX) + { /* xN[q] is non-basic unbounded variable */ + xassert(u[k] == +DBL_MAX); + beta[p] = 0.0 + delta_q; + } + else + { /* xN[q] has its lower bound active or is fixed (latter + * case is unusual) */ + beta[p] = l[k] + delta_q; + } + } + /* compute new beta[i] for all i != p */ + for (i = 1; i <= m; i++) + { if (i != p) + beta[i] += tcol[i] * delta_q; + } + return; +} + +#if 1 /* 30/III-2016 */ +void spx_update_beta_s(SPXLP *lp, double beta[/*1+m*/], int p, + int p_flag, int q, const FVS *tcol) +{ /* sparse version of spx_update_beta */ + int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int nnz = tcol->nnz; + int *ind = tcol->ind; + double *vec = tcol->vec; + int i, k; + double delta_p, delta_q; + xassert(tcol->n == m); + if (p < 0) + { /* special case: xN[q] goes to its opposite bound */ +#if 0 /* 11/VI-2017 */ + /* FIXME: not tested yet */ + xassert(0); +#endif + xassert(1 <= q && q <= n-m); + /* xN[q] should be double-bounded variable */ + k = head[m+q]; /* x[k] = xN[q] */ + xassert(l[k] != -DBL_MAX && u[k] != +DBL_MAX && l[k] != u[k]); + /* determine delta xN[q] */ + if (flag[q]) + { /* xN[q] goes from its upper bound to its lower bound */ + delta_q = l[k] - u[k]; + } + else + { /* xN[q] goes from its lower bound to its upper bound */ + delta_q = u[k] - l[k]; + } + } + else + { /* xB[p] leaves the basis, xN[q] enters the basis */ + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + /* determine delta xB[p] */ + k = head[p]; /* x[k] = xB[p] */ + if (p_flag) + { /* xB[p] goes to its upper bound */ + xassert(l[k] != u[k] && u[k] != +DBL_MAX); + delta_p = u[k] - beta[p]; + } + else if (l[k] == -DBL_MAX) + { /* unbounded xB[p] becomes non-basic (unusual case) */ + xassert(u[k] == +DBL_MAX); + delta_p = 0.0 - beta[p]; + } + else + { /* xB[p] goes to its lower bound or becomes fixed */ + delta_p = l[k] - beta[p]; + } + /* determine delta xN[q] */ + delta_q = delta_p / vec[p]; + /* compute new beta[p], which is the value of xN[q] in the + * adjacent basis */ + k = head[m+q]; /* x[k] = xN[q] */ + if (flag[q]) + { /* xN[q] has its upper bound active */ + xassert(l[k] != u[k] && u[k] != +DBL_MAX); + beta[p] = u[k] + delta_q; + } + else if (l[k] == -DBL_MAX) + { /* xN[q] is non-basic unbounded variable */ + xassert(u[k] == +DBL_MAX); + beta[p] = 0.0 + delta_q; + } + else + { /* xN[q] has its lower bound active or is fixed (latter + * case is unusual) */ + beta[p] = l[k] + delta_q; + } + } + /* compute new beta[i] for all i != p */ + for (k = 1; k <= nnz; k++) + { i = ind[k]; + if (i != p) + beta[i] += vec[i] * delta_q; + } + return; +} +#endif + +/*********************************************************************** +* spx_update_d - update reduced costs of non-basic variables +* +* This routine updates the vector d = (d[j]) of reduced costs of +* non-basic variables xN = (xN[j]) for the adjacent basis. +* +* On entry to the routine components of the vector d in the current +* basis should be placed in locations d[1], ..., d[n-m]. +* +* The parameter 1 <= p <= m specifies basic variable xB[p] which +* becomes non-basic variable xN[q] in the adjacent basis. +* +* The parameter 1 <= q <= n-m specified non-basic variable xN[q] which +* becomes basic variable xB[p] in the adjacent basis. +* +* It is assumed that the array trow contains elements of p-th (pivot) +* row T'[p] of the simplex table in locations trow[1], ..., trow[n-m]. +* It is also assumed that the array tcol contains elements of q-th +* (pivot) column T[q] of the simple table in locations tcol[1], ..., +* tcol[m]. (These row and column should be computed for the current +* basis.) +* +* First, the routine computes more accurate reduced cost d[q] in the +* current basis using q-th column of the simplex table: +* +* n-m +* d[q] = cN[q] + sum t[i,q] * cB[i], +* i=1 +* +* where cN[q] and cB[i] are objective coefficients at variables xN[q] +* and xB[i], resp. The routine also computes the relative error: +* +* e = |d[q] - d'[q]| / (1 + |d[q]|), +* +* where d'[q] is the reduced cost of xN[q] on entry to the routine, +* and returns e on exit. (If e happens to be large enough, the calling +* program may compute the reduced costs directly, since other reduced +* costs also may be inaccurate.) +* +* In the adjacent basis xB[p] becomes xN[q], so: +* +* new d[q] = d[q] / T[p,q], +* +* where T[p,q] is the pivot element of the simplex table (it is taken +* from column T[q] as more accurate). Reduced costs of other non-basic +* variables xN[j] for 1 <= j <= n-m, j != q, are updated as follows: +* +* new d[j] = d[j] + T[p,j] * new d[q]. +* +* On exit the routine stores updated components of the vector d to the +* same locations, where the input vector d was stored. */ + +double spx_update_d(SPXLP *lp, double d[/*1+n-m*/], int p, int q, + const double trow[/*1+n-m*/], const double tcol[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + int *head = lp->head; + int i, j, k; + double dq, e; + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n); + /* compute d[q] in current basis more accurately */ + k = head[m+q]; /* x[k] = xN[q] */ + dq = c[k]; + for (i = 1; i <= m; i++) + dq += tcol[i] * c[head[i]]; + /* compute relative error in d[q] */ + e = fabs(dq - d[q]) / (1.0 + fabs(dq)); + /* compute new d[q], which is the reduced cost of xB[p] in the + * adjacent basis */ + d[q] = (dq /= tcol[p]); + /* compute new d[j] for all j != q */ + for (j = 1; j <= n-m; j++) + { if (j != q) + d[j] -= trow[j] * dq; + } + return e; +} + +#if 1 /* 30/III-2016 */ +double spx_update_d_s(SPXLP *lp, double d[/*1+n-m*/], int p, int q, + const FVS *trow, const FVS *tcol) +{ /* sparse version of spx_update_d */ + int m = lp->m; + int n = lp->n; + double *c = lp->c; + int *head = lp->head; + int trow_nnz = trow->nnz; + int *trow_ind = trow->ind; + double *trow_vec = trow->vec; + int tcol_nnz = tcol->nnz; + int *tcol_ind = tcol->ind; + double *tcol_vec = tcol->vec; + int i, j, k; + double dq, e; + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n); + xassert(trow->n == n-m); + xassert(tcol->n == m); + /* compute d[q] in current basis more accurately */ + k = head[m+q]; /* x[k] = xN[q] */ + dq = c[k]; + for (k = 1; k <= tcol_nnz; k++) + { i = tcol_ind[k]; + dq += tcol_vec[i] * c[head[i]]; + } + /* compute relative error in d[q] */ + e = fabs(dq - d[q]) / (1.0 + fabs(dq)); + /* compute new d[q], which is the reduced cost of xB[p] in the + * adjacent basis */ + d[q] = (dq /= tcol_vec[p]); + /* compute new d[j] for all j != q */ + for (k = 1; k <= trow_nnz; k++) + { j = trow_ind[k]; + if (j != q) + d[j] -= trow_vec[j] * dq; + } + return e; +} +#endif + +/*********************************************************************** +* spx_change_basis - change current basis to adjacent one +* +* This routine changes the current basis to the adjacent one making +* necessary changes in lp->head and lp->flag members. +* +* The parameters p, p_flag, and q have the same meaning as for the +* routine spx_update_beta. */ + +void spx_change_basis(SPXLP *lp, int p, int p_flag, int q) +{ int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int k; + if (p < 0) + { /* special case: xN[q] goes to its opposite bound */ + xassert(1 <= q && q <= n-m); + /* xN[q] should be double-bounded variable */ + k = head[m+q]; /* x[k] = xN[q] */ + xassert(l[k] != -DBL_MAX && u[k] != +DBL_MAX && l[k] != u[k]); + /* change active bound flag */ + flag[q] = 1 - flag[q]; + } + else + { /* xB[p] leaves the basis, xN[q] enters the basis */ + xassert(1 <= p && p <= m); + xassert(p_flag == 0 || p_flag == 1); + xassert(1 <= q && q <= n-m); + k = head[p]; /* xB[p] = x[k] */ + if (p_flag) + { /* xB[p] goes to its upper bound */ + xassert(l[k] != u[k] && u[k] != +DBL_MAX); + } + /* swap xB[p] and xN[q] in the basis */ + head[p] = head[m+q], head[m+q] = k; + /* and set active bound flag for new xN[q] */ + lp->flag[q] = p_flag; + } + return; +} + +/*********************************************************************** +* spx_update_invb - update factorization of basis matrix +* +* This routine updates factorization of the basis matrix B when i-th +* column of B is replaced by k-th column of the constraint matrix A. +* +* The parameter 1 <= i <= m specifies the number of column of matrix B +* to be replaced by a new column. +* +* The parameter 1 <= k <= n specifies the number of column of matrix A +* to be used for replacement. +* +* If the factorization has been successfully updated, the routine +* validates it and returns zero. Otherwise, the routine invalidates +* the factorization and returns the code provided by the factorization +* driver (bfd_update). */ + +int spx_update_invb(SPXLP *lp, int i, int k) +{ int m = lp->m; + int n = lp->n; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int ptr, len, ret; + xassert(1 <= i && i <= m); + xassert(1 <= k && k <= n); + ptr = A_ptr[k]; + len = A_ptr[k+1] - ptr; + ret = bfd_update(lp->bfd, i, len, &A_ind[ptr-1], &A_val[ptr-1]); + lp->valid = (ret == 0); + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxlp.h b/test/monniaux/glpk-4.65/src/simplex/spxlp.h new file mode 100644 index 00000000..29a135fe --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxlp.h @@ -0,0 +1,234 @@ +/* spxlp.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPXLP_H +#define SPXLP_H + +#include "bfd.h" + +/*********************************************************************** +* The structure SPXLP describes LP problem and its current basis. +* +* It is assumed that LP problem has the following formulation (this is +* so called "working format"): +* +* z = c'* x + c0 -> min (1) +* +* A * x = b (2) +* +* l <= x <= u (3) +* +* where: +* +* x = (x[k]) is a n-vector of variables; +* +* z is an objective function; +* +* c = (c[k]) is a n-vector of objective coefficients; +* +* c0 is a constant term of the objective function; +* +* A = (a[i,k]) is a mxn-matrix of constraint coefficients; +* +* b = (b[i]) is a m-vector of right-hand sides; +* +* l = (l[k]) is a n-vector of lower bounds of variables; +* +* u = (u[k]) is a n-vector of upper bounds of variables. +* +* If variable x[k] has no lower (upper) bound, it is formally assumed +* that l[k] = -inf (u[k] = +inf). Variable having no bounds is called +* free (unbounded) variable. If l[k] = u[k], variable x[k] is assumed +* to be fixed. +* +* It is also assumed that matrix A has full row rank: rank(A) = m, +* i.e. all its rows are linearly independent, so m <= n. +* +* The (current) basis is defined by an appropriate permutation matrix +* P of order n such that: +* +* ( xB ) +* P * x = ( ), (4) +* ( xN ) +* +* where xB = (xB[i]) is a m-vector of basic variables, xN = (xN[j]) is +* a (n-m)-vector of non-basic variables. If a non-basic variable xN[j] +* has both lower and upper bounds, there is used an additional flag to +* indicate which bound is active. +* +* From (2) and (4) it follows that: +* +* A * P'* P * x = b <=> B * xB + N * xN = b, (5) +* +* where P' is a matrix transposed to P, and +* +* A * P' = (B | N). (6) +* +* Here B is the basis matrix, which is a square non-singular matrix +* of order m composed from columns of matrix A that correspond to +* basic variables xB, and N is a mx(n-m) matrix composed from columns +* of matrix A that correspond to non-basic variables xN. */ + +typedef struct SPXLP SPXLP; + +struct SPXLP +{ /* LP problem data and its (current) basis */ + int m; + /* number of equality constraints, m > 0 */ + int n; + /* number of variables, n >= m */ + int nnz; + /* number of non-zeros in constraint matrix A */ + /*--------------------------------------------------------------*/ + /* mxn-matrix A of constraint coefficients in sparse column-wise + * format */ + int *A_ptr; /* int A_ptr[1+n+1]; */ + /* A_ptr[0] is not used; + * A_ptr[k], 1 <= k <= n, is starting position of k-th column in + * arrays A_ind and A_val; note that A_ptr[1] is always 1; + * A_ptr[n+1] indicates the position after the last element in + * arrays A_ind and A_val, i.e. A_ptr[n+1] = nnz+1, where nnz is + * the number of non-zero elements in matrix A; + * the length of k-th column (the number of non-zero elements in + * that column) can be calculated as A_ptr[k+1] - A_ptr[k] */ + int *A_ind; /* int A_ind[1+nnz]; */ + /* row indices */ + double *A_val; /* double A_val[1+nnz]; */ + /* non-zero element values (constraint coefficients) */ + /*--------------------------------------------------------------*/ + /* principal vectors of LP formulation */ + double *b; /* double b[1+m]; */ + /* b[0] is not used; + * b[i], 1 <= i <= m, is the right-hand side of i-th equality + * constraint */ + double *c; /* double c[1+n]; */ + /* c[0] is the constant term of the objective function; + * c[k], 1 <= k <= n, is the objective function coefficient at + * variable x[k] */ + double *l; /* double l[1+n]; */ + /* l[0] is not used; + * l[k], 1 <= k <= n, is the lower bound of variable x[k]; + * if x[k] has no lower bound, l[k] = -DBL_MAX */ + double *u; /* double u[1+n]; */ + /* u[0] is not used; + * u[k], 1 <= k <= n, is the upper bound of variable u[k]; + * if x[k] has no upper bound, u[k] = +DBL_MAX; + * note that l[k] = u[k] means that x[k] is fixed variable */ + /*--------------------------------------------------------------*/ + /* LP basis */ + int *head; /* int head[1+n]; */ + /* basis header, which is permutation matrix P (4): + * head[0] is not used; + * head[i] = k means that xB[i] = x[k], 1 <= i <= m; + * head[m+j] = k, means that xN[j] = x[k], 1 <= j <= n-m */ + char *flag; /* char flag[1+n-m]; */ + /* flags of non-basic variables: + * flag[0] is not used; + * flag[j], 1 <= j <= n-m, indicates that non-basic variable + * xN[j] is non-fixed and has its upper bound active */ + /*--------------------------------------------------------------*/ + /* basis matrix B of order m stored in factorized form */ + int valid; + /* factorization validity flag */ + BFD *bfd; + /* driver to factorization of the basis matrix */ +}; + +#define spx_factorize _glp_spx_factorize +int spx_factorize(SPXLP *lp); +/* compute factorization of current basis matrix */ + +#define spx_eval_beta _glp_spx_eval_beta +void spx_eval_beta(SPXLP *lp, double beta[/*1+m*/]); +/* compute values of basic variables */ + +#define spx_eval_obj _glp_spx_eval_obj +double spx_eval_obj(SPXLP *lp, const double beta[/*1+m*/]); +/* compute value of objective function */ + +#define spx_eval_pi _glp_spx_eval_pi +void spx_eval_pi(SPXLP *lp, double pi[/*1+m*/]); +/* compute simplex multipliers */ + +#define spx_eval_dj _glp_spx_eval_dj +double spx_eval_dj(SPXLP *lp, const double pi[/*1+m*/], int j); +/* compute reduced cost of j-th non-basic variable */ + +#define spx_eval_tcol _glp_spx_eval_tcol +void spx_eval_tcol(SPXLP *lp, int j, double tcol[/*1+m*/]); +/* compute j-th column of simplex table */ + +#define spx_eval_rho _glp_spx_eval_rho +void spx_eval_rho(SPXLP *lp, int i, double rho[/*1+m*/]); +/* compute i-th row of basis matrix inverse */ + +#if 1 /* 31/III-2016 */ +#define spx_eval_rho_s _glp_spx_eval_rho_s +void spx_eval_rho_s(SPXLP *lp, int i, FVS *rho); +/* sparse version of spx_eval_rho */ +#endif + +#define spx_eval_tij _glp_spx_eval_tij +double spx_eval_tij(SPXLP *lp, const double rho[/*1+m*/], int j); +/* compute element T[i,j] of simplex table */ + +#define spx_eval_trow _glp_spx_eval_trow +void spx_eval_trow(SPXLP *lp, const double rho[/*1+m*/], double + trow[/*1+n-m*/]); +/* compute i-th row of simplex table */ + +#define spx_update_beta _glp_spx_update_beta +void spx_update_beta(SPXLP *lp, double beta[/*1+m*/], int p, + int p_flag, int q, const double tcol[/*1+m*/]); +/* update values of basic variables */ + +#if 1 /* 30/III-2016 */ +#define spx_update_beta_s _glp_spx_update_beta_s +void spx_update_beta_s(SPXLP *lp, double beta[/*1+m*/], int p, + int p_flag, int q, const FVS *tcol); +/* sparse version of spx_update_beta */ +#endif + +#define spx_update_d _glp_spx_update_d +double spx_update_d(SPXLP *lp, double d[/*1+n-m*/], int p, int q, + const double trow[/*1+n-m*/], const double tcol[/*1+m*/]); +/* update reduced costs of non-basic variables */ + +#if 1 /* 30/III-2016 */ +#define spx_update_d_s _glp_spx_update_d_s +double spx_update_d_s(SPXLP *lp, double d[/*1+n-m*/], int p, int q, + const FVS *trow, const FVS *tcol); +/* sparse version of spx_update_d */ +#endif + +#define spx_change_basis _glp_spx_change_basis +void spx_change_basis(SPXLP *lp, int p, int p_flag, int q); +/* change current basis to adjacent one */ + +#define spx_update_invb _glp_spx_update_invb +int spx_update_invb(SPXLP *lp, int i, int k); +/* update factorization of basis matrix */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxnt.c b/test/monniaux/glpk-4.65/src/simplex/spxnt.c new file mode 100644 index 00000000..7eaac852 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxnt.c @@ -0,0 +1,303 @@ +/* spxnt.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spxnt.h" + +/*********************************************************************** +* spx_alloc_nt - allocate matrix N in sparse row-wise format +* +* This routine allocates the memory for arrays needed to represent the +* matrix N composed of non-basic columns of the constraint matrix A. */ + +void spx_alloc_nt(SPXLP *lp, SPXNT *nt) +{ int m = lp->m; + int nnz = lp->nnz; + nt->ptr = talloc(1+m, int); + nt->len = talloc(1+m, int); + nt->ind = talloc(1+nnz, int); + nt->val = talloc(1+nnz, double); + return; +} + +/*********************************************************************** +* spx_init_nt - initialize row pointers for matrix N +* +* This routine initializes (sets up) row pointers for the matrix N +* using column-wise representation of the constraint matrix A. +* +* This routine needs to be called only once. */ + +void spx_init_nt(SPXLP *lp, SPXNT *nt) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + int *NT_ptr = nt->ptr; + int *NT_len = nt->len; + int i, k, ptr, end; + /* calculate NT_len[i] = maximal number of non-zeros in i-th row + * of N = number of non-zeros in i-th row of A */ + memset(&NT_len[1], 0, m * sizeof(int)); + for (k = 1; k <= n; k++) + { ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + NT_len[A_ind[ptr]]++; + } + /* initialize row pointers NT_ptr[i], i = 1,...,n-m */ + NT_ptr[1] = 1; + for (i = 2; i <= m; i++) + NT_ptr[i] = NT_ptr[i-1] + NT_len[i-1]; + xassert(NT_ptr[m] + NT_len[m] == nnz+1); + return; +} + +/*********************************************************************** +* spx_nt_add_col - add column N[j] = A[k] to matrix N +* +* This routine adds elements of column N[j] = A[k], 1 <= j <= n-m, +* 1 <= k <= n, to the row-wise represntation of the matrix N. It is +* assumed (with no check) that elements of the specified column are +* missing in the row-wise represntation of N. */ + +void spx_nt_add_col(SPXLP *lp, SPXNT *nt, int j, int k) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + int *NT_ptr = nt->ptr; + int *NT_len = nt->len; + int *NT_ind = nt->ind; + double *NT_val = nt->val; + int i, ptr, end, pos; + xassert(1 <= j && j <= n-m); + xassert(1 <= k && k <= n); + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + { i = A_ind[ptr]; + /* add element N[i,j] = A[i,k] to i-th row of matrix N */ + pos = NT_ptr[i] + (NT_len[i]++); + if (i < m) + xassert(pos < NT_ptr[i+1]); + else + xassert(pos <= nnz); + NT_ind[pos] = j; + NT_val[pos] = A_val[ptr]; + } + return; +} + +/*********************************************************************** +* spx_build_nt - build matrix N for current basis +* +* This routine builds the row-wise represntation of the matrix N +* for the current basis by adding columns of the constraint matrix A +* corresponding to non-basic variables. */ + +void spx_build_nt(SPXLP *lp, SPXNT *nt) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + int *NT_len = nt->len; + int j, k; + /* N := 0 */ + memset(&NT_len[1], 0, m * sizeof(int)); + /* add non-basic columns N[j] = A[k] */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + spx_nt_add_col(lp, nt, j, k); + } + return; +} + +/*********************************************************************** +* spx_nt_del_col - remove column N[j] = A[k] from matrix N +* +* This routine removes elements of column N[j] = A[k], 1 <= j <= n-m, +* 1 <= k <= n, from the row-wise representation of the matrix N. It is +* assumed (with no check) that elements of the specified column are +* present in the row-wise representation of N. */ + +void spx_nt_del_col(SPXLP *lp, SPXNT *nt, int j, int k) +{ int m = lp->m; + int n = lp->n; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + int *NT_ptr = nt->ptr; + int *NT_len = nt->len; + int *NT_ind = nt->ind; + double *NT_val = nt->val; + int i, ptr, end, ptr1, end1; + xassert(1 <= j && j <= n-m); + xassert(1 <= k && k <= n); + ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + { i = A_ind[ptr]; + /* find element N[i,j] = A[i,k] in i-th row of matrix N */ + ptr1 = NT_ptr[i]; + end1 = ptr1 + NT_len[i]; + for (; NT_ind[ptr1] != j; ptr1++) + /* nop */; + xassert(ptr1 < end1); + /* and remove it from i-th row element list */ + NT_len[i]--; + NT_ind[ptr1] = NT_ind[end1-1]; + NT_val[ptr1] = NT_val[end1-1]; + } + return; +} + +/*********************************************************************** +* spx_update_nt - update matrix N for adjacent basis +* +* This routine updates the row-wise represntation of matrix N for +* the adjacent basis, where column N[q], 1 <= q <= n-m, is replaced by +* column B[p], 1 <= p <= m, of the current basis matrix B. */ + +void spx_update_nt(SPXLP *lp, SPXNT *nt, int p, int q) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + /* remove old column N[q] corresponding to variable xN[q] */ + spx_nt_del_col(lp, nt, q, head[m+q]); + /* add new column N[q] corresponding to variable xB[p] */ + spx_nt_add_col(lp, nt, q, head[p]); + return; +} + +/*********************************************************************** +* spx_nt_prod - compute product y := y + s * N'* x +* +* This routine computes the product: +* +* y := y + s * N'* x, +* +* where N' is a matrix transposed to the mx(n-m)-matrix N composed +* from non-basic columns of the constraint matrix A, x is a m-vector, +* s is a scalar, y is (n-m)-vector. +* +* If the flag ign is non-zero, the routine ignores the input content +* of the array y assuming that y = 0. +* +* The routine uses the row-wise representation of the matrix N and +* computes the product as a linear combination: +* +* y := y + s * (N'[1] * x[1] + ... + N'[m] * x[m]), +* +* where N'[i] is i-th row of N, 1 <= i <= m. */ + +void spx_nt_prod(SPXLP *lp, SPXNT *nt, double y[/*1+n-m*/], int ign, + double s, const double x[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + int *NT_ptr = nt->ptr; + int *NT_len = nt->len; + int *NT_ind = nt->ind; + double *NT_val = nt->val; + int i, j, ptr, end; + double t; + if (ign) + { /* y := 0 */ + for (j = 1; j <= n-m; j++) + y[j] = 0.0; + } + for (i = 1; i <= m; i++) + { if (x[i] != 0.0) + { /* y := y + s * (i-th row of N) * x[i] */ + t = s * x[i]; + ptr = NT_ptr[i]; + end = ptr + NT_len[i]; + for (; ptr < end; ptr++) + y[NT_ind[ptr]] += NT_val[ptr] * t; + } + } + return; +} + +#if 1 /* 31/III-2016 */ +void spx_nt_prod_s(SPXLP *lp, SPXNT *nt, FVS *y, int ign, double s, + const FVS *x, double eps) +{ /* sparse version of spx_nt_prod */ + int *NT_ptr = nt->ptr; + int *NT_len = nt->len; + int *NT_ind = nt->ind; + double *NT_val = nt->val; + int *x_ind = x->ind; + double *x_vec = x->vec; + int *y_ind = y->ind; + double *y_vec = y->vec; + int i, j, k, nnz, ptr, end; + double t; + xassert(x->n == lp->m); + xassert(y->n == lp->n-lp->m); + if (ign) + { /* y := 0 */ + fvs_clear_vec(y); + } + nnz = y->nnz; + for (k = x->nnz; k >= 1; k--) + { i = x_ind[k]; + /* y := y + s * (i-th row of N) * x[i] */ + t = s * x_vec[i]; + ptr = NT_ptr[i]; + end = ptr + NT_len[i]; + for (; ptr < end; ptr++) + { j = NT_ind[ptr]; + if (y_vec[j] == 0.0) + y_ind[++nnz] = j; + y_vec[j] += NT_val[ptr] * t; + /* don't forget about numeric cancellation */ + if (y_vec[j] == 0.0) + y_vec[j] = DBL_MIN; + } + } + y->nnz = nnz; + fvs_adjust_vec(y, eps); + return; +} +#endif + +/*********************************************************************** +* spx_free_nt - deallocate matrix N in sparse row-wise format +* +* This routine deallocates the memory used for arrays of the program +* object nt. */ + +void spx_free_nt(SPXLP *lp, SPXNT *nt) +{ xassert(lp == lp); + tfree(nt->ptr); + tfree(nt->len); + tfree(nt->ind); + tfree(nt->val); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxnt.h b/test/monniaux/glpk-4.65/src/simplex/spxnt.h new file mode 100644 index 00000000..857917b8 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxnt.h @@ -0,0 +1,96 @@ +/* spxnt.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPXNT_H +#define SPXNT_H + +#include "spxlp.h" + +typedef struct SPXNT SPXNT; + +struct SPXNT +{ /* mx(n-m)-matrix N composed of non-basic columns of constraint + * matrix A, in sparse row-wise format */ + int *ptr; /* int ptr[1+m]; */ + /* ptr[0] is not used; + * ptr[i], 1 <= i <= m, is starting position of i-th row in + * arrays ind and val; note that ptr[1] is always 1; + * these starting positions are set up *once* as if they would + * correspond to rows of matrix A stored without gaps, i.e. + * ptr[i+1] - ptr[i] is the number of non-zeros in i-th (i < m) + * row of matrix A, and (nnz+1) - ptr[m] is the number of + * non-zero in m-th (last) row of matrix A, where nnz is the + * total number of non-zeros in matrix A */ + int *len; /* int len[1+m]; */ + /* len[0] is not used; + * len[i], 1 <= i <= m, is the number of non-zeros in i-th row + * of current matrix N */ + int *ind; /* int ind[1+nnz]; */ + /* column indices */ + double *val; /* double val[1+nnz]; */ + /* non-zero element values */ +}; + +#define spx_alloc_nt _glp_spx_alloc_nt +void spx_alloc_nt(SPXLP *lp, SPXNT *nt); +/* allocate matrix N in sparse row-wise format */ + +#define spx_init_nt _glp_spx_init_nt +void spx_init_nt(SPXLP *lp, SPXNT *nt); +/* initialize row pointers for matrix N */ + +#define spx_nt_add_col _glp_spx_nt_add_col +void spx_nt_add_col(SPXLP *lp, SPXNT *nt, int j, int k); +/* add column N[j] = A[k] */ + +#define spx_build_nt _glp_spx_build_nt +void spx_build_nt(SPXLP *lp, SPXNT *nt); +/* build matrix N for current basis */ + +#define spx_nt_del_col _glp_spx_nt_del_col +void spx_nt_del_col(SPXLP *lp, SPXNT *nt, int j, int k); +/* remove column N[j] = A[k] from matrix N */ + +#define spx_update_nt _glp_spx_update_nt +void spx_update_nt(SPXLP *lp, SPXNT *nt, int p, int q); +/* update matrix N for adjacent basis */ + +#define spx_nt_prod _glp_spx_nt_prod +void spx_nt_prod(SPXLP *lp, SPXNT *nt, double y[/*1+n-m*/], int ign, + double s, const double x[/*1+m*/]); +/* compute product y := y + s * N'* x */ + +#if 1 /* 31/III-2016 */ +#define spx_nt_prod_s _glp_spx_nt_prod_s +void spx_nt_prod_s(SPXLP *lp, SPXNT *nt, FVS *y, int ign, double s, + const FVS *x, double eps); +/* sparse version of spx_nt_prod */ +#endif + +#define spx_free_nt _glp_spx_free_nt +void spx_free_nt(SPXLP *lp, SPXNT *nt); +/* deallocate matrix N in sparse row-wise format */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxprim.c b/test/monniaux/glpk-4.65/src/simplex/spxprim.c new file mode 100644 index 00000000..e1cdfb5a --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxprim.c @@ -0,0 +1,1860 @@ +/* spxprim.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015-2017 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#if 1 /* 18/VII-2017 */ +#define SCALE_Z 1 +#endif + +#include "env.h" +#include "simplex.h" +#include "spxat.h" +#include "spxnt.h" +#include "spxchuzc.h" +#include "spxchuzr.h" +#include "spxprob.h" + +#define CHECK_ACCURACY 0 +/* (for debugging) */ + +struct csa +{ /* common storage area */ + SPXLP *lp; + /* LP problem data and its (current) basis; this LP has m rows + * and n columns */ + int dir; + /* original optimization direction: + * +1 - minimization + * -1 - maximization */ +#if SCALE_Z + double fz; + /* factor used to scale original objective */ +#endif + double *orig_c; /* double orig_c[1+n]; */ + /* copy of original objective coefficients */ + double *orig_l; /* double orig_l[1+n]; */ + /* copy of original lower bounds */ + double *orig_u; /* double orig_u[1+n]; */ + /* copy of original upper bounds */ + SPXAT *at; + /* mxn-matrix A of constraint coefficients, in sparse row-wise + * format (NULL if not used) */ + SPXNT *nt; + /* mx(n-m)-matrix N composed of non-basic columns of constraint + * matrix A, in sparse row-wise format (NULL if not used) */ + int phase; + /* search phase: + * 0 - not determined yet + * 1 - searching for primal feasible solution + * 2 - searching for optimal solution */ + double *beta; /* double beta[1+m]; */ + /* beta[i] is a primal value of basic variable xB[i] */ + int beta_st; + /* status of the vector beta: + * 0 - undefined + * 1 - just computed + * 2 - updated */ + double *d; /* double d[1+n-m]; */ + /* d[j] is a reduced cost of non-basic variable xN[j] */ + int d_st; + /* status of the vector d: + * 0 - undefined + * 1 - just computed + * 2 - updated */ + SPXSE *se; + /* projected steepest edge and Devex pricing data block (NULL if + * not used) */ + int num; + /* number of eligible non-basic variables */ + int *list; /* int list[1+n-m]; */ + /* list[1], ..., list[num] are indices j of eligible non-basic + * variables xN[j] */ + int q; + /* xN[q] is a non-basic variable chosen to enter the basis */ +#if 0 /* 11/VI-2017 */ + double *tcol; /* double tcol[1+m]; */ +#else + FVS tcol; /* FVS tcol[1:m]; */ +#endif + /* q-th (pivot) column of the simplex table */ +#if 1 /* 23/VI-2017 */ + SPXBP *bp; /* SPXBP bp[1+2*m+1]; */ + /* penalty function break points */ +#endif + int p; + /* xB[p] is a basic variable chosen to leave the basis; + * p = 0 means that no basic variable reaches its bound; + * p < 0 means that non-basic variable xN[q] reaches its opposite + * bound before any basic variable */ + int p_flag; + /* if this flag is set, the active bound of xB[p] in the adjacent + * basis should be set to the upper bound */ +#if 0 /* 11/VI-2017 */ + double *trow; /* double trow[1+n-m]; */ +#else + FVS trow; /* FVS trow[1:n-m]; */ +#endif + /* p-th (pivot) row of the simplex table */ +#if 0 /* 09/VII-2017 */ + double *work; /* double work[1+m]; */ + /* working array */ +#else + FVS work; /* FVS work[1:m]; */ + /* working vector */ +#endif + int p_stat, d_stat; + /* primal and dual solution statuses */ + /*--------------------------------------------------------------*/ + /* control parameters (see struct glp_smcp) */ + int msg_lev; + /* message level */ +#if 0 /* 23/VI-2017 */ + int harris; + /* ratio test technique: + * 0 - textbook ratio test + * 1 - Harris' two pass ratio test */ +#else + int r_test; + /* ratio test technique: + * GLP_RT_STD - textbook ratio test + * GLP_RT_HAR - Harris' two pass ratio test + * GLP_RT_FLIP - long-step ratio test (only for phase I) */ +#endif + double tol_bnd, tol_bnd1; + /* primal feasibility tolerances */ + double tol_dj, tol_dj1; + /* dual feasibility tolerances */ + double tol_piv; + /* pivot tolerance */ + int it_lim; + /* iteration limit */ + int tm_lim; + /* time limit, milliseconds */ + int out_frq; +#if 0 /* 15/VII-2017 */ + /* display output frequency, iterations */ +#else + /* display output frequency, milliseconds */ +#endif + int out_dly; + /* display output delay, milliseconds */ + /*--------------------------------------------------------------*/ + /* working parameters */ + double tm_beg; + /* time value at the beginning of the search */ + int it_beg; + /* simplex iteration count at the beginning of the search */ + int it_cnt; + /* simplex iteration count; it increases by one every time the + * basis changes (including the case when a non-basic variable + * jumps to its opposite bound) */ + int it_dpy; + /* simplex iteration count at most recent display output */ +#if 1 /* 15/VII-2017 */ + double tm_dpy; + /* time value at most recent display output */ +#endif + int inv_cnt; + /* basis factorization count since most recent display output */ +#if 1 /* 01/VII-2017 */ + int degen; + /* count of successive degenerate iterations; this count is used + * to detect stalling */ +#endif +#if 1 /* 23/VI-2017 */ + int ns_cnt, ls_cnt; + /* normal and long-step iteration counts */ +#endif +}; + +/*********************************************************************** +* set_penalty - set penalty function coefficients +* +* This routine sets up objective coefficients of the penalty function, +* which is the sum of primal infeasibilities, as follows: +* +* if beta[i] < l[k] - eps1, set c[k] = -1, +* +* if beta[i] > u[k] + eps2, set c[k] = +1, +* +* otherwise, set c[k] = 0, +* +* where beta[i] is current value of basic variable xB[i] = x[k], l[k] +* and u[k] are original bounds of x[k], and +* +* eps1 = tol + tol1 * |l[k]|, +* +* eps2 = tol + tol1 * |u[k]|. +* +* The routine returns the number of non-zero objective coefficients, +* which is the number of basic variables violating their bounds. Thus, +* if the value returned is zero, the current basis is primal feasible +* within the specified tolerances. */ + +static int set_penalty(struct csa *csa, double tol, double tol1) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + double *beta = csa->beta; + int i, k, count = 0; + double t, eps; + /* reset objective coefficients */ + for (k = 0; k <= n; k++) + c[k] = 0.0; + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + /* check lower bound */ + if ((t = l[k]) != -DBL_MAX) + { eps = tol + tol1 * (t >= 0.0 ? +t : -t); + if (beta[i] < t - eps) + { /* lower bound is violated */ + c[k] = -1.0, count++; + } + } + /* check upper bound */ + if ((t = u[k]) != +DBL_MAX) + { eps = tol + tol1 * (t >= 0.0 ? +t : -t); + if (beta[i] > t + eps) + { /* upper bound is violated */ + c[k] = +1.0, count++; + } + } + } + return count; +} + +/*********************************************************************** +* check_feas - check primal feasibility of basic solution +* +* This routine checks if the specified values of all basic variables +* beta = (beta[i]) are within their bounds. +* +* Let l[k] and u[k] be original bounds of basic variable xB[i] = x[k]. +* The actual bounds of x[k] are determined as follows: +* +* 1) if phase = 1 and c[k] < 0, x[k] violates its lower bound, so its +* actual bounds are artificial: -inf < x[k] <= l[k]; +* +* 2) if phase = 1 and c[k] > 0, x[k] violates its upper bound, so its +* actual bounds are artificial: u[k] <= x[k] < +inf; +* +* 3) in all other cases (if phase = 1 and c[k] = 0, or if phase = 2) +* actual bounds are original: l[k] <= x[k] <= u[k]. +* +* The parameters tol and tol1 are bound violation tolerances. The +* actual bounds l'[k] and u'[k] are considered as non-violated within +* the specified tolerance if +* +* l'[k] - eps1 <= beta[i] <= u'[k] + eps2, +* +* where eps1 = tol + tol1 * |l'[k]|, eps2 = tol + tol1 * |u'[k]|. +* +* The routine returns one of the following codes: +* +* 0 - solution is feasible (no actual bounds are violated); +* +* 1 - solution is infeasible, however, only artificial bounds are +* violated (this is possible only if phase = 1); +* +* 2 - solution is infeasible and at least one original bound is +* violated. */ + +static int check_feas(struct csa *csa, int phase, double tol, double + tol1) +{ SPXLP *lp = csa->lp; + int m = lp->m; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + double *beta = csa->beta; + int i, k, orig, ret = 0; + double lk, uk, eps; + xassert(phase == 1 || phase == 2); + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + /* determine actual bounds of x[k] */ + if (phase == 1 && c[k] < 0.0) + { /* -inf < x[k] <= l[k] */ + lk = -DBL_MAX, uk = l[k]; + orig = 0; /* artificial bounds */ + } + else if (phase == 1 && c[k] > 0.0) + { /* u[k] <= x[k] < +inf */ + lk = u[k], uk = +DBL_MAX; + orig = 0; /* artificial bounds */ + } + else + { /* l[k] <= x[k] <= u[k] */ + lk = l[k], uk = u[k]; + orig = 1; /* original bounds */ + } + /* check actual lower bound */ + if (lk != -DBL_MAX) + { eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] < lk - eps) + { /* actual lower bound is violated */ + if (orig) + { ret = 2; + break; + } + ret = 1; + } + } + /* check actual upper bound */ + if (uk != +DBL_MAX) + { eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] > uk + eps) + { /* actual upper bound is violated */ + if (orig) + { ret = 2; + break; + } + ret = 1; + } + } + } + return ret; +} + +/*********************************************************************** +* adjust_penalty - adjust penalty function coefficients +* +* On searching for primal feasible solution it may happen that some +* basic variable xB[i] = x[k] has non-zero objective coefficient c[k] +* indicating that xB[i] violates its lower (if c[k] < 0) or upper (if +* c[k] > 0) original bound, but due to primal degenarcy the violation +* is close to zero. +* +* This routine identifies such basic variables and sets objective +* coefficients at these variables to zero that allows avoiding zero- +* step simplex iterations. +* +* The parameters tol and tol1 are bound violation tolerances. The +* original bounds l[k] and u[k] are considered as non-violated within +* the specified tolerance if +* +* l[k] - eps1 <= beta[i] <= u[k] + eps2, +* +* where beta[i] is value of basic variable xB[i] = x[k] in the current +* basis, eps1 = tol + tol1 * |l[k]|, eps2 = tol + tol1 * |u[k]|. +* +* The routine returns the number of objective coefficients which were +* set to zero. */ + +#if 0 +static int adjust_penalty(struct csa *csa, double tol, double tol1) +{ SPXLP *lp = csa->lp; + int m = lp->m; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + double *beta = csa->beta; + int i, k, count = 0; + double t, eps; + xassert(csa->phase == 1); + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + if (c[k] < 0.0) + { /* x[k] violates its original lower bound l[k] */ + xassert((t = l[k]) != -DBL_MAX); + eps = tol + tol1 * (t >= 0.0 ? +t : -t); + if (beta[i] >= t - eps) + { /* however, violation is close to zero */ + c[k] = 0.0, count++; + } + } + else if (c[k] > 0.0) + { /* x[k] violates its original upper bound u[k] */ + xassert((t = u[k]) != +DBL_MAX); + eps = tol + tol1 * (t >= 0.0 ? +t : -t); + if (beta[i] <= t + eps) + { /* however, violation is close to zero */ + c[k] = 0.0, count++; + } + } + } + return count; +} +#else +static int adjust_penalty(struct csa *csa, int num, const int + ind[/*1+num*/], double tol, double tol1) +{ SPXLP *lp = csa->lp; + int m = lp->m; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + double *beta = csa->beta; + int i, k, t, cnt = 0; + double lk, uk, eps; + xassert(csa->phase == 1); + /* walk thru the specified list of basic variables */ + for (t = 1; t <= num; t++) + { i = ind[t]; + xassert(1 <= i && i <= m); + k = head[i]; /* x[k] = xB[i] */ + if (c[k] < 0.0) + { /* x[k] violates its original lower bound */ + lk = l[k]; + xassert(lk != -DBL_MAX); + eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] >= lk - eps) + { /* however, violation is close to zero */ + c[k] = 0.0, cnt++; + } + } + else if (c[k] > 0.0) + { /* x[k] violates its original upper bound */ + uk = u[k]; + xassert(uk != +DBL_MAX); + eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] <= uk + eps) + { /* however, violation is close to zero */ + c[k] = 0.0, cnt++; + } + } + } + return cnt; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_vec - compute maximal relative error between two vectors +* +* This routine computes and returns maximal relative error between +* n-vectors x and y: +* +* err_max = max |x[i] - y[i]| / (1 + |x[i]|). +* +* NOTE: This routine is intended only for debugginig purposes. */ + +static double err_in_vec(int n, const double x[], const double y[]) +{ int i; + double err, err_max; + err_max = 0.0; + for (i = 1; i <= n; i++) + { err = fabs(x[i] - y[i]) / (1.0 + fabs(x[i])); + if (err_max < err) + err_max = err; + } + return err_max; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_beta - compute maximal relative error in vector beta +* +* This routine computes and returns maximal relative error in vector +* of values of basic variables beta = (beta[i]). +* +* NOTE: This routine is intended only for debugginig purposes. */ + +static double err_in_beta(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + double err, *beta; + beta = talloc(1+m, double); + spx_eval_beta(lp, beta); + err = err_in_vec(m, beta, csa->beta); + tfree(beta); + return err; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_d - compute maximal relative error in vector d +* +* This routine computes and returns maximal relative error in vector +* of reduced costs of non-basic variables d = (d[j]). +* +* NOTE: This routine is intended only for debugginig purposes. */ + +static double err_in_d(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + int j; + double err, *pi, *d; + pi = talloc(1+m, double); + d = talloc(1+n-m, double); + spx_eval_pi(lp, pi); + for (j = 1; j <= n-m; j++) + d[j] = spx_eval_dj(lp, pi, j); + err = err_in_vec(n-m, d, csa->d); + tfree(pi); + tfree(d); + return err; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_gamma - compute maximal relative error in vector gamma +* +* This routine computes and returns maximal relative error in vector +* of projected steepest edge weights gamma = (gamma[j]). +* +* NOTE: This routine is intended only for debugginig purposes. */ + +static double err_in_gamma(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + SPXSE *se = csa->se; + int j; + double err, *gamma; + xassert(se != NULL); + gamma = talloc(1+n-m, double); + for (j = 1; j <= n-m; j++) + gamma[j] = spx_eval_gamma_j(lp, se, j); + err = err_in_vec(n-m, gamma, se->gamma); + tfree(gamma); + return err; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* check_accuracy - check accuracy of basic solution components +* +* This routine checks accuracy of current basic solution components. +* +* NOTE: This routine is intended only for debugginig purposes. */ + +static void check_accuracy(struct csa *csa) +{ double e_beta, e_d, e_gamma; + e_beta = err_in_beta(csa); + e_d = err_in_d(csa); + if (csa->se == NULL) + e_gamma = 0.; + else + e_gamma = err_in_gamma(csa); + xprintf("e_beta = %10.3e; e_d = %10.3e; e_gamma = %10.3e\n", + e_beta, e_d, e_gamma); + xassert(e_beta <= 1e-5 && e_d <= 1e-5 && e_gamma <= 1e-3); + return; +} +#endif + +/*********************************************************************** +* choose_pivot - choose xN[q] and xB[p] +* +* Given the list of eligible non-basic variables this routine first +* chooses non-basic variable xN[q]. This choice is always possible, +* because the list is assumed to be non-empty. Then the routine +* computes q-th column T[*,q] of the simplex table T[i,j] and chooses +* basic variable xB[p]. If the pivot T[p,q] is small in magnitude, +* the routine attempts to choose another xN[q] and xB[p] in order to +* avoid badly conditioned adjacent bases. */ + +#if 1 /* 17/III-2016 */ +#define MIN_RATIO 0.0001 + +static int choose_pivot(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *beta = csa->beta; + double *d = csa->d; + SPXSE *se = csa->se; + int *list = csa->list; +#if 0 /* 09/VII-2017 */ + double *tcol = csa->work; +#else + double *tcol = csa->work.vec; +#endif + double tol_piv = csa->tol_piv; + int try, nnn, /*i,*/ p, p_flag, q, t; + double big, /*temp,*/ best_ratio; +#if 1 /* 23/VI-2017 */ + double *c = lp->c; + int *head = lp->head; + SPXBP *bp = csa->bp; + int nbp, t_best, ret, k; + double dz_best; +#endif + xassert(csa->beta_st); + xassert(csa->d_st); +more: /* initial number of eligible non-basic variables */ + nnn = csa->num; + /* nothing has been chosen so far */ + csa->q = 0; + best_ratio = 0.0; +#if 0 /* 23/VI-2017 */ + try = 0; +#else + try = ret = 0; +#endif +try: /* choose non-basic variable xN[q] */ + xassert(nnn > 0); + try++; + if (se == NULL) + { /* Dantzig's rule */ + q = spx_chuzc_std(lp, d, nnn, list); + } + else + { /* projected steepest edge */ + q = spx_chuzc_pse(lp, se, d, nnn, list); + } + xassert(1 <= q && q <= n-m); + /* compute q-th column of the simplex table */ + spx_eval_tcol(lp, q, tcol); +#if 0 + /* big := max(1, |tcol[1]|, ..., |tcol[m]|) */ + big = 1.0; + for (i = 1; i <= m; i++) + { temp = tcol[i]; + if (temp < 0.0) + temp = - temp; + if (big < temp) + big = temp; + } +#else + /* this still puzzles me */ + big = 1.0; +#endif + /* choose basic variable xB[p] */ +#if 1 /* 23/VI-2017 */ + if (csa->phase == 1 && csa->r_test == GLP_RT_FLIP && try <= 2) + { /* long-step ratio test */ + int t, num, num1; + double slope, teta_lim; + /* determine penalty function break points */ + nbp = spx_ls_eval_bp(lp, beta, q, d[q], tcol, tol_piv, bp); + if (nbp < 2) + goto skip; + /* set initial slope */ + slope = - fabs(d[q]); + /* estimate initial teta_lim */ + teta_lim = DBL_MAX; + for (t = 1; t <= nbp; t++) + { if (teta_lim > bp[t].teta) + teta_lim = bp[t].teta; + } + xassert(teta_lim >= 0.0); + if (teta_lim < 1e-3) + teta_lim = 1e-3; + /* nothing has been chosen so far */ + t_best = 0, dz_best = 0.0, num = 0; + /* choose appropriate break point */ + while (num < nbp) + { /* select and process a new portion of break points */ + num1 = spx_ls_select_bp(lp, tcol, nbp, bp, num, &slope, + teta_lim); + for (t = num+1; t <= num1; t++) + { int i = (bp[t].i >= 0 ? bp[t].i : -bp[t].i); + xassert(0 <= i && i <= m); + if (i == 0 || fabs(tcol[i]) / big >= MIN_RATIO) + { if (dz_best > bp[t].dz) + t_best = t, dz_best = bp[t].dz; + } +#if 0 + if (i == 0) + { /* do not consider further break points beyond this + * point, where xN[q] reaches its opposite bound; + * in principle (see spx_ls_eval_bp), this break + * point should be the last one, however, due to + * round-off errors there may be other break points + * with the same teta beyond this one */ + slope = +1.0; + } +#endif + } + if (slope > 0.0) + { /* penalty function starts increasing */ + break; + } + /* penalty function continues decreasing */ + num = num1; + teta_lim += teta_lim; + } + if (dz_best == 0.0) + goto skip; + /* the choice has been made */ + xassert(1 <= t_best && t_best <= num1); + if (t_best == 1) + { /* the very first break point was chosen; it is reasonable + * to use the short-step ratio test */ + goto skip; + } + csa->q = q; + memcpy(&csa->tcol.vec[1], &tcol[1], m * sizeof(double)); + fvs_gather_vec(&csa->tcol, DBL_EPSILON); + if (bp[t_best].i == 0) + { /* xN[q] goes to its opposite bound */ + csa->p = -1; + csa->p_flag = 0; + best_ratio = 1.0; + } + else if (bp[t_best].i > 0) + { /* xB[p] leaves the basis and goes to its lower bound */ + csa->p = + bp[t_best].i; + xassert(1 <= csa->p && csa->p <= m); + csa->p_flag = 0; + best_ratio = fabs(tcol[csa->p]) / big; + } + else + { /* xB[p] leaves the basis and goes to its upper bound */ + csa->p = - bp[t_best].i; + xassert(1 <= csa->p && csa->p <= m); + csa->p_flag = 1; + best_ratio = fabs(tcol[csa->p]) / big; + } +#if 0 + xprintf("num1 = %d; t_best = %d; dz = %g\n", num1, t_best, + bp[t_best].dz); +#endif + ret = 1; + goto done; +skip: ; + } +#endif +#if 0 /* 23/VI-2017 */ + if (!csa->harris) +#else + if (csa->r_test == GLP_RT_STD) +#endif + { /* textbook ratio test */ + p = spx_chuzr_std(lp, csa->phase, beta, q, + d[q] < 0.0 ? +1. : -1., tcol, &p_flag, tol_piv, + .30 * csa->tol_bnd, .30 * csa->tol_bnd1); + } + else + { /* Harris' two-pass ratio test */ + p = spx_chuzr_harris(lp, csa->phase, beta, q, + d[q] < 0.0 ? +1. : -1., tcol, &p_flag , tol_piv, + .50 * csa->tol_bnd, .50 * csa->tol_bnd1); + } + if (p <= 0) + { /* primal unboundedness or special case */ + csa->q = q; +#if 0 /* 11/VI-2017 */ + memcpy(&csa->tcol[1], &tcol[1], m * sizeof(double)); +#else + memcpy(&csa->tcol.vec[1], &tcol[1], m * sizeof(double)); + fvs_gather_vec(&csa->tcol, DBL_EPSILON); +#endif + csa->p = p; + csa->p_flag = p_flag; + best_ratio = 1.0; + goto done; + } + /* either keep previous choice or accept new choice depending on + * which one is better */ + if (best_ratio < fabs(tcol[p]) / big) + { csa->q = q; +#if 0 /* 11/VI-2017 */ + memcpy(&csa->tcol[1], &tcol[1], m * sizeof(double)); +#else + memcpy(&csa->tcol.vec[1], &tcol[1], m * sizeof(double)); + fvs_gather_vec(&csa->tcol, DBL_EPSILON); +#endif + csa->p = p; + csa->p_flag = p_flag; + best_ratio = fabs(tcol[p]) / big; + } + /* check if the current choice is acceptable */ + if (best_ratio >= MIN_RATIO || nnn == 1 || try == 5) + goto done; + /* try to choose other xN[q] and xB[p] */ + /* find xN[q] in the list */ + for (t = 1; t <= nnn; t++) + if (list[t] == q) break; + xassert(t <= nnn); + /* move xN[q] to the end of the list */ + list[t] = list[nnn], list[nnn] = q; + /* and exclude it from consideration */ + nnn--; + /* repeat the choice */ + goto try; +done: /* the choice has been made */ +#if 1 /* FIXME: currently just to avoid badly conditioned basis */ + if (best_ratio < .001 * MIN_RATIO) + { /* looks like this helps */ + if (bfd_get_count(lp->bfd) > 0) + return -1; + /* didn't help; last chance to improve the choice */ + if (tol_piv == csa->tol_piv) + { tol_piv *= 1000.; + goto more; + } + } +#endif +#if 0 /* 23/VI-2017 */ + return 0; +#else /* FIXME */ + if (ret) + { /* invalidate dual basic solution components */ + csa->d_st = 0; + /* change penalty function coefficients at basic variables for + * all break points preceding the chosen one */ + for (t = 1; t < t_best; t++) + { int i = (bp[t].i >= 0 ? bp[t].i : -bp[t].i); + xassert(0 <= i && i <= m); + if (i == 0) + { /* xN[q] crosses its opposite bound */ + xassert(1 <= csa->q && csa->q <= n-m); + k = head[m+csa->q]; + } + else + { /* xB[i] crosses its (lower or upper) bound */ + k = head[i]; /* x[k] = xB[i] */ + } + c[k] += bp[t].dc; + xassert(c[k] == 0.0 || c[k] == +1.0 || c[k] == -1.0); + } + } + return ret; +#endif +} +#endif + +/*********************************************************************** +* play_bounds - play bounds of primal variables +* +* This routine is called after the primal values of basic variables +* beta[i] were updated and the basis was changed to the adjacent one. +* +* It is assumed that before updating all the primal values beta[i] +* were strongly feasible, so in the adjacent basis beta[i] remain +* feasible within a tolerance, i.e. if some beta[i] violates its lower +* or upper bound, the violation is insignificant. +* +* If some beta[i] violates its lower or upper bound, this routine +* changes (perturbs) the bound to remove such violation, i.e. to make +* all beta[i] strongly feasible. Otherwise, if beta[i] has a feasible +* value, this routine attempts to reduce (or remove) perturbation of +* corresponding lower/upper bound keeping strong feasibility. */ + +/* FIXME: what to do if l[k] = u[k]? */ + +/* FIXME: reduce/remove perturbation if x[k] becomes non-basic? */ + +static void play_bounds(struct csa *csa, int all) +{ SPXLP *lp = csa->lp; + int m = lp->m; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + double *orig_l = csa->orig_l; + double *orig_u = csa->orig_u; + double *beta = csa->beta; +#if 0 /* 11/VI-2017 */ + const double *tcol = csa->tcol; /* was used to update beta */ +#else + const double *tcol = csa->tcol.vec; +#endif + int i, k; + xassert(csa->phase == 1 || csa->phase == 2); + /* primal values beta = (beta[i]) should be valid */ + xassert(csa->beta_st); + /* walk thru the list of basic variables xB = (xB[i]) */ + for (i = 1; i <= m; i++) + { if (all || tcol[i] != 0.0) + { /* beta[i] has changed in the adjacent basis */ + k = head[i]; /* x[k] = xB[i] */ + if (csa->phase == 1 && c[k] < 0.0) + { /* -inf < xB[i] <= lB[i] (artificial bounds) */ + if (beta[i] < l[k] - 1e-9) + continue; + /* restore actual bounds */ + c[k] = 0.0; + csa->d_st = 0; /* since c[k] = cB[i] has changed */ + } + if (csa->phase == 1 && c[k] > 0.0) + { /* uB[i] <= xB[i] < +inf (artificial bounds) */ + if (beta[i] > u[k] + 1e-9) + continue; + /* restore actual bounds */ + c[k] = 0.0; + csa->d_st = 0; /* since c[k] = cB[i] has changed */ + } + /* lB[i] <= xB[i] <= uB[i] */ + if (csa->phase == 1) + xassert(c[k] == 0.0); + if (l[k] != -DBL_MAX) + { /* xB[i] has lower bound */ + if (beta[i] < l[k]) + { /* strong feasibility means xB[i] >= lB[i] */ +#if 0 /* 11/VI-2017 */ + l[k] = beta[i]; +#else + l[k] = beta[i] - 1e-9; +#endif + } + else if (l[k] < orig_l[k]) + { /* remove/reduce perturbation of lB[i] */ + if (beta[i] >= orig_l[k]) + l[k] = orig_l[k]; + else + l[k] = beta[i]; + } + } + if (u[k] != +DBL_MAX) + { /* xB[i] has upper bound */ + if (beta[i] > u[k]) + { /* strong feasibility means xB[i] <= uB[i] */ +#if 0 /* 11/VI-2017 */ + u[k] = beta[i]; +#else + u[k] = beta[i] + 1e-9; +#endif + } + else if (u[k] > orig_u[k]) + { /* remove/reduce perturbation of uB[i] */ + if (beta[i] <= orig_u[k]) + u[k] = orig_u[k]; + else + u[k] = beta[i]; + } + } + } + } + return; +} + +static void remove_perturb(struct csa *csa) +{ /* remove perturbation */ + SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + double *orig_l = csa->orig_l; + double *orig_u = csa->orig_u; + int j, k; + /* restore original bounds of variables */ + memcpy(l, orig_l, (1+n) * sizeof(double)); + memcpy(u, orig_u, (1+n) * sizeof(double)); + /* adjust flags of fixed non-basic variables, because in the + * perturbed problem such variables might be changed to double- + * bounded type */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == u[k]) + flag[j] = 0; + } + /* removing perturbation changes primal solution components */ + csa->phase = csa->beta_st = 0; +#if 1 + if (csa->msg_lev >= GLP_MSG_ALL) + xprintf("Removing LP perturbation [%d]...\n", + csa->it_cnt); +#endif + return; +} + +/*********************************************************************** +* sum_infeas - compute sum of primal infeasibilities +* +* This routine compute the sum of primal infeasibilities, which is the +* current penalty function value. */ + +static double sum_infeas(SPXLP *lp, const double beta[/*1+m*/]) +{ int m = lp->m; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int i, k; + double sum = 0.0; + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + if (l[k] != -DBL_MAX && beta[i] < l[k]) + sum += l[k] - beta[i]; + if (u[k] != +DBL_MAX && beta[i] > u[k]) + sum += beta[i] - u[k]; + } + return sum; +} + +/*********************************************************************** +* 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; +* +* sum of (scaled) primal infeasibilities; +* +* number of infeasibilities (phase I) or non-optimalities (phase II); +* +* number of basic factorizations since last display output. */ + +static void display(struct csa *csa, int spec) +{ int nnn, k; + double obj, sum, *save, *save1; +#if 1 /* 15/VII-2017 */ + double tm_cur; +#endif + /* check if the display output should be skipped */ + if (csa->msg_lev < GLP_MSG_ON) goto skip; +#if 1 /* 15/VII-2017 */ + tm_cur = xtime(); +#endif + if (csa->out_dly > 0 && +#if 0 /* 15/VII-2017 */ + 1000.0 * xdifftime(xtime(), csa->tm_beg) < csa->out_dly) +#else + 1000.0 * xdifftime(tm_cur, csa->tm_beg) < csa->out_dly) +#endif + goto skip; + if (csa->it_cnt == csa->it_dpy) goto skip; +#if 0 /* 15/VII-2017 */ + if (!spec && csa->it_cnt % csa->out_frq != 0) goto skip; +#else + if (!spec && + 1000.0 * xdifftime(tm_cur, csa->tm_dpy) < csa->out_frq) + goto skip; +#endif + /* compute original objective value */ + save = csa->lp->c; + csa->lp->c = csa->orig_c; + obj = csa->dir * spx_eval_obj(csa->lp, csa->beta); + csa->lp->c = save; +#if SCALE_Z + obj *= csa->fz; +#endif + /* compute sum of (scaled) primal infeasibilities */ +#if 1 /* 01/VII-2017 */ + save = csa->lp->l; + save1 = csa->lp->u; + csa->lp->l = csa->orig_l; + csa->lp->u = csa->orig_u; +#endif + sum = sum_infeas(csa->lp, csa->beta); +#if 1 /* 01/VII-2017 */ + csa->lp->l = save; + csa->lp->u = save1; +#endif + /* compute number of infeasibilities/non-optimalities */ + switch (csa->phase) + { case 1: + nnn = 0; + for (k = 1; k <= csa->lp->n; k++) + if (csa->lp->c[k] != 0.0) nnn++; + break; + case 2: + xassert(csa->d_st); + nnn = spx_chuzc_sel(csa->lp, csa->d, csa->tol_dj, + csa->tol_dj1, NULL); + break; + default: + xassert(csa != csa); + } + /* display search progress */ + xprintf("%c%6d: obj = %17.9e inf = %11.3e (%d)", + csa->phase == 2 ? '*' : ' ', csa->it_cnt, obj, sum, nnn); + if (csa->inv_cnt) + { /* number of basis factorizations performed */ + xprintf(" %d", csa->inv_cnt); + csa->inv_cnt = 0; + } +#if 1 /* 23/VI-2017 */ + if (csa->phase == 1 && csa->r_test == GLP_RT_FLIP) + { /*xprintf(" %d,%d", csa->ns_cnt, csa->ls_cnt);*/ + if (csa->ns_cnt + csa->ls_cnt) + xprintf(" %d%%", + (100 * csa->ls_cnt) / (csa->ns_cnt + csa->ls_cnt)); + csa->ns_cnt = csa->ls_cnt = 0; + } +#endif + xprintf("\n"); + csa->it_dpy = csa->it_cnt; +#if 1 /* 15/VII-2017 */ + csa->tm_dpy = tm_cur; +#endif +skip: return; +} + +/*********************************************************************** +* spx_primal - driver to the primal simplex method +* +* This routine is a driver to the two-phase primal simplex method. +* +* On exit this routine returns one of the following codes: +* +* 0 LP instance has been successfully solved. +* +* 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 primal_simplex(struct csa *csa) +{ /* primal simplex method main logic routine */ + SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *c = lp->c; + int *head = lp->head; + SPXAT *at = csa->at; + SPXNT *nt = csa->nt; + double *beta = csa->beta; + double *d = csa->d; + SPXSE *se = csa->se; + int *list = csa->list; +#if 0 /* 11/VI-2017 */ + double *tcol = csa->tcol; + double *trow = csa->trow; +#endif +#if 0 /* 09/VII-2017 */ + double *pi = csa->work; + double *rho = csa->work; +#else + double *pi = csa->work.vec; + double *rho = csa->work.vec; +#endif + 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 perturb = -1; + /* -1 = perturbation is not used, but enabled + * 0 = perturbation is not used and disabled + * +1 = perturbation is being used */ + int j, refct, ret; +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 values of basic variables beta = (beta[i]) */ + if (!csa->beta_st) + { spx_eval_beta(lp, beta); + csa->beta_st = 1; /* just computed */ + /* determine the search phase, if not determined yet */ + if (!csa->phase) + { if (set_penalty(csa, 0.97 * tol_bnd, 0.97 * tol_bnd1)) + { /* current basic solution is primal infeasible */ + /* start to minimize the sum of infeasibilities */ + csa->phase = 1; + } + else + { /* current basic solution is primal feasible */ + /* start to minimize the original objective function */ + csa->phase = 2; + memcpy(c, csa->orig_c, (1+n) * sizeof(double)); + } + /* working objective coefficients have been changed, so + * invalidate reduced costs */ + csa->d_st = 0; + } + /* make sure that the current basic solution remains primal + * feasible (or pseudo-feasible on phase I) */ + if (perturb <= 0) + { if (check_feas(csa, csa->phase, tol_bnd, tol_bnd1)) + { /* excessive bound violations due to round-off errors */ +#if 1 /* 01/VII-2017 */ + if (perturb < 0) + { if (msg_lev >= GLP_MSG_ALL) + xprintf("Perturbing LP to avoid instability [%d].." + ".\n", csa->it_cnt); + perturb = 1; + goto loop; + } +#endif + if (msg_lev >= GLP_MSG_ERR) + xprintf("Warning: numerical instability (primal simpl" + "ex, phase %s)\n", csa->phase == 1 ? "I" : "II"); + /* restart the search */ + lp->valid = 0; + csa->phase = 0; + goto loop; + } + if (csa->phase == 1) + { int i, cnt; + for (i = 1; i <= m; i++) + csa->tcol.ind[i] = i; + cnt = adjust_penalty(csa, m, csa->tcol.ind, + 0.99 * tol_bnd, 0.99 * tol_bnd1); + if (cnt) + { /*xprintf("*** cnt = %d\n", cnt);*/ + csa->d_st = 0; + } + } + } + else + { /* FIXME */ + play_bounds(csa, 1); + } + } + /* at this point the search phase is determined */ + xassert(csa->phase == 1 || csa->phase == 2); + /* 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 */ + } + /* reset the reference space, if necessary */ + if (se != NULL && !se->valid) + spx_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); +#if CHECK_ACCURACY + /* check accuracy of current basic solution components (only for + * debugging) */ + check_accuracy(csa); +#endif + /* check if the iteration limit has been exhausted */ + if (csa->it_cnt - csa->it_beg >= csa->it_lim) + { if (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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); + if (msg_lev >= GLP_MSG_ALL) + xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED\n"); + csa->p_stat = (csa->phase == 2 ? GLP_FEAS : GLP_INFEAS); + csa->d_stat = GLP_UNDEF; /* will be set below */ + 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 (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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); + if (msg_lev >= GLP_MSG_ALL) + xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); + csa->p_stat = (csa->phase == 2 ? GLP_FEAS : GLP_INFEAS); + csa->d_stat = GLP_UNDEF; /* will be set below */ + ret = GLP_ETMLIM; + goto fini; + } + /* display the search progress */ + display(csa, 0); + /* select eligible non-basic variables */ + switch (csa->phase) + { case 1: + csa->num = spx_chuzc_sel(lp, d, 1e-8, 0.0, list); + break; + case 2: + csa->num = spx_chuzc_sel(lp, d, tol_dj, tol_dj1, list); + break; + default: + xassert(csa != csa); + } + /* check for optimality */ + if (csa->num == 0) + { if (perturb > 0 && csa->phase == 2) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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 primal feasibility */ + if (!check_feas(csa, 2, tol_bnd, tol_bnd1)) + { /* feasible solution found; switch to phase II */ + memcpy(c, csa->orig_c, (1+n) * sizeof(double)); + csa->phase = 2; + csa->d_st = 0; + goto loop; + } + /* no feasible solution exists */ +#if 1 /* 09/VII-2017 */ + /* FIXME: remove perturbation */ +#endif + if (msg_lev >= GLP_MSG_ALL) + xprintf("LP HAS NO PRIMAL FEASIBLE SOLUTION\n"); + csa->p_stat = GLP_NOFEAS; + csa->d_stat = GLP_UNDEF; /* will be set below */ + 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 xN[q] and xB[p] */ +#if 0 /* 23/VI-2017 */ +#if 0 /* 17/III-2016 */ + choose_pivot(csa); +#else + if (choose_pivot(csa) < 0) + { lp->valid = 0; + goto loop; + } +#endif +#else + ret = choose_pivot(csa); + if (ret < 0) + { lp->valid = 0; + goto loop; + } + if (ret == 0) + csa->ns_cnt++; + else + csa->ls_cnt++; +#endif + /* check for unboundedness */ + if (csa->p == 0) + { if (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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: primal simplex failed\n"); + csa->p_stat = csa->d_stat = GLP_UNDEF; + ret = GLP_EFAIL; + goto fini; + case 2: + /* primal unboundedness detected */ + if (msg_lev >= GLP_MSG_ALL) + xprintf("LP HAS UNBOUNDED PRIMAL SOLUTION\n"); + csa->p_stat = GLP_FEAS; + csa->d_stat = GLP_NOFEAS; + ret = 0; + goto fini; + default: + xassert(csa != csa); + } + } +#if 1 /* 01/VII-2017 */ + /* check for stalling */ + if (csa->p > 0) + { int k; + xassert(1 <= csa->p && csa->p <= m); + k = head[csa->p]; /* x[k] = xB[p] */ + if (lp->l[k] != lp->u[k]) + { if (csa->p_flag) + { /* xB[p] goes to its upper bound */ + xassert(lp->u[k] != +DBL_MAX); + if (fabs(beta[csa->p] - lp->u[k]) >= 1e-6) + { csa->degen = 0; + goto skip1; + } + } + else if (lp->l[k] == -DBL_MAX) + { /* unusual case */ + goto skip1; + } + else + { /* xB[p] goes to its lower bound */ + xassert(lp->l[k] != -DBL_MAX); + if (fabs(beta[csa->p] - lp->l[k]) >= 1e-6) + { csa->degen = 0; + goto skip1; + } + } + /* degenerate iteration has been detected */ + csa->degen++; + if (perturb < 0 && csa->degen >= 200) + { if (msg_lev >= GLP_MSG_ALL) + xprintf("Perturbing LP to avoid stalling [%d]...\n", + csa->it_cnt); + perturb = 1; + } +skip1: ; + } + } +#endif + /* update values of basic variables for adjacent basis */ +#if 0 /* 11/VI-2017 */ + spx_update_beta(lp, beta, csa->p, csa->p_flag, csa->q, tcol); +#else + spx_update_beta_s(lp, beta, csa->p, csa->p_flag, csa->q, + &csa->tcol); +#endif + csa->beta_st = 2; + /* p < 0 means that xN[q] jumps to its opposite bound */ + if (csa->p < 0) + goto skip; + /* xN[q] enters and xB[p] leaves the basis */ + /* compute p-th row of inv(B) */ + spx_eval_rho(lp, csa->p, rho); + /* compute p-th (pivot) row of the simplex table */ +#if 0 /* 11/VI-2017 */ + if (at != NULL) + spx_eval_trow1(lp, at, rho, trow); + else + spx_nt_prod(lp, nt, trow, 1, -1.0, rho); +#else + if (at != NULL) + spx_eval_trow1(lp, at, rho, csa->trow.vec); + else + spx_nt_prod(lp, nt, csa->trow.vec, 1, -1.0, rho); + fvs_gather_vec(&csa->trow, DBL_EPSILON); +#endif + /* FIXME: tcol[p] and trow[q] should be close to each other */ +#if 0 /* 26/V-2017 by cmatraki */ + xassert(trow[csa->q] != 0.0); +#else + if (csa->trow.vec[csa->q] == 0.0) + { if (msg_lev >= GLP_MSG_ERR) + xprintf("Error: trow[q] = 0.0\n"); + csa->p_stat = csa->d_stat = GLP_UNDEF; + ret = GLP_EFAIL; + goto fini; + } +#endif + /* update reduced costs of non-basic variables for adjacent + * basis */ +#if 1 /* 23/VI-2017 */ + /* dual solution may be invalidated due to long step */ + if (csa->d_st) +#endif +#if 0 /* 11/VI-2017 */ + if (spx_update_d(lp, d, csa->p, csa->q, trow, tcol) <= 1e-9) +#else + if (spx_update_d_s(lp, d, csa->p, csa->q, &csa->trow, &csa->tcol) + <= 1e-9) +#endif + { /* successful updating */ + csa->d_st = 2; + if (csa->phase == 1) + { /* adjust reduced cost of xN[q] in adjacent basis, since + * its penalty coefficient changes (see below) */ + d[csa->q] -= c[head[csa->p]]; + } + } + else + { /* new reduced costs are inaccurate */ + csa->d_st = 0; + } + if (csa->phase == 1) + { /* xB[p] leaves the basis replacing xN[q], so set its penalty + * coefficient to zero */ + c[head[csa->p]] = 0.0; + } + /* update steepest edge weights for adjacent basis, if used */ + if (se != NULL) + { if (refct > 0) +#if 0 /* 11/VI-2017 */ + { if (spx_update_gamma(lp, se, csa->p, csa->q, trow, tcol) + <= 1e-3) +#else /* FIXME: spx_update_gamma_s */ + { if (spx_update_gamma(lp, se, csa->p, csa->q, csa->trow.vec, + csa->tcol.vec) <= 1e-3) +#endif + { /* 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); +skip: /* change current basis header to adjacent one */ + spx_change_basis(lp, csa->p, csa->p_flag, csa->q); + /* and update factorization of the basis matrix */ + if (csa->p > 0) + spx_update_invb(lp, csa->p, head[csa->p]); +#if 1 + if (perturb <= 0) + { if (csa->phase == 1) + { int cnt; + /* adjust penalty function coefficients */ + cnt = adjust_penalty(csa, csa->tcol.nnz, csa->tcol.ind, + 0.99 * tol_bnd, 0.99 * tol_bnd1); + if (cnt) + { /* some coefficients were changed, so invalidate reduced + * costs of non-basic variables */ + /*xprintf("... cnt = %d\n", cnt);*/ + csa->d_st = 0; + } + } + } + else + { /* FIXME */ + play_bounds(csa, 0); + } +#endif + /* simplex iteration complete */ + csa->it_cnt++; + goto loop; +fini: /* restore original objective function */ + memcpy(c, csa->orig_c, (1+n) * sizeof(double)); + /* compute reduced costs of non-basic variables and determine + * solution dual status, if necessary */ + if (csa->p_stat != GLP_UNDEF && csa->d_stat == GLP_UNDEF) + { xassert(ret != GLP_EFAIL); + spx_eval_pi(lp, pi); + for (j = 1; j <= n-m; j++) + d[j] = spx_eval_dj(lp, pi, j); + csa->num = spx_chuzc_sel(lp, d, tol_dj, tol_dj1, NULL); + csa->d_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); + } + return ret; +} + +int spx_primal(glp_prob *P, const glp_smcp *parm) +{ /* driver to the primal simplex method */ + struct csa csa_, *csa = &csa_; + SPXLP lp; + SPXAT at; + SPXNT nt; + SPXSE se; + int ret, *map, *daeh; +#if SCALE_Z + int i, j, k; +#endif + /* build working LP and its initial basis */ + memset(csa, 0, sizeof(struct csa)); + csa->lp = &lp; + spx_init_lp(csa->lp, P, parm->excl); + spx_alloc_lp(csa->lp); + map = talloc(1+P->m+P->n, int); + spx_build_lp(csa->lp, P, parm->excl, parm->shift, map); + spx_build_basis(csa->lp, P, map); + switch (P->dir) + { case GLP_MIN: + csa->dir = +1; + break; + case GLP_MAX: + csa->dir = -1; + break; + default: + xassert(P != P); + } +#if SCALE_Z + csa->fz = 0.0; + for (k = 1; k <= csa->lp->n; k++) + { double t = fabs(csa->lp->c[k]); + if (csa->fz < t) + csa->fz = t; + } + if (csa->fz <= 1000.0) + csa->fz = 1.0; + else + csa->fz /= 1000.0; + /*xprintf("csa->fz = %g\n", csa->fz);*/ + for (k = 0; k <= csa->lp->n; k++) + csa->lp->c[k] /= csa->fz; +#endif + csa->orig_c = talloc(1+csa->lp->n, double); + memcpy(csa->orig_c, csa->lp->c, (1+csa->lp->n) * sizeof(double)); +#if 1 /*PERTURB*/ + csa->orig_l = talloc(1+csa->lp->n, double); + memcpy(csa->orig_l, csa->lp->l, (1+csa->lp->n) * sizeof(double)); + csa->orig_u = talloc(1+csa->lp->n, double); + memcpy(csa->orig_u, csa->lp->u, (1+csa->lp->n) * sizeof(double)); +#else + csa->orig_l = csa->orig_u = NULL; +#endif + switch (parm->aorn) + { case GLP_USE_AT: + /* build matrix A in row-wise format */ + csa->at = &at; + csa->nt = NULL; + spx_alloc_at(csa->lp, csa->at); + spx_build_at(csa->lp, csa->at); + break; + case GLP_USE_NT: + /* build matrix N in row-wise format for initial basis */ + csa->at = NULL; + csa->nt = &nt; + spx_alloc_nt(csa->lp, csa->nt); + spx_init_nt(csa->lp, csa->nt); + spx_build_nt(csa->lp, csa->nt); + break; + default: + xassert(parm != parm); + } + /* allocate and initialize working components */ + csa->phase = 0; + csa->beta = talloc(1+csa->lp->m, double); + csa->beta_st = 0; + csa->d = talloc(1+csa->lp->n-csa->lp->m, double); + csa->d_st = 0; + switch (parm->pricing) + { case GLP_PT_STD: + csa->se = NULL; + break; + case GLP_PT_PSE: + csa->se = &se; + spx_alloc_se(csa->lp, csa->se); + break; + default: + xassert(parm != parm); + } + csa->list = talloc(1+csa->lp->n-csa->lp->m, int); +#if 0 /* 11/VI-2017 */ + csa->tcol = talloc(1+csa->lp->m, double); + csa->trow = talloc(1+csa->lp->n-csa->lp->m, double); +#else + fvs_alloc_vec(&csa->tcol, csa->lp->m); + fvs_alloc_vec(&csa->trow, csa->lp->n-csa->lp->m); +#endif +#if 1 /* 23/VI-2017 */ + csa->bp = NULL; +#endif +#if 0 /* 09/VII-2017 */ + csa->work = talloc(1+csa->lp->m, double); +#else + fvs_alloc_vec(&csa->work, csa->lp->m); +#endif + /* initialize control parameters */ + csa->msg_lev = parm->msg_lev; +#if 0 /* 23/VI-2017 */ + switch (parm->r_test) + { case GLP_RT_STD: + csa->harris = 0; + break; + case GLP_RT_HAR: +#if 1 /* 16/III-2016 */ + case GLP_RT_FLIP: + /* FIXME */ + /* currently for primal simplex GLP_RT_FLIP is equivalent + * to GLP_RT_HAR */ +#endif + csa->harris = 1; + break; + default: + xassert(parm != parm); + } +#else + switch (parm->r_test) + { case GLP_RT_STD: + case GLP_RT_HAR: + break; + case GLP_RT_FLIP: + csa->bp = talloc(1+2*csa->lp->m+1, SPXBP); + break; + default: + xassert(parm != parm); + } + csa->r_test = parm->r_test; +#endif + csa->tol_bnd = parm->tol_bnd; + csa->tol_bnd1 = .001 * parm->tol_bnd; + csa->tol_dj = parm->tol_dj; + csa->tol_dj1 = .001 * parm->tol_dj; + csa->tol_piv = parm->tol_piv; + csa->it_lim = parm->it_lim; + csa->tm_lim = parm->tm_lim; + csa->out_frq = parm->out_frq; + csa->out_dly = parm->out_dly; + /* initialize working parameters */ + csa->tm_beg = xtime(); + csa->it_beg = csa->it_cnt = P->it_cnt; + csa->it_dpy = -1; +#if 1 /* 15/VII-2017 */ + csa->tm_dpy = 0.0; +#endif + csa->inv_cnt = 0; +#if 1 /* 01/VII-2017 */ + csa->degen = 0; +#endif +#if 1 /* 23/VI-2017 */ + csa->ns_cnt = csa->ls_cnt = 0; +#endif + /* try to solve working LP */ + ret = primal_simplex(csa); + /* return basis factorization back to problem object */ + P->valid = csa->lp->valid; + P->bfd = csa->lp->bfd; + /* set solution status */ + P->pbs_stat = csa->p_stat; + P->dbs_stat = csa->d_stat; + /* if the solver failed, do not store basis header and basic + * solution components to problem object */ + if (ret == GLP_EFAIL) + goto skip; + /* convert working LP basis to original LP basis and store it to + * problem object */ + daeh = talloc(1+csa->lp->n, int); + spx_store_basis(csa->lp, P, map, daeh); + /* compute simplex multipliers for final basic solution found by + * the solver */ +#if 0 /* 09/VII-2017 */ + spx_eval_pi(csa->lp, csa->work); +#else + spx_eval_pi(csa->lp, csa->work.vec); +#endif + /* convert working LP solution to original LP solution and store + * it into the problem object */ +#if SCALE_Z + for (i = 1; i <= csa->lp->m; i++) + csa->work.vec[i] *= csa->fz; + for (j = 1; j <= csa->lp->n-csa->lp->m; j++) + csa->d[j] *= csa->fz; +#endif +#if 0 /* 09/VII-2017 */ + spx_store_sol(csa->lp, P, SHIFT, map, daeh, csa->beta, csa->work, + csa->d); +#else + spx_store_sol(csa->lp, P, parm->shift, map, daeh, csa->beta, + csa->work.vec, csa->d); +#endif + tfree(daeh); + /* save simplex iteration count */ + P->it_cnt = csa->it_cnt; + /* report auxiliary/structural variable causing unboundedness */ + P->some = 0; + if (csa->p_stat == GLP_FEAS && csa->d_stat == GLP_NOFEAS) + { int k, kk; + /* xN[q] = x[k] causes unboundedness */ + xassert(1 <= csa->q && csa->q <= csa->lp->n - csa->lp->m); + k = csa->lp->head[csa->lp->m + csa->q]; + xassert(1 <= k && k <= csa->lp->n); + /* convert to number of original variable */ + for (kk = 1; kk <= P->m + P->n; kk++) + { if (abs(map[kk]) == k) + { P->some = kk; + break; + } + } + xassert(P->some != 0); + } +skip: /* deallocate working objects and arrays */ + spx_free_lp(csa->lp); + tfree(map); + tfree(csa->orig_c); +#if 1 /*PERTURB*/ + tfree(csa->orig_l); + tfree(csa->orig_u); +#endif + if (csa->at != NULL) + spx_free_at(csa->lp, csa->at); + if (csa->nt != NULL) + spx_free_nt(csa->lp, csa->nt); + tfree(csa->beta); + tfree(csa->d); + if (csa->se != NULL) + spx_free_se(csa->lp, csa->se); + tfree(csa->list); +#if 0 /* 11/VI-2017 */ + tfree(csa->tcol); + tfree(csa->trow); +#else + fvs_free_vec(&csa->tcol); + fvs_free_vec(&csa->trow); +#endif +#if 1 /* 23/VI-2017 */ + if (csa->bp != NULL) + tfree(csa->bp); +#endif +#if 0 /* 09/VII-2017 */ + tfree(csa->work); +#else + fvs_free_vec(&csa->work); +#endif + /* return to calling program */ + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxprob.c b/test/monniaux/glpk-4.65/src/simplex/spxprob.c new file mode 100644 index 00000000..4bebe2e7 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxprob.c @@ -0,0 +1,679 @@ +/* spxprob.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spxprob.h" + +/*********************************************************************** +* spx_init_lp - initialize working LP object +* +* This routine determines the number of equality constraints m, the +* number of variables n, and the number of non-zero elements nnz in +* the constraint matrix for the working LP, which corresponds to the +* original LP, and stores these dimensions to the working LP object. +* (The working LP object should be allocated by the calling routine.) +* +* If the flag excl is set, the routine assumes that non-basic fixed +* variables will be excluded from the working LP. */ + +void spx_init_lp(SPXLP *lp, glp_prob *P, int excl) +{ int i, j, m, n, nnz; + m = P->m; + xassert(m > 0); + n = 0; + nnz = P->nnz; + xassert(P->valid); + /* scan rows of original LP */ + for (i = 1; i <= m; i++) + { GLPROW *row = P->row[i]; + if (excl && row->stat == GLP_NS) + { /* skip non-basic fixed auxiliary variable */ + /* nop */ + } + else + { /* include auxiliary variable in working LP */ + n++; + nnz++; /* unity column */ + } + } + /* scan columns of original LP */ + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + if (excl && col->stat == GLP_NS) + { /* skip non-basic fixed structural variable */ + GLPAIJ *aij; + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + nnz--; + } + else + { /* include structural variable in working LP */ + n++; + } + } + /* initialize working LP data block */ + memset(lp, 0, sizeof(SPXLP)); + lp->m = m; + xassert(n > 0); + lp->n = n; + lp->nnz = nnz; + return; +} + +/*********************************************************************** +* spx_alloc_lp - allocate working LP arrays +* +* This routine allocates the memory for all arrays in the working LP +* object. */ + +void spx_alloc_lp(SPXLP *lp) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + lp->A_ptr = talloc(1+n+1, int); + lp->A_ind = talloc(1+nnz, int); + lp->A_val = talloc(1+nnz, double); + lp->b = talloc(1+m, double); + lp->c = talloc(1+n, double); + lp->l = talloc(1+n, double); + lp->u = talloc(1+n, double); + lp->head = talloc(1+n, int); + lp->flag = talloc(1+n-m, char); + return; +} + +/*********************************************************************** +* spx_build_lp - convert original LP to working LP +* +* This routine converts components (except the current basis) of the +* original LP to components of the working LP and perform scaling of +* these components. Also, if the original LP is maximization, the +* routine changes the signs of the objective coefficients and constant +* term to opposite ones. +* +* If the flag excl is set, original non-basic fixed variables are +* *not* included in the working LP. Otherwise, all (auxiliary and +* structural) original variables are included in the working LP. Note +* that this flag should have the same value as it has in a call to the +* routine spx_init_lp. +* +* If the flag shift is set, the routine shift bounds of variables +* included in the working LP to make at least one bound to be zero. +* If a variable has both lower and upper bounds, the bound having +* smaller magnitude is shifted to zero. +* +* On exit the routine stores information about correspondence between +* numbers of variables in the original and working LPs to the array +* map, which should have 1+P->m+P->n locations (location [0] is not +* used), where P->m is the numbers of rows and P->n is the number of +* columns in the original LP: +* +* map[i] = +k, 1 <= i <= P->m, means that i-th auxiliary variable of +* the original LP corresponds to variable x[k] of the working LP; +* +* map[i] = -k, 1 <= i <= P->m, means that i-th auxiliary variable of +* the original LP corresponds to variable x[k] of the working LP, and +* the upper bound of that variable was shifted to zero; +* +* map[i] = 0, 1 <= i <= P->m, means that i-th auxiliary variable of +* the original LP was excluded from the working LP; +* +* map[P->m+j], 1 <= j <= P->n, has the same sense as above, however, +* for j-th structural variable of the original LP. */ + +void spx_build_lp(SPXLP *lp, glp_prob *P, int excl, int shift, + int map[/*1+P->m+P->n*/]) +{ int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + int *A_ptr = lp->A_ptr; + int *A_ind = lp->A_ind; + double *A_val = lp->A_val; + double *b = lp->b; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int i, j, k, kk, ptr, end; + double dir, delta; + /* working LP is always minimization */ + switch (P->dir) + { case GLP_MIN: + dir = +1.0; + break; + case GLP_MAX: + dir = -1.0; + break; + default: + xassert(P != P); + } + /* initialize constant term of the objective */ + c[0] = dir * P->c0; + k = 0; /* number of variable in working LP */ + ptr = 1; /* current available position in A_ind/A_val */ + /* process rows of original LP */ + xassert(P->m == m); + for (i = 1; i <= m; i++) + { GLPROW *row = P->row[i]; + if (excl && row->stat == GLP_NS) + { /* i-th auxiliary variable is non-basic and fixed */ + /* substitute its scaled value in working LP */ + xassert(row->type == GLP_FX); + map[i] = 0; + b[i] = - row->lb * row->rii; + } + else + { /* include i-th auxiliary variable in working LP */ + map[i] = ++k; + /* setup k-th column of working constraint matrix which is + * i-th column of unity matrix */ + A_ptr[k] = ptr; + A_ind[ptr] = i; + A_val[ptr] = 1.0; + ptr++; + /* initialize right-hand side of i-th equality constraint + * and setup zero objective coefficient at variable x[k] */ + b[i] = c[k] = 0.0; + /* setup scaled bounds of variable x[k] */ + switch (row->type) + { case GLP_FR: + l[k] = -DBL_MAX, u[k] = +DBL_MAX; + break; + case GLP_LO: + l[k] = row->lb * row->rii, u[k] = +DBL_MAX; + break; + case GLP_UP: + l[k] = -DBL_MAX, u[k] = row->ub * row->rii; + break; + case GLP_DB: + l[k] = row->lb * row->rii, u[k] = row->ub * row->rii; + xassert(l[k] != u[k]); + break; + case GLP_FX: + l[k] = u[k] = row->lb * row->rii; + break; + default: + xassert(row != row); + } + } + } + /* process columns of original LP */ + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + GLPAIJ *aij; + if (excl && col->stat == GLP_NS) + { /* j-th structural variable is non-basic and fixed */ + /* substitute its scaled value in working LP */ + xassert(col->type == GLP_FX); + map[m+j] = 0; + if (col->lb != 0.0) + { /* (note that sjj scale factor is cancelled) */ + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + b[aij->row->i] += + (aij->row->rii * aij->val) * col->lb; + c[0] += (dir * col->coef) * col->lb; + } + } + else + { /* include j-th structural variable in working LP */ + map[m+j] = ++k; + /* setup k-th column of working constraint matrix which is + * scaled j-th column of original constraint matrix (-A) */ + A_ptr[k] = ptr; + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + { A_ind[ptr] = aij->row->i; + A_val[ptr] = - aij->row->rii * aij->val * col->sjj; + ptr++; + } + /* setup scaled objective coefficient at variable x[k] */ + c[k] = dir * col->coef * col->sjj; + /* setup scaled bounds of variable x[k] */ + switch (col->type) + { case GLP_FR: + l[k] = -DBL_MAX, u[k] = +DBL_MAX; + break; + case GLP_LO: + l[k] = col->lb / col->sjj, u[k] = +DBL_MAX; + break; + case GLP_UP: + l[k] = -DBL_MAX, u[k] = col->ub / col->sjj; + break; + case GLP_DB: + l[k] = col->lb / col->sjj, u[k] = col->ub / col->sjj; + xassert(l[k] != u[k]); + break; + case GLP_FX: + l[k] = u[k] = col->lb / col->sjj; + break; + default: + xassert(col != col); + } + } + } + xassert(k == n); + xassert(ptr == nnz+1); + A_ptr[n+1] = ptr; + /* shift bounds of all variables of working LP (optionally) */ + if (shift) + { for (kk = 1; kk <= m+P->n; kk++) + { k = map[kk]; + if (k == 0) + { /* corresponding original variable was excluded */ + continue; + } + /* shift bounds of variable x[k] */ + if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) + { /* x[k] is unbounded variable */ + delta = 0.0; + } + else if (l[k] != -DBL_MAX && u[k] == +DBL_MAX) + { /* shift lower bound to zero */ + delta = l[k]; + l[k] = 0.0; + } + else if (l[k] == -DBL_MAX && u[k] != +DBL_MAX) + { /* shift upper bound to zero */ + map[kk] = -k; + delta = u[k]; + u[k] = 0.0; + } + else if (l[k] != u[k]) + { /* x[k] is double bounded variable */ + if (fabs(l[k]) <= fabs(u[k])) + { /* shift lower bound to zero */ + delta = l[k]; + l[k] = 0.0, u[k] -= delta; + } + else + { /* shift upper bound to zero */ + map[kk] = -k; + delta = u[k]; + l[k] -= delta, u[k] = 0.0; + } + xassert(l[k] != u[k]); + } + else + { /* shift fixed value to zero */ + delta = l[k]; + l[k] = u[k] = 0.0; + } + /* substitute x[k] = x'[k] + delta into all constraints + * and the objective function of working LP */ + if (delta != 0.0) + { ptr = A_ptr[k]; + end = A_ptr[k+1]; + for (; ptr < end; ptr++) + b[A_ind[ptr]] -= A_val[ptr] * delta; + c[0] += c[k] * delta; + } + } + } + return; +} + +/*********************************************************************** +* spx_build_basis - convert original LP basis to working LP basis +* +* This routine converts the current basis of the original LP to +* corresponding initial basis of the working LP, and moves the basis +* factorization driver from the original LP object to the working LP +* object. +* +* The array map should contain information provided by the routine +* spx_build_lp. */ + +void spx_build_basis(SPXLP *lp, glp_prob *P, const int map[]) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *flag = lp->flag; + int i, j, k, ii, jj; + /* original basis factorization should be valid that guarantees + * the basis is correct */ + xassert(P->m == m); + xassert(P->valid); + /* initialize basis header for working LP */ + memset(&head[1], 0, m * sizeof(int)); + jj = 0; + /* scan rows of original LP */ + xassert(P->m == m); + for (i = 1; i <= m; i++) + { GLPROW *row = P->row[i]; + /* determine ordinal number of x[k] in working LP */ + if ((k = map[i]) < 0) + k = -k; + if (k == 0) + { /* corresponding original variable was excluded */ + continue; + } + xassert(1 <= k && k <= n); + if (row->stat == GLP_BS) + { /* x[k] is basic variable xB[ii] */ + ii = row->bind; + xassert(1 <= ii && ii <= m); + xassert(head[ii] == 0); + head[ii] = k; + } + else + { /* x[k] is non-basic variable xN[jj] */ + jj++; + head[m+jj] = k; + flag[jj] = (row->stat == GLP_NU); + } + } + /* scan columns of original LP */ + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + /* determine ordinal number of x[k] in working LP */ + if ((k = map[m+j]) < 0) + k = -k; + if (k == 0) + { /* corresponding original variable was excluded */ + continue; + } + xassert(1 <= k && k <= n); + if (col->stat == GLP_BS) + { /* x[k] is basic variable xB[ii] */ + ii = col->bind; + xassert(1 <= ii && ii <= m); + xassert(head[ii] == 0); + head[ii] = k; + } + else + { /* x[k] is non-basic variable xN[jj] */ + jj++; + head[m+jj] = k; + flag[jj] = (col->stat == GLP_NU); + } + } + xassert(m+jj == n); + /* acquire basis factorization */ + lp->valid = 1; + lp->bfd = P->bfd; + P->valid = 0; + P->bfd = NULL; + return; +} + +/*********************************************************************** +* spx_store_basis - convert working LP basis to original LP basis +* +* This routine converts the current working LP basis to corresponding +* original LP basis. This operations includes determining and setting +* statuses of all rows (auxiliary variables) and columns (structural +* variables), and building the basis header. +* +* The array map should contain information provided by the routine +* spx_build_lp. +* +* On exit the routine fills the array daeh. This array should have +* 1+lp->n locations (location [0] is not used) and contain the inverse +* of the working basis header lp->head, i.e. head[k'] = k means that +* daeh[k] = k'. */ + +void spx_store_basis(SPXLP *lp, glp_prob *P, const int map[], + int daeh[/*1+n*/]) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *flag = lp->flag; + int i, j, k, kk; + /* determine inverse of working basis header */ + for (kk = 1; kk <= n; kk++) + daeh[head[kk]] = kk; + /* set row statuses */ + xassert(P->m == m); + for (i = 1; i <= m; i++) + { GLPROW *row = P->row[i]; + if ((k = map[i]) < 0) + k = -k; + if (k == 0) + { /* non-basic fixed auxiliary variable was excluded */ + xassert(row->type == GLP_FX); + row->stat = GLP_NS; + row->bind = 0; + } + else + { /* auxiliary variable corresponds to variable x[k] */ + kk = daeh[k]; + if (kk <= m) + { /* x[k] = xB[kk] */ + P->head[kk] = i; + row->stat = GLP_BS; + row->bind = kk; + } + else + { /* x[k] = xN[kk-m] */ + switch (row->type) + { case GLP_FR: + row->stat = GLP_NF; + break; + case GLP_LO: + row->stat = GLP_NL; + break; + case GLP_UP: + row->stat = GLP_NU; + break; + case GLP_DB: + row->stat = (flag[kk-m] ? GLP_NU : GLP_NL); + break; + case GLP_FX: + row->stat = GLP_NS; + break; + default: + xassert(row != row); + } + row->bind = 0; + } + } + } + /* set column statuses */ + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + if ((k = map[m+j]) < 0) + k = -k; + if (k == 0) + { /* non-basic fixed structural variable was excluded */ + xassert(col->type == GLP_FX); + col->stat = GLP_NS; + col->bind = 0; + } + else + { /* structural variable corresponds to variable x[k] */ + kk = daeh[k]; + if (kk <= m) + { /* x[k] = xB[kk] */ + P->head[kk] = m+j; + col->stat = GLP_BS; + col->bind = kk; + } + else + { /* x[k] = xN[kk-m] */ + switch (col->type) + { case GLP_FR: + col->stat = GLP_NF; + break; + case GLP_LO: + col->stat = GLP_NL; + break; + case GLP_UP: + col->stat = GLP_NU; + break; + case GLP_DB: + col->stat = (flag[kk-m] ? GLP_NU : GLP_NL); + break; + case GLP_FX: + col->stat = GLP_NS; + break; + default: + xassert(col != col); + } + col->bind = 0; + } + } + } + return; +} + +/*********************************************************************** +* spx_store_sol - convert working LP solution to original LP solution +* +* This routine converts the current basic solution of the working LP +* (values of basic variables, simplex multipliers, reduced costs of +* non-basic variables) to corresponding basic solution of the original +* LP (values and reduced costs of auxiliary and structural variables). +* This conversion includes unscaling all basic solution components, +* computing reduced costs of excluded non-basic variables, recovering +* unshifted values of basic variables, changing the signs of reduced +* costs (if the original LP is maximization), and computing the value +* of the objective function. +* +* The flag shift should have the same value as it has in a call to the +* routine spx_build_lp. +* +* The array map should contain information provided by the routine +* spx_build_lp. +* +* The array daeh should contain information provided by the routine +* spx_store_basis. +* +* The arrays beta, pi, and d should contain basic solution components +* for the working LP: +* +* array locations beta[1], ..., beta[m] should contain values of basic +* variables beta = (beta[i]); +* +* array locations pi[1], ..., pi[m] should contain simplex multipliers +* pi = (pi[i]); +* +* array locations d[1], ..., d[n-m] should contain reduced costs of +* non-basic variables d = (d[j]). */ + +void spx_store_sol(SPXLP *lp, glp_prob *P, int shift, + const int map[], const int daeh[], const double beta[], + const double pi[], const double d[]) +{ int m = lp->m; + char *flag = lp->flag; + int i, j, k, kk; + double dir; + /* working LP is always minimization */ + switch (P->dir) + { case GLP_MIN: + dir = +1.0; + break; + case GLP_MAX: + dir = -1.0; + break; + default: + xassert(P != P); + } + /* compute row solution components */ + xassert(P->m == m); + for (i = 1; i <= m; i++) + { GLPROW *row = P->row[i]; + if ((k = map[i]) < 0) + k = -k; + if (k == 0) + { /* non-basic fixed auxiliary variable was excluded */ + xassert(row->type == GLP_FX); + row->prim = row->lb; + /* compute reduced cost d[k] = c[k] - A'[k] * pi as if x[k] + * would be non-basic in working LP */ + row->dual = - dir * pi[i] * row->rii; + } + else + { /* auxiliary variable corresponds to variable x[k] */ + kk = daeh[k]; + if (kk <= m) + { /* x[k] = xB[kk] */ + row->prim = beta[kk] / row->rii; + if (shift) + row->prim += (map[i] < 0 ? row->ub : row->lb); + row->dual = 0.0; + } + else + { /* x[k] = xN[kk-m] */ + row->prim = (flag[kk-m] ? row->ub : row->lb); + row->dual = (dir * d[kk-m]) * row->rii; + } + } + } + /* compute column solution components and objective value */ + P->obj_val = P->c0; + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + if ((k = map[m+j]) < 0) + k = -k; + if (k == 0) + { /* non-basic fixed structural variable was excluded */ + GLPAIJ *aij; + double dk; + xassert(col->type == GLP_FX); + col->prim = col->lb; + /* compute reduced cost d[k] = c[k] - A'[k] * pi as if x[k] + * would be non-basic in working LP */ + /* (note that sjj scale factor is cancelled) */ + dk = dir * col->coef; + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + dk += (aij->row->rii * aij->val) * pi[aij->row->i]; + col->dual = dir * dk; + } + else + { /* structural variable corresponds to variable x[k] */ + kk = daeh[k]; + if (kk <= m) + { /* x[k] = xB[kk] */ + col->prim = beta[kk] * col->sjj; + if (shift) + col->prim += (map[m+j] < 0 ? col->ub : col->lb); + col->dual = 0.0; + } + else + { /* x[k] = xN[kk-m] */ + col->prim = (flag[kk-m] ? col->ub : col->lb); + col->dual = (dir * d[kk-m]) / col->sjj; + } + } + P->obj_val += col->coef * col->prim; + } + return; +} + +/*********************************************************************** +* spx_free_lp - deallocate working LP arrays +* +* This routine deallocates the memory used for arrays of the working +* LP object. */ + +void spx_free_lp(SPXLP *lp) +{ tfree(lp->A_ptr); + tfree(lp->A_ind); + tfree(lp->A_val); + tfree(lp->b); + tfree(lp->c); + tfree(lp->l); + tfree(lp->u); + tfree(lp->head); + tfree(lp->flag); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spxprob.h b/test/monniaux/glpk-4.65/src/simplex/spxprob.h new file mode 100644 index 00000000..b7d87fa7 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spxprob.h @@ -0,0 +1,64 @@ +/* spxprob.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPXPROB_H +#define SPXPROB_H + +#include "prob.h" +#include "spxlp.h" + +#define spx_init_lp _glp_spx_init_lp +void spx_init_lp(SPXLP *lp, glp_prob *P, int excl); +/* initialize working LP object */ + +#define spx_alloc_lp _glp_spx_alloc_lp +void spx_alloc_lp(SPXLP *lp); +/* allocate working LP arrays */ + +#define spx_build_lp _glp_spx_build_lp +void spx_build_lp(SPXLP *lp, glp_prob *P, int excl, int shift, + int map[/*1+P->m+P->n*/]); +/* convert original LP to working LP */ + +#define spx_build_basis _glp_spx_build_basis +void spx_build_basis(SPXLP *lp, glp_prob *P, const int map[]); +/* convert original LP basis to working LP basis */ + +#define spx_store_basis _glp_spx_store_basis +void spx_store_basis(SPXLP *lp, glp_prob *P, const int map[], + int daeh[/*1+n*/]); +/* convert working LP basis to original LP basis */ + +#define spx_store_sol _glp_spx_store_sol +void spx_store_sol(SPXLP *lp, glp_prob *P, int shift, + const int map[], const int daeh[], const double beta[], + const double pi[], const double d[]); +/* convert working LP solution to original LP solution */ + +#define spx_free_lp _glp_spx_free_lp +void spx_free_lp(SPXLP *lp); +/* deallocate working LP arrays */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spychuzc.c b/test/monniaux/glpk-4.65/src/simplex/spychuzc.c new file mode 100644 index 00000000..b9221298 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spychuzc.c @@ -0,0 +1,567 @@ +/* spychuzc.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015-2018 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spychuzc.h" + +/*********************************************************************** +* spy_chuzc_std - choose non-basic variable (dual textbook ratio test) +* +* This routine implements an improved dual textbook ratio test to +* choose non-basic variable xN[q]. +* +* Current reduced costs of non-basic variables should be placed in the +* array locations d[1], ..., d[n-m]. Note that d[j] is a value of dual +* basic variable lambdaN[j] in the current basis. +* +#if 0 (* 14/III-2016 *) +* The parameter s specifies the sign of bound violation for basic +* variable xB[p] chosen: s = +1.0 means that xB[p] violates its lower +* bound, so dual non-basic variable lambdaB[p] = lambda^+B[p] +* increases, and s = -1.0 means that xB[p] violates its upper bound, +* so dual non-basic variable lambdaB[p] = lambda^-B[p] decreases. +* (Thus, the dual ray parameter theta = s * lambdaB[p] >= 0.) +#else +* The parameter r specifies the bound violation for basic variable +* xB[p] chosen: +* +* r = lB[p] - beta[p] > 0 means that xB[p] violates its lower bound, +* so dual non-basic variable lambdaB[p] = lambda^+B[p] increases; and +* +* r = uB[p] - beta[p] < 0 means that xB[p] violates its upper bound, +* so dual non-basic variable lambdaB[p] = lambda^-B[p] decreases. +* +* (Note that r is the dual reduced cost of lambdaB[p].) +#endif +* +* Elements of p-th simplex table row t[p] = (t[p,j]) corresponding +* to basic variable xB[p] should be placed in the array locations +* trow[1], ..., trow[n-m]. +* +* The parameter tol_piv specifies a tolerance for elements of the +* simplex table row t[p]. If |t[p,j]| < tol_piv, dual basic variable +* lambdaN[j] is skipped, i.e. it is assumed that it does not depend on +* the dual ray parameter theta. +* +* The parameters tol and tol1 specify tolerances used to increase the +* choice freedom by simulating an artificial degeneracy as follows. +* If lambdaN[j] = lambda^+N[j] >= 0 and d[j] <= +delta[j], or if +* lambdaN[j] = lambda^-N[j] <= 0 and d[j] >= -delta[j], where +* delta[j] = tol + tol1 * |cN[j]|, cN[j] is objective coefficient at +* xN[j], then it is assumed that reduced cost d[j] is equal to zero. +* +* The routine determines the index 1 <= q <= n-m of non-basic variable +* xN[q], for which corresponding dual basic variable lambda^+N[j] or +* lambda^-N[j] reaches its zero bound first on increasing the dual ray +* parameter theta, and returns p on exit. And if theta may increase +* unlimitedly, the routine returns zero. */ + +int spy_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], +#if 0 /* 14/III-2016 */ + double s, const double trow[/*1+n-m*/], double tol_piv, +#else + double r, const double trow[/*1+n-m*/], double tol_piv, +#endif + double tol, double tol1) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, k, q; + double alfa, biga, delta, teta, teta_min; +#if 0 /* 14/III-2016 */ + xassert(s == +1.0 || s == -1.0); +#else + double s; + xassert(r != 0.0); + s = (r > 0.0 ? +1.0 : -1.0); +#endif + /* nothing is chosen so far */ + q = 0, teta_min = DBL_MAX, biga = 0.0; + /* walk thru the list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* if xN[j] is fixed variable, skip it */ + if (l[k] == u[k]) + continue; + alfa = s * trow[j]; + if (alfa >= +tol_piv && !flag[j]) + { /* xN[j] is either free or has its lower bound active, so + * lambdaN[j] = d[j] >= 0 decreases down to zero */ + delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); + /* determine theta on which lambdaN[j] reaches zero */ + teta = (d[j] < +delta ? 0.0 : d[j] / alfa); + } + else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) + { /* xN[j] is either free or has its upper bound active, so + * lambdaN[j] = d[j] <= 0 increases up to zero */ + delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); + /* determine theta on which lambdaN[j] reaches zero */ + teta = (d[j] > -delta ? 0.0 : d[j] / alfa); + } + else + { /* lambdaN[j] cannot reach zero on increasing theta */ + continue; + } + /* choose non-basic variable xN[q] by corresponding dual basic + * variable lambdaN[q] for which theta is minimal */ + xassert(teta >= 0.0); + alfa = (alfa >= 0.0 ? +alfa : -alfa); + if (teta_min > teta || (teta_min == teta && biga < alfa)) + q = j, teta_min = teta, biga = alfa; + } + return q; +} + +/*********************************************************************** +* spy_chuzc_harris - choose non-basic var. (dual Harris' ratio test) +* +* This routine implements dual Harris' ratio test to choose non-basic +* variable xN[q]. +* +* All the parameters, except tol and tol1, as well as the returned +* value have the same meaning as for the routine spx_chuzr_std (see +* above). +* +* The parameters tol and tol1 specify tolerances on zero bound +* violations for reduced costs of non-basic variables. For reduced +* cost d[j] the tolerance is delta[j] = tol + tol1 |cN[j]|, where +* cN[j] is objective coefficient at non-basic variable xN[j]. */ + +int spy_chuzc_harris(SPXLP *lp, const double d[/*1+n-m*/], +#if 0 /* 14/III-2016 */ + double s, const double trow[/*1+n-m*/], double tol_piv, +#else + double r, const double trow[/*1+n-m*/], double tol_piv, +#endif + double tol, double tol1) +{ int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, k, q; + double alfa, biga, delta, teta, teta_min; +#if 0 /* 14/III-2016 */ + xassert(s == +1.0 || s == -1.0); +#else + double s; + xassert(r != 0.0); + s = (r > 0.0 ? +1.0 : -1.0); +#endif + /*--------------------------------------------------------------*/ + /* first pass: determine teta_min for relaxed bounds */ + /*--------------------------------------------------------------*/ + teta_min = DBL_MAX; + /* walk thru the list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* if xN[j] is fixed variable, skip it */ + if (l[k] == u[k]) + continue; + alfa = s * trow[j]; + if (alfa >= +tol_piv && !flag[j]) + { /* xN[j] is either free or has its lower bound active, so + * lambdaN[j] = d[j] >= 0 decreases down to zero */ + delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); + /* determine theta on which lambdaN[j] reaches -delta */ + teta = ((d[j] < 0.0 ? 0.0 : d[j]) + delta) / alfa; + } + else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) + { /* xN[j] is either free or has its upper bound active, so + * lambdaN[j] = d[j] <= 0 increases up to zero */ + delta = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); + /* determine theta on which lambdaN[j] reaches +delta */ + teta = ((d[j] > 0.0 ? 0.0 : d[j]) - delta) / alfa; + } + else + { /* lambdaN[j] cannot reach zero on increasing theta */ + continue; + } + xassert(teta >= 0.0); + if (teta_min > teta) + teta_min = teta; + } + /*--------------------------------------------------------------*/ + /* second pass: choose non-basic variable xN[q] */ + /*--------------------------------------------------------------*/ + if (teta_min == DBL_MAX) + { /* theta may increase unlimitedly */ + q = 0; + goto done; + } + /* nothing is chosen so far */ + q = 0, biga = 0.0; + /* walk thru the list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* if xN[j] is fixed variable, skip it */ + if (l[k] == u[k]) + continue; + alfa = s * trow[j]; + if (alfa >= +tol_piv && !flag[j]) + { /* xN[j] is either free or has its lower bound active, so + * lambdaN[j] = d[j] >= 0 decreases down to zero */ + /* determine theta on which lambdaN[j] reaches zero */ + teta = d[j] / alfa; + } + else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) + { /* xN[j] is either free or has its upper bound active, so + * lambdaN[j] = d[j] <= 0 increases up to zero */ + /* determine theta on which lambdaN[j] reaches zero */ + teta = d[j] / alfa; + } + else + { /* lambdaN[j] cannot reach zero on increasing theta */ + continue; + } + /* choose non-basic variable for which theta is not greater + * than theta_min determined for relaxed bounds and which has + * best (largest in magnitude) pivot */ + alfa = (alfa >= 0.0 ? +alfa : -alfa); + if (teta <= teta_min && biga < alfa) + q = j, biga = alfa; + } + /* something must be chosen */ + xassert(1 <= q && q <= n-m); +done: return q; +} + +#if 0 /* 23/III-2016 */ +/*********************************************************************** +* spy_eval_bp - determine dual objective function break-points +* +* This routine determines the dual objective function break-points. +* +* The parameters lp, d, r, trow, and tol_piv have the same meaning as +* for the routine spx_chuzc_std (see above). +* +* On exit the routine stores the break-points determined to the array +* elements bp[1], ..., bp[num], where 0 <= num <= n-m is the number of +* break-points returned by the routine. +* +* The break-points stored in the array bp are ordered by ascending +* the ray parameter teta >= 0. The break-points numbered 1, ..., num-1 +* always correspond to non-basic non-fixed variables xN[j] of primal +* LP having both lower and upper bounds while the last break-point +* numbered num may correspond to a non-basic variable having only one +* lower or upper bound, if such variable prevents further increasing +* of the ray parameter teta. Besides, the routine includes in the +* array bp only the break-points that correspond to positive increment +* of the dual objective. */ + +static int CDECL fcmp(const void *v1, const void *v2) +{ const SPYBP *p1 = v1, *p2 = v2; + if (p1->teta < p2->teta) + return -1; + else if (p1->teta > p2->teta) + return +1; + else + return 0; +} + +int spy_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], + double r, const double trow[/*1+n-m*/], double tol_piv, + SPYBP bp[/*1+n-m*/]) +{ int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, j_max, k, t, nnn, num; + double s, alfa, teta, teta_max, dz, v; + xassert(r != 0.0); + s = (r > 0.0 ? +1.0 : -1.0); + /* build the list of all dual basic variables lambdaN[j] that + * can reach zero on increasing the ray parameter teta >= 0 */ + num = 0; + /* walk thru the list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* if xN[j] is fixed variable, skip it */ + if (l[k] == u[k]) + continue; + alfa = s * trow[j]; + if (alfa >= +tol_piv && !flag[j]) + { /* xN[j] is either free or has its lower bound active, so + * lambdaN[j] = d[j] >= 0 decreases down to zero */ + /* determine teta[j] on which lambdaN[j] reaches zero */ + teta = (d[j] < 0.0 ? 0.0 : d[j] / alfa); + } + else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) + { /* xN[j] is either free or has its upper bound active, so + * lambdaN[j] = d[j] <= 0 increases up to zero */ + /* determine teta[j] on which lambdaN[j] reaches zero */ + teta = (d[j] > 0.0 ? 0.0 : d[j] / alfa); + } + else + { /* lambdaN[j] cannot reach zero on increasing teta */ + continue; + } + /* add lambdaN[j] to the list */ + num++; + bp[num].j = j; + bp[num].teta = teta; + } + if (num == 0) + { /* dual unboundedness */ + goto done; + } + /* determine "blocking" dual basic variable lambdaN[j_max] that + * prevents increasing teta more than teta_max */ + j_max = 0, teta_max = DBL_MAX; + for (t = 1; t <= num; t++) + { j = bp[t].j; + k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == -DBL_MAX || u[k] == +DBL_MAX) + { /* lambdaN[j] cannot intersect zero */ + if (j_max == 0 + || teta_max > bp[t].teta + || (teta_max == bp[t].teta + && fabs(trow[j_max]) < fabs(trow[j]))) + j_max = j, teta_max = bp[t].teta; + } + } + /* keep in the list only dual basic variables lambdaN[j] that + * correspond to primal double-bounded variables xN[j] and whose + * teta[j] is not greater than teta_max */ + nnn = 0; + for (t = 1; t <= num; t++) + { j = bp[t].j; + k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] != -DBL_MAX && u[k] != +DBL_MAX + && bp[t].teta <= teta_max) + { nnn++; + bp[nnn].j = j; + bp[nnn].teta = bp[t].teta; + } + } + num = nnn; + /* sort break-points by ascending teta[j] */ + qsort(&bp[1], num, sizeof(SPYBP), fcmp); + /* add lambdaN[j_max] to the end of the list */ + if (j_max != 0) + { xassert(num < n-m); + num++; + bp[num].j = j_max; + bp[num].teta = teta_max; + } + /* compute increments of the dual objective at all break-points + * (relative to its value at teta = 0) */ + dz = 0.0; /* dual objective increment */ + v = fabs(r); /* dual objective slope d zeta / d teta */ + for (t = 1; t <= num; t++) + { /* compute increment at current break-point */ + dz += v * (bp[t].teta - (t == 1 ? 0.0 : bp[t-1].teta)); + if (dz < 0.001) + { /* break-point with non-positive increment reached */ + num = t - 1; + break; + } + bp[t].dz = dz; + /* compute next slope on the right to current break-point */ + if (t < num) + { j = bp[t].j; + k = head[m+j]; /* x[k] = xN[j] */ + xassert(-DBL_MAX < l[k] && l[k] < u[k] && u[k] < +DBL_MAX); + v -= fabs(trow[j]) * (u[k] - l[k]); + } + } +done: return num; +} +#endif + +/*********************************************************************** +* spy_ls_eval_bp - determine dual objective function break-points +* +* This routine determines the dual objective function break-points. +* +* The parameters lp, d, r, trow, and tol_piv have the same meaning as +* for the routine spx_chuzc_std (see above). +* +* The routine stores the break-points determined to the array elements +* bp[1], ..., bp[nbp] in *arbitrary* order, where 0 <= nbp <= n-m is +* the number of break-points returned by the routine on exit. */ + +int spy_ls_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], + double r, const double trow[/*1+n-m*/], double tol_piv, + SPYBP bp[/*1+n-m*/]) +{ int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, k, t, nnn, nbp; + double s, alfa, teta, teta_max; + xassert(r != 0.0); + s = (r > 0.0 ? +1.0 : -1.0); + /* build the list of all dual basic variables lambdaN[j] that + * can reach zero on increasing the ray parameter teta >= 0 */ + nnn = 0, teta_max = DBL_MAX; + /* walk thru the list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + /* if xN[j] is fixed variable, skip it */ + if (l[k] == u[k]) + continue; + alfa = s * trow[j]; + if (alfa >= +tol_piv && !flag[j]) + { /* xN[j] is either free or has its lower bound active, so + * lambdaN[j] = d[j] >= 0 decreases down to zero */ + /* determine teta[j] on which lambdaN[j] reaches zero */ + teta = (d[j] < 0.0 ? 0.0 : d[j] / alfa); + /* if xN[j] has no upper bound, lambdaN[j] cannot become + * negative and thereby blocks further increasing teta */ + if (u[k] == +DBL_MAX && teta_max > teta) + teta_max = teta; + } + else if (alfa <= -tol_piv && (l[k] == -DBL_MAX || flag[j])) + { /* xN[j] is either free or has its upper bound active, so + * lambdaN[j] = d[j] <= 0 increases up to zero */ + /* determine teta[j] on which lambdaN[j] reaches zero */ + teta = (d[j] > 0.0 ? 0.0 : d[j] / alfa); + /* if xN[j] has no lower bound, lambdaN[j] cannot become + * positive and thereby blocks further increasing teta */ + if (l[k] == -DBL_MAX && teta_max > teta) + teta_max = teta; + } + else + { /* lambdaN[j] cannot reach zero on increasing teta */ + continue; + } + /* add lambdaN[j] to the list */ + nnn++; + bp[nnn].j = j; + bp[nnn].teta = teta; + } + /* remove from the list all dual basic variables lambdaN[j], for + * which teta[j] > teta_max */ + nbp = 0; + for (t = 1; t <= nnn; t++) + { if (bp[t].teta <= teta_max + 1e-6) + { nbp++; + bp[nbp].j = bp[t].j; + bp[nbp].teta = bp[t].teta; + } + } + return nbp; +} + +/*********************************************************************** +* spy_ls_select_bp - select and process dual objective break-points +* +* This routine selects a next portion of the dual objective function +* break-points and processes them. +* +* On entry to the routine it is assumed that break-points bp[1], ..., +* bp[num] are already processed, and slope is the dual objective slope +* to the right of the last processed break-point bp[num]. (Initially, +* when num = 0, slope should be specified as fabs(r), where r has the +* same meaning as above.) +* +* The routine selects break-points among bp[num+1], ..., bp[nbp], for +* which teta <= teta_lim, and moves these break-points to the array +* elements bp[num+1], ..., bp[num1], where num <= num1 <= n-m is the +* new number of processed break-points returned by the routine on +* exit. Then the routine sorts these break-points by ascending teta +* and computes the change of the dual objective function relative to +* its value at teta = 0. +* +* On exit the routine also replaces the parameter slope with a new +* value that corresponds to the new last break-point bp[num1]. */ + +static int CDECL fcmp(const void *v1, const void *v2) +{ const SPYBP *p1 = v1, *p2 = v2; + if (p1->teta < p2->teta) + return -1; + else if (p1->teta > p2->teta) + return +1; + else + return 0; +} + +int spy_ls_select_bp(SPXLP *lp, const double trow[/*1+n-m*/], + int nbp, SPYBP bp[/*1+n-m*/], int num, double *slope, double + teta_lim) +{ int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int j, k, t, num1; + double teta, dz; + xassert(0 <= num && num <= nbp && nbp <= n-m); + /* select a new portion of break-points */ + num1 = num; + for (t = num+1; t <= nbp; t++) + { if (bp[t].teta <= teta_lim) + { /* move break-point to the beginning of the new portion */ + num1++; + j = bp[num1].j, teta = bp[num1].teta; + bp[num1].j = bp[t].j, bp[num1].teta = bp[t].teta; + bp[t].j = j, bp[t].teta = teta; + } + } + /* sort new break-points bp[num+1], ..., bp[num1] by ascending + * the ray parameter teta */ + if (num1 - num > 1) + qsort(&bp[num+1], num1 - num, sizeof(SPYBP), fcmp); + /* calculate the dual objective change at the new break-points */ + for (t = num+1; t <= num1; t++) + { /* calculate the dual objective change relative to its value + * at break-point bp[t-1] */ + if (*slope == -DBL_MAX) + dz = -DBL_MAX; + else + dz = (*slope) * + (bp[t].teta - (t == 1 ? 0.0 : bp[t-1].teta)); + /* calculate the dual objective change relative to its value + * at teta = 0 */ + if (dz == -DBL_MAX) + bp[t].dz = -DBL_MAX; + else + bp[t].dz = (t == 1 ? 0.0 : bp[t-1].dz) + dz; + /* calculate a new slope of the dual objective to the right of + * the current break-point bp[t] */ + if (*slope != -DBL_MAX) + { j = bp[t].j; + k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == -DBL_MAX || u[k] == +DBL_MAX) + *slope = -DBL_MAX; /* blocking break-point reached */ + else + { xassert(l[k] < u[k]); + *slope -= fabs(trow[j]) * (u[k] - l[k]); + } + } + } + return num1; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spychuzc.h b/test/monniaux/glpk-4.65/src/simplex/spychuzc.h new file mode 100644 index 00000000..8aa45a07 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spychuzc.h @@ -0,0 +1,85 @@ +/* spychuzc.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015-2016 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPYCHUZC_H +#define SPYCHUZC_H + +#include "spxlp.h" + +#define spy_chuzc_std _glp_spy_chuzc_std +int spy_chuzc_std(SPXLP *lp, const double d[/*1+n-m*/], +#if 0 /* 14/III-2016 */ + double s, const double trow[/*1+n-m*/], double tol_piv, +#else + double r, const double trow[/*1+n-m*/], double tol_piv, +#endif + double tol, double tol1); +/* choose non-basic variable (dual textbook ratio test) */ + +#define spy_chuzc_harris _glp_spy_chuzc_harris +int spy_chuzc_harris(SPXLP *lp, const double d[/*1+n-m*/], +#if 0 /* 14/III-2016 */ + double s, const double trow[/*1+n-m*/], double tol_piv, +#else + double r, const double trow[/*1+n-m*/], double tol_piv, +#endif + double tol, double tol1); +/* choose non-basic variable (dual Harris' ratio test) */ + +typedef struct SPYBP SPYBP; + +struct SPYBP +{ /* dual objective function break point */ + int j; + /* dual basic variable lambdaN[j], 1 <= j <= n-m, that intersects + * zero at this break point */ + double teta; + /* ray parameter value, teta[j] >= 0, at this break point */ + double dz; + /* increment, zeta[j] - zeta[0], of the dual objective function + * at this break point */ +}; + +#if 0 /* 23/III-2016 */ +#define spy_eval_bp _glp_spy_eval_bp +int spy_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], + double r, const double trow[/*1+n-m*/], double tol_piv, + SPYBP bp[/*1+n-m*/]); +/* determine dual objective function break-points */ +#endif + +#define spy_ls_eval_bp _glp_spy_ls_eval_bp +int spy_ls_eval_bp(SPXLP *lp, const double d[/*1+n-m*/], + double r, const double trow[/*1+n-m*/], double tol_piv, + SPYBP bp[/*1+n-m*/]); +/* determine dual objective function break-points */ + +#define spy_ls_select_bp _glp_spy_ls_select_bp +int spy_ls_select_bp(SPXLP *lp, const double trow[/*1+n-m*/], + int nbp, SPYBP bp[/*1+n-m*/], int num, double *slope, double + teta_lim); +/* select and process dual objective break-points */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spychuzr.c b/test/monniaux/glpk-4.65/src/simplex/spychuzr.c new file mode 100644 index 00000000..63079c17 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spychuzr.c @@ -0,0 +1,483 @@ +/* spychuzr.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#include "env.h" +#include "spychuzr.h" + +/*********************************************************************** +* spy_chuzr_sel - select eligible basic variables +* +* This routine selects eligible basic variables xB[i], whose value +* beta[i] violates corresponding lower lB[i] or upper uB[i] bound. +* Positive bound violation rp[i] = lb[i] - beta[i] > 0 is the reduced +* cost of non-basic dual variable lambda^+B[i] >= 0, so increasing it +* increases the dual objective. Similarly, negative bound violation +* rn[i] = ub[i] - beta[i] < 0 is the reduced cost of non-basic dual +* variable lambda^-B[i] <= 0, so decreasing it also increases the dual +* objective. +* +* Current values of basic variables should be placed in the array +* locations beta[1], ..., beta[m]. +* +* Basic variable xB[i] is considered eligible, if: +* +* beta[i] <= lB[i] - eps1[i], or +* +* beta[i] >= uB[i] + eps2[i], +* +* for +* +* eps1[i] = tol + tol1 * |lB[i]|, +* +* eps2[i] = tol + tol2 * |uB[i]|, +* +* where lB[i] and uB[i] are, resp., lower and upper bounds of xB[i], +* tol and tol1 are specified tolerances. +* +* On exit the routine stores indices i of eligible basic variables +* xB[i] to the array locations list[1], ..., list[num] and returns the +* number of such variables 0 <= num <= m. (If the parameter list is +* specified as NULL, no indices are stored.) */ + +int spy_chuzr_sel(SPXLP *lp, const double beta[/*1+m*/], double tol, + double tol1, int list[/*1+m*/]) +{ int m = lp->m; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int i, k, num; + double lk, uk, eps; + num = 0; + /* walk thru list of basic variables */ + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + lk = l[k], uk = u[k]; + /* check if xB[i] is eligible */ + if (beta[i] < lk) + { /* determine absolute tolerance eps1[i] */ + eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] < lk - eps) + { /* lower bound is violated */ + num++; + if (list != NULL) + list[num] = i; + } + } + else if (beta[i] > uk) + { /* determine absolute tolerance eps2[i] */ + eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] > uk + eps) + { /* upper bound is violated */ + num++; + if (list != NULL) + list[num] = i; + } + } + } + return num; +} + +/*********************************************************************** +* spy_chuzr_std - choose basic variable (dual Dantzig's rule) +* +* This routine chooses most eligible basic variable xB[p] according +* to dual Dantzig's ("standard") rule: +* +* r[p] = max |r[i]|, +* i in I +* +* ( lB[i] - beta[i], if beta[i] < lB[i] +* ( +* r[i] = { 0, if lB[i] <= beta[i] <= uB[i] +* ( +* ( uB[i] - beta[i], if beta[i] > uB[i] +* +* where I <= {1, ..., m} is the set of indices of eligible basic +* variables, beta[i] is current value of xB[i], lB[i] and uB[i] are, +* resp., lower and upper bounds of xB[i], r[i] is bound violation. +* +* Current values of basic variables should be placed in the array +* locations beta[1], ..., beta[m]. +* +* Indices of eligible basic variables i in I should be placed in the +* array locations list[1], ..., list[num], where num = |J| > 0 is the +* total number of such variables. +* +* On exit the routine returns p, the index of the basic variable xB[p] +* chosen. */ + +int spy_chuzr_std(SPXLP *lp, const double beta[/*1+m*/], int num, + const int list[]) +{ int m = lp->m; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int i, k, p, t; + double abs_ri, abs_rp; + xassert(0 < num && num <= m); + p = 0, abs_rp = -1.0; + for (t = 1; t <= num; t++) + { i = list[t]; + k = head[i]; /* x[k] = xB[i] */ + if (beta[i] < l[k]) + abs_ri = l[k] - beta[i]; + else if (beta[i] > u[k]) + abs_ri = beta[i] - u[k]; + else + xassert(t != t); + if (abs_rp < abs_ri) + p = i, abs_rp = abs_ri; + } + xassert(p != 0); + return p; +} + +/*********************************************************************** +* spy_alloc_se - allocate dual pricing data block +* +* This routine allocates the memory for arrays used in the dual +* pricing data block. */ + +void spy_alloc_se(SPXLP *lp, SPYSE *se) +{ int m = lp->m; + int n = lp->n; +#if 1 /* 30/III-2016 */ + int i; +#endif + se->valid = 0; + se->refsp = talloc(1+n, char); + se->gamma = talloc(1+m, double); + se->work = talloc(1+m, double); +#if 1 /* 30/III-2016 */ + se->u.n = m; + se->u.nnz = 0; + se->u.ind = talloc(1+m, int); + se->u.vec = talloc(1+m, double); + for (i = 1; i <= m; i++) + se->u.vec[i] = 0.0; +#endif + return; +} + +/*********************************************************************** +* spy_reset_refsp - reset dual reference space +* +* This routine resets (re-initializes) the dual reference space +* composing it from dual variables which are non-basic (corresponding +* to basic primal variables) in the current basis, and sets all +* weights gamma[i] to 1. */ + +void spy_reset_refsp(SPXLP *lp, SPYSE *se) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *refsp = se->refsp; + double *gamma = se->gamma; + int i, k; + se->valid = 1; + memset(&refsp[1], 0, n * sizeof(char)); + for (i = 1; i <= m; i++) + { k = head[i]; /* x[k] = xB[i] */ + refsp[k] = 1; + gamma[i] = 1.0; + } + return; +} + +/*********************************************************************** +* spy_eval_gamma_i - compute dual proj. steepest edge weight directly +* +* This routine computes dual projected steepest edge weight gamma[i], +* 1 <= i <= m, for the current basis directly with the formula: +* +* n-m +* gamma[i] = delta[i] + sum eta[j] * T[i,j]**2, +* j=1 +* +* where T[i,j] is element of the current simplex table, and +* +* ( 1, if lambdaN[j] is in the reference space +* eta[j] = { +* ( 0, otherwise +* +* ( 1, if lambdaB[i] is in the reference space +* delta[i] = { +* ( 0, otherwise +* +* Dual basic variable lambdaN[j] corresponds to primal non-basic +* variable xN[j], and dual non-basic variable lambdaB[j] corresponds +* to primal basic variable xB[i]. +* +* NOTE: For testing/debugging only. */ + +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; +} + +/*********************************************************************** +* spy_chuzr_pse - choose basic variable (dual projected steepest edge) +* +* This routine chooses most eligible basic variable xB[p] according +* to the dual projected steepest edge method: +* +* r[p]**2 r[i]**2 +* -------- = max -------- , +* gamma[p] i in I gamma[i] +* +* ( lB[i] - beta[i], if beta[i] < lB[i] +* ( +* r[i] = { 0, if lB[i] <= beta[i] <= uB[i] +* ( +* ( uB[i] - beta[i], if beta[i] > uB[i] +* +* where I <= {1, ..., m} is the set of indices of eligible basic +* variables, beta[i] is current value of xB[i], lB[i] and uB[i] are, +* resp., lower and upper bounds of xB[i], r[i] is bound violation. +* +* Current values of basic variables should be placed in the array +* locations beta[1], ..., beta[m]. +* +* Indices of eligible basic variables i in I should be placed in the +* array locations list[1], ..., list[num], where num = |J| > 0 is the +* total number of such variables. +* +* On exit the routine returns p, the index of the basic variable xB[p] +* chosen. */ + +int spy_chuzr_pse(SPXLP *lp, SPYSE *se, const double beta[/*1+m*/], + int num, const int list[]) +{ int m = lp->m; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + double *gamma = se->gamma; + int i, k, p, t; + double best, ri, temp; + xassert(0 < num && num <= m); + p = 0, best = -1.0; + for (t = 1; t <= num; t++) + { i = list[t]; + k = head[i]; /* x[k] = xB[i] */ + if (beta[i] < l[k]) + ri = l[k] - beta[i]; + else if (beta[i] > u[k]) + ri = u[k] - beta[i]; + else + xassert(t != t); + /* FIXME */ + if (gamma[i] < DBL_EPSILON) + temp = 0.0; + else + temp = (ri * ri) / gamma[i]; + if (best < temp) + p = i, best = temp; + } + xassert(p != 0); + return p; +} + +/*********************************************************************** +* spy_update_gamma - update dual proj. steepest edge weights exactly +* +* This routine updates the vector gamma = (gamma[i]) of dual projected +* steepest edge weights exactly, for the adjacent basis. +* +* On entry to the routine the content of the se object should be valid +* and should correspond to the current basis. +* +* The parameter 1 <= p <= m specifies basic variable xB[p] which +* becomes non-basic variable xN[q] in the adjacent basis. +* +* The parameter 1 <= q <= n-m specified non-basic variable xN[q] which +* becomes basic variable xB[p] in the adjacent basis. +* +* It is assumed that the array trow contains elements of p-th (pivot) +* row T'[p] of the simplex table in locations trow[1], ..., trow[n-m]. +* It is also assumed that the array tcol contains elements of q-th +* (pivot) column T[q] of the simple table in locations tcol[1], ..., +* tcol[m]. (These row and column should be computed for the current +* basis.) +* +* For details about the formulae used see the program documentation. +* +* The routine also computes the relative error: +* +* e = |gamma[p] - gamma'[p]| / (1 + |gamma[p]|), +* +* where gamma'[p] is the weight for lambdaB[p] (which is dual +* non-basic variable corresponding to xB[p]) on entry to the routine, +* and returns e on exit. (If e happens to be large enough, the calling +* program may reset the reference space, since other weights also may +* be inaccurate.) */ + +double spy_update_gamma(SPXLP *lp, SPYSE *se, int p, int q, + const double trow[/*1+n-m*/], const double tcol[/*1+m*/]) +{ int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *refsp = se->refsp; + double *gamma = se->gamma; + double *u = se->work; + int i, j, k, ptr, end; + double gamma_p, delta_p, e, r, t1, t2; + xassert(se->valid); + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + /* compute gamma[p] in current basis more accurately; also + * compute auxiliary vector u */ + k = head[p]; /* x[k] = xB[p] */ + gamma_p = delta_p = (refsp[k] ? 1.0 : 0.0); + for (i = 1; i <= m; i++) + u[i] = 0.0; + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + if (refsp[k] && trow[j] != 0.0) + { gamma_p += trow[j] * trow[j]; + /* u := u + T[p,j] * N[j], where N[j] = A[k] is constraint + * matrix column corresponding to xN[j] */ + ptr = lp->A_ptr[k]; + end = lp->A_ptr[k+1]; + for (; ptr < end; ptr++) + u[lp->A_ind[ptr]] += trow[j] * lp->A_val[ptr]; + } + } + bfd_ftran(lp->bfd, u); + /* compute relative error in gamma[p] */ + e = fabs(gamma_p - gamma[p]) / (1.0 + gamma_p); + /* compute new gamma[p] */ + gamma[p] = gamma_p / (tcol[p] * tcol[p]); + /* compute new gamma[i] for all i != p */ + for (i = 1; i <= m; i++) + { if (i == p) + continue; + /* compute r[i] = T[i,q] / T[p,q] */ + r = tcol[i] / tcol[p]; + /* compute new gamma[i] */ + t1 = gamma[i] + r * (r * gamma_p + u[i] + u[i]); + k = head[i]; /* x[k] = xB[i] */ + t2 = (refsp[k] ? 1.0 : 0.0) + delta_p * r * r; + gamma[i] = (t1 >= t2 ? t1 : t2); + } + return e; +} + +#if 1 /* 30/III-2016 */ +double spy_update_gamma_s(SPXLP *lp, SPYSE *se, int p, int q, + const FVS *trow, const FVS *tcol) +{ /* sparse version of spy_update_gamma */ + int m = lp->m; + int n = lp->n; + int *head = lp->head; + char *refsp = se->refsp; + double *gamma = se->gamma; + double *u = se->work; + int trow_nnz = trow->nnz; + int *trow_ind = trow->ind; + double *trow_vec = trow->vec; + int tcol_nnz = tcol->nnz; + int *tcol_ind = tcol->ind; + double *tcol_vec = tcol->vec; + int i, j, k, t, ptr, end; + double gamma_p, delta_p, e, r, t1, t2; + xassert(se->valid); + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + /* compute gamma[p] in current basis more accurately; also + * compute auxiliary vector u */ + k = head[p]; /* x[k] = xB[p] */ + gamma_p = delta_p = (refsp[k] ? 1.0 : 0.0); + for (i = 1; i <= m; i++) + u[i] = 0.0; + for (t = 1; t <= trow_nnz; t++) + { j = trow_ind[t]; + k = head[m+j]; /* x[k] = xN[j] */ + if (refsp[k]) + { gamma_p += trow_vec[j] * trow_vec[j]; + /* u := u + T[p,j] * N[j], where N[j] = A[k] is constraint + * matrix column corresponding to xN[j] */ + ptr = lp->A_ptr[k]; + end = lp->A_ptr[k+1]; + for (; ptr < end; ptr++) + u[lp->A_ind[ptr]] += trow_vec[j] * lp->A_val[ptr]; + } + } + bfd_ftran(lp->bfd, u); + /* compute relative error in gamma[p] */ + e = fabs(gamma_p - gamma[p]) / (1.0 + gamma_p); + /* compute new gamma[p] */ + gamma[p] = gamma_p / (tcol_vec[p] * tcol_vec[p]); + /* compute new gamma[i] for all i != p */ + for (t = 1; t <= tcol_nnz; t++) + { i = tcol_ind[t]; + if (i == p) + continue; + /* compute r[i] = T[i,q] / T[p,q] */ + r = tcol_vec[i] / tcol_vec[p]; + /* compute new gamma[i] */ + t1 = gamma[i] + r * (r * gamma_p + u[i] + u[i]); + k = head[i]; /* x[k] = xB[i] */ + t2 = (refsp[k] ? 1.0 : 0.0) + delta_p * r * r; + gamma[i] = (t1 >= t2 ? t1 : t2); + } + return e; +} +#endif + +/*********************************************************************** +* spy_free_se - deallocate dual pricing data block +* +* This routine deallocates the memory used for arrays in the dual +* pricing data block. */ + +void spy_free_se(SPXLP *lp, SPYSE *se) +{ xassert(lp == lp); + tfree(se->refsp); + tfree(se->gamma); + tfree(se->work); +#if 1 /* 30/III-2016 */ + tfree(se->u.ind); + tfree(se->u.vec); +#endif + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spychuzr.h b/test/monniaux/glpk-4.65/src/simplex/spychuzr.h new file mode 100644 index 00000000..31f01b78 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spychuzr.h @@ -0,0 +1,97 @@ +/* spychuzr.h */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#ifndef SPYCHUZR_H +#define SPYCHUZR_H + +#include "spxlp.h" + +#define spy_chuzr_sel _glp_spy_chuzr_sel +int spy_chuzr_sel(SPXLP *lp, const double beta[/*1+m*/], double tol, + double tol1, int list[/*1+m*/]); +/* select eligible basic variables */ + +#define spy_chuzr_std _glp_spy_chuzr_std +int spy_chuzr_std(SPXLP *lp, const double beta[/*1+m*/], int num, + const int list[]); +/* choose basic variable (dual Dantzig's rule) */ + +typedef struct SPYSE SPYSE; + +struct SPYSE +{ /* dual projected steepest edge and Devex pricing data block */ + int valid; + /* content validity flag */ + char *refsp; /* char refsp[1+n]; */ + /* refsp[0] is not used; + * refsp[k], 1 <= k <= n, is the flag meaning that dual variable + * lambda[k] is in the dual reference space */ + double *gamma; /* double gamma[1+m]; */ + /* gamma[0] is not used; + * gamma[i], 1 <= i <= m, is the weight for reduced cost r[i] + * of dual non-basic variable lambdaB[j] in the current basis + * (r[i] is bound violation for basic variable xB[i]) */ + double *work; /* double work[1+m]; */ + /* working array */ +#if 1 /* 30/III-2016 */ + FVS u; /* FVS u[1:m]; */ + /* working vector */ +#endif +}; + +#define spy_alloc_se _glp_spy_alloc_se +void spy_alloc_se(SPXLP *lp, SPYSE *se); +/* allocate dual pricing data block */ + +#define spy_reset_refsp _glp_spy_reset_refsp +void spy_reset_refsp(SPXLP *lp, SPYSE *se); +/* reset dual reference space */ + +#define spy_eval_gamma_i _glp_spy_eval_gamma_i +double spy_eval_gamma_i(SPXLP *lp, SPYSE *se, int i); +/* compute dual projected steepest edge weight directly */ + +#define spy_chuzr_pse _glp_spy_chuzr_pse +int spy_chuzr_pse(SPXLP *lp, SPYSE *se, const double beta[/*1+m*/], + int num, const int list[]); +/* choose basic variable (dual projected steepest edge) */ + +#define spy_update_gamma _glp_spy_update_gamma +double spy_update_gamma(SPXLP *lp, SPYSE *se, int p, int q, + const double trow[/*1+n-m*/], const double tcol[/*1+m*/]); +/* update dual projected steepest edge weights exactly */ + +#if 1 /* 30/III-2016 */ +#define spy_update_gamma_s _glp_spy_update_gamma_s +double spy_update_gamma_s(SPXLP *lp, SPYSE *se, int p, int q, + const FVS *trow, const FVS *tcol); +/* sparse version of spy_update_gamma */ +#endif + +#define spy_free_se _glp_spy_free_se +void spy_free_se(SPXLP *lp, SPYSE *se); +/* deallocate dual pricing data block */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/simplex/spydual.c b/test/monniaux/glpk-4.65/src/simplex/spydual.c new file mode 100644 index 00000000..89d98db9 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/simplex/spydual.c @@ -0,0 +1,2101 @@ +/* spydual.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2015-2017 Andrew Makhorin, Department for Applied +* Informatics, Moscow Aviation Institute, Moscow, Russia. All rights +* reserved. E-mail: <mao@gnu.org>. +* +* GLPK is free software: you can redistribute it and/or modify it +* under the terms of the GNU General Public License as published by +* the Free Software Foundation, either version 3 of the License, or +* (at your option) any later version. +* +* GLPK is distributed in the hope that it will be useful, but WITHOUT +* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY +* or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public +* License for more details. +* +* You should have received a copy of the GNU General Public License +* along with GLPK. If not, see <http://www.gnu.org/licenses/>. +***********************************************************************/ + +#if 1 /* 18/VII-2017 */ +#define SCALE_Z 1 +#endif + +#include "env.h" +#include "simplex.h" +#include "spxat.h" +#include "spxnt.h" +#include "spxprob.h" +#include "spychuzc.h" +#include "spychuzr.h" +#if 0 /* 11/VI-2017 */ +#if 1 /* 29/III-2016 */ +#include "fvs.h" +#endif +#endif + +#define CHECK_ACCURACY 0 +/* (for debugging) */ + +struct csa +{ /* common storage area */ + SPXLP *lp; + /* LP problem data and its (current) basis; this LP has m rows + * and n columns */ + int dir; + /* original optimization direction: + * +1 - minimization + * -1 - maximization */ +#if SCALE_Z + double fz; + /* factor used to scale original objective */ +#endif + double *orig_b; /* double orig_b[1+m]; */ + /* copy of original right-hand sides */ + double *orig_c; /* double orig_c[1+n]; */ + /* copy of original objective coefficients */ + double *orig_l; /* double orig_l[1+n]; */ + /* copy of original lower bounds */ + double *orig_u; /* double orig_u[1+n]; */ + /* copy of original upper bounds */ + SPXAT *at; + /* mxn-matrix A of constraint coefficients, in sparse row-wise + * format (NULL if not used) */ + SPXNT *nt; + /* mx(n-m)-matrix N composed of non-basic columns of constraint + * matrix A, in sparse row-wise format (NULL if not used) */ + int phase; + /* search phase: + * 0 - not determined yet + * 1 - searching for dual feasible solution + * 2 - searching for optimal solution */ + double *beta; /* double beta[1+m]; */ + /* beta[i] is primal value of basic variable xB[i] */ + int beta_st; + /* status of the vector beta: + * 0 - undefined + * 1 - just computed + * 2 - updated */ + double *d; /* double d[1+n-m]; */ + /* d[j] is reduced cost of non-basic variable xN[j] */ + int d_st; + /* status of the vector d: + * 0 - undefined + * 1 - just computed + * 2 - updated */ + SPYSE *se; + /* dual projected steepest edge and Devex pricing data block + * (NULL if not used) */ +#if 0 /* 30/III-2016 */ + int num; + /* number of eligible basic variables */ + int *list; /* int list[1+m]; */ + /* list[1], ..., list[num] are indices i of eligible basic + * variables xB[i] */ +#else + FVS r; /* FVS r[1:m]; */ + /* vector of primal infeasibilities */ + /* r->nnz = num; r->ind = list */ + /* vector r has the same status as vector beta (see above) */ +#endif + int p; + /* xB[p] is a basic variable chosen to leave the basis */ +#if 0 /* 29/III-2016 */ + double *trow; /* double trow[1+n-m]; */ +#else + FVS trow; /* FVS trow[1:n-m]; */ +#endif + /* p-th (pivot) row of the simplex table */ +#if 1 /* 16/III-2016 */ + SPYBP *bp; /* SPYBP bp[1+n-m]; */ + /* dual objective break-points */ +#endif + int q; + /* xN[q] is a non-basic variable chosen to enter the basis */ +#if 0 /* 29/III-2016 */ + double *tcol; /* double tcol[1+m]; */ +#else + FVS tcol; /* FVS tcol[1:m]; */ +#endif + /* q-th (pivot) column of the simplex table */ + double *work; /* double work[1+m]; */ + /* working array */ + double *work1; /* double work1[1+n-m]; */ + /* another working array */ +#if 0 /* 11/VI-2017 */ +#if 1 /* 31/III-2016 */ + FVS wrow; /* FVS wrow[1:n-m]; */ + FVS wcol; /* FVS wcol[1:m]; */ + /* working sparse vectors */ +#endif +#endif + int p_stat, d_stat; + /* primal and dual solution statuses */ + /*--------------------------------------------------------------*/ + /* control parameters (see struct glp_smcp) */ + int msg_lev; + /* message level */ + int dualp; + /* if this flag is set, report failure in case of instability */ +#if 0 /* 16/III-2016 */ + int harris; + /* dual ratio test technique: + * 0 - textbook ratio test + * 1 - Harris' two pass ratio test */ +#else + int r_test; + /* dual ratio test technique: + * GLP_RT_STD - textbook ratio test + * GLP_RT_HAR - Harris' two pass ratio test + * GLP_RT_FLIP - long-step (flip-flop) ratio test */ +#endif + double tol_bnd, tol_bnd1; + /* primal feasibility tolerances */ + double tol_dj, tol_dj1; + /* dual feasibility tolerances */ + double tol_piv; + /* pivot tolerance */ + double obj_lim; + /* objective limit */ + int it_lim; + /* iteration limit */ + int tm_lim; + /* time limit, milliseconds */ + int out_frq; +#if 0 /* 15/VII-2017 */ + /* display output frequency, iterations */ +#else + /* display output frequency, milliseconds */ +#endif + int out_dly; + /* display output delay, milliseconds */ + /*--------------------------------------------------------------*/ + /* working parameters */ + double tm_beg; + /* time value at the beginning of the search */ + int it_beg; + /* simplex iteration count at the beginning of the search */ + int it_cnt; + /* simplex iteration count; it increases by one every time the + * basis changes */ + int it_dpy; + /* simplex iteration count at most recent display output */ +#if 1 /* 15/VII-2017 */ + double tm_dpy; + /* time value at most recent display output */ +#endif + int inv_cnt; + /* basis factorization count since most recent display output */ +#if 1 /* 11/VII-2017 */ + int degen; + /* count of successive degenerate iterations; this count is used + * to detect stalling */ +#endif +#if 1 /* 23/III-2016 */ + int ns_cnt, ls_cnt; + /* normal and long-step iteration count */ +#endif +}; + +/*********************************************************************** +* check_flags - check correctness of active bound flags +* +* This routine checks that flags specifying active bounds of all +* non-basic variables are correct. +* +* NOTE: It is important to note that if bounds of variables have been +* changed, active bound flags should be corrected accordingly. */ + +static void check_flags(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + int j, k; + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) + xassert(!flag[j]); + else if (l[k] != -DBL_MAX && u[k] == +DBL_MAX) + xassert(!flag[j]); + else if (l[k] == -DBL_MAX && u[k] != +DBL_MAX) + xassert(flag[j]); + else if (l[k] == u[k]) + xassert(!flag[j]); + } + return; +} + +/*********************************************************************** +* set_art_bounds - set artificial right-hand sides and bounds +* +* This routine sets artificial right-hand sides and artificial bounds +* for all variables to minimize the sum of dual infeasibilities on +* phase I. Given current reduced costs d = (d[j]) this routine also +* sets active artificial bounds of non-basic variables to provide dual +* feasibility (this is always possible because all variables have both +* lower and upper artificial bounds). */ + +static void set_art_bounds(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *b = lp->b; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + double *d = csa->d; + int i, j, k; +#if 1 /* 31/III-2016: FIXME */ + /* set artificial right-hand sides */ + for (i = 1; i <= m; i++) + b[i] = 0.0; + /* set artificial bounds depending on types of variables */ + for (k = 1; k <= n; k++) + { if (csa->orig_l[k] == -DBL_MAX && csa->orig_u[k] == +DBL_MAX) + { /* force free variables to enter the basis */ + l[k] = -1e3, u[k] = +1e3; + } + else if (csa->orig_l[k] != -DBL_MAX && csa->orig_u[k] == +DBL_MAX) + l[k] = 0.0, u[k] = +1.0; + else if (csa->orig_l[k] == -DBL_MAX && csa->orig_u[k] != +DBL_MAX) + l[k] = -1.0, u[k] = 0.0; + else + l[k] = u[k] = 0.0; + } +#endif + /* set active artificial bounds for non-basic variables */ + xassert(csa->d_st == 1); + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + flag[j] = (l[k] != u[k] && d[j] < 0.0); + } + /* invalidate values of basic variables, since active bounds of + * non-basic variables have been changed */ + csa->beta_st = 0; + return; +} + +/*********************************************************************** +* set_orig_bounds - restore original right-hand sides and bounds +* +* This routine restores original right-hand sides and original bounds +* for all variables. This routine also sets active original bounds for +* non-basic variables; for double-bounded non-basic variables current +* reduced costs d = (d[j]) are used to decide which bound (lower or +* upper) should be made active. */ + +static void set_orig_bounds(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *b = lp->b; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + double *d = csa->d; + int j, k; + /* restore original right-hand sides */ + memcpy(b, csa->orig_b, (1+m) * sizeof(double)); + /* restore original bounds of all variables */ + memcpy(l, csa->orig_l, (1+n) * sizeof(double)); + memcpy(u, csa->orig_u, (1+n) * sizeof(double)); + /* set active original bounds for non-basic variables */ + xassert(csa->d_st == 1); + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) + flag[j] = 0; + else if (l[k] != -DBL_MAX && u[k] == +DBL_MAX) + flag[j] = 0; + else if (l[k] == -DBL_MAX && u[k] != +DBL_MAX) + flag[j] = 1; + else if (l[k] != u[k]) + flag[j] = (d[j] < 0.0); + else + flag[j] = 0; + } + /* invalidate values of basic variables, since active bounds of + * non-basic variables have been changed */ + csa->beta_st = 0; + return; +} + +/*********************************************************************** +* check_feas - check dual feasibility of basic solution +* +* This routine checks that reduced costs of all non-basic variables +* d = (d[j]) have correct signs. +* +* Reduced cost d[j] is considered as having correct sign within the +* specified tolerance depending on status of non-basic variable xN[j] +* if one of the following conditions is met: +* +* xN[j] is free -eps <= d[j] <= +eps +* +* xN[j] has its lower bound active d[j] >= -eps +* +* xN[j] has its upper bound active d[j] <= +eps +* +* xN[j] is fixed d[j] has any value +* +* where eps = tol + tol1 * |cN[j]|, cN[j] is the objective coefficient +* at xN[j]. (See also the routine spx_chuzc_sel.) +* +* The flag recov allows the routine to recover dual feasibility by +* changing active bounds of non-basic variables. (For example, if +* xN[j] has its lower bound active and d[j] < -eps, the feasibility +* can be recovered by making xN[j] active on its upper bound.) +* +* If the basic solution is dual feasible, the routine returns zero. +* If the basic solution is dual infeasible, but its dual feasibility +* can be recovered (or has been recovered, if the flag recov is set), +* the routine returns a negative value. Otherwise, the routine returns +* the number j of some non-basic variable xN[j], whose reduced cost +* d[j] is dual infeasible and cannot be recovered. */ + +static int check_feas(struct csa *csa, double tol, double tol1, + int recov) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + double *d = csa->d; + int j, k, ret = 0; + double eps; + /* reduced costs should be just computed */ + xassert(csa->d_st == 1); + /* walk thru list of non-basic variables */ + for (j = 1; j <= n-m; j++) + { k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == u[k]) + { /* xN[j] is fixed variable; skip it */ + continue; + } + /* determine absolute tolerance eps[j] */ + eps = tol + tol1 * (c[k] >= 0.0 ? +c[k] : -c[k]); + /* check dual feasibility of xN[j] */ + if (d[j] > +eps) + { /* xN[j] should have its lower bound active */ + if (l[k] == -DBL_MAX || flag[j]) + { /* but it either has no lower bound or its lower bound + * is inactive */ + if (l[k] == -DBL_MAX) + { /* cannot recover, since xN[j] has no lower bound */ + ret = j; + break; + } + /* recovering is possible */ + if (recov) + flag[j] = 0; + ret = -1; + } + } + else if (d[j] < -eps) + { /* xN[j] should have its upper bound active */ + if (!flag[j]) + { /* but it either has no upper bound or its upper bound + * is inactive */ + if (u[k] == +DBL_MAX) + { /* cannot recover, since xN[j] has no upper bound */ + ret = j; + break; + } + /* recovering is possible */ + if (recov) + flag[j] = 1; + ret = -1; + } + } + } + if (recov && ret) + { /* invalidate values of basic variables, since active bounds + * of non-basic variables have been changed */ + csa->beta_st = 0; + } + return ret; +} + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_vec - compute maximal relative error between two vectors +* +* This routine computes and returns maximal relative error between +* n-vectors x and y: +* +* err_max = max |x[i] - y[i]| / (1 + |x[i]|). +* +* NOTE: This routine is intended only for debugging purposes. */ + +static double err_in_vec(int n, const double x[], const double y[]) +{ int i; + double err, err_max; + err_max = 0.0; + for (i = 1; i <= n; i++) + { err = fabs(x[i] - y[i]) / (1.0 + fabs(x[i])); + if (err_max < err) + err_max = err; + } + return err_max; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_beta - compute maximal relative error in vector beta +* +* This routine computes and returns maximal relative error in vector +* of values of basic variables beta = (beta[i]). +* +* NOTE: This routine is intended only for debugging purposes. */ + +static double err_in_beta(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + double err, *beta; + beta = talloc(1+m, double); + spx_eval_beta(lp, beta); + err = err_in_vec(m, beta, csa->beta); + tfree(beta); + return err; +} +#endif + +#if CHECK_ACCURACY +static double err_in_r(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int i, k; + double err, *r; + r = talloc(1+m, double); + for (i = 1; i <= m; i++) + { k = lp->head[i]; + if (csa->beta[i] < lp->l[k]) + r[i] = lp->l[k] - csa->beta[i]; + else if (csa->beta[i] > lp->u[k]) + r[i] = lp->u[k] - csa->beta[i]; + else + r[i] = 0.0; + +if (fabs(r[i] - csa->r.vec[i]) > 1e-6) +printf("i = %d; r = %g; csa->r = %g\n", i, r[i], csa->r.vec[i]); + + + } + err = err_in_vec(m, r, csa->r.vec); + tfree(r); + return err; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_d - compute maximal relative error in vector d +* +* This routine computes and returns maximal relative error in vector +* of reduced costs of non-basic variables d = (d[j]). +* +* NOTE: This routine is intended only for debugging purposes. */ + +static double err_in_d(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + int j; + double err, *pi, *d; + pi = talloc(1+m, double); + d = talloc(1+n-m, double); + spx_eval_pi(lp, pi); + for (j = 1; j <= n-m; j++) + d[j] = spx_eval_dj(lp, pi, j); + err = err_in_vec(n-m, d, csa->d); + tfree(pi); + tfree(d); + return err; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* err_in_gamma - compute maximal relative error in vector gamma +* +* This routine computes and returns maximal relative error in vector +* of projected steepest edge weights gamma = (gamma[j]). +* +* NOTE: This routine is intended only for debugging purposes. */ + +static double err_in_gamma(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + SPYSE *se = csa->se; + int i; + double err, *gamma; + xassert(se != NULL); +gamma = talloc(1+m, double); + for (i = 1; i <= m; i++) + gamma[i] = spy_eval_gamma_i(lp, se, i); + err = err_in_vec(m, gamma, se->gamma); + tfree(gamma); + return err; +} +#endif + +#if CHECK_ACCURACY +/*********************************************************************** +* check_accuracy - check accuracy of basic solution components +* +* This routine checks accuracy of current basic solution components. +* +* NOTE: This routine is intended only for debugging purposes. */ + +static void check_accuracy(struct csa *csa) +{ double e_beta, e_r, e_d, e_gamma; + e_beta = err_in_beta(csa); + e_r = err_in_r(csa); + e_d = err_in_d(csa); + if (csa->se == NULL) + e_gamma = 0.; + else + e_gamma = err_in_gamma(csa); + xprintf("e_beta = %10.3e; e_r = %10.3e; e_d = %10.3e; e_gamma = %" + "10.3e\n", e_beta, e_r, e_d, e_gamma); + xassert(e_beta <= 1e-5 && e_d <= 1e-5 && e_gamma <= 1e-3); + return; +} +#endif + +#if 1 /* 30/III-2016 */ +static +void spy_eval_r(SPXLP *lp, const double beta[/*1+m*/], double tol, + double tol1, FVS *r) +{ /* this routine computes the vector of primal infeasibilities: + * + * ( lB[i] - beta[i] > 0, if beta[i] < lb[i] + * r[i] = { 0, if lb[i] <= beta[i] <= ub[i] + * ( ub[i] - beta[i] < 0, if beta[i] > ub[i] + * + * (this routine replaces spy_chuzr_sel) */ + int m = lp->m; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int *ind = r->ind; + double *vec = r->vec; + int i, k, nnz = 0; + double lk, uk, eps; + xassert(r->n == m); + /* walk thru the list of basic variables */ + for (i = 1; i <= m; i++) + { vec[i] = 0.0; + k = head[i]; /* x[k] = xB[i] */ + lk = l[k], uk = u[k]; + /* check primal feasibility */ + if (beta[i] < lk) + { /* determine absolute tolerance eps1[i] */ + eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] < lk - eps) + { /* lower bound is violated */ + ind[++nnz] = i; + vec[i] = lk - beta[i]; + } + } + else if (beta[i] > uk) + { /* determine absolute tolerance eps2[i] */ + eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] > uk + eps) + { /* upper bound is violated */ + ind[++nnz] = i; + vec[i] = uk - beta[i]; + } + } + } + r->nnz = nnz; + return; +} +#endif + +/*********************************************************************** +* choose_pivot - choose xB[p] and xN[q] +* +* Given the list of eligible basic variables this routine first +* chooses basic variable xB[p]. This choice is always possible, +* because the list is assumed to be non-empty. Then the routine +* computes p-th row T[p,*] of the simplex table T[i,j] and chooses +* non-basic variable xN[q]. If the pivot T[p,q] is small in magnitude, +* the routine attempts to choose another xB[p] and xN[q] in order to +* avoid badly conditioned adjacent bases. +* +* If the normal choice was made, the routine returns zero. Otherwise, +* if the long-step choice was made, the routine returns non-zero. */ + +#ifdef TIMING /* 31/III-2016 */ + +#include "choose_pivot.c" + +#else + +#define MIN_RATIO 0.0001 + +static int choose_pivot(struct csa *csa) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + SPXAT *at = csa->at; + SPXNT *nt = csa->nt; + double *beta = csa->beta; + double *d = csa->d; + SPYSE *se = csa->se; +#if 0 /* 30/III-2016 */ + int *list = csa->list; +#else + int *list = csa->r.ind; +#endif + double *rho = csa->work; + double *trow = csa->work1; + SPYBP *bp = csa->bp; + double tol_piv = csa->tol_piv; + int try, nnn, j, k, p, q, t, t_best, nbp, ret; + double big, temp, r, best_ratio, dz_best; + xassert(csa->beta_st); + xassert(csa->d_st); +more: /* initial number of eligible basic variables */ +#if 0 /* 30/III-2016 */ + nnn = csa->num; +#else + nnn = csa->r.nnz; +#endif + /* nothing has been chosen so far */ + csa->p = 0; + best_ratio = 0.0; + try = ret = 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); +#if 1 /* 23/III-2016 */ + /* big := max(1, |trow[1]|, ..., |trow[n-m]|) */ + big = 1.0; + for (j = 1; j <= n-m; j++) + { temp = trow[j]; + if (temp < 0.0) + temp = - temp; + if (big < temp) + big = temp; + } +#else + /* this still puzzles me */ + big = 1.0; +#endif + /* choose non-basic variable xN[q] */ + k = head[p]; /* x[k] = xB[p] */ + xassert(beta[p] < l[k] || beta[p] > u[k]); + r = beta[p] < l[k] ? l[k] - beta[p] : u[k] - beta[p]; + if (csa->r_test == GLP_RT_FLIP && try <= 2) + { /* long-step ratio test */ +#if 0 /* 23/III-2016 */ + /* determine dual objective break-points */ + nbp = spy_eval_bp(lp, d, r, trow, tol_piv, bp); + if (nbp <= 1) + goto skip; + /* choose appropriate break-point */ + t_best = 0, dz_best = -DBL_MAX; + for (t = 1; t <= nbp; t++) + { if (fabs(trow[bp[t].j]) / big >= MIN_RATIO) + { if (dz_best < bp[t].dz) + t_best = t, dz_best = bp[t].dz; + } + } + if (t_best == 0) + goto skip; +#else + int t, num, num1; + double slope, teta_lim; + /* determine dual objective break-points */ + nbp = spy_ls_eval_bp(lp, d, r, trow, tol_piv, bp); + if (nbp < 2) + goto skip; + /* set initial slope */ + slope = fabs(r); + /* estimate initial teta_lim */ + teta_lim = DBL_MAX; + for (t = 1; t <= nbp; t++) + { if (teta_lim > bp[t].teta) + teta_lim = bp[t].teta; + } + xassert(teta_lim >= 0.0); + if (teta_lim < 1e-6) + teta_lim = 1e-6; + /* nothing has been chosen so far */ + t_best = 0, dz_best = 0.0, num = 0; + /* choose appropriate break-point */ + while (num < nbp) + { /* select and process a new portion of break-points */ + num1 = spy_ls_select_bp(lp, trow, nbp, bp, num, &slope, + teta_lim); + for (t = num+1; t <= num1; t++) + { if (fabs(trow[bp[t].j]) / big >= MIN_RATIO) + { if (dz_best < bp[t].dz) + t_best = t, dz_best = bp[t].dz; + } + } + if (slope < 0.0) + { /* the dual objective starts decreasing */ + break; + } + /* the dual objective continues increasing */ + num = num1; + teta_lim += teta_lim; + } + if (dz_best == 0.0) + goto skip; + xassert(1 <= t_best && t_best <= num1); +#endif + /* the choice has been made */ + csa->p = p; +#if 0 /* 29/III-2016 */ + memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double)); +#else + memcpy(&csa->trow.vec[1], &trow[1], (n-m) * sizeof(double)); + fvs_gather_vec(&csa->trow, DBL_EPSILON); +#endif + csa->q = bp[t_best].j; + best_ratio = fabs(trow[bp[t_best].j]) / big; +#if 0 + xprintf("num = %d; t_best = %d; dz = %g\n", num, t_best, + bp[t_best].dz); +#endif + ret = 1; + goto done; +skip: ; + } + if (csa->r_test == GLP_RT_STD) + { /* textbook dual ratio test */ + q = spy_chuzc_std(lp, d, r, trow, tol_piv, + .30 * csa->tol_dj, .30 * csa->tol_dj1); + } + else + { /* Harris' two-pass dual ratio test */ + q = spy_chuzc_harris(lp, d, r, trow, tol_piv, + .35 * csa->tol_dj, .35 * csa->tol_dj1); + } + if (q == 0) + { /* dual unboundedness */ + csa->p = p; +#if 0 /* 29/III-2016 */ + memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double)); +#else + memcpy(&csa->trow.vec[1], &trow[1], (n-m) * sizeof(double)); + fvs_gather_vec(&csa->trow, DBL_EPSILON); +#endif + csa->q = q; + best_ratio = 1.0; + goto done; + } + /* either keep previous choice or accept new choice depending on + * which one is better */ + if (best_ratio < fabs(trow[q]) / big) + { csa->p = p; +#if 0 /* 29/III-2016 */ + memcpy(&csa->trow[1], &trow[1], (n-m) * sizeof(double)); +#else + memcpy(&csa->trow.vec[1], &trow[1], (n-m) * sizeof(double)); + fvs_gather_vec(&csa->trow, DBL_EPSILON); +#endif + csa->q = q; + best_ratio = fabs(trow[q]) / big; + } + /* check if the current choice is acceptable */ + if (best_ratio >= MIN_RATIO || nnn == 1 || 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 */ +#if 1 /* FIXME: currently just to avoid badly conditioned basis */ + if (best_ratio < .001 * MIN_RATIO) + { /* looks like this helps */ + if (bfd_get_count(lp->bfd) > 0) + return -1; + /* didn't help; last chance to improve the choice */ + if (tol_piv == csa->tol_piv) + { tol_piv *= 1000.; + goto more; + } + } +#endif +#if 1 /* FIXME */ + if (ret) + { /* invalidate basic solution components */ +#if 0 /* 28/III-2016 */ + csa->beta_st = csa->d_st = 0; +#else + /* dual solution remains valid */ + csa->beta_st = 0; +#endif + /* set double-bounded non-basic variables to opposite bounds + * for all break-points preceding the chosen one */ + for (t = 1; t < t_best; t++) + { k = head[m + bp[t].j]; + xassert(-DBL_MAX < l[k] && l[k] < u[k] && u[k] < +DBL_MAX); + lp->flag[bp[t].j] = !(lp->flag[bp[t].j]); + } + } +#endif + return ret; +} + +#endif + +/*********************************************************************** +* play_coef - play objective coefficients +* +* This routine is called after the reduced costs d[j] was updated and +* the basis was changed to the adjacent one. +* +* It is assumed that before updating all the reduced costs d[j] were +* strongly feasible, so in the adjacent basis d[j] remain feasible +* within a tolerance, i.e. if some d[j] violates its zero bound, the +* violation is insignificant. +* +* If some d[j] violates its zero bound, the routine changes (perturbs) +* objective coefficient cN[j] to provide d[j] = 0, i.e. to make all +* d[j] strongly feasible. Otherwise, if d[j] has a feasible value, the +* routine attempts to reduce (or remove) perturbation in cN[j] by +* shifting d[j] to its zero bound keeping strong feasibility. */ + +static void play_coef(struct csa *csa, int all) +{ SPXLP *lp = csa->lp; + int m = lp->m; + int n = lp->n; + double *c = lp->c; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + char *flag = lp->flag; + double *orig_c = csa->orig_c; + double *d = csa->d; + const double *trow = csa->trow.vec; + /* this vector was used to update d = (d[j]) */ + int j, k; + static const double eps = 1e-9; + /* reduced costs d = (d[j]) should be valid */ + xassert(csa->d_st); + /* walk thru the list of non-basic variables xN = (xN[j]) */ + for (j = 1; j <= n-m; j++) + { if (all || trow[j] != 0.0) + { /* d[j] has changed in the adjacent basis */ + k = head[m+j]; /* x[k] = xN[j] */ + if (l[k] == u[k]) + { /* xN[j] is fixed variable */ + /* d[j] may have any sign */ + } + else if (l[k] == -DBL_MAX && u[k] == +DBL_MAX) + { /* xN[j] is free (unbounded) variable */ + /* strong feasibility means d[j] = 0 */ + c[k] -= d[j], d[j] = 0.0; + /* in this case dual degeneracy is not critical, since + * if xN[j] enters the basis, it never leaves it */ + } + else if (!flag[j]) + { /* xN[j] has its lower bound active */ + xassert(l[k] != -DBL_MAX); + /* first, we remove current perturbation to provide + * c[k] = orig_c[k] */ + d[j] -= c[k] - orig_c[k], c[k] = orig_c[k]; + /* strong feasibility means d[j] >= 0, but we provide + * d[j] >= +eps to prevent dual degeneracy */ + if (d[j] < +eps) + c[k] -= d[j] - eps, d[j] = +eps; + } + else + { /* xN[j] has its upper bound active */ + xassert(u[k] != +DBL_MAX); + /* similarly, we remove current perturbation to provide + * c[k] = orig_c[k] */ + d[j] -= c[k] - orig_c[k], c[k] = orig_c[k]; + /* strong feasibility means d[j] <= 0, but we provide + * d[j] <= -eps to prevent dual degeneracy */ + if (d[j] > -eps) + c[k] -= d[j] + eps, d[j] = -eps; + } + } + } + return; +} + +#if 1 /* 11/VII-2017 */ +static void remove_perturb(struct csa *csa) +{ /* remove perturbation */ + SPXLP *lp = csa->lp; + int n = lp->n; + double *c = lp->c; + double *orig_c = csa->orig_c; + memcpy(c, orig_c, (1+n) * sizeof(double)); + /* removing perturbation changes dual solution components */ + csa->phase = csa->d_st = 0; +#if 1 + if (csa->msg_lev >= GLP_MSG_ALL) + xprintf("Removing LP perturbation [%d]...\n", + csa->it_cnt); +#endif + return; +} +#endif + +/*********************************************************************** +* 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->orig_l; /* original lower bounds */ + double *u = csa->orig_u; /* original upper bounds */ + double *beta = csa->beta; + double *d = csa->d; + int j, k, nnn; + double sum; +#if 1 /* 15/VII-2017 */ + double tm_cur; +#endif + /* check if the display output should be skipped */ + if (csa->msg_lev < GLP_MSG_ON) goto skip; +#if 1 /* 15/VII-2017 */ + tm_cur = xtime(); +#endif + if (csa->out_dly > 0 && +#if 0 /* 15/VII-2017 */ + 1000.0 * xdifftime(xtime(), csa->tm_beg) < csa->out_dly) +#else + 1000.0 * xdifftime(tm_cur, csa->tm_beg) < csa->out_dly) +#endif + goto skip; + if (csa->it_cnt == csa->it_dpy) goto skip; +#if 0 /* 15/VII-2017 */ + if (!spec && csa->it_cnt % csa->out_frq != 0) goto skip; +#else + if (!spec && + 1000.0 * xdifftime(tm_cur, csa->tm_dpy) < csa->out_frq) + goto skip; +#endif + /* 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 */ +#if 0 /* 27/III-2016 */ + xprintf(" %6d: %23s inf = %11.3e (%d)", + csa->it_cnt, "", sum, nnn); +#else + xprintf(" %6d: sum = %17.9e inf = %11.3e (%d)", + csa->it_cnt, lp->c[0] - spx_eval_obj(lp, beta), + sum, nnn); +#endif + 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)", +#if SCALE_Z + csa->it_cnt, + (double)csa->dir * csa->fz * spx_eval_obj(lp, beta), +#else + csa->it_cnt, (double)csa->dir * spx_eval_obj(lp, beta), +#endif + 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; + } +#if 1 /* 23/III-2016 */ + if (csa->r_test == GLP_RT_FLIP) + { /*xprintf(" %d,%d", csa->ns_cnt, csa->ls_cnt);*/ + if (csa->ns_cnt + csa->ls_cnt) + xprintf(" %d%%", + (100 * csa->ls_cnt) / (csa->ns_cnt + csa->ls_cnt)); + csa->ns_cnt = csa->ls_cnt = 0; + } +#endif + xprintf("\n"); + csa->it_dpy = csa->it_cnt; +#if 1 /* 15/VII-2017 */ + csa->tm_dpy = tm_cur; +#endif +skip: return; +} + +#if 1 /* 31/III-2016 */ +static +void spy_update_r(SPXLP *lp, int p, int q, const double beta[/*1+m*/], + const FVS *tcol, double tol, double tol1, FVS *r) +{ /* update vector r of primal infeasibilities */ + /* it is assumed that xB[p] leaves the basis, xN[q] enters the + * basis, and beta corresponds to the adjacent basis (i.e. this + * routine should be called after spx_update_beta) */ + int m = lp->m; + int n = lp->n; + double *l = lp->l; + double *u = lp->u; + int *head = lp->head; + int *tcol_ind = tcol->ind; + int *ind = r->ind; + double *vec = r->vec; + int i, k, t, nnz; + double lk, uk, ri, eps; + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n-m); + nnz = r->nnz; + for (t = tcol->nnz; t >= 1; t--) + { i = tcol_ind[t]; + /* xB[i] changes in the adjacent basis to beta[i], so only + * r[i] should be updated */ + if (i == p) + k = head[m+q]; /* x[k] = new xB[p] = old xN[q] */ + else + k = head[i]; /* x[k] = new xB[i] = old xB[i] */ + lk = l[k], uk = u[k]; + /* determine new value of r[i]; see spy_eval_r */ + ri = 0.0; + if (beta[i] < lk) + { /* determine absolute tolerance eps1[i] */ + eps = tol + tol1 * (lk >= 0.0 ? +lk : -lk); + if (beta[i] < lk - eps) + { /* lower bound is violated */ + ri = lk - beta[i]; + } + } + else if (beta[i] > uk) + { /* determine absolute tolerance eps2[i] */ + eps = tol + tol1 * (uk >= 0.0 ? +uk : -uk); + if (beta[i] > uk + eps) + { /* upper bound is violated */ + ri = uk - beta[i]; + } + } + if (ri == 0.0) + { if (vec[i] != 0.0) + vec[i] = DBL_MIN; /* will be removed */ + } + else + { if (vec[i] == 0.0) + ind[++nnz] = i; + vec[i] = ri; + } + + } + r->nnz = nnz; + /* remove zero elements */ + fvs_adjust_vec(r, DBL_MIN + DBL_MIN); + return; +} +#endif + +/*********************************************************************** +* spy_dual - driver to the 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; +#if 0 /* 30/III-2016 */ + int *list = csa->list; +#endif +#if 0 /* 31/III-2016 */ + double *trow = csa->trow; + double *tcol = csa->tcol; +#endif + 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; + int perturb = -1; + /* -1 = perturbation is not used, but enabled + * 0 = perturbation is not used and disabled + * +1 = perturbation is being used */ +#if 1 /* 27/III-2016 */ + int instab = 0; /* instability count */ +#endif +#ifdef TIMING + double t_total = timer(); /* total time */ + double t_fact = 0.0; /* computing factorization */ + double t_rtest = 0.0; /* performing ratio test */ + double t_pivcol = 0.0; /* computing pivot column */ + double t_upd1 = 0.0; /* updating primal values */ + double t_upd2 = 0.0; /* updating dual values */ + double t_upd3 = 0.0; /* updating se weights */ + double t_upd4 = 0.0; /* updating matrix N */ + double t_upd5 = 0.0; /* updating factorization */ + double t_start; +#endif + check_flags(csa); +loop: /* main loop starts here */ + /* compute factorization of the basis matrix */ + if (!lp->valid) + { double cond; +#ifdef TIMING + t_start = timer(); +#endif + ret = spx_factorize(lp); +#ifdef TIMING + t_fact += timer() - t_start; +#endif + 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 */ +#if 1 /* 11/VII-2017 */ + if (perturb <= 0) + { if (check_feas(csa, tol_dj, tol_dj1, 0)) + { /* dual feasibility is broken due to excessive round-off + * errors */ + if (perturb < 0) + { if (msg_lev >= GLP_MSG_ALL) + xprintf("Perturbing LP to avoid instability [%d].." + ".\n", csa->it_cnt); + perturb = 1; + goto loop; + } + if (msg_lev >= GLP_MSG_ERR) + xprintf("Warning: numerical instability (dual simplex" + ", phase %s)\n", csa->phase == 1 ? "I" : "II"); + instab++; + if (csa->dualp && instab >= 10) + { /* do not continue the search; report failure */ + if (msg_lev >= GLP_MSG_ERR) + xprintf("Warning: dual simplex failed due to exces" + "sive numerical instability\n"); + 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; + } + } + } + else + { /* FIXME */ + play_coef(csa, 1); + } + } +#endif + /* 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); +#if 1 /* 31/III-2016 */ + /* also compute vector r of primal infeasibilities */ + switch (csa->phase) + { case 1: + spy_eval_r(lp, beta, 1e-8, 0.0, &csa->r); + break; + case 2: + spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); + break; + default: + xassert(csa != csa); + } +#endif + 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); +#ifdef GLP_DEBUG + check_flags(csa); +#endif +#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 1 /* 26/V-2017 by mao */ + if (perturb > 0) + { /* remove perturbation */ + /* [Should note that perturbing of objective coefficients + * implemented in play_coef is equivalent to *relaxing* of + * (zero) bounds of dual variables, so the perturbed + * objective is always better (*greater*) that the original + * one at the same basic point.] */ + remove_perturb(csa); + perturb = 0; + } +#endif + 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"); +#if 0 /* 30/III-2016 */ + csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); + csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); +#else + spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); + csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); +#endif + 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 (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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); + 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); + } +#if 0 /* 30/III-2016 */ + csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); + csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); +#else + spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); + csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); +#endif + 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 (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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); + 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); + } +#if 0 /* 30/III-2016 */ + csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); + csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); +#else + spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); + csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); +#endif + csa->d_stat = (csa->phase == 1 ? GLP_INFEAS : GLP_FEAS); + ret = GLP_ETMLIM; + goto fini; + } + /* display the search progress */ + display(csa, 0); + /* select eligible basic variables */ +#if 0 /* 31/III-2016; not needed because r is valid */ + switch (csa->phase) + { case 1: +#if 0 /* 30/III-2016 */ + csa->num = spy_chuzr_sel(lp, beta, 1e-8, 0.0, list); +#else + spy_eval_r(lp, beta, 1e-8, 0.0, &csa->r); +#endif + break; + case 2: +#if 0 /* 30/III-2016 */ + csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, list); +#else + spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); +#endif + break; + default: + xassert(csa != csa); + } +#endif + /* check for optimality */ +#if 0 /* 30/III-2016 */ + if (csa->num == 0) +#else + if (csa->r.nnz == 0) +#endif + { if (perturb > 0 && csa->phase == 2) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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; + } +#if 1 /* 26/V-2017 by cmatraki */ + if (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 0; + goto loop; + } +#endif + /* no dual feasible solution exists */ + if (msg_lev >= GLP_MSG_ALL) + xprintf("LP HAS NO DUAL FEASIBLE SOLUTION\n"); + spx_eval_beta(lp, beta); +#if 0 /* 30/III-2016 */ + csa->num = spy_chuzr_sel(lp, beta, tol_bnd, tol_bnd1, + list); + csa->p_stat = (csa->num == 0 ? GLP_FEAS : GLP_INFEAS); +#else + spy_eval_r(lp, beta, tol_bnd, tol_bnd1, &csa->r); + csa->p_stat = (csa->r.nnz == 0 ? GLP_FEAS : GLP_INFEAS); +#endif + 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] */ +#if 0 /* 23/III-2016 */ + choose_pivot(csa); +#else +#ifdef TIMING + t_start = timer(); +#endif +#if 1 /* 31/III-2016 */ + ret = choose_pivot(csa); +#endif +#ifdef TIMING + t_rtest += timer() - t_start; +#endif + if (ret < 0) + { lp->valid = 0; + goto loop; + } + if (ret == 0) + csa->ns_cnt++; + else + csa->ls_cnt++; +#endif + /* check for dual unboundedness */ + if (csa->q == 0) + { if (perturb > 0) + { /* remove perturbation */ + remove_perturb(csa); + perturb = 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 */ +#ifdef TIMING + t_start = timer(); +#endif +#if 0 /* 31/III-2016 */ + spx_eval_tcol(lp, csa->q, tcol); +#else + spx_eval_tcol(lp, csa->q, csa->tcol.vec); + fvs_gather_vec(&csa->tcol, DBL_EPSILON); +#endif +#ifdef TIMING + t_pivcol += timer() - t_start; +#endif + /* FIXME: tcol[p] and trow[q] should be close to each other */ +#if 0 /* 26/V-2017 by cmatraki */ + xassert(csa->tcol.vec[csa->p] != 0.0); +#else + if (csa->tcol.vec[csa->p] == 0.0) + { if (msg_lev >= GLP_MSG_ERR) + xprintf("Error: tcol[p] = 0.0\n"); + csa->p_stat = csa->d_stat = GLP_UNDEF; + ret = GLP_EFAIL; + goto fini; + } +#endif + /* 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]); +#if 0 /* 16/III-2016 */ + spx_update_beta(lp, beta, csa->p, p_flag, csa->q, tcol); + csa->beta_st = 2; +#else + /* primal solution may be invalidated due to long step */ +#ifdef TIMING + t_start = timer(); +#endif + if (csa->beta_st) +#if 0 /* 30/III-2016 */ + { spx_update_beta(lp, beta, csa->p, p_flag, csa->q, tcol); +#else + { spx_update_beta_s(lp, beta, csa->p, p_flag, csa->q, + &csa->tcol); + /* also update vector r of primal infeasibilities */ + /*fvs_check_vec(&csa->r);*/ + switch (csa->phase) + { case 1: + spy_update_r(lp, csa->p, csa->q, beta, &csa->tcol, + 1e-8, 0.0, &csa->r); + break; + case 2: + spy_update_r(lp, csa->p, csa->q, beta, &csa->tcol, + tol_bnd, tol_bnd1, &csa->r); + break; + default: + xassert(csa != csa); + } + /*fvs_check_vec(&csa->r);*/ +#endif + csa->beta_st = 2; + } +#ifdef TIMING + t_upd1 += timer() - t_start; +#endif +#endif +#if 1 /* 11/VII-2017 */ + /* check for stalling */ + { int k; + xassert(1 <= csa->p && csa->p <= m); + xassert(1 <= csa->q && csa->q <= n-m); + /* FIXME: recompute d[q]; see spx_update_d */ + k = head[m+csa->q]; /* x[k] = xN[q] */ + if (!(lp->l[k] == -DBL_MAX && lp->u[k] == +DBL_MAX)) + { if (fabs(d[csa->q]) >= 1e-6) + { csa->degen = 0; + goto skip1; + } + /* degenerate iteration has been detected */ + csa->degen++; + if (perturb < 0 && csa->degen >= 200) + { if (msg_lev >= GLP_MSG_ALL) + xprintf("Perturbing LP to avoid stalling [%d]...\n", + csa->it_cnt); + perturb = 1; + } +skip1: ; + } + } +#endif + /* update reduced costs of non-basic variables for adjacent + * basis */ +#if 1 /* 28/III-2016 */ + xassert(csa->d_st); +#endif +#ifdef TIMING + t_start = timer(); +#endif +#if 0 /* 30/III-2016 */ + if (spx_update_d(lp, d, csa->p, csa->q, trow, tcol) <= 1e-9) +#else + if (spx_update_d_s(lp, d, csa->p, csa->q, &csa->trow, &csa->tcol) + <= 1e-9) +#endif + { /* successful updating */ + csa->d_st = 2; + } + else + { /* new reduced costs are inaccurate */ + csa->d_st = 0; + } +#ifdef TIMING + t_upd2 += timer() - t_start; +#endif + /* update steepest edge weights for adjacent basis, if used */ +#ifdef TIMING + t_start = timer(); +#endif + if (se != NULL) + { if (refct > 0) +#if 0 /* 30/III-2016 */ + { if (spy_update_gamma(lp, se, csa->p, csa->q, trow, tcol) + <= 1e-3) +#else + { if (spy_update_gamma_s(lp, se, csa->p, csa->q, &csa->trow, + &csa->tcol) <= 1e-3) +#endif + { /* successful updating */ + refct--; + } + else + { /* new weights are inaccurate; reset reference space */ + se->valid = 0; + } + } + else + { /* too many updates; reset reference space */ + se->valid = 0; + } + } +#ifdef TIMING + t_upd3 += timer() - t_start; +#endif +#ifdef TIMING + t_start = timer(); +#endif + /* update matrix N for adjacent basis, if used */ + if (nt != NULL) + spx_update_nt(lp, nt, csa->p, csa->q); +#ifdef TIMING + t_upd4 += timer() - t_start; +#endif + /* change current basis header to adjacent one */ + spx_change_basis(lp, csa->p, p_flag, csa->q); + /* and update factorization of the basis matrix */ +#ifdef TIMING + t_start = timer(); +#endif +#if 0 /* 16/III-2016 */ + if (csa->p > 0) +#endif + spx_update_invb(lp, csa->p, head[csa->p]); +#ifdef TIMING + t_upd5 += timer() - t_start; +#endif + if (perturb > 0 && csa->d_st) + play_coef(csa, 0); + /* dual simplex iteration complete */ + csa->it_cnt++; + goto loop; +fini: +#ifdef TIMING + t_total = timer() - t_total; + xprintf("Total time = %10.3f\n", t_total); + xprintf("Factorization = %10.3f\n", t_fact); + xprintf("Ratio test = %10.3f\n", t_rtest); + xprintf("Pivot column = %10.3f\n", t_pivcol); + xprintf("Updating beta = %10.3f\n", t_upd1); + xprintf("Updating d = %10.3f\n", t_upd2); + xprintf("Updating gamma = %10.3f\n", t_upd3); + xprintf("Updating N = %10.3f\n", t_upd4); + xprintf("Updating inv(B) = %10.3f\n", t_upd5); +#endif + return ret; +} + +int spy_dual(glp_prob *P, const glp_smcp *parm) +{ /* driver to the dual simplex method */ + struct csa csa_, *csa = &csa_; + SPXLP lp; + SPXAT at; + SPXNT nt; + SPYSE se; + int ret, *map, *daeh; +#if SCALE_Z + int i, j, k; +#endif + /* build working LP and its initial basis */ + memset(csa, 0, sizeof(struct csa)); + csa->lp = &lp; + spx_init_lp(csa->lp, P, parm->excl); + spx_alloc_lp(csa->lp); + map = talloc(1+P->m+P->n, int); + spx_build_lp(csa->lp, P, parm->excl, parm->shift, map); + spx_build_basis(csa->lp, P, map); + switch (P->dir) + { case GLP_MIN: + csa->dir = +1; + break; + case GLP_MAX: + csa->dir = -1; + break; + default: + xassert(P != P); + } +#if SCALE_Z + csa->fz = 0.0; + for (k = 1; k <= csa->lp->n; k++) + { double t = fabs(csa->lp->c[k]); + if (csa->fz < t) + csa->fz = t; + } + if (csa->fz <= 1000.0) + csa->fz = 1.0; + else + csa->fz /= 1000.0; + /*xprintf("csa->fz = %g\n", csa->fz);*/ + for (k = 0; k <= csa->lp->n; k++) + csa->lp->c[k] /= csa->fz; +#endif + csa->orig_b = talloc(1+csa->lp->m, double); + memcpy(csa->orig_b, csa->lp->b, (1+csa->lp->m) * sizeof(double)); + csa->orig_c = talloc(1+csa->lp->n, double); + memcpy(csa->orig_c, csa->lp->c, (1+csa->lp->n) * sizeof(double)); + csa->orig_l = talloc(1+csa->lp->n, double); + memcpy(csa->orig_l, csa->lp->l, (1+csa->lp->n) * sizeof(double)); + csa->orig_u = talloc(1+csa->lp->n, double); + memcpy(csa->orig_u, csa->lp->u, (1+csa->lp->n) * sizeof(double)); + switch (parm->aorn) + { case GLP_USE_AT: + /* build matrix A in row-wise format */ + csa->at = &at; + csa->nt = NULL; + spx_alloc_at(csa->lp, csa->at); + spx_build_at(csa->lp, csa->at); + break; + case GLP_USE_NT: + /* build matrix N in row-wise format for initial basis */ + csa->at = NULL; + csa->nt = &nt; + spx_alloc_nt(csa->lp, csa->nt); + spx_init_nt(csa->lp, csa->nt); + spx_build_nt(csa->lp, csa->nt); + break; + default: + xassert(parm != parm); + } + /* allocate and initialize working components */ + csa->phase = 0; + csa->beta = talloc(1+csa->lp->m, double); + csa->beta_st = 0; + csa->d = talloc(1+csa->lp->n-csa->lp->m, double); + csa->d_st = 0; + switch (parm->pricing) + { case GLP_PT_STD: + csa->se = NULL; + break; + case GLP_PT_PSE: + csa->se = &se; + spy_alloc_se(csa->lp, csa->se); + break; + default: + xassert(parm != parm); + } +#if 0 /* 30/III-2016 */ + csa->list = talloc(1+csa->lp->m, int); + csa->trow = talloc(1+csa->lp->n-csa->lp->m, double); + csa->tcol = talloc(1+csa->lp->m, double); +#else + fvs_alloc_vec(&csa->r, csa->lp->m); + fvs_alloc_vec(&csa->trow, csa->lp->n-csa->lp->m); + fvs_alloc_vec(&csa->tcol, csa->lp->m); +#endif +#if 1 /* 16/III-2016 */ + csa->bp = NULL; +#endif + csa->work = talloc(1+csa->lp->m, double); + csa->work1 = talloc(1+csa->lp->n-csa->lp->m, double); +#if 0 /* 11/VI-2017 */ +#if 1 /* 31/III-2016 */ + fvs_alloc_vec(&csa->wrow, csa->lp->n-csa->lp->m); + fvs_alloc_vec(&csa->wcol, csa->lp->m); +#endif +#endif + /* initialize control parameters */ + csa->msg_lev = parm->msg_lev; + csa->dualp = (parm->meth == GLP_DUALP); +#if 0 /* 16/III-2016 */ + switch (parm->r_test) + { case GLP_RT_STD: + csa->harris = 0; + break; + case GLP_RT_HAR: + csa->harris = 1; + break; + default: + xassert(parm != parm); + } +#else + switch (parm->r_test) + { case GLP_RT_STD: + case GLP_RT_HAR: + break; + case GLP_RT_FLIP: + csa->bp = talloc(1+csa->lp->n-csa->lp->m, SPYBP); + break; + default: + xassert(parm != parm); + } + csa->r_test = parm->r_test; +#endif + csa->tol_bnd = parm->tol_bnd; + csa->tol_bnd1 = .001 * parm->tol_bnd; + csa->tol_dj = parm->tol_dj; + csa->tol_dj1 = .001 * parm->tol_dj; +#if 0 + csa->tol_dj1 = 1e-9 * parm->tol_dj; +#endif + csa->tol_piv = parm->tol_piv; + switch (P->dir) + { case GLP_MIN: + csa->obj_lim = + parm->obj_ul; + break; + case GLP_MAX: + csa->obj_lim = - parm->obj_ll; + break; + default: + xassert(parm != parm); + } +#if SCALE_Z + if (csa->obj_lim != DBL_MAX) + csa->obj_lim /= csa->fz; +#endif + csa->it_lim = parm->it_lim; + csa->tm_lim = parm->tm_lim; + csa->out_frq = parm->out_frq; + csa->out_dly = parm->out_dly; + /* initialize working parameters */ + csa->tm_beg = xtime(); + csa->it_beg = csa->it_cnt = P->it_cnt; + csa->it_dpy = -1; +#if 1 /* 15/VII-2017 */ + csa->tm_dpy = 0.0; +#endif + csa->inv_cnt = 0; +#if 1 /* 11/VII-2017 */ + csa->degen = 0; +#endif +#if 1 /* 23/III-2016 */ + csa->ns_cnt = csa->ls_cnt = 0; +#endif + /* try to solve working LP */ + ret = dual_simplex(csa); + /* return basis factorization back to problem object */ + P->valid = csa->lp->valid; + P->bfd = csa->lp->bfd; + /* set solution status */ + P->pbs_stat = csa->p_stat; + P->dbs_stat = csa->d_stat; + /* if the solver failed, do not store basis header and basic + * solution components to problem object */ + if (ret == GLP_EFAIL) + goto skip; + /* convert working LP basis to original LP basis and store it to + * problem object */ + daeh = talloc(1+csa->lp->n, int); + spx_store_basis(csa->lp, P, map, daeh); + /* compute simplex multipliers for final basic solution found by + * the solver */ + spx_eval_pi(csa->lp, csa->work); + /* convert working LP solution to original LP solution and store + * it to problem object */ +#if SCALE_Z + for (i = 1; i <= csa->lp->m; i++) + csa->work[i] *= csa->fz; + for (j = 1; j <= csa->lp->n-csa->lp->m; j++) + csa->d[j] *= csa->fz; +#endif + spx_store_sol(csa->lp, P, parm->shift, map, daeh, csa->beta, + csa->work, csa->d); + tfree(daeh); + /* save simplex iteration count */ + P->it_cnt = csa->it_cnt; + /* report auxiliary/structural variable causing unboundedness */ + P->some = 0; + if (csa->p_stat == GLP_NOFEAS && csa->d_stat == GLP_FEAS) + { int k, kk; + /* xB[p] = x[k] causes dual unboundedness */ + xassert(1 <= csa->p && csa->p <= csa->lp->m); + k = csa->lp->head[csa->p]; + xassert(1 <= k && k <= csa->lp->n); + /* convert to number of original variable */ + for (kk = 1; kk <= P->m + P->n; kk++) + { if (abs(map[kk]) == k) + { P->some = kk; + break; + } + } + xassert(P->some != 0); + } +skip: /* deallocate working objects and arrays */ + spx_free_lp(csa->lp); + tfree(map); + tfree(csa->orig_b); + tfree(csa->orig_c); + tfree(csa->orig_l); + tfree(csa->orig_u); + if (csa->at != NULL) + spx_free_at(csa->lp, csa->at); + if (csa->nt != NULL) + spx_free_nt(csa->lp, csa->nt); + tfree(csa->beta); + tfree(csa->d); + if (csa->se != NULL) + spy_free_se(csa->lp, csa->se); +#if 0 /* 30/III-2016 */ + tfree(csa->list); + tfree(csa->trow); +#else + fvs_free_vec(&csa->r); + fvs_free_vec(&csa->trow); +#endif +#if 1 /* 16/III-2016 */ + if (csa->bp != NULL) + tfree(csa->bp); +#endif +#if 0 /* 29/III-2016 */ + tfree(csa->tcol); +#else + fvs_free_vec(&csa->tcol); +#endif + tfree(csa->work); + tfree(csa->work1); +#if 0 /* 11/VI-2017 */ +#if 1 /* 31/III-2016 */ + fvs_free_vec(&csa->wrow); + fvs_free_vec(&csa->wcol); +#endif +#endif + /* return to calling program */ + return ret >= 0 ? ret : GLP_EFAIL; +} + +/* eof */ |