SEXP R_mpc_pow(SEXP e1, SEXP e2) {
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, max(mpc_get_prec(*z1),
mpc_get_prec(*z2)));
mpc_pow(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_pow_si(*z, *z1, INTEGER(e2)[0],
Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_pow_d(*z, *z1, REAL(e2)[0], Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc power.");
}
} else {
Rf_error("Invalid first operand for MPC power.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
SEXP R_mpc_mul(SEXP e1, SEXP e2) {
/* N.B. We always use signed integers for e2 given R's type system. */
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, max(mpc_get_prec(*z1),
mpc_get_prec(*z2)));
mpc_mul(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_mul_si(*z, *z1, INTEGER(e2)[0],
Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
mpc_mul_fr(*z, *z1, x, Rmpc_get_rounding());
} else {
Rf_error("Invalid second operand for mpc multiplication.");
}
} else {
Rf_error("Invalid first operand for MPC multiplication.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
static void
improve_root (mps_context * ctx, mps_polynomial * p, mps_approximation * root, long precision)
{
mpc_t newton_correction;
rdpe_t corr_mod, epsilon;
mpc_set_prec (root->mvalue, precision);
mpc_init2 (newton_correction, precision);
mps_polynomial_mnewton (ctx, p, root, newton_correction,
mpc_get_prec (root->mvalue));
mpc_sub_eq (root->mvalue, newton_correction);
mpc_rmod (corr_mod, newton_correction);
rdpe_add_eq (root->drad, corr_mod);
if (ctx->debug_level & MPS_DEBUG_IMPROVEMENT)
MPS_DEBUG_MPC (ctx, 15, newton_correction, "Newton correction");
mpc_rmod (corr_mod, root->mvalue);
rdpe_set_2dl (epsilon, 1.0, 2 - precision);
rdpe_mul_eq (corr_mod, epsilon);
rdpe_add_eq (root->drad, corr_mod);
mpc_clear (newton_correction);
}
/**
* @brief Get the roots computed as multiprecision complex numbers.
*
* @param roots A pointer to an array of mpc_t variables. if *roots == NULL,
* MPSolve will take care of allocate and init those for you. You are in charge to free
* and clear them when you don't need them anymore.
*
* @param radius A pointer to an array of rdpe_t where MPSolve should store the
* inclusion radii. If *radius == NULL MPSolve will allocate those radii for you.
* If radius == NULL no radii will be returned.
*/
int
mps_context_get_roots_m (mps_context * s, mpc_t ** roots, rdpe_t ** radius)
{
int i;
if (!*roots)
{
*roots = mpc_valloc (s->n);
mpc_vinit2 (*roots, s->n, 0);
}
if (radius && !*radius)
{
*radius = rdpe_valloc (s->n);
}
{
mpc_t * local_roots = *roots;
rdpe_t * local_radius = radius ? *radius : NULL;
for (i = 0; i < s->n; i++)
{
mpc_set_prec (local_roots[i], mpc_get_prec (s->root[i]->mvalue));
mpc_set (local_roots[i], s->root[i]->mvalue);
if (radius)
rdpe_set (local_radius[i], s->root[i]->drad);
}
}
return 0;
}
SEXP R_mpc_add(SEXP e1, SEXP e2) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (z == NULL) {
Rf_error("Could not allocate memory for MPC type.");
}
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpfr_prec_t real_prec, imag_prec;
Rmpc_get_max_prec(&real_prec, &imag_prec, *z1, *z2);
mpc_init3(*z, real_prec, imag_prec);
mpc_add(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_add_ui(*z, *z1, INTEGER(e2)[0], Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpfr_t x;
mpfr_init2(x, 53);
// We use GMP_RNDN rather than MPFR_RNDN for compatibility
// with mpfr 2.4.x and earlier as well as more modern versions.
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
/* Max of mpc precision z2 and 53 from e2. */
Rprintf("Precision: %d\n", mpc_get_prec(*z1));
mpc_init2(*z, max(mpc_get_prec(*z1), 53));
mpc_add_fr(*z, *z1, x, Rmpc_get_rounding());
} else {
/* TODO(mstokely): Add support for mpfr types here. */
free(z);
Rf_error("Invalid second operand for mpc addition.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
SEXP R_mpc_conj(SEXP x) {
if (!Rf_inherits(x, "mpc")) {
Rf_error("Invalid operand for conj.mpc");
}
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(x);
mpc_init2(*z, mpc_get_prec(*z1));
mpc_conj(*z, *z1, Rmpc_get_rounding());
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
SEXP R_mpc_neg(SEXP e1) {
/* Garbage collector will be confused if we just call
* mpc_neg(*z, *z, ...) */
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (Rf_inherits(e1, "mpc")) {
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
mpc_init2(*z, mpc_get_prec(*z1));
mpc_neg(*z, *z1, Rmpc_get_rounding());
} else {
Rf_error("Invalid operands for mpc negation.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
mps_boolean
mps_quadratic_poly_meval (mps_context * ctx, mps_polynomial * p, mpc_t x, mpc_t value, rdpe_t error)
{
int i;
int m = (int) (log (p->degree + 1.0) / LOG2);
rdpe_t ax, rtmp;
mpc_t tmp;
long int wp = mpc_get_prec (x);
/* Correct the working precision in case of a limited
precision polynomial (quite unlikely
* in the quadratic case, but still. */
if (p->prec > 0 && p->prec < wp)
wp = p->prec;
if ((1 << m) <= p->degree)
m++;
mpc_init2 (tmp, wp);
mpc_rmod (ax, x);
mpc_set_ui (value, 1U, 0U);
mpc_rmod (error, value);
for (i = 1; i <= m; i++)
{
mpc_sqr (tmp, value);
mpc_mul (value, x, tmp);
mpc_add_eq_ui (value, 1U, 0U);
rdpe_mul_eq (error, ax);
mpc_rmod (rtmp, value);
rdpe_add_eq (error, rtmp);
}
rdpe_set_2dl (rtmp, 1.0, -wp);
rdpe_mul_eq (error, rtmp);
mpc_clear (tmp);
return true;
}
static void
mps_context_expand (mps_context * s, int n)
{
int i;
long int previous_prec = mpc_get_prec (s->mfpc1[0]);
s->root = mps_realloc (s->root, sizeof(mps_approximation*) * n);
for (i = s->n - s->zero_roots; i < n; i++)
{
s->root[i] = mps_approximation_new (s);
}
s->order = mps_realloc (s->order, sizeof(int) * n);
s->fppc1 = mps_realloc (s->fppc1, sizeof(cplx_t) * (n + 1));
s->mfpc1 = mps_realloc (s->mfpc1, sizeof(mpc_t) * (n + 1));
for (i = s->n + 1 - s->zero_roots; i < n + 1; i++)
mpc_init2 (s->mfpc1[i], previous_prec);
s->mfppc1 = mps_realloc (s->mfppc1, sizeof(mpc_t) * (n + 1));
for (i = s->n + 1- s->zero_roots; i <= n; i++)
mpc_init2 (s->mfppc1[i], previous_prec);
/* temporary vectors */
s->spar1 = mps_realloc (s->spar1, sizeof(mps_boolean) * (n + 2));
s->again_old = mps_realloc (s->again_old, sizeof(mps_boolean) * (n));
s->fap1 = mps_realloc (s->fap1, sizeof(double) * (n + 1));
s->fap2 = mps_realloc (s->fap2, sizeof(double) * (n + 1));
s->dap1 = mps_realloc (s->dap1, sizeof(rdpe_t) * (n + 1));
s->dpc1 = mps_realloc (s->dpc1, sizeof(cdpe_t) * (n + 1));
s->dpc2 = mps_realloc (s->dpc2, sizeof(cdpe_t) * (n + 1));
/* Setting some default here, that were not settable because we didn't know
* the degree of the polynomial */
for (i = 0; i < n; i++)
s->root[i]->wp = DBL_DIG * LOG2_10;
}
SEXP R_mpc_sub(SEXP e1, SEXP e2) {
mpc_t *z = (mpc_t *)malloc(sizeof(mpc_t));
if (z == NULL) {
Rf_error("Could not allocate memory for MPC type.");
}
if (Rf_inherits(e1, "mpc")) {
Rprintf("It's an mpc");
mpc_t *z1 = (mpc_t *)R_ExternalPtrAddr(e1);
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, max(mpc_get_prec(*z1),
mpc_get_prec(*z2)));
mpc_sub(*z, *z1, *z2, Rmpc_get_rounding());
} else if (Rf_isInteger(e2)) {
mpc_init2(*z, mpc_get_prec(*z1));
mpc_sub_ui(*z, *z1, INTEGER(e2)[0],
Rmpc_get_rounding());
} else if (Rf_isNumeric(e2)) {
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e2)[0], GMP_RNDN);
Rprintf("Precision: %d\n", mpc_get_prec(*z1));
mpc_init2(*z, max(mpc_get_prec(*z1), 53));
mpc_sub_fr(*z, *z1, x, Rmpc_get_rounding());
} else {
Rf_error("Unsupported type for operand 2 of MPC subtraction.");
}
} else if (Rf_isInteger(e1)) {
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, mpc_get_prec(*z2));
mpc_ui_sub(*z, INTEGER(e1)[0], *z2,
Rmpc_get_rounding());
} else {
Rf_error("Unsupported type for operands for MPC subtraction.");
}
} else if (Rf_isNumeric(e1)) {
if (Rf_inherits(e2, "mpc")) {
mpc_t *z2 = (mpc_t *)R_ExternalPtrAddr(e2);
mpc_init2(*z, mpc_get_prec(*z2));
mpfr_t x;
mpfr_init2(x, 53);
mpfr_set_d(x, REAL(e1)[0], GMP_RNDN);
mpc_fr_sub(*z, x, *z2, Rmpc_get_rounding());
} else {
Rf_error("Unsupported type for operands for MPC subtraction.");
}
} else {
/* TODO(mstokely): Add support for mpfr types here. */
Rprintf("It's unknown");
free(z);
Rf_error("Invalid second operand for mpc subtraction.");
}
SEXP retVal = PROTECT(R_MakeExternalPtr((void *)z,
Rf_install("mpc ptr"), R_NilValue));
Rf_setAttrib(retVal, R_ClassSymbol, Rf_mkString("mpc"));
R_RegisterCFinalizerEx(retVal, mpcFinalizer, TRUE);
UNPROTECT(1);
return retVal;
}
mps_boolean
mps_chebyshev_poly_meval (mps_context * ctx, mps_polynomial * poly, mpc_t x, mpc_t value, rdpe_t error)
{
long int wp = mpc_get_prec (x);
/* Lower the working precision in case of limited precision coefficients
* in the input polynomial. */
if (poly->prec > 0 && poly->prec < wp)
wp = poly->prec;
mps_chebyshev_poly * cpoly = MPS_CHEBYSHEV_POLY (poly);
int i;
mpc_t t0, t1, ctmp, ctmp2;
rdpe_t ax, rtmp, rtmp2;
mpc_rmod (ax, x);
rdpe_set (error, rdpe_zero);
/* Make sure that we have sufficient precision to perform the computation */
mps_polynomial_raise_data (ctx, poly, wp);
mpc_init2 (t0, wp);
mpc_init2 (t1, wp);
mpc_init2 (ctmp, wp);
mpc_init2 (ctmp2, wp);
mpc_set (value, cpoly->mfpc[0]);
mpc_set_ui (t0, 1U, 0U);
if (poly->degree == 0)
{
return true;
}
mpc_set (t1, x);
mpc_mul (ctmp, cpoly->mfpc[1], x);
mpc_add_eq (value, ctmp);
mpc_rmod (rtmp, ctmp);
rdpe_add_eq (error, rtmp);
for (i = 2; i <= poly->degree; i++)
{
mpc_mul (ctmp, x, t1);
mpc_mul_eq_ui (ctmp, 2U);
mpc_rmod (rtmp, ctmp);
mpc_sub_eq (ctmp, t0);
mpc_rmod (rtmp2, t0);
rdpe_add_eq (rtmp, rtmp2);
mpc_mul (ctmp2, ctmp, cpoly->mfpc[i]);
mpc_add_eq (value, ctmp2);
rdpe_mul_eq (rtmp, ax);
rdpe_add_eq (error, rtmp);
mpc_set (t0, t1);
mpc_set (t1, ctmp);
}
mpc_clear (t0);
mpc_clear (t1);
mpc_clear (ctmp);
mpc_clear (ctmp2);
rdpe_set_2dl (rtmp, 2.0, -wp);
rdpe_mul_eq (error, rtmp);
return true;
}
/**
* @brief Print an approximation to stdout (or whatever the output
* stream currently selected in the mps_context is).
*
* @param s A pointer to the current mps_context.
* @param i The index of the approxiomation that shall be printed.
* @param num The number of zero roots.
*/
MPS_PRIVATE void
mps_outroot (mps_context * s, int i, int num)
{
long out_digit;
out_digit = (long)(LOG10_2 * s->output_config->prec) + 10;
/* print format header */
switch (s->output_config->format)
{
case MPS_OUTPUT_FORMAT_COMPACT:
case MPS_OUTPUT_FORMAT_FULL:
fprintf (s->outstr, "(");
break;
case MPS_OUTPUT_FORMAT_VERBOSE:
fprintf (s->outstr, "Root(%d) = ", num);
break;
default:
break;
}
/* print real part */
if (i == ISZERO || s->root[i]->attrs == MPS_ROOT_ATTRS_IMAG)
fprintf (s->outstr, "0");
else
mps_outfloat (s, mpc_Re (s->root[i]->mvalue), s->root[i]->drad, out_digit, true);
/* print format middle part */
switch (s->output_config->format)
{
case MPS_OUTPUT_FORMAT_BARE:
fprintf (s->outstr, " ");
break;
case MPS_OUTPUT_FORMAT_GNUPLOT:
case MPS_OUTPUT_FORMAT_GNUPLOT_FULL:
fprintf (s->outstr, "\t");
break;
case MPS_OUTPUT_FORMAT_COMPACT:
case MPS_OUTPUT_FORMAT_FULL:
fprintf (s->outstr, ", ");
break;
case MPS_OUTPUT_FORMAT_VERBOSE:
if (i == ISZERO || mpf_sgn (mpc_Im (s->root[i]->mvalue)) >= 0)
fprintf (s->outstr, " + I * ");
else
fprintf (s->outstr, " - I * ");
break;
default:
break;
}
/* print imaginary part */
if (i == ISZERO || s->root[i]->attrs == MPS_ROOT_ATTRS_REAL)
fprintf (s->outstr, "0");
else
mps_outfloat (s, mpc_Im (s->root[i]->mvalue), s->root[i]->drad, out_digit,
s->output_config->format != MPS_OUTPUT_FORMAT_VERBOSE);
/* If the output format is GNUPLOT_FORMAT_FULL, print out also the radius */
if (s->output_config->format == MPS_OUTPUT_FORMAT_GNUPLOT_FULL)
{
fprintf (s->outstr, "\t");
rdpe_out_str_u (s->outstr, s->root[i]->drad);
fprintf (s->outstr, "\t");
rdpe_out_str_u (s->outstr, s->root[i]->drad);
}
/* print format ending */
switch (s->output_config->format)
{
case MPS_OUTPUT_FORMAT_COMPACT:
fprintf (s->outstr, ")");
break;
case MPS_OUTPUT_FORMAT_FULL:
fprintf (s->outstr, ")\n");
if (i != ISZERO)
{
rdpe_outln_str (s->outstr, s->root[i]->drad);
fprintf (s->outstr, "Status: %s, %s, %s\n",
MPS_ROOT_STATUS_TO_STRING (s->root[i]->status),
MPS_ROOT_ATTRS_TO_STRING (s->root[i]->attrs),
MPS_ROOT_INCLUSION_TO_STRING (s->root[i]->inclusion));
}
else
fprintf (s->outstr, " 0\n ---\n");
break;
default:
break;
}
fprintf (s->outstr, "\n");
/* debug info */
if (s->DOLOG)
{
if (i == ISZERO)
fprintf (s->logstr, "zero root %-4d = 0", num);
else
{
fprintf (s->logstr, "Root %-4d = ", i);
mpc_out_str_2 (s->logstr, 10, 0, 0, s->root[i]->mvalue);
fprintf (s->logstr, "\n");
fprintf (s->logstr, " Radius = ");
rdpe_outln_str (s->logstr, s->root[i]->drad);
fprintf (s->logstr, " Prec = %ld\n",
(long)(mpc_get_prec (s->root[i]->mvalue) / LOG2_10));
fprintf (s->logstr, " Approximation = %s\n",
MPS_ROOT_STATUS_TO_STRING (s->root[i]->status));
fprintf (s->logstr, " Attributes = %s\n",
MPS_ROOT_ATTRS_TO_STRING (s->root[i]->attrs));
fprintf (s->logstr, " Inclusion = %s\n",
MPS_ROOT_INCLUSION_TO_STRING (s->root[i]->inclusion));
fprintf (s->logstr, "--------------------\n");
}
}
}
/**
* @brief Check consistency of data and makes some basic adjustments.
*
* This routine check, for example, if there are zero roots in the polynomial
* (i.e. no costant term) and deflates the polynomial if necessary (shifting
* the coefficients).
*
* It sets the value of the parameter <code>which_case</code> to <code>'f'</code>
* if a floating point phase is enough, or to <code>'d'</code> if
* a <code>dpe</code> phase is needed.
*
* @param s The <code>mps_context</code> associated with the current computation.
* @param which_case the address of the variable which_case;
*/
MPS_PRIVATE void
mps_check_data (mps_context * s, char *which_case)
{
rdpe_t min_coeff, max_coeff, tmp;
mps_monomial_poly *p = NULL;
int i;
/* case of user-defined polynomial */
if (! MPS_IS_MONOMIAL_POLY (s->active_poly))
{
if (s->output_config->multiplicity)
mps_error (s,
"Multiplicity detection not yet implemented for user polynomial");
if (s->output_config->root_properties)
mps_error (s,
"Real/imaginary detection not yet implemented for user polynomial");
*which_case = 'd';
return;
}
else
p = MPS_MONOMIAL_POLY (s->active_poly);
/* Check consistency of input */
if (rdpe_eq (p->dap[s->n], rdpe_zero))
{
mps_warn (s, "The leading coefficient is zero");
do
(s->n)--;
while (rdpe_eq (p->dap[s->n], rdpe_zero));
MPS_POLYNOMIAL (p)->degree = s->n;
}
/* Compute min_coeff */
if (rdpe_lt (p->dap[0], p->dap[s->n]))
rdpe_set (min_coeff, p->dap[0]);
else
rdpe_set (min_coeff, p->dap[s->n]);
/* Compute max_coeff and its logarithm */
rdpe_set (max_coeff, p->dap[0]);
for (i = 1; i <= s->n; i++)
if (rdpe_lt (max_coeff, p->dap[i]))
rdpe_set (max_coeff, p->dap[i]);
s->lmax_coeff = rdpe_log (max_coeff);
/* Multiplicity and sep */
if (s->output_config->multiplicity)
{
if (MPS_STRUCTURE_IS_INTEGER (s->active_poly->structure))
{
mps_compute_sep (s);
}
else if (MPS_STRUCTURE_IS_RATIONAL (s->active_poly->structure))
{
mps_warn (s, "The multiplicity option has not been yet implemented");
s->sep = 0.0;
}
else
{
mps_warn (s, "The input polynomial has neither integer nor rational");
mps_warn (s, " coefficients: unable to compute multiplicities");
s->sep = 0.0;
}
}
/* Real/Imaginary detection */
if (s->output_config->root_properties ||
s->output_config->search_set == MPS_SEARCH_SET_REAL ||
s->output_config->search_set == MPS_SEARCH_SET_IMAG)
{
if (MPS_STRUCTURE_IS_INTEGER (s->active_poly->structure))
{
mps_compute_sep (s);
}
else if (MPS_STRUCTURE_IS_RATIONAL (s->active_poly->structure))
{
mps_error (s,
"The real/imaginary option has not been yet implemented for rational input");
return;
}
else
{
mps_error (s, "The input polynomial has neither integer nor rational "
"coefficients: unable to perform real/imaginary options");
return;
}
}
/* Select cases (dpe or floating point)
* First normalize the polynomial (only the float version) */
rdpe_div (tmp, max_coeff, min_coeff);
rdpe_mul_eq_d (tmp, (double)(s->n + 1));
rdpe_mul_eq (tmp, rdpe_mind);
rdpe_div_eq (tmp, rdpe_maxd);
if (rdpe_lt (tmp, rdpe_one))
{
mpc_t m_min_coeff;
cdpe_t c_min_coeff;
/* if (n+1)*max_coeff/min_coeff < dhuge/dtiny - float case */
*which_case = 'f';
rdpe_mul_eq (min_coeff, max_coeff);
rdpe_mul (tmp, rdpe_mind, rdpe_maxd);
rdpe_div (min_coeff, tmp, min_coeff);
rdpe_sqrt_eq (min_coeff);
rdpe_set (cdpe_Re (c_min_coeff), min_coeff);
rdpe_set (cdpe_Im (c_min_coeff), rdpe_zero);
mpc_init2 (m_min_coeff, mpc_get_prec (p->mfpc[0]));
mpc_set_cdpe (m_min_coeff, c_min_coeff);
/* min_coeff = sqrt(dhuge*dtiny/(min_coeff*max_coeff))
* NOTE: This is enabled for floating point polynomials only
* for the moment, but it may work nicely also for other representations. */
{
for (i = 0; i <= s->n; i++)
{
/* Multiply the MP leading coefficient */
mpc_mul_eq (p->mfpc[i], m_min_coeff);
rdpe_mul (tmp, p->dap[i], min_coeff);
rdpe_set (p->dap[i], tmp);
p->fap[i] = rdpe_get_d (tmp);
mpc_get_cdpe (p->dpc[i], p->mfpc[i]);
cdpe_get_x (p->fpc[i], p->dpc[i]);
}
}
mpc_clear (m_min_coeff);
}
else
*which_case = 'd';
}