Exemplo n.º 1
0
Arquivo: mpc.c Projeto: rforge/mpc
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;
}
Exemplo n.º 2
0
Arquivo: mpc.c Projeto: rforge/mpc
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;
}
Exemplo n.º 3
0
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);
}
Exemplo n.º 4
0
/**
 * @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;
}
Exemplo n.º 5
0
Arquivo: mpc.c Projeto: rforge/mpc
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;
}
Exemplo n.º 6
0
Arquivo: mpc.c Projeto: rforge/mpc
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;
}
Exemplo n.º 7
0
Arquivo: mpc.c Projeto: rforge/mpc
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;
}
Exemplo n.º 8
0
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;
}
Exemplo n.º 9
0
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;
}
Exemplo n.º 10
0
Arquivo: mpc.c Projeto: rforge/mpc
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;
}
Exemplo n.º 11
0
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;
}
Exemplo n.º 12
0
/**
 * @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");
        }
    }
}
Exemplo n.º 13
0
Arquivo: main.c Projeto: robol/MPSolve
/**
 * @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';
}