// Computes z = Delta(q) (see Cohen).
static void compute_Delta(mpc_t z, mpc_t q) {
int d;
int n;
int power;
mpc_t z0, z1, z2;
mpc_init(z0);
mpc_init(z1);
mpc_init(z2);
mpc_set_ui(z0, 1);
d = -1;
for(n=1; n<100; n++) {
power = n *(3 * n - 1) / 2;
mpc_pow_ui(z1, q, power);
mpc_pow_ui(z2, q, n);
mpc_mul(z2, z2, z1);
mpc_add(z1, z1, z2);
if (d) {
mpc_sub(z0, z0, z1);
d = 0;
} else {
mpc_add(z0, z0, z1);
d = 1;
}
}
mpc_pow_ui(z0, z0, 24);
mpc_mul(z, z0, q);
mpc_clear(z0);
mpc_clear(z1);
mpc_clear(z2);
}
void
ovm_dd_sub(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
break;
case t_word:
l->v.dd -= r->v.w;
break;
case t_float:
l->v.dd -= r->v.d;
break;
case t_mpz:
l->v.dd -= mpz_get_d(ozr(r));
break;
case t_rat:
l->v.dd -= rat_get_d(r->v.r);
break;
case t_mpq:
l->v.dd -= mpq_get_d(oqr(r));
break;
case t_mpr:
l->t = t_mpc;
mpc_set_d_d(occ(l), real(l->v.dd), imag(l->v.dd), thr_rndc);
mpc_set_fr(occ(r), orr(r), thr_rndc);
mpc_sub(occ(l), occ(l), occ(r), thr_rndc);
break;
case t_cdd:
l->v.dd -= r->v.dd;
check_cdd(l);
break;
case t_cqq:
real(r->v.dd) = mpq_get_d(oqr(r));
imag(r->v.dd) = mpq_get_d(oqi(r));
l->v.dd -= r->v.dd;
check_cdd(l);
break;
case t_mpc:
l->t = t_mpc;
mpc_set_d_d(occ(l), real(l->v.dd), imag(l->v.dd), thr_rndc);
mpc_sub(occ(l), occ(l), occ(r), thr_rndc);
check_mpc(l);
break;
default:
ovm_raise(except_not_a_number);
}
}
void add_diff(Sequence seq, size_t N)
{
Sequence hseq = seq + N / 2, end = seq + N;
while (hseq < end)
{
mpc_set(temp, seq, RND); //temp = *seq
mpc_add(seq, seq, hseq, RND); //*seq += *hseq
mpc_sub(hseq, temp, hseq, RND); //*hseq = temp - *hseq
seq++, hseq++;
}
}
void
ovm_q_sub(oregister_t *l, oregister_t *r)
{
switch (r->t) {
case t_void:
break;
case t_word:
mpq_set_si(oqr(r), r->v.w, 1);
mpq_sub(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_float:
l->t = t_float;
l->v.d = mpq_get_d(oqr(l)) - r->v.d;
break;
case t_mpz:
mpz_set_ui(ozs(r), 1);
mpq_sub(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_rat:
mpq_set_si(oqr(r), rat_num(r->v.r), rat_den(r->v.r));
mpq_sub(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_mpq:
mpq_sub(oqr(l), oqr(l), oqr(r));
check_mpq(l);
break;
case t_mpr:
l->t = t_mpr;
mpfr_set_q(orr(l), oqr(l), thr_rnd);
mpfr_sub(orr(l), orr(l), orr(r), thr_rnd);
break;
case t_cdd:
l->t = t_cdd;
l->v.dd = mpq_get_d(oqr(l)) - r->v.dd;
break;
case t_cqq:
l->t = t_cqq;
mpq_set_ui(oqi(l), 0, 1);
cqq_sub(oqq(l), oqq(l), oqq(r));
check_cqq(l);
break;
case t_mpc:
l->t = t_mpc;
mpc_set_q(occ(l), oqr(l), thr_rndc);
mpc_sub(occ(l), occ(l), occ(r), thr_rndc);
break;
default:
ovm_raise(except_not_a_number);
}
}
static PyObject *
GMPy_Complex_Sub(PyObject *x, PyObject *y, CTXT_Object *context)
{
MPC_Object *result = NULL;
CHECK_CONTEXT(context);
if (!(result = GMPy_MPC_New(0, 0, context)))
return NULL;
if (MPC_Check(x) && MPC_Check(y)) {
result->rc = mpc_sub(result->c, MPC(x), MPC(y),
GET_MPC_ROUND(context));
goto done;
}
if (IS_COMPLEX(x) && IS_COMPLEX(y)) {
MPC_Object *tempx, *tempy;
tempx = GMPy_MPC_From_Complex(x, 1, 1, context);
tempy = GMPy_MPC_From_Complex(y, 1, 1, context);
if (!tempx || !tempy) {
Py_XDECREF((PyObject*)tempx);
Py_XDECREF((PyObject*)tempy);
Py_DECREF((PyObject*)result);
return NULL;
}
result->rc = mpc_sub(result->c, tempx->c, tempy->c, GET_MPC_ROUND(context));
Py_DECREF((PyObject*)tempx);
Py_DECREF((PyObject*)tempy);
goto done;
}
Py_DECREF((PyObject*)result);
Py_RETURN_NOTIMPLEMENTED;
done:
GMPY_MPC_CLEANUP(result, context, "subtraction");
return (PyObject*)result;
}
void
mps_maberth_s_wl (mps_context * s, int j, mps_cluster * cluster, mpc_t abcorr,
pthread_mutex_t * aberth_mutexes)
{
int k;
mps_root * root;
cdpe_t z, temp;
mpc_t diff, mroot;
mpc_init2 (mroot, s->mpwp);
mpc_init2 (diff, s->mpwp);
pthread_mutex_lock (&aberth_mutexes[j]);
mpc_set (mroot, s->root[j]->mvalue);
pthread_mutex_unlock (&aberth_mutexes[j]);
cdpe_set (temp, cdpe_zero);
for (root = cluster->first; root != NULL; root = root->next)
{
k = root->k;
if (k == j)
continue;
pthread_mutex_lock (&aberth_mutexes[k]);
mpc_sub (diff, mroot, s->root[k]->mvalue);
pthread_mutex_unlock (&aberth_mutexes[k]);
mpc_get_cdpe (z, diff);
if (cdpe_eq_zero(z))
continue;
cdpe_inv_eq (z);
cdpe_add_eq (temp, z);
}
mpc_set_cdpe (abcorr, temp);
mpc_clear (mroot);
mpc_clear (diff);
}
/**
* @brief Compute Aberth correction for j-th root, without
* selective correction.
*/
void
mps_maberth (mps_context * s, mps_approximation * root, mpc_t abcorr)
{
int i;
cdpe_t z, temp;
mpc_t diff;
mpc_init2 (diff, s->mpwp);
cdpe_set (temp, cdpe_zero);
for (i = 0; i < s->n; i++)
{
if (s->root[i] == root)
continue;
mpc_sub (diff, root->mvalue, s->root[i]->mvalue);
mpc_get_cdpe (z, diff);
cdpe_inv_eq (z);
cdpe_add_eq (temp, z);
}
mpc_set_cdpe (abcorr, temp);
mpc_clear (diff);
}
/**
* @brief Compute Aberth correction for the j-th root,
* but only with other roots of the <code>jc</code>-th
* cluster.
*/
void
mps_maberth_s (mps_context * s, mps_approximation * ab_root, mps_cluster * cluster, mpc_t abcorr)
{
mps_root * root;
cdpe_t z, temp;
mpc_t diff;
mpc_init2 (diff, s->mpwp);
cdpe_set (temp, cdpe_zero);
for (root = cluster->first; root != NULL; root = root->next)
{
mps_approximation * appr = s->root[root->k];
if (appr == ab_root)
continue;
mpc_sub (diff, ab_root->mvalue, appr->mvalue);
mpc_get_cdpe (z, diff);
cdpe_inv_eq (z);
cdpe_add_eq (temp, z);
}
mpc_set_cdpe (abcorr, temp);
mpc_clear (diff);
}
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;
}
int
test_mpsolve (char * pol_file, char * res_file, mps_algorithm algorithm)
{
mpc_t root, ctmp;
mps_boolean passed = true;
int i, j, zero_roots = 0;
char ch;
rdpe_t eps;
/* Check the roots */
FILE* result_stream = fopen (res_file, "r");
FILE* input_stream = fopen (pol_file, "r");
if (!result_stream)
{
fprintf (stderr, "Checking \033[1m%-30s\033[0m \033[31;1mno results file found!\033[0m\n", pol_file + 9);
return EXIT_FAILURE;
}
if (!input_stream)
{
fprintf (stderr, "Checking \033[1m%-30s\033[0m \033[31;1mno polinomial file found!\033[0m\n", pol_file + 9);
return EXIT_FAILURE;
}
/* Create a new empty mps_context */
mps_context * s = mps_context_new ();
if (debug)
mps_context_set_debug_level (s, MPS_DEBUG_TRACE);
/* Load the polynomial that has been given to us */
mps_parse_stream (s, input_stream);
fprintf (stderr, "Checking \033[1m%-30s\033[0m [\033[34;1mchecking\033[0m]", pol_file + 9);
mps_context_set_output_goal (s, MPS_OUTPUT_GOAL_ISOLATE);
mps_context_set_output_prec (s, 50 * LOG2_10);
rdpe_set_dl (eps, 1.0, -15);
/* Solve it */
mps_context_select_algorithm (s, algorithm);
mps_mpsolve (s);
mpc_init2 (root, mps_context_get_data_prec_max (s));
mpc_init2 (ctmp, mps_context_get_data_prec_max (s));
/* Test if roots are equal to the roots provided in the check */
passed = true;
rdpe_t * drad = rdpe_valloc (mps_context_get_degree (s));
mpc_t * mroot = mpc_valloc (mps_context_get_degree (s));
mpc_vinit2 (mroot, mps_context_get_degree (s), 53);
mps_context_get_roots_m (s, &mroot, &drad);
for (i = 0; i < mps_context_get_degree (s); i++)
{
rdpe_t rtmp;
cdpe_t cdtmp;
rdpe_t min_dist;
int found_root = 0;
rdpe_t exp_drad;
while (isspace (ch = getc (result_stream)));
ungetc (ch, result_stream);
mpc_inp_str (root, result_stream, 10);
if (mpc_eq_zero (root))
{
zero_roots++;
/* We need to read it another time. This seems a bug in
* mpc_inp_str, but I don't get why is necessary. */
mpc_inp_str (root, result_stream, 10);
continue;
}
mpc_sub (ctmp, root, mroot[0]);
mpc_get_cdpe (cdtmp, ctmp);
cdpe_mod (rtmp, cdtmp);
rdpe_set (min_dist, rtmp);
if (getenv ("MPS_VERBOSE_TEST") && (strstr (pol_file, getenv ("MPS_VERBOSE_TEST"))))
{
printf ("Read root_%d = ", i);
mpc_out_str_2 (stdout, 10, mps_context_get_data_prec_max (s), mps_context_get_data_prec_max (s),
root);
printf ("\n");
}
for (j = 1; j < mps_context_get_degree (s); j++)
{
mpc_sub (ctmp, root, mroot[j]);
mpc_get_cdpe (cdtmp, ctmp);
cdpe_mod (rtmp, cdtmp);
if (rdpe_le (rtmp, min_dist))
{
rdpe_set (min_dist, rtmp);
found_root = j;
}
}
/* printf ("min_dist_%d = ", i); */
/* rdpe_out_str (stdout, min_dist); */
/* printf ("\nrad_%d", i); */
/* rdpe_out_str (stdout, s->drad[i]); */
/* printf ("\n"); */
mpc_get_cdpe (cdtmp, mroot[found_root]);
cdpe_mod (rtmp, cdtmp);
rdpe_mul_eq (rtmp, eps);
rdpe_set (exp_drad, rtmp);
if ((!rdpe_le (min_dist, drad[found_root]) && !rdpe_gt (drad[found_root], exp_drad)) && !mps_context_get_over_max (s))
{
passed = false;
if (getenv ("MPS_VERBOSE_TEST") && (strstr (pol_file, getenv ("MPS_VERBOSE_TEST"))))
{
printf("Failing on root %d, with min_dist = ", found_root);
rdpe_out_str (stdout, min_dist);
printf("\ndrad_%d", found_root);
rdpe_out_str (stdout, drad[found_root]);
printf("\n");
printf("Approximation_%d = ", found_root);
mpc_out_str_2 (stdout, 10, -rdpe_Esp (drad[found_root]), -rdpe_Esp (drad[found_root]), mroot[found_root]);
printf("\n");
}
}
}
if (zero_roots != mps_context_get_zero_roots (s))
passed = false;
fclose (input_stream);
fclose (result_stream);
mpc_clear (ctmp);
mpc_clear (root);
mpc_vclear (mroot, mps_context_get_degree (s));
free (mroot);
free (drad);
if (getenv ("MPS_VERBOSE_TEST") && (strstr (pol_file, getenv ("MPS_VERBOSE_TEST"))))
{
mps_context_set_output_format (s, MPS_OUTPUT_FORMAT_GNUPLOT_FULL);
mps_output (s);
}
mps_context_free (s);
if (passed)
fprintf (stderr, "\rChecking \033[1m%-30s\033[0m [\033[32;1m done \033[0m]\n", pol_file + 9);
else
fprintf (stderr, "\rChecking \033[1m%-30s\033[0m [\033[31;1m failed \033[0m]\n", pol_file + 9);
return passed;
}
/**
* @brief This function tests the resolution of a polynomial file
* referenced by <code>pol</code>.
*/
int
test_secsolve_on_pol_impl (test_pol * pol, mps_output_goal goal, mps_boolean jacobi_iterations)
{
mpc_t root, ctmp;
mps_boolean passed = true;
int i, j, zero_roots = 0;
char ch;
rdpe_t eps;
mps_polynomial * poly = NULL;
/* Check the roots */
FILE* result_stream = fopen (pol->res_file, "r");
FILE* input_stream = fopen (pol->pol_file, "r");
rdpe_set_2dl (eps, 1.0, -pol->out_digits);
if (!result_stream)
{
error_test_message ("no results file found", pol->pol_file);
return EXIT_FAILURE;
}
if (!input_stream)
{
error_test_message ("no polynomial file found", pol->pol_file);
return EXIT_FAILURE;
}
/* Create a new empty mps_context */
mps_context * s = mps_context_new ();
if ((getenv ("MPS_VERBOSE_TEST") && strstr (pol->pol_file, getenv ("MPS_VERBOSE_TEST"))) || pol->DOLOG)
mps_context_set_debug_level (s, MPS_DEBUG_TRACE);
/* Load the polynomial that has been given to us */
poly = mps_parse_stream (s, input_stream);
mps_context_set_input_poly (s, poly);
starting_test_message (pol->pol_file);
mps_context_set_output_prec (s, pol->out_digits);
mps_context_set_output_goal (s, goal);
mps_context_set_jacobi_iterations (s, jacobi_iterations);
/* Solve it */
mps_context_select_algorithm (s, (pol->ga) ? MPS_ALGORITHM_SECULAR_GA : MPS_ALGORITHM_STANDARD_MPSOLVE);
mps_mpsolve (s);
mpc_init2 (root, mps_context_get_data_prec_max (s));
mpc_init2 (ctmp, mps_context_get_data_prec_max (s));
/* Test if roots are equal to the roots provided in the check */
passed = true;
rdpe_t * drad = rdpe_valloc (mps_context_get_degree (s));
mpc_t * mroot = mpc_valloc (mps_context_get_degree (s));
mpc_vinit2 (mroot, mps_context_get_degree (s), mps_context_get_data_prec_max (s));
mps_context_get_roots_m (s, &mroot, &drad);
for (i = 0; i < mps_context_get_degree (s); i++)
{
rdpe_t rtmp;
cdpe_t cdtmp;
rdpe_t min_dist;
int found_root = 0;
rdpe_t exp_drad;
while (isspace (ch = getc (result_stream)))
;
ungetc (ch, result_stream);
mpc_inp_str (root, result_stream, 10);
if (mpc_eq_zero (root))
{
zero_roots++;
/* We need to read it another time. This seems a bug in
* mpc_inp_str, but I don't get why is necessary. */
mpc_inp_str (root, result_stream, 10);
continue;
}
mpc_sub (ctmp, root, mroot[0]);
mpc_get_cdpe (cdtmp, ctmp);
cdpe_mod (rtmp, cdtmp);
rdpe_set (min_dist, rtmp);
if (getenv ("MPS_VERBOSE_TEST") && (strstr (pol->pol_file, getenv ("MPS_VERBOSE_TEST"))))
{
printf ("Read root_%d = ", i);
mpc_out_str_2 (stdout, 10, mps_context_get_data_prec_max (s), mps_context_get_data_prec_max (s),
root);
printf ("\n");
}
for (j = 1; j < mps_context_get_degree (s); j++)
{
mpc_sub (ctmp, root, mroot[j]);
mpc_get_cdpe (cdtmp, ctmp);
cdpe_mod (rtmp, cdtmp);
if (rdpe_le (rtmp, min_dist))
{
rdpe_set (min_dist, rtmp);
found_root = j;
}
}
mpc_get_cdpe (cdtmp, mroot[found_root]);
cdpe_mod (rtmp, cdtmp);
rdpe_mul_eq (rtmp, eps);
rdpe_set (exp_drad, rtmp);
rdpe_div_eq_d (min_dist, 1 + 4.0 * DBL_EPSILON);
if ((!rdpe_le (min_dist, drad[found_root]) && !rdpe_gt (drad[found_root], exp_drad)) && !mps_context_get_over_max (s))
{
passed = false;
if (getenv ("MPS_VERBOSE_TEST") && (strstr (pol->pol_file, getenv ("MPS_VERBOSE_TEST"))))
{
printf ("Failing on root %d, with min_dist = ", found_root);
rdpe_out_str (stdout, min_dist);
printf ("\ndrad_%d", found_root);
rdpe_out_str (stdout, drad[found_root]);
printf ("\n");
printf ("Approximation_%d = ", found_root);
mpc_out_str_2 (stdout, 10, -rdpe_Esp (drad[found_root]), -rdpe_Esp (drad[found_root]), mroot[found_root]);
printf ("\n");
}
}
}
if (zero_roots != mps_context_get_zero_roots (s))
passed = false;
if ((getenv ("MPS_VERBOSE_TEST") && strstr (pol->pol_file, getenv ("MPS_VERBOSE_TEST"))) || pol->DOLOG)
{
/* mps_context_set_output_format (s, MPS_OUTPUT_FORMAT_GNUPLOT_FULL); */
mps_output (s);
}
fclose (result_stream);
mpc_clear (ctmp);
mpc_clear (root);
mpc_vclear (mroot, mps_context_get_degree (s));
free (mroot);
free (drad);
mps_polynomial_free (s, poly);
mps_context_free (s);
if (passed)
success_test_message (pol->pol_file);
else
failed_test_message (pol->pol_file);
if (getenv ("MPS_VERBOSE_TEST"))
fail_unless (passed == true,
"Computed results are not exact to the required "
"precision.\n" "\n" " Dumping test configuration: \n"
" => Polynomial file: %s;\n" " => Required digits: %d\n"
" => Gemignani's approach: %s;\n"
" => Starting phase: %s;\n", pol->pol_file, pol->out_digits,
mps_boolean_to_string (pol->ga),
(pol->phase == float_phase) ? "float_phase" : "dpe_phase");
else
fail_unless (passed == true,
"Computed results are not exact to the required precision");
return passed;
}
mpcomplex operator-(const mpcomplex& a, const mpcomplex& b) {
mpc_t value;
mpc_init3( value , a.mpc_prec, a.mpc_prec );
mpc_sub(value, a.mpc_val, b.mpc_val, a.default_rnd);
return mpcomplex(value);
}
mpcomplex& mpcomplex::operator-=( const mpcomplex& a) {
mpc_sub(mpc_val, mpc_val, a.mpc_val, default_rnd);
return *this;
}
void Lib_Mpcr_Sub(MpcrPtr f, MpcrPtr g, MpcrPtr h, long rnd)
{
mpc_sub( (mpc_ptr) f, (mpc_ptr) g, (mpc_ptr) h, (mpc_rnd_t) rnd);
}
