/*============================================================================= This file is part of ARB. ARB is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. ARB is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with ARB; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA =============================================================================*/ /****************************************************************************** Copyright (C) 2013 Fredrik Johansson ******************************************************************************/ #include "double_extras.h" #include "arb_mat.h" long _fmprb_mat_exp_choose_N(const fmpr_t norm, long prec); void _fmprb_mat_exp_bound(fmpr_t err, const fmpr_t norm, long N); long _arb_mat_exp_choose_N(const arf_t norm, long prec) { fmpr_t fnorm; long r; fmpr_init(fnorm); arf_get_fmpr(fnorm, norm); r = _fmprb_mat_exp_choose_N(fnorm, prec); fmpr_clear(fnorm); return r; } void _arb_mat_exp_bound(arf_t err, const arf_t norm, long N) { fmpr_t ferr, fnorm; fmpr_init(ferr); fmpr_init(fnorm); arf_get_fmpr(fnorm, norm); _fmprb_mat_exp_bound(ferr, fnorm, N); arf_set_fmpr(err, ferr); fmpr_clear(ferr); fmpr_clear(fnorm); } /* evaluates the truncated Taylor series (assumes no aliasing) */ void _arb_mat_exp_taylor(arb_mat_t S, const arb_mat_t A, long N, long 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 { long 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, long prec) { long i, j, dim, wp, N, q, r; arf_t norm, err; arb_mat_t T; dim = arb_mat_nrows(A); if (dim != arb_mat_ncols(A)) { 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); arf_init(norm); arf_init(err); arb_mat_init(T, dim, dim); arb_mat_bound_inf_norm(norm, A, MAG_BITS); if (arf_is_zero(norm)) { arb_mat_one(B); } else { r = arf_abs_bound_lt_2exp_si(norm); q = pow(wp, 0.25); /* wanted magnitude */ if (r > 2 * wp) /* too big */ r = 2 * wp; else if (r < -q) /* tiny, no need to reduce */ r = 0; else r += q; /* reduce to magnitude 2^(-r) */ arb_mat_scalar_mul_2exp_si(T, A, -r); arf_mul_2exp_si(norm, norm, -r); N = _arb_mat_exp_choose_N(norm, wp); _arb_mat_exp_bound(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_arf(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); } arf_clear(norm); arf_clear(err); arb_mat_clear(T); }