int
_spd_solve(arb_mat_t X, const arb_mat_t A, const arb_mat_t B, slong prec)
{
slong n, m;
int result;
arb_mat_t L;
n = arb_mat_nrows(A);
m = arb_mat_ncols(X);
if (n == 0 || m == 0)
return 1;
n = arb_mat_nrows(A);
arb_mat_init(L, n, n);
result = arb_mat_cho(L, A, prec);
if (result)
{
arb_mat_solve_cho_precomp(X, L, B, prec);
}
arb_mat_clear(L);
return result;
}
void arb_mat_set_exact(arb_mat_t A) {
int nrows = arb_mat_nrows(A);
int ncols = arb_mat_nrows(A);
for(int i = 0; i < nrows; i++) {
for(int j = 0; j < ncols; j++) {
arb_set_exact(arb_mat_entry(A, i, j));
}
}
}
void
arb_mat_randtest(arb_mat_t mat, flint_rand_t state, slong prec, slong mag_bits)
{
slong i, j;
if (n_randint(state, 2))
for (i = 0; i < arb_mat_nrows(mat); i++)
for (j = 0; j < arb_mat_ncols(mat); j++)
arb_randtest(arb_mat_entry(mat, i, j), state, prec, mag_bits);
else
for (i = 0; i < arb_mat_nrows(mat); i++)
for (j = 0; j < arb_mat_ncols(mat); j++)
arb_randtest_precise(arb_mat_entry(mat, i, j), state, prec, mag_bits);
}
void
arb_mat_mul_classical(arb_mat_t C, const arb_mat_t A, const arb_mat_t B, long prec)
{
long ar, ac, br, bc, i, j, k;
ar = arb_mat_nrows(A);
ac = arb_mat_ncols(A);
br = arb_mat_nrows(B);
bc = arb_mat_ncols(B);
if (ac != br || ar != arb_mat_nrows(C) || bc != arb_mat_ncols(C))
{
printf("arb_mat_mul: incompatible dimensions\n");
abort();
}
if (br == 0)
{
arb_mat_zero(C);
return;
}
if (A == C || B == C)
{
arb_mat_t T;
arb_mat_init(T, ar, bc);
arb_mat_mul(T, A, B, prec);
arb_mat_swap(T, C);
arb_mat_clear(T);
return;
}
for (i = 0; i < ar; i++)
{
for (j = 0; j < bc; j++)
{
arb_mul(arb_mat_entry(C, i, j),
arb_mat_entry(A, i, 0),
arb_mat_entry(B, 0, j), prec);
for (k = 1; k < br; k++)
{
arb_addmul(arb_mat_entry(C, i, j),
arb_mat_entry(A, i, k),
arb_mat_entry(B, k, j), prec);
}
}
}
}
void
arb_mat_bound_inf_norm(mag_t b, const arb_mat_t A)
{
slong i, j, r, c;
mag_t s, t;
r = arb_mat_nrows(A);
c = arb_mat_ncols(A);
mag_zero(b);
if (r == 0 || c == 0)
return;
mag_init(s);
mag_init(t);
for (i = 0; i < r; i++)
{
mag_zero(s);
for (j = 0; j < c; j++)
{
arb_get_mag(t, arb_mat_entry(A, i, j));
mag_add(s, s, t);
}
mag_max(b, b, s);
}
mag_clear(s);
mag_clear(t);
}
int
arb_mat_approx_solve(arb_mat_t X, const arb_mat_t A, const arb_mat_t B, slong prec)
{
int result;
slong n, m, *perm;
arb_mat_t LU;
n = arb_mat_nrows(A);
m = arb_mat_ncols(X);
if (n == 0 || m == 0)
return 1;
perm = _perm_init(n);
arb_mat_init(LU, n, n);
result = arb_mat_approx_lu(perm, LU, A, prec);
if (result)
arb_mat_approx_solve_lu_precomp(X, perm, LU, B, prec);
arb_mat_clear(LU);
_perm_clear(perm);
return result;
}
int
arb_mat_contains(const arb_mat_t mat1, const arb_mat_t mat2)
{
slong i, j;
if ((arb_mat_nrows(mat1) != arb_mat_nrows(mat2)) ||
(arb_mat_ncols(mat1) != arb_mat_ncols(mat2)))
return 0;
for (i = 0; i < arb_mat_nrows(mat1); i++)
for (j = 0; j < arb_mat_ncols(mat1); j++)
if (!arb_contains(arb_mat_entry(mat1, i, j), arb_mat_entry(mat2, i, j)))
return 0;
return 1;
}
void
arb_mat_mul(arb_mat_t C, const arb_mat_t A, const arb_mat_t B, slong prec)
{
if (flint_get_num_threads() > 1 &&
((double) arb_mat_nrows(A) *
(double) arb_mat_nrows(B) *
(double) arb_mat_ncols(B) *
(double) prec > 100000))
{
arb_mat_mul_threaded(C, A, B, prec);
}
else
{
arb_mat_mul_classical(C, A, B, prec);
}
}
int
arb_mat_lu(long * P, arb_mat_t LU, const arb_mat_t A, long prec)
{
arb_t d, e;
arb_ptr * a;
long i, j, m, n, r, row, col;
int result;
m = arb_mat_nrows(A);
n = arb_mat_ncols(A);
result = 1;
if (m == 0 || n == 0)
return result;
arb_mat_set(LU, A);
a = LU->rows;
row = col = 0;
for (i = 0; i < m; i++)
P[i] = i;
arb_init(d);
arb_init(e);
while (row < m && col < n)
{
r = arb_mat_find_pivot_partial(LU, row, m, col);
if (r == -1)
{
result = 0;
break;
}
else if (r != row)
arb_mat_swap_rows(LU, P, row, r);
arb_set(d, a[row] + col);
for (j = row + 1; j < m; j++)
{
arb_div(e, a[j] + col, d, prec);
arb_neg(e, e);
_arb_vec_scalar_addmul(a[j] + col,
a[row] + col, n - col, e, prec);
arb_zero(a[j] + col);
arb_neg(a[j] + row, e);
}
row++;
col++;
}
arb_clear(d);
arb_clear(e);
return result;
}
void
arb_mat_zero(arb_mat_t mat)
{
slong i, j;
for (i = 0; i < arb_mat_nrows(mat); i++)
for (j = 0; j < arb_mat_ncols(mat); j++)
arb_zero(arb_mat_entry(mat, i, j));
}
int
arb_mat_solve(arb_mat_t X, const arb_mat_t A, const arb_mat_t B, slong prec)
{
slong n = arb_mat_nrows(A);
if (n <= 4 || prec > 10.0 * n)
return arb_mat_solve_lu(X, A, B, prec);
else
return arb_mat_solve_precond(X, A, B, prec);
}
void arb_mat_L2norm(arb_t out, const arb_mat_t in, slong prec) {
int nrows = arb_mat_nrows(in);
int ncols = arb_mat_ncols(in);
arb_zero(out);
for(int i = 0; i < nrows; i++) {
for(int j = 0; j < ncols; j++) {
arb_addmul(out, arb_mat_entry(in, i, j), arb_mat_entry(in, i, j), prec);
}
}
arb_sqrtpos(out, out, prec);
}
void
arb_mat_sub(arb_mat_t res,
const arb_mat_t mat1, const arb_mat_t mat2, slong prec)
{
slong i, j;
for (i = 0; i < arb_mat_nrows(mat1); i++)
for (j = 0; j < arb_mat_ncols(mat1); j++)
arb_sub(arb_mat_entry(res, i, j),
arb_mat_entry(mat1, i, j),
arb_mat_entry(mat2, i, j), prec);
}
void
arb_mat_ones(arb_mat_t mat)
{
slong R, C, i, j;
R = arb_mat_nrows(mat);
C = arb_mat_ncols(mat);
for (i = 0; i < R; i++)
for (j = 0; j < C; j++)
arb_one(arb_mat_entry(mat, i, j));
}
void
arb_mat_set_round_fmpz_mat(arb_mat_t dest, const fmpz_mat_t src, slong prec)
{
slong i, j;
if (arb_mat_ncols(dest) != 0)
{
for (i = 0; i < arb_mat_nrows(dest); i++)
for (j = 0; j < arb_mat_ncols(dest); j++)
arb_set_round_fmpz(arb_mat_entry(dest, i, j),
fmpz_mat_entry(src, i, j), prec);
}
}
void
arb_mat_pow_ui(arb_mat_t B, const arb_mat_t A, ulong exp, slong prec)
{
slong d = arb_mat_nrows(A);
if (exp <= 2 || d <= 1)
{
if (exp == 0 || d == 0)
{
arb_mat_one(B);
}
else if (d == 1)
{
arb_pow_ui(arb_mat_entry(B, 0, 0),
arb_mat_entry(A, 0, 0), exp, prec);
}
else if (exp == 1)
{
arb_mat_set(B, A);
}
else if (exp == 2)
{
arb_mat_sqr(B, A, prec);
}
}
else
{
arb_mat_t T, U;
slong i;
arb_mat_init(T, d, d);
arb_mat_set(T, A);
arb_mat_init(U, d, d);
for (i = ((slong) FLINT_BIT_COUNT(exp)) - 2; i >= 0; i--)
{
arb_mat_sqr(U, T, prec);
if (exp & (WORD(1) << i))
arb_mat_mul(T, U, A, prec);
else
arb_mat_swap(T, U);
}
arb_mat_swap(B, T);
arb_mat_clear(T);
arb_mat_clear(U);
}
}
int
arb_mat_is_triu(const arb_mat_t A)
{
slong i, j, n, m;
n = arb_mat_nrows(A);
m = arb_mat_ncols(A);
for (i = 1; i < n; i++)
for (j = 0; j < FLINT_MIN(i, m); j++)
if (!arb_is_zero(arb_mat_entry(A, i, j)))
return 0;
return 1;
}
void arb_mat_print_sage_float(const arb_mat_t A) {
int nrows = arb_mat_nrows(A);
int ncols = arb_mat_ncols(A);
printf("[");
for(int j = 0; j < nrows; j++) {
printf("[");
for(int k = 0; k < ncols; k++) {
double x = arf_get_d(arb_midref(arb_mat_entry(A, j, k)), ARF_RND_NEAR);
printf("%e", x);
if(k < nrows - 1)
printf(", ");
}
printf("],\n");
}
printf("]\n");
}
int
arb_mat_inv(arb_mat_t X, const arb_mat_t A, slong prec)
{
if (X == A)
{
int r;
arb_mat_t T;
arb_mat_init(T, arb_mat_nrows(A), arb_mat_ncols(A));
r = arb_mat_inv(T, A, prec);
arb_mat_swap(T, X);
arb_mat_clear(T);
return r;
}
arb_mat_one(X);
return arb_mat_solve(X, A, X, prec);
}
void arb_mat_cholesky(arb_mat_t out, const arb_mat_t in, slong prec) {
int nrows = arb_mat_nrows(in);
for(int j = 0; j < nrows; j++) {
for(int i = j; i < nrows; i++) {
arb_set(arb_mat_entry(out, i, j), arb_mat_entry(in, i, j));
for(int k = 0; k < j; k++) {
arb_submul(arb_mat_entry(out, i, j), arb_mat_entry(out, i, k), arb_mat_entry(out, j, k), prec);
}
if(i == j) {
arb_sqrt(arb_mat_entry(out, i, j), arb_mat_entry(out, i, j), prec);
}
else {
arb_div(arb_mat_entry(out, i, j), arb_mat_entry(out, i, j), arb_mat_entry(out, j, j), prec);
}
}
}
}
int
acb_mat_eig_multiple(acb_ptr E, const acb_mat_t A, acb_srcptr E_approx, const acb_mat_t R_approx, slong prec)
{
slong n;
acb_ptr F;
int success;
n = arb_mat_nrows(A);
F = _acb_vec_init(n);
success = acb_mat_eig_simple_vdhoeven_mourrain(F, NULL, NULL, A, E_approx, R_approx, prec);
if (!success)
success = acb_mat_eig_multiple_rump(F, A, E_approx, R_approx, prec);
_acb_vec_set(E, F, n);
_acb_vec_clear(F, n);
return success;
}
void
arb_mat_solve_cho_precomp(arb_mat_t X,
const arb_mat_t L, const arb_mat_t B, slong prec)
{
slong i, j, c, n, m;
n = arb_mat_nrows(X);
m = arb_mat_ncols(X);
arb_mat_set(X, B);
for (c = 0; c < m; c++)
{
/* solve Ly = b */
for (i = 0; i < n; i++)
{
for (j = 0; j < i; j++)
{
arb_submul(arb_mat_entry(X, i, c),
arb_mat_entry(L, i, j), arb_mat_entry(X, j, c), prec);
}
arb_div(arb_mat_entry(X, i, c), arb_mat_entry(X, i, c),
arb_mat_entry(L, i, i), prec);
}
/* solve Ux = y */
for (i = n - 1; i >= 0; i--)
{
for (j = i + 1; j < n; j++)
{
arb_submul(arb_mat_entry(X, i, c),
arb_mat_entry(L, j, i), arb_mat_entry(X, j, c), prec);
}
arb_div(arb_mat_entry(X, i, c), arb_mat_entry(X, i, c),
arb_mat_entry(L, i, i), prec);
}
}
}
void
arb_mat_trace(arb_t trace, const arb_mat_t mat, slong prec)
{
slong i;
if (!arb_mat_is_square(mat))
{
flint_printf("arb_mat_trace: a square matrix is required!\n");
abort();
}
if (arb_mat_is_empty(mat))
{
arb_zero(trace);
return;
}
arb_set(trace, arb_mat_entry(mat, 0, 0));
for (i = 1; i < arb_mat_nrows(mat); i++)
{
arb_add(trace, trace, arb_mat_entry(mat, i, i), prec);
}
}
void
arb_mat_frobenius_norm(arb_t res, const arb_mat_t A, slong prec)
{
slong i, j, r, c;
r = arb_mat_nrows(A);
c = arb_mat_ncols(A);
arb_zero(res);
if (r == 0 || c == 0)
return;
for (i = 0; i < r; i++)
{
for (j = 0; j < c; j++)
{
arb_srcptr x = arb_mat_entry(A, i, j);
arb_addmul(res, x, x, prec);
}
}
arb_sqrtpos(res, res, prec);
}
static int
_spd_inv(arb_mat_t X, const arb_mat_t A, slong prec)
{
slong n;
arb_mat_t L;
int result;
n = arb_mat_nrows(A);
arb_mat_init(L, n, n);
arb_mat_set(L, A);
if (_arb_mat_ldl_inplace(L, prec))
{
arb_mat_inv_ldl_precomp(X, L, prec);
result = 1;
}
else
{
result = 0;
}
arb_mat_clear(L);
return result;
}
int arb_mat_generalized_eigenproblem_symmetric_positive_definite(arb_mat_t D, arb_mat_t P, const arb_mat_t A, const arb_mat_t B, slong prec) {
// solve the generalized eigenvalue problem Ax = lambda * Bx, where B
// is symmetric positive definite and A is symmetric.
//
// Returns 0 on success.
//
// If there is a problem inverting the Cholesky factorization of B, returns -1.
// If the eigenvalues are not distinct (or cannot be certified as distinct),
// returns 1. In this case the returned eigenvalues will be correct, but
// some eigenvectors will be nonsense, or will be accurate eigenvectors but with
// infinite radius, or something like that.
int dim = arb_mat_nrows(B);
arb_mat_t L;
arb_mat_t X;
arb_mat_init(L, dim, dim);
arb_mat_init(X, dim, dim);
arb_mat_cholesky(L, B, prec);
int result = arb_mat_inv(L, L, prec);
if(!result) {
arb_mat_clear(L);
arb_mat_clear(X);
return -1;
}
arb_mat_mul(X, L, A, prec);
arb_mat_transpose(L, L);
arb_mat_mul(X, X, L, prec);
result = arb_mat_jacobi(D, P, X, prec);
arb_mat_mul(P, L, P, prec);
//arb_mat_transpose(P, P);
arb_mat_clear(L);
arb_mat_clear(X);
return result;
}
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
}
void
arb_mat_inv_cho_precomp(arb_mat_t X, const arb_mat_t L, slong prec)
{
slong n;
if (arb_mat_nrows(X) != arb_mat_nrows(L) ||
arb_mat_ncols(X) != arb_mat_ncols(L))
{
flint_printf("arb_mat_inv_cho_precomp: incompatible dimensions\n");
abort();
}
if (arb_mat_is_empty(L))
return;
n = arb_mat_nrows(L);
if (n == 1)
{
arb_inv(arb_mat_entry(X, 0, 0), arb_mat_entry(L, 0, 0), prec);
_arb_sqr(arb_mat_entry(X, 0, 0), arb_mat_entry(X, 0, 0), prec);
return;
}
if (X == L)
{
flint_printf("arb_mat_inv_cho_precomp: unsupported aliasing\n");
abort();
}
/* invert a 2x2 or larger matrix given its L * L^T decomposition */
{
slong i, j, k;
arb_struct *s;
arb_mat_zero(X);
s = _arb_vec_init(n);
for (i = 0; i < n; i++)
{
arb_inv(s + i, arb_mat_entry(L, i, i), prec);
}
for (j = n-1; j >= 0; j--)
{
for (i = j; i >= 0; i--)
{
if (i == j)
{
arb_set(arb_mat_entry(X, i, j), s + i);
}
else
{
arb_zero(arb_mat_entry(X, i, j));
}
for (k = i + 1; k < n; k++)
{
arb_submul(arb_mat_entry(X, i, j),
arb_mat_entry(L, k, i),
arb_mat_entry(X, k, j), prec);
}
arb_div(arb_mat_entry(X, i, j),
arb_mat_entry(X, i, j),
arb_mat_entry(L, i, i), prec);
arb_set(arb_mat_entry(X, j, i),
arb_mat_entry(X, i, j));
}
}
_arb_vec_clear(s, n);
}
}
void
arb_mat_exp(arb_mat_t B, const arb_mat_t A, slong prec)
{
slong i, j, dim, wp, N, q, r;
mag_t norm, err;
arb_mat_t T;
dim = arb_mat_nrows(A);
if (dim != arb_mat_ncols(A))
{
flint_printf("arb_mat_exp: a square matrix is required!\n");
abort();
}
if (dim == 0)
{
return;
}
else if (dim == 1)
{
arb_exp(arb_mat_entry(B, 0, 0), arb_mat_entry(A, 0, 0), prec);
return;
}
wp = prec + 3 * FLINT_BIT_COUNT(prec);
mag_init(norm);
mag_init(err);
arb_mat_init(T, dim, dim);
arb_mat_bound_inf_norm(norm, A);
if (mag_is_zero(norm))
{
arb_mat_one(B);
}
else
{
q = pow(wp, 0.25); /* wanted magnitude */
if (mag_cmp_2exp_si(norm, 2 * wp) > 0) /* too big */
r = 2 * wp;
else if (mag_cmp_2exp_si(norm, -q) < 0) /* tiny, no need to reduce */
r = 0;
else
r = FLINT_MAX(0, q + MAG_EXP(norm)); /* reduce to magnitude 2^(-r) */
arb_mat_scalar_mul_2exp_si(T, A, -r);
mag_mul_2exp_si(norm, norm, -r);
N = _arb_mat_exp_choose_N(norm, wp);
mag_exp_tail(err, norm, N);
_arb_mat_exp_taylor(B, T, N, wp);
for (i = 0; i < dim; i++)
for (j = 0; j < dim; j++)
arb_add_error_mag(arb_mat_entry(B, i, j), err);
for (i = 0; i < r; i++)
{
arb_mat_mul(T, B, B, wp);
arb_mat_swap(T, B);
}
for (i = 0; i < dim; i++)
for (j = 0; j < dim; j++)
arb_set_round(arb_mat_entry(B, i, j),
arb_mat_entry(B, i, j), prec);
}
mag_clear(norm);
mag_clear(err);
arb_mat_clear(T);
}
/* evaluates the truncated Taylor series (assumes no aliasing) */
void
_arb_mat_exp_taylor(arb_mat_t S, const arb_mat_t A, slong N, slong prec)
{
if (N == 1)
{
arb_mat_one(S);
}
else if (N == 2)
{
arb_mat_one(S);
arb_mat_add(S, S, A, prec);
}
else if (N == 3)
{
arb_mat_t T;
arb_mat_init(T, arb_mat_nrows(A), arb_mat_nrows(A));
arb_mat_mul(T, A, A, prec);
arb_mat_scalar_mul_2exp_si(T, T, -1);
arb_mat_add(S, A, T, prec);
arb_mat_one(T);
arb_mat_add(S, S, T, prec);
arb_mat_clear(T);
}
else
{
slong i, lo, hi, m, w, dim;
arb_mat_struct * pows;
arb_mat_t T, U;
fmpz_t c, f;
dim = arb_mat_nrows(A);
m = n_sqrt(N);
w = (N + m - 1) / m;
fmpz_init(c);
fmpz_init(f);
pows = flint_malloc(sizeof(arb_mat_t) * (m + 1));
arb_mat_init(T, dim, dim);
arb_mat_init(U, dim, dim);
for (i = 0; i <= m; i++)
{
arb_mat_init(pows + i, dim, dim);
if (i == 0)
arb_mat_one(pows + i);
else if (i == 1)
arb_mat_set(pows + i, A);
else
arb_mat_mul(pows + i, pows + i - 1, A, prec);
}
arb_mat_zero(S);
fmpz_one(f);
for (i = w - 1; i >= 0; i--)
{
lo = i * m;
hi = FLINT_MIN(N - 1, lo + m - 1);
arb_mat_zero(T);
fmpz_one(c);
while (hi >= lo)
{
arb_mat_scalar_addmul_fmpz(T, pows + hi - lo, c, prec);
if (hi != 0)
fmpz_mul_ui(c, c, hi);
hi--;
}
arb_mat_mul(U, pows + m, S, prec);
arb_mat_scalar_mul_fmpz(S, T, f, prec);
arb_mat_add(S, S, U, prec);
fmpz_mul(f, f, c);
}
arb_mat_scalar_div_fmpz(S, S, f, prec);
fmpz_clear(c);
fmpz_clear(f);
for (i = 0; i <= m; i++)
arb_mat_clear(pows + i);
flint_free(pows);
arb_mat_clear(T);
arb_mat_clear(U);
}
}
