libmaus2::math::GmpFloat & libmaus2::math::GmpFloat::operator-() { #if defined(LIBMAUS2_HAVE_GMP) mpf_neg(decode(v),decode(v)); #endif return *this; }
void all (mpf_ptr f, int want) { one (f, want); mpf_neg (f, f); one (f, want); }
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 check_all (mpf_ptr src, mpf_ptr trunc, mpf_ptr ceil, mpf_ptr floor) { /* some of these values are generated with direct field assignments */ MPF_CHECK_FORMAT (src); MPF_CHECK_FORMAT (trunc); MPF_CHECK_FORMAT (ceil); MPF_CHECK_FORMAT (floor); check_one (src, trunc, ceil, floor); mpf_neg (src, src); mpf_neg (trunc, trunc); mpf_neg (ceil, ceil); mpf_neg (floor, floor); check_one (src, trunc, floor, ceil); }
void check_rand (void) { unsigned long min_prec = __GMPF_BITS_TO_PREC (1); gmp_randstate_t rands; mpf_t got, u; unsigned long prec, v; int i; /* The nails code in mpf_mul_ui currently isn't exact, so suppress these tests for now. */ if (BITS_PER_UI > GMP_NUMB_BITS) return; mpf_init (got); mpf_init (u); gmp_randinit_default(rands); for (i = 0; i < 200; i++) { /* got precision */ prec = min_prec + gmp_urandomm_ui (rands, 15L); refmpf_set_prec_limbs (got, prec); /* u precision */ prec = min_prec + gmp_urandomm_ui (rands, 15L); refmpf_set_prec_limbs (u, prec); /* u, possibly negative */ mpf_rrandomb (u, rands, PREC(u), (mp_exp_t) 20); if (gmp_urandomb_ui (rands, 1L)) mpf_neg (u, u); /* v, 0 to BITS_PER_ULONG bits (inclusive) */ prec = gmp_urandomm_ui (rands, BITS_PER_ULONG+1); v = gmp_urandomb_ui (rands, prec); if ((i % 2) == 0) { /* separate */ mpf_mul_ui (got, u, v); check_one ("separate", got, u, v); } else { /* overlap */ prec = refmpf_set_overlap (got, u); mpf_mul_ui (got, got, v); check_one ("overlap src==dst", got, u, v); mpf_set_prec_raw (got, prec); } } mpf_clear (got); mpf_clear (u); gmp_randclear(rands); }
static void Pks (mpf_t p, mpf_t x) { double dt; /* temp double */ mpf_set (p, x); mpf_mul (p, p, p); /* p = x^2 */ mpf_mul_ui (p, p, 2); /* p = 2*x^2 */ mpf_neg (p, p); /* p = -2*x^2 */ /* No pow() in gmp. Use doubles. */ /* FIXME: Use exp()? */ dt = pow (M_E, mpf_get_d (p)); mpf_set_d (p, dt); mpf_ui_sub (p, 1, p); }
/** * rasqal_xsd_decimal_negate: * @result: result variable * @a: argment decimal * * Negate an XSD Decimal * * Return value: non-0 on failure **/ int rasqal_xsd_decimal_negate(rasqal_xsd_decimal* result, rasqal_xsd_decimal* a) { int rc=0; rasqal_xsd_decimal_clear_string(result); #if defined(RASQAL_DECIMAL_C99) || defined(RASQAL_DECIMAL_NONE) result->raw = -a->raw; #endif #ifdef RASQAL_DECIMAL_MPFR mpfr_neg(result->raw, a->raw, result->rounding); #endif #ifdef RASQAL_DECIMAL_GMP mpf_neg(result->raw, a->raw); #endif return rc; }
/* Exercise calls mpf(x,x,x) */ void check_reuse_three (void) { unsigned long min_prec = __GMPF_BITS_TO_PREC (1); gmp_randstate_ptr rands = RANDS; unsigned long result_prec, input_prec, set_prec; mpf_t got; int i; mpf_init (got); for (i = 0; i < 8; i++) { result_prec = min_prec + gmp_urandomm_ui (rands, 15L); input_prec = min_prec + gmp_urandomm_ui (rands, 15L); set_prec = MAX (result_prec, input_prec); refmpf_set_prec_limbs (got, set_prec); /* input, non-zero, possibly negative */ PREC(got) = input_prec; do { mpf_random2 (got, input_prec, (mp_exp_t) 20); } while (SIZ(got) == 0); if (gmp_urandomb_ui (rands, 1L)) mpf_neg (got, got); PREC(got) = result_prec; mpf_div (got, got, got); /* expect exactly 1.0 always */ ASSERT_ALWAYS (mpf_cmp_ui (got, 1L) == 0); PREC(got) = set_prec; } mpf_clear (got); }
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); }
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 main (int argc, char **argv) { #if GMP_NAIL_BITS == 0 static const struct { int f_base; const char *f; int z_base; const char *want_num; const char *want_den; } data[] = { { -2, "0", 16, "0", "1" }, { -2, "1", 16, "1", "1" }, { -2, "1@1", 16, "2", "1" }, { -2, "1@2", 16, "4", "1" }, { -2, "1@3", 16, "8", "1" }, { -2, "1@30", 16, "40000000", "1" }, { -2, "1@31", 16, "80000000", "1" }, { -2, "1@32", 16, "100000000", "1" }, { -2, "1@33", 16, "200000000", "1" }, { -2, "1@34", 16, "400000000", "1" }, { -2, "1@62", 16, "4000000000000000", "1" }, { -2, "1@63", 16, "8000000000000000", "1" }, { -2, "1@64", 16, "10000000000000000", "1" }, { -2, "1@65", 16, "20000000000000000", "1" }, { -2, "1@66", 16, "40000000000000000", "1" }, { -2, "1@126", 16, "40000000000000000000000000000000", "1" }, { -2, "1@127", 16, "80000000000000000000000000000000", "1" }, { -2, "1@128", 16, "100000000000000000000000000000000", "1" }, { -2, "1@129", 16, "200000000000000000000000000000000", "1" }, { -2, "1@130", 16, "400000000000000000000000000000000", "1" }, { -2, "1@-1", 16, "1", "2" }, { -2, "1@-2", 16, "1", "4" }, { -2, "1@-3", 16, "1", "8" }, { -2, "1@-30", 16, "1", "40000000" }, { -2, "1@-31", 16, "1", "80000000" }, { -2, "1@-32", 16, "1", "100000000" }, { -2, "1@-33", 16, "1", "200000000" }, { -2, "1@-34", 16, "1", "400000000" }, { -2, "1@-62", 16, "1", "4000000000000000" }, { -2, "1@-63", 16, "1", "8000000000000000" }, { -2, "1@-64", 16, "1", "10000000000000000" }, { -2, "1@-65", 16, "1", "20000000000000000" }, { -2, "1@-66", 16, "1", "40000000000000000" }, { -2, "1@-126", 16, "1", "40000000000000000000000000000000" }, { -2, "1@-127", 16, "1", "80000000000000000000000000000000" }, { -2, "1@-128", 16, "1", "100000000000000000000000000000000" }, { -2, "1@-129", 16, "1", "200000000000000000000000000000000" }, { -2, "1@-130", 16, "1", "400000000000000000000000000000000" }, { -2, "1@-30", 16, "1", "40000000" }, { -2, "1@-31", 16, "1", "80000000" }, { -2, "1@-32", 16, "1", "100000000" }, { -2, "1@-33", 16, "1", "200000000" }, { -2, "1@-34", 16, "1", "400000000" }, { -2, "11@-62", 16, "3", "4000000000000000" }, { -2, "11@-63", 16, "3", "8000000000000000" }, { -2, "11@-64", 16, "3", "10000000000000000" }, { -2, "11@-65", 16, "3", "20000000000000000" }, { -2, "11@-66", 16, "3", "40000000000000000" }, { 16, "80000000.00000001", 16, "8000000000000001", "100000000" }, { 16, "80000000.00000008", 16, "1000000000000001", "20000000" }, { 16, "80000000.8", 16, "100000001", "2" }, }; mpf_t f; mpq_t got; mpz_t want_num, want_den; int i, neg; tests_start (); mpf_init2 (f, 1024L); mpq_init (got); mpz_init (want_num); mpz_init (want_den); for (i = 0; i < numberof (data); i++) { for (neg = 0; neg <= 1; neg++) { mpf_set_str_or_abort (f, data[i].f, data[i].f_base); mpz_set_str_or_abort (want_num, data[i].want_num, data[i].z_base); mpz_set_str_or_abort (want_den, data[i].want_den, data[i].z_base); if (neg) { mpf_neg (f, f); mpz_neg (want_num, want_num); } mpq_set_f (got, f); MPQ_CHECK_FORMAT (got); if (mpz_cmp (mpq_numref(got), want_num) != 0 || mpz_cmp (mpq_denref(got), want_den) != 0) { printf ("wrong at data[%d]\n", i); printf (" f_base %d, z_base %d\n", data[i].f_base, data[i].z_base); printf (" f \"%s\" hex ", data[i].f); mpf_out_str (stdout, 16, 0, f); printf ("\n"); printf (" want num 0x"); mpz_out_str (stdout, 16, want_num); printf ("\n"); printf (" want den 0x"); mpz_out_str (stdout, 16, want_den); printf ("\n"); printf (" got num 0x"); mpz_out_str (stdout, 16, mpq_numref(got)); printf ("\n"); printf (" got den 0x"); mpz_out_str (stdout, 16, mpq_denref(got)); printf ("\n"); abort (); } } } mpf_clear (f); mpq_clear (got); mpz_clear (want_num); mpz_clear (want_den); tests_end (); #endif exit (0); }
// See Cohen; my D is -D in his notation. size_t pbc_hilbert(mpz_t **arr, int D) { int a, b; int t; int B = (int)floor(sqrt((double) D / 3.0)); mpc_t alpha; mpc_t j; mpf_t sqrtD; mpf_t f0; darray_t Pz; mpc_t z0, z1, z2; double d = 1.0; int h = 1; int jcount = 1; // Compute required precision. b = D % 2; for (;;) { t = (b*b + D) / 4; a = b; if (a <= 1) { a = 1; goto step535_4; } step535_3: if (!(t % a)) { jcount++; if ((a == b) || (a*a == t) || !b) { d += 1.0 / ((double) a); h++; } else { d += 2.0 / ((double) a); h+=2; } } step535_4: a++; if (a * a <= t) { goto step535_3; } else { b += 2; if (b > B) break; } } //printf("modulus: %f\n", exp(3.14159265358979 * sqrt(D)) * d * 0.5); d *= sqrt(D) * 3.14159265358979 / log(2); precision_init((int)(d + 34)); pbc_info("class number %d, %d bit precision", h, (int) d + 34); darray_init(Pz); mpc_init(alpha); mpc_init(j); mpc_init(z0); mpc_init(z1); mpc_init(z2); mpf_init(sqrtD); mpf_init(f0); mpf_sqrt_ui(sqrtD, D); b = D % 2; h = 0; for (;;) { t = (b*b + D) / 4; if (b > 1) { a = b; } else { a = 1; } step3: if (t % a) { step4: a++; if (a * a <= t) goto step3; } else { // a, b, t/a are coeffs of an appropriate primitive reduced positive // definite form. // Compute j((-b + sqrt{-D})/(2a)). h++; pbc_info("[%d/%d] a b c = %d %d %d", h, jcount, a, b, t/a); mpf_set_ui(f0, 1); mpf_div_ui(f0, f0, 2 * a); mpf_mul(mpc_im(alpha), sqrtD, f0); mpf_mul_ui(f0, f0, b); mpf_neg(mpc_re(alpha), f0); compute_j(j, alpha); if (0) { int i; for (i=Pz->count - 1; i>=0; i--) { printf("P %d = ", i); mpc_out_str(stdout, 10, 4, Pz->item[i]); printf("\n"); } } if (a == b || a * a == t || !b) { // P *= X - j int i, n; mpc_ptr p0; p0 = (mpc_ptr) pbc_malloc(sizeof(mpc_t)); mpc_init(p0); mpc_neg(p0, j); n = Pz->count; if (n) { mpc_set(z1, Pz->item[0]); mpc_add(Pz->item[0], z1, p0); for (i=1; i<n; i++) { mpc_mul(z0, z1, p0); mpc_set(z1, Pz->item[i]); mpc_add(Pz->item[i], z1, z0); } mpc_mul(p0, p0, z1); } darray_append(Pz, p0); } else { // P *= X^2 - 2 Re(j) X + |j|^2 int i, n; mpc_ptr p0, p1; p0 = (mpc_ptr) pbc_malloc(sizeof(mpc_t)); p1 = (mpc_ptr) pbc_malloc(sizeof(mpc_t)); mpc_init(p0); mpc_init(p1); // p1 = - 2 Re(j) mpf_mul_ui(f0, mpc_re(j), 2); mpf_neg(f0, f0); mpf_set(mpc_re(p1), f0); // p0 = |j|^2 mpf_mul(f0, mpc_re(j), mpc_re(j)); mpf_mul(mpc_re(p0), mpc_im(j), mpc_im(j)); mpf_add(mpc_re(p0), mpc_re(p0), f0); n = Pz->count; if (!n) { } else if (n == 1) { mpc_set(z1, Pz->item[0]); mpc_add(Pz->item[0], z1, p1); mpc_mul(p1, z1, p1); mpc_add(p1, p1, p0); mpc_mul(p0, p0, z1); } else { mpc_set(z2, Pz->item[0]); mpc_set(z1, Pz->item[1]); mpc_add(Pz->item[0], z2, p1); mpc_mul(z0, z2, p1); mpc_add(Pz->item[1], z1, z0); mpc_add(Pz->item[1], Pz->item[1], p0); for (i=2; i<n; i++) { mpc_mul(z0, z1, p1); mpc_mul(alpha, z2, p0); mpc_set(z2, z1); mpc_set(z1, Pz->item[i]); mpc_add(alpha, alpha, z0); mpc_add(Pz->item[i], z1, alpha); } mpc_mul(z0, z2, p0); mpc_mul(p1, p1, z1); mpc_add(p1, p1, z0); mpc_mul(p0, p0, z1); } darray_append(Pz, p1); darray_append(Pz, p0); } goto step4; } b+=2; if (b > B) break; } // Round polynomial and assign. int k = 0; { *arr = pbc_malloc(sizeof(mpz_t) * (Pz->count + 1)); int i; for (i=Pz->count - 1; i>=0; i--) { if (mpf_sgn(mpc_re(Pz->item[i])) < 0) { mpf_set_d(f0, -0.5); } else { mpf_set_d(f0, 0.5); } mpf_add(f0, f0, mpc_re(Pz->item[i])); mpz_init((*arr)[k]); mpz_set_f((*arr)[k], f0); k++; mpc_clear(Pz->item[i]); pbc_free(Pz->item[i]); } mpz_init((*arr)[k]); mpz_set_ui((*arr)[k], 1); k++; } darray_clear(Pz); mpc_clear(z0); mpc_clear(z1); mpc_clear(z2); mpf_clear(f0); mpf_clear(sqrtD); mpc_clear(alpha); mpc_clear(j); precision_clear(); return k; }
/* Since MPFR-3.0, return the usual inexact value. The erange flag is set if an error occurred in the conversion (y is NaN, +Inf, or -Inf that have no equivalent in mpf) */ int mpfr_get_f (mpf_ptr x, mpfr_srcptr y, mpfr_rnd_t rnd_mode) { int inex; mp_size_t sx, sy; mpfr_prec_t precx, precy; mp_limb_t *xp; int sh; if (MPFR_UNLIKELY(MPFR_IS_SINGULAR(y))) { if (MPFR_IS_ZERO(y)) { mpf_set_ui (x, 0); return 0; } else if (MPFR_IS_NAN (y)) { MPFR_SET_ERANGEFLAG (); return 0; } else /* y is plus infinity (resp. minus infinity), set x to the maximum value (resp. the minimum value) in precision PREC(x) */ { int i; mp_limb_t *xp; MPFR_SET_ERANGEFLAG (); /* To this day, [mp_exp_t] and mp_size_t are #defined as the same type */ EXP (x) = MP_SIZE_T_MAX; sx = PREC (x); SIZ (x) = sx; xp = PTR (x); for (i = 0; i < sx; i++) xp[i] = MPFR_LIMB_MAX; if (MPFR_IS_POS (y)) return -1; else { mpf_neg (x, x); return +1; } } } sx = PREC(x); /* number of limbs of the mantissa of x */ precy = MPFR_PREC(y); precx = (mpfr_prec_t) sx * GMP_NUMB_BITS; sy = MPFR_LIMB_SIZE (y); xp = PTR (x); /* since mpf numbers are represented in base 2^GMP_NUMB_BITS, we loose -EXP(y) % GMP_NUMB_BITS bits in the most significant limb */ sh = MPFR_GET_EXP(y) % GMP_NUMB_BITS; sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh; MPFR_ASSERTD (sh >= 0); if (precy + sh <= precx) /* we can copy directly */ { mp_size_t ds; MPFR_ASSERTN (sx >= sy); ds = sx - sy; if (sh != 0) { mp_limb_t out; out = mpn_rshift (xp + ds, MPFR_MANT(y), sy, sh); MPFR_ASSERTN (ds > 0 || out == 0); if (ds > 0) xp[--ds] = out; } else MPN_COPY (xp + ds, MPFR_MANT (y), sy); if (ds > 0) MPN_ZERO (xp, ds); EXP(x) = (MPFR_GET_EXP(y) + sh) / GMP_NUMB_BITS; inex = 0; } else /* we have to round to precx - sh bits */ { mpfr_t z; mp_size_t sz; /* Recall that precx = (mpfr_prec_t) sx * GMP_NUMB_BITS, thus removing sh bits (sh < GMP_NUMB_BITSS) won't reduce the number of limbs. */ mpfr_init2 (z, precx - sh); sz = MPFR_LIMB_SIZE (z); MPFR_ASSERTN (sx == sz); inex = mpfr_set (z, y, rnd_mode); /* warning, sh may change due to rounding, but then z is a power of two, thus we can safely ignore its last bit which is 0 */ sh = MPFR_GET_EXP(z) % GMP_NUMB_BITS; sh = sh <= 0 ? - sh : GMP_NUMB_BITS - sh; MPFR_ASSERTD (sh >= 0); if (sh != 0) { mp_limb_t out; out = mpn_rshift (xp, MPFR_MANT(z), sz, sh); /* If sh hasn't changed, it is the number of the non-significant bits in the lowest limb of z. Therefore out == 0. */ MPFR_ASSERTD (out == 0); (void) out; /* avoid a warning */ } else MPN_COPY (xp, MPFR_MANT(z), sz); EXP(x) = (MPFR_GET_EXP(z) + sh) / GMP_NUMB_BITS; mpfr_clear (z); } /* set size and sign */ SIZ(x) = (MPFR_FROM_SIGN_TO_INT(MPFR_SIGN(y)) < 0) ? -sx : sx; return inex; }
extern void _jl_mpf_neg(mpf_t* rop, mpf_t* op1) { mpf_neg(*rop, *op1); }
void mpf_ui_sub (mpf_ptr r, unsigned long int u, mpf_srcptr v) { #if 1 __mpf_struct uu; mp_limb_t ul; if (u == 0) { mpf_neg (r, v); return; } ul = u; uu._mp_size = 1; uu._mp_d = &ul; uu._mp_exp = 1; mpf_sub (r, &uu, v); #else mp_srcptr up, vp; mp_ptr rp, tp; mp_size_t usize, vsize, rsize; mp_size_t prec; mp_exp_t uexp; mp_size_t ediff; int negate; mp_limb_t ulimb; TMP_DECL; vsize = v->_mp_size; /* Handle special cases that don't work in generic code below. */ if (u == 0) { mpf_neg (r, v); return; } if (vsize == 0) { mpf_set_ui (r, u); return; } /* If signs of U and V are different, perform addition. */ if (vsize < 0) { __mpf_struct v_negated; v_negated._mp_size = -vsize; v_negated._mp_exp = v->_mp_exp; v_negated._mp_d = v->_mp_d; mpf_add_ui (r, &v_negated, u); return; } /* Signs are now known to be the same. */ ASSERT (vsize > 0); ulimb = u; /* Make U be the operand with the largest exponent. */ negate = 1 < v->_mp_exp; prec = r->_mp_prec + negate; rp = r->_mp_d; if (negate) { usize = vsize; vsize = 1; up = v->_mp_d; vp = &ulimb; uexp = v->_mp_exp; ediff = uexp - 1; /* If U extends beyond PREC, ignore the part that does. */ if (usize > prec) { up += usize - prec; usize = prec; } ASSERT (ediff > 0); } else { vp = v->_mp_d; ediff = 1 - v->_mp_exp; /* Ignore leading limbs in U and V that are equal. Doing this helps increase the precision of the result. */ if (ediff == 0 && ulimb == vp[vsize - 1]) { usize = 0; vsize--; uexp = 0; /* Note that V might now have leading zero limbs. In that case we have to adjust uexp. */ for (;;) { if (vsize == 0) { rsize = 0; uexp = 0; goto done; } if ( vp[vsize - 1] != 0) break; vsize--, uexp--; } } else { usize = 1; uexp = 1; up = &ulimb; } ASSERT (usize <= prec); } if (ediff >= prec) { /* V completely cancelled. */ if (rp != up) MPN_COPY (rp, up, usize); rsize = usize; } else { /* If V extends beyond PREC, ignore the part that does. Note that this can make vsize neither zero nor negative. */ if (vsize + ediff > prec) { vp += vsize + ediff - prec; vsize = prec - ediff; } /* Locate the least significant non-zero limb in (the needed parts of) U and V, to simplify the code below. */ ASSERT (vsize > 0); for (;;) { if (vp[0] != 0) break; vp++, vsize--; if (vsize == 0) { MPN_COPY (rp, up, usize); rsize = usize; goto done; } } for (;;) { if (usize == 0) { MPN_COPY (rp, vp, vsize); rsize = vsize; negate ^= 1; goto done; } if (up[0] != 0) break; up++, usize--; } ASSERT (usize > 0 && vsize > 0); TMP_MARK; tp = TMP_ALLOC_LIMBS (prec); /* uuuu | uuuu | uuuu | uuuu | uuuu */ /* vvvvvvv | vv | vvvvv | v | vv */ if (usize > ediff) { /* U and V partially overlaps. */ if (ediff == 0) { ASSERT (usize == 1 && vsize >= 1 && ulimb == *up); /* usize is 1>ediff, vsize >= 1 */ if (1 < vsize) { /* u */ /* vvvvvvv */ rsize = vsize; vsize -= 1; /* mpn_cmp (up, vp + vsize - usize, usize) > 0 */ if (ulimb > vp[vsize]) { tp[vsize] = ulimb - vp[vsize] - 1; ASSERT_CARRY (mpn_neg (tp, vp, vsize)); } else { /* vvvvvvv */ /* Swap U and V. */ /* u */ MPN_COPY (tp, vp, vsize); tp[vsize] = vp[vsize] - ulimb; negate = 1; } } else /* vsize == usize == 1 */ { /* u */ /* v */ rsize = 1; negate = ulimb < vp[0]; tp[0] = negate ? vp[0] - ulimb: ulimb - vp[0]; } } else { ASSERT (vsize + ediff <= usize); ASSERT (vsize == 1 && usize >= 2 && ulimb == *vp); { /* uuuu */ /* v */ mp_size_t size; size = usize - ediff - 1; MPN_COPY (tp, up, size); ASSERT_NOCARRY (mpn_sub_1 (tp + size, up + size, usize - size, ulimb)); rsize = usize; } /* Other cases are not possible */ /* uuuu */ /* vvvvv */ } } else { /* uuuu */ /* vv */ mp_size_t size, i; ASSERT_CARRY (mpn_neg (tp, vp, vsize)); rsize = vsize + ediff; size = rsize - usize; for (i = vsize; i < size; i++) tp[i] = GMP_NUMB_MAX; ASSERT_NOCARRY (mpn_sub_1 (tp + size, up, usize, CNST_LIMB (1))); } /* Full normalize. Optimize later. */ while (rsize != 0 && tp[rsize - 1] == 0) { rsize--; uexp--; } MPN_COPY (rp, tp, rsize); TMP_FREE; } done: r->_mp_size = negate ? -rsize : rsize; r->_mp_exp = uexp; #endif }
int pi_worker( unsigned long start_x , unsigned long end_x ) { mpf_t _4 ; unsigned long x ; int flag ; mpf_t pi_incr ; mpf_t pi ; char output[ 1024 + 1 ] ; DC4CSetAppLogFile( "pi_worker" ); SetLogLevel( LOGLEVEL_INFO ); InfoLog( __FILE__ , __LINE__ , "pi_worker" ); if( start_x % 2 == 0 ) start_x++; if( end_x % 2 == 0 ) end_x++; if( start_x < 1 ) start_x = 1 ; if( end_x < start_x ) end_x = start_x ; mpf_init_set_d( _4 , 4.00 ); mpf_init( pi_incr ); mpf_init( pi ); /* 0 1 2 3 4 1234567890123456789012345678901234567890 1 1 1 1 1 PI = 4 * ( _ - _ + _ - _ + _ ... ) = 3.1415926535897932384626433832795 1 3 5 7 9 4 1000000000 3.14159265158640477943 14.962s 1000000000 3.14159265557624002834 56.315s 4 100000000 3.14159263358945602263 1.460s 100000000 3.14159267358843756024 5.888s 10000000 3.14159285358961767296 0.621s 1000000 3.14159465358577968703 0.091s 100000 3.14161265318979787768 0.011s 10000 3.14179261359579270235 0.003s */ mpf_set_d( pi , 0.00 ); flag = ((start_x/2)%2)?'-':' ' ; for( x = start_x ; x <= end_x ; x += 2 ) { mpf_div_ui( pi_incr , _4 , x ); if( flag == '-' ) mpf_neg( pi_incr , pi_incr ); mpf_add( pi , pi , pi_incr ); flag = '-' + ' ' - flag ; } memset( output , 0x00 , sizeof(output) ); gmp_snprintf( output , sizeof(output)-1 , "%.Ff" , pi ); InfoLog( __FILE__ , __LINE__ , "pi_worker() - start_x[%lu] end_x[%lu] - PI[%s]" , start_x , end_x , output ); DC4CSetReplyInfo( output ); mpf_clear( _4 ); mpf_clear( pi_incr ); mpf_clear( pi ); return 0; }
void mpf_sub (mpf_ptr r, mpf_srcptr u, mpf_srcptr v) { mp_srcptr up, vp; mp_ptr rp, tp; mp_size_t usize, vsize, rsize; mp_size_t prec; mp_exp_t exp; mp_size_t ediff; int negate; TMP_DECL; usize = u->_mp_size; vsize = v->_mp_size; /* Handle special cases that don't work in generic code below. */ if (usize == 0) { mpf_neg (r, v); return; } if (vsize == 0) { if (r != u) mpf_set (r, u); return; } /* If signs of U and V are different, perform addition. */ if ((usize ^ vsize) < 0) { __mpf_struct v_negated; v_negated._mp_size = -vsize; v_negated._mp_exp = v->_mp_exp; v_negated._mp_d = v->_mp_d; mpf_add (r, u, &v_negated); return; } TMP_MARK; /* Signs are now known to be the same. */ negate = usize < 0; /* Make U be the operand with the largest exponent. */ if (u->_mp_exp < v->_mp_exp) { mpf_srcptr t; t = u; u = v; v = t; negate ^= 1; usize = u->_mp_size; vsize = v->_mp_size; } usize = ABS (usize); vsize = ABS (vsize); up = u->_mp_d; vp = v->_mp_d; rp = r->_mp_d; prec = r->_mp_prec + 1; exp = u->_mp_exp; ediff = u->_mp_exp - v->_mp_exp; /* If ediff is 0 or 1, we might have a situation where the operands are extremely close. We need to scan the operands from the most significant end ignore the initial parts that are equal. */ if (ediff <= 1) { if (ediff == 0) { /* Skip leading limbs in U and V that are equal. */ if (up[usize - 1] == vp[vsize - 1]) { /* This loop normally exits immediately. Optimize for that. */ do { usize--; vsize--; exp--; if (usize == 0) { /* u cancels high limbs of v, result is rest of v */ negate ^= 1; cancellation: /* strip high zeros before truncating to prec */ while (vsize != 0 && vp[vsize - 1] == 0) { vsize--; exp--; } if (vsize > prec) { vp += vsize - prec; vsize = prec; } MPN_COPY_INCR (rp, vp, vsize); rsize = vsize; goto done; } if (vsize == 0) { vp = up; vsize = usize; goto cancellation; } } while (up[usize - 1] == vp[vsize - 1]); } if (up[usize - 1] < vp[vsize - 1]) { /* For simplicity, swap U and V. Note that since the loop above wouldn't have exited unless up[usize - 1] and vp[vsize - 1] were non-equal, this if-statement catches all cases where U is smaller than V. */ MPN_SRCPTR_SWAP (up,usize, vp,vsize); negate ^= 1; /* negating ediff not necessary since it is 0. */ } /* Check for x+1 00000000 ... x ffffffff ... */ if (up[usize - 1] != vp[vsize - 1] + 1) goto general_case; usize--; vsize--; exp--; } else /* ediff == 1 */ { /* Check for 1 00000000 ... 0 ffffffff ... */ if (up[usize - 1] != 1 || vp[vsize - 1] != GMP_NUMB_MAX || (usize >= 2 && up[usize - 2] != 0)) goto general_case; usize--; exp--; } /* Skip sequences of 00000000/ffffffff */ while (vsize != 0 && usize != 0 && up[usize - 1] == 0 && vp[vsize - 1] == GMP_NUMB_MAX) { usize--; vsize--; exp--; } if (usize == 0) { while (vsize != 0 && vp[vsize - 1] == GMP_NUMB_MAX) { vsize--; exp--; } } if (usize > prec - 1) { up += usize - (prec - 1); usize = prec - 1; } if (vsize > prec - 1) { vp += vsize - (prec - 1); vsize = prec - 1; } tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB); { mp_limb_t cy_limb; if (vsize == 0) { mp_size_t size, i; size = usize; for (i = 0; i < size; i++) tp[i] = up[i]; tp[size] = 1; rsize = size + 1; exp++; goto normalize; } if (usize == 0) { mp_size_t size, i; size = vsize; for (i = 0; i < size; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; cy_limb = 1 - mpn_add_1 (tp, tp, vsize, (mp_limb_t) 1); rsize = vsize; if (cy_limb == 0) { tp[rsize] = 1; rsize++; exp++; } goto normalize; } if (usize >= vsize) { /* uuuu */ /* vv */ mp_size_t size; size = usize - vsize; MPN_COPY (tp, up, size); cy_limb = mpn_sub_n (tp + size, up + size, vp, vsize); rsize = usize; } else /* (usize < vsize) */ { /* uuuu */ /* vvvvvvv */ mp_size_t size, i; size = vsize - usize; for (i = 0; i < size; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; cy_limb = mpn_sub_n (tp + size, up, vp + size, usize); cy_limb+= mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1); cy_limb-= mpn_add_1 (tp, tp, vsize, (mp_limb_t) 1); rsize = vsize; } if (cy_limb == 0) { tp[rsize] = 1; rsize++; exp++; } goto normalize; } } general_case: /* If U extends beyond PREC, ignore the part that does. */ if (usize > prec) { up += usize - prec; usize = prec; } /* If V extends beyond PREC, ignore the part that does. Note that this may make vsize negative. */ if (vsize + ediff > prec) { vp += vsize + ediff - prec; vsize = prec - ediff; } /* Allocate temp space for the result. Allocate just vsize + ediff later??? */ tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB); if (ediff >= prec) { /* V completely cancelled. */ if (tp != up) MPN_COPY (rp, up, usize); rsize = usize; } else { /* Locate the least significant non-zero limb in (the needed parts of) U and V, to simplify the code below. */ for (;;) { if (vsize == 0) { MPN_COPY (rp, up, usize); rsize = usize; goto done; } if (vp[0] != 0) break; vp++, vsize--; } for (;;) { if (usize == 0) { MPN_COPY (rp, vp, vsize); rsize = vsize; negate ^= 1; goto done; } if (up[0] != 0) break; up++, usize--; } /* uuuu | uuuu | uuuu | uuuu | uuuu */ /* vvvvvvv | vv | vvvvv | v | vv */ if (usize > ediff) { /* U and V partially overlaps. */ if (ediff == 0) { /* Have to compare the leading limbs of u and v to determine whether to compute u - v or v - u. */ if (usize >= vsize) { /* uuuu */ /* vv */ mp_size_t size; size = usize - vsize; MPN_COPY (tp, up, size); mpn_sub_n (tp + size, up + size, vp, vsize); rsize = usize; } else /* (usize < vsize) */ { /* uuuu */ /* vvvvvvv */ mp_size_t size, i; size = vsize - usize; tp[0] = -vp[0] & GMP_NUMB_MASK; for (i = 1; i < size; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; mpn_sub_n (tp + size, up, vp + size, usize); mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1); rsize = vsize; } } else { if (vsize + ediff <= usize) { /* uuuu */ /* v */ mp_size_t size; size = usize - ediff - vsize; MPN_COPY (tp, up, size); mpn_sub (tp + size, up + size, usize - size, vp, vsize); rsize = usize; } else { /* uuuu */ /* vvvvv */ mp_size_t size, i; size = vsize + ediff - usize; tp[0] = -vp[0] & GMP_NUMB_MASK; for (i = 1; i < size; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; mpn_sub (tp + size, up, usize, vp + size, usize - ediff); mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1); rsize = vsize + ediff; } } } else { /* uuuu */ /* vv */ mp_size_t size, i; size = vsize + ediff - usize; tp[0] = -vp[0] & GMP_NUMB_MASK; for (i = 1; i < vsize; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; for (i = vsize; i < size; i++) tp[i] = GMP_NUMB_MAX; mpn_sub_1 (tp + size, up, usize, (mp_limb_t) 1); rsize = size + usize; } normalize: /* Full normalize. Optimize later. */ while (rsize != 0 && tp[rsize - 1] == 0) { rsize--; exp--; } MPN_COPY (rp, tp, rsize); } done: r->_mp_size = negate ? -rsize : rsize; if (rsize == 0) exp = 0; r->_mp_exp = exp; TMP_FREE; }
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 check_rand (void) { unsigned long min_prec = __GMPF_BITS_TO_PREC (1); gmp_randstate_ptr rands = RANDS; unsigned long prec; mpf_t got, u, v; int i; mpf_init (got); mpf_init (u); mpf_init (v); /* separate */ for (i = 0; i < 100; i++) { /* got precision */ prec = min_prec + gmp_urandomm_ui (rands, 15L); refmpf_set_prec_limbs (got, prec); /* u */ prec = min_prec + gmp_urandomm_ui (rands, 15L); refmpf_set_prec_limbs (u, prec); do { mpf_random2 (u, PREC(u), (mp_exp_t) 20); } while (SIZ(u) == 0); if (gmp_urandomb_ui (rands, 1L)) mpf_neg (u, u); /* v */ prec = min_prec + gmp_urandomm_ui (rands, 15L); refmpf_set_prec_limbs (v, prec); do { mpf_random2 (v, PREC(v), (mp_exp_t) 20); } while (SIZ(v) == 0); if (gmp_urandomb_ui (rands, 1L)) mpf_neg (v, v); switch (i % 3) { case 0: mpf_div (got, u, v); check_one ("separate", got, u, v); break; case 1: prec = refmpf_set_overlap (got, u); mpf_div (got, got, v); check_one ("dst == u", got, u, v); mpf_set_prec_raw (got, prec); break; case 2: prec = refmpf_set_overlap (got, v); mpf_div (got, u, got); check_one ("dst == v", got, u, v); mpf_set_prec_raw (got, prec); break; } } mpf_clear (got); mpf_clear (u); mpf_clear (v); }
Float Float::operator-() const { Float result; mpf_neg(result.value, value); return result; }
//------------------------------------------------------------------------------ // Name: //------------------------------------------------------------------------------ knumber_base *knumber_float::neg() { mpf_neg(mpf_, mpf_); return this; }
// only (exp(log(gamma(a)))) for now int mpf_lngamma(mp_float * a, mp_float * b) { int oldeps, eps, err, n, accuracy; size_t A; mp_float z, ONE, factrl, e, pi, t1, t2, t3, sum; err = MP_OKAY; if (mpf_iszero(a)) { // raise singularity error return MP_VAL; } // Check is expensive and inexact. // if(mpf_isint(a){...} // very near zero if (a->exp + a->radix < -(a->radix)) { if ((err = mpf_ln(a, b)) != MP_OKAY) { return err; } return err; } oldeps = a->radix; if (reflection == 1) { // angst-allowance seemed not necessary // TODO: check if that is really true eps = oldeps; } else { accuracy = oldeps + MP_DIGIT_BIT; A = (size_t) ceil(0.37714556279552730250018797240191093794 * accuracy); // We need to compute the coefficients as exact as possible, so // increase the working precision acccording to the largest coefficient // TODO: probably too much eps = ((accuracy * 116) / 100); if ((err = fill_spougecache(A, accuracy, eps)) != MP_OKAY) { return err; } } if ((err = mpf_init_multi(eps, &z, &ONE, &factrl, &e, &t1, &t2, &t3, &sum, NULL)) != MP_OKAY) { return err; } if ((err = mpf_copy(a, &z)) != MP_OKAY) { goto _ERR; } if ((err = mpf_normalize_to(&z, eps)) != MP_OKAY) { goto _ERR; } if ((err = mpf_set_int(&ONE, 1)) != MP_OKAY) { goto _ERR; } // printf("splen = %u, A = %u, seps = %ld, acc = %d\n", // spougecache_len , A , spougecache_eps , accuracy); if (a->mantissa.sign == MP_NEG) { // eps = oldeps + 10; if ((err = mpf_copy(a, &z)) != MP_OKAY) { goto _ERR; } if ((err = mpf_normalize_to(&z, eps)) != MP_OKAY) { goto _ERR; } if ((err = mpf_init(&pi, eps)) != MP_OKAY) { goto _ERR; } if ((err = mpf_const_pi(&pi)) != MP_OKAY) { goto _ERR; } if ((err = mpf_normalize_to(&ONE, eps)) != MP_OKAY) { goto _ERR; } if ((err = mpf_sub(&ONE, &z, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_mul(&pi, &z, &t2)) != MP_OKAY) { goto _ERR; } if ((err = mpf_sin(&t2, &t2)) != MP_OKAY) { goto _ERR; } if ((err = mpf_div(&pi, &t2, &t2)) != MP_OKAY) { goto _ERR; } t2.mantissa.sign = MP_ZPOS; if ((err = mpf_ln(&t2, &t2)) != MP_OKAY) { goto _ERR; } reflection = 1; if ((err = mpf_lngamma(&t1, &t1)) != MP_OKAY) { goto _ERR; } reflection = 0; if ((err = mpf_sub(&t2, &t1, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_normalize_to(&t1, oldeps)) != MP_OKAY) { goto _ERR; } mpf_exch(&t1, b); goto _ERR; } if ((err = mpf_copy(&(spougecache[0]), &sum)) != MP_OKAY) { goto _ERR; } for (n = 1; n < (int) spougecache_len; n++) { if ((err = mpf_const_d(&t1, n)) != MP_OKAY) { goto _ERR; } if ((err = mpf_add(&z, &t1, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_div(&(spougecache[n]), &t1, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_add(&sum, &t1, &sum)) != MP_OKAY) { goto _ERR; } } if ((err = mpf_const_d(&t1, (int) spougecache_len)) != MP_OKAY) { goto _ERR; } if ((err = mpf_add(&z, &t1, &t1)) != MP_OKAY) { goto _ERR; } // 1/2 ONE.exp -= 1; //ret = log(sum) + (-(t1)) + log(t1) * (z + 1/2); // = log(sum) + t2 + log(t1) * (z + 1/2); // = log(sum) + t2 + log(t1) * t3 if ((err = mpf_neg(&t1, &t2)) != MP_OKAY) { goto _ERR; } if ((err = mpf_add(&z, &ONE, &t3)) != MP_OKAY) { goto _ERR; } if ((err = mpf_ln(&sum, &sum)) != MP_OKAY) { goto _ERR; } if ((err = mpf_ln(&t1, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_mul(&t1, &t3, &t3)) != MP_OKAY) { goto _ERR; } if ((err = mpf_add(&sum, &t2, &sum)) != MP_OKAY) { goto _ERR; } if ((err = mpf_add(&sum, &t3, &sum)) != MP_OKAY) { goto _ERR; } // ret = ret - log(z) if ((err = mpf_ln(&z, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_sub(&sum, &t1, &t1)) != MP_OKAY) { goto _ERR; } if ((err = mpf_normalize_to(&t1, oldeps)) != MP_OKAY) { goto _ERR; } mpf_exch(&t1, b); _ERR: mpf_clear_multi(&z, &ONE, &factrl, &e, &t1, &t2, &t3, &sum, NULL); return err; }
void mpfc_neg(mpfc_ptr x,mpfc_ptr y) { mpf_neg(x->Re,y->Re); mpf_neg(x->Im,y->Im); }
void integrator_generate_constants(void) { printf("Generaring constants.\n\n"); mpf_set_default_prec(512); mpf_t* _h = malloc(sizeof(mpf_t)*8); for (int i=0; i<8; i++) { mpf_init(_h[i]); } mpf_t* _r = malloc(sizeof(mpf_t)*28); for (int i=0; i<28; i++) { mpf_init(_r[i]); } mpf_t* _c = malloc(sizeof(mpf_t)*21); mpf_t* _d = malloc(sizeof(mpf_t)*21); for (int i=0; i<21; i++) { mpf_init(_c[i]); mpf_init(_d[i]); } mpf_set_str(_h[0],"0.0",10); mpf_set_str(_h[1],"0.0562625605369221464656521910",10); mpf_set_str(_h[2],"0.1802406917368923649875799428",10); mpf_set_str(_h[3],"0.3526247171131696373739077702",10); mpf_set_str(_h[4],"0.5471536263305553830014485577",10); mpf_set_str(_h[5],"0.7342101772154105410531523211",10); mpf_set_str(_h[6],"0.8853209468390957680903597629",10); mpf_set_str(_h[7],"0.9775206135612875018911745004",10); int l=0; for (int j=1; j<8; ++j) { for(int k=0; k<j; ++k) { // r[l] = h[j] - h[k]; mpf_sub(_r[l],_h[j],_h[k]); ++l; } } //c[0] = -h[1]; mpf_neg(_c[0],_h[1]); //d[0] = h[1]; mpf_set(_d[0],_h[1]); l=0; for (int j=2; j<7; ++j) { ++l; // c[l] = -h[j] * c[l-j+1]; mpf_mul(_c[l], _h[j], _c[l-j+1]); mpf_neg(_c[l], _c[l]); //d[l] = h[1] * d[l-j+1]; mpf_mul(_d[l], _h[1], _d[l-j+1]); for(int k=2; k<j; ++k) { ++l; //c[l] = c[l-j] - h[j] * c[l-j+1]; mpf_mul(_c[l], _h[j], _c[l-j+1]); mpf_sub(_c[l], _c[l-j], _c[l]); //d[l] = d[l-j] + h[k] * d[l-j+1]; mpf_mul(_d[l], _h[k], _d[l-j+1]); mpf_add(_d[l], _d[l-j], _d[l]); } ++l; //c[l] = c[l-j] - h[j]; mpf_sub(_c[l], _c[l-j], _h[j]); //d[l] = d[l-j] + h[j]; mpf_add(_d[l], _d[l-j], _h[j]); } // Output printf("double r[28] = {"); for (int i=0; i<28; i++) { gmp_printf ("%.*Ff", 25, _r[i]); if (i!=27) printf(", "); } printf("};\n"); printf("double c[21] = {"); for (int i=0; i<21; i++) { gmp_printf ("%.*Ff", 25, _c[i]); if (i!=20) printf(", "); } printf("};\n"); printf("double d[21] = {"); for (int i=0; i<21; i++) { gmp_printf ("%.*Ff", 25, _d[i]); if (i!=20) printf(", "); } printf("};\n"); exit(0); }
void mpf_ui_sub (mpf_ptr r, unsigned long int u, mpf_srcptr v) { mp_srcptr up, vp; mp_ptr rp, tp; mp_size_t usize, vsize, rsize; mp_size_t prec; mp_exp_t uexp; mp_size_t ediff; int negate; mp_limb_t ulimb; TMP_DECL; vsize = v->_mp_size; /* Handle special cases that don't work in generic code below. */ if (u == 0) { mpf_neg (r, v); return; } if (vsize == 0) { mpf_set_ui (r, u); return; } /* If signs of U and V are different, perform addition. */ if (vsize < 0) { __mpf_struct v_negated; v_negated._mp_size = -vsize; v_negated._mp_exp = v->_mp_exp; v_negated._mp_d = v->_mp_d; mpf_add_ui (r, &v_negated, u); return; } TMP_MARK; /* Signs are now known to be the same. */ ulimb = u; /* Make U be the operand with the largest exponent. */ if (1 < v->_mp_exp) { negate = 1; usize = ABS (vsize); vsize = 1; up = v->_mp_d; vp = &ulimb; rp = r->_mp_d; prec = r->_mp_prec + 1; uexp = v->_mp_exp; ediff = uexp - 1; } else { negate = 0; usize = 1; vsize = ABS (vsize); up = &ulimb; vp = v->_mp_d; rp = r->_mp_d; prec = r->_mp_prec; uexp = 1; ediff = 1 - v->_mp_exp; } /* Ignore leading limbs in U and V that are equal. Doing this helps increase the precision of the result. */ if (ediff == 0) { /* This loop normally exits immediately. Optimize for that. */ for (;;) { usize--; vsize--; if (up[usize] != vp[vsize]) break; uexp--; if (usize == 0) goto Lu0; if (vsize == 0) goto Lv0; } usize++; vsize++; /* Note that either operand (but not both operands) might now have leading zero limbs. It matters only that U is unnormalized if vsize is now zero, and vice versa. And it is only in that case that we have to adjust uexp. */ if (vsize == 0) Lv0: while (usize != 0 && up[usize - 1] == 0) usize--, uexp--; if (usize == 0) Lu0: while (vsize != 0 && vp[vsize - 1] == 0) vsize--, uexp--; } /* If U extends beyond PREC, ignore the part that does. */ if (usize > prec) { up += usize - prec; usize = prec; } /* If V extends beyond PREC, ignore the part that does. Note that this may make vsize negative. */ if (vsize + ediff > prec) { vp += vsize + ediff - prec; vsize = prec - ediff; } /* Allocate temp space for the result. Allocate just vsize + ediff later??? */ tp = (mp_ptr) TMP_ALLOC (prec * BYTES_PER_MP_LIMB); if (ediff >= prec) { /* V completely cancelled. */ if (tp != up) MPN_COPY (rp, up, usize); rsize = usize; } else { /* Locate the least significant non-zero limb in (the needed parts of) U and V, to simplify the code below. */ for (;;) { if (vsize == 0) { MPN_COPY (rp, up, usize); rsize = usize; goto done; } if (vp[0] != 0) break; vp++, vsize--; } for (;;) { if (usize == 0) { MPN_COPY (rp, vp, vsize); rsize = vsize; negate ^= 1; goto done; } if (up[0] != 0) break; up++, usize--; } /* uuuu | uuuu | uuuu | uuuu | uuuu */ /* vvvvvvv | vv | vvvvv | v | vv */ if (usize > ediff) { /* U and V partially overlaps. */ if (ediff == 0) { /* Have to compare the leading limbs of u and v to determine whether to compute u - v or v - u. */ if (usize > vsize) { /* uuuu */ /* vv */ int cmp; cmp = mpn_cmp (up + usize - vsize, vp, vsize); if (cmp >= 0) { mp_size_t size; size = usize - vsize; MPN_COPY (tp, up, size); mpn_sub_n (tp + size, up + size, vp, vsize); rsize = usize; } else { /* vv */ /* Swap U and V. */ /* uuuu */ mp_size_t size, i; size = usize - vsize; tp[0] = -up[0] & GMP_NUMB_MASK; for (i = 1; i < size; i++) tp[i] = ~up[i] & GMP_NUMB_MASK; mpn_sub_n (tp + size, vp, up + size, vsize); mpn_sub_1 (tp + size, tp + size, vsize, (mp_limb_t) 1); negate ^= 1; rsize = usize; } } else if (usize < vsize) { /* uuuu */ /* vvvvvvv */ int cmp; cmp = mpn_cmp (up, vp + vsize - usize, usize); if (cmp > 0) { mp_size_t size, i; size = vsize - usize; tp[0] = -vp[0] & GMP_NUMB_MASK; for (i = 1; i < size; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; mpn_sub_n (tp + size, up, vp + size, usize); mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1); rsize = vsize; } else { /* vvvvvvv */ /* Swap U and V. */ /* uuuu */ /* This is the only place we can get 0.0. */ mp_size_t size; size = vsize - usize; MPN_COPY (tp, vp, size); mpn_sub_n (tp + size, vp + size, up, usize); negate ^= 1; rsize = vsize; } } else { /* uuuu */ /* vvvv */ int cmp; cmp = mpn_cmp (up, vp + vsize - usize, usize); if (cmp > 0) { mpn_sub_n (tp, up, vp, usize); rsize = usize; } else { mpn_sub_n (tp, vp, up, usize); negate ^= 1; rsize = usize; /* can give zero */ } } } else { if (vsize + ediff <= usize) { /* uuuu */ /* v */ mp_size_t size; size = usize - ediff - vsize; MPN_COPY (tp, up, size); mpn_sub (tp + size, up + size, usize - size, vp, vsize); rsize = usize; } else { /* uuuu */ /* vvvvv */ mp_size_t size, i; size = vsize + ediff - usize; tp[0] = -vp[0] & GMP_NUMB_MASK; for (i = 1; i < size; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; mpn_sub (tp + size, up, usize, vp + size, usize - ediff); mpn_sub_1 (tp + size, tp + size, usize, (mp_limb_t) 1); rsize = vsize + ediff; } } } else { /* uuuu */ /* vv */ mp_size_t size, i; size = vsize + ediff - usize; tp[0] = -vp[0] & GMP_NUMB_MASK; for (i = 1; i < vsize; i++) tp[i] = ~vp[i] & GMP_NUMB_MASK; for (i = vsize; i < size; i++) tp[i] = GMP_NUMB_MAX; mpn_sub_1 (tp + size, up, usize, (mp_limb_t) 1); rsize = size + usize; } /* Full normalize. Optimize later. */ while (rsize != 0 && tp[rsize - 1] == 0) { rsize--; uexp--; } MPN_COPY (rp, tp, rsize); } done: r->_mp_size = negate ? -rsize : rsize; r->_mp_exp = uexp; TMP_FREE; }
void topsin_series (mpf_t a_k, unsigned int k, unsigned int prec) { unsigned int n; mpf_t fourpi, numer, fact, low_bound, term, xterm; mpz_t bino; mpf_set_ui(a_k, 0); /* If k == 0 then we are done */ if (0 == k) return; mpf_init(fourpi); mpf_init(numer); mpf_init(fact); mpf_init(low_bound); mpf_init(term); mpf_init(xterm); mpz_init(bino); fp_two_pi(numer, prec); mpf_neg(numer, numer); // fourpi is actually -4pi^2 mpf_mul(fourpi, numer, numer); mpf_neg(fourpi, fourpi); mpf_set_ui(fact, 1); /* Get the number of binary bits from prec = log_2 10 * prec */ long nbits = (long) floor (3.321 * prec); mpf_div_2exp(low_bound, fact, nbits+32); for (n=0; n<2023123123; n++) { i_binomial(bino, 2*n+k, 2*n); mpf_set_z(term, bino); mpf_mul(xterm, term, numer); mpf_div(term, xterm, fact); mpf_add(a_k, a_k, term); // #define DEBUG 1 #ifdef DEBUG { double h_f, q_f, b_f; h_f = mpf_get_d(h); q_f = mpf_get_d(qmark); b_f = mpf_get_d(bits); printf("duuude place=%d, bitsdone=%ld h=%g q=%g bits=%f s=%d\n", place, bitsdone, h_f, q_f, b_f, mpf_sgn(h)); } #endif // If the term is small enough, we are done. mpf_abs(xterm, term); if (mpf_cmp(xterm, low_bound) < 0) break; // Now iterate mpf_mul(numer, numer, fourpi); mpf_mul_ui(fact, fact, (2*n+3)*2*(n+1)); } if (k%2 == 0) mpf_neg(a_k, a_k); mpf_clear(fourpi); mpf_clear(numer); mpf_clear(fact); mpf_clear(low_bound); mpf_clear(term); mpf_clear(xterm); mpz_clear(bino); }
void omega(long int n, long int m, double tau, long int q, long int k1, long int k2, mpf_t *factoriales, mpf_t pi) { mpf_t aux, aux2, aux3, sqrf, acum, Ltau, z, zelev; int j; unsigned long int qsqr; /* * Set n = min(n,m), and m = max(n,m) */ j = n; n = min(n,m); m = max(j,m); /* * The sqrt(n!m!) pre-factor */ mpf_init(aux); mpf_init(sqrf); mpf_mul(aux, factoriales[n], factoriales[m]); mpf_sqrt(sqrf, aux); /* * Calculus of tau */ mpf_init(aux2); mpf_init_set_d(Ltau, tau); mpf_init(z); mpf_init(zelev); qsqr = (unsigned long int) q; mpf_set_d(aux, (double) pow((double) k1, (double) 2)); mpf_mul(aux, aux, Ltau); mpf_set_d(aux2, (double) pow((double) k2, (double) 2)); mpf_div(aux, aux, Ltau); mpf_add(aux, aux, aux2); mpf_div_ui(aux, aux, qsqr); mpf_mul(z, aux, pi); if ( ((m-n)%2) == 0) mpf_pow_ui(zelev, z, (unsigned long int) (m-n)/2); else { mpf_pow_ui(zelev, z, m-n); mpf_sqrt(zelev, zelev); } /* mpf_pow_ui(zelev, z, m-n); *mpf_pow_ui(z, z, 2); */ /* mpf_out_str(stdout, 10, 20, z); printf("\n");*/ /* * The loop */ mpf_init(acum); mpf_init(aux3); mpf_set_ui(acum, (unsigned long int) 0); for (j=0; j <= n; j++) { mpf_mul(aux, factoriales[j], factoriales[n-j]); mpf_mul(aux2, aux, factoriales[j+m-n]); mpf_pow_ui(aux3, z, j); mpf_div(aux, aux3, aux2); if ((j%2) == 0) mpf_set(aux2, aux); else mpf_neg(aux2, aux); mpf_add(acum, acum, aux2); } mpf_mul(aux, acum, sqrf); mpf_mul(aux, aux, zelev); gmp_printf("%4d %4d %4d %4d %20.20Fe\n", n, m, k1, k2, aux); /*mpf_out_str(stdout, 10, 20, aux);*/ }
void check_one (mpz_srcptr z) { static const int shift[] = { 0, 1, BITS_PER_MP_LIMB, 2*BITS_PER_MP_LIMB, 5*BITS_PER_MP_LIMB }; int sh, shneg, neg; mpf_t f; mpz_t got, want; mpf_init2 (f, mpz_sizeinbase(z,2)); mpz_init (got); mpz_init (want); for (sh = 0; sh < numberof(shift); sh++) { for (shneg = 0; shneg <= 1; shneg++) { for (neg = 0; neg <= 1; neg++) { mpf_set_z (f, z); mpz_set (want, z); if (neg) { mpf_neg (f, f); mpz_neg (want, want); } if (shneg) { mpz_tdiv_q_2exp (want, want, shift[sh]); mpf_div_2exp (f, f, shift[sh]); } else { mpz_mul_2exp (want, want, shift[sh]); mpf_mul_2exp (f, f, shift[sh]); } mpz_set_f (got, f); MPZ_CHECK_FORMAT (got); if (mpz_cmp (got, want) != 0) { printf ("wrong result\n"); printf (" shift %d\n", shneg ? -shift[sh] : shift[sh]); printf (" neg %d\n", neg); mpf_trace (" f", f); mpz_trace (" got", got); mpz_trace (" want", want); abort (); } } } } mpf_clear (f); mpz_clear (got); mpz_clear (want); }