diff options
Diffstat (limited to 'test/monniaux/glpk-4.65/src/draft')
36 files changed, 20679 insertions, 0 deletions
diff --git a/test/monniaux/glpk-4.65/src/draft/bfd.c b/test/monniaux/glpk-4.65/src/draft/bfd.c new file mode 100644 index 00000000..dece376c --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/bfd.c @@ -0,0 +1,544 @@ +/* bfd.c (LP basis factorization driver) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2007, 2014 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 "glpk.h" +#include "env.h" +#include "bfd.h" +#include "fhvint.h" +#include "scfint.h" +#ifdef GLP_DEBUG +#include "glpspm.h" +#endif + +struct BFD +{ /* LP basis factorization driver */ + int valid; + /* factorization is valid only if this flag is set */ + int type; + /* type of factorization used: + 0 - interface not established yet + 1 - FHV-factorization + 2 - Schur-complement-based factorization */ + union + { void *none; /* type = 0 */ + FHVINT *fhvi; /* type = 1 */ + SCFINT *scfi; /* type = 2 */ + } u; + /* interface to factorization of LP basis */ + glp_bfcp parm; + /* factorization control parameters */ +#ifdef GLP_DEBUG + SPM *B; + /* current basis (for testing/debugging only) */ +#endif + int upd_cnt; + /* factorization update count */ +#if 1 /* 21/IV-2014 */ + double b_norm; + /* 1-norm of matrix B */ + double i_norm; + /* estimated 1-norm of matrix inv(B) */ +#endif +}; + +BFD *bfd_create_it(void) +{ /* create LP basis factorization */ + BFD *bfd; +#ifdef GLP_DEBUG + xprintf("bfd_create_it: warning: debugging version used\n"); +#endif + bfd = talloc(1, BFD); + bfd->valid = 0; + bfd->type = 0; + bfd->u.none = NULL; + bfd_set_bfcp(bfd, NULL); +#ifdef GLP_DEBUG + bfd->B = NULL; +#endif + bfd->upd_cnt = 0; + return bfd; +} + +#if 0 /* 08/III-2014 */ +void bfd_set_parm(BFD *bfd, const void *parm) +{ /* change LP basis factorization control parameters */ + memcpy(&bfd->parm, parm, sizeof(glp_bfcp)); + return; +} +#endif + +void bfd_get_bfcp(BFD *bfd, void /* glp_bfcp */ *parm) +{ /* retrieve LP basis factorization control parameters */ + memcpy(parm, &bfd->parm, sizeof(glp_bfcp)); + return; +} + +void bfd_set_bfcp(BFD *bfd, const void /* glp_bfcp */ *parm) +{ /* change LP basis factorization control parameters */ + if (parm == NULL) + { /* reset to default */ + memset(&bfd->parm, 0, sizeof(glp_bfcp)); + bfd->parm.type = GLP_BF_LUF + GLP_BF_FT; + bfd->parm.piv_tol = 0.10; + bfd->parm.piv_lim = 4; + bfd->parm.suhl = 1; + bfd->parm.eps_tol = DBL_EPSILON; + bfd->parm.nfs_max = 100; + bfd->parm.nrs_max = 70; + } + else + memcpy(&bfd->parm, parm, sizeof(glp_bfcp)); + return; +} + +#if 1 /* 21/IV-2014 */ +struct bfd_info +{ BFD *bfd; + int (*col)(void *info, int j, int ind[], double val[]); + void *info; +}; + +static int bfd_col(void *info_, int j, int ind[], double val[]) +{ struct bfd_info *info = info_; + int t, len; + double sum; + len = info->col(info->info, j, ind, val); + sum = 0.0; + for (t = 1; t <= len; t++) + { if (val[t] >= 0.0) + sum += val[t]; + else + sum -= val[t]; + } + if (info->bfd->b_norm < sum) + info->bfd->b_norm = sum; + return len; +} +#endif + +int bfd_factorize(BFD *bfd, int m, /*const int bh[],*/ int (*col1) + (void *info, int j, int ind[], double val[]), void *info1) +{ /* compute LP basis factorization */ +#if 1 /* 21/IV-2014 */ + struct bfd_info info; +#endif + int type, ret; + /*xassert(bh == bh);*/ + /* invalidate current factorization */ + bfd->valid = 0; + /* determine required factorization type */ + switch (bfd->parm.type) + { case GLP_BF_LUF + GLP_BF_FT: + type = 1; + break; + case GLP_BF_LUF + GLP_BF_BG: + case GLP_BF_LUF + GLP_BF_GR: + case GLP_BF_BTF + GLP_BF_BG: + case GLP_BF_BTF + GLP_BF_GR: + type = 2; + break; + default: + xassert(bfd != bfd); + } + /* delete factorization interface, if necessary */ + switch (bfd->type) + { case 0: + break; + case 1: + if (type != 1) + { bfd->type = 0; + fhvint_delete(bfd->u.fhvi); + bfd->u.fhvi = NULL; + } + break; + case 2: + if (type != 2) + { bfd->type = 0; + scfint_delete(bfd->u.scfi); + bfd->u.scfi = NULL; + } + break; + default: + xassert(bfd != bfd); + } + /* establish factorization interface, if necessary */ + if (bfd->type == 0) + { switch (type) + { case 1: + bfd->type = 1; + xassert(bfd->u.fhvi == NULL); + bfd->u.fhvi = fhvint_create(); + break; + case 2: + bfd->type = 2; + xassert(bfd->u.scfi == NULL); + if (!(bfd->parm.type & GLP_BF_BTF)) + bfd->u.scfi = scfint_create(1); + else + bfd->u.scfi = scfint_create(2); + break; + default: + xassert(type != type); + } + } + /* try to compute factorization */ +#if 1 /* 21/IV-2014 */ + bfd->b_norm = bfd->i_norm = 0.0; + info.bfd = bfd; + info.col = col1; + info.info = info1; +#endif + switch (bfd->type) + { case 1: + bfd->u.fhvi->lufi->sgf_piv_tol = bfd->parm.piv_tol; + bfd->u.fhvi->lufi->sgf_piv_lim = bfd->parm.piv_lim; + bfd->u.fhvi->lufi->sgf_suhl = bfd->parm.suhl; + bfd->u.fhvi->lufi->sgf_eps_tol = bfd->parm.eps_tol; + bfd->u.fhvi->nfs_max = bfd->parm.nfs_max; + ret = fhvint_factorize(bfd->u.fhvi, m, bfd_col, &info); +#if 1 /* FIXME */ + if (ret == 0) + bfd->i_norm = fhvint_estimate(bfd->u.fhvi); + else + ret = BFD_ESING; +#endif + break; + case 2: + if (bfd->u.scfi->scf.type == 1) + { bfd->u.scfi->u.lufi->sgf_piv_tol = bfd->parm.piv_tol; + bfd->u.scfi->u.lufi->sgf_piv_lim = bfd->parm.piv_lim; + bfd->u.scfi->u.lufi->sgf_suhl = bfd->parm.suhl; + bfd->u.scfi->u.lufi->sgf_eps_tol = bfd->parm.eps_tol; + } + else if (bfd->u.scfi->scf.type == 2) + { bfd->u.scfi->u.btfi->sgf_piv_tol = bfd->parm.piv_tol; + bfd->u.scfi->u.btfi->sgf_piv_lim = bfd->parm.piv_lim; + bfd->u.scfi->u.btfi->sgf_suhl = bfd->parm.suhl; + bfd->u.scfi->u.btfi->sgf_eps_tol = bfd->parm.eps_tol; + } + else + xassert(bfd != bfd); + bfd->u.scfi->nn_max = bfd->parm.nrs_max; + ret = scfint_factorize(bfd->u.scfi, m, bfd_col, &info); +#if 1 /* FIXME */ + if (ret == 0) + bfd->i_norm = scfint_estimate(bfd->u.scfi); + else + ret = BFD_ESING; +#endif + break; + default: + xassert(bfd != bfd); + } +#ifdef GLP_DEBUG + /* save specified LP basis */ + if (bfd->B != NULL) + spm_delete_mat(bfd->B); + bfd->B = spm_create_mat(m, m); + { int *ind = talloc(1+m, int); + double *val = talloc(1+m, double); + int j, k, len; + for (j = 1; j <= m; j++) + { len = col(info, j, ind, val); + for (k = 1; k <= len; k++) + spm_new_elem(bfd->B, ind[k], j, val[k]); + } + tfree(ind); + tfree(val); + } +#endif + if (ret == 0) + { /* factorization has been successfully computed */ + double cond; + bfd->valid = 1; +#ifdef GLP_DEBUG + cond = bfd_condest(bfd); + if (cond > 1e9) + xprintf("bfd_factorize: warning: cond(B) = %g\n", cond); +#endif + } +#ifdef GLP_DEBUG + xprintf("bfd_factorize: m = %d; ret = %d\n", m, ret); +#endif + bfd->upd_cnt = 0; + return ret; +} + +#if 0 /* 21/IV-2014 */ +double bfd_estimate(BFD *bfd) +{ /* estimate 1-norm of inv(B) */ + double norm; + xassert(bfd->valid); + xassert(bfd->upd_cnt == 0); + switch (bfd->type) + { case 1: + norm = fhvint_estimate(bfd->u.fhvi); + break; + case 2: + norm = scfint_estimate(bfd->u.scfi); + break; + default: + xassert(bfd != bfd); + } + return norm; +} +#endif + +#if 1 /* 21/IV-2014 */ +double bfd_condest(BFD *bfd) +{ /* estimate condition of B */ + double cond; + xassert(bfd->valid); + /*xassert(bfd->upd_cnt == 0);*/ + cond = bfd->b_norm * bfd->i_norm; + if (cond < 1.0) + cond = 1.0; + return cond; +} +#endif + +void bfd_ftran(BFD *bfd, double x[]) +{ /* perform forward transformation (solve system B * x = b) */ +#ifdef GLP_DEBUG + SPM *B = bfd->B; + int m = B->m; + double *b = talloc(1+m, double); + SPME *e; + int k; + double s, relerr, maxerr; + for (k = 1; k <= m; k++) + b[k] = x[k]; +#endif + xassert(bfd->valid); + switch (bfd->type) + { case 1: + fhvint_ftran(bfd->u.fhvi, x); + break; + case 2: + scfint_ftran(bfd->u.scfi, x); + break; + default: + xassert(bfd != bfd); + } +#ifdef GLP_DEBUG + maxerr = 0.0; + for (k = 1; k <= m; k++) + { s = 0.0; + for (e = B->row[k]; e != NULL; e = e->r_next) + s += e->val * x[e->j]; + relerr = (b[k] - s) / (1.0 + fabs(b[k])); + if (maxerr < relerr) + maxerr = relerr; + } + if (maxerr > 1e-8) + xprintf("bfd_ftran: maxerr = %g; relative error too large\n", + maxerr); + tfree(b); +#endif + return; +} + +#if 1 /* 30/III-2016 */ +void bfd_ftran_s(BFD *bfd, FVS *x) +{ /* sparse version of bfd_ftran */ + /* (sparse mode is not implemented yet) */ + int n = x->n; + int *ind = x->ind; + double *vec = x->vec; + int j, nnz = 0; + bfd_ftran(bfd, vec); + for (j = n; j >= 1; j--) + { if (vec[j] != 0.0) + ind[++nnz] = j; + } + x->nnz = nnz; + return; +} +#endif + +void bfd_btran(BFD *bfd, double x[]) +{ /* perform backward transformation (solve system B'* x = b) */ +#ifdef GLP_DEBUG + SPM *B = bfd->B; + int m = B->m; + double *b = talloc(1+m, double); + SPME *e; + int k; + double s, relerr, maxerr; + for (k = 1; k <= m; k++) + b[k] = x[k]; +#endif + xassert(bfd->valid); + switch (bfd->type) + { case 1: + fhvint_btran(bfd->u.fhvi, x); + break; + case 2: + scfint_btran(bfd->u.scfi, x); + break; + default: + xassert(bfd != bfd); + } +#ifdef GLP_DEBUG + maxerr = 0.0; + for (k = 1; k <= m; k++) + { s = 0.0; + for (e = B->col[k]; e != NULL; e = e->c_next) + s += e->val * x[e->i]; + relerr = (b[k] - s) / (1.0 + fabs(b[k])); + if (maxerr < relerr) + maxerr = relerr; + } + if (maxerr > 1e-8) + xprintf("bfd_btran: maxerr = %g; relative error too large\n", + maxerr); + tfree(b); +#endif + return; +} + +#if 1 /* 30/III-2016 */ +void bfd_btran_s(BFD *bfd, FVS *x) +{ /* sparse version of bfd_btran */ + /* (sparse mode is not implemented yet) */ + int n = x->n; + int *ind = x->ind; + double *vec = x->vec; + int j, nnz = 0; + bfd_btran(bfd, vec); + for (j = n; j >= 1; j--) + { if (vec[j] != 0.0) + ind[++nnz] = j; + } + x->nnz = nnz; + return; +} +#endif + +int bfd_update(BFD *bfd, int j, int len, const int ind[], const double + val[]) +{ /* update LP basis factorization */ + int ret; + xassert(bfd->valid); + switch (bfd->type) + { case 1: + ret = fhvint_update(bfd->u.fhvi, j, len, ind, val); +#if 1 /* FIXME */ + switch (ret) + { case 0: + break; + case 1: + ret = BFD_ESING; + break; + case 2: + case 3: + ret = BFD_ECOND; + break; + case 4: + ret = BFD_ELIMIT; + break; + case 5: + ret = BFD_ECHECK; + break; + default: + xassert(ret != ret); + } +#endif + break; + case 2: + switch (bfd->parm.type & 0x0F) + { case GLP_BF_BG: + ret = scfint_update(bfd->u.scfi, 1, j, len, ind, val); + break; + case GLP_BF_GR: + ret = scfint_update(bfd->u.scfi, 2, j, len, ind, val); + break; + default: + xassert(bfd != bfd); + } +#if 1 /* FIXME */ + switch (ret) + { case 0: + break; + case 1: + ret = BFD_ELIMIT; + break; + case 2: + ret = BFD_ECOND; + break; + default: + xassert(ret != ret); + } +#endif + break; + default: + xassert(bfd != bfd); + } + if (ret != 0) + { /* updating factorization failed */ + bfd->valid = 0; + } +#ifdef GLP_DEBUG + /* save updated LP basis */ + { SPME *e; + int k; + for (e = bfd->B->col[j]; e != NULL; e = e->c_next) + e->val = 0.0; + spm_drop_zeros(bfd->B, 0.0); + for (k = 1; k <= len; k++) + spm_new_elem(bfd->B, ind[k], j, val[k]); + } +#endif + if (ret == 0) + bfd->upd_cnt++; + return ret; +} + +int bfd_get_count(BFD *bfd) +{ /* determine factorization update count */ + return bfd->upd_cnt; +} + +void bfd_delete_it(BFD *bfd) +{ /* delete LP basis factorization */ + switch (bfd->type) + { case 0: + break; + case 1: + fhvint_delete(bfd->u.fhvi); + break; + case 2: + scfint_delete(bfd->u.scfi); + break; + default: + xassert(bfd != bfd); + } +#ifdef GLP_DEBUG + if (bfd->B != NULL) + spm_delete_mat(bfd->B); +#endif + tfree(bfd); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/bfd.h b/test/monniaux/glpk-4.65/src/draft/bfd.h new file mode 100644 index 00000000..0ef4c023 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/bfd.h @@ -0,0 +1,107 @@ +/* bfd.h (LP basis factorization driver) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 BFD_H +#define BFD_H + +#if 1 /* 30/III-2016 */ +#include "fvs.h" +#endif + +typedef struct BFD BFD; + +/* return codes: */ +#define BFD_ESING 1 /* singular matrix */ +#define BFD_ECOND 2 /* ill-conditioned matrix */ +#define BFD_ECHECK 3 /* insufficient accuracy */ +#define BFD_ELIMIT 4 /* update limit reached */ +#if 0 /* 05/III-2014 */ +#define BFD_EROOM 5 /* SVA overflow */ +#endif + +#define bfd_create_it _glp_bfd_create_it +BFD *bfd_create_it(void); +/* create LP basis factorization */ + +#if 0 /* 08/III-2014 */ +#define bfd_set_parm _glp_bfd_set_parm +void bfd_set_parm(BFD *bfd, const void *parm); +/* change LP basis factorization control parameters */ +#endif + +#define bfd_get_bfcp _glp_bfd_get_bfcp +void bfd_get_bfcp(BFD *bfd, void /* glp_bfcp */ *parm); +/* retrieve LP basis factorization control parameters */ + +#define bfd_set_bfcp _glp_bfd_set_bfcp +void bfd_set_bfcp(BFD *bfd, const void /* glp_bfcp */ *parm); +/* change LP basis factorization control parameters */ + +#define bfd_factorize _glp_bfd_factorize +int bfd_factorize(BFD *bfd, int m, /*const int bh[],*/ int (*col) + (void *info, int j, int ind[], double val[]), void *info); +/* compute LP basis factorization */ + +#if 1 /* 21/IV-2014 */ +#define bfd_condest _glp_bfd_condest +double bfd_condest(BFD *bfd); +/* estimate condition of B */ +#endif + +#define bfd_ftran _glp_bfd_ftran +void bfd_ftran(BFD *bfd, double x[]); +/* perform forward transformation (solve system B*x = b) */ + +#if 1 /* 30/III-2016 */ +#define bfd_ftran_s _glp_bfd_ftran_s +void bfd_ftran_s(BFD *bfd, FVS *x); +/* sparse version of bfd_ftran */ +#endif + +#define bfd_btran _glp_bfd_btran +void bfd_btran(BFD *bfd, double x[]); +/* perform backward transformation (solve system B'*x = b) */ + +#if 1 /* 30/III-2016 */ +#define bfd_btran_s _glp_bfd_btran_s +void bfd_btran_s(BFD *bfd, FVS *x); +/* sparse version of bfd_btran */ +#endif + +#define bfd_update _glp_bfd_update +int bfd_update(BFD *bfd, int j, int len, const int ind[], const double + val[]); +/* update LP basis factorization */ + +#define bfd_get_count _glp_bfd_get_count +int bfd_get_count(BFD *bfd); +/* determine factorization update count */ + +#define bfd_delete_it _glp_bfd_delete_it +void bfd_delete_it(BFD *bfd); +/* delete LP basis factorization */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/bfx.c b/test/monniaux/glpk-4.65/src/draft/bfx.c new file mode 100644 index 00000000..565480b6 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/bfx.c @@ -0,0 +1,89 @@ +/* bfx.c (LP basis factorization driver, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "bfx.h" +#include "env.h" +#include "lux.h" + +struct BFX +{ int valid; + LUX *lux; +}; + +BFX *bfx_create_binv(void) +{ /* create factorization of the basis matrix */ + BFX *bfx; + bfx = xmalloc(sizeof(BFX)); + bfx->valid = 0; + bfx->lux = NULL; + return bfx; +} + +int bfx_factorize(BFX *binv, int m, int (*col)(void *info, int j, + int ind[], mpq_t val[]), void *info) +{ /* compute factorization of the basis matrix */ + int ret; + xassert(m > 0); + if (binv->lux != NULL && binv->lux->n != m) + { lux_delete(binv->lux); + binv->lux = NULL; + } + if (binv->lux == NULL) + binv->lux = lux_create(m); + ret = lux_decomp(binv->lux, col, info); + binv->valid = (ret == 0); + return ret; +} + +void bfx_ftran(BFX *binv, mpq_t x[], int save) +{ /* perform forward transformation (FTRAN) */ + xassert(binv->valid); + lux_solve(binv->lux, 0, x); + xassert(save == save); + return; +} + +void bfx_btran(BFX *binv, mpq_t x[]) +{ /* perform backward transformation (BTRAN) */ + xassert(binv->valid); + lux_solve(binv->lux, 1, x); + return; +} + +int bfx_update(BFX *binv, int j) +{ /* update factorization of the basis matrix */ + xassert(binv->valid); + xassert(1 <= j && j <= binv->lux->n); + return 1; +} + +void bfx_delete_binv(BFX *binv) +{ /* delete factorization of the basis matrix */ + if (binv->lux != NULL) + lux_delete(binv->lux); + xfree(binv); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/bfx.h b/test/monniaux/glpk-4.65/src/draft/bfx.h new file mode 100644 index 00000000..c67d5ea4 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/bfx.h @@ -0,0 +1,67 @@ +/* bfx.h (LP basis factorization driver, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 BFX_H +#define BFX_H + +#include "mygmp.h" + +typedef struct BFX BFX; + +#define bfx_create_binv _glp_bfx_create_binv +BFX *bfx_create_binv(void); +/* create factorization of the basis matrix */ + +#define bfx_is_valid _glp_bfx_is_valid +int bfx_is_valid(BFX *binv); +/* check if factorization is valid */ + +#define bfx_invalidate _glp_bfx_invalidate +void bfx_invalidate(BFX *binv); +/* invalidate factorization of the basis matrix */ + +#define bfx_factorize _glp_bfx_factorize +int bfx_factorize(BFX *binv, int m, int (*col)(void *info, int j, + int ind[], mpq_t val[]), void *info); +/* compute factorization of the basis matrix */ + +#define bfx_ftran _glp_bfx_ftran +void bfx_ftran(BFX *binv, mpq_t x[], int save); +/* perform forward transformation (FTRAN) */ + +#define bfx_btran _glp_bfx_btran +void bfx_btran(BFX *binv, mpq_t x[]); +/* perform backward transformation (BTRAN) */ + +#define bfx_update _glp_bfx_update +int bfx_update(BFX *binv, int j); +/* update factorization of the basis matrix */ + +#define bfx_delete_binv _glp_bfx_delete_binv +void bfx_delete_binv(BFX *binv); +/* delete factorization of the basis matrix */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/draft.h b/test/monniaux/glpk-4.65/src/draft/draft.h new file mode 100644 index 00000000..cefd2124 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/draft.h @@ -0,0 +1,22 @@ +/* draft.h */ + +/* (reserved for copyright notice) */ + +#ifndef DRAFT_H +#define DRAFT_H + +#if 1 /* 28/III-2016 */ +#define GLP_UNDOC 1 +#endif +#include "glpk.h" + +#if 1 /* 28/XI-2009 */ +int _glp_analyze_row(glp_prob *P, int len, const int ind[], + const double val[], int type, double rhs, double eps, int *_piv, + double *_x, double *_dx, double *_y, double *_dy, double *_dz); +/* simulate one iteration of dual simplex method */ +#endif + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi06.c b/test/monniaux/glpk-4.65/src/draft/glpapi06.c new file mode 100644 index 00000000..a31e3968 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi06.c @@ -0,0 +1,860 @@ +/* glpapi06.c (simplex method routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" +#include "npp.h" +#if 0 /* 07/XI-2015 */ +#include "glpspx.h" +#else +#include "simplex.h" +#define spx_dual spy_dual +#endif + +/*********************************************************************** +* NAME +* +* glp_simplex - solve LP problem with the simplex method +* +* SYNOPSIS +* +* int glp_simplex(glp_prob *P, const glp_smcp *parm); +* +* DESCRIPTION +* +* The routine glp_simplex is a driver to the LP solver based on the +* simplex method. This routine retrieves problem data from the +* specified problem object, calls the solver to solve the problem +* instance, and stores results of computations back into the problem +* object. +* +* The simplex solver has a set of control parameters. Values of the +* control parameters can be passed in a structure glp_smcp, which the +* parameter parm points to. +* +* The parameter parm can be specified as NULL, in which case the LP +* solver uses default settings. +* +* RETURNS +* +* 0 The LP problem instance has been successfully solved. This code +* does not necessarily mean that the solver has found optimal +* solution. It only means that the solution process was successful. +* +* GLP_EBADB +* Unable to start the search, because the initial basis specified +* in the problem object is invalid--the number of basic (auxiliary +* and structural) variables is not the same as the number of rows in +* the problem object. +* +* GLP_ESING +* Unable to start the search, because the basis matrix correspodning +* to the initial basis is singular within the working precision. +* +* GLP_ECOND +* Unable to start the search, because the basis matrix correspodning +* to the initial basis is ill-conditioned, i.e. its condition number +* is too large. +* +* GLP_EBOUND +* Unable to start the search, because some double-bounded variables +* have incorrect bounds. +* +* GLP_EFAIL +* The search was prematurely terminated due to the solver failure. +* +* GLP_EOBJLL +* The search was prematurely terminated, because the objective +* function being maximized has reached its lower limit and continues +* decreasing (dual simplex only). +* +* GLP_EOBJUL +* The search was prematurely terminated, because the objective +* function being minimized has reached its upper limit and continues +* increasing (dual simplex only). +* +* GLP_EITLIM +* The search was prematurely terminated, because the simplex +* iteration limit has been exceeded. +* +* GLP_ETMLIM +* The search was prematurely terminated, because the time limit has +* been exceeded. +* +* GLP_ENOPFS +* The LP problem instance has no primal feasible solution (only if +* the LP presolver is used). +* +* GLP_ENODFS +* The LP problem instance has no dual feasible solution (only if the +* LP presolver is used). */ + +static void trivial_lp(glp_prob *P, const glp_smcp *parm) +{ /* solve trivial LP which has empty constraint matrix */ + GLPROW *row; + GLPCOL *col; + int i, j; + double p_infeas, d_infeas, zeta; + P->valid = 0; + P->pbs_stat = P->dbs_stat = GLP_FEAS; + P->obj_val = P->c0; + P->some = 0; + p_infeas = d_infeas = 0.0; + /* make all auxiliary variables basic */ + for (i = 1; i <= P->m; i++) + { row = P->row[i]; + row->stat = GLP_BS; + row->prim = row->dual = 0.0; + /* check primal feasibility */ + if (row->type == GLP_LO || row->type == GLP_DB || + row->type == GLP_FX) + { /* row has lower bound */ + if (row->lb > + parm->tol_bnd) + { P->pbs_stat = GLP_NOFEAS; + if (P->some == 0 && parm->meth != GLP_PRIMAL) + P->some = i; + } + if (p_infeas < + row->lb) + p_infeas = + row->lb; + } + if (row->type == GLP_UP || row->type == GLP_DB || + row->type == GLP_FX) + { /* row has upper bound */ + if (row->ub < - parm->tol_bnd) + { P->pbs_stat = GLP_NOFEAS; + if (P->some == 0 && parm->meth != GLP_PRIMAL) + P->some = i; + } + if (p_infeas < - row->ub) + p_infeas = - row->ub; + } + } + /* determine scale factor for the objective row */ + zeta = 1.0; + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (zeta < fabs(col->coef)) zeta = fabs(col->coef); + } + zeta = (P->dir == GLP_MIN ? +1.0 : -1.0) / zeta; + /* make all structural variables non-basic */ + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (col->type == GLP_FR) + col->stat = GLP_NF, col->prim = 0.0; + else if (col->type == GLP_LO) +lo: col->stat = GLP_NL, col->prim = col->lb; + else if (col->type == GLP_UP) +up: col->stat = GLP_NU, col->prim = col->ub; + else if (col->type == GLP_DB) + { if (zeta * col->coef > 0.0) + goto lo; + else if (zeta * col->coef < 0.0) + goto up; + else if (fabs(col->lb) <= fabs(col->ub)) + goto lo; + else + goto up; + } + else if (col->type == GLP_FX) + col->stat = GLP_NS, col->prim = col->lb; + col->dual = col->coef; + P->obj_val += col->coef * col->prim; + /* check dual feasibility */ + if (col->type == GLP_FR || col->type == GLP_LO) + { /* column has no upper bound */ + if (zeta * col->dual < - parm->tol_dj) + { P->dbs_stat = GLP_NOFEAS; + if (P->some == 0 && parm->meth == GLP_PRIMAL) + P->some = P->m + j; + } + if (d_infeas < - zeta * col->dual) + d_infeas = - zeta * col->dual; + } + if (col->type == GLP_FR || col->type == GLP_UP) + { /* column has no lower bound */ + if (zeta * col->dual > + parm->tol_dj) + { P->dbs_stat = GLP_NOFEAS; + if (P->some == 0 && parm->meth == GLP_PRIMAL) + P->some = P->m + j; + } + if (d_infeas < + zeta * col->dual) + d_infeas = + zeta * col->dual; + } + } + /* simulate the simplex solver output */ + if (parm->msg_lev >= GLP_MSG_ON && parm->out_dly == 0) + { xprintf("~%6d: obj = %17.9e infeas = %10.3e\n", P->it_cnt, + P->obj_val, parm->meth == GLP_PRIMAL ? p_infeas : d_infeas); + } + if (parm->msg_lev >= GLP_MSG_ALL && parm->out_dly == 0) + { if (P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS) + xprintf("OPTIMAL SOLUTION FOUND\n"); + else if (P->pbs_stat == GLP_NOFEAS) + xprintf("PROBLEM HAS NO FEASIBLE SOLUTION\n"); + else if (parm->meth == GLP_PRIMAL) + xprintf("PROBLEM HAS UNBOUNDED SOLUTION\n"); + else + xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION\n"); + } + return; +} + +static int solve_lp(glp_prob *P, const glp_smcp *parm) +{ /* solve LP directly without using the preprocessor */ + int ret; + if (!glp_bf_exists(P)) + { ret = glp_factorize(P); + if (ret == 0) + ; + else if (ret == GLP_EBADB) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_simplex: initial basis is invalid\n"); + } + else if (ret == GLP_ESING) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_simplex: initial basis is singular\n"); + } + else if (ret == GLP_ECOND) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf( + "glp_simplex: initial basis is ill-conditioned\n"); + } + else + xassert(ret != ret); + if (ret != 0) goto done; + } + if (parm->meth == GLP_PRIMAL) + ret = spx_primal(P, parm); + else if (parm->meth == GLP_DUALP) + { ret = spx_dual(P, parm); + if (ret == GLP_EFAIL && P->valid) + ret = spx_primal(P, parm); + } + else if (parm->meth == GLP_DUAL) + ret = spx_dual(P, parm); + else + xassert(parm != parm); +done: return ret; +} + +static int preprocess_and_solve_lp(glp_prob *P, const glp_smcp *parm) +{ /* solve LP using the preprocessor */ + NPP *npp; + glp_prob *lp = NULL; + glp_bfcp bfcp; + int ret; + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("Preprocessing...\n"); + /* create preprocessor workspace */ + npp = npp_create_wksp(); + /* load original problem into the preprocessor workspace */ + npp_load_prob(npp, P, GLP_OFF, GLP_SOL, GLP_OFF); + /* process LP prior to applying primal/dual simplex method */ + ret = npp_simplex(npp, parm); + if (ret == 0) + ; + else if (ret == GLP_ENOPFS) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION\n"); + } + else if (ret == GLP_ENODFS) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("PROBLEM HAS NO DUAL FEASIBLE SOLUTION\n"); + } + else + xassert(ret != ret); + if (ret != 0) goto done; + /* build transformed LP */ + lp = glp_create_prob(); + npp_build_prob(npp, lp); + /* if the transformed LP is empty, it has empty solution, which + is optimal */ + if (lp->m == 0 && lp->n == 0) + { lp->pbs_stat = lp->dbs_stat = GLP_FEAS; + lp->obj_val = lp->c0; + if (parm->msg_lev >= GLP_MSG_ON && parm->out_dly == 0) + { xprintf("~%6d: obj = %17.9e infeas = %10.3e\n", P->it_cnt, + lp->obj_val, 0.0); + } + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("OPTIMAL SOLUTION FOUND BY LP PREPROCESSOR\n"); + goto post; + } + if (parm->msg_lev >= GLP_MSG_ALL) + { xprintf("%d row%s, %d column%s, %d non-zero%s\n", + lp->m, lp->m == 1 ? "" : "s", lp->n, lp->n == 1 ? "" : "s", + lp->nnz, lp->nnz == 1 ? "" : "s"); + } + /* inherit basis factorization control parameters */ + glp_get_bfcp(P, &bfcp); + glp_set_bfcp(lp, &bfcp); + /* scale the transformed problem */ + { ENV *env = get_env_ptr(); + int term_out = env->term_out; + if (!term_out || parm->msg_lev < GLP_MSG_ALL) + env->term_out = GLP_OFF; + else + env->term_out = GLP_ON; + glp_scale_prob(lp, GLP_SF_AUTO); + env->term_out = term_out; + } + /* build advanced initial basis */ + { ENV *env = get_env_ptr(); + int term_out = env->term_out; + if (!term_out || parm->msg_lev < GLP_MSG_ALL) + env->term_out = GLP_OFF; + else + env->term_out = GLP_ON; + glp_adv_basis(lp, 0); + env->term_out = term_out; + } + /* solve the transformed LP */ + lp->it_cnt = P->it_cnt; + ret = solve_lp(lp, parm); + P->it_cnt = lp->it_cnt; + /* only optimal solution can be postprocessed */ + if (!(ret == 0 && lp->pbs_stat == GLP_FEAS && lp->dbs_stat == + GLP_FEAS)) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_simplex: unable to recover undefined or non-op" + "timal solution\n"); + if (ret == 0) + { if (lp->pbs_stat == GLP_NOFEAS) + ret = GLP_ENOPFS; + else if (lp->dbs_stat == GLP_NOFEAS) + ret = GLP_ENODFS; + else + xassert(lp != lp); + } + goto done; + } +post: /* postprocess solution from the transformed LP */ + npp_postprocess(npp, lp); + /* the transformed LP is no longer needed */ + glp_delete_prob(lp), lp = NULL; + /* store solution to the original problem */ + npp_unload_sol(npp, P); + /* the original LP has been successfully solved */ + ret = 0; +done: /* delete the transformed LP, if it exists */ + if (lp != NULL) glp_delete_prob(lp); + /* delete preprocessor workspace */ + npp_delete_wksp(npp); + return ret; +} + +int glp_simplex(glp_prob *P, const glp_smcp *parm) +{ /* solve LP problem with the simplex method */ + glp_smcp _parm; + int i, j, ret; + /* check problem object */ +#if 0 /* 04/IV-2016 */ + if (P == NULL || P->magic != GLP_PROB_MAGIC) + xerror("glp_simplex: P = %p; invalid problem object\n", P); +#endif + if (P->tree != NULL && P->tree->reason != 0) + xerror("glp_simplex: operation not allowed\n"); + /* check control parameters */ + if (parm == NULL) + parm = &_parm, glp_init_smcp((glp_smcp *)parm); + if (!(parm->msg_lev == GLP_MSG_OFF || + parm->msg_lev == GLP_MSG_ERR || + parm->msg_lev == GLP_MSG_ON || + parm->msg_lev == GLP_MSG_ALL || + parm->msg_lev == GLP_MSG_DBG)) + xerror("glp_simplex: msg_lev = %d; invalid parameter\n", + parm->msg_lev); + if (!(parm->meth == GLP_PRIMAL || + parm->meth == GLP_DUALP || + parm->meth == GLP_DUAL)) + xerror("glp_simplex: meth = %d; invalid parameter\n", + parm->meth); + if (!(parm->pricing == GLP_PT_STD || + parm->pricing == GLP_PT_PSE)) + xerror("glp_simplex: pricing = %d; invalid parameter\n", + parm->pricing); + if (!(parm->r_test == GLP_RT_STD || +#if 1 /* 16/III-2016 */ + parm->r_test == GLP_RT_FLIP || +#endif + parm->r_test == GLP_RT_HAR)) + xerror("glp_simplex: r_test = %d; invalid parameter\n", + parm->r_test); + if (!(0.0 < parm->tol_bnd && parm->tol_bnd < 1.0)) + xerror("glp_simplex: tol_bnd = %g; invalid parameter\n", + parm->tol_bnd); + if (!(0.0 < parm->tol_dj && parm->tol_dj < 1.0)) + xerror("glp_simplex: tol_dj = %g; invalid parameter\n", + parm->tol_dj); + if (!(0.0 < parm->tol_piv && parm->tol_piv < 1.0)) + xerror("glp_simplex: tol_piv = %g; invalid parameter\n", + parm->tol_piv); + if (parm->it_lim < 0) + xerror("glp_simplex: it_lim = %d; invalid parameter\n", + parm->it_lim); + if (parm->tm_lim < 0) + xerror("glp_simplex: tm_lim = %d; invalid parameter\n", + parm->tm_lim); +#if 0 /* 15/VII-2017 */ + if (parm->out_frq < 1) +#else + if (parm->out_frq < 0) +#endif + xerror("glp_simplex: out_frq = %d; invalid parameter\n", + parm->out_frq); + if (parm->out_dly < 0) + xerror("glp_simplex: out_dly = %d; invalid parameter\n", + parm->out_dly); + if (!(parm->presolve == GLP_ON || parm->presolve == GLP_OFF)) + xerror("glp_simplex: presolve = %d; invalid parameter\n", + parm->presolve); +#if 1 /* 11/VII-2017 */ + if (!(parm->excl == GLP_ON || parm->excl == GLP_OFF)) + xerror("glp_simplex: excl = %d; invalid parameter\n", + parm->excl); + if (!(parm->shift == GLP_ON || parm->shift == GLP_OFF)) + xerror("glp_simplex: shift = %d; invalid parameter\n", + parm->shift); + if (!(parm->aorn == GLP_USE_AT || parm->aorn == GLP_USE_NT)) + xerror("glp_simplex: aorn = %d; invalid parameter\n", + parm->aorn); +#endif + /* basic solution is currently undefined */ + P->pbs_stat = P->dbs_stat = GLP_UNDEF; + P->obj_val = 0.0; + P->some = 0; + /* check bounds of double-bounded variables */ + for (i = 1; i <= P->m; i++) + { GLPROW *row = P->row[i]; + if (row->type == GLP_DB && row->lb >= row->ub) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_simplex: row %d: lb = %g, ub = %g; incorrec" + "t bounds\n", i, row->lb, row->ub); + ret = GLP_EBOUND; + goto done; + } + } + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + if (col->type == GLP_DB && col->lb >= col->ub) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_simplex: column %d: lb = %g, ub = %g; incor" + "rect bounds\n", j, col->lb, col->ub); + ret = GLP_EBOUND; + goto done; + } + } + /* solve LP problem */ + if (parm->msg_lev >= GLP_MSG_ALL) + { xprintf("GLPK Simplex Optimizer, v%s\n", glp_version()); + xprintf("%d row%s, %d column%s, %d non-zero%s\n", + P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", + P->nnz, P->nnz == 1 ? "" : "s"); + } + if (P->nnz == 0) + trivial_lp(P, parm), ret = 0; + else if (!parm->presolve) + ret = solve_lp(P, parm); + else + ret = preprocess_and_solve_lp(P, parm); +done: /* return to the application program */ + return ret; +} + +/*********************************************************************** +* NAME +* +* glp_init_smcp - initialize simplex method control parameters +* +* SYNOPSIS +* +* void glp_init_smcp(glp_smcp *parm); +* +* DESCRIPTION +* +* The routine glp_init_smcp initializes control parameters, which are +* used by the simplex solver, with default values. +* +* Default values of the control parameters are stored in a glp_smcp +* structure, which the parameter parm points to. */ + +void glp_init_smcp(glp_smcp *parm) +{ parm->msg_lev = GLP_MSG_ALL; + parm->meth = GLP_PRIMAL; + parm->pricing = GLP_PT_PSE; + parm->r_test = GLP_RT_HAR; + parm->tol_bnd = 1e-7; + parm->tol_dj = 1e-7; +#if 0 /* 07/XI-2015 */ + parm->tol_piv = 1e-10; +#else + parm->tol_piv = 1e-9; +#endif + parm->obj_ll = -DBL_MAX; + parm->obj_ul = +DBL_MAX; + parm->it_lim = INT_MAX; + parm->tm_lim = INT_MAX; +#if 0 /* 15/VII-2017 */ + parm->out_frq = 500; +#else + parm->out_frq = 5000; /* 5 seconds */ +#endif + parm->out_dly = 0; + parm->presolve = GLP_OFF; +#if 1 /* 11/VII-2017 */ + parm->excl = GLP_ON; + parm->shift = GLP_ON; + parm->aorn = GLP_USE_NT; +#endif + return; +} + +/*********************************************************************** +* NAME +* +* glp_get_status - retrieve generic status of basic solution +* +* SYNOPSIS +* +* int glp_get_status(glp_prob *lp); +* +* RETURNS +* +* The routine glp_get_status reports the generic status of the basic +* solution for the specified problem object as follows: +* +* GLP_OPT - solution is optimal; +* GLP_FEAS - solution is feasible; +* GLP_INFEAS - solution is infeasible; +* GLP_NOFEAS - problem has no feasible solution; +* GLP_UNBND - problem has unbounded solution; +* GLP_UNDEF - solution is undefined. */ + +int glp_get_status(glp_prob *lp) +{ int status; + status = glp_get_prim_stat(lp); + switch (status) + { case GLP_FEAS: + switch (glp_get_dual_stat(lp)) + { case GLP_FEAS: + status = GLP_OPT; + break; + case GLP_NOFEAS: + status = GLP_UNBND; + break; + case GLP_UNDEF: + case GLP_INFEAS: + status = status; + break; + default: + xassert(lp != lp); + } + break; + case GLP_UNDEF: + case GLP_INFEAS: + case GLP_NOFEAS: + status = status; + break; + default: + xassert(lp != lp); + } + return status; +} + +/*********************************************************************** +* NAME +* +* glp_get_prim_stat - retrieve status of primal basic solution +* +* SYNOPSIS +* +* int glp_get_prim_stat(glp_prob *lp); +* +* RETURNS +* +* The routine glp_get_prim_stat reports the status of the primal basic +* solution for the specified problem object as follows: +* +* GLP_UNDEF - primal solution is undefined; +* GLP_FEAS - primal solution is feasible; +* GLP_INFEAS - primal solution is infeasible; +* GLP_NOFEAS - no primal feasible solution exists. */ + +int glp_get_prim_stat(glp_prob *lp) +{ int pbs_stat = lp->pbs_stat; + return pbs_stat; +} + +/*********************************************************************** +* NAME +* +* glp_get_dual_stat - retrieve status of dual basic solution +* +* SYNOPSIS +* +* int glp_get_dual_stat(glp_prob *lp); +* +* RETURNS +* +* The routine glp_get_dual_stat reports the status of the dual basic +* solution for the specified problem object as follows: +* +* GLP_UNDEF - dual solution is undefined; +* GLP_FEAS - dual solution is feasible; +* GLP_INFEAS - dual solution is infeasible; +* GLP_NOFEAS - no dual feasible solution exists. */ + +int glp_get_dual_stat(glp_prob *lp) +{ int dbs_stat = lp->dbs_stat; + return dbs_stat; +} + +/*********************************************************************** +* NAME +* +* glp_get_obj_val - retrieve objective value (basic solution) +* +* SYNOPSIS +* +* double glp_get_obj_val(glp_prob *lp); +* +* RETURNS +* +* The routine glp_get_obj_val returns value of the objective function +* for basic solution. */ + +double glp_get_obj_val(glp_prob *lp) +{ /*struct LPXCPS *cps = lp->cps;*/ + double z; + z = lp->obj_val; + /*if (cps->round && fabs(z) < 1e-9) z = 0.0;*/ + return z; +} + +/*********************************************************************** +* NAME +* +* glp_get_row_stat - retrieve row status +* +* SYNOPSIS +* +* int glp_get_row_stat(glp_prob *lp, int i); +* +* RETURNS +* +* The routine glp_get_row_stat returns current status assigned to the +* auxiliary variable associated with i-th row as follows: +* +* GLP_BS - basic variable; +* GLP_NL - non-basic variable on its lower bound; +* GLP_NU - non-basic variable on its upper bound; +* GLP_NF - non-basic free (unbounded) variable; +* GLP_NS - non-basic fixed variable. */ + +int glp_get_row_stat(glp_prob *lp, int i) +{ if (!(1 <= i && i <= lp->m)) + xerror("glp_get_row_stat: i = %d; row number out of range\n", + i); + return lp->row[i]->stat; +} + +/*********************************************************************** +* NAME +* +* glp_get_row_prim - retrieve row primal value (basic solution) +* +* SYNOPSIS +* +* double glp_get_row_prim(glp_prob *lp, int i); +* +* RETURNS +* +* The routine glp_get_row_prim returns primal value of the auxiliary +* variable associated with i-th row. */ + +double glp_get_row_prim(glp_prob *lp, int i) +{ /*struct LPXCPS *cps = lp->cps;*/ + double prim; + if (!(1 <= i && i <= lp->m)) + xerror("glp_get_row_prim: i = %d; row number out of range\n", + i); + prim = lp->row[i]->prim; + /*if (cps->round && fabs(prim) < 1e-9) prim = 0.0;*/ + return prim; +} + +/*********************************************************************** +* NAME +* +* glp_get_row_dual - retrieve row dual value (basic solution) +* +* SYNOPSIS +* +* double glp_get_row_dual(glp_prob *lp, int i); +* +* RETURNS +* +* The routine glp_get_row_dual returns dual value (i.e. reduced cost) +* of the auxiliary variable associated with i-th row. */ + +double glp_get_row_dual(glp_prob *lp, int i) +{ /*struct LPXCPS *cps = lp->cps;*/ + double dual; + if (!(1 <= i && i <= lp->m)) + xerror("glp_get_row_dual: i = %d; row number out of range\n", + i); + dual = lp->row[i]->dual; + /*if (cps->round && fabs(dual) < 1e-9) dual = 0.0;*/ + return dual; +} + +/*********************************************************************** +* NAME +* +* glp_get_col_stat - retrieve column status +* +* SYNOPSIS +* +* int glp_get_col_stat(glp_prob *lp, int j); +* +* RETURNS +* +* The routine glp_get_col_stat returns current status assigned to the +* structural variable associated with j-th column as follows: +* +* GLP_BS - basic variable; +* GLP_NL - non-basic variable on its lower bound; +* GLP_NU - non-basic variable on its upper bound; +* GLP_NF - non-basic free (unbounded) variable; +* GLP_NS - non-basic fixed variable. */ + +int glp_get_col_stat(glp_prob *lp, int j) +{ if (!(1 <= j && j <= lp->n)) + xerror("glp_get_col_stat: j = %d; column number out of range\n" + , j); + return lp->col[j]->stat; +} + +/*********************************************************************** +* NAME +* +* glp_get_col_prim - retrieve column primal value (basic solution) +* +* SYNOPSIS +* +* double glp_get_col_prim(glp_prob *lp, int j); +* +* RETURNS +* +* The routine glp_get_col_prim returns primal value of the structural +* variable associated with j-th column. */ + +double glp_get_col_prim(glp_prob *lp, int j) +{ /*struct LPXCPS *cps = lp->cps;*/ + double prim; + if (!(1 <= j && j <= lp->n)) + xerror("glp_get_col_prim: j = %d; column number out of range\n" + , j); + prim = lp->col[j]->prim; + /*if (cps->round && fabs(prim) < 1e-9) prim = 0.0;*/ + return prim; +} + +/*********************************************************************** +* NAME +* +* glp_get_col_dual - retrieve column dual value (basic solution) +* +* SYNOPSIS +* +* double glp_get_col_dual(glp_prob *lp, int j); +* +* RETURNS +* +* The routine glp_get_col_dual returns dual value (i.e. reduced cost) +* of the structural variable associated with j-th column. */ + +double glp_get_col_dual(glp_prob *lp, int j) +{ /*struct LPXCPS *cps = lp->cps;*/ + double dual; + if (!(1 <= j && j <= lp->n)) + xerror("glp_get_col_dual: j = %d; column number out of range\n" + , j); + dual = lp->col[j]->dual; + /*if (cps->round && fabs(dual) < 1e-9) dual = 0.0;*/ + return dual; +} + +/*********************************************************************** +* NAME +* +* glp_get_unbnd_ray - determine variable causing unboundedness +* +* SYNOPSIS +* +* int glp_get_unbnd_ray(glp_prob *lp); +* +* RETURNS +* +* The routine glp_get_unbnd_ray returns the number k of a variable, +* which causes primal or dual unboundedness. If 1 <= k <= m, it is +* k-th auxiliary variable, and if m+1 <= k <= m+n, it is (k-m)-th +* structural variable, where m is the number of rows, n is the number +* of columns in the problem object. If such variable is not defined, +* the routine returns 0. +* +* COMMENTS +* +* If it is not exactly known which version of the simplex solver +* detected unboundedness, i.e. whether the unboundedness is primal or +* dual, it is sufficient to check the status of the variable reported +* with the routine glp_get_row_stat or glp_get_col_stat. If the +* variable is non-basic, the unboundedness is primal, otherwise, if +* the variable is basic, the unboundedness is dual (the latter case +* means that the problem has no primal feasible dolution). */ + +int glp_get_unbnd_ray(glp_prob *lp) +{ int k; + k = lp->some; + xassert(k >= 0); + if (k > lp->m + lp->n) k = 0; + return k; +} + +#if 1 /* 08/VIII-2013 */ +int glp_get_it_cnt(glp_prob *P) +{ /* get simplex solver iteration count */ + return P->it_cnt; +} +#endif + +#if 1 /* 08/VIII-2013 */ +void glp_set_it_cnt(glp_prob *P, int it_cnt) +{ /* set simplex solver iteration count */ + P->it_cnt = it_cnt; + return; +} +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi07.c b/test/monniaux/glpk-4.65/src/draft/glpapi07.c new file mode 100644 index 00000000..9ac294bd --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi07.c @@ -0,0 +1,499 @@ +/* glpapi07.c (exact simplex solver) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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/>. +***********************************************************************/ + +#include "draft.h" +#include "glpssx.h" +#include "misc.h" +#include "prob.h" + +/*********************************************************************** +* NAME +* +* glp_exact - solve LP problem in exact arithmetic +* +* SYNOPSIS +* +* int glp_exact(glp_prob *lp, const glp_smcp *parm); +* +* DESCRIPTION +* +* The routine glp_exact is a tentative implementation of the primal +* two-phase simplex method based on exact (rational) arithmetic. It is +* similar to the routine glp_simplex, however, for all internal +* computations it uses arithmetic of rational numbers, which is exact +* in mathematical sense, i.e. free of round-off errors unlike floating +* point arithmetic. +* +* Note that the routine glp_exact uses inly two control parameters +* passed in the structure glp_smcp, namely, it_lim and tm_lim. +* +* RETURNS +* +* 0 The LP problem instance has been successfully solved. This code +* does not necessarily mean that the solver has found optimal +* solution. It only means that the solution process was successful. +* +* GLP_EBADB +* Unable to start the search, because the initial basis specified +* in the problem object is invalid--the number of basic (auxiliary +* and structural) variables is not the same as the number of rows in +* the problem object. +* +* GLP_ESING +* Unable to start the search, because the basis matrix correspodning +* to the initial basis is exactly singular. +* +* GLP_EBOUND +* Unable to start the search, because some double-bounded variables +* have incorrect bounds. +* +* GLP_EFAIL +* The problem has no rows/columns. +* +* GLP_EITLIM +* The search was prematurely terminated, because the simplex +* iteration limit has been exceeded. +* +* GLP_ETMLIM +* The search was prematurely terminated, because the time limit has +* been exceeded. */ + +static void set_d_eps(mpq_t x, double val) +{ /* convert double val to rational x obtaining a more adequate + fraction than provided by mpq_set_d due to allowing a small + approximation error specified by a given relative tolerance; + for example, mpq_set_d would give the following + 1/3 ~= 0.333333333333333314829616256247391... -> + -> 6004799503160661/18014398509481984 + while this routine gives exactly 1/3 */ + int s, n, j; + double f, p, q, eps = 1e-9; + mpq_t temp; + xassert(-DBL_MAX <= val && val <= +DBL_MAX); +#if 1 /* 30/VII-2008 */ + if (val == floor(val)) + { /* if val is integral, do not approximate */ + mpq_set_d(x, val); + goto done; + } +#endif + if (val > 0.0) + s = +1; + else if (val < 0.0) + s = -1; + else + { mpq_set_si(x, 0, 1); + goto done; + } + f = frexp(fabs(val), &n); + /* |val| = f * 2^n, where 0.5 <= f < 1.0 */ + fp2rat(f, 0.1 * eps, &p, &q); + /* f ~= p / q, where p and q are integers */ + mpq_init(temp); + mpq_set_d(x, p); + mpq_set_d(temp, q); + mpq_div(x, x, temp); + mpq_set_si(temp, 1, 1); + for (j = 1; j <= abs(n); j++) + mpq_add(temp, temp, temp); + if (n > 0) + mpq_mul(x, x, temp); + else if (n < 0) + mpq_div(x, x, temp); + mpq_clear(temp); + if (s < 0) mpq_neg(x, x); + /* check that the desired tolerance has been attained */ + xassert(fabs(val - mpq_get_d(x)) <= eps * (1.0 + fabs(val))); +done: return; +} + +static void load_data(SSX *ssx, glp_prob *lp) +{ /* load LP problem data into simplex solver workspace */ + int m = ssx->m; + int n = ssx->n; + int nnz = ssx->A_ptr[n+1]-1; + int j, k, type, loc, len, *ind; + double lb, ub, coef, *val; + xassert(lp->m == m); + xassert(lp->n == n); + xassert(lp->nnz == nnz); + /* types and bounds of rows and columns */ + for (k = 1; k <= m+n; k++) + { if (k <= m) + { type = lp->row[k]->type; + lb = lp->row[k]->lb; + ub = lp->row[k]->ub; + } + else + { type = lp->col[k-m]->type; + lb = lp->col[k-m]->lb; + ub = lp->col[k-m]->ub; + } + switch (type) + { case GLP_FR: type = SSX_FR; break; + case GLP_LO: type = SSX_LO; break; + case GLP_UP: type = SSX_UP; break; + case GLP_DB: type = SSX_DB; break; + case GLP_FX: type = SSX_FX; break; + default: xassert(type != type); + } + ssx->type[k] = type; + set_d_eps(ssx->lb[k], lb); + set_d_eps(ssx->ub[k], ub); + } + /* optimization direction */ + switch (lp->dir) + { case GLP_MIN: ssx->dir = SSX_MIN; break; + case GLP_MAX: ssx->dir = SSX_MAX; break; + default: xassert(lp != lp); + } + /* objective coefficients */ + for (k = 0; k <= m+n; k++) + { if (k == 0) + coef = lp->c0; + else if (k <= m) + coef = 0.0; + else + coef = lp->col[k-m]->coef; + set_d_eps(ssx->coef[k], coef); + } + /* constraint coefficients */ + ind = xcalloc(1+m, sizeof(int)); + val = xcalloc(1+m, sizeof(double)); + loc = 0; + for (j = 1; j <= n; j++) + { ssx->A_ptr[j] = loc+1; + len = glp_get_mat_col(lp, j, ind, val); + for (k = 1; k <= len; k++) + { loc++; + ssx->A_ind[loc] = ind[k]; + set_d_eps(ssx->A_val[loc], val[k]); + } + } + xassert(loc == nnz); + xfree(ind); + xfree(val); + return; +} + +static int load_basis(SSX *ssx, glp_prob *lp) +{ /* load current LP basis into simplex solver workspace */ + int m = ssx->m; + int n = ssx->n; + int *type = ssx->type; + int *stat = ssx->stat; + int *Q_row = ssx->Q_row; + int *Q_col = ssx->Q_col; + int i, j, k; + xassert(lp->m == m); + xassert(lp->n == n); + /* statuses of rows and columns */ + for (k = 1; k <= m+n; k++) + { if (k <= m) + stat[k] = lp->row[k]->stat; + else + stat[k] = lp->col[k-m]->stat; + switch (stat[k]) + { case GLP_BS: + stat[k] = SSX_BS; + break; + case GLP_NL: + stat[k] = SSX_NL; + xassert(type[k] == SSX_LO || type[k] == SSX_DB); + break; + case GLP_NU: + stat[k] = SSX_NU; + xassert(type[k] == SSX_UP || type[k] == SSX_DB); + break; + case GLP_NF: + stat[k] = SSX_NF; + xassert(type[k] == SSX_FR); + break; + case GLP_NS: + stat[k] = SSX_NS; + xassert(type[k] == SSX_FX); + break; + default: + xassert(stat != stat); + } + } + /* build permutation matix Q */ + i = j = 0; + for (k = 1; k <= m+n; k++) + { if (stat[k] == SSX_BS) + { i++; + if (i > m) return 1; + Q_row[k] = i, Q_col[i] = k; + } + else + { j++; + if (j > n) return 1; + Q_row[k] = m+j, Q_col[m+j] = k; + } + } + xassert(i == m && j == n); + return 0; +} + +int glp_exact(glp_prob *lp, const glp_smcp *parm) +{ glp_smcp _parm; + SSX *ssx; + int m = lp->m; + int n = lp->n; + int nnz = lp->nnz; + int i, j, k, type, pst, dst, ret, stat; + double lb, ub, prim, dual, sum; + if (parm == NULL) + parm = &_parm, glp_init_smcp((glp_smcp *)parm); + /* check control parameters */ +#if 1 /* 25/XI-2017 */ + switch (parm->msg_lev) + { case GLP_MSG_OFF: + case GLP_MSG_ERR: + case GLP_MSG_ON: + case GLP_MSG_ALL: + case GLP_MSG_DBG: + break; + default: + xerror("glp_exact: msg_lev = %d; invalid parameter\n", + parm->msg_lev); + } +#endif + if (parm->it_lim < 0) + xerror("glp_exact: it_lim = %d; invalid parameter\n", + parm->it_lim); + if (parm->tm_lim < 0) + xerror("glp_exact: tm_lim = %d; invalid parameter\n", + parm->tm_lim); + /* the problem must have at least one row and one column */ + if (!(m > 0 && n > 0)) +#if 0 /* 25/XI-2017 */ + { xprintf("glp_exact: problem has no rows/columns\n"); +#else + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_exact: problem has no rows/columns\n"); +#endif + return GLP_EFAIL; + } +#if 1 + /* basic solution is currently undefined */ + lp->pbs_stat = lp->dbs_stat = GLP_UNDEF; + lp->obj_val = 0.0; + lp->some = 0; +#endif + /* check that all double-bounded variables have correct bounds */ + for (k = 1; k <= m+n; k++) + { if (k <= m) + { type = lp->row[k]->type; + lb = lp->row[k]->lb; + ub = lp->row[k]->ub; + } + else + { type = lp->col[k-m]->type; + lb = lp->col[k-m]->lb; + ub = lp->col[k-m]->ub; + } + if (type == GLP_DB && lb >= ub) +#if 0 /* 25/XI-2017 */ + { xprintf("glp_exact: %s %d has invalid bounds\n", + k <= m ? "row" : "column", k <= m ? k : k-m); +#else + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_exact: %s %d has invalid bounds\n", + k <= m ? "row" : "column", k <= m ? k : k-m); +#endif + return GLP_EBOUND; + } + } + /* create the simplex solver workspace */ +#if 1 /* 25/XI-2017 */ + if (parm->msg_lev >= GLP_MSG_ALL) + { +#endif + xprintf("glp_exact: %d rows, %d columns, %d non-zeros\n", + m, n, nnz); +#ifdef HAVE_GMP + xprintf("GNU MP bignum library is being used\n"); +#else + xprintf("GLPK bignum module is being used\n"); + xprintf("(Consider installing GNU MP to attain a much better perf" + "ormance.)\n"); +#endif +#if 1 /* 25/XI-2017 */ + } +#endif + ssx = ssx_create(m, n, nnz); + /* load LP problem data into the workspace */ + load_data(ssx, lp); + /* load current LP basis into the workspace */ + if (load_basis(ssx, lp)) +#if 0 /* 25/XI-2017 */ + { xprintf("glp_exact: initial LP basis is invalid\n"); +#else + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_exact: initial LP basis is invalid\n"); +#endif + ret = GLP_EBADB; + goto done; + } +#if 0 + /* inherit some control parameters from the LP object */ + ssx->it_lim = lpx_get_int_parm(lp, LPX_K_ITLIM); + ssx->it_cnt = lpx_get_int_parm(lp, LPX_K_ITCNT); + ssx->tm_lim = lpx_get_real_parm(lp, LPX_K_TMLIM); +#else +#if 1 /* 25/XI-2017 */ + ssx->msg_lev = parm->msg_lev; +#endif + ssx->it_lim = parm->it_lim; + ssx->it_cnt = lp->it_cnt; + ssx->tm_lim = (double)parm->tm_lim / 1000.0; +#endif + ssx->out_frq = 5.0; + ssx->tm_beg = xtime(); +#if 0 /* 10/VI-2013 */ + ssx->tm_lag = xlset(0); +#else + ssx->tm_lag = 0.0; +#endif + /* solve LP */ + ret = ssx_driver(ssx); +#if 0 + /* copy back some statistics to the LP object */ + lpx_set_int_parm(lp, LPX_K_ITLIM, ssx->it_lim); + lpx_set_int_parm(lp, LPX_K_ITCNT, ssx->it_cnt); + lpx_set_real_parm(lp, LPX_K_TMLIM, ssx->tm_lim); +#else + lp->it_cnt = ssx->it_cnt; +#endif + /* analyze the return code */ + switch (ret) + { case 0: + /* optimal solution found */ + ret = 0; + pst = dst = GLP_FEAS; + break; + case 1: + /* problem has no feasible solution */ + ret = 0; + pst = GLP_NOFEAS, dst = GLP_INFEAS; + break; + case 2: + /* problem has unbounded solution */ + ret = 0; + pst = GLP_FEAS, dst = GLP_NOFEAS; +#if 1 + xassert(1 <= ssx->q && ssx->q <= n); + lp->some = ssx->Q_col[m + ssx->q]; + xassert(1 <= lp->some && lp->some <= m+n); +#endif + break; + case 3: + /* iteration limit exceeded (phase I) */ + ret = GLP_EITLIM; + pst = dst = GLP_INFEAS; + break; + case 4: + /* iteration limit exceeded (phase II) */ + ret = GLP_EITLIM; + pst = GLP_FEAS, dst = GLP_INFEAS; + break; + case 5: + /* time limit exceeded (phase I) */ + ret = GLP_ETMLIM; + pst = dst = GLP_INFEAS; + break; + case 6: + /* time limit exceeded (phase II) */ + ret = GLP_ETMLIM; + pst = GLP_FEAS, dst = GLP_INFEAS; + break; + case 7: + /* initial basis matrix is singular */ + ret = GLP_ESING; + goto done; + default: + xassert(ret != ret); + } + /* store final basic solution components into LP object */ + lp->pbs_stat = pst; + lp->dbs_stat = dst; + sum = lp->c0; + for (k = 1; k <= m+n; k++) + { if (ssx->stat[k] == SSX_BS) + { i = ssx->Q_row[k]; /* x[k] = xB[i] */ + xassert(1 <= i && i <= m); + stat = GLP_BS; + prim = mpq_get_d(ssx->bbar[i]); + dual = 0.0; + } + else + { j = ssx->Q_row[k] - m; /* x[k] = xN[j] */ + xassert(1 <= j && j <= n); + switch (ssx->stat[k]) + { case SSX_NF: + stat = GLP_NF; + prim = 0.0; + break; + case SSX_NL: + stat = GLP_NL; + prim = mpq_get_d(ssx->lb[k]); + break; + case SSX_NU: + stat = GLP_NU; + prim = mpq_get_d(ssx->ub[k]); + break; + case SSX_NS: + stat = GLP_NS; + prim = mpq_get_d(ssx->lb[k]); + break; + default: + xassert(ssx != ssx); + } + dual = mpq_get_d(ssx->cbar[j]); + } + if (k <= m) + { glp_set_row_stat(lp, k, stat); + lp->row[k]->prim = prim; + lp->row[k]->dual = dual; + } + else + { glp_set_col_stat(lp, k-m, stat); + lp->col[k-m]->prim = prim; + lp->col[k-m]->dual = dual; + sum += lp->col[k-m]->coef * prim; + } + } + lp->obj_val = sum; +done: /* delete the simplex solver workspace */ + ssx_delete(ssx); +#if 1 /* 23/XI-2015 */ + xassert(gmp_pool_count() == 0); + gmp_free_mem(); +#endif + /* return to the application program */ + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi08.c b/test/monniaux/glpk-4.65/src/draft/glpapi08.c new file mode 100644 index 00000000..652292cb --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi08.c @@ -0,0 +1,388 @@ +/* glpapi08.c (interior-point method routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "glpipm.h" +#include "npp.h" + +/*********************************************************************** +* NAME +* +* glp_interior - solve LP problem with the interior-point method +* +* SYNOPSIS +* +* int glp_interior(glp_prob *P, const glp_iptcp *parm); +* +* The routine glp_interior is a driver to the LP solver based on the +* interior-point method. +* +* The interior-point solver has a set of control parameters. Values of +* the control parameters can be passed in a structure glp_iptcp, which +* the parameter parm points to. +* +* Currently this routine implements an easy variant of the primal-dual +* interior-point method based on Mehrotra's technique. +* +* This routine transforms the original LP problem to an equivalent LP +* problem in the standard formulation (all constraints are equalities, +* all variables are non-negative), calls the routine ipm_main to solve +* the transformed problem, and then transforms an obtained solution to +* the solution of the original problem. +* +* RETURNS +* +* 0 The LP problem instance has been successfully solved. This code +* does not necessarily mean that the solver has found optimal +* solution. It only means that the solution process was successful. +* +* GLP_EFAIL +* The problem has no rows/columns. +* +* GLP_ENOCVG +* Very slow convergence or divergence. +* +* GLP_EITLIM +* Iteration limit exceeded. +* +* GLP_EINSTAB +* Numerical instability on solving Newtonian system. */ + +static void transform(NPP *npp) +{ /* transform LP to the standard formulation */ + NPPROW *row, *prev_row; + NPPCOL *col, *prev_col; + for (row = npp->r_tail; row != NULL; row = prev_row) + { prev_row = row->prev; + if (row->lb == -DBL_MAX && row->ub == +DBL_MAX) + npp_free_row(npp, row); + else if (row->lb == -DBL_MAX) + npp_leq_row(npp, row); + else if (row->ub == +DBL_MAX) + npp_geq_row(npp, row); + else if (row->lb != row->ub) + { if (fabs(row->lb) < fabs(row->ub)) + npp_geq_row(npp, row); + else + npp_leq_row(npp, row); + } + } + for (col = npp->c_tail; col != NULL; col = prev_col) + { prev_col = col->prev; + if (col->lb == -DBL_MAX && col->ub == +DBL_MAX) + npp_free_col(npp, col); + else if (col->lb == -DBL_MAX) + npp_ubnd_col(npp, col); + else if (col->ub == +DBL_MAX) + { if (col->lb != 0.0) + npp_lbnd_col(npp, col); + } + else if (col->lb != col->ub) + { if (fabs(col->lb) < fabs(col->ub)) + { if (col->lb != 0.0) + npp_lbnd_col(npp, col); + } + else + npp_ubnd_col(npp, col); + npp_dbnd_col(npp, col); + } + else + npp_fixed_col(npp, col); + } + for (row = npp->r_head; row != NULL; row = row->next) + xassert(row->lb == row->ub); + for (col = npp->c_head; col != NULL; col = col->next) + xassert(col->lb == 0.0 && col->ub == +DBL_MAX); + return; +} + +int glp_interior(glp_prob *P, const glp_iptcp *parm) +{ glp_iptcp _parm; + GLPROW *row; + GLPCOL *col; + NPP *npp = NULL; + glp_prob *prob = NULL; + int i, j, ret; + /* check control parameters */ + if (parm == NULL) + glp_init_iptcp(&_parm), parm = &_parm; + if (!(parm->msg_lev == GLP_MSG_OFF || + parm->msg_lev == GLP_MSG_ERR || + parm->msg_lev == GLP_MSG_ON || + parm->msg_lev == GLP_MSG_ALL)) + xerror("glp_interior: msg_lev = %d; invalid parameter\n", + parm->msg_lev); + if (!(parm->ord_alg == GLP_ORD_NONE || + parm->ord_alg == GLP_ORD_QMD || + parm->ord_alg == GLP_ORD_AMD || + parm->ord_alg == GLP_ORD_SYMAMD)) + xerror("glp_interior: ord_alg = %d; invalid parameter\n", + parm->ord_alg); + /* interior-point solution is currently undefined */ + P->ipt_stat = GLP_UNDEF; + P->ipt_obj = 0.0; + /* check bounds of double-bounded variables */ + for (i = 1; i <= P->m; i++) + { row = P->row[i]; + if (row->type == GLP_DB && row->lb >= row->ub) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_interior: row %d: lb = %g, ub = %g; incorre" + "ct bounds\n", i, row->lb, row->ub); + ret = GLP_EBOUND; + goto done; + } + } + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (col->type == GLP_DB && col->lb >= col->ub) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_interior: column %d: lb = %g, ub = %g; inco" + "rrect bounds\n", j, col->lb, col->ub); + ret = GLP_EBOUND; + goto done; + } + } + /* transform LP to the standard formulation */ + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("Original LP has %d row(s), %d column(s), and %d non-z" + "ero(s)\n", P->m, P->n, P->nnz); + npp = npp_create_wksp(); + npp_load_prob(npp, P, GLP_OFF, GLP_IPT, GLP_ON); + transform(npp); + prob = glp_create_prob(); + npp_build_prob(npp, prob); + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("Working LP has %d row(s), %d column(s), and %d non-ze" + "ro(s)\n", prob->m, prob->n, prob->nnz); +#if 1 + /* currently empty problem cannot be solved */ + if (!(prob->m > 0 && prob->n > 0)) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_interior: unable to solve empty problem\n"); + ret = GLP_EFAIL; + goto done; + } +#endif + /* scale the resultant LP */ + { ENV *env = get_env_ptr(); + int term_out = env->term_out; + env->term_out = GLP_OFF; + glp_scale_prob(prob, GLP_SF_EQ); + env->term_out = term_out; + } + /* warn about dense columns */ + if (parm->msg_lev >= GLP_MSG_ON && prob->m >= 200) + { int len, cnt = 0; + for (j = 1; j <= prob->n; j++) + { len = glp_get_mat_col(prob, j, NULL, NULL); + if ((double)len >= 0.20 * (double)prob->m) cnt++; + } + if (cnt == 1) + xprintf("WARNING: PROBLEM HAS ONE DENSE COLUMN\n"); + else if (cnt > 0) + xprintf("WARNING: PROBLEM HAS %d DENSE COLUMNS\n", cnt); + } + /* solve the transformed LP */ + ret = ipm_solve(prob, parm); + /* postprocess solution from the transformed LP */ + npp_postprocess(npp, prob); + /* and store solution to the original LP */ + npp_unload_sol(npp, P); +done: /* free working program objects */ + if (npp != NULL) npp_delete_wksp(npp); + if (prob != NULL) glp_delete_prob(prob); + /* return to the application program */ + return ret; +} + +/*********************************************************************** +* NAME +* +* glp_init_iptcp - initialize interior-point solver control parameters +* +* SYNOPSIS +* +* void glp_init_iptcp(glp_iptcp *parm); +* +* DESCRIPTION +* +* The routine glp_init_iptcp initializes control parameters, which are +* used by the interior-point solver, with default values. +* +* Default values of the control parameters are stored in the glp_iptcp +* structure, which the parameter parm points to. */ + +void glp_init_iptcp(glp_iptcp *parm) +{ parm->msg_lev = GLP_MSG_ALL; + parm->ord_alg = GLP_ORD_AMD; + return; +} + +/*********************************************************************** +* NAME +* +* glp_ipt_status - retrieve status of interior-point solution +* +* SYNOPSIS +* +* int glp_ipt_status(glp_prob *lp); +* +* RETURNS +* +* The routine glp_ipt_status reports the status of solution found by +* the interior-point solver as follows: +* +* GLP_UNDEF - interior-point solution is undefined; +* GLP_OPT - interior-point solution is optimal; +* GLP_INFEAS - interior-point solution is infeasible; +* GLP_NOFEAS - no feasible solution exists. */ + +int glp_ipt_status(glp_prob *lp) +{ int ipt_stat = lp->ipt_stat; + return ipt_stat; +} + +/*********************************************************************** +* NAME +* +* glp_ipt_obj_val - retrieve objective value (interior point) +* +* SYNOPSIS +* +* double glp_ipt_obj_val(glp_prob *lp); +* +* RETURNS +* +* The routine glp_ipt_obj_val returns value of the objective function +* for interior-point solution. */ + +double glp_ipt_obj_val(glp_prob *lp) +{ /*struct LPXCPS *cps = lp->cps;*/ + double z; + z = lp->ipt_obj; + /*if (cps->round && fabs(z) < 1e-9) z = 0.0;*/ + return z; +} + +/*********************************************************************** +* NAME +* +* glp_ipt_row_prim - retrieve row primal value (interior point) +* +* SYNOPSIS +* +* double glp_ipt_row_prim(glp_prob *lp, int i); +* +* RETURNS +* +* The routine glp_ipt_row_prim returns primal value of the auxiliary +* variable associated with i-th row. */ + +double glp_ipt_row_prim(glp_prob *lp, int i) +{ /*struct LPXCPS *cps = lp->cps;*/ + double pval; + if (!(1 <= i && i <= lp->m)) + xerror("glp_ipt_row_prim: i = %d; row number out of range\n", + i); + pval = lp->row[i]->pval; + /*if (cps->round && fabs(pval) < 1e-9) pval = 0.0;*/ + return pval; +} + +/*********************************************************************** +* NAME +* +* glp_ipt_row_dual - retrieve row dual value (interior point) +* +* SYNOPSIS +* +* double glp_ipt_row_dual(glp_prob *lp, int i); +* +* RETURNS +* +* The routine glp_ipt_row_dual returns dual value (i.e. reduced cost) +* of the auxiliary variable associated with i-th row. */ + +double glp_ipt_row_dual(glp_prob *lp, int i) +{ /*struct LPXCPS *cps = lp->cps;*/ + double dval; + if (!(1 <= i && i <= lp->m)) + xerror("glp_ipt_row_dual: i = %d; row number out of range\n", + i); + dval = lp->row[i]->dval; + /*if (cps->round && fabs(dval) < 1e-9) dval = 0.0;*/ + return dval; +} + +/*********************************************************************** +* NAME +* +* glp_ipt_col_prim - retrieve column primal value (interior point) +* +* SYNOPSIS +* +* double glp_ipt_col_prim(glp_prob *lp, int j); +* +* RETURNS +* +* The routine glp_ipt_col_prim returns primal value of the structural +* variable associated with j-th column. */ + +double glp_ipt_col_prim(glp_prob *lp, int j) +{ /*struct LPXCPS *cps = lp->cps;*/ + double pval; + if (!(1 <= j && j <= lp->n)) + xerror("glp_ipt_col_prim: j = %d; column number out of range\n" + , j); + pval = lp->col[j]->pval; + /*if (cps->round && fabs(pval) < 1e-9) pval = 0.0;*/ + return pval; +} + +/*********************************************************************** +* NAME +* +* glp_ipt_col_dual - retrieve column dual value (interior point) +* +* SYNOPSIS +* +* double glp_ipt_col_dual(glp_prob *lp, int j); +* +* RETURNS +* +* The routine glp_ipt_col_dual returns dual value (i.e. reduced cost) +* of the structural variable associated with j-th column. */ + +double glp_ipt_col_dual(glp_prob *lp, int j) +{ /*struct LPXCPS *cps = lp->cps;*/ + double dval; + if (!(1 <= j && j <= lp->n)) + xerror("glp_ipt_col_dual: j = %d; column number out of range\n" + , j); + dval = lp->col[j]->dval; + /*if (cps->round && fabs(dval) < 1e-9) dval = 0.0;*/ + return dval; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi09.c b/test/monniaux/glpk-4.65/src/draft/glpapi09.c new file mode 100644 index 00000000..0d3ab57b --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi09.c @@ -0,0 +1,798 @@ +/* glpapi09.c (mixed integer programming routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "draft.h" +#include "env.h" +#include "ios.h" +#include "npp.h" + +/*********************************************************************** +* NAME +* +* glp_set_col_kind - set (change) column kind +* +* SYNOPSIS +* +* void glp_set_col_kind(glp_prob *mip, int j, int kind); +* +* DESCRIPTION +* +* The routine glp_set_col_kind sets (changes) the kind of j-th column +* (structural variable) as specified by the parameter kind: +* +* GLP_CV - continuous variable; +* GLP_IV - integer variable; +* GLP_BV - binary variable. */ + +void glp_set_col_kind(glp_prob *mip, int j, int kind) +{ GLPCOL *col; + if (!(1 <= j && j <= mip->n)) + xerror("glp_set_col_kind: j = %d; column number out of range\n" + , j); + col = mip->col[j]; + switch (kind) + { case GLP_CV: + col->kind = GLP_CV; + break; + case GLP_IV: + col->kind = GLP_IV; + break; + case GLP_BV: + col->kind = GLP_IV; + if (!(col->type == GLP_DB && col->lb == 0.0 && col->ub == + 1.0)) glp_set_col_bnds(mip, j, GLP_DB, 0.0, 1.0); + break; + default: + xerror("glp_set_col_kind: j = %d; kind = %d; invalid column" + " kind\n", j, kind); + } + return; +} + +/*********************************************************************** +* NAME +* +* glp_get_col_kind - retrieve column kind +* +* SYNOPSIS +* +* int glp_get_col_kind(glp_prob *mip, int j); +* +* RETURNS +* +* The routine glp_get_col_kind returns the kind of j-th column, i.e. +* the kind of corresponding structural variable, as follows: +* +* GLP_CV - continuous variable; +* GLP_IV - integer variable; +* GLP_BV - binary variable */ + +int glp_get_col_kind(glp_prob *mip, int j) +{ GLPCOL *col; + int kind; + if (!(1 <= j && j <= mip->n)) + xerror("glp_get_col_kind: j = %d; column number out of range\n" + , j); + col = mip->col[j]; + kind = col->kind; + switch (kind) + { case GLP_CV: + break; + case GLP_IV: + if (col->type == GLP_DB && col->lb == 0.0 && col->ub == 1.0) + kind = GLP_BV; + break; + default: + xassert(kind != kind); + } + return kind; +} + +/*********************************************************************** +* NAME +* +* glp_get_num_int - retrieve number of integer columns +* +* SYNOPSIS +* +* int glp_get_num_int(glp_prob *mip); +* +* RETURNS +* +* The routine glp_get_num_int returns the current number of columns, +* which are marked as integer. */ + +int glp_get_num_int(glp_prob *mip) +{ GLPCOL *col; + int j, count = 0; + for (j = 1; j <= mip->n; j++) + { col = mip->col[j]; + if (col->kind == GLP_IV) count++; + } + return count; +} + +/*********************************************************************** +* NAME +* +* glp_get_num_bin - retrieve number of binary columns +* +* SYNOPSIS +* +* int glp_get_num_bin(glp_prob *mip); +* +* RETURNS +* +* The routine glp_get_num_bin returns the current number of columns, +* which are marked as binary. */ + +int glp_get_num_bin(glp_prob *mip) +{ GLPCOL *col; + int j, count = 0; + for (j = 1; j <= mip->n; j++) + { col = mip->col[j]; + if (col->kind == GLP_IV && col->type == GLP_DB && col->lb == + 0.0 && col->ub == 1.0) count++; + } + return count; +} + +/*********************************************************************** +* NAME +* +* glp_intopt - solve MIP problem with the branch-and-bound method +* +* SYNOPSIS +* +* int glp_intopt(glp_prob *P, const glp_iocp *parm); +* +* DESCRIPTION +* +* The routine glp_intopt is a driver to the MIP solver based on the +* branch-and-bound method. +* +* On entry the problem object should contain optimal solution to LP +* relaxation (which can be obtained with the routine glp_simplex). +* +* The MIP solver has a set of control parameters. Values of the control +* parameters can be passed in a structure glp_iocp, which the parameter +* parm points to. +* +* The parameter parm can be specified as NULL, in which case the MIP +* solver uses default settings. +* +* RETURNS +* +* 0 The MIP problem instance has been successfully solved. This code +* does not necessarily mean that the solver has found optimal +* solution. It only means that the solution process was successful. +* +* GLP_EBOUND +* Unable to start the search, because some double-bounded variables +* have incorrect bounds or some integer variables have non-integer +* (fractional) bounds. +* +* GLP_EROOT +* Unable to start the search, because optimal basis for initial LP +* relaxation is not provided. +* +* GLP_EFAIL +* The search was prematurely terminated due to the solver failure. +* +* GLP_EMIPGAP +* The search was prematurely terminated, because the relative mip +* gap tolerance has been reached. +* +* GLP_ETMLIM +* The search was prematurely terminated, because the time limit has +* been exceeded. +* +* GLP_ENOPFS +* The MIP problem instance has no primal feasible solution (only if +* the MIP presolver is used). +* +* GLP_ENODFS +* LP relaxation of the MIP problem instance has no dual feasible +* solution (only if the MIP presolver is used). +* +* GLP_ESTOP +* The search was prematurely terminated by application. */ + +#if 0 /* 11/VII-2013 */ +static int solve_mip(glp_prob *P, const glp_iocp *parm) +#else +static int solve_mip(glp_prob *P, const glp_iocp *parm, + glp_prob *P0 /* problem passed to glp_intopt */, + NPP *npp /* preprocessor workspace or NULL */) +#endif +{ /* solve MIP directly without using the preprocessor */ + glp_tree *T; + int ret; + /* optimal basis to LP relaxation must be provided */ + if (glp_get_status(P) != GLP_OPT) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: optimal basis to initial LP relaxation" + " not provided\n"); + ret = GLP_EROOT; + goto done; + } + /* it seems all is ok */ + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("Integer optimization begins...\n"); + /* create the branch-and-bound tree */ + T = ios_create_tree(P, parm); +#if 1 /* 11/VII-2013 */ + T->P = P0; + T->npp = npp; +#endif + /* solve the problem instance */ + ret = ios_driver(T); + /* delete the branch-and-bound tree */ + ios_delete_tree(T); + /* analyze exit code reported by the mip driver */ + if (ret == 0) + { if (P->mip_stat == GLP_FEAS) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("INTEGER OPTIMAL SOLUTION FOUND\n"); + P->mip_stat = GLP_OPT; + } + else + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("PROBLEM HAS NO INTEGER FEASIBLE SOLUTION\n"); + P->mip_stat = GLP_NOFEAS; + } + } + else if (ret == GLP_EMIPGAP) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("RELATIVE MIP GAP TOLERANCE REACHED; SEARCH TERMINA" + "TED\n"); + } + else if (ret == GLP_ETMLIM) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); + } + else if (ret == GLP_EFAIL) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: cannot solve current LP relaxation\n"); + } + else if (ret == GLP_ESTOP) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("SEARCH TERMINATED BY APPLICATION\n"); + } + else + xassert(ret != ret); +done: return ret; +} + +static int preprocess_and_solve_mip(glp_prob *P, const glp_iocp *parm) +{ /* solve MIP using the preprocessor */ + ENV *env = get_env_ptr(); + int term_out = env->term_out; + NPP *npp; + glp_prob *mip = NULL; + glp_bfcp bfcp; + glp_smcp smcp; + int ret; + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("Preprocessing...\n"); + /* create preprocessor workspace */ + npp = npp_create_wksp(); + /* load original problem into the preprocessor workspace */ + npp_load_prob(npp, P, GLP_OFF, GLP_MIP, GLP_OFF); + /* process MIP prior to applying the branch-and-bound method */ + if (!term_out || parm->msg_lev < GLP_MSG_ALL) + env->term_out = GLP_OFF; + else + env->term_out = GLP_ON; + ret = npp_integer(npp, parm); + env->term_out = term_out; + if (ret == 0) + ; + else if (ret == GLP_ENOPFS) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("PROBLEM HAS NO PRIMAL FEASIBLE SOLUTION\n"); + } + else if (ret == GLP_ENODFS) + { if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("LP RELAXATION HAS NO DUAL FEASIBLE SOLUTION\n"); + } + else + xassert(ret != ret); + if (ret != 0) goto done; + /* build transformed MIP */ + mip = glp_create_prob(); + npp_build_prob(npp, mip); + /* if the transformed MIP is empty, it has empty solution, which + is optimal */ + if (mip->m == 0 && mip->n == 0) + { mip->mip_stat = GLP_OPT; + mip->mip_obj = mip->c0; + if (parm->msg_lev >= GLP_MSG_ALL) + { xprintf("Objective value = %17.9e\n", mip->mip_obj); + xprintf("INTEGER OPTIMAL SOLUTION FOUND BY MIP PREPROCESSOR" + "\n"); + } + goto post; + } + /* display some statistics */ + if (parm->msg_lev >= GLP_MSG_ALL) + { int ni = glp_get_num_int(mip); + int nb = glp_get_num_bin(mip); + char s[50]; + xprintf("%d row%s, %d column%s, %d non-zero%s\n", + mip->m, mip->m == 1 ? "" : "s", mip->n, mip->n == 1 ? "" : + "s", mip->nnz, mip->nnz == 1 ? "" : "s"); + if (nb == 0) + strcpy(s, "none of"); + else if (ni == 1 && nb == 1) + strcpy(s, ""); + else if (nb == 1) + strcpy(s, "one of"); + else if (nb == ni) + strcpy(s, "all of"); + else + sprintf(s, "%d of", nb); + xprintf("%d integer variable%s, %s which %s binary\n", + ni, ni == 1 ? "" : "s", s, nb == 1 ? "is" : "are"); + } + /* inherit basis factorization control parameters */ + glp_get_bfcp(P, &bfcp); + glp_set_bfcp(mip, &bfcp); + /* scale the transformed problem */ + if (!term_out || parm->msg_lev < GLP_MSG_ALL) + env->term_out = GLP_OFF; + else + env->term_out = GLP_ON; + glp_scale_prob(mip, + GLP_SF_GM | GLP_SF_EQ | GLP_SF_2N | GLP_SF_SKIP); + env->term_out = term_out; + /* build advanced initial basis */ + if (!term_out || parm->msg_lev < GLP_MSG_ALL) + env->term_out = GLP_OFF; + else + env->term_out = GLP_ON; + glp_adv_basis(mip, 0); + env->term_out = term_out; + /* solve initial LP relaxation */ + if (parm->msg_lev >= GLP_MSG_ALL) + xprintf("Solving LP relaxation...\n"); + glp_init_smcp(&smcp); + smcp.msg_lev = parm->msg_lev; + /* respect time limit */ + smcp.tm_lim = parm->tm_lim; + mip->it_cnt = P->it_cnt; + ret = glp_simplex(mip, &smcp); + P->it_cnt = mip->it_cnt; + if (ret == GLP_ETMLIM) + goto done; + else if (ret != 0) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: cannot solve LP relaxation\n"); + ret = GLP_EFAIL; + goto done; + } + /* check status of the basic solution */ + ret = glp_get_status(mip); + if (ret == GLP_OPT) + ret = 0; + else if (ret == GLP_NOFEAS) + ret = GLP_ENOPFS; + else if (ret == GLP_UNBND) + ret = GLP_ENODFS; + else + xassert(ret != ret); + if (ret != 0) goto done; + /* solve the transformed MIP */ + mip->it_cnt = P->it_cnt; +#if 0 /* 11/VII-2013 */ + ret = solve_mip(mip, parm); +#else + if (parm->use_sol) + { mip->mip_stat = P->mip_stat; + mip->mip_obj = P->mip_obj; + } + ret = solve_mip(mip, parm, P, npp); +#endif + P->it_cnt = mip->it_cnt; + /* only integer feasible solution can be postprocessed */ + if (!(mip->mip_stat == GLP_OPT || mip->mip_stat == GLP_FEAS)) + { P->mip_stat = mip->mip_stat; + goto done; + } + /* postprocess solution from the transformed MIP */ +post: npp_postprocess(npp, mip); + /* the transformed MIP is no longer needed */ + glp_delete_prob(mip), mip = NULL; + /* store solution to the original problem */ + npp_unload_sol(npp, P); +done: /* delete the transformed MIP, if it exists */ + if (mip != NULL) glp_delete_prob(mip); + /* delete preprocessor workspace */ + npp_delete_wksp(npp); + return ret; +} + +#ifndef HAVE_ALIEN_SOLVER /* 28/V-2010 */ +int _glp_intopt1(glp_prob *P, const glp_iocp *parm) +{ xassert(P == P); + xassert(parm == parm); + xprintf("glp_intopt: no alien solver is available\n"); + return GLP_EFAIL; +} +#endif + +int glp_intopt(glp_prob *P, const glp_iocp *parm) +{ /* solve MIP problem with the branch-and-bound method */ + glp_iocp _parm; + int i, j, ret; +#if 0 /* 04/IV-2016 */ + /* check problem object */ + if (P == NULL || P->magic != GLP_PROB_MAGIC) + xerror("glp_intopt: P = %p; invalid problem object\n", P); +#endif + if (P->tree != NULL) + xerror("glp_intopt: operation not allowed\n"); + /* check control parameters */ + if (parm == NULL) + parm = &_parm, glp_init_iocp((glp_iocp *)parm); + if (!(parm->msg_lev == GLP_MSG_OFF || + parm->msg_lev == GLP_MSG_ERR || + parm->msg_lev == GLP_MSG_ON || + parm->msg_lev == GLP_MSG_ALL || + parm->msg_lev == GLP_MSG_DBG)) + xerror("glp_intopt: msg_lev = %d; invalid parameter\n", + parm->msg_lev); + if (!(parm->br_tech == GLP_BR_FFV || + parm->br_tech == GLP_BR_LFV || + parm->br_tech == GLP_BR_MFV || + parm->br_tech == GLP_BR_DTH || + parm->br_tech == GLP_BR_PCH)) + xerror("glp_intopt: br_tech = %d; invalid parameter\n", + parm->br_tech); + if (!(parm->bt_tech == GLP_BT_DFS || + parm->bt_tech == GLP_BT_BFS || + parm->bt_tech == GLP_BT_BLB || + parm->bt_tech == GLP_BT_BPH)) + xerror("glp_intopt: bt_tech = %d; invalid parameter\n", + parm->bt_tech); + if (!(0.0 < parm->tol_int && parm->tol_int < 1.0)) + xerror("glp_intopt: tol_int = %g; invalid parameter\n", + parm->tol_int); + if (!(0.0 < parm->tol_obj && parm->tol_obj < 1.0)) + xerror("glp_intopt: tol_obj = %g; invalid parameter\n", + parm->tol_obj); + if (parm->tm_lim < 0) + xerror("glp_intopt: tm_lim = %d; invalid parameter\n", + parm->tm_lim); + if (parm->out_frq < 0) + xerror("glp_intopt: out_frq = %d; invalid parameter\n", + parm->out_frq); + if (parm->out_dly < 0) + xerror("glp_intopt: out_dly = %d; invalid parameter\n", + parm->out_dly); + if (!(0 <= parm->cb_size && parm->cb_size <= 256)) + xerror("glp_intopt: cb_size = %d; invalid parameter\n", + parm->cb_size); + if (!(parm->pp_tech == GLP_PP_NONE || + parm->pp_tech == GLP_PP_ROOT || + parm->pp_tech == GLP_PP_ALL)) + xerror("glp_intopt: pp_tech = %d; invalid parameter\n", + parm->pp_tech); + if (parm->mip_gap < 0.0) + xerror("glp_intopt: mip_gap = %g; invalid parameter\n", + parm->mip_gap); + if (!(parm->mir_cuts == GLP_ON || parm->mir_cuts == GLP_OFF)) + xerror("glp_intopt: mir_cuts = %d; invalid parameter\n", + parm->mir_cuts); + if (!(parm->gmi_cuts == GLP_ON || parm->gmi_cuts == GLP_OFF)) + xerror("glp_intopt: gmi_cuts = %d; invalid parameter\n", + parm->gmi_cuts); + if (!(parm->cov_cuts == GLP_ON || parm->cov_cuts == GLP_OFF)) + xerror("glp_intopt: cov_cuts = %d; invalid parameter\n", + parm->cov_cuts); + if (!(parm->clq_cuts == GLP_ON || parm->clq_cuts == GLP_OFF)) + xerror("glp_intopt: clq_cuts = %d; invalid parameter\n", + parm->clq_cuts); + if (!(parm->presolve == GLP_ON || parm->presolve == GLP_OFF)) + xerror("glp_intopt: presolve = %d; invalid parameter\n", + parm->presolve); + if (!(parm->binarize == GLP_ON || parm->binarize == GLP_OFF)) + xerror("glp_intopt: binarize = %d; invalid parameter\n", + parm->binarize); + if (!(parm->fp_heur == GLP_ON || parm->fp_heur == GLP_OFF)) + xerror("glp_intopt: fp_heur = %d; invalid parameter\n", + parm->fp_heur); +#if 1 /* 28/V-2010 */ + if (!(parm->alien == GLP_ON || parm->alien == GLP_OFF)) + xerror("glp_intopt: alien = %d; invalid parameter\n", + parm->alien); +#endif +#if 0 /* 11/VII-2013 */ + /* integer solution is currently undefined */ + P->mip_stat = GLP_UNDEF; + P->mip_obj = 0.0; +#else + if (!parm->use_sol) + P->mip_stat = GLP_UNDEF; + if (P->mip_stat == GLP_NOFEAS) + P->mip_stat = GLP_UNDEF; + if (P->mip_stat == GLP_UNDEF) + P->mip_obj = 0.0; + else if (P->mip_stat == GLP_OPT) + P->mip_stat = GLP_FEAS; +#endif + /* check bounds of double-bounded variables */ + for (i = 1; i <= P->m; i++) + { GLPROW *row = P->row[i]; + if (row->type == GLP_DB && row->lb >= row->ub) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: row %d: lb = %g, ub = %g; incorrect" + " bounds\n", i, row->lb, row->ub); + ret = GLP_EBOUND; + goto done; + } + } + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + if (col->type == GLP_DB && col->lb >= col->ub) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: column %d: lb = %g, ub = %g; incorr" + "ect bounds\n", j, col->lb, col->ub); + ret = GLP_EBOUND; + goto done; + } + } + /* bounds of all integer variables must be integral */ + for (j = 1; j <= P->n; j++) + { GLPCOL *col = P->col[j]; + if (col->kind != GLP_IV) continue; + if (col->type == GLP_LO || col->type == GLP_DB) + { if (col->lb != floor(col->lb)) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: integer column %d has non-intege" + "r lower bound %g\n", j, col->lb); + ret = GLP_EBOUND; + goto done; + } + } + if (col->type == GLP_UP || col->type == GLP_DB) + { if (col->ub != floor(col->ub)) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: integer column %d has non-intege" + "r upper bound %g\n", j, col->ub); + ret = GLP_EBOUND; + goto done; + } + } + if (col->type == GLP_FX) + { if (col->lb != floor(col->lb)) + { if (parm->msg_lev >= GLP_MSG_ERR) + xprintf("glp_intopt: integer column %d has non-intege" + "r fixed value %g\n", j, col->lb); + ret = GLP_EBOUND; + goto done; + } + } + } + /* solve MIP problem */ + if (parm->msg_lev >= GLP_MSG_ALL) + { int ni = glp_get_num_int(P); + int nb = glp_get_num_bin(P); + char s[50]; + xprintf("GLPK Integer Optimizer, v%s\n", glp_version()); + xprintf("%d row%s, %d column%s, %d non-zero%s\n", + P->m, P->m == 1 ? "" : "s", P->n, P->n == 1 ? "" : "s", + P->nnz, P->nnz == 1 ? "" : "s"); + if (nb == 0) + strcpy(s, "none of"); + else if (ni == 1 && nb == 1) + strcpy(s, ""); + else if (nb == 1) + strcpy(s, "one of"); + else if (nb == ni) + strcpy(s, "all of"); + else + sprintf(s, "%d of", nb); + xprintf("%d integer variable%s, %s which %s binary\n", + ni, ni == 1 ? "" : "s", s, nb == 1 ? "is" : "are"); + } +#if 1 /* 28/V-2010 */ + if (parm->alien) + { /* use alien integer optimizer */ + ret = _glp_intopt1(P, parm); + goto done; + } +#endif + if (!parm->presolve) +#if 0 /* 11/VII-2013 */ + ret = solve_mip(P, parm); +#else + ret = solve_mip(P, parm, P, NULL); +#endif + else + ret = preprocess_and_solve_mip(P, parm); +#if 1 /* 12/III-2013 */ + if (ret == GLP_ENOPFS) + P->mip_stat = GLP_NOFEAS; +#endif +done: /* return to the application program */ + return ret; +} + +/*********************************************************************** +* NAME +* +* glp_init_iocp - initialize integer optimizer control parameters +* +* SYNOPSIS +* +* void glp_init_iocp(glp_iocp *parm); +* +* DESCRIPTION +* +* The routine glp_init_iocp initializes control parameters, which are +* used by the integer optimizer, with default values. +* +* Default values of the control parameters are stored in a glp_iocp +* structure, which the parameter parm points to. */ + +void glp_init_iocp(glp_iocp *parm) +{ parm->msg_lev = GLP_MSG_ALL; + parm->br_tech = GLP_BR_DTH; + parm->bt_tech = GLP_BT_BLB; + parm->tol_int = 1e-5; + parm->tol_obj = 1e-7; + parm->tm_lim = INT_MAX; + parm->out_frq = 5000; + parm->out_dly = 10000; + parm->cb_func = NULL; + parm->cb_info = NULL; + parm->cb_size = 0; + parm->pp_tech = GLP_PP_ALL; + parm->mip_gap = 0.0; + parm->mir_cuts = GLP_OFF; + parm->gmi_cuts = GLP_OFF; + parm->cov_cuts = GLP_OFF; + parm->clq_cuts = GLP_OFF; + parm->presolve = GLP_OFF; + parm->binarize = GLP_OFF; + parm->fp_heur = GLP_OFF; + parm->ps_heur = GLP_OFF; + parm->ps_tm_lim = 60000; /* 1 minute */ + parm->sr_heur = GLP_ON; +#if 1 /* 24/X-2015; not documented--should not be used */ + parm->use_sol = GLP_OFF; + parm->save_sol = NULL; + parm->alien = GLP_OFF; +#endif +#if 0 /* 20/I-2018 */ +#if 1 /* 16/III-2016; not documented--should not be used */ + parm->flip = GLP_OFF; +#endif +#else + parm->flip = GLP_ON; +#endif + return; +} + +/*********************************************************************** +* NAME +* +* glp_mip_status - retrieve status of MIP solution +* +* SYNOPSIS +* +* int glp_mip_status(glp_prob *mip); +* +* RETURNS +* +* The routine lpx_mip_status reports the status of MIP solution found +* by the branch-and-bound solver as follows: +* +* GLP_UNDEF - MIP solution is undefined; +* GLP_OPT - MIP solution is integer optimal; +* GLP_FEAS - MIP solution is integer feasible but its optimality +* (or non-optimality) has not been proven, perhaps due to +* premature termination of the search; +* GLP_NOFEAS - problem has no integer feasible solution (proven by the +* solver). */ + +int glp_mip_status(glp_prob *mip) +{ int mip_stat = mip->mip_stat; + return mip_stat; +} + +/*********************************************************************** +* NAME +* +* glp_mip_obj_val - retrieve objective value (MIP solution) +* +* SYNOPSIS +* +* double glp_mip_obj_val(glp_prob *mip); +* +* RETURNS +* +* The routine glp_mip_obj_val returns value of the objective function +* for MIP solution. */ + +double glp_mip_obj_val(glp_prob *mip) +{ /*struct LPXCPS *cps = mip->cps;*/ + double z; + z = mip->mip_obj; + /*if (cps->round && fabs(z) < 1e-9) z = 0.0;*/ + return z; +} + +/*********************************************************************** +* NAME +* +* glp_mip_row_val - retrieve row value (MIP solution) +* +* SYNOPSIS +* +* double glp_mip_row_val(glp_prob *mip, int i); +* +* RETURNS +* +* The routine glp_mip_row_val returns value of the auxiliary variable +* associated with i-th row. */ + +double glp_mip_row_val(glp_prob *mip, int i) +{ /*struct LPXCPS *cps = mip->cps;*/ + double mipx; + if (!(1 <= i && i <= mip->m)) + xerror("glp_mip_row_val: i = %d; row number out of range\n", i) + ; + mipx = mip->row[i]->mipx; + /*if (cps->round && fabs(mipx) < 1e-9) mipx = 0.0;*/ + return mipx; +} + +/*********************************************************************** +* NAME +* +* glp_mip_col_val - retrieve column value (MIP solution) +* +* SYNOPSIS +* +* double glp_mip_col_val(glp_prob *mip, int j); +* +* RETURNS +* +* The routine glp_mip_col_val returns value of the structural variable +* associated with j-th column. */ + +double glp_mip_col_val(glp_prob *mip, int j) +{ /*struct LPXCPS *cps = mip->cps;*/ + double mipx; + if (!(1 <= j && j <= mip->n)) + xerror("glp_mip_col_val: j = %d; column number out of range\n", + j); + mipx = mip->col[j]->mipx; + /*if (cps->round && fabs(mipx) < 1e-9) mipx = 0.0;*/ + return mipx; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi10.c b/test/monniaux/glpk-4.65/src/draft/glpapi10.c new file mode 100644 index 00000000..5550aa39 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi10.c @@ -0,0 +1,305 @@ +/* glpapi10.c (solution checking routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "prob.h" + +void glp_check_kkt(glp_prob *P, int sol, int cond, double *_ae_max, + int *_ae_ind, double *_re_max, int *_re_ind) +{ /* check feasibility and optimality conditions */ + int m = P->m; + int n = P->n; + GLPROW *row; + GLPCOL *col; + GLPAIJ *aij; + int i, j, ae_ind, re_ind; + double e, sp, sn, t, ae_max, re_max; + if (!(sol == GLP_SOL || sol == GLP_IPT || sol == GLP_MIP)) + xerror("glp_check_kkt: sol = %d; invalid solution indicator\n", + sol); + if (!(cond == GLP_KKT_PE || cond == GLP_KKT_PB || + cond == GLP_KKT_DE || cond == GLP_KKT_DB || + cond == GLP_KKT_CS)) + xerror("glp_check_kkt: cond = %d; invalid condition indicator " + "\n", cond); + ae_max = re_max = 0.0; + ae_ind = re_ind = 0; + if (cond == GLP_KKT_PE) + { /* xR - A * xS = 0 */ + for (i = 1; i <= m; i++) + { row = P->row[i]; + sp = sn = 0.0; + /* t := xR[i] */ + if (sol == GLP_SOL) + t = row->prim; + else if (sol == GLP_IPT) + t = row->pval; + else if (sol == GLP_MIP) + t = row->mipx; + else + xassert(sol != sol); + if (t >= 0.0) sp += t; else sn -= t; + for (aij = row->ptr; aij != NULL; aij = aij->r_next) + { col = aij->col; + /* t := - a[i,j] * xS[j] */ + if (sol == GLP_SOL) + t = - aij->val * col->prim; + else if (sol == GLP_IPT) + t = - aij->val * col->pval; + else if (sol == GLP_MIP) + t = - aij->val * col->mipx; + else + xassert(sol != sol); + if (t >= 0.0) sp += t; else sn -= t; + } + /* absolute error */ + e = fabs(sp - sn); + if (ae_max < e) + ae_max = e, ae_ind = i; + /* relative error */ + e /= (1.0 + sp + sn); + if (re_max < e) + re_max = e, re_ind = i; + } + } + else if (cond == GLP_KKT_PB) + { /* lR <= xR <= uR */ + for (i = 1; i <= m; i++) + { row = P->row[i]; + /* t := xR[i] */ + if (sol == GLP_SOL) + t = row->prim; + else if (sol == GLP_IPT) + t = row->pval; + else if (sol == GLP_MIP) + t = row->mipx; + else + xassert(sol != sol); + /* check lower bound */ + if (row->type == GLP_LO || row->type == GLP_DB || + row->type == GLP_FX) + { if (t < row->lb) + { /* absolute error */ + e = row->lb - t; + if (ae_max < e) + ae_max = e, ae_ind = i; + /* relative error */ + e /= (1.0 + fabs(row->lb)); + if (re_max < e) + re_max = e, re_ind = i; + } + } + /* check upper bound */ + if (row->type == GLP_UP || row->type == GLP_DB || + row->type == GLP_FX) + { if (t > row->ub) + { /* absolute error */ + e = t - row->ub; + if (ae_max < e) + ae_max = e, ae_ind = i; + /* relative error */ + e /= (1.0 + fabs(row->ub)); + if (re_max < e) + re_max = e, re_ind = i; + } + } + } + /* lS <= xS <= uS */ + for (j = 1; j <= n; j++) + { col = P->col[j]; + /* t := xS[j] */ + if (sol == GLP_SOL) + t = col->prim; + else if (sol == GLP_IPT) + t = col->pval; + else if (sol == GLP_MIP) + t = col->mipx; + else + xassert(sol != sol); + /* check lower bound */ + if (col->type == GLP_LO || col->type == GLP_DB || + col->type == GLP_FX) + { if (t < col->lb) + { /* absolute error */ + e = col->lb - t; + if (ae_max < e) + ae_max = e, ae_ind = m+j; + /* relative error */ + e /= (1.0 + fabs(col->lb)); + if (re_max < e) + re_max = e, re_ind = m+j; + } + } + /* check upper bound */ + if (col->type == GLP_UP || col->type == GLP_DB || + col->type == GLP_FX) + { if (t > col->ub) + { /* absolute error */ + e = t - col->ub; + if (ae_max < e) + ae_max = e, ae_ind = m+j; + /* relative error */ + e /= (1.0 + fabs(col->ub)); + if (re_max < e) + re_max = e, re_ind = m+j; + } + } + } + } + else if (cond == GLP_KKT_DE) + { /* A' * (lambdaR - cR) + (lambdaS - cS) = 0 */ + for (j = 1; j <= n; j++) + { col = P->col[j]; + sp = sn = 0.0; + /* t := lambdaS[j] - cS[j] */ + if (sol == GLP_SOL) + t = col->dual - col->coef; + else if (sol == GLP_IPT) + t = col->dval - col->coef; + else + xassert(sol != sol); + if (t >= 0.0) sp += t; else sn -= t; + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + { row = aij->row; + /* t := a[i,j] * (lambdaR[i] - cR[i]) */ + if (sol == GLP_SOL) + t = aij->val * row->dual; + else if (sol == GLP_IPT) + t = aij->val * row->dval; + else + xassert(sol != sol); + if (t >= 0.0) sp += t; else sn -= t; + } + /* absolute error */ + e = fabs(sp - sn); + if (ae_max < e) + ae_max = e, ae_ind = m+j; + /* relative error */ + e /= (1.0 + sp + sn); + if (re_max < e) + re_max = e, re_ind = m+j; + } + } + else if (cond == GLP_KKT_DB) + { /* check lambdaR */ + for (i = 1; i <= m; i++) + { row = P->row[i]; + /* t := lambdaR[i] */ + if (sol == GLP_SOL) + t = row->dual; + else if (sol == GLP_IPT) + t = row->dval; + else + xassert(sol != sol); + /* correct sign */ + if (P->dir == GLP_MIN) + t = + t; + else if (P->dir == GLP_MAX) + t = - t; + else + xassert(P != P); + /* check for positivity */ +#if 1 /* 08/III-2013 */ + /* the former check was correct */ + /* the bug reported by David Price is related to violation + of complementarity slackness, not to this condition */ + if (row->type == GLP_FR || row->type == GLP_LO) +#else + if (row->stat == GLP_NF || row->stat == GLP_NL) +#endif + { if (t < 0.0) + { e = - t; + if (ae_max < e) + ae_max = re_max = e, ae_ind = re_ind = i; + } + } + /* check for negativity */ +#if 1 /* 08/III-2013 */ + /* see comment above */ + if (row->type == GLP_FR || row->type == GLP_UP) +#else + if (row->stat == GLP_NF || row->stat == GLP_NU) +#endif + { if (t > 0.0) + { e = + t; + if (ae_max < e) + ae_max = re_max = e, ae_ind = re_ind = i; + } + } + } + /* check lambdaS */ + for (j = 1; j <= n; j++) + { col = P->col[j]; + /* t := lambdaS[j] */ + if (sol == GLP_SOL) + t = col->dual; + else if (sol == GLP_IPT) + t = col->dval; + else + xassert(sol != sol); + /* correct sign */ + if (P->dir == GLP_MIN) + t = + t; + else if (P->dir == GLP_MAX) + t = - t; + else + xassert(P != P); + /* check for positivity */ +#if 1 /* 08/III-2013 */ + /* see comment above */ + if (col->type == GLP_FR || col->type == GLP_LO) +#else + if (col->stat == GLP_NF || col->stat == GLP_NL) +#endif + { if (t < 0.0) + { e = - t; + if (ae_max < e) + ae_max = re_max = e, ae_ind = re_ind = m+j; + } + } + /* check for negativity */ +#if 1 /* 08/III-2013 */ + /* see comment above */ + if (col->type == GLP_FR || col->type == GLP_UP) +#else + if (col->stat == GLP_NF || col->stat == GLP_NU) +#endif + { if (t > 0.0) + { e = + t; + if (ae_max < e) + ae_max = re_max = e, ae_ind = re_ind = m+j; + } + } + } + } + else + xassert(cond != cond); + if (_ae_max != NULL) *_ae_max = ae_max; + if (_ae_ind != NULL) *_ae_ind = ae_ind; + if (_re_max != NULL) *_re_max = re_max; + if (_re_ind != NULL) *_re_ind = re_ind; + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi12.c b/test/monniaux/glpk-4.65/src/draft/glpapi12.c new file mode 100644 index 00000000..020c8981 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi12.c @@ -0,0 +1,2185 @@ +/* glpapi12.c (basis factorization and simplex tableau routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "draft.h" +#include "env.h" +#include "prob.h" + +/*********************************************************************** +* NAME +* +* glp_bf_exists - check if the basis factorization exists +* +* SYNOPSIS +* +* int glp_bf_exists(glp_prob *lp); +* +* RETURNS +* +* If the basis factorization for the current basis associated with +* the specified problem object exists and therefore is available for +* computations, the routine glp_bf_exists returns non-zero. Otherwise +* the routine returns zero. */ + +int glp_bf_exists(glp_prob *lp) +{ int ret; + ret = (lp->m == 0 || lp->valid); + return ret; +} + +/*********************************************************************** +* NAME +* +* glp_factorize - compute the basis factorization +* +* SYNOPSIS +* +* int glp_factorize(glp_prob *lp); +* +* DESCRIPTION +* +* The routine glp_factorize computes the basis factorization for the +* current basis associated with the specified problem object. +* +* RETURNS +* +* 0 The basis factorization has been successfully computed. +* +* GLP_EBADB +* The basis matrix is invalid, i.e. the number of basic (auxiliary +* and structural) variables differs from the number of rows in the +* problem object. +* +* GLP_ESING +* The basis matrix is singular within the working precision. +* +* GLP_ECOND +* The basis matrix is ill-conditioned. */ + +static int b_col(void *info, int j, int ind[], double val[]) +{ glp_prob *lp = info; + int m = lp->m; + GLPAIJ *aij; + int k, len; + xassert(1 <= j && j <= m); + /* determine the ordinal number of basic auxiliary or structural + variable x[k] corresponding to basic variable xB[j] */ + k = lp->head[j]; + /* build j-th column of the basic matrix, which is k-th column of + the scaled augmented matrix (I | -R*A*S) */ + if (k <= m) + { /* x[k] is auxiliary variable */ + len = 1; + ind[1] = k; + val[1] = 1.0; + } + else + { /* x[k] is structural variable */ + len = 0; + for (aij = lp->col[k-m]->ptr; aij != NULL; aij = aij->c_next) + { len++; + ind[len] = aij->row->i; + val[len] = - aij->row->rii * aij->val * aij->col->sjj; + } + } + return len; +} + +int glp_factorize(glp_prob *lp) +{ int m = lp->m; + int n = lp->n; + GLPROW **row = lp->row; + GLPCOL **col = lp->col; + int *head = lp->head; + int j, k, stat, ret; + /* invalidate the basis factorization */ + lp->valid = 0; + /* build the basis header */ + j = 0; + for (k = 1; k <= m+n; k++) + { if (k <= m) + { stat = row[k]->stat; + row[k]->bind = 0; + } + else + { stat = col[k-m]->stat; + col[k-m]->bind = 0; + } + if (stat == GLP_BS) + { j++; + if (j > m) + { /* too many basic variables */ + ret = GLP_EBADB; + goto fini; + } + head[j] = k; + if (k <= m) + row[k]->bind = j; + else + col[k-m]->bind = j; + } + } + if (j < m) + { /* too few basic variables */ + ret = GLP_EBADB; + goto fini; + } + /* try to factorize the basis matrix */ + if (m > 0) + { if (lp->bfd == NULL) + { lp->bfd = bfd_create_it(); +#if 0 /* 08/III-2014 */ + copy_bfcp(lp); +#endif + } + switch (bfd_factorize(lp->bfd, m, /*lp->head,*/ b_col, lp)) + { case 0: + /* ok */ + break; + case BFD_ESING: + /* singular matrix */ + ret = GLP_ESING; + goto fini; + case BFD_ECOND: + /* ill-conditioned matrix */ + ret = GLP_ECOND; + goto fini; + default: + xassert(lp != lp); + } + lp->valid = 1; + } + /* factorization successful */ + ret = 0; +fini: /* bring the return code to the calling program */ + return ret; +} + +/*********************************************************************** +* NAME +* +* glp_bf_updated - check if the basis factorization has been updated +* +* SYNOPSIS +* +* int glp_bf_updated(glp_prob *lp); +* +* RETURNS +* +* If the basis factorization has been just computed from scratch, the +* routine glp_bf_updated returns zero. Otherwise, if the factorization +* has been updated one or more times, the routine returns non-zero. */ + +int glp_bf_updated(glp_prob *lp) +{ int cnt; + if (!(lp->m == 0 || lp->valid)) + xerror("glp_bf_update: basis factorization does not exist\n"); +#if 0 /* 15/XI-2009 */ + cnt = (lp->m == 0 ? 0 : lp->bfd->upd_cnt); +#else + cnt = (lp->m == 0 ? 0 : bfd_get_count(lp->bfd)); +#endif + return cnt; +} + +/*********************************************************************** +* NAME +* +* glp_get_bfcp - retrieve basis factorization control parameters +* +* SYNOPSIS +* +* void glp_get_bfcp(glp_prob *lp, glp_bfcp *parm); +* +* DESCRIPTION +* +* The routine glp_get_bfcp retrieves control parameters, which are +* used on computing and updating the basis factorization associated +* with the specified problem object. +* +* Current values of control parameters are stored by the routine in +* a glp_bfcp structure, which the parameter parm points to. */ + +#if 1 /* 08/III-2014 */ +void glp_get_bfcp(glp_prob *P, glp_bfcp *parm) +{ if (P->bfd == NULL) + P->bfd = bfd_create_it(); + bfd_get_bfcp(P->bfd, parm); + return; +} +#endif + +/*********************************************************************** +* NAME +* +* glp_set_bfcp - change basis factorization control parameters +* +* SYNOPSIS +* +* void glp_set_bfcp(glp_prob *lp, const glp_bfcp *parm); +* +* DESCRIPTION +* +* The routine glp_set_bfcp changes control parameters, which are used +* by internal GLPK routines in computing and updating the basis +* factorization associated with the specified problem object. +* +* New values of the control parameters should be passed in a structure +* glp_bfcp, which the parameter parm points to. +* +* The parameter parm can be specified as NULL, in which case all +* control parameters are reset to their default values. */ + +#if 1 /* 08/III-2014 */ +void glp_set_bfcp(glp_prob *P, const glp_bfcp *parm) +{ if (P->bfd == NULL) + P->bfd = bfd_create_it(); + if (parm != NULL) + { if (!(parm->type == GLP_BF_LUF + GLP_BF_FT || + parm->type == GLP_BF_LUF + GLP_BF_BG || + parm->type == GLP_BF_LUF + GLP_BF_GR || + parm->type == GLP_BF_BTF + GLP_BF_BG || + parm->type == GLP_BF_BTF + GLP_BF_GR)) + xerror("glp_set_bfcp: type = 0x%02X; invalid parameter\n", + parm->type); + if (!(0.0 < parm->piv_tol && parm->piv_tol < 1.0)) + xerror("glp_set_bfcp: piv_tol = %g; invalid parameter\n", + parm->piv_tol); + if (parm->piv_lim < 1) + xerror("glp_set_bfcp: piv_lim = %d; invalid parameter\n", + parm->piv_lim); + if (!(parm->suhl == GLP_ON || parm->suhl == GLP_OFF)) + xerror("glp_set_bfcp: suhl = %d; invalid parameter\n", + parm->suhl); + if (!(0.0 <= parm->eps_tol && parm->eps_tol <= 1e-6)) + xerror("glp_set_bfcp: eps_tol = %g; invalid parameter\n", + parm->eps_tol); + if (!(1 <= parm->nfs_max && parm->nfs_max <= 32767)) + xerror("glp_set_bfcp: nfs_max = %d; invalid parameter\n", + parm->nfs_max); + if (!(1 <= parm->nrs_max && parm->nrs_max <= 32767)) + xerror("glp_set_bfcp: nrs_max = %d; invalid parameter\n", + parm->nrs_max); + } + bfd_set_bfcp(P->bfd, parm); + return; +} +#endif + +/*********************************************************************** +* NAME +* +* glp_get_bhead - retrieve the basis header information +* +* SYNOPSIS +* +* int glp_get_bhead(glp_prob *lp, int k); +* +* DESCRIPTION +* +* The routine glp_get_bhead returns the basis header information for +* the current basis associated with the specified problem object. +* +* RETURNS +* +* If xB[k], 1 <= k <= m, is i-th auxiliary variable (1 <= i <= m), the +* routine returns i. Otherwise, if xB[k] is j-th structural variable +* (1 <= j <= n), the routine returns m+j. Here m is the number of rows +* and n is the number of columns in the problem object. */ + +int glp_get_bhead(glp_prob *lp, int k) +{ if (!(lp->m == 0 || lp->valid)) + xerror("glp_get_bhead: basis factorization does not exist\n"); + if (!(1 <= k && k <= lp->m)) + xerror("glp_get_bhead: k = %d; index out of range\n", k); + return lp->head[k]; +} + +/*********************************************************************** +* NAME +* +* glp_get_row_bind - retrieve row index in the basis header +* +* SYNOPSIS +* +* int glp_get_row_bind(glp_prob *lp, int i); +* +* RETURNS +* +* The routine glp_get_row_bind returns the index k of basic variable +* xB[k], 1 <= k <= m, which is i-th auxiliary variable, 1 <= i <= m, +* in the current basis associated with the specified problem object, +* where m is the number of rows. However, if i-th auxiliary variable +* is non-basic, the routine returns zero. */ + +int glp_get_row_bind(glp_prob *lp, int i) +{ if (!(lp->m == 0 || lp->valid)) + xerror("glp_get_row_bind: basis factorization does not exist\n" + ); + if (!(1 <= i && i <= lp->m)) + xerror("glp_get_row_bind: i = %d; row number out of range\n", + i); + return lp->row[i]->bind; +} + +/*********************************************************************** +* NAME +* +* glp_get_col_bind - retrieve column index in the basis header +* +* SYNOPSIS +* +* int glp_get_col_bind(glp_prob *lp, int j); +* +* RETURNS +* +* The routine glp_get_col_bind returns the index k of basic variable +* xB[k], 1 <= k <= m, which is j-th structural variable, 1 <= j <= n, +* in the current basis associated with the specified problem object, +* where m is the number of rows, n is the number of columns. However, +* if j-th structural variable is non-basic, the routine returns zero.*/ + +int glp_get_col_bind(glp_prob *lp, int j) +{ if (!(lp->m == 0 || lp->valid)) + xerror("glp_get_col_bind: basis factorization does not exist\n" + ); + if (!(1 <= j && j <= lp->n)) + xerror("glp_get_col_bind: j = %d; column number out of range\n" + , j); + return lp->col[j]->bind; +} + +/*********************************************************************** +* NAME +* +* glp_ftran - perform forward transformation (solve system B*x = b) +* +* SYNOPSIS +* +* void glp_ftran(glp_prob *lp, double x[]); +* +* DESCRIPTION +* +* The routine glp_ftran performs forward transformation, i.e. solves +* the system B*x = b, where B is the basis matrix corresponding to the +* current basis for the specified problem object, x is the vector of +* unknowns to be computed, b is the vector of right-hand sides. +* +* On entry elements of the vector b should be stored in dense format +* in locations x[1], ..., x[m], where m is the number of rows. On exit +* the routine stores elements of the vector x in the same locations. +* +* SCALING/UNSCALING +* +* Let A~ = (I | -A) is the augmented constraint matrix of the original +* (unscaled) problem. In the scaled LP problem instead the matrix A the +* scaled matrix A" = R*A*S is actually used, so +* +* A~" = (I | A") = (I | R*A*S) = (R*I*inv(R) | R*A*S) = +* (1) +* = R*(I | A)*S~ = R*A~*S~, +* +* is the scaled augmented constraint matrix, where R and S are diagonal +* scaling matrices used to scale rows and columns of the matrix A, and +* +* S~ = diag(inv(R) | S) (2) +* +* is an augmented diagonal scaling matrix. +* +* By definition: +* +* A~ = (B | N), (3) +* +* where B is the basic matrix, which consists of basic columns of the +* augmented constraint matrix A~, and N is a matrix, which consists of +* non-basic columns of A~. From (1) it follows that: +* +* A~" = (B" | N") = (R*B*SB | R*N*SN), (4) +* +* where SB and SN are parts of the augmented scaling matrix S~, which +* correspond to basic and non-basic variables, respectively. Therefore +* +* B" = R*B*SB, (5) +* +* which is the scaled basis matrix. */ + +void glp_ftran(glp_prob *lp, double x[]) +{ int m = lp->m; + GLPROW **row = lp->row; + GLPCOL **col = lp->col; + int i, k; + /* B*x = b ===> (R*B*SB)*(inv(SB)*x) = R*b ===> + B"*x" = b", where b" = R*b, x = SB*x" */ + if (!(m == 0 || lp->valid)) + xerror("glp_ftran: basis factorization does not exist\n"); + /* b" := R*b */ + for (i = 1; i <= m; i++) + x[i] *= row[i]->rii; + /* x" := inv(B")*b" */ + if (m > 0) bfd_ftran(lp->bfd, x); + /* x := SB*x" */ + for (i = 1; i <= m; i++) + { k = lp->head[i]; + if (k <= m) + x[i] /= row[k]->rii; + else + x[i] *= col[k-m]->sjj; + } + return; +} + +/*********************************************************************** +* NAME +* +* glp_btran - perform backward transformation (solve system B'*x = b) +* +* SYNOPSIS +* +* void glp_btran(glp_prob *lp, double x[]); +* +* DESCRIPTION +* +* The routine glp_btran performs backward transformation, i.e. solves +* the system B'*x = b, where B' is a matrix transposed to the basis +* matrix corresponding to the current basis for the specified problem +* problem object, x is the vector of unknowns to be computed, b is the +* vector of right-hand sides. +* +* On entry elements of the vector b should be stored in dense format +* in locations x[1], ..., x[m], where m is the number of rows. On exit +* the routine stores elements of the vector x in the same locations. +* +* SCALING/UNSCALING +* +* See comments to the routine glp_ftran. */ + +void glp_btran(glp_prob *lp, double x[]) +{ int m = lp->m; + GLPROW **row = lp->row; + GLPCOL **col = lp->col; + int i, k; + /* B'*x = b ===> (SB*B'*R)*(inv(R)*x) = SB*b ===> + (B")'*x" = b", where b" = SB*b, x = R*x" */ + if (!(m == 0 || lp->valid)) + xerror("glp_btran: basis factorization does not exist\n"); + /* b" := SB*b */ + for (i = 1; i <= m; i++) + { k = lp->head[i]; + if (k <= m) + x[i] /= row[k]->rii; + else + x[i] *= col[k-m]->sjj; + } + /* x" := inv[(B")']*b" */ + if (m > 0) bfd_btran(lp->bfd, x); + /* x := R*x" */ + for (i = 1; i <= m; i++) + x[i] *= row[i]->rii; + return; +} + +/*********************************************************************** +* NAME +* +* glp_warm_up - "warm up" LP basis +* +* SYNOPSIS +* +* int glp_warm_up(glp_prob *P); +* +* DESCRIPTION +* +* The routine glp_warm_up "warms up" the LP basis for the specified +* problem object using current statuses assigned to rows and columns +* (that is, to auxiliary and structural variables). +* +* This operation includes computing factorization of the basis matrix +* (if it does not exist), computing primal and dual components of basic +* solution, and determining the solution status. +* +* RETURNS +* +* 0 The operation has been successfully performed. +* +* GLP_EBADB +* The basis matrix is invalid, i.e. the number of basic (auxiliary +* and structural) variables differs from the number of rows in the +* problem object. +* +* GLP_ESING +* The basis matrix is singular within the working precision. +* +* GLP_ECOND +* The basis matrix is ill-conditioned. */ + +int glp_warm_up(glp_prob *P) +{ GLPROW *row; + GLPCOL *col; + GLPAIJ *aij; + int i, j, type, stat, ret; + double eps, temp, *work; + /* invalidate basic solution */ + P->pbs_stat = P->dbs_stat = GLP_UNDEF; + P->obj_val = 0.0; + P->some = 0; + for (i = 1; i <= P->m; i++) + { row = P->row[i]; + row->prim = row->dual = 0.0; + } + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + col->prim = col->dual = 0.0; + } + /* compute the basis factorization, if necessary */ + if (!glp_bf_exists(P)) + { ret = glp_factorize(P); + if (ret != 0) goto done; + } + /* allocate working array */ + work = xcalloc(1+P->m, sizeof(double)); + /* determine and store values of non-basic variables, compute + vector (- N * xN) */ + for (i = 1; i <= P->m; i++) + work[i] = 0.0; + for (i = 1; i <= P->m; i++) + { row = P->row[i]; + if (row->stat == GLP_BS) + continue; + else if (row->stat == GLP_NL) + row->prim = row->lb; + else if (row->stat == GLP_NU) + row->prim = row->ub; + else if (row->stat == GLP_NF) + row->prim = 0.0; + else if (row->stat == GLP_NS) + row->prim = row->lb; + else + xassert(row != row); + /* N[j] is i-th column of matrix (I|-A) */ + work[i] -= row->prim; + } + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (col->stat == GLP_BS) + continue; + else if (col->stat == GLP_NL) + col->prim = col->lb; + else if (col->stat == GLP_NU) + col->prim = col->ub; + else if (col->stat == GLP_NF) + col->prim = 0.0; + else if (col->stat == GLP_NS) + col->prim = col->lb; + else + xassert(col != col); + /* N[j] is (m+j)-th column of matrix (I|-A) */ + if (col->prim != 0.0) + { for (aij = col->ptr; aij != NULL; aij = aij->c_next) + work[aij->row->i] += aij->val * col->prim; + } + } + /* compute vector of basic variables xB = - inv(B) * N * xN */ + glp_ftran(P, work); + /* store values of basic variables, check primal feasibility */ + P->pbs_stat = GLP_FEAS; + for (i = 1; i <= P->m; i++) + { row = P->row[i]; + if (row->stat != GLP_BS) + continue; + row->prim = work[row->bind]; + type = row->type; + if (type == GLP_LO || type == GLP_DB || type == GLP_FX) + { eps = 1e-6 + 1e-9 * fabs(row->lb); + if (row->prim < row->lb - eps) + P->pbs_stat = GLP_INFEAS; + } + if (type == GLP_UP || type == GLP_DB || type == GLP_FX) + { eps = 1e-6 + 1e-9 * fabs(row->ub); + if (row->prim > row->ub + eps) + P->pbs_stat = GLP_INFEAS; + } + } + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (col->stat != GLP_BS) + continue; + col->prim = work[col->bind]; + type = col->type; + if (type == GLP_LO || type == GLP_DB || type == GLP_FX) + { eps = 1e-6 + 1e-9 * fabs(col->lb); + if (col->prim < col->lb - eps) + P->pbs_stat = GLP_INFEAS; + } + if (type == GLP_UP || type == GLP_DB || type == GLP_FX) + { eps = 1e-6 + 1e-9 * fabs(col->ub); + if (col->prim > col->ub + eps) + P->pbs_stat = GLP_INFEAS; + } + } + /* compute value of the objective function */ + P->obj_val = P->c0; + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + P->obj_val += col->coef * col->prim; + } + /* build vector cB of objective coefficients at basic variables */ + for (i = 1; i <= P->m; i++) + work[i] = 0.0; + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (col->stat == GLP_BS) + work[col->bind] = col->coef; + } + /* compute vector of simplex multipliers pi = inv(B') * cB */ + glp_btran(P, work); + /* compute and store reduced costs of non-basic variables d[j] = + c[j] - N'[j] * pi, check dual feasibility */ + P->dbs_stat = GLP_FEAS; + for (i = 1; i <= P->m; i++) + { row = P->row[i]; + if (row->stat == GLP_BS) + { row->dual = 0.0; + continue; + } + /* N[j] is i-th column of matrix (I|-A) */ + row->dual = - work[i]; +#if 0 /* 07/III-2013 */ + type = row->type; + temp = (P->dir == GLP_MIN ? + row->dual : - row->dual); + if ((type == GLP_FR || type == GLP_LO) && temp < -1e-5 || + (type == GLP_FR || type == GLP_UP) && temp > +1e-5) + P->dbs_stat = GLP_INFEAS; +#else + stat = row->stat; + temp = (P->dir == GLP_MIN ? + row->dual : - row->dual); + if ((stat == GLP_NF || stat == GLP_NL) && temp < -1e-5 || + (stat == GLP_NF || stat == GLP_NU) && temp > +1e-5) + P->dbs_stat = GLP_INFEAS; +#endif + } + for (j = 1; j <= P->n; j++) + { col = P->col[j]; + if (col->stat == GLP_BS) + { col->dual = 0.0; + continue; + } + /* N[j] is (m+j)-th column of matrix (I|-A) */ + col->dual = col->coef; + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + col->dual += aij->val * work[aij->row->i]; +#if 0 /* 07/III-2013 */ + type = col->type; + temp = (P->dir == GLP_MIN ? + col->dual : - col->dual); + if ((type == GLP_FR || type == GLP_LO) && temp < -1e-5 || + (type == GLP_FR || type == GLP_UP) && temp > +1e-5) + P->dbs_stat = GLP_INFEAS; +#else + stat = col->stat; + temp = (P->dir == GLP_MIN ? + col->dual : - col->dual); + if ((stat == GLP_NF || stat == GLP_NL) && temp < -1e-5 || + (stat == GLP_NF || stat == GLP_NU) && temp > +1e-5) + P->dbs_stat = GLP_INFEAS; +#endif + } + /* free working array */ + xfree(work); + ret = 0; +done: return ret; +} + +/*********************************************************************** +* NAME +* +* glp_eval_tab_row - compute row of the simplex tableau +* +* SYNOPSIS +* +* int glp_eval_tab_row(glp_prob *lp, int k, int ind[], double val[]); +* +* DESCRIPTION +* +* The routine glp_eval_tab_row computes a row of the current simplex +* tableau for the basic variable, which is specified by the number k: +* if 1 <= k <= m, x[k] is k-th auxiliary variable; if m+1 <= k <= m+n, +* x[k] is (k-m)-th structural variable, where m is number of rows, and +* n is number of columns. The current basis must be available. +* +* The routine stores column indices and numerical values of non-zero +* elements of the computed row using sparse format to the locations +* ind[1], ..., ind[len] and val[1], ..., val[len], respectively, where +* 0 <= len <= n is number of non-zeros returned on exit. +* +* Element indices stored in the array ind have the same sense as the +* index k, i.e. indices 1 to m denote auxiliary variables and indices +* m+1 to m+n denote structural ones (all these variables are obviously +* non-basic by definition). +* +* The computed row shows how the specified basic variable x[k] = xB[i] +* depends on non-basic variables: +* +* xB[i] = alfa[i,1]*xN[1] + alfa[i,2]*xN[2] + ... + alfa[i,n]*xN[n], +* +* where alfa[i,j] are elements of the simplex table row, xN[j] are +* non-basic (auxiliary and structural) variables. +* +* RETURNS +* +* The routine returns number of non-zero elements in the simplex table +* row stored in the arrays ind and val. +* +* BACKGROUND +* +* The system of equality constraints of the LP problem is: +* +* xR = A * xS, (1) +* +* where xR is the vector of auxliary variables, xS is the vector of +* structural variables, A is the matrix of constraint coefficients. +* +* The system (1) can be written in homogenous form as follows: +* +* A~ * x = 0, (2) +* +* where A~ = (I | -A) is the augmented constraint matrix (has m rows +* and m+n columns), x = (xR | xS) is the vector of all (auxiliary and +* structural) variables. +* +* By definition for the current basis we have: +* +* A~ = (B | N), (3) +* +* where B is the basis matrix. Thus, the system (2) can be written as: +* +* B * xB + N * xN = 0. (4) +* +* From (4) it follows that: +* +* xB = A^ * xN, (5) +* +* where the matrix +* +* A^ = - inv(B) * N (6) +* +* is called the simplex table. +* +* It is understood that i-th row of the simplex table is: +* +* e * A^ = - e * inv(B) * N, (7) +* +* where e is a unity vector with e[i] = 1. +* +* To compute i-th row of the simplex table the routine first computes +* i-th row of the inverse: +* +* rho = inv(B') * e, (8) +* +* where B' is a matrix transposed to B, and then computes elements of +* i-th row of the simplex table as scalar products: +* +* alfa[i,j] = - rho * N[j] for all j, (9) +* +* where N[j] is a column of the augmented constraint matrix A~, which +* corresponds to some non-basic auxiliary or structural variable. */ + +int glp_eval_tab_row(glp_prob *lp, int k, int ind[], double val[]) +{ int m = lp->m; + int n = lp->n; + int i, t, len, lll, *iii; + double alfa, *rho, *vvv; + if (!(m == 0 || lp->valid)) + xerror("glp_eval_tab_row: basis factorization does not exist\n" + ); + if (!(1 <= k && k <= m+n)) + xerror("glp_eval_tab_row: k = %d; variable number out of range" + , k); + /* determine xB[i] which corresponds to x[k] */ + if (k <= m) + i = glp_get_row_bind(lp, k); + else + i = glp_get_col_bind(lp, k-m); + if (i == 0) + xerror("glp_eval_tab_row: k = %d; variable must be basic", k); + xassert(1 <= i && i <= m); + /* allocate working arrays */ + rho = xcalloc(1+m, sizeof(double)); + iii = xcalloc(1+m, sizeof(int)); + vvv = xcalloc(1+m, sizeof(double)); + /* compute i-th row of the inverse; see (8) */ + for (t = 1; t <= m; t++) rho[t] = 0.0; + rho[i] = 1.0; + glp_btran(lp, rho); + /* compute i-th row of the simplex table */ + len = 0; + for (k = 1; k <= m+n; k++) + { if (k <= m) + { /* x[k] is auxiliary variable, so N[k] is a unity column */ + if (glp_get_row_stat(lp, k) == GLP_BS) continue; + /* compute alfa[i,j]; see (9) */ + alfa = - rho[k]; + } + else + { /* x[k] is structural variable, so N[k] is a column of the + original constraint matrix A with negative sign */ + if (glp_get_col_stat(lp, k-m) == GLP_BS) continue; + /* compute alfa[i,j]; see (9) */ + lll = glp_get_mat_col(lp, k-m, iii, vvv); + alfa = 0.0; + for (t = 1; t <= lll; t++) alfa += rho[iii[t]] * vvv[t]; + } + /* store alfa[i,j] */ + if (alfa != 0.0) len++, ind[len] = k, val[len] = alfa; + } + xassert(len <= n); + /* free working arrays */ + xfree(rho); + xfree(iii); + xfree(vvv); + /* return to the calling program */ + return len; +} + +/*********************************************************************** +* NAME +* +* glp_eval_tab_col - compute column of the simplex tableau +* +* SYNOPSIS +* +* int glp_eval_tab_col(glp_prob *lp, int k, int ind[], double val[]); +* +* DESCRIPTION +* +* The routine glp_eval_tab_col computes a column of the current simplex +* table for the non-basic variable, which is specified by the number k: +* if 1 <= k <= m, x[k] is k-th auxiliary variable; if m+1 <= k <= m+n, +* x[k] is (k-m)-th structural variable, where m is number of rows, and +* n is number of columns. The current basis must be available. +* +* The routine stores row indices and numerical values of non-zero +* elements of the computed column using sparse format to the locations +* ind[1], ..., ind[len] and val[1], ..., val[len] respectively, where +* 0 <= len <= m is number of non-zeros returned on exit. +* +* Element indices stored in the array ind have the same sense as the +* index k, i.e. indices 1 to m denote auxiliary variables and indices +* m+1 to m+n denote structural ones (all these variables are obviously +* basic by the definition). +* +* The computed column shows how basic variables depend on the specified +* non-basic variable x[k] = xN[j]: +* +* xB[1] = ... + alfa[1,j]*xN[j] + ... +* xB[2] = ... + alfa[2,j]*xN[j] + ... +* . . . . . . +* xB[m] = ... + alfa[m,j]*xN[j] + ... +* +* where alfa[i,j] are elements of the simplex table column, xB[i] are +* basic (auxiliary and structural) variables. +* +* RETURNS +* +* The routine returns number of non-zero elements in the simplex table +* column stored in the arrays ind and val. +* +* BACKGROUND +* +* As it was explained in comments to the routine glp_eval_tab_row (see +* above) the simplex table is the following matrix: +* +* A^ = - inv(B) * N. (1) +* +* Therefore j-th column of the simplex table is: +* +* A^ * e = - inv(B) * N * e = - inv(B) * N[j], (2) +* +* where e is a unity vector with e[j] = 1, B is the basis matrix, N[j] +* is a column of the augmented constraint matrix A~, which corresponds +* to the given non-basic auxiliary or structural variable. */ + +int glp_eval_tab_col(glp_prob *lp, int k, int ind[], double val[]) +{ int m = lp->m; + int n = lp->n; + int t, len, stat; + double *col; + if (!(m == 0 || lp->valid)) + xerror("glp_eval_tab_col: basis factorization does not exist\n" + ); + if (!(1 <= k && k <= m+n)) + xerror("glp_eval_tab_col: k = %d; variable number out of range" + , k); + if (k <= m) + stat = glp_get_row_stat(lp, k); + else + stat = glp_get_col_stat(lp, k-m); + if (stat == GLP_BS) + xerror("glp_eval_tab_col: k = %d; variable must be non-basic", + k); + /* obtain column N[k] with negative sign */ + col = xcalloc(1+m, sizeof(double)); + for (t = 1; t <= m; t++) col[t] = 0.0; + if (k <= m) + { /* x[k] is auxiliary variable, so N[k] is a unity column */ + col[k] = -1.0; + } + else + { /* x[k] is structural variable, so N[k] is a column of the + original constraint matrix A with negative sign */ + len = glp_get_mat_col(lp, k-m, ind, val); + for (t = 1; t <= len; t++) col[ind[t]] = val[t]; + } + /* compute column of the simplex table, which corresponds to the + specified non-basic variable x[k] */ + glp_ftran(lp, col); + len = 0; + for (t = 1; t <= m; t++) + { if (col[t] != 0.0) + { len++; + ind[len] = glp_get_bhead(lp, t); + val[len] = col[t]; + } + } + xfree(col); + /* return to the calling program */ + return len; +} + +/*********************************************************************** +* NAME +* +* glp_transform_row - transform explicitly specified row +* +* SYNOPSIS +* +* int glp_transform_row(glp_prob *P, int len, int ind[], double val[]); +* +* DESCRIPTION +* +* The routine glp_transform_row performs the same operation as the +* routine glp_eval_tab_row with exception that the row to be +* transformed is specified explicitly as a sparse vector. +* +* The explicitly specified row may be thought as a linear form: +* +* x = a[1]*x[m+1] + a[2]*x[m+2] + ... + a[n]*x[m+n], (1) +* +* where x is an auxiliary variable for this row, a[j] are coefficients +* of the linear form, x[m+j] are structural variables. +* +* On entry column indices and numerical values of non-zero elements of +* the row should be stored in locations ind[1], ..., ind[len] and +* val[1], ..., val[len], where len is the number of non-zero elements. +* +* This routine uses the system of equality constraints and the current +* basis in order to express the auxiliary variable x in (1) through the +* current non-basic variables (as if the transformed row were added to +* the problem object and its auxiliary variable were basic), i.e. the +* resultant row has the form: +* +* x = alfa[1]*xN[1] + alfa[2]*xN[2] + ... + alfa[n]*xN[n], (2) +* +* where xN[j] are non-basic (auxiliary or structural) variables, n is +* the number of columns in the LP problem object. +* +* On exit the routine stores indices and numerical values of non-zero +* elements of the resultant row (2) in locations ind[1], ..., ind[len'] +* and val[1], ..., val[len'], where 0 <= len' <= n is the number of +* non-zero elements in the resultant row returned by the routine. Note +* that indices (numbers) of non-basic variables stored in the array ind +* correspond to original ordinal numbers of variables: indices 1 to m +* mean auxiliary variables and indices m+1 to m+n mean structural ones. +* +* RETURNS +* +* The routine returns len', which is the number of non-zero elements in +* the resultant row stored in the arrays ind and val. +* +* BACKGROUND +* +* The explicitly specified row (1) is transformed in the same way as it +* were the objective function row. +* +* From (1) it follows that: +* +* x = aB * xB + aN * xN, (3) +* +* where xB is the vector of basic variables, xN is the vector of +* non-basic variables. +* +* The simplex table, which corresponds to the current basis, is: +* +* xB = [-inv(B) * N] * xN. (4) +* +* Therefore substituting xB from (4) to (3) we have: +* +* x = aB * [-inv(B) * N] * xN + aN * xN = +* (5) +* = rho * (-N) * xN + aN * xN = alfa * xN, +* +* where: +* +* rho = inv(B') * aB, (6) +* +* and +* +* alfa = aN + rho * (-N) (7) +* +* is the resultant row computed by the routine. */ + +int glp_transform_row(glp_prob *P, int len, int ind[], double val[]) +{ int i, j, k, m, n, t, lll, *iii; + double alfa, *a, *aB, *rho, *vvv; + if (!glp_bf_exists(P)) + xerror("glp_transform_row: basis factorization does not exist " + "\n"); + m = glp_get_num_rows(P); + n = glp_get_num_cols(P); + /* unpack the row to be transformed to the array a */ + a = xcalloc(1+n, sizeof(double)); + for (j = 1; j <= n; j++) a[j] = 0.0; + if (!(0 <= len && len <= n)) + xerror("glp_transform_row: len = %d; invalid row length\n", + len); + for (t = 1; t <= len; t++) + { j = ind[t]; + if (!(1 <= j && j <= n)) + xerror("glp_transform_row: ind[%d] = %d; column index out o" + "f range\n", t, j); + if (val[t] == 0.0) + xerror("glp_transform_row: val[%d] = 0; zero coefficient no" + "t allowed\n", t); + if (a[j] != 0.0) + xerror("glp_transform_row: ind[%d] = %d; duplicate column i" + "ndices not allowed\n", t, j); + a[j] = val[t]; + } + /* construct the vector aB */ + aB = xcalloc(1+m, sizeof(double)); + for (i = 1; i <= m; i++) + { k = glp_get_bhead(P, i); + /* xB[i] is k-th original variable */ + xassert(1 <= k && k <= m+n); + aB[i] = (k <= m ? 0.0 : a[k-m]); + } + /* solve the system B'*rho = aB to compute the vector rho */ + rho = aB, glp_btran(P, rho); + /* compute coefficients at non-basic auxiliary variables */ + len = 0; + for (i = 1; i <= m; i++) + { if (glp_get_row_stat(P, i) != GLP_BS) + { alfa = - rho[i]; + if (alfa != 0.0) + { len++; + ind[len] = i; + val[len] = alfa; + } + } + } + /* compute coefficients at non-basic structural variables */ + iii = xcalloc(1+m, sizeof(int)); + vvv = xcalloc(1+m, sizeof(double)); + for (j = 1; j <= n; j++) + { if (glp_get_col_stat(P, j) != GLP_BS) + { alfa = a[j]; + lll = glp_get_mat_col(P, j, iii, vvv); + for (t = 1; t <= lll; t++) alfa += vvv[t] * rho[iii[t]]; + if (alfa != 0.0) + { len++; + ind[len] = m+j; + val[len] = alfa; + } + } + } + xassert(len <= n); + xfree(iii); + xfree(vvv); + xfree(aB); + xfree(a); + return len; +} + +/*********************************************************************** +* NAME +* +* glp_transform_col - transform explicitly specified column +* +* SYNOPSIS +* +* int glp_transform_col(glp_prob *P, int len, int ind[], double val[]); +* +* DESCRIPTION +* +* The routine glp_transform_col performs the same operation as the +* routine glp_eval_tab_col with exception that the column to be +* transformed is specified explicitly as a sparse vector. +* +* The explicitly specified column may be thought as if it were added +* to the original system of equality constraints: +* +* x[1] = a[1,1]*x[m+1] + ... + a[1,n]*x[m+n] + a[1]*x +* x[2] = a[2,1]*x[m+1] + ... + a[2,n]*x[m+n] + a[2]*x (1) +* . . . . . . . . . . . . . . . +* x[m] = a[m,1]*x[m+1] + ... + a[m,n]*x[m+n] + a[m]*x +* +* where x[i] are auxiliary variables, x[m+j] are structural variables, +* x is a structural variable for the explicitly specified column, a[i] +* are constraint coefficients for x. +* +* On entry row indices and numerical values of non-zero elements of +* the column should be stored in locations ind[1], ..., ind[len] and +* val[1], ..., val[len], where len is the number of non-zero elements. +* +* This routine uses the system of equality constraints and the current +* basis in order to express the current basic variables through the +* structural variable x in (1) (as if the transformed column were added +* to the problem object and the variable x were non-basic), i.e. the +* resultant column has the form: +* +* xB[1] = ... + alfa[1]*x +* xB[2] = ... + alfa[2]*x (2) +* . . . . . . +* xB[m] = ... + alfa[m]*x +* +* where xB are basic (auxiliary and structural) variables, m is the +* number of rows in the problem object. +* +* On exit the routine stores indices and numerical values of non-zero +* elements of the resultant column (2) in locations ind[1], ..., +* ind[len'] and val[1], ..., val[len'], where 0 <= len' <= m is the +* number of non-zero element in the resultant column returned by the +* routine. Note that indices (numbers) of basic variables stored in +* the array ind correspond to original ordinal numbers of variables: +* indices 1 to m mean auxiliary variables and indices m+1 to m+n mean +* structural ones. +* +* RETURNS +* +* The routine returns len', which is the number of non-zero elements +* in the resultant column stored in the arrays ind and val. +* +* BACKGROUND +* +* The explicitly specified column (1) is transformed in the same way +* as any other column of the constraint matrix using the formula: +* +* alfa = inv(B) * a, (3) +* +* where alfa is the resultant column computed by the routine. */ + +int glp_transform_col(glp_prob *P, int len, int ind[], double val[]) +{ int i, m, t; + double *a, *alfa; + if (!glp_bf_exists(P)) + xerror("glp_transform_col: basis factorization does not exist " + "\n"); + m = glp_get_num_rows(P); + /* unpack the column to be transformed to the array a */ + a = xcalloc(1+m, sizeof(double)); + for (i = 1; i <= m; i++) a[i] = 0.0; + if (!(0 <= len && len <= m)) + xerror("glp_transform_col: len = %d; invalid column length\n", + len); + for (t = 1; t <= len; t++) + { i = ind[t]; + if (!(1 <= i && i <= m)) + xerror("glp_transform_col: ind[%d] = %d; row index out of r" + "ange\n", t, i); + if (val[t] == 0.0) + xerror("glp_transform_col: val[%d] = 0; zero coefficient no" + "t allowed\n", t); + if (a[i] != 0.0) + xerror("glp_transform_col: ind[%d] = %d; duplicate row indi" + "ces not allowed\n", t, i); + a[i] = val[t]; + } + /* solve the system B*a = alfa to compute the vector alfa */ + alfa = a, glp_ftran(P, alfa); + /* store resultant coefficients */ + len = 0; + for (i = 1; i <= m; i++) + { if (alfa[i] != 0.0) + { len++; + ind[len] = glp_get_bhead(P, i); + val[len] = alfa[i]; + } + } + xfree(a); + return len; +} + +/*********************************************************************** +* NAME +* +* glp_prim_rtest - perform primal ratio test +* +* SYNOPSIS +* +* int glp_prim_rtest(glp_prob *P, int len, const int ind[], +* const double val[], int dir, double eps); +* +* DESCRIPTION +* +* The routine glp_prim_rtest performs the primal ratio test using an +* explicitly specified column of the simplex table. +* +* The current basic solution associated with the LP problem object +* must be primal feasible. +* +* The explicitly specified column of the simplex table shows how the +* basic variables xB depend on some non-basic variable x (which is not +* necessarily presented in the problem object): +* +* xB[1] = ... + alfa[1] * x + ... +* xB[2] = ... + alfa[2] * x + ... (*) +* . . . . . . . . +* xB[m] = ... + alfa[m] * x + ... +* +* The column (*) is specifed on entry to the routine using the sparse +* format. Ordinal numbers of basic variables xB[i] should be placed in +* locations ind[1], ..., ind[len], where ordinal number 1 to m denote +* auxiliary variables, and ordinal numbers m+1 to m+n denote structural +* variables. The corresponding non-zero coefficients alfa[i] should be +* placed in locations val[1], ..., val[len]. The arrays ind and val are +* not changed on exit. +* +* The parameter dir specifies direction in which the variable x changes +* on entering the basis: +1 means increasing, -1 means decreasing. +* +* The parameter eps is an absolute tolerance (small positive number) +* used by the routine to skip small alfa[j] of the row (*). +* +* The routine determines which basic variable (among specified in +* ind[1], ..., ind[len]) should leave the basis in order to keep primal +* feasibility. +* +* RETURNS +* +* The routine glp_prim_rtest returns the index piv in the arrays ind +* and val corresponding to the pivot element chosen, 1 <= piv <= len. +* If the adjacent basic solution is primal unbounded and therefore the +* choice cannot be made, the routine returns zero. +* +* COMMENTS +* +* If the non-basic variable x is presented in the LP problem object, +* the column (*) can be computed with the routine glp_eval_tab_col; +* otherwise it can be computed with the routine glp_transform_col. */ + +int glp_prim_rtest(glp_prob *P, int len, const int ind[], + const double val[], int dir, double eps) +{ int k, m, n, piv, t, type, stat; + double alfa, big, beta, lb, ub, temp, teta; + if (glp_get_prim_stat(P) != GLP_FEAS) + xerror("glp_prim_rtest: basic solution is not primal feasible " + "\n"); + if (!(dir == +1 || dir == -1)) + xerror("glp_prim_rtest: dir = %d; invalid parameter\n", dir); + if (!(0.0 < eps && eps < 1.0)) + xerror("glp_prim_rtest: eps = %g; invalid parameter\n", eps); + m = glp_get_num_rows(P); + n = glp_get_num_cols(P); + /* initial settings */ + piv = 0, teta = DBL_MAX, big = 0.0; + /* walk through the entries of the specified column */ + for (t = 1; t <= len; t++) + { /* get the ordinal number of basic variable */ + k = ind[t]; + if (!(1 <= k && k <= m+n)) + xerror("glp_prim_rtest: ind[%d] = %d; variable number out o" + "f range\n", t, k); + /* determine type, bounds, status and primal value of basic + variable xB[i] = x[k] in the current basic solution */ + if (k <= m) + { type = glp_get_row_type(P, k); + lb = glp_get_row_lb(P, k); + ub = glp_get_row_ub(P, k); + stat = glp_get_row_stat(P, k); + beta = glp_get_row_prim(P, k); + } + else + { type = glp_get_col_type(P, k-m); + lb = glp_get_col_lb(P, k-m); + ub = glp_get_col_ub(P, k-m); + stat = glp_get_col_stat(P, k-m); + beta = glp_get_col_prim(P, k-m); + } + if (stat != GLP_BS) + xerror("glp_prim_rtest: ind[%d] = %d; non-basic variable no" + "t allowed\n", t, k); + /* determine influence coefficient at basic variable xB[i] + in the explicitly specified column and turn to the case of + increasing the variable x in order to simplify the program + logic */ + alfa = (dir > 0 ? + val[t] : - val[t]); + /* analyze main cases */ + if (type == GLP_FR) + { /* xB[i] is free variable */ + continue; + } + else if (type == GLP_LO) +lo: { /* xB[i] has an lower bound */ + if (alfa > - eps) continue; + temp = (lb - beta) / alfa; + } + else if (type == GLP_UP) +up: { /* xB[i] has an upper bound */ + if (alfa < + eps) continue; + temp = (ub - beta) / alfa; + } + else if (type == GLP_DB) + { /* xB[i] has both lower and upper bounds */ + if (alfa < 0.0) goto lo; else goto up; + } + else if (type == GLP_FX) + { /* xB[i] is fixed variable */ + if (- eps < alfa && alfa < + eps) continue; + temp = 0.0; + } + else + xassert(type != type); + /* if the value of the variable xB[i] violates its lower or + upper bound (slightly, because the current basis is assumed + to be primal feasible), temp is negative; we can think this + happens due to round-off errors and the value is exactly on + the bound; this allows replacing temp by zero */ + if (temp < 0.0) temp = 0.0; + /* apply the minimal ratio test */ + if (teta > temp || teta == temp && big < fabs(alfa)) + piv = t, teta = temp, big = fabs(alfa); + } + /* return index of the pivot element chosen */ + return piv; +} + +/*********************************************************************** +* NAME +* +* glp_dual_rtest - perform dual ratio test +* +* SYNOPSIS +* +* int glp_dual_rtest(glp_prob *P, int len, const int ind[], +* const double val[], int dir, double eps); +* +* DESCRIPTION +* +* The routine glp_dual_rtest performs the dual ratio test using an +* explicitly specified row of the simplex table. +* +* The current basic solution associated with the LP problem object +* must be dual feasible. +* +* The explicitly specified row of the simplex table is a linear form +* that shows how some basic variable x (which is not necessarily +* presented in the problem object) depends on non-basic variables xN: +* +* x = alfa[1] * xN[1] + alfa[2] * xN[2] + ... + alfa[n] * xN[n]. (*) +* +* The row (*) is specified on entry to the routine using the sparse +* format. Ordinal numbers of non-basic variables xN[j] should be placed +* in locations ind[1], ..., ind[len], where ordinal numbers 1 to m +* denote auxiliary variables, and ordinal numbers m+1 to m+n denote +* structural variables. The corresponding non-zero coefficients alfa[j] +* should be placed in locations val[1], ..., val[len]. The arrays ind +* and val are not changed on exit. +* +* The parameter dir specifies direction in which the variable x changes +* on leaving the basis: +1 means that x goes to its lower bound, and -1 +* means that x goes to its upper bound. +* +* The parameter eps is an absolute tolerance (small positive number) +* used by the routine to skip small alfa[j] of the row (*). +* +* The routine determines which non-basic variable (among specified in +* ind[1], ..., ind[len]) should enter the basis in order to keep dual +* feasibility. +* +* RETURNS +* +* The routine glp_dual_rtest returns the index piv in the arrays ind +* and val corresponding to the pivot element chosen, 1 <= piv <= len. +* If the adjacent basic solution is dual unbounded and therefore the +* choice cannot be made, the routine returns zero. +* +* COMMENTS +* +* If the basic variable x is presented in the LP problem object, the +* row (*) can be computed with the routine glp_eval_tab_row; otherwise +* it can be computed with the routine glp_transform_row. */ + +int glp_dual_rtest(glp_prob *P, int len, const int ind[], + const double val[], int dir, double eps) +{ int k, m, n, piv, t, stat; + double alfa, big, cost, obj, temp, teta; + if (glp_get_dual_stat(P) != GLP_FEAS) + xerror("glp_dual_rtest: basic solution is not dual feasible\n") + ; + if (!(dir == +1 || dir == -1)) + xerror("glp_dual_rtest: dir = %d; invalid parameter\n", dir); + if (!(0.0 < eps && eps < 1.0)) + xerror("glp_dual_rtest: eps = %g; invalid parameter\n", eps); + m = glp_get_num_rows(P); + n = glp_get_num_cols(P); + /* take into account optimization direction */ + obj = (glp_get_obj_dir(P) == GLP_MIN ? +1.0 : -1.0); + /* initial settings */ + piv = 0, teta = DBL_MAX, big = 0.0; + /* walk through the entries of the specified row */ + for (t = 1; t <= len; t++) + { /* get ordinal number of non-basic variable */ + k = ind[t]; + if (!(1 <= k && k <= m+n)) + xerror("glp_dual_rtest: ind[%d] = %d; variable number out o" + "f range\n", t, k); + /* determine status and reduced cost of non-basic variable + x[k] = xN[j] in the current basic solution */ + if (k <= m) + { stat = glp_get_row_stat(P, k); + cost = glp_get_row_dual(P, k); + } + else + { stat = glp_get_col_stat(P, k-m); + cost = glp_get_col_dual(P, k-m); + } + if (stat == GLP_BS) + xerror("glp_dual_rtest: ind[%d] = %d; basic variable not al" + "lowed\n", t, k); + /* determine influence coefficient at non-basic variable xN[j] + in the explicitly specified row and turn to the case of + increasing the variable x in order to simplify the program + logic */ + alfa = (dir > 0 ? + val[t] : - val[t]); + /* analyze main cases */ + if (stat == GLP_NL) + { /* xN[j] is on its lower bound */ + if (alfa < + eps) continue; + temp = (obj * cost) / alfa; + } + else if (stat == GLP_NU) + { /* xN[j] is on its upper bound */ + if (alfa > - eps) continue; + temp = (obj * cost) / alfa; + } + else if (stat == GLP_NF) + { /* xN[j] is non-basic free variable */ + if (- eps < alfa && alfa < + eps) continue; + temp = 0.0; + } + else if (stat == GLP_NS) + { /* xN[j] is non-basic fixed variable */ + continue; + } + else + xassert(stat != stat); + /* if the reduced cost of the variable xN[j] violates its zero + bound (slightly, because the current basis is assumed to be + dual feasible), temp is negative; we can think this happens + due to round-off errors and the reduced cost is exact zero; + this allows replacing temp by zero */ + if (temp < 0.0) temp = 0.0; + /* apply the minimal ratio test */ + if (teta > temp || teta == temp && big < fabs(alfa)) + piv = t, teta = temp, big = fabs(alfa); + } + /* return index of the pivot element chosen */ + return piv; +} + +/*********************************************************************** +* NAME +* +* glp_analyze_row - simulate one iteration of dual simplex method +* +* SYNOPSIS +* +* int glp_analyze_row(glp_prob *P, int len, const int ind[], +* const double val[], int type, double rhs, double eps, int *piv, +* double *x, double *dx, double *y, double *dy, double *dz); +* +* DESCRIPTION +* +* Let the current basis be optimal or dual feasible, and there be +* specified a row (constraint), which is violated by the current basic +* solution. The routine glp_analyze_row simulates one iteration of the +* dual simplex method to determine some information on the adjacent +* basis (see below), where the specified row becomes active constraint +* (i.e. its auxiliary variable becomes non-basic). +* +* The current basic solution associated with the problem object passed +* to the routine must be dual feasible, and its primal components must +* be defined. +* +* The row to be analyzed must be previously transformed either with +* the routine glp_eval_tab_row (if the row is in the problem object) +* or with the routine glp_transform_row (if the row is external, i.e. +* not in the problem object). This is needed to express the row only +* through (auxiliary and structural) variables, which are non-basic in +* the current basis: +* +* y = alfa[1] * xN[1] + alfa[2] * xN[2] + ... + alfa[n] * xN[n], +* +* where y is an auxiliary variable of the row, alfa[j] is an influence +* coefficient, xN[j] is a non-basic variable. +* +* The row is passed to the routine in sparse format. Ordinal numbers +* of non-basic variables are stored in locations ind[1], ..., ind[len], +* where numbers 1 to m denote auxiliary variables while numbers m+1 to +* m+n denote structural variables. Corresponding non-zero coefficients +* alfa[j] are stored in locations val[1], ..., val[len]. The arrays +* ind and val are ot changed on exit. +* +* The parameters type and rhs specify the row type and its right-hand +* side as follows: +* +* type = GLP_LO: y = sum alfa[j] * xN[j] >= rhs +* +* type = GLP_UP: y = sum alfa[j] * xN[j] <= rhs +* +* The parameter eps is an absolute tolerance (small positive number) +* used by the routine to skip small coefficients alfa[j] on performing +* the dual ratio test. +* +* If the operation was successful, the routine stores the following +* information to corresponding location (if some parameter is NULL, +* its value is not stored): +* +* piv index in the array ind and val, 1 <= piv <= len, determining +* the non-basic variable, which would enter the adjacent basis; +* +* x value of the non-basic variable in the current basis; +* +* dx difference between values of the non-basic variable in the +* adjacent and current bases, dx = x.new - x.old; +* +* y value of the row (i.e. of its auxiliary variable) in the +* current basis; +* +* dy difference between values of the row in the adjacent and +* current bases, dy = y.new - y.old; +* +* dz difference between values of the objective function in the +* adjacent and current bases, dz = z.new - z.old. Note that in +* case of minimization dz >= 0, and in case of maximization +* dz <= 0, i.e. in the adjacent basis the objective function +* always gets worse (degrades). */ + +int _glp_analyze_row(glp_prob *P, int len, const int ind[], + const double val[], int type, double rhs, double eps, int *_piv, + double *_x, double *_dx, double *_y, double *_dy, double *_dz) +{ int t, k, dir, piv, ret = 0; + double x, dx, y, dy, dz; + if (P->pbs_stat == GLP_UNDEF) + xerror("glp_analyze_row: primal basic solution components are " + "undefined\n"); + if (P->dbs_stat != GLP_FEAS) + xerror("glp_analyze_row: basic solution is not dual feasible\n" + ); + /* compute the row value y = sum alfa[j] * xN[j] in the current + basis */ + if (!(0 <= len && len <= P->n)) + xerror("glp_analyze_row: len = %d; invalid row length\n", len); + y = 0.0; + for (t = 1; t <= len; t++) + { /* determine value of x[k] = xN[j] in the current basis */ + k = ind[t]; + if (!(1 <= k && k <= P->m+P->n)) + xerror("glp_analyze_row: ind[%d] = %d; row/column index out" + " of range\n", t, k); + if (k <= P->m) + { /* x[k] is auxiliary variable */ + if (P->row[k]->stat == GLP_BS) + xerror("glp_analyze_row: ind[%d] = %d; basic auxiliary v" + "ariable is not allowed\n", t, k); + x = P->row[k]->prim; + } + else + { /* x[k] is structural variable */ + if (P->col[k-P->m]->stat == GLP_BS) + xerror("glp_analyze_row: ind[%d] = %d; basic structural " + "variable is not allowed\n", t, k); + x = P->col[k-P->m]->prim; + } + y += val[t] * x; + } + /* check if the row is primal infeasible in the current basis, + i.e. the constraint is violated at the current point */ + if (type == GLP_LO) + { if (y >= rhs) + { /* the constraint is not violated */ + ret = 1; + goto done; + } + /* in the adjacent basis y goes to its lower bound */ + dir = +1; + } + else if (type == GLP_UP) + { if (y <= rhs) + { /* the constraint is not violated */ + ret = 1; + goto done; + } + /* in the adjacent basis y goes to its upper bound */ + dir = -1; + } + else + xerror("glp_analyze_row: type = %d; invalid parameter\n", + type); + /* compute dy = y.new - y.old */ + dy = rhs - y; + /* perform dual ratio test to determine which non-basic variable + should enter the adjacent basis to keep it dual feasible */ + piv = glp_dual_rtest(P, len, ind, val, dir, eps); + if (piv == 0) + { /* no dual feasible adjacent basis exists */ + ret = 2; + goto done; + } + /* non-basic variable x[k] = xN[j] should enter the basis */ + k = ind[piv]; + xassert(1 <= k && k <= P->m+P->n); + /* determine its value in the current basis */ + if (k <= P->m) + x = P->row[k]->prim; + else + x = P->col[k-P->m]->prim; + /* compute dx = x.new - x.old = dy / alfa[j] */ + xassert(val[piv] != 0.0); + dx = dy / val[piv]; + /* compute dz = z.new - z.old = d[j] * dx, where d[j] is reduced + cost of xN[j] in the current basis */ + if (k <= P->m) + dz = P->row[k]->dual * dx; + else + dz = P->col[k-P->m]->dual * dx; + /* store the analysis results */ + if (_piv != NULL) *_piv = piv; + if (_x != NULL) *_x = x; + if (_dx != NULL) *_dx = dx; + if (_y != NULL) *_y = y; + if (_dy != NULL) *_dy = dy; + if (_dz != NULL) *_dz = dz; +done: return ret; +} + +#if 0 +int main(void) +{ /* example program for the routine glp_analyze_row */ + glp_prob *P; + glp_smcp parm; + int i, k, len, piv, ret, ind[1+100]; + double rhs, x, dx, y, dy, dz, val[1+100]; + P = glp_create_prob(); + /* read plan.mps (see glpk/examples) */ + ret = glp_read_mps(P, GLP_MPS_DECK, NULL, "plan.mps"); + glp_assert(ret == 0); + /* and solve it to optimality */ + ret = glp_simplex(P, NULL); + glp_assert(ret == 0); + glp_assert(glp_get_status(P) == GLP_OPT); + /* the optimal objective value is 296.217 */ + /* we would like to know what happens if we would add a new row + (constraint) to plan.mps: + .01 * bin1 + .01 * bin2 + .02 * bin4 + .02 * bin5 <= 12 */ + /* first, we specify this new row */ + glp_create_index(P); + len = 0; + ind[++len] = glp_find_col(P, "BIN1"), val[len] = .01; + ind[++len] = glp_find_col(P, "BIN2"), val[len] = .01; + ind[++len] = glp_find_col(P, "BIN4"), val[len] = .02; + ind[++len] = glp_find_col(P, "BIN5"), val[len] = .02; + rhs = 12; + /* then we can compute value of the row (i.e. of its auxiliary + variable) in the current basis to see if the constraint is + violated */ + y = 0.0; + for (k = 1; k <= len; k++) + y += val[k] * glp_get_col_prim(P, ind[k]); + glp_printf("y = %g\n", y); + /* this prints y = 15.1372, so the constraint is violated, since + we require that y <= rhs = 12 */ + /* now we transform the row to express it only through non-basic + (auxiliary and artificial) variables */ + len = glp_transform_row(P, len, ind, val); + /* finally, we simulate one step of the dual simplex method to + obtain necessary information for the adjacent basis */ + ret = _glp_analyze_row(P, len, ind, val, GLP_UP, rhs, 1e-9, &piv, + &x, &dx, &y, &dy, &dz); + glp_assert(ret == 0); + glp_printf("k = %d, x = %g; dx = %g; y = %g; dy = %g; dz = %g\n", + ind[piv], x, dx, y, dy, dz); + /* this prints dz = 5.64418 and means that in the adjacent basis + the objective function would be 296.217 + 5.64418 = 301.861 */ + /* now we actually include the row into the problem object; note + that the arrays ind and val are clobbered, so we need to build + them once again */ + len = 0; + ind[++len] = glp_find_col(P, "BIN1"), val[len] = .01; + ind[++len] = glp_find_col(P, "BIN2"), val[len] = .01; + ind[++len] = glp_find_col(P, "BIN4"), val[len] = .02; + ind[++len] = glp_find_col(P, "BIN5"), val[len] = .02; + rhs = 12; + i = glp_add_rows(P, 1); + glp_set_row_bnds(P, i, GLP_UP, 0, rhs); + glp_set_mat_row(P, i, len, ind, val); + /* and perform one dual simplex iteration */ + glp_init_smcp(&parm); + parm.meth = GLP_DUAL; + parm.it_lim = 1; + glp_simplex(P, &parm); + /* the current objective value is 301.861 */ + return 0; +} +#endif + +/*********************************************************************** +* NAME +* +* glp_analyze_bound - analyze active bound of non-basic variable +* +* SYNOPSIS +* +* void glp_analyze_bound(glp_prob *P, int k, double *limit1, int *var1, +* double *limit2, int *var2); +* +* DESCRIPTION +* +* The routine glp_analyze_bound analyzes the effect of varying the +* active bound of specified non-basic variable. +* +* The non-basic variable is specified by the parameter k, where +* 1 <= k <= m means auxiliary variable of corresponding row while +* m+1 <= k <= m+n means structural variable (column). +* +* Note that the current basic solution must be optimal, and the basis +* factorization must exist. +* +* Results of the analysis have the following meaning. +* +* value1 is the minimal value of the active bound, at which the basis +* still remains primal feasible and thus optimal. -DBL_MAX means that +* the active bound has no lower limit. +* +* var1 is the ordinal number of an auxiliary (1 to m) or structural +* (m+1 to n) basic variable, which reaches its bound first and thereby +* limits further decreasing the active bound being analyzed. +* if value1 = -DBL_MAX, var1 is set to 0. +* +* value2 is the maximal value of the active bound, at which the basis +* still remains primal feasible and thus optimal. +DBL_MAX means that +* the active bound has no upper limit. +* +* var2 is the ordinal number of an auxiliary (1 to m) or structural +* (m+1 to n) basic variable, which reaches its bound first and thereby +* limits further increasing the active bound being analyzed. +* if value2 = +DBL_MAX, var2 is set to 0. */ + +void glp_analyze_bound(glp_prob *P, int k, double *value1, int *var1, + double *value2, int *var2) +{ GLPROW *row; + GLPCOL *col; + int m, n, stat, kase, p, len, piv, *ind; + double x, new_x, ll, uu, xx, delta, *val; +#if 0 /* 04/IV-2016 */ + /* sanity checks */ + if (P == NULL || P->magic != GLP_PROB_MAGIC) + xerror("glp_analyze_bound: P = %p; invalid problem object\n", + P); +#endif + m = P->m, n = P->n; + if (!(P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS)) + xerror("glp_analyze_bound: optimal basic solution required\n"); + if (!(m == 0 || P->valid)) + xerror("glp_analyze_bound: basis factorization required\n"); + if (!(1 <= k && k <= m+n)) + xerror("glp_analyze_bound: k = %d; variable number out of rang" + "e\n", k); + /* retrieve information about the specified non-basic variable + x[k] whose active bound is to be analyzed */ + if (k <= m) + { row = P->row[k]; + stat = row->stat; + x = row->prim; + } + else + { col = P->col[k-m]; + stat = col->stat; + x = col->prim; + } + if (stat == GLP_BS) + xerror("glp_analyze_bound: k = %d; basic variable not allowed " + "\n", k); + /* allocate working arrays */ + ind = xcalloc(1+m, sizeof(int)); + val = xcalloc(1+m, sizeof(double)); + /* compute column of the simplex table corresponding to the + non-basic variable x[k] */ + len = glp_eval_tab_col(P, k, ind, val); + xassert(0 <= len && len <= m); + /* perform analysis */ + for (kase = -1; kase <= +1; kase += 2) + { /* kase < 0 means active bound of x[k] is decreasing; + kase > 0 means active bound of x[k] is increasing */ + /* use the primal ratio test to determine some basic variable + x[p] which reaches its bound first */ + piv = glp_prim_rtest(P, len, ind, val, kase, 1e-9); + if (piv == 0) + { /* nothing limits changing the active bound of x[k] */ + p = 0; + new_x = (kase < 0 ? -DBL_MAX : +DBL_MAX); + goto store; + } + /* basic variable x[p] limits changing the active bound of + x[k]; determine its value in the current basis */ + xassert(1 <= piv && piv <= len); + p = ind[piv]; + if (p <= m) + { row = P->row[p]; + ll = glp_get_row_lb(P, row->i); + uu = glp_get_row_ub(P, row->i); + stat = row->stat; + xx = row->prim; + } + else + { col = P->col[p-m]; + ll = glp_get_col_lb(P, col->j); + uu = glp_get_col_ub(P, col->j); + stat = col->stat; + xx = col->prim; + } + xassert(stat == GLP_BS); + /* determine delta x[p] = bound of x[p] - value of x[p] */ + if (kase < 0 && val[piv] > 0.0 || + kase > 0 && val[piv] < 0.0) + { /* delta x[p] < 0, so x[p] goes toward its lower bound */ + xassert(ll != -DBL_MAX); + delta = ll - xx; + } + else + { /* delta x[p] > 0, so x[p] goes toward its upper bound */ + xassert(uu != +DBL_MAX); + delta = uu - xx; + } + /* delta x[p] = alfa[p,k] * delta x[k], so new x[k] = x[k] + + delta x[k] = x[k] + delta x[p] / alfa[p,k] is the value of + x[k] in the adjacent basis */ + xassert(val[piv] != 0.0); + new_x = x + delta / val[piv]; +store: /* store analysis results */ + if (kase < 0) + { if (value1 != NULL) *value1 = new_x; + if (var1 != NULL) *var1 = p; + } + else + { if (value2 != NULL) *value2 = new_x; + if (var2 != NULL) *var2 = p; + } + } + /* free working arrays */ + xfree(ind); + xfree(val); + return; +} + +/*********************************************************************** +* NAME +* +* glp_analyze_coef - analyze objective coefficient at basic variable +* +* SYNOPSIS +* +* void glp_analyze_coef(glp_prob *P, int k, double *coef1, int *var1, +* double *value1, double *coef2, int *var2, double *value2); +* +* DESCRIPTION +* +* The routine glp_analyze_coef analyzes the effect of varying the +* objective coefficient at specified basic variable. +* +* The basic variable is specified by the parameter k, where +* 1 <= k <= m means auxiliary variable of corresponding row while +* m+1 <= k <= m+n means structural variable (column). +* +* Note that the current basic solution must be optimal, and the basis +* factorization must exist. +* +* Results of the analysis have the following meaning. +* +* coef1 is the minimal value of the objective coefficient, at which +* the basis still remains dual feasible and thus optimal. -DBL_MAX +* means that the objective coefficient has no lower limit. +* +* var1 is the ordinal number of an auxiliary (1 to m) or structural +* (m+1 to n) non-basic variable, whose reduced cost reaches its zero +* bound first and thereby limits further decreasing the objective +* coefficient being analyzed. If coef1 = -DBL_MAX, var1 is set to 0. +* +* value1 is value of the basic variable being analyzed in an adjacent +* basis, which is defined as follows. Let the objective coefficient +* reaches its minimal value (coef1) and continues decreasing. Then the +* reduced cost of the limiting non-basic variable (var1) becomes dual +* infeasible and the current basis becomes non-optimal that forces the +* limiting non-basic variable to enter the basis replacing there some +* basic variable that leaves the basis to keep primal feasibility. +* Should note that on determining the adjacent basis current bounds +* of the basic variable being analyzed are ignored as if it were free +* (unbounded) variable, so it cannot leave the basis. It may happen +* that no dual feasible adjacent basis exists, in which case value1 is +* set to -DBL_MAX or +DBL_MAX. +* +* coef2 is the maximal value of the objective coefficient, at which +* the basis still remains dual feasible and thus optimal. +DBL_MAX +* means that the objective coefficient has no upper limit. +* +* var2 is the ordinal number of an auxiliary (1 to m) or structural +* (m+1 to n) non-basic variable, whose reduced cost reaches its zero +* bound first and thereby limits further increasing the objective +* coefficient being analyzed. If coef2 = +DBL_MAX, var2 is set to 0. +* +* value2 is value of the basic variable being analyzed in an adjacent +* basis, which is defined exactly in the same way as value1 above with +* exception that now the objective coefficient is increasing. */ + +void glp_analyze_coef(glp_prob *P, int k, double *coef1, int *var1, + double *value1, double *coef2, int *var2, double *value2) +{ GLPROW *row; GLPCOL *col; + int m, n, type, stat, kase, p, q, dir, clen, cpiv, rlen, rpiv, + *cind, *rind; + double lb, ub, coef, x, lim_coef, new_x, d, delta, ll, uu, xx, + *rval, *cval; +#if 0 /* 04/IV-2016 */ + /* sanity checks */ + if (P == NULL || P->magic != GLP_PROB_MAGIC) + xerror("glp_analyze_coef: P = %p; invalid problem object\n", + P); +#endif + m = P->m, n = P->n; + if (!(P->pbs_stat == GLP_FEAS && P->dbs_stat == GLP_FEAS)) + xerror("glp_analyze_coef: optimal basic solution required\n"); + if (!(m == 0 || P->valid)) + xerror("glp_analyze_coef: basis factorization required\n"); + if (!(1 <= k && k <= m+n)) + xerror("glp_analyze_coef: k = %d; variable number out of range" + "\n", k); + /* retrieve information about the specified basic variable x[k] + whose objective coefficient c[k] is to be analyzed */ + if (k <= m) + { row = P->row[k]; + type = row->type; + lb = row->lb; + ub = row->ub; + coef = 0.0; + stat = row->stat; + x = row->prim; + } + else + { col = P->col[k-m]; + type = col->type; + lb = col->lb; + ub = col->ub; + coef = col->coef; + stat = col->stat; + x = col->prim; + } + if (stat != GLP_BS) + xerror("glp_analyze_coef: k = %d; non-basic variable not allow" + "ed\n", k); + /* allocate working arrays */ + cind = xcalloc(1+m, sizeof(int)); + cval = xcalloc(1+m, sizeof(double)); + rind = xcalloc(1+n, sizeof(int)); + rval = xcalloc(1+n, sizeof(double)); + /* compute row of the simplex table corresponding to the basic + variable x[k] */ + rlen = glp_eval_tab_row(P, k, rind, rval); + xassert(0 <= rlen && rlen <= n); + /* perform analysis */ + for (kase = -1; kase <= +1; kase += 2) + { /* kase < 0 means objective coefficient c[k] is decreasing; + kase > 0 means objective coefficient c[k] is increasing */ + /* note that decreasing c[k] is equivalent to increasing dual + variable lambda[k] and vice versa; we need to correctly set + the dir flag as required by the routine glp_dual_rtest */ + if (P->dir == GLP_MIN) + dir = - kase; + else if (P->dir == GLP_MAX) + dir = + kase; + else + xassert(P != P); + /* use the dual ratio test to determine non-basic variable + x[q] whose reduced cost d[q] reaches zero bound first */ + rpiv = glp_dual_rtest(P, rlen, rind, rval, dir, 1e-9); + if (rpiv == 0) + { /* nothing limits changing c[k] */ + lim_coef = (kase < 0 ? -DBL_MAX : +DBL_MAX); + q = 0; + /* x[k] keeps its current value */ + new_x = x; + goto store; + } + /* non-basic variable x[q] limits changing coefficient c[k]; + determine its status and reduced cost d[k] in the current + basis */ + xassert(1 <= rpiv && rpiv <= rlen); + q = rind[rpiv]; + xassert(1 <= q && q <= m+n); + if (q <= m) + { row = P->row[q]; + stat = row->stat; + d = row->dual; + } + else + { col = P->col[q-m]; + stat = col->stat; + d = col->dual; + } + /* note that delta d[q] = new d[q] - d[q] = - d[q], because + new d[q] = 0; delta d[q] = alfa[k,q] * delta c[k], so + delta c[k] = delta d[q] / alfa[k,q] = - d[q] / alfa[k,q] */ + xassert(rval[rpiv] != 0.0); + delta = - d / rval[rpiv]; + /* compute new c[k] = c[k] + delta c[k], which is the limiting + value of the objective coefficient c[k] */ + lim_coef = coef + delta; + /* let c[k] continue decreasing/increasing that makes d[q] + dual infeasible and forces x[q] to enter the basis; + to perform the primal ratio test we need to know in which + direction x[q] changes on entering the basis; we determine + that analyzing the sign of delta d[q] (see above), since + d[q] may be close to zero having wrong sign */ + /* let, for simplicity, the problem is minimization */ + if (kase < 0 && rval[rpiv] > 0.0 || + kase > 0 && rval[rpiv] < 0.0) + { /* delta d[q] < 0, so d[q] being non-negative will become + negative, so x[q] will increase */ + dir = +1; + } + else + { /* delta d[q] > 0, so d[q] being non-positive will become + positive, so x[q] will decrease */ + dir = -1; + } + /* if the problem is maximization, correct the direction */ + if (P->dir == GLP_MAX) dir = - dir; + /* check that we didn't make a silly mistake */ + if (dir > 0) + xassert(stat == GLP_NL || stat == GLP_NF); + else + xassert(stat == GLP_NU || stat == GLP_NF); + /* compute column of the simplex table corresponding to the + non-basic variable x[q] */ + clen = glp_eval_tab_col(P, q, cind, cval); + /* make x[k] temporarily free (unbounded) */ + if (k <= m) + { row = P->row[k]; + row->type = GLP_FR; + row->lb = row->ub = 0.0; + } + else + { col = P->col[k-m]; + col->type = GLP_FR; + col->lb = col->ub = 0.0; + } + /* use the primal ratio test to determine some basic variable + which leaves the basis */ + cpiv = glp_prim_rtest(P, clen, cind, cval, dir, 1e-9); + /* restore original bounds of the basic variable x[k] */ + if (k <= m) + { row = P->row[k]; + row->type = type; + row->lb = lb, row->ub = ub; + } + else + { col = P->col[k-m]; + col->type = type; + col->lb = lb, col->ub = ub; + } + if (cpiv == 0) + { /* non-basic variable x[q] can change unlimitedly */ + if (dir < 0 && rval[rpiv] > 0.0 || + dir > 0 && rval[rpiv] < 0.0) + { /* delta x[k] = alfa[k,q] * delta x[q] < 0 */ + new_x = -DBL_MAX; + } + else + { /* delta x[k] = alfa[k,q] * delta x[q] > 0 */ + new_x = +DBL_MAX; + } + goto store; + } + /* some basic variable x[p] limits changing non-basic variable + x[q] in the adjacent basis */ + xassert(1 <= cpiv && cpiv <= clen); + p = cind[cpiv]; + xassert(1 <= p && p <= m+n); + xassert(p != k); + if (p <= m) + { row = P->row[p]; + xassert(row->stat == GLP_BS); + ll = glp_get_row_lb(P, row->i); + uu = glp_get_row_ub(P, row->i); + xx = row->prim; + } + else + { col = P->col[p-m]; + xassert(col->stat == GLP_BS); + ll = glp_get_col_lb(P, col->j); + uu = glp_get_col_ub(P, col->j); + xx = col->prim; + } + /* determine delta x[p] = new x[p] - x[p] */ + if (dir < 0 && cval[cpiv] > 0.0 || + dir > 0 && cval[cpiv] < 0.0) + { /* delta x[p] < 0, so x[p] goes toward its lower bound */ + xassert(ll != -DBL_MAX); + delta = ll - xx; + } + else + { /* delta x[p] > 0, so x[p] goes toward its upper bound */ + xassert(uu != +DBL_MAX); + delta = uu - xx; + } + /* compute new x[k] = x[k] + alfa[k,q] * delta x[q], where + delta x[q] = delta x[p] / alfa[p,q] */ + xassert(cval[cpiv] != 0.0); + new_x = x + (rval[rpiv] / cval[cpiv]) * delta; +store: /* store analysis results */ + if (kase < 0) + { if (coef1 != NULL) *coef1 = lim_coef; + if (var1 != NULL) *var1 = q; + if (value1 != NULL) *value1 = new_x; + } + else + { if (coef2 != NULL) *coef2 = lim_coef; + if (var2 != NULL) *var2 = q; + if (value2 != NULL) *value2 = new_x; + } + } + /* free working arrays */ + xfree(cind); + xfree(cval); + xfree(rind); + xfree(rval); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpapi13.c b/test/monniaux/glpk-4.65/src/draft/glpapi13.c new file mode 100644 index 00000000..1181b397 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpapi13.c @@ -0,0 +1,710 @@ +/* glpapi13.c (branch-and-bound interface routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" + +/*********************************************************************** +* NAME +* +* glp_ios_reason - determine reason for calling the callback routine +* +* SYNOPSIS +* +* glp_ios_reason(glp_tree *tree); +* +* RETURNS +* +* The routine glp_ios_reason returns a code, which indicates why the +* user-defined callback routine is being called. */ + +int glp_ios_reason(glp_tree *tree) +{ return + tree->reason; +} + +/*********************************************************************** +* NAME +* +* glp_ios_get_prob - access the problem object +* +* SYNOPSIS +* +* glp_prob *glp_ios_get_prob(glp_tree *tree); +* +* DESCRIPTION +* +* The routine glp_ios_get_prob can be called from the user-defined +* callback routine to access the problem object, which is used by the +* MIP solver. It is the original problem object passed to the routine +* glp_intopt if the MIP presolver is not used; otherwise it is an +* internal problem object built by the presolver. If the current +* subproblem exists, LP segment of the problem object corresponds to +* its LP relaxation. +* +* RETURNS +* +* The routine glp_ios_get_prob returns a pointer to the problem object +* used by the MIP solver. */ + +glp_prob *glp_ios_get_prob(glp_tree *tree) +{ return + tree->mip; +} + +/*********************************************************************** +* NAME +* +* glp_ios_tree_size - determine size of the branch-and-bound tree +* +* SYNOPSIS +* +* void glp_ios_tree_size(glp_tree *tree, int *a_cnt, int *n_cnt, +* int *t_cnt); +* +* DESCRIPTION +* +* The routine glp_ios_tree_size stores the following three counts which +* characterize the current size of the branch-and-bound tree: +* +* a_cnt is the current number of active nodes, i.e. the current size of +* the active list; +* +* n_cnt is the current number of all (active and inactive) nodes; +* +* t_cnt is the total number of nodes including those which have been +* already removed from the tree. This count is increased whenever +* a new node appears in the tree and never decreased. +* +* If some of the parameters a_cnt, n_cnt, t_cnt is a null pointer, the +* corresponding count is not stored. */ + +void glp_ios_tree_size(glp_tree *tree, int *a_cnt, int *n_cnt, + int *t_cnt) +{ if (a_cnt != NULL) *a_cnt = tree->a_cnt; + if (n_cnt != NULL) *n_cnt = tree->n_cnt; + if (t_cnt != NULL) *t_cnt = tree->t_cnt; + return; +} + +/*********************************************************************** +* NAME +* +* glp_ios_curr_node - determine current active subproblem +* +* SYNOPSIS +* +* int glp_ios_curr_node(glp_tree *tree); +* +* RETURNS +* +* The routine glp_ios_curr_node returns the reference number of the +* current active subproblem. However, if the current subproblem does +* not exist, the routine returns zero. */ + +int glp_ios_curr_node(glp_tree *tree) +{ IOSNPD *node; + /* obtain pointer to the current subproblem */ + node = tree->curr; + /* return its reference number */ + return node == NULL ? 0 : node->p; +} + +/*********************************************************************** +* NAME +* +* glp_ios_next_node - determine next active subproblem +* +* SYNOPSIS +* +* int glp_ios_next_node(glp_tree *tree, int p); +* +* RETURNS +* +* If the parameter p is zero, the routine glp_ios_next_node returns +* the reference number of the first active subproblem. However, if the +* tree is empty, zero is returned. +* +* If the parameter p is not zero, it must specify the reference number +* of some active subproblem, in which case the routine returns the +* reference number of the next active subproblem. However, if there is +* no next active subproblem in the list, zero is returned. +* +* All subproblems in the active list are ordered chronologically, i.e. +* subproblem A precedes subproblem B if A was created before B. */ + +int glp_ios_next_node(glp_tree *tree, int p) +{ IOSNPD *node; + if (p == 0) + { /* obtain pointer to the first active subproblem */ + node = tree->head; + } + else + { /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_next_node: p = %d; invalid subproblem refer" + "ence number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* the specified subproblem must be active */ + if (node->count != 0) + xerror("glp_ios_next_node: p = %d; subproblem not in the ac" + "tive list\n", p); + /* obtain pointer to the next active subproblem */ + node = node->next; + } + /* return the reference number */ + return node == NULL ? 0 : node->p; +} + +/*********************************************************************** +* NAME +* +* glp_ios_prev_node - determine previous active subproblem +* +* SYNOPSIS +* +* int glp_ios_prev_node(glp_tree *tree, int p); +* +* RETURNS +* +* If the parameter p is zero, the routine glp_ios_prev_node returns +* the reference number of the last active subproblem. However, if the +* tree is empty, zero is returned. +* +* If the parameter p is not zero, it must specify the reference number +* of some active subproblem, in which case the routine returns the +* reference number of the previous active subproblem. However, if there +* is no previous active subproblem in the list, zero is returned. +* +* All subproblems in the active list are ordered chronologically, i.e. +* subproblem A precedes subproblem B if A was created before B. */ + +int glp_ios_prev_node(glp_tree *tree, int p) +{ IOSNPD *node; + if (p == 0) + { /* obtain pointer to the last active subproblem */ + node = tree->tail; + } + else + { /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_prev_node: p = %d; invalid subproblem refer" + "ence number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* the specified subproblem must be active */ + if (node->count != 0) + xerror("glp_ios_prev_node: p = %d; subproblem not in the ac" + "tive list\n", p); + /* obtain pointer to the previous active subproblem */ + node = node->prev; + } + /* return the reference number */ + return node == NULL ? 0 : node->p; +} + +/*********************************************************************** +* NAME +* +* glp_ios_up_node - determine parent subproblem +* +* SYNOPSIS +* +* int glp_ios_up_node(glp_tree *tree, int p); +* +* RETURNS +* +* The parameter p must specify the reference number of some (active or +* inactive) subproblem, in which case the routine iet_get_up_node +* returns the reference number of its parent subproblem. However, if +* the specified subproblem is the root of the tree and, therefore, has +* no parent, the routine returns zero. */ + +int glp_ios_up_node(glp_tree *tree, int p) +{ IOSNPD *node; + /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_up_node: p = %d; invalid subproblem reference " + "number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* obtain pointer to the parent subproblem */ + node = node->up; + /* return the reference number */ + return node == NULL ? 0 : node->p; +} + +/*********************************************************************** +* NAME +* +* glp_ios_node_level - determine subproblem level +* +* SYNOPSIS +* +* int glp_ios_node_level(glp_tree *tree, int p); +* +* RETURNS +* +* The routine glp_ios_node_level returns the level of the subproblem, +* whose reference number is p, in the branch-and-bound tree. (The root +* subproblem has level 0, and the level of any other subproblem is the +* level of its parent plus one.) */ + +int glp_ios_node_level(glp_tree *tree, int p) +{ IOSNPD *node; + /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_node_level: p = %d; invalid subproblem referen" + "ce number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* return the node level */ + return node->level; +} + +/*********************************************************************** +* NAME +* +* glp_ios_node_bound - determine subproblem local bound +* +* SYNOPSIS +* +* double glp_ios_node_bound(glp_tree *tree, int p); +* +* RETURNS +* +* The routine glp_ios_node_bound returns the local bound for (active or +* inactive) subproblem, whose reference number is p. +* +* COMMENTS +* +* The local bound for subproblem p is an lower (minimization) or upper +* (maximization) bound for integer optimal solution to this subproblem +* (not to the original problem). This bound is local in the sense that +* only subproblems in the subtree rooted at node p cannot have better +* integer feasible solutions. +* +* On creating a subproblem (due to the branching step) its local bound +* is inherited from its parent and then may get only stronger (never +* weaker). For the root subproblem its local bound is initially set to +* -DBL_MAX (minimization) or +DBL_MAX (maximization) and then improved +* as the root LP relaxation has been solved. +* +* Note that the local bound is not necessarily the optimal objective +* value to corresponding LP relaxation; it may be stronger. */ + +double glp_ios_node_bound(glp_tree *tree, int p) +{ IOSNPD *node; + /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_node_bound: p = %d; invalid subproblem referen" + "ce number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* return the node local bound */ + return node->bound; +} + +/*********************************************************************** +* NAME +* +* glp_ios_best_node - find active subproblem with best local bound +* +* SYNOPSIS +* +* int glp_ios_best_node(glp_tree *tree); +* +* RETURNS +* +* The routine glp_ios_best_node returns the reference number of the +* active subproblem, whose local bound is best (i.e. smallest in case +* of minimization or largest in case of maximization). However, if the +* tree is empty, the routine returns zero. +* +* COMMENTS +* +* The best local bound is an lower (minimization) or upper +* (maximization) bound for integer optimal solution to the original +* MIP problem. */ + +int glp_ios_best_node(glp_tree *tree) +{ return + ios_best_node(tree); +} + +/*********************************************************************** +* NAME +* +* glp_ios_mip_gap - compute relative MIP gap +* +* SYNOPSIS +* +* double glp_ios_mip_gap(glp_tree *tree); +* +* DESCRIPTION +* +* The routine glp_ios_mip_gap computes the relative MIP gap with the +* following formula: +* +* gap = |best_mip - best_bnd| / (|best_mip| + DBL_EPSILON), +* +* where best_mip is the best integer feasible solution found so far, +* best_bnd is the best (global) bound. If no integer feasible solution +* has been found yet, gap is set to DBL_MAX. +* +* RETURNS +* +* The routine glp_ios_mip_gap returns the relative MIP gap. */ + +double glp_ios_mip_gap(glp_tree *tree) +{ return + ios_relative_gap(tree); +} + +/*********************************************************************** +* NAME +* +* glp_ios_node_data - access subproblem application-specific data +* +* SYNOPSIS +* +* void *glp_ios_node_data(glp_tree *tree, int p); +* +* DESCRIPTION +* +* The routine glp_ios_node_data allows the application accessing a +* memory block allocated for the subproblem (which may be active or +* inactive), whose reference number is p. +* +* The size of the block is defined by the control parameter cb_size +* passed to the routine glp_intopt. The block is initialized by binary +* zeros on creating corresponding subproblem, and its contents is kept +* until the subproblem will be removed from the tree. +* +* The application may use these memory blocks to store specific data +* for each subproblem. +* +* RETURNS +* +* The routine glp_ios_node_data returns a pointer to the memory block +* for the specified subproblem. Note that if cb_size = 0, the routine +* returns a null pointer. */ + +void *glp_ios_node_data(glp_tree *tree, int p) +{ IOSNPD *node; + /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_node_level: p = %d; invalid subproblem referen" + "ce number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* return pointer to the application-specific data */ + return node->data; +} + +/*********************************************************************** +* NAME +* +* glp_ios_row_attr - retrieve additional row attributes +* +* SYNOPSIS +* +* void glp_ios_row_attr(glp_tree *tree, int i, glp_attr *attr); +* +* DESCRIPTION +* +* The routine glp_ios_row_attr retrieves additional attributes of row +* i and stores them in the structure glp_attr. */ + +void glp_ios_row_attr(glp_tree *tree, int i, glp_attr *attr) +{ GLPROW *row; + if (!(1 <= i && i <= tree->mip->m)) + xerror("glp_ios_row_attr: i = %d; row number out of range\n", + i); + row = tree->mip->row[i]; + attr->level = row->level; + attr->origin = row->origin; + attr->klass = row->klass; + return; +} + +/**********************************************************************/ + +int glp_ios_pool_size(glp_tree *tree) +{ /* determine current size of the cut pool */ + if (tree->reason != GLP_ICUTGEN) + xerror("glp_ios_pool_size: operation not allowed\n"); + xassert(tree->local != NULL); +#ifdef NEW_LOCAL /* 02/II-2018 */ + return tree->local->m; +#else + return tree->local->size; +#endif +} + +/**********************************************************************/ + +int glp_ios_add_row(glp_tree *tree, + const char *name, int klass, int flags, int len, const int ind[], + const double val[], int type, double rhs) +{ /* add row (constraint) to the cut pool */ + int num; + if (tree->reason != GLP_ICUTGEN) + xerror("glp_ios_add_row: operation not allowed\n"); + xassert(tree->local != NULL); + num = ios_add_row(tree, tree->local, name, klass, flags, len, + ind, val, type, rhs); + return num; +} + +/**********************************************************************/ + +void glp_ios_del_row(glp_tree *tree, int i) +{ /* remove row (constraint) from the cut pool */ + if (tree->reason != GLP_ICUTGEN) + xerror("glp_ios_del_row: operation not allowed\n"); + ios_del_row(tree, tree->local, i); + return; +} + +/**********************************************************************/ + +void glp_ios_clear_pool(glp_tree *tree) +{ /* remove all rows (constraints) from the cut pool */ + if (tree->reason != GLP_ICUTGEN) + xerror("glp_ios_clear_pool: operation not allowed\n"); + ios_clear_pool(tree, tree->local); + return; +} + +/*********************************************************************** +* NAME +* +* glp_ios_can_branch - check if can branch upon specified variable +* +* SYNOPSIS +* +* int glp_ios_can_branch(glp_tree *tree, int j); +* +* RETURNS +* +* If j-th variable (column) can be used to branch upon, the routine +* glp_ios_can_branch returns non-zero, otherwise zero. */ + +int glp_ios_can_branch(glp_tree *tree, int j) +{ if (!(1 <= j && j <= tree->mip->n)) + xerror("glp_ios_can_branch: j = %d; column number out of range" + "\n", j); + return tree->non_int[j]; +} + +/*********************************************************************** +* NAME +* +* glp_ios_branch_upon - choose variable to branch upon +* +* SYNOPSIS +* +* void glp_ios_branch_upon(glp_tree *tree, int j, int sel); +* +* DESCRIPTION +* +* The routine glp_ios_branch_upon can be called from the user-defined +* callback routine in response to the reason GLP_IBRANCH to choose a +* branching variable, whose ordinal number is j. Should note that only +* variables, for which the routine glp_ios_can_branch returns non-zero, +* can be used to branch upon. +* +* The parameter sel is a flag that indicates which branch (subproblem) +* should be selected next to continue the search: +* +* GLP_DN_BRNCH - select down-branch; +* GLP_UP_BRNCH - select up-branch; +* GLP_NO_BRNCH - use general selection technique. */ + +void glp_ios_branch_upon(glp_tree *tree, int j, int sel) +{ if (!(1 <= j && j <= tree->mip->n)) + xerror("glp_ios_branch_upon: j = %d; column number out of rang" + "e\n", j); + if (!(sel == GLP_DN_BRNCH || sel == GLP_UP_BRNCH || + sel == GLP_NO_BRNCH)) + xerror("glp_ios_branch_upon: sel = %d: invalid branch selectio" + "n flag\n", sel); + if (!(tree->non_int[j])) + xerror("glp_ios_branch_upon: j = %d; variable cannot be used t" + "o branch upon\n", j); + if (tree->br_var != 0) + xerror("glp_ios_branch_upon: branching variable already chosen" + "\n"); + tree->br_var = j; + tree->br_sel = sel; + return; +} + +/*********************************************************************** +* NAME +* +* glp_ios_select_node - select subproblem to continue the search +* +* SYNOPSIS +* +* void glp_ios_select_node(glp_tree *tree, int p); +* +* DESCRIPTION +* +* The routine glp_ios_select_node can be called from the user-defined +* callback routine in response to the reason GLP_ISELECT to select an +* active subproblem, whose reference number is p. The search will be +* continued from the subproblem selected. */ + +void glp_ios_select_node(glp_tree *tree, int p) +{ IOSNPD *node; + /* obtain pointer to the specified subproblem */ + if (!(1 <= p && p <= tree->nslots)) +err: xerror("glp_ios_select_node: p = %d; invalid subproblem refere" + "nce number\n", p); + node = tree->slot[p].node; + if (node == NULL) goto err; + /* the specified subproblem must be active */ + if (node->count != 0) + xerror("glp_ios_select_node: p = %d; subproblem not in the act" + "ive list\n", p); + /* no subproblem must be selected yet */ + if (tree->next_p != 0) + xerror("glp_ios_select_node: subproblem already selected\n"); + /* select the specified subproblem to continue the search */ + tree->next_p = p; + return; +} + +/*********************************************************************** +* NAME +* +* glp_ios_heur_sol - provide solution found by heuristic +* +* SYNOPSIS +* +* int glp_ios_heur_sol(glp_tree *tree, const double x[]); +* +* DESCRIPTION +* +* The routine glp_ios_heur_sol can be called from the user-defined +* callback routine in response to the reason GLP_IHEUR to provide an +* integer feasible solution found by a primal heuristic. +* +* Primal values of *all* variables (columns) found by the heuristic +* should be placed in locations x[1], ..., x[n], where n is the number +* of columns in the original problem object. Note that the routine +* glp_ios_heur_sol *does not* check primal feasibility of the solution +* provided. +* +* Using the solution passed in the array x the routine computes value +* of the objective function. If the objective value is better than the +* best known integer feasible solution, the routine computes values of +* auxiliary variables (rows) and stores all solution components in the +* problem object. +* +* RETURNS +* +* If the provided solution is accepted, the routine glp_ios_heur_sol +* returns zero. Otherwise, if the provided solution is rejected, the +* routine returns non-zero. */ + +int glp_ios_heur_sol(glp_tree *tree, const double x[]) +{ glp_prob *mip = tree->mip; + int m = tree->orig_m; + int n = tree->n; + int i, j; + double obj; + xassert(mip->m >= m); + xassert(mip->n == n); + /* check values of integer variables and compute value of the + objective function */ + obj = mip->c0; + for (j = 1; j <= n; j++) + { GLPCOL *col = mip->col[j]; + if (col->kind == GLP_IV) + { /* provided value must be integral */ + if (x[j] != floor(x[j])) return 1; + } + obj += col->coef * x[j]; + } + /* check if the provided solution is better than the best known + integer feasible solution */ + if (mip->mip_stat == GLP_FEAS) + { switch (mip->dir) + { case GLP_MIN: + if (obj >= tree->mip->mip_obj) return 1; + break; + case GLP_MAX: + if (obj <= tree->mip->mip_obj) return 1; + break; + default: + xassert(mip != mip); + } + } + /* it is better; store it in the problem object */ + if (tree->parm->msg_lev >= GLP_MSG_ON) + xprintf("Solution found by heuristic: %.12g\n", obj); + mip->mip_stat = GLP_FEAS; + mip->mip_obj = obj; + for (j = 1; j <= n; j++) + mip->col[j]->mipx = x[j]; + for (i = 1; i <= m; i++) + { GLPROW *row = mip->row[i]; + GLPAIJ *aij; + row->mipx = 0.0; + for (aij = row->ptr; aij != NULL; aij = aij->r_next) + row->mipx += aij->val * aij->col->mipx; + } +#if 1 /* 11/VII-2013 */ + ios_process_sol(tree); +#endif + return 0; +} + +/*********************************************************************** +* NAME +* +* glp_ios_terminate - terminate the solution process. +* +* SYNOPSIS +* +* void glp_ios_terminate(glp_tree *tree); +* +* DESCRIPTION +* +* The routine glp_ios_terminate sets a flag indicating that the MIP +* solver should prematurely terminate the search. */ + +void glp_ios_terminate(glp_tree *tree) +{ if (tree->parm->msg_lev >= GLP_MSG_DBG) + xprintf("The search is prematurely terminated due to applicati" + "on request\n"); + tree->stop = 1; + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glphbm.c b/test/monniaux/glpk-4.65/src/draft/glphbm.c new file mode 100644 index 00000000..8b33c172 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glphbm.c @@ -0,0 +1,533 @@ +/* glphbm.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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/>. +***********************************************************************/ + +#include "env.h" +#include "glphbm.h" +#include "misc.h" + +/*********************************************************************** +* NAME +* +* hbm_read_mat - read sparse matrix in Harwell-Boeing format +* +* SYNOPSIS +* +* #include "glphbm.h" +* HBM *hbm_read_mat(const char *fname); +* +* DESCRIPTION +* +* The routine hbm_read_mat reads a sparse matrix in the Harwell-Boeing +* format from a text file whose name is the character string fname. +* +* Detailed description of the Harwell-Boeing format recognised by this +* routine is given in the following report: +* +* I.S.Duff, R.G.Grimes, J.G.Lewis. User's Guide for the Harwell-Boeing +* Sparse Matrix Collection (Release I), TR/PA/92/86, October 1992. +* +* RETURNS +* +* If no error occured, the routine hbm_read_mat returns a pointer to +* a data structure containing the matrix. In case of error the routine +* prints an appropriate error message and returns NULL. */ + +struct dsa +{ /* working area used by routine hbm_read_mat */ + const char *fname; + /* name of input text file */ + FILE *fp; + /* stream assigned to input text file */ + int seqn; + /* card sequential number */ + char card[80+1]; + /* card image buffer */ + int fmt_p; + /* scale factor */ + int fmt_k; + /* iterator */ + int fmt_f; + /* format code */ + int fmt_w; + /* field width */ + int fmt_d; + /* number of decimal places after point */ +}; + +/*********************************************************************** +* read_card - read next data card +* +* This routine reads the next 80-column card from the input text file +* and stores its image into the character string card. If the card was +* read successfully, the routine returns zero, otherwise non-zero. */ + +#if 1 /* 11/III-2012 */ +static int read_card(struct dsa *dsa) +{ int c, len = 0; + char buf[255+1]; + dsa->seqn++; + for (;;) + { c = fgetc(dsa->fp); + if (c == EOF) + { if (ferror(dsa->fp)) + xprintf("%s:%d: read error\n", + dsa->fname, dsa->seqn); + else + xprintf("%s:%d: unexpected end-of-file\n", + dsa->fname, dsa->seqn); + return 1; + } + else if (c == '\r') + /* nop */; + else if (c == '\n') + break; + else if (iscntrl(c)) + { xprintf("%s:%d: invalid control character\n", + dsa->fname, dsa->seqn, c); + return 1; + } + else + { if (len == sizeof(buf)-1) + goto err; + buf[len++] = (char)c; + } + } + /* remove trailing spaces */ + while (len > 80 && buf[len-1] == ' ') + len--; + buf[len] = '\0'; + /* line should not be longer than 80 chars */ + if (len > 80) +err: { xerror("%s:%d: card image too long\n", + dsa->fname, dsa->seqn); + return 1; + } + /* padd by spaces to 80-column card image */ + strcpy(dsa->card, buf); + memset(&dsa->card[len], ' ', 80 - len); + dsa->card[80] = '\0'; + return 0; +} +#endif + +/*********************************************************************** +* scan_int - scan integer value from the current card +* +* This routine scans an integer value from the current card, where fld +* is the name of the field, pos is the position of the field, width is +* the width of the field, val points to a location to which the scanned +* value should be stored. If the value was scanned successfully, the +* routine returns zero, otherwise non-zero. */ + +static int scan_int(struct dsa *dsa, char *fld, int pos, int width, + int *val) +{ char str[80+1]; + xassert(1 <= width && width <= 80); + memcpy(str, dsa->card + pos, width), str[width] = '\0'; + if (str2int(strspx(str), val)) + { xprintf("%s:%d: field '%s' contains invalid value '%s'\n", + dsa->fname, dsa->seqn, fld, str); + return 1; + } + return 0; +} + +/*********************************************************************** +* parse_fmt - parse Fortran format specification +* +* This routine parses the Fortran format specification represented as +* character string which fmt points to and stores format elements into +* appropriate static locations. Should note that not all valid Fortran +* format specifications may be recognised. If the format specification +* was recognised, the routine returns zero, otherwise non-zero. */ + +static int parse_fmt(struct dsa *dsa, char *fmt) +{ int k, s, val; + char str[80+1]; + /* first character should be left parenthesis */ + if (fmt[0] != '(') +fail: { xprintf("hbm_read_mat: format '%s' not recognised\n", fmt); + return 1; + } + k = 1; + /* optional scale factor */ + dsa->fmt_p = 0; + if (isdigit((unsigned char)fmt[k])) + { s = 0; + while (isdigit((unsigned char)fmt[k])) + { if (s == 80) goto fail; + str[s++] = fmt[k++]; + } + str[s] = '\0'; + if (str2int(str, &val)) goto fail; + if (toupper((unsigned char)fmt[k]) != 'P') goto iter; + dsa->fmt_p = val, k++; + if (!(0 <= dsa->fmt_p && dsa->fmt_p <= 255)) goto fail; + /* optional comma may follow scale factor */ + if (fmt[k] == ',') k++; + } + /* optional iterator */ + dsa->fmt_k = 1; + if (isdigit((unsigned char)fmt[k])) + { s = 0; + while (isdigit((unsigned char)fmt[k])) + { if (s == 80) goto fail; + str[s++] = fmt[k++]; + } + str[s] = '\0'; + if (str2int(str, &val)) goto fail; +iter: dsa->fmt_k = val; + if (!(1 <= dsa->fmt_k && dsa->fmt_k <= 255)) goto fail; + } + /* format code */ + dsa->fmt_f = toupper((unsigned char)fmt[k++]); + if (!(dsa->fmt_f == 'D' || dsa->fmt_f == 'E' || + dsa->fmt_f == 'F' || dsa->fmt_f == 'G' || + dsa->fmt_f == 'I')) goto fail; + /* field width */ + if (!isdigit((unsigned char)fmt[k])) goto fail; + s = 0; + while (isdigit((unsigned char)fmt[k])) + { if (s == 80) goto fail; + str[s++] = fmt[k++]; + } + str[s] = '\0'; + if (str2int(str, &dsa->fmt_w)) goto fail; + if (!(1 <= dsa->fmt_w && dsa->fmt_w <= 255)) goto fail; + /* optional number of decimal places after point */ + dsa->fmt_d = 0; + if (fmt[k] == '.') + { k++; + if (!isdigit((unsigned char)fmt[k])) goto fail; + s = 0; + while (isdigit((unsigned char)fmt[k])) + { if (s == 80) goto fail; + str[s++] = fmt[k++]; + } + str[s] = '\0'; + if (str2int(str, &dsa->fmt_d)) goto fail; + if (!(0 <= dsa->fmt_d && dsa->fmt_d <= 255)) goto fail; + } + /* last character should be right parenthesis */ + if (!(fmt[k] == ')' && fmt[k+1] == '\0')) goto fail; + return 0; +} + +/*********************************************************************** +* read_int_array - read array of integer type +* +* This routine reads an integer array from the input text file, where +* name is array name, fmt is Fortran format specification that controls +* reading, n is number of array elements, val is array of integer type. +* If the array was read successful, the routine returns zero, otherwise +* non-zero. */ + +static int read_int_array(struct dsa *dsa, char *name, char *fmt, + int n, int val[]) +{ int k, pos; + char str[80+1]; + if (parse_fmt(dsa, fmt)) return 1; + if (!(dsa->fmt_f == 'I' && dsa->fmt_w <= 80 && + dsa->fmt_k * dsa->fmt_w <= 80)) + { xprintf( + "%s:%d: can't read array '%s' - invalid format '%s'\n", + dsa->fname, dsa->seqn, name, fmt); + return 1; + } + for (k = 1, pos = INT_MAX; k <= n; k++, pos++) + { if (pos >= dsa->fmt_k) + { if (read_card(dsa)) return 1; + pos = 0; + } + memcpy(str, dsa->card + dsa->fmt_w * pos, dsa->fmt_w); + str[dsa->fmt_w] = '\0'; + strspx(str); + if (str2int(str, &val[k])) + { xprintf( + "%s:%d: can't read array '%s' - invalid value '%s'\n", + dsa->fname, dsa->seqn, name, str); + return 1; + } + } + return 0; +} + +/*********************************************************************** +* read_real_array - read array of real type +* +* This routine reads a real array from the input text file, where name +* is array name, fmt is Fortran format specification that controls +* reading, n is number of array elements, val is array of real type. +* If the array was read successful, the routine returns zero, otherwise +* non-zero. */ + +static int read_real_array(struct dsa *dsa, char *name, char *fmt, + int n, double val[]) +{ int k, pos; + char str[80+1], *ptr; + if (parse_fmt(dsa, fmt)) return 1; + if (!(dsa->fmt_f != 'I' && dsa->fmt_w <= 80 && + dsa->fmt_k * dsa->fmt_w <= 80)) + { xprintf( + "%s:%d: can't read array '%s' - invalid format '%s'\n", + dsa->fname, dsa->seqn, name, fmt); + return 1; + } + for (k = 1, pos = INT_MAX; k <= n; k++, pos++) + { if (pos >= dsa->fmt_k) + { if (read_card(dsa)) return 1; + pos = 0; + } + memcpy(str, dsa->card + dsa->fmt_w * pos, dsa->fmt_w); + str[dsa->fmt_w] = '\0'; + strspx(str); + if (strchr(str, '.') == NULL && strcmp(str, "0")) + { xprintf("%s(%d): can't read array '%s' - value '%s' has no " + "decimal point\n", dsa->fname, dsa->seqn, name, str); + return 1; + } + /* sometimes lower case letters appear */ + for (ptr = str; *ptr; ptr++) + *ptr = (char)toupper((unsigned char)*ptr); + ptr = strchr(str, 'D'); + if (ptr != NULL) *ptr = 'E'; + /* value may appear with decimal exponent but without letters + E or D (for example, -123.456-012), so missing letter should + be inserted */ + ptr = strchr(str+1, '+'); + if (ptr == NULL) ptr = strchr(str+1, '-'); + if (ptr != NULL && *(ptr-1) != 'E') + { xassert(strlen(str) < 80); + memmove(ptr+1, ptr, strlen(ptr)+1); + *ptr = 'E'; + } + if (str2num(str, &val[k])) + { xprintf( + "%s:%d: can't read array '%s' - invalid value '%s'\n", + dsa->fname, dsa->seqn, name, str); + return 1; + } + } + return 0; +} + +HBM *hbm_read_mat(const char *fname) +{ struct dsa _dsa, *dsa = &_dsa; + HBM *hbm = NULL; + dsa->fname = fname; + xprintf("hbm_read_mat: reading matrix from '%s'...\n", + dsa->fname); + dsa->fp = fopen(dsa->fname, "r"); + if (dsa->fp == NULL) + { xprintf("hbm_read_mat: unable to open '%s' - %s\n", +#if 0 /* 29/I-2017 */ + dsa->fname, strerror(errno)); +#else + dsa->fname, xstrerr(errno)); +#endif + goto fail; + } + dsa->seqn = 0; + hbm = xmalloc(sizeof(HBM)); + memset(hbm, 0, sizeof(HBM)); + /* read the first heading card */ + if (read_card(dsa)) goto fail; + memcpy(hbm->title, dsa->card, 72), hbm->title[72] = '\0'; + strtrim(hbm->title); + xprintf("%s\n", hbm->title); + memcpy(hbm->key, dsa->card+72, 8), hbm->key[8] = '\0'; + strspx(hbm->key); + xprintf("key = %s\n", hbm->key); + /* read the second heading card */ + if (read_card(dsa)) goto fail; + if (scan_int(dsa, "totcrd", 0, 14, &hbm->totcrd)) goto fail; + if (scan_int(dsa, "ptrcrd", 14, 14, &hbm->ptrcrd)) goto fail; + if (scan_int(dsa, "indcrd", 28, 14, &hbm->indcrd)) goto fail; + if (scan_int(dsa, "valcrd", 42, 14, &hbm->valcrd)) goto fail; + if (scan_int(dsa, "rhscrd", 56, 14, &hbm->rhscrd)) goto fail; + xprintf("totcrd = %d; ptrcrd = %d; indcrd = %d; valcrd = %d; rhsc" + "rd = %d\n", hbm->totcrd, hbm->ptrcrd, hbm->indcrd, + hbm->valcrd, hbm->rhscrd); + /* read the third heading card */ + if (read_card(dsa)) goto fail; + memcpy(hbm->mxtype, dsa->card, 3), hbm->mxtype[3] = '\0'; + if (strchr("RCP", hbm->mxtype[0]) == NULL || + strchr("SUHZR", hbm->mxtype[1]) == NULL || + strchr("AE", hbm->mxtype[2]) == NULL) + { xprintf("%s:%d: matrix type '%s' not recognised\n", + dsa->fname, dsa->seqn, hbm->mxtype); + goto fail; + } + if (scan_int(dsa, "nrow", 14, 14, &hbm->nrow)) goto fail; + if (scan_int(dsa, "ncol", 28, 14, &hbm->ncol)) goto fail; + if (scan_int(dsa, "nnzero", 42, 14, &hbm->nnzero)) goto fail; + if (scan_int(dsa, "neltvl", 56, 14, &hbm->neltvl)) goto fail; + xprintf("mxtype = %s; nrow = %d; ncol = %d; nnzero = %d; neltvl =" + " %d\n", hbm->mxtype, hbm->nrow, hbm->ncol, hbm->nnzero, + hbm->neltvl); + /* read the fourth heading card */ + if (read_card(dsa)) goto fail; + memcpy(hbm->ptrfmt, dsa->card, 16), hbm->ptrfmt[16] = '\0'; + strspx(hbm->ptrfmt); + memcpy(hbm->indfmt, dsa->card+16, 16), hbm->indfmt[16] = '\0'; + strspx(hbm->indfmt); + memcpy(hbm->valfmt, dsa->card+32, 20), hbm->valfmt[20] = '\0'; + strspx(hbm->valfmt); + memcpy(hbm->rhsfmt, dsa->card+52, 20), hbm->rhsfmt[20] = '\0'; + strspx(hbm->rhsfmt); + xprintf("ptrfmt = %s; indfmt = %s; valfmt = %s; rhsfmt = %s\n", + hbm->ptrfmt, hbm->indfmt, hbm->valfmt, hbm->rhsfmt); + /* read the fifth heading card (optional) */ + if (hbm->rhscrd <= 0) + { strcpy(hbm->rhstyp, "???"); + hbm->nrhs = 0; + hbm->nrhsix = 0; + } + else + { if (read_card(dsa)) goto fail; + memcpy(hbm->rhstyp, dsa->card, 3), hbm->rhstyp[3] = '\0'; + if (scan_int(dsa, "nrhs", 14, 14, &hbm->nrhs)) goto fail; + if (scan_int(dsa, "nrhsix", 28, 14, &hbm->nrhsix)) goto fail; + xprintf("rhstyp = '%s'; nrhs = %d; nrhsix = %d\n", + hbm->rhstyp, hbm->nrhs, hbm->nrhsix); + } + /* read matrix structure */ + hbm->colptr = xcalloc(1+hbm->ncol+1, sizeof(int)); + if (read_int_array(dsa, "colptr", hbm->ptrfmt, hbm->ncol+1, + hbm->colptr)) goto fail; + hbm->rowind = xcalloc(1+hbm->nnzero, sizeof(int)); + if (read_int_array(dsa, "rowind", hbm->indfmt, hbm->nnzero, + hbm->rowind)) goto fail; + /* read matrix values */ + if (hbm->valcrd <= 0) goto done; + if (hbm->mxtype[2] == 'A') + { /* assembled matrix */ + hbm->values = xcalloc(1+hbm->nnzero, sizeof(double)); + if (read_real_array(dsa, "values", hbm->valfmt, hbm->nnzero, + hbm->values)) goto fail; + } + else + { /* elemental (unassembled) matrix */ + hbm->values = xcalloc(1+hbm->neltvl, sizeof(double)); + if (read_real_array(dsa, "values", hbm->valfmt, hbm->neltvl, + hbm->values)) goto fail; + } + /* read right-hand sides */ + if (hbm->nrhs <= 0) goto done; + if (hbm->rhstyp[0] == 'F') + { /* dense format */ + hbm->nrhsvl = hbm->nrow * hbm->nrhs; + hbm->rhsval = xcalloc(1+hbm->nrhsvl, sizeof(double)); + if (read_real_array(dsa, "rhsval", hbm->rhsfmt, hbm->nrhsvl, + hbm->rhsval)) goto fail; + } + else if (hbm->rhstyp[0] == 'M' && hbm->mxtype[2] == 'A') + { /* sparse format */ + /* read pointers */ + hbm->rhsptr = xcalloc(1+hbm->nrhs+1, sizeof(int)); + if (read_int_array(dsa, "rhsptr", hbm->ptrfmt, hbm->nrhs+1, + hbm->rhsptr)) goto fail; + /* read sparsity pattern */ + hbm->rhsind = xcalloc(1+hbm->nrhsix, sizeof(int)); + if (read_int_array(dsa, "rhsind", hbm->indfmt, hbm->nrhsix, + hbm->rhsind)) goto fail; + /* read values */ + hbm->rhsval = xcalloc(1+hbm->nrhsix, sizeof(double)); + if (read_real_array(dsa, "rhsval", hbm->rhsfmt, hbm->nrhsix, + hbm->rhsval)) goto fail; + } + else if (hbm->rhstyp[0] == 'M' && hbm->mxtype[2] == 'E') + { /* elemental format */ + hbm->rhsval = xcalloc(1+hbm->nrhsvl, sizeof(double)); + if (read_real_array(dsa, "rhsval", hbm->rhsfmt, hbm->nrhsvl, + hbm->rhsval)) goto fail; + } + else + { xprintf("%s:%d: right-hand side type '%c' not recognised\n", + dsa->fname, dsa->seqn, hbm->rhstyp[0]); + goto fail; + } + /* read starting guesses */ + if (hbm->rhstyp[1] == 'G') + { hbm->nguess = hbm->nrow * hbm->nrhs; + hbm->sguess = xcalloc(1+hbm->nguess, sizeof(double)); + if (read_real_array(dsa, "sguess", hbm->rhsfmt, hbm->nguess, + hbm->sguess)) goto fail; + } + /* read solution vectors */ + if (hbm->rhstyp[2] == 'X') + { hbm->nexact = hbm->nrow * hbm->nrhs; + hbm->xexact = xcalloc(1+hbm->nexact, sizeof(double)); + if (read_real_array(dsa, "xexact", hbm->rhsfmt, hbm->nexact, + hbm->xexact)) goto fail; + } +done: /* reading has been completed */ + xprintf("hbm_read_mat: %d cards were read\n", dsa->seqn); + fclose(dsa->fp); + return hbm; +fail: /* something wrong in Danish kingdom */ + if (hbm != NULL) + { if (hbm->colptr != NULL) xfree(hbm->colptr); + if (hbm->rowind != NULL) xfree(hbm->rowind); + if (hbm->rhsptr != NULL) xfree(hbm->rhsptr); + if (hbm->rhsind != NULL) xfree(hbm->rhsind); + if (hbm->values != NULL) xfree(hbm->values); + if (hbm->rhsval != NULL) xfree(hbm->rhsval); + if (hbm->sguess != NULL) xfree(hbm->sguess); + if (hbm->xexact != NULL) xfree(hbm->xexact); + xfree(hbm); + } + if (dsa->fp != NULL) fclose(dsa->fp); + return NULL; +} + +/*********************************************************************** +* NAME +* +* hbm_free_mat - free sparse matrix in Harwell-Boeing format +* +* SYNOPSIS +* +* #include "glphbm.h" +* void hbm_free_mat(HBM *hbm); +* +* DESCRIPTION +* +* The hbm_free_mat routine frees all the memory allocated to the data +* structure containing a sparse matrix in the Harwell-Boeing format. */ + +void hbm_free_mat(HBM *hbm) +{ if (hbm->colptr != NULL) xfree(hbm->colptr); + if (hbm->rowind != NULL) xfree(hbm->rowind); + if (hbm->rhsptr != NULL) xfree(hbm->rhsptr); + if (hbm->rhsind != NULL) xfree(hbm->rhsind); + if (hbm->values != NULL) xfree(hbm->values); + if (hbm->rhsval != NULL) xfree(hbm->rhsval); + if (hbm->sguess != NULL) xfree(hbm->sguess); + if (hbm->xexact != NULL) xfree(hbm->xexact); + xfree(hbm); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glphbm.h b/test/monniaux/glpk-4.65/src/draft/glphbm.h new file mode 100644 index 00000000..688a78ec --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glphbm.h @@ -0,0 +1,127 @@ +/* glphbm.h (Harwell-Boeing sparse matrix format) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 GLPHBM_H +#define GLPHBM_H + +typedef struct HBM HBM; + +struct HBM +{ /* sparse matrix in Harwell-Boeing format; for details see the + report: I.S.Duff, R.G.Grimes, J.G.Lewis. User's Guide for the + Harwell-Boeing Sparse Matrix Collection (Release I), 1992 */ + char title[72+1]; + /* matrix title (informative) */ + char key[8+1]; + /* matrix key (informative) */ + char mxtype[3+1]; + /* matrix type: + R.. real matrix + C.. complex matrix + P.. pattern only (no numerical values supplied) + .S. symmetric (lower triangle + main diagonal) + .U. unsymmetric + .H. hermitian (lower triangle + main diagonal) + .Z. skew symmetric (lower triangle only) + .R. rectangular + ..A assembled + ..E elemental (unassembled) */ + char rhstyp[3+1]; + /* optional types: + F.. right-hand sides in dense format + M.. right-hand sides in same format as matrix + .G. starting vector(s) (guess) is supplied + ..X exact solution vector(s) is supplied */ + char ptrfmt[16+1]; + /* format for pointers */ + char indfmt[16+1]; + /* format for row (or variable) indices */ + char valfmt[20+1]; + /* format for numerical values of coefficient matrix */ + char rhsfmt[20+1]; + /* format for numerical values of right-hand sides */ + int totcrd; + /* total number of cards excluding header */ + int ptrcrd; + /* number of cards for ponters */ + int indcrd; + /* number of cards for row (or variable) indices */ + int valcrd; + /* number of cards for numerical values */ + int rhscrd; + /* number of lines for right-hand sides; + including starting guesses and solution vectors if present; + zero indicates no right-hand side data is present */ + int nrow; + /* number of rows (or variables) */ + int ncol; + /* number of columns (or elements) */ + int nnzero; + /* number of row (or variable) indices; + equal to number of entries for assembled matrix */ + int neltvl; + /* number of elemental matrix entries; + zero in case of assembled matrix */ + int nrhs; + /* number of right-hand sides */ + int nrhsix; + /* number of row indices; + ignored in case of unassembled matrix */ + int nrhsvl; + /* total number of entries in all right-hand sides */ + int nguess; + /* total number of entries in all starting guesses */ + int nexact; + /* total number of entries in all solution vectors */ + int *colptr; /* alias: eltptr */ + /* column pointers (in case of assembled matrix); + elemental matrix pointers (in case of unassembled matrix) */ + int *rowind; /* alias: varind */ + /* row indices (in case of assembled matrix); + variable indices (in case of unassembled matrix) */ + int *rhsptr; + /* right-hand side pointers */ + int *rhsind; + /* right-hand side indices */ + double *values; + /* matrix values */ + double *rhsval; + /* right-hand side values */ + double *sguess; + /* starting guess values */ + double *xexact; + /* solution vector values */ +}; + +#define hbm_read_mat _glp_hbm_read_mat +HBM *hbm_read_mat(const char *fname); +/* read sparse matrix in Harwell-Boeing format */ + +#define hbm_free_mat _glp_hbm_free_mat +void hbm_free_mat(HBM *hbm); +/* free sparse matrix in Harwell-Boeing format */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios01.c b/test/monniaux/glpk-4.65/src/draft/glpios01.c new file mode 100644 index 00000000..cb1a0dab --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios01.c @@ -0,0 +1,1685 @@ +/* glpios01.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" +#include "misc.h" + +static int lpx_eval_tab_row(glp_prob *lp, int k, int ind[], + double val[]) +{ /* compute row of the simplex tableau */ + return glp_eval_tab_row(lp, k, ind, val); +} + +static int lpx_dual_ratio_test(glp_prob *lp, int len, const int ind[], + const double val[], int how, double tol) +{ /* perform dual ratio test */ + int piv; + piv = glp_dual_rtest(lp, len, ind, val, how, tol); + xassert(0 <= piv && piv <= len); + return piv == 0 ? 0 : ind[piv]; +} + +/*********************************************************************** +* NAME +* +* ios_create_tree - create branch-and-bound tree +* +* SYNOPSIS +* +* #include "glpios.h" +* glp_tree *ios_create_tree(glp_prob *mip, const glp_iocp *parm); +* +* DESCRIPTION +* +* The routine ios_create_tree creates the branch-and-bound tree. +* +* Being created the tree consists of the only root subproblem whose +* reference number is 1. Note that initially the root subproblem is in +* frozen state and therefore needs to be revived. +* +* RETURNS +* +* The routine returns a pointer to the tree created. */ + +static IOSNPD *new_node(glp_tree *tree, IOSNPD *parent); + +glp_tree *ios_create_tree(glp_prob *mip, const glp_iocp *parm) +{ int m = mip->m; + int n = mip->n; + glp_tree *tree; + int i, j; + xassert(mip->tree == NULL); + mip->tree = tree = xmalloc(sizeof(glp_tree)); + tree->pool = dmp_create_pool(); + tree->n = n; + /* save original problem components */ + tree->orig_m = m; + tree->orig_type = xcalloc(1+m+n, sizeof(char)); + tree->orig_lb = xcalloc(1+m+n, sizeof(double)); + tree->orig_ub = xcalloc(1+m+n, sizeof(double)); + tree->orig_stat = xcalloc(1+m+n, sizeof(char)); + tree->orig_prim = xcalloc(1+m+n, sizeof(double)); + tree->orig_dual = xcalloc(1+m+n, sizeof(double)); + for (i = 1; i <= m; i++) + { GLPROW *row = mip->row[i]; + tree->orig_type[i] = (char)row->type; + tree->orig_lb[i] = row->lb; + tree->orig_ub[i] = row->ub; + tree->orig_stat[i] = (char)row->stat; + tree->orig_prim[i] = row->prim; + tree->orig_dual[i] = row->dual; + } + for (j = 1; j <= n; j++) + { GLPCOL *col = mip->col[j]; + tree->orig_type[m+j] = (char)col->type; + tree->orig_lb[m+j] = col->lb; + tree->orig_ub[m+j] = col->ub; + tree->orig_stat[m+j] = (char)col->stat; + tree->orig_prim[m+j] = col->prim; + tree->orig_dual[m+j] = col->dual; + } + tree->orig_obj = mip->obj_val; + /* initialize the branch-and-bound tree */ + tree->nslots = 0; + tree->avail = 0; + tree->slot = NULL; + tree->head = tree->tail = NULL; + tree->a_cnt = tree->n_cnt = tree->t_cnt = 0; + /* the root subproblem is not solved yet, so its final components + are unknown so far */ + tree->root_m = 0; + tree->root_type = NULL; + tree->root_lb = tree->root_ub = NULL; + tree->root_stat = NULL; + /* the current subproblem does not exist yet */ + tree->curr = NULL; + tree->mip = mip; + /*tree->solved = 0;*/ + tree->non_int = xcalloc(1+n, sizeof(char)); + memset(&tree->non_int[1], 0, n); + /* arrays to save parent subproblem components will be allocated + later */ + tree->pred_m = tree->pred_max = 0; + tree->pred_type = NULL; + tree->pred_lb = tree->pred_ub = NULL; + tree->pred_stat = NULL; + /* cut generators */ + tree->local = ios_create_pool(tree); + /*tree->first_attempt = 1;*/ + /*tree->max_added_cuts = 0;*/ + /*tree->min_eff = 0.0;*/ + /*tree->miss = 0;*/ + /*tree->just_selected = 0;*/ +#ifdef NEW_COVER /* 13/II-2018 */ + tree->cov_gen = NULL; +#endif + tree->mir_gen = NULL; + tree->clq_gen = NULL; + /*tree->round = 0;*/ +#if 0 + /* create the conflict graph */ + tree->n_ref = xcalloc(1+n, sizeof(int)); + memset(&tree->n_ref[1], 0, n * sizeof(int)); + tree->c_ref = xcalloc(1+n, sizeof(int)); + memset(&tree->c_ref[1], 0, n * sizeof(int)); + tree->g = scg_create_graph(0); + tree->j_ref = xcalloc(1+tree->g->n_max, sizeof(int)); +#endif + /* pseudocost branching */ + tree->pcost = NULL; + tree->iwrk = xcalloc(1+n, sizeof(int)); + tree->dwrk = xcalloc(1+n, sizeof(double)); + /* initialize control parameters */ + tree->parm = parm; + tree->tm_beg = xtime(); +#if 0 /* 10/VI-2013 */ + tree->tm_lag = xlset(0); +#else + tree->tm_lag = 0.0; +#endif + tree->sol_cnt = 0; +#if 1 /* 11/VII-2013 */ + tree->P = NULL; + tree->npp = NULL; + tree->save_sol = parm->save_sol; + tree->save_cnt = 0; +#endif + /* initialize advanced solver interface */ + tree->reason = 0; + tree->reopt = 0; + tree->reinv = 0; + tree->br_var = 0; + tree->br_sel = 0; + tree->child = 0; + tree->next_p = 0; + /*tree->btrack = NULL;*/ + tree->stop = 0; + /* create the root subproblem, which initially is identical to + the original MIP */ + new_node(tree, NULL); + return tree; +} + +/*********************************************************************** +* NAME +* +* ios_revive_node - revive specified subproblem +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_revive_node(glp_tree *tree, int p); +* +* DESCRIPTION +* +* The routine ios_revive_node revives the specified subproblem, whose +* reference number is p, and thereby makes it the current subproblem. +* Note that the specified subproblem must be active. Besides, if the +* current subproblem already exists, it must be frozen before reviving +* another subproblem. */ + +void ios_revive_node(glp_tree *tree, int p) +{ glp_prob *mip = tree->mip; + IOSNPD *node, *root; + /* obtain pointer to the specified subproblem */ + xassert(1 <= p && p <= tree->nslots); + node = tree->slot[p].node; + xassert(node != NULL); + /* the specified subproblem must be active */ + xassert(node->count == 0); + /* the current subproblem must not exist */ + xassert(tree->curr == NULL); + /* the specified subproblem becomes current */ + tree->curr = node; + /*tree->solved = 0;*/ + /* obtain pointer to the root subproblem */ + root = tree->slot[1].node; + xassert(root != NULL); + /* at this point problem object components correspond to the root + subproblem, so if the root subproblem should be revived, there + is nothing more to do */ + if (node == root) goto done; + xassert(mip->m == tree->root_m); + /* build path from the root to the current node */ + node->temp = NULL; + for (node = node; node != NULL; node = node->up) + { if (node->up == NULL) + xassert(node == root); + else + node->up->temp = node; + } + /* go down from the root to the current node and make necessary + changes to restore components of the current subproblem */ + for (node = root; node != NULL; node = node->temp) + { int m = mip->m; + int n = mip->n; + /* if the current node is reached, the problem object at this + point corresponds to its parent, so save attributes of rows + and columns for the parent subproblem */ + if (node->temp == NULL) + { int i, j; + tree->pred_m = m; + /* allocate/reallocate arrays, if necessary */ + if (tree->pred_max < m + n) + { int new_size = m + n + 100; + if (tree->pred_type != NULL) xfree(tree->pred_type); + if (tree->pred_lb != NULL) xfree(tree->pred_lb); + if (tree->pred_ub != NULL) xfree(tree->pred_ub); + if (tree->pred_stat != NULL) xfree(tree->pred_stat); + tree->pred_max = new_size; + tree->pred_type = xcalloc(1+new_size, sizeof(char)); + tree->pred_lb = xcalloc(1+new_size, sizeof(double)); + tree->pred_ub = xcalloc(1+new_size, sizeof(double)); + tree->pred_stat = xcalloc(1+new_size, sizeof(char)); + } + /* save row attributes */ + for (i = 1; i <= m; i++) + { GLPROW *row = mip->row[i]; + tree->pred_type[i] = (char)row->type; + tree->pred_lb[i] = row->lb; + tree->pred_ub[i] = row->ub; + tree->pred_stat[i] = (char)row->stat; + } + /* save column attributes */ + for (j = 1; j <= n; j++) + { GLPCOL *col = mip->col[j]; + tree->pred_type[mip->m+j] = (char)col->type; + tree->pred_lb[mip->m+j] = col->lb; + tree->pred_ub[mip->m+j] = col->ub; + tree->pred_stat[mip->m+j] = (char)col->stat; + } + } + /* change bounds of rows and columns */ + { IOSBND *b; + for (b = node->b_ptr; b != NULL; b = b->next) + { if (b->k <= m) + glp_set_row_bnds(mip, b->k, b->type, b->lb, b->ub); + else + glp_set_col_bnds(mip, b->k-m, b->type, b->lb, b->ub); + } + } + /* change statuses of rows and columns */ + { IOSTAT *s; + for (s = node->s_ptr; s != NULL; s = s->next) + { if (s->k <= m) + glp_set_row_stat(mip, s->k, s->stat); + else + glp_set_col_stat(mip, s->k-m, s->stat); + } + } + /* add new rows */ + if (node->r_ptr != NULL) + { IOSROW *r; + IOSAIJ *a; + int i, len, *ind; + double *val; + ind = xcalloc(1+n, sizeof(int)); + val = xcalloc(1+n, sizeof(double)); + for (r = node->r_ptr; r != NULL; r = r->next) + { i = glp_add_rows(mip, 1); + glp_set_row_name(mip, i, r->name); +#if 1 /* 20/IX-2008 */ + xassert(mip->row[i]->level == 0); + mip->row[i]->level = node->level; + mip->row[i]->origin = r->origin; + mip->row[i]->klass = r->klass; +#endif + glp_set_row_bnds(mip, i, r->type, r->lb, r->ub); + len = 0; + for (a = r->ptr; a != NULL; a = a->next) + len++, ind[len] = a->j, val[len] = a->val; + glp_set_mat_row(mip, i, len, ind, val); + glp_set_rii(mip, i, r->rii); + glp_set_row_stat(mip, i, r->stat); + } + xfree(ind); + xfree(val); + } +#if 0 + /* add new edges to the conflict graph */ + /* add new cliques to the conflict graph */ + /* (not implemented yet) */ + xassert(node->own_nn == 0); + xassert(node->own_nc == 0); + xassert(node->e_ptr == NULL); +#endif + } + /* the specified subproblem has been revived */ + node = tree->curr; + /* delete its bound change list */ + while (node->b_ptr != NULL) + { IOSBND *b; + b = node->b_ptr; + node->b_ptr = b->next; + dmp_free_atom(tree->pool, b, sizeof(IOSBND)); + } + /* delete its status change list */ + while (node->s_ptr != NULL) + { IOSTAT *s; + s = node->s_ptr; + node->s_ptr = s->next; + dmp_free_atom(tree->pool, s, sizeof(IOSTAT)); + } +#if 1 /* 20/XI-2009 */ + /* delete its row addition list (additional rows may appear, for + example, due to branching on GUB constraints */ + while (node->r_ptr != NULL) + { IOSROW *r; + r = node->r_ptr; + node->r_ptr = r->next; + xassert(r->name == NULL); + while (r->ptr != NULL) + { IOSAIJ *a; + a = r->ptr; + r->ptr = a->next; + dmp_free_atom(tree->pool, a, sizeof(IOSAIJ)); + } + dmp_free_atom(tree->pool, r, sizeof(IOSROW)); + } +#endif +done: return; +} + +/*********************************************************************** +* NAME +* +* ios_freeze_node - freeze current subproblem +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_freeze_node(glp_tree *tree); +* +* DESCRIPTION +* +* The routine ios_freeze_node freezes the current subproblem. */ + +void ios_freeze_node(glp_tree *tree) +{ glp_prob *mip = tree->mip; + int m = mip->m; + int n = mip->n; + IOSNPD *node; + /* obtain pointer to the current subproblem */ + node = tree->curr; + xassert(node != NULL); + if (node->up == NULL) + { /* freeze the root subproblem */ + int k; + xassert(node->p == 1); + xassert(tree->root_m == 0); + xassert(tree->root_type == NULL); + xassert(tree->root_lb == NULL); + xassert(tree->root_ub == NULL); + xassert(tree->root_stat == NULL); + tree->root_m = m; + tree->root_type = xcalloc(1+m+n, sizeof(char)); + tree->root_lb = xcalloc(1+m+n, sizeof(double)); + tree->root_ub = xcalloc(1+m+n, sizeof(double)); + tree->root_stat = xcalloc(1+m+n, sizeof(char)); + for (k = 1; k <= m+n; k++) + { if (k <= m) + { GLPROW *row = mip->row[k]; + tree->root_type[k] = (char)row->type; + tree->root_lb[k] = row->lb; + tree->root_ub[k] = row->ub; + tree->root_stat[k] = (char)row->stat; + } + else + { GLPCOL *col = mip->col[k-m]; + tree->root_type[k] = (char)col->type; + tree->root_lb[k] = col->lb; + tree->root_ub[k] = col->ub; + tree->root_stat[k] = (char)col->stat; + } + } + } + else + { /* freeze non-root subproblem */ + int root_m = tree->root_m; + int pred_m = tree->pred_m; + int i, j, k; + xassert(pred_m <= m); + /* build change lists for rows and columns which exist in the + parent subproblem */ + xassert(node->b_ptr == NULL); + xassert(node->s_ptr == NULL); + for (k = 1; k <= pred_m + n; k++) + { int pred_type, pred_stat, type, stat; + double pred_lb, pred_ub, lb, ub; + /* determine attributes in the parent subproblem */ + pred_type = tree->pred_type[k]; + pred_lb = tree->pred_lb[k]; + pred_ub = tree->pred_ub[k]; + pred_stat = tree->pred_stat[k]; + /* determine attributes in the current subproblem */ + if (k <= pred_m) + { GLPROW *row = mip->row[k]; + type = row->type; + lb = row->lb; + ub = row->ub; + stat = row->stat; + } + else + { GLPCOL *col = mip->col[k - pred_m]; + type = col->type; + lb = col->lb; + ub = col->ub; + stat = col->stat; + } + /* save type and bounds of a row/column, if changed */ + if (!(pred_type == type && pred_lb == lb && pred_ub == ub)) + { IOSBND *b; + b = dmp_get_atom(tree->pool, sizeof(IOSBND)); + b->k = k; + b->type = (unsigned char)type; + b->lb = lb; + b->ub = ub; + b->next = node->b_ptr; + node->b_ptr = b; + } + /* save status of a row/column, if changed */ + if (pred_stat != stat) + { IOSTAT *s; + s = dmp_get_atom(tree->pool, sizeof(IOSTAT)); + s->k = k; + s->stat = (unsigned char)stat; + s->next = node->s_ptr; + node->s_ptr = s; + } + } + /* save new rows added to the current subproblem */ + xassert(node->r_ptr == NULL); + if (pred_m < m) + { int i, len, *ind; + double *val; + ind = xcalloc(1+n, sizeof(int)); + val = xcalloc(1+n, sizeof(double)); + for (i = m; i > pred_m; i--) + { GLPROW *row = mip->row[i]; + IOSROW *r; + const char *name; + r = dmp_get_atom(tree->pool, sizeof(IOSROW)); + name = glp_get_row_name(mip, i); + if (name == NULL) + r->name = NULL; + else + { r->name = dmp_get_atom(tree->pool, strlen(name)+1); + strcpy(r->name, name); + } +#if 1 /* 20/IX-2008 */ + r->origin = row->origin; + r->klass = row->klass; +#endif + r->type = (unsigned char)row->type; + r->lb = row->lb; + r->ub = row->ub; + r->ptr = NULL; + len = glp_get_mat_row(mip, i, ind, val); + for (k = 1; k <= len; k++) + { IOSAIJ *a; + a = dmp_get_atom(tree->pool, sizeof(IOSAIJ)); + a->j = ind[k]; + a->val = val[k]; + a->next = r->ptr; + r->ptr = a; + } + r->rii = row->rii; + r->stat = (unsigned char)row->stat; + r->next = node->r_ptr; + node->r_ptr = r; + } + xfree(ind); + xfree(val); + } + /* remove all rows missing in the root subproblem */ + if (m != root_m) + { int nrs, *num; + nrs = m - root_m; + xassert(nrs > 0); + num = xcalloc(1+nrs, sizeof(int)); + for (i = 1; i <= nrs; i++) num[i] = root_m + i; + glp_del_rows(mip, nrs, num); + xfree(num); + } + m = mip->m; + /* and restore attributes of all rows and columns for the root + subproblem */ + xassert(m == root_m); + for (i = 1; i <= m; i++) + { glp_set_row_bnds(mip, i, tree->root_type[i], + tree->root_lb[i], tree->root_ub[i]); + glp_set_row_stat(mip, i, tree->root_stat[i]); + } + for (j = 1; j <= n; j++) + { glp_set_col_bnds(mip, j, tree->root_type[m+j], + tree->root_lb[m+j], tree->root_ub[m+j]); + glp_set_col_stat(mip, j, tree->root_stat[m+j]); + } +#if 1 + /* remove all edges and cliques missing in the conflict graph + for the root subproblem */ + /* (not implemented yet) */ +#endif + } + /* the current subproblem has been frozen */ + tree->curr = NULL; + return; +} + +/*********************************************************************** +* NAME +* +* ios_clone_node - clone specified subproblem +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_clone_node(glp_tree *tree, int p, int nnn, int ref[]); +* +* DESCRIPTION +* +* The routine ios_clone_node clones the specified subproblem, whose +* reference number is p, creating its nnn exact copies. Note that the +* specified subproblem must be active and must be in the frozen state +* (i.e. it must not be the current subproblem). +* +* Each clone, an exact copy of the specified subproblem, becomes a new +* active subproblem added to the end of the active list. After cloning +* the specified subproblem becomes inactive. +* +* The reference numbers of clone subproblems are stored to locations +* ref[1], ..., ref[nnn]. */ + +static int get_slot(glp_tree *tree) +{ int p; + /* if no free slots are available, increase the room */ + if (tree->avail == 0) + { int nslots = tree->nslots; + IOSLOT *save = tree->slot; + if (nslots == 0) + tree->nslots = 20; + else + { tree->nslots = nslots + nslots; + xassert(tree->nslots > nslots); + } + tree->slot = xcalloc(1+tree->nslots, sizeof(IOSLOT)); + if (save != NULL) + { memcpy(&tree->slot[1], &save[1], nslots * sizeof(IOSLOT)); + xfree(save); + } + /* push more free slots into the stack */ + for (p = tree->nslots; p > nslots; p--) + { tree->slot[p].node = NULL; + tree->slot[p].next = tree->avail; + tree->avail = p; + } + } + /* pull a free slot from the stack */ + p = tree->avail; + tree->avail = tree->slot[p].next; + xassert(tree->slot[p].node == NULL); + tree->slot[p].next = 0; + return p; +} + +static IOSNPD *new_node(glp_tree *tree, IOSNPD *parent) +{ IOSNPD *node; + int p; + /* pull a free slot for the new node */ + p = get_slot(tree); + /* create descriptor of the new subproblem */ + node = dmp_get_atom(tree->pool, sizeof(IOSNPD)); + tree->slot[p].node = node; + node->p = p; + node->up = parent; + node->level = (parent == NULL ? 0 : parent->level + 1); + node->count = 0; + node->b_ptr = NULL; + node->s_ptr = NULL; + node->r_ptr = NULL; + node->solved = 0; +#if 0 + node->own_nn = node->own_nc = 0; + node->e_ptr = NULL; +#endif +#if 1 /* 04/X-2008 */ + node->lp_obj = (parent == NULL ? (tree->mip->dir == GLP_MIN ? + -DBL_MAX : +DBL_MAX) : parent->lp_obj); +#endif + node->bound = (parent == NULL ? (tree->mip->dir == GLP_MIN ? + -DBL_MAX : +DBL_MAX) : parent->bound); + node->br_var = 0; + node->br_val = 0.0; + node->ii_cnt = 0; + node->ii_sum = 0.0; +#if 1 /* 30/XI-2009 */ + node->changed = 0; +#endif + if (tree->parm->cb_size == 0) + node->data = NULL; + else + { node->data = dmp_get_atom(tree->pool, tree->parm->cb_size); + memset(node->data, 0, tree->parm->cb_size); + } + node->temp = NULL; + node->prev = tree->tail; + node->next = NULL; + /* add the new subproblem to the end of the active list */ + if (tree->head == NULL) + tree->head = node; + else + tree->tail->next = node; + tree->tail = node; + tree->a_cnt++; + tree->n_cnt++; + tree->t_cnt++; + /* increase the number of child subproblems */ + if (parent == NULL) + xassert(p == 1); + else + parent->count++; + return node; +} + +void ios_clone_node(glp_tree *tree, int p, int nnn, int ref[]) +{ IOSNPD *node; + int k; + /* obtain pointer to the subproblem to be cloned */ + xassert(1 <= p && p <= tree->nslots); + node = tree->slot[p].node; + xassert(node != NULL); + /* the specified subproblem must be active */ + xassert(node->count == 0); + /* and must be in the frozen state */ + xassert(tree->curr != node); + /* remove the specified subproblem from the active list, because + it becomes inactive */ + if (node->prev == NULL) + tree->head = node->next; + else + node->prev->next = node->next; + if (node->next == NULL) + tree->tail = node->prev; + else + node->next->prev = node->prev; + node->prev = node->next = NULL; + tree->a_cnt--; + /* create clone subproblems */ + xassert(nnn > 0); + for (k = 1; k <= nnn; k++) + ref[k] = new_node(tree, node)->p; + return; +} + +/*********************************************************************** +* NAME +* +* ios_delete_node - delete specified subproblem +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_delete_node(glp_tree *tree, int p); +* +* DESCRIPTION +* +* The routine ios_delete_node deletes the specified subproblem, whose +* reference number is p. The subproblem must be active and must be in +* the frozen state (i.e. it must not be the current subproblem). +* +* Note that deletion is performed recursively, i.e. if a subproblem to +* be deleted is the only child of its parent, the parent subproblem is +* also deleted, etc. */ + +void ios_delete_node(glp_tree *tree, int p) +{ IOSNPD *node, *temp; + /* obtain pointer to the subproblem to be deleted */ + xassert(1 <= p && p <= tree->nslots); + node = tree->slot[p].node; + xassert(node != NULL); + /* the specified subproblem must be active */ + xassert(node->count == 0); + /* and must be in the frozen state */ + xassert(tree->curr != node); + /* remove the specified subproblem from the active list, because + it is gone from the tree */ + if (node->prev == NULL) + tree->head = node->next; + else + node->prev->next = node->next; + if (node->next == NULL) + tree->tail = node->prev; + else + node->next->prev = node->prev; + node->prev = node->next = NULL; + tree->a_cnt--; +loop: /* recursive deletion starts here */ + /* delete the bound change list */ + { IOSBND *b; + while (node->b_ptr != NULL) + { b = node->b_ptr; + node->b_ptr = b->next; + dmp_free_atom(tree->pool, b, sizeof(IOSBND)); + } + } + /* delete the status change list */ + { IOSTAT *s; + while (node->s_ptr != NULL) + { s = node->s_ptr; + node->s_ptr = s->next; + dmp_free_atom(tree->pool, s, sizeof(IOSTAT)); + } + } + /* delete the row addition list */ + while (node->r_ptr != NULL) + { IOSROW *r; + r = node->r_ptr; + if (r->name != NULL) + dmp_free_atom(tree->pool, r->name, strlen(r->name)+1); + while (r->ptr != NULL) + { IOSAIJ *a; + a = r->ptr; + r->ptr = a->next; + dmp_free_atom(tree->pool, a, sizeof(IOSAIJ)); + } + node->r_ptr = r->next; + dmp_free_atom(tree->pool, r, sizeof(IOSROW)); + } +#if 0 + /* delete the edge addition list */ + /* delete the clique addition list */ + /* (not implemented yet) */ + xassert(node->own_nn == 0); + xassert(node->own_nc == 0); + xassert(node->e_ptr == NULL); +#endif + /* free application-specific data */ + if (tree->parm->cb_size == 0) + xassert(node->data == NULL); + else + dmp_free_atom(tree->pool, node->data, tree->parm->cb_size); + /* free the corresponding node slot */ + p = node->p; + xassert(tree->slot[p].node == node); + tree->slot[p].node = NULL; + tree->slot[p].next = tree->avail; + tree->avail = p; + /* save pointer to the parent subproblem */ + temp = node->up; + /* delete the subproblem descriptor */ + dmp_free_atom(tree->pool, node, sizeof(IOSNPD)); + tree->n_cnt--; + /* take pointer to the parent subproblem */ + node = temp; + if (node != NULL) + { /* the parent subproblem exists; decrease the number of its + child subproblems */ + xassert(node->count > 0); + node->count--; + /* if now the parent subproblem has no childs, it also must be + deleted */ + if (node->count == 0) goto loop; + } + return; +} + +/*********************************************************************** +* NAME +* +* ios_delete_tree - delete branch-and-bound tree +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_delete_tree(glp_tree *tree); +* +* DESCRIPTION +* +* The routine ios_delete_tree deletes the branch-and-bound tree, which +* the parameter tree points to, and frees all the memory allocated to +* this program object. +* +* On exit components of the problem object are restored to correspond +* to the original MIP passed to the routine ios_create_tree. */ + +void ios_delete_tree(glp_tree *tree) +{ glp_prob *mip = tree->mip; + int i, j; + int m = mip->m; + int n = mip->n; + xassert(mip->tree == tree); + /* remove all additional rows */ + if (m != tree->orig_m) + { int nrs, *num; + nrs = m - tree->orig_m; + xassert(nrs > 0); + num = xcalloc(1+nrs, sizeof(int)); + for (i = 1; i <= nrs; i++) num[i] = tree->orig_m + i; + glp_del_rows(mip, nrs, num); + xfree(num); + } + m = tree->orig_m; + /* restore original attributes of rows and columns */ + xassert(m == tree->orig_m); + xassert(n == tree->n); + for (i = 1; i <= m; i++) + { glp_set_row_bnds(mip, i, tree->orig_type[i], + tree->orig_lb[i], tree->orig_ub[i]); + glp_set_row_stat(mip, i, tree->orig_stat[i]); + mip->row[i]->prim = tree->orig_prim[i]; + mip->row[i]->dual = tree->orig_dual[i]; + } + for (j = 1; j <= n; j++) + { glp_set_col_bnds(mip, j, tree->orig_type[m+j], + tree->orig_lb[m+j], tree->orig_ub[m+j]); + glp_set_col_stat(mip, j, tree->orig_stat[m+j]); + mip->col[j]->prim = tree->orig_prim[m+j]; + mip->col[j]->dual = tree->orig_dual[m+j]; + } + mip->pbs_stat = mip->dbs_stat = GLP_FEAS; + mip->obj_val = tree->orig_obj; + /* delete the branch-and-bound tree */ + xassert(tree->local != NULL); + ios_delete_pool(tree, tree->local); + dmp_delete_pool(tree->pool); + xfree(tree->orig_type); + xfree(tree->orig_lb); + xfree(tree->orig_ub); + xfree(tree->orig_stat); + xfree(tree->orig_prim); + xfree(tree->orig_dual); + xfree(tree->slot); + if (tree->root_type != NULL) xfree(tree->root_type); + if (tree->root_lb != NULL) xfree(tree->root_lb); + if (tree->root_ub != NULL) xfree(tree->root_ub); + if (tree->root_stat != NULL) xfree(tree->root_stat); + xfree(tree->non_int); +#if 0 + xfree(tree->n_ref); + xfree(tree->c_ref); + xfree(tree->j_ref); +#endif + if (tree->pcost != NULL) ios_pcost_free(tree); + xfree(tree->iwrk); + xfree(tree->dwrk); +#if 0 + scg_delete_graph(tree->g); +#endif + if (tree->pred_type != NULL) xfree(tree->pred_type); + if (tree->pred_lb != NULL) xfree(tree->pred_lb); + if (tree->pred_ub != NULL) xfree(tree->pred_ub); + if (tree->pred_stat != NULL) xfree(tree->pred_stat); +#if 0 + xassert(tree->cut_gen == NULL); +#endif + xassert(tree->mir_gen == NULL); + xassert(tree->clq_gen == NULL); + xfree(tree); + mip->tree = NULL; + return; +} + +/*********************************************************************** +* NAME +* +* ios_eval_degrad - estimate obj. degrad. for down- and up-branches +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_eval_degrad(glp_tree *tree, int j, double *dn, double *up); +* +* DESCRIPTION +* +* Given optimal basis to LP relaxation of the current subproblem the +* routine ios_eval_degrad performs the dual ratio test to compute the +* objective values in the adjacent basis for down- and up-branches, +* which are stored in locations *dn and *up, assuming that x[j] is a +* variable chosen to branch upon. */ + +void ios_eval_degrad(glp_tree *tree, int j, double *dn, double *up) +{ glp_prob *mip = tree->mip; + int m = mip->m, n = mip->n; + int len, kase, k, t, stat; + double alfa, beta, gamma, delta, dz; + int *ind = tree->iwrk; + double *val = tree->dwrk; + /* current basis must be optimal */ + xassert(glp_get_status(mip) == GLP_OPT); + /* basis factorization must exist */ + xassert(glp_bf_exists(mip)); + /* obtain (fractional) value of x[j] in optimal basic solution + to LP relaxation of the current subproblem */ + xassert(1 <= j && j <= n); + beta = mip->col[j]->prim; + /* since the value of x[j] is fractional, it is basic; compute + corresponding row of the simplex table */ + len = lpx_eval_tab_row(mip, m+j, ind, val); + /* kase < 0 means down-branch; kase > 0 means up-branch */ + for (kase = -1; kase <= +1; kase += 2) + { /* for down-branch we introduce new upper bound floor(beta) + for x[j]; similarly, for up-branch we introduce new lower + bound ceil(beta) for x[j]; in the current basis this new + upper/lower bound is violated, so in the adjacent basis + x[j] will leave the basis and go to its new upper/lower + bound; we need to know which non-basic variable x[k] should + enter the basis to keep dual feasibility */ +#if 0 /* 23/XI-2009 */ + k = lpx_dual_ratio_test(mip, len, ind, val, kase, 1e-7); +#else + k = lpx_dual_ratio_test(mip, len, ind, val, kase, 1e-9); +#endif + /* if no variable has been chosen, current basis being primal + infeasible due to the new upper/lower bound of x[j] is dual + unbounded, therefore, LP relaxation to corresponding branch + has no primal feasible solution */ + if (k == 0) + { if (mip->dir == GLP_MIN) + { if (kase < 0) + *dn = +DBL_MAX; + else + *up = +DBL_MAX; + } + else if (mip->dir == GLP_MAX) + { if (kase < 0) + *dn = -DBL_MAX; + else + *up = -DBL_MAX; + } + else + xassert(mip != mip); + continue; + } + xassert(1 <= k && k <= m+n); + /* row of the simplex table corresponding to specified basic + variable x[j] is the following: + x[j] = ... + alfa * x[k] + ... ; + we need to know influence coefficient, alfa, at non-basic + variable x[k] chosen with the dual ratio test */ + for (t = 1; t <= len; t++) + if (ind[t] == k) break; + xassert(1 <= t && t <= len); + alfa = val[t]; + /* determine status and reduced cost of variable x[k] */ + if (k <= m) + { stat = mip->row[k]->stat; + gamma = mip->row[k]->dual; + } + else + { stat = mip->col[k-m]->stat; + gamma = mip->col[k-m]->dual; + } + /* x[k] cannot be basic or fixed non-basic */ + xassert(stat == GLP_NL || stat == GLP_NU || stat == GLP_NF); + /* if the current basis is dual degenerative, some reduced + costs, which are close to zero, may have wrong sign due to + round-off errors, so correct the sign of gamma */ + if (mip->dir == GLP_MIN) + { if (stat == GLP_NL && gamma < 0.0 || + stat == GLP_NU && gamma > 0.0 || + stat == GLP_NF) gamma = 0.0; + } + else if (mip->dir == GLP_MAX) + { if (stat == GLP_NL && gamma > 0.0 || + stat == GLP_NU && gamma < 0.0 || + stat == GLP_NF) gamma = 0.0; + } + else + xassert(mip != mip); + /* determine the change of x[j] in the adjacent basis: + delta x[j] = new x[j] - old x[j] */ + delta = (kase < 0 ? floor(beta) : ceil(beta)) - beta; + /* compute the change of x[k] in the adjacent basis: + delta x[k] = new x[k] - old x[k] = delta x[j] / alfa */ + delta /= alfa; + /* compute the change of the objective in the adjacent basis: + delta z = new z - old z = gamma * delta x[k] */ + dz = gamma * delta; + if (mip->dir == GLP_MIN) + xassert(dz >= 0.0); + else if (mip->dir == GLP_MAX) + xassert(dz <= 0.0); + else + xassert(mip != mip); + /* compute the new objective value in the adjacent basis: + new z = old z + delta z */ + if (kase < 0) + *dn = mip->obj_val + dz; + else + *up = mip->obj_val + dz; + } + /*xprintf("obj = %g; dn = %g; up = %g\n", + mip->obj_val, *dn, *up);*/ + return; +} + +/*********************************************************************** +* NAME +* +* ios_round_bound - improve local bound by rounding +* +* SYNOPSIS +* +* #include "glpios.h" +* double ios_round_bound(glp_tree *tree, double bound); +* +* RETURNS +* +* For the given local bound for any integer feasible solution to the +* current subproblem the routine ios_round_bound returns an improved +* local bound for the same integer feasible solution. +* +* BACKGROUND +* +* Let the current subproblem has the following objective function: +* +* z = sum c[j] * x[j] + s >= b, (1) +* j in J +* +* where J = {j: c[j] is non-zero and integer, x[j] is integer}, s is +* the sum of terms corresponding to fixed variables, b is an initial +* local bound (minimization). +* +* From (1) it follows that: +* +* d * sum (c[j] / d) * x[j] + s >= b, (2) +* j in J +* +* or, equivalently, +* +* sum (c[j] / d) * x[j] >= (b - s) / d = h, (3) +* j in J +* +* where d = gcd(c[j]). Since the left-hand side of (3) is integer, +* h = (b - s) / d can be rounded up to the nearest integer: +* +* h' = ceil(h) = (b' - s) / d, (4) +* +* that gives an rounded, improved local bound: +* +* b' = d * h' + s. (5) +* +* In case of maximization '>=' in (1) should be replaced by '<=' that +* leads to the following formula: +* +* h' = floor(h) = (b' - s) / d, (6) +* +* which should used in the same way as (4). +* +* NOTE: If b is a valid local bound for a child of the current +* subproblem, b' is also valid for that child subproblem. */ + +double ios_round_bound(glp_tree *tree, double bound) +{ glp_prob *mip = tree->mip; + int n = mip->n; + int d, j, nn, *c = tree->iwrk; + double s, h; + /* determine c[j] and compute s */ + nn = 0, s = mip->c0, d = 0; + for (j = 1; j <= n; j++) + { GLPCOL *col = mip->col[j]; + if (col->coef == 0.0) continue; + if (col->type == GLP_FX) + { /* fixed variable */ + s += col->coef * col->prim; + } + else + { /* non-fixed variable */ + if (col->kind != GLP_IV) goto skip; + if (col->coef != floor(col->coef)) goto skip; + if (fabs(col->coef) <= (double)INT_MAX) + c[++nn] = (int)fabs(col->coef); + else + d = 1; + } + } + /* compute d = gcd(c[1],...c[nn]) */ + if (d == 0) + { if (nn == 0) goto skip; + d = gcdn(nn, c); + } + xassert(d > 0); + /* compute new local bound */ + if (mip->dir == GLP_MIN) + { if (bound != +DBL_MAX) + { h = (bound - s) / (double)d; + if (h >= floor(h) + 0.001) + { /* round up */ + h = ceil(h); + /*xprintf("d = %d; old = %g; ", d, bound);*/ + bound = (double)d * h + s; + /*xprintf("new = %g\n", bound);*/ + } + } + } + else if (mip->dir == GLP_MAX) + { if (bound != -DBL_MAX) + { h = (bound - s) / (double)d; + if (h <= ceil(h) - 0.001) + { /* round down */ + h = floor(h); + bound = (double)d * h + s; + } + } + } + else + xassert(mip != mip); +skip: return bound; +} + +/*********************************************************************** +* NAME +* +* ios_is_hopeful - check if subproblem is hopeful +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_is_hopeful(glp_tree *tree, double bound); +* +* DESCRIPTION +* +* Given the local bound of a subproblem the routine ios_is_hopeful +* checks if the subproblem can have an integer optimal solution which +* is better than the best one currently known. +* +* RETURNS +* +* If the subproblem can have a better integer optimal solution, the +* routine returns non-zero; otherwise, if the corresponding branch can +* be pruned, the routine returns zero. */ + +int ios_is_hopeful(glp_tree *tree, double bound) +{ glp_prob *mip = tree->mip; + int ret = 1; + double eps; + if (mip->mip_stat == GLP_FEAS) + { eps = tree->parm->tol_obj * (1.0 + fabs(mip->mip_obj)); + switch (mip->dir) + { case GLP_MIN: + if (bound >= mip->mip_obj - eps) ret = 0; + break; + case GLP_MAX: + if (bound <= mip->mip_obj + eps) ret = 0; + break; + default: + xassert(mip != mip); + } + } + else + { switch (mip->dir) + { case GLP_MIN: + if (bound == +DBL_MAX) ret = 0; + break; + case GLP_MAX: + if (bound == -DBL_MAX) ret = 0; + break; + default: + xassert(mip != mip); + } + } + return ret; +} + +/*********************************************************************** +* NAME +* +* ios_best_node - find active node with best local bound +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_best_node(glp_tree *tree); +* +* DESCRIPTION +* +* The routine ios_best_node finds an active node whose local bound is +* best among other active nodes. +* +* It is understood that the integer optimal solution of the original +* mip problem cannot be better than the best bound, so the best bound +* is an lower (minimization) or upper (maximization) global bound for +* the original problem. +* +* RETURNS +* +* The routine ios_best_node returns the subproblem reference number +* for the best node. However, if the tree is empty, it returns zero. */ + +int ios_best_node(glp_tree *tree) +{ IOSNPD *node, *best = NULL; + switch (tree->mip->dir) + { case GLP_MIN: + /* minimization */ + for (node = tree->head; node != NULL; node = node->next) + if (best == NULL || best->bound > node->bound) + best = node; + break; + case GLP_MAX: + /* maximization */ + for (node = tree->head; node != NULL; node = node->next) + if (best == NULL || best->bound < node->bound) + best = node; + break; + default: + xassert(tree != tree); + } + return best == NULL ? 0 : best->p; +} + +/*********************************************************************** +* NAME +* +* ios_relative_gap - compute relative mip gap +* +* SYNOPSIS +* +* #include "glpios.h" +* double ios_relative_gap(glp_tree *tree); +* +* DESCRIPTION +* +* The routine ios_relative_gap computes the relative mip gap using the +* formula: +* +* gap = |best_mip - best_bnd| / (|best_mip| + DBL_EPSILON), +* +* where best_mip is the best integer feasible solution found so far, +* best_bnd is the best (global) bound. If no integer feasible solution +* has been found yet, rel_gap is set to DBL_MAX. +* +* RETURNS +* +* The routine ios_relative_gap returns the relative mip gap. */ + +double ios_relative_gap(glp_tree *tree) +{ glp_prob *mip = tree->mip; + int p; + double best_mip, best_bnd, gap; + if (mip->mip_stat == GLP_FEAS) + { best_mip = mip->mip_obj; + p = ios_best_node(tree); + if (p == 0) + { /* the tree is empty */ + gap = 0.0; + } + else + { best_bnd = tree->slot[p].node->bound; + gap = fabs(best_mip - best_bnd) / (fabs(best_mip) + + DBL_EPSILON); + } + } + else + { /* no integer feasible solution has been found yet */ + gap = DBL_MAX; + } + return gap; +} + +/*********************************************************************** +* NAME +* +* ios_solve_node - solve LP relaxation of current subproblem +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_solve_node(glp_tree *tree); +* +* DESCRIPTION +* +* The routine ios_solve_node re-optimizes LP relaxation of the current +* subproblem using the dual simplex method. +* +* RETURNS +* +* The routine returns the code which is reported by glp_simplex. */ + +int ios_solve_node(glp_tree *tree) +{ glp_prob *mip = tree->mip; + glp_smcp parm; + int ret; + /* the current subproblem must exist */ + xassert(tree->curr != NULL); + /* set some control parameters */ + glp_init_smcp(&parm); + switch (tree->parm->msg_lev) + { case GLP_MSG_OFF: + parm.msg_lev = GLP_MSG_OFF; break; + case GLP_MSG_ERR: + parm.msg_lev = GLP_MSG_ERR; break; + case GLP_MSG_ON: + case GLP_MSG_ALL: + parm.msg_lev = GLP_MSG_ON; break; + case GLP_MSG_DBG: + parm.msg_lev = GLP_MSG_ALL; break; + default: + xassert(tree != tree); + } + parm.meth = GLP_DUALP; +#if 1 /* 16/III-2016 */ + if (tree->parm->flip) + parm.r_test = GLP_RT_FLIP; +#endif + /* respect time limit */ + if (tree->parm->tm_lim < INT_MAX) + parm.tm_lim = tree->parm->tm_lim - (glp_time() - tree->tm_beg); + if (parm.tm_lim < 0) + parm.tm_lim = 0; + if (tree->parm->msg_lev < GLP_MSG_DBG) + parm.out_dly = tree->parm->out_dly; + else + parm.out_dly = 0; + /* if the incumbent objective value is already known, use it to + prematurely terminate the dual simplex search */ + if (mip->mip_stat == GLP_FEAS) + { switch (tree->mip->dir) + { case GLP_MIN: + parm.obj_ul = mip->mip_obj; + break; + case GLP_MAX: + parm.obj_ll = mip->mip_obj; + break; + default: + xassert(mip != mip); + } + } + /* try to solve/re-optimize the LP relaxation */ + ret = glp_simplex(mip, &parm); +#if 1 /* 21/II-2016 by Chris */ + if (ret == GLP_EFAIL) + { /* retry with a new basis */ + glp_adv_basis(mip, 0); + ret = glp_simplex(mip, &parm); + } +#endif + tree->curr->solved++; +#if 0 + xprintf("ret = %d; status = %d; pbs = %d; dbs = %d; some = %d\n", + ret, glp_get_status(mip), mip->pbs_stat, mip->dbs_stat, + mip->some); + lpx_print_sol(mip, "sol"); +#endif + return ret; +} + +/**********************************************************************/ + +#ifdef NEW_LOCAL /* 02/II-2018 */ +IOSPOOL *ios_create_pool(glp_tree *tree) +{ /* create cut pool */ + IOSPOOL *pool; + pool = glp_create_prob(); + glp_add_cols(pool, tree->mip->n); + return pool; +} +#else +IOSPOOL *ios_create_pool(glp_tree *tree) +{ /* create cut pool */ + IOSPOOL *pool; +#if 0 + pool = dmp_get_atom(tree->pool, sizeof(IOSPOOL)); +#else + xassert(tree == tree); + pool = xmalloc(sizeof(IOSPOOL)); +#endif + pool->size = 0; + pool->head = pool->tail = NULL; + pool->ord = 0, pool->curr = NULL; + return pool; +} +#endif + +#ifdef NEW_LOCAL /* 02/II-2018 */ +int ios_add_row(glp_tree *tree, IOSPOOL *pool, + const char *name, int klass, int flags, int len, const int ind[], + const double val[], int type, double rhs) +{ /* add row (constraint) to the cut pool */ + int i; + i = glp_add_rows(pool, 1); + glp_set_row_name(pool, i, name); + pool->row[i]->klass = klass; + xassert(flags == 0); + glp_set_mat_row(pool, i, len, ind, val); + glp_set_row_bnds(pool, i, type, rhs, rhs); + return i; +} +#else +int ios_add_row(glp_tree *tree, IOSPOOL *pool, + const char *name, int klass, int flags, int len, const int ind[], + const double val[], int type, double rhs) +{ /* add row (constraint) to the cut pool */ + IOSCUT *cut; + IOSAIJ *aij; + int k; + xassert(pool != NULL); + cut = dmp_get_atom(tree->pool, sizeof(IOSCUT)); + if (name == NULL || name[0] == '\0') + cut->name = NULL; + else + { for (k = 0; name[k] != '\0'; k++) + { if (k == 256) + xerror("glp_ios_add_row: cut name too long\n"); + if (iscntrl((unsigned char)name[k])) + xerror("glp_ios_add_row: cut name contains invalid chara" + "cter(s)\n"); + } + cut->name = dmp_get_atom(tree->pool, strlen(name)+1); + strcpy(cut->name, name); + } + if (!(0 <= klass && klass <= 255)) + xerror("glp_ios_add_row: klass = %d; invalid cut class\n", + klass); + cut->klass = (unsigned char)klass; + if (flags != 0) + xerror("glp_ios_add_row: flags = %d; invalid cut flags\n", + flags); + cut->ptr = NULL; + if (!(0 <= len && len <= tree->n)) + xerror("glp_ios_add_row: len = %d; invalid cut length\n", + len); + for (k = 1; k <= len; k++) + { aij = dmp_get_atom(tree->pool, sizeof(IOSAIJ)); + if (!(1 <= ind[k] && ind[k] <= tree->n)) + xerror("glp_ios_add_row: ind[%d] = %d; column index out of " + "range\n", k, ind[k]); + aij->j = ind[k]; + aij->val = val[k]; + aij->next = cut->ptr; + cut->ptr = aij; + } + if (!(type == GLP_LO || type == GLP_UP || type == GLP_FX)) + xerror("glp_ios_add_row: type = %d; invalid cut type\n", + type); + cut->type = (unsigned char)type; + cut->rhs = rhs; + cut->prev = pool->tail; + cut->next = NULL; + if (cut->prev == NULL) + pool->head = cut; + else + cut->prev->next = cut; + pool->tail = cut; + pool->size++; + return pool->size; +} +#endif + +#ifdef NEW_LOCAL /* 02/II-2018 */ +IOSCUT *ios_find_row(IOSPOOL *pool, int i) +{ /* find row (constraint) in the cut pool */ + xassert(0); +} +#else +IOSCUT *ios_find_row(IOSPOOL *pool, int i) +{ /* find row (constraint) in the cut pool */ + /* (smart linear search) */ + xassert(pool != NULL); + xassert(1 <= i && i <= pool->size); + if (pool->ord == 0) + { xassert(pool->curr == NULL); + pool->ord = 1; + pool->curr = pool->head; + } + xassert(pool->curr != NULL); + if (i < pool->ord) + { if (i < pool->ord - i) + { pool->ord = 1; + pool->curr = pool->head; + while (pool->ord != i) + { pool->ord++; + xassert(pool->curr != NULL); + pool->curr = pool->curr->next; + } + } + else + { while (pool->ord != i) + { pool->ord--; + xassert(pool->curr != NULL); + pool->curr = pool->curr->prev; + } + } + } + else if (i > pool->ord) + { if (i - pool->ord < pool->size - i) + { while (pool->ord != i) + { pool->ord++; + xassert(pool->curr != NULL); + pool->curr = pool->curr->next; + } + } + else + { pool->ord = pool->size; + pool->curr = pool->tail; + while (pool->ord != i) + { pool->ord--; + xassert(pool->curr != NULL); + pool->curr = pool->curr->prev; + } + } + } + xassert(pool->ord == i); + xassert(pool->curr != NULL); + return pool->curr; +} +#endif + +#ifdef NEW_LOCAL /* 02/II-2018 */ +void ios_del_row(glp_tree *tree, IOSPOOL *pool, int i) +{ /* remove row (constraint) from the cut pool */ + xassert(0); +} +#else +void ios_del_row(glp_tree *tree, IOSPOOL *pool, int i) +{ /* remove row (constraint) from the cut pool */ + IOSCUT *cut; + IOSAIJ *aij; + xassert(pool != NULL); + if (!(1 <= i && i <= pool->size)) + xerror("glp_ios_del_row: i = %d; cut number out of range\n", + i); + cut = ios_find_row(pool, i); + xassert(pool->curr == cut); + if (cut->next != NULL) + pool->curr = cut->next; + else if (cut->prev != NULL) + pool->ord--, pool->curr = cut->prev; + else + pool->ord = 0, pool->curr = NULL; + if (cut->name != NULL) + dmp_free_atom(tree->pool, cut->name, strlen(cut->name)+1); + if (cut->prev == NULL) + { xassert(pool->head == cut); + pool->head = cut->next; + } + else + { xassert(cut->prev->next == cut); + cut->prev->next = cut->next; + } + if (cut->next == NULL) + { xassert(pool->tail == cut); + pool->tail = cut->prev; + } + else + { xassert(cut->next->prev == cut); + cut->next->prev = cut->prev; + } + while (cut->ptr != NULL) + { aij = cut->ptr; + cut->ptr = aij->next; + dmp_free_atom(tree->pool, aij, sizeof(IOSAIJ)); + } + dmp_free_atom(tree->pool, cut, sizeof(IOSCUT)); + pool->size--; + return; +} +#endif + +#ifdef NEW_LOCAL /* 02/II-2018 */ +void ios_clear_pool(glp_tree *tree, IOSPOOL *pool) +{ /* remove all rows (constraints) from the cut pool */ + if (pool->m > 0) + { int i, *num; + num = talloc(1+pool->m, int); + for (i = 1; i <= pool->m; i++) + num[i] = i; + glp_del_rows(pool, pool->m, num); + tfree(num); + } + return; +} +#else +void ios_clear_pool(glp_tree *tree, IOSPOOL *pool) +{ /* remove all rows (constraints) from the cut pool */ + xassert(pool != NULL); + while (pool->head != NULL) + { IOSCUT *cut = pool->head; + pool->head = cut->next; + if (cut->name != NULL) + dmp_free_atom(tree->pool, cut->name, strlen(cut->name)+1); + while (cut->ptr != NULL) + { IOSAIJ *aij = cut->ptr; + cut->ptr = aij->next; + dmp_free_atom(tree->pool, aij, sizeof(IOSAIJ)); + } + dmp_free_atom(tree->pool, cut, sizeof(IOSCUT)); + } + pool->size = 0; + pool->head = pool->tail = NULL; + pool->ord = 0, pool->curr = NULL; + return; +} +#endif + +#ifdef NEW_LOCAL /* 02/II-2018 */ +void ios_delete_pool(glp_tree *tree, IOSPOOL *pool) +{ /* delete cut pool */ + xassert(pool != NULL); + glp_delete_prob(pool); + return; +} +#else +void ios_delete_pool(glp_tree *tree, IOSPOOL *pool) +{ /* delete cut pool */ + xassert(pool != NULL); + ios_clear_pool(tree, pool); + xfree(pool); + return; +} +#endif + +#if 1 /* 11/VII-2013 */ +#include "npp.h" + +void ios_process_sol(glp_tree *T) +{ /* process integer feasible solution just found */ + if (T->npp != NULL) + { /* postprocess solution from transformed mip */ + npp_postprocess(T->npp, T->mip); + /* store solution to problem passed to glp_intopt */ + npp_unload_sol(T->npp, T->P); + } + xassert(T->P != NULL); + /* save solution to text file, if requested */ + if (T->save_sol != NULL) + { char *fn, *mark; + fn = talloc(strlen(T->save_sol) + 50, char); + mark = strrchr(T->save_sol, '*'); + if (mark == NULL) + strcpy(fn, T->save_sol); + else + { memcpy(fn, T->save_sol, mark - T->save_sol); + fn[mark - T->save_sol] = '\0'; + sprintf(fn + strlen(fn), "%03d", ++(T->save_cnt)); + strcat(fn, &mark[1]); + } + glp_write_mip(T->P, fn); + tfree(fn); + } + return; +} +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios02.c b/test/monniaux/glpk-4.65/src/draft/glpios02.c new file mode 100644 index 00000000..a73458aa --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios02.c @@ -0,0 +1,826 @@ +/* glpios02.c (preprocess current subproblem) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" + +/*********************************************************************** +* prepare_row_info - prepare row info to determine implied bounds +* +* Given a row (linear form) +* +* n +* sum a[j] * x[j] (1) +* j=1 +* +* and bounds of columns (variables) +* +* l[j] <= x[j] <= u[j] (2) +* +* this routine computes f_min, j_min, f_max, j_max needed to determine +* implied bounds. +* +* ALGORITHM +* +* Let J+ = {j : a[j] > 0} and J- = {j : a[j] < 0}. +* +* Parameters f_min and j_min are computed as follows: +* +* 1) if there is no x[k] such that k in J+ and l[k] = -inf or k in J- +* and u[k] = +inf, then +* +* f_min := sum a[j] * l[j] + sum a[j] * u[j] +* j in J+ j in J- +* (3) +* j_min := 0 +* +* 2) if there is exactly one x[k] such that k in J+ and l[k] = -inf +* or k in J- and u[k] = +inf, then +* +* f_min := sum a[j] * l[j] + sum a[j] * u[j] +* j in J+\{k} j in J-\{k} +* (4) +* j_min := k +* +* 3) if there are two or more x[k] such that k in J+ and l[k] = -inf +* or k in J- and u[k] = +inf, then +* +* f_min := -inf +* (5) +* j_min := 0 +* +* Parameters f_max and j_max are computed in a similar way as follows: +* +* 1) if there is no x[k] such that k in J+ and u[k] = +inf or k in J- +* and l[k] = -inf, then +* +* f_max := sum a[j] * u[j] + sum a[j] * l[j] +* j in J+ j in J- +* (6) +* j_max := 0 +* +* 2) if there is exactly one x[k] such that k in J+ and u[k] = +inf +* or k in J- and l[k] = -inf, then +* +* f_max := sum a[j] * u[j] + sum a[j] * l[j] +* j in J+\{k} j in J-\{k} +* (7) +* j_max := k +* +* 3) if there are two or more x[k] such that k in J+ and u[k] = +inf +* or k in J- and l[k] = -inf, then +* +* f_max := +inf +* (8) +* j_max := 0 */ + +struct f_info +{ int j_min, j_max; + double f_min, f_max; +}; + +static void prepare_row_info(int n, const double a[], const double l[], + const double u[], struct f_info *f) +{ int j, j_min, j_max; + double f_min, f_max; + xassert(n >= 0); + /* determine f_min and j_min */ + f_min = 0.0, j_min = 0; + for (j = 1; j <= n; j++) + { if (a[j] > 0.0) + { if (l[j] == -DBL_MAX) + { if (j_min == 0) + j_min = j; + else + { f_min = -DBL_MAX, j_min = 0; + break; + } + } + else + f_min += a[j] * l[j]; + } + else if (a[j] < 0.0) + { if (u[j] == +DBL_MAX) + { if (j_min == 0) + j_min = j; + else + { f_min = -DBL_MAX, j_min = 0; + break; + } + } + else + f_min += a[j] * u[j]; + } + else + xassert(a != a); + } + f->f_min = f_min, f->j_min = j_min; + /* determine f_max and j_max */ + f_max = 0.0, j_max = 0; + for (j = 1; j <= n; j++) + { if (a[j] > 0.0) + { if (u[j] == +DBL_MAX) + { if (j_max == 0) + j_max = j; + else + { f_max = +DBL_MAX, j_max = 0; + break; + } + } + else + f_max += a[j] * u[j]; + } + else if (a[j] < 0.0) + { if (l[j] == -DBL_MAX) + { if (j_max == 0) + j_max = j; + else + { f_max = +DBL_MAX, j_max = 0; + break; + } + } + else + f_max += a[j] * l[j]; + } + else + xassert(a != a); + } + f->f_max = f_max, f->j_max = j_max; + return; +} + +/*********************************************************************** +* row_implied_bounds - determine row implied bounds +* +* Given a row (linear form) +* +* n +* sum a[j] * x[j] +* j=1 +* +* and bounds of columns (variables) +* +* l[j] <= x[j] <= u[j] +* +* this routine determines implied bounds of the row. +* +* ALGORITHM +* +* Let J+ = {j : a[j] > 0} and J- = {j : a[j] < 0}. +* +* The implied lower bound of the row is computed as follows: +* +* L' := sum a[j] * l[j] + sum a[j] * u[j] (9) +* j in J+ j in J- +* +* and as it follows from (3), (4), and (5): +* +* L' := if j_min = 0 then f_min else -inf (10) +* +* The implied upper bound of the row is computed as follows: +* +* U' := sum a[j] * u[j] + sum a[j] * l[j] (11) +* j in J+ j in J- +* +* and as it follows from (6), (7), and (8): +* +* U' := if j_max = 0 then f_max else +inf (12) +* +* The implied bounds are stored in locations LL and UU. */ + +static void row_implied_bounds(const struct f_info *f, double *LL, + double *UU) +{ *LL = (f->j_min == 0 ? f->f_min : -DBL_MAX); + *UU = (f->j_max == 0 ? f->f_max : +DBL_MAX); + return; +} + +/*********************************************************************** +* col_implied_bounds - determine column implied bounds +* +* Given a row (constraint) +* +* n +* L <= sum a[j] * x[j] <= U (13) +* j=1 +* +* and bounds of columns (variables) +* +* l[j] <= x[j] <= u[j] +* +* this routine determines implied bounds of variable x[k]. +* +* It is assumed that if L != -inf, the lower bound of the row can be +* active, and if U != +inf, the upper bound of the row can be active. +* +* ALGORITHM +* +* From (13) it follows that +* +* L <= sum a[j] * x[j] + a[k] * x[k] <= U +* j!=k +* or +* +* L - sum a[j] * x[j] <= a[k] * x[k] <= U - sum a[j] * x[j] +* j!=k j!=k +* +* Thus, if the row lower bound L can be active, implied lower bound of +* term a[k] * x[k] can be determined as follows: +* +* ilb(a[k] * x[k]) = min(L - sum a[j] * x[j]) = +* j!=k +* (14) +* = L - max sum a[j] * x[j] +* j!=k +* +* where, as it follows from (6), (7), and (8) +* +* / f_max - a[k] * u[k], j_max = 0, a[k] > 0 +* | +* | f_max - a[k] * l[k], j_max = 0, a[k] < 0 +* max sum a[j] * x[j] = { +* j!=k | f_max, j_max = k +* | +* \ +inf, j_max != 0 +* +* and if the upper bound U can be active, implied upper bound of term +* a[k] * x[k] can be determined as follows: +* +* iub(a[k] * x[k]) = max(U - sum a[j] * x[j]) = +* j!=k +* (15) +* = U - min sum a[j] * x[j] +* j!=k +* +* where, as it follows from (3), (4), and (5) +* +* / f_min - a[k] * l[k], j_min = 0, a[k] > 0 +* | +* | f_min - a[k] * u[k], j_min = 0, a[k] < 0 +* min sum a[j] * x[j] = { +* j!=k | f_min, j_min = k +* | +* \ -inf, j_min != 0 +* +* Since +* +* ilb(a[k] * x[k]) <= a[k] * x[k] <= iub(a[k] * x[k]) +* +* implied lower and upper bounds of x[k] are determined as follows: +* +* l'[k] := if a[k] > 0 then ilb / a[k] else ulb / a[k] (16) +* +* u'[k] := if a[k] > 0 then ulb / a[k] else ilb / a[k] (17) +* +* The implied bounds are stored in locations ll and uu. */ + +static void col_implied_bounds(const struct f_info *f, int n, + const double a[], double L, double U, const double l[], + const double u[], int k, double *ll, double *uu) +{ double ilb, iub; + xassert(n >= 0); + xassert(1 <= k && k <= n); + /* determine implied lower bound of term a[k] * x[k] (14) */ + if (L == -DBL_MAX || f->f_max == +DBL_MAX) + ilb = -DBL_MAX; + else if (f->j_max == 0) + { if (a[k] > 0.0) + { xassert(u[k] != +DBL_MAX); + ilb = L - (f->f_max - a[k] * u[k]); + } + else if (a[k] < 0.0) + { xassert(l[k] != -DBL_MAX); + ilb = L - (f->f_max - a[k] * l[k]); + } + else + xassert(a != a); + } + else if (f->j_max == k) + ilb = L - f->f_max; + else + ilb = -DBL_MAX; + /* determine implied upper bound of term a[k] * x[k] (15) */ + if (U == +DBL_MAX || f->f_min == -DBL_MAX) + iub = +DBL_MAX; + else if (f->j_min == 0) + { if (a[k] > 0.0) + { xassert(l[k] != -DBL_MAX); + iub = U - (f->f_min - a[k] * l[k]); + } + else if (a[k] < 0.0) + { xassert(u[k] != +DBL_MAX); + iub = U - (f->f_min - a[k] * u[k]); + } + else + xassert(a != a); + } + else if (f->j_min == k) + iub = U - f->f_min; + else + iub = +DBL_MAX; + /* determine implied bounds of x[k] (16) and (17) */ +#if 1 + /* do not use a[k] if it has small magnitude to prevent wrong + implied bounds; for example, 1e-15 * x1 >= x2 + x3, where + x1 >= -10, x2, x3 >= 0, would lead to wrong conclusion that + x1 >= 0 */ + if (fabs(a[k]) < 1e-6) + *ll = -DBL_MAX, *uu = +DBL_MAX; else +#endif + if (a[k] > 0.0) + { *ll = (ilb == -DBL_MAX ? -DBL_MAX : ilb / a[k]); + *uu = (iub == +DBL_MAX ? +DBL_MAX : iub / a[k]); + } + else if (a[k] < 0.0) + { *ll = (iub == +DBL_MAX ? -DBL_MAX : iub / a[k]); + *uu = (ilb == -DBL_MAX ? +DBL_MAX : ilb / a[k]); + } + else + xassert(a != a); + return; +} + +/*********************************************************************** +* check_row_bounds - check and relax original row bounds +* +* Given a row (constraint) +* +* n +* L <= sum a[j] * x[j] <= U +* j=1 +* +* and bounds of columns (variables) +* +* l[j] <= x[j] <= u[j] +* +* this routine checks the original row bounds L and U for feasibility +* and redundancy. If the original lower bound L or/and upper bound U +* cannot be active due to bounds of variables, the routine remove them +* replacing by -inf or/and +inf, respectively. +* +* If no primal infeasibility is detected, the routine returns zero, +* otherwise non-zero. */ + +static int check_row_bounds(const struct f_info *f, double *L_, + double *U_) +{ int ret = 0; + double L = *L_, U = *U_, LL, UU; + /* determine implied bounds of the row */ + row_implied_bounds(f, &LL, &UU); + /* check if the original lower bound is infeasible */ + if (L != -DBL_MAX) + { double eps = 1e-3 * (1.0 + fabs(L)); + if (UU < L - eps) + { ret = 1; + goto done; + } + } + /* check if the original upper bound is infeasible */ + if (U != +DBL_MAX) + { double eps = 1e-3 * (1.0 + fabs(U)); + if (LL > U + eps) + { ret = 1; + goto done; + } + } + /* check if the original lower bound is redundant */ + if (L != -DBL_MAX) + { double eps = 1e-12 * (1.0 + fabs(L)); + if (LL > L - eps) + { /* it cannot be active, so remove it */ + *L_ = -DBL_MAX; + } + } + /* check if the original upper bound is redundant */ + if (U != +DBL_MAX) + { double eps = 1e-12 * (1.0 + fabs(U)); + if (UU < U + eps) + { /* it cannot be active, so remove it */ + *U_ = +DBL_MAX; + } + } +done: return ret; +} + +/*********************************************************************** +* check_col_bounds - check and tighten original column bounds +* +* Given a row (constraint) +* +* n +* L <= sum a[j] * x[j] <= U +* j=1 +* +* and bounds of columns (variables) +* +* l[j] <= x[j] <= u[j] +* +* for column (variable) x[j] this routine checks the original column +* bounds l[j] and u[j] for feasibility and redundancy. If the original +* lower bound l[j] or/and upper bound u[j] cannot be active due to +* bounds of the constraint and other variables, the routine tighten +* them replacing by corresponding implied bounds, if possible. +* +* NOTE: It is assumed that if L != -inf, the row lower bound can be +* active, and if U != +inf, the row upper bound can be active. +* +* The flag means that variable x[j] is required to be integer. +* +* New actual bounds for x[j] are stored in locations lj and uj. +* +* If no primal infeasibility is detected, the routine returns zero, +* otherwise non-zero. */ + +static int check_col_bounds(const struct f_info *f, int n, + const double a[], double L, double U, const double l[], + const double u[], int flag, int j, double *_lj, double *_uj) +{ int ret = 0; + double lj, uj, ll, uu; + xassert(n >= 0); + xassert(1 <= j && j <= n); + lj = l[j], uj = u[j]; + /* determine implied bounds of the column */ + col_implied_bounds(f, n, a, L, U, l, u, j, &ll, &uu); + /* if x[j] is integral, round its implied bounds */ + if (flag) + { if (ll != -DBL_MAX) + ll = (ll - floor(ll) < 1e-3 ? floor(ll) : ceil(ll)); + if (uu != +DBL_MAX) + uu = (ceil(uu) - uu < 1e-3 ? ceil(uu) : floor(uu)); + } + /* check if the original lower bound is infeasible */ + if (lj != -DBL_MAX) + { double eps = 1e-3 * (1.0 + fabs(lj)); + if (uu < lj - eps) + { ret = 1; + goto done; + } + } + /* check if the original upper bound is infeasible */ + if (uj != +DBL_MAX) + { double eps = 1e-3 * (1.0 + fabs(uj)); + if (ll > uj + eps) + { ret = 1; + goto done; + } + } + /* check if the original lower bound is redundant */ + if (ll != -DBL_MAX) + { double eps = 1e-3 * (1.0 + fabs(ll)); + if (lj < ll - eps) + { /* it cannot be active, so tighten it */ + lj = ll; + } + } + /* check if the original upper bound is redundant */ + if (uu != +DBL_MAX) + { double eps = 1e-3 * (1.0 + fabs(uu)); + if (uj > uu + eps) + { /* it cannot be active, so tighten it */ + uj = uu; + } + } + /* due to round-off errors it may happen that lj > uj (although + lj < uj + eps, since no primal infeasibility is detected), so + adjuct the new actual bounds to provide lj <= uj */ + if (!(lj == -DBL_MAX || uj == +DBL_MAX)) + { double t1 = fabs(lj), t2 = fabs(uj); + double eps = 1e-10 * (1.0 + (t1 <= t2 ? t1 : t2)); + if (lj > uj - eps) + { if (lj == l[j]) + uj = lj; + else if (uj == u[j]) + lj = uj; + else if (t1 <= t2) + uj = lj; + else + lj = uj; + } + } + *_lj = lj, *_uj = uj; +done: return ret; +} + +/*********************************************************************** +* check_efficiency - check if change in column bounds is efficient +* +* Given the original bounds of a column l and u and its new actual +* bounds l' and u' (possibly tighten by the routine check_col_bounds) +* this routine checks if the change in the column bounds is efficient +* enough. If so, the routine returns non-zero, otherwise zero. +* +* The flag means that the variable is required to be integer. */ + +static int check_efficiency(int flag, double l, double u, double ll, + double uu) +{ int eff = 0; + /* check efficiency for lower bound */ + if (l < ll) + { if (flag || l == -DBL_MAX) + eff++; + else + { double r; + if (u == +DBL_MAX) + r = 1.0 + fabs(l); + else + r = 1.0 + (u - l); + if (ll - l >= 0.25 * r) + eff++; + } + } + /* check efficiency for upper bound */ + if (u > uu) + { if (flag || u == +DBL_MAX) + eff++; + else + { double r; + if (l == -DBL_MAX) + r = 1.0 + fabs(u); + else + r = 1.0 + (u - l); + if (u - uu >= 0.25 * r) + eff++; + } + } + return eff; +} + +/*********************************************************************** +* basic_preprocessing - perform basic preprocessing +* +* This routine performs basic preprocessing of the specified MIP that +* includes relaxing some row bounds and tightening some column bounds. +* +* On entry the arrays L and U contains original row bounds, and the +* arrays l and u contains original column bounds: +* +* L[0] is the lower bound of the objective row; +* L[i], i = 1,...,m, is the lower bound of i-th row; +* U[0] is the upper bound of the objective row; +* U[i], i = 1,...,m, is the upper bound of i-th row; +* l[0] is not used; +* l[j], j = 1,...,n, is the lower bound of j-th column; +* u[0] is not used; +* u[j], j = 1,...,n, is the upper bound of j-th column. +* +* On exit the arrays L, U, l, and u contain new actual bounds of rows +* and column in the same locations. +* +* The parameters nrs and num specify an initial list of rows to be +* processed: +* +* nrs is the number of rows in the initial list, 0 <= nrs <= m+1; +* num[0] is not used; +* num[1,...,nrs] are row numbers (0 means the objective row). +* +* The parameter max_pass specifies the maximal number of times that +* each row can be processed, max_pass > 0. +* +* If no primal infeasibility is detected, the routine returns zero, +* otherwise non-zero. */ + +static int basic_preprocessing(glp_prob *mip, double L[], double U[], + double l[], double u[], int nrs, const int num[], int max_pass) +{ int m = mip->m; + int n = mip->n; + struct f_info f; + int i, j, k, len, size, ret = 0; + int *ind, *list, *mark, *pass; + double *val, *lb, *ub; + xassert(0 <= nrs && nrs <= m+1); + xassert(max_pass > 0); + /* allocate working arrays */ + ind = xcalloc(1+n, sizeof(int)); + list = xcalloc(1+m+1, sizeof(int)); + mark = xcalloc(1+m+1, sizeof(int)); + memset(&mark[0], 0, (m+1) * sizeof(int)); + pass = xcalloc(1+m+1, sizeof(int)); + memset(&pass[0], 0, (m+1) * sizeof(int)); + val = xcalloc(1+n, sizeof(double)); + lb = xcalloc(1+n, sizeof(double)); + ub = xcalloc(1+n, sizeof(double)); + /* initialize the list of rows to be processed */ + size = 0; + for (k = 1; k <= nrs; k++) + { i = num[k]; + xassert(0 <= i && i <= m); + /* duplicate row numbers are not allowed */ + xassert(!mark[i]); + list[++size] = i, mark[i] = 1; + } + xassert(size == nrs); + /* process rows in the list until it becomes empty */ + while (size > 0) + { /* get a next row from the list */ + i = list[size--], mark[i] = 0; + /* increase the row processing count */ + pass[i]++; + /* if the row is free, skip it */ + if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) continue; + /* obtain coefficients of the row */ + len = 0; + if (i == 0) + { for (j = 1; j <= n; j++) + { GLPCOL *col = mip->col[j]; + if (col->coef != 0.0) + len++, ind[len] = j, val[len] = col->coef; + } + } + else + { GLPROW *row = mip->row[i]; + GLPAIJ *aij; + for (aij = row->ptr; aij != NULL; aij = aij->r_next) + len++, ind[len] = aij->col->j, val[len] = aij->val; + } + /* determine lower and upper bounds of columns corresponding + to non-zero row coefficients */ + for (k = 1; k <= len; k++) + j = ind[k], lb[k] = l[j], ub[k] = u[j]; + /* prepare the row info to determine implied bounds */ + prepare_row_info(len, val, lb, ub, &f); + /* check and relax bounds of the row */ + if (check_row_bounds(&f, &L[i], &U[i])) + { /* the feasible region is empty */ + ret = 1; + goto done; + } + /* if the row became free, drop it */ + if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) continue; + /* process columns having non-zero coefficients in the row */ + for (k = 1; k <= len; k++) + { GLPCOL *col; + int flag, eff; + double ll, uu; + /* take a next column in the row */ + j = ind[k], col = mip->col[j]; + flag = col->kind != GLP_CV; + /* check and tighten bounds of the column */ + if (check_col_bounds(&f, len, val, L[i], U[i], lb, ub, + flag, k, &ll, &uu)) + { /* the feasible region is empty */ + ret = 1; + goto done; + } + /* check if change in the column bounds is efficient */ + eff = check_efficiency(flag, l[j], u[j], ll, uu); + /* set new actual bounds of the column */ + l[j] = ll, u[j] = uu; + /* if the change is efficient, add all rows affected by the + corresponding column, to the list */ + if (eff > 0) + { GLPAIJ *aij; + for (aij = col->ptr; aij != NULL; aij = aij->c_next) + { int ii = aij->row->i; + /* if the row was processed maximal number of times, + skip it */ + if (pass[ii] >= max_pass) continue; + /* if the row is free, skip it */ + if (L[ii] == -DBL_MAX && U[ii] == +DBL_MAX) continue; + /* put the row into the list */ + if (mark[ii] == 0) + { xassert(size <= m); + list[++size] = ii, mark[ii] = 1; + } + } + } + } + } +done: /* free working arrays */ + xfree(ind); + xfree(list); + xfree(mark); + xfree(pass); + xfree(val); + xfree(lb); + xfree(ub); + return ret; +} + +/*********************************************************************** +* NAME +* +* ios_preprocess_node - preprocess current subproblem +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_preprocess_node(glp_tree *tree, int max_pass); +* +* DESCRIPTION +* +* The routine ios_preprocess_node performs basic preprocessing of the +* current subproblem. +* +* RETURNS +* +* If no primal infeasibility is detected, the routine returns zero, +* otherwise non-zero. */ + +int ios_preprocess_node(glp_tree *tree, int max_pass) +{ glp_prob *mip = tree->mip; + int m = mip->m; + int n = mip->n; + int i, j, nrs, *num, ret = 0; + double *L, *U, *l, *u; + /* the current subproblem must exist */ + xassert(tree->curr != NULL); + /* determine original row bounds */ + L = xcalloc(1+m, sizeof(double)); + U = xcalloc(1+m, sizeof(double)); + switch (mip->mip_stat) + { case GLP_UNDEF: + L[0] = -DBL_MAX, U[0] = +DBL_MAX; + break; + case GLP_FEAS: + switch (mip->dir) + { case GLP_MIN: + L[0] = -DBL_MAX, U[0] = mip->mip_obj - mip->c0; + break; + case GLP_MAX: + L[0] = mip->mip_obj - mip->c0, U[0] = +DBL_MAX; + break; + default: + xassert(mip != mip); + } + break; + default: + xassert(mip != mip); + } + for (i = 1; i <= m; i++) + { L[i] = glp_get_row_lb(mip, i); + U[i] = glp_get_row_ub(mip, i); + } + /* determine original column bounds */ + l = xcalloc(1+n, sizeof(double)); + u = xcalloc(1+n, sizeof(double)); + for (j = 1; j <= n; j++) + { l[j] = glp_get_col_lb(mip, j); + u[j] = glp_get_col_ub(mip, j); + } + /* build the initial list of rows to be analyzed */ + nrs = m + 1; + num = xcalloc(1+nrs, sizeof(int)); + for (i = 1; i <= nrs; i++) num[i] = i - 1; + /* perform basic preprocessing */ + if (basic_preprocessing(mip , L, U, l, u, nrs, num, max_pass)) + { ret = 1; + goto done; + } + /* set new actual (relaxed) row bounds */ + for (i = 1; i <= m; i++) + { /* consider only non-active rows to keep dual feasibility */ + if (glp_get_row_stat(mip, i) == GLP_BS) + { if (L[i] == -DBL_MAX && U[i] == +DBL_MAX) + glp_set_row_bnds(mip, i, GLP_FR, 0.0, 0.0); + else if (U[i] == +DBL_MAX) + glp_set_row_bnds(mip, i, GLP_LO, L[i], 0.0); + else if (L[i] == -DBL_MAX) + glp_set_row_bnds(mip, i, GLP_UP, 0.0, U[i]); + } + } + /* set new actual (tightened) column bounds */ + for (j = 1; j <= n; j++) + { int type; + if (l[j] == -DBL_MAX && u[j] == +DBL_MAX) + type = GLP_FR; + else if (u[j] == +DBL_MAX) + type = GLP_LO; + else if (l[j] == -DBL_MAX) + type = GLP_UP; + else if (l[j] != u[j]) + type = GLP_DB; + else + type = GLP_FX; + glp_set_col_bnds(mip, j, type, l[j], u[j]); + } +done: /* free working arrays and return */ + xfree(L); + xfree(U); + xfree(l); + xfree(u); + xfree(num); + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios03.c b/test/monniaux/glpk-4.65/src/draft/glpios03.c new file mode 100644 index 00000000..21d6a000 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios03.c @@ -0,0 +1,1512 @@ +/* glpios03.c (branch-and-cut driver) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" + +/*********************************************************************** +* show_progress - display current progress of the search +* +* This routine displays some information about current progress of the +* search. +* +* The information includes: +* +* the current number of iterations performed by the simplex solver; +* +* the objective value for the best known integer feasible solution, +* which is upper (minimization) or lower (maximization) global bound +* for optimal solution of the original mip problem; +* +* the best local bound for active nodes, which is lower (minimization) +* or upper (maximization) global bound for optimal solution of the +* original mip problem; +* +* the relative mip gap, in percents; +* +* the number of open (active) subproblems; +* +* the number of completely explored subproblems, i.e. whose nodes have +* been removed from the tree. */ + +static void show_progress(glp_tree *T, int bingo) +{ int p; + double temp; + char best_mip[50], best_bound[50], *rho, rel_gap[50]; + /* format the best known integer feasible solution */ + if (T->mip->mip_stat == GLP_FEAS) + sprintf(best_mip, "%17.9e", T->mip->mip_obj); + else + sprintf(best_mip, "%17s", "not found yet"); + /* determine reference number of an active subproblem whose local + bound is best */ + p = ios_best_node(T); + /* format the best bound */ + if (p == 0) + sprintf(best_bound, "%17s", "tree is empty"); + else + { temp = T->slot[p].node->bound; + if (temp == -DBL_MAX) + sprintf(best_bound, "%17s", "-inf"); + else if (temp == +DBL_MAX) + sprintf(best_bound, "%17s", "+inf"); + else + { if (fabs(temp) < 1e-9) + temp = 0; + sprintf(best_bound, "%17.9e", temp); + } + } + /* choose the relation sign between global bounds */ + if (T->mip->dir == GLP_MIN) + rho = ">="; + else if (T->mip->dir == GLP_MAX) + rho = "<="; + else + xassert(T != T); + /* format the relative mip gap */ + temp = ios_relative_gap(T); + if (temp == 0.0) + sprintf(rel_gap, " 0.0%%"); + else if (temp < 0.001) + sprintf(rel_gap, "< 0.1%%"); + else if (temp <= 9.999) + sprintf(rel_gap, "%5.1f%%", 100.0 * temp); + else + sprintf(rel_gap, "%6s", ""); + /* display progress of the search */ + xprintf("+%6d: %s %s %s %s %s (%d; %d)\n", + T->mip->it_cnt, bingo ? ">>>>>" : "mip =", best_mip, rho, + best_bound, rel_gap, T->a_cnt, T->t_cnt - T->n_cnt); + T->tm_lag = xtime(); + return; +} + +/*********************************************************************** +* is_branch_hopeful - check if specified branch is hopeful +* +* This routine checks if the specified subproblem can have an integer +* optimal solution which is better than the best known one. +* +* The check is based on comparison of the local objective bound stored +* in the subproblem descriptor and the incumbent objective value which +* is the global objective bound. +* +* If there is a chance that the specified subproblem can have a better +* integer optimal solution, the routine returns non-zero. Otherwise, if +* the corresponding branch can pruned, zero is returned. */ + +static int is_branch_hopeful(glp_tree *T, int p) +{ xassert(1 <= p && p <= T->nslots); + xassert(T->slot[p].node != NULL); + return ios_is_hopeful(T, T->slot[p].node->bound); +} + +/*********************************************************************** +* check_integrality - check integrality of basic solution +* +* This routine checks if the basic solution of LP relaxation of the +* current subproblem satisfies to integrality conditions, i.e. that all +* variables of integer kind have integral primal values. (The solution +* is assumed to be optimal.) +* +* For each variable of integer kind the routine computes the following +* quantity: +* +* ii(x[j]) = min(x[j] - floor(x[j]), ceil(x[j]) - x[j]), (1) +* +* which is a measure of the integer infeasibility (non-integrality) of +* x[j] (for example, ii(2.1) = 0.1, ii(3.7) = 0.3, ii(5.0) = 0). It is +* understood that 0 <= ii(x[j]) <= 0.5, and variable x[j] is integer +* feasible if ii(x[j]) = 0. However, due to floating-point arithmetic +* the routine checks less restrictive condition: +* +* ii(x[j]) <= tol_int, (2) +* +* where tol_int is a given tolerance (small positive number) and marks +* each variable which does not satisfy to (2) as integer infeasible by +* setting its fractionality flag. +* +* In order to characterize integer infeasibility of the basic solution +* in the whole the routine computes two parameters: ii_cnt, which is +* the number of variables with the fractionality flag set, and ii_sum, +* which is the sum of integer infeasibilities (1). */ + +static void check_integrality(glp_tree *T) +{ glp_prob *mip = T->mip; + int j, type, ii_cnt = 0; + double lb, ub, x, temp1, temp2, ii_sum = 0.0; + /* walk through the set of columns (structural variables) */ + for (j = 1; j <= mip->n; j++) + { GLPCOL *col = mip->col[j]; + T->non_int[j] = 0; + /* if the column is not integer, skip it */ + if (col->kind != GLP_IV) continue; + /* if the column is non-basic, it is integer feasible */ + if (col->stat != GLP_BS) continue; + /* obtain the type and bounds of the column */ + type = col->type, lb = col->lb, ub = col->ub; + /* obtain value of the column in optimal basic solution */ + x = col->prim; + /* if the column's primal value is close to the lower bound, + the column is integer feasible within given tolerance */ + if (type == GLP_LO || type == GLP_DB || type == GLP_FX) + { temp1 = lb - T->parm->tol_int; + temp2 = lb + T->parm->tol_int; + if (temp1 <= x && x <= temp2) continue; +#if 0 + /* the lower bound must not be violated */ + xassert(x >= lb); +#else + if (x < lb) continue; +#endif + } + /* if the column's primal value is close to the upper bound, + the column is integer feasible within given tolerance */ + if (type == GLP_UP || type == GLP_DB || type == GLP_FX) + { temp1 = ub - T->parm->tol_int; + temp2 = ub + T->parm->tol_int; + if (temp1 <= x && x <= temp2) continue; +#if 0 + /* the upper bound must not be violated */ + xassert(x <= ub); +#else + if (x > ub) continue; +#endif + } + /* if the column's primal value is close to nearest integer, + the column is integer feasible within given tolerance */ + temp1 = floor(x + 0.5) - T->parm->tol_int; + temp2 = floor(x + 0.5) + T->parm->tol_int; + if (temp1 <= x && x <= temp2) continue; + /* otherwise the column is integer infeasible */ + T->non_int[j] = 1; + /* increase the number of fractional-valued columns */ + ii_cnt++; + /* compute the sum of integer infeasibilities */ + temp1 = x - floor(x); + temp2 = ceil(x) - x; + xassert(temp1 > 0.0 && temp2 > 0.0); + ii_sum += (temp1 <= temp2 ? temp1 : temp2); + } + /* store ii_cnt and ii_sum to the current problem descriptor */ + xassert(T->curr != NULL); + T->curr->ii_cnt = ii_cnt; + T->curr->ii_sum = ii_sum; + /* and also display these parameters */ + if (T->parm->msg_lev >= GLP_MSG_DBG) + { if (ii_cnt == 0) + xprintf("There are no fractional columns\n"); + else if (ii_cnt == 1) + xprintf("There is one fractional column, integer infeasibil" + "ity is %.3e\n", ii_sum); + else + xprintf("There are %d fractional columns, integer infeasibi" + "lity is %.3e\n", ii_cnt, ii_sum); + } + return; +} + +/*********************************************************************** +* record_solution - record better integer feasible solution +* +* This routine records optimal basic solution of LP relaxation of the +* current subproblem, which being integer feasible is better than the +* best known integer feasible solution. */ + +static void record_solution(glp_tree *T) +{ glp_prob *mip = T->mip; + int i, j; + mip->mip_stat = GLP_FEAS; + mip->mip_obj = mip->obj_val; + for (i = 1; i <= mip->m; i++) + { GLPROW *row = mip->row[i]; + row->mipx = row->prim; + } + for (j = 1; j <= mip->n; j++) + { GLPCOL *col = mip->col[j]; + if (col->kind == GLP_CV) + col->mipx = col->prim; + else if (col->kind == GLP_IV) + { /* value of the integer column must be integral */ + col->mipx = floor(col->prim + 0.5); + } + else + xassert(col != col); + } + T->sol_cnt++; + return; +} + +/*********************************************************************** +* fix_by_red_cost - fix non-basic integer columns by reduced costs +* +* This routine fixes some non-basic integer columns if their reduced +* costs indicate that increasing (decreasing) the column at least by +* one involves the objective value becoming worse than the incumbent +* objective value. */ + +static void fix_by_red_cost(glp_tree *T) +{ glp_prob *mip = T->mip; + int j, stat, fixed = 0; + double obj, lb, ub, dj; + /* the global bound must exist */ + xassert(T->mip->mip_stat == GLP_FEAS); + /* basic solution of LP relaxation must be optimal */ + xassert(mip->pbs_stat == GLP_FEAS && mip->dbs_stat == GLP_FEAS); + /* determine the objective function value */ + obj = mip->obj_val; + /* walk through the column list */ + for (j = 1; j <= mip->n; j++) + { GLPCOL *col = mip->col[j]; + /* if the column is not integer, skip it */ + if (col->kind != GLP_IV) continue; + /* obtain bounds of j-th column */ + lb = col->lb, ub = col->ub; + /* and determine its status and reduced cost */ + stat = col->stat, dj = col->dual; + /* analyze the reduced cost */ + switch (mip->dir) + { case GLP_MIN: + /* minimization */ + if (stat == GLP_NL) + { /* j-th column is non-basic on its lower bound */ + if (dj < 0.0) dj = 0.0; + if (obj + dj >= mip->mip_obj) + glp_set_col_bnds(mip, j, GLP_FX, lb, lb), fixed++; + } + else if (stat == GLP_NU) + { /* j-th column is non-basic on its upper bound */ + if (dj > 0.0) dj = 0.0; + if (obj - dj >= mip->mip_obj) + glp_set_col_bnds(mip, j, GLP_FX, ub, ub), fixed++; + } + break; + case GLP_MAX: + /* maximization */ + if (stat == GLP_NL) + { /* j-th column is non-basic on its lower bound */ + if (dj > 0.0) dj = 0.0; + if (obj + dj <= mip->mip_obj) + glp_set_col_bnds(mip, j, GLP_FX, lb, lb), fixed++; + } + else if (stat == GLP_NU) + { /* j-th column is non-basic on its upper bound */ + if (dj < 0.0) dj = 0.0; + if (obj - dj <= mip->mip_obj) + glp_set_col_bnds(mip, j, GLP_FX, ub, ub), fixed++; + } + break; + default: + xassert(T != T); + } + } + if (T->parm->msg_lev >= GLP_MSG_DBG) + { if (fixed == 0) + /* nothing to say */; + else if (fixed == 1) + xprintf("One column has been fixed by reduced cost\n"); + else + xprintf("%d columns have been fixed by reduced costs\n", + fixed); + } + /* fixing non-basic columns on their current bounds does not + change the basic solution */ + xassert(mip->pbs_stat == GLP_FEAS && mip->dbs_stat == GLP_FEAS); + return; +} + +/*********************************************************************** +* branch_on - perform branching on specified variable +* +* This routine performs branching on j-th column (structural variable) +* of the current subproblem. The specified column must be of integer +* kind and must have a fractional value in optimal basic solution of +* LP relaxation of the current subproblem (i.e. only columns for which +* the flag non_int[j] is set are valid candidates to branch on). +* +* Let x be j-th structural variable, and beta be its primal fractional +* value in the current basic solution. Branching on j-th variable is +* dividing the current subproblem into two new subproblems, which are +* identical to the current subproblem with the following exception: in +* the first subproblem that begins the down-branch x has a new upper +* bound x <= floor(beta), and in the second subproblem that begins the +* up-branch x has a new lower bound x >= ceil(beta). +* +* Depending on estimation of local bounds for down- and up-branches +* this routine returns the following: +* +* 0 - both branches have been created; +* 1 - one branch is hopeless and has been pruned, so now the current +* subproblem is other branch; +* 2 - both branches are hopeless and have been pruned; new subproblem +* selection is needed to continue the search. */ + +static int branch_on(glp_tree *T, int j, int next) +{ glp_prob *mip = T->mip; + IOSNPD *node; + int m = mip->m; + int n = mip->n; + int type, dn_type, up_type, dn_bad, up_bad, p, ret, clone[1+2]; + double lb, ub, beta, new_ub, new_lb, dn_lp, up_lp, dn_bnd, up_bnd; + /* determine bounds and value of x[j] in optimal solution to LP + relaxation of the current subproblem */ + xassert(1 <= j && j <= n); + type = mip->col[j]->type; + lb = mip->col[j]->lb; + ub = mip->col[j]->ub; + beta = mip->col[j]->prim; + /* determine new bounds of x[j] for down- and up-branches */ + new_ub = floor(beta); + new_lb = ceil(beta); + switch (type) + { case GLP_FR: + dn_type = GLP_UP; + up_type = GLP_LO; + break; + case GLP_LO: + xassert(lb <= new_ub); + dn_type = (lb == new_ub ? GLP_FX : GLP_DB); + xassert(lb + 1.0 <= new_lb); + up_type = GLP_LO; + break; + case GLP_UP: + xassert(new_ub <= ub - 1.0); + dn_type = GLP_UP; + xassert(new_lb <= ub); + up_type = (new_lb == ub ? GLP_FX : GLP_DB); + break; + case GLP_DB: + xassert(lb <= new_ub && new_ub <= ub - 1.0); + dn_type = (lb == new_ub ? GLP_FX : GLP_DB); + xassert(lb + 1.0 <= new_lb && new_lb <= ub); + up_type = (new_lb == ub ? GLP_FX : GLP_DB); + break; + default: + xassert(type != type); + } + /* compute local bounds to LP relaxation for both branches */ + ios_eval_degrad(T, j, &dn_lp, &up_lp); + /* and improve them by rounding */ + dn_bnd = ios_round_bound(T, dn_lp); + up_bnd = ios_round_bound(T, up_lp); + /* check local bounds for down- and up-branches */ + dn_bad = !ios_is_hopeful(T, dn_bnd); + up_bad = !ios_is_hopeful(T, up_bnd); + if (dn_bad && up_bad) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Both down- and up-branches are hopeless\n"); + ret = 2; + goto done; + } + else if (up_bad) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Up-branch is hopeless\n"); + glp_set_col_bnds(mip, j, dn_type, lb, new_ub); + T->curr->lp_obj = dn_lp; + if (mip->dir == GLP_MIN) + { if (T->curr->bound < dn_bnd) + T->curr->bound = dn_bnd; + } + else if (mip->dir == GLP_MAX) + { if (T->curr->bound > dn_bnd) + T->curr->bound = dn_bnd; + } + else + xassert(mip != mip); + ret = 1; + goto done; + } + else if (dn_bad) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Down-branch is hopeless\n"); + glp_set_col_bnds(mip, j, up_type, new_lb, ub); + T->curr->lp_obj = up_lp; + if (mip->dir == GLP_MIN) + { if (T->curr->bound < up_bnd) + T->curr->bound = up_bnd; + } + else if (mip->dir == GLP_MAX) + { if (T->curr->bound > up_bnd) + T->curr->bound = up_bnd; + } + else + xassert(mip != mip); + ret = 1; + goto done; + } + /* both down- and up-branches seem to be hopeful */ + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Branching on column %d, primal value is %.9e\n", + j, beta); + /* determine the reference number of the current subproblem */ + xassert(T->curr != NULL); + p = T->curr->p; + T->curr->br_var = j; + T->curr->br_val = beta; + /* freeze the current subproblem */ + ios_freeze_node(T); + /* create two clones of the current subproblem; the first clone + begins the down-branch, the second one begins the up-branch */ + ios_clone_node(T, p, 2, clone); + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Node %d begins down branch, node %d begins up branch " + "\n", clone[1], clone[2]); + /* set new upper bound of j-th column in the down-branch */ + node = T->slot[clone[1]].node; + xassert(node != NULL); + xassert(node->up != NULL); + xassert(node->b_ptr == NULL); + node->b_ptr = dmp_get_atom(T->pool, sizeof(IOSBND)); + node->b_ptr->k = m + j; + node->b_ptr->type = (unsigned char)dn_type; + node->b_ptr->lb = lb; + node->b_ptr->ub = new_ub; + node->b_ptr->next = NULL; + node->lp_obj = dn_lp; + if (mip->dir == GLP_MIN) + { if (node->bound < dn_bnd) + node->bound = dn_bnd; + } + else if (mip->dir == GLP_MAX) + { if (node->bound > dn_bnd) + node->bound = dn_bnd; + } + else + xassert(mip != mip); + /* set new lower bound of j-th column in the up-branch */ + node = T->slot[clone[2]].node; + xassert(node != NULL); + xassert(node->up != NULL); + xassert(node->b_ptr == NULL); + node->b_ptr = dmp_get_atom(T->pool, sizeof(IOSBND)); + node->b_ptr->k = m + j; + node->b_ptr->type = (unsigned char)up_type; + node->b_ptr->lb = new_lb; + node->b_ptr->ub = ub; + node->b_ptr->next = NULL; + node->lp_obj = up_lp; + if (mip->dir == GLP_MIN) + { if (node->bound < up_bnd) + node->bound = up_bnd; + } + else if (mip->dir == GLP_MAX) + { if (node->bound > up_bnd) + node->bound = up_bnd; + } + else + xassert(mip != mip); + /* suggest the subproblem to be solved next */ + xassert(T->child == 0); + if (next == GLP_NO_BRNCH) + T->child = 0; + else if (next == GLP_DN_BRNCH) + T->child = clone[1]; + else if (next == GLP_UP_BRNCH) + T->child = clone[2]; + else + xassert(next != next); + ret = 0; +done: return ret; +} + +/*********************************************************************** +* cleanup_the_tree - prune hopeless branches from the tree +* +* This routine walks through the active list and checks the local +* bound for every active subproblem. If the local bound indicates that +* the subproblem cannot have integer optimal solution better than the +* incumbent objective value, the routine deletes such subproblem that, +* in turn, involves pruning the corresponding branch of the tree. */ + +static void cleanup_the_tree(glp_tree *T) +{ IOSNPD *node, *next_node; + int count = 0; + /* the global bound must exist */ + xassert(T->mip->mip_stat == GLP_FEAS); + /* walk through the list of active subproblems */ + for (node = T->head; node != NULL; node = next_node) + { /* deleting some active problem node may involve deleting its + parents recursively; however, all its parents being created + *before* it are always *precede* it in the node list, so + the next problem node is never affected by such deletion */ + next_node = node->next; + /* if the branch is hopeless, prune it */ + if (!is_branch_hopeful(T, node->p)) + ios_delete_node(T, node->p), count++; + } + if (T->parm->msg_lev >= GLP_MSG_DBG) + { if (count == 1) + xprintf("One hopeless branch has been pruned\n"); + else if (count > 1) + xprintf("%d hopeless branches have been pruned\n", count); + } + return; +} + +/*********************************************************************** +* round_heur - simple rounding heuristic +* +* This routine attempts to guess an integer feasible solution by +* simple rounding values of all integer variables in basic solution to +* nearest integers. */ + +static int round_heur(glp_tree *T) +{ glp_prob *P = T->mip; + /*int m = P->m;*/ + int n = P->n; + int i, j, ret; + double *x; + /* compute rounded values of variables */ + x = talloc(1+n, double); + for (j = 1; j <= n; j++) + { GLPCOL *col = P->col[j]; + if (col->kind == GLP_IV) + { /* integer variable */ + x[j] = floor(col->prim + 0.5); + } + else if (col->type == GLP_FX) + { /* fixed variable */ + x[j] = col->prim; + } + else + { /* non-integer non-fixed variable */ + ret = 3; + goto done; + } + } + /* check that no constraints are violated */ + for (i = 1; i <= T->orig_m; i++) + { int type = T->orig_type[i]; + GLPAIJ *aij; + double sum; + if (type == GLP_FR) + continue; + /* compute value of linear form */ + sum = 0.0; + for (aij = P->row[i]->ptr; aij != NULL; aij = aij->r_next) + sum += aij->val * x[aij->col->j]; + /* check lower bound */ + if (type == GLP_LO || type == GLP_DB || type == GLP_FX) + { if (sum < T->orig_lb[i] - 1e-9) + { /* lower bound is violated */ + ret = 2; + goto done; + } + } + /* check upper bound */ + if (type == GLP_UP || type == GLP_DB || type == GLP_FX) + { if (sum > T->orig_ub[i] + 1e-9) + { /* upper bound is violated */ + ret = 2; + goto done; + } + } + } + /* rounded solution is integer feasible */ + if (glp_ios_heur_sol(T, x) == 0) + { /* solution is accepted */ + ret = 0; + } + else + { /* solution is rejected */ + ret = 1; + } +done: tfree(x); + return ret; +} + +/**********************************************************************/ + +#if 1 /* 08/III-2016 */ +static void gmi_gen(glp_tree *T) +{ /* generate Gomory's mixed integer cuts */ + glp_prob *P, *pool; + P = T->mip; + pool = glp_create_prob(); + glp_add_cols(pool, P->n); + glp_gmi_gen(P, pool, 50); + if (pool->m > 0) + { int i, len, *ind; + double *val; + ind = xcalloc(1+P->n, sizeof(int)); + val = xcalloc(1+P->n, sizeof(double)); + for (i = 1; i <= pool->m; i++) + { len = glp_get_mat_row(pool, i, ind, val); + glp_ios_add_row(T, NULL, GLP_RF_GMI, 0, len, ind, val, + GLP_LO, pool->row[i]->lb); + } + xfree(ind); + xfree(val); + } + glp_delete_prob(pool); + return; +} +#endif + +#ifdef NEW_COVER /* 13/II-2018 */ +static void cov_gen(glp_tree *T) +{ /* generate cover cuts */ + glp_prob *P, *pool; + if (T->cov_gen == NULL) + return; + P = T->mip; + pool = glp_create_prob(); + glp_add_cols(pool, P->n); + glp_cov_gen1(P, T->cov_gen, pool); + if (pool->m > 0) + { int i, len, *ind; + double *val; + ind = xcalloc(1+P->n, sizeof(int)); + val = xcalloc(1+P->n, sizeof(double)); + for (i = 1; i <= pool->m; i++) + { len = glp_get_mat_row(pool, i, ind, val); + glp_ios_add_row(T, NULL, GLP_RF_COV, 0, len, ind, val, + GLP_UP, pool->row[i]->ub); + } + xfree(ind); + xfree(val); + } + glp_delete_prob(pool); + return; +} +#endif + +#if 1 /* 08/III-2016 */ +static void mir_gen(glp_tree *T) +{ /* generate mixed integer rounding cuts */ + glp_prob *P, *pool; + P = T->mip; + pool = glp_create_prob(); + glp_add_cols(pool, P->n); + glp_mir_gen(P, T->mir_gen, pool); + if (pool->m > 0) + { int i, len, *ind; + double *val; + ind = xcalloc(1+P->n, sizeof(int)); + val = xcalloc(1+P->n, sizeof(double)); + for (i = 1; i <= pool->m; i++) + { len = glp_get_mat_row(pool, i, ind, val); + glp_ios_add_row(T, NULL, GLP_RF_MIR, 0, len, ind, val, + GLP_UP, pool->row[i]->ub); + } + xfree(ind); + xfree(val); + } + glp_delete_prob(pool); + return; +} +#endif + +#if 1 /* 08/III-2016 */ +static void clq_gen(glp_tree *T, glp_cfg *G) +{ /* generate clique cut from conflict graph */ + glp_prob *P = T->mip; + int n = P->n; + int len, *ind; + double *val; + ind = talloc(1+n, int); + val = talloc(1+n, double); + len = glp_clq_cut(T->mip, G, ind, val); + if (len > 0) + glp_ios_add_row(T, NULL, GLP_RF_CLQ, 0, len, ind, val, GLP_UP, + val[0]); + tfree(ind); + tfree(val); + return; +} +#endif + +static void generate_cuts(glp_tree *T) +{ /* generate generic cuts with built-in generators */ + if (!(T->parm->mir_cuts == GLP_ON || + T->parm->gmi_cuts == GLP_ON || + T->parm->cov_cuts == GLP_ON || + T->parm->clq_cuts == GLP_ON)) goto done; +#if 1 /* 20/IX-2008 */ + { int i, max_cuts, added_cuts; + max_cuts = T->n; + if (max_cuts < 1000) max_cuts = 1000; + added_cuts = 0; + for (i = T->orig_m+1; i <= T->mip->m; i++) + { if (T->mip->row[i]->origin == GLP_RF_CUT) + added_cuts++; + } + /* xprintf("added_cuts = %d\n", added_cuts); */ + if (added_cuts >= max_cuts) goto done; + } +#endif + /* generate and add to POOL all cuts violated by x* */ + if (T->parm->gmi_cuts == GLP_ON) + { if (T->curr->changed < 7) +#if 0 /* 08/III-2016 */ + ios_gmi_gen(T); +#else + gmi_gen(T); +#endif + } + if (T->parm->mir_cuts == GLP_ON) + { xassert(T->mir_gen != NULL); +#if 0 /* 08/III-2016 */ + ios_mir_gen(T, T->mir_gen); +#else + mir_gen(T); +#endif + } + if (T->parm->cov_cuts == GLP_ON) + { /* cover cuts works well along with mir cuts */ +#ifdef NEW_COVER /* 13/II-2018 */ + cov_gen(T); +#else + ios_cov_gen(T); +#endif + } + if (T->parm->clq_cuts == GLP_ON) + { if (T->clq_gen != NULL) +#if 0 /* 29/VI-2013 */ + { if (T->curr->level == 0 && T->curr->changed < 50 || + T->curr->level > 0 && T->curr->changed < 5) +#else /* FIXME */ + { if (T->curr->level == 0 && T->curr->changed < 500 || + T->curr->level > 0 && T->curr->changed < 50) +#endif +#if 0 /* 08/III-2016 */ + ios_clq_gen(T, T->clq_gen); +#else + clq_gen(T, T->clq_gen); +#endif + } + } +done: return; +} + +/**********************************************************************/ + +static void remove_cuts(glp_tree *T) +{ /* remove inactive cuts (some valueable globally valid cut might + be saved in the global cut pool) */ + int i, cnt = 0, *num = NULL; + xassert(T->curr != NULL); + for (i = T->orig_m+1; i <= T->mip->m; i++) + { if (T->mip->row[i]->origin == GLP_RF_CUT && + T->mip->row[i]->level == T->curr->level && + T->mip->row[i]->stat == GLP_BS) + { if (num == NULL) + num = xcalloc(1+T->mip->m, sizeof(int)); + num[++cnt] = i; + } + } + if (cnt > 0) + { glp_del_rows(T->mip, cnt, num); +#if 0 + xprintf("%d inactive cut(s) removed\n", cnt); +#endif + xfree(num); + xassert(glp_factorize(T->mip) == 0); + } + return; +} + +/**********************************************************************/ + +static void display_cut_info(glp_tree *T) +{ glp_prob *mip = T->mip; + int i, gmi = 0, mir = 0, cov = 0, clq = 0, app = 0; + for (i = mip->m; i > 0; i--) + { GLPROW *row; + row = mip->row[i]; + /* if (row->level < T->curr->level) break; */ + if (row->origin == GLP_RF_CUT) + { if (row->klass == GLP_RF_GMI) + gmi++; + else if (row->klass == GLP_RF_MIR) + mir++; + else if (row->klass == GLP_RF_COV) + cov++; + else if (row->klass == GLP_RF_CLQ) + clq++; + else + app++; + } + } + xassert(T->curr != NULL); + if (gmi + mir + cov + clq + app > 0) + { xprintf("Cuts on level %d:", T->curr->level); + if (gmi > 0) xprintf(" gmi = %d;", gmi); + if (mir > 0) xprintf(" mir = %d;", mir); + if (cov > 0) xprintf(" cov = %d;", cov); + if (clq > 0) xprintf(" clq = %d;", clq); + if (app > 0) xprintf(" app = %d;", app); + xprintf("\n"); + } + return; +} + +/*********************************************************************** +* NAME +* +* ios_driver - branch-and-cut driver +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_driver(glp_tree *T); +* +* DESCRIPTION +* +* The routine ios_driver is a branch-and-cut driver. It controls the +* MIP solution process. +* +* RETURNS +* +* 0 The MIP problem instance has been successfully solved. This code +* does not necessarily mean that the solver has found optimal +* solution. It only means that the solution process was successful. +* +* GLP_EFAIL +* The search was prematurely terminated due to the solver failure. +* +* GLP_EMIPGAP +* The search was prematurely terminated, because the relative mip +* gap tolerance has been reached. +* +* GLP_ETMLIM +* The search was prematurely terminated, because the time limit has +* been exceeded. +* +* GLP_ESTOP +* The search was prematurely terminated by application. */ + +int ios_driver(glp_tree *T) +{ int p, curr_p, p_stat, d_stat, ret; +#if 1 /* carry out to glp_tree */ + int pred_p = 0; + /* if the current subproblem has been just created due to + branching, pred_p is the reference number of its parent + subproblem, otherwise pred_p is zero */ +#endif +#if 1 /* 18/VII-2013 */ + int bad_cut; + double old_obj; +#endif +#if 0 /* 10/VI-2013 */ + glp_long ttt = T->tm_beg; +#else + double ttt = T->tm_beg; +#endif +#if 1 /* 27/II-2016 by Chris */ + int root_done = 0; +#endif +#if 0 + ((glp_iocp *)T->parm)->msg_lev = GLP_MSG_DBG; +#endif +#if 1 /* 16/III-2016 */ + if (((glp_iocp *)T->parm)->flip) +#if 0 /* 20/I-2018 */ + xprintf("WARNING: LONG-STEP DUAL SIMPLEX WILL BE USED\n"); +#else + xprintf("Long-step dual simplex will be used\n"); +#endif +#endif + /* on entry to the B&B driver it is assumed that the active list + contains the only active (i.e. root) subproblem, which is the + original MIP problem to be solved */ +loop: /* main loop starts here */ + /* at this point the current subproblem does not exist */ + xassert(T->curr == NULL); + /* if the active list is empty, the search is finished */ + if (T->head == NULL) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Active list is empty!\n"); +#if 0 /* 10/VI-2013 */ + xassert(dmp_in_use(T->pool).lo == 0); +#else + xassert(dmp_in_use(T->pool) == 0); +#endif + ret = 0; + goto done; + } + /* select some active subproblem to continue the search */ + xassert(T->next_p == 0); + /* let the application program select subproblem */ + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + T->reason = GLP_ISELECT; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + } + if (T->next_p != 0) + { /* the application program has selected something */ + ; + } + else if (T->a_cnt == 1) + { /* the only active subproblem exists, so select it */ + xassert(T->head->next == NULL); + T->next_p = T->head->p; + } + else if (T->child != 0) + { /* select one of branching childs suggested by the branching + heuristic */ + T->next_p = T->child; + } + else + { /* select active subproblem as specified by the backtracking + technique option */ + T->next_p = ios_choose_node(T); + } + /* the active subproblem just selected becomes current */ + ios_revive_node(T, T->next_p); + T->next_p = T->child = 0; + /* invalidate pred_p, if it is not the reference number of the + parent of the current subproblem */ + if (T->curr->up != NULL && T->curr->up->p != pred_p) pred_p = 0; + /* determine the reference number of the current subproblem */ + p = T->curr->p; + if (T->parm->msg_lev >= GLP_MSG_DBG) + { xprintf("-----------------------------------------------------" + "-------------------\n"); + xprintf("Processing node %d at level %d\n", p, T->curr->level); + } +#if 0 + if (p == 1) + glp_write_lp(T->mip, NULL, "root.lp"); +#endif +#if 1 /* 24/X-2015 */ + if (p == 1) + { if (T->parm->sr_heur == GLP_OFF) + { if (T->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Simple rounding heuristic disabled\n"); + } + } +#endif + /* if it is the root subproblem, initialize cut generators */ + if (p == 1) + { if (T->parm->gmi_cuts == GLP_ON) + { if (T->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Gomory's cuts enabled\n"); + } + if (T->parm->mir_cuts == GLP_ON) + { if (T->parm->msg_lev >= GLP_MSG_ALL) + xprintf("MIR cuts enabled\n"); + xassert(T->mir_gen == NULL); +#if 0 /* 06/III-2016 */ + T->mir_gen = ios_mir_init(T); +#else + T->mir_gen = glp_mir_init(T->mip); +#endif + } + if (T->parm->cov_cuts == GLP_ON) + { if (T->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Cover cuts enabled\n"); +#ifdef NEW_COVER /* 13/II-2018 */ + xassert(T->cov_gen == NULL); + T->cov_gen = glp_cov_init(T->mip); +#endif + } + if (T->parm->clq_cuts == GLP_ON) + { xassert(T->clq_gen == NULL); + if (T->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Clique cuts enabled\n"); +#if 0 /* 08/III-2016 */ + T->clq_gen = ios_clq_init(T); +#else + T->clq_gen = glp_cfg_init(T->mip); +#endif + } + } +#if 1 /* 18/VII-2013 */ + bad_cut = 0; +#endif +more: /* minor loop starts here */ + /* at this point the current subproblem needs either to be solved + for the first time or re-optimized due to reformulation */ + /* display current progress of the search */ + if (T->parm->msg_lev >= GLP_MSG_DBG || + T->parm->msg_lev >= GLP_MSG_ON && + (double)(T->parm->out_frq - 1) <= + 1000.0 * xdifftime(xtime(), T->tm_lag)) + show_progress(T, 0); + if (T->parm->msg_lev >= GLP_MSG_ALL && + xdifftime(xtime(), ttt) >= 60.0) +#if 0 /* 16/II-2012 */ + { glp_long total; + glp_mem_usage(NULL, NULL, &total, NULL); + xprintf("Time used: %.1f secs. Memory used: %.1f Mb.\n", + xdifftime(xtime(), T->tm_beg), xltod(total) / 1048576.0); + ttt = xtime(); + } +#else + { size_t total; + glp_mem_usage(NULL, NULL, &total, NULL); + xprintf("Time used: %.1f secs. Memory used: %.1f Mb.\n", + xdifftime(xtime(), T->tm_beg), (double)total / 1048576.0); + ttt = xtime(); + } +#endif + /* check the mip gap */ + if (T->parm->mip_gap > 0.0 && + ios_relative_gap(T) <= T->parm->mip_gap) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Relative gap tolerance reached; search terminated " + "\n"); + ret = GLP_EMIPGAP; + goto done; + } + /* check if the time limit has been exhausted */ + if (T->parm->tm_lim < INT_MAX && + (double)(T->parm->tm_lim - 1) <= + 1000.0 * xdifftime(xtime(), T->tm_beg)) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Time limit exhausted; search terminated\n"); + ret = GLP_ETMLIM; + goto done; + } + /* let the application program preprocess the subproblem */ + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + T->reason = GLP_IPREPRO; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + } + /* perform basic preprocessing */ + if (T->parm->pp_tech == GLP_PP_NONE) + ; + else if (T->parm->pp_tech == GLP_PP_ROOT) +#if 0 /* 27/II-2016 by Chris */ + { if (T->curr->level == 0) +#else + { if (!root_done) +#endif + { if (ios_preprocess_node(T, 100)) + goto fath; + } + } + else if (T->parm->pp_tech == GLP_PP_ALL) +#if 0 /* 27/II-2016 by Chris */ + { if (ios_preprocess_node(T, T->curr->level == 0 ? 100 : 10)) +#else + { if (ios_preprocess_node(T, !root_done ? 100 : 10)) +#endif + goto fath; + } + else + xassert(T != T); + /* preprocessing may improve the global bound */ + if (!is_branch_hopeful(T, p)) + { xprintf("*** not tested yet ***\n"); + goto fath; + } + /* solve LP relaxation of the current subproblem */ + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Solving LP relaxation...\n"); + ret = ios_solve_node(T); + if (ret == GLP_ETMLIM) + goto done; + else if (!(ret == 0 || ret == GLP_EOBJLL || ret == GLP_EOBJUL)) + { if (T->parm->msg_lev >= GLP_MSG_ERR) + xprintf("ios_driver: unable to solve current LP relaxation;" + " glp_simplex returned %d\n", ret); + ret = GLP_EFAIL; + goto done; + } + /* analyze status of the basic solution to LP relaxation found */ + p_stat = T->mip->pbs_stat; + d_stat = T->mip->dbs_stat; + if (p_stat == GLP_FEAS && d_stat == GLP_FEAS) + { /* LP relaxation has optimal solution */ + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Found optimal solution to LP relaxation\n"); + } + else if (d_stat == GLP_NOFEAS) + { /* LP relaxation has no dual feasible solution */ + /* since the current subproblem cannot have a larger feasible + region than its parent, there is something wrong */ + if (T->parm->msg_lev >= GLP_MSG_ERR) + xprintf("ios_driver: current LP relaxation has no dual feas" + "ible solution\n"); + ret = GLP_EFAIL; + goto done; + } + else if (p_stat == GLP_INFEAS && d_stat == GLP_FEAS) + { /* LP relaxation has no primal solution which is better than + the incumbent objective value */ + xassert(T->mip->mip_stat == GLP_FEAS); + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("LP relaxation has no solution better than incumben" + "t objective value\n"); + /* prune the branch */ + goto fath; + } + else if (p_stat == GLP_NOFEAS) + { /* LP relaxation has no primal feasible solution */ + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("LP relaxation has no feasible solution\n"); + /* prune the branch */ + goto fath; + } + else + { /* other cases cannot appear */ + xassert(T->mip != T->mip); + } + /* at this point basic solution to LP relaxation of the current + subproblem is optimal */ + xassert(p_stat == GLP_FEAS && d_stat == GLP_FEAS); + xassert(T->curr != NULL); + T->curr->lp_obj = T->mip->obj_val; + /* thus, it defines a local bound to integer optimal solution of + the current subproblem */ + { double bound = T->mip->obj_val; + /* some local bound to the current subproblem could be already + set before, so we should only improve it */ + bound = ios_round_bound(T, bound); + if (T->mip->dir == GLP_MIN) + { if (T->curr->bound < bound) + T->curr->bound = bound; + } + else if (T->mip->dir == GLP_MAX) + { if (T->curr->bound > bound) + T->curr->bound = bound; + } + else + xassert(T->mip != T->mip); + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Local bound is %.9e\n", bound); + } + /* if the local bound indicates that integer optimal solution of + the current subproblem cannot be better than the global bound, + prune the branch */ + if (!is_branch_hopeful(T, p)) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Current branch is hopeless and can be pruned\n"); + goto fath; + } + /* let the application program generate additional rows ("lazy" + constraints) */ + xassert(T->reopt == 0); + xassert(T->reinv == 0); + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + T->reason = GLP_IROWGEN; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + if (T->reopt) + { /* some rows were added; re-optimization is needed */ + T->reopt = T->reinv = 0; + goto more; + } + if (T->reinv) + { /* no rows were added, however, some inactive rows were + removed */ + T->reinv = 0; + xassert(glp_factorize(T->mip) == 0); + } + } + /* check if the basic solution is integer feasible */ + check_integrality(T); + /* if the basic solution satisfies to all integrality conditions, + it is a new, better integer feasible solution */ + if (T->curr->ii_cnt == 0) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("New integer feasible solution found\n"); + if (T->parm->msg_lev >= GLP_MSG_ALL) + display_cut_info(T); + record_solution(T); + if (T->parm->msg_lev >= GLP_MSG_ON) + show_progress(T, 1); +#if 1 /* 11/VII-2013 */ + ios_process_sol(T); +#endif + /* make the application program happy */ + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + T->reason = GLP_IBINGO; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + } + /* since the current subproblem has been fathomed, prune its + branch */ + goto fath; + } + /* at this point basic solution to LP relaxation of the current + subproblem is optimal, but integer infeasible */ + /* try to fix some non-basic structural variables of integer kind + on their current bounds due to reduced costs */ + if (T->mip->mip_stat == GLP_FEAS) + fix_by_red_cost(T); + /* let the application program try to find some solution to the + original MIP with a primal heuristic */ + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + T->reason = GLP_IHEUR; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + /* check if the current branch became hopeless */ + if (!is_branch_hopeful(T, p)) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Current branch became hopeless and can be prune" + "d\n"); + goto fath; + } + } + /* try to find solution with the feasibility pump heuristic */ +#if 0 /* 27/II-2016 by Chris */ + if (T->parm->fp_heur) +#else + if (T->parm->fp_heur && !root_done) +#endif + { xassert(T->reason == 0); + T->reason = GLP_IHEUR; + ios_feas_pump(T); + T->reason = 0; + /* check if the current branch became hopeless */ + if (!is_branch_hopeful(T, p)) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Current branch became hopeless and can be prune" + "d\n"); + goto fath; + } + } +#if 1 /* 25/V-2013 */ + /* try to find solution with the proximity search heuristic */ +#if 0 /* 27/II-2016 by Chris */ + if (T->parm->ps_heur) +#else + if (T->parm->ps_heur && !root_done) +#endif + { xassert(T->reason == 0); + T->reason = GLP_IHEUR; + ios_proxy_heur(T); + T->reason = 0; + /* check if the current branch became hopeless */ + if (!is_branch_hopeful(T, p)) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Current branch became hopeless and can be prune" + "d\n"); + goto fath; + } + } +#endif +#if 1 /* 24/X-2015 */ + /* try to find solution with a simple rounding heuristic */ + if (T->parm->sr_heur) + { xassert(T->reason == 0); + T->reason = GLP_IHEUR; + round_heur(T); + T->reason = 0; + /* check if the current branch became hopeless */ + if (!is_branch_hopeful(T, p)) + { if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Current branch became hopeless and can be prune" + "d\n"); + goto fath; + } + } +#endif + /* it's time to generate cutting planes */ + xassert(T->local != NULL); +#ifdef NEW_LOCAL /* 02/II-2018 */ + xassert(T->local->m == 0); +#else + xassert(T->local->size == 0); +#endif + /* let the application program generate some cuts; note that it + can add cuts either to the local cut pool or directly to the + current subproblem */ + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + T->reason = GLP_ICUTGEN; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + } +#if 1 /* 18/VII-2013 */ + if (T->curr->changed > 0) + { double degrad = fabs(T->curr->lp_obj - old_obj); + if (degrad < 1e-4 * (1.0 + fabs(old_obj))) + bad_cut++; + else + bad_cut = 0; + } + old_obj = T->curr->lp_obj; +#if 0 /* 27/II-2016 by Chris */ + if (bad_cut == 0 || (T->curr->level == 0 && bad_cut <= 3)) +#else + if (bad_cut == 0 || (!root_done && bad_cut <= 3)) +#endif +#endif + /* try to generate generic cuts with built-in generators + (as suggested by Prof. Fischetti et al. the built-in cuts are + not generated at each branching node; an intense attempt of + generating new cuts is only made at the root node, and then + a moderate effort is spent after each backtracking step) */ +#if 0 /* 27/II-2016 by Chris */ + if (T->curr->level == 0 || pred_p == 0) +#else + if (!root_done || pred_p == 0) +#endif + { xassert(T->reason == 0); + T->reason = GLP_ICUTGEN; + generate_cuts(T); + T->reason = 0; + } + /* if the local cut pool is not empty, select useful cuts and add + them to the current subproblem */ +#ifdef NEW_LOCAL /* 02/II-2018 */ + if (T->local->m > 0) +#else + if (T->local->size > 0) +#endif + { xassert(T->reason == 0); + T->reason = GLP_ICUTGEN; + ios_process_cuts(T); + T->reason = 0; + } + /* clear the local cut pool */ + ios_clear_pool(T, T->local); + /* perform re-optimization, if necessary */ + if (T->reopt) + { T->reopt = 0; + T->curr->changed++; + goto more; + } + /* no cuts were generated; remove inactive cuts */ + remove_cuts(T); +#if 0 /* 27/II-2016 by Chris */ + if (T->parm->msg_lev >= GLP_MSG_ALL && T->curr->level == 0) +#else + if (T->parm->msg_lev >= GLP_MSG_ALL && !root_done) +#endif + display_cut_info(T); +#if 1 /* 27/II-2016 by Chris */ + /* the first node will not be treated as root any more */ + if (!root_done) root_done = 1; +#endif + /* update history information used on pseudocost branching */ + if (T->pcost != NULL) ios_pcost_update(T); + /* it's time to perform branching */ + xassert(T->br_var == 0); + xassert(T->br_sel == 0); + /* let the application program choose variable to branch on */ + if (T->parm->cb_func != NULL) + { xassert(T->reason == 0); + xassert(T->br_var == 0); + xassert(T->br_sel == 0); + T->reason = GLP_IBRANCH; + T->parm->cb_func(T, T->parm->cb_info); + T->reason = 0; + if (T->stop) + { ret = GLP_ESTOP; + goto done; + } + } + /* if nothing has been chosen, choose some variable as specified + by the branching technique option */ + if (T->br_var == 0) + T->br_var = ios_choose_var(T, &T->br_sel); + /* perform actual branching */ + curr_p = T->curr->p; + ret = branch_on(T, T->br_var, T->br_sel); + T->br_var = T->br_sel = 0; + if (ret == 0) + { /* both branches have been created */ + pred_p = curr_p; + goto loop; + } + else if (ret == 1) + { /* one branch is hopeless and has been pruned, so now the + current subproblem is other branch */ + /* the current subproblem should be considered as a new one, + since one bound of the branching variable was changed */ + T->curr->solved = T->curr->changed = 0; +#if 1 /* 18/VII-2013 */ + /* bad_cut = 0; */ +#endif + goto more; + } + else if (ret == 2) + { /* both branches are hopeless and have been pruned; new + subproblem selection is needed to continue the search */ + goto fath; + } + else + xassert(ret != ret); +fath: /* the current subproblem has been fathomed */ + if (T->parm->msg_lev >= GLP_MSG_DBG) + xprintf("Node %d fathomed\n", p); + /* freeze the current subproblem */ + ios_freeze_node(T); + /* and prune the corresponding branch of the tree */ + ios_delete_node(T, p); + /* if a new integer feasible solution has just been found, other + branches may become hopeless and therefore must be pruned */ + if (T->mip->mip_stat == GLP_FEAS) cleanup_the_tree(T); + /* new subproblem selection is needed due to backtracking */ + pred_p = 0; + goto loop; +done: /* display progress of the search on exit from the solver */ + if (T->parm->msg_lev >= GLP_MSG_ON) + show_progress(T, 0); + if (T->mir_gen != NULL) +#if 0 /* 06/III-2016 */ + ios_mir_term(T->mir_gen), T->mir_gen = NULL; +#else + glp_mir_free(T->mir_gen), T->mir_gen = NULL; +#endif +#ifdef NEW_COVER /* 13/II-2018 */ + if (T->cov_gen != NULL) + glp_cov_free(T->cov_gen), T->cov_gen = NULL; +#endif + if (T->clq_gen != NULL) +#if 0 /* 08/III-2016 */ + ios_clq_term(T->clq_gen), T->clq_gen = NULL; +#else + glp_cfg_free(T->clq_gen), T->clq_gen = NULL; +#endif + /* return to the calling program */ + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios07.c b/test/monniaux/glpk-4.65/src/draft/glpios07.c new file mode 100644 index 00000000..f750e571 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios07.c @@ -0,0 +1,551 @@ +/* glpios07.c (mixed cover cut generator) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" + +/*---------------------------------------------------------------------- +-- COVER INEQUALITIES +-- +-- Consider the set of feasible solutions to 0-1 knapsack problem: +-- +-- sum a[j]*x[j] <= b, (1) +-- j in J +-- +-- x[j] is binary, (2) +-- +-- where, wlog, we assume that a[j] > 0 (since 0-1 variables can be +-- complemented) and a[j] <= b (since a[j] > b implies x[j] = 0). +-- +-- A set C within J is called a cover if +-- +-- sum a[j] > b. (3) +-- j in C +-- +-- For any cover C the inequality +-- +-- sum x[j] <= |C| - 1 (4) +-- j in C +-- +-- is called a cover inequality and is valid for (1)-(2). +-- +-- MIXED COVER INEQUALITIES +-- +-- Consider the set of feasible solutions to mixed knapsack problem: +-- +-- sum a[j]*x[j] + y <= b, (5) +-- j in J +-- +-- x[j] is binary, (6) +-- +-- 0 <= y <= u is continuous, (7) +-- +-- where again we assume that a[j] > 0. +-- +-- Let C within J be some set. From (1)-(4) it follows that +-- +-- sum a[j] > b - y (8) +-- j in C +-- +-- implies +-- +-- sum x[j] <= |C| - 1. (9) +-- j in C +-- +-- Thus, we need to modify the inequality (9) in such a way that it be +-- a constraint only if the condition (8) is satisfied. +-- +-- Consider the following inequality: +-- +-- sum x[j] <= |C| - t. (10) +-- j in C +-- +-- If 0 < t <= 1, then (10) is equivalent to (9), because all x[j] are +-- binary variables. On the other hand, if t <= 0, (10) being satisfied +-- for any values of x[j] is not a constraint. +-- +-- Let +-- +-- t' = sum a[j] + y - b. (11) +-- j in C +-- +-- It is understood that the condition t' > 0 is equivalent to (8). +-- Besides, from (6)-(7) it follows that t' has an implied upper bound: +-- +-- t'max = sum a[j] + u - b. (12) +-- j in C +-- +-- This allows to express the parameter t having desired properties: +-- +-- t = t' / t'max. (13) +-- +-- In fact, t <= 1 by definition, and t > 0 being equivalent to t' > 0 +-- is equivalent to (8). +-- +-- Thus, the inequality (10), where t is given by formula (13) is valid +-- for (5)-(7). +-- +-- Note that if u = 0, then y = 0, so t = 1, and the conditions (8) and +-- (10) is transformed to the conditions (3) and (4). +-- +-- GENERATING MIXED COVER CUTS +-- +-- To generate a mixed cover cut in the form (10) we need to find such +-- set C which satisfies to the inequality (8) and for which, in turn, +-- the inequality (10) is violated in the current point. +-- +-- Substituting t from (13) to (10) gives: +-- +-- 1 +-- sum x[j] <= |C| - ----- (sum a[j] + y - b), (14) +-- j in C t'max j in C +-- +-- and finally we have the cut inequality in the standard form: +-- +-- sum x[j] + alfa * y <= beta, (15) +-- j in C +-- +-- where: +-- +-- alfa = 1 / t'max, (16) +-- +-- beta = |C| - alfa * (sum a[j] - b). (17) +-- j in C */ + +#if 1 +#define MAXTRY 1000 +#else +#define MAXTRY 10000 +#endif + +static int cover2(int n, double a[], double b, double u, double x[], + double y, int cov[], double *_alfa, double *_beta) +{ /* try to generate mixed cover cut using two-element cover */ + int i, j, try = 0, ret = 0; + double eps, alfa, beta, temp, rmax = 0.001; + eps = 0.001 * (1.0 + fabs(b)); + for (i = 0+1; i <= n; i++) + for (j = i+1; j <= n; j++) + { /* C = {i, j} */ + try++; + if (try > MAXTRY) goto done; + /* check if condition (8) is satisfied */ + if (a[i] + a[j] + y > b + eps) + { /* compute parameters for inequality (15) */ + temp = a[i] + a[j] - b; + alfa = 1.0 / (temp + u); + beta = 2.0 - alfa * temp; + /* compute violation of inequality (15) */ + temp = x[i] + x[j] + alfa * y - beta; + /* choose C providing maximum violation */ + if (rmax < temp) + { rmax = temp; + cov[1] = i; + cov[2] = j; + *_alfa = alfa; + *_beta = beta; + ret = 1; + } + } + } +done: return ret; +} + +static int cover3(int n, double a[], double b, double u, double x[], + double y, int cov[], double *_alfa, double *_beta) +{ /* try to generate mixed cover cut using three-element cover */ + int i, j, k, try = 0, ret = 0; + double eps, alfa, beta, temp, rmax = 0.001; + eps = 0.001 * (1.0 + fabs(b)); + for (i = 0+1; i <= n; i++) + for (j = i+1; j <= n; j++) + for (k = j+1; k <= n; k++) + { /* C = {i, j, k} */ + try++; + if (try > MAXTRY) goto done; + /* check if condition (8) is satisfied */ + if (a[i] + a[j] + a[k] + y > b + eps) + { /* compute parameters for inequality (15) */ + temp = a[i] + a[j] + a[k] - b; + alfa = 1.0 / (temp + u); + beta = 3.0 - alfa * temp; + /* compute violation of inequality (15) */ + temp = x[i] + x[j] + x[k] + alfa * y - beta; + /* choose C providing maximum violation */ + if (rmax < temp) + { rmax = temp; + cov[1] = i; + cov[2] = j; + cov[3] = k; + *_alfa = alfa; + *_beta = beta; + ret = 1; + } + } + } +done: return ret; +} + +static int cover4(int n, double a[], double b, double u, double x[], + double y, int cov[], double *_alfa, double *_beta) +{ /* try to generate mixed cover cut using four-element cover */ + int i, j, k, l, try = 0, ret = 0; + double eps, alfa, beta, temp, rmax = 0.001; + eps = 0.001 * (1.0 + fabs(b)); + for (i = 0+1; i <= n; i++) + for (j = i+1; j <= n; j++) + for (k = j+1; k <= n; k++) + for (l = k+1; l <= n; l++) + { /* C = {i, j, k, l} */ + try++; + if (try > MAXTRY) goto done; + /* check if condition (8) is satisfied */ + if (a[i] + a[j] + a[k] + a[l] + y > b + eps) + { /* compute parameters for inequality (15) */ + temp = a[i] + a[j] + a[k] + a[l] - b; + alfa = 1.0 / (temp + u); + beta = 4.0 - alfa * temp; + /* compute violation of inequality (15) */ + temp = x[i] + x[j] + x[k] + x[l] + alfa * y - beta; + /* choose C providing maximum violation */ + if (rmax < temp) + { rmax = temp; + cov[1] = i; + cov[2] = j; + cov[3] = k; + cov[4] = l; + *_alfa = alfa; + *_beta = beta; + ret = 1; + } + } + } +done: return ret; +} + +static int cover(int n, double a[], double b, double u, double x[], + double y, int cov[], double *alfa, double *beta) +{ /* try to generate mixed cover cut; + input (see (5)): + n is the number of binary variables; + a[1:n] are coefficients at binary variables; + b is the right-hand side; + u is upper bound of continuous variable; + x[1:n] are values of binary variables at current point; + y is value of continuous variable at current point; + output (see (15), (16), (17)): + cov[1:r] are indices of binary variables included in cover C, + where r is the set cardinality returned on exit; + alfa coefficient at continuous variable; + beta is the right-hand side; */ + int j; + /* perform some sanity checks */ + xassert(n >= 2); + for (j = 1; j <= n; j++) xassert(a[j] > 0.0); +#if 1 /* ??? */ + xassert(b > -1e-5); +#else + xassert(b > 0.0); +#endif + xassert(u >= 0.0); + for (j = 1; j <= n; j++) xassert(0.0 <= x[j] && x[j] <= 1.0); + xassert(0.0 <= y && y <= u); + /* try to generate mixed cover cut */ + if (cover2(n, a, b, u, x, y, cov, alfa, beta)) return 2; + if (cover3(n, a, b, u, x, y, cov, alfa, beta)) return 3; + if (cover4(n, a, b, u, x, y, cov, alfa, beta)) return 4; + return 0; +} + +/*---------------------------------------------------------------------- +-- lpx_cover_cut - generate mixed cover cut. +-- +-- SYNOPSIS +-- +-- int lpx_cover_cut(LPX *lp, int len, int ind[], double val[], +-- double work[]); +-- +-- DESCRIPTION +-- +-- The routine lpx_cover_cut generates a mixed cover cut for a given +-- row of the MIP problem. +-- +-- The given row of the MIP problem should be explicitly specified in +-- the form: +-- +-- sum{j in J} a[j]*x[j] <= b. (1) +-- +-- On entry indices (ordinal numbers) of structural variables, which +-- have non-zero constraint coefficients, should be placed in locations +-- ind[1], ..., ind[len], and corresponding constraint coefficients +-- should be placed in locations val[1], ..., val[len]. The right-hand +-- side b should be stored in location val[0]. +-- +-- The working array work should have at least nb locations, where nb +-- is the number of binary variables in (1). +-- +-- The routine generates a mixed cover cut in the same form as (1) and +-- stores the cut coefficients and right-hand side in the same way as +-- just described above. +-- +-- RETURNS +-- +-- If the cutting plane has been successfully generated, the routine +-- returns 1 <= len' <= n, which is the number of non-zero coefficients +-- in the inequality constraint. Otherwise, the routine returns zero. */ + +static int lpx_cover_cut(glp_prob *lp, int len, int ind[], + double val[], double work[]) +{ int cov[1+4], j, k, nb, newlen, r; + double f_min, f_max, alfa, beta, u, *x = work, y; + /* substitute and remove fixed variables */ + newlen = 0; + for (k = 1; k <= len; k++) + { j = ind[k]; + if (glp_get_col_type(lp, j) == GLP_FX) + val[0] -= val[k] * glp_get_col_lb(lp, j); + else + { newlen++; + ind[newlen] = ind[k]; + val[newlen] = val[k]; + } + } + len = newlen; + /* move binary variables to the beginning of the list so that + elements 1, 2, ..., nb correspond to binary variables, and + elements nb+1, nb+2, ..., len correspond to rest variables */ + nb = 0; + for (k = 1; k <= len; k++) + { j = ind[k]; + if (glp_get_col_kind(lp, j) == GLP_BV) + { /* binary variable */ + int ind_k; + double val_k; + nb++; + ind_k = ind[nb], val_k = val[nb]; + ind[nb] = ind[k], val[nb] = val[k]; + ind[k] = ind_k, val[k] = val_k; + } + } + /* now the specified row has the form: + sum a[j]*x[j] + sum a[j]*y[j] <= b, + where x[j] are binary variables, y[j] are rest variables */ + /* at least two binary variables are needed */ + if (nb < 2) return 0; + /* compute implied lower and upper bounds for sum a[j]*y[j] */ + f_min = f_max = 0.0; + for (k = nb+1; k <= len; k++) + { j = ind[k]; + /* both bounds must be finite */ + if (glp_get_col_type(lp, j) != GLP_DB) return 0; + if (val[k] > 0.0) + { f_min += val[k] * glp_get_col_lb(lp, j); + f_max += val[k] * glp_get_col_ub(lp, j); + } + else + { f_min += val[k] * glp_get_col_ub(lp, j); + f_max += val[k] * glp_get_col_lb(lp, j); + } + } + /* sum a[j]*x[j] + sum a[j]*y[j] <= b ===> + sum a[j]*x[j] + (sum a[j]*y[j] - f_min) <= b - f_min ===> + sum a[j]*x[j] + y <= b - f_min, + where y = sum a[j]*y[j] - f_min; + note that 0 <= y <= u, u = f_max - f_min */ + /* determine upper bound of y */ + u = f_max - f_min; + /* determine value of y at the current point */ + y = 0.0; + for (k = nb+1; k <= len; k++) + { j = ind[k]; + y += val[k] * glp_get_col_prim(lp, j); + } + y -= f_min; + if (y < 0.0) y = 0.0; + if (y > u) y = u; + /* modify the right-hand side b */ + val[0] -= f_min; + /* now the transformed row has the form: + sum a[j]*x[j] + y <= b, where 0 <= y <= u */ + /* determine values of x[j] at the current point */ + for (k = 1; k <= nb; k++) + { j = ind[k]; + x[k] = glp_get_col_prim(lp, j); + if (x[k] < 0.0) x[k] = 0.0; + if (x[k] > 1.0) x[k] = 1.0; + } + /* if a[j] < 0, replace x[j] by its complement 1 - x'[j] */ + for (k = 1; k <= nb; k++) + { if (val[k] < 0.0) + { ind[k] = - ind[k]; + val[k] = - val[k]; + val[0] += val[k]; + x[k] = 1.0 - x[k]; + } + } + /* try to generate a mixed cover cut for the transformed row */ + r = cover(nb, val, val[0], u, x, y, cov, &alfa, &beta); + if (r == 0) return 0; + xassert(2 <= r && r <= 4); + /* now the cut is in the form: + sum{j in C} x[j] + alfa * y <= beta */ + /* store the right-hand side beta */ + ind[0] = 0, val[0] = beta; + /* restore the original ordinal numbers of x[j] */ + for (j = 1; j <= r; j++) cov[j] = ind[cov[j]]; + /* store cut coefficients at binary variables complementing back + the variables having negative row coefficients */ + xassert(r <= nb); + for (k = 1; k <= r; k++) + { if (cov[k] > 0) + { ind[k] = +cov[k]; + val[k] = +1.0; + } + else + { ind[k] = -cov[k]; + val[k] = -1.0; + val[0] -= 1.0; + } + } + /* substitute y = sum a[j]*y[j] - f_min */ + for (k = nb+1; k <= len; k++) + { r++; + ind[r] = ind[k]; + val[r] = alfa * val[k]; + } + val[0] += alfa * f_min; + xassert(r <= len); + len = r; + return len; +} + +/*---------------------------------------------------------------------- +-- lpx_eval_row - compute explictily specified row. +-- +-- SYNOPSIS +-- +-- double lpx_eval_row(LPX *lp, int len, int ind[], double val[]); +-- +-- DESCRIPTION +-- +-- The routine lpx_eval_row computes the primal value of an explicitly +-- specified row using current values of structural variables. +-- +-- The explicitly specified row may be thought as a linear form: +-- +-- y = a[1]*x[m+1] + a[2]*x[m+2] + ... + a[n]*x[m+n], +-- +-- where y is an auxiliary variable for this row, a[j] are coefficients +-- of the linear form, x[m+j] are structural variables. +-- +-- On entry column indices and numerical values of non-zero elements of +-- the row should be stored in locations ind[1], ..., ind[len] and +-- val[1], ..., val[len], where len is the number of non-zero elements. +-- The array ind and val are not changed on exit. +-- +-- RETURNS +-- +-- The routine returns a computed value of y, the auxiliary variable of +-- the specified row. */ + +static double lpx_eval_row(glp_prob *lp, int len, int ind[], + double val[]) +{ int n = glp_get_num_cols(lp); + int j, k; + double sum = 0.0; + if (len < 0) + xerror("lpx_eval_row: len = %d; invalid row length\n", len); + for (k = 1; k <= len; k++) + { j = ind[k]; + if (!(1 <= j && j <= n)) + xerror("lpx_eval_row: j = %d; column number out of range\n", + j); + sum += val[k] * glp_get_col_prim(lp, j); + } + return sum; +} + +/*********************************************************************** +* NAME +* +* ios_cov_gen - generate mixed cover cuts +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_cov_gen(glp_tree *tree); +* +* DESCRIPTION +* +* The routine ios_cov_gen generates mixed cover cuts for the current +* point and adds them to the cut pool. */ + +void ios_cov_gen(glp_tree *tree) +{ glp_prob *prob = tree->mip; + int m = glp_get_num_rows(prob); + int n = glp_get_num_cols(prob); + int i, k, type, kase, len, *ind; + double r, *val, *work; + xassert(glp_get_status(prob) == GLP_OPT); + /* allocate working arrays */ + ind = xcalloc(1+n, sizeof(int)); + val = xcalloc(1+n, sizeof(double)); + work = xcalloc(1+n, sizeof(double)); + /* look through all rows */ + for (i = 1; i <= m; i++) + for (kase = 1; kase <= 2; kase++) + { type = glp_get_row_type(prob, i); + if (kase == 1) + { /* consider rows of '<=' type */ + if (!(type == GLP_UP || type == GLP_DB)) continue; + len = glp_get_mat_row(prob, i, ind, val); + val[0] = glp_get_row_ub(prob, i); + } + else + { /* consider rows of '>=' type */ + if (!(type == GLP_LO || type == GLP_DB)) continue; + len = glp_get_mat_row(prob, i, ind, val); + for (k = 1; k <= len; k++) val[k] = - val[k]; + val[0] = - glp_get_row_lb(prob, i); + } + /* generate mixed cover cut: + sum{j in J} a[j] * x[j] <= b */ + len = lpx_cover_cut(prob, len, ind, val, work); + if (len == 0) continue; + /* at the current point the cut inequality is violated, i.e. + sum{j in J} a[j] * x[j] - b > 0 */ + r = lpx_eval_row(prob, len, ind, val) - val[0]; + if (r < 1e-3) continue; + /* add the cut to the cut pool */ + glp_ios_add_row(tree, NULL, GLP_RF_COV, 0, len, ind, val, + GLP_UP, val[0]); + } + /* free working arrays */ + xfree(ind); + xfree(val); + xfree(work); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios09.c b/test/monniaux/glpk-4.65/src/draft/glpios09.c new file mode 100644 index 00000000..d80ed9a3 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios09.c @@ -0,0 +1,664 @@ +/* glpios09.c (branching heuristics) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" + +/*********************************************************************** +* NAME +* +* ios_choose_var - select variable to branch on +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_choose_var(glp_tree *T, int *next); +* +* The routine ios_choose_var chooses a variable from the candidate +* list to branch on. Additionally the routine provides a flag stored +* in the location next to suggests which of the child subproblems +* should be solved next. +* +* RETURNS +* +* The routine ios_choose_var returns the ordinal number of the column +* choosen. */ + +static int branch_first(glp_tree *T, int *next); +static int branch_last(glp_tree *T, int *next); +static int branch_mostf(glp_tree *T, int *next); +static int branch_drtom(glp_tree *T, int *next); + +int ios_choose_var(glp_tree *T, int *next) +{ int j; + if (T->parm->br_tech == GLP_BR_FFV) + { /* branch on first fractional variable */ + j = branch_first(T, next); + } + else if (T->parm->br_tech == GLP_BR_LFV) + { /* branch on last fractional variable */ + j = branch_last(T, next); + } + else if (T->parm->br_tech == GLP_BR_MFV) + { /* branch on most fractional variable */ + j = branch_mostf(T, next); + } + else if (T->parm->br_tech == GLP_BR_DTH) + { /* branch using the heuristic by Dreebeck and Tomlin */ + j = branch_drtom(T, next); + } + else if (T->parm->br_tech == GLP_BR_PCH) + { /* hybrid pseudocost heuristic */ + j = ios_pcost_branch(T, next); + } + else + xassert(T != T); + return j; +} + +/*********************************************************************** +* branch_first - choose first branching variable +* +* This routine looks up the list of structural variables and chooses +* the first one, which is of integer kind and has fractional value in +* optimal solution to the current LP relaxation. +* +* This routine also selects the branch to be solved next where integer +* infeasibility of the chosen variable is less than in other one. */ + +static int branch_first(glp_tree *T, int *_next) +{ int j, next; + double beta; + /* choose the column to branch on */ + for (j = 1; j <= T->n; j++) + if (T->non_int[j]) break; + xassert(1 <= j && j <= T->n); + /* select the branch to be solved next */ + beta = glp_get_col_prim(T->mip, j); + if (beta - floor(beta) < ceil(beta) - beta) + next = GLP_DN_BRNCH; + else + next = GLP_UP_BRNCH; + *_next = next; + return j; +} + +/*********************************************************************** +* branch_last - choose last branching variable +* +* This routine looks up the list of structural variables and chooses +* the last one, which is of integer kind and has fractional value in +* optimal solution to the current LP relaxation. +* +* This routine also selects the branch to be solved next where integer +* infeasibility of the chosen variable is less than in other one. */ + +static int branch_last(glp_tree *T, int *_next) +{ int j, next; + double beta; + /* choose the column to branch on */ + for (j = T->n; j >= 1; j--) + if (T->non_int[j]) break; + xassert(1 <= j && j <= T->n); + /* select the branch to be solved next */ + beta = glp_get_col_prim(T->mip, j); + if (beta - floor(beta) < ceil(beta) - beta) + next = GLP_DN_BRNCH; + else + next = GLP_UP_BRNCH; + *_next = next; + return j; +} + +/*********************************************************************** +* branch_mostf - choose most fractional branching variable +* +* This routine looks up the list of structural variables and chooses +* that one, which is of integer kind and has most fractional value in +* optimal solution to the current LP relaxation. +* +* This routine also selects the branch to be solved next where integer +* infeasibility of the chosen variable is less than in other one. +* +* (Alexander Martin notices that "...most infeasible is as good as +* random...".) */ + +static int branch_mostf(glp_tree *T, int *_next) +{ int j, jj, next; + double beta, most, temp; + /* choose the column to branch on */ + jj = 0, most = DBL_MAX; + for (j = 1; j <= T->n; j++) + { if (T->non_int[j]) + { beta = glp_get_col_prim(T->mip, j); + temp = floor(beta) + 0.5; + if (most > fabs(beta - temp)) + { jj = j, most = fabs(beta - temp); + if (beta < temp) + next = GLP_DN_BRNCH; + else + next = GLP_UP_BRNCH; + } + } + } + *_next = next; + return jj; +} + +/*********************************************************************** +* branch_drtom - choose branching var using Driebeck-Tomlin heuristic +* +* This routine chooses a structural variable, which is required to be +* integral and has fractional value in optimal solution of the current +* LP relaxation, using a heuristic proposed by Driebeck and Tomlin. +* +* The routine also selects the branch to be solved next, again due to +* Driebeck and Tomlin. +* +* This routine is based on the heuristic proposed in: +* +* Driebeck N.J. An algorithm for the solution of mixed-integer +* programming problems, Management Science, 12: 576-87 (1966); +* +* and improved in: +* +* Tomlin J.A. Branch and bound methods for integer and non-convex +* programming, in J.Abadie (ed.), Integer and Nonlinear Programming, +* North-Holland, Amsterdam, pp. 437-50 (1970). +* +* Must note that this heuristic is time-expensive, because computing +* one-step degradation (see the routine below) requires one BTRAN for +* each fractional-valued structural variable. */ + +static int branch_drtom(glp_tree *T, int *_next) +{ glp_prob *mip = T->mip; + int m = mip->m; + int n = mip->n; + unsigned char *non_int = T->non_int; + int j, jj, k, t, next, kase, len, stat, *ind; + double x, dk, alfa, delta_j, delta_k, delta_z, dz_dn, dz_up, + dd_dn, dd_up, degrad, *val; + /* basic solution of LP relaxation must be optimal */ + xassert(glp_get_status(mip) == GLP_OPT); + /* allocate working arrays */ + ind = xcalloc(1+n, sizeof(int)); + val = xcalloc(1+n, sizeof(double)); + /* nothing has been chosen so far */ + jj = 0, degrad = -1.0; + /* walk through the list of columns (structural variables) */ + for (j = 1; j <= n; j++) + { /* if j-th column is not marked as fractional, skip it */ + if (!non_int[j]) continue; + /* obtain (fractional) value of j-th column in basic solution + of LP relaxation */ + x = glp_get_col_prim(mip, j); + /* since the value of j-th column is fractional, the column is + basic; compute corresponding row of the simplex table */ + len = glp_eval_tab_row(mip, m+j, ind, val); + /* the following fragment computes a change in the objective + function: delta Z = new Z - old Z, where old Z is the + objective value in the current optimal basis, and new Z is + the objective value in the adjacent basis, for two cases: + 1) if new upper bound ub' = floor(x[j]) is introduced for + j-th column (down branch); + 2) if new lower bound lb' = ceil(x[j]) is introduced for + j-th column (up branch); + since in both cases the solution remaining dual feasible + becomes primal infeasible, one implicit simplex iteration + is performed to determine the change delta Z; + it is obvious that new Z, which is never better than old Z, + is a lower (minimization) or upper (maximization) bound of + the objective function for down- and up-branches. */ + for (kase = -1; kase <= +1; kase += 2) + { /* if kase < 0, the new upper bound of x[j] is introduced; + in this case x[j] should decrease in order to leave the + basis and go to its new upper bound */ + /* if kase > 0, the new lower bound of x[j] is introduced; + in this case x[j] should increase in order to leave the + basis and go to its new lower bound */ + /* apply the dual ratio test in order to determine which + auxiliary or structural variable should enter the basis + to keep dual feasibility */ + k = glp_dual_rtest(mip, len, ind, val, kase, 1e-9); + if (k != 0) k = ind[k]; + /* if no non-basic variable has been chosen, LP relaxation + of corresponding branch being primal infeasible and dual + unbounded has no primal feasible solution; in this case + the change delta Z is formally set to infinity */ + if (k == 0) + { delta_z = + (T->mip->dir == GLP_MIN ? +DBL_MAX : -DBL_MAX); + goto skip; + } + /* row of the simplex table that corresponds to non-basic + variable x[k] choosen by the dual ratio test is: + x[j] = ... + alfa * x[k] + ... + where alfa is the influence coefficient (an element of + the simplex table row) */ + /* determine the coefficient alfa */ + for (t = 1; t <= len; t++) if (ind[t] == k) break; + xassert(1 <= t && t <= len); + alfa = val[t]; + /* since in the adjacent basis the variable x[j] becomes + non-basic, knowing its value in the current basis we can + determine its change delta x[j] = new x[j] - old x[j] */ + delta_j = (kase < 0 ? floor(x) : ceil(x)) - x; + /* and knowing the coefficient alfa we can determine the + corresponding change delta x[k] = new x[k] - old x[k], + where old x[k] is a value of x[k] in the current basis, + and new x[k] is a value of x[k] in the adjacent basis */ + delta_k = delta_j / alfa; + /* Tomlin noticed that if the variable x[k] is of integer + kind, its change cannot be less (eventually) than one in + the magnitude */ + if (k > m && glp_get_col_kind(mip, k-m) != GLP_CV) + { /* x[k] is structural integer variable */ + if (fabs(delta_k - floor(delta_k + 0.5)) > 1e-3) + { if (delta_k > 0.0) + delta_k = ceil(delta_k); /* +3.14 -> +4 */ + else + delta_k = floor(delta_k); /* -3.14 -> -4 */ + } + } + /* now determine the status and reduced cost of x[k] in the + current basis */ + if (k <= m) + { stat = glp_get_row_stat(mip, k); + dk = glp_get_row_dual(mip, k); + } + else + { stat = glp_get_col_stat(mip, k-m); + dk = glp_get_col_dual(mip, k-m); + } + /* if the current basis is dual degenerate, some reduced + costs which are close to zero may have wrong sign due to + round-off errors, so correct the sign of d[k] */ + switch (T->mip->dir) + { case GLP_MIN: + if (stat == GLP_NL && dk < 0.0 || + stat == GLP_NU && dk > 0.0 || + stat == GLP_NF) dk = 0.0; + break; + case GLP_MAX: + if (stat == GLP_NL && dk > 0.0 || + stat == GLP_NU && dk < 0.0 || + stat == GLP_NF) dk = 0.0; + break; + default: + xassert(T != T); + } + /* now knowing the change of x[k] and its reduced cost d[k] + we can compute the corresponding change in the objective + function delta Z = new Z - old Z = d[k] * delta x[k]; + note that due to Tomlin's modification new Z can be even + worse than in the adjacent basis */ + delta_z = dk * delta_k; +skip: /* new Z is never better than old Z, therefore the change + delta Z is always non-negative (in case of minimization) + or non-positive (in case of maximization) */ + switch (T->mip->dir) + { case GLP_MIN: xassert(delta_z >= 0.0); break; + case GLP_MAX: xassert(delta_z <= 0.0); break; + default: xassert(T != T); + } + /* save the change in the objective fnction for down- and + up-branches, respectively */ + if (kase < 0) dz_dn = delta_z; else dz_up = delta_z; + } + /* thus, in down-branch no integer feasible solution can be + better than Z + dz_dn, and in up-branch no integer feasible + solution can be better than Z + dz_up, where Z is value of + the objective function in the current basis */ + /* following the heuristic by Driebeck and Tomlin we choose a + column (i.e. structural variable) which provides largest + degradation of the objective function in some of branches; + besides, we select the branch with smaller degradation to + be solved next and keep other branch with larger degradation + in the active list hoping to minimize the number of further + backtrackings */ + if (degrad < fabs(dz_dn) || degrad < fabs(dz_up)) + { jj = j; + if (fabs(dz_dn) < fabs(dz_up)) + { /* select down branch to be solved next */ + next = GLP_DN_BRNCH; + degrad = fabs(dz_up); + } + else + { /* select up branch to be solved next */ + next = GLP_UP_BRNCH; + degrad = fabs(dz_dn); + } + /* save the objective changes for printing */ + dd_dn = dz_dn, dd_up = dz_up; + /* if down- or up-branch has no feasible solution, we does + not need to consider other candidates (in principle, the + corresponding branch could be pruned right now) */ + if (degrad == DBL_MAX) break; + } + } + /* free working arrays */ + xfree(ind); + xfree(val); + /* something must be chosen */ + xassert(1 <= jj && jj <= n); +#if 1 /* 02/XI-2009 */ + if (degrad < 1e-6 * (1.0 + 0.001 * fabs(mip->obj_val))) + { jj = branch_mostf(T, &next); + goto done; + } +#endif + if (T->parm->msg_lev >= GLP_MSG_DBG) + { xprintf("branch_drtom: column %d chosen to branch on\n", jj); + if (fabs(dd_dn) == DBL_MAX) + xprintf("branch_drtom: down-branch is infeasible\n"); + else + xprintf("branch_drtom: down-branch bound is %.9e\n", + glp_get_obj_val(mip) + dd_dn); + if (fabs(dd_up) == DBL_MAX) + xprintf("branch_drtom: up-branch is infeasible\n"); + else + xprintf("branch_drtom: up-branch bound is %.9e\n", + glp_get_obj_val(mip) + dd_up); + } +done: *_next = next; + return jj; +} + +/**********************************************************************/ + +struct csa +{ /* common storage area */ + int *dn_cnt; /* int dn_cnt[1+n]; */ + /* dn_cnt[j] is the number of subproblems, whose LP relaxations + have been solved and which are down-branches for variable x[j]; + dn_cnt[j] = 0 means the down pseudocost is uninitialized */ + double *dn_sum; /* double dn_sum[1+n]; */ + /* dn_sum[j] is the sum of per unit degradations of the objective + over all dn_cnt[j] subproblems */ + int *up_cnt; /* int up_cnt[1+n]; */ + /* up_cnt[j] is the number of subproblems, whose LP relaxations + have been solved and which are up-branches for variable x[j]; + up_cnt[j] = 0 means the up pseudocost is uninitialized */ + double *up_sum; /* double up_sum[1+n]; */ + /* up_sum[j] is the sum of per unit degradations of the objective + over all up_cnt[j] subproblems */ +}; + +void *ios_pcost_init(glp_tree *tree) +{ /* initialize working data used on pseudocost branching */ + struct csa *csa; + int n = tree->n, j; + csa = xmalloc(sizeof(struct csa)); + csa->dn_cnt = xcalloc(1+n, sizeof(int)); + csa->dn_sum = xcalloc(1+n, sizeof(double)); + csa->up_cnt = xcalloc(1+n, sizeof(int)); + csa->up_sum = xcalloc(1+n, sizeof(double)); + for (j = 1; j <= n; j++) + { csa->dn_cnt[j] = csa->up_cnt[j] = 0; + csa->dn_sum[j] = csa->up_sum[j] = 0.0; + } + return csa; +} + +static double eval_degrad(glp_prob *P, int j, double bnd) +{ /* compute degradation of the objective on fixing x[j] at given + value with a limited number of dual simplex iterations */ + /* this routine fixes column x[j] at specified value bnd, + solves resulting LP, and returns a lower bound to degradation + of the objective, degrad >= 0 */ + glp_prob *lp; + glp_smcp parm; + int ret; + double degrad; + /* the current basis must be optimal */ + xassert(glp_get_status(P) == GLP_OPT); + /* create a copy of P */ + lp = glp_create_prob(); + glp_copy_prob(lp, P, 0); + /* fix column x[j] at specified value */ + glp_set_col_bnds(lp, j, GLP_FX, bnd, bnd); + /* try to solve resulting LP */ + glp_init_smcp(&parm); + parm.msg_lev = GLP_MSG_OFF; + parm.meth = GLP_DUAL; + parm.it_lim = 30; + parm.out_dly = 1000; + parm.meth = GLP_DUAL; + ret = glp_simplex(lp, &parm); + if (ret == 0 || ret == GLP_EITLIM) + { if (glp_get_prim_stat(lp) == GLP_NOFEAS) + { /* resulting LP has no primal feasible solution */ + degrad = DBL_MAX; + } + else if (glp_get_dual_stat(lp) == GLP_FEAS) + { /* resulting basis is optimal or at least dual feasible, + so we have the correct lower bound to degradation */ + if (P->dir == GLP_MIN) + degrad = lp->obj_val - P->obj_val; + else if (P->dir == GLP_MAX) + degrad = P->obj_val - lp->obj_val; + else + xassert(P != P); + /* degradation cannot be negative by definition */ + /* note that the lower bound to degradation may be close + to zero even if its exact value is zero due to round-off + errors on computing the objective value */ + if (degrad < 1e-6 * (1.0 + 0.001 * fabs(P->obj_val))) + degrad = 0.0; + } + else + { /* the final basis reported by the simplex solver is dual + infeasible, so we cannot determine a non-trivial lower + bound to degradation */ + degrad = 0.0; + } + } + else + { /* the simplex solver failed */ + degrad = 0.0; + } + /* delete the copy of P */ + glp_delete_prob(lp); + return degrad; +} + +void ios_pcost_update(glp_tree *tree) +{ /* update history information for pseudocost branching */ + /* this routine is called every time when LP relaxation of the + current subproblem has been solved to optimality with all lazy + and cutting plane constraints included */ + int j; + double dx, dz, psi; + struct csa *csa = tree->pcost; + xassert(csa != NULL); + xassert(tree->curr != NULL); + /* if the current subproblem is the root, skip updating */ + if (tree->curr->up == NULL) goto skip; + /* determine branching variable x[j], which was used in the + parent subproblem to create the current subproblem */ + j = tree->curr->up->br_var; + xassert(1 <= j && j <= tree->n); + /* determine the change dx[j] = new x[j] - old x[j], + where new x[j] is a value of x[j] in optimal solution to LP + relaxation of the current subproblem, old x[j] is a value of + x[j] in optimal solution to LP relaxation of the parent + subproblem */ + dx = tree->mip->col[j]->prim - tree->curr->up->br_val; + xassert(dx != 0.0); + /* determine corresponding change dz = new dz - old dz in the + objective function value */ + dz = tree->mip->obj_val - tree->curr->up->lp_obj; + /* determine per unit degradation of the objective function */ + psi = fabs(dz / dx); + /* update history information */ + if (dx < 0.0) + { /* the current subproblem is down-branch */ + csa->dn_cnt[j]++; + csa->dn_sum[j] += psi; + } + else /* dx > 0.0 */ + { /* the current subproblem is up-branch */ + csa->up_cnt[j]++; + csa->up_sum[j] += psi; + } +skip: return; +} + +void ios_pcost_free(glp_tree *tree) +{ /* free working area used on pseudocost branching */ + struct csa *csa = tree->pcost; + xassert(csa != NULL); + xfree(csa->dn_cnt); + xfree(csa->dn_sum); + xfree(csa->up_cnt); + xfree(csa->up_sum); + xfree(csa); + tree->pcost = NULL; + return; +} + +static double eval_psi(glp_tree *T, int j, int brnch) +{ /* compute estimation of pseudocost of variable x[j] for down- + or up-branch */ + struct csa *csa = T->pcost; + double beta, degrad, psi; + xassert(csa != NULL); + xassert(1 <= j && j <= T->n); + if (brnch == GLP_DN_BRNCH) + { /* down-branch */ + if (csa->dn_cnt[j] == 0) + { /* initialize down pseudocost */ + beta = T->mip->col[j]->prim; + degrad = eval_degrad(T->mip, j, floor(beta)); + if (degrad == DBL_MAX) + { psi = DBL_MAX; + goto done; + } + csa->dn_cnt[j] = 1; + csa->dn_sum[j] = degrad / (beta - floor(beta)); + } + psi = csa->dn_sum[j] / (double)csa->dn_cnt[j]; + } + else if (brnch == GLP_UP_BRNCH) + { /* up-branch */ + if (csa->up_cnt[j] == 0) + { /* initialize up pseudocost */ + beta = T->mip->col[j]->prim; + degrad = eval_degrad(T->mip, j, ceil(beta)); + if (degrad == DBL_MAX) + { psi = DBL_MAX; + goto done; + } + csa->up_cnt[j] = 1; + csa->up_sum[j] = degrad / (ceil(beta) - beta); + } + psi = csa->up_sum[j] / (double)csa->up_cnt[j]; + } + else + xassert(brnch != brnch); +done: return psi; +} + +static void progress(glp_tree *T) +{ /* display progress of pseudocost initialization */ + struct csa *csa = T->pcost; + int j, nv = 0, ni = 0; + for (j = 1; j <= T->n; j++) + { if (glp_ios_can_branch(T, j)) + { nv++; + if (csa->dn_cnt[j] > 0 && csa->up_cnt[j] > 0) ni++; + } + } + xprintf("Pseudocosts initialized for %d of %d variables\n", + ni, nv); + return; +} + +int ios_pcost_branch(glp_tree *T, int *_next) +{ /* choose branching variable with pseudocost branching */ +#if 0 /* 10/VI-2013 */ + glp_long t = xtime(); +#else + double t = xtime(); +#endif + int j, jjj, sel; + double beta, psi, d1, d2, d, dmax; + /* initialize the working arrays */ + if (T->pcost == NULL) + T->pcost = ios_pcost_init(T); + /* nothing has been chosen so far */ + jjj = 0, dmax = -1.0; + /* go through the list of branching candidates */ + for (j = 1; j <= T->n; j++) + { if (!glp_ios_can_branch(T, j)) continue; + /* determine primal value of x[j] in optimal solution to LP + relaxation of the current subproblem */ + beta = T->mip->col[j]->prim; + /* estimate pseudocost of x[j] for down-branch */ + psi = eval_psi(T, j, GLP_DN_BRNCH); + if (psi == DBL_MAX) + { /* down-branch has no primal feasible solution */ + jjj = j, sel = GLP_DN_BRNCH; + goto done; + } + /* estimate degradation of the objective for down-branch */ + d1 = psi * (beta - floor(beta)); + /* estimate pseudocost of x[j] for up-branch */ + psi = eval_psi(T, j, GLP_UP_BRNCH); + if (psi == DBL_MAX) + { /* up-branch has no primal feasible solution */ + jjj = j, sel = GLP_UP_BRNCH; + goto done; + } + /* estimate degradation of the objective for up-branch */ + d2 = psi * (ceil(beta) - beta); + /* determine d = max(d1, d2) */ + d = (d1 > d2 ? d1 : d2); + /* choose x[j] which provides maximal estimated degradation of + the objective either in down- or up-branch */ + if (dmax < d) + { dmax = d; + jjj = j; + /* continue the search from a subproblem, where degradation + is less than in other one */ + sel = (d1 <= d2 ? GLP_DN_BRNCH : GLP_UP_BRNCH); + } + /* display progress of pseudocost initialization */ + if (T->parm->msg_lev >= GLP_ON) + { if (xdifftime(xtime(), t) >= 10.0) + { progress(T); + t = xtime(); + } + } + } + if (dmax == 0.0) + { /* no degradation is indicated; choose a variable having most + fractional value */ + jjj = branch_mostf(T, &sel); + } +done: *_next = sel; + return jjj; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios11.c b/test/monniaux/glpk-4.65/src/draft/glpios11.c new file mode 100644 index 00000000..09fccef6 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios11.c @@ -0,0 +1,435 @@ +/* glpios11.c (process cuts stored in the local cut pool) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 2017, 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 "draft.h" +#include "env.h" +#include "ios.h" + +/*********************************************************************** +* NAME +* +* ios_process_cuts - process cuts stored in the local cut pool +* +* SYNOPSIS +* +* #include "glpios.h" +* void ios_process_cuts(glp_tree *T); +* +* DESCRIPTION +* +* The routine ios_process_cuts analyzes each cut currently stored in +* the local cut pool, which must be non-empty, and either adds the cut +* to the current subproblem or just discards it. All cuts are assumed +* to be locally valid. On exit the local cut pool remains unchanged. +* +* REFERENCES +* +* 1. E.Balas, S.Ceria, G.Cornuejols, "Mixed 0-1 Programming by +* Lift-and-Project in a Branch-and-Cut Framework", Management Sc., +* 42 (1996) 1229-1246. +* +* 2. G.Andreello, A.Caprara, and M.Fischetti, "Embedding Cuts in +* a Branch&Cut Framework: a Computational Study with {0,1/2}-Cuts", +* Preliminary Draft, October 28, 2003, pp.6-8. */ + +struct info +{ /* estimated cut efficiency */ + IOSCUT *cut; + /* pointer to cut in the cut pool */ + char flag; + /* if this flag is set, the cut is included into the current + subproblem */ + double eff; + /* cut efficacy (normalized residual) */ + double deg; + /* lower bound to objective degradation */ +}; + +static int CDECL fcmp(const void *arg1, const void *arg2) +{ const struct info *info1 = arg1, *info2 = arg2; + if (info1->deg == 0.0 && info2->deg == 0.0) + { if (info1->eff > info2->eff) return -1; + if (info1->eff < info2->eff) return +1; + } + else + { if (info1->deg > info2->deg) return -1; + if (info1->deg < info2->deg) return +1; + } + return 0; +} + +static double parallel(IOSCUT *a, IOSCUT *b, double work[]); + +#ifdef NEW_LOCAL /* 02/II-2018 */ +void ios_process_cuts(glp_tree *T) +{ IOSPOOL *pool; + IOSCUT *cut; + GLPAIJ *aij; + struct info *info; + int k, kk, max_cuts, len, ret, *ind; + double *val, *work, rhs; + /* the current subproblem must exist */ + xassert(T->curr != NULL); + /* the pool must exist and be non-empty */ + pool = T->local; + xassert(pool != NULL); + xassert(pool->m > 0); + /* allocate working arrays */ + info = xcalloc(1+pool->m, sizeof(struct info)); + ind = xcalloc(1+T->n, sizeof(int)); + val = xcalloc(1+T->n, sizeof(double)); + work = xcalloc(1+T->n, sizeof(double)); + for (k = 1; k <= T->n; k++) work[k] = 0.0; + /* build the list of cuts stored in the cut pool */ + for (k = 1; k <= pool->m; k++) + info[k].cut = pool->row[k], info[k].flag = 0; + /* estimate efficiency of all cuts in the cut pool */ + for (k = 1; k <= pool->m; k++) + { double temp, dy, dz; + cut = info[k].cut; + /* build the vector of cut coefficients and compute its + Euclidean norm */ + len = 0; temp = 0.0; + for (aij = cut->ptr; aij != NULL; aij = aij->r_next) + { xassert(1 <= aij->col->j && aij->col->j <= T->n); + len++, ind[len] = aij->col->j, val[len] = aij->val; + temp += aij->val * aij->val; + } + if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; + /* transform the cut to express it only through non-basic + (auxiliary and structural) variables */ + len = glp_transform_row(T->mip, len, ind, val); + /* determine change in the cut value and in the objective + value for the adjacent basis by simulating one step of the + dual simplex */ + switch (cut->type) + { case GLP_LO: rhs = cut->lb; break; + case GLP_UP: rhs = cut->ub; break; + default: xassert(cut != cut); + } + ret = _glp_analyze_row(T->mip, len, ind, val, cut->type, + rhs, 1e-9, NULL, NULL, NULL, NULL, &dy, &dz); + /* determine normalized residual and lower bound to objective + degradation */ + if (ret == 0) + { info[k].eff = fabs(dy) / sqrt(temp); + /* if some reduced costs violates (slightly) their zero + bounds (i.e. have wrong signs) due to round-off errors, + dz also may have wrong sign being close to zero */ + if (T->mip->dir == GLP_MIN) + { if (dz < 0.0) dz = 0.0; + info[k].deg = + dz; + } + else /* GLP_MAX */ + { if (dz > 0.0) dz = 0.0; + info[k].deg = - dz; + } + } + else if (ret == 1) + { /* the constraint is not violated at the current point */ + info[k].eff = info[k].deg = 0.0; + } + else if (ret == 2) + { /* no dual feasible adjacent basis exists */ + info[k].eff = 1.0; + info[k].deg = DBL_MAX; + } + else + xassert(ret != ret); + /* if the degradation is too small, just ignore it */ + if (info[k].deg < 0.01) info[k].deg = 0.0; + } + /* sort the list of cuts by decreasing objective degradation and + then by decreasing efficacy */ + qsort(&info[1], pool->m, sizeof(struct info), fcmp); + /* only first (most efficient) max_cuts in the list are qualified + as candidates to be added to the current subproblem */ + max_cuts = (T->curr->level == 0 ? 90 : 10); + if (max_cuts > pool->m) max_cuts = pool->m; + /* add cuts to the current subproblem */ +#if 0 + xprintf("*** adding cuts ***\n"); +#endif + for (k = 1; k <= max_cuts; k++) + { int i, len; + /* if this cut seems to be inefficient, skip it */ + if (info[k].deg < 0.01 && info[k].eff < 0.01) continue; + /* if the angle between this cut and every other cut included + in the current subproblem is small, skip this cut */ + for (kk = 1; kk < k; kk++) + { if (info[kk].flag) + { if (parallel(info[k].cut, info[kk].cut, work) > 0.90) + break; + } + } + if (kk < k) continue; + /* add this cut to the current subproblem */ +#if 0 + xprintf("eff = %g; deg = %g\n", info[k].eff, info[k].deg); +#endif + cut = info[k].cut, info[k].flag = 1; + i = glp_add_rows(T->mip, 1); + if (cut->name != NULL) + glp_set_row_name(T->mip, i, cut->name); + xassert(T->mip->row[i]->origin == GLP_RF_CUT); + T->mip->row[i]->klass = cut->klass; + len = 0; + for (aij = cut->ptr; aij != NULL; aij = aij->r_next) + len++, ind[len] = aij->col->j, val[len] = aij->val; + glp_set_mat_row(T->mip, i, len, ind, val); + switch (cut->type) + { case GLP_LO: rhs = cut->lb; break; + case GLP_UP: rhs = cut->ub; break; + default: xassert(cut != cut); + } + glp_set_row_bnds(T->mip, i, cut->type, rhs, rhs); + } + /* free working arrays */ + xfree(info); + xfree(ind); + xfree(val); + xfree(work); + return; +} +#else +void ios_process_cuts(glp_tree *T) +{ IOSPOOL *pool; + IOSCUT *cut; + IOSAIJ *aij; + struct info *info; + int k, kk, max_cuts, len, ret, *ind; + double *val, *work; + /* the current subproblem must exist */ + xassert(T->curr != NULL); + /* the pool must exist and be non-empty */ + pool = T->local; + xassert(pool != NULL); + xassert(pool->size > 0); + /* allocate working arrays */ + info = xcalloc(1+pool->size, sizeof(struct info)); + ind = xcalloc(1+T->n, sizeof(int)); + val = xcalloc(1+T->n, sizeof(double)); + work = xcalloc(1+T->n, sizeof(double)); + for (k = 1; k <= T->n; k++) work[k] = 0.0; + /* build the list of cuts stored in the cut pool */ + for (k = 0, cut = pool->head; cut != NULL; cut = cut->next) + k++, info[k].cut = cut, info[k].flag = 0; + xassert(k == pool->size); + /* estimate efficiency of all cuts in the cut pool */ + for (k = 1; k <= pool->size; k++) + { double temp, dy, dz; + cut = info[k].cut; + /* build the vector of cut coefficients and compute its + Euclidean norm */ + len = 0; temp = 0.0; + for (aij = cut->ptr; aij != NULL; aij = aij->next) + { xassert(1 <= aij->j && aij->j <= T->n); + len++, ind[len] = aij->j, val[len] = aij->val; + temp += aij->val * aij->val; + } + if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; + /* transform the cut to express it only through non-basic + (auxiliary and structural) variables */ + len = glp_transform_row(T->mip, len, ind, val); + /* determine change in the cut value and in the objective + value for the adjacent basis by simulating one step of the + dual simplex */ + ret = _glp_analyze_row(T->mip, len, ind, val, cut->type, + cut->rhs, 1e-9, NULL, NULL, NULL, NULL, &dy, &dz); + /* determine normalized residual and lower bound to objective + degradation */ + if (ret == 0) + { info[k].eff = fabs(dy) / sqrt(temp); + /* if some reduced costs violates (slightly) their zero + bounds (i.e. have wrong signs) due to round-off errors, + dz also may have wrong sign being close to zero */ + if (T->mip->dir == GLP_MIN) + { if (dz < 0.0) dz = 0.0; + info[k].deg = + dz; + } + else /* GLP_MAX */ + { if (dz > 0.0) dz = 0.0; + info[k].deg = - dz; + } + } + else if (ret == 1) + { /* the constraint is not violated at the current point */ + info[k].eff = info[k].deg = 0.0; + } + else if (ret == 2) + { /* no dual feasible adjacent basis exists */ + info[k].eff = 1.0; + info[k].deg = DBL_MAX; + } + else + xassert(ret != ret); + /* if the degradation is too small, just ignore it */ + if (info[k].deg < 0.01) info[k].deg = 0.0; + } + /* sort the list of cuts by decreasing objective degradation and + then by decreasing efficacy */ + qsort(&info[1], pool->size, sizeof(struct info), fcmp); + /* only first (most efficient) max_cuts in the list are qualified + as candidates to be added to the current subproblem */ + max_cuts = (T->curr->level == 0 ? 90 : 10); + if (max_cuts > pool->size) max_cuts = pool->size; + /* add cuts to the current subproblem */ +#if 0 + xprintf("*** adding cuts ***\n"); +#endif + for (k = 1; k <= max_cuts; k++) + { int i, len; + /* if this cut seems to be inefficient, skip it */ + if (info[k].deg < 0.01 && info[k].eff < 0.01) continue; + /* if the angle between this cut and every other cut included + in the current subproblem is small, skip this cut */ + for (kk = 1; kk < k; kk++) + { if (info[kk].flag) + { if (parallel(info[k].cut, info[kk].cut, work) > 0.90) + break; + } + } + if (kk < k) continue; + /* add this cut to the current subproblem */ +#if 0 + xprintf("eff = %g; deg = %g\n", info[k].eff, info[k].deg); +#endif + cut = info[k].cut, info[k].flag = 1; + i = glp_add_rows(T->mip, 1); + if (cut->name != NULL) + glp_set_row_name(T->mip, i, cut->name); + xassert(T->mip->row[i]->origin == GLP_RF_CUT); + T->mip->row[i]->klass = cut->klass; + len = 0; + for (aij = cut->ptr; aij != NULL; aij = aij->next) + len++, ind[len] = aij->j, val[len] = aij->val; + glp_set_mat_row(T->mip, i, len, ind, val); + xassert(cut->type == GLP_LO || cut->type == GLP_UP); + glp_set_row_bnds(T->mip, i, cut->type, cut->rhs, cut->rhs); + } + /* free working arrays */ + xfree(info); + xfree(ind); + xfree(val); + xfree(work); + return; +} +#endif + +#if 0 +/*********************************************************************** +* Given a cut a * x >= b (<= b) the routine efficacy computes the cut +* efficacy as follows: +* +* eff = d * (a * x~ - b) / ||a||, +* +* where d is -1 (in case of '>= b') or +1 (in case of '<= b'), x~ is +* the vector of values of structural variables in optimal solution to +* LP relaxation of the current subproblem, ||a|| is the Euclidean norm +* of the vector of cut coefficients. +* +* If the cut is violated at point x~, the efficacy eff is positive, +* and its value is the Euclidean distance between x~ and the cut plane +* a * x = b in the space of structural variables. +* +* Following geometrical intuition, it is quite natural to consider +* this distance as a first-order measure of the expected efficacy of +* the cut: the larger the distance the better the cut [1]. */ + +static double efficacy(glp_tree *T, IOSCUT *cut) +{ glp_prob *mip = T->mip; + IOSAIJ *aij; + double s = 0.0, t = 0.0, temp; + for (aij = cut->ptr; aij != NULL; aij = aij->next) + { xassert(1 <= aij->j && aij->j <= mip->n); + s += aij->val * mip->col[aij->j]->prim; + t += aij->val * aij->val; + } + temp = sqrt(t); + if (temp < DBL_EPSILON) temp = DBL_EPSILON; + if (cut->type == GLP_LO) + temp = (s >= cut->rhs ? 0.0 : (cut->rhs - s) / temp); + else if (cut->type == GLP_UP) + temp = (s <= cut->rhs ? 0.0 : (s - cut->rhs) / temp); + else + xassert(cut != cut); + return temp; +} +#endif + +/*********************************************************************** +* Given two cuts a1 * x >= b1 (<= b1) and a2 * x >= b2 (<= b2) the +* routine parallel computes the cosine of angle between the cut planes +* a1 * x = b1 and a2 * x = b2 (which is the acute angle between two +* normals to these planes) in the space of structural variables as +* follows: +* +* cos phi = (a1' * a2) / (||a1|| * ||a2||), +* +* where (a1' * a2) is a dot product of vectors of cut coefficients, +* ||a1|| and ||a2|| are Euclidean norms of vectors a1 and a2. +* +* Note that requirement cos phi = 0 forces the cuts to be orthogonal, +* i.e. with disjoint support, while requirement cos phi <= 0.999 means +* only avoiding duplicate (parallel) cuts [1]. */ + +#ifdef NEW_LOCAL /* 02/II-2018 */ +static double parallel(IOSCUT *a, IOSCUT *b, double work[]) +{ GLPAIJ *aij; + double s = 0.0, sa = 0.0, sb = 0.0, temp; + for (aij = a->ptr; aij != NULL; aij = aij->r_next) + { work[aij->col->j] = aij->val; + sa += aij->val * aij->val; + } + for (aij = b->ptr; aij != NULL; aij = aij->r_next) + { s += work[aij->col->j] * aij->val; + sb += aij->val * aij->val; + } + for (aij = a->ptr; aij != NULL; aij = aij->r_next) + work[aij->col->j] = 0.0; + temp = sqrt(sa) * sqrt(sb); + if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; + return s / temp; +} +#else +static double parallel(IOSCUT *a, IOSCUT *b, double work[]) +{ IOSAIJ *aij; + double s = 0.0, sa = 0.0, sb = 0.0, temp; + for (aij = a->ptr; aij != NULL; aij = aij->next) + { work[aij->j] = aij->val; + sa += aij->val * aij->val; + } + for (aij = b->ptr; aij != NULL; aij = aij->next) + { s += work[aij->j] * aij->val; + sb += aij->val * aij->val; + } + for (aij = a->ptr; aij != NULL; aij = aij->next) + work[aij->j] = 0.0; + temp = sqrt(sa) * sqrt(sb); + if (temp < DBL_EPSILON * DBL_EPSILON) temp = DBL_EPSILON; + return s / temp; +} +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpios12.c b/test/monniaux/glpk-4.65/src/draft/glpios12.c new file mode 100644 index 00000000..bec6fa2c --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpios12.c @@ -0,0 +1,177 @@ +/* glpios12.c (node selection heuristics) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 "ios.h" + +/*********************************************************************** +* NAME +* +* ios_choose_node - select subproblem to continue the search +* +* SYNOPSIS +* +* #include "glpios.h" +* int ios_choose_node(glp_tree *T); +* +* DESCRIPTION +* +* The routine ios_choose_node selects a subproblem from the active +* list to continue the search. The choice depends on the backtracking +* technique option. +* +* RETURNS +* +* The routine ios_choose_node return the reference number of the +* subproblem selected. */ + +static int most_feas(glp_tree *T); +static int best_proj(glp_tree *T); +static int best_node(glp_tree *T); + +int ios_choose_node(glp_tree *T) +{ int p; + if (T->parm->bt_tech == GLP_BT_DFS) + { /* depth first search */ + xassert(T->tail != NULL); + p = T->tail->p; + } + else if (T->parm->bt_tech == GLP_BT_BFS) + { /* breadth first search */ + xassert(T->head != NULL); + p = T->head->p; + } + else if (T->parm->bt_tech == GLP_BT_BLB) + { /* select node with best local bound */ + p = best_node(T); + } + else if (T->parm->bt_tech == GLP_BT_BPH) + { if (T->mip->mip_stat == GLP_UNDEF) + { /* "most integer feasible" subproblem */ + p = most_feas(T); + } + else + { /* best projection heuristic */ + p = best_proj(T); + } + } + else + xassert(T != T); + return p; +} + +static int most_feas(glp_tree *T) +{ /* select subproblem whose parent has minimal sum of integer + infeasibilities */ + IOSNPD *node; + int p; + double best; + p = 0, best = DBL_MAX; + for (node = T->head; node != NULL; node = node->next) + { xassert(node->up != NULL); + if (best > node->up->ii_sum) + p = node->p, best = node->up->ii_sum; + } + return p; +} + +static int best_proj(glp_tree *T) +{ /* select subproblem using the best projection heuristic */ + IOSNPD *root, *node; + int p; + double best, deg, obj; + /* the global bound must exist */ + xassert(T->mip->mip_stat == GLP_FEAS); + /* obtain pointer to the root node, which must exist */ + root = T->slot[1].node; + xassert(root != NULL); + /* deg estimates degradation of the objective function per unit + of the sum of integer infeasibilities */ + xassert(root->ii_sum > 0.0); + deg = (T->mip->mip_obj - root->bound) / root->ii_sum; + /* nothing has been selected so far */ + p = 0, best = DBL_MAX; + /* walk through the list of active subproblems */ + for (node = T->head; node != NULL; node = node->next) + { xassert(node->up != NULL); + /* obj estimates optimal objective value if the sum of integer + infeasibilities were zero */ + obj = node->up->bound + deg * node->up->ii_sum; + if (T->mip->dir == GLP_MAX) obj = - obj; + /* select the subproblem which has the best estimated optimal + objective value */ + if (best > obj) p = node->p, best = obj; + } + return p; +} + +static int best_node(glp_tree *T) +{ /* select subproblem with best local bound */ + IOSNPD *node, *best = NULL; + double bound, eps; + switch (T->mip->dir) + { case GLP_MIN: + bound = +DBL_MAX; + for (node = T->head; node != NULL; node = node->next) + if (bound > node->bound) bound = node->bound; + xassert(bound != +DBL_MAX); + eps = 1e-10 * (1.0 + fabs(bound)); + for (node = T->head; node != NULL; node = node->next) + { if (node->bound <= bound + eps) + { xassert(node->up != NULL); + if (best == NULL || +#if 1 + best->up->ii_sum > node->up->ii_sum) best = node; +#else + best->lp_obj > node->lp_obj) best = node; +#endif + } + } + break; + case GLP_MAX: + bound = -DBL_MAX; + for (node = T->head; node != NULL; node = node->next) + if (bound < node->bound) bound = node->bound; + xassert(bound != -DBL_MAX); + eps = 1e-10 * (1.0 + fabs(bound)); + for (node = T->head; node != NULL; node = node->next) + { if (node->bound >= bound - eps) + { xassert(node->up != NULL); + if (best == NULL || +#if 1 + best->up->ii_sum > node->up->ii_sum) best = node; +#else + best->lp_obj < node->lp_obj) best = node; +#endif + } + } + break; + default: + xassert(T != T); + } + xassert(best != NULL); + return best->p; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpipm.c b/test/monniaux/glpk-4.65/src/draft/glpipm.c new file mode 100644 index 00000000..2b3a8176 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpipm.c @@ -0,0 +1,1144 @@ +/* glpipm.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "glpipm.h" +#include "glpmat.h" + +#define ITER_MAX 100 +/* maximal number of iterations */ + +struct csa +{ /* common storage area */ + /*--------------------------------------------------------------*/ + /* LP data */ + int m; + /* number of rows (equality constraints) */ + int n; + /* number of columns (structural variables) */ + int *A_ptr; /* int A_ptr[1+m+1]; */ + int *A_ind; /* int A_ind[A_ptr[m+1]]; */ + double *A_val; /* double A_val[A_ptr[m+1]]; */ + /* mxn-matrix A in storage-by-rows format */ + double *b; /* double b[1+m]; */ + /* m-vector b of right-hand sides */ + double *c; /* double c[1+n]; */ + /* n-vector c of objective coefficients; c[0] is constant term of + the objective function */ + /*--------------------------------------------------------------*/ + /* LP solution */ + double *x; /* double x[1+n]; */ + double *y; /* double y[1+m]; */ + double *z; /* double z[1+n]; */ + /* current point in primal-dual space; the best point on exit */ + /*--------------------------------------------------------------*/ + /* control parameters */ + const glp_iptcp *parm; + /*--------------------------------------------------------------*/ + /* working arrays and variables */ + double *D; /* double D[1+n]; */ + /* diagonal nxn-matrix D = X*inv(Z), where X = diag(x[j]) and + Z = diag(z[j]) */ + int *P; /* int P[1+m+m]; */ + /* permutation mxm-matrix P used to minimize fill-in in Cholesky + factorization */ + int *S_ptr; /* int S_ptr[1+m+1]; */ + int *S_ind; /* int S_ind[S_ptr[m+1]]; */ + double *S_val; /* double S_val[S_ptr[m+1]]; */ + double *S_diag; /* double S_diag[1+m]; */ + /* symmetric mxm-matrix S = P*A*D*A'*P' whose upper triangular + part without diagonal elements is stored in S_ptr, S_ind, and + S_val in storage-by-rows format, diagonal elements are stored + in S_diag */ + int *U_ptr; /* int U_ptr[1+m+1]; */ + int *U_ind; /* int U_ind[U_ptr[m+1]]; */ + double *U_val; /* double U_val[U_ptr[m+1]]; */ + double *U_diag; /* double U_diag[1+m]; */ + /* upper triangular mxm-matrix U defining Cholesky factorization + S = U'*U; its non-diagonal elements are stored in U_ptr, U_ind, + U_val in storage-by-rows format, diagonal elements are stored + in U_diag */ + int iter; + /* iteration number (0, 1, 2, ...); iter = 0 corresponds to the + initial point */ + double obj; + /* current value of the objective function */ + double rpi; + /* relative primal infeasibility rpi = ||A*x-b||/(1+||b||) */ + double rdi; + /* relative dual infeasibility rdi = ||A'*y+z-c||/(1+||c||) */ + double gap; + /* primal-dual gap = |c'*x-b'*y|/(1+|c'*x|) which is a relative + difference between primal and dual objective functions */ + double phi; + /* merit function phi = ||A*x-b||/max(1,||b||) + + + ||A'*y+z-c||/max(1,||c||) + + + |c'*x-b'*y|/max(1,||b||,||c||) */ + double mu; + /* duality measure mu = x'*z/n (used as barrier parameter) */ + double rmu; + /* rmu = max(||A*x-b||,||A'*y+z-c||)/mu */ + double rmu0; + /* the initial value of rmu on iteration 0 */ + double *phi_min; /* double phi_min[1+ITER_MAX]; */ + /* phi_min[k] = min(phi[k]), where phi[k] is the value of phi on + k-th iteration, 0 <= k <= iter */ + int best_iter; + /* iteration number, on which the value of phi reached its best + (minimal) value */ + double *best_x; /* double best_x[1+n]; */ + double *best_y; /* double best_y[1+m]; */ + double *best_z; /* double best_z[1+n]; */ + /* best point (in the sense of the merit function phi) which has + been reached on iteration iter_best */ + double best_obj; + /* objective value at the best point */ + double *dx_aff; /* double dx_aff[1+n]; */ + double *dy_aff; /* double dy_aff[1+m]; */ + double *dz_aff; /* double dz_aff[1+n]; */ + /* affine scaling direction */ + double alfa_aff_p, alfa_aff_d; + /* maximal primal and dual stepsizes in affine scaling direction, + on which x and z are still non-negative */ + double mu_aff; + /* duality measure mu_aff = x_aff'*z_aff/n in the boundary point + x_aff' = x+alfa_aff_p*dx_aff, z_aff' = z+alfa_aff_d*dz_aff */ + double sigma; + /* Mehrotra's heuristic parameter (0 <= sigma <= 1) */ + double *dx_cc; /* double dx_cc[1+n]; */ + double *dy_cc; /* double dy_cc[1+m]; */ + double *dz_cc; /* double dz_cc[1+n]; */ + /* centering corrector direction */ + double *dx; /* double dx[1+n]; */ + double *dy; /* double dy[1+m]; */ + double *dz; /* double dz[1+n]; */ + /* final combined direction dx = dx_aff+dx_cc, dy = dy_aff+dy_cc, + dz = dz_aff+dz_cc */ + double alfa_max_p; + double alfa_max_d; + /* maximal primal and dual stepsizes in combined direction, on + which x and z are still non-negative */ +}; + +/*********************************************************************** +* initialize - allocate and initialize common storage area +* +* This routine allocates and initializes the common storage area (CSA) +* used by interior-point method routines. */ + +static void initialize(struct csa *csa) +{ int m = csa->m; + int n = csa->n; + int i; + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Matrix A has %d non-zeros\n", csa->A_ptr[m+1]-1); + csa->D = xcalloc(1+n, sizeof(double)); + /* P := I */ + csa->P = xcalloc(1+m+m, sizeof(int)); + for (i = 1; i <= m; i++) csa->P[i] = csa->P[m+i] = i; + /* S := A*A', symbolically */ + csa->S_ptr = xcalloc(1+m+1, sizeof(int)); + csa->S_ind = adat_symbolic(m, n, csa->P, csa->A_ptr, csa->A_ind, + csa->S_ptr); + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Matrix S = A*A' has %d non-zeros (upper triangle)\n", + csa->S_ptr[m+1]-1 + m); + /* determine P using specified ordering algorithm */ + if (csa->parm->ord_alg == GLP_ORD_NONE) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Original ordering is being used\n"); + for (i = 1; i <= m; i++) + csa->P[i] = csa->P[m+i] = i; + } + else if (csa->parm->ord_alg == GLP_ORD_QMD) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Minimum degree ordering (QMD)...\n"); + min_degree(m, csa->S_ptr, csa->S_ind, csa->P); + } + else if (csa->parm->ord_alg == GLP_ORD_AMD) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Approximate minimum degree ordering (AMD)...\n"); + amd_order1(m, csa->S_ptr, csa->S_ind, csa->P); + } + else if (csa->parm->ord_alg == GLP_ORD_SYMAMD) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Approximate minimum degree ordering (SYMAMD)...\n") + ; + symamd_ord(m, csa->S_ptr, csa->S_ind, csa->P); + } + else + xassert(csa != csa); + /* S := P*A*A'*P', symbolically */ + xfree(csa->S_ind); + csa->S_ind = adat_symbolic(m, n, csa->P, csa->A_ptr, csa->A_ind, + csa->S_ptr); + csa->S_val = xcalloc(csa->S_ptr[m+1], sizeof(double)); + csa->S_diag = xcalloc(1+m, sizeof(double)); + /* compute Cholesky factorization S = U'*U, symbolically */ + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Computing Cholesky factorization S = L*L'...\n"); + csa->U_ptr = xcalloc(1+m+1, sizeof(int)); + csa->U_ind = chol_symbolic(m, csa->S_ptr, csa->S_ind, csa->U_ptr); + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Matrix L has %d non-zeros\n", csa->U_ptr[m+1]-1 + m); + csa->U_val = xcalloc(csa->U_ptr[m+1], sizeof(double)); + csa->U_diag = xcalloc(1+m, sizeof(double)); + csa->iter = 0; + csa->obj = 0.0; + csa->rpi = 0.0; + csa->rdi = 0.0; + csa->gap = 0.0; + csa->phi = 0.0; + csa->mu = 0.0; + csa->rmu = 0.0; + csa->rmu0 = 0.0; + csa->phi_min = xcalloc(1+ITER_MAX, sizeof(double)); + csa->best_iter = 0; + csa->best_x = xcalloc(1+n, sizeof(double)); + csa->best_y = xcalloc(1+m, sizeof(double)); + csa->best_z = xcalloc(1+n, sizeof(double)); + csa->best_obj = 0.0; + csa->dx_aff = xcalloc(1+n, sizeof(double)); + csa->dy_aff = xcalloc(1+m, sizeof(double)); + csa->dz_aff = xcalloc(1+n, sizeof(double)); + csa->alfa_aff_p = 0.0; + csa->alfa_aff_d = 0.0; + csa->mu_aff = 0.0; + csa->sigma = 0.0; + csa->dx_cc = xcalloc(1+n, sizeof(double)); + csa->dy_cc = xcalloc(1+m, sizeof(double)); + csa->dz_cc = xcalloc(1+n, sizeof(double)); + csa->dx = csa->dx_aff; + csa->dy = csa->dy_aff; + csa->dz = csa->dz_aff; + csa->alfa_max_p = 0.0; + csa->alfa_max_d = 0.0; + return; +} + +/*********************************************************************** +* A_by_vec - compute y = A*x +* +* This routine computes matrix-vector product y = A*x, where A is the +* constraint matrix. */ + +static void A_by_vec(struct csa *csa, double x[], double y[]) +{ /* compute y = A*x */ + int m = csa->m; + int *A_ptr = csa->A_ptr; + int *A_ind = csa->A_ind; + double *A_val = csa->A_val; + int i, t, beg, end; + double temp; + for (i = 1; i <= m; i++) + { temp = 0.0; + beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) temp += A_val[t] * x[A_ind[t]]; + y[i] = temp; + } + return; +} + +/*********************************************************************** +* AT_by_vec - compute y = A'*x +* +* This routine computes matrix-vector product y = A'*x, where A' is a +* matrix transposed to the constraint matrix A. */ + +static void AT_by_vec(struct csa *csa, double x[], double y[]) +{ /* compute y = A'*x, where A' is transposed to A */ + int m = csa->m; + int n = csa->n; + int *A_ptr = csa->A_ptr; + int *A_ind = csa->A_ind; + double *A_val = csa->A_val; + int i, j, t, beg, end; + double temp; + for (j = 1; j <= n; j++) y[j] = 0.0; + for (i = 1; i <= m; i++) + { temp = x[i]; + if (temp == 0.0) continue; + beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) y[A_ind[t]] += A_val[t] * temp; + } + return; +} + +/*********************************************************************** +* decomp_NE - numeric factorization of matrix S = P*A*D*A'*P' +* +* This routine implements numeric phase of Cholesky factorization of +* the matrix S = P*A*D*A'*P', which is a permuted matrix of the normal +* equation system. Matrix D is assumed to be already computed. */ + +static void decomp_NE(struct csa *csa) +{ adat_numeric(csa->m, csa->n, csa->P, csa->A_ptr, csa->A_ind, + csa->A_val, csa->D, csa->S_ptr, csa->S_ind, csa->S_val, + csa->S_diag); + chol_numeric(csa->m, csa->S_ptr, csa->S_ind, csa->S_val, + csa->S_diag, csa->U_ptr, csa->U_ind, csa->U_val, csa->U_diag); + return; +} + +/*********************************************************************** +* solve_NE - solve normal equation system +* +* This routine solves the normal equation system: +* +* A*D*A'*y = h. +* +* It is assumed that the matrix A*D*A' has been previously factorized +* by the routine decomp_NE. +* +* On entry the array y contains the vector of right-hand sides h. On +* exit this array contains the computed vector of unknowns y. +* +* Once the vector y has been computed the routine checks for numeric +* stability. If the residual vector: +* +* r = A*D*A'*y - h +* +* is relatively small, the routine returns zero, otherwise non-zero is +* returned. */ + +static int solve_NE(struct csa *csa, double y[]) +{ int m = csa->m; + int n = csa->n; + int *P = csa->P; + int i, j, ret = 0; + double *h, *r, *w; + /* save vector of right-hand sides h */ + h = xcalloc(1+m, sizeof(double)); + for (i = 1; i <= m; i++) h[i] = y[i]; + /* solve normal equation system (A*D*A')*y = h */ + /* since S = P*A*D*A'*P' = U'*U, then A*D*A' = P'*U'*U*P, so we + have inv(A*D*A') = P'*inv(U)*inv(U')*P */ + /* w := P*h */ + w = xcalloc(1+m, sizeof(double)); + for (i = 1; i <= m; i++) w[i] = y[P[i]]; + /* w := inv(U')*w */ + ut_solve(m, csa->U_ptr, csa->U_ind, csa->U_val, csa->U_diag, w); + /* w := inv(U)*w */ + u_solve(m, csa->U_ptr, csa->U_ind, csa->U_val, csa->U_diag, w); + /* y := P'*w */ + for (i = 1; i <= m; i++) y[i] = w[P[m+i]]; + xfree(w); + /* compute residual vector r = A*D*A'*y - h */ + r = xcalloc(1+m, sizeof(double)); + /* w := A'*y */ + w = xcalloc(1+n, sizeof(double)); + AT_by_vec(csa, y, w); + /* w := D*w */ + for (j = 1; j <= n; j++) w[j] *= csa->D[j]; + /* r := A*w */ + A_by_vec(csa, w, r); + xfree(w); + /* r := r - h */ + for (i = 1; i <= m; i++) r[i] -= h[i]; + /* check for numeric stability */ + for (i = 1; i <= m; i++) + { if (fabs(r[i]) / (1.0 + fabs(h[i])) > 1e-4) + { ret = 1; + break; + } + } + xfree(h); + xfree(r); + return ret; +} + +/*********************************************************************** +* solve_NS - solve Newtonian system +* +* This routine solves the Newtonian system: +* +* A*dx = p +* +* A'*dy + dz = q +* +* Z*dx + X*dz = r +* +* where X = diag(x[j]), Z = diag(z[j]), by reducing it to the normal +* equation system: +* +* (A*inv(Z)*X*A')*dy = A*inv(Z)*(X*q-r)+p +* +* (it is assumed that the matrix A*inv(Z)*X*A' has been factorized by +* the routine decomp_NE). +* +* Once vector dy has been computed the routine computes vectors dx and +* dz as follows: +* +* dx = inv(Z)*(X*(A'*dy-q)+r) +* +* dz = inv(X)*(r-Z*dx) +* +* The routine solve_NS returns the same code which was reported by the +* routine solve_NE (see above). */ + +static int solve_NS(struct csa *csa, double p[], double q[], double r[], + double dx[], double dy[], double dz[]) +{ int m = csa->m; + int n = csa->n; + double *x = csa->x; + double *z = csa->z; + int i, j, ret; + double *w = dx; + /* compute the vector of right-hand sides A*inv(Z)*(X*q-r)+p for + the normal equation system */ + for (j = 1; j <= n; j++) + w[j] = (x[j] * q[j] - r[j]) / z[j]; + A_by_vec(csa, w, dy); + for (i = 1; i <= m; i++) dy[i] += p[i]; + /* solve the normal equation system to compute vector dy */ + ret = solve_NE(csa, dy); + /* compute vectors dx and dz */ + AT_by_vec(csa, dy, dx); + for (j = 1; j <= n; j++) + { dx[j] = (x[j] * (dx[j] - q[j]) + r[j]) / z[j]; + dz[j] = (r[j] - z[j] * dx[j]) / x[j]; + } + return ret; +} + +/*********************************************************************** +* initial_point - choose initial point using Mehrotra's heuristic +* +* This routine chooses a starting point using a heuristic proposed in +* the paper: +* +* S. Mehrotra. On the implementation of a primal-dual interior point +* method. SIAM J. on Optim., 2(4), pp. 575-601, 1992. +* +* The starting point x in the primal space is chosen as a solution of +* the following least squares problem: +* +* minimize ||x|| +* +* subject to A*x = b +* +* which can be computed explicitly as follows: +* +* x = A'*inv(A*A')*b +* +* Similarly, the starting point (y, z) in the dual space is chosen as +* a solution of the following least squares problem: +* +* minimize ||z|| +* +* subject to A'*y + z = c +* +* which can be computed explicitly as follows: +* +* y = inv(A*A')*A*c +* +* z = c - A'*y +* +* However, some components of the vectors x and z may be non-positive +* or close to zero, so the routine uses a Mehrotra's heuristic to find +* a more appropriate starting point. */ + +static void initial_point(struct csa *csa) +{ int m = csa->m; + int n = csa->n; + double *b = csa->b; + double *c = csa->c; + double *x = csa->x; + double *y = csa->y; + double *z = csa->z; + double *D = csa->D; + int i, j; + double dp, dd, ex, ez, xz; + /* factorize A*A' */ + for (j = 1; j <= n; j++) D[j] = 1.0; + decomp_NE(csa); + /* x~ = A'*inv(A*A')*b */ + for (i = 1; i <= m; i++) y[i] = b[i]; + solve_NE(csa, y); + AT_by_vec(csa, y, x); + /* y~ = inv(A*A')*A*c */ + A_by_vec(csa, c, y); + solve_NE(csa, y); + /* z~ = c - A'*y~ */ + AT_by_vec(csa, y,z); + for (j = 1; j <= n; j++) z[j] = c[j] - z[j]; + /* use Mehrotra's heuristic in order to choose more appropriate + starting point with positive components of vectors x and z */ + dp = dd = 0.0; + for (j = 1; j <= n; j++) + { if (dp < -1.5 * x[j]) dp = -1.5 * x[j]; + if (dd < -1.5 * z[j]) dd = -1.5 * z[j]; + } + /* note that b = 0 involves x = 0, and c = 0 involves y = 0 and + z = 0, so we need to be careful */ + if (dp == 0.0) dp = 1.5; + if (dd == 0.0) dd = 1.5; + ex = ez = xz = 0.0; + for (j = 1; j <= n; j++) + { ex += (x[j] + dp); + ez += (z[j] + dd); + xz += (x[j] + dp) * (z[j] + dd); + } + dp += 0.5 * (xz / ez); + dd += 0.5 * (xz / ex); + for (j = 1; j <= n; j++) + { x[j] += dp; + z[j] += dd; + xassert(x[j] > 0.0 && z[j] > 0.0); + } + return; +} + +/*********************************************************************** +* basic_info - perform basic computations at the current point +* +* This routine computes the following quantities at the current point: +* +* 1) value of the objective function: +* +* F = c'*x + c[0] +* +* 2) relative primal infeasibility: +* +* rpi = ||A*x-b|| / (1+||b||) +* +* 3) relative dual infeasibility: +* +* rdi = ||A'*y+z-c|| / (1+||c||) +* +* 4) primal-dual gap (relative difference between the primal and the +* dual objective function values): +* +* gap = |c'*x-b'*y| / (1+|c'*x|) +* +* 5) merit function: +* +* phi = ||A*x-b|| / max(1,||b||) + ||A'*y+z-c|| / max(1,||c||) + +* +* + |c'*x-b'*y| / max(1,||b||,||c||) +* +* 6) duality measure: +* +* mu = x'*z / n +* +* 7) the ratio of infeasibility to mu: +* +* rmu = max(||A*x-b||,||A'*y+z-c||) / mu +* +* where ||*|| denotes euclidian norm, *' denotes transposition. */ + +static void basic_info(struct csa *csa) +{ int m = csa->m; + int n = csa->n; + double *b = csa->b; + double *c = csa->c; + double *x = csa->x; + double *y = csa->y; + double *z = csa->z; + int i, j; + double norm1, bnorm, norm2, cnorm, cx, by, *work, temp; + /* compute value of the objective function */ + temp = c[0]; + for (j = 1; j <= n; j++) temp += c[j] * x[j]; + csa->obj = temp; + /* norm1 = ||A*x-b|| */ + work = xcalloc(1+m, sizeof(double)); + A_by_vec(csa, x, work); + norm1 = 0.0; + for (i = 1; i <= m; i++) + norm1 += (work[i] - b[i]) * (work[i] - b[i]); + norm1 = sqrt(norm1); + xfree(work); + /* bnorm = ||b|| */ + bnorm = 0.0; + for (i = 1; i <= m; i++) bnorm += b[i] * b[i]; + bnorm = sqrt(bnorm); + /* compute relative primal infeasibility */ + csa->rpi = norm1 / (1.0 + bnorm); + /* norm2 = ||A'*y+z-c|| */ + work = xcalloc(1+n, sizeof(double)); + AT_by_vec(csa, y, work); + norm2 = 0.0; + for (j = 1; j <= n; j++) + norm2 += (work[j] + z[j] - c[j]) * (work[j] + z[j] - c[j]); + norm2 = sqrt(norm2); + xfree(work); + /* cnorm = ||c|| */ + cnorm = 0.0; + for (j = 1; j <= n; j++) cnorm += c[j] * c[j]; + cnorm = sqrt(cnorm); + /* compute relative dual infeasibility */ + csa->rdi = norm2 / (1.0 + cnorm); + /* by = b'*y */ + by = 0.0; + for (i = 1; i <= m; i++) by += b[i] * y[i]; + /* cx = c'*x */ + cx = 0.0; + for (j = 1; j <= n; j++) cx += c[j] * x[j]; + /* compute primal-dual gap */ + csa->gap = fabs(cx - by) / (1.0 + fabs(cx)); + /* compute merit function */ + csa->phi = 0.0; + csa->phi += norm1 / (bnorm > 1.0 ? bnorm : 1.0); + csa->phi += norm2 / (cnorm > 1.0 ? cnorm : 1.0); + temp = 1.0; + if (temp < bnorm) temp = bnorm; + if (temp < cnorm) temp = cnorm; + csa->phi += fabs(cx - by) / temp; + /* compute duality measure */ + temp = 0.0; + for (j = 1; j <= n; j++) temp += x[j] * z[j]; + csa->mu = temp / (double)n; + /* compute the ratio of infeasibility to mu */ + csa->rmu = (norm1 > norm2 ? norm1 : norm2) / csa->mu; + return; +} + +/*********************************************************************** +* make_step - compute next point using Mehrotra's technique +* +* This routine computes the next point using the predictor-corrector +* technique proposed in the paper: +* +* S. Mehrotra. On the implementation of a primal-dual interior point +* method. SIAM J. on Optim., 2(4), pp. 575-601, 1992. +* +* At first, the routine computes so called affine scaling (predictor) +* direction (dx_aff,dy_aff,dz_aff) which is a solution of the system: +* +* A*dx_aff = b - A*x +* +* A'*dy_aff + dz_aff = c - A'*y - z +* +* Z*dx_aff + X*dz_aff = - X*Z*e +* +* where (x,y,z) is the current point, X = diag(x[j]), Z = diag(z[j]), +* e = (1,...,1)'. +* +* Then, the routine computes the centering parameter sigma, using the +* following Mehrotra's heuristic: +* +* alfa_aff_p = inf{0 <= alfa <= 1 | x+alfa*dx_aff >= 0} +* +* alfa_aff_d = inf{0 <= alfa <= 1 | z+alfa*dz_aff >= 0} +* +* mu_aff = (x+alfa_aff_p*dx_aff)'*(z+alfa_aff_d*dz_aff)/n +* +* sigma = (mu_aff/mu)^3 +* +* where alfa_aff_p is the maximal stepsize along the affine scaling +* direction in the primal space, alfa_aff_d is the maximal stepsize +* along the same direction in the dual space. +* +* After determining sigma the routine computes so called centering +* (corrector) direction (dx_cc,dy_cc,dz_cc) which is the solution of +* the system: +* +* A*dx_cc = 0 +* +* A'*dy_cc + dz_cc = 0 +* +* Z*dx_cc + X*dz_cc = sigma*mu*e - X*Z*e +* +* Finally, the routine computes the combined direction +* +* (dx,dy,dz) = (dx_aff,dy_aff,dz_aff) + (dx_cc,dy_cc,dz_cc) +* +* and determines maximal primal and dual stepsizes along the combined +* direction: +* +* alfa_max_p = inf{0 <= alfa <= 1 | x+alfa*dx >= 0} +* +* alfa_max_d = inf{0 <= alfa <= 1 | z+alfa*dz >= 0} +* +* In order to prevent the next point to be too close to the boundary +* of the positive ortant, the routine decreases maximal stepsizes: +* +* alfa_p = gamma_p * alfa_max_p +* +* alfa_d = gamma_d * alfa_max_d +* +* where gamma_p and gamma_d are scaling factors, and computes the next +* point: +* +* x_new = x + alfa_p * dx +* +* y_new = y + alfa_d * dy +* +* z_new = z + alfa_d * dz +* +* which becomes the current point on the next iteration. */ + +static int make_step(struct csa *csa) +{ int m = csa->m; + int n = csa->n; + double *b = csa->b; + double *c = csa->c; + double *x = csa->x; + double *y = csa->y; + double *z = csa->z; + double *dx_aff = csa->dx_aff; + double *dy_aff = csa->dy_aff; + double *dz_aff = csa->dz_aff; + double *dx_cc = csa->dx_cc; + double *dy_cc = csa->dy_cc; + double *dz_cc = csa->dz_cc; + double *dx = csa->dx; + double *dy = csa->dy; + double *dz = csa->dz; + int i, j, ret = 0; + double temp, gamma_p, gamma_d, *p, *q, *r; + /* allocate working arrays */ + p = xcalloc(1+m, sizeof(double)); + q = xcalloc(1+n, sizeof(double)); + r = xcalloc(1+n, sizeof(double)); + /* p = b - A*x */ + A_by_vec(csa, x, p); + for (i = 1; i <= m; i++) p[i] = b[i] - p[i]; + /* q = c - A'*y - z */ + AT_by_vec(csa, y,q); + for (j = 1; j <= n; j++) q[j] = c[j] - q[j] - z[j]; + /* r = - X * Z * e */ + for (j = 1; j <= n; j++) r[j] = - x[j] * z[j]; + /* solve the first Newtonian system */ + if (solve_NS(csa, p, q, r, dx_aff, dy_aff, dz_aff)) + { ret = 1; + goto done; + } + /* alfa_aff_p = inf{0 <= alfa <= 1 | x + alfa*dx_aff >= 0} */ + /* alfa_aff_d = inf{0 <= alfa <= 1 | z + alfa*dz_aff >= 0} */ + csa->alfa_aff_p = csa->alfa_aff_d = 1.0; + for (j = 1; j <= n; j++) + { if (dx_aff[j] < 0.0) + { temp = - x[j] / dx_aff[j]; + if (csa->alfa_aff_p > temp) csa->alfa_aff_p = temp; + } + if (dz_aff[j] < 0.0) + { temp = - z[j] / dz_aff[j]; + if (csa->alfa_aff_d > temp) csa->alfa_aff_d = temp; + } + } + /* mu_aff = (x+alfa_aff_p*dx_aff)' * (z+alfa_aff_d*dz_aff) / n */ + temp = 0.0; + for (j = 1; j <= n; j++) + temp += (x[j] + csa->alfa_aff_p * dx_aff[j]) * + (z[j] + csa->alfa_aff_d * dz_aff[j]); + csa->mu_aff = temp / (double)n; + /* sigma = (mu_aff/mu)^3 */ + temp = csa->mu_aff / csa->mu; + csa->sigma = temp * temp * temp; + /* p = 0 */ + for (i = 1; i <= m; i++) p[i] = 0.0; + /* q = 0 */ + for (j = 1; j <= n; j++) q[j] = 0.0; + /* r = sigma * mu * e - X * Z * e */ + for (j = 1; j <= n; j++) + r[j] = csa->sigma * csa->mu - dx_aff[j] * dz_aff[j]; + /* solve the second Newtonian system with the same coefficients + but with altered right-hand sides */ + if (solve_NS(csa, p, q, r, dx_cc, dy_cc, dz_cc)) + { ret = 1; + goto done; + } + /* (dx,dy,dz) = (dx_aff,dy_aff,dz_aff) + (dx_cc,dy_cc,dz_cc) */ + for (j = 1; j <= n; j++) dx[j] = dx_aff[j] + dx_cc[j]; + for (i = 1; i <= m; i++) dy[i] = dy_aff[i] + dy_cc[i]; + for (j = 1; j <= n; j++) dz[j] = dz_aff[j] + dz_cc[j]; + /* alfa_max_p = inf{0 <= alfa <= 1 | x + alfa*dx >= 0} */ + /* alfa_max_d = inf{0 <= alfa <= 1 | z + alfa*dz >= 0} */ + csa->alfa_max_p = csa->alfa_max_d = 1.0; + for (j = 1; j <= n; j++) + { if (dx[j] < 0.0) + { temp = - x[j] / dx[j]; + if (csa->alfa_max_p > temp) csa->alfa_max_p = temp; + } + if (dz[j] < 0.0) + { temp = - z[j] / dz[j]; + if (csa->alfa_max_d > temp) csa->alfa_max_d = temp; + } + } + /* determine scale factors (not implemented yet) */ + gamma_p = 0.90; + gamma_d = 0.90; + /* compute the next point */ + for (j = 1; j <= n; j++) + { x[j] += gamma_p * csa->alfa_max_p * dx[j]; + xassert(x[j] > 0.0); + } + for (i = 1; i <= m; i++) + y[i] += gamma_d * csa->alfa_max_d * dy[i]; + for (j = 1; j <= n; j++) + { z[j] += gamma_d * csa->alfa_max_d * dz[j]; + xassert(z[j] > 0.0); + } +done: /* free working arrays */ + xfree(p); + xfree(q); + xfree(r); + return ret; +} + +/*********************************************************************** +* terminate - deallocate common storage area +* +* This routine frees all memory allocated to the common storage area +* used by interior-point method routines. */ + +static void terminate(struct csa *csa) +{ xfree(csa->D); + xfree(csa->P); + xfree(csa->S_ptr); + xfree(csa->S_ind); + xfree(csa->S_val); + xfree(csa->S_diag); + xfree(csa->U_ptr); + xfree(csa->U_ind); + xfree(csa->U_val); + xfree(csa->U_diag); + xfree(csa->phi_min); + xfree(csa->best_x); + xfree(csa->best_y); + xfree(csa->best_z); + xfree(csa->dx_aff); + xfree(csa->dy_aff); + xfree(csa->dz_aff); + xfree(csa->dx_cc); + xfree(csa->dy_cc); + xfree(csa->dz_cc); + return; +} + +/*********************************************************************** +* ipm_main - main interior-point method routine +* +* This is a main routine of the primal-dual interior-point method. +* +* The routine ipm_main returns one of the following codes: +* +* 0 - optimal solution found; +* 1 - problem has no feasible (primal or dual) solution; +* 2 - no convergence; +* 3 - iteration limit exceeded; +* 4 - numeric instability on solving Newtonian system. +* +* In case of non-zero return code the routine returns the best point, +* which has been reached during optimization. */ + +static int ipm_main(struct csa *csa) +{ int m = csa->m; + int n = csa->n; + int i, j, status; + double temp; + /* choose initial point using Mehrotra's heuristic */ + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Guessing initial point...\n"); + initial_point(csa); + /* main loop starts here */ + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Optimization begins...\n"); + for (;;) + { /* perform basic computations at the current point */ + basic_info(csa); + /* save initial value of rmu */ + if (csa->iter == 0) csa->rmu0 = csa->rmu; + /* accumulate values of min(phi[k]) and save the best point */ + xassert(csa->iter <= ITER_MAX); + if (csa->iter == 0 || csa->phi_min[csa->iter-1] > csa->phi) + { csa->phi_min[csa->iter] = csa->phi; + csa->best_iter = csa->iter; + for (j = 1; j <= n; j++) csa->best_x[j] = csa->x[j]; + for (i = 1; i <= m; i++) csa->best_y[i] = csa->y[i]; + for (j = 1; j <= n; j++) csa->best_z[j] = csa->z[j]; + csa->best_obj = csa->obj; + } + else + csa->phi_min[csa->iter] = csa->phi_min[csa->iter-1]; + /* display information at the current point */ + if (csa->parm->msg_lev >= GLP_MSG_ON) + xprintf("%3d: obj = %17.9e; rpi = %8.1e; rdi = %8.1e; gap =" + " %8.1e\n", csa->iter, csa->obj, csa->rpi, csa->rdi, + csa->gap); + /* check if the current point is optimal */ + if (csa->rpi < 1e-8 && csa->rdi < 1e-8 && csa->gap < 1e-8) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("OPTIMAL SOLUTION FOUND\n"); + status = 0; + break; + } + /* check if the problem has no feasible solution */ + temp = 1e5 * csa->phi_min[csa->iter]; + if (temp < 1e-8) temp = 1e-8; + if (csa->phi >= temp) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("PROBLEM HAS NO FEASIBLE PRIMAL/DUAL SOLUTION\n") + ; + status = 1; + break; + } + /* check for very slow convergence or divergence */ + if (((csa->rpi >= 1e-8 || csa->rdi >= 1e-8) && csa->rmu / + csa->rmu0 >= 1e6) || + (csa->iter >= 30 && csa->phi_min[csa->iter] >= 0.5 * + csa->phi_min[csa->iter - 30])) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("NO CONVERGENCE; SEARCH TERMINATED\n"); + status = 2; + break; + } + /* check for maximal number of iterations */ + if (csa->iter == ITER_MAX) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("ITERATION LIMIT EXCEEDED; SEARCH TERMINATED\n"); + status = 3; + break; + } + /* start the next iteration */ + csa->iter++; + /* factorize normal equation system */ + for (j = 1; j <= n; j++) csa->D[j] = csa->x[j] / csa->z[j]; + decomp_NE(csa); + /* compute the next point using Mehrotra's predictor-corrector + technique */ + if (make_step(csa)) + { if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("NUMERIC INSTABILITY; SEARCH TERMINATED\n"); + status = 4; + break; + } + } + /* restore the best point */ + if (status != 0) + { for (j = 1; j <= n; j++) csa->x[j] = csa->best_x[j]; + for (i = 1; i <= m; i++) csa->y[i] = csa->best_y[i]; + for (j = 1; j <= n; j++) csa->z[j] = csa->best_z[j]; + if (csa->parm->msg_lev >= GLP_MSG_ALL) + xprintf("Best point %17.9e was reached on iteration %d\n", + csa->best_obj, csa->best_iter); + } + /* return to the calling program */ + return status; +} + +/*********************************************************************** +* NAME +* +* ipm_solve - core LP solver based on the interior-point method +* +* SYNOPSIS +* +* #include "glpipm.h" +* int ipm_solve(glp_prob *P, const glp_iptcp *parm); +* +* DESCRIPTION +* +* The routine ipm_solve is a core LP solver based on the primal-dual +* interior-point method. +* +* The routine assumes the following standard formulation of LP problem +* to be solved: +* +* minimize +* +* F = c[0] + c[1]*x[1] + c[2]*x[2] + ... + c[n]*x[n] +* +* subject to linear constraints +* +* a[1,1]*x[1] + a[1,2]*x[2] + ... + a[1,n]*x[n] = b[1] +* +* a[2,1]*x[1] + a[2,2]*x[2] + ... + a[2,n]*x[n] = b[2] +* +* . . . . . . +* +* a[m,1]*x[1] + a[m,2]*x[2] + ... + a[m,n]*x[n] = b[m] +* +* and non-negative variables +* +* x[1] >= 0, x[2] >= 0, ..., x[n] >= 0 +* +* where: +* F is the objective function; +* x[1], ..., x[n] are (structural) variables; +* c[0] is a constant term of the objective function; +* c[1], ..., c[n] are objective coefficients; +* a[1,1], ..., a[m,n] are constraint coefficients; +* b[1], ..., b[n] are right-hand sides. +* +* The solution is three vectors x, y, and z, which are stored by the +* routine in the arrays x, y, and z, respectively. These vectors +* correspond to the best primal-dual point found during optimization. +* They are approximate solution of the following system (which is the +* Karush-Kuhn-Tucker optimality conditions): +* +* A*x = b (primal feasibility condition) +* +* A'*y + z = c (dual feasibility condition) +* +* x'*z = 0 (primal-dual complementarity condition) +* +* x >= 0, z >= 0 (non-negativity condition) +* +* where: +* x[1], ..., x[n] are primal (structural) variables; +* y[1], ..., y[m] are dual variables (Lagrange multipliers) for +* equality constraints; +* z[1], ..., z[n] are dual variables (Lagrange multipliers) for +* non-negativity constraints. +* +* RETURNS +* +* 0 LP has been successfully solved. +* +* GLP_ENOCVG +* No convergence. +* +* GLP_EITLIM +* Iteration limit exceeded. +* +* GLP_EINSTAB +* Numeric instability on solving Newtonian system. +* +* In case of non-zero return code the routine returns the best point, +* which has been reached during optimization. */ + +int ipm_solve(glp_prob *P, const glp_iptcp *parm) +{ struct csa _dsa, *csa = &_dsa; + int m = P->m; + int n = P->n; + int nnz = P->nnz; + GLPROW *row; + GLPCOL *col; + GLPAIJ *aij; + int i, j, loc, ret, *A_ind, *A_ptr; + double dir, *A_val, *b, *c, *x, *y, *z; + xassert(m > 0); + xassert(n > 0); + /* allocate working arrays */ + A_ptr = xcalloc(1+m+1, sizeof(int)); + A_ind = xcalloc(1+nnz, sizeof(int)); + A_val = xcalloc(1+nnz, sizeof(double)); + b = xcalloc(1+m, sizeof(double)); + c = xcalloc(1+n, sizeof(double)); + x = xcalloc(1+n, sizeof(double)); + y = xcalloc(1+m, sizeof(double)); + z = xcalloc(1+n, sizeof(double)); + /* prepare rows and constraint coefficients */ + loc = 1; + for (i = 1; i <= m; i++) + { row = P->row[i]; + xassert(row->type == GLP_FX); + b[i] = row->lb * row->rii; + A_ptr[i] = loc; + for (aij = row->ptr; aij != NULL; aij = aij->r_next) + { A_ind[loc] = aij->col->j; + A_val[loc] = row->rii * aij->val * aij->col->sjj; + loc++; + } + } + A_ptr[m+1] = loc; + xassert(loc-1 == nnz); + /* prepare columns and objective coefficients */ + if (P->dir == GLP_MIN) + dir = +1.0; + else if (P->dir == GLP_MAX) + dir = -1.0; + else + xassert(P != P); + c[0] = dir * P->c0; + for (j = 1; j <= n; j++) + { col = P->col[j]; + xassert(col->type == GLP_LO && col->lb == 0.0); + c[j] = dir * col->coef * col->sjj; + } + /* allocate and initialize the common storage area */ + csa->m = m; + csa->n = n; + csa->A_ptr = A_ptr; + csa->A_ind = A_ind; + csa->A_val = A_val; + csa->b = b; + csa->c = c; + csa->x = x; + csa->y = y; + csa->z = z; + csa->parm = parm; + initialize(csa); + /* solve LP with the interior-point method */ + ret = ipm_main(csa); + /* deallocate the common storage area */ + terminate(csa); + /* determine solution status */ + if (ret == 0) + { /* optimal solution found */ + P->ipt_stat = GLP_OPT; + ret = 0; + } + else if (ret == 1) + { /* problem has no feasible (primal or dual) solution */ + P->ipt_stat = GLP_NOFEAS; + ret = 0; + } + else if (ret == 2) + { /* no convergence */ + P->ipt_stat = GLP_INFEAS; + ret = GLP_ENOCVG; + } + else if (ret == 3) + { /* iteration limit exceeded */ + P->ipt_stat = GLP_INFEAS; + ret = GLP_EITLIM; + } + else if (ret == 4) + { /* numeric instability on solving Newtonian system */ + P->ipt_stat = GLP_INFEAS; + ret = GLP_EINSTAB; + } + else + xassert(ret != ret); + /* store row solution components */ + for (i = 1; i <= m; i++) + { row = P->row[i]; + row->pval = row->lb; + row->dval = dir * y[i] * row->rii; + } + /* store column solution components */ + P->ipt_obj = P->c0; + for (j = 1; j <= n; j++) + { col = P->col[j]; + col->pval = x[j] * col->sjj; + col->dval = dir * z[j] / col->sjj; + P->ipt_obj += col->coef * col->pval; + } + /* free working arrays */ + xfree(A_ptr); + xfree(A_ind); + xfree(A_val); + xfree(b); + xfree(c); + xfree(x); + xfree(y); + xfree(z); + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpipm.h b/test/monniaux/glpk-4.65/src/draft/glpipm.h new file mode 100644 index 00000000..a5f94fec --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpipm.h @@ -0,0 +1,36 @@ +/* glpipm.h (primal-dual interior-point method) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 GLPIPM_H +#define GLPIPM_H + +#include "prob.h" + +#define ipm_solve _glp_ipm_solve +int ipm_solve(glp_prob *P, const glp_iptcp *parm); +/* core LP solver based on the interior-point method */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpmat.c b/test/monniaux/glpk-4.65/src/draft/glpmat.c new file mode 100644 index 00000000..97d1c651 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpmat.c @@ -0,0 +1,924 @@ +/* glpmat.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "glpmat.h" +#include "qmd.h" +#include "amd.h" +#include "colamd.h" + +/*---------------------------------------------------------------------- +-- check_fvs - check sparse vector in full-vector storage format. +-- +-- SYNOPSIS +-- +-- #include "glpmat.h" +-- int check_fvs(int n, int nnz, int ind[], double vec[]); +-- +-- DESCRIPTION +-- +-- The routine check_fvs checks if a given vector of dimension n in +-- full-vector storage format has correct representation. +-- +-- RETURNS +-- +-- The routine returns one of the following codes: +-- +-- 0 - the vector is correct; +-- 1 - the number of elements (n) is negative; +-- 2 - the number of non-zero elements (nnz) is negative; +-- 3 - some element index is out of range; +-- 4 - some element index is duplicate; +-- 5 - some non-zero element is out of pattern. */ + +int check_fvs(int n, int nnz, int ind[], double vec[]) +{ int i, t, ret, *flag = NULL; + /* check the number of elements */ + if (n < 0) + { ret = 1; + goto done; + } + /* check the number of non-zero elements */ + if (nnz < 0) + { ret = 2; + goto done; + } + /* check vector indices */ + flag = xcalloc(1+n, sizeof(int)); + for (i = 1; i <= n; i++) flag[i] = 0; + for (t = 1; t <= nnz; t++) + { i = ind[t]; + if (!(1 <= i && i <= n)) + { ret = 3; + goto done; + } + if (flag[i]) + { ret = 4; + goto done; + } + flag[i] = 1; + } + /* check vector elements */ + for (i = 1; i <= n; i++) + { if (!flag[i] && vec[i] != 0.0) + { ret = 5; + goto done; + } + } + /* the vector is ok */ + ret = 0; +done: if (flag != NULL) xfree(flag); + return ret; +} + +/*---------------------------------------------------------------------- +-- check_pattern - check pattern of sparse matrix. +-- +-- SYNOPSIS +-- +-- #include "glpmat.h" +-- int check_pattern(int m, int n, int A_ptr[], int A_ind[]); +-- +-- DESCRIPTION +-- +-- The routine check_pattern checks the pattern of a given mxn matrix +-- in storage-by-rows format. +-- +-- RETURNS +-- +-- The routine returns one of the following codes: +-- +-- 0 - the pattern is correct; +-- 1 - the number of rows (m) is negative; +-- 2 - the number of columns (n) is negative; +-- 3 - A_ptr[1] is not 1; +-- 4 - some column index is out of range; +-- 5 - some column indices are duplicate. */ + +int check_pattern(int m, int n, int A_ptr[], int A_ind[]) +{ int i, j, ptr, ret, *flag = NULL; + /* check the number of rows */ + if (m < 0) + { ret = 1; + goto done; + } + /* check the number of columns */ + if (n < 0) + { ret = 2; + goto done; + } + /* check location A_ptr[1] */ + if (A_ptr[1] != 1) + { ret = 3; + goto done; + } + /* check row patterns */ + flag = xcalloc(1+n, sizeof(int)); + for (j = 1; j <= n; j++) flag[j] = 0; + for (i = 1; i <= m; i++) + { /* check pattern of row i */ + for (ptr = A_ptr[i]; ptr < A_ptr[i+1]; ptr++) + { j = A_ind[ptr]; + /* check column index */ + if (!(1 <= j && j <= n)) + { ret = 4; + goto done; + } + /* check for duplication */ + if (flag[j]) + { ret = 5; + goto done; + } + flag[j] = 1; + } + /* clear flags */ + for (ptr = A_ptr[i]; ptr < A_ptr[i+1]; ptr++) + { j = A_ind[ptr]; + flag[j] = 0; + } + } + /* the pattern is ok */ + ret = 0; +done: if (flag != NULL) xfree(flag); + return ret; +} + +/*---------------------------------------------------------------------- +-- transpose - transpose sparse matrix. +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- void transpose(int m, int n, int A_ptr[], int A_ind[], +-- double A_val[], int AT_ptr[], int AT_ind[], double AT_val[]); +-- +-- *Description* +-- +-- For a given mxn sparse matrix A the routine transpose builds a nxm +-- sparse matrix A' which is a matrix transposed to A. +-- +-- The arrays A_ptr, A_ind, and A_val specify a given mxn matrix A to +-- be transposed in storage-by-rows format. The parameter A_val can be +-- NULL, in which case numeric values are not copied. The arrays A_ptr, +-- A_ind, and A_val are not changed on exit. +-- +-- On entry the arrays AT_ptr, AT_ind, and AT_val must be allocated, +-- but their content is ignored. On exit the routine stores a resultant +-- nxm matrix A' in these arrays in storage-by-rows format. Note that +-- if the parameter A_val is NULL, the array AT_val is not used. +-- +-- The routine transpose has a side effect that elements in rows of the +-- resultant matrix A' follow in ascending their column indices. */ + +void transpose(int m, int n, int A_ptr[], int A_ind[], double A_val[], + int AT_ptr[], int AT_ind[], double AT_val[]) +{ int i, j, t, beg, end, pos, len; + /* determine row lengths of resultant matrix */ + for (j = 1; j <= n; j++) AT_ptr[j] = 0; + for (i = 1; i <= m; i++) + { beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) AT_ptr[A_ind[t]]++; + } + /* set up row pointers of resultant matrix */ + pos = 1; + for (j = 1; j <= n; j++) + len = AT_ptr[j], pos += len, AT_ptr[j] = pos; + AT_ptr[n+1] = pos; + /* build resultant matrix */ + for (i = m; i >= 1; i--) + { beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) + { pos = --AT_ptr[A_ind[t]]; + AT_ind[pos] = i; + if (A_val != NULL) AT_val[pos] = A_val[t]; + } + } + return; +} + +/*---------------------------------------------------------------------- +-- adat_symbolic - compute S = P*A*D*A'*P' (symbolic phase). +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- int *adat_symbolic(int m, int n, int P_per[], int A_ptr[], +-- int A_ind[], int S_ptr[]); +-- +-- *Description* +-- +-- The routine adat_symbolic implements the symbolic phase to compute +-- symmetric matrix S = P*A*D*A'*P', where P is a permutation matrix, +-- A is a given sparse matrix, D is a diagonal matrix, A' is a matrix +-- transposed to A, P' is an inverse of P. +-- +-- The parameter m is the number of rows in A and the order of P. +-- +-- The parameter n is the number of columns in A and the order of D. +-- +-- The array P_per specifies permutation matrix P. It is not changed on +-- exit. +-- +-- The arrays A_ptr and A_ind specify the pattern of matrix A. They are +-- not changed on exit. +-- +-- On exit the routine stores the pattern of upper triangular part of +-- matrix S without diagonal elements in the arrays S_ptr and S_ind in +-- storage-by-rows format. The array S_ptr should be allocated on entry, +-- however, its content is ignored. The array S_ind is allocated by the +-- routine itself which returns a pointer to it. +-- +-- *Returns* +-- +-- The routine returns a pointer to the array S_ind. */ + +int *adat_symbolic(int m, int n, int P_per[], int A_ptr[], int A_ind[], + int S_ptr[]) +{ int i, j, t, ii, jj, tt, k, size, len; + int *S_ind, *AT_ptr, *AT_ind, *ind, *map, *temp; + /* build the pattern of A', which is a matrix transposed to A, to + efficiently access A in column-wise manner */ + AT_ptr = xcalloc(1+n+1, sizeof(int)); + AT_ind = xcalloc(A_ptr[m+1], sizeof(int)); + transpose(m, n, A_ptr, A_ind, NULL, AT_ptr, AT_ind, NULL); + /* allocate the array S_ind */ + size = A_ptr[m+1] - 1; + if (size < m) size = m; + S_ind = xcalloc(1+size, sizeof(int)); + /* allocate and initialize working arrays */ + ind = xcalloc(1+m, sizeof(int)); + map = xcalloc(1+m, sizeof(int)); + for (jj = 1; jj <= m; jj++) map[jj] = 0; + /* compute pattern of S; note that symbolically S = B*B', where + B = P*A, B' is matrix transposed to B */ + S_ptr[1] = 1; + for (ii = 1; ii <= m; ii++) + { /* compute pattern of ii-th row of S */ + len = 0; + i = P_per[ii]; /* i-th row of A = ii-th row of B */ + for (t = A_ptr[i]; t < A_ptr[i+1]; t++) + { k = A_ind[t]; + /* walk through k-th column of A */ + for (tt = AT_ptr[k]; tt < AT_ptr[k+1]; tt++) + { j = AT_ind[tt]; + jj = P_per[m+j]; /* j-th row of A = jj-th row of B */ + /* a[i,k] != 0 and a[j,k] != 0 ergo s[ii,jj] != 0 */ + if (ii < jj && !map[jj]) ind[++len] = jj, map[jj] = 1; + } + } + /* now (ind) is pattern of ii-th row of S */ + S_ptr[ii+1] = S_ptr[ii] + len; + /* at least (S_ptr[ii+1] - 1) locations should be available in + the array S_ind */ + if (S_ptr[ii+1] - 1 > size) + { temp = S_ind; + size += size; + S_ind = xcalloc(1+size, sizeof(int)); + memcpy(&S_ind[1], &temp[1], (S_ptr[ii] - 1) * sizeof(int)); + xfree(temp); + } + xassert(S_ptr[ii+1] - 1 <= size); + /* (ii-th row of S) := (ind) */ + memcpy(&S_ind[S_ptr[ii]], &ind[1], len * sizeof(int)); + /* clear the row pattern map */ + for (t = 1; t <= len; t++) map[ind[t]] = 0; + } + /* free working arrays */ + xfree(AT_ptr); + xfree(AT_ind); + xfree(ind); + xfree(map); + /* reallocate the array S_ind to free unused locations */ + temp = S_ind; + size = S_ptr[m+1] - 1; + S_ind = xcalloc(1+size, sizeof(int)); + memcpy(&S_ind[1], &temp[1], size * sizeof(int)); + xfree(temp); + return S_ind; +} + +/*---------------------------------------------------------------------- +-- adat_numeric - compute S = P*A*D*A'*P' (numeric phase). +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- void adat_numeric(int m, int n, int P_per[], +-- int A_ptr[], int A_ind[], double A_val[], double D_diag[], +-- int S_ptr[], int S_ind[], double S_val[], double S_diag[]); +-- +-- *Description* +-- +-- The routine adat_numeric implements the numeric phase to compute +-- symmetric matrix S = P*A*D*A'*P', where P is a permutation matrix, +-- A is a given sparse matrix, D is a diagonal matrix, A' is a matrix +-- transposed to A, P' is an inverse of P. +-- +-- The parameter m is the number of rows in A and the order of P. +-- +-- The parameter n is the number of columns in A and the order of D. +-- +-- The matrix P is specified in the array P_per, which is not changed +-- on exit. +-- +-- The matrix A is specified in the arrays A_ptr, A_ind, and A_val in +-- storage-by-rows format. These arrays are not changed on exit. +-- +-- Diagonal elements of the matrix D are specified in the array D_diag, +-- where D_diag[0] is not used, D_diag[i] = d[i,i] for i = 1, ..., n. +-- The array D_diag is not changed on exit. +-- +-- The pattern of the upper triangular part of the matrix S without +-- diagonal elements (previously computed by the routine adat_symbolic) +-- is specified in the arrays S_ptr and S_ind, which are not changed on +-- exit. Numeric values of non-diagonal elements of S are stored in +-- corresponding locations of the array S_val, and values of diagonal +-- elements of S are stored in locations S_diag[1], ..., S_diag[n]. */ + +void adat_numeric(int m, int n, int P_per[], + int A_ptr[], int A_ind[], double A_val[], double D_diag[], + int S_ptr[], int S_ind[], double S_val[], double S_diag[]) +{ int i, j, t, ii, jj, tt, beg, end, beg1, end1, k; + double sum, *work; + work = xcalloc(1+n, sizeof(double)); + for (j = 1; j <= n; j++) work[j] = 0.0; + /* compute S = B*D*B', where B = P*A, B' is a matrix transposed + to B */ + for (ii = 1; ii <= m; ii++) + { i = P_per[ii]; /* i-th row of A = ii-th row of B */ + /* (work) := (i-th row of A) */ + beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) + work[A_ind[t]] = A_val[t]; + /* compute ii-th row of S */ + beg = S_ptr[ii], end = S_ptr[ii+1]; + for (t = beg; t < end; t++) + { jj = S_ind[t]; + j = P_per[jj]; /* j-th row of A = jj-th row of B */ + /* s[ii,jj] := sum a[i,k] * d[k,k] * a[j,k] */ + sum = 0.0; + beg1 = A_ptr[j], end1 = A_ptr[j+1]; + for (tt = beg1; tt < end1; tt++) + { k = A_ind[tt]; + sum += work[k] * D_diag[k] * A_val[tt]; + } + S_val[t] = sum; + } + /* s[ii,ii] := sum a[i,k] * d[k,k] * a[i,k] */ + sum = 0.0; + beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) + { k = A_ind[t]; + sum += A_val[t] * D_diag[k] * A_val[t]; + work[k] = 0.0; + } + S_diag[ii] = sum; + } + xfree(work); + return; +} + +/*---------------------------------------------------------------------- +-- min_degree - minimum degree ordering. +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- void min_degree(int n, int A_ptr[], int A_ind[], int P_per[]); +-- +-- *Description* +-- +-- The routine min_degree uses the minimum degree ordering algorithm +-- to find a permutation matrix P for a given sparse symmetric positive +-- matrix A which minimizes the number of non-zeros in upper triangular +-- factor U for Cholesky factorization P*A*P' = U'*U. +-- +-- The parameter n is the order of matrices A and P. +-- +-- The pattern of the given matrix A is specified on entry in the arrays +-- A_ptr and A_ind in storage-by-rows format. Only the upper triangular +-- part without diagonal elements (which all are assumed to be non-zero) +-- should be specified as if A were upper triangular. The arrays A_ptr +-- and A_ind are not changed on exit. +-- +-- The permutation matrix P is stored by the routine in the array P_per +-- on exit. +-- +-- *Algorithm* +-- +-- The routine min_degree is based on some subroutines from the package +-- SPARSPAK (see comments in the module glpqmd). */ + +void min_degree(int n, int A_ptr[], int A_ind[], int P_per[]) +{ int i, j, ne, t, pos, len; + int *xadj, *adjncy, *deg, *marker, *rchset, *nbrhd, *qsize, + *qlink, nofsub; + /* determine number of non-zeros in complete pattern */ + ne = A_ptr[n+1] - 1; + ne += ne; + /* allocate working arrays */ + xadj = xcalloc(1+n+1, sizeof(int)); + adjncy = xcalloc(1+ne, sizeof(int)); + deg = xcalloc(1+n, sizeof(int)); + marker = xcalloc(1+n, sizeof(int)); + rchset = xcalloc(1+n, sizeof(int)); + nbrhd = xcalloc(1+n, sizeof(int)); + qsize = xcalloc(1+n, sizeof(int)); + qlink = xcalloc(1+n, sizeof(int)); + /* determine row lengths in complete pattern */ + for (i = 1; i <= n; i++) xadj[i] = 0; + for (i = 1; i <= n; i++) + { for (t = A_ptr[i]; t < A_ptr[i+1]; t++) + { j = A_ind[t]; + xassert(i < j && j <= n); + xadj[i]++, xadj[j]++; + } + } + /* set up row pointers for complete pattern */ + pos = 1; + for (i = 1; i <= n; i++) + len = xadj[i], pos += len, xadj[i] = pos; + xadj[n+1] = pos; + xassert(pos - 1 == ne); + /* construct complete pattern */ + for (i = 1; i <= n; i++) + { for (t = A_ptr[i]; t < A_ptr[i+1]; t++) + { j = A_ind[t]; + adjncy[--xadj[i]] = j, adjncy[--xadj[j]] = i; + } + } + /* call the main minimimum degree ordering routine */ + genqmd(&n, xadj, adjncy, P_per, P_per + n, deg, marker, rchset, + nbrhd, qsize, qlink, &nofsub); + /* make sure that permutation matrix P is correct */ + for (i = 1; i <= n; i++) + { j = P_per[i]; + xassert(1 <= j && j <= n); + xassert(P_per[n+j] == i); + } + /* free working arrays */ + xfree(xadj); + xfree(adjncy); + xfree(deg); + xfree(marker); + xfree(rchset); + xfree(nbrhd); + xfree(qsize); + xfree(qlink); + return; +} + +/**********************************************************************/ + +void amd_order1(int n, int A_ptr[], int A_ind[], int P_per[]) +{ /* approximate minimum degree ordering (AMD) */ + int k, ret; + double Control[AMD_CONTROL], Info[AMD_INFO]; + /* get the default parameters */ + amd_defaults(Control); +#if 0 + /* and print them */ + amd_control(Control); +#endif + /* make all indices 0-based */ + for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]--; + for (k = 1; k <= n+1; k++) A_ptr[k]--; + /* call the ordering routine */ + ret = amd_order(n, &A_ptr[1], &A_ind[1], &P_per[1], Control, Info) + ; +#if 0 + amd_info(Info); +#endif + xassert(ret == AMD_OK || ret == AMD_OK_BUT_JUMBLED); + /* retsore 1-based indices */ + for (k = 1; k <= n+1; k++) A_ptr[k]++; + for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]++; + /* patch up permutation matrix */ + memset(&P_per[n+1], 0, n * sizeof(int)); + for (k = 1; k <= n; k++) + { P_per[k]++; + xassert(1 <= P_per[k] && P_per[k] <= n); + xassert(P_per[n+P_per[k]] == 0); + P_per[n+P_per[k]] = k; + } + return; +} + +/**********************************************************************/ + +static void *allocate(size_t n, size_t size) +{ void *ptr; + ptr = xcalloc(n, size); + memset(ptr, 0, n * size); + return ptr; +} + +static void release(void *ptr) +{ xfree(ptr); + return; +} + +void symamd_ord(int n, int A_ptr[], int A_ind[], int P_per[]) +{ /* approximate minimum degree ordering (SYMAMD) */ + int k, ok; + int stats[COLAMD_STATS]; + /* make all indices 0-based */ + for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]--; + for (k = 1; k <= n+1; k++) A_ptr[k]--; + /* call the ordering routine */ + ok = symamd(n, &A_ind[1], &A_ptr[1], &P_per[1], NULL, stats, + allocate, release); +#if 0 + symamd_report(stats); +#endif + xassert(ok); + /* restore 1-based indices */ + for (k = 1; k <= n+1; k++) A_ptr[k]++; + for (k = 1; k < A_ptr[n+1]; k++) A_ind[k]++; + /* patch up permutation matrix */ + memset(&P_per[n+1], 0, n * sizeof(int)); + for (k = 1; k <= n; k++) + { P_per[k]++; + xassert(1 <= P_per[k] && P_per[k] <= n); + xassert(P_per[n+P_per[k]] == 0); + P_per[n+P_per[k]] = k; + } + return; +} + +/*---------------------------------------------------------------------- +-- chol_symbolic - compute Cholesky factorization (symbolic phase). +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- int *chol_symbolic(int n, int A_ptr[], int A_ind[], int U_ptr[]); +-- +-- *Description* +-- +-- The routine chol_symbolic implements the symbolic phase of Cholesky +-- factorization A = U'*U, where A is a given sparse symmetric positive +-- definite matrix, U is a resultant upper triangular factor, U' is a +-- matrix transposed to U. +-- +-- The parameter n is the order of matrices A and U. +-- +-- The pattern of the given matrix A is specified on entry in the arrays +-- A_ptr and A_ind in storage-by-rows format. Only the upper triangular +-- part without diagonal elements (which all are assumed to be non-zero) +-- should be specified as if A were upper triangular. The arrays A_ptr +-- and A_ind are not changed on exit. +-- +-- The pattern of the matrix U without diagonal elements (which all are +-- assumed to be non-zero) is stored on exit from the routine in the +-- arrays U_ptr and U_ind in storage-by-rows format. The array U_ptr +-- should be allocated on entry, however, its content is ignored. The +-- array U_ind is allocated by the routine which returns a pointer to it +-- on exit. +-- +-- *Returns* +-- +-- The routine returns a pointer to the array U_ind. +-- +-- *Method* +-- +-- The routine chol_symbolic computes the pattern of the matrix U in a +-- row-wise manner. No pivoting is used. +-- +-- It is known that to compute the pattern of row k of the matrix U we +-- need to merge the pattern of row k of the matrix A and the patterns +-- of each row i of U, where u[i,k] is non-zero (these rows are already +-- computed and placed above row k). +-- +-- However, to reduce the number of rows to be merged the routine uses +-- an advanced algorithm proposed in: +-- +-- D.J.Rose, R.E.Tarjan, and G.S.Lueker. Algorithmic aspects of vertex +-- elimination on graphs. SIAM J. Comput. 5, 1976, 266-83. +-- +-- The authors of the cited paper show that we have the same result if +-- we merge row k of the matrix A and such rows of the matrix U (among +-- rows 1, ..., k-1) whose leftmost non-diagonal non-zero element is +-- placed in k-th column. This feature signficantly reduces the number +-- of rows to be merged, especially on the final steps, where rows of +-- the matrix U become quite dense. +-- +-- To determine rows, which should be merged on k-th step, for a fixed +-- time the routine uses linked lists of row numbers of the matrix U. +-- Location head[k] contains the number of a first row, whose leftmost +-- non-diagonal non-zero element is placed in column k, and location +-- next[i] contains the number of a next row with the same property as +-- row i. */ + +int *chol_symbolic(int n, int A_ptr[], int A_ind[], int U_ptr[]) +{ int i, j, k, t, len, size, beg, end, min_j, *U_ind, *head, *next, + *ind, *map, *temp; + /* initially we assume that on computing the pattern of U fill-in + will double the number of non-zeros in A */ + size = A_ptr[n+1] - 1; + if (size < n) size = n; + size += size; + U_ind = xcalloc(1+size, sizeof(int)); + /* allocate and initialize working arrays */ + head = xcalloc(1+n, sizeof(int)); + for (i = 1; i <= n; i++) head[i] = 0; + next = xcalloc(1+n, sizeof(int)); + ind = xcalloc(1+n, sizeof(int)); + map = xcalloc(1+n, sizeof(int)); + for (j = 1; j <= n; j++) map[j] = 0; + /* compute the pattern of matrix U */ + U_ptr[1] = 1; + for (k = 1; k <= n; k++) + { /* compute the pattern of k-th row of U, which is the union of + k-th row of A and those rows of U (among 1, ..., k-1) whose + leftmost non-diagonal non-zero is placed in k-th column */ + /* (ind) := (k-th row of A) */ + len = A_ptr[k+1] - A_ptr[k]; + memcpy(&ind[1], &A_ind[A_ptr[k]], len * sizeof(int)); + for (t = 1; t <= len; t++) + { j = ind[t]; + xassert(k < j && j <= n); + map[j] = 1; + } + /* walk through rows of U whose leftmost non-diagonal non-zero + is placed in k-th column */ + for (i = head[k]; i != 0; i = next[i]) + { /* (ind) := (ind) union (i-th row of U) */ + beg = U_ptr[i], end = U_ptr[i+1]; + for (t = beg; t < end; t++) + { j = U_ind[t]; + if (j > k && !map[j]) ind[++len] = j, map[j] = 1; + } + } + /* now (ind) is the pattern of k-th row of U */ + U_ptr[k+1] = U_ptr[k] + len; + /* at least (U_ptr[k+1] - 1) locations should be available in + the array U_ind */ + if (U_ptr[k+1] - 1 > size) + { temp = U_ind; + size += size; + U_ind = xcalloc(1+size, sizeof(int)); + memcpy(&U_ind[1], &temp[1], (U_ptr[k] - 1) * sizeof(int)); + xfree(temp); + } + xassert(U_ptr[k+1] - 1 <= size); + /* (k-th row of U) := (ind) */ + memcpy(&U_ind[U_ptr[k]], &ind[1], len * sizeof(int)); + /* determine column index of leftmost non-diagonal non-zero in + k-th row of U and clear the row pattern map */ + min_j = n + 1; + for (t = 1; t <= len; t++) + { j = ind[t], map[j] = 0; + if (min_j > j) min_j = j; + } + /* include k-th row into corresponding linked list */ + if (min_j <= n) next[k] = head[min_j], head[min_j] = k; + } + /* free working arrays */ + xfree(head); + xfree(next); + xfree(ind); + xfree(map); + /* reallocate the array U_ind to free unused locations */ + temp = U_ind; + size = U_ptr[n+1] - 1; + U_ind = xcalloc(1+size, sizeof(int)); + memcpy(&U_ind[1], &temp[1], size * sizeof(int)); + xfree(temp); + return U_ind; +} + +/*---------------------------------------------------------------------- +-- chol_numeric - compute Cholesky factorization (numeric phase). +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- int chol_numeric(int n, +-- int A_ptr[], int A_ind[], double A_val[], double A_diag[], +-- int U_ptr[], int U_ind[], double U_val[], double U_diag[]); +-- +-- *Description* +-- +-- The routine chol_symbolic implements the numeric phase of Cholesky +-- factorization A = U'*U, where A is a given sparse symmetric positive +-- definite matrix, U is a resultant upper triangular factor, U' is a +-- matrix transposed to U. +-- +-- The parameter n is the order of matrices A and U. +-- +-- Upper triangular part of the matrix A without diagonal elements is +-- specified in the arrays A_ptr, A_ind, and A_val in storage-by-rows +-- format. Diagonal elements of A are specified in the array A_diag, +-- where A_diag[0] is not used, A_diag[i] = a[i,i] for i = 1, ..., n. +-- The arrays A_ptr, A_ind, A_val, and A_diag are not changed on exit. +-- +-- The pattern of the matrix U without diagonal elements (previously +-- computed with the routine chol_symbolic) is specified in the arrays +-- U_ptr and U_ind, which are not changed on exit. Numeric values of +-- non-diagonal elements of U are stored in corresponding locations of +-- the array U_val, and values of diagonal elements of U are stored in +-- locations U_diag[1], ..., U_diag[n]. +-- +-- *Returns* +-- +-- The routine returns the number of non-positive diagonal elements of +-- the matrix U which have been replaced by a huge positive number (see +-- the method description below). Zero return code means the matrix A +-- has been successfully factorized. +-- +-- *Method* +-- +-- The routine chol_numeric computes the matrix U in a row-wise manner +-- using standard gaussian elimination technique. No pivoting is used. +-- +-- Initially the routine sets U = A, and before k-th elimination step +-- the matrix U is the following: +-- +-- 1 k n +-- 1 x x x x x x x x x x +-- . x x x x x x x x x +-- . . x x x x x x x x +-- . . . x x x x x x x +-- k . . . . * * * * * * +-- . . . . * * * * * * +-- . . . . * * * * * * +-- . . . . * * * * * * +-- . . . . * * * * * * +-- n . . . . * * * * * * +-- +-- where 'x' are elements of already computed rows, '*' are elements of +-- the active submatrix. (Note that the lower triangular part of the +-- active submatrix being symmetric is not stored and diagonal elements +-- are stored separately in the array U_diag.) +-- +-- The matrix A is assumed to be positive definite. However, if it is +-- close to semi-definite, on some elimination step a pivot u[k,k] may +-- happen to be non-positive due to round-off errors. In this case the +-- routine uses a technique proposed in: +-- +-- S.J.Wright. The Cholesky factorization in interior-point and barrier +-- methods. Preprint MCS-P600-0596, Mathematics and Computer Science +-- Division, Argonne National Laboratory, Argonne, Ill., May 1996. +-- +-- The routine just replaces non-positive u[k,k] by a huge positive +-- number. This involves non-diagonal elements in k-th row of U to be +-- close to zero that, in turn, involves k-th component of a solution +-- vector to be close to zero. Note, however, that this technique works +-- only if the system A*x = b is consistent. */ + +int chol_numeric(int n, + int A_ptr[], int A_ind[], double A_val[], double A_diag[], + int U_ptr[], int U_ind[], double U_val[], double U_diag[]) +{ int i, j, k, t, t1, beg, end, beg1, end1, count = 0; + double ukk, uki, *work; + work = xcalloc(1+n, sizeof(double)); + for (j = 1; j <= n; j++) work[j] = 0.0; + /* U := (upper triangle of A) */ + /* note that the upper traingle of A is a subset of U */ + for (i = 1; i <= n; i++) + { beg = A_ptr[i], end = A_ptr[i+1]; + for (t = beg; t < end; t++) + j = A_ind[t], work[j] = A_val[t]; + beg = U_ptr[i], end = U_ptr[i+1]; + for (t = beg; t < end; t++) + j = U_ind[t], U_val[t] = work[j], work[j] = 0.0; + U_diag[i] = A_diag[i]; + } + /* main elimination loop */ + for (k = 1; k <= n; k++) + { /* transform k-th row of U */ + ukk = U_diag[k]; + if (ukk > 0.0) + U_diag[k] = ukk = sqrt(ukk); + else + U_diag[k] = ukk = DBL_MAX, count++; + /* (work) := (transformed k-th row) */ + beg = U_ptr[k], end = U_ptr[k+1]; + for (t = beg; t < end; t++) + work[U_ind[t]] = (U_val[t] /= ukk); + /* transform other rows of U */ + for (t = beg; t < end; t++) + { i = U_ind[t]; + xassert(i > k); + /* (i-th row) := (i-th row) - u[k,i] * (k-th row) */ + uki = work[i]; + beg1 = U_ptr[i], end1 = U_ptr[i+1]; + for (t1 = beg1; t1 < end1; t1++) + U_val[t1] -= uki * work[U_ind[t1]]; + U_diag[i] -= uki * uki; + } + /* (work) := 0 */ + for (t = beg; t < end; t++) + work[U_ind[t]] = 0.0; + } + xfree(work); + return count; +} + +/*---------------------------------------------------------------------- +-- u_solve - solve upper triangular system U*x = b. +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- void u_solve(int n, int U_ptr[], int U_ind[], double U_val[], +-- double U_diag[], double x[]); +-- +-- *Description* +-- +-- The routine u_solve solves an linear system U*x = b, where U is an +-- upper triangular matrix. +-- +-- The parameter n is the order of matrix U. +-- +-- The matrix U without diagonal elements is specified in the arrays +-- U_ptr, U_ind, and U_val in storage-by-rows format. Diagonal elements +-- of U are specified in the array U_diag, where U_diag[0] is not used, +-- U_diag[i] = u[i,i] for i = 1, ..., n. All these four arrays are not +-- changed on exit. +-- +-- The right-hand side vector b is specified on entry in the array x, +-- where x[0] is not used, and x[i] = b[i] for i = 1, ..., n. On exit +-- the routine stores computed components of the vector of unknowns x +-- in the array x in the same manner. */ + +void u_solve(int n, int U_ptr[], int U_ind[], double U_val[], + double U_diag[], double x[]) +{ int i, t, beg, end; + double temp; + for (i = n; i >= 1; i--) + { temp = x[i]; + beg = U_ptr[i], end = U_ptr[i+1]; + for (t = beg; t < end; t++) + temp -= U_val[t] * x[U_ind[t]]; + xassert(U_diag[i] != 0.0); + x[i] = temp / U_diag[i]; + } + return; +} + +/*---------------------------------------------------------------------- +-- ut_solve - solve lower triangular system U'*x = b. +-- +-- *Synopsis* +-- +-- #include "glpmat.h" +-- void ut_solve(int n, int U_ptr[], int U_ind[], double U_val[], +-- double U_diag[], double x[]); +-- +-- *Description* +-- +-- The routine ut_solve solves an linear system U'*x = b, where U is a +-- matrix transposed to an upper triangular matrix. +-- +-- The parameter n is the order of matrix U. +-- +-- The matrix U without diagonal elements is specified in the arrays +-- U_ptr, U_ind, and U_val in storage-by-rows format. Diagonal elements +-- of U are specified in the array U_diag, where U_diag[0] is not used, +-- U_diag[i] = u[i,i] for i = 1, ..., n. All these four arrays are not +-- changed on exit. +-- +-- The right-hand side vector b is specified on entry in the array x, +-- where x[0] is not used, and x[i] = b[i] for i = 1, ..., n. On exit +-- the routine stores computed components of the vector of unknowns x +-- in the array x in the same manner. */ + +void ut_solve(int n, int U_ptr[], int U_ind[], double U_val[], + double U_diag[], double x[]) +{ int i, t, beg, end; + double temp; + for (i = 1; i <= n; i++) + { xassert(U_diag[i] != 0.0); + temp = (x[i] /= U_diag[i]); + if (temp == 0.0) continue; + beg = U_ptr[i], end = U_ptr[i+1]; + for (t = beg; t < end; t++) + x[U_ind[t]] -= U_val[t] * temp; + } + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpmat.h b/test/monniaux/glpk-4.65/src/draft/glpmat.h new file mode 100644 index 00000000..5b058437 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpmat.h @@ -0,0 +1,198 @@ +/* glpmat.h (linear algebra routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 GLPMAT_H +#define GLPMAT_H + +/*********************************************************************** +* FULL-VECTOR STORAGE +* +* For a sparse vector x having n elements, ne of which are non-zero, +* the full-vector storage format uses two arrays x_ind and x_vec, which +* are set up as follows: +* +* x_ind is an integer array of length [1+ne]. Location x_ind[0] is +* not used, and locations x_ind[1], ..., x_ind[ne] contain indices of +* non-zero elements in vector x. +* +* x_vec is a floating-point array of length [1+n]. Location x_vec[0] +* is not used, and locations x_vec[1], ..., x_vec[n] contain numeric +* values of ALL elements in vector x, including its zero elements. +* +* Let, for example, the following sparse vector x be given: +* +* (0, 1, 0, 0, 2, 3, 0, 4) +* +* Then the arrays are: +* +* x_ind = { X; 2, 5, 6, 8 } +* +* x_vec = { X; 0, 1, 0, 0, 2, 3, 0, 4 } +* +* COMPRESSED-VECTOR STORAGE +* +* For a sparse vector x having n elements, ne of which are non-zero, +* the compressed-vector storage format uses two arrays x_ind and x_vec, +* which are set up as follows: +* +* x_ind is an integer array of length [1+ne]. Location x_ind[0] is +* not used, and locations x_ind[1], ..., x_ind[ne] contain indices of +* non-zero elements in vector x. +* +* x_vec is a floating-point array of length [1+ne]. Location x_vec[0] +* is not used, and locations x_vec[1], ..., x_vec[ne] contain numeric +* values of corresponding non-zero elements in vector x. +* +* Let, for example, the following sparse vector x be given: +* +* (0, 1, 0, 0, 2, 3, 0, 4) +* +* Then the arrays are: +* +* x_ind = { X; 2, 5, 6, 8 } +* +* x_vec = { X; 1, 2, 3, 4 } +* +* STORAGE-BY-ROWS +* +* For a sparse matrix A, which has m rows, n columns, and ne non-zero +* elements the storage-by-rows format uses three arrays A_ptr, A_ind, +* and A_val, which are set up as follows: +* +* A_ptr is an integer array of length [1+m+1] also called "row pointer +* array". It contains the relative starting positions of each row of A +* in the arrays A_ind and A_val, i.e. element A_ptr[i], 1 <= i <= m, +* indicates where row i begins in the arrays A_ind and A_val. If all +* elements in row i are zero, then A_ptr[i] = A_ptr[i+1]. Location +* A_ptr[0] is not used, location A_ptr[1] must contain 1, and location +* A_ptr[m+1] must contain ne+1 that indicates the position after the +* last element in the arrays A_ind and A_val. +* +* A_ind is an integer array of length [1+ne]. Location A_ind[0] is not +* used, and locations A_ind[1], ..., A_ind[ne] contain column indices +* of (non-zero) elements in matrix A. +* +* A_val is a floating-point array of length [1+ne]. Location A_val[0] +* is not used, and locations A_val[1], ..., A_val[ne] contain numeric +* values of non-zero elements in matrix A. +* +* Non-zero elements of matrix A are stored contiguously, and the rows +* of matrix A are stored consecutively from 1 to m in the arrays A_ind +* and A_val. The elements in each row of A may be stored in any order +* in A_ind and A_val. Note that elements with duplicate column indices +* are not allowed. +* +* Let, for example, the following sparse matrix A be given: +* +* | 11 . 13 . . . | +* | 21 22 . 24 . . | +* | . 32 33 . . . | +* | . . 43 44 . 46 | +* | . . . . . . | +* | 61 62 . . . 66 | +* +* Then the arrays are: +* +* A_ptr = { X; 1, 3, 6, 8, 11, 11; 14 } +* +* A_ind = { X; 1, 3; 4, 2, 1; 2, 3; 4, 3, 6; 1, 2, 6 } +* +* A_val = { X; 11, 13; 24, 22, 21; 32, 33; 44, 43, 46; 61, 62, 66 } +* +* PERMUTATION MATRICES +* +* Let P be a permutation matrix of the order n. It is represented as +* an integer array P_per of length [1+n+n] as follows: if p[i,j] = 1, +* then P_per[i] = j and P_per[n+j] = i. Location P_per[0] is not used. +* +* Let A' = P*A. If i-th row of A corresponds to i'-th row of A', then +* P_per[i'] = i and P_per[n+i] = i'. +* +* References: +* +* 1. Gustavson F.G. Some basic techniques for solving sparse systems of +* linear equations. In Rose and Willoughby (1972), pp. 41-52. +* +* 2. Basic Linear Algebra Subprograms Technical (BLAST) Forum Standard. +* University of Tennessee (2001). */ + +#define check_fvs _glp_mat_check_fvs +int check_fvs(int n, int nnz, int ind[], double vec[]); +/* check sparse vector in full-vector storage format */ + +#define check_pattern _glp_mat_check_pattern +int check_pattern(int m, int n, int A_ptr[], int A_ind[]); +/* check pattern of sparse matrix */ + +#define transpose _glp_mat_transpose +void transpose(int m, int n, int A_ptr[], int A_ind[], double A_val[], + int AT_ptr[], int AT_ind[], double AT_val[]); +/* transpose sparse matrix */ + +#define adat_symbolic _glp_mat_adat_symbolic +int *adat_symbolic(int m, int n, int P_per[], int A_ptr[], int A_ind[], + int S_ptr[]); +/* compute S = P*A*D*A'*P' (symbolic phase) */ + +#define adat_numeric _glp_mat_adat_numeric +void adat_numeric(int m, int n, int P_per[], + int A_ptr[], int A_ind[], double A_val[], double D_diag[], + int S_ptr[], int S_ind[], double S_val[], double S_diag[]); +/* compute S = P*A*D*A'*P' (numeric phase) */ + +#define min_degree _glp_mat_min_degree +void min_degree(int n, int A_ptr[], int A_ind[], int P_per[]); +/* minimum degree ordering */ + +#define amd_order1 _glp_mat_amd_order1 +void amd_order1(int n, int A_ptr[], int A_ind[], int P_per[]); +/* approximate minimum degree ordering (AMD) */ + +#define symamd_ord _glp_mat_symamd_ord +void symamd_ord(int n, int A_ptr[], int A_ind[], int P_per[]); +/* approximate minimum degree ordering (SYMAMD) */ + +#define chol_symbolic _glp_mat_chol_symbolic +int *chol_symbolic(int n, int A_ptr[], int A_ind[], int U_ptr[]); +/* compute Cholesky factorization (symbolic phase) */ + +#define chol_numeric _glp_mat_chol_numeric +int chol_numeric(int n, + int A_ptr[], int A_ind[], double A_val[], double A_diag[], + int U_ptr[], int U_ind[], double U_val[], double U_diag[]); +/* compute Cholesky factorization (numeric phase) */ + +#define u_solve _glp_mat_u_solve +void u_solve(int n, int U_ptr[], int U_ind[], double U_val[], + double U_diag[], double x[]); +/* solve upper triangular system U*x = b */ + +#define ut_solve _glp_mat_ut_solve +void ut_solve(int n, int U_ptr[], int U_ind[], double U_val[], + double U_diag[], double x[]); +/* solve lower triangular system U'*x = b */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glprgr.c b/test/monniaux/glpk-4.65/src/draft/glprgr.c new file mode 100644 index 00000000..fbff6b8d --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glprgr.c @@ -0,0 +1,173 @@ +/* glprgr.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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/>. +***********************************************************************/ + +#define _GLPSTD_ERRNO +#define _GLPSTD_STDIO +#include "env.h" +#include "glprgr.h" +#define xfault xerror + +/*********************************************************************** +* NAME +* +* rgr_write_bmp16 - write 16-color raster image in BMP file format +* +* SYNOPSIS +* +* #include "glprgr.h" +* int rgr_write_bmp16(const char *fname, int m, int n, const char +* map[]); +* +* DESCRIPTION +* +* The routine rgr_write_bmp16 writes 16-color raster image in +* uncompressed BMP file format (Windows bitmap) to a binary file whose +* name is specified by the character string fname. +* +* The parameters m and n specify, respectively, the number of rows and +* the numbers of columns (i.e. height and width) of the raster image. +* +* The character array map has m*n elements. Elements map[0, ..., n-1] +* correspond to the first (top) scanline, elements map[n, ..., 2*n-1] +* correspond to the second scanline, etc. +* +* Each element of the array map specifies a color of the corresponding +* pixel as 8-bit binary number XXXXIRGB, where four high-order bits (X) +* are ignored, I is high intensity bit, R is red color bit, G is green +* color bit, and B is blue color bit. Thus, all 16 possible colors are +* coded as following hexadecimal numbers: +* +* 0x00 = black 0x08 = dark gray +* 0x01 = blue 0x09 = bright blue +* 0x02 = green 0x0A = bright green +* 0x03 = cyan 0x0B = bright cyan +* 0x04 = red 0x0C = bright red +* 0x05 = magenta 0x0D = bright magenta +* 0x06 = brown 0x0E = yellow +* 0x07 = light gray 0x0F = white +* +* RETURNS +* +* If no error occured, the routine returns zero; otherwise, it prints +* an appropriate error message and returns non-zero. */ + +static void put_byte(FILE *fp, int c) +{ fputc(c, fp); + return; +} + +static void put_word(FILE *fp, int w) +{ /* big endian */ + put_byte(fp, w); + put_byte(fp, w >> 8); + return; +} + +static void put_dword(FILE *fp, int d) +{ /* big endian */ + put_word(fp, d); + put_word(fp, d >> 16); + return; +} + +int rgr_write_bmp16(const char *fname, int m, int n, const char map[]) +{ FILE *fp; + int offset, bmsize, i, j, b, ret = 0; + if (!(1 <= m && m <= 32767)) + xfault("rgr_write_bmp16: m = %d; invalid height\n", m); + if (!(1 <= n && n <= 32767)) + xfault("rgr_write_bmp16: n = %d; invalid width\n", n); + fp = fopen(fname, "wb"); + if (fp == NULL) + { xprintf("rgr_write_bmp16: unable to create '%s' - %s\n", +#if 0 /* 29/I-2017 */ + fname, strerror(errno)); +#else + fname, xstrerr(errno)); +#endif + ret = 1; + goto fini; + } + offset = 14 + 40 + 16 * 4; + bmsize = (4 * n + 31) / 32; + /* struct BMPFILEHEADER (14 bytes) */ + /* UINT bfType */ put_byte(fp, 'B'), put_byte(fp, 'M'); + /* DWORD bfSize */ put_dword(fp, offset + bmsize * 4); + /* UINT bfReserved1 */ put_word(fp, 0); + /* UNIT bfReserved2 */ put_word(fp, 0); + /* DWORD bfOffBits */ put_dword(fp, offset); + /* struct BMPINFOHEADER (40 bytes) */ + /* DWORD biSize */ put_dword(fp, 40); + /* LONG biWidth */ put_dword(fp, n); + /* LONG biHeight */ put_dword(fp, m); + /* WORD biPlanes */ put_word(fp, 1); + /* WORD biBitCount */ put_word(fp, 4); + /* DWORD biCompression */ put_dword(fp, 0 /* BI_RGB */); + /* DWORD biSizeImage */ put_dword(fp, 0); + /* LONG biXPelsPerMeter */ put_dword(fp, 2953 /* 75 dpi */); + /* LONG biYPelsPerMeter */ put_dword(fp, 2953 /* 75 dpi */); + /* DWORD biClrUsed */ put_dword(fp, 0); + /* DWORD biClrImportant */ put_dword(fp, 0); + /* struct RGBQUAD (16 * 4 = 64 bytes) */ + /* CGA-compatible colors: */ + /* 0x00 = black */ put_dword(fp, 0x000000); + /* 0x01 = blue */ put_dword(fp, 0x000080); + /* 0x02 = green */ put_dword(fp, 0x008000); + /* 0x03 = cyan */ put_dword(fp, 0x008080); + /* 0x04 = red */ put_dword(fp, 0x800000); + /* 0x05 = magenta */ put_dword(fp, 0x800080); + /* 0x06 = brown */ put_dword(fp, 0x808000); + /* 0x07 = light gray */ put_dword(fp, 0xC0C0C0); + /* 0x08 = dark gray */ put_dword(fp, 0x808080); + /* 0x09 = bright blue */ put_dword(fp, 0x0000FF); + /* 0x0A = bright green */ put_dword(fp, 0x00FF00); + /* 0x0B = bright cyan */ put_dword(fp, 0x00FFFF); + /* 0x0C = bright red */ put_dword(fp, 0xFF0000); + /* 0x0D = bright magenta */ put_dword(fp, 0xFF00FF); + /* 0x0E = yellow */ put_dword(fp, 0xFFFF00); + /* 0x0F = white */ put_dword(fp, 0xFFFFFF); + /* pixel data bits */ + b = 0; + for (i = m - 1; i >= 0; i--) + { for (j = 0; j < ((n + 7) / 8) * 8; j++) + { b <<= 4; + b |= (j < n ? map[i * n + j] & 15 : 0); + if (j & 1) put_byte(fp, b); + } + } + fflush(fp); + if (ferror(fp)) + { xprintf("rgr_write_bmp16: write error on '%s' - %s\n", +#if 0 /* 29/I-2017 */ + fname, strerror(errno)); +#else + fname, xstrerr(errno)); +#endif + ret = 1; + } +fini: if (fp != NULL) fclose(fp); + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glprgr.h b/test/monniaux/glpk-4.65/src/draft/glprgr.h new file mode 100644 index 00000000..71e089e9 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glprgr.h @@ -0,0 +1,34 @@ +/* glprgr.h (raster graphics) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 GLPRGR_H +#define GLPRGR_H + +#define rgr_write_bmp16 _glp_rgr_write_bmp16 +int rgr_write_bmp16(const char *fname, int m, int n, const char map[]); +/* write 16-color raster image in BMP file format */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpscl.c b/test/monniaux/glpk-4.65/src/draft/glpscl.c new file mode 100644 index 00000000..de769a8b --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpscl.c @@ -0,0 +1,478 @@ +/* glpscl.c (problem scaling routines) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "misc.h" +#include "prob.h" + +/*********************************************************************** +* min_row_aij - determine minimal |a[i,j]| in i-th row +* +* This routine returns minimal magnitude of (non-zero) constraint +* coefficients in i-th row of the constraint matrix. +* +* If the parameter scaled is zero, the original constraint matrix A is +* assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. +* +* If i-th row of the matrix is empty, the routine returns 1. */ + +static double min_row_aij(glp_prob *lp, int i, int scaled) +{ GLPAIJ *aij; + double min_aij, temp; + xassert(1 <= i && i <= lp->m); + min_aij = 1.0; + for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) + { temp = fabs(aij->val); + if (scaled) temp *= (aij->row->rii * aij->col->sjj); + if (aij->r_prev == NULL || min_aij > temp) + min_aij = temp; + } + return min_aij; +} + +/*********************************************************************** +* max_row_aij - determine maximal |a[i,j]| in i-th row +* +* This routine returns maximal magnitude of (non-zero) constraint +* coefficients in i-th row of the constraint matrix. +* +* If the parameter scaled is zero, the original constraint matrix A is +* assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. +* +* If i-th row of the matrix is empty, the routine returns 1. */ + +static double max_row_aij(glp_prob *lp, int i, int scaled) +{ GLPAIJ *aij; + double max_aij, temp; + xassert(1 <= i && i <= lp->m); + max_aij = 1.0; + for (aij = lp->row[i]->ptr; aij != NULL; aij = aij->r_next) + { temp = fabs(aij->val); + if (scaled) temp *= (aij->row->rii * aij->col->sjj); + if (aij->r_prev == NULL || max_aij < temp) + max_aij = temp; + } + return max_aij; +} + +/*********************************************************************** +* min_col_aij - determine minimal |a[i,j]| in j-th column +* +* This routine returns minimal magnitude of (non-zero) constraint +* coefficients in j-th column of the constraint matrix. +* +* If the parameter scaled is zero, the original constraint matrix A is +* assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. +* +* If j-th column of the matrix is empty, the routine returns 1. */ + +static double min_col_aij(glp_prob *lp, int j, int scaled) +{ GLPAIJ *aij; + double min_aij, temp; + xassert(1 <= j && j <= lp->n); + min_aij = 1.0; + for (aij = lp->col[j]->ptr; aij != NULL; aij = aij->c_next) + { temp = fabs(aij->val); + if (scaled) temp *= (aij->row->rii * aij->col->sjj); + if (aij->c_prev == NULL || min_aij > temp) + min_aij = temp; + } + return min_aij; +} + +/*********************************************************************** +* max_col_aij - determine maximal |a[i,j]| in j-th column +* +* This routine returns maximal magnitude of (non-zero) constraint +* coefficients in j-th column of the constraint matrix. +* +* If the parameter scaled is zero, the original constraint matrix A is +* assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. +* +* If j-th column of the matrix is empty, the routine returns 1. */ + +static double max_col_aij(glp_prob *lp, int j, int scaled) +{ GLPAIJ *aij; + double max_aij, temp; + xassert(1 <= j && j <= lp->n); + max_aij = 1.0; + for (aij = lp->col[j]->ptr; aij != NULL; aij = aij->c_next) + { temp = fabs(aij->val); + if (scaled) temp *= (aij->row->rii * aij->col->sjj); + if (aij->c_prev == NULL || max_aij < temp) + max_aij = temp; + } + return max_aij; +} + +/*********************************************************************** +* min_mat_aij - determine minimal |a[i,j]| in constraint matrix +* +* This routine returns minimal magnitude of (non-zero) constraint +* coefficients in the constraint matrix. +* +* If the parameter scaled is zero, the original constraint matrix A is +* assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. +* +* If the matrix is empty, the routine returns 1. */ + +static double min_mat_aij(glp_prob *lp, int scaled) +{ int i; + double min_aij, temp; + min_aij = 1.0; + for (i = 1; i <= lp->m; i++) + { temp = min_row_aij(lp, i, scaled); + if (i == 1 || min_aij > temp) + min_aij = temp; + } + return min_aij; +} + +/*********************************************************************** +* max_mat_aij - determine maximal |a[i,j]| in constraint matrix +* +* This routine returns maximal magnitude of (non-zero) constraint +* coefficients in the constraint matrix. +* +* If the parameter scaled is zero, the original constraint matrix A is +* assumed. Otherwise, the scaled constraint matrix R*A*S is assumed. +* +* If the matrix is empty, the routine returns 1. */ + +static double max_mat_aij(glp_prob *lp, int scaled) +{ int i; + double max_aij, temp; + max_aij = 1.0; + for (i = 1; i <= lp->m; i++) + { temp = max_row_aij(lp, i, scaled); + if (i == 1 || max_aij < temp) + max_aij = temp; + } + return max_aij; +} + +/*********************************************************************** +* eq_scaling - perform equilibration scaling +* +* This routine performs equilibration scaling of rows and columns of +* the constraint matrix. +* +* If the parameter flag is zero, the routine scales rows at first and +* then columns. Otherwise, the routine scales columns and then rows. +* +* Rows are scaled as follows: +* +* n +* a'[i,j] = a[i,j] / max |a[i,j]|, i = 1,...,m. +* j=1 +* +* This makes the infinity (maximum) norm of each row of the matrix +* equal to 1. +* +* Columns are scaled as follows: +* +* m +* a'[i,j] = a[i,j] / max |a[i,j]|, j = 1,...,n. +* i=1 +* +* This makes the infinity (maximum) norm of each column of the matrix +* equal to 1. */ + +static void eq_scaling(glp_prob *lp, int flag) +{ int i, j, pass; + double temp; + xassert(flag == 0 || flag == 1); + for (pass = 0; pass <= 1; pass++) + { if (pass == flag) + { /* scale rows */ + for (i = 1; i <= lp->m; i++) + { temp = max_row_aij(lp, i, 1); + glp_set_rii(lp, i, glp_get_rii(lp, i) / temp); + } + } + else + { /* scale columns */ + for (j = 1; j <= lp->n; j++) + { temp = max_col_aij(lp, j, 1); + glp_set_sjj(lp, j, glp_get_sjj(lp, j) / temp); + } + } + } + return; +} + +/*********************************************************************** +* gm_scaling - perform geometric mean scaling +* +* This routine performs geometric mean scaling of rows and columns of +* the constraint matrix. +* +* If the parameter flag is zero, the routine scales rows at first and +* then columns. Otherwise, the routine scales columns and then rows. +* +* Rows are scaled as follows: +* +* a'[i,j] = a[i,j] / sqrt(alfa[i] * beta[i]), i = 1,...,m, +* +* where: +* n n +* alfa[i] = min |a[i,j]|, beta[i] = max |a[i,j]|. +* j=1 j=1 +* +* This allows decreasing the ratio beta[i] / alfa[i] for each row of +* the matrix. +* +* Columns are scaled as follows: +* +* a'[i,j] = a[i,j] / sqrt(alfa[j] * beta[j]), j = 1,...,n, +* +* where: +* m m +* alfa[j] = min |a[i,j]|, beta[j] = max |a[i,j]|. +* i=1 i=1 +* +* This allows decreasing the ratio beta[j] / alfa[j] for each column +* of the matrix. */ + +static void gm_scaling(glp_prob *lp, int flag) +{ int i, j, pass; + double temp; + xassert(flag == 0 || flag == 1); + for (pass = 0; pass <= 1; pass++) + { if (pass == flag) + { /* scale rows */ + for (i = 1; i <= lp->m; i++) + { temp = min_row_aij(lp, i, 1) * max_row_aij(lp, i, 1); + glp_set_rii(lp, i, glp_get_rii(lp, i) / sqrt(temp)); + } + } + else + { /* scale columns */ + for (j = 1; j <= lp->n; j++) + { temp = min_col_aij(lp, j, 1) * max_col_aij(lp, j, 1); + glp_set_sjj(lp, j, glp_get_sjj(lp, j) / sqrt(temp)); + } + } + } + return; +} + +/*********************************************************************** +* max_row_ratio - determine worst scaling "quality" for rows +* +* This routine returns the worst scaling "quality" for rows of the +* currently scaled constraint matrix: +* +* m +* ratio = max ratio[i], +* i=1 +* where: +* n n +* ratio[i] = max |a[i,j]| / min |a[i,j]|, 1 <= i <= m, +* j=1 j=1 +* +* is the scaling "quality" of i-th row. */ + +static double max_row_ratio(glp_prob *lp) +{ int i; + double ratio, temp; + ratio = 1.0; + for (i = 1; i <= lp->m; i++) + { temp = max_row_aij(lp, i, 1) / min_row_aij(lp, i, 1); + if (i == 1 || ratio < temp) ratio = temp; + } + return ratio; +} + +/*********************************************************************** +* max_col_ratio - determine worst scaling "quality" for columns +* +* This routine returns the worst scaling "quality" for columns of the +* currently scaled constraint matrix: +* +* n +* ratio = max ratio[j], +* j=1 +* where: +* m m +* ratio[j] = max |a[i,j]| / min |a[i,j]|, 1 <= j <= n, +* i=1 i=1 +* +* is the scaling "quality" of j-th column. */ + +static double max_col_ratio(glp_prob *lp) +{ int j; + double ratio, temp; + ratio = 1.0; + for (j = 1; j <= lp->n; j++) + { temp = max_col_aij(lp, j, 1) / min_col_aij(lp, j, 1); + if (j == 1 || ratio < temp) ratio = temp; + } + return ratio; +} + +/*********************************************************************** +* gm_iterate - perform iterative geometric mean scaling +* +* This routine performs iterative geometric mean scaling of rows and +* columns of the constraint matrix. +* +* The parameter it_max specifies the maximal number of iterations. +* Recommended value of it_max is 15. +* +* The parameter tau specifies a minimal improvement of the scaling +* "quality" on each iteration, 0 < tau < 1. It means than the scaling +* process continues while the following condition is satisfied: +* +* ratio[k] <= tau * ratio[k-1], +* +* where ratio = max |a[i,j]| / min |a[i,j]| is the scaling "quality" +* to be minimized, k is the iteration number. Recommended value of tau +* is 0.90. */ + +static void gm_iterate(glp_prob *lp, int it_max, double tau) +{ int k, flag; + double ratio = 0.0, r_old; + /* if the scaling "quality" for rows is better than for columns, + the rows are scaled first; otherwise, the columns are scaled + first */ + flag = (max_row_ratio(lp) > max_col_ratio(lp)); + for (k = 1; k <= it_max; k++) + { /* save the scaling "quality" from previous iteration */ + r_old = ratio; + /* determine the current scaling "quality" */ + ratio = max_mat_aij(lp, 1) / min_mat_aij(lp, 1); +#if 0 + xprintf("k = %d; ratio = %g\n", k, ratio); +#endif + /* if improvement is not enough, terminate scaling */ + if (k > 1 && ratio > tau * r_old) break; + /* otherwise, perform another iteration */ + gm_scaling(lp, flag); + } + return; +} + +/*********************************************************************** +* NAME +* +* scale_prob - scale problem data +* +* SYNOPSIS +* +* #include "glpscl.h" +* void scale_prob(glp_prob *lp, int flags); +* +* DESCRIPTION +* +* The routine scale_prob performs automatic scaling of problem data +* for the specified problem object. */ + +static void scale_prob(glp_prob *lp, int flags) +{ static const char *fmt = + "%s: min|aij| = %10.3e max|aij| = %10.3e ratio = %10.3e\n"; + double min_aij, max_aij, ratio; + xprintf("Scaling...\n"); + /* cancel the current scaling effect */ + glp_unscale_prob(lp); + /* report original scaling "quality" */ + min_aij = min_mat_aij(lp, 1); + max_aij = max_mat_aij(lp, 1); + ratio = max_aij / min_aij; + xprintf(fmt, " A", min_aij, max_aij, ratio); + /* check if the problem is well scaled */ + if (min_aij >= 0.10 && max_aij <= 10.0) + { xprintf("Problem data seem to be well scaled\n"); + /* skip scaling, if required */ + if (flags & GLP_SF_SKIP) goto done; + } + /* perform iterative geometric mean scaling, if required */ + if (flags & GLP_SF_GM) + { gm_iterate(lp, 15, 0.90); + min_aij = min_mat_aij(lp, 1); + max_aij = max_mat_aij(lp, 1); + ratio = max_aij / min_aij; + xprintf(fmt, "GM", min_aij, max_aij, ratio); + } + /* perform equilibration scaling, if required */ + if (flags & GLP_SF_EQ) + { eq_scaling(lp, max_row_ratio(lp) > max_col_ratio(lp)); + min_aij = min_mat_aij(lp, 1); + max_aij = max_mat_aij(lp, 1); + ratio = max_aij / min_aij; + xprintf(fmt, "EQ", min_aij, max_aij, ratio); + } + /* round scale factors to nearest power of two, if required */ + if (flags & GLP_SF_2N) + { int i, j; + for (i = 1; i <= lp->m; i++) + glp_set_rii(lp, i, round2n(glp_get_rii(lp, i))); + for (j = 1; j <= lp->n; j++) + glp_set_sjj(lp, j, round2n(glp_get_sjj(lp, j))); + min_aij = min_mat_aij(lp, 1); + max_aij = max_mat_aij(lp, 1); + ratio = max_aij / min_aij; + xprintf(fmt, "2N", min_aij, max_aij, ratio); + } +done: return; +} + +/*********************************************************************** +* NAME +* +* glp_scale_prob - scale problem data +* +* SYNOPSIS +* +* void glp_scale_prob(glp_prob *lp, int flags); +* +* DESCRIPTION +* +* The routine glp_scale_prob performs automatic scaling of problem +* data for the specified problem object. +* +* The parameter flags specifies scaling options used by the routine. +* Options can be combined with the bitwise OR operator and may be the +* following: +* +* GLP_SF_GM perform geometric mean scaling; +* GLP_SF_EQ perform equilibration scaling; +* GLP_SF_2N round scale factors to nearest power of two; +* GLP_SF_SKIP skip scaling, if the problem is well scaled. +* +* The parameter flags may be specified as GLP_SF_AUTO, in which case +* the routine chooses scaling options automatically. */ + +void glp_scale_prob(glp_prob *lp, int flags) +{ if (flags & ~(GLP_SF_GM | GLP_SF_EQ | GLP_SF_2N | GLP_SF_SKIP | + GLP_SF_AUTO)) + xerror("glp_scale_prob: flags = 0x%02X; invalid scaling option" + "s\n", flags); + if (flags & GLP_SF_AUTO) + flags = (GLP_SF_GM | GLP_SF_EQ | GLP_SF_SKIP); + scale_prob(lp, flags); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpspm.c b/test/monniaux/glpk-4.65/src/draft/glpspm.c new file mode 100644 index 00000000..c6cfd25d --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpspm.c @@ -0,0 +1,847 @@ +/* glpspm.c */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "glphbm.h" +#include "glprgr.h" +#include "glpspm.h" +#include "env.h" + +/*********************************************************************** +* NAME +* +* spm_create_mat - create general sparse matrix +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPM *spm_create_mat(int m, int n); +* +* DESCRIPTION +* +* The routine spm_create_mat creates a general sparse matrix having +* m rows and n columns. Being created the matrix is zero (empty), i.e. +* has no elements. +* +* RETURNS +* +* The routine returns a pointer to the matrix created. */ + +SPM *spm_create_mat(int m, int n) +{ SPM *A; + xassert(0 <= m && m < INT_MAX); + xassert(0 <= n && n < INT_MAX); + A = xmalloc(sizeof(SPM)); + A->m = m; + A->n = n; + if (m == 0 || n == 0) + { A->pool = NULL; + A->row = NULL; + A->col = NULL; + } + else + { int i, j; + A->pool = dmp_create_pool(); + A->row = xcalloc(1+m, sizeof(SPME *)); + for (i = 1; i <= m; i++) A->row[i] = NULL; + A->col = xcalloc(1+n, sizeof(SPME *)); + for (j = 1; j <= n; j++) A->col[j] = NULL; + } + return A; +} + +/*********************************************************************** +* NAME +* +* spm_new_elem - add new element to sparse matrix +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPME *spm_new_elem(SPM *A, int i, int j, double val); +* +* DESCRIPTION +* +* The routine spm_new_elem adds a new element to the specified sparse +* matrix. Parameters i, j, and val specify the row number, the column +* number, and a numerical value of the element, respectively. +* +* RETURNS +* +* The routine returns a pointer to the new element added. */ + +SPME *spm_new_elem(SPM *A, int i, int j, double val) +{ SPME *e; + xassert(1 <= i && i <= A->m); + xassert(1 <= j && j <= A->n); + e = dmp_get_atom(A->pool, sizeof(SPME)); + e->i = i; + e->j = j; + e->val = val; + e->r_prev = NULL; + e->r_next = A->row[i]; + if (e->r_next != NULL) e->r_next->r_prev = e; + e->c_prev = NULL; + e->c_next = A->col[j]; + if (e->c_next != NULL) e->c_next->c_prev = e; + A->row[i] = A->col[j] = e; + return e; +} + +/*********************************************************************** +* NAME +* +* spm_delete_mat - delete general sparse matrix +* +* SYNOPSIS +* +* #include "glpspm.h" +* void spm_delete_mat(SPM *A); +* +* DESCRIPTION +* +* The routine deletes the specified general sparse matrix freeing all +* the memory allocated to this object. */ + +void spm_delete_mat(SPM *A) +{ /* delete sparse matrix */ + if (A->pool != NULL) dmp_delete_pool(A->pool); + if (A->row != NULL) xfree(A->row); + if (A->col != NULL) xfree(A->col); + xfree(A); + return; +} + +/*********************************************************************** +* NAME +* +* spm_test_mat_e - create test sparse matrix of E(n,c) class +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPM *spm_test_mat_e(int n, int c); +* +* DESCRIPTION +* +* The routine spm_test_mat_e creates a test sparse matrix of E(n,c) +* class as described in the book: Ole 0sterby, Zahari Zlatev. Direct +* Methods for Sparse Matrices. Springer-Verlag, 1983. +* +* Matrix of E(n,c) class is a symmetric positive definite matrix of +* the order n. It has the number 4 on its main diagonal and the number +* -1 on its four co-diagonals, two of which are neighbour to the main +* diagonal and two others are shifted from the main diagonal on the +* distance c. +* +* It is necessary that n >= 3 and 2 <= c <= n-1. +* +* RETURNS +* +* The routine returns a pointer to the matrix created. */ + +SPM *spm_test_mat_e(int n, int c) +{ SPM *A; + int i; + xassert(n >= 3 && 2 <= c && c <= n-1); + A = spm_create_mat(n, n); + for (i = 1; i <= n; i++) + spm_new_elem(A, i, i, 4.0); + for (i = 1; i <= n-1; i++) + { spm_new_elem(A, i, i+1, -1.0); + spm_new_elem(A, i+1, i, -1.0); + } + for (i = 1; i <= n-c; i++) + { spm_new_elem(A, i, i+c, -1.0); + spm_new_elem(A, i+c, i, -1.0); + } + return A; +} + +/*********************************************************************** +* NAME +* +* spm_test_mat_d - create test sparse matrix of D(n,c) class +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPM *spm_test_mat_d(int n, int c); +* +* DESCRIPTION +* +* The routine spm_test_mat_d creates a test sparse matrix of D(n,c) +* class as described in the book: Ole 0sterby, Zahari Zlatev. Direct +* Methods for Sparse Matrices. Springer-Verlag, 1983. +* +* Matrix of D(n,c) class is a non-singular matrix of the order n. It +* has unity main diagonal, three co-diagonals above the main diagonal +* on the distance c, which are cyclically continued below the main +* diagonal, and a triangle block of the size 10x10 in the upper right +* corner. +* +* It is necessary that n >= 14 and 1 <= c <= n-13. +* +* RETURNS +* +* The routine returns a pointer to the matrix created. */ + +SPM *spm_test_mat_d(int n, int c) +{ SPM *A; + int i, j; + xassert(n >= 14 && 1 <= c && c <= n-13); + A = spm_create_mat(n, n); + for (i = 1; i <= n; i++) + spm_new_elem(A, i, i, 1.0); + for (i = 1; i <= n-c; i++) + spm_new_elem(A, i, i+c, (double)(i+1)); + for (i = n-c+1; i <= n; i++) + spm_new_elem(A, i, i-n+c, (double)(i+1)); + for (i = 1; i <= n-c-1; i++) + spm_new_elem(A, i, i+c+1, (double)(-i)); + for (i = n-c; i <= n; i++) + spm_new_elem(A, i, i-n+c+1, (double)(-i)); + for (i = 1; i <= n-c-2; i++) + spm_new_elem(A, i, i+c+2, 16.0); + for (i = n-c-1; i <= n; i++) + spm_new_elem(A, i, i-n+c+2, 16.0); + for (j = 1; j <= 10; j++) + for (i = 1; i <= 11-j; i++) + spm_new_elem(A, i, n-11+i+j, 100.0 * (double)j); + return A; +} + +/*********************************************************************** +* NAME +* +* spm_show_mat - write sparse matrix pattern in BMP file format +* +* SYNOPSIS +* +* #include "glpspm.h" +* int spm_show_mat(const SPM *A, const char *fname); +* +* DESCRIPTION +* +* The routine spm_show_mat writes pattern of the specified sparse +* matrix in uncompressed BMP file format (Windows bitmap) to a binary +* file whose name is specified by the character string fname. +* +* Each pixel corresponds to one matrix element. The pixel colors have +* the following meaning: +* +* Black structurally zero element +* White positive element +* Cyan negative element +* Green zero element +* Red duplicate element +* +* RETURNS +* +* If no error occured, the routine returns zero. Otherwise, it prints +* an appropriate error message and returns non-zero. */ + +int spm_show_mat(const SPM *A, const char *fname) +{ int m = A->m; + int n = A->n; + int i, j, k, ret; + char *map; + xprintf("spm_show_mat: writing matrix pattern to '%s'...\n", + fname); + xassert(1 <= m && m <= 32767); + xassert(1 <= n && n <= 32767); + map = xmalloc(m * n); + memset(map, 0x08, m * n); + for (i = 1; i <= m; i++) + { SPME *e; + for (e = A->row[i]; e != NULL; e = e->r_next) + { j = e->j; + xassert(1 <= j && j <= n); + k = n * (i - 1) + (j - 1); + if (map[k] != 0x08) + map[k] = 0x0C; + else if (e->val > 0.0) + map[k] = 0x0F; + else if (e->val < 0.0) + map[k] = 0x0B; + else + map[k] = 0x0A; + } + } + ret = rgr_write_bmp16(fname, m, n, map); + xfree(map); + return ret; +} + +/*********************************************************************** +* NAME +* +* spm_read_hbm - read sparse matrix in Harwell-Boeing format +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPM *spm_read_hbm(const char *fname); +* +* DESCRIPTION +* +* The routine spm_read_hbm reads a sparse matrix in the Harwell-Boeing +* format from a text file whose name is the character string fname. +* +* Detailed description of the Harwell-Boeing format recognised by this +* routine can be found in the following report: +* +* I.S.Duff, R.G.Grimes, J.G.Lewis. User's Guide for the Harwell-Boeing +* Sparse Matrix Collection (Release I), TR/PA/92/86, October 1992. +* +* NOTE +* +* The routine spm_read_hbm reads the matrix "as is", due to which zero +* and/or duplicate elements can appear in the matrix. +* +* RETURNS +* +* If no error occured, the routine returns a pointer to the matrix +* created. Otherwise, the routine prints an appropriate error message +* and returns NULL. */ + +SPM *spm_read_hbm(const char *fname) +{ SPM *A = NULL; + HBM *hbm; + int nrow, ncol, nnzero, i, j, beg, end, ptr, *colptr, *rowind; + double val, *values; + char *mxtype; + hbm = hbm_read_mat(fname); + if (hbm == NULL) + { xprintf("spm_read_hbm: unable to read matrix\n"); + goto fini; + } + mxtype = hbm->mxtype; + nrow = hbm->nrow; + ncol = hbm->ncol; + nnzero = hbm->nnzero; + colptr = hbm->colptr; + rowind = hbm->rowind; + values = hbm->values; + if (!(strcmp(mxtype, "RSA") == 0 || strcmp(mxtype, "PSA") == 0 || + strcmp(mxtype, "RUA") == 0 || strcmp(mxtype, "PUA") == 0 || + strcmp(mxtype, "RRA") == 0 || strcmp(mxtype, "PRA") == 0)) + { xprintf("spm_read_hbm: matrix type '%s' not supported\n", + mxtype); + goto fini; + } + A = spm_create_mat(nrow, ncol); + if (mxtype[1] == 'S' || mxtype[1] == 'U') + xassert(nrow == ncol); + for (j = 1; j <= ncol; j++) + { beg = colptr[j]; + end = colptr[j+1]; + xassert(1 <= beg && beg <= end && end <= nnzero + 1); + for (ptr = beg; ptr < end; ptr++) + { i = rowind[ptr]; + xassert(1 <= i && i <= nrow); + if (mxtype[0] == 'R') + val = values[ptr]; + else + val = 1.0; + spm_new_elem(A, i, j, val); + if (mxtype[1] == 'S' && i != j) + spm_new_elem(A, j, i, val); + } + } +fini: if (hbm != NULL) hbm_free_mat(hbm); + return A; +} + +/*********************************************************************** +* NAME +* +* spm_count_nnz - determine number of non-zeros in sparse matrix +* +* SYNOPSIS +* +* #include "glpspm.h" +* int spm_count_nnz(const SPM *A); +* +* RETURNS +* +* The routine spm_count_nnz returns the number of structural non-zero +* elements in the specified sparse matrix. */ + +int spm_count_nnz(const SPM *A) +{ SPME *e; + int i, nnz = 0; + for (i = 1; i <= A->m; i++) + for (e = A->row[i]; e != NULL; e = e->r_next) nnz++; + return nnz; +} + +/*********************************************************************** +* NAME +* +* spm_drop_zeros - remove zero elements from sparse matrix +* +* SYNOPSIS +* +* #include "glpspm.h" +* int spm_drop_zeros(SPM *A, double eps); +* +* DESCRIPTION +* +* The routine spm_drop_zeros removes all elements from the specified +* sparse matrix, whose absolute value is less than eps. +* +* If the parameter eps is 0, only zero elements are removed from the +* matrix. +* +* RETURNS +* +* The routine returns the number of elements removed. */ + +int spm_drop_zeros(SPM *A, double eps) +{ SPME *e, *next; + int i, count = 0; + for (i = 1; i <= A->m; i++) + { for (e = A->row[i]; e != NULL; e = next) + { next = e->r_next; + if (e->val == 0.0 || fabs(e->val) < eps) + { /* remove element from the row list */ + if (e->r_prev == NULL) + A->row[e->i] = e->r_next; + else + e->r_prev->r_next = e->r_next; + if (e->r_next == NULL) + ; + else + e->r_next->r_prev = e->r_prev; + /* remove element from the column list */ + if (e->c_prev == NULL) + A->col[e->j] = e->c_next; + else + e->c_prev->c_next = e->c_next; + if (e->c_next == NULL) + ; + else + e->c_next->c_prev = e->c_prev; + /* return element to the memory pool */ + dmp_free_atom(A->pool, e, sizeof(SPME)); + count++; + } + } + } + return count; +} + +/*********************************************************************** +* NAME +* +* spm_read_mat - read sparse matrix from text file +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPM *spm_read_mat(const char *fname); +* +* DESCRIPTION +* +* The routine reads a sparse matrix from a text file whose name is +* specified by the parameter fname. +* +* For the file format see description of the routine spm_write_mat. +* +* RETURNS +* +* On success the routine returns a pointer to the matrix created, +* otherwise NULL. */ + +#if 1 +SPM *spm_read_mat(const char *fname) +{ xassert(fname != fname); + return NULL; +} +#else +SPM *spm_read_mat(const char *fname) +{ SPM *A = NULL; + PDS *pds; + jmp_buf jump; + int i, j, k, m, n, nnz, fail = 0; + double val; + xprintf("spm_read_mat: reading matrix from '%s'...\n", fname); + pds = pds_open_file(fname); + if (pds == NULL) + { xprintf("spm_read_mat: unable to open '%s' - %s\n", fname, + strerror(errno)); + fail = 1; + goto done; + } + if (setjmp(jump)) + { fail = 1; + goto done; + } + pds_set_jump(pds, jump); + /* number of rows, number of columns, number of non-zeros */ + m = pds_scan_int(pds); + if (m < 0) + pds_error(pds, "invalid number of rows\n"); + n = pds_scan_int(pds); + if (n < 0) + pds_error(pds, "invalid number of columns\n"); + nnz = pds_scan_int(pds); + if (nnz < 0) + pds_error(pds, "invalid number of non-zeros\n"); + /* create matrix */ + xprintf("spm_read_mat: %d rows, %d columns, %d non-zeros\n", + m, n, nnz); + A = spm_create_mat(m, n); + /* read matrix elements */ + for (k = 1; k <= nnz; k++) + { /* row index, column index, element value */ + i = pds_scan_int(pds); + if (!(1 <= i && i <= m)) + pds_error(pds, "row index out of range\n"); + j = pds_scan_int(pds); + if (!(1 <= j && j <= n)) + pds_error(pds, "column index out of range\n"); + val = pds_scan_num(pds); + /* add new element to the matrix */ + spm_new_elem(A, i, j, val); + } + xprintf("spm_read_mat: %d lines were read\n", pds->count); +done: if (pds != NULL) pds_close_file(pds); + if (fail && A != NULL) spm_delete_mat(A), A = NULL; + return A; +} +#endif + +/*********************************************************************** +* NAME +* +* spm_write_mat - write sparse matrix to text file +* +* SYNOPSIS +* +* #include "glpspm.h" +* int spm_write_mat(const SPM *A, const char *fname); +* +* DESCRIPTION +* +* The routine spm_write_mat writes the specified sparse matrix to a +* text file whose name is specified by the parameter fname. This file +* can be read back with the routine spm_read_mat. +* +* RETURNS +* +* On success the routine returns zero, otherwise non-zero. +* +* FILE FORMAT +* +* The file created by the routine spm_write_mat is a plain text file, +* which contains the following information: +* +* m n nnz +* row[1] col[1] val[1] +* row[2] col[2] val[2] +* . . . +* row[nnz] col[nnz] val[nnz] +* +* where: +* m is the number of rows; +* n is the number of columns; +* nnz is the number of non-zeros; +* row[k], k = 1,...,nnz, are row indices; +* col[k], k = 1,...,nnz, are column indices; +* val[k], k = 1,...,nnz, are element values. */ + +#if 1 +int spm_write_mat(const SPM *A, const char *fname) +{ xassert(A != A); + xassert(fname != fname); + return 0; +} +#else +int spm_write_mat(const SPM *A, const char *fname) +{ FILE *fp; + int i, nnz, ret = 0; + xprintf("spm_write_mat: writing matrix to '%s'...\n", fname); + fp = fopen(fname, "w"); + if (fp == NULL) + { xprintf("spm_write_mat: unable to create '%s' - %s\n", fname, + strerror(errno)); + ret = 1; + goto done; + } + /* number of rows, number of columns, number of non-zeros */ + nnz = spm_count_nnz(A); + fprintf(fp, "%d %d %d\n", A->m, A->n, nnz); + /* walk through rows of the matrix */ + for (i = 1; i <= A->m; i++) + { SPME *e; + /* walk through elements of i-th row */ + for (e = A->row[i]; e != NULL; e = e->r_next) + { /* row index, column index, element value */ + fprintf(fp, "%d %d %.*g\n", e->i, e->j, DBL_DIG, e->val); + } + } + fflush(fp); + if (ferror(fp)) + { xprintf("spm_write_mat: writing error on '%s' - %s\n", fname, + strerror(errno)); + ret = 1; + goto done; + } + xprintf("spm_write_mat: %d lines were written\n", 1 + nnz); +done: if (fp != NULL) fclose(fp); + return ret; +} +#endif + +/*********************************************************************** +* NAME +* +* spm_transpose - transpose sparse matrix +* +* SYNOPSIS +* +* #include "glpspm.h" +* SPM *spm_transpose(const SPM *A); +* +* RETURNS +* +* The routine computes and returns sparse matrix B, which is a matrix +* transposed to sparse matrix A. */ + +SPM *spm_transpose(const SPM *A) +{ SPM *B; + int i; + B = spm_create_mat(A->n, A->m); + for (i = 1; i <= A->m; i++) + { SPME *e; + for (e = A->row[i]; e != NULL; e = e->r_next) + spm_new_elem(B, e->j, i, e->val); + } + return B; +} + +SPM *spm_add_sym(const SPM *A, const SPM *B) +{ /* add two sparse matrices (symbolic phase) */ + SPM *C; + int i, j, *flag; + xassert(A->m == B->m); + xassert(A->n == B->n); + /* create resultant matrix */ + C = spm_create_mat(A->m, A->n); + /* allocate and clear the flag array */ + flag = xcalloc(1+C->n, sizeof(int)); + for (j = 1; j <= C->n; j++) + flag[j] = 0; + /* compute pattern of C = A + B */ + for (i = 1; i <= C->m; i++) + { SPME *e; + /* at the beginning i-th row of C is empty */ + /* (i-th row of C) := (i-th row of C) union (i-th row of A) */ + for (e = A->row[i]; e != NULL; e = e->r_next) + { /* (note that i-th row of A may have duplicate elements) */ + j = e->j; + if (!flag[j]) + { spm_new_elem(C, i, j, 0.0); + flag[j] = 1; + } + } + /* (i-th row of C) := (i-th row of C) union (i-th row of B) */ + for (e = B->row[i]; e != NULL; e = e->r_next) + { /* (note that i-th row of B may have duplicate elements) */ + j = e->j; + if (!flag[j]) + { spm_new_elem(C, i, j, 0.0); + flag[j] = 1; + } + } + /* reset the flag array */ + for (e = C->row[i]; e != NULL; e = e->r_next) + flag[e->j] = 0; + } + /* check and deallocate the flag array */ + for (j = 1; j <= C->n; j++) + xassert(!flag[j]); + xfree(flag); + return C; +} + +void spm_add_num(SPM *C, double alfa, const SPM *A, double beta, + const SPM *B) +{ /* add two sparse matrices (numeric phase) */ + int i, j; + double *work; + /* allocate and clear the working array */ + work = xcalloc(1+C->n, sizeof(double)); + for (j = 1; j <= C->n; j++) + work[j] = 0.0; + /* compute matrix C = alfa * A + beta * B */ + for (i = 1; i <= C->n; i++) + { SPME *e; + /* work := alfa * (i-th row of A) + beta * (i-th row of B) */ + /* (note that A and/or B may have duplicate elements) */ + for (e = A->row[i]; e != NULL; e = e->r_next) + work[e->j] += alfa * e->val; + for (e = B->row[i]; e != NULL; e = e->r_next) + work[e->j] += beta * e->val; + /* (i-th row of C) := work, work := 0 */ + for (e = C->row[i]; e != NULL; e = e->r_next) + { j = e->j; + e->val = work[j]; + work[j] = 0.0; + } + } + /* check and deallocate the working array */ + for (j = 1; j <= C->n; j++) + xassert(work[j] == 0.0); + xfree(work); + return; +} + +SPM *spm_add_mat(double alfa, const SPM *A, double beta, const SPM *B) +{ /* add two sparse matrices (driver routine) */ + SPM *C; + C = spm_add_sym(A, B); + spm_add_num(C, alfa, A, beta, B); + return C; +} + +SPM *spm_mul_sym(const SPM *A, const SPM *B) +{ /* multiply two sparse matrices (symbolic phase) */ + int i, j, k, *flag; + SPM *C; + xassert(A->n == B->m); + /* create resultant matrix */ + C = spm_create_mat(A->m, B->n); + /* allocate and clear the flag array */ + flag = xcalloc(1+C->n, sizeof(int)); + for (j = 1; j <= C->n; j++) + flag[j] = 0; + /* compute pattern of C = A * B */ + for (i = 1; i <= C->m; i++) + { SPME *e, *ee; + /* compute pattern of i-th row of C */ + for (e = A->row[i]; e != NULL; e = e->r_next) + { k = e->j; + for (ee = B->row[k]; ee != NULL; ee = ee->r_next) + { j = ee->j; + /* if a[i,k] != 0 and b[k,j] != 0 then c[i,j] != 0 */ + if (!flag[j]) + { /* c[i,j] does not exist, so create it */ + spm_new_elem(C, i, j, 0.0); + flag[j] = 1; + } + } + } + /* reset the flag array */ + for (e = C->row[i]; e != NULL; e = e->r_next) + flag[e->j] = 0; + } + /* check and deallocate the flag array */ + for (j = 1; j <= C->n; j++) + xassert(!flag[j]); + xfree(flag); + return C; +} + +void spm_mul_num(SPM *C, const SPM *A, const SPM *B) +{ /* multiply two sparse matrices (numeric phase) */ + int i, j; + double *work; + /* allocate and clear the working array */ + work = xcalloc(1+A->n, sizeof(double)); + for (j = 1; j <= A->n; j++) + work[j] = 0.0; + /* compute matrix C = A * B */ + for (i = 1; i <= C->m; i++) + { SPME *e, *ee; + double temp; + /* work := (i-th row of A) */ + /* (note that A may have duplicate elements) */ + for (e = A->row[i]; e != NULL; e = e->r_next) + work[e->j] += e->val; + /* compute i-th row of C */ + for (e = C->row[i]; e != NULL; e = e->r_next) + { j = e->j; + /* c[i,j] := work * (j-th column of B) */ + temp = 0.0; + for (ee = B->col[j]; ee != NULL; ee = ee->c_next) + temp += work[ee->i] * ee->val; + e->val = temp; + } + /* reset the working array */ + for (e = A->row[i]; e != NULL; e = e->r_next) + work[e->j] = 0.0; + } + /* check and deallocate the working array */ + for (j = 1; j <= A->n; j++) + xassert(work[j] == 0.0); + xfree(work); + return; +} + +SPM *spm_mul_mat(const SPM *A, const SPM *B) +{ /* multiply two sparse matrices (driver routine) */ + SPM *C; + C = spm_mul_sym(A, B); + spm_mul_num(C, A, B); + return C; +} + +PER *spm_create_per(int n) +{ /* create permutation matrix */ + PER *P; + int k; + xassert(n >= 0); + P = xmalloc(sizeof(PER)); + P->n = n; + P->row = xcalloc(1+n, sizeof(int)); + P->col = xcalloc(1+n, sizeof(int)); + /* initially it is identity matrix */ + for (k = 1; k <= n; k++) + P->row[k] = P->col[k] = k; + return P; +} + +void spm_check_per(PER *P) +{ /* check permutation matrix for correctness */ + int i, j; + xassert(P->n >= 0); + for (i = 1; i <= P->n; i++) + { j = P->row[i]; + xassert(1 <= j && j <= P->n); + xassert(P->col[j] == i); + } + return; +} + +void spm_delete_per(PER *P) +{ /* delete permutation matrix */ + xfree(P->row); + xfree(P->col); + xfree(P); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpspm.h b/test/monniaux/glpk-4.65/src/draft/glpspm.h new file mode 100644 index 00000000..eda9f98f --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpspm.h @@ -0,0 +1,165 @@ +/* glpspm.h (general sparse matrix) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 GLPSPM_H +#define GLPSPM_H + +#include "dmp.h" + +typedef struct SPM SPM; +typedef struct SPME SPME; + +struct SPM +{ /* general sparse matrix */ + int m; + /* number of rows, m >= 0 */ + int n; + /* number of columns, n >= 0 */ + DMP *pool; + /* memory pool to store matrix elements */ + SPME **row; /* SPME *row[1+m]; */ + /* row[i], 1 <= i <= m, is a pointer to i-th row list */ + SPME **col; /* SPME *col[1+n]; */ + /* col[j], 1 <= j <= n, is a pointer to j-th column list */ +}; + +struct SPME +{ /* sparse matrix element */ + int i; + /* row number */ + int j; + /* column number */ + double val; + /* element value */ + SPME *r_prev; + /* pointer to previous element in the same row */ + SPME *r_next; + /* pointer to next element in the same row */ + SPME *c_prev; + /* pointer to previous element in the same column */ + SPME *c_next; + /* pointer to next element in the same column */ +}; + +typedef struct PER PER; + +struct PER +{ /* permutation matrix */ + int n; + /* matrix order, n >= 0 */ + int *row; /* int row[1+n]; */ + /* row[i] = j means p[i,j] = 1 */ + int *col; /* int col[1+n]; */ + /* col[j] = i means p[i,j] = 1 */ +}; + +#define spm_create_mat _glp_spm_create_mat +SPM *spm_create_mat(int m, int n); +/* create general sparse matrix */ + +#define spm_new_elem _glp_spm_new_elem +SPME *spm_new_elem(SPM *A, int i, int j, double val); +/* add new element to sparse matrix */ + +#define spm_delete_mat _glp_spm_delete_mat +void spm_delete_mat(SPM *A); +/* delete general sparse matrix */ + +#define spm_test_mat_e _glp_spm_test_mat_e +SPM *spm_test_mat_e(int n, int c); +/* create test sparse matrix of E(n,c) class */ + +#define spm_test_mat_d _glp_spm_test_mat_d +SPM *spm_test_mat_d(int n, int c); +/* create test sparse matrix of D(n,c) class */ + +#define spm_show_mat _glp_spm_show_mat +int spm_show_mat(const SPM *A, const char *fname); +/* write sparse matrix pattern in BMP file format */ + +#define spm_read_hbm _glp_spm_read_hbm +SPM *spm_read_hbm(const char *fname); +/* read sparse matrix in Harwell-Boeing format */ + +#define spm_count_nnz _glp_spm_count_nnz +int spm_count_nnz(const SPM *A); +/* determine number of non-zeros in sparse matrix */ + +#define spm_drop_zeros _glp_spm_drop_zeros +int spm_drop_zeros(SPM *A, double eps); +/* remove zero elements from sparse matrix */ + +#define spm_read_mat _glp_spm_read_mat +SPM *spm_read_mat(const char *fname); +/* read sparse matrix from text file */ + +#define spm_write_mat _glp_spm_write_mat +int spm_write_mat(const SPM *A, const char *fname); +/* write sparse matrix to text file */ + +#define spm_transpose _glp_spm_transpose +SPM *spm_transpose(const SPM *A); +/* transpose sparse matrix */ + +#define spm_add_sym _glp_spm_add_sym +SPM *spm_add_sym(const SPM *A, const SPM *B); +/* add two sparse matrices (symbolic phase) */ + +#define spm_add_num _glp_spm_add_num +void spm_add_num(SPM *C, double alfa, const SPM *A, double beta, + const SPM *B); +/* add two sparse matrices (numeric phase) */ + +#define spm_add_mat _glp_spm_add_mat +SPM *spm_add_mat(double alfa, const SPM *A, double beta, + const SPM *B); +/* add two sparse matrices (driver routine) */ + +#define spm_mul_sym _glp_spm_mul_sym +SPM *spm_mul_sym(const SPM *A, const SPM *B); +/* multiply two sparse matrices (symbolic phase) */ + +#define spm_mul_num _glp_spm_mul_num +void spm_mul_num(SPM *C, const SPM *A, const SPM *B); +/* multiply two sparse matrices (numeric phase) */ + +#define spm_mul_mat _glp_spm_mul_mat +SPM *spm_mul_mat(const SPM *A, const SPM *B); +/* multiply two sparse matrices (driver routine) */ + +#define spm_create_per _glp_spm_create_per +PER *spm_create_per(int n); +/* create permutation matrix */ + +#define spm_check_per _glp_spm_check_per +void spm_check_per(PER *P); +/* check permutation matrix for correctness */ + +#define spm_delete_per _glp_spm_delete_per +void spm_delete_per(PER *P); +/* delete permutation matrix */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpssx.h b/test/monniaux/glpk-4.65/src/draft/glpssx.h new file mode 100644 index 00000000..3b52b3cc --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpssx.h @@ -0,0 +1,437 @@ +/* glpssx.h (simplex method, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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 GLPSSX_H +#define GLPSSX_H + +#include "bfx.h" +#include "env.h" +#if 1 /* 25/XI-2017 */ +#include "glpk.h" +#endif + +typedef struct SSX SSX; + +struct SSX +{ /* simplex solver workspace */ +/*---------------------------------------------------------------------- +// LP PROBLEM DATA +// +// It is assumed that LP problem has the following statement: +// +// minimize (or maximize) +// +// z = c[1]*x[1] + ... + c[m+n]*x[m+n] + c[0] (1) +// +// subject to equality constraints +// +// x[1] - a[1,1]*x[m+1] - ... - a[1,n]*x[m+n] = 0 +// +// . . . . . . . (2) +// +// x[m] - a[m,1]*x[m+1] + ... - a[m,n]*x[m+n] = 0 +// +// and bounds of variables +// +// l[1] <= x[1] <= u[1] +// +// . . . . . . . (3) +// +// l[m+n] <= x[m+n] <= u[m+n] +// +// where: +// x[1], ..., x[m] - auxiliary variables; +// x[m+1], ..., x[m+n] - structural variables; +// z - objective function; +// c[1], ..., c[m+n] - coefficients of the objective function; +// c[0] - constant term of the objective function; +// a[1,1], ..., a[m,n] - constraint coefficients; +// l[1], ..., l[m+n] - lower bounds of variables; +// u[1], ..., u[m+n] - upper bounds of variables. +// +// Bounds of variables can be finite as well as inifinite. Besides, +// lower and upper bounds can be equal to each other. So the following +// five types of variables are possible: +// +// Bounds of variable Type of variable +// ------------------------------------------------- +// -inf < x[k] < +inf Free (unbounded) variable +// l[k] <= x[k] < +inf Variable with lower bound +// -inf < x[k] <= u[k] Variable with upper bound +// l[k] <= x[k] <= u[k] Double-bounded variable +// l[k] = x[k] = u[k] Fixed variable +// +// Using vector-matrix notations the LP problem (1)-(3) can be written +// as follows: +// +// minimize (or maximize) +// +// z = c * x + c[0] (4) +// +// subject to equality constraints +// +// xR - A * xS = 0 (5) +// +// and bounds of variables +// +// l <= x <= u (6) +// +// where: +// xR - vector of auxiliary variables; +// xS - vector of structural variables; +// x = (xR, xS) - vector of all variables; +// z - objective function; +// c - vector of objective coefficients; +// c[0] - constant term of the objective function; +// A - matrix of constraint coefficients (has m rows +// and n columns); +// l - vector of lower bounds of variables; +// u - vector of upper bounds of variables. +// +// The simplex method makes no difference between auxiliary and +// structural variables, so it is convenient to think the system of +// equality constraints (5) written in a homogeneous form: +// +// (I | -A) * x = 0, (7) +// +// where (I | -A) is an augmented (m+n)xm constraint matrix, I is mxm +// unity matrix whose columns correspond to auxiliary variables, and A +// is the original mxn constraint matrix whose columns correspond to +// structural variables. Note that only the matrix A is stored. +----------------------------------------------------------------------*/ + int m; + /* number of rows (auxiliary variables), m > 0 */ + int n; + /* number of columns (structural variables), n > 0 */ + int *type; /* int type[1+m+n]; */ + /* type[0] is not used; + type[k], 1 <= k <= m+n, is the type of variable x[k]: */ +#define SSX_FR 0 /* free (unbounded) variable */ +#define SSX_LO 1 /* variable with lower bound */ +#define SSX_UP 2 /* variable with upper bound */ +#define SSX_DB 3 /* double-bounded variable */ +#define SSX_FX 4 /* fixed variable */ + mpq_t *lb; /* mpq_t lb[1+m+n]; alias: l */ + /* lb[0] is not used; + lb[k], 1 <= k <= m+n, is an lower bound of variable x[k]; + if x[k] has no lower bound, lb[k] is zero */ + mpq_t *ub; /* mpq_t ub[1+m+n]; alias: u */ + /* ub[0] is not used; + ub[k], 1 <= k <= m+n, is an upper bound of variable x[k]; + if x[k] has no upper bound, ub[k] is zero; + if x[k] is of fixed type, ub[k] is equal to lb[k] */ + int dir; + /* optimization direction (sense of the objective function): */ +#define SSX_MIN 0 /* minimization */ +#define SSX_MAX 1 /* maximization */ + mpq_t *coef; /* mpq_t coef[1+m+n]; alias: c */ + /* coef[0] is a constant term of the objective function; + coef[k], 1 <= k <= m+n, is a coefficient of the objective + function at variable x[k]; + note that auxiliary variables also may have non-zero objective + coefficients */ + int *A_ptr; /* int A_ptr[1+n+1]; */ + int *A_ind; /* int A_ind[A_ptr[n+1]]; */ + mpq_t *A_val; /* mpq_t A_val[A_ptr[n+1]]; */ + /* constraint matrix A (see (5)) in storage-by-columns format */ +/*---------------------------------------------------------------------- +// LP BASIS AND CURRENT BASIC SOLUTION +// +// The LP basis is defined by the following partition of the augmented +// constraint matrix (7): +// +// (B | N) = (I | -A) * Q, (8) +// +// where B is a mxm non-singular basis matrix whose columns correspond +// to basic variables xB, N is a mxn matrix whose columns correspond to +// non-basic variables xN, and Q is a permutation (m+n)x(m+n) matrix. +// +// From (7) and (8) it follows that +// +// (I | -A) * x = (I | -A) * Q * Q' * x = (B | N) * (xB, xN), +// +// therefore +// +// (xB, xN) = Q' * x, (9) +// +// where x is the vector of all variables in the original order, xB is +// a vector of basic variables, xN is a vector of non-basic variables, +// Q' = inv(Q) is a matrix transposed to Q. +// +// Current values of non-basic variables xN[j], j = 1, ..., n, are not +// stored; they are defined implicitly by their statuses as follows: +// +// 0, if xN[j] is free variable +// lN[j], if xN[j] is on its lower bound (10) +// uN[j], if xN[j] is on its upper bound +// lN[j] = uN[j], if xN[j] is fixed variable +// +// where lN[j] and uN[j] are lower and upper bounds of xN[j]. +// +// Current values of basic variables xB[i], i = 1, ..., m, are computed +// as follows: +// +// beta = - inv(B) * N * xN, (11) +// +// where current values of xN are defined by (10). +// +// Current values of simplex multipliers pi[i], i = 1, ..., m (which +// are values of Lagrange multipliers for equality constraints (7) also +// called shadow prices) are computed as follows: +// +// pi = inv(B') * cB, (12) +// +// where B' is a matrix transposed to B, cB is a vector of objective +// coefficients at basic variables xB. +// +// Current values of reduced costs d[j], j = 1, ..., n, (which are +// values of Langrange multipliers for active inequality constraints +// corresponding to non-basic variables) are computed as follows: +// +// d = cN - N' * pi, (13) +// +// where N' is a matrix transposed to N, cN is a vector of objective +// coefficients at non-basic variables xN. +----------------------------------------------------------------------*/ + int *stat; /* int stat[1+m+n]; */ + /* stat[0] is not used; + stat[k], 1 <= k <= m+n, is the status of variable x[k]: */ +#define SSX_BS 0 /* basic variable */ +#define SSX_NL 1 /* non-basic variable on lower bound */ +#define SSX_NU 2 /* non-basic variable on upper bound */ +#define SSX_NF 3 /* non-basic free variable */ +#define SSX_NS 4 /* non-basic fixed variable */ + int *Q_row; /* int Q_row[1+m+n]; */ + /* matrix Q in row-like format; + Q_row[0] is not used; + Q_row[i] = j means that q[i,j] = 1 */ + int *Q_col; /* int Q_col[1+m+n]; */ + /* matrix Q in column-like format; + Q_col[0] is not used; + Q_col[j] = i means that q[i,j] = 1 */ + /* if k-th column of the matrix (I | A) is k'-th column of the + matrix (B | N), then Q_row[k] = k' and Q_col[k'] = k; + if x[k] is xB[i], then Q_row[k] = i and Q_col[i] = k; + if x[k] is xN[j], then Q_row[k] = m+j and Q_col[m+j] = k */ + BFX *binv; + /* invertable form of the basis matrix B */ + mpq_t *bbar; /* mpq_t bbar[1+m]; alias: beta */ + /* bbar[0] is a value of the objective function; + bbar[i], 1 <= i <= m, is a value of basic variable xB[i] */ + mpq_t *pi; /* mpq_t pi[1+m]; */ + /* pi[0] is not used; + pi[i], 1 <= i <= m, is a simplex multiplier corresponding to + i-th row (equality constraint) */ + mpq_t *cbar; /* mpq_t cbar[1+n]; alias: d */ + /* cbar[0] is not used; + cbar[j], 1 <= j <= n, is a reduced cost of non-basic variable + xN[j] */ +/*---------------------------------------------------------------------- +// SIMPLEX TABLE +// +// Due to (8) and (9) the system of equality constraints (7) for the +// current basis can be written as follows: +// +// xB = A~ * xN, (14) +// +// where +// +// A~ = - inv(B) * N (15) +// +// is a mxn matrix called the simplex table. +// +// The revised simplex method uses only two components of A~, namely, +// pivot column corresponding to non-basic variable xN[q] chosen to +// enter the basis, and pivot row corresponding to basic variable xB[p] +// chosen to leave the basis. +// +// Pivot column alfa_q is q-th column of A~, so +// +// alfa_q = A~ * e[q] = - inv(B) * N * e[q] = - inv(B) * N[q], (16) +// +// where N[q] is q-th column of the matrix N. +// +// Pivot row alfa_p is p-th row of A~ or, equivalently, p-th column of +// A~', a matrix transposed to A~, so +// +// alfa_p = A~' * e[p] = - N' * inv(B') * e[p] = - N' * rho_p, (17) +// +// where (*)' means transposition, and +// +// rho_p = inv(B') * e[p], (18) +// +// is p-th column of inv(B') or, that is the same, p-th row of inv(B). +----------------------------------------------------------------------*/ + int p; + /* number of basic variable xB[p], 1 <= p <= m, chosen to leave + the basis */ + mpq_t *rho; /* mpq_t rho[1+m]; */ + /* p-th row of the inverse inv(B); see (18) */ + mpq_t *ap; /* mpq_t ap[1+n]; */ + /* p-th row of the simplex table; see (17) */ + int q; + /* number of non-basic variable xN[q], 1 <= q <= n, chosen to + enter the basis */ + mpq_t *aq; /* mpq_t aq[1+m]; */ + /* q-th column of the simplex table; see (16) */ +/*--------------------------------------------------------------------*/ + int q_dir; + /* direction in which non-basic variable xN[q] should change on + moving to the adjacent vertex of the polyhedron: + +1 means that xN[q] increases + -1 means that xN[q] decreases */ + int p_stat; + /* non-basic status which should be assigned to basic variable + xB[p] when it has left the basis and become xN[q] */ + mpq_t delta; + /* actual change of xN[q] in the adjacent basis (it has the same + sign as q_dir) */ +/*--------------------------------------------------------------------*/ +#if 1 /* 25/XI-2017 */ + int msg_lev; + /* verbosity level: + GLP_MSG_OFF no output + GLP_MSG_ERR report errors and warnings + GLP_MSG_ON normal output + GLP_MSG_ALL highest verbosity */ +#endif + int it_lim; + /* simplex iterations limit; if this value is positive, it is + decreased by one each time when one simplex iteration has been + performed, and reaching zero value signals the solver to stop + the search; negative value means no iterations limit */ + int it_cnt; + /* simplex iterations count; this count is increased by one each + time when one simplex iteration has been performed */ + double tm_lim; + /* searching time limit, in seconds; if this value is positive, + it is decreased each time when one simplex iteration has been + performed by the amount of time spent for the iteration, and + reaching zero value signals the solver to stop the search; + negative value means no time limit */ + double out_frq; + /* output frequency, in seconds; this parameter specifies how + frequently the solver sends information about the progress of + the search to the standard output */ +#if 0 /* 10/VI-2013 */ + glp_long tm_beg; +#else + double tm_beg; +#endif + /* starting time of the search, in seconds; the total time of the + search is the difference between xtime() and tm_beg */ +#if 0 /* 10/VI-2013 */ + glp_long tm_lag; +#else + double tm_lag; +#endif + /* the most recent time, in seconds, at which the progress of the + the search was displayed */ +}; + +#define ssx_create _glp_ssx_create +#define ssx_factorize _glp_ssx_factorize +#define ssx_get_xNj _glp_ssx_get_xNj +#define ssx_eval_bbar _glp_ssx_eval_bbar +#define ssx_eval_pi _glp_ssx_eval_pi +#define ssx_eval_dj _glp_ssx_eval_dj +#define ssx_eval_cbar _glp_ssx_eval_cbar +#define ssx_eval_rho _glp_ssx_eval_rho +#define ssx_eval_row _glp_ssx_eval_row +#define ssx_eval_col _glp_ssx_eval_col +#define ssx_chuzc _glp_ssx_chuzc +#define ssx_chuzr _glp_ssx_chuzr +#define ssx_update_bbar _glp_ssx_update_bbar +#define ssx_update_pi _glp_ssx_update_pi +#define ssx_update_cbar _glp_ssx_update_cbar +#define ssx_change_basis _glp_ssx_change_basis +#define ssx_delete _glp_ssx_delete + +#define ssx_phase_I _glp_ssx_phase_I +#define ssx_phase_II _glp_ssx_phase_II +#define ssx_driver _glp_ssx_driver + +SSX *ssx_create(int m, int n, int nnz); +/* create simplex solver workspace */ + +int ssx_factorize(SSX *ssx); +/* factorize the current basis matrix */ + +void ssx_get_xNj(SSX *ssx, int j, mpq_t x); +/* determine value of non-basic variable */ + +void ssx_eval_bbar(SSX *ssx); +/* compute values of basic variables */ + +void ssx_eval_pi(SSX *ssx); +/* compute values of simplex multipliers */ + +void ssx_eval_dj(SSX *ssx, int j, mpq_t dj); +/* compute reduced cost of non-basic variable */ + +void ssx_eval_cbar(SSX *ssx); +/* compute reduced costs of all non-basic variables */ + +void ssx_eval_rho(SSX *ssx); +/* compute p-th row of the inverse */ + +void ssx_eval_row(SSX *ssx); +/* compute pivot row of the simplex table */ + +void ssx_eval_col(SSX *ssx); +/* compute pivot column of the simplex table */ + +void ssx_chuzc(SSX *ssx); +/* choose pivot column */ + +void ssx_chuzr(SSX *ssx); +/* choose pivot row */ + +void ssx_update_bbar(SSX *ssx); +/* update values of basic variables */ + +void ssx_update_pi(SSX *ssx); +/* update simplex multipliers */ + +void ssx_update_cbar(SSX *ssx); +/* update reduced costs of non-basic variables */ + +void ssx_change_basis(SSX *ssx); +/* change current basis to adjacent one */ + +void ssx_delete(SSX *ssx); +/* delete simplex solver workspace */ + +int ssx_phase_I(SSX *ssx); +/* find primal feasible solution */ + +int ssx_phase_II(SSX *ssx); +/* find optimal solution */ + +int ssx_driver(SSX *ssx); +/* base driver to exact simplex method */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpssx01.c b/test/monniaux/glpk-4.65/src/draft/glpssx01.c new file mode 100644 index 00000000..9b70444e --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpssx01.c @@ -0,0 +1,839 @@ +/* glpssx01.c (simplex method, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "glpssx.h" +#define xfault xerror + +/*---------------------------------------------------------------------- +// ssx_create - create simplex solver workspace. +// +// This routine creates the workspace used by simplex solver routines, +// and returns a pointer to it. +// +// Parameters m, n, and nnz specify, respectively, the number of rows, +// columns, and non-zero constraint coefficients. +// +// This routine only allocates the memory for the workspace components, +// so the workspace needs to be saturated by data. */ + +SSX *ssx_create(int m, int n, int nnz) +{ SSX *ssx; + int i, j, k; + if (m < 1) + xfault("ssx_create: m = %d; invalid number of rows\n", m); + if (n < 1) + xfault("ssx_create: n = %d; invalid number of columns\n", n); + if (nnz < 0) + xfault("ssx_create: nnz = %d; invalid number of non-zero const" + "raint coefficients\n", nnz); + ssx = xmalloc(sizeof(SSX)); + ssx->m = m; + ssx->n = n; + ssx->type = xcalloc(1+m+n, sizeof(int)); + ssx->lb = xcalloc(1+m+n, sizeof(mpq_t)); + for (k = 1; k <= m+n; k++) mpq_init(ssx->lb[k]); + ssx->ub = xcalloc(1+m+n, sizeof(mpq_t)); + for (k = 1; k <= m+n; k++) mpq_init(ssx->ub[k]); + ssx->coef = xcalloc(1+m+n, sizeof(mpq_t)); + for (k = 0; k <= m+n; k++) mpq_init(ssx->coef[k]); + ssx->A_ptr = xcalloc(1+n+1, sizeof(int)); + ssx->A_ptr[n+1] = nnz+1; + ssx->A_ind = xcalloc(1+nnz, sizeof(int)); + ssx->A_val = xcalloc(1+nnz, sizeof(mpq_t)); + for (k = 1; k <= nnz; k++) mpq_init(ssx->A_val[k]); + ssx->stat = xcalloc(1+m+n, sizeof(int)); + ssx->Q_row = xcalloc(1+m+n, sizeof(int)); + ssx->Q_col = xcalloc(1+m+n, sizeof(int)); + ssx->binv = bfx_create_binv(); + ssx->bbar = xcalloc(1+m, sizeof(mpq_t)); + for (i = 0; i <= m; i++) mpq_init(ssx->bbar[i]); + ssx->pi = xcalloc(1+m, sizeof(mpq_t)); + for (i = 1; i <= m; i++) mpq_init(ssx->pi[i]); + ssx->cbar = xcalloc(1+n, sizeof(mpq_t)); + for (j = 1; j <= n; j++) mpq_init(ssx->cbar[j]); + ssx->rho = xcalloc(1+m, sizeof(mpq_t)); + for (i = 1; i <= m; i++) mpq_init(ssx->rho[i]); + ssx->ap = xcalloc(1+n, sizeof(mpq_t)); + for (j = 1; j <= n; j++) mpq_init(ssx->ap[j]); + ssx->aq = xcalloc(1+m, sizeof(mpq_t)); + for (i = 1; i <= m; i++) mpq_init(ssx->aq[i]); + mpq_init(ssx->delta); + return ssx; +} + +/*---------------------------------------------------------------------- +// ssx_factorize - factorize the current basis matrix. +// +// This routine computes factorization of the current basis matrix B +// and returns the singularity flag. If the matrix B is non-singular, +// the flag is zero, otherwise non-zero. */ + +static int basis_col(void *info, int j, int ind[], mpq_t val[]) +{ /* this auxiliary routine provides row indices and numeric values + of non-zero elements in j-th column of the matrix B */ + SSX *ssx = info; + int m = ssx->m; + int n = ssx->n; + int *A_ptr = ssx->A_ptr; + int *A_ind = ssx->A_ind; + mpq_t *A_val = ssx->A_val; + int *Q_col = ssx->Q_col; + int k, len, ptr; + xassert(1 <= j && j <= m); + k = Q_col[j]; /* x[k] = xB[j] */ + xassert(1 <= k && k <= m+n); + /* j-th column of the matrix B is k-th column of the augmented + constraint matrix (I | -A) */ + if (k <= m) + { /* it is a column of the unity matrix I */ + len = 1, ind[1] = k, mpq_set_si(val[1], 1, 1); + } + else + { /* it is a column of the original constraint matrix -A */ + len = 0; + for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) + { len++; + ind[len] = A_ind[ptr]; + mpq_neg(val[len], A_val[ptr]); + } + } + return len; +} + +int ssx_factorize(SSX *ssx) +{ int ret; + ret = bfx_factorize(ssx->binv, ssx->m, basis_col, ssx); + return ret; +} + +/*---------------------------------------------------------------------- +// ssx_get_xNj - determine value of non-basic variable. +// +// This routine determines the value of non-basic variable xN[j] in the +// current basic solution defined as follows: +// +// 0, if xN[j] is free variable +// lN[j], if xN[j] is on its lower bound +// uN[j], if xN[j] is on its upper bound +// lN[j] = uN[j], if xN[j] is fixed variable +// +// where lN[j] and uN[j] are lower and upper bounds of xN[j]. */ + +void ssx_get_xNj(SSX *ssx, int j, mpq_t x) +{ int m = ssx->m; + int n = ssx->n; + mpq_t *lb = ssx->lb; + mpq_t *ub = ssx->ub; + int *stat = ssx->stat; + int *Q_col = ssx->Q_col; + int k; + xassert(1 <= j && j <= n); + k = Q_col[m+j]; /* x[k] = xN[j] */ + xassert(1 <= k && k <= m+n); + switch (stat[k]) + { case SSX_NL: + /* xN[j] is on its lower bound */ + mpq_set(x, lb[k]); break; + case SSX_NU: + /* xN[j] is on its upper bound */ + mpq_set(x, ub[k]); break; + case SSX_NF: + /* xN[j] is free variable */ + mpq_set_si(x, 0, 1); break; + case SSX_NS: + /* xN[j] is fixed variable */ + mpq_set(x, lb[k]); break; + default: + xassert(stat != stat); + } + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_bbar - compute values of basic variables. +// +// This routine computes values of basic variables xB in the current +// basic solution as follows: +// +// beta = - inv(B) * N * xN, +// +// where B is the basis matrix, N is the matrix of non-basic columns, +// xN is a vector of current values of non-basic variables. */ + +void ssx_eval_bbar(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + mpq_t *coef = ssx->coef; + int *A_ptr = ssx->A_ptr; + int *A_ind = ssx->A_ind; + mpq_t *A_val = ssx->A_val; + int *Q_col = ssx->Q_col; + mpq_t *bbar = ssx->bbar; + int i, j, k, ptr; + mpq_t x, temp; + mpq_init(x); + mpq_init(temp); + /* bbar := 0 */ + for (i = 1; i <= m; i++) + mpq_set_si(bbar[i], 0, 1); + /* bbar := - N * xN = - N[1] * xN[1] - ... - N[n] * xN[n] */ + for (j = 1; j <= n; j++) + { ssx_get_xNj(ssx, j, x); + if (mpq_sgn(x) == 0) continue; + k = Q_col[m+j]; /* x[k] = xN[j] */ + if (k <= m) + { /* N[j] is a column of the unity matrix I */ + mpq_sub(bbar[k], bbar[k], x); + } + else + { /* N[j] is a column of the original constraint matrix -A */ + for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) + { mpq_mul(temp, A_val[ptr], x); + mpq_add(bbar[A_ind[ptr]], bbar[A_ind[ptr]], temp); + } + } + } + /* bbar := inv(B) * bbar */ + bfx_ftran(ssx->binv, bbar, 0); +#if 1 + /* compute value of the objective function */ + /* bbar[0] := c[0] */ + mpq_set(bbar[0], coef[0]); + /* bbar[0] := bbar[0] + sum{i in B} cB[i] * xB[i] */ + for (i = 1; i <= m; i++) + { k = Q_col[i]; /* x[k] = xB[i] */ + if (mpq_sgn(coef[k]) == 0) continue; + mpq_mul(temp, coef[k], bbar[i]); + mpq_add(bbar[0], bbar[0], temp); + } + /* bbar[0] := bbar[0] + sum{j in N} cN[j] * xN[j] */ + for (j = 1; j <= n; j++) + { k = Q_col[m+j]; /* x[k] = xN[j] */ + if (mpq_sgn(coef[k]) == 0) continue; + ssx_get_xNj(ssx, j, x); + mpq_mul(temp, coef[k], x); + mpq_add(bbar[0], bbar[0], temp); + } +#endif + mpq_clear(x); + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_pi - compute values of simplex multipliers. +// +// This routine computes values of simplex multipliers (shadow prices) +// pi in the current basic solution as follows: +// +// pi = inv(B') * cB, +// +// where B' is a matrix transposed to the basis matrix B, cB is a vector +// of objective coefficients at basic variables xB. */ + +void ssx_eval_pi(SSX *ssx) +{ int m = ssx->m; + mpq_t *coef = ssx->coef; + int *Q_col = ssx->Q_col; + mpq_t *pi = ssx->pi; + int i; + /* pi := cB */ + for (i = 1; i <= m; i++) mpq_set(pi[i], coef[Q_col[i]]); + /* pi := inv(B') * cB */ + bfx_btran(ssx->binv, pi); + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_dj - compute reduced cost of non-basic variable. +// +// This routine computes reduced cost d[j] of non-basic variable xN[j] +// in the current basic solution as follows: +// +// d[j] = cN[j] - N[j] * pi, +// +// where cN[j] is an objective coefficient at xN[j], N[j] is a column +// of the augmented constraint matrix (I | -A) corresponding to xN[j], +// pi is the vector of simplex multipliers (shadow prices). */ + +void ssx_eval_dj(SSX *ssx, int j, mpq_t dj) +{ int m = ssx->m; + int n = ssx->n; + mpq_t *coef = ssx->coef; + int *A_ptr = ssx->A_ptr; + int *A_ind = ssx->A_ind; + mpq_t *A_val = ssx->A_val; + int *Q_col = ssx->Q_col; + mpq_t *pi = ssx->pi; + int k, ptr, end; + mpq_t temp; + mpq_init(temp); + xassert(1 <= j && j <= n); + k = Q_col[m+j]; /* x[k] = xN[j] */ + xassert(1 <= k && k <= m+n); + /* j-th column of the matrix N is k-th column of the augmented + constraint matrix (I | -A) */ + if (k <= m) + { /* it is a column of the unity matrix I */ + mpq_sub(dj, coef[k], pi[k]); + } + else + { /* it is a column of the original constraint matrix -A */ + mpq_set(dj, coef[k]); + for (ptr = A_ptr[k-m], end = A_ptr[k-m+1]; ptr < end; ptr++) + { mpq_mul(temp, A_val[ptr], pi[A_ind[ptr]]); + mpq_add(dj, dj, temp); + } + } + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_cbar - compute reduced costs of all non-basic variables. +// +// This routine computes the vector of reduced costs pi in the current +// basic solution for all non-basic variables, including fixed ones. */ + +void ssx_eval_cbar(SSX *ssx) +{ int n = ssx->n; + mpq_t *cbar = ssx->cbar; + int j; + for (j = 1; j <= n; j++) + ssx_eval_dj(ssx, j, cbar[j]); + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_rho - compute p-th row of the inverse. +// +// This routine computes p-th row of the matrix inv(B), where B is the +// current basis matrix. +// +// p-th row of the inverse is computed using the following formula: +// +// rho = inv(B') * e[p], +// +// where B' is a matrix transposed to B, e[p] is a unity vector, which +// contains one in p-th position. */ + +void ssx_eval_rho(SSX *ssx) +{ int m = ssx->m; + int p = ssx->p; + mpq_t *rho = ssx->rho; + int i; + xassert(1 <= p && p <= m); + /* rho := 0 */ + for (i = 1; i <= m; i++) mpq_set_si(rho[i], 0, 1); + /* rho := e[p] */ + mpq_set_si(rho[p], 1, 1); + /* rho := inv(B') * rho */ + bfx_btran(ssx->binv, rho); + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_row - compute pivot row of the simplex table. +// +// This routine computes p-th (pivot) row of the current simplex table +// A~ = - inv(B) * N using the following formula: +// +// A~[p] = - N' * inv(B') * e[p] = - N' * rho[p], +// +// where N' is a matrix transposed to the matrix N, rho[p] is p-th row +// of the inverse inv(B). */ + +void ssx_eval_row(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int *A_ptr = ssx->A_ptr; + int *A_ind = ssx->A_ind; + mpq_t *A_val = ssx->A_val; + int *Q_col = ssx->Q_col; + mpq_t *rho = ssx->rho; + mpq_t *ap = ssx->ap; + int j, k, ptr; + mpq_t temp; + mpq_init(temp); + for (j = 1; j <= n; j++) + { /* ap[j] := - N'[j] * rho (inner product) */ + k = Q_col[m+j]; /* x[k] = xN[j] */ + if (k <= m) + mpq_neg(ap[j], rho[k]); + else + { mpq_set_si(ap[j], 0, 1); + for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) + { mpq_mul(temp, A_val[ptr], rho[A_ind[ptr]]); + mpq_add(ap[j], ap[j], temp); + } + } + } + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +// ssx_eval_col - compute pivot column of the simplex table. +// +// This routine computes q-th (pivot) column of the current simplex +// table A~ = - inv(B) * N using the following formula: +// +// A~[q] = - inv(B) * N[q], +// +// where N[q] is q-th column of the matrix N corresponding to chosen +// non-basic variable xN[q]. */ + +void ssx_eval_col(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int *A_ptr = ssx->A_ptr; + int *A_ind = ssx->A_ind; + mpq_t *A_val = ssx->A_val; + int *Q_col = ssx->Q_col; + int q = ssx->q; + mpq_t *aq = ssx->aq; + int i, k, ptr; + xassert(1 <= q && q <= n); + /* aq := 0 */ + for (i = 1; i <= m; i++) mpq_set_si(aq[i], 0, 1); + /* aq := N[q] */ + k = Q_col[m+q]; /* x[k] = xN[q] */ + if (k <= m) + { /* N[q] is a column of the unity matrix I */ + mpq_set_si(aq[k], 1, 1); + } + else + { /* N[q] is a column of the original constraint matrix -A */ + for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) + mpq_neg(aq[A_ind[ptr]], A_val[ptr]); + } + /* aq := inv(B) * aq */ + bfx_ftran(ssx->binv, aq, 1); + /* aq := - aq */ + for (i = 1; i <= m; i++) mpq_neg(aq[i], aq[i]); + return; +} + +/*---------------------------------------------------------------------- +// ssx_chuzc - choose pivot column. +// +// This routine chooses non-basic variable xN[q] whose reduced cost +// indicates possible improving of the objective function to enter it +// in the basis. +// +// Currently the standard (textbook) pricing is used, i.e. that +// non-basic variable is preferred which has greatest reduced cost (in +// magnitude). +// +// If xN[q] has been chosen, the routine stores its number q and also +// sets the flag q_dir that indicates direction in which xN[q] has to +// change (+1 means increasing, -1 means decreasing). +// +// If the choice cannot be made, because the current basic solution is +// dual feasible, the routine sets the number q to 0. */ + +void ssx_chuzc(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int dir = (ssx->dir == SSX_MIN ? +1 : -1); + int *Q_col = ssx->Q_col; + int *stat = ssx->stat; + mpq_t *cbar = ssx->cbar; + int j, k, s, q, q_dir; + double best, temp; + /* nothing is chosen so far */ + q = 0, q_dir = 0, best = 0.0; + /* look through the list of non-basic variables */ + for (j = 1; j <= n; j++) + { k = Q_col[m+j]; /* x[k] = xN[j] */ + s = dir * mpq_sgn(cbar[j]); + if ((stat[k] == SSX_NF || stat[k] == SSX_NL) && s < 0 || + (stat[k] == SSX_NF || stat[k] == SSX_NU) && s > 0) + { /* reduced cost of xN[j] indicates possible improving of + the objective function */ + temp = fabs(mpq_get_d(cbar[j])); + xassert(temp != 0.0); + if (q == 0 || best < temp) + q = j, q_dir = - s, best = temp; + } + } + ssx->q = q, ssx->q_dir = q_dir; + return; +} + +/*---------------------------------------------------------------------- +// ssx_chuzr - choose pivot row. +// +// This routine looks through elements of q-th column of the simplex +// table and chooses basic variable xB[p] which should leave the basis. +// +// The choice is based on the standard (textbook) ratio test. +// +// If xB[p] has been chosen, the routine stores its number p and also +// sets its non-basic status p_stat which should be assigned to xB[p] +// when it has left the basis and become xN[q]. +// +// Special case p < 0 means that xN[q] is double-bounded variable and +// it reaches its opposite bound before any basic variable does that, +// so the current basis remains unchanged. +// +// If the choice cannot be made, because xN[q] can infinitely change in +// the feasible direction, the routine sets the number p to 0. */ + +void ssx_chuzr(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int *type = ssx->type; + mpq_t *lb = ssx->lb; + mpq_t *ub = ssx->ub; + int *Q_col = ssx->Q_col; + mpq_t *bbar = ssx->bbar; + int q = ssx->q; + mpq_t *aq = ssx->aq; + int q_dir = ssx->q_dir; + int i, k, s, t, p, p_stat; + mpq_t teta, temp; + mpq_init(teta); + mpq_init(temp); + xassert(1 <= q && q <= n); + xassert(q_dir == +1 || q_dir == -1); + /* nothing is chosen so far */ + p = 0, p_stat = 0; + /* look through the list of basic variables */ + for (i = 1; i <= m; i++) + { s = q_dir * mpq_sgn(aq[i]); + if (s < 0) + { /* xB[i] decreases */ + k = Q_col[i]; /* x[k] = xB[i] */ + t = type[k]; + if (t == SSX_LO || t == SSX_DB || t == SSX_FX) + { /* xB[i] has finite lower bound */ + mpq_sub(temp, bbar[i], lb[k]); + mpq_div(temp, temp, aq[i]); + mpq_abs(temp, temp); + if (p == 0 || mpq_cmp(teta, temp) > 0) + { p = i; + p_stat = (t == SSX_FX ? SSX_NS : SSX_NL); + mpq_set(teta, temp); + } + } + } + else if (s > 0) + { /* xB[i] increases */ + k = Q_col[i]; /* x[k] = xB[i] */ + t = type[k]; + if (t == SSX_UP || t == SSX_DB || t == SSX_FX) + { /* xB[i] has finite upper bound */ + mpq_sub(temp, bbar[i], ub[k]); + mpq_div(temp, temp, aq[i]); + mpq_abs(temp, temp); + if (p == 0 || mpq_cmp(teta, temp) > 0) + { p = i; + p_stat = (t == SSX_FX ? SSX_NS : SSX_NU); + mpq_set(teta, temp); + } + } + } + /* if something has been chosen and the ratio test indicates + exact degeneracy, the search can be finished */ + if (p != 0 && mpq_sgn(teta) == 0) break; + } + /* if xN[q] is double-bounded, check if it can reach its opposite + bound before any basic variable */ + k = Q_col[m+q]; /* x[k] = xN[q] */ + if (type[k] == SSX_DB) + { mpq_sub(temp, ub[k], lb[k]); + if (p == 0 || mpq_cmp(teta, temp) > 0) + { p = -1; + p_stat = -1; + mpq_set(teta, temp); + } + } + ssx->p = p; + ssx->p_stat = p_stat; + /* if xB[p] has been chosen, determine its actual change in the + adjacent basis (it has the same sign as q_dir) */ + if (p != 0) + { xassert(mpq_sgn(teta) >= 0); + if (q_dir > 0) + mpq_set(ssx->delta, teta); + else + mpq_neg(ssx->delta, teta); + } + mpq_clear(teta); + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +// ssx_update_bbar - update values of basic variables. +// +// This routine recomputes the current values of basic variables for +// the adjacent basis. +// +// The simplex table for the current basis is the following: +// +// xB[i] = sum{j in 1..n} alfa[i,j] * xN[q], i = 1,...,m +// +// therefore +// +// delta xB[i] = alfa[i,q] * delta xN[q], i = 1,...,m +// +// where delta xN[q] = xN.new[q] - xN[q] is the change of xN[q] in the +// adjacent basis, and delta xB[i] = xB.new[i] - xB[i] is the change of +// xB[i]. This gives formulae for recomputing values of xB[i]: +// +// xB.new[p] = xN[q] + delta xN[q] +// +// (because xN[q] becomes xB[p] in the adjacent basis), and +// +// xB.new[i] = xB[i] + alfa[i,q] * delta xN[q], i != p +// +// for other basic variables. */ + +void ssx_update_bbar(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + mpq_t *bbar = ssx->bbar; + mpq_t *cbar = ssx->cbar; + int p = ssx->p; + int q = ssx->q; + mpq_t *aq = ssx->aq; + int i; + mpq_t temp; + mpq_init(temp); + xassert(1 <= q && q <= n); + if (p < 0) + { /* xN[q] is double-bounded and goes to its opposite bound */ + /* nop */; + } + else + { /* xN[q] becomes xB[p] in the adjacent basis */ + /* xB.new[p] = xN[q] + delta xN[q] */ + xassert(1 <= p && p <= m); + ssx_get_xNj(ssx, q, temp); + mpq_add(bbar[p], temp, ssx->delta); + } + /* update values of other basic variables depending on xN[q] */ + for (i = 1; i <= m; i++) + { if (i == p) continue; + /* xB.new[i] = xB[i] + alfa[i,q] * delta xN[q] */ + if (mpq_sgn(aq[i]) == 0) continue; + mpq_mul(temp, aq[i], ssx->delta); + mpq_add(bbar[i], bbar[i], temp); + } +#if 1 + /* update value of the objective function */ + /* z.new = z + d[q] * delta xN[q] */ + mpq_mul(temp, cbar[q], ssx->delta); + mpq_add(bbar[0], bbar[0], temp); +#endif + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +-- ssx_update_pi - update simplex multipliers. +-- +-- This routine recomputes the vector of simplex multipliers for the +-- adjacent basis. */ + +void ssx_update_pi(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + mpq_t *pi = ssx->pi; + mpq_t *cbar = ssx->cbar; + int p = ssx->p; + int q = ssx->q; + mpq_t *aq = ssx->aq; + mpq_t *rho = ssx->rho; + int i; + mpq_t new_dq, temp; + mpq_init(new_dq); + mpq_init(temp); + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n); + /* compute d[q] in the adjacent basis */ + mpq_div(new_dq, cbar[q], aq[p]); + /* update the vector of simplex multipliers */ + for (i = 1; i <= m; i++) + { if (mpq_sgn(rho[i]) == 0) continue; + mpq_mul(temp, new_dq, rho[i]); + mpq_sub(pi[i], pi[i], temp); + } + mpq_clear(new_dq); + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +// ssx_update_cbar - update reduced costs of non-basic variables. +// +// This routine recomputes the vector of reduced costs of non-basic +// variables for the adjacent basis. */ + +void ssx_update_cbar(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + mpq_t *cbar = ssx->cbar; + int p = ssx->p; + int q = ssx->q; + mpq_t *ap = ssx->ap; + int j; + mpq_t temp; + mpq_init(temp); + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n); + /* compute d[q] in the adjacent basis */ + /* d.new[q] = d[q] / alfa[p,q] */ + mpq_div(cbar[q], cbar[q], ap[q]); + /* update reduced costs of other non-basic variables */ + for (j = 1; j <= n; j++) + { if (j == q) continue; + /* d.new[j] = d[j] - (alfa[p,j] / alfa[p,q]) * d[q] */ + if (mpq_sgn(ap[j]) == 0) continue; + mpq_mul(temp, ap[j], cbar[q]); + mpq_sub(cbar[j], cbar[j], temp); + } + mpq_clear(temp); + return; +} + +/*---------------------------------------------------------------------- +// ssx_change_basis - change current basis to adjacent one. +// +// This routine changes the current basis to the adjacent one swapping +// basic variable xB[p] and non-basic variable xN[q]. */ + +void ssx_change_basis(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int *type = ssx->type; + int *stat = ssx->stat; + int *Q_row = ssx->Q_row; + int *Q_col = ssx->Q_col; + int p = ssx->p; + int q = ssx->q; + int p_stat = ssx->p_stat; + int k, kp, kq; + if (p < 0) + { /* special case: xN[q] goes to its opposite bound */ + xassert(1 <= q && q <= n); + k = Q_col[m+q]; /* x[k] = xN[q] */ + xassert(type[k] == SSX_DB); + switch (stat[k]) + { case SSX_NL: + stat[k] = SSX_NU; + break; + case SSX_NU: + stat[k] = SSX_NL; + break; + default: + xassert(stat != stat); + } + } + else + { /* xB[p] leaves the basis, xN[q] enters the basis */ + xassert(1 <= p && p <= m); + xassert(1 <= q && q <= n); + kp = Q_col[p]; /* x[kp] = xB[p] */ + kq = Q_col[m+q]; /* x[kq] = xN[q] */ + /* check non-basic status of xB[p] which becomes xN[q] */ + switch (type[kp]) + { case SSX_FR: + xassert(p_stat == SSX_NF); + break; + case SSX_LO: + xassert(p_stat == SSX_NL); + break; + case SSX_UP: + xassert(p_stat == SSX_NU); + break; + case SSX_DB: + xassert(p_stat == SSX_NL || p_stat == SSX_NU); + break; + case SSX_FX: + xassert(p_stat == SSX_NS); + break; + default: + xassert(type != type); + } + /* swap xB[p] and xN[q] */ + stat[kp] = (char)p_stat, stat[kq] = SSX_BS; + Q_row[kp] = m+q, Q_row[kq] = p; + Q_col[p] = kq, Q_col[m+q] = kp; + /* update factorization of the basis matrix */ + if (bfx_update(ssx->binv, p)) + { if (ssx_factorize(ssx)) + xassert(("Internal error: basis matrix is singular", 0)); + } + } + return; +} + +/*---------------------------------------------------------------------- +// ssx_delete - delete simplex solver workspace. +// +// This routine deletes the simplex solver workspace freeing all the +// memory allocated to this object. */ + +void ssx_delete(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int nnz = ssx->A_ptr[n+1]-1; + int i, j, k; + xfree(ssx->type); + for (k = 1; k <= m+n; k++) mpq_clear(ssx->lb[k]); + xfree(ssx->lb); + for (k = 1; k <= m+n; k++) mpq_clear(ssx->ub[k]); + xfree(ssx->ub); + for (k = 0; k <= m+n; k++) mpq_clear(ssx->coef[k]); + xfree(ssx->coef); + xfree(ssx->A_ptr); + xfree(ssx->A_ind); + for (k = 1; k <= nnz; k++) mpq_clear(ssx->A_val[k]); + xfree(ssx->A_val); + xfree(ssx->stat); + xfree(ssx->Q_row); + xfree(ssx->Q_col); + bfx_delete_binv(ssx->binv); + for (i = 0; i <= m; i++) mpq_clear(ssx->bbar[i]); + xfree(ssx->bbar); + for (i = 1; i <= m; i++) mpq_clear(ssx->pi[i]); + xfree(ssx->pi); + for (j = 1; j <= n; j++) mpq_clear(ssx->cbar[j]); + xfree(ssx->cbar); + for (i = 1; i <= m; i++) mpq_clear(ssx->rho[i]); + xfree(ssx->rho); + for (j = 1; j <= n; j++) mpq_clear(ssx->ap[j]); + xfree(ssx->ap); + for (i = 1; i <= m; i++) mpq_clear(ssx->aq[i]); + xfree(ssx->aq); + mpq_clear(ssx->delta); + xfree(ssx); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/glpssx02.c b/test/monniaux/glpk-4.65/src/draft/glpssx02.c new file mode 100644 index 00000000..81db1350 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/glpssx02.c @@ -0,0 +1,523 @@ +/* glpssx02.c (simplex method, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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/>. +***********************************************************************/ + +#include "env.h" +#include "glpssx.h" + +static void show_progress(SSX *ssx, int phase) +{ /* this auxiliary routine displays information about progress of + the search */ + int i, def = 0; + for (i = 1; i <= ssx->m; i++) + if (ssx->type[ssx->Q_col[i]] == SSX_FX) def++; + xprintf("%s%6d: %s = %22.15g (%d)\n", phase == 1 ? " " : "*", + ssx->it_cnt, phase == 1 ? "infsum" : "objval", + mpq_get_d(ssx->bbar[0]), def); +#if 0 + ssx->tm_lag = utime(); +#else + ssx->tm_lag = xtime(); +#endif + return; +} + +/*---------------------------------------------------------------------- +// ssx_phase_I - find primal feasible solution. +// +// This routine implements phase I of the primal simplex method. +// +// On exit the routine returns one of the following codes: +// +// 0 - feasible solution found; +// 1 - problem has no feasible solution; +// 2 - iterations limit exceeded; +// 3 - time limit exceeded. +----------------------------------------------------------------------*/ + +int ssx_phase_I(SSX *ssx) +{ int m = ssx->m; + int n = ssx->n; + int *type = ssx->type; + mpq_t *lb = ssx->lb; + mpq_t *ub = ssx->ub; + mpq_t *coef = ssx->coef; + int *A_ptr = ssx->A_ptr; + int *A_ind = ssx->A_ind; + mpq_t *A_val = ssx->A_val; + int *Q_col = ssx->Q_col; + mpq_t *bbar = ssx->bbar; + mpq_t *pi = ssx->pi; + mpq_t *cbar = ssx->cbar; + int *orig_type, orig_dir; + mpq_t *orig_lb, *orig_ub, *orig_coef; + int i, k, ret; + /* save components of the original LP problem, which are changed + by the routine */ + orig_type = xcalloc(1+m+n, sizeof(int)); + orig_lb = xcalloc(1+m+n, sizeof(mpq_t)); + orig_ub = xcalloc(1+m+n, sizeof(mpq_t)); + orig_coef = xcalloc(1+m+n, sizeof(mpq_t)); + for (k = 1; k <= m+n; k++) + { orig_type[k] = type[k]; + mpq_init(orig_lb[k]); + mpq_set(orig_lb[k], lb[k]); + mpq_init(orig_ub[k]); + mpq_set(orig_ub[k], ub[k]); + } + orig_dir = ssx->dir; + for (k = 0; k <= m+n; k++) + { mpq_init(orig_coef[k]); + mpq_set(orig_coef[k], coef[k]); + } + /* build an artificial basic solution, which is primal feasible, + and also build an auxiliary objective function to minimize the + sum of infeasibilities for the original problem */ + ssx->dir = SSX_MIN; + for (k = 0; k <= m+n; k++) mpq_set_si(coef[k], 0, 1); + mpq_set_si(bbar[0], 0, 1); + for (i = 1; i <= m; i++) + { int t; + k = Q_col[i]; /* x[k] = xB[i] */ + t = type[k]; + if (t == SSX_LO || t == SSX_DB || t == SSX_FX) + { /* in the original problem x[k] has lower bound */ + if (mpq_cmp(bbar[i], lb[k]) < 0) + { /* which is violated */ + type[k] = SSX_UP; + mpq_set(ub[k], lb[k]); + mpq_set_si(lb[k], 0, 1); + mpq_set_si(coef[k], -1, 1); + mpq_add(bbar[0], bbar[0], ub[k]); + mpq_sub(bbar[0], bbar[0], bbar[i]); + } + } + if (t == SSX_UP || t == SSX_DB || t == SSX_FX) + { /* in the original problem x[k] has upper bound */ + if (mpq_cmp(bbar[i], ub[k]) > 0) + { /* which is violated */ + type[k] = SSX_LO; + mpq_set(lb[k], ub[k]); + mpq_set_si(ub[k], 0, 1); + mpq_set_si(coef[k], +1, 1); + mpq_add(bbar[0], bbar[0], bbar[i]); + mpq_sub(bbar[0], bbar[0], lb[k]); + } + } + } + /* now the initial basic solution should be primal feasible due + to changes of bounds of some basic variables, which turned to + implicit artifical variables */ + /* compute simplex multipliers and reduced costs */ + ssx_eval_pi(ssx); + ssx_eval_cbar(ssx); + /* display initial progress of the search */ +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ON) +#endif + show_progress(ssx, 1); + /* main loop starts here */ + for (;;) + { /* display current progress of the search */ +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ON) +#endif +#if 0 + if (utime() - ssx->tm_lag >= ssx->out_frq - 0.001) +#else + if (xdifftime(xtime(), ssx->tm_lag) >= ssx->out_frq - 0.001) +#endif + show_progress(ssx, 1); + /* we do not need to wait until all artificial variables have + left the basis */ + if (mpq_sgn(bbar[0]) == 0) + { /* the sum of infeasibilities is zero, therefore the current + solution is primal feasible for the original problem */ + ret = 0; + break; + } + /* check if the iterations limit has been exhausted */ + if (ssx->it_lim == 0) + { ret = 2; + break; + } + /* check if the time limit has been exhausted */ +#if 0 + if (ssx->tm_lim >= 0.0 && ssx->tm_lim <= utime() - ssx->tm_beg) +#else + if (ssx->tm_lim >= 0.0 && + ssx->tm_lim <= xdifftime(xtime(), ssx->tm_beg)) +#endif + { ret = 3; + break; + } + /* choose non-basic variable xN[q] */ + ssx_chuzc(ssx); + /* if xN[q] cannot be chosen, the sum of infeasibilities is + minimal but non-zero; therefore the original problem has no + primal feasible solution */ + if (ssx->q == 0) + { ret = 1; + break; + } + /* compute q-th column of the simplex table */ + ssx_eval_col(ssx); + /* choose basic variable xB[p] */ + ssx_chuzr(ssx); + /* the sum of infeasibilities cannot be negative, therefore + the auxiliary lp problem cannot have unbounded solution */ + xassert(ssx->p != 0); + /* update values of basic variables */ + ssx_update_bbar(ssx); + if (ssx->p > 0) + { /* compute p-th row of the inverse inv(B) */ + ssx_eval_rho(ssx); + /* compute p-th row of the simplex table */ + ssx_eval_row(ssx); + xassert(mpq_cmp(ssx->aq[ssx->p], ssx->ap[ssx->q]) == 0); + /* update simplex multipliers */ + ssx_update_pi(ssx); + /* update reduced costs of non-basic variables */ + ssx_update_cbar(ssx); + } + /* xB[p] is leaving the basis; if it is implicit artificial + variable, the corresponding residual vanishes; therefore + bounds of this variable should be restored to the original + values */ + if (ssx->p > 0) + { k = Q_col[ssx->p]; /* x[k] = xB[p] */ + if (type[k] != orig_type[k]) + { /* x[k] is implicit artificial variable */ + type[k] = orig_type[k]; + mpq_set(lb[k], orig_lb[k]); + mpq_set(ub[k], orig_ub[k]); + xassert(ssx->p_stat == SSX_NL || ssx->p_stat == SSX_NU); + ssx->p_stat = (ssx->p_stat == SSX_NL ? SSX_NU : SSX_NL); + if (type[k] == SSX_FX) ssx->p_stat = SSX_NS; + /* nullify the objective coefficient at x[k] */ + mpq_set_si(coef[k], 0, 1); + /* since coef[k] has been changed, we need to compute + new reduced cost of x[k], which it will have in the + adjacent basis */ + /* the formula d[j] = cN[j] - pi' * N[j] is used (note + that the vector pi is not changed, because it depends + on objective coefficients at basic variables, but in + the adjacent basis, for which the vector pi has been + just recomputed, x[k] is non-basic) */ + if (k <= m) + { /* x[k] is auxiliary variable */ + mpq_neg(cbar[ssx->q], pi[k]); + } + else + { /* x[k] is structural variable */ + int ptr; + mpq_t temp; + mpq_init(temp); + mpq_set_si(cbar[ssx->q], 0, 1); + for (ptr = A_ptr[k-m]; ptr < A_ptr[k-m+1]; ptr++) + { mpq_mul(temp, pi[A_ind[ptr]], A_val[ptr]); + mpq_add(cbar[ssx->q], cbar[ssx->q], temp); + } + mpq_clear(temp); + } + } + } + /* jump to the adjacent vertex of the polyhedron */ + ssx_change_basis(ssx); + /* one simplex iteration has been performed */ + if (ssx->it_lim > 0) ssx->it_lim--; + ssx->it_cnt++; + } + /* display final progress of the search */ +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ON) +#endif + show_progress(ssx, 1); + /* restore components of the original problem, which were changed + by the routine */ + for (k = 1; k <= m+n; k++) + { type[k] = orig_type[k]; + mpq_set(lb[k], orig_lb[k]); + mpq_clear(orig_lb[k]); + mpq_set(ub[k], orig_ub[k]); + mpq_clear(orig_ub[k]); + } + ssx->dir = orig_dir; + for (k = 0; k <= m+n; k++) + { mpq_set(coef[k], orig_coef[k]); + mpq_clear(orig_coef[k]); + } + xfree(orig_type); + xfree(orig_lb); + xfree(orig_ub); + xfree(orig_coef); + /* return to the calling program */ + return ret; +} + +/*---------------------------------------------------------------------- +// ssx_phase_II - find optimal solution. +// +// This routine implements phase II of the primal simplex method. +// +// On exit the routine returns one of the following codes: +// +// 0 - optimal solution found; +// 1 - problem has unbounded solution; +// 2 - iterations limit exceeded; +// 3 - time limit exceeded. +----------------------------------------------------------------------*/ + +int ssx_phase_II(SSX *ssx) +{ int ret; + /* display initial progress of the search */ +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ON) +#endif + show_progress(ssx, 2); + /* main loop starts here */ + for (;;) + { /* display current progress of the search */ +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ON) +#endif +#if 0 + if (utime() - ssx->tm_lag >= ssx->out_frq - 0.001) +#else + if (xdifftime(xtime(), ssx->tm_lag) >= ssx->out_frq - 0.001) +#endif + show_progress(ssx, 2); + /* check if the iterations limit has been exhausted */ + if (ssx->it_lim == 0) + { ret = 2; + break; + } + /* check if the time limit has been exhausted */ +#if 0 + if (ssx->tm_lim >= 0.0 && ssx->tm_lim <= utime() - ssx->tm_beg) +#else + if (ssx->tm_lim >= 0.0 && + ssx->tm_lim <= xdifftime(xtime(), ssx->tm_beg)) +#endif + { ret = 3; + break; + } + /* choose non-basic variable xN[q] */ + ssx_chuzc(ssx); + /* if xN[q] cannot be chosen, the current basic solution is + dual feasible and therefore optimal */ + if (ssx->q == 0) + { ret = 0; + break; + } + /* compute q-th column of the simplex table */ + ssx_eval_col(ssx); + /* choose basic variable xB[p] */ + ssx_chuzr(ssx); + /* if xB[p] cannot be chosen, the problem has no dual feasible + solution (i.e. unbounded) */ + if (ssx->p == 0) + { ret = 1; + break; + } + /* update values of basic variables */ + ssx_update_bbar(ssx); + if (ssx->p > 0) + { /* compute p-th row of the inverse inv(B) */ + ssx_eval_rho(ssx); + /* compute p-th row of the simplex table */ + ssx_eval_row(ssx); + xassert(mpq_cmp(ssx->aq[ssx->p], ssx->ap[ssx->q]) == 0); +#if 0 + /* update simplex multipliers */ + ssx_update_pi(ssx); +#endif + /* update reduced costs of non-basic variables */ + ssx_update_cbar(ssx); + } + /* jump to the adjacent vertex of the polyhedron */ + ssx_change_basis(ssx); + /* one simplex iteration has been performed */ + if (ssx->it_lim > 0) ssx->it_lim--; + ssx->it_cnt++; + } + /* display final progress of the search */ +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ON) +#endif + show_progress(ssx, 2); + /* return to the calling program */ + return ret; +} + +/*---------------------------------------------------------------------- +// ssx_driver - base driver to exact simplex method. +// +// This routine is a base driver to a version of the primal simplex +// method using exact (bignum) arithmetic. +// +// On exit the routine returns one of the following codes: +// +// 0 - optimal solution found; +// 1 - problem has no feasible solution; +// 2 - problem has unbounded solution; +// 3 - iterations limit exceeded (phase I); +// 4 - iterations limit exceeded (phase II); +// 5 - time limit exceeded (phase I); +// 6 - time limit exceeded (phase II); +// 7 - initial basis matrix is exactly singular. +----------------------------------------------------------------------*/ + +int ssx_driver(SSX *ssx) +{ int m = ssx->m; + int *type = ssx->type; + mpq_t *lb = ssx->lb; + mpq_t *ub = ssx->ub; + int *Q_col = ssx->Q_col; + mpq_t *bbar = ssx->bbar; + int i, k, ret; + ssx->tm_beg = xtime(); + /* factorize the initial basis matrix */ + if (ssx_factorize(ssx)) +#if 0 /* 25/XI-2017 */ + { xprintf("Initial basis matrix is singular\n"); +#else + { if (ssx->msg_lev >= GLP_MSG_ERR) + xprintf("Initial basis matrix is singular\n"); +#endif + ret = 7; + goto done; + } + /* compute values of basic variables */ + ssx_eval_bbar(ssx); + /* check if the initial basic solution is primal feasible */ + for (i = 1; i <= m; i++) + { int t; + k = Q_col[i]; /* x[k] = xB[i] */ + t = type[k]; + if (t == SSX_LO || t == SSX_DB || t == SSX_FX) + { /* x[k] has lower bound */ + if (mpq_cmp(bbar[i], lb[k]) < 0) + { /* which is violated */ + break; + } + } + if (t == SSX_UP || t == SSX_DB || t == SSX_FX) + { /* x[k] has upper bound */ + if (mpq_cmp(bbar[i], ub[k]) > 0) + { /* which is violated */ + break; + } + } + } + if (i > m) + { /* no basic variable violates its bounds */ + ret = 0; + goto skip; + } + /* phase I: find primal feasible solution */ + ret = ssx_phase_I(ssx); + switch (ret) + { case 0: + ret = 0; + break; + case 1: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("PROBLEM HAS NO FEASIBLE SOLUTION\n"); + ret = 1; + break; + case 2: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("ITERATIONS LIMIT EXCEEDED; SEARCH TERMINATED\n"); + ret = 3; + break; + case 3: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); + ret = 5; + break; + default: + xassert(ret != ret); + } + /* compute values of basic variables (actually only the objective + value needs to be computed) */ + ssx_eval_bbar(ssx); +skip: /* compute simplex multipliers */ + ssx_eval_pi(ssx); + /* compute reduced costs of non-basic variables */ + ssx_eval_cbar(ssx); + /* if phase I failed, do not start phase II */ + if (ret != 0) goto done; + /* phase II: find optimal solution */ + ret = ssx_phase_II(ssx); + switch (ret) + { case 0: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("OPTIMAL SOLUTION FOUND\n"); + ret = 0; + break; + case 1: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("PROBLEM HAS UNBOUNDED SOLUTION\n"); + ret = 2; + break; + case 2: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("ITERATIONS LIMIT EXCEEDED; SEARCH TERMINATED\n"); + ret = 4; + break; + case 3: +#if 1 /* 25/XI-2017 */ + if (ssx->msg_lev >= GLP_MSG_ALL) +#endif + xprintf("TIME LIMIT EXCEEDED; SEARCH TERMINATED\n"); + ret = 6; + break; + default: + xassert(ret != ret); + } +done: /* decrease the time limit by the spent amount of time */ + if (ssx->tm_lim >= 0.0) +#if 0 + { ssx->tm_lim -= utime() - ssx->tm_beg; +#else + { ssx->tm_lim -= xdifftime(xtime(), ssx->tm_beg); +#endif + if (ssx->tm_lim < 0.0) ssx->tm_lim = 0.0; + } + return ret; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/ios.h b/test/monniaux/glpk-4.65/src/draft/ios.h new file mode 100644 index 00000000..1cb07ee0 --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/ios.h @@ -0,0 +1,547 @@ +/* ios.h (integer optimization suite) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013, 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/>. +***********************************************************************/ + +#ifndef IOS_H +#define IOS_H + +#include "prob.h" + +#if 1 /* 02/II-2018 */ +#define NEW_LOCAL 1 +#endif + +#if 1 /* 15/II-2018 */ +#define NEW_COVER 1 +#endif + +typedef struct IOSLOT IOSLOT; +typedef struct IOSNPD IOSNPD; +typedef struct IOSBND IOSBND; +typedef struct IOSTAT IOSTAT; +typedef struct IOSROW IOSROW; +typedef struct IOSAIJ IOSAIJ; +#ifdef NEW_LOCAL /* 02/II-2018 */ +typedef glp_prob IOSPOOL; +typedef GLPROW IOSCUT; +#else +typedef struct IOSPOOL IOSPOOL; +typedef struct IOSCUT IOSCUT; +#endif + +struct glp_tree +{ /* branch-and-bound tree */ + int magic; + /* magic value used for debugging */ + DMP *pool; + /* memory pool to store all IOS components */ + int n; + /* number of columns (variables) */ + /*--------------------------------------------------------------*/ + /* problem components corresponding to the original MIP and its + LP relaxation (used to restore the original problem object on + exit from the solver) */ + int orig_m; + /* number of rows */ + unsigned char *orig_type; /* uchar orig_type[1+orig_m+n]; */ + /* types of all variables */ + double *orig_lb; /* double orig_lb[1+orig_m+n]; */ + /* lower bounds of all variables */ + double *orig_ub; /* double orig_ub[1+orig_m+n]; */ + /* upper bounds of all variables */ + unsigned char *orig_stat; /* uchar orig_stat[1+orig_m+n]; */ + /* statuses of all variables */ + double *orig_prim; /* double orig_prim[1+orig_m+n]; */ + /* primal values of all variables */ + double *orig_dual; /* double orig_dual[1+orig_m+n]; */ + /* dual values of all variables */ + double orig_obj; + /* optimal objective value for LP relaxation */ + /*--------------------------------------------------------------*/ + /* branch-and-bound tree */ + int nslots; + /* length of the array of slots (enlarged automatically) */ + int avail; + /* index of the first free slot; 0 means all slots are in use */ + IOSLOT *slot; /* IOSLOT slot[1+nslots]; */ + /* array of slots: + slot[0] is not used; + slot[p], 1 <= p <= nslots, either contains a pointer to some + node of the branch-and-bound tree, in which case p is used on + API level as the reference number of corresponding subproblem, + or is free; all free slots are linked into single linked list; + slot[1] always contains a pointer to the root node (it is free + only if the tree is empty) */ + IOSNPD *head; + /* pointer to the head of the active list */ + IOSNPD *tail; + /* pointer to the tail of the active list */ + /* the active list is a doubly linked list of active subproblems + which correspond to leaves of the tree; all subproblems in the + active list are ordered chronologically (each a new subproblem + is always added to the tail of the list) */ + int a_cnt; + /* current number of active nodes (including the current one) */ + int n_cnt; + /* current number of all (active and inactive) nodes */ + int t_cnt; + /* total number of nodes including those which have been already + removed from the tree; this count is increased by one whenever + a new node is created and never decreased */ + /*--------------------------------------------------------------*/ + /* problem components corresponding to the root subproblem */ + int root_m; + /* number of rows */ + unsigned char *root_type; /* uchar root_type[1+root_m+n]; */ + /* types of all variables */ + double *root_lb; /* double root_lb[1+root_m+n]; */ + /* lower bounds of all variables */ + double *root_ub; /* double root_ub[1+root_m+n]; */ + /* upper bounds of all variables */ + unsigned char *root_stat; /* uchar root_stat[1+root_m+n]; */ + /* statuses of all variables */ + /*--------------------------------------------------------------*/ + /* current subproblem and its LP relaxation */ + IOSNPD *curr; + /* pointer to the current subproblem (which can be only active); + NULL means the current subproblem does not exist */ + glp_prob *mip; + /* original problem object passed to the solver; if the current + subproblem exists, its LP segment corresponds to LP relaxation + of the current subproblem; if the current subproblem does not + exist, its LP segment corresponds to LP relaxation of the root + subproblem (note that the root subproblem may differ from the + original MIP, because it may be preprocessed and/or may have + additional rows) */ + unsigned char *non_int; /* uchar non_int[1+n]; */ + /* these column flags are set each time when LP relaxation of the + current subproblem has been solved; + non_int[0] is not used; + non_int[j], 1 <= j <= n, is j-th column flag; if this flag is + set, corresponding variable is required to be integer, but its + value in basic solution is fractional */ + /*--------------------------------------------------------------*/ + /* problem components corresponding to the parent (predecessor) + subproblem for the current subproblem; used to inspect changes + on freezing the current subproblem */ + int pred_m; + /* number of rows */ + int pred_max; + /* length of the following four arrays (enlarged automatically), + pred_max >= pred_m + n */ + unsigned char *pred_type; /* uchar pred_type[1+pred_m+n]; */ + /* types of all variables */ + double *pred_lb; /* double pred_lb[1+pred_m+n]; */ + /* lower bounds of all variables */ + double *pred_ub; /* double pred_ub[1+pred_m+n]; */ + /* upper bounds of all variables */ + unsigned char *pred_stat; /* uchar pred_stat[1+pred_m+n]; */ + /* statuses of all variables */ + /****************************************************************/ + /* built-in cut generators segment */ + IOSPOOL *local; + /* local cut pool */ +#if 1 /* 13/II-2018 */ + glp_cov *cov_gen; + /* pointer to working area used by the cover cut generator */ +#endif + glp_mir *mir_gen; + /* pointer to working area used by the MIR cut generator */ + glp_cfg *clq_gen; + /* pointer to conflict graph used by the clique cut generator */ + /*--------------------------------------------------------------*/ + void *pcost; + /* pointer to working area used on pseudocost branching */ + int *iwrk; /* int iwrk[1+n]; */ + /* working array */ + double *dwrk; /* double dwrk[1+n]; */ + /* working array */ + /*--------------------------------------------------------------*/ + /* control parameters and statistics */ + const glp_iocp *parm; + /* copy of control parameters passed to the solver */ + double tm_beg; + /* starting time of the search, in seconds; the total time of the + search is the difference between xtime() and tm_beg */ + double tm_lag; + /* the most recent time, in seconds, at which the progress of the + the search was displayed */ + int sol_cnt; + /* number of integer feasible solutions found */ +#if 1 /* 11/VII-2013 */ + void *P; /* glp_prob *P; */ + /* problem passed to glp_intopt */ + void *npp; /* NPP *npp; */ + /* preprocessor workspace or NULL */ + const char *save_sol; + /* filename (template) to save every new solution */ + int save_cnt; + /* count to generate filename */ +#endif + /*--------------------------------------------------------------*/ + /* advanced solver interface */ + int reason; + /* flag indicating the reason why the callback routine is being + called (see glpk.h) */ + int stop; + /* flag indicating that the callback routine requires premature + termination of the search */ + int next_p; + /* reference number of active subproblem selected to continue + the search; 0 means no subproblem has been selected */ + int reopt; + /* flag indicating that the current LP relaxation needs to be + re-optimized */ + int reinv; + /* flag indicating that some (non-active) rows were removed from + the current LP relaxation, so if there no new rows appear, the + basis must be re-factorized */ + int br_var; + /* the number of variable chosen to branch on */ + int br_sel; + /* flag indicating which branch (subproblem) is suggested to be + selected to continue the search: + GLP_DN_BRNCH - select down-branch + GLP_UP_BRNCH - select up-branch + GLP_NO_BRNCH - use general selection technique */ + int child; + /* subproblem reference number corresponding to br_sel */ +}; + +struct IOSLOT +{ /* node subproblem slot */ + IOSNPD *node; + /* pointer to subproblem descriptor; NULL means free slot */ + int next; + /* index of another free slot (only if this slot is free) */ +}; + +struct IOSNPD +{ /* node subproblem descriptor */ + int p; + /* subproblem reference number (it is the index to corresponding + slot, i.e. slot[p] points to this descriptor) */ + IOSNPD *up; + /* pointer to the parent subproblem; NULL means this node is the + root of the tree, in which case p = 1 */ + int level; + /* node level (the root node has level 0) */ + int count; + /* if count = 0, this subproblem is active; if count > 0, this + subproblem is inactive, in which case count is the number of + its child subproblems */ + /* the following three linked lists are destroyed on reviving and + built anew on freezing the subproblem: */ + IOSBND *b_ptr; + /* linked list of rows and columns of the parent subproblem whose + types and bounds were changed */ + IOSTAT *s_ptr; + /* linked list of rows and columns of the parent subproblem whose + statuses were changed */ + IOSROW *r_ptr; + /* linked list of rows (cuts) added to the parent subproblem */ + int solved; + /* how many times LP relaxation of this subproblem was solved; + for inactive subproblem this count is always non-zero; + for active subproblem, which is not current, this count may be + non-zero, if the subproblem was temporarily suspended */ + double lp_obj; + /* optimal objective value to LP relaxation of this subproblem; + on creating a subproblem this value is inherited from its + parent; for the root subproblem, which has no parent, this + value is initially set to -DBL_MAX (minimization) or +DBL_MAX + (maximization); each time the subproblem is re-optimized, this + value is appropriately changed */ + double bound; + /* local lower (minimization) or upper (maximization) bound for + integer optimal solution to *this* subproblem; this bound is + local in the sense that only subproblems in the subtree rooted + at this node cannot have better integer feasible solutions; + on creating a subproblem its local bound is inherited from its + parent and then can be made stronger (never weaker); for the + root subproblem its local bound is initially set to -DBL_MAX + (minimization) or +DBL_MAX (maximization) and then improved as + the root LP relaxation has been solved */ + /* the following two quantities are defined only if LP relaxation + of this subproblem was solved at least once (solved > 0): */ + int ii_cnt; + /* number of integer variables whose value in optimal solution to + LP relaxation of this subproblem is fractional */ + double ii_sum; + /* sum of integer infeasibilities */ +#if 1 /* 30/XI-2009 */ + int changed; + /* how many times this subproblem was re-formulated (by adding + cutting plane constraints) */ +#endif + int br_var; + /* ordinal number of branching variable, 1 <= br_var <= n, used + to split this subproblem; 0 means that either this subproblem + is active or branching was made on a constraint */ + double br_val; + /* (fractional) value of branching variable in optimal solution + to final LP relaxation of this subproblem */ + void *data; /* char data[tree->cb_size]; */ + /* pointer to the application-specific data */ + IOSNPD *temp; + /* working pointer used by some routines */ + IOSNPD *prev; + /* pointer to previous subproblem in the active list */ + IOSNPD *next; + /* pointer to next subproblem in the active list */ +}; + +struct IOSBND +{ /* bounds change entry */ + int k; + /* ordinal number of corresponding row (1 <= k <= m) or column + (m+1 <= k <= m+n), where m and n are the number of rows and + columns, resp., in the parent subproblem */ + unsigned char type; + /* new type */ + double lb; + /* new lower bound */ + double ub; + /* new upper bound */ + IOSBND *next; + /* pointer to next entry for the same subproblem */ +}; + +struct IOSTAT +{ /* status change entry */ + int k; + /* ordinal number of corresponding row (1 <= k <= m) or column + (m+1 <= k <= m+n), where m and n are the number of rows and + columns, resp., in the parent subproblem */ + unsigned char stat; + /* new status */ + IOSTAT *next; + /* pointer to next entry for the same subproblem */ +}; + +struct IOSROW +{ /* row (constraint) addition entry */ + char *name; + /* row name or NULL */ + unsigned char origin; + /* row origin flag (see glp_attr.origin) */ + unsigned char klass; + /* row class descriptor (see glp_attr.klass) */ + unsigned char type; + /* row type (GLP_LO, GLP_UP, etc.) */ + double lb; + /* row lower bound */ + double ub; + /* row upper bound */ + IOSAIJ *ptr; + /* pointer to the row coefficient list */ + double rii; + /* row scale factor */ + unsigned char stat; + /* row status (GLP_BS, GLP_NL, etc.) */ + IOSROW *next; + /* pointer to next entry for the same subproblem */ +}; + +struct IOSAIJ +{ /* constraint coefficient */ + int j; + /* variable (column) number, 1 <= j <= n */ + double val; + /* non-zero coefficient value */ + IOSAIJ *next; + /* pointer to next coefficient for the same row */ +}; + +#ifndef NEW_LOCAL /* 02/II-2018 */ +struct IOSPOOL +{ /* cut pool */ + int size; + /* pool size = number of cuts in the pool */ + IOSCUT *head; + /* pointer to the first cut */ + IOSCUT *tail; + /* pointer to the last cut */ + int ord; + /* ordinal number of the current cut, 1 <= ord <= size */ + IOSCUT *curr; + /* pointer to the current cut */ +}; +#endif + +#ifndef NEW_LOCAL /* 02/II-2018 */ +struct IOSCUT +{ /* cut (cutting plane constraint) */ + char *name; + /* cut name or NULL */ + unsigned char klass; + /* cut class descriptor (see glp_attr.klass) */ + IOSAIJ *ptr; + /* pointer to the cut coefficient list */ + unsigned char type; + /* cut type: + GLP_LO: sum a[j] * x[j] >= b + GLP_UP: sum a[j] * x[j] <= b + GLP_FX: sum a[j] * x[j] = b */ + double rhs; + /* cut right-hand side */ + IOSCUT *prev; + /* pointer to previous cut */ + IOSCUT *next; + /* pointer to next cut */ +}; +#endif + +#define ios_create_tree _glp_ios_create_tree +glp_tree *ios_create_tree(glp_prob *mip, const glp_iocp *parm); +/* create branch-and-bound tree */ + +#define ios_revive_node _glp_ios_revive_node +void ios_revive_node(glp_tree *tree, int p); +/* revive specified subproblem */ + +#define ios_freeze_node _glp_ios_freeze_node +void ios_freeze_node(glp_tree *tree); +/* freeze current subproblem */ + +#define ios_clone_node _glp_ios_clone_node +void ios_clone_node(glp_tree *tree, int p, int nnn, int ref[]); +/* clone specified subproblem */ + +#define ios_delete_node _glp_ios_delete_node +void ios_delete_node(glp_tree *tree, int p); +/* delete specified subproblem */ + +#define ios_delete_tree _glp_ios_delete_tree +void ios_delete_tree(glp_tree *tree); +/* delete branch-and-bound tree */ + +#define ios_eval_degrad _glp_ios_eval_degrad +void ios_eval_degrad(glp_tree *tree, int j, double *dn, double *up); +/* estimate obj. degrad. for down- and up-branches */ + +#define ios_round_bound _glp_ios_round_bound +double ios_round_bound(glp_tree *tree, double bound); +/* improve local bound by rounding */ + +#define ios_is_hopeful _glp_ios_is_hopeful +int ios_is_hopeful(glp_tree *tree, double bound); +/* check if subproblem is hopeful */ + +#define ios_best_node _glp_ios_best_node +int ios_best_node(glp_tree *tree); +/* find active node with best local bound */ + +#define ios_relative_gap _glp_ios_relative_gap +double ios_relative_gap(glp_tree *tree); +/* compute relative mip gap */ + +#define ios_solve_node _glp_ios_solve_node +int ios_solve_node(glp_tree *tree); +/* solve LP relaxation of current subproblem */ + +#define ios_create_pool _glp_ios_create_pool +IOSPOOL *ios_create_pool(glp_tree *tree); +/* create cut pool */ + +#define ios_add_row _glp_ios_add_row +int ios_add_row(glp_tree *tree, IOSPOOL *pool, + const char *name, int klass, int flags, int len, const int ind[], + const double val[], int type, double rhs); +/* add row (constraint) to the cut pool */ + +#define ios_find_row _glp_ios_find_row +IOSCUT *ios_find_row(IOSPOOL *pool, int i); +/* find row (constraint) in the cut pool */ + +#define ios_del_row _glp_ios_del_row +void ios_del_row(glp_tree *tree, IOSPOOL *pool, int i); +/* remove row (constraint) from the cut pool */ + +#define ios_clear_pool _glp_ios_clear_pool +void ios_clear_pool(glp_tree *tree, IOSPOOL *pool); +/* remove all rows (constraints) from the cut pool */ + +#define ios_delete_pool _glp_ios_delete_pool +void ios_delete_pool(glp_tree *tree, IOSPOOL *pool); +/* delete cut pool */ + +#if 1 /* 11/VII-2013 */ +#define ios_process_sol _glp_ios_process_sol +void ios_process_sol(glp_tree *T); +/* process integer feasible solution just found */ +#endif + +#define ios_preprocess_node _glp_ios_preprocess_node +int ios_preprocess_node(glp_tree *tree, int max_pass); +/* preprocess current subproblem */ + +#define ios_driver _glp_ios_driver +int ios_driver(glp_tree *tree); +/* branch-and-bound driver */ + +#define ios_cov_gen _glp_ios_cov_gen +void ios_cov_gen(glp_tree *tree); +/* generate mixed cover cuts */ + +#define ios_pcost_init _glp_ios_pcost_init +void *ios_pcost_init(glp_tree *tree); +/* initialize working data used on pseudocost branching */ + +#define ios_pcost_branch _glp_ios_pcost_branch +int ios_pcost_branch(glp_tree *T, int *next); +/* choose branching variable with pseudocost branching */ + +#define ios_pcost_update _glp_ios_pcost_update +void ios_pcost_update(glp_tree *tree); +/* update history information for pseudocost branching */ + +#define ios_pcost_free _glp_ios_pcost_free +void ios_pcost_free(glp_tree *tree); +/* free working area used on pseudocost branching */ + +#define ios_feas_pump _glp_ios_feas_pump +void ios_feas_pump(glp_tree *T); +/* feasibility pump heuristic */ + +#if 1 /* 25/V-2013 */ +#define ios_proxy_heur _glp_ios_proxy_heur +void ios_proxy_heur(glp_tree *T); +/* proximity search heuristic */ +#endif + +#define ios_process_cuts _glp_ios_process_cuts +void ios_process_cuts(glp_tree *T); +/* process cuts stored in the local cut pool */ + +#define ios_choose_node _glp_ios_choose_node +int ios_choose_node(glp_tree *T); +/* select subproblem to continue the search */ + +#define ios_choose_var _glp_ios_choose_var +int ios_choose_var(glp_tree *T, int *next); +/* select variable to branch on */ + +#endif + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/lux.c b/test/monniaux/glpk-4.65/src/draft/lux.c new file mode 100644 index 00000000..38cb758c --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/lux.c @@ -0,0 +1,1030 @@ +/* lux.c (LU-factorization, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 "lux.h" + +#define xfault xerror +#define dmp_create_poolx(size) dmp_create_pool() + +/*********************************************************************** +* lux_create - create LU-factorization +* +* SYNOPSIS +* +* #include "lux.h" +* LUX *lux_create(int n); +* +* DESCRIPTION +* +* The routine lux_create creates LU-factorization data structure for +* a matrix of the order n. Initially the factorization corresponds to +* the unity matrix (F = V = P = Q = I, so A = I). +* +* RETURNS +* +* The routine returns a pointer to the created LU-factorization data +* structure, which represents the unity matrix of the order n. */ + +LUX *lux_create(int n) +{ LUX *lux; + int k; + if (n < 1) + xfault("lux_create: n = %d; invalid parameter\n", n); + lux = xmalloc(sizeof(LUX)); + lux->n = n; + lux->pool = dmp_create_poolx(sizeof(LUXELM)); + lux->F_row = xcalloc(1+n, sizeof(LUXELM *)); + lux->F_col = xcalloc(1+n, sizeof(LUXELM *)); + lux->V_piv = xcalloc(1+n, sizeof(mpq_t)); + lux->V_row = xcalloc(1+n, sizeof(LUXELM *)); + lux->V_col = xcalloc(1+n, sizeof(LUXELM *)); + lux->P_row = xcalloc(1+n, sizeof(int)); + lux->P_col = xcalloc(1+n, sizeof(int)); + lux->Q_row = xcalloc(1+n, sizeof(int)); + lux->Q_col = xcalloc(1+n, sizeof(int)); + for (k = 1; k <= n; k++) + { lux->F_row[k] = lux->F_col[k] = NULL; + mpq_init(lux->V_piv[k]); + mpq_set_si(lux->V_piv[k], 1, 1); + lux->V_row[k] = lux->V_col[k] = NULL; + lux->P_row[k] = lux->P_col[k] = k; + lux->Q_row[k] = lux->Q_col[k] = k; + } + lux->rank = n; + return lux; +} + +/*********************************************************************** +* initialize - initialize LU-factorization data structures +* +* This routine initializes data structures for subsequent computing +* the LU-factorization of a given matrix A, which is specified by the +* formal routine col. On exit V = A and F = P = Q = I, where I is the +* unity matrix. */ + +static void initialize(LUX *lux, int (*col)(void *info, int j, + int ind[], mpq_t val[]), void *info, LUXWKA *wka) +{ int n = lux->n; + DMP *pool = lux->pool; + LUXELM **F_row = lux->F_row; + LUXELM **F_col = lux->F_col; + mpq_t *V_piv = lux->V_piv; + LUXELM **V_row = lux->V_row; + LUXELM **V_col = lux->V_col; + int *P_row = lux->P_row; + int *P_col = lux->P_col; + int *Q_row = lux->Q_row; + int *Q_col = lux->Q_col; + int *R_len = wka->R_len; + int *R_head = wka->R_head; + int *R_prev = wka->R_prev; + int *R_next = wka->R_next; + int *C_len = wka->C_len; + int *C_head = wka->C_head; + int *C_prev = wka->C_prev; + int *C_next = wka->C_next; + LUXELM *fij, *vij; + int i, j, k, len, *ind; + mpq_t *val; + /* F := I */ + for (i = 1; i <= n; i++) + { while (F_row[i] != NULL) + { fij = F_row[i], F_row[i] = fij->r_next; + mpq_clear(fij->val); + dmp_free_atom(pool, fij, sizeof(LUXELM)); + } + } + for (j = 1; j <= n; j++) F_col[j] = NULL; + /* V := 0 */ + for (k = 1; k <= n; k++) mpq_set_si(V_piv[k], 0, 1); + for (i = 1; i <= n; i++) + { while (V_row[i] != NULL) + { vij = V_row[i], V_row[i] = vij->r_next; + mpq_clear(vij->val); + dmp_free_atom(pool, vij, sizeof(LUXELM)); + } + } + for (j = 1; j <= n; j++) V_col[j] = NULL; + /* V := A */ + ind = xcalloc(1+n, sizeof(int)); + val = xcalloc(1+n, sizeof(mpq_t)); + for (k = 1; k <= n; k++) mpq_init(val[k]); + for (j = 1; j <= n; j++) + { /* obtain j-th column of matrix A */ + len = col(info, j, ind, val); + if (!(0 <= len && len <= n)) + xfault("lux_decomp: j = %d: len = %d; invalid column length" + "\n", j, len); + /* copy elements of j-th column to matrix V */ + for (k = 1; k <= len; k++) + { /* get row index of a[i,j] */ + i = ind[k]; + if (!(1 <= i && i <= n)) + xfault("lux_decomp: j = %d: i = %d; row index out of ran" + "ge\n", j, i); + /* check for duplicate indices */ + if (V_row[i] != NULL && V_row[i]->j == j) + xfault("lux_decomp: j = %d: i = %d; duplicate row indice" + "s not allowed\n", j, i); + /* check for zero value */ + if (mpq_sgn(val[k]) == 0) + xfault("lux_decomp: j = %d: i = %d; zero elements not al" + "lowed\n", j, i); + /* add new element v[i,j] = a[i,j] to V */ + vij = dmp_get_atom(pool, sizeof(LUXELM)); + vij->i = i, vij->j = j; + mpq_init(vij->val); + mpq_set(vij->val, val[k]); + vij->r_prev = NULL; + vij->r_next = V_row[i]; + vij->c_prev = NULL; + vij->c_next = V_col[j]; + if (vij->r_next != NULL) vij->r_next->r_prev = vij; + if (vij->c_next != NULL) vij->c_next->c_prev = vij; + V_row[i] = V_col[j] = vij; + } + } + xfree(ind); + for (k = 1; k <= n; k++) mpq_clear(val[k]); + xfree(val); + /* P := Q := I */ + for (k = 1; k <= n; k++) + P_row[k] = P_col[k] = Q_row[k] = Q_col[k] = k; + /* the rank of A and V is not determined yet */ + lux->rank = -1; + /* initially the entire matrix V is active */ + /* determine its row lengths */ + for (i = 1; i <= n; i++) + { len = 0; + for (vij = V_row[i]; vij != NULL; vij = vij->r_next) len++; + R_len[i] = len; + } + /* build linked lists of active rows */ + for (len = 0; len <= n; len++) R_head[len] = 0; + for (i = 1; i <= n; i++) + { len = R_len[i]; + R_prev[i] = 0; + R_next[i] = R_head[len]; + if (R_next[i] != 0) R_prev[R_next[i]] = i; + R_head[len] = i; + } + /* determine its column lengths */ + for (j = 1; j <= n; j++) + { len = 0; + for (vij = V_col[j]; vij != NULL; vij = vij->c_next) len++; + C_len[j] = len; + } + /* build linked lists of active columns */ + for (len = 0; len <= n; len++) C_head[len] = 0; + for (j = 1; j <= n; j++) + { len = C_len[j]; + C_prev[j] = 0; + C_next[j] = C_head[len]; + if (C_next[j] != 0) C_prev[C_next[j]] = j; + C_head[len] = j; + } + return; +} + +/*********************************************************************** +* find_pivot - choose a pivot element +* +* This routine chooses a pivot element v[p,q] in the active submatrix +* of matrix U = P*V*Q. +* +* It is assumed that on entry the matrix U has the following partially +* triangularized form: +* +* 1 k n +* 1 x x x x x x x x x x +* . x x x x x x x x x +* . . x x x x x x x x +* . . . x x x x x x x +* k . . . . * * * * * * +* . . . . * * * * * * +* . . . . * * * * * * +* . . . . * * * * * * +* . . . . * * * * * * +* n . . . . * * * * * * +* +* where rows and columns k, k+1, ..., n belong to the active submatrix +* (elements of the active submatrix are marked by '*'). +* +* Since the matrix U = P*V*Q is not stored, the routine works with the +* matrix V. It is assumed that the row-wise representation corresponds +* to the matrix V, but the column-wise representation corresponds to +* the active submatrix of the matrix V, i.e. elements of the matrix V, +* which does not belong to the active submatrix, are missing from the +* column linked lists. It is also assumed that each active row of the +* matrix V is in the set R[len], where len is number of non-zeros in +* the row, and each active column of the matrix V is in the set C[len], +* where len is number of non-zeros in the column (in the latter case +* only elements of the active submatrix are counted; such elements are +* marked by '*' on the figure above). +* +* Due to exact arithmetic any non-zero element of the active submatrix +* can be chosen as a pivot. However, to keep sparsity of the matrix V +* the routine uses Markowitz strategy, trying to choose such element +* v[p,q], which has smallest Markowitz cost (nr[p]-1) * (nc[q]-1), +* where nr[p] and nc[q] are the number of non-zero elements, resp., in +* p-th row and in q-th column of the active submatrix. +* +* In order to reduce the search, i.e. not to walk through all elements +* of the active submatrix, the routine exploits a technique proposed by +* I.Duff. This technique is based on using the sets R[len] and C[len] +* of active rows and columns. +* +* On exit the routine returns a pointer to a pivot v[p,q] chosen, or +* NULL, if the active submatrix is empty. */ + +static LUXELM *find_pivot(LUX *lux, LUXWKA *wka) +{ int n = lux->n; + LUXELM **V_row = lux->V_row; + LUXELM **V_col = lux->V_col; + int *R_len = wka->R_len; + int *R_head = wka->R_head; + int *R_next = wka->R_next; + int *C_len = wka->C_len; + int *C_head = wka->C_head; + int *C_next = wka->C_next; + LUXELM *piv, *some, *vij; + int i, j, len, min_len, ncand, piv_lim = 5; + double best, cost; + /* nothing is chosen so far */ + piv = NULL, best = DBL_MAX, ncand = 0; + /* if in the active submatrix there is a column that has the only + non-zero (column singleton), choose it as a pivot */ + j = C_head[1]; + if (j != 0) + { xassert(C_len[j] == 1); + piv = V_col[j]; + xassert(piv != NULL && piv->c_next == NULL); + goto done; + } + /* if in the active submatrix there is a row that has the only + non-zero (row singleton), choose it as a pivot */ + i = R_head[1]; + if (i != 0) + { xassert(R_len[i] == 1); + piv = V_row[i]; + xassert(piv != NULL && piv->r_next == NULL); + goto done; + } + /* there are no singletons in the active submatrix; walk through + other non-empty rows and columns */ + for (len = 2; len <= n; len++) + { /* consider active columns having len non-zeros */ + for (j = C_head[len]; j != 0; j = C_next[j]) + { /* j-th column has len non-zeros */ + /* find an element in the row of minimal length */ + some = NULL, min_len = INT_MAX; + for (vij = V_col[j]; vij != NULL; vij = vij->c_next) + { if (min_len > R_len[vij->i]) + some = vij, min_len = R_len[vij->i]; + /* if Markowitz cost of this element is not greater than + (len-1)**2, it can be chosen right now; this heuristic + reduces the search and works well in many cases */ + if (min_len <= len) + { piv = some; + goto done; + } + } + /* j-th column has been scanned */ + /* the minimal element found is a next pivot candidate */ + xassert(some != NULL); + ncand++; + /* compute its Markowitz cost */ + cost = (double)(min_len - 1) * (double)(len - 1); + /* choose between the current candidate and this element */ + if (cost < best) piv = some, best = cost; + /* if piv_lim candidates have been considered, there is a + doubt that a much better candidate exists; therefore it + is the time to terminate the search */ + if (ncand == piv_lim) goto done; + } + /* now consider active rows having len non-zeros */ + for (i = R_head[len]; i != 0; i = R_next[i]) + { /* i-th row has len non-zeros */ + /* find an element in the column of minimal length */ + some = NULL, min_len = INT_MAX; + for (vij = V_row[i]; vij != NULL; vij = vij->r_next) + { if (min_len > C_len[vij->j]) + some = vij, min_len = C_len[vij->j]; + /* if Markowitz cost of this element is not greater than + (len-1)**2, it can be chosen right now; this heuristic + reduces the search and works well in many cases */ + if (min_len <= len) + { piv = some; + goto done; + } + } + /* i-th row has been scanned */ + /* the minimal element found is a next pivot candidate */ + xassert(some != NULL); + ncand++; + /* compute its Markowitz cost */ + cost = (double)(len - 1) * (double)(min_len - 1); + /* choose between the current candidate and this element */ + if (cost < best) piv = some, best = cost; + /* if piv_lim candidates have been considered, there is a + doubt that a much better candidate exists; therefore it + is the time to terminate the search */ + if (ncand == piv_lim) goto done; + } + } +done: /* bring the pivot v[p,q] to the factorizing routine */ + return piv; +} + +/*********************************************************************** +* eliminate - perform gaussian elimination +* +* This routine performs elementary gaussian transformations in order +* to eliminate subdiagonal elements in the k-th column of the matrix +* U = P*V*Q using the pivot element u[k,k], where k is the number of +* the current elimination step. +* +* The parameter piv specifies the pivot element v[p,q] = u[k,k]. +* +* Each time when the routine applies the elementary transformation to +* a non-pivot row of the matrix V, it stores the corresponding element +* to the matrix F in order to keep the main equality A = F*V. +* +* The routine assumes that on entry the matrices L = P*F*inv(P) and +* U = P*V*Q are the following: +* +* 1 k 1 k n +* 1 1 . . . . . . . . . 1 x x x x x x x x x x +* x 1 . . . . . . . . . x x x x x x x x x +* x x 1 . . . . . . . . . x x x x x x x x +* x x x 1 . . . . . . . . . x x x x x x x +* k x x x x 1 . . . . . k . . . . * * * * * * +* x x x x _ 1 . . . . . . . . # * * * * * +* x x x x _ . 1 . . . . . . . # * * * * * +* x x x x _ . . 1 . . . . . . # * * * * * +* x x x x _ . . . 1 . . . . . # * * * * * +* n x x x x _ . . . . 1 n . . . . # * * * * * +* +* matrix L matrix U +* +* where rows and columns of the matrix U with numbers k, k+1, ..., n +* form the active submatrix (eliminated elements are marked by '#' and +* other elements of the active submatrix are marked by '*'). Note that +* each eliminated non-zero element u[i,k] of the matrix U gives the +* corresponding element l[i,k] of the matrix L (marked by '_'). +* +* Actually all operations are performed on the matrix V. Should note +* that the row-wise representation corresponds to the matrix V, but the +* column-wise representation corresponds to the active submatrix of the +* matrix V, i.e. elements of the matrix V, which doesn't belong to the +* active submatrix, are missing from the column linked lists. +* +* Let u[k,k] = v[p,q] be the pivot. In order to eliminate subdiagonal +* elements u[i',k] = v[i,q], i' = k+1, k+2, ..., n, the routine applies +* the following elementary gaussian transformations: +* +* (i-th row of V) := (i-th row of V) - f[i,p] * (p-th row of V), +* +* where f[i,p] = v[i,q] / v[p,q] is a gaussian multiplier. +* +* Additionally, in order to keep the main equality A = F*V, each time +* when the routine applies the transformation to i-th row of the matrix +* V, it also adds f[i,p] as a new element to the matrix F. +* +* IMPORTANT: On entry the working arrays flag and work should contain +* zeros. This status is provided by the routine on exit. */ + +static void eliminate(LUX *lux, LUXWKA *wka, LUXELM *piv, int flag[], + mpq_t work[]) +{ DMP *pool = lux->pool; + LUXELM **F_row = lux->F_row; + LUXELM **F_col = lux->F_col; + mpq_t *V_piv = lux->V_piv; + LUXELM **V_row = lux->V_row; + LUXELM **V_col = lux->V_col; + int *R_len = wka->R_len; + int *R_head = wka->R_head; + int *R_prev = wka->R_prev; + int *R_next = wka->R_next; + int *C_len = wka->C_len; + int *C_head = wka->C_head; + int *C_prev = wka->C_prev; + int *C_next = wka->C_next; + LUXELM *fip, *vij, *vpj, *viq, *next; + mpq_t temp; + int i, j, p, q; + mpq_init(temp); + /* determine row and column indices of the pivot v[p,q] */ + xassert(piv != NULL); + p = piv->i, q = piv->j; + /* remove p-th (pivot) row from the active set; it will never + return there */ + if (R_prev[p] == 0) + R_head[R_len[p]] = R_next[p]; + else + R_next[R_prev[p]] = R_next[p]; + if (R_next[p] == 0) + ; + else + R_prev[R_next[p]] = R_prev[p]; + /* remove q-th (pivot) column from the active set; it will never + return there */ + if (C_prev[q] == 0) + C_head[C_len[q]] = C_next[q]; + else + C_next[C_prev[q]] = C_next[q]; + if (C_next[q] == 0) + ; + else + C_prev[C_next[q]] = C_prev[q]; + /* store the pivot value in a separate array */ + mpq_set(V_piv[p], piv->val); + /* remove the pivot from p-th row */ + if (piv->r_prev == NULL) + V_row[p] = piv->r_next; + else + piv->r_prev->r_next = piv->r_next; + if (piv->r_next == NULL) + ; + else + piv->r_next->r_prev = piv->r_prev; + R_len[p]--; + /* remove the pivot from q-th column */ + if (piv->c_prev == NULL) + V_col[q] = piv->c_next; + else + piv->c_prev->c_next = piv->c_next; + if (piv->c_next == NULL) + ; + else + piv->c_next->c_prev = piv->c_prev; + C_len[q]--; + /* free the space occupied by the pivot */ + mpq_clear(piv->val); + dmp_free_atom(pool, piv, sizeof(LUXELM)); + /* walk through p-th (pivot) row, which already does not contain + the pivot v[p,q], and do the following... */ + for (vpj = V_row[p]; vpj != NULL; vpj = vpj->r_next) + { /* get column index of v[p,j] */ + j = vpj->j; + /* store v[p,j] in the working array */ + flag[j] = 1; + mpq_set(work[j], vpj->val); + /* remove j-th column from the active set; it will return there + later with a new length */ + if (C_prev[j] == 0) + C_head[C_len[j]] = C_next[j]; + else + C_next[C_prev[j]] = C_next[j]; + if (C_next[j] == 0) + ; + else + C_prev[C_next[j]] = C_prev[j]; + /* v[p,j] leaves the active submatrix, so remove it from j-th + column; however, v[p,j] is kept in p-th row */ + if (vpj->c_prev == NULL) + V_col[j] = vpj->c_next; + else + vpj->c_prev->c_next = vpj->c_next; + if (vpj->c_next == NULL) + ; + else + vpj->c_next->c_prev = vpj->c_prev; + C_len[j]--; + } + /* now walk through q-th (pivot) column, which already does not + contain the pivot v[p,q], and perform gaussian elimination */ + while (V_col[q] != NULL) + { /* element v[i,q] has to be eliminated */ + viq = V_col[q]; + /* get row index of v[i,q] */ + i = viq->i; + /* remove i-th row from the active set; later it will return + there with a new length */ + if (R_prev[i] == 0) + R_head[R_len[i]] = R_next[i]; + else + R_next[R_prev[i]] = R_next[i]; + if (R_next[i] == 0) + ; + else + R_prev[R_next[i]] = R_prev[i]; + /* compute gaussian multiplier f[i,p] = v[i,q] / v[p,q] and + store it in the matrix F */ + fip = dmp_get_atom(pool, sizeof(LUXELM)); + fip->i = i, fip->j = p; + mpq_init(fip->val); + mpq_div(fip->val, viq->val, V_piv[p]); + fip->r_prev = NULL; + fip->r_next = F_row[i]; + fip->c_prev = NULL; + fip->c_next = F_col[p]; + if (fip->r_next != NULL) fip->r_next->r_prev = fip; + if (fip->c_next != NULL) fip->c_next->c_prev = fip; + F_row[i] = F_col[p] = fip; + /* v[i,q] has to be eliminated, so remove it from i-th row */ + if (viq->r_prev == NULL) + V_row[i] = viq->r_next; + else + viq->r_prev->r_next = viq->r_next; + if (viq->r_next == NULL) + ; + else + viq->r_next->r_prev = viq->r_prev; + R_len[i]--; + /* and also from q-th column */ + V_col[q] = viq->c_next; + C_len[q]--; + /* free the space occupied by v[i,q] */ + mpq_clear(viq->val); + dmp_free_atom(pool, viq, sizeof(LUXELM)); + /* perform gaussian transformation: + (i-th row) := (i-th row) - f[i,p] * (p-th row) + note that now p-th row, which is in the working array, + does not contain the pivot v[p,q], and i-th row does not + contain the element v[i,q] to be eliminated */ + /* walk through i-th row and transform existing non-zero + elements */ + for (vij = V_row[i]; vij != NULL; vij = next) + { next = vij->r_next; + /* get column index of v[i,j] */ + j = vij->j; + /* v[i,j] := v[i,j] - f[i,p] * v[p,j] */ + if (flag[j]) + { /* v[p,j] != 0 */ + flag[j] = 0; + mpq_mul(temp, fip->val, work[j]); + mpq_sub(vij->val, vij->val, temp); + if (mpq_sgn(vij->val) == 0) + { /* new v[i,j] is zero, so remove it from the active + submatrix */ + /* remove v[i,j] from i-th row */ + if (vij->r_prev == NULL) + V_row[i] = vij->r_next; + else + vij->r_prev->r_next = vij->r_next; + if (vij->r_next == NULL) + ; + else + vij->r_next->r_prev = vij->r_prev; + R_len[i]--; + /* remove v[i,j] from j-th column */ + if (vij->c_prev == NULL) + V_col[j] = vij->c_next; + else + vij->c_prev->c_next = vij->c_next; + if (vij->c_next == NULL) + ; + else + vij->c_next->c_prev = vij->c_prev; + C_len[j]--; + /* free the space occupied by v[i,j] */ + mpq_clear(vij->val); + dmp_free_atom(pool, vij, sizeof(LUXELM)); + } + } + } + /* now flag is the pattern of the set v[p,*] \ v[i,*] */ + /* walk through p-th (pivot) row and create new elements in + i-th row, which appear due to fill-in */ + for (vpj = V_row[p]; vpj != NULL; vpj = vpj->r_next) + { j = vpj->j; + if (flag[j]) + { /* create new non-zero v[i,j] = 0 - f[i,p] * v[p,j] and + add it to i-th row and j-th column */ + vij = dmp_get_atom(pool, sizeof(LUXELM)); + vij->i = i, vij->j = j; + mpq_init(vij->val); + mpq_mul(vij->val, fip->val, work[j]); + mpq_neg(vij->val, vij->val); + vij->r_prev = NULL; + vij->r_next = V_row[i]; + vij->c_prev = NULL; + vij->c_next = V_col[j]; + if (vij->r_next != NULL) vij->r_next->r_prev = vij; + if (vij->c_next != NULL) vij->c_next->c_prev = vij; + V_row[i] = V_col[j] = vij; + R_len[i]++, C_len[j]++; + } + else + { /* there is no fill-in, because v[i,j] already exists in + i-th row; restore the flag, which was reset before */ + flag[j] = 1; + } + } + /* now i-th row has been completely transformed and can return + to the active set with a new length */ + R_prev[i] = 0; + R_next[i] = R_head[R_len[i]]; + if (R_next[i] != 0) R_prev[R_next[i]] = i; + R_head[R_len[i]] = i; + } + /* at this point q-th (pivot) column must be empty */ + xassert(C_len[q] == 0); + /* walk through p-th (pivot) row again and do the following... */ + for (vpj = V_row[p]; vpj != NULL; vpj = vpj->r_next) + { /* get column index of v[p,j] */ + j = vpj->j; + /* erase v[p,j] from the working array */ + flag[j] = 0; + mpq_set_si(work[j], 0, 1); + /* now j-th column has been completely transformed, so it can + return to the active list with a new length */ + C_prev[j] = 0; + C_next[j] = C_head[C_len[j]]; + if (C_next[j] != 0) C_prev[C_next[j]] = j; + C_head[C_len[j]] = j; + } + mpq_clear(temp); + /* return to the factorizing routine */ + return; +} + +/*********************************************************************** +* lux_decomp - compute LU-factorization +* +* SYNOPSIS +* +* #include "lux.h" +* int lux_decomp(LUX *lux, int (*col)(void *info, int j, int ind[], +* mpq_t val[]), void *info); +* +* DESCRIPTION +* +* The routine lux_decomp computes LU-factorization of a given square +* matrix A. +* +* The parameter lux specifies LU-factorization data structure built by +* means of the routine lux_create. +* +* The formal routine col specifies the original matrix A. In order to +* obtain j-th column of the matrix A the routine lux_decomp calls the +* routine col with the parameter j (1 <= j <= n, where n is the order +* of A). In response the routine col should store row indices and +* numerical values of non-zero elements of j-th column of A to the +* locations ind[1], ..., ind[len] and val[1], ..., val[len], resp., +* where len is the number of non-zeros in j-th column, which should be +* returned on exit. Neiter zero nor duplicate elements are allowed. +* +* The parameter info is a transit pointer passed to the formal routine +* col; it can be used for various purposes. +* +* RETURNS +* +* The routine lux_decomp returns the singularity flag. Zero flag means +* that the original matrix A is non-singular while non-zero flag means +* that A is (exactly!) singular. +* +* Note that LU-factorization is valid in both cases, however, in case +* of singularity some rows of the matrix V (including pivot elements) +* will be empty. +* +* REPAIRING SINGULAR MATRIX +* +* If the routine lux_decomp returns non-zero flag, it provides all +* necessary information that can be used for "repairing" the matrix A, +* where "repairing" means replacing linearly dependent columns of the +* matrix A by appropriate columns of the unity matrix. This feature is +* needed when the routine lux_decomp is used for reinverting the basis +* matrix within the simplex method procedure. +* +* On exit linearly dependent columns of the matrix U have the numbers +* rank+1, rank+2, ..., n, where rank is the exact rank of the matrix A +* stored by the routine to the member lux->rank. The correspondence +* between columns of A and U is the same as between columns of V and U. +* Thus, linearly dependent columns of the matrix A have the numbers +* Q_col[rank+1], Q_col[rank+2], ..., Q_col[n], where Q_col is an array +* representing the permutation matrix Q in column-like format. It is +* understood that each j-th linearly dependent column of the matrix U +* should be replaced by the unity vector, where all elements are zero +* except the unity diagonal element u[j,j]. On the other hand j-th row +* of the matrix U corresponds to the row of the matrix V (and therefore +* of the matrix A) with the number P_row[j], where P_row is an array +* representing the permutation matrix P in row-like format. Thus, each +* j-th linearly dependent column of the matrix U should be replaced by +* a column of the unity matrix with the number P_row[j]. +* +* The code that repairs the matrix A may look like follows: +* +* for (j = rank+1; j <= n; j++) +* { replace column Q_col[j] of the matrix A by column P_row[j] of +* the unity matrix; +* } +* +* where rank, P_row, and Q_col are members of the structure LUX. */ + +int lux_decomp(LUX *lux, int (*col)(void *info, int j, int ind[], + mpq_t val[]), void *info) +{ int n = lux->n; + LUXELM **V_row = lux->V_row; + LUXELM **V_col = lux->V_col; + int *P_row = lux->P_row; + int *P_col = lux->P_col; + int *Q_row = lux->Q_row; + int *Q_col = lux->Q_col; + LUXELM *piv, *vij; + LUXWKA *wka; + int i, j, k, p, q, t, *flag; + mpq_t *work; + /* allocate working area */ + wka = xmalloc(sizeof(LUXWKA)); + wka->R_len = xcalloc(1+n, sizeof(int)); + wka->R_head = xcalloc(1+n, sizeof(int)); + wka->R_prev = xcalloc(1+n, sizeof(int)); + wka->R_next = xcalloc(1+n, sizeof(int)); + wka->C_len = xcalloc(1+n, sizeof(int)); + wka->C_head = xcalloc(1+n, sizeof(int)); + wka->C_prev = xcalloc(1+n, sizeof(int)); + wka->C_next = xcalloc(1+n, sizeof(int)); + /* initialize LU-factorization data structures */ + initialize(lux, col, info, wka); + /* allocate working arrays */ + flag = xcalloc(1+n, sizeof(int)); + work = xcalloc(1+n, sizeof(mpq_t)); + for (k = 1; k <= n; k++) + { flag[k] = 0; + mpq_init(work[k]); + } + /* main elimination loop */ + for (k = 1; k <= n; k++) + { /* choose a pivot element v[p,q] */ + piv = find_pivot(lux, wka); + if (piv == NULL) + { /* no pivot can be chosen, because the active submatrix is + empty */ + break; + } + /* determine row and column indices of the pivot element */ + p = piv->i, q = piv->j; + /* let v[p,q] correspond to u[i',j']; permute k-th and i'-th + rows and k-th and j'-th columns of the matrix U = P*V*Q to + move the element u[i',j'] to the position u[k,k] */ + i = P_col[p], j = Q_row[q]; + xassert(k <= i && i <= n && k <= j && j <= n); + /* permute k-th and i-th rows of the matrix U */ + t = P_row[k]; + P_row[i] = t, P_col[t] = i; + P_row[k] = p, P_col[p] = k; + /* permute k-th and j-th columns of the matrix U */ + t = Q_col[k]; + Q_col[j] = t, Q_row[t] = j; + Q_col[k] = q, Q_row[q] = k; + /* eliminate subdiagonal elements of k-th column of the matrix + U = P*V*Q using the pivot element u[k,k] = v[p,q] */ + eliminate(lux, wka, piv, flag, work); + } + /* determine the rank of A (and V) */ + lux->rank = k - 1; + /* free working arrays */ + xfree(flag); + for (k = 1; k <= n; k++) mpq_clear(work[k]); + xfree(work); + /* build column lists of the matrix V using its row lists */ + for (j = 1; j <= n; j++) + xassert(V_col[j] == NULL); + for (i = 1; i <= n; i++) + { for (vij = V_row[i]; vij != NULL; vij = vij->r_next) + { j = vij->j; + vij->c_prev = NULL; + vij->c_next = V_col[j]; + if (vij->c_next != NULL) vij->c_next->c_prev = vij; + V_col[j] = vij; + } + } + /* free working area */ + xfree(wka->R_len); + xfree(wka->R_head); + xfree(wka->R_prev); + xfree(wka->R_next); + xfree(wka->C_len); + xfree(wka->C_head); + xfree(wka->C_prev); + xfree(wka->C_next); + xfree(wka); + /* return to the calling program */ + return (lux->rank < n); +} + +/*********************************************************************** +* lux_f_solve - solve system F*x = b or F'*x = b +* +* SYNOPSIS +* +* #include "lux.h" +* void lux_f_solve(LUX *lux, int tr, mpq_t x[]); +* +* DESCRIPTION +* +* The routine lux_f_solve solves either the system F*x = b (if the +* flag tr is zero) or the system F'*x = b (if the flag tr is non-zero), +* where the matrix F is a component of LU-factorization specified by +* the parameter lux, F' is a matrix transposed to F. +* +* On entry the array x should contain elements of the right-hand side +* vector b in locations x[1], ..., x[n], where n is the order of the +* matrix F. On exit this array will contain elements of the solution +* vector x in the same locations. */ + +void lux_f_solve(LUX *lux, int tr, mpq_t x[]) +{ int n = lux->n; + LUXELM **F_row = lux->F_row; + LUXELM **F_col = lux->F_col; + int *P_row = lux->P_row; + LUXELM *fik, *fkj; + int i, j, k; + mpq_t temp; + mpq_init(temp); + if (!tr) + { /* solve the system F*x = b */ + for (j = 1; j <= n; j++) + { k = P_row[j]; + if (mpq_sgn(x[k]) != 0) + { for (fik = F_col[k]; fik != NULL; fik = fik->c_next) + { mpq_mul(temp, fik->val, x[k]); + mpq_sub(x[fik->i], x[fik->i], temp); + } + } + } + } + else + { /* solve the system F'*x = b */ + for (i = n; i >= 1; i--) + { k = P_row[i]; + if (mpq_sgn(x[k]) != 0) + { for (fkj = F_row[k]; fkj != NULL; fkj = fkj->r_next) + { mpq_mul(temp, fkj->val, x[k]); + mpq_sub(x[fkj->j], x[fkj->j], temp); + } + } + } + } + mpq_clear(temp); + return; +} + +/*********************************************************************** +* lux_v_solve - solve system V*x = b or V'*x = b +* +* SYNOPSIS +* +* #include "lux.h" +* void lux_v_solve(LUX *lux, int tr, double x[]); +* +* DESCRIPTION +* +* The routine lux_v_solve solves either the system V*x = b (if the +* flag tr is zero) or the system V'*x = b (if the flag tr is non-zero), +* where the matrix V is a component of LU-factorization specified by +* the parameter lux, V' is a matrix transposed to V. +* +* On entry the array x should contain elements of the right-hand side +* vector b in locations x[1], ..., x[n], where n is the order of the +* matrix V. On exit this array will contain elements of the solution +* vector x in the same locations. */ + +void lux_v_solve(LUX *lux, int tr, mpq_t x[]) +{ int n = lux->n; + mpq_t *V_piv = lux->V_piv; + LUXELM **V_row = lux->V_row; + LUXELM **V_col = lux->V_col; + int *P_row = lux->P_row; + int *Q_col = lux->Q_col; + LUXELM *vij; + int i, j, k; + mpq_t *b, temp; + b = xcalloc(1+n, sizeof(mpq_t)); + for (k = 1; k <= n; k++) + mpq_init(b[k]), mpq_set(b[k], x[k]), mpq_set_si(x[k], 0, 1); + mpq_init(temp); + if (!tr) + { /* solve the system V*x = b */ + for (k = n; k >= 1; k--) + { i = P_row[k], j = Q_col[k]; + if (mpq_sgn(b[i]) != 0) + { mpq_set(x[j], b[i]); + mpq_div(x[j], x[j], V_piv[i]); + for (vij = V_col[j]; vij != NULL; vij = vij->c_next) + { mpq_mul(temp, vij->val, x[j]); + mpq_sub(b[vij->i], b[vij->i], temp); + } + } + } + } + else + { /* solve the system V'*x = b */ + for (k = 1; k <= n; k++) + { i = P_row[k], j = Q_col[k]; + if (mpq_sgn(b[j]) != 0) + { mpq_set(x[i], b[j]); + mpq_div(x[i], x[i], V_piv[i]); + for (vij = V_row[i]; vij != NULL; vij = vij->r_next) + { mpq_mul(temp, vij->val, x[i]); + mpq_sub(b[vij->j], b[vij->j], temp); + } + } + } + } + for (k = 1; k <= n; k++) mpq_clear(b[k]); + mpq_clear(temp); + xfree(b); + return; +} + +/*********************************************************************** +* lux_solve - solve system A*x = b or A'*x = b +* +* SYNOPSIS +* +* #include "lux.h" +* void lux_solve(LUX *lux, int tr, mpq_t x[]); +* +* DESCRIPTION +* +* The routine lux_solve solves either the system A*x = b (if the flag +* tr is zero) or the system A'*x = b (if the flag tr is non-zero), +* where the parameter lux specifies LU-factorization of the matrix A, +* A' is a matrix transposed to A. +* +* On entry the array x should contain elements of the right-hand side +* vector b in locations x[1], ..., x[n], where n is the order of the +* matrix A. On exit this array will contain elements of the solution +* vector x in the same locations. */ + +void lux_solve(LUX *lux, int tr, mpq_t x[]) +{ if (lux->rank < lux->n) + xfault("lux_solve: LU-factorization has incomplete rank\n"); + if (!tr) + { /* A = F*V, therefore inv(A) = inv(V)*inv(F) */ + lux_f_solve(lux, 0, x); + lux_v_solve(lux, 0, x); + } + else + { /* A' = V'*F', therefore inv(A') = inv(F')*inv(V') */ + lux_v_solve(lux, 1, x); + lux_f_solve(lux, 1, x); + } + return; +} + +/*********************************************************************** +* lux_delete - delete LU-factorization +* +* SYNOPSIS +* +* #include "lux.h" +* void lux_delete(LUX *lux); +* +* DESCRIPTION +* +* The routine lux_delete deletes LU-factorization data structure, +* which the parameter lux points to, freeing all the memory allocated +* to this object. */ + +void lux_delete(LUX *lux) +{ int n = lux->n; + LUXELM *fij, *vij; + int i; + for (i = 1; i <= n; i++) + { for (fij = lux->F_row[i]; fij != NULL; fij = fij->r_next) + mpq_clear(fij->val); + mpq_clear(lux->V_piv[i]); + for (vij = lux->V_row[i]; vij != NULL; vij = vij->r_next) + mpq_clear(vij->val); + } + dmp_delete_pool(lux->pool); + xfree(lux->F_row); + xfree(lux->F_col); + xfree(lux->V_piv); + xfree(lux->V_row); + xfree(lux->V_col); + xfree(lux->P_row); + xfree(lux->P_col); + xfree(lux->Q_row); + xfree(lux->Q_col); + xfree(lux); + return; +} + +/* eof */ diff --git a/test/monniaux/glpk-4.65/src/draft/lux.h b/test/monniaux/glpk-4.65/src/draft/lux.h new file mode 100644 index 00000000..8767bb8e --- /dev/null +++ b/test/monniaux/glpk-4.65/src/draft/lux.h @@ -0,0 +1,220 @@ +/* lux.h (LU-factorization, rational arithmetic) */ + +/*********************************************************************** +* This code is part of GLPK (GNU Linear Programming Kit). +* +* Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, +* 2009, 2010, 2011, 2013 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 LUX_H +#define LUX_H + +#include "dmp.h" +#include "mygmp.h" + +/*********************************************************************** +* The structure LUX defines LU-factorization of a square matrix A, +* which is the following quartet: +* +* [A] = (F, V, P, Q), (1) +* +* where F and V are such matrices that +* +* A = F * V, (2) +* +* and P and Q are such permutation matrices that the matrix +* +* L = P * F * inv(P) (3) +* +* is lower triangular with unity diagonal, and the matrix +* +* U = P * V * Q (4) +* +* is upper triangular. All the matrices have the order n. +* +* The matrices F and V are stored in row/column-wise sparse format as +* row and column linked lists of non-zero elements. Unity elements on +* the main diagonal of the matrix F are not stored. Pivot elements of +* the matrix V (that correspond to diagonal elements of the matrix U) +* are also missing from the row and column lists and stored separately +* in an ordinary array. +* +* The permutation matrices P and Q are stored as ordinary arrays using +* both row- and column-like formats. +* +* The matrices L and U being completely defined by the matrices F, V, +* P, and Q are not stored explicitly. +* +* It is easy to show that the factorization (1)-(3) is some version of +* LU-factorization. Indeed, from (3) and (4) it follows that: +* +* F = inv(P) * L * P, +* +* V = inv(P) * U * inv(Q), +* +* and substitution into (2) gives: +* +* A = F * V = inv(P) * L * U * inv(Q). +* +* For more details see the program documentation. */ + +typedef struct LUX LUX; +typedef struct LUXELM LUXELM; +typedef struct LUXWKA LUXWKA; + +struct LUX +{ /* LU-factorization of a square matrix */ + int n; + /* the order of matrices A, F, V, P, Q */ + DMP *pool; + /* memory pool for elements of matrices F and V */ + LUXELM **F_row; /* LUXELM *F_row[1+n]; */ + /* F_row[0] is not used; + F_row[i], 1 <= i <= n, is a pointer to the list of elements in + i-th row of matrix F (diagonal elements are not stored) */ + LUXELM **F_col; /* LUXELM *F_col[1+n]; */ + /* F_col[0] is not used; + F_col[j], 1 <= j <= n, is a pointer to the list of elements in + j-th column of matrix F (diagonal elements are not stored) */ + mpq_t *V_piv; /* mpq_t V_piv[1+n]; */ + /* V_piv[0] is not used; + V_piv[p], 1 <= p <= n, is a pivot element v[p,q] corresponding + to a diagonal element u[k,k] of matrix U = P*V*Q (used on k-th + elimination step, k = 1, 2, ..., n) */ + LUXELM **V_row; /* LUXELM *V_row[1+n]; */ + /* V_row[0] is not used; + V_row[i], 1 <= i <= n, is a pointer to the list of elements in + i-th row of matrix V (except pivot elements) */ + LUXELM **V_col; /* LUXELM *V_col[1+n]; */ + /* V_col[0] is not used; + V_col[j], 1 <= j <= n, is a pointer to the list of elements in + j-th column of matrix V (except pivot elements) */ + int *P_row; /* int P_row[1+n]; */ + /* P_row[0] is not used; + P_row[i] = j means that p[i,j] = 1, where p[i,j] is an element + of permutation matrix P */ + int *P_col; /* int P_col[1+n]; */ + /* P_col[0] is not used; + P_col[j] = i means that p[i,j] = 1, where p[i,j] is an element + of permutation matrix P */ + /* if i-th row or column of matrix F is i'-th row or column of + matrix L = P*F*inv(P), or if i-th row of matrix V is i'-th row + of matrix U = P*V*Q, then P_row[i'] = i and P_col[i] = i' */ + int *Q_row; /* int Q_row[1+n]; */ + /* Q_row[0] is not used; + Q_row[i] = j means that q[i,j] = 1, where q[i,j] is an element + of permutation matrix Q */ + int *Q_col; /* int Q_col[1+n]; */ + /* Q_col[0] is not used; + Q_col[j] = i means that q[i,j] = 1, where q[i,j] is an element + of permutation matrix Q */ + /* if j-th column of matrix V is j'-th column of matrix U = P*V*Q, + then Q_row[j] = j' and Q_col[j'] = j */ + int rank; + /* the (exact) rank of matrices A and V */ +}; + +struct LUXELM +{ /* element of matrix F or V */ + int i; + /* row index, 1 <= i <= m */ + int j; + /* column index, 1 <= j <= n */ + mpq_t val; + /* numeric (non-zero) element value */ + LUXELM *r_prev; + /* pointer to previous element in the same row */ + LUXELM *r_next; + /* pointer to next element in the same row */ + LUXELM *c_prev; + /* pointer to previous element in the same column */ + LUXELM *c_next; + /* pointer to next element in the same column */ +}; + +struct LUXWKA +{ /* working area (used only during factorization) */ + /* in order to efficiently implement Markowitz strategy and Duff + search technique there are two families {R[0], R[1], ..., R[n]} + and {C[0], C[1], ..., C[n]}; member R[k] is a set of active + rows of matrix V having k non-zeros, and member C[k] is a set + of active columns of matrix V having k non-zeros (in the active + submatrix); each set R[k] and C[k] is implemented as a separate + doubly linked list */ + int *R_len; /* int R_len[1+n]; */ + /* R_len[0] is not used; + R_len[i], 1 <= i <= n, is the number of non-zero elements in + i-th row of matrix V (that is the length of i-th row) */ + int *R_head; /* int R_head[1+n]; */ + /* R_head[k], 0 <= k <= n, is the number of a first row, which is + active and whose length is k */ + int *R_prev; /* int R_prev[1+n]; */ + /* R_prev[0] is not used; + R_prev[i], 1 <= i <= n, is the number of a previous row, which + is active and has the same length as i-th row */ + int *R_next; /* int R_next[1+n]; */ + /* R_prev[0] is not used; + R_prev[i], 1 <= i <= n, is the number of a next row, which is + active and has the same length as i-th row */ + int *C_len; /* int C_len[1+n]; */ + /* C_len[0] is not used; + C_len[j], 1 <= j <= n, is the number of non-zero elements in + j-th column of the active submatrix of matrix V (that is the + length of j-th column in the active submatrix) */ + int *C_head; /* int C_head[1+n]; */ + /* C_head[k], 0 <= k <= n, is the number of a first column, which + is active and whose length is k */ + int *C_prev; /* int C_prev[1+n]; */ + /* C_prev[0] is not used; + C_prev[j], 1 <= j <= n, is the number of a previous column, + which is active and has the same length as j-th column */ + int *C_next; /* int C_next[1+n]; */ + /* C_next[0] is not used; + C_next[j], 1 <= j <= n, is the number of a next column, which + is active and has the same length as j-th column */ +}; + +#define lux_create _glp_lux_create +LUX *lux_create(int n); +/* create LU-factorization */ + +#define lux_decomp _glp_lux_decomp +int lux_decomp(LUX *lux, int (*col)(void *info, int j, int ind[], + mpq_t val[]), void *info); +/* compute LU-factorization */ + +#define lux_f_solve _glp_lux_f_solve +void lux_f_solve(LUX *lux, int tr, mpq_t x[]); +/* solve system F*x = b or F'*x = b */ + +#define lux_v_solve _glp_lux_v_solve +void lux_v_solve(LUX *lux, int tr, mpq_t x[]); +/* solve system V*x = b or V'*x = b */ + +#define lux_solve _glp_lux_solve +void lux_solve(LUX *lux, int tr, mpq_t x[]); +/* solve system A*x = b or A'*x = b */ + +#define lux_delete _glp_lux_delete +void lux_delete(LUX *lux); +/* delete LU-factorization */ + +#endif + +/* eof */ |