static void mpf_exp(mpf_t res, mpf_t pwr) {
mpf_t a;
mpf_t f0;
int i;
mpf_init(a); mpf_set(a, pwr);
mpf_init(f0);
mpf_set(f0, a);
mpf_add_ui(res, a, 1);
for (i=2;;i++) {
mpf_mul(f0, f0, a);
mpf_div_ui(f0, f0, i);
if (mpf_sgn(f0) > 0) {
if (mpf_cmp(f0, epsilon) < 0) break;
} else {
if (mpf_cmp(f0, negepsilon) > 0) break;
}
mpf_add(res, res, f0);
}
mpf_clear(f0);
mpf_clear(a);
}
TEST_F(InputTest, Precision) {
mpf_class expected_precision {10.0};
mpf_pow_ui(expected_precision.get_mpf_t(),
expected_precision.get_mpf_t(), 110);
expected_precision = 1.0 / expected_precision;
EXPECT_TRUE(mpf_cmp(expected_precision.get_mpf_t(),
inputF.getPrecision().get_mpf_t()));
EXPECT_TRUE(mpf_cmp(expected_precision.get_mpf_t(),
inputM.getPrecision().get_mpf_t()));
}
static void mpc_cis(mpc_t res, mpf_t theta) {
mpf_t a;
mpf_init(a); mpf_set(a, theta);
//res = exp(i a)
// = cos a + i sin a
//converges quickly near the origin
mpf_t f0;
mpf_ptr rx = mpc_re(res), ry = mpc_im(res);
int i;
int toggle = 1;
mpf_init(f0);
mpf_set(f0, a);
mpf_set_ui(rx, 1);
mpf_set(ry, f0);
i = 1;
for(;;) {
toggle = !toggle;
i++;
mpf_div_ui(f0, f0, i);
mpf_mul(f0, f0, a);
if (toggle) {
mpf_add(rx, rx, f0);
} else {
mpf_sub(rx, rx, f0);
}
i++;
mpf_div_ui(f0, f0, i);
mpf_mul(f0, f0, a);
if (toggle) {
mpf_add(ry, ry, f0);
} else {
mpf_sub(ry, ry, f0);
}
if (mpf_sgn(f0) > 0) {
if (mpf_cmp(f0, epsilon) < 0) break;
} else {
if (mpf_cmp(f0, negepsilon) > 0) break;
}
}
mpf_clear(f0);
mpf_clear(a);
}
static void precision_init(int prec) {
int i;
mpf_t f0;
mpf_set_default_prec(prec);
mpf_init2(epsilon, 2);
mpf_init2(negepsilon, 2);
mpf_init(recipeulere);
mpf_init(pi);
mpf_init(eulere);
mpf_set_ui(epsilon, 1);
mpf_div_2exp(epsilon, epsilon, prec);
mpf_neg(negepsilon, epsilon);
mpf_init(f0);
mpf_set_ui(eulere, 1);
mpf_set_ui(f0, 1);
for (i=1;; i++) {
mpf_div_ui(f0, f0, i);
if (mpf_cmp(f0, epsilon) < 0) {
break;
}
mpf_add(eulere, eulere, f0);
}
mpf_clear(f0);
mpf_ui_div(recipeulere, 1, eulere);
compute_pi(prec);
}
void DoComparisionOperation(number_t result, number_t number1, number_t number2, char *op)
{
int cmp_result;
cmp_result = mpf_cmp(number1, number2);
switch (op[0])
{
case '<':
if (op[1] == '=') {
mpf_set_si(result, cmp_result <= 0);
} else {
mpf_set_si(result, cmp_result < 0);
}
break;
case '>':
if(op[1] == '=') {
mpf_set_si(result, cmp_result >= 0);
} else {
mpf_set_si(result, cmp_result > 0);
}
break;
case '=':
if (op[1] == '=') {
mpf_set_si(result, cmp_result == 0);
}
else {
mpf_set_si(result, cmp_result != 0);
}
break;
}
}
/**
* rasqal_xsd_decimal_compare:
* @a: first XSD decimal
* @b: second XSD decimal
*
* Compare two XSD Decimals
*
* Return value: <0 if @a is less than @b, 0 if equal, >1 otherwise
**/
int
rasqal_xsd_decimal_compare(rasqal_xsd_decimal* a, rasqal_xsd_decimal* b)
{
#if defined(RASQAL_DECIMAL_C99) || defined(RASQAL_DECIMAL_NONE)
double d;
#endif
int rc=0;
#if defined(RASQAL_DECIMAL_C99) || defined(RASQAL_DECIMAL_NONE)
d = (a->raw - b->raw);
/* do this carefully to avoid rounding e.g. (int)0.5 = 0 but is >0 */
if(d < 0.0)
rc = -1;
else if (d > 0.0)
rc = 1;
/* else rc is 0 set above */
#endif
#ifdef RASQAL_DECIMAL_MPFR
rc = mpfr_cmp(a->raw, b->raw);
#endif
#ifdef RASQAL_DECIMAL_GMP
rc=mpf_cmp(a->raw, b->raw);
#endif
return rc;
}
vanilla::object::ptr vanilla::int_object::neq(object::ptr const& other)
{
switch(other->type_id())
{
case OBJECT_ID_INT:
{
int_object const* rhs = static_cast<int_object const*>(other.get());
int result = mpz_cmp(_v.mpz(), rhs->value().mpz());
return allocate_object<bool_object>(result != 0);
}
case OBJECT_ID_FLOAT:
{
float_object const* rhs = static_cast<float_object const*>(other.get());
if(!mpf_integer_p(rhs->value().mpf()))
return allocate_object<bool_object>(true);
float_object::float_type lhs( (_v.mpz()) );
return allocate_object<bool_object>(mpf_cmp(lhs.mpf(), rhs->value().mpf()) != 0);
}
default:
{
return object::ge(other);
}
}
}
static int is_small(const mpf_t x, const mpf_t y) {
DECLARE_2VARS(xa,ya);
mpf_abs(xa,x);
mpf_abs(ya,y);
mpf_div_2exp(ya,ya,PREC_BITS-mp_bits_per_limb);
return mpf_cmp(xa,ya) < 0;
}
/**
* int main()
*
* Descricao:
* Funcao principal do programa que contem um loop (do-while) contendo a chamada
* das funcoes que calculam as variaveis utilizadas pelo algoritmo Gauss-Legendre
* a cada iteracao.
*
* Parametros de entrada:
* -
*
* Parametros de retorno:
* -
*
*/
int main(){
/* Variaveis utilizadas para calcular o tempo de execucao do programa */
time_t begin, end;
double time_spent;
time(&begin);
/* Inicialicazao das variaveis globais utilizadas no algoritmo */
initAttributes();
/* Loop principal que calcula o valor do "pi" */
do{
//printf("Iteracao: %ld\n", n_count);
calculate_a();
calculate_b();
calculate_t();
calculate_p();
calculate_pi();
filePrint();
n_count++;
} while(mpf_cmp(pi[n_count-2], pi[n_count-1])!=0); /* Condicao de parada: o "pi" recem calculado deve
ser igual ao seu antecessor, garantindo assim a sua
convergencia com 10 milhoes de casas decimais */
time(&end);
time_spent = difftime(end, begin);
printf("Tempo de execucao: %lf segundos\nIteracoes: %ld\n", time_spent, n_count);
return 0;
}
int realCompare(Real real1, Real real2){
#ifdef USE_MPFR
return mpfr_cmp(real1->mpfr_val, real2->mpfr_val);
#else
return mpf_cmp(real1->mpf_val, real2->mpf_val);
#endif
}
depth_t frac_generalized_celtic_gmp(
depth_t depth,
mpf_t bail,
mpf_t wim, mpf_t wre,
mpf_t c_im, mpf_t c_re,
mpf_t wim2, mpf_t wre2, mpf_t t1)
{
depth_t wz;
for (wz = 1; wz <= depth; wz++)
{
/* wim = 2.0 * wre * wim + c_im; */
mpf_mul( t1, wre, wim);
mpf_mul_ui(t1, t1, 2);
mpf_add( wim, t1, c_im);
/* wre = wre2 - wim2 + c_re; */
mpf_sub( t1, wre2, wim2);
mpf_abs( t1, t1);
mpf_add( wre, t1, c_re);
/* wim2 = wim * wim; */
mpf_mul( wim2, wim, wim);
/* wre2 = wre * wre; */
mpf_mul( wre2, wre, wre);
/* if ((wim2 + wre2) > frs_bail) */
mpf_add( t1, wim2, wre2);
if (mpf_cmp(t1, bail) > 0)
return wz;
}
return 0;
}
int camlidl_custom_mpf_compare(value val1, value val2)
{
int res;
__mpf_struct* mpf1;
__mpf_struct* mpf2;
mpf1 = (__mpf_struct*)(Data_custom_val(val1));
mpf2 = (__mpf_struct*)(Data_custom_val(val2));
res = mpf_cmp(mpf1,mpf2);
res = res > 0 ? 1 : res==0 ? 0 : -1;
return res;
}
bool libmaus2::math::GmpFloat::operator>=(
GmpFloat const &
#if defined(LIBMAUS2_HAVE_GMP)
o
#endif
) const
{
#if defined(LIBMAUS2_HAVE_GMP)
return mpf_cmp(decode(v),decode(o.v)) >= 0;
#else
return 0;
#endif
}
void
check_various (void)
{
mpf_t u, got, want;
char *s;
mpf_init2 (u, 2*8*sizeof(long));
mpf_init2 (got, 2*8*sizeof(long));
mpf_init2 (want, 2*8*sizeof(long));
s = "0 * GMP_UI_MAX";
mpf_set_ui (u, 0L);
mpf_mul_ui (got, u, GMP_UI_MAX);
MPF_CHECK_FORMAT (got);
mpf_set_ui (want, 0L);
if (mpf_cmp (got, want) != 0)
{
error:
printf ("Wrong result from %s\n", s);
mpf_trace ("u ", u);
mpf_trace ("got ", got);
mpf_trace ("want", want);
abort ();
}
s = "1 * GMP_UI_MAX";
mpf_set_ui (u, 1L);
mpf_mul_ui (got, u, GMP_UI_MAX);
MPF_CHECK_FORMAT (got);
mpf_set_ui (want, GMP_UI_MAX);
if (mpf_cmp (got, want) != 0)
goto error;
mpf_clear (u);
mpf_clear (got);
mpf_clear (want);
}
/**
* rasqal_xsd_decimal_equals:
* @a: first XSD Decimal
* @b: second XSD Decimal
*
* Compare two XSD Decimals for equality.
*
* Return value: non-0 if equal.
**/
int
rasqal_xsd_decimal_equals(rasqal_xsd_decimal* a, rasqal_xsd_decimal* b)
{
int rc;
#if defined(RASQAL_DECIMAL_C99) || defined(RASQAL_DECIMAL_NONE)
rc= (b->raw == a->raw);
#elif defined(RASQAL_DECIMAL_MPFR)
rc = mpfr_equal_p(a->raw, b->raw);
#elif defined(RASQAL_DECIMAL_GMP)
/* NOTE: Not using mpf_eq() but could do, with sufficient bits */
rc=!mpf_cmp(a->raw, b->raw);
#else
#error RASQAL_DECIMAL flagging error
#endif
return rc;
}
//------------------------------------------------------------------------------
// Name:
//------------------------------------------------------------------------------
int knumber_float::compare(knumber_base *rhs) {
if(knumber_integer *const p = dynamic_cast<knumber_integer *>(rhs)) {
knumber_float f(p);
return compare(&f);
} else if(knumber_float *const p = dynamic_cast<knumber_float *>(rhs)) {
return mpf_cmp(mpf_, p->mpf_);
} else if(knumber_fraction *const p = dynamic_cast<knumber_fraction *>(rhs)) {
knumber_float f(p);
return compare(&f);
} else if(knumber_error *const p = dynamic_cast<knumber_error *>(rhs)) {
// NOTE: any number compared to NaN/Inf/-Inf always compares less
// at the moment
return -1;
}
Q_ASSERT(0);
return 0;
}
int
main (int argc, char **argv)
{
double d, e, r;
mpf_t u, v;
tests_start ();
mpf_init (u);
mpf_init (v);
mpf_set_d (u, LOW_BOUND);
for (d = 2.0 * LOW_BOUND; d < HIGH_BOUND; d *= 1.01)
{
mpf_set_d (v, d);
if (mpf_cmp (u, v) >= 0)
abort ();
e = mpf_get_d (v);
r = e/d;
if (r < 0.99999999999999 || r > 1.00000000000001)
{
fprintf (stderr, "should be one ulp from 1: %.16f\n", r);
abort ();
}
mpf_set (u, v);
}
mpf_clear (u);
mpf_clear (v);
test_denorms (10);
test_denorms (32);
test_denorms (64);
test_denorms (100);
test_denorms (200);
tests_end ();
exit (0);
}
void UniRootF_Newton()
{
poly_f f,fd;
mpf_t x,y,den,num;
mpf_t prec;
mpf_init2(den,DigitisToBits(FC_DEFAULT_PREC));
mpf_init2(num,DigitisToBits(FC_DEFAULT_PREC));
mpf_init2(y,DigitisToBits(FC_DEFAULT_PREC));
mpf_init2(x,DigitisToBits(FC_DEFAULT_PREC));
mpf_init2(prec,1);
f.resize(3);
mpf_set_str(prec,"1e-50",10);
mpf_set_si(f[0],-2);
mpf_set_si(f[1],0);
mpf_set_si(f[2],1);
mpf_set_str(x,"1",10);
UniDFormF(fd,f);
while(1)
{
UniEvalF(num,f,x);
UniEvalF(den,fd,x);
mpf_div(y,num,den);
mpf_abs(num,y);
if(mpf_cmp(num,prec)<0)break;
mpf_sub(x,x,y);
}
mpf_sub(y,x,y);
mpf_out_str(0,10,FC_DEFAULT_PREC,y);std::cout<<"\n";
mpf_clear(prec);
mpf_clear(den);
mpf_clear(num);
mpf_clear(y);
mpf_clear(x);
f.resize(0);
fd.resize(0);
}
int
main (int argc, char **argv)
{
mp_size_t size;
mp_exp_t exp;
int reps = 10000;
int i;
mpf_t u, v, w, x;
mp_size_t bprec = SIZE * GMP_LIMB_BITS;
mpf_t rerr, limit_rerr;
unsigned long ulimb, vlimb;
int single_flag;
tests_start ();
if (argc > 1)
{
reps = strtol (argv[1], 0, 0);
if (argc > 2)
bprec = strtol (argv[2], 0, 0);
}
mpf_set_default_prec (bprec);
mpf_init (rerr);
mpf_init (limit_rerr);
mpf_init (u);
mpf_init (v);
mpf_init (w);
mpf_init (x);
for (i = 0; i < reps; i++)
{
mp_size_t res_prec;
res_prec = urandom () % bprec + 1;
mpf_set_prec (w, res_prec);
mpf_set_prec (x, res_prec);
mpf_set_ui (limit_rerr, 1);
mpf_div_2exp (limit_rerr, limit_rerr, res_prec - 1);
single_flag = 0;
if ((urandom () & 1) != 0)
{
size = urandom () % (2 * SIZE) - SIZE;
exp = urandom () % SIZE;
mpf_random2 (u, size, exp);
}
else
{
ulimb = urandom ();
mpf_set_ui (u, ulimb);
single_flag = 1;
}
if ((urandom () & 1) != 0)
{
size = urandom () % (2 * SIZE) - SIZE;
exp = urandom () % SIZE;
mpf_random2 (v, size, exp);
}
else
{
vlimb = urandom ();
mpf_set_ui (v, vlimb);
single_flag = 2;
}
if (mpf_sgn (v) == 0)
continue;
mpf_div (w, u, v);
mpf_mul (x, w, v);
mpf_reldiff (rerr, u, x);
if (mpf_cmp (rerr, limit_rerr) > 0)
{
printf ("ERROR in mpf_mul or mpf_div after %d tests\n", i);
printf (" u = "); mpf_dump (u);
printf (" v = "); mpf_dump (v);
printf (" x = "); mpf_dump (x);
printf (" w = "); mpf_dump (w);
abort ();
}
if (single_flag == 2)
{
mpf_div_ui (x, u, vlimb);
mpf_reldiff (rerr, w, x);
if (mpf_cmp (rerr, limit_rerr) > 0)
{
printf ("ERROR in mpf_div or mpf_div_ui after %d tests\n", i);
printf (" u = "); mpf_dump (u);
printf (" v = "); mpf_dump (v);
printf (" x = "); mpf_dump (x);
printf (" w = "); mpf_dump (w);
abort ();
}
}
if (single_flag == 1)
{
mpf_ui_div (x, ulimb, v);
mpf_reldiff (rerr, w, x);
if (mpf_cmp (rerr, limit_rerr) > 0)
{
printf ("ERROR in mpf_div or mpf_ui_div after %d tests\n", i);
printf (" u = "); mpf_dump (u);
printf (" v = "); mpf_dump (v);
printf (" x = "); mpf_dump (x);
printf (" w = "); mpf_dump (w);
abort ();
}
}
}
mpf_clear (rerr);
mpf_clear (limit_rerr);
mpf_clear (u);
mpf_clear (v);
mpf_clear (w);
mpf_clear (x);
tests_end ();
exit (0);
}
int segment_intersection_2d_test(double ax1, double ay1, double ax2,
double ay2, double bx1, double by1,
double bx2, double by2, double *x1,
double *y1, double *x2, double *y2)
{
double t;
double max_ax, min_ax, max_ay, min_ay;
double max_bx, min_bx, max_by, min_by;
int sgn_d, sgn_da, sgn_db;
int vertical;
int f11, f12, f21, f22;
mp_exp_t exp;
char *s;
double d, da, db, ra, rb;
if (!initialized)
initialize_mpf_vars();
/* TODO: Works for points ? */
G_debug(3, "segment_intersection_2d_test()");
G_debug(3, " ax1 = %.18e, ay1 = %.18e", ax1, ay1);
G_debug(3, " ax2 = %.18e, ay2 = %.18e", ax2, ay2);
G_debug(3, " bx1 = %.18e, by1 = %.18e", bx1, by1);
G_debug(3, " bx2 = %.18e, by2 = %.18e", bx2, by2);
f11 = ((ax1 == bx1) && (ay1 == by1));
f12 = ((ax1 == bx2) && (ay1 == by2));
f21 = ((ax2 == bx1) && (ay2 == by1));
f22 = ((ax2 == bx2) && (ay2 == by2));
/* Check for identical segments */
if ((f11 && f22) || (f12 && f21)) {
G_debug(4, " identical segments");
*x1 = ax1;
*y1 = ay1;
*x2 = ax2;
*y2 = ay2;
return 5;
}
/* Check for identical endpoints */
if (f11 || f12) {
G_debug(4, " connected by endpoints");
*x1 = ax1;
*y1 = ay1;
return 1;
}
if (f21 || f22) {
G_debug(4, " connected by endpoints");
*x1 = ax2;
*y1 = ay2;
return 1;
}
if ((MAX(ax1, ax2) < MIN(bx1, bx2)) || (MAX(bx1, bx2) < MIN(ax1, ax2))) {
G_debug(4, " no intersection (disjoint bounding boxes)");
return 0;
}
if ((MAX(ay1, ay2) < MIN(by1, by2)) || (MAX(by1, by2) < MIN(ay1, ay2))) {
G_debug(4, " no intersection (disjoint bounding boxes)");
return 0;
}
d = (ax2 - ax1) * (by1 - by2) - (ay2 - ay1) * (bx1 - bx2);
da = (bx1 - ax1) * (by1 - by2) - (by1 - ay1) * (bx1 - bx2);
db = (ax2 - ax1) * (by1 - ay1) - (ay2 - ay1) * (bx1 - ax1);
det22(dd, ax2, ax1, bx1, bx2, ay2, ay1, by1, by2);
sgn_d = mpf_sgn(dd);
s = mpf_get_str(NULL, &exp, 10, 40, dd);
G_debug(3, " dd = %sE%d", (s[0] == 0) ? "0" : s, exp);
G_debug(3, " d = %.18E", d);
if (sgn_d != 0) {
G_debug(3, " general position");
det22(dda, bx1, ax1, bx1, bx2, by1, ay1, by1, by2);
det22(ddb, ax2, ax1, bx1, ax1, ay2, ay1, by1, ay1);
sgn_da = mpf_sgn(dda);
sgn_db = mpf_sgn(ddb);
ra = da / d;
rb = db / d;
mpf_div(rra, dda, dd);
mpf_div(rrb, ddb, dd);
s = mpf_get_str(NULL, &exp, 10, 40, rra);
G_debug(4, " rra = %sE%d", (s[0] == 0) ? "0" : s, exp);
G_debug(4, " ra = %.18E", ra);
s = mpf_get_str(NULL, &exp, 10, 40, rrb);
G_debug(4, " rrb = %sE%d", (s[0] == 0) ? "0" : s, exp);
G_debug(4, " rb = %.18E", rb);
if (sgn_d > 0) {
if ((sgn_da < 0) || (mpf_cmp(dda, dd) > 0)) {
G_debug(DLEVEL, " no intersection");
return 0;
}
if ((sgn_db < 0) || (mpf_cmp(ddb, dd) > 0)) {
G_debug(DLEVEL, " no intersection");
return 0;
}
}
else { /* if sgn_d < 0 */
if ((sgn_da > 0) || (mpf_cmp(dda, dd) < 0)) {
G_debug(DLEVEL, " no intersection");
return 0;
}
if ((sgn_db > 0) || (mpf_cmp(ddb, dd) < 0)) {
G_debug(DLEVEL, " no intersection");
return 0;
}
}
mpf_set_d(delta, ax2 - ax1);
mpf_mul(t1, dda, delta);
mpf_div(t2, t1, dd);
*x1 = ax1 + mpf_get_d(t2);
mpf_set_d(delta, ay2 - ay1);
mpf_mul(t1, dda, delta);
mpf_div(t2, t1, dd);
*y1 = ay1 + mpf_get_d(t2);
G_debug(2, " intersection at:");
G_debug(2, " xx = %.18e", *x1);
G_debug(2, " x = %.18e", ax1 + ra * (ax2 - ax1));
G_debug(2, " yy = %.18e", *y1);
G_debug(2, " y = %.18e", ay1 + ra * (ay2 - ay1));
return 1;
}
G_debug(3, " parallel/collinear...");
return -1;
}
/* multi-precision version */
int segment_intersection_2d_e(double ax1, double ay1, double ax2, double ay2,
double bx1, double by1, double bx2, double by2,
double *x1, double *y1, double *x2, double *y2)
{
double t;
double max_ax, min_ax, max_ay, min_ay;
double max_bx, min_bx, max_by, min_by;
int sgn_d, sgn_da, sgn_db;
int vertical;
int f11, f12, f21, f22;
mp_exp_t exp;
char *s;
if (!initialized)
initialize_mpf_vars();
/* TODO: Works for points ? */
G_debug(3, "segment_intersection_2d_e()");
G_debug(4, " ax1 = %.18f, ay1 = %.18f", ax1, ay1);
G_debug(4, " ax2 = %.18f, ay2 = %.18f", ax2, ay2);
G_debug(4, " bx1 = %.18f, by1 = %.18f", bx1, by1);
G_debug(4, " bx2 = %.18f, by2 = %.18f", bx2, by2);
f11 = ((ax1 == bx1) && (ay1 == by1));
f12 = ((ax1 == bx2) && (ay1 == by2));
f21 = ((ax2 == bx1) && (ay2 == by1));
f22 = ((ax2 == bx2) && (ay2 == by2));
/* Check for identical segments */
if ((f11 && f22) || (f12 && f21)) {
G_debug(3, " identical segments");
*x1 = ax1;
*y1 = ay1;
*x2 = ax2;
*y2 = ay2;
return 5;
}
/* Check for identical endpoints */
if (f11 || f12) {
G_debug(3, " connected by endpoints");
*x1 = ax1;
*y1 = ay1;
return 1;
}
if (f21 || f22) {
G_debug(3, " connected by endpoints");
*x1 = ax2;
*y1 = ay2;
return 1;
}
if ((MAX(ax1, ax2) < MIN(bx1, bx2)) || (MAX(bx1, bx2) < MIN(ax1, ax2))) {
G_debug(3, " no intersection (disjoint bounding boxes)");
return 0;
}
if ((MAX(ay1, ay2) < MIN(by1, by2)) || (MAX(by1, by2) < MIN(ay1, ay2))) {
G_debug(3, " no intersection (disjoint bounding boxes)");
return 0;
}
det22(dd, ax2, ax1, bx1, bx2, ay2, ay1, by1, by2);
sgn_d = mpf_sgn(dd);
if (sgn_d != 0) {
G_debug(3, " general position");
det22(dda, bx1, ax1, bx1, bx2, by1, ay1, by1, by2);
sgn_da = mpf_sgn(dda);
/*mpf_div(rra, dda, dd);
mpf_div(rrb, ddb, dd);
s = mpf_get_str(NULL, &exp, 10, 40, rra);
G_debug(4, " ra = %sE%d", (s[0]==0)?"0":s, exp);
s = mpf_get_str(NULL, &exp, 10, 24, rrb);
G_debug(4, " rb = %sE%d", (s[0]==0)?"0":s, exp);
*/
if (sgn_d > 0) {
if ((sgn_da < 0) || (mpf_cmp(dda, dd) > 0)) {
G_debug(3, " no intersection");
return 0;
}
det22(ddb, ax2, ax1, bx1, ax1, ay2, ay1, by1, ay1);
sgn_db = mpf_sgn(ddb);
if ((sgn_db < 0) || (mpf_cmp(ddb, dd) > 0)) {
G_debug(3, " no intersection");
return 0;
}
}
else { /* if sgn_d < 0 */
if ((sgn_da > 0) || (mpf_cmp(dda, dd) < 0)) {
G_debug(3, " no intersection");
return 0;
}
det22(ddb, ax2, ax1, bx1, ax1, ay2, ay1, by1, ay1);
sgn_db = mpf_sgn(ddb);
if ((sgn_db > 0) || (mpf_cmp(ddb, dd) < 0)) {
G_debug(3, " no intersection");
return 0;
}
}
/*G_debug(3, " ra=%.17g rb=%.17g", mpf_get_d(dda)/mpf_get_d(dd), mpf_get_d(ddb)/mpf_get_d(dd)); */
/*G_debug(3, " sgn_d=%d sgn_da=%d sgn_db=%d cmp(dda,dd)=%d cmp(ddb,dd)=%d", sgn_d, sgn_da, sgn_db, mpf_cmp(dda, dd), mpf_cmp(ddb, dd)); */
mpf_set_d(delta, ax2 - ax1);
mpf_mul(t1, dda, delta);
mpf_div(t2, t1, dd);
*x1 = ax1 + mpf_get_d(t2);
mpf_set_d(delta, ay2 - ay1);
mpf_mul(t1, dda, delta);
mpf_div(t2, t1, dd);
*y1 = ay1 + mpf_get_d(t2);
G_debug(3, " intersection %.16g, %.16g", *x1, *y1);
return 1;
}
/* segments are parallel or collinear */
det22(dda, bx1, ax1, bx1, bx2, by1, ay1, by1, by2);
sgn_da = mpf_sgn(dda);
if (sgn_da != 0) {
/* segments are parallel */
G_debug(3, " parallel segments");
return 0;
}
/* segments are colinear. check for overlap */
/* swap endpoints if needed */
/* if segments are vertical, we swap x-coords with y-coords */
vertical = 0;
if (ax1 > ax2) {
SWAP(ax1, ax2);
SWAP(ay1, ay2);
}
else if (ax1 == ax2) {
vertical = 1;
if (ay1 > ay2)
SWAP(ay1, ay2);
SWAP(ax1, ay1);
SWAP(ax2, ay2);
}
if (bx1 > bx2) {
SWAP(bx1, bx2);
SWAP(by1, by2);
}
else if (bx1 == bx2) {
if (by1 > by2)
SWAP(by1, by2);
SWAP(bx1, by1);
SWAP(bx2, by2);
}
G_debug(3, " collinear segments");
if ((bx2 < ax1) || (bx1 > ax2)) {
G_debug(3, " no intersection");
return 0;
}
/* there is overlap or connected end points */
G_debug(3, " overlap");
/* a contains b */
if ((ax1 < bx1) && (ax2 > bx2)) {
G_debug(3, " a contains b");
if (!vertical) {
*x1 = bx1;
*y1 = by1;
*x2 = bx2;
*y2 = by2;
}
else {
*x1 = by1;
*y1 = bx1;
*x2 = by2;
*y2 = bx2;
}
return 3;
}
/* b contains a */
if ((ax1 > bx1) && (ax2 < bx2)) {
G_debug(3, " b contains a");
if (!vertical) {
*x1 = bx1;
*y1 = by1;
*x2 = bx2;
*y2 = by2;
}
else {
*x1 = by1;
*y1 = bx1;
*x2 = by2;
*y2 = bx2;
}
return 4;
}
/* general overlap, 2 intersection points */
G_debug(3, " partial overlap");
if ((bx1 > ax1) && (bx1 < ax2)) { /* b1 is in a */
if (!vertical) {
*x1 = bx1;
*y1 = by1;
*x2 = ax2;
*y2 = ay2;
}
else {
*x1 = by1;
*y1 = bx1;
*x2 = ay2;
*y2 = ax2;
}
return 2;
}
if ((bx2 > ax1) && (bx2 < ax2)) { /* b2 is in a */
if (!vertical) {
*x1 = bx2;
*y1 = by2;
*x2 = ax1;
*y2 = ay1;
}
else {
*x1 = by2;
*y1 = bx2;
*x2 = ay1;
*y2 = ax1;
}
return 2;
}
/* should not be reached */
G_warning(("segment_intersection_2d() ERROR (should not be reached)"));
G_warning("%.16g %.16g", ax1, ay1);
G_warning("%.16g %.16g", ax2, ay2);
G_warning("x");
G_warning("%.16g %.16g", bx1, by1);
G_warning("%.16g %.16g", bx2, by2);
return 0;
}
extern int _jl_mpf_cmp(mpf_t* op1, mpf_t* op2) {
return mpf_cmp(*op1, *op2);
}
enum sg_big_float_cmp_result sg_big_float_cmp(sg_big_float_t *a, sg_big_float_t *b)
{
int ret = mpf_cmp(a->mpf, b->mpf);
return ret > 0 ? SGBIGFLOATCMP_A_BIGGER : ret == 0 ? SGBIGFLOATCMP_EQUALS : SGBIGFLOATCMP_B_BIGGER;
}
int main(int argc, char *argv[])
{
//mpi stuff
int my_rank, p;
MPI_Init(&argc, &argv);
MPI_Comm_rank(MPI_COMM_WORLD, &my_rank);
MPI_Comm_size(MPI_COMM_WORLD, &p);
//julia stuff
long int width, height, maxiter;
int flag;
// double x, xr, y, yr, c[2];
char *image, *image_ext;
long prec = 160;
mpf_t xr_i, xr_f, yr_i, yr_f, x_center, y_center, zoom, c[2];
mpf_set_default_prec (prec);
mpf_init (xr_i);
mpf_init (xr_f);
mpf_init (yr_i);
mpf_init (yr_f);
mpf_init (x_center);
mpf_init (y_center);
mpf_init (zoom);
mpf_init (c[0]);
mpf_init (c[1]);
getParams(argv, &flag, c, &x_center, &y_center, &xr_i, &yr_i, &xr_f, &yr_f, &width, &height, &maxiter, &zoom, &image, &image_ext);
int i = 0;
while (1){
// Process 0 is responsible for saving the image
if(my_rank == 0){
float *iterations = (float*)malloc( sizeof(float) * width * height );
assert(iterations);
printf ("Processing image %i\n", i);
/* compute set */
julia(x_center, xr_i, width, y_center, yr_i, height, c, flag, maxiter, iterations, my_rank, p, MPI_COMM_WORLD);
/* save our picture for the viewer */
char currentImage [50];
sprintf (currentImage, "%s%d%s", image, i, image_ext);
printf ("currentImage: %s\n", currentImage);
gmp_printf ("fixed point mpf %.*Ff with %d digits\n", prec, xr_i, prec);
gmp_printf ("fixed point mpf %.*Ff with %d digits\n", prec, yr_i, prec);
saveBMP(currentImage, iterations, width, height);
printf ("Finished image %i\n", i);
//printf("saving image took: %lf seconds\n", MPI_Wtime() - t0);
//printf("max iterations hit: %ld /%ld\n", maxCount, maxiter);
free(iterations);
}
else{
julia(x_center, xr_i, width, y_center, yr_i, height, c, flag, maxiter, NULL, my_rank, p, MPI_COMM_WORLD);
}
mpf_div(xr_i, xr_i, zoom);
mpf_div(yr_i, yr_i, zoom);
i++;
//check if xr_i < xr_f OR yr_i < yr_f
if (mpf_cmp(xr_i, xr_f)<=0 || mpf_cmp(yr_i, yr_f)<=0){
break;
}
// Only process image 0 to i-1
/*
if (i > 7){
break;
}
*/
}
MPI_Finalize();
return 0;
}
int
cl1mp (int k, int l, int m, int n,
int nklmd, int n2d,
LDBLE * q_arg,
int *kode_arg, LDBLE toler_arg,
int *iter, LDBLE * x_arg, LDBLE * res_arg, LDBLE * error_arg,
LDBLE * cu_arg, int *iu, int *s, int check, LDBLE censor_arg)
{
/* System generated locals */
union double_or_int
{
int ival;
mpf_t dval;
} *q2;
/* Local variables */
static int nklm;
static int iout, i, j;
static int maxit, n1, n2;
static int ia, ii, kk, in, nk, js;
static int iphase, kforce;
static int klm, jmn, nkl, jpn;
static int klm1;
static int *kode;
int q_dim, cu_dim;
int iswitch;
mpf_t *q;
mpf_t *x;
mpf_t *res;
mpf_t error;
mpf_t *cu;
mpf_t dummy, dummy1, sum, z, zu, zv, xmax, minus_one, toler, check_toler;
/*mpf_t *scratch; */
mpf_t pivot, xmin, cuv, tpivot, sn;
mpf_t zero;
int censor;
mpf_t censor_tol;
/* THIS SUBROUTINE USES A MODIFICATION OF THE SIMPLEX */
/* METHOD OF LINEAR PROGRAMMING TO CALCULATE AN L1 SOLUTION */
/* TO A K BY N SYSTEM OF LINEAR EQUATIONS */
/* AX=B */
/* SUBJECT TO L LINEAR EQUALITY CONSTRAINTS */
/* CX=D */
/* AND M LINEAR INEQUALITY CONSTRAINTS */
/* EX.LE.F. */
/* DESCRIPTION OF PARAMETERS */
/* K NUMBER OF ROWS OF THE MATRIX A (K.GE.1). */
/* L NUMBER OF ROWS OF THE MATRIX C (L.GE.0). */
/* M NUMBER OF ROWS OF THE MATRIX E (M.GE.0). */
/* N NUMBER OF COLUMNS OF THE MATRICES A,C,E (N.GE.1). */
/* KLMD SET TO AT LEAST K+L+M FOR ADJUSTABLE DIMENSIONS. */
/* KLM2D SET TO AT LEAST K+L+M+2 FOR ADJUSTABLE DIMENSIONS. */
/* NKLMD SET TO AT LEAST N+K+L+M FOR ADJUSTABLE DIMENSIONS. */
/* N2D SET TO AT LEAST N+2 FOR ADJUSTABLE DIMENSIONS */
/* Q TWO DIMENSIONAL REAL ARRAY WITH KLM2D ROWS AND */
/* AT LEAST N2D COLUMNS. */
/* ON ENTRY THE MATRICES A,C AND E, AND THE VECTORS */
/* B,D AND F MUST BE STORED IN THE FIRST K+L+M ROWS */
/* AND N+1 COLUMNS OF Q AS FOLLOWS */
/* A B */
/* Q = C D */
/* E F */
/* THESE VALUES ARE DESTROYED BY THE SUBROUTINE. */
/* KODE A CODE USED ON ENTRY TO, AND EXIT */
/* FROM, THE SUBROUTINE. */
/* ON ENTRY, THIS SHOULD NORMALLY BE SET TO 0. */
/* HOWEVER, IF CERTAIN NONNEGATIVITY CONSTRAINTS */
/* ARE TO BE INCLUDED IMPLICITLY, RATHER THAN */
/* EXPLICITLY IN THE CONSTRAINTS EX.LE.F, THEN KODE */
/* SHOULD BE SET TO 1, AND THE NONNEGATIVITY */
/* CONSTRAINTS INCLUDED IN THE ARRAYS X AND */
/* RES (SEE BELOW). */
/* ON EXIT, KODE HAS ONE OF THE */
/* FOLLOWING VALUES */
/* 0- OPTIMAL SOLUTION FOUND, */
/* 1- NO FEASIBLE SOLUTION TO THE */
/* CONSTRAINTS, */
/* 2- CALCULATIONS TERMINATED */
/* PREMATURELY DUE TO ROUNDING ERRORS, */
/* 3- MAXIMUM NUMBER OF ITERATIONS REACHED. */
/* TOLER A SMALL POSITIVE TOLERANCE. EMPIRICAL */
/* EVIDENCE SUGGESTS TOLER = 10**(-D*2/3), */
/* WHERE D REPRESENTS THE NUMBER OF DECIMAL */
/* DIGITS OF ACCURACY AVAILABLE. ESSENTIALLY, */
/* THE SUBROUTINE CANNOT DISTINGUISH BETWEEN ZERO */
/* AND ANY QUANTITY WHOSE MAGNITUDE DOES NOT EXCEED */
/* TOLER. IN PARTICULAR, IT WILL NOT PIVOT ON ANY */
/* NUMBER WHOSE MAGNITUDE DOES NOT EXCEED TOLER. */
/* ITER ON ENTRY ITER MUST CONTAIN AN UPPER BOUND ON */
/* THE MAXIMUM NUMBER OF ITERATIONS ALLOWED. */
/* A SUGGESTED VALUE IS 10*(K+L+M). ON EXIT ITER */
/* GIVES THE NUMBER OF SIMPLEX ITERATIONS. */
/* X ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST N2D. */
/* ON EXIT THIS ARRAY CONTAINS A */
/* SOLUTION TO THE L1 PROBLEM. IF KODE=1 */
/* ON ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE */
/* SIMPLE NONNEGATIVITY CONSTRAINTS ON THE */
/* VARIABLES. THE VALUES -1, 0, OR 1 */
/* FOR X(J) INDICATE THAT THE J-TH VARIABLE */
/* IS RESTRICTED TO BE .LE.0, UNRESTRICTED, */
/* OR .GE.0 RESPECTIVELY. */
/* RES ONE DIMENSIONAL REAL ARRAY OF SIZE AT LEAST KLMD. */
/* ON EXIT THIS CONTAINS THE RESIDUALS B-AX */
/* IN THE FIRST K COMPONENTS, D-CX IN THE */
/* NEXT L COMPONENTS (THESE WILL BE =0),AND */
/* F-EX IN THE NEXT M COMPONENTS. IF KODE=1 ON */
/* ENTRY, THIS ARRAY IS ALSO USED TO INCLUDE SIMPLE */
/* NONNEGATIVITY CONSTRAINTS ON THE RESIDUALS */
/* B-AX. THE VALUES -1, 0, OR 1 FOR RES(I) */
/* INDICATE THAT THE I-TH RESIDUAL (1.LE.I.LE.K) IS */
/* RESTRICTED TO BE .LE.0, UNRESTRICTED, OR .GE.0 */
/* RESPECTIVELY. */
/* ERROR ON EXIT, THIS GIVES THE MINIMUM SUM OF */
/* ABSOLUTE VALUES OF THE RESIDUALS. */
/* CU A TWO DIMENSIONAL REAL ARRAY WITH TWO ROWS AND */
/* AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. */
/* IU A TWO DIMENSIONAL INTEGER ARRAY WITH TWO ROWS AND */
/* AT LEAST NKLMD COLUMNS USED FOR WORKSPACE. */
/* S INTEGER ARRAY OF SIZE AT LEAST KLMD, USED FOR */
/* WORKSPACE. */
/* DOUBLE PRECISION DBLE */
/* REAL */
/* INITIALIZATION. */
if (svnid == NULL)
fprintf (stderr, " ");
/*
* mp variables
*/
censor = 1;
if (censor_arg == 0.0)
censor = 0;
mpf_set_default_prec (96);
mpf_init (zero);
mpf_init (dummy);
mpf_init (dummy1);
mpf_init_set_d (censor_tol, censor_arg);
q =
(mpf_t *)
PHRQ_malloc ((size_t)
(max_row_count * max_column_count * sizeof (mpf_t)));
if (q == NULL)
malloc_error ();
for (i = 0; i < max_row_count * max_column_count; i++)
{
mpf_init_set_d (q[i], q_arg[i]);
if (censor == 1)
{
if (mpf_cmp (q[i], zero) != 0)
{
mpf_abs (dummy1, q[i]);
if (mpf_cmp (dummy1, censor_tol) <= 0)
{
mpf_set_si (q[i], 0);
}
}
}
}
x = (mpf_t *) PHRQ_malloc ((size_t) (n2d * sizeof (mpf_t)));
if (x == NULL)
malloc_error ();
for (i = 0; i < n2d; i++)
{
mpf_init_set_d (x[i], x_arg[i]);
}
res = (mpf_t *) PHRQ_malloc ((size_t) ((k + l + m) * sizeof (mpf_t)));
if (res == NULL)
malloc_error ();
for (i = 0; i < k + l + m; i++)
{
mpf_init_set_d (res[i], res_arg[i]);
}
cu = (mpf_t *) PHRQ_malloc ((size_t) (2 * nklmd * sizeof (mpf_t)));
if (cu == NULL)
malloc_error ();
for (i = 0; i < 2 * nklmd; i++)
{
mpf_init_set_d (cu[i], cu_arg[i]);
}
kode = (int *) PHRQ_malloc (sizeof (int));
if (kode == NULL)
malloc_error ();
*kode = *kode_arg;
mpf_init (sum);
mpf_init (error);
mpf_init (z);
mpf_init (zu);
mpf_init (zv);
mpf_init (xmax);
mpf_init_set_si (minus_one, -1);
mpf_init_set_d (toler, toler_arg);
mpf_init_set_d (check_toler, toler_arg);
mpf_init (pivot);
mpf_init (xmin);
mpf_init (cuv);
mpf_init (tpivot);
mpf_init (sn);
/* Parameter adjustments */
q_dim = n2d;
q2 = (union double_or_int *) q;
cu_dim = nklmd;
/* Function Body */
maxit = *iter;
n1 = n + 1;
n2 = n + 2;
nk = n + k;
nkl = nk + l;
klm = k + l + m;
klm1 = klm + 1;
nklm = n + klm;
kforce = 1;
*iter = 0;
js = 0;
ia = -1;
/* Make scratch space */
/*
scratch = (LDBLE *) PHRQ_malloc( (size_t) nklmd * sizeof(LDBLE));
if (scratch == NULL) malloc_error();
for (i=0; i < nklmd; i++) {
scratch[i] = 0.0;
}
*/
/*
scratch = (mpf_t *) PHRQ_malloc( (size_t) nklmd * sizeof(mpf_t));
if (scratch == NULL) malloc_error();
for (i=0; i < nklmd; i++) {
mpf_init(scratch[i]);
}
*/
/* SET UP LABELS IN Q. */
for (j = 0; j < n; ++j)
{
q2[klm1 * q_dim + j].ival = j + 1;
}
/* L10: */
for (i = 0; i < klm; ++i)
{
q2[i * q_dim + n1].ival = n + i + 1;
if (mpf_cmp_d (q2[i * q_dim + n].dval, 0.0) < 0)
{
for (j = 0; j < n1; ++j)
{
/* q2[ i * q_dim + j ].dval = -q2[ i * q_dim + j ].dval; */
mpf_neg (q2[i * q_dim + j].dval, q2[i * q_dim + j].dval);
}
q2[i * q_dim + n1].ival = -q2[i * q_dim + n1].ival;
/* L20: */
}
}
/* L30: */
/* SET UP PHASE 1 COSTS. */
iphase = 2;
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "Set up phase 1 costs\n");
#endif
/* Zero first row of cu and iu */
/*memcpy( (void *) &(cu[0]), (void *) &(scratch[0]), (size_t) nklm * sizeof(mpf_t) ); */
for (j = 0; j < nklm; ++j)
{
mpf_set_si (cu[j], 0);
iu[j] = 0;
}
/* L40: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L40\n");
#endif
if (l != 0)
{
for (j = nk; j < nkl; ++j)
{
mpf_set_si (cu[j], 1);
/*cu[ j ] = 1.; */
iu[j] = 1;
}
/* L50: */
iphase = 1;
}
/* Copy first row of cu and iu to second row */
/*memcpy( (void *) &(cu[cu_dim]), (void *) &(cu[0]), (size_t) nklm * sizeof(mpf_t) ); */
for (i = 0; i < nklm; i++)
{
mpf_set (cu[cu_dim + i], cu[i]);
}
memcpy ((void *) &(iu[cu_dim]), (void *) &(iu[0]),
(size_t) nklm * sizeof (int));
/* L60: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L60\n");
#endif
if (m != 0)
{
for (j = nkl; j < nklm; ++j)
{
/* cu[ cu_dim + j ] = 1.; */
mpf_set_si (cu[cu_dim + j], 1);
iu[cu_dim + j] = 1;
jmn = j - n;
if (q2[jmn * q_dim + n1].ival < 0)
{
iphase = 1;
}
}
/* L70: */
}
/* L80: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L80\n");
#endif
if (*kode != 0)
{
for (j = 0; j < n; ++j)
{
/* if ( x[j] < 0.) { */
if (mpf_cmp_si (x[j], 0) < 0)
{
/* L90: */
/* cu[ j ] = 1.; */
mpf_set_si (cu[j], 1);
iu[j] = 1;
/* } else if (x[j] > 0.) { */
}
else if (mpf_cmp_si (x[j], 0) > 0)
{
/* cu[ cu_dim + j ] = 1.; */
mpf_set_si (cu[cu_dim + j], 1);
iu[cu_dim + j] = 1;
}
}
/* L110: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L110\n");
#endif
for (j = 0; j < k; ++j)
{
jpn = j + n;
/* if (res[j] < 0.) { */
if (mpf_cmp_si (res[j], 0) < 0)
{
/* L120: */
/* cu[ jpn ] = 1.; */
mpf_set_si (cu[jpn], 1);
iu[jpn] = 1;
if (q2[j * q_dim + n1].ival > 0)
{
iphase = 1;
}
/* } else if (res[j] > 0.) { */
}
else if (mpf_cmp_si (res[j], 0) > 0)
{
/* L130: */
/* cu[ cu_dim + jpn ] = 1.; */
mpf_set_si (cu[cu_dim + jpn], 1);
iu[cu_dim + jpn] = 1;
if (q2[j * q_dim + n1].ival < 0)
{
iphase = 1;
}
}
}
/* L140: */
}
/* L150: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L150\n");
#endif
if (iphase == 2)
{
goto L500;
}
/* COMPUTE THE MARGINAL COSTS. */
L160:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L160\n");
#endif
for (j = js; j < n1; ++j)
{
mpf_set_si (sum, 0);
for (i = 0; i < klm; ++i)
{
ii = q2[i * q_dim + n1].ival;
if (ii < 0)
{
/* z = cu[ cu_dim - ii - 1 ]; */
mpf_set (z, cu[cu_dim - ii - 1]);
}
else
{
/*z = cu[ ii - 1 ]; */
mpf_set (z, cu[ii - 1]);
}
/*sum += q2[ i * q_dim + j ].dval * z; */
mpf_mul (dummy, q2[i * q_dim + j].dval, z);
mpf_add (sum, sum, dummy);
}
/*q2[ klm * q_dim + j ].dval = sum; */
mpf_set (q2[klm * q_dim + j].dval, sum);
}
for (j = js; j < n; ++j)
{
ii = q2[klm1 * q_dim + j].ival;
if (ii < 0)
{
/*z = cu[ cu_dim - ii - 1 ]; */
mpf_set (z, cu[cu_dim - ii - 1]);
}
else
{
/*z = cu[ ii - 1 ]; */
mpf_set (z, cu[ii - 1]);
}
/*q2[ klm * q_dim + j ].dval -= z; */
mpf_sub (q2[klm * q_dim + j].dval, q2[klm * q_dim + j].dval, z);
}
/* DETERMINE THE VECTOR TO ENTER THE BASIS. */
L240:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L240, xmax %e\n", mpf_get_d (xmax));
#endif
/*xmax = 0.; */
mpf_set_si (xmax, 0);
if (js >= n)
{
goto L490; /* test for optimality */
}
for (j = js; j < n; ++j)
{
/*zu = q2[ klm * q_dim + j ].dval; */
mpf_set (zu, q2[klm * q_dim + j].dval);
ii = q2[klm1 * q_dim + j].ival;
if (ii > 0)
{
/*zv = -zu - cu[ ii - 1 ] - cu[ cu_dim + ii - 1 ]; */
mpf_mul (dummy, cu[cu_dim + ii - 1], minus_one);
mpf_sub (dummy, dummy, cu[ii - 1]);
mpf_sub (zv, dummy, zu);
}
else
{
ii = -ii;
/* zv = zu; */
mpf_set (zv, zu);
/* zu = -zu - cu[ ii - 1 ] - cu[ cu_dim + ii - 1 ]; */
mpf_mul (dummy, cu[cu_dim + ii - 1], minus_one);
mpf_sub (dummy, dummy, cu[ii - 1]);
mpf_sub (zu, dummy, zu);
}
/* L260 */
if (kforce == 1 && ii > n)
{
continue;
}
/*if (iu[ ii - 1 ] != 1 && zu > xmax){ */
if ((iu[ii - 1] != 1) && (mpf_cmp (zu, xmax) > 0))
{
/*xmax = zu; */
mpf_set (xmax, zu);
in = j;
}
/* L270 */
/*if (iu[ cu_dim + ii - 1 ] != 1 && zv > xmax ) { */
if ((iu[cu_dim + ii - 1] != 1) && (mpf_cmp (zv, xmax) > 0))
{
/*xmax = zv; */
mpf_set (xmax, zv);
in = j;
}
}
/* L280 */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L280 xmax %e, toler %e\n", mpf_get_d (xmax),
mpf_get_d (toler));
#endif
/*if (xmax <= toler) { */
if (mpf_cmp (xmax, toler) <= 0)
{
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "xmax before optimality test %e\n",
mpf_get_d (xmax));
#endif
goto L490; /* test for optimality */
}
/*if (q2[ klm * q_dim + in ].dval != xmax) { */
if (mpf_cmp (q2[klm * q_dim + in].dval, xmax) != 0)
{
for (i = 0; i < klm1; ++i)
{
/*q2[ i * q_dim + in ].dval = -q2[ i * q_dim + in ].dval; */
mpf_neg (q2[i * q_dim + in].dval, q2[i * q_dim + in].dval);
}
q2[klm1 * q_dim + in].ival = -q2[klm1 * q_dim + in].ival;
/* L290: */
/*q2[ klm * q_dim + in ].dval = xmax; */
mpf_set (q2[klm * q_dim + in].dval, xmax);
}
/* DETERMINE THE VECTOR TO LEAVE THE BASIS. */
if (iphase != 1 && ia != -1)
{
/*xmax = 0.; */
mpf_set_si (xmax, 0);
/* find maximum absolute value in column "in" */
for (i = 0; i <= ia; ++i)
{
/*z = fabs(q2[ i * q_dim + in ].dval); */
mpf_abs (z, q2[i * q_dim + in].dval);
/*if (z > xmax) { */
if (mpf_cmp (z, xmax) > 0)
{
/*xmax = z; */
mpf_set (xmax, z);
iout = i;
}
}
/* L310: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L310, xmax %e\n", mpf_get_d (xmax));
#endif
/* switch row ia with row iout, use memcpy */
/*if (xmax > toler) { */
if (mpf_cmp (xmax, toler) > 0)
{
/*
memcpy( (void *) &(scratch[0]), (void *) &(q2[ ia * q_dim]),
(size_t) n2 * sizeof(mpf_t) );
memcpy( (void *) &(q2[ ia * q_dim ]), (void *) &(q2[ iout * q_dim]),
(size_t) n2 * sizeof(mpf_t) );
memcpy( (void *) &(q2[ iout * q_dim ]), (void *) &(scratch[ 0 ]),
(size_t) n2 * sizeof(mpf_t) );
*/
for (i = 0; i < n1; i++)
{
mpf_set (dummy, q2[ia * q_dim + i].dval);
mpf_set (q2[ia * q_dim + i].dval, q2[iout * q_dim + i].dval);
mpf_set (q2[iout * q_dim + i].dval, dummy);
}
j = q2[ia * q_dim + n1].ival;
q2[ia * q_dim + n1].ival = q2[iout * q_dim + n1].ival;
q2[iout * q_dim + n1].ival = j;
/* L320: */
/* set pivot to row ia, column in */
iout = ia;
--ia;
/*pivot = q2[ iout * q_dim + in ].dval; */
mpf_set (pivot, q2[iout * q_dim + in].dval);
goto L420; /* Gauss Jordan */
}
}
/* L330: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L330, xmax %e\n", mpf_get_d (xmax));
#endif
kk = -1;
/* divide column n1 by positive value in column "in" greater than toler */
for (i = 0; i < klm; ++i)
{
/*z = q2[ i * q_dim + in ].dval; */
mpf_set (z, q2[i * q_dim + in].dval);
/*if (z > toler) { */
if (mpf_cmp (z, toler) > 0)
{
++kk;
/*res[kk] = q2[ i * q_dim + n ].dval / z; */
mpf_div (res[kk], q2[i * q_dim + n].dval, z);
s[kk] = i;
}
}
/* L340: */
if (kk < 0)
{
output_msg (OUTPUT_MESSAGE, "kode = 2 in loop 340.\n");
}
L350:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L350, xmax %e\n", mpf_get_d (xmax));
#endif
if (kk < 0)
{
/* no positive value found in L340 or bypass intermediate verticies */
*kode = 2;
goto L590;
}
/* L360: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L360, xmax %e\n", mpf_get_d (xmax));
#endif
/* find minimum residual */
/*xmin = res[ 0 ]; */
mpf_set (xmin, res[0]);
iout = s[0];
j = 0;
if (kk != 0)
{
for (i = 1; i <= kk; ++i)
{
/*if (res[i] < xmin) { */
if (mpf_cmp (res[i], xmin) < 0)
{
j = i;
/*xmin = res[i]; */
mpf_set (xmin, res[i]);
iout = s[i];
}
}
/* L370: */
/* put kk in position j */
/*res[j] = res[kk]; */
mpf_set (res[j], res[kk]);
s[j] = s[kk];
}
/* L380: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L380 iout %d, xmin %e, xmax %e\n", iout,
mpf_get_d (xmin), mpf_get_d (xmax));
#endif
--kk;
/*pivot = q2[ iout * q_dim + in ].dval; */
mpf_set (pivot, q2[iout * q_dim + in].dval);
ii = q2[iout * q_dim + n1].ival;
if (iphase != 1)
{
if (ii < 0)
{
/* L390: */
if (iu[-ii - 1] == 1)
{
goto L420;
}
}
else
{
if (iu[cu_dim + ii - 1] == 1)
{
goto L420;
}
}
}
/* L400: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L400\n");
#endif
ii = abs (ii);
/*cuv = cu[ ii - 1 ] + cu[ cu_dim + ii - 1]; */
mpf_add (cuv, cu[ii - 1], cu[cu_dim + ii - 1]);
/*if (q2[ klm * q_dim + in ].dval - pivot * cuv > toler) { */
mpf_mul (dummy, pivot, cuv);
mpf_sub (dummy, q2[klm * q_dim + in].dval, dummy);
if (mpf_cmp (dummy, toler) > 0)
{
/* BYPASS INTERMEDIATE VERTICES. */
for (j = js; j < n1; ++j)
{
/*z = q2[ iout * q_dim + j ].dval; */
mpf_set (z, q2[iout * q_dim + j].dval);
/*q2[ klm * q_dim + j ].dval -= z * cuv; */
mpf_mul (dummy1, z, cuv);
mpf_sub (q2[klm * q_dim + j].dval, q2[klm * q_dim + j].dval, dummy1);
if (censor == 1)
{
if (mpf_cmp (q2[klm * q_dim + j].dval, zero) != 0)
{
mpf_abs (dummy1, q2[klm * q_dim + j].dval);
if (mpf_cmp (dummy1, censor_tol) <= 0)
{
mpf_set_si (q2[klm * q_dim + j].dval, 0);
}
}
}
/*q2[ iout * q_dim + j ].dval = -z; */
mpf_neg (q2[iout * q_dim + j].dval, z);
}
/* L410: */
q2[iout * q_dim + n1].ival = -q2[iout * q_dim + n1].ival;
goto L350;
}
/* GAUSS-JORDAN ELIMINATION. */
L420:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "Gauss Jordon %d\n", *iter);
#endif
if (*iter >= maxit)
{
*kode = 3;
goto L590;
}
/* L430: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L430\n");
#endif
++(*iter);
for (j = js; j < n1; ++j)
{
if (j != in)
{
/*q2[ iout * q_dim + j ].dval /= pivot; */
mpf_div (q2[iout * q_dim + j].dval, q2[iout * q_dim + j].dval, pivot);
}
}
/* L440: */
for (j = js; j < n1; ++j)
{
if (j != in)
{
/*z = -q2[ iout * q_dim + j ].dval; */
mpf_neg (z, q2[iout * q_dim + j].dval);
for (i = 0; i < klm1; ++i)
{
if (i != iout)
{
/*q2[ i * q_dim + j ].dval += z * q2[ i * q_dim + in ].dval; */
mpf_mul (dummy, z, q2[i * q_dim + in].dval);
mpf_add (q2[i * q_dim + j].dval, q2[i * q_dim + j].dval, dummy);
if (censor == 1)
{
if (mpf_cmp (q2[i * q_dim + j].dval, zero) != 0)
{
mpf_abs (dummy1, q2[i * q_dim + j].dval);
if (mpf_cmp (dummy1, censor_tol) <= 0)
{
mpf_set_si (q2[i * q_dim + j].dval, 0);
}
}
}
}
}
/* L450: */
}
}
/* L460: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L460\n");
#endif
/*tpivot = -pivot; */
mpf_neg (tpivot, pivot);
for (i = 0; i < klm1; ++i)
{
if (i != iout)
{
/*q2[ i * q_dim + in ].dval /= tpivot; */
mpf_div (q2[i * q_dim + in].dval, q2[i * q_dim + in].dval, tpivot);
}
}
/* L470: */
/*q2[ iout * q_dim + in ].dval = 1. / pivot; */
mpf_set_si (dummy, 1);
mpf_div (q2[iout * q_dim + in].dval, dummy, pivot);
ii = q2[iout * q_dim + n1].ival;
q2[iout * q_dim + n1].ival = q2[klm1 * q_dim + in].ival;
q2[klm1 * q_dim + in].ival = ii;
ii = abs (ii);
if (iu[ii - 1] == 0 || iu[cu_dim + ii - 1] == 0)
{
goto L240;
}
/* switch column */
for (i = 0; i < klm1; ++i)
{
/*z = q2[ i * q_dim + in ].dval; */
mpf_set (z, q2[i * q_dim + in].dval);
/*q2[ i * q_dim + in ].dval = q2[ i * q_dim + js ].dval; */
mpf_set (q2[i * q_dim + in].dval, q2[i * q_dim + js].dval);
/*q2[ i * q_dim + js ].dval = z; */
mpf_set (q2[i * q_dim + js].dval, z);
}
i = q2[klm1 * q_dim + in].ival;
q2[klm1 * q_dim + in].ival = q2[klm1 * q_dim + js].ival;
q2[klm1 * q_dim + js].ival = i;
/* L480: */
++js;
goto L240;
/* TEST FOR OPTIMALITY. */
L490:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L490\n");
#endif
if (kforce == 0)
{
if (iphase == 1)
{
/*if (q2[ klm * q_dim + n ].dval <= toler) { */
if (mpf_cmp (q2[klm * q_dim + n].dval, toler) <= 0)
{
goto L500;
}
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "q2[klm1-1, n1-1] > *toler. %e\n",
mpf_get_d (q2[(klm1 - 1) * q_dim + n1 - 1].dval));
#endif
*kode = 1;
goto L590;
}
*kode = 0;
goto L590;
}
/*if (iphase != 1 || q2[ klm * q_dim + n ].dval > toler) { */
if ((iphase != 1) || (mpf_cmp (q2[klm * q_dim + n].dval, toler) > 0))
{
kforce = 0;
goto L240;
}
/* SET UP PHASE 2 COSTS. */
L500:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "Set up phase 2 costs %d\n", *iter);
#endif
iphase = 2;
for (j = 0; j < nklm; ++j)
{
/*cu[ j ] = 0.; */
mpf_set_si (cu[j], 0);
}
/* L510: */
for (j = n; j < nk; ++j)
{
/*cu[ j ] = 1.; */
mpf_set_si (cu[j], 1);
}
/*
memcpy( (void *) &(cu[cu_dim]), (void *) &(cu[0]), (size_t) nklm * sizeof(LDBLE) );
*/
for (i = 0; i < nklm; i++)
{
mpf_set (cu[cu_dim + i], cu[i]);
}
/* L520: */
for (i = 0; i < klm; ++i)
{
ii = q2[i * q_dim + n1].ival;
if (ii <= 0)
{
if (iu[cu_dim - ii - 1] == 0)
{
continue;
}
/*cu[ cu_dim - ii - 1 ] = 0.; */
mpf_set_si (cu[cu_dim - ii - 1], 0);
}
else
{
/* L530: */
if (iu[ii - 1] == 0)
{
continue;
}
/*cu[ ii - 1 ] = 0.; */
mpf_set_si (cu[ii - 1], 0);
}
/* L540: */
++ia;
/* switch row */
/*
memcpy( (void *) &(scratch[0]), (void *) &(q2[ ia * q_dim]),
(size_t) n2 * sizeof(LDBLE) );
memcpy( (void *) &(q2[ ia * q_dim ]), (void *) &(q2[ i * q_dim]),
(size_t) n2 * sizeof(LDBLE) );
memcpy( (void *) &(q2[ i * q_dim ]), (void *) &(scratch[ 0 ]),
(size_t) n2 * sizeof(LDBLE) );
*/
for (iswitch = 0; iswitch < n1; iswitch++)
{
mpf_set (dummy, q2[ia * q_dim + iswitch].dval);
mpf_set (q2[ia * q_dim + iswitch].dval, q2[i * q_dim + iswitch].dval);
mpf_set (q2[i * q_dim + iswitch].dval, dummy);
}
iswitch = q2[ia * q_dim + n1].ival;
q2[ia * q_dim + n1].ival = q2[i * q_dim + n1].ival;
q2[i * q_dim + n1].ival = iswitch;
/* L550: */
}
/* L560: */
goto L160;
/* PREPARE OUTPUT. */
L590:
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L590\n");
#endif
/*sum = 0.; */
mpf_set_si (sum, 0);
for (j = 0; j < n; ++j)
{
/*x[j] = 0.; */
mpf_set_si (x[j], 0);
}
/* L600: */
for (i = 0; i < klm; ++i)
{
/*res[i] = 0.; */
mpf_set_si (res[i], 0);
}
/* L610: */
for (i = 0; i < klm; ++i)
{
ii = q2[i * q_dim + n1].ival;
/*sn = 1.; */
mpf_set_si (sn, 1);
if (ii < 0)
{
ii = -ii;
/*sn = -1.; */
mpf_set_si (sn, -1);
}
if (ii <= n)
{
/* L620: */
/*x[ii - 1] = sn * q2[ i * q_dim + n ].dval; */
mpf_mul (x[ii - 1], sn, q2[i * q_dim + n].dval);
}
else
{
/* L630: */
/*res[ii - n - 1] = sn * q2[ i * q_dim + n ].dval; */
mpf_mul (res[ii - n - 1], sn, q2[i * q_dim + n].dval);
if (ii >= n1 && ii <= nk)
{
/* * DBLE(Q(I,N1)) */
/*sum += q2[ i * q_dim + n ].dval; */
mpf_add (sum, sum, q2[i * q_dim + n].dval);
}
}
}
/* L640: */
#ifdef DEBUG_CL1
output_msg (OUTPUT_MESSAGE, "L640\n");
#endif
/*
* Check calculation
*/
mpf_set_si (dummy, 100);
mpf_mul (check_toler, toler, dummy);
if (check && *kode == 0)
{
/*
* Check optimization constraints
*/
if (*kode_arg == 1)
{
for (i = 0; i < k; i++)
{
if (res_arg[i] < 0.0)
{
mpf_sub (dummy, res[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) > 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: optimization constraint not satisfied row %d, res %e, constraint %f.\n",
i, mpf_get_d (res[i]), res_arg[i]);
#endif
*kode = 1;
}
}
else if (res_arg[i] > 0.0)
{
mpf_add (dummy, res[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) < 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: optimization constraint not satisfied row %d, res %e, constraint %f.\n",
i, mpf_get_d (res[i]), res_arg[i]);
#endif
*kode = 1;
}
}
}
}
/*
* Check equalities
*/
for (i = k; i < k + l; i++)
{
mpf_abs (dummy, res[i]);
if (mpf_cmp (dummy, check_toler) > 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: equality constraint not satisfied row %d, res %e, tolerance %e.\n",
i, mpf_get_d (res[i]), mpf_get_d (check_toler));
#endif
*kode = 1;
}
}
/*
* Check inequalities
*/
for (i = k + l; i < k + l + m; i++)
{
mpf_neg (dummy, check_toler);
if (mpf_cmp (res[i], dummy) < 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: inequality constraint not satisfied row %d, res %e, tolerance %e.\n",
i, mpf_get_d (res[i]), mpf_get_d (check_toler));
#endif
*kode = 1;
}
}
/*
* Check dissolution/precipitation constraints
*/
if (*kode_arg == 1)
{
for (i = 0; i < n; i++)
{
if (x_arg[i] < 0.0)
{
mpf_sub (dummy, x[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) > 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: dis/pre constraint not satisfied column %d, x %e, constraint %f.\n",
i, mpf_get_d (x[i]), x_arg[i]);
#endif
*kode = 1;
}
}
else if (x_arg[i] > 0.0)
{
mpf_add (dummy, x[i], check_toler);
mpf_set_si (dummy1, 0);
if (mpf_cmp (dummy, dummy1) < 0)
{
#ifdef CHECK_ERRORS
output_msg (OUTPUT_MESSAGE,
"\tCL1MP: dis/pre constraint not satisfied column %d, x %e, constraint %f.\n",
i, mpf_get_d (x[i]), x_arg[i]);
#endif
*kode = 1;
}
}
}
}
if (*kode == 1)
{
output_msg (OUTPUT_MESSAGE,
"\n\tCL1MP: Roundoff errors in optimization.\n\t Deleting model.\n");
}
}
/*
* set return variables
*/
/**error = sum;*/
mpf_set (error, sum);
*error_arg = mpf_get_d (error);
*kode_arg = *kode;
for (i = 0; i < n2d; i++)
{
x_arg[i] = mpf_get_d (x[i]);
}
for (i = 0; i < k + l + m; i++)
{
res_arg[i] = mpf_get_d (res[i]);
}
/*scratch = free_check_null (scratch); */
for (i = 0; i < max_row_count * max_column_count; i++)
{
mpf_clear (q[i]);
}
q = (mpf_t *) free_check_null (q);
for (i = 0; i < n2d; i++)
{
mpf_clear (x[i]);
}
x = (mpf_t *) free_check_null (x);
for (i = 0; i < k + l + m; i++)
{
mpf_clear (res[i]);
}
res = (mpf_t *) free_check_null (res);
for (i = 0; i < 2 * nklmd; i++)
{
mpf_clear (cu[i]);
}
cu = (mpf_t *) free_check_null (cu);
mpf_clear (dummy);
mpf_clear (dummy1);
mpf_clear (sum);
mpf_clear (error);
mpf_clear (z);
mpf_clear (zu);
mpf_clear (zv);
mpf_clear (xmax);
mpf_clear (minus_one);
mpf_clear (toler);
mpf_clear (check_toler);
mpf_clear (pivot);
mpf_clear (xmin);
mpf_clear (cuv);
mpf_clear (tpivot);
mpf_clear (sn);
mpf_clear (censor_tol);
kode = (int *) free_check_null (kode);
return 0;
}
void series(bool const & abortTask, mpf_t & rop, unsigned long m,
mpz_t * const & tmpI, mpf_t * const & tmpF,
mpz_t const & sixteen, mpz_t const & digit, mpf_t const & epsilon)
{
// temporary local variables
mpf_t & tmp1 = tmpF[0];
mpf_t & t = tmpF[1];
mpz_t & tmp2 = tmpI[0];
mpz_t & k = tmpI[1];
mpz_t & p = tmpI[2];
mpz_t & ak = tmpI[3];
mpf_set_ui(rop, 0);
mpz_set_ui(k, 0);
while (mpz_cmp(k, digit) < 0) // k < digit
{
// p = id - k;
mpz_sub(p, digit, k);
// ak = 8 * k + m;
mpz_set(ak, k);
mpz_mul_ui(ak, ak, 8);
mpz_add_ui(ak, ak, m);
// t = expm (p, ak);
mpz_powm(tmp2, sixteen, p, ak);
mpf_set_z(t, tmp2);
// s = s + t / ak;
mpf_set_z(tmp1, ak);
mpf_div(tmp1, t, tmp1);
mpf_add(rop, rop, tmp1);
// s = s - (int) s;
mpf_floor(tmp1, rop);
mpf_sub(rop, rop, tmp1);
// k++
mpz_add_ui(k, k, 1);
if (abortTask)
return;
}
// ak = 8 * k + m;
mpz_set(ak, k);
mpz_mul_ui(ak, ak, 8);
mpz_add_ui(ak, ak, m);
// t = pow (16., (double) (id - k)) / ak;
mpf_set_z(tmp1, ak);
mpf_ui_div(t, 1, tmp1);
while (mpf_cmp(t, epsilon) >= 0) // t >= epsilon
{
// s = s + t;
mpf_add(rop, rop, t);
// s = s - (int) s;
mpf_floor(tmp1, rop);
mpf_sub(rop, rop, tmp1);
// k++
mpz_add_ui(k, k, 1);
// p = id - k;
mpz_sub(p, digit, k);
// ak = 8 * k + m;
mpz_set(ak, k);
mpz_mul_ui(ak, ak, 8);
mpz_add_ui(ak, ak, m);
// t = pow (16., (double) (id - k)) / ak;
mpz_pow_ui(tmp2, sixteen, mpz_get_ui(p));
mpz_mul(tmp2, tmp2, ak);
mpf_set_z(t, tmp2);
mpf_ui_div(t, 1, t);
if (abortTask)
return;
}
}
void
ks (mpf_t Kp,
mpf_t Km,
mpf_t X[],
void (P) (mpf_t, mpf_t),
unsigned long int n)
{
mpf_t Kt; /* temp */
mpf_t f_x;
mpf_t f_j; /* j */
mpf_t f_jnq; /* j/n or (j-1)/n */
unsigned long int j;
/* Sort the vector in ascending order. */
qsort (X, n, sizeof (__mpf_struct), mpf_cmp);
/* K-S test. */
/* Kp = sqr(n) * max(j/n - F(Xj)) for all 1<=j<=n
Km = sqr(n) * max(F(Xj) - (j-1)/n)) for all 1<=j<=n
*/
mpf_init (Kt); mpf_init (f_x); mpf_init (f_j); mpf_init (f_jnq);
mpf_set_ui (Kp, 0); mpf_set_ui (Km, 0);
for (j = 1; j <= n; j++)
{
P (f_x, X[j-1]);
mpf_set_ui (f_j, j);
mpf_div_ui (f_jnq, f_j, n);
mpf_sub (Kt, f_jnq, f_x);
if (mpf_cmp (Kt, Kp) > 0)
mpf_set (Kp, Kt);
if (g_debug > DEBUG_2)
{
printf ("j=%lu ", j);
printf ("P()="); mpf_out_str (stdout, 10, 2, f_x); printf ("\t");
printf ("jnq="); mpf_out_str (stdout, 10, 2, f_jnq); printf (" ");
printf ("diff="); mpf_out_str (stdout, 10, 2, Kt); printf (" ");
printf ("Kp="); mpf_out_str (stdout, 10, 2, Kp); printf ("\t");
}
mpf_sub_ui (f_j, f_j, 1);
mpf_div_ui (f_jnq, f_j, n);
mpf_sub (Kt, f_x, f_jnq);
if (mpf_cmp (Kt, Km) > 0)
mpf_set (Km, Kt);
if (g_debug > DEBUG_2)
{
printf ("jnq="); mpf_out_str (stdout, 10, 2, f_jnq); printf (" ");
printf ("diff="); mpf_out_str (stdout, 10, 2, Kt); printf (" ");
printf ("Km="); mpf_out_str (stdout, 10, 2, Km); printf (" ");
printf ("\n");
}
}
mpf_sqrt_ui (Kt, n);
mpf_mul (Kp, Kp, Kt);
mpf_mul (Km, Km, Kt);
mpf_clear (Kt); mpf_clear (f_x); mpf_clear (f_j); mpf_clear (f_jnq);
}
/* Test that there is no lost of accuracy when converting a mpfr_t number
into a mpf_t number (test with various precisions and exponents). */
static void
prec_test (void)
{
int px, py;
for (py = 3; py <= 136; py++)
{
mpfr_t y1, y2, y3;
mpfr_init2 (y1, py);
mpfr_init2 (y2, py);
mpfr_init2 (y3, py);
for (px = 32; px <= 160; px += 32)
{
mpf_t x1, x2, x3;
int e;
mpf_init (x1);
mpf_init (x2);
mpf_init (x3);
mpfr_set_ui_2exp (y1, 1, py - 1, MPFR_RNDN);
mpfr_get_f (x1, y1, MPFR_RNDN); /* exact (power of 2) */
mpf_set (x2, x1);
mpfr_set (y2, y1, MPFR_RNDN);
for (e = py - 2; e >= 0; e--)
{
int inex;
mpf_div_2exp (x2, x2, 1);
mpf_add (x1, x1, x2);
mpfr_div_2exp (y2, y2, 1, MPFR_RNDN);
inex = mpfr_add (y1, y1, y2, MPFR_RNDN);
MPFR_ASSERTN (inex == 0);
mpfr_set_f (y3, x1, MPFR_RNDN);
if (! mpfr_equal_p (y1, y3))
break;
inex = mpfr_get_f (x3, y3, MPFR_RNDN);
if (mpf_cmp (x1, x3) != 0)
{
printf ("Error in prec_test (px = %d, py = %d, e = %d)\n",
px, py, e);
printf ("x1 = ");
mpf_out_str (stdout, 16, 0, x1);
printf ("\nx2 = ");
mpf_out_str (stdout, 16, 0, x2);
printf ("\n");
exit (1);
}
if (inex != 0)
{
printf ("Error in prec_test (px = %d, py = %d, e = %d)\n",
px, py, e);
printf ("wrong ternary value got: %+d, expected: 0\n",
inex);
exit (1);
}
}
mpf_clear (x1);
mpf_clear (x2);
mpf_clear (x3);
}
mpfr_clear (y1);
mpfr_clear (y2);
mpfr_clear (y3);
}
}
void
check_f (void)
{
static const struct {
const char *fmt;
const char *input;
const char *want;
int ret;
long ftell; /* or -1 for length of input string */
} data[] = {
{ "%Ff", "0", "0", 1, -1 },
{ "%Fe", "0", "0", 1, -1 },
{ "%FE", "0", "0", 1, -1 },
{ "%Fg", "0", "0", 1, -1 },
{ "%FG", "0", "0", 1, -1 },
{ "%Ff", "123", "123", 1, -1 },
{ "%Ff", "+123", "123", 1, -1 },
{ "%Ff", "-123", "-123", 1, -1 },
{ "%Ff", "123.", "123", 1, -1 },
{ "%Ff", "+123.", "123", 1, -1 },
{ "%Ff", "-123.", "-123", 1, -1 },
{ "%Ff", "123.0", "123", 1, -1 },
{ "%Ff", "+123.0", "123", 1, -1 },
{ "%Ff", "-123.0", "-123", 1, -1 },
{ "%Ff", "0123", "123", 1, -1 },
{ "%Ff", "-0123", "-123", 1, -1 },
{ "%Ff", "123.456e3", "123456", 1, -1 },
{ "%Ff", "-123.456e3", "-123456", 1, -1 },
{ "%Ff", "123.456e+3", "123456", 1, -1 },
{ "%Ff", "-123.456e+3", "-123456", 1, -1 },
{ "%Ff", "123000e-3", "123", 1, -1 },
{ "%Ff", "-123000e-3", "-123", 1, -1 },
{ "%Ff", "123000.e-3", "123", 1, -1 },
{ "%Ff", "-123000.e-3", "-123", 1, -1 },
{ "%Ff", "123.456E3", "123456", 1, -1 },
{ "%Ff", "-123.456E3", "-123456", 1, -1 },
{ "%Ff", "123.456E+3", "123456", 1, -1 },
{ "%Ff", "-123.456E+3", "-123456", 1, -1 },
{ "%Ff", "123000E-3", "123", 1, -1 },
{ "%Ff", "-123000E-3", "-123", 1, -1 },
{ "%Ff", "123000.E-3", "123", 1, -1 },
{ "%Ff", "-123000.E-3", "-123", 1, -1 },
{ "%Ff", ".456e3", "456", 1, -1 },
{ "%Ff", "-.456e3", "-456", 1, -1 },
{ "%Ff", ".456e+3", "456", 1, -1 },
{ "%Ff", "-.456e+3", "-456", 1, -1 },
{ "%Ff", " 0", "0", 1, -1 },
{ "%Ff", " 0", "0", 1, -1 },
{ "%Ff", " 0", "0", 1, -1 },
{ "%Ff", "\t0", "0", 1, -1 },
{ "%Ff", "\t\t0", "0", 1, -1 },
{ "hello%Fg", "hello0", "0", 1, -1 },
{ "hello%Fg", "hello 0", "0", 1, -1 },
{ "hello%Fg", "hello \t0", "0", 1, -1 },
{ "hello%Fgworld", "hello 0world", "0", 1, -1 },
{ "hello%Fg", "hello3.0", "3.0", 1, -1 },
{ "hello%*Fg", "hello0", "-999", 0, -1 },
{ "hello%*Fg", "hello 0", "-999", 0, -1 },
{ "hello%*Fg", "hello \t0", "-999", 0, -1 },
{ "hello%*Fgworld", "hello 0world", "-999", 0, -1 },
{ "hello%*Fgworld", "hello3.0world", "-999", 0, -1 },
{ "%Ff", "", "-999", -1, -1 },
{ "%Ff", " ", "-999", -1, -1 },
{ "%Ff", "\t", "-999", -1, -1 },
{ "%Ff", " \t", "-999", -1, -1 },
{ " %Ff", "", "-999", -1, -1 },
{ "xyz%Ff", "", "-999", -1, -1 },
{ "%*Ff", "", "-999", -1, -1 },
{ " %*Ff", "", "-999", -1, -1 },
{ "xyz%*Ff", "", "-999", -1, -1 },
{ "%Ff", "xyz", "0", 0 },
/* various non-empty but invalid */
{ "%Ff", "-", "-999", 0, 1 },
{ "%Ff", "+", "-999", 0, 1 },
{ "xyz%Ff", "xyz-", "-999", 0, 4 },
{ "xyz%Ff", "xyz+", "-999", 0, 4 },
{ "%Ff", "-.", "-999", 0, 2 },
{ "%Ff", "+.", "-999", 0, 2 },
{ "%Ff", ".e", "-999", 0, 1 },
{ "%Ff", "-.e", "-999", 0, 2 },
{ "%Ff", "+.e", "-999", 0, 2 },
{ "%Ff", ".E", "-999", 0, 1 },
{ "%Ff", "-.E", "-999", 0, 2 },
{ "%Ff", "+.E", "-999", 0, 2 },
{ "%Ff", ".e123", "-999", 0, 1 },
{ "%Ff", "-.e123", "-999", 0, 2 },
{ "%Ff", "+.e123", "-999", 0, 2 },
{ "%Ff", "123e", "-999", 0, 4 },
{ "%Ff", "-123e", "-999", 0, 5 },
{ "%Ff", "123e-", "-999", 0, 5 },
{ "%Ff", "-123e-", "-999", 0, 6 },
{ "%Ff", "123e+", "-999", 0, 5 },
{ "%Ff", "-123e+", "-999", 0, 6 },
{ "%Ff", "123e-Z", "-999", 0, 5 },
/* hex floats */
{ "%Ff", "0x123p0", "291", 1, -1 },
{ "%Ff", "0x123P0", "291", 1, -1 },
{ "%Ff", "0X123p0", "291", 1, -1 },
{ "%Ff", "0X123P0", "291", 1, -1 },
{ "%Ff", "-0x123p0", "-291", 1, -1 },
{ "%Ff", "+0x123p0", "291", 1, -1 },
{ "%Ff", "0x123.p0", "291", 1, -1 },
{ "%Ff", "0x12.3p4", "291", 1, -1 },
{ "%Ff", "-0x12.3p4", "-291", 1, -1 },
{ "%Ff", "+0x12.3p4", "291", 1, -1 },
{ "%Ff", "0x1230p-4", "291", 1, -1 },
{ "%Ff", "-0x1230p-4", "-291", 1, -1 },
{ "%Ff", "+0x1230p-4", "291", 1, -1 },
{ "%Ff", "+0x.1230p12", "291", 1, -1 },
{ "%Ff", "+0x123000p-12", "291", 1, -1 },
{ "%Ff", "0x123 p12", "291", 1, 5 },
{ "%Ff", "0x9 9", "9", 1, 3 },
{ "%Ff", "0x01", "1", 1, 4 },
{ "%Ff", "0x23", "35", 1, 4 },
{ "%Ff", "0x45", "69", 1, 4 },
{ "%Ff", "0x67", "103", 1, 4 },
{ "%Ff", "0x89", "137", 1, 4 },
{ "%Ff", "0xAB", "171", 1, 4 },
{ "%Ff", "0xCD", "205", 1, 4 },
{ "%Ff", "0xEF", "239", 1, 4 },
{ "%Ff", "0xab", "171", 1, 4 },
{ "%Ff", "0xcd", "205", 1, 4 },
{ "%Ff", "0xef", "239", 1, 4 },
{ "%Ff", "0x100p0A", "256", 1, 7 },
{ "%Ff", "0x1p9", "512", 1, -1 },
/* invalid hex floats */
{ "%Ff", "0x", "-999", 0, 2 },
{ "%Ff", "-0x", "-999", 0, 3 },
{ "%Ff", "+0x", "-999", 0, 3 },
{ "%Ff", "0x-", "-999", 0, 2 },
{ "%Ff", "0x+", "-999", 0, 2 },
{ "%Ff", "0x.", "-999", 0, 3 },
{ "%Ff", "-0x.", "-999", 0, 4 },
{ "%Ff", "+0x.", "-999", 0, 4 },
{ "%Ff", "0x.p", "-999", 0, 3 },
{ "%Ff", "-0x.p", "-999", 0, 4 },
{ "%Ff", "+0x.p", "-999", 0, 4 },
{ "%Ff", "0x.P", "-999", 0, 3 },
{ "%Ff", "-0x.P", "-999", 0, 4 },
{ "%Ff", "+0x.P", "-999", 0, 4 },
{ "%Ff", ".p123", "-999", 0, 1 },
{ "%Ff", "-.p123", "-999", 0, 2 },
{ "%Ff", "+.p123", "-999", 0, 2 },
{ "%Ff", "0x1p", "-999", 0, 4 },
{ "%Ff", "0x1p-", "-999", 0, 5 },
{ "%Ff", "0x1p+", "-999", 0, 5 },
{ "%Ff", "0x123p 12", "291", 0, 6 },
{ "%Ff", "0x 123p12", "291", 0, 2 },
};
int i, j, ignore, got_ret, want_ret, got_upto, want_upto;
mpf_t got, want;
double got_d;
long want_ftell;
int error = 0;
fun_t fun;
const char *name;
char fmt[128];
mpf_init (got);
mpf_init (want);
for (i = 0; i < numberof (data); i++)
{
mpf_set_str_or_abort (want, data[i].want, 10);
ASSERT_ALWAYS (strlen (data[i].fmt) + 2 < sizeof (fmt));
strcpy (fmt, data[i].fmt);
strcat (fmt, "%n");
ignore = (strchr (fmt, '*') != NULL);
for (j = 0; j <= 3; j++)
{
want_ret = data[i].ret;
want_ftell = data[i].ftell;
if (want_ftell == -1)
want_ftell = strlen (data[i].input);
want_upto = want_ftell;
if (want_ret == -1 || (want_ret == 0 && ! ignore))
want_upto = -555;
switch (j) {
case 0:
name = "gmp_sscanf";
fun = fun_gmp_sscanf;
break;
case 1:
name = "gmp_fscanf";
fun = fun_gmp_fscanf;
break;
case 2:
if (! libc_scanf_convert (fmt))
continue;
name = "standard sscanf";
fun = fun_sscanf;
break;
case 3:
if (! libc_scanf_convert (fmt))
continue;
name = "standard fscanf";
fun = fun_fscanf;
break;
default:
ASSERT_ALWAYS (0);
break;
}
got_upto = -555;
got_ftell = -1;
switch (j) {
case 0:
case 1:
mpf_set_si (got, -999L);
if (ignore)
got_ret = (*fun) (data[i].input, fmt, &got_upto, NULL);
else
got_ret = (*fun) (data[i].input, fmt, got, &got_upto);
break;
case 2:
case 3:
got_d = -999L;
if (ignore)
got_ret = (*fun) (data[i].input, fmt, &got_upto, NULL);
else
got_ret = (*fun) (data[i].input, fmt, &got_d, &got_upto);
mpf_set_d (got, got_d);
break;
default:
ASSERT_ALWAYS (0);
break;
}
MPF_CHECK_FORMAT (got);
if (got_ret != want_ret)
{
printf ("%s wrong return value\n", name);
error = 1;
}
if (want_ret == 1 && mpf_cmp (want, got) != 0)
{
printf ("%s wrong result\n", name);
error = 1;
}
if (got_upto != want_upto)
{
printf ("%s wrong upto\n", name);
error = 1;
}
if (got_ftell != -1 && want_ftell != -1 && got_ftell != want_ftell)
{
printf ("%s wrong ftell\n", name);
error = 1;
}
if (error)
{
printf (" fmt \"%s\"\n", data[i].fmt);
printf (" input \"%s\"\n", data[i].input);
printf (" ret want=%d\n", want_ret);
printf (" got =%d\n", got_ret);
mpf_trace (" value want", want);
mpf_trace (" got ", got);
printf (" upto want=%d\n", want_upto);
printf (" got =%d\n", got_upto);
if (got_ftell != -1)
{
printf (" ftell want =%ld\n", want_ftell);
printf (" got =%ld\n", got_ftell);
}
abort ();
}
}
}
mpf_clear (got);
mpf_clear (want);
}
int
main (int argc, char **argv)
{
mpf_t x, y;
int reps = 20000;
int i;
mp_size_t bprec = 100;
mpf_t d, rerr, max_rerr, limit_rerr;
char *str;
mp_exp_t bexp;
long size, exp;
int base;
char buf[SIZE * GMP_LIMB_BITS + 5];
tests_start ();
if (argc > 1)
{
reps = strtol (argv[1], 0, 0);
if (argc > 2)
bprec = strtol (argv[2], 0, 0);
}
mpf_set_default_prec (bprec);
mpf_init_set_ui (limit_rerr, 1);
mpf_div_2exp (limit_rerr, limit_rerr, bprec);
#if VERBOSE
mpf_dump (limit_rerr);
#endif
mpf_init (rerr);
mpf_init_set_ui (max_rerr, 0);
mpf_init (x);
mpf_init (y);
mpf_init (d);
/* First test some specific values. */
mpf_set_str (y, "1.23456e1000", 0);
mpf_set_str (x, "1.23456e1000", 10);
if (mpf_cmp (x, y) != 0)
abort ();
mpf_set_str (x, "1.23456e+1000", 0);
if (mpf_cmp (x, y) != 0)
abort ();
mpf_set_str (x, "1.23456e+1000", 10);
if (mpf_cmp (x, y) != 0)
abort ();
/* Now test random values. */
for (i = 0; i < reps; i++)
{
if (i == 0)
{
/* exercise the special case in get_str for for x==0 */
mpf_set_ui (x, 0L);
base = 10;
}
else
{
size = urandom () % (2 * SIZE) - SIZE;
exp = urandom () % EXPO;
mpf_random2 (x, size, exp);
base = urandom () % 61 + 2;
}
str = mpf_get_str (0, &bexp, base, 0, x);
if (str[0] == '-')
sprintf (buf, "-0.%s@%ld", str + 1, bexp);
else
sprintf (buf, "0.%s@%ld", str, bexp);
mpf_set_str_or_abort (y, buf, -base);
(*__gmp_free_func) (str, strlen (str) + 1);
mpf_reldiff (rerr, x, y);
if (mpf_cmp (rerr, max_rerr) > 0)
{
mpf_set (max_rerr, rerr);
#if VERBOSE
mpf_dump (max_rerr);
#endif
if (mpf_cmp (rerr, limit_rerr) > 0)
{
printf ("ERROR after %d tests\n", i);
printf ("base = %d\n", base);
printf (" x = ");
mpf_dump (x);
printf (" y = ");
mpf_dump (y);
abort ();
}
}
}
mpf_clear (limit_rerr);
mpf_clear (rerr);
mpf_clear (max_rerr);
mpf_clear (x);
mpf_clear (y);
mpf_clear (d);
tests_end ();
exit (0);
}
