void
check_max (void)
{
mpf_t f;
long want;
long got;
mpf_init2 (f, 200L);
#define CHECK_MAX(name) \
if (got != want) \
{ \
printf ("mpf_get_si wrong on %s\n", name); \
printf (" f "); \
mpf_out_str (stdout, 10, 0, f); printf (", hex "); \
mpf_out_str (stdout, 16, 0, f); printf ("\n"); \
printf (" got %ld, hex %lX\n", got, got); \
printf (" want %ld, hex %lX\n", want, want); \
abort(); \
}
want = LONG_MAX;
mpf_set_si (f, want);
got = mpf_get_si (f);
CHECK_MAX ("LONG_MAX");
want = LONG_MIN;
mpf_set_si (f, want);
got = mpf_get_si (f);
CHECK_MAX ("LONG_MIN");
mpf_clear (f);
}
/* Constructor and destructor for Lambda fractal. */
static lambda_t* constructor_lambda(const ordinal_number_t iteration_steps, long long int prec, const char args[])
{
lambda_t* context;
char* real_param;
char* imaginary_param;
char* args_help;
/* Get memory for the fractal context. */
if (!(context=malloc(sizeof(lambda_t)))) return NULL;
mpf_set_default_prec(sizeof(char)*prec);
mpf_init(Re(context->lambda));
mpf_init(Im(context->lambda));
/* Set the fractal context. */
context->iteration_steps=iteration_steps;
if(args!=NULL)
{
if (strchr(args, ',')==NULL)
{
real_param=malloc(sizeof(char)*(prec+1));
sscanf(args,"%s",real_param);
mpf_set_str(Re(context->lambda),real_param,10);
mpf_set_str(Im(context->lambda),"0",10);
free(real_param);
}
else
{
args_help=malloc(sizeof(args));
strcpy(args_help,args);
real_param=strtok(args_help,",");
imaginary_param=strtok(NULL,"\0");
mpf_set_str(Re(context->lambda),real_param,10);
mpf_set_str(Im(context->lambda),imaginary_param,10);
free(args_help);
}
}
else
{
mpf_set_si(Re(context->lambda),1);
mpf_set_si(Im(context->lambda),0);
}
context->prec=prec;
#ifdef DEBUG
gmp_fprintf(stderr,"Lambda parameter: %F.10f,%F.10f\n",Re(context->lambda),Im(context->lambda));
#endif
/* Return the handle. */
return context;
}
/* New calculate function. */
ordinal_number_t cache_calculator(render_t* handle,const view_position_t render_position)
{
/* Volatile data. */
ordinal_number_t* help;
complex_number_t complex_position;
view_position_t shift;
real_number_t scaling_factor;
mpf_t help_mpf;
mpf_t help_two;
mpf_set_default_prec(sizeof(char)*handle->prec);
mpf_init(help_mpf);
mpf_init(Re(complex_position));
mpf_init(Im(complex_position));
mpf_init(scaling_factor);
mpf_init(help_two);
/* Check if the point has been calculated already. */
help=handle->points+render_position.y*handle->geometry.width+render_position.x;
if(*help==0)
{
/* Has not been calculated till now, calculate the iteration. */
/* Precalculate scaling factor and center shift for speed reasons. */
mpf_div_ui(scaling_factor,handle->scale,handle->geometry.width);
shift.x=handle->geometry.width/2;
shift.y=handle->geometry.height/2;
/* Calculate the iteration. */
mpf_set_si(help_two,(render_position.x-shift.x));
mpf_mul(help_mpf,scaling_factor,help_two);
mpf_add(complex_position.real_part,help_mpf,handle->center.real_part);
mpf_set_si(help_two,(render_position.y-shift.y));
mpf_mul(help_mpf,scaling_factor,help_two);
mpf_sub(Im(complex_position),Im(handle->center),help_mpf);
*help=(*handle->fractal_facility->facility.fractal.calculate_function)(handle->fractal,&complex_position);
}
mpf_clear(help_mpf);
mpf_clear(Re(complex_position));
mpf_clear(Im(complex_position));
mpf_clear(scaling_factor);
mpf_clear(help_two);
/* Return the iteration. */
return(*help);
//return(0);
}
int sg_big_float_set_c_int(sg_big_float_t *dst, const void *c_int_ptr, enum sg_c_int_type type)
{
if (!dst || !c_int_ptr)
return -1;
int32_t s32 = 0;
uint32_t u32 = 0;
double d = 0;
switch (type) {
case SGCINTTYPE_SCHAR:
s32 = *((char*) c_int_ptr);
mpf_set_si(dst->mpf, s32);
break;
case SGCINTTYPE_UCHAR:
u32 = *((unsigned char*) c_int_ptr);
mpf_set_ui(dst->mpf, u32);
break;
case SGCINTTYPE_SSHORT:
s32 = *((short*) c_int_ptr);
mpf_set_si(dst->mpf, s32);
break;
case SGCINTTYPE_USHORT:
u32 = *((unsigned short*) c_int_ptr);
mpf_set_ui(dst->mpf, u32);
break;
case SGCINTTYPE_SINT32:
case SGCINTTYPE_SINT:
case SGCINTTYPE_SLONG:
s32 = *((int32_t*) c_int_ptr);
mpf_set_si(dst->mpf, s32);
break;
case SGCINTTYPE_UINT32:
case SGCINTTYPE_UINT:
case SGCINTTYPE_ULONG:
u32 = *((uint32_t*) c_int_ptr);
mpf_set_ui(dst->mpf, u32);
break;
case SGCINTTYPE_SINT64:
d = *((int64_t*) c_int_ptr);
mpf_set_d(dst->mpf, d);
break;
case SGCINTTYPE_UINT64:
d = *((uint64_t*) c_int_ptr);
mpf_set_d(dst->mpf, d);
break;
}
return 0;
}
void DoUniaryOperation(number_t result, number_t number1, char *op)
{
switch( op[0] )
{
case '!':
mpf_set_si(result, mpf_cmp_ui(number1, 0));
break;
case '~':
DO_INTEGER_OPERATION1_ON_FLOAT(mpz_com, result, number1);
break;
case '+':
if (op[1] == '+') {
mpf_add_ui(result, number1, 1);
} else {
mpf_set(result, number1);
}
break;
case '-':
if (op[1] == '-') {
mpf_sub_ui(result, number1, 1);
} else {
mpf_sub(result, result, number1);
}
break;
}
}
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;
}
}
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);
}
void
check_data (void)
{
static const struct {
long x;
mp_size_t want_size;
mp_limb_t want_limb;
} data[] = {
{ 0L, 0 },
{ 1L, 1, 1 },
{ -1L, -1, 1 },
{ LONG_MAX, 1, LONG_MAX },
{ -LONG_MAX, -1, LONG_MAX },
{ LONG_HIGHBIT, -1, ULONG_HIGHBIT },
};
mpf_t x;
int i;
for (i = 0; i < numberof (data); i++)
{
mpf_init (x);
mpf_set_si (x, data[i].x);
MPF_CHECK_FORMAT (x);
if (x->_mp_size != data[i].want_size
|| (x->_mp_size != 0
&& (x->_mp_d[0] != data[i].want_limb
|| x->_mp_exp != 1)))
{
printf ("mpf_set_si wrong on data[%d]\n", i);
abort();
}
mpf_clear (x);
mpf_init_set_si (x, data[i].x);
MPF_CHECK_FORMAT (x);
if (x->_mp_size != data[i].want_size
|| (x->_mp_size != 0
&& (x->_mp_d[0] != data[i].want_limb
|| x->_mp_exp != 1)))
{
printf ("mpf_init_set_si wrong on data[%d]\n", i);
abort();
}
mpf_clear (x);
}
}
/**
* rasqal_xsd_decimal_set_long:
* @dec: XSD Decimal
* @l: long
*
* Set an XSD Decimal value from a long.
*
* Return value: non-0 on failure
**/
int
rasqal_xsd_decimal_set_long(rasqal_xsd_decimal* dec, long l)
{
int rc=0;
rasqal_xsd_decimal_clear_string(dec);
#if defined(RASQAL_DECIMAL_C99) || defined(RASQAL_DECIMAL_NONE)
dec->raw=l;
#endif
#ifdef RASQAL_DECIMAL_MPFR
rc = mpfr_set_si(dec->raw, l, dec->rounding);
#endif
#ifdef RASQAL_DECIMAL_GMP
mpf_set_si(dec->raw, l);
#endif
return rc;
}
R gaunt(Int lp, Int l1, Int l2, Int mp, Int m1, Int m2)
{
R gg;
mpf_t g,h;
if((lp+l1+l2)%Int(2)==Int(1)) return R(0);
if(NewGaunt::iabs(mp)>lp || NewGaunt::iabs(m1)>l1 || NewGaunt::iabs(m2)>l2) return R(0);
mpf_init(g);
mpf_init(h);
NewGaunt::w3j(g,lp,l1,l2,0,0,0);
NewGaunt::w3j(h,lp,l1,l2,-mp,m1,m2);
mpf_mul(g,g,h);
mpf_set_si(h,(2*lp+1)*(2*l1+1)*(2*l2+1));
mpf_sqrt(h,h);
mpf_mul(g,g,h);
gg=mpf_get_d(g)/sqrt(4.0*M_PI);
if(NewGaunt::iabs(mp)%Int(2)==Int(1)) gg=-gg;
mpf_clear(g);
mpf_clear(h);
return gg;
}
void dd_set_global_constants()
{
dd_init(dd_zero);
dd_init(dd_minuszero);
dd_init(dd_one);
dd_init(dd_minusone);
dd_init(dd_purezero);
time(&dd_statStartTime); /* cddlib starting time */
dd_statBApivots=0; /* basis finding pivots */
dd_statCCpivots=0; /* criss-cross pivots */
dd_statDS1pivots=0; /* phase 1 pivots */
dd_statDS2pivots=0; /* phase 2 pivots */
dd_statACpivots=0; /* anticycling (cc) pivots */
dd_choiceLPSolverDefault=dd_DualSimplex; /* Default LP solver Algorithm */
dd_choiceRedcheckAlgorithm=dd_DualSimplex; /* Redundancy Checking Algorithm */
dd_choiceLexicoPivotQ=dd_TRUE; /* whether to use the lexicographic pivot */
#if defined GMPRATIONAL
dd_statBSpivots=0; /* basis status checking pivots */
mpq_set_ui(dd_zero,0U,1U);
mpq_set_ui(dd_purezero,0U,1U);
mpq_set_ui(dd_one,1U,1U);
mpq_set_si(dd_minusone,-1L,1U);
ddf_set_global_constants();
#elif defined GMPFLOAT
mpf_set_d(dd_zero,dd_almostzero);
mpf_set_ui(dd_purezero,0U);
mpf_set_ui(dd_one,1U);
mpf_set_si(dd_minusone,-1L,1U);
#else
dd_zero[0]= dd_almostzero; /*real zero */
dd_purezero[0]= 0.0;
dd_one[0]= 1L;
dd_minusone[0]= -1L;
#endif
dd_neg(dd_minuszero,dd_zero);
}
void
check_infinity (void)
{
mpf_t x;
double y = tests_infinity_d ();
if (y == 0.0)
return;
mpf_init (x);
/* 0 cmp inf */
mpf_set_ui (x, 0L);
check_one ("check_infinity", x, y, -1);
check_one ("check_infinity", x, -y, 1);
/* 123 cmp inf */
mpf_set_ui (x, 123L);
check_one ("check_infinity", x, y, -1);
check_one ("check_infinity", x, -y, 1);
/* -123 cmp inf */
mpf_set_si (x, -123L);
check_one ("check_infinity", x, y, -1);
check_one ("check_infinity", x, -y, 1);
/* 2^5000 cmp inf */
mpf_set_ui (x, 1L);
mpf_mul_2exp (x, x, 5000L);
check_one ("check_infinity", x, y, -1);
check_one ("check_infinity", x, -y, 1);
/* -2^5000 cmp inf */
mpf_neg (x, x);
check_one ("check_infinity", x, y, -1);
check_one ("check_infinity", x, -y, 1);
mpf_clear (x);
}
vanilla::float_object::gmp_mpf_wrapper::gmp_mpf_wrapper(signed long op)
: _mpf(), _valid(true)
{
mpf_init(_mpf);
mpf_set_si(_mpf, op);
}
/*
* Function: compute_bbp_second_sum_gmp
* --------------------
* Computes the second summand in the BBP formula.
*
* d: digit to be calculated
* base: the base
* c: a fixed positive integer
* p: a simple polynomial like x or x^2
*
* returns: the value of the second sum
*/
void compute_bbp_second_sum_gmp(mpf_t sum, int d, int base, int c, void (*p)(mpz_t, mpz_t))
{
mpf_set_d(sum, 0.0);
mpz_t k;
mpz_init_set_si(k, floor((double) d / (double) c) + 1);
mpf_t prev_sum;
mpf_init(prev_sum);
mpf_set(prev_sum, sum);
mpf_t base_gmp;
mpf_init(base_gmp);
mpf_set_si(base_gmp, base);
double d_diff = 0.0;
do
{
mpf_set(prev_sum, sum);
mpz_t poly_result;
mpz_init(poly_result);
(*p)(poly_result, k);
mpf_t num;
mpf_init(num);
mpz_t exponent;
mpz_init_set(exponent, k);
mpz_mul_si(exponent, exponent, c);
mpz_mul_si(exponent, exponent, -1);
mpz_add_ui(exponent, exponent, d);
signed long int exp = mpz_get_si(exponent);
unsigned long int neg_exp = -1 * exp;
mpf_pow_ui(num, base_gmp, neg_exp);
mpf_ui_div(num, 1, num);
mpz_clear(exponent);
mpf_t denom;
mpf_init_set_d(denom, mpz_get_d(poly_result));
mpz_clear(poly_result);
mpf_t quotient;
mpf_init(quotient);
mpf_div(quotient, num, denom);
mpf_clear(num);
mpf_clear(denom);
mpf_add(sum, sum, quotient);
mpf_clear(quotient);
mpz_add_ui(k, k, 1);
mpf_t diff;
mpf_init(diff);
mpf_sub(diff, prev_sum, sum);
d_diff = mpf_get_d(diff);
d_diff = fabs(d_diff);
mpf_clear(diff);
}
while (d_diff > 0.00000001);
mpz_clear(k);
mpf_clear(base_gmp);
mpf_clear(prev_sum);
}
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;
}
int
aks (mpz_t n)
{
mpz_t r;
mpz_t a;
mpz_t max_a;
mpz_t gcd_rslt;
mpz_t totient_r;
mpf_t ftotient_r;
mpf_t sqrt_rslt;
mpf_t sqrt_rslt2;
mpf_t temp;
mpf_t temp2;
sli_t logn;
/* For the sake of maple kernel */
int argc = 0;
char **argv;
char err[2048];
mpz_init (r);
mpz_init (a);
mpz_init (max_a);
mpz_init (gcd_rslt);
mpz_init (totient_r);
mpf_init (ftotient_r);
mpf_init (sqrt_rslt);
mpf_init (sqrt_rslt2);
mpf_init (temp);
mpf_init (temp2);
/* 1. If (n = a^k for a in N and b > 1) output COMPOSITE */
if (mpz_perfect_power_p (n) != 0)
{
printf ("Step 1 detected composite\n");
return FALSE;
}
/* 2. Find the smallest r such that or(n) > 4(log n)^2 */
find_smallest_r (r, n);
gmp_printf ("good r seems to be %Zd\n", r);
/* 3. If 1 < gcd(a, n) < n for some a <= r, output COMPOSITE */
/* for (a = 1; a <= r; a++) {
* gcd_rslt = gcd(a, n);
* if (gcd_rslt > 1 && gcd_rslt < n) {
* return FALSE;
* }
* }
*/
for (mpz_set_ui (a, 1);
mpz_cmp (a, r) < 0 || mpz_cmp (a, r) == 0; mpz_add_ui (a, a, 1))
{
mpz_gcd (gcd_rslt, a, n);
if (mpz_cmp_ui (gcd_rslt, 1) > 0 && mpz_cmp (gcd_rslt, n) < 0)
{
printf ("Step 3 detected composite\n");
return FALSE;
}
}
/* 4. If n <= r, output PRIME */
if (mpz_cmp (n, r) < 0 || mpz_cmp (n, r) == 0)
{
printf ("Step 4 detected prime\n");
return TRUE;
}
/* 5. For a = 1 to floor(2*sqrt(totient(r))*(log n)
* if ( (X+a)^n != X^n + a (mod X^r-1, n) ), output COMPOSITE
*
* Choices of implementation to evaluate the polynomial equality:
* (1) Implement powermodreduce on polynomial ourselves (tough manly way)
* (2) Use MAPLE (not so manly, but less painful)
*/
/* Compute totient(r), since r is prime, this is simply r-1 */
mpz_sub_ui (totient_r, r, 1);
/* Compute log n (ceilinged) */
mpz_logbase2cl (&logn, n);
/* Compute sqrt(totient(r)) */
mpf_set_z (ftotient_r, totient_r);
mpf_sqrt (sqrt_rslt, ftotient_r);
/* Compute 2*sqrt(totient(r)) */
mpf_mul_ui (sqrt_rslt2, sqrt_rslt, 2);
/* Compute 2*sqrt(totient(r))*(log n) */
mpf_set (temp, sqrt_rslt2);
mpf_set_si (temp2, logn);
mpf_mul (temp, temp, temp2);
/* Finally, compute max_a, after lots of singing and dancing */
mpf_floor (temp, temp);
mpz_set_f (max_a, temp);
gmp_printf ("max_a = %Zd\n", max_a);
/* Now evaluate the polynomial equality with the help of maple kernel */
/* Set up maple kernel incantations */
MKernelVector kv;
MCallBackVectorDesc cb = { textCallBack,
0, /* errorCallBack not used */
0, /* statusCallBack not used */
0, /* readLineCallBack not used */
0, /* redirectCallBack not used */
0, /* streamCallBack not used */
0, /* queryInterrupt not used */
0 /* callBackCallBack not used */
};
/* Initialize Maple */
if ((kv = StartMaple (argc, argv, &cb, NULL, NULL, err)) == NULL)
{
printf ("Could not start Maple, %s\n", err);
exit (666);
}
/* Here comes the complexity and bottleneck */
/* for (a = 1; a <= max_a; a++) {
* if (!poly_eq_holds(kv, a, n, r)) {
* return FALSE;
* }
* }
*/
/* Make max_a only up to 5 */
mpz_set_ui (max_a, 5);
for (mpz_set_ui (a, 1);
mpz_cmp (a, max_a) < 0 || mpz_cmp (a, max_a) == 0;
mpz_add_ui (a, a, 1))
{
if (!poly_eq_holds (kv, a, n, r))
{
printf ("Step 5 detected composite\n");
return FALSE;
}
}
/* 6. Output PRIME */
printf ("Step 6 detected prime\n");
return TRUE;
}
extern void _jl_mpf_set_si(mpf_t* rop, signed long int op) {
mpf_set_si(*rop, op);
}
int fractal_gmp_calculate_line(image_info* img, int line)
{
int ret = 1;
int ix = 0;
int mx = 0;
int chk_px = ((rthdata*)img->rth_ptr)->check_stop_px;
int img_width = img->real_width;
int* raw_data = &img->raw_data[line * img_width];
depth_t depth = img->depth;
mpf_t x, y;
mpf_t x2, y2;
mpf_t c_re, c_im;
/* working variables: */
mpf_t wre, wim;
mpf_t wre2, wim2;
mpf_t frs_bail;
mpf_t width, img_rw, img_xmin;
mpf_t t1;
mpf_init2(x, img->precision);
mpf_init2(y, img->precision);
mpf_init2(x2, img->precision);
mpf_init2(y2, img->precision);
mpf_init2(c_re, img->precision);
mpf_init2(c_im, img->precision);
mpf_init2(wre, img->precision);
mpf_init2(wim, img->precision);
mpf_init2(wre2, img->precision);
mpf_init2(wim2, img->precision);
mpf_init2(frs_bail,img->precision);
mpf_init2(width, img->precision);
mpf_init2(img_rw, img->precision);
mpf_init2(img_xmin,img->precision);
mpf_init2(t1, img->precision);
mpf_set_si(frs_bail, 4);
mpf_set_si(img_rw, img_width);
mpf_set( img_xmin, img->gxmin);
mpf_set( width, img->gwidth);
/* y = img->ymax - ((img->xmax - img->xmin)
/ (long double)img->real_width)
* (long double)img->lines_done; */
mpf_div( t1, width, img_rw);
mpf_mul_ui( t1, t1, line);
mpf_sub( y, img->gymax, t1);
mpf_mul( y2, y, y);
while (ix < img_width)
{
mx += chk_px;
if (mx > img_width)
mx = img_width;
for (; ix < mx; ++ix, ++raw_data)
{
/* x = ((long double)ix / (long double)img->real_width)
* (img->xmax - img->xmin) + img->xmin; */
mpf_ui_div(t1, ix, img_rw);
mpf_mul(x, t1, width);
mpf_add(x, x, img_xmin);
mpf_mul( x2, x, x);
mpf_set( wre, x);
mpf_set( wim, y);
mpf_set( wre2, x2);
mpf_set( wim2, y2);
switch (img->family)
{
case FAMILY_MANDEL:
mpf_set(c_re, x);
mpf_set(c_im, y);
break;
case FAMILY_JULIA:
mpfr_to_gmp(img->u.julia.c_re, c_re);
mpfr_to_gmp(img->u.julia.c_im, c_im);
break;
}
switch(img->fractal)
{
case BURNING_SHIP:
*raw_data = frac_burning_ship_gmp(
depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
break;
case GENERALIZED_CELTIC:
*raw_data = frac_generalized_celtic_gmp(
depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
break;
case VARIANT:
*raw_data = frac_variant_gmp(
depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
break;
case MANDELBROT:
default:
*raw_data = frac_mandel_gmp(depth, frs_bail,
wim, wre,
c_im, c_re,
wim2, wre2, t1);
}
}
if (rth_render_should_stop((rthdata*)img->rth_ptr))
{
ret = 0;
break;
}
}
mpf_clear(x);
mpf_clear(y);
mpf_clear(x2);
mpf_clear(y2);
mpf_clear(c_re);
mpf_clear(c_im);
mpf_clear(wre);
mpf_clear(wim);
mpf_clear(wre2);
mpf_clear(wim2);
mpf_clear(frs_bail);
mpf_clear(width);
mpf_clear(img_rw);
mpf_clear(t1);
return ret;
}
int
main (void)
{
mpf_t f, f0p5;
int got;
const char *expr;
int error = 0;
tests_start ();
mpf_init2 (f, 200L);
mpf_init2 (f0p5, 200L);
/* 0.5 */
mpf_set_ui (f0p5, 1L);
mpf_div_2exp (f0p5, f0p5, 1L);
mpf_set_ui (f, 0L);
expr = "0";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
EXPECT (mpf_fits_ushort_p, 1);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_ui (f, 1L);
expr = "1";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
EXPECT (mpf_fits_ushort_p, 1);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_si (f, -1L);
expr = "-1";
EXPECT (mpf_fits_ulong_p, 0);
EXPECT (mpf_fits_uint_p, 0);
EXPECT (mpf_fits_ushort_p, 0);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_ui (f, (unsigned long) USHRT_MAX);
expr = "USHRT_MAX";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
EXPECT (mpf_fits_ushort_p, 1);
mpf_set_ui (f, (unsigned long) USHRT_MAX);
mpf_add (f, f, f0p5);
expr = "USHRT_MAX + 0.5";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
EXPECT (mpf_fits_ushort_p, 1);
mpf_set_ui (f, (unsigned long) USHRT_MAX);
mpf_add_ui (f, f, 1L);
expr = "USHRT_MAX + 1";
EXPECT (mpf_fits_ushort_p, 0);
mpf_set_ui (f, (unsigned long) UINT_MAX);
expr = "UINT_MAX";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
mpf_set_ui (f, (unsigned long) UINT_MAX);
mpf_add (f, f, f0p5);
expr = "UINT_MAX + 0.5";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
mpf_set_ui (f, (unsigned long) UINT_MAX);
mpf_add_ui (f, f, 1L);
expr = "UINT_MAX + 1";
EXPECT (mpf_fits_uint_p, 0);
mpf_set_ui (f, ULONG_MAX);
expr = "ULONG_MAX";
EXPECT (mpf_fits_ulong_p, 1);
mpf_set_ui (f, ULONG_MAX);
mpf_add (f, f, f0p5);
expr = "ULONG_MAX + 0.5";
EXPECT (mpf_fits_ulong_p, 1);
mpf_set_ui (f, ULONG_MAX);
mpf_add_ui (f, f, 1L);
expr = "ULONG_MAX + 1";
EXPECT (mpf_fits_ulong_p, 0);
mpf_set_si (f, (long) SHRT_MAX);
expr = "SHRT_MAX";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_si (f, (long) SHRT_MAX);
expr = "SHRT_MAX + 0.5";
mpf_add (f, f, f0p5);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_si (f, (long) SHRT_MAX);
mpf_add_ui (f, f, 1L);
expr = "SHRT_MAX + 1";
EXPECT (mpf_fits_sshort_p, 0);
mpf_set_si (f, (long) INT_MAX);
expr = "INT_MAX";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
mpf_set_si (f, (long) INT_MAX);
mpf_add (f, f, f0p5);
expr = "INT_MAX + 0.5";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
mpf_set_si (f, (long) INT_MAX);
mpf_add_ui (f, f, 1L);
expr = "INT_MAX + 1";
EXPECT (mpf_fits_sint_p, 0);
mpf_set_si (f, LONG_MAX);
expr = "LONG_MAX";
EXPECT (mpf_fits_slong_p, 1);
mpf_set_si (f, LONG_MAX);
mpf_add (f, f, f0p5);
expr = "LONG_MAX + 0.5";
EXPECT (mpf_fits_slong_p, 1);
mpf_set_si (f, LONG_MAX);
mpf_add_ui (f, f, 1L);
expr = "LONG_MAX + 1";
EXPECT (mpf_fits_slong_p, 0);
mpf_set_si (f, (long) SHRT_MIN);
expr = "SHRT_MIN";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_si (f, (long) SHRT_MIN);
mpf_sub (f, f, f0p5);
expr = "SHRT_MIN - 0.5";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_si (f, (long) SHRT_MIN);
mpf_sub_ui (f, f, 1L);
expr = "SHRT_MIN + 1";
EXPECT (mpf_fits_sshort_p, 0);
mpf_set_si (f, (long) INT_MIN);
expr = "INT_MIN";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
mpf_set_si (f, (long) INT_MIN);
mpf_sub (f, f, f0p5);
expr = "INT_MIN - 0.5";
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
mpf_set_si (f, (long) INT_MIN);
mpf_sub_ui (f, f, 1L);
expr = "INT_MIN + 1";
EXPECT (mpf_fits_sint_p, 0);
mpf_set_si (f, LONG_MIN);
expr = "LONG_MIN";
EXPECT (mpf_fits_slong_p, 1);
mpf_set_si (f, LONG_MIN);
mpf_sub (f, f, f0p5);
expr = "LONG_MIN - 0.5";
EXPECT (mpf_fits_slong_p, 1);
mpf_set_si (f, LONG_MIN);
mpf_sub_ui (f, f, 1L);
expr = "LONG_MIN + 1";
EXPECT (mpf_fits_slong_p, 0);
mpf_set_str_or_abort (f, "0.5", 10);
expr = "0.5";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
EXPECT (mpf_fits_ushort_p, 1);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_str_or_abort (f, "-0.5", 10);
expr = "-0.5";
EXPECT (mpf_fits_ulong_p, 0);
EXPECT (mpf_fits_uint_p, 0);
EXPECT (mpf_fits_ushort_p, 0);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_str_or_abort (f, "1.000000000000000000000000000000000001", 16);
expr = "1.000000000000000000000000000000000001 base 16";
EXPECT (mpf_fits_ulong_p, 1);
EXPECT (mpf_fits_uint_p, 1);
EXPECT (mpf_fits_ushort_p, 1);
EXPECT (mpf_fits_slong_p, 1);
EXPECT (mpf_fits_sint_p, 1);
EXPECT (mpf_fits_sshort_p, 1);
mpf_set_str_or_abort (f, "1@1000", 16);
expr = "1@1000 base 16";
EXPECT (mpf_fits_ulong_p, 0);
EXPECT (mpf_fits_uint_p, 0);
EXPECT (mpf_fits_ushort_p, 0);
EXPECT (mpf_fits_slong_p, 0);
EXPECT (mpf_fits_sint_p, 0);
EXPECT (mpf_fits_sshort_p, 0);
mpf_set_ui (f, 1L);
mpf_mul_2exp (f, f, BITS_PER_ULONG + 1);
mpf_sub_ui (f, f, 1L);
expr = "2^(BITS_PER_ULONG+1) - 1";
EXPECT (mpf_fits_ulong_p, 0);
EXPECT (mpf_fits_uint_p, 0);
EXPECT (mpf_fits_ushort_p, 0);
EXPECT (mpf_fits_slong_p, 0);
EXPECT (mpf_fits_sint_p, 0);
EXPECT (mpf_fits_sshort_p, 0);
mpf_set_ui (f, 1L);
mpf_mul_2exp (f, f, BITS_PER_ULONG + 1);
mpf_sub_ui (f, f, 1L);
mpf_neg (f, f);
expr = "- (2^(BITS_PER_ULONG+1) - 1)";
EXPECT (mpf_fits_ulong_p, 0);
EXPECT (mpf_fits_uint_p, 0);
EXPECT (mpf_fits_ushort_p, 0);
EXPECT (mpf_fits_slong_p, 0);
EXPECT (mpf_fits_sint_p, 0);
EXPECT (mpf_fits_sshort_p, 0);
mpf_set_ui (f, 1L);
mpf_mul_2exp (f, f, BITS_PER_ULONG + 5);
mpf_sub_ui (f, f, 1L);
expr = "2^(BITS_PER_ULONG+5) - 1";
EXPECT (mpf_fits_ulong_p, 0);
EXPECT (mpf_fits_uint_p, 0);
EXPECT (mpf_fits_ushort_p, 0);
EXPECT (mpf_fits_slong_p, 0);
EXPECT (mpf_fits_sint_p, 0);
EXPECT (mpf_fits_sshort_p, 0);
if (error)
abort ();
mpf_clear (f);
mpf_clear (f0p5);
tests_end ();
exit (0);
}
void mpfc_set_c(mpfc_ptr x,uint a,uint b)
{
mpf_set_si(x->Re,a);
mpf_set_si(x->Im,b);
}
void
check_various (void)
{
mpf_t src, trunc, ceil, floor;
int n, i;
mpf_init2 (src, 512L);
mpf_init2 (trunc, 256L);
mpf_init2 (ceil, 256L);
mpf_init2 (floor, 256L);
/* 0 */
mpf_set_ui (src, 0L);
mpf_set_ui (trunc, 0L);
mpf_set_ui (ceil, 0L);
mpf_set_ui (floor, 0L);
check_all (src, trunc, ceil, floor);
/* 1 */
mpf_set_ui (src, 1L);
mpf_set_ui (trunc, 1L);
mpf_set_ui (ceil, 1L);
mpf_set_ui (floor, 1L);
check_all (src, trunc, ceil, floor);
/* 2^1024 */
mpf_set_ui (src, 1L);
mpf_mul_2exp (src, src, 1024L);
mpf_set (trunc, src);
mpf_set (ceil, src);
mpf_set (floor, src);
check_all (src, trunc, ceil, floor);
/* 1/2^1024, fraction only */
mpf_set_ui (src, 1L);
mpf_div_2exp (src, src, 1024L);
mpf_set_si (trunc, 0L);
mpf_set_si (ceil, 1L);
mpf_set_si (floor, 0L);
check_all (src, trunc, ceil, floor);
/* 1/2 */
mpf_set_ui (src, 1L);
mpf_div_2exp (src, src, 1L);
mpf_set_si (trunc, 0L);
mpf_set_si (ceil, 1L);
mpf_set_si (floor, 0L);
check_all (src, trunc, ceil, floor);
/* 123+1/2^64 */
mpf_set_ui (src, 1L);
mpf_div_2exp (src, src, 64L);
mpf_add_ui (src, src, 123L);
mpf_set_si (trunc, 123L);
mpf_set_si (ceil, 124L);
mpf_set_si (floor, 123L);
check_all (src, trunc, ceil, floor);
/* integer of full prec+1 limbs, unchanged */
n = PREC(trunc)+1;
ASSERT_ALWAYS (n <= PREC(src)+1);
EXP(src) = n;
SIZ(src) = n;
for (i = 0; i < SIZ(src); i++)
PTR(src)[i] = i+100;
mpf_set (trunc, src);
mpf_set (ceil, src);
mpf_set (floor, src);
check_all (src, trunc, ceil, floor);
/* full prec+1 limbs, 1 trimmed for integer */
n = PREC(trunc)+1;
ASSERT_ALWAYS (n <= PREC(src)+1);
EXP(src) = n-1;
SIZ(src) = n;
for (i = 0; i < SIZ(src); i++)
PTR(src)[i] = i+200;
EXP(trunc) = n-1;
SIZ(trunc) = n-1;
for (i = 0; i < SIZ(trunc); i++)
PTR(trunc)[i] = i+201;
mpf_set (floor, trunc);
mpf_add_ui (ceil, trunc, 1L);
check_all (src, trunc, ceil, floor);
/* prec+3 limbs, 2 trimmed for size */
n = PREC(trunc)+3;
ASSERT_ALWAYS (n <= PREC(src)+1);
EXP(src) = n;
SIZ(src) = n;
for (i = 0; i < SIZ(src); i++)
PTR(src)[i] = i+300;
EXP(trunc) = n;
SIZ(trunc) = n-2;
for (i = 0; i < SIZ(trunc); i++)
PTR(trunc)[i] = i+302;
mpf_set (floor, trunc);
mpf_set (ceil, trunc);
PTR(ceil)[0]++;
check_all (src, trunc, ceil, floor);
/* prec+4 limbs, 2 trimmed for size, 1 trimmed for integer */
n = PREC(trunc)+4;
ASSERT_ALWAYS (n <= PREC(src)+1);
EXP(src) = n-1;
SIZ(src) = n;
for (i = 0; i < SIZ(src); i++)
PTR(src)[i] = i+400;
EXP(trunc) = n-1;
SIZ(trunc) = n-3;
for (i = 0; i < SIZ(trunc); i++)
PTR(trunc)[i] = i+403;
mpf_set (floor, trunc);
mpf_set (ceil, trunc);
PTR(ceil)[0]++;
check_all (src, trunc, ceil, floor);
/* F.F, carry out of ceil */
EXP(src) = 1;
SIZ(src) = 2;
PTR(src)[0] = GMP_NUMB_MAX;
PTR(src)[1] = GMP_NUMB_MAX;
EXP(trunc) = 1;
SIZ(trunc) = 1;
PTR(trunc)[0] = GMP_NUMB_MAX;
mpf_set (floor, trunc);
EXP(ceil) = 2;
SIZ(ceil) = 1;
PTR(ceil)[0] = 1;
check_all (src, trunc, ceil, floor);
/* FF.F, carry out of ceil */
EXP(src) = 2;
SIZ(src) = 3;
PTR(src)[0] = GMP_NUMB_MAX;
PTR(src)[1] = GMP_NUMB_MAX;
PTR(src)[2] = GMP_NUMB_MAX;
EXP(trunc) = 2;
SIZ(trunc) = 2;
PTR(trunc)[0] = GMP_NUMB_MAX;
PTR(trunc)[1] = GMP_NUMB_MAX;
mpf_set (floor, trunc);
EXP(ceil) = 3;
SIZ(ceil) = 1;
PTR(ceil)[0] = 1;
check_all (src, trunc, ceil, floor);
mpf_clear (src);
mpf_clear (trunc);
mpf_clear (ceil);
mpf_clear (floor);
}
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)
{
int k;
mpf_t one;
mpf_t three;
mpf_t negone;
mpf_t two;
mpf_t negthird;
mpf_t sr12;
mpf_t num;
mpf_t denom;
mpf_t tmp;
FILE *f;
if (argc < 2)
{
printf("%s <prec> [file]\n", argv[0]);
return 1;
}
PREC = atol(argv[1]);
if (argc > 2)
f = fopen(argv[2], "w");
mpf_set_default_prec(4 * PREC);
mpf_init(pi);
mpf_init(one);
mpf_init(two);
mpf_init(three);
mpf_init(negone);
mpf_init(negthird);
mpf_init(sr12);
mpf_init(num);
mpf_init(denom);
mpf_init(tmp);
mpf_set_ui(pi, 0);
mpf_set_ui(one, 1);
mpf_set_ui(two, 2);
mpf_set_ui(three, 3);
mpf_set_si(negone, -1);
mpf_sqrt_ui(sr12, 12);
mpf_div(negthird, negone, three);
mpf_set_ui(num, 1);
mpf_set_ui(denom, 1);
printf("Alloc\r");
fflush(stdout);
for (k = 0; k < PREC; k++)
{
mpf_pow_ui(num, negthird, k);
mpf_set_ui(denom, 2*k + 1);
mpf_div(tmp, num, denom);
mpf_add(pi, pi, tmp);
//if (k % 50 == 0)
{
double progress = k;
progress /= PREC;
progress *= 100;
printf("\rProgress: %.2lf\r", progress);
fflush(stdout);
}
}
mpf_mul(pi, pi, sr12);
gmp_printf("%.*Ff\n", PREC, pi);
if (f)
gmp_fprintf(f, "%.*Ff", PREC, pi);
}
