void fft(acb_t *x) {
long *base=(long *)x-2,i,j,k,l;
long n=base[0],prec=base[1],halfn=n>>1;
acb_t *p,*w=x+n;
static acb_t ctemp;
static int init;
if (!init) {
acb_init(ctemp);
init = 1;
}
/* swap each element with one with bit-reversed index */
for (i=0;i<halfn;++i) {
/* j = bit reversal of i */
for (k=1,j=0;k<n;k<<=1) {
j <<= 1;
if (i & k) j |= 1;
}
if (i < j)
acb_swap(x[i],x[j]);
else if (i > j)
acb_swap(x[n-1-i],x[n-1-j]);
++i, j |= halfn;
acb_swap(x[i],x[j]);
}
for (k=1,l=halfn;k<n;k<<=1,l>>=1)
for (p=x;p<w;p+=k)
for (j=0;j<halfn;j+=l,p++) {
acb_mul(ctemp,p[k],w[j],prec);
acb_sub(p[k],p[0],ctemp,prec);
acb_add(p[0],p[0],ctemp,prec);
}
}
void
acb_mat_transpose(acb_mat_t B, const acb_mat_t A)
{
slong i, j;
if (acb_mat_nrows(B) != acb_mat_ncols(A) || acb_mat_ncols(B) != acb_mat_nrows(A))
{
flint_printf("Exception (acb_mat_transpose). Incompatible dimensions.\n");
flint_abort();
}
if (acb_mat_is_empty(A))
return;
if (A == B) /* In-place, guaranteed to be square */
{
for (i = 0; i < acb_mat_nrows(A) - 1; i++)
{
for (j = i + 1; j < acb_mat_ncols(A); j++)
{
acb_swap(acb_mat_entry(A, i, j), acb_mat_entry(A, j, i));
}
}
}
else /* Not aliased; general case */
{
for (i = 0; i < acb_mat_nrows(B); i++)
for (j = 0; j < acb_mat_ncols(B); j++)
acb_set(acb_mat_entry(B, i, j), acb_mat_entry(A, j, i));
}
}
/* todo: remove radii */
void
acb_lambertw_halley_step(acb_t res, acb_t ew, const acb_t z, const acb_t w, slong prec)
{
acb_t t, u, v;
acb_init(t);
acb_init(u);
acb_init(v);
acb_exp(ew, w, prec);
acb_add_ui(u, w, 2, prec);
acb_add_ui(v, w, 1, prec);
acb_mul_2exp_si(v, v, 1);
acb_div(v, u, v, prec);
acb_mul(t, ew, w, prec);
acb_sub(u, t, z, prec);
acb_mul(v, v, u, prec);
acb_neg(v, v);
acb_add(v, v, t, prec);
acb_add(v, v, ew, prec);
acb_div(t, u, v, prec);
acb_sub(t, w, t, prec);
acb_swap(res, t);
acb_clear(t);
acb_clear(u);
acb_clear(v);
}
void
acb_hypgeom_m_asymp(acb_t res, const acb_t a, const acb_t b, const acb_t z, int regularized, slong prec)
{
acb_t t, u, v, c;
acb_init(t);
acb_init(u);
acb_init(v);
acb_init(c);
acb_sub(c, b, a, prec);
acb_neg(v, z);
acb_hypgeom_u_asymp(t, a, b, z, -1, prec);
acb_hypgeom_u_asymp(u, c, b, v, -1, prec);
/* gamma(b-a) */
acb_rgamma(v, c, prec);
acb_mul(t, t, v, prec);
/* z^(a-b) */
acb_neg(c, c);
acb_pow(v, z, c, prec);
acb_mul(u, u, v, prec);
/* gamma(a) */
acb_rgamma(v, a, prec);
acb_mul(u, u, v, prec);
/* exp(z) */
acb_exp(v, z, prec);
acb_mul(u, u, v, prec);
/* (-z)^(-a) */
acb_neg(c, a);
acb_neg(v, z);
acb_pow(v, v, c, prec);
acb_mul(t, t, v, prec);
acb_add(t, t, u, prec);
if (!regularized)
{
acb_gamma(v, b, prec);
acb_mul(t, t, v, prec);
}
if (acb_is_real(a) && acb_is_real(b) && acb_is_real(z))
{
arb_zero(acb_imagref(t));
}
acb_swap(res, t);
acb_clear(t);
acb_clear(u);
acb_clear(v);
acb_clear(c);
}
void ifft(acb_t *x) {
long *base=(long *)x-2,i;
long n=base[0],prec=base[1],halfn=n>>1;
fft(x);
acb_div_ui(x[0],x[0],n,prec);
acb_div_ui(x[halfn],x[halfn],n,prec);
for (i=1;i<halfn;i++) {
acb_div_ui(x[i],x[i],n,prec);
acb_div_ui(x[n-i],x[n-i],n,prec);
acb_swap(x[i],x[n-i]);
}
}
void
acb_hypgeom_laguerre_l_ui_recurrence(acb_t res, ulong n, const acb_t m,
const acb_t z, slong prec)
{
acb_t t, u, v;
ulong k;
if (n == 0)
{
acb_one(res);
return;
}
if (n == 1)
{
acb_sub(res, m, z, prec);
acb_add_ui(res, res, 1, prec);
return;
}
acb_init(t);
acb_init(u);
acb_init(v);
acb_one(t);
acb_sub(u, m, z, prec);
acb_add_ui(u, u, 1, prec);
for (k = 2; k <= n; k++)
{
acb_add_ui(v, m, k - 1, prec);
acb_mul(t, t, v, prec);
acb_add_ui(v, m, 2 * k - 1, prec);
acb_sub(v, v, z, prec);
acb_mul(v, v, u, prec);
acb_sub(t, v, t, prec);
acb_div_ui(t, t, k, prec);
acb_swap(t, u);
}
acb_set(res, u);
acb_clear(t);
acb_clear(u);
acb_clear(v);
}
/* compose by poly2 = a*x^n + c, no aliasing; n >= 1 */
void
_acb_poly_compose_axnc(acb_ptr res, acb_srcptr poly1, slong len1,
const acb_t c, const acb_t a, slong n, slong prec)
{
slong i;
_acb_vec_set_round(res, poly1, len1, prec);
/* shift by c (c = 0 case will be fast) */
_acb_poly_taylor_shift(res, c, len1, prec);
/* multiply by powers of a */
if (!acb_is_one(a))
{
if (acb_equal_si(a, -1))
{
for (i = 1; i < len1; i += 2)
acb_neg(res + i, res + i);
}
else if (len1 == 2)
{
acb_mul(res + 1, res + 1, a, prec);
}
else
{
acb_t t;
acb_init(t);
acb_set(t, a);
for (i = 1; i < len1; i++)
{
acb_mul(res + i, res + i, t, prec);
if (i + 1 < len1)
acb_mul(t, t, a, prec);
}
acb_clear(t);
}
}
/* stretch */
for (i = len1 - 1; i >= 1 && n > 1; i--)
{
acb_swap(res + i * n, res + i);
_acb_vec_zero(res + (i - 1) * n + 1, n - 1);
}
}
void
_acb_poly_shift_right(acb_ptr res, acb_srcptr poly, slong len, slong n)
{
slong i;
/* Copy in forward order to avoid writing over unshifted coefficients */
if (res != poly)
{
for (i = 0; i < len - n; i++)
acb_set(res + i, poly + n + i);
}
else
{
for (i = 0; i < len - n; i++)
acb_swap(res + i, res + n + i);
}
}
void
_acb_poly_shift_left(acb_ptr res, acb_srcptr poly, long len, long n)
{
long i;
/* Copy in reverse to avoid writing over unshifted coefficients */
if (res != poly)
{
for (i = len; i--; )
acb_set(res + n + i, poly + i);
}
else
{
for (i = len; i--; )
acb_swap(res + n + i, res + i);
}
for (i = 0; i < n; i++)
acb_zero(res + i);
}
void
acb_hypgeom_ci_2f3(acb_t res, const acb_t z, slong prec)
{
acb_t a, t, u;
acb_struct b[3];
acb_init(a);
acb_init(b);
acb_init(b + 1);
acb_init(b + 2);
acb_init(t);
acb_init(u);
acb_one(a);
acb_set_ui(b, 2);
acb_set(b + 1, b);
acb_set_ui(b + 2, 3);
acb_mul_2exp_si(b + 2, b + 2, -1);
acb_mul(t, z, z, prec);
acb_mul_2exp_si(t, t, -2);
acb_neg(t, t);
acb_hypgeom_pfq_direct(u, a, 1, b, 3, t, -1, prec);
acb_mul(u, u, t, prec);
acb_log(t, z, prec);
acb_add(u, u, t, prec);
arb_const_euler(acb_realref(t), prec);
arb_add(acb_realref(u), acb_realref(u), acb_realref(t), prec);
acb_swap(res, u);
acb_clear(a);
acb_clear(b);
acb_clear(b + 1);
acb_clear(b + 2);
acb_clear(t);
acb_clear(u);
}
void
_arb_poly_evaluate_acb_horner(acb_t y, arb_srcptr f, long len,
const acb_t x, long prec)
{
if (len == 0)
{
acb_zero(y);
}
else if (len == 1 || acb_is_zero(x))
{
acb_set_round_arb(y, f, prec);
}
else if (len == 2)
{
acb_mul_arb(y, x, f + 1, prec);
acb_add_arb(y, y, f + 0, prec);
}
else
{
long i = len - 1;
acb_t t, u;
acb_init(t);
acb_init(u);
acb_set_arb(u, f + i);
for (i = len - 2; i >= 0; i--)
{
acb_mul(t, u, x, prec);
acb_add_arb(u, t, f + i, prec);
}
acb_swap(y, u);
acb_clear(t);
acb_clear(u);
}
}
/* u[0..l1[ contains roots re(ui)<=0
u[l1..d-2[ roots with re(ui) > 0
the last two components are set to
(b-a)/2 and (a+b)/(b-a)
returns l1
*/
slong
ab_points(acb_ptr u, acb_srcptr x, edge_t e, slong d, slong prec)
{
slong k, l;
acb_t ab, ba; /* a + b and b - a */
acb_init(ab);
acb_init(ba);
acb_set(ba, x + e.b);
acb_sub(ba, ba, x + e.a, prec);
acb_set(ab, x + e.a);
acb_add(ab, ba, x + e.b, prec);
for (k = 0, l = 0; k < d; k++)
{
if (k == e.a || k == e.b)
continue;
acb_mul_2exp_si(u + l, x + k, 1);
acb_sub(u + l, u + l, ab, prec);
acb_div(u + l, u + l, ba, prec);
l++;
}
/* now l = d - 2, set last two */
acb_mul_2exp_si(u + l, ba, -1);
acb_div(u + l + 1, ab, ba, prec);
/* reorder */
for (k = 0; k < l; k++)
if (arb_is_positive(acb_realref(u + k)))
acb_swap(u + k--, u + l--);
acb_clear(ab);
acb_clear(ba);
return l;
}
void
acb_mat_approx_solve_triu_classical(acb_mat_t X, const acb_mat_t U,
const acb_mat_t B, int unit, slong prec)
{
slong i, j, n, m;
acb_ptr tmp;
acb_t s, t;
n = U->r;
m = B->c;
acb_init(s);
acb_init(t);
tmp = flint_malloc(sizeof(acb_struct) * n);
for (i = 0; i < m; i++)
{
for (j = 0; j < n; j++)
tmp[j] = *acb_mat_entry(X, j, i);
for (j = n - 1; j >= 0; j--)
{
acb_approx_dot(s, acb_mat_entry(B, j, i), 1, U->rows[j] + j + 1, 1, tmp + j + 1, 1, n - j - 1, prec);
if (!unit)
acb_approx_div(tmp + j, s, arb_mat_entry(U, j, j), t, prec);
else
acb_swap(tmp + j, s);
}
for (j = 0; j < n; j++)
*acb_mat_entry(X, j, i) = tmp[j];
}
flint_free(tmp);
acb_clear(s);
acb_clear(t);
}
void
_acb_poly_atan_series(acb_ptr g, acb_srcptr h, slong hlen, slong n, slong prec)
{
acb_t c;
acb_init(c);
acb_atan(c, h, prec);
hlen = FLINT_MIN(hlen, n);
if (hlen == 1)
{
_acb_vec_zero(g + 1, n - 1);
}
else
{
acb_ptr t, u;
slong ulen;
t = _acb_vec_init(n);
u = _acb_vec_init(n);
/* atan(h(x)) = integral(h'(x)/(1+h(x)^2)) */
ulen = FLINT_MIN(n, 2 * hlen - 1);
_acb_poly_mullow(u, h, hlen, h, hlen, ulen, prec);
acb_add_ui(u, u, 1, prec);
_acb_poly_derivative(t, h, hlen, prec);
_acb_poly_div_series(g, t, hlen - 1, u, ulen, n, prec);
_acb_poly_integral(g, g, n, prec);
_acb_vec_clear(t, n);
_acb_vec_clear(u, n);
}
acb_swap(g, c);
acb_clear(c);
}
void
acb_hypgeom_ci_asymp(acb_t res, const acb_t z, slong prec)
{
acb_t t, u, w, v, one;
acb_init(t);
acb_init(u);
acb_init(w);
acb_init(v);
acb_init(one);
acb_one(one);
acb_mul_onei(w, z);
/* u = U(1,1,iz) */
acb_hypgeom_u_asymp(u, one, one, w, -1, prec);
/* v = e^(-iz) */
acb_neg(v, w);
acb_exp(v, v, prec);
acb_mul(t, u, v, prec);
if (acb_is_real(z))
{
arb_div(acb_realref(t), acb_imagref(t), acb_realref(z), prec);
arb_zero(acb_imagref(t));
acb_neg(t, t);
}
else
{
/* u = U(1,1,-iz) */
acb_neg(w, w);
acb_hypgeom_u_asymp(u, one, one, w, -1, prec);
acb_inv(v, v, prec);
acb_submul(t, u, v, prec);
acb_div(t, t, w, prec);
acb_mul_2exp_si(t, t, -1);
}
if (arb_is_zero(acb_realref(z)))
{
if (arb_is_positive(acb_imagref(z)))
{
arb_const_pi(acb_imagref(t), prec);
arb_mul_2exp_si(acb_imagref(t), acb_imagref(t), -1);
}
else if (arb_is_negative(acb_imagref(z)))
{
arb_const_pi(acb_imagref(t), prec);
arb_mul_2exp_si(acb_imagref(t), acb_imagref(t), -1);
arb_neg(acb_imagref(t), acb_imagref(t));
}
else
{
acb_const_pi(u, prec);
acb_mul_2exp_si(u, u, -1);
arb_zero(acb_imagref(t));
arb_add_error(acb_imagref(t), acb_realref(u));
}
}
else
{
/* 0 if positive or positive imaginary
pi if upper left quadrant (including negative real axis)
-pi if lower left quadrant (including negative imaginary axis) */
if (arb_is_positive(acb_realref(z)))
{
/* do nothing */
}
else if (arb_is_negative(acb_realref(z)) && arb_is_nonnegative(acb_imagref(z)))
{
acb_const_pi(u, prec);
arb_add(acb_imagref(t), acb_imagref(t), acb_realref(u), prec);
}
else if (arb_is_nonpositive(acb_realref(z)) && arb_is_negative(acb_imagref(z)))
{
acb_const_pi(u, prec);
arb_sub(acb_imagref(t), acb_imagref(t), acb_realref(u), prec);
}
else
{
/* add [-pi,pi] */
acb_const_pi(u, prec);
arb_add_error(acb_imagref(t), acb_realref(u));
}
}
acb_swap(res, t);
acb_clear(t);
acb_clear(u);
acb_clear(w);
acb_clear(v);
acb_clear(one);
}
void
acb_hypgeom_chi_asymp(acb_t res, const acb_t z, slong prec)
{
acb_t t, u, v, one;
acb_init(t);
acb_init(u);
acb_init(v);
acb_init(one);
acb_one(one);
/* u = U(1,1,z) */
acb_hypgeom_u_asymp(u, one, one, z, -1, prec);
/* v = e^(-z) */
acb_neg(v, z);
acb_exp(v, v, prec);
acb_mul(t, u, v, prec);
if (arb_is_zero(acb_realref(z)))
{
arb_div(acb_realref(t), acb_imagref(t), acb_imagref(z), prec);
arb_zero(acb_imagref(t));
acb_neg(t, t);
}
else
{
/* u = U(1,1,-z) */
acb_neg(u, z);
acb_hypgeom_u_asymp(u, one, one, u, -1, prec);
acb_inv(v, v, prec);
acb_submul(t, u, v, prec);
acb_div(t, t, z, prec);
acb_mul_2exp_si(t, t, -1);
acb_neg(t, t);
}
if (acb_is_real(z))
{
if (arb_is_positive(acb_realref(z)))
{
arb_zero(acb_imagref(t));
}
else if (arb_is_negative(acb_realref(z)))
{
arb_const_pi(acb_imagref(t), prec);
}
else
{
/* add [-pi,pi]/2 i */
acb_const_pi(u, prec);
arb_zero(acb_imagref(t));
arb_add_error(acb_imagref(t), acb_realref(u));
}
}
else
{
/* -pi/2 if positive real or in lower half plane
pi/2 if negative real or in upper half plane */
if (arb_is_negative(acb_imagref(z)))
{
acb_const_pi(u, prec);
acb_mul_2exp_si(u, u, -1);
arb_sub(acb_imagref(t), acb_imagref(t), acb_realref(u), prec);
}
else if (arb_is_positive(acb_imagref(z)))
{
acb_const_pi(u, prec);
acb_mul_2exp_si(u, u, -1);
arb_add(acb_imagref(t), acb_imagref(t), acb_realref(u), prec);
}
else
{
/* add [-pi,pi]/2 i */
acb_const_pi(u, prec);
acb_mul_2exp_si(u, u, -1);
arb_add_error(acb_imagref(t), acb_realref(u));
}
}
acb_swap(res, t);
acb_clear(t);
acb_clear(u);
acb_clear(v);
acb_clear(one);
}
