void
arb_addmul_arf(arb_t z, const arb_t x, const arf_t y, slong prec)
{
mag_t ym;
int inexact;
if (arb_is_exact(x))
{
inexact = arf_addmul(arb_midref(z), arb_midref(x), y, prec, ARB_RND);
if (inexact)
arf_mag_add_ulp(arb_radref(z), arb_radref(z), arb_midref(z), prec);
}
else if (ARB_IS_LAGOM(x) && ARF_IS_LAGOM(y) && ARB_IS_LAGOM(z))
{
mag_fast_init_set_arf(ym, y);
mag_fast_addmul(arb_radref(z), ym, arb_radref(x));
inexact = arf_addmul(arb_midref(z), arb_midref(x), y, prec, ARB_RND);
if (inexact)
arf_mag_fast_add_ulp(arb_radref(z), arb_radref(z), arb_midref(z), prec);
}
else
{
mag_init_set_arf(ym, y);
mag_addmul(arb_radref(z), ym, arb_radref(x));
inexact = arf_addmul(arb_midref(z), arb_midref(x), y, prec, ARB_RND);
if (inexact)
arf_mag_add_ulp(arb_radref(z), arb_radref(z), arb_midref(z), prec);
mag_clear(ym);
}
}
void
arb_addmul(arb_t z, const arb_t x, const arb_t y, slong prec)
{
mag_t zr, xm, ym;
int inexact;
if (arb_is_exact(y))
{
arb_addmul_arf(z, x, arb_midref(y), prec);
}
else if (arb_is_exact(x))
{
arb_addmul_arf(z, y, arb_midref(x), prec);
}
else if (ARB_IS_LAGOM(x) && ARB_IS_LAGOM(y) && ARB_IS_LAGOM(z))
{
mag_fast_init_set_arf(xm, arb_midref(x));
mag_fast_init_set_arf(ym, arb_midref(y));
mag_fast_init_set(zr, arb_radref(z));
mag_fast_addmul(zr, xm, arb_radref(y));
mag_fast_addmul(zr, ym, arb_radref(x));
mag_fast_addmul(zr, arb_radref(x), arb_radref(y));
inexact = arf_addmul(arb_midref(z), arb_midref(x), arb_midref(y),
prec, ARF_RND_DOWN);
if (inexact)
arf_mag_fast_add_ulp(zr, zr, arb_midref(z), prec);
*arb_radref(z) = *zr;
}
else
{
mag_init_set_arf(xm, arb_midref(x));
mag_init_set_arf(ym, arb_midref(y));
mag_init_set(zr, arb_radref(z));
mag_addmul(zr, xm, arb_radref(y));
mag_addmul(zr, ym, arb_radref(x));
mag_addmul(zr, arb_radref(x), arb_radref(y));
inexact = arf_addmul(arb_midref(z), arb_midref(x), arb_midref(y),
prec, ARF_RND_DOWN);
if (inexact)
arf_mag_add_ulp(arb_radref(z), zr, arb_midref(z), prec);
else
mag_set(arb_radref(z), zr);
mag_clear(zr);
mag_clear(xm);
mag_clear(ym);
}
}
void arf_twobytwo_diag(arf_t u1, arf_t u2, const arf_t a, const arf_t b, const arf_t d, slong prec) {
// Compute the orthogonal matrix that diagonalizes
//
// A = [a b]
// [b d]
//
// This matrix will have the form
//
// U = [cos x , -sin x]
// [sin x, cos x]
//
// where the diagonal matrix is U^t A U.
// We set u1 = cos x, u2 = -sin x.
if(arf_is_zero(b)) {
arf_set_ui(u1, 1);
arf_set_ui(u2, 0);
return;
}
arf_t x; arf_init(x);
arf_mul(u1, b, b, prec, ARF_RND_NEAR); // u1 = b^2
arf_sub(u2, a, d, prec, ARF_RND_NEAR); // u2 = a - d
arf_mul_2exp_si(u2, u2, -1); // u2 = (a - d)/2
arf_mul(u2, u2, u2, prec, ARF_RND_NEAR); // u2 = ( (a - d)/2 )^2
arf_add(u1, u1, u2, prec, ARF_RND_NEAR); // u1 = b^2 + ( (a-d)/2 )^2
arf_sqrt(u1, u1, prec, ARF_RND_NEAR); // u1 = sqrt(above)
arf_mul_2exp_si(u1, u1, 1); // u1 = 2 (sqrt (above) )
arf_add(u1, u1, d, prec, ARF_RND_NEAR); // u1 += d
arf_sub(u1, u1, a, prec, ARF_RND_NEAR); // u1 -= a
arf_mul_2exp_si(u1, u1, -1); // u1 = (d - a)/2 + sqrt(b^2 + ( (a-d)/2 )^2)
arf_mul(x, u1, u1, prec, ARF_RND_NEAR);
arf_addmul(x, b, b, prec, ARF_RND_NEAR); // x = u1^2 + b^2
arf_sqrt(x, x, prec, ARF_RND_NEAR); // x = sqrt(u1^2 + b^2)
arf_div(u2, u1, x, prec, ARF_RND_NEAR);
arf_div(u1, b, x, prec, ARF_RND_NEAR);
arf_neg(u1, u1);
arf_clear(x);
}
void
arb_mul_naive(arb_t z, const arb_t x, const arb_t y, slong prec)
{
arf_t zm_exact, zm_rounded, zr, t, u;
arf_init(zm_exact);
arf_init(zm_rounded);
arf_init(zr);
arf_init(t);
arf_init(u);
arf_mul(zm_exact, arb_midref(x), arb_midref(y), ARF_PREC_EXACT, ARF_RND_DOWN);
arf_set_round(zm_rounded, zm_exact, prec, ARB_RND);
/* rounding error */
if (arf_equal(zm_exact, zm_rounded))
{
arf_zero(zr);
}
else
{
fmpz_t e;
fmpz_init(e);
/* more accurate, but not what we are testing
arf_sub(zr, zm_exact, zm_rounded, MAG_BITS, ARF_RND_UP);
arf_abs(zr, zr); */
fmpz_sub_ui(e, ARF_EXPREF(zm_rounded), prec);
arf_one(zr);
arf_mul_2exp_fmpz(zr, zr, e);
fmpz_clear(e);
}
/* propagated error */
if (!arb_is_exact(x))
{
arf_set_mag(t, arb_radref(x));
arf_abs(u, arb_midref(y));
arf_addmul(zr, t, u, MAG_BITS, ARF_RND_UP);
}
if (!arb_is_exact(y))
{
arf_set_mag(t, arb_radref(y));
arf_abs(u, arb_midref(x));
arf_addmul(zr, t, u, MAG_BITS, ARF_RND_UP);
}
if (!arb_is_exact(x) && !arb_is_exact(y))
{
arf_set_mag(t, arb_radref(x));
arf_set_mag(u, arb_radref(y));
arf_addmul(zr, t, u, MAG_BITS, ARF_RND_UP);
}
arf_set(arb_midref(z), zm_rounded);
arf_get_mag(arb_radref(z), zr);
arf_clear(zm_exact);
arf_clear(zm_rounded);
arf_clear(zr);
arf_clear(t);
arf_clear(u);
}
int main()
{
long iter, iter2;
flint_rand_t state;
printf("addmul....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 1000; iter++)
{
arf_t x, y, z, v;
long prec, r1, r2;
arf_rnd_t rnd;
arf_init(x);
arf_init(y);
arf_init(z);
arf_init(v);
for (iter2 = 0; iter2 < 100; iter2++)
{
arf_randtest_special(x, state, 2000, 100);
arf_randtest_special(y, state, 2000, 100);
arf_randtest_special(z, state, 2000, 100);
arf_set(v, z);
prec = 2 + n_randint(state, 2000);
if (n_randint(state, 10) == 0 &&
fmpz_bits(ARF_EXPREF(x)) < 10 &&
fmpz_bits(ARF_EXPREF(y)) < 10 &&
fmpz_bits(ARF_EXPREF(z)) < 10)
{
prec = ARF_PREC_EXACT;
}
switch (n_randint(state, 4))
{
case 0: rnd = ARF_RND_DOWN; break;
case 1: rnd = ARF_RND_UP; break;
case 2: rnd = ARF_RND_FLOOR; break;
default: rnd = ARF_RND_CEIL; break;
}
switch (n_randint(state, 5))
{
case 0:
r1 = arf_addmul(z, x, y, prec, rnd);
r2 = arf_addmul_naive(v, x, y, prec, rnd);
if (!arf_equal(z, v) || r1 != r2)
{
printf("FAIL!\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("x = "); arf_print(x); printf("\n\n");
printf("y = "); arf_print(y); printf("\n\n");
printf("z = "); arf_print(z); printf("\n\n");
printf("v = "); arf_print(v); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
case 1:
r1 = arf_addmul(z, x, x, prec, rnd);
r2 = arf_addmul_naive(v, x, x, prec, rnd);
if (!arf_equal(z, v) || r1 != r2)
{
printf("FAIL (aliasing 1)!\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("x = "); arf_print(x); printf("\n\n");
printf("z = "); arf_print(z); printf("\n\n");
printf("v = "); arf_print(v); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
case 2:
r2 = arf_addmul_naive(v, v, v, prec, rnd);
r1 = arf_addmul(z, z, z, prec, rnd);
if (!arf_equal(v, z) || r1 != r2)
{
printf("FAIL (aliasing 2)!\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("v = "); arf_print(v); printf("\n\n");
printf("z = "); arf_print(z); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
case 3:
r2 = arf_addmul_naive(v, v, y, prec, rnd);
r1 = arf_addmul(z, z, y, prec, rnd);
if (!arf_equal(v, z) || r1 != r2)
{
printf("FAIL (aliasing 3)!\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("y = "); arf_print(y); printf("\n\n");
printf("v = "); arf_print(v); printf("\n\n");
printf("z = "); arf_print(z); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
default:
r2 = arf_addmul_naive(v, x, v, prec, rnd);
r1 = arf_addmul(z, x, z, prec, rnd);
if (!arf_equal(z, v) || r1 != r2)
{
printf("FAIL (aliasing 4)!\n");
printf("prec = %ld, rnd = %d\n\n", prec, rnd);
printf("x = "); arf_print(x); printf("\n\n");
printf("v = "); arf_print(v); printf("\n\n");
printf("z = "); arf_print(z); printf("\n\n");
printf("r1 = %ld, r2 = %ld\n", r1, r2);
abort();
}
break;
}
}
arf_clear(x);
arf_clear(y);
arf_clear(z);
arf_clear(v);
}
flint_randclear(state);
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
int arb_mat_jacobi(arb_mat_t D, arb_mat_t P, const arb_mat_t A, slong prec) {
//
// Given a d x d real symmetric matrix A, compute an orthogonal matrix
// P and a diagonal D such that A = P D P^t = P D P^(-1).
//
// D should have already been initialized as a d x 1 matrix, and Pp
// should have already been initialized as a d x d matrix.
//
// If the eigenvalues can be certified as unique, then a nonzero int is
// returned, and the eigenvectors should have reasonable error bounds. If
// the eigenvalues cannot be certified as unique, then some of the
// eigenvectors will have infinite error radius.
#define B(i,j) arb_mat_entry(B, i, j)
#define D(i) arb_mat_entry(D, i, 0)
#define P(i,j) arb_mat_entry(P, i, j)
int dim = arb_mat_nrows(A);
if(dim == 1) {
arb_mat_set(D, A);
arb_mat_one(P);
return 0;
}
arb_mat_t B;
arb_mat_init(B, dim, dim);
arf_t * B1 = (arf_t*)malloc(dim * sizeof(arf_t));
arf_t * B2 = (arf_t*)malloc(dim * sizeof(arf_t));
arf_t * row_max = (arf_t*)malloc((dim - 1) * sizeof(arf_t));
int * row_max_indices = (int*)malloc((dim - 1) * sizeof(int));
for(int k = 0; k < dim; k++) {
arf_init(B1[k]);
arf_init(B2[k]);
}
for(int k = 0; k < dim - 1; k++) {
arf_init(row_max[k]);
}
arf_t x1, x2;
arf_init(x1);
arf_init(x2);
arf_t Gii, Gij, Gji, Gjj;
arf_init(Gii);
arf_init(Gij);
arf_init(Gji);
arf_init(Gjj);
arb_mat_set(B, A);
arb_mat_one(P);
for(int i = 0; i < dim - 1; i++) {
for(int j = i + 1; j < dim; j++) {
arf_abs(x1, arb_midref(B(i,j)));
if(arf_cmp(row_max[i], x1) < 0) {
arf_set(row_max[i], x1);
row_max_indices[i] = j;
}
}
}
int finished = 0;
while(!finished) {
arf_zero(x1);
int i = 0;
int j = 0;
for(int k = 0; k < dim - 1; k++) {
if(arf_cmp(x1, row_max[k]) < 0) {
arf_set(x1, row_max[k]);
i = k;
}
}
j = row_max_indices[i];
slong bound = arf_abs_bound_lt_2exp_si(x1);
if(bound < -prec * .9) {
finished = 1;
break;
}
else {
//printf("%ld\n", arf_abs_bound_lt_2exp_si(x1));
//arb_mat_printd(B, 10);
//printf("\n");
}
arf_twobytwo_diag(Gii, Gij, arb_midref(B(i,i)), arb_midref(B(i,j)), arb_midref(B(j,j)), 2*prec);
arf_neg(Gji, Gij);
arf_set(Gjj, Gii);
//printf("%d %d\n", i, j);
//arf_printd(Gii, 100);
//printf(" ");
//arf_printd(Gij, 100);
//printf("\n");
if(arf_is_zero(Gij)) { // If this happens, we're
finished = 1; // not going to do any better
break; // without increasing the precision.
}
for(int k = 0; k < dim; k++) {
arf_mul(B1[k], Gii, arb_midref(B(i,k)), prec, ARF_RND_NEAR);
arf_addmul(B1[k], Gji, arb_midref(B(j,k)), prec, ARF_RND_NEAR);
arf_mul(B2[k], Gij, arb_midref(B(i,k)), prec, ARF_RND_NEAR);
arf_addmul(B2[k], Gjj, arb_midref(B(j,k)), prec, ARF_RND_NEAR);
}
for(int k = 0; k < dim; k++) {
arf_set(arb_midref(B(i,k)), B1[k]);
arf_set(arb_midref(B(j,k)), B2[k]);
}
for(int k = 0; k < dim; k++) {
arf_mul(B1[k], Gii, arb_midref(B(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B1[k], Gji, arb_midref(B(k,j)), prec, ARF_RND_NEAR);
arf_mul(B2[k], Gij, arb_midref(B(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B2[k], Gjj, arb_midref(B(k,j)), prec, ARF_RND_NEAR);
}
for(int k = 0; k < dim; k++) {
arf_set(arb_midref(B(k,i)), B1[k]);
arf_set(arb_midref(B(k,j)), B2[k]);
}
for(int k = 0; k < dim; k++) {
arf_mul(B1[k], Gii, arb_midref(P(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B1[k], Gji, arb_midref(P(k,j)), prec, ARF_RND_NEAR);
arf_mul(B2[k], Gij, arb_midref(P(k,i)), prec, ARF_RND_NEAR);
arf_addmul(B2[k], Gjj, arb_midref(P(k,j)), prec, ARF_RND_NEAR);
}
for(int k = 0; k < dim; k++) {
arf_set(arb_midref(P(k,i)), B1[k]);
arf_set(arb_midref(P(k,j)), B2[k]);
}
if(i < dim - 1)
arf_set_ui(row_max[i], 0);
if(j < dim - 1)
arf_set_ui(row_max[j], 0);
// Update the max in any row where the maximum
// was in a column that changed.
for(int k = 0; k < dim - 1; k++) {
if(row_max_indices[k] == j || row_max_indices[k] == i) {
arf_abs(row_max[k], arb_midref(B(k,k+1)));
row_max_indices[k] = k+1;
for(int l = k+2; l < dim; l++) {
arf_abs(x1, arb_midref(B(k,l)));
if(arf_cmp(row_max[k], x1) < 0) {
arf_set(row_max[k], x1);
row_max_indices[k] = l;
}
}
}
}
// Update the max in the ith row.
for(int k = i + 1; k < dim; k++) {
arf_abs(x1, arb_midref(B(i, k)));
if(arf_cmp(row_max[i], x1) < 0) {
arf_set(row_max[i], x1);
row_max_indices[i] = k;
}
}
// Update the max in the jth row.
for(int k = j + 1; k < dim; k++) {
arf_abs(x1, arb_midref(B(j, k)));
if(arf_cmp(row_max[j], x1) < 0) {
arf_set(row_max[j], x1);
row_max_indices[j] = k;
}
}
// Go through column i to see if any of
// the new entries are larger than the
// max of their row.
for(int k = 0; k < i; k++) {
if(k == dim) continue;
arf_abs(x1, arb_midref(B(k, i)));
if(arf_cmp(row_max[k], x1) < 0) {
arf_set(row_max[k], x1);
row_max_indices[k] = i;
}
}
// And then column j.
for(int k = 0; k < j; k++) {
if(k == dim) continue;
arf_abs(x1, arb_midref(B(k, j)));
if(arf_cmp(row_max[k], x1) < 0) {
arf_set(row_max[k], x1);
row_max_indices[k] = j;
}
}
}
for(int k = 0; k < dim; k++) {
arb_set(D(k), B(k,k));
arb_set_exact(D(k));
}
// At this point we've done that diagonalization and all that remains is
// to certify the correctness and compute error bounds.
arb_mat_t e;
arb_t error_norms[dim];
for(int k = 0; k < dim; k++) arb_init(error_norms[k]);
arb_mat_init(e, dim, 1);
arb_t z1, z2;
arb_init(z1);
arb_init(z2);
for(int j = 0; j < dim; j++) {
arb_mat_set(B, A);
for(int k = 0; k < dim; k++) {
arb_sub(B(k, k), B(k, k), D(j), prec);
}
for(int k = 0; k < dim; k++) {
arb_set(arb_mat_entry(e, k, 0), P(k, j));
}
arb_mat_L2norm(z2, e, prec);
arb_mat_mul(e, B, e, prec);
arb_mat_L2norm(error_norms[j], e, prec);
arb_div(z2, error_norms[j], z2, prec); // and now z1 is an upper bound for the
// error in the eigenvalue
arb_add_error(D(j), z2);
}
int unique_eigenvalues = 1;
for(int j = 0; j < dim; j++) {
if(j == 0) {
arb_sub(z1, D(j), D(1), prec);
}
else {
arb_sub(z1, D(j), D(0), prec);
}
arb_get_abs_lbound_arf(x1, z1, prec);
for(int k = 1; k < dim; k++) {
if(k == j) continue;
arb_sub(z1, D(j), D(k), prec);
arb_get_abs_lbound_arf(x2, z1, prec);
if(arf_cmp(x2, x1) < 0) {
arf_set(x1, x2);
}
}
if(arf_is_zero(x1)) {
unique_eigenvalues = 0;
}
arb_div_arf(z1, error_norms[j], x1, prec);
for(int k = 0; k < dim; k++) {
arb_add_error(P(k, j), z1);
}
}
arb_mat_clear(e);
arb_clear(z1);
arb_clear(z2);
for(int k = 0; k < dim; k++) arb_clear(error_norms[k]);
arf_clear(x1);
arf_clear(x2);
arb_mat_clear(B);
for(int k = 0; k < dim; k++) {
arf_clear(B1[k]);
arf_clear(B2[k]);
}
for(int k = 0; k < dim - 1; k++) {
arf_clear(row_max[k]);
}
arf_clear(Gii);
arf_clear(Gij);
arf_clear(Gji);
arf_clear(Gjj);
free(B1);
free(B2);
free(row_max);
free(row_max_indices);
if(unique_eigenvalues) return 0;
else return 1;
#undef B
#undef D
#undef P
}
