END_TEST
START_TEST (determinant_hessenberg_example1)
{
/* Custom 8 by 8 example. The matrix is defined as:
* A(i,j) = sin(i) * cos(j) + 1e-3 * i*j .
* Its determinant should be*/
cplx_t *hessenberg_matrix = mps_newv (cplx_t, 64);
cplx_t det, t;
int i, j;
long int exp;
mps_context *ctx = mps_context_new ();
for (i = 0; i < 8; i++)
for (j = MAX (0, i - 1); j < 8; j++)
{
cplx_set_d (hessenberg_matrix[i * 8 + j], sin (1.0 * (i + 1)) * cos (1.0 * (j + 1)) + 1e-3 * (i + 1) * (j + 1), 0.0);
}
mps_fhessenberg_determinant (ctx, hessenberg_matrix, 8, det, &exp);
free (hessenberg_matrix);
cplx_mul_eq_d (det, pow(2.0, exp));
cplx_set_d (t, 6.14427105181099e-06, 0.0);
cplx_sub_eq (det, t);
fail_unless (cplx_mod (det) < cplx_mod (t) * 10.0 * 8 * DBL_EPSILON,
"The error on determinant_hessenberg_example1 is bigger than n * DBL_EPSILON");
mps_context_free (ctx);
}
void
cdpe_get_x (cplx_t x, const cdpe_t c)
/* e = im(c) */
{
cplx_set_d (x,
ldexp (rdpe_Mnt (cdpe_Re (c)), (int)rdpe_Esp (cdpe_Re (c))),
ldexp (rdpe_Mnt (cdpe_Im (c)), (int)rdpe_Esp (cdpe_Im (c))));
}
int
cplx_inp_str (cplx_t x, FILE * f)
/* input from file as (re, im) */
{
double real, imag;
if (f == NULL)
f = stdin;
int ret = fscanf (f, CPLX_INP_FMT, &real, &imag);
cplx_set_d (x, real, imag);
return ret;
}
END_TEST
START_TEST (determinant_shifted_hessenberg_example1)
{
/* Custom 8 by 8 example. The matrix is defined as:
* A(i,j) = sin(i) * cos(j) + 1e-3 * i*j .
* Its determinant should be*/
cplx_t *hessenberg_matrix = mps_newv (cplx_t, 64);
cplx_t det, t;
int i, j;
cplx_t shifts[3];
cplx_t results[3];
cplx_set_d (shifts[0], 0.403815598068559, 0.754480932782281);
cplx_set_d (results[0], -0.2755152414594506, 0.0732925950505913);
cplx_set_d (shifts[1], 0.0590780603923638, 0.9236523504901163);
cplx_set_d (results[1], 0.5885575152394473, -0.0800261442305445);
cplx_set_d (shifts[2], 0.0534877455734864, 0.1853972552409148);
cplx_set_d (results[2], -4.28682106680713e-05, -4.18995301563591e-05);
mps_context *ctx = mps_context_new ();
for (i = 0; i < 8; i++)
for (j = MAX (0, i - 1); j < 8; j++)
{
cplx_set_d (hessenberg_matrix[i * 8 + j], sin (1.0 * (i + 1)) * cos (1.0 * (j + 1)) + 1e-3 * (i + 1) * (j + 1), 0.0);
}
for (i = 0; i < 2; i++)
{
long int exp;
mps_fhessenberg_shifted_determinant (ctx, hessenberg_matrix, shifts[i], 8, det, &exp);
cplx_mul_eq_d (det, pow(2.0, exp));
cplx_sub_eq (det, results[i]);
fail_unless (cplx_mod (det) < cplx_mod (results[i]) * 10.0 * 8 * DBL_EPSILON,
"The error on shifted Hessenberg determinant example1 is bigger than n * DBL_EPSILON");
}
free (hessenberg_matrix);
mps_context_free (ctx);
}
void
mps_general_fstart (mps_context * ctx, mps_polynomial * p)
{
int i;
double sigma, ang;
if (ctx->random_seed)
sigma = drand ();
else
{
sigma = ctx->last_sigma = MPS_STARTING_SIGMA;
}
/* In the case of user-defined polynomial choose as starting
* approximations equally spaced points in the unit circle. */
ang = pi2 / ctx->n;
for (i = 0; i < ctx->n; i++)
{
cplx_set_d (ctx->root[i]->fvalue, cos (ang * i + sigma),
sin (ang * i + sigma));
}
}
/**
* @brief Worker for the fpolzer routine.
*/
void *
mps_thread_fpolzer_worker (void *data_ptr)
{
mps_thread_worker_data *data = (mps_thread_worker_data*)data_ptr;
mps_context *s = data->s;
mps_polynomial *p = s->active_poly;
int i, iter;
cplx_t corr, abcorr, froot;
double rad1, modcorr;
mps_thread_job job;
while (!(*data->excep) && (*data->nzeros) < data->required_zeros)
{
job = mps_thread_job_queue_next (s, data->queue);
i = job.i;
iter = job.iter;
/* Check if we got over the maximum number of iterations */
if (job.iter == MPS_THREAD_JOB_EXCEP)
{
(*data->excep) = true;
return 0;
}
/* Lock this roots to make sure that we are the only one working on it */
pthread_mutex_lock (&data->roots_mutex[i]);
if (s->root[i]->again)
{
/* Check if, while we were waiting, excep condition has been reached */
if (*data->excep || !s->root[i]->again || (*data->nzeros > data->required_zeros))
{
pthread_mutex_unlock (&data->roots_mutex[i]);
return 0;
}
(*data->it)++;
rad1 = s->root[i]->frad;
/* Make a local copy of the root */
pthread_mutex_lock (&data->aberth_mutex[i]);
cplx_set (froot, s->root[i]->fvalue);
pthread_mutex_unlock (&data->aberth_mutex[i]);
mps_polynomial_fnewton (s, p, s->root[i], corr);
if (cplx_check_fpe (corr))
{
/* If we get a floating point exception we need to switch to DPE
* arithmetic. */
s->root[i]->frad = rad1;
s->skip_float = true;
s->root[i]->again = false;
}
if (iter == 0 && !s->root[i]->again && s->root[i]->frad > rad1 && rad1 != 0)
s->root[i]->frad = rad1;
/***************************************
The above condition is needed to cope with the case
where at the first iteration the starting point
is already in the root neighbourhood and the actually
computed radius is too big since the value of the first
derivative is too small.
In this case the previous radius bound, obtained by
means of Rouche' is more reliable and strict
**************************************/
if (s->root[i]->again
/* the correction is performed only if iter!=1 or rad(i)!=rad1 */
|| iter != 0 || s->root[i]->frad != rad1)
{
mps_faberth (s, s->root[i], abcorr);
cplx_mul_eq (abcorr, corr);
cplx_sub (abcorr, cplx_one, abcorr);
if (cplx_eq_zero (abcorr))
{
MPS_DEBUG (s, "Aberth correction is zero");
cplx_set_d (abcorr, DBL_EPSILON, 0);
}
cplx_div (abcorr, corr, abcorr);
cplx_sub_eq (froot, abcorr);
modcorr = cplx_mod (abcorr);
s->root[i]->frad += modcorr;
pthread_mutex_lock (&data->aberth_mutex[i]);
cplx_set (s->root[i]->fvalue, froot);
pthread_mutex_unlock (&data->aberth_mutex[i]);
}
/* check for new approximated roots */
if (!s->root[i]->again)
{
(*data->nzeros)++;
if (*data->nzeros >= data->required_zeros)
{
pthread_mutex_unlock (&data->roots_mutex[i]);
return 0;
}
}
}
pthread_mutex_unlock (&data->roots_mutex[i]);
}
return NULL;
}
/**
* @brief Setup vectors and variables
*/
MPS_PRIVATE void
mps_setup (mps_context * s)
{
int i;
mps_polynomial *p = s->active_poly;
mpf_t mptemp;
mpc_t mptempc;
if (s->DOLOG)
{
/* fprintf (s->logstr, "Goal = %5s\n", s->goal); */
/* fprintf (s->logstr, "Data type = %3s\n", s->data_type); */
fprintf (s->logstr, "Degree = %d\n", s->n);
fprintf (s->logstr, "Input prec. = %ld digits\n", (long)(s->active_poly->prec
* LOG10_2));
fprintf (s->logstr, "Output prec. = %ld digits\n", (long)(s->output_config->prec
* LOG10_2));
}
/* setup temporary vectors */
if (MPS_IS_MONOMIAL_POLY (p) && MPS_DENSITY_IS_SPARSE (s->active_poly->density))
{
mps_monomial_poly *mp = MPS_MONOMIAL_POLY (p);
for (i = 0; i <= p->degree; i++)
{
mp->fap[i] = 0.0;
mp->fpr[i] = 0.0;
rdpe_set (mp->dap[i], rdpe_zero);
cplx_set (mp->fpc[i], cplx_zero);
rdpe_set (mp->dpr[i], rdpe_zero);
cdpe_set (mp->dpc[i], cdpe_zero);
}
}
/* Indexes of the first (and only) cluster start from
* 0 and reach n */
mps_cluster_reset (s);
/* set input and output epsilon */
rdpe_set_2dl (s->eps_in, 1.0, 1 - s->active_poly->prec);
rdpe_set_2dl (s->eps_out, 1.0, 1 - s->output_config->prec);
/* precision of each root */
for (i = 0; i < s->n; i++)
s->root[i]->wp = 53;
/* output order info */
for (i = 0; i < s->n; i++)
s->order[i] = i;
/* reset root counts */
s->count[0] = s->count[1] = s->count[2] = 0;
/* compute DPE approximations */
if (MPS_IS_MONOMIAL_POLY (p))
{
mps_monomial_poly *mp = MPS_MONOMIAL_POLY (p);
/* init temporary mp variables */
mpf_init2 (mptemp, DBL_MANT_DIG);
mpc_init2 (mptempc, DBL_MANT_DIG);
/* main loop */
s->skip_float = false;
for (i = 0; i <= s->n; i++)
{
if (MPS_DENSITY_IS_SPARSE (s->active_poly->density) && !mp->spar[i])
continue;
if (MPS_STRUCTURE_IS_REAL (s->active_poly->structure))
{
if (MPS_STRUCTURE_IS_RATIONAL (s->active_poly->structure) ||
MPS_STRUCTURE_IS_INTEGER (s->active_poly->structure))
{
mpf_set_q (mptemp, mp->initial_mqp_r[i]);
mpf_get_rdpe (mp->dpr[i], mptemp);
/*#G GMP 2.0.2 bug begin */
if (rdpe_sgn (mp->dpr[i]) != mpq_sgn (mp->initial_mqp_r[i]))
rdpe_neg_eq (mp->dpr[i]);
/*#G GMP bug end */
}
if (MPS_STRUCTURE_IS_FP (s->active_poly->structure))
mpf_get_rdpe (mp->dpr[i], mpc_Re (mp->mfpc[i]));
cdpe_set_e (mp->dpc[i], mp->dpr[i], rdpe_zero);
/* compute dap[i] and check for float phase */
rdpe_abs (mp->dap[i], mp->dpr[i]);
rdpe_abs (mp->dap[i], mp->dpr[i]);
if (rdpe_gt (mp->dap[i], rdpe_maxd)
|| rdpe_lt (mp->dap[i], rdpe_mind))
s->skip_float = true;
}
else if (MPS_STRUCTURE_IS_COMPLEX (s->active_poly->structure))
{
if (MPS_STRUCTURE_IS_RATIONAL (s->active_poly->structure) ||
MPS_STRUCTURE_IS_INTEGER (s->active_poly->structure))
{
mpc_set_q (mptempc, mp->initial_mqp_r[i], mp->initial_mqp_i[i]);
mpc_get_cdpe (mp->dpc[i], mptempc);
/*#G GMP 2.0.2 bug begin */
if (rdpe_sgn (cdpe_Re (mp->dpc[i])) != mpq_sgn (mp->initial_mqp_r[i]))
rdpe_neg_eq (cdpe_Re (mp->dpc[i]));
if (rdpe_sgn (cdpe_Im (mp->dpc[i])) != mpq_sgn (mp->initial_mqp_i[i]))
rdpe_neg_eq (cdpe_Im (mp->dpc[i]));
/*#G GMP bug end */
}
else if (MPS_STRUCTURE_IS_FP (s->active_poly->structure))
mpc_get_cdpe (mp->dpc[i], mp->mfpc[i]);
/* compute dap[i] */
cdpe_mod (mp->dap[i], mp->dpc[i]);
if (rdpe_gt (mp->dap[i], rdpe_maxd)
|| rdpe_lt (mp->dap[i], rdpe_mind))
s->skip_float = true;
}
}
/* free temporary mp variables */
mpf_clear (mptemp);
mpc_clear (mptempc);
/* adjust input data type */
if (MPS_STRUCTURE_IS_FP (s->active_poly->structure) && s->skip_float)
s->active_poly->structure = MPS_STRUCTURE_IS_REAL (s->active_poly->structure) ?
MPS_STRUCTURE_REAL_BIGFLOAT : MPS_STRUCTURE_COMPLEX_BIGFLOAT;
/* prepare floating point vectors */
if (!s->skip_float)
for (i = 0; i <= MPS_POLYNOMIAL (p)->degree; i++)
{
if (MPS_DENSITY_IS_SPARSE (s->active_poly->density) || !mp->spar[i])
continue;
if (MPS_STRUCTURE_IS_REAL (s->active_poly->structure))
{
mp->fpr[i] = rdpe_get_d (mp->dpr[i]);
mp->fap[i] = fabs (mp->fpr[i]);
cplx_set_d (mp->fpc[i], mp->fpr[i], 0.0);
}
else
{
cdpe_get_x (mp->fpc[i], mp->dpc[i]);
mp->fap[i] = cplx_mod (mp->fpc[i]);
}
}
}
}
