abdelrahman/agent_compositor_test
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add graph references

Browse Source
This commit is contained in:
Abdelrahman Said
2026-06-28 13:49:01 +01:00
parent 0a9807e448
commit a11edf0c53
2578 changed files with 868045 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files
references/igraph-1.0.1/vendor/glpk/draft/bfd.c
Vendored
+542
View File
@@ -0,0 +1,542 @@
/* bfd.c (LP basis factorization driver) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2007-2014 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/bfd.h
Vendored
+104
View File
@@ -0,0 +1,104 @@
/* bfd.h (LP basis factorization driver) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2007-2014 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/bfx.c
Vendored
+86
View File
@@ -0,0 +1,86 @@
/* bfx.c (LP basis factorization driver, rational arithmetic) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2007-2014 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/bfx.h
Vendored
+64
View File
@@ -0,0 +1,64 @@
/* bfx.h (LP basis factorization driver, rational arithmetic) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2007-2014 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/draft.h
Vendored
+20
View File
@@ -0,0 +1,20 @@
/* draft.h */
#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 */
references/igraph-1.0.1/vendor/glpk/draft/glpapi06.c
Vendored
+857
View File
@@ -0,0 +1,857 @@
/* glpapi06.c (simplex method routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2007-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 %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 */
references/igraph-1.0.1/vendor/glpk/draft/glpapi07.c
Vendored
+496
View File
@@ -0,0 +1,496 @@
/* glpapi07.c (exact simplex solver) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2007-2017 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpapi08.c
Vendored
+385
View File
@@ -0,0 +1,385 @@
/* glpapi08.c (interior-point method routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpapi09.c
Vendored
+795
View File
@@ -0,0 +1,795 @@
/* glpapi09.c (mixed integer programming routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 %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 */
references/igraph-1.0.1/vendor/glpk/draft/glpapi10.c
Vendored
+302
View File
@@ -0,0 +1,302 @@
/* glpapi10.c (solution checking routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpapi12.c
Vendored
+2182
View File
File diff suppressed because it is too large Load Diff
references/igraph-1.0.1/vendor/glpk/draft/glpapi13.c
Vendored
+707
View File
@@ -0,0 +1,707 @@
/* glpapi13.c (branch-and-bound interface routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpios01.c
Vendored
+1686
View File
File diff suppressed because it is too large Load Diff
references/igraph-1.0.1/vendor/glpk/draft/glpios02.c
Vendored
+823
View File
@@ -0,0 +1,823 @@
/* glpios02.c (preprocess current subproblem) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpios03.c
Vendored
+1506
View File
File diff suppressed because it is too large Load Diff
references/igraph-1.0.1/vendor/glpk/draft/glpios07.c
Vendored
+548
View File
@@ -0,0 +1,548 @@
/* glpios07.c (mixed cover cut generator) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2005-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpios09.c
Vendored
+661
View File
@@ -0,0 +1,661 @@
/* glpios09.c (branching heuristics) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2005-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpios11.c
Vendored
+432
View File
@@ -0,0 +1,432 @@
/* glpios11.c (process cuts stored in the local cut pool) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2005-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpios12.c
Vendored
+174
View File
@@ -0,0 +1,174 @@
/* glpios12.c (node selection heuristics) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpipm.c
Vendored
+1141
View File
File diff suppressed because it is too large Load Diff
references/igraph-1.0.1/vendor/glpk/draft/glpipm.h
Vendored
+33
View File
@@ -0,0 +1,33 @@
/* glpipm.h (primal-dual interior-point method) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpmat.c
Vendored
+921
View File
@@ -0,0 +1,921 @@
/* glpmat.c */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpmat.h
Vendored
+195
View File
@@ -0,0 +1,195 @@
/* glpmat.h (linear algebra routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpscl.c
Vendored
+475
View File
@@ -0,0 +1,475 @@
/* glpscl.c (problem scaling routines) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2000-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpssx.h
Vendored
+434
View File
@@ -0,0 +1,434 @@
/* glpssx.h (simplex method, rational arithmetic) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpssx01.c
Vendored
+836
View File
@@ -0,0 +1,836 @@
/* glpssx01.c (simplex method, rational arithmetic) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/glpssx02.c
Vendored
+520
View File
@@ -0,0 +1,520 @@
/* glpssx02.c (simplex method, rational arithmetic) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/ios.h
Vendored
+544
View File
@@ -0,0 +1,544 @@
/* ios.h (integer optimization suite) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2018 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */
references/igraph-1.0.1/vendor/glpk/draft/lux.c
Vendored
+1027
View File
File diff suppressed because it is too large Load Diff
references/igraph-1.0.1/vendor/glpk/draft/lux.h
Vendored
+217
View File
@@ -0,0 +1,217 @@
/* lux.h (LU-factorization, rational arithmetic) */
/***********************************************************************
* This code is part of GLPK (GNU Linear Programming Kit).
* Copyright (C) 2003-2013 Free Software Foundation, Inc.
* Written by Andrew Makhorin <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 */