void
ovm_dd_ne(oregister_t *l, oregister_t *r)
{
l->t = t_word;
switch (r->t) {
case t_cdd:
l->v.w = l->v.dd != r->v.dd;
break;
case t_cqq:
l->v.w = mpq_get_d(oqr(r)) != real(l->v.dd) ||
mpq_get_d(oqi(r)) != imag(l->v.dd);
break;
case t_mpc:
mpfr_set_d(orr(l), real(l->v.dd), thr_rnd);
if (mpfr_equal_p(orr(l), orr(r))) {
mpfr_set_d(ori(l), imag(l->v.dd), thr_rnd);
l->v.w = !mpfr_equal_p(ori(l), ori(r));
}
else
l->v.w = 1;
break;
default:
l->v.w = 1;
break;
}
}
void
ovm_dd_atan2(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
goto flt;
case t_word:
if (r->v.w) {
real(r->v.dd) = r->v.w;
imag(r->v.dd) = 0.0;
goto cdd;
}
flt:
l->t = t_float;
l->v.d = real(l->v.dd) >= 0.0 ? M_PI_2 : -M_PI_2;
break;
case t_float:
if (r->v.d) {
real(r->v.dd) = r->v.d;
imag(r->v.dd) = 0.0;
goto cdd;
}
goto flt;
case t_mpz:
real(r->v.dd) = mpz_get_d(ozr(r));
imag(r->v.dd) = 0.0;
goto cdd;
case t_rat:
real(r->v.dd) = rat_get_d(r->v.r);
imag(r->v.dd) = 0.0;
goto cdd;
case t_mpq:
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = 0.0;
goto cdd;
case t_mpr:
mpc_set_fr(occ(r), orr(r), thr_rndc);
goto mpc;
case t_cdd:
cdd:
l->v.dd = catan(l->v.dd / r->v.dd);
check_cdd(l);
break;
case t_cqq:
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
case t_mpc:
mpc:
l->t = t_mpc;
mpc_set_d_d(occ(l), real(l->v.dd), imag(l->v.dd), thr_rndc);
mpc_div(occ(l), occ(l), occ(r), thr_rndc);
mpc_atan(occ(l), occ(l), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_q_mul(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
l->t = t_word;
l->v.w = 0;
break;
case t_word:
mpq_set_si(oqr(r), r->v.w, 1);
mpq_mul(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_float:
l->t = t_float;
l->v.d = mpq_get_d(oqr(l)) * r->v.d;
break;
case t_mpz:
mpz_set_ui(ozs(r), 1);
mpq_mul(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_rat:
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpq_mul(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_mpq:
mpq_mul(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_mul(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
l->t = t_cdd;
l->v.dd = mpq_get_d(oqr(l)) * r->v.dd;
check_cdd(l);
break;
case t_cqq:
l->t = t_cqq;
mpq_set_ui(oqi(l), 0, 1);
cqq_mul(oqq(l), oqq(l), oqq(r));
check_cqq(l);
break;
case t_mpc:
l->t = t_mpc;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpc_mul(occ(l), occ(l), occ(r), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_dd_hypot(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
l->t = t_float;
l->v.d = cabs(l->v.dd);
break;
case t_word:
l->t = t_float;
l->v.d = hypot(hypot(real(l->v.dd), imag(l->v.dd)), r->v.w);
break;
case t_float:
l->t = t_float;
l->v.d = hypot(hypot(real(l->v.dd), imag(l->v.dd)), r->v.d);
break;
case t_mpz:
l->t = t_float;
l->v.d = hypot(hypot(real(l->v.dd), imag(l->v.dd)),
mpz_get_d(ozr(r)));
break;
case t_rat:
l->t = t_float;
l->v.d = hypot(hypot(real(l->v.dd), imag(l->v.dd)),
rat_get_d(r->v.r));
break;
case t_mpq:
l->t = t_float;
l->v.d = hypot(hypot(real(l->v.dd), imag(l->v.dd)),
mpq_get_d(oqr(r)));
break;
case t_mpr:
mpc_set_fr(occ(r), orr(r), thr_rndc);
goto mpc;
case t_cdd:
cdd:
l->t = t_float;
l->v.d = hypot(hypot(real(l->v.dd), imag(l->v.dd)),
hypot(real(r->v.dd), imag(r->v.dd)));
break;
case t_cqq:
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
case t_mpc:
mpc:
l->t = t_mpr;
mpc_set_d_d(occ(l), real(l->v.dd), imag(l->v.dd), thr_rndc);
mpfr_hypot(orr(l), orr(l), ori(l), thr_rnd);
mpfr_hypot(ori(l), orr(r), ori(r), thr_rnd);
mpfr_hypot(orr(l), orr(l), ori(l), thr_rnd);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_dd_div(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
l->v.dd /= 0.0;
check_cdd(l);
break;
case t_word:
l->v.dd /= r->v.w;
check_cdd(l);
break;
case t_float:
l->v.dd /= r->v.d;
check_cdd(l);
break;
case t_mpz:
l->v.dd /= mpz_get_d(ozr(r));
check_cdd(l);
break;
case t_rat:
l->v.dd /= rat_get_d(r->v.r);
check_cdd(l);
break;
case t_mpq:
l->v.dd /= mpq_get_d(oqr(r));
check_cdd(l);
break;
case t_mpr:
l->t = t_mpc;
mpc_set_d_d(occ(l), real(l->v.dd), imag(l->v.dd), thr_rndc);
mpc_set_fr(occ(r), orr(r), thr_rndc);
mpc_div(occ(l), occ(l), occ(r), thr_rndc);
check_mpc(l);
break;
case t_cdd:
l->v.dd /= r->v.dd;
check_cdd(l);
break;
case t_cqq:
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
l->v.dd /= r->v.dd;
check_cdd(l);
break;
case t_mpc:
l->t = t_mpc;
mpc_set_d_d(occ(l), real(l->v.dd), imag(l->v.dd), thr_rndc);
mpc_div(occ(l), occ(l), occ(r), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_q_le(oregister_t *l, oregister_t *r)
{
l->t = t_word;
switch (r->t) {
case t_void:
l->v.w = mpq_sgn(oqr(l)) <= 0;
break;
case t_word:
l->v.w = mpq_cmp_si(oqr(l), r->v.w, 1) <= 0;
break;
case t_float:
l->v.w = mpq_get_d(oqr(l)) <= r->v.d;
break;
case t_mpz:
mpq_set_z(oqr(r), ozr(r));
l->v.w = mpq_cmp(oqr(l), oqr(r)) <= 0;
break;
case t_rat:
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
l->v.w = mpq_cmp(oqr(l), oqr(r)) <= 0;
break;
case t_mpq:
l->v.w = mpq_cmp(oqr(l), oqr(r)) <= 0;
break;
case t_mpr:
mpfr_set_z(orr(l), ozr(l), thr_rnd);
l->v.w = mpfr_lessequal_p(orr(l), orr(r));
break;
default:
ovm_raise(except_not_a_real_number);
}
}
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;
}
double Rational::toDouble() const
{
mpq_t mpq;
mpqInit(mpq);
const double result = mpq_get_d(mpq);
mpq_clear(mpq);
return result;
}
/* Check various values 2^n and 1/2^n. */
void
check_onebit (void)
{
static const long data[] = {
-3*GMP_NUMB_BITS-1, -3*GMP_NUMB_BITS, -3*GMP_NUMB_BITS+1,
-2*GMP_NUMB_BITS-1, -2*GMP_NUMB_BITS, -2*GMP_NUMB_BITS+1,
-GMP_NUMB_BITS-1, -GMP_NUMB_BITS, -GMP_NUMB_BITS+1,
-5, -2, -1, 0, 1, 2, 5,
GMP_NUMB_BITS-1, GMP_NUMB_BITS, GMP_NUMB_BITS+1,
2*GMP_NUMB_BITS-1, 2*GMP_NUMB_BITS, 2*GMP_NUMB_BITS+1,
3*GMP_NUMB_BITS-1, 3*GMP_NUMB_BITS, 3*GMP_NUMB_BITS+1,
};
int i, neg;
long exp, l;
mpq_t q;
double got, want;
mpq_init (q);
for (i = 0; i < numberof (data); i++)
{
exp = data[i];
mpq_set_ui (q, 1L, 1L);
if (exp >= 0)
mpq_mul_2exp (q, q, exp);
else
mpq_div_2exp (q, q, -exp);
want = 1.0;
for (l = 0; l < exp; l++)
want *= 2.0;
for (l = 0; l > exp; l--)
want /= 2.0;
for (neg = 0; neg <= 1; neg++)
{
if (neg)
{
mpq_neg (q, q);
want = -want;
}
got = mpq_get_d (q);
if (got != want)
{
printf ("mpq_get_d wrong on %s2**%ld\n", neg ? "-" : "", exp);
mpq_trace (" q ", q);
d_trace (" want ", want);
d_trace (" got ", got);
abort();
}
}
}
mpq_clear (q);
}
double AB_Value_GetValueAsDouble(const AB_VALUE *v) {
assert(v);
if (mpz_fits_slong_p(mpq_numref(v->value)) && mpz_fits_slong_p(mpq_denref(v->value))) {
return (double) (mpz_get_d(mpq_numref(v->value)) / mpz_get_d(mpq_denref(v->value)));
}
else {
return mpq_get_d(v->value);
}
}
void lps_transtable(const Lps* lp, FILE* fp, LpFormat format, const char* head)
{
Var* var;
Con* con;
char* temp;
int namelen;
assert(lps_valid(lp));
assert(fp != NULL);
assert(head != NULL);
assert(format == LP_FORM_LPF || format == LP_FORM_MPS || format == LP_FORM_RLP || format == LP_FORM_PIP);
namelen = lps_getnamesize(lp, format);
temp = malloc((size_t)namelen);
assert(temp != NULL);
lps_number(lp);
for(var = lp->var_root; var != NULL; var = var->next)
{
lps_makename(temp, namelen, var->name, var->number);
if (var->type == VAR_FIXED)
fprintf(fp, "%s\tv %7d\t%-*s\t\"%s\"\t%.16e\n",
head, var->number, namelen - 1, temp, var->name, mpq_get_d(var->lower));
else
{
if (var->size > 0 || !mpq_equal(var->cost, const_zero))
fprintf(fp, "%s\tv %7d\t%-*s\t\"%s\"\n",
head, var->number, namelen - 1, temp, var->name);
}
}
for(con = lp->con_root; con != NULL; con = con->next)
{
lps_makename(temp, namelen, con->name, con->number);
fprintf(fp, "%s\tc %7d\t%-*s\t\"%s\"\t%.16e\n",
head, con->number, namelen - 1, temp, con->name, mpq_get_d(con->scale));
}
free(temp);
}
uint64_t Lib_Mpq_Get_Ui64(MpqPtr x)
{
return (uint64_t) mpq_get_d( (mpq_ptr) x);
// mpq_t z; mpq_init(z);
// Lib_Mpq_Get_Mpz(z, (mpq_ptr) x);
// uint64_t res = Lib_Mpz_Get_Ui64(z);
// mpq_clear(z);
// return res;
}
/*lint -e{818} supress "Pointer parameter 'var' could be declared as pointing to const" */
static void remove_fixed_var(
Lps* lp,
Var* var,
int verbose_level)
{
Nzo* nzo;
mpq_t x;
mpq_t temp;
Bool is_zero;
assert(lp != NULL);
assert(var != NULL);
assert(var->type == VAR_FIXED && mpq_equal(var->lower, var->upper));
if (verbose_level > 0)
printf("Removing variable %s fixed to %g\n", var->name, mpq_get_d(var->lower));
mpq_init(x);
mpq_init(temp);
is_zero = mpq_equal(var->lower, x /* zero */);
while(var->first != NULL)
{
nzo = var->first;
/* Do we have to ajust the lhs/rhs ?
*/
if (!is_zero)
{
mpq_mul(x, var->lower, nzo->value);
/* do we have a valid rhs ?
*/
if (HAS_RHS(nzo->con))
{
mpq_sub(temp, nzo->con->rhs, x);
lps_setrhs(nzo->con, temp);
}
/* do we have a valid lhs ?
*/
if (HAS_LHS(nzo->con))
{
mpq_sub(temp, nzo->con->lhs, x);
lps_setlhs(nzo->con, temp);
}
}
lps_delnzo(lp, nzo);
}
mpq_clear(temp);
mpq_clear(x);
}
void
ovm_q_rem(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
ovm_raise(except_floating_point_error);
case t_word:
if (r->v.w == 0)
ovm_raise(except_floating_point_error);
if (r->v.w > 0)
mpz_mul_ui(ozr(r), ozs(l), r->v.w);
else {
mpz_set_si(ozr(r), r->v.w);
mpz_mul(ozr(r), ozs(l), ozr(r));
}
mpz_tdiv_r(ozr(l), ozr(l), ozr(r));
mpq_canonicalize(oqr(l));
check_mpq(l);
break;
case t_float:
l->t = t_float;
l->v.d = fmod(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
mpz_mul(ozr(r), ozs(l), ozr(r));
mpz_tdiv_r(ozr(l), ozr(l), ozr(r));
check_mpq(l);
break;
case t_rat:
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
case t_mpq:
mpq_div(oqr(l), oqr(l), oqr(r));
mpz_tdiv_r(ozr(l), ozr(l), ozs(l));
mpz_mul(ozs(l), ozs(l), ozs(r));
mpq_canonicalize(oqr(l));
if (mpq_sgn(oqr(r)) < 0)
mpq_neg(oqr(l), oqr(l));
check_mpq(l);
break;
case t_mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_fmod(orr(l), orr(l), orr(r), thr_rnd);
break;
default:
ovm_raise(except_not_a_real_number);
}
}
/**
* ncm_mpsf_sbessel: (skip)
* @l: FIXME
* @q: FIXME
* @res: FIXME
* @rnd: FIXME
*
* FIXME
*/
void
ncm_mpsf_sbessel (gulong l, mpq_t q, mpfr_ptr res, mp_rnd_t rnd)
{
gdouble x = mpq_get_d (q);
if (x == 0)
{
if (l == 0)
mpfr_set_ui (res, 1, rnd);
else
mpfr_set_ui (res, 0, rnd);
return;
}
if (fabs(x) < l)
_taylor_mpfr (l, q, res, rnd);
else
_assympt_mpfr (l, q, res, rnd);
}
static void write_val(FILE* fp, LpFormat format, Bool force_sign, const mpq_t val)
{
switch(format)
{
case LP_FORM_LPF :
case LP_FORM_RLP :
case LP_FORM_PIP :
fprintf(fp, force_sign ? "%+.15g" : "%.15g", mpq_get_d(val));
break;
case LP_FORM_HUM :
if (force_sign && (mpq_sgn(val) > 0)) /*lint !e634 Strong type mismatch (type 'Bool') */
fprintf(fp, "+");
mpq_out_str(fp, 10, val);
break;
default:
abort();
}
}
/* A specification for the ORD file format can be found in the
* ILOG CPLEX 7.0 Reference Manual page 545.
*/
void lps_mstfile(
const Lps* lp,
FILE* fp,
LpFormat format,
const char* text)
{
const Var* var;
int name_size;
char* vtmp;
assert(lp != NULL);
assert(fp != NULL);
assert(format == LP_FORM_LPF || format == LP_FORM_MPS);
name_size = lps_getnamesize(lp, format);
vtmp = malloc((size_t)name_size);
assert(vtmp != NULL);
if (text != NULL)
fprintf(fp, "* %s\n", text);
fprintf(fp, "NAME %8.8s\n", lp->name);
for(var = lp->var_root; var != NULL; var = var->next)
{
if (var->vclass == VAR_CON)
continue;
if (var->size == 0)
continue;
lps_makename(vtmp, name_size, var->name, var->number);
fprintf(fp, " %-*s %.10e",
name_size - 1, vtmp, mpq_get_d(var->startval));
fputc('\n', fp);
}
fprintf(fp, "ENDATA\n");
free(vtmp);
}
void
ovm_q_trunc2(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
ovm_raise(except_floating_point_error);
case t_word:
if (r->v.w == 0)
ovm_raise(except_floating_point_error);
l->t = t_mpz;
if (r->v.w > 0)
mpz_mul_ui(ozr(r), ozs(l), r->v.w);
else {
mpz_set_si(ozr(r), r->v.w);
mpz_mul(ozr(r), ozs(l), ozr(r));
}
mpz_tdiv_q(ozr(l), ozr(l), ozr(r));
check_mpz(l);
break;
case t_float:
ovm_trunc_d(l, mpq_get_d(oqr(l)) / r->v.d);
break;
case t_mpz:
mpz_tdiv_q(ozr(l), ozr(l), ozr(r));
check_mpz(l);
break;
case t_rat:
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
case t_mpq:
l->t = t_mpz;
mpq_div(oqr(l), oqr(l), oqr(r));
mpz_tdiv_q(ozr(l), ozr(l), ozs(l));
check_mpz(l);
break;
case t_mpr:
mpfr_set_q(orr(l), oqr(l), thr_rnd);
ovm_trunc_r(l, orr(r));
break;
default:
ovm_raise(except_not_a_real_number);
}
}
void
ovm_q_eq(oregister_t *l, oregister_t *r)
{
l->t = t_word;
switch (r->t) {
case t_float:
l->v.w = mpq_get_d(oqr(l)) == r->v.d;
break;
case t_mpq:
l->v.w = mpq_cmp(oqr(l), oqr(r)) == 0;
break;
case t_mpr:
mpfr_set_q(orr(l), oqr(l), thr_rnd);
l->v.w = mpfr_equal_p(orr(l), orr(r));
break;
default:
l->v.w = 0;
break;
}
}
void
ovm_q_complex(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
break;
case t_word:
l->t = t_cqq;
mpq_set_si(oqi(l), r->v.w, 1);
check_cqq(l);
break;
case t_float:
l->t = t_cdd;
real(l->v.dd) = mpq_get_d(oqr(l));
imag(l->v.dd) = r->v.d;
check_cdd(l);
break;
case t_mpz:
l->t = t_cqq;
mpq_set_z(oqi(l), ozr(r));
check_cqq(l);
break;
case t_mpq:
l->t = t_cqq;
mpq_set(oqi(l), oqr(r));
check_cqq(l);
break;
case t_mpr:
l->t = t_mpc;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_set(ori(l), orr(r), thr_rnd);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_real_number);
}
}
void game_set_initial_configuration_position(game_t *game)
{
random_set_seed(time(NULL));
int n = game->graph->n;
GArray *players = g_array_new(FALSE, FALSE, sizeof(int));
int i;
for(i = 0; i < n; ++i)
{
game->initial_config[i] = 0;
game->current_config[i] = 0;
g_array_append_val(players, i);
}
mpq_t e;
mpq_init(e);
mpq_set_si(e, game->graph->n, 1);
mpq_mul(e, game->p_c, e);
int m = ROUND(mpq_get_d(e));
mpq_clear(e);
for(i = 0; i < m; ++i)
{
int j = random_integer(n);
int x = g_array_index(players, int, j);
game->initial_config[x] = 1;
game->current_config[x] = 1;
g_array_remove_index_fast(players, j);
n--;
}
g_array_free(players, TRUE);
}
static int
my_main (int argc, char **argv)
{
setlocale (LC_ALL, "");
scm_dynwind_begin (0);
CBLAS_SIDE_t Side = side_func (argv[1]);
CBLAS_UPLO_t Uplo = uplo_func (argv[2]);
CBLAS_TRANSPOSE_t TransA = trans_func (argv[3]);
CBLAS_DIAG_t Diag = diag_func (argv[4]);
int m = atoi (argv[5]);
int n = atoi (argv[6]);
mpq_t alpha;
mpq_init (alpha);
scm_dynwind_mpq_clear (alpha);
mpq_set_str (alpha, argv[7], 0);
mpq_canonicalize (alpha);
int k = (Side == CblasLeft) ? m : n;
mpq_t A[k][k];
mpq_matrix_init (k, k, A);
scm_dynwind_mpq_matrix_clear (k, k, A);
mpq_t B[m][n];
mpq_matrix_init (m, n, B);
scm_dynwind_mpq_matrix_clear (m, n, B);
double A1[k][k];
double B1[m][n];
gsl_matrix_view mA1 = gsl_matrix_view_array (&A1[0][0], k, k);
gsl_matrix_view mB1 = gsl_matrix_view_array (&B1[0][0], m, n);
unsigned int i_argv = 8;
for (unsigned int i = 0; i < k; i++)
for (unsigned int j = 0; j < k; j++)
{
mpq_set_str (A[i][j], argv[i_argv], 0);
mpq_canonicalize (A[i][j]);
A1[i][j] = mpq_get_d (A[i][j]);
i_argv++;
}
for (unsigned int i = 0; i < m; i++)
for (unsigned int j = 0; j < n; j++)
{
mpq_set_str (B[i][j], argv[i_argv], 0);
mpq_canonicalize (B[i][j]);
B1[i][j] = mpq_get_d (B[i][j]);
i_argv++;
}
mpq_matrix_trmm (Side, Uplo, TransA, Diag, m, n, alpha, A, B);
gsl_blas_dtrmm (Side, Uplo, TransA, Diag, mpq_get_d (alpha), &mA1.matrix,
&mB1.matrix);
int exit_status = 0;
// Check that we get the same results as gsl_blas_dtrmm.
for (unsigned int i = 0; i < m; i++)
for (unsigned int j = 0; j < n; j++)
{
gmp_printf ("B[%u][%u] = %lf\t%Qd\n", i, j, B1[i][j], B[i][j]);
if (10000 * DBL_EPSILON < fabs (mpq_get_d (B[i][j]) - B1[i][j]))
exit_status = 1;
}
scm_dynwind_end ();
return exit_status;
}
static bool _convert(CRATIONAL *a, GB_TYPE type, GB_VALUE *conv)
{
if (a)
{
switch (type)
{
case GB_T_FLOAT:
conv->_float.value = mpq_get_d(a->n);
return FALSE;
case GB_T_SINGLE:
conv->_single.value = mpq_get_d(a->n);
return FALSE;
case GB_T_INTEGER:
case GB_T_SHORT:
case GB_T_BYTE:
conv->_integer.value = (int)mpq_get_d(a->n);
return FALSE;
case GB_T_LONG:
conv->_long.value = (int64_t)mpq_get_d(a->n);
return FALSE;
case GB_T_STRING:
case GB_T_CSTRING:
conv->_string.value.addr = RATIONAL_to_string(a->n, 10); //, type == GB_T_CSTRING);
conv->_string.value.start = 0;
conv->_string.value.len = GB.StringLength(conv->_string.value.addr);
return FALSE;
default:
if (type == CLASS_BigInt)
{
mpz_t n;
mpz_init(n);
mpz_tdiv_q(n, mpq_numref(a->n), mpq_denref(a->n));
conv->_object.value = BIGINT_create(n);
return FALSE;
}
return TRUE;
}
}
else
{
mpq_t n;
switch(type)
{
case GB_T_FLOAT:
mpq_init_set_d(n, conv->_float.value);
conv->_object.value = RATIONAL_create(n);
return FALSE;
case GB_T_SINGLE:
mpq_init_set_d(n, conv->_single.value);
conv->_object.value = RATIONAL_create(n);
return FALSE;
case GB_T_INTEGER:
case GB_T_SHORT:
case GB_T_BYTE:
mpq_init_set_si(n, (long)conv->_integer.value);
conv->_object.value = RATIONAL_create(n);
return FALSE;
case GB_T_LONG:
mpq_init_set_si(n, (long)conv->_long.value);
conv->_object.value = RATIONAL_create(n);
return FALSE;
case GB_T_STRING:
case GB_T_CSTRING:
conv->_object.value = RATIONAL_from_string(GB.ToZeroString(&conv->_string), 10);
return conv->_object.value == NULL;
default:
if (type == CLASS_BigInt)
{
mpq_init(n);
mpq_set_z(n, ((CBIGINT *)conv->_object.value)->n);
conv->_object.value = RATIONAL_create(n);
return FALSE;
}
return TRUE;
}
}
}
static inline rsexp add_flo_fix (RState* r, rsexp lhs, rsexp rhs)
{
double sum = floreal_value (lhs) + mpq_get_d (fixreal_value (rhs));
return r_floreal_new (r, sum);
}
static inline rsexp multiply_flo_fix (RState* r, rsexp lhs, rsexp rhs)
{
double prod = floreal_value (lhs) * mpq_get_d (fixreal_value (rhs));
return r_floreal_new (r, prod);
}
static void
solve(char* file_name) {
ppl_Constraint_System_t ppl_cs;
#ifndef NDEBUG
ppl_Constraint_System_t ppl_cs_copy;
#endif
ppl_Generator_t optimum_location;
ppl_Linear_Expression_t ppl_le;
int dimension, row, num_rows, column, nz, i, j, type;
int* coefficient_index;
double lb, ub;
double* coefficient_value;
mpq_t rational_lb, rational_ub;
mpq_t* rational_coefficient;
mpq_t* objective;
ppl_Linear_Expression_t ppl_objective_le;
ppl_Coefficient_t optimum_n;
ppl_Coefficient_t optimum_d;
mpq_t optimum;
mpz_t den_lcm;
int optimum_found;
glp_mpscp glpk_mpscp;
glpk_lp = glp_create_prob();
glp_init_mpscp(&glpk_mpscp);
if (verbosity == 0) {
/* FIXME: find a way to suppress output from glp_read_mps. */
}
#ifdef PPL_LPSOL_SUPPORTS_TIMINGS
if (print_timings)
start_clock();
#endif /* defined(PPL_LPSOL_SUPPORTS_TIMINGS) */
if (glp_read_mps(glpk_lp, GLP_MPS_FILE, &glpk_mpscp, file_name) != 0)
fatal("cannot read MPS file `%s'", file_name);
#ifdef PPL_LPSOL_SUPPORTS_TIMINGS
if (print_timings) {
fprintf(stderr, "Time to read the input file: ");
print_clock(stderr);
fprintf(stderr, " s\n");
start_clock();
}
#endif /* defined(PPL_LPSOL_SUPPORTS_TIMINGS) */
glpk_lp_num_int = glp_get_num_int(glpk_lp);
if (glpk_lp_num_int > 0 && !no_mip && !use_simplex)
fatal("the enumeration solving method can not handle MIP problems");
dimension = glp_get_num_cols(glpk_lp);
/* Read variables constrained to be integer. */
if (glpk_lp_num_int > 0 && !no_mip && use_simplex) {
if (verbosity >= 4)
fprintf(output_file, "Integer variables:\n");
integer_variables = (ppl_dimension_type*)
malloc((glpk_lp_num_int + 1)*sizeof(ppl_dimension_type));
for (i = 0, j = 0; i < dimension; ++i) {
int col_kind = glp_get_col_kind(glpk_lp, i+1);
if (col_kind == GLP_IV || col_kind == GLP_BV) {
integer_variables[j] = i;
if (verbosity >= 4) {
ppl_io_fprint_variable(output_file, i);
fprintf(output_file, " ");
}
++j;
}
}
}
coefficient_index = (int*) malloc((dimension+1)*sizeof(int));
coefficient_value = (double*) malloc((dimension+1)*sizeof(double));
rational_coefficient = (mpq_t*) malloc((dimension+1)*sizeof(mpq_t));
ppl_new_Constraint_System(&ppl_cs);
mpq_init(rational_lb);
mpq_init(rational_ub);
for (i = 1; i <= dimension; ++i)
mpq_init(rational_coefficient[i]);
mpz_init(den_lcm);
if (verbosity >= 4)
fprintf(output_file, "\nConstraints:\n");
/* Set up the row (ordinary) constraints. */
num_rows = glp_get_num_rows(glpk_lp);
for (row = 1; row <= num_rows; ++row) {
/* Initialize the least common multiple computation. */
mpz_set_si(den_lcm, 1);
/* Set `nz' to the number of non-zero coefficients. */
nz = glp_get_mat_row(glpk_lp, row, coefficient_index, coefficient_value);
for (i = 1; i <= nz; ++i) {
set_mpq_t_from_double(rational_coefficient[i], coefficient_value[i]);
/* Update den_lcm. */
mpz_lcm(den_lcm, den_lcm, mpq_denref(rational_coefficient[i]));
}
lb = glp_get_row_lb(glpk_lp, row);
ub = glp_get_row_ub(glpk_lp, row);
set_mpq_t_from_double(rational_lb, lb);
set_mpq_t_from_double(rational_ub, ub);
mpz_lcm(den_lcm, den_lcm, mpq_denref(rational_lb));
mpz_lcm(den_lcm, den_lcm, mpq_denref(rational_ub));
ppl_new_Linear_Expression_with_dimension(&ppl_le, dimension);
for (i = 1; i <= nz; ++i) {
mpz_mul(tmp_z, den_lcm, mpq_numref(rational_coefficient[i]));
mpz_divexact(tmp_z, tmp_z, mpq_denref(rational_coefficient[i]));
ppl_assign_Coefficient_from_mpz_t(ppl_coeff, tmp_z);
ppl_Linear_Expression_add_to_coefficient(ppl_le, coefficient_index[i]-1,
ppl_coeff);
}
type = glp_get_row_type(glpk_lp, row);
add_constraints(ppl_le, type, rational_lb, rational_ub, den_lcm, ppl_cs);
ppl_delete_Linear_Expression(ppl_le);
}
free(coefficient_value);
for (i = 1; i <= dimension; ++i)
mpq_clear(rational_coefficient[i]);
free(rational_coefficient);
free(coefficient_index);
#ifndef NDEBUG
ppl_new_Constraint_System_from_Constraint_System(&ppl_cs_copy, ppl_cs);
#endif
/*
FIXME: here we could build the polyhedron and minimize it before
adding the variable bounds.
*/
/* Set up the columns constraints, i.e., variable bounds. */
for (column = 1; column <= dimension; ++column) {
lb = glp_get_col_lb(glpk_lp, column);
ub = glp_get_col_ub(glpk_lp, column);
set_mpq_t_from_double(rational_lb, lb);
set_mpq_t_from_double(rational_ub, ub);
/* Initialize the least common multiple computation. */
mpz_set_si(den_lcm, 1);
mpz_lcm(den_lcm, den_lcm, mpq_denref(rational_lb));
mpz_lcm(den_lcm, den_lcm, mpq_denref(rational_ub));
ppl_new_Linear_Expression_with_dimension(&ppl_le, dimension);
ppl_assign_Coefficient_from_mpz_t(ppl_coeff, den_lcm);
ppl_Linear_Expression_add_to_coefficient(ppl_le, column-1, ppl_coeff);
type = glp_get_col_type(glpk_lp, column);
add_constraints(ppl_le, type, rational_lb, rational_ub, den_lcm, ppl_cs);
ppl_delete_Linear_Expression(ppl_le);
}
mpq_clear(rational_ub);
mpq_clear(rational_lb);
/* Deal with the objective function. */
objective = (mpq_t*) malloc((dimension+1)*sizeof(mpq_t));
/* Initialize the least common multiple computation. */
mpz_set_si(den_lcm, 1);
mpq_init(objective[0]);
set_mpq_t_from_double(objective[0], glp_get_obj_coef(glpk_lp, 0));
for (i = 1; i <= dimension; ++i) {
mpq_init(objective[i]);
set_mpq_t_from_double(objective[i], glp_get_obj_coef(glpk_lp, i));
/* Update den_lcm. */
mpz_lcm(den_lcm, den_lcm, mpq_denref(objective[i]));
}
/* Set the ppl_objective_le to be the objective function. */
ppl_new_Linear_Expression_with_dimension(&ppl_objective_le, dimension);
/* Set value for objective function's inhomogeneous term. */
mpz_mul(tmp_z, den_lcm, mpq_numref(objective[0]));
mpz_divexact(tmp_z, tmp_z, mpq_denref(objective[0]));
ppl_assign_Coefficient_from_mpz_t(ppl_coeff, tmp_z);
ppl_Linear_Expression_add_to_inhomogeneous(ppl_objective_le, ppl_coeff);
/* Set values for objective function's variable coefficients. */
for (i = 1; i <= dimension; ++i) {
mpz_mul(tmp_z, den_lcm, mpq_numref(objective[i]));
mpz_divexact(tmp_z, tmp_z, mpq_denref(objective[i]));
ppl_assign_Coefficient_from_mpz_t(ppl_coeff, tmp_z);
ppl_Linear_Expression_add_to_coefficient(ppl_objective_le, i-1, ppl_coeff);
}
if (verbosity >= 4) {
fprintf(output_file, "Objective function:\n");
if (mpz_cmp_si(den_lcm, 1) != 0)
fprintf(output_file, "(");
ppl_io_fprint_Linear_Expression(output_file, ppl_objective_le);
}
for (i = 0; i <= dimension; ++i)
mpq_clear(objective[i]);
free(objective);
if (verbosity >= 4) {
if (mpz_cmp_si(den_lcm, 1) != 0) {
fprintf(output_file, ")/");
mpz_out_str(output_file, 10, den_lcm);
}
fprintf(output_file, "\n%s\n",
(maximize ? "Maximizing." : "Minimizing."));
}
ppl_new_Coefficient(&optimum_n);
ppl_new_Coefficient(&optimum_d);
ppl_new_Generator_zero_dim_point(&optimum_location);
optimum_found = use_simplex
? solve_with_simplex(ppl_cs,
ppl_objective_le,
optimum_n,
optimum_d,
optimum_location)
: solve_with_generators(ppl_cs,
ppl_objective_le,
optimum_n,
optimum_d,
optimum_location);
ppl_delete_Linear_Expression(ppl_objective_le);
if (glpk_lp_num_int > 0)
free(integer_variables);
if (optimum_found) {
mpq_init(optimum);
ppl_Coefficient_to_mpz_t(optimum_n, tmp_z);
mpq_set_num(optimum, tmp_z);
ppl_Coefficient_to_mpz_t(optimum_d, tmp_z);
mpz_mul(tmp_z, tmp_z, den_lcm);
mpq_set_den(optimum, tmp_z);
if (verbosity == 1)
fprintf(output_file, "Optimized problem.\n");
if (verbosity >= 2)
fprintf(output_file, "Optimum value: %.10g\n", mpq_get_d(optimum));
if (verbosity >= 3) {
fprintf(output_file, "Optimum location:\n");
ppl_Generator_divisor(optimum_location, ppl_coeff);
ppl_Coefficient_to_mpz_t(ppl_coeff, tmp_z);
for (i = 0; i < dimension; ++i) {
mpz_set(mpq_denref(tmp1_q), tmp_z);
ppl_Generator_coefficient(optimum_location, i, ppl_coeff);
ppl_Coefficient_to_mpz_t(ppl_coeff, mpq_numref(tmp1_q));
ppl_io_fprint_variable(output_file, i);
fprintf(output_file, " = %.10g\n", mpq_get_d(tmp1_q));
}
}
#ifndef NDEBUG
{
ppl_Polyhedron_t ph;
unsigned int relation;
ppl_new_C_Polyhedron_recycle_Constraint_System(&ph, ppl_cs_copy);
ppl_delete_Constraint_System(ppl_cs_copy);
relation = ppl_Polyhedron_relation_with_Generator(ph, optimum_location);
ppl_delete_Polyhedron(ph);
assert(relation == PPL_POLY_GEN_RELATION_SUBSUMES);
}
#endif
maybe_check_results(PPL_MIP_PROBLEM_STATUS_OPTIMIZED,
mpq_get_d(optimum));
mpq_clear(optimum);
}
ppl_delete_Constraint_System(ppl_cs);
ppl_delete_Coefficient(optimum_d);
ppl_delete_Coefficient(optimum_n);
ppl_delete_Generator(optimum_location);
glp_delete_prob(glpk_lp);
}
void set_from_mpq(ElementType &result, mpq_ptr a) const {
result.re = mpq_get_d(a);
result.im = 0.0;
}
void
ovm_q_hypot(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = fabs(mpq_get_d(oqr(l)));
}
else {
mpfr_set_ui(orr(r), 0, thr_rnd);
goto mpr;
}
break;
case t_word:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), r->v.w);
}
else {
mpfr_set_si(orr(r), r->v.w, thr_rnd);
goto mpr;
}
break;
case t_float:
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), mpz_get_d(ozr(r)));
}
else {
mpfr_set_z(orr(r), ozr(r), thr_rnd);
goto mpr;
}
break;
case t_rat:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), rat_get_d(r->v.r));
}
else {
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpq:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)), mpq_get_d(oqr(r)));
}
else {
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpr:
mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_hypot(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
cdd:
l->t = t_float;
l->v.d = hypot(mpq_get_d(oqr(l)),
hypot(real(r->v.dd), imag(r->v.dd)));
break;
case t_cqq:
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
}
mpc_set_q_q(occ(r), oqr(r), oqi(r), thr_rndc);
case t_mpc:
l->t = t_mpr;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpfr_hypot(ori(l), orr(l), ori(l), thr_rnd);
mpfr_hypot(orr(l), orr(r), ori(r), thr_rnd);
mpfr_hypot(orr(l), ori(l), orr(l), thr_rnd);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_q_pow(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = 1.0;
}
else {
l->t = t_mpr;
mpfr_set_ui(orr(l), 1, thr_rnd);
}
break;
case t_word:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), r->v.w);
}
else {
mpfr_set_si(orr(r), r->v.w, thr_rnd);
goto mpr;
}
break;
case t_float:
if (mpq_sgn(oqr(l)) < 0 &&
finite(r->v.d) && rint(r->v.d) != r->v.d) {
real(r->v.dd) = r->v.d;
imag(r->v.dd) = 0.0;
goto cdd;
}
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), mpz_get_d(ozr(r)));
}
else {
mpfr_set_z(orr(r), ozr(r), thr_rnd);
goto mpr;
}
break;
case t_rat:
if (mpq_sgn(oqr(l)) < 0) {
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = 0.0;
goto cdd;
}
mpc_set_q(occ(r), oqr(r), thr_rndc);
goto mpc;
}
else {
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), rat_get_d(r->v.r));
}
else {
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
}
break;
case t_mpq:
if (mpq_sgn(oqr(r)) < 0) {
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = 0.0;
goto cdd;
}
mpc_set_q(occ(r), oqr(r), thr_rndc);
goto mpc;
}
else {
if (!cfg_float_format) {
l->t = t_float;
l->v.d = pow(mpq_get_d(oqr(l)), mpq_get_d(oqr(r)));
}
else {
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
}
break;
case t_mpr:
if (mpq_sgn(oqr(l)) < 0 &&
mpfr_number_p(orr(r)) && !mpfr_integer_p(orr(r))) {
mpc_set_q(occ(r), oqr(r), thr_rndc);
goto mpc;
}
mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_pow(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
cdd:
l->t = t_cdd;
real(l->v.dd) = mpq_get_d(oqr(l));
imag(l->v.dd) = 0.0;
l->v.dd = cpow(l->v.dd, r->v.dd);
check_cdd(l);
break;
case t_cqq:
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
}
mpc_set_q_q(occ(r), oqr(r), oqi(r), thr_rndc);
case t_mpc:
mpc:
l->t = t_mpc;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpc_pow(occ(l), occ(l), occ(r), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
void
ovm_q_atan2(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), 0.0);
}
else {
mpfr_set_ui(orr(r), 0, thr_rnd);
goto mpr;
}
break;
case t_word:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), r->v.w);
}
else {
mpfr_set_si(orr(r), r->v.w, thr_rnd);
goto mpr;
}
break;
case t_float:
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), r->v.d);
break;
case t_mpz:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), mpz_get_d(ozr(r)));
}
else {
mpfr_set_z(orr(r), ozr(r), thr_rnd);
goto mpr;
}
break;
case t_rat:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), rat_get_d(r->v.r));
}
else {
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpq:
if (!cfg_float_format) {
l->t = t_float;
l->v.d = atan2(mpq_get_d(oqr(l)), mpq_get_d(oqr(r)));
}
else {
mpfr_set_q(orr(r), oqr(r), thr_rnd);
goto mpr;
}
break;
case t_mpr:
mpr:
mpfr_set_q(orr(l), oqr(l), thr_rnd);
l->t = t_mpr;
mpfr_atan2(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
cdd:
l->t = t_cdd;
real(l->v.dd) = mpq_get_d(oqr(l));
imag(l->v.dd) = 0.0;
l->v.dd = catan(l->v.dd / r->v.dd);
check_cdd(l);
break;
case t_cqq:
if (!cfg_float_format) {
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
goto cdd;
}
mpc_set_q_q(occ(r), oqr(r), oqi(r), thr_rndc);
case t_mpc:
l->t = t_mpc;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpc_div(occ(l), occ(l), occ(r), thr_rndc);
mpc_atan(occ(l), occ(l), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
