static void
_update_aggregated_state_frechet_matrices(
cross_site_ws_t csw, model_and_data_t m,
nd_axis_struct *edge_axis, nd_axis_struct *trans_axis,
const int *first_idx, const int *second_idx, slong prec)
{
arb_mat_t P, L, Q;
arb_t rate;
slong first_state, second_state;
slong cat, trans_idx;
slong state_count = model_and_data_state_count(m);
slong edge_count = model_and_data_edge_count(m);
slong rate_category_count = model_and_data_rate_category_count(m);
arb_init(rate);
arb_mat_init(P, state_count, state_count);
arb_mat_init(L, state_count, state_count);
arb_mat_init(Q, state_count, state_count);
/* set entries of L to the requested transition weights */
for (trans_idx = 0; trans_idx < trans_axis->n; trans_idx++)
{
first_state = first_idx[trans_idx];
second_state = second_idx[trans_idx];
arb_add(arb_mat_entry(L, first_state, second_state),
arb_mat_entry(L, first_state, second_state),
trans_axis->agg_weights + trans_idx, prec);
}
/* multiply entries of L by the rate matrix entries */
arb_mat_mul_entrywise(L, L, csw->rate_matrix, prec);
/* divide L by the global weight divisor */
arb_mat_scalar_div_arb(L, L, trans_axis->agg_weight_divisor, prec);
for (cat = 0; cat < rate_category_count; cat++)
{
slong edge;
const arb_struct * cat_rate = csw->rate_mix_rates + cat;
for (edge = 0; edge < edge_count; edge++)
{
slong idx = m->edge_map->order[edge];
const arb_struct * edge_rate = csw->edge_rates + idx;
arb_mat_struct *fmat;
if (!edge_axis->request_update[edge]) continue;
fmat = cross_site_ws_trans_frechet_matrix(csw, cat, idx);
arb_mul(rate, edge_rate, cat_rate, prec);
arb_mat_scalar_mul_arb(Q, csw->rate_matrix, rate, prec);
_arb_mat_exp_frechet(P, fmat, Q, L, prec);
}
}
arb_clear(rate);
arb_mat_clear(P);
arb_mat_clear(L);
arb_mat_clear(Q);
}
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_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
_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;
}
/*
* Update the frechet matrix for each rate category and edge.
* At this point the rate matrix has been normalized
* to have zero row sums, but it has not been scaled
* by the edge rate coefficients.
* The frechet matrices must already have been initialized.
*/
static void
_update_state_pair_frechet_matrices(
cross_site_ws_t csw, model_and_data_t m,
nd_axis_struct *edge_axis,
slong first_state, slong second_state, slong prec)
{
arb_mat_t P, L, Q;
slong cat;
arb_t rate;
slong state_count = model_and_data_state_count(m);
slong edge_count = model_and_data_edge_count(m);
slong rate_category_count = model_and_data_rate_category_count(m);
arb_init(rate);
arb_mat_init(P, state_count, state_count);
arb_mat_init(L, state_count, state_count);
arb_mat_init(Q, state_count, state_count);
arb_set(arb_mat_entry(L, first_state, second_state),
arb_mat_entry(csw->rate_matrix, first_state, second_state));
for (cat = 0; cat < rate_category_count; cat++)
{
slong edge;
const arb_struct * cat_rate = csw->rate_mix_rates + cat;
for (edge = 0; edge < edge_count; edge++)
{
slong idx = m->edge_map->order[edge];
const arb_struct * edge_rate = csw->edge_rates + idx;
arb_mat_struct *fmat;
if (!edge_axis->request_update[edge]) continue;
fmat = cross_site_ws_trans_frechet_matrix(csw, cat, idx);
arb_mul(rate, edge_rate, cat_rate, prec);
arb_mat_scalar_mul_arb(Q, csw->rate_matrix, rate, prec);
_arb_mat_exp_frechet(P, fmat, Q, L, prec);
}
}
arb_clear(rate);
arb_mat_clear(P);
arb_mat_clear(L);
arb_mat_clear(Q);
}
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);
}
}
}
}
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;
}
void
arb_mat_approx_solve_tril_recursive(arb_mat_t X,
const arb_mat_t L, const arb_mat_t B, int unit, slong prec)
{
arb_mat_t LA, LC, LD, XX, XY, BX, BY, T;
slong r, n, m;
n = L->r;
m = B->c;
r = n / 2;
if (n == 0 || m == 0)
return;
/*
Denoting inv(M) by M^, we have:
[A 0]^ [X] == [A^ 0 ] [X] == [A^ X]
[C D] [Y] == [-D^ C A^ D^] [Y] == [D^ (Y - C A^ X)]
*/
arb_mat_window_init(LA, L, 0, 0, r, r);
arb_mat_window_init(LC, L, r, 0, n, r);
arb_mat_window_init(LD, L, r, r, n, n);
arb_mat_window_init(BX, B, 0, 0, r, m);
arb_mat_window_init(BY, B, r, 0, n, m);
arb_mat_window_init(XX, X, 0, 0, r, m);
arb_mat_window_init(XY, X, r, 0, n, m);
arb_mat_approx_solve_tril(XX, LA, BX, unit, prec);
/* arb_mat_submul(XY, BY, LC, XX); */
arb_mat_init(T, LC->r, BX->c);
arb_mat_approx_mul(T, LC, XX, prec);
arb_mat_sub(XY, BY, T, prec);
arb_mat_get_mid(XY, XY);
arb_mat_clear(T);
arb_mat_approx_solve_tril(XY, LD, XY, unit, prec);
arb_mat_window_clear(LA);
arb_mat_window_clear(LC);
arb_mat_window_clear(LD);
arb_mat_window_clear(BX);
arb_mat_window_clear(BY);
arb_mat_window_clear(XX);
arb_mat_window_clear(XY);
}
void
cross_site_ws_clear(cross_site_ws_t w)
{
if (w->edge_rates)
{
_arb_vec_clear(w->edge_rates, w->edge_count);
}
if (w->equilibrium)
{
_arb_vec_clear(w->equilibrium, w->state_count);
}
if (w->rate_divisor)
{
arb_clear(w->rate_divisor);
flint_free(w->rate_divisor);
}
if (w->rate_matrix)
{
arb_mat_clear(w->rate_matrix);
flint_free(w->rate_matrix);
}
/* Clear stuff related to the rate mixture. */
if (w->rate_mix_prior)
{
_arb_vec_clear(w->rate_mix_prior, w->rate_category_count);
}
if (w->rate_mix_rates)
{
_arb_vec_clear(w->rate_mix_rates, w->rate_category_count);
}
if (w->rate_mix_expect)
{
_arb_vec_clear(w->rate_mix_expect, 1);
}
/*
* Clear arrays of matrices.
* The arrays are allowed to be NULL.
*/
{
slong n = w->rate_category_count * w->edge_count;
_arb_mat_vec_clear(w->transition_matrices, n);
_arb_mat_vec_clear(w->dwell_frechet_matrices, n);
_arb_mat_vec_clear(w->trans_frechet_matrices, 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_approx_solve_triu_recursive(arb_mat_t X,
const arb_mat_t U, const arb_mat_t B, int unit, slong prec)
{
arb_mat_t UA, UB, UD, XX, XY, BX, BY, T;
slong r, n, m;
n = U->r;
m = B->c;
r = n / 2;
if (n == 0 || m == 0)
return;
/*
Denoting inv(M) by M^, we have:
[A B]^ [X] == [A^ (X - B D^ Y)]
[0 D] [Y] == [ D^ Y ]
*/
arb_mat_window_init(UA, U, 0, 0, r, r);
arb_mat_window_init(UB, U, 0, r, r, n);
arb_mat_window_init(UD, U, r, r, n, n);
arb_mat_window_init(BX, B, 0, 0, r, m);
arb_mat_window_init(BY, B, r, 0, n, m);
arb_mat_window_init(XX, X, 0, 0, r, m);
arb_mat_window_init(XY, X, r, 0, n, m);
arb_mat_approx_solve_triu(XY, UD, BY, unit, prec);
arb_mat_init(T, UB->r, XY->c);
arb_mat_approx_mul(T, UB, XY, prec);
arb_mat_sub(XX, BX, T, prec);
arb_mat_get_mid(XX, XX);
arb_mat_clear(T);
arb_mat_approx_solve_triu(XX, UA, XX, unit, prec);
arb_mat_window_clear(UA);
arb_mat_window_clear(UB);
arb_mat_window_clear(UD);
arb_mat_window_clear(BX);
arb_mat_window_clear(BY);
arb_mat_window_clear(XX);
arb_mat_window_clear(XY);
}
void
evaluate_site_frechet(
arb_struct *lhood_scaled_edge_expectations,
const arb_mat_struct *lhood_node_vectors,
const arb_mat_struct *forward_edge_vectors,
const arb_mat_struct *frechet_matrices,
const csr_graph_t g, int *preorder,
int node_count, int state_count, slong prec)
{
slong u, idx, state;
arb_mat_t fvec;
arb_mat_init(fvec, state_count, 1);
for (u = 0; u < node_count; u++)
{
slong a = preorder[u];
slong start = g->indptr[a];
slong stop = g->indptr[a+1];
for (idx = start; idx < stop; idx++)
{
slong b = g->indices[idx];
const arb_mat_struct *lvec = lhood_node_vectors + b;
const arb_mat_struct *evec = forward_edge_vectors + idx;
arb_zero(lhood_scaled_edge_expectations + idx);
arb_mat_mul(fvec, frechet_matrices + idx, lvec, prec);
for (state = 0; state < state_count; state++)
{
arb_addmul(lhood_scaled_edge_expectations + idx,
arb_mat_entry(fvec, state, 0),
arb_mat_entry(evec, state, 0), prec);
}
}
}
arb_mat_clear(fvec);
}
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 main()
{
slong iter;
flint_rand_t state;
flint_printf("spd_solve....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_mat_t Q, QX, QB;
arb_mat_t A, X, B;
slong n, m, qbits, prec;
int q_invertible, r_invertible, r_invertible2;
n = n_randint(state, 8);
m = n_randint(state, 8);
qbits = 1 + n_randint(state, 30);
prec = 2 + n_randint(state, 200);
fmpq_mat_init(Q, n, n);
fmpq_mat_init(QX, n, m);
fmpq_mat_init(QB, n, m);
arb_mat_init(A, n, n);
arb_mat_init(X, n, m);
arb_mat_init(B, n, m);
_fmpq_mat_randtest_positive_semidefinite(Q, state, qbits);
fmpq_mat_randtest(QB, state, qbits);
q_invertible = fmpq_mat_solve_fraction_free(QX, Q, QB);
if (!q_invertible)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = arb_mat_spd_solve(X, A, B, prec);
if (r_invertible)
{
flint_printf("FAIL: matrix is singular over Q but not over R\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("QX = \n"); fmpq_mat_print(QX); flint_printf("\n\n");
flint_printf("QB = \n"); fmpq_mat_print(QB); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
abort();
}
}
else
{
/* now this must converge */
while (1)
{
arb_mat_set_fmpq_mat(A, Q, prec);
arb_mat_set_fmpq_mat(B, QB, prec);
r_invertible = arb_mat_spd_solve(X, A, B, prec);
if (r_invertible)
{
break;
}
else
{
if (prec > 10000)
{
flint_printf("FAIL: failed to converge at 10000 bits\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("QX = \n"); fmpq_mat_print(QX); flint_printf("\n\n");
flint_printf("QB = \n"); fmpq_mat_print(QB); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
abort();
}
prec *= 2;
}
}
if (!arb_mat_contains_fmpq_mat(X, QX))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("QB = \n"); fmpq_mat_print(QB); flint_printf("\n\n");
flint_printf("QX = \n"); fmpq_mat_print(QX); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("B = \n"); arb_mat_printd(B, 15); flint_printf("\n\n");
flint_printf("X = \n"); arb_mat_printd(X, 15); flint_printf("\n\n");
abort();
}
/* test aliasing */
r_invertible2 = arb_mat_spd_solve(B, A, B, prec);
if (!arb_mat_equal(X, B) || r_invertible != r_invertible2)
{
flint_printf("FAIL (aliasing)\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("B = \n"); arb_mat_printd(B, 15); flint_printf("\n\n");
flint_printf("X = \n"); arb_mat_printd(X, 15); flint_printf("\n\n");
abort();
}
}
fmpq_mat_clear(Q);
fmpq_mat_clear(QB);
fmpq_mat_clear(QX);
arb_mat_clear(A);
arb_mat_clear(B);
arb_mat_clear(X);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("mul_entrywise....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
slong m, n, qbits1, qbits2, rbits1, rbits2, rbits3;
fmpq_mat_t A, B, C;
arb_mat_t a, b, c, d;
qbits1 = 2 + n_randint(state, 200);
qbits2 = 2 + n_randint(state, 200);
rbits1 = 2 + n_randint(state, 200);
rbits2 = 2 + n_randint(state, 200);
rbits3 = 2 + n_randint(state, 200);
m = n_randint(state, 10);
n = n_randint(state, 10);
fmpq_mat_init(A, m, n);
fmpq_mat_init(B, m, n);
fmpq_mat_init(C, m, n);
arb_mat_init(a, m, n);
arb_mat_init(b, m, n);
arb_mat_init(c, m, n);
arb_mat_init(d, m, n);
fmpq_mat_randtest(A, state, qbits1);
fmpq_mat_randtest(B, state, qbits2);
_fmpq_mat_mul_entrywise(C, A, B);
arb_mat_set_fmpq_mat(a, A, rbits1);
arb_mat_set_fmpq_mat(b, B, rbits2);
arb_mat_mul_entrywise(c, a, b, rbits3);
if (!arb_mat_contains_fmpq_mat(c, C))
{
flint_printf("FAIL\n\n");
flint_printf("m = %wd, n = %wd, bits3 = %wd\n", m, n, rbits3);
flint_printf("A = "); fmpq_mat_print(A); flint_printf("\n\n");
flint_printf("B = "); fmpq_mat_print(B); flint_printf("\n\n");
flint_printf("C = "); fmpq_mat_print(C); flint_printf("\n\n");
flint_printf("a = "); arb_mat_printd(a, 15); flint_printf("\n\n");
flint_printf("b = "); arb_mat_printd(b, 15); flint_printf("\n\n");
flint_printf("c = "); arb_mat_printd(c, 15); flint_printf("\n\n");
abort();
}
/* test aliasing with a */
if (arb_mat_nrows(a) == arb_mat_nrows(c) &&
arb_mat_ncols(a) == arb_mat_ncols(c))
{
arb_mat_set(d, a);
arb_mat_mul_entrywise(d, d, b, rbits3);
if (!arb_mat_equal(d, c))
{
flint_printf("FAIL (aliasing 1)\n\n");
abort();
}
}
/* test aliasing with b */
if (arb_mat_nrows(b) == arb_mat_nrows(c) &&
arb_mat_ncols(b) == arb_mat_ncols(c))
{
arb_mat_set(d, b);
arb_mat_mul_entrywise(d, a, d, rbits3);
if (!arb_mat_equal(d, c))
{
flint_printf("FAIL (aliasing 2)\n\n");
abort();
}
}
fmpq_mat_clear(A);
fmpq_mat_clear(B);
fmpq_mat_clear(C);
arb_mat_clear(a);
arb_mat_clear(b);
arb_mat_clear(c);
arb_mat_clear(d);
}
flint_randclear(state);
flint_cleanup();
flint_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
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("solve_tril....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 2000 * arb_test_multiplier(); iter++)
{
arb_mat_t A, X, B, Y;
slong rows, cols, prec, i, j;
int unit;
prec = 2 + n_randint(state, 200);
if (n_randint(state, 10) == 0)
{
rows = n_randint(state, 60);
cols = n_randint(state, 60);
}
else
{
rows = n_randint(state, 10);
cols = n_randint(state, 10);
}
unit = n_randint(state, 2);
arb_mat_init(A, rows, rows);
arb_mat_init(B, rows, cols);
arb_mat_init(X, rows, cols);
arb_mat_init(Y, rows, cols);
arb_mat_randtest(A, state, prec, 10);
arb_mat_randtest(X, state, prec, 10);
arb_mat_randtest(Y, state, prec, 10);
for (i = 0; i < rows; i++)
{
if (unit)
arb_one(arb_mat_entry(A, i, i));
else
arb_set_ui(arb_mat_entry(A, i, i), 1 + n_randint(state, 100));
for (j = i + 1; j < rows; j++)
arb_zero(arb_mat_entry(A, i, j));
}
arb_mat_mul(B, A, X, prec);
if (unit) /* check that diagonal entries are ignored */
{
for (i = 0; i < rows; i++)
arb_set_ui(arb_mat_entry(A, i, i), 1 + n_randint(state, 100));
}
/* Check Y = A^(-1) * (A * X) = X */
arb_mat_solve_tril(Y, A, B, unit, prec);
if (!arb_mat_overlaps(Y, X))
{
flint_printf("FAIL\n");
flint_printf("A = \n"); arb_mat_printd(A, 10); flint_printf("\n\n");
flint_printf("B = \n"); arb_mat_printd(B, 10); flint_printf("\n\n");
flint_printf("X = \n"); arb_mat_printd(X, 10); flint_printf("\n\n");
flint_printf("Y = \n"); arb_mat_printd(Y, 10); flint_printf("\n\n");
flint_abort();
}
/* Check aliasing */
arb_mat_solve_tril(B, A, B, unit, prec);
if (!arb_mat_equal(B, Y))
{
flint_printf("FAIL (aliasing)\n");
flint_printf("A = \n"); arb_mat_printd(A, 10); flint_printf("\n\n");
flint_printf("B = \n"); arb_mat_printd(B, 10); flint_printf("\n\n");
flint_printf("X = \n"); arb_mat_printd(X, 10); flint_printf("\n\n");
flint_printf("Y = \n"); arb_mat_printd(Y, 10); flint_printf("\n\n");
flint_abort();
}
arb_mat_clear(A);
arb_mat_clear(B);
arb_mat_clear(X);
arb_mat_clear(Y);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
/* 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);
}
}
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);
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("ldl....");
fflush(stdout);
flint_randinit(state);
/* check special matrices */
{
slong n;
for (n = 1; n < 10; n++)
{
slong lprec;
arb_mat_t L, A;
arb_mat_init(L, n, n);
arb_mat_init(A, n, n);
for (lprec = 2; lprec < 10; lprec++)
{
int result;
slong prec;
prec = 1 << lprec;
/* zero */
arb_mat_zero(A);
result = arb_mat_ldl(L, A, prec);
if (result)
{
flint_printf("FAIL (zero):\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("L = \n"); arb_mat_printd(L, 15);
flint_printf("\n\n");
}
/* negative identity */
arb_mat_one(A);
arb_mat_neg(A, A);
result = arb_mat_ldl(L, A, prec);
if (result)
{
flint_printf("FAIL (negative identity):\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("L = \n"); arb_mat_printd(L, 15);
flint_printf("\n\n");
}
/* identity */
arb_mat_one(A);
result = arb_mat_ldl(L, A, prec);
if (!result || !arb_mat_equal(L, A))
{
flint_printf("FAIL (identity):\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("L = \n"); arb_mat_printd(L, 15);
flint_printf("\n\n");
}
}
arb_mat_clear(L);
arb_mat_clear(A);
}
}
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_mat_t Q;
arb_mat_t A, L, D, U, T;
slong n, qbits, prec;
int q_invertible, r_invertible;
n = n_randint(state, 8);
qbits = 1 + n_randint(state, 100);
prec = 2 + n_randint(state, 202);
fmpq_mat_init(Q, n, n);
arb_mat_init(A, n, n);
arb_mat_init(L, n, n);
arb_mat_init(D, n, n);
arb_mat_init(U, n, n);
arb_mat_init(T, n, n);
_fmpq_mat_randtest_positive_semidefinite(Q, state, qbits);
q_invertible = fmpq_mat_is_invertible(Q);
if (!q_invertible)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = arb_mat_ldl(L, A, prec);
if (r_invertible)
{
flint_printf("FAIL: matrix is singular over Q but not over R\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("L = \n"); arb_mat_printd(L, 15); flint_printf("\n\n");
}
}
else
{
/* now this must converge */
while (1)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = arb_mat_ldl(L, A, prec);
if (r_invertible)
{
break;
}
else
{
if (prec > 10000)
{
flint_printf("FAIL: failed to converge at 10000 bits\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
abort();
}
prec *= 2;
}
}
/* multiply out the decomposition */
{
slong i;
arb_mat_zero(D);
arb_mat_transpose(U, L);
for (i = 0; i < n; i++)
{
arb_set(arb_mat_entry(D, i, i), arb_mat_entry(L, i, i));
arb_one(arb_mat_entry(L, i, i));
arb_one(arb_mat_entry(U, i, i));
}
arb_mat_mul(T, L, D, prec);
arb_mat_mul(T, T, U, prec);
}
if (!arb_mat_contains_fmpq_mat(T, Q))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("L = \n"); arb_mat_printd(L, 15); flint_printf("\n\n");
flint_printf("U = \n"); arb_mat_printd(U, 15); flint_printf("\n\n");
flint_printf("L*U = \n"); arb_mat_printd(T, 15); flint_printf("\n\n");
abort();
}
}
fmpq_mat_clear(Q);
arb_mat_clear(A);
arb_mat_clear(L);
arb_mat_clear(D);
arb_mat_clear(U);
arb_mat_clear(T);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
long iter;
flint_rand_t state;
printf("exp....");
fflush(stdout);
flint_randinit(state);
/* check exp(A)*exp(c*A) = exp((1+c)*A) */
for (iter = 0; iter < 1000; iter++)
{
arb_mat_t A, E, F, EF, G;
fmpq_mat_t Q;
arb_t c, d;
long n, qbits, prec;
n = n_randint(state, 5);
qbits = 2 + n_randint(state, 300);
prec = 2 + n_randint(state, 300);
arb_init(c);
arb_init(d);
fmpq_mat_init(Q, n, n);
arb_mat_init(A, n, n);
arb_mat_init(E, n, n);
arb_mat_init(F, n, n);
arb_mat_init(EF, n, n);
arb_mat_init(G, n, n);
fmpq_mat_randtest(Q, state, qbits);
arb_mat_set_fmpq_mat(A, Q, prec);
arb_mat_exp(E, A, prec);
arb_randtest(c, state, prec, 10);
arb_mat_scalar_mul_arb(F, A, c, prec);
arb_mat_exp(F, F, prec);
arb_add_ui(d, c, 1, prec);
arb_mat_scalar_mul_arb(G, A, d, prec);
arb_mat_exp(G, G, prec);
arb_mat_mul(EF, E, F, prec);
if (!arb_mat_overlaps(EF, G))
{
printf("FAIL\n\n");
printf("n = %ld, prec = %ld\n", n, prec);
printf("c = \n"); arb_printd(c, 15); printf("\n\n");
printf("A = \n"); arb_mat_printd(A, 15); printf("\n\n");
printf("E = \n"); arb_mat_printd(E, 15); printf("\n\n");
printf("F = \n"); arb_mat_printd(F, 15); printf("\n\n");
printf("E*F = \n"); arb_mat_printd(EF, 15); printf("\n\n");
printf("G = \n"); arb_mat_printd(G, 15); printf("\n\n");
abort();
}
arb_clear(c);
arb_clear(d);
fmpq_mat_clear(Q);
arb_mat_clear(A);
arb_mat_clear(E);
arb_mat_clear(F);
arb_mat_clear(EF);
arb_mat_clear(G);
}
flint_randclear(state);
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
void Lib_Arb_Mat_Clear(ArbMatPtr A)
{
arb_mat_clear( (arb_mat_struct*) A);
free(A);
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("frobenius_norm....");
fflush(stdout);
flint_randinit(state);
/* compare to the exact rational norm */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_mat_t Q;
fmpq_t q;
arb_mat_t A;
slong n, qbits, prec;
n = n_randint(state, 8);
qbits = 1 + n_randint(state, 100);
prec = 2 + n_randint(state, 200);
fmpq_mat_init(Q, n, n);
fmpq_init(q);
arb_mat_init(A, n, n);
fmpq_mat_randtest(Q, state, qbits);
_fmpq_mat_sum_of_squares(q, Q);
arb_mat_set_fmpq_mat(A, Q, prec);
/* check that the arb interval contains the exact value */
{
arb_t a;
arb_init(a);
arb_mat_frobenius_norm(a, A, prec);
arb_mul(a, a, a, prec);
if (!arb_contains_fmpq(a, q))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n");
fmpq_mat_print(Q);
flint_printf("\n\n");
flint_printf("frobenius_norm(Q)^2 = \n");
fmpq_print(q);
flint_printf("\n\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("frobenius_norm(A)^2 = \n");
arb_printd(a, 15);
flint_printf("\n\n");
flint_printf("frobenius_norm(A)^2 = \n");
arb_print(a);
flint_printf("\n\n");
abort();
}
arb_clear(a);
}
/* check that the upper bound is not less than the exact value */
{
mag_t b;
fmpq_t y;
mag_init(b);
fmpq_init(y);
arb_mat_bound_frobenius_norm(b, A);
mag_mul(b, b, b);
mag_get_fmpq(y, b);
if (fmpq_cmp(q, y) > 0)
{
flint_printf("FAIL (bound, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n");
fmpq_mat_print(Q);
flint_printf("\n\n");
flint_printf("frobenius_norm(Q)^2 = \n");
fmpq_print(q);
flint_printf("\n\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("bound_frobenius_norm(A)^2 = \n");
mag_printd(b, 15);
flint_printf("\n\n");
flint_printf("bound_frobenius_norm(A)^2 = \n");
mag_print(b);
flint_printf("\n\n");
abort();
}
mag_clear(b);
fmpq_clear(y);
}
fmpq_mat_clear(Q);
fmpq_clear(q);
arb_mat_clear(A);
}
/* check trace(A^T A) = frobenius_norm(A)^2 */
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
slong m, n, prec;
arb_mat_t A, AT, ATA;
arb_t t;
prec = 2 + n_randint(state, 200);
m = n_randint(state, 10);
n = n_randint(state, 10);
arb_mat_init(A, m, n);
arb_mat_init(AT, n, m);
arb_mat_init(ATA, n, n);
arb_init(t);
arb_mat_randtest(A, state, 2 + n_randint(state, 100), 10);
arb_mat_transpose(AT, A);
arb_mat_mul(ATA, AT, A, prec);
arb_mat_trace(t, ATA, prec);
arb_sqrt(t, t, prec);
/* check the norm bound */
{
mag_t low, frobenius;
mag_init(low);
arb_get_mag_lower(low, t);
mag_init(frobenius);
arb_mat_bound_frobenius_norm(frobenius, A);
if (mag_cmp(low, frobenius) > 0)
{
flint_printf("FAIL (bound)\n", iter);
flint_printf("m = %wd, n = %wd, prec = %wd\n", m, n, prec);
flint_printf("\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("lower(sqrt(trace(A^T A))) = \n");
mag_printd(low, 15);
flint_printf("\n\n");
flint_printf("bound_frobenius_norm(A) = \n");
mag_printd(frobenius, 15);
flint_printf("\n\n");
abort();
}
mag_clear(low);
mag_clear(frobenius);
}
/* check the norm interval */
{
arb_t frobenius;
arb_init(frobenius);
arb_mat_frobenius_norm(frobenius, A, prec);
if (!arb_overlaps(t, frobenius))
{
flint_printf("FAIL (overlap)\n", iter);
flint_printf("m = %wd, n = %wd, prec = %wd\n", m, n, prec);
flint_printf("\n");
flint_printf("A = \n");
arb_mat_printd(A, 15);
flint_printf("\n\n");
flint_printf("sqrt(trace(A^T A)) = \n");
arb_printd(t, 15);
flint_printf("\n\n");
flint_printf("frobenius_norm(A) = \n");
arb_printd(frobenius, 15);
flint_printf("\n\n");
abort();
}
arb_clear(frobenius);
}
arb_mat_clear(A);
arb_mat_clear(AT);
arb_mat_clear(ATA);
arb_clear(t);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("det....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 100000; iter++)
{
fmpq_mat_t Q;
fmpq_t Qdet;
arb_mat_t A;
arb_t Adet;
slong n, qbits, prec;
n = n_randint(state, 8);
qbits = 1 + n_randint(state, 100);
prec = 2 + n_randint(state, 200);
fmpq_mat_init(Q, n, n);
fmpq_init(Qdet);
arb_mat_init(A, n, n);
arb_init(Adet);
fmpq_mat_randtest(Q, state, qbits);
fmpq_mat_det(Qdet, Q);
arb_mat_set_fmpq_mat(A, Q, prec);
arb_mat_det(Adet, A, prec);
if (!arb_contains_fmpq(Adet, Qdet))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("Qdet = \n"); fmpq_print(Qdet); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("Adet = \n"); arb_printd(Adet, 15); flint_printf("\n\n");
flint_printf("Adet = \n"); arb_print(Adet); flint_printf("\n\n");
abort();
}
fmpq_mat_clear(Q);
fmpq_clear(Qdet);
arb_mat_clear(A);
arb_clear(Adet);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("inv_ldl_precomp....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 10000 * arb_test_multiplier(); iter++)
{
fmpq_mat_t Q, Qinv;
arb_mat_t A, Ainv;
slong n, qbits, prec;
int q_invertible, r_invertible, r_invertible2;
n = n_randint(state, 8);
qbits = 1 + n_randint(state, 30);
prec = 2 + n_randint(state, 200);
fmpq_mat_init(Q, n, n);
fmpq_mat_init(Qinv, n, n);
arb_mat_init(A, n, n);
arb_mat_init(Ainv, n, n);
_fmpq_mat_randtest_positive_semidefinite(Q, state, qbits);
q_invertible = fmpq_mat_inv(Qinv, Q);
if (!q_invertible)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = _spd_inv(Ainv, A, prec);
if (r_invertible)
{
flint_printf("FAIL: matrix is singular over Q but not over R\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("Ainv = \n"); arb_mat_printd(Ainv, 15); flint_printf("\n\n");
abort();
}
}
else
{
/* now this must converge */
while (1)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = _spd_inv(Ainv, A, prec);
if (r_invertible)
{
break;
}
else
{
if (prec > 10000)
{
flint_printf("FAIL: failed to converge at 10000 bits\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
abort();
}
prec *= 2;
}
}
if (!arb_mat_contains_fmpq_mat(Ainv, Qinv))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("Qinv = \n"); fmpq_mat_print(Qinv); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("Ainv = \n"); arb_mat_printd(Ainv, 15); flint_printf("\n\n");
abort();
}
/* test aliasing */
r_invertible2 = _spd_inv(A, A, prec);
if (!arb_mat_equal(A, Ainv) || r_invertible != r_invertible2)
{
flint_printf("FAIL (aliasing)\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("Ainv = \n"); arb_mat_printd(Ainv, 15); flint_printf("\n\n");
abort();
}
}
fmpq_mat_clear(Q);
fmpq_mat_clear(Qinv);
arb_mat_clear(A);
arb_mat_clear(Ainv);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
int main()
{
slong iter;
flint_rand_t state;
flint_printf("lu....");
fflush(stdout);
flint_randinit(state);
for (iter = 0; iter < 100000; iter++)
{
fmpq_mat_t Q;
arb_mat_t A, LU, P, L, U, T;
slong i, j, n, qbits, prec, *perm;
int q_invertible, r_invertible;
n = n_randint(state, 8);
qbits = 1 + n_randint(state, 100);
prec = 2 + n_randint(state, 202);
fmpq_mat_init(Q, n, n);
arb_mat_init(A, n, n);
arb_mat_init(LU, n, n);
arb_mat_init(P, n, n);
arb_mat_init(L, n, n);
arb_mat_init(U, n, n);
arb_mat_init(T, n, n);
perm = _perm_init(n);
fmpq_mat_randtest(Q, state, qbits);
q_invertible = fmpq_mat_is_invertible(Q);
if (!q_invertible)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = arb_mat_lu(perm, LU, A, prec);
if (r_invertible)
{
flint_printf("FAIL: matrix is singular over Q but not over R\n");
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("LU = \n"); arb_mat_printd(LU, 15); flint_printf("\n\n");
}
}
else
{
/* now this must converge */
while (1)
{
arb_mat_set_fmpq_mat(A, Q, prec);
r_invertible = arb_mat_lu(perm, LU, A, prec);
if (r_invertible)
{
break;
}
else
{
if (prec > 10000)
{
flint_printf("FAIL: failed to converge at 10000 bits\n");
abort();
}
prec *= 2;
}
}
arb_mat_one(L);
for (i = 0; i < n; i++)
for (j = 0; j < i; j++)
arb_set(arb_mat_entry(L, i, j),
arb_mat_entry(LU, i, j));
for (i = 0; i < n; i++)
for (j = i; j < n; j++)
arb_set(arb_mat_entry(U, i, j),
arb_mat_entry(LU, i, j));
for (i = 0; i < n; i++)
arb_one(arb_mat_entry(P, perm[i], i));
arb_mat_mul(T, P, L, prec);
arb_mat_mul(T, T, U, prec);
if (!arb_mat_contains_fmpq_mat(T, Q))
{
flint_printf("FAIL (containment, iter = %wd)\n", iter);
flint_printf("n = %wd, prec = %wd\n", n, prec);
flint_printf("\n");
flint_printf("Q = \n"); fmpq_mat_print(Q); flint_printf("\n\n");
flint_printf("A = \n"); arb_mat_printd(A, 15); flint_printf("\n\n");
flint_printf("LU = \n"); arb_mat_printd(LU, 15); flint_printf("\n\n");
flint_printf("L = \n"); arb_mat_printd(L, 15); flint_printf("\n\n");
flint_printf("U = \n"); arb_mat_printd(U, 15); flint_printf("\n\n");
flint_printf("P*L*U = \n"); arb_mat_printd(T, 15); flint_printf("\n\n");
abort();
}
}
fmpq_mat_clear(Q);
arb_mat_clear(A);
arb_mat_clear(LU);
arb_mat_clear(P);
arb_mat_clear(L);
arb_mat_clear(U);
arb_mat_clear(T);
_perm_clear(perm);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
