void
_fmpz_poly_pseudo_divrem_cohen(fmpz * Q, fmpz * R, const fmpz * A,
long lenA, const fmpz * B, long lenB)
{
const fmpz * leadB = B + (lenB - 1);
long e, lenQ;
fmpz_t pow;
if (lenB == 1)
{
fmpz_init(pow);
fmpz_pow_ui(pow, leadB, lenA - 1);
_fmpz_vec_scalar_mul_fmpz(Q, A, lenA, pow);
_fmpz_vec_zero(R, lenA);
fmpz_clear(pow);
return;
}
lenQ = lenA - lenB + 1;
_fmpz_vec_zero(Q, lenQ);
if (R != A)
_fmpz_vec_set(R, A, lenA);
e = lenA - lenB;
/* Unroll the first run of the while loop */
{
fmpz_set(Q + (lenQ - 1), R + (lenA - 1));
_fmpz_vec_scalar_mul_fmpz(R, R, lenA - 1, leadB);
_fmpz_vec_scalar_submul_fmpz(R + (lenA - lenB), B, lenB - 1, R + (lenA - 1));
fmpz_zero(R + (lenA - 1));
for (lenA -= 2; (lenA >= 0) && (R[lenA] == 0L); lenA--) ;
lenA++;
}
while (lenA >= lenB)
{
_fmpz_vec_scalar_mul_fmpz(Q, Q, lenQ, leadB);
fmpz_add(Q + (lenA - lenB), Q + (lenA - lenB), R + (lenA - 1));
_fmpz_vec_scalar_mul_fmpz(R, R, lenA - 1, leadB);
_fmpz_vec_scalar_submul_fmpz(R + lenA - lenB, B, lenB - 1, R + (lenA - 1));
fmpz_zero(R + (lenA - 1));
for (lenA -= 2; (lenA >= 0) && (R[lenA] == 0L); lenA--) ;
lenA++;
e--;
}
fmpz_init(pow);
fmpz_pow_ui(pow, leadB, e);
_fmpz_vec_scalar_mul_fmpz(Q, Q, lenQ, pow);
_fmpz_vec_scalar_mul_fmpz(R, R, lenA, pow);
fmpz_clear(pow);
}
static __inline__
long _zeta_function(const fmpz_t p, long a,
long n, long d)
{
const long b = gmc_basis_size(n, d);
long i, N;
fmpz_t f, g, max;
fmpz_init(f);
fmpz_init(g);
fmpz_init(max);
if (n == 3 && fmpz_cmp_ui(p, 2) != 0)
{
fmpz_bin_uiui(f, d-1, 3);
fmpz_bin_uiui(g, b, b / 2);
fmpz_mul_ui(g, g, 2);
N = a * (*f) + fmpz_clog(g, p);
}
else if (n % 2L == 0) /* n even implies b even */
{
fmpz_bin_uiui(f, b, b / 2);
fmpz_pow_ui(g, p, (a * (b / 2) * (n - 1) + 1) / 2);
fmpz_mul(f, f, g);
fmpz_mul_ui(f, f, 2);
N = fmpz_flog(f, p) + 1;
}
else
{
for (i = b / 2; i <= b; i++)
{
fmpz_bin_uiui(f, b, i);
fmpz_pow_ui(g, p, (a * i * (n - 1) + 1) / 2);
fmpz_mul(f, f, g);
fmpz_mul_ui(f, f, 2);
if (fmpz_cmp(max, f) < 0)
fmpz_swap(max, f);
}
N = fmpz_flog(max, p) + 1;
}
fmpz_clear(f);
fmpz_clear(g);
fmpz_clear(max);
return N;
}
int main()
{
printf("seq_set_fmpq_pow....");
fflush(stdout);
{
long i;
fmpq_t t, u;
fmpz_holonomic_t op;
fmpq_t c, initial;
fmpz_holonomic_init(op);
fmpq_init(t);
fmpq_init(u);
fmpq_init(c);
fmpq_init(initial);
fmpq_set_si(c, -7, 3);
fmpz_holonomic_seq_set_fmpq_pow(op, c);
fmpq_set_si(initial, -2, 1);
for (i = 0; i < 20; i++)
{
fmpz_holonomic_get_nth_fmpq(t, op, initial, 0, i);
fmpz_pow_ui(fmpq_numref(u), fmpq_numref(c), i);
fmpz_pow_ui(fmpq_denref(u), fmpq_denref(c), i);
fmpz_mul_si(fmpq_numref(u), fmpq_numref(u), -2);
if (!fmpq_equal(t, u))
{
printf("FAIL\n");
printf("i = %ld, t = ", i); fmpq_print(t);
printf(" u = "); fmpq_print(u);
printf("\n");
abort();
}
}
fmpq_clear(c);
fmpq_clear(t);
fmpq_clear(u);
fmpq_clear(initial);
fmpz_holonomic_clear(op);
}
flint_cleanup();
printf("PASS\n");
return EXIT_SUCCESS;
}
static void precompute_dinv_p(fmpz *list, long M, long d, long p, long N)
{
fmpz_one(list + 0);
if (M >= p)
{
fmpz_t P, PN;
long r;
fmpz_init_set_ui(P, p);
fmpz_init(PN);
fmpz_pow_ui(PN, P, N);
fmpz_set_ui(list + 1, d);
_padic_inv(list + 1, list + 1, P, N);
for (r = 2; r <= M / p; r++)
{
fmpz_mul(list + r, list + (r - 1), list + 1);
fmpz_mod(list + r, list + r, PN);
}
fmpz_clear(P);
fmpz_clear(PN);
}
}
static void
_padic_log_bsplit(fmpz_t z, const fmpz_t y, long v, const fmpz_t p, long N)
{
fmpz_t P, B, T;
long n;
if (fmpz_fits_si(p))
n = _padic_log_bound(v, N, fmpz_get_si(p));
else
n = (N - 1) / v;
n = FLINT_MAX(n, 2);
fmpz_init(P);
fmpz_init(B);
fmpz_init(T);
_padic_log_bsplit_series(P, B, T, y, 1, n);
n = fmpz_remove(B, B, p);
fmpz_pow_ui(P, p, n);
fmpz_divexact(T, T, P);
_padic_inv(B, B, p, N);
fmpz_mul(z, T, B);
fmpz_clear(P);
fmpz_clear(B);
fmpz_clear(T);
}
void padic_ctx_init(padic_ctx_t ctx, const fmpz_t p, long N,
enum padic_print_mode mode)
{
fmpz_init(ctx->p);
fmpz_set(ctx->p, p);
ctx->N = N;
ctx->pinv = (!COEFF_IS_MPZ(*p)) ? n_precompute_inverse(fmpz_get_ui(p)) : 0;
if (N > 0)
{
long i, len;
ctx->min = FLINT_MAX(1, N - 10);
ctx->max = N + 10;
len = ctx->max - ctx->min;
ctx->pow = _fmpz_vec_init(len);
fmpz_pow_ui(ctx->pow, p, ctx->min);
for (i = 1; i < len; i++)
fmpz_mul(ctx->pow + i, ctx->pow + (i - 1), p);
}
else
{
ctx->min = 0;
ctx->max = 0;
ctx->pow = NULL;
}
ctx->mode = mode;
}
int padic_poly_get_fmpz_poly(fmpz_poly_t rop, const padic_poly_t op,
const padic_ctx_t ctx)
{
const slong len = op->length;
if (op->val < 0)
{
return 0;
}
if (padic_poly_is_zero(op))
{
fmpz_poly_zero(rop);
return 1;
}
fmpz_poly_fit_length(rop, len);
_fmpz_poly_set_length(rop, len);
if (op->val == 0)
{
_fmpz_vec_set(rop->coeffs, op->coeffs, len);
}
else /* op->val > 0 */
{
fmpz_t pow;
fmpz_init(pow);
fmpz_pow_ui(pow, ctx->p, op->val);
_fmpz_vec_scalar_mul_fmpz(rop->coeffs, op->coeffs, len, pow);
fmpz_clear(pow);
}
return 1;
}
void
fmpz_holonomic_forward_fmpz_mat(fmpz_mat_t M, fmpz_t Q,
const fmpz_holonomic_t op, long start, long n)
{
long r = fmpz_holonomic_order(op);
if (r == 0 || n == 0)
{
fmpz_mat_one(M);
fmpz_one(Q);
return;
}
if (n < 0)
{
abort();
}
if (fmpz_holonomic_seq_is_cfinite(op))
{
_fmpz_holonomic_eval_companion_matrix_fmpz(M, Q, op, 0);
fmpz_mat_pow(M, M, n);
fmpz_pow_ui(Q, Q, n);
}
else if (fmpz_holonomic_seq_is_hypgeom(op))
{
_fmpz_holonomic_bsplit_hypgeom_fmpz(M->rows[0], Q,
op->coeffs, op->coeffs + 1, start, 0, n);
}
else
{
_fmpz_holonomic_forward_bsplit_fmpz(M, Q, op, start, 0, n);
}
}
static void dsum_p(
fmpz_t rop,
const fmpz *dinv, const fmpz *mu, long M, const long *C, long lenC,
const fmpz_t a, long ui, long vi, long n, long d, long p, long N)
{
long m, r, idx;
fmpz_t apm1, apow, f, g, P, PN;
fmpz_init(apm1);
fmpz_init(apow);
fmpz_init(f);
fmpz_init(g);
fmpz_init_set_ui(P, p);
fmpz_init(PN);
fmpz_pow_ui(PN, P, N);
fmpz_zero(rop);
r = 0;
m = (p * (ui + 1) - (vi + 1)) / d;
if (m <= M) /* Step {r = 0} */
{
idx = _bsearch(C, 0, lenC, m % p);
fmpz_powm_ui(apm1, a, p - 1, PN);
fmpz_one(apow);
fmpz_one(f);
fmpz_mod(rop, mu + idx + lenC * (m / p), PN);
}
for (r = 1, m += p; m <= M; r++, m += p)
{
idx = _bsearch(C, 0, lenC, m % p);
fmpz_mul(apow, apow, apm1);
fmpz_mod(apow, apow, PN);
fmpz_mul_ui(f, f, ui + 1 + (r - 1) * d);
fmpz_mod(f, f, PN);
fmpz_mul(g, f, dinv + r);
fmpz_mul(g, g, apow);
fmpz_mul(g, g, mu + idx + lenC * (m / p));
fmpz_mod(g, g, PN);
fmpz_add(rop, rop, g);
}
fmpz_mod(rop, rop, PN);
fmpz_clear(apm1);
fmpz_clear(apow);
fmpz_clear(f);
fmpz_clear(g);
fmpz_clear(P);
fmpz_clear(PN);
}
static void entry(fmpz_t rop_u, long *rop_v,
const long *u, const long *v, const fmpz *a, const fmpz *dinv,
const fmpz **mu, long M, const long **C, const long *lenC,
long n, long d, long p, long N, long N2)
{
const long ku = diagfrob_k(u, n, d);
const long kv = diagfrob_k(v, n, d);
fmpz_t f, g, P;
fmpz_init(f);
fmpz_init(g);
fmpz_init_set_ui(P, p);
/*
Compute $g := (u'-1)! \alpha_{u+1,v+1}$ to precision $N2$.
*/
fmpz_fac_ui(f, ku - 1);
alpha(g, u, v, a, dinv, mu, M, C, lenC, n, d, p, N2);
fmpz_mul(g, f, g);
/*
Compute $f := (-1)^{u'+v'} (v'-1)!$ exactly.
*/
fmpz_fac_ui(f, kv - 1);
if ((ku + kv) % 2 != 0)
{
fmpz_neg(f, f);
}
/*
Set rop to the product of $f$ and $g^{-1} mod $p^N$.
*/
*rop_v = fmpz_remove(f, f, P) + n - fmpz_remove(g, g, P);
if (*rop_v >= N)
{
fmpz_zero(rop_u);
*rop_v = 0;
}
else
{
_padic_inv(g, g, P, N - *rop_v);
fmpz_mul(rop_u, f, g);
fmpz_pow_ui(f, P, N - *rop_v);
fmpz_mod(rop_u, rop_u, f);
}
fmpz_clear(f);
fmpz_clear(g);
fmpz_clear(P);
}
void
_padic_log_balanced(fmpz_t z, const fmpz_t y, long v, const fmpz_t p, long N)
{
fmpz_t pv, pN, r, t, u;
long val;
padic_inv_t S;
fmpz_init(pv);
fmpz_init(pN);
fmpz_init(r);
fmpz_init(t);
fmpz_init(u);
_padic_inv_precompute(S, p, N);
fmpz_set(t, y);
fmpz_set(pv, p);
fmpz_pow_ui(pN, p, N);
fmpz_zero(z);
val = 1;
/*
TODO: Abort earlier if larger than $p^N$, possible
with variable precision?
*/
while (!fmpz_is_zero(t))
{
fmpz_mul(pv, pv, pv);
fmpz_fdiv_qr(t, r, t, pv);
if (!fmpz_is_zero(t))
{
fmpz_mul(t, t, pv);
fmpz_add_ui(u, r, 1);
_padic_inv_precomp(u, u, S);
fmpz_mul(t, t, u);
fmpz_mod(t, t, pN);
}
if (!fmpz_is_zero(r))
{
fmpz_neg(r, r);
_padic_log_bsplit(r, r, val, p, N);
fmpz_sub(z, z, r);
}
val *= 2;
}
fmpz_clear(pv);
fmpz_clear(pN);
fmpz_clear(r);
fmpz_clear(t);
fmpz_clear(u);
_padic_inv_clear(S);
}
/*
Applies the operator $\sigma^e$ to all elements in the matrix \code{op},
setting the corresponding elements in \code{rop} to the results.
*/
static
void fmpz_poly_mat_frobenius(fmpz_poly_mat_t B,
const fmpz_poly_mat_t A, long e,
const fmpz_t p, long N, const qadic_ctx_t ctx)
{
const long d = qadic_ctx_degree(ctx);
e = e % d;
if (e < 0)
e += d;
if (e == 0)
{
fmpz_t pN;
fmpz_init(pN);
fmpz_pow_ui(pN, p, N);
fmpz_poly_mat_scalar_mod_fmpz(B, A, pN);
fmpz_clear(pN);
}
else
{
long i, j;
fmpz *t = _fmpz_vec_init(2 * d - 1);
for (i = 0; i < B->r; i++)
for (j = 0; j < B->c; j++)
{
const fmpz_poly_struct *a = fmpz_poly_mat_entry(A, i, j);
fmpz_poly_struct *b = fmpz_poly_mat_entry(B, i, j);
if (a->length == 0)
{
fmpz_poly_zero(b);
}
else
{
_qadic_frobenius(t, a->coeffs, a->length, e,
ctx->a, ctx->j, ctx->len, p, N);
fmpz_poly_fit_length(b, d);
_fmpz_vec_set(b->coeffs, t, d);
_fmpz_poly_set_length(b, d);
_fmpz_poly_normalise(b);
}
}
_fmpz_vec_clear(t, 2 * d - 1);
}
}
void _fmpq_poly_div(fmpz * Q, fmpz_t q,
const fmpz * A, const fmpz_t a, long lenA,
const fmpz * B, const fmpz_t b, long lenB)
{
long lenQ = lenA - lenB + 1;
ulong d;
const fmpz * lead = B + (lenB - 1);
if (lenB == 1)
{
_fmpq_poly_scalar_div_fmpq(Q, q, A, a, lenA, B, b);
return;
}
/*
From pseudo division over Z we have
lead^d * A = Q * B + R
and thus
{A, a} = {b * Q, a * lead^d} * {B, b} + {R, a * lead^d}.
*/
_fmpz_poly_pseudo_div(Q, &d, A, lenA, B, lenB);
/* 1. lead^d == +-1. {Q, q} = {b Q, a} up to sign */
if (d == 0UL || *lead == 1L || *lead == -1L)
{
fmpz_one(q);
_fmpq_poly_scalar_mul_fmpz(Q, q, Q, q, lenQ, b);
_fmpq_poly_scalar_div_fmpz(Q, q, Q, q, lenQ, a);
if (*lead == -1L && d % 2UL)
_fmpz_vec_neg(Q, Q, lenQ);
}
/* 2. lead^d != +-1. {Q, q} = {b Q, a lead^d} */
else
{
/*
TODO: Improve this. Clearly we do not need to compute
den = a lead^d in many cases, but can determine the GCD from
lead alone already.
*/
fmpz_t den;
fmpz_init(den);
fmpz_pow_ui(den, lead, d);
fmpz_mul(den, a, den);
fmpz_one(q);
_fmpq_poly_scalar_mul_fmpz(Q, q, Q, q, lenQ, b);
_fmpq_poly_scalar_div_fmpz(Q, q, Q, q, lenQ, den);
fmpz_clear(den);
}
}
static void alpha(fmpz_t rop, const long *u, const long *v,
const fmpz *a, const fmpz *dinv, const fmpz **mu, long M, const long **C, const long *lenC,
long n, long d, long p, long N)
{
const long ku = diagfrob_k(u, n, d);
long i;
fmpz_t f, g, P, PN;
fmpz_init(f);
fmpz_init(g);
fmpz_init_set_ui(P, p);
fmpz_init(PN);
fmpz_pow_ui(PN, P, N);
fmpz_pow_ui(rop, P, ku);
fmpz_mod(rop, rop, PN);
for (i = 0; i <= n; i++)
{
long e = (p * (u[i] + 1) - (v[i] + 1)) / d;
fmpz_powm_ui(f, a + i, e, PN);
dsum(g, dinv, mu[i], M, C[i], lenC[i], a + i, u[i], v[i], n, d, p, N);
fmpz_mul(rop, rop, f);
fmpz_mul(rop, rop, g);
fmpz_mod(rop, rop, PN);
}
if (ku % 2 != 0 && !fmpz_is_zero(rop))
{
fmpz_sub(rop, PN, rop);
}
fmpz_clear(f);
fmpz_clear(g);
fmpz_clear(P);
fmpz_clear(PN);
}
void _qadic_exp_balanced(fmpz *rop, const fmpz *x, slong v, slong len,
const fmpz *a, const slong *j, slong lena,
const fmpz_t p, slong N, const fmpz_t pN)
{
const slong d = j[lena - 1];
fmpz_t pw;
fmpz *r, *s, *t;
slong i, w;
r = _fmpz_vec_init(d);
s = _fmpz_vec_init(2*d - 1);
t = _fmpz_vec_init(d);
fmpz_init(pw);
fmpz_pow_ui(pw, p, v);
_fmpz_vec_scalar_mul_fmpz(t, x, len, pw);
_fmpz_vec_scalar_mod_fmpz(t, t, len, pN);
_fmpz_vec_zero(t + len, d - len);
fmpz_set(pw, p);
fmpz_one(rop + 0);
_fmpz_vec_zero(rop + 1, d - 1);
w = 1;
while (!_fmpz_vec_is_zero(t, d))
{
fmpz_mul(pw, pw, pw);
for (i = 0; i < d; i++)
{
fmpz_fdiv_r(r + i, t + i, pw);
fmpz_sub(t + i, t + i, r + i);
}
if (!_fmpz_vec_is_zero(r, d))
{
_qadic_exp_bsplit(r, r, w, d, a, j, lena, p, N);
_fmpz_poly_mul(s, rop, d, r, d);
_fmpz_poly_reduce(s, 2*d - 1, a, j, lena);
_fmpz_vec_scalar_mod_fmpz(rop, s, d, pN);
}
w *= 2;
}
_fmpz_vec_clear(r, d);
_fmpz_vec_clear(s, 2*d - 1);
_fmpz_vec_clear(t, d);
fmpz_clear(pw);
}
void _fmpz_ramanujan_tau(fmpz_t res, fmpz_factor_t factors)
{
fmpz_poly_t poly;
fmpz_t tau_p, p_11, next, this, prev;
long k, r;
ulong max_prime;
max_prime = 1UL;
for (k = 0; k < factors->length; k++)
{
/* TODO: handle overflow properly */
max_prime = FLINT_MAX(max_prime, fmpz_get_ui(factors->p + k));
}
fmpz_poly_init(poly);
fmpz_poly_ramanujan_tau(poly, max_prime + 1);
fmpz_set_ui(res, 1);
fmpz_init(tau_p);
fmpz_init(p_11);
fmpz_init(next);
fmpz_init(this);
fmpz_init(prev);
for (k = 0; k < factors->length; k++)
{
ulong p = fmpz_get_ui(factors->p + k);
fmpz_set(tau_p, poly->coeffs + p);
fmpz_set_ui(p_11, p);
fmpz_pow_ui(p_11, p_11, 11);
fmpz_set_ui(prev, 1);
fmpz_set(this, tau_p);
for (r = 1; r < fmpz_get_ui(factors->exp + k); r++)
{
fmpz_mul(next, tau_p, this);
fmpz_submul(next, p_11, prev);
fmpz_set(prev, this);
fmpz_set(this, next);
}
fmpz_mul(res, res, this);
}
fmpz_clear(tau_p);
fmpz_clear(p_11);
fmpz_clear(next);
fmpz_clear(this);
fmpz_clear(prev);
fmpz_poly_clear(poly);
}
void
_fmpz_poly_pow_multinomial(fmpz * res, const fmpz * poly, long len, ulong e)
{
long k, low, rlen;
fmpz_t d, t;
fmpz * P;
rlen = (long) e * (len - 1L) + 1L;
_fmpz_vec_zero(res, rlen);
for (low = 0L; poly[low] == 0L; low++) ;
if (low == 0L)
{
P = (fmpz *) poly;
}
else
{
P = (fmpz *) poly + low;
len -= low;
res += (long) e * low;
rlen -= (long) e * low;
}
fmpz_init(d);
fmpz_init(t);
fmpz_pow_ui(res, P, e);
for (k = 1; k < rlen; k++)
{
long i, u = -k;
for (i = 1; i <= FLINT_MIN(k, len - 1); i++)
{
fmpz_mul(t, P + i, res + (k - i));
u += (long) e + 1;
if (u >= 0)
fmpz_addmul_ui(res + k, t, (ulong) u);
else
fmpz_submul_ui(res + k, t, - ((ulong) u));
}
fmpz_add(d, d, P);
fmpz_divexact(res + k, res + k, d);
}
fmpz_clear(d);
fmpz_clear(t);
}
void gmde_convert_soln(fmpz_poly_mat_t A, long *vA,
const padic_mat_struct *C, long N, const fmpz_t p)
{
long i, j, k;
fmpz_t s, t;
assert(N > 0);
assert(A->r == padic_mat(C)->r && A->c == padic_mat(C)->c);
fmpz_init(s);
fmpz_init(t);
/* Find valuation */
*vA = LONG_MAX;
for (k = 0; k < N; k++)
*vA = FLINT_MIN(*vA, padic_mat_val(C + k));
fmpz_poly_mat_zero(A);
for (k = N - 1; k >= 0; k--)
{
if (padic_mat_val(C + k) == *vA)
{
for (i = 0; i < A->r; i++)
for (j = 0; j < A->c; j++)
if (!fmpz_is_zero(padic_mat_entry(C + k, i, j)))
fmpz_poly_set_coeff_fmpz(fmpz_poly_mat_entry(A, i, j), k,
padic_mat_entry(C + k, i, j));
}
else
{
fmpz_pow_ui(s, p, padic_mat_val(C + k) - *vA);
for (i = 0; i < A->r; i++)
for (j = 0; j < A->c; j++)
if (!fmpz_is_zero(padic_mat_entry(C + k, i, j)))
{
fmpz_mul(t, s, padic_mat_entry(C + k, i, j));
fmpz_poly_set_coeff_fmpz(fmpz_poly_mat_entry(A, i, j),
k, t);
}
}
}
fmpz_clear(s);
fmpz_clear(t);
}
void
fmpz_poly_pow_multinomial(fmpz_poly_t res, const fmpz_poly_t poly, ulong e)
{
const long len = poly->length;
long rlen;
if ((len < 2) | (e < 3UL))
{
if (e == 0UL)
fmpz_poly_set_ui(res, 1);
else if (len == 0)
fmpz_poly_zero(res);
else if (len == 1)
{
fmpz_poly_fit_length(res, 1);
fmpz_pow_ui(res->coeffs, poly->coeffs, e);
_fmpz_poly_set_length(res, 1);
}
else if (e == 1UL)
fmpz_poly_set(res, poly);
else /* e == 2UL */
fmpz_poly_sqr(res, poly);
return;
}
rlen = (long) e * (len - 1) + 1;
if (res != poly)
{
fmpz_poly_fit_length(res, rlen);
_fmpz_poly_pow_multinomial(res->coeffs, poly->coeffs, len, e);
_fmpz_poly_set_length(res, rlen);
}
else
{
fmpz_poly_t t;
fmpz_poly_init2(t, rlen);
_fmpz_poly_pow_multinomial(t->coeffs, poly->coeffs, len, e);
_fmpz_poly_set_length(t, rlen);
fmpz_poly_swap(res, t);
fmpz_poly_clear(t);
}
}
static void
_qadic_exp_bsplit(fmpz *y, const fmpz *x, slong v, slong len,
const fmpz *a, const slong *j, slong lena,
const fmpz_t p, slong N)
{
const slong d = j[lena - 1];
const slong n = _padic_exp_bound(v, N, p);
if (n == 1)
{
fmpz_one(y + 0);
_fmpz_vec_zero(y + 1, d - 1);
}
else
{
fmpz *P, *T;
fmpz_t Q, R;
slong f;
P = _fmpz_vec_init(2*d - 1);
T = _fmpz_vec_init(2*d - 1);
fmpz_init(Q);
fmpz_init(R);
_qadic_exp_bsplit_series(P, Q, T, x, len, 1, n, a, j, lena);
fmpz_add(T + 0, T + 0, Q); /* (T,Q) := (T,Q) + 1 */
/* Note exp(x) is a unit so val(T) == val(Q). */
f = fmpz_remove(Q, Q, p);
fmpz_pow_ui(R, p, f);
_fmpz_vec_scalar_divexact_fmpz(T, T, d, R);
_padic_inv(Q, Q, p, N);
_fmpz_vec_scalar_mul_fmpz(y, T, d, Q);
_fmpz_vec_clear(P, 2*d - 1);
_fmpz_vec_clear(T, 2*d - 1);
fmpz_clear(Q);
fmpz_clear(R);
}
}
static
void fmpz_poly_evaluate_qadic(qadic_t rop,
const fmpz_poly_t op1, const qadic_t op2, const qadic_ctx_t ctx)
{
const long N = qadic_prec(rop);
const long d = qadic_ctx_degree(ctx);
if (N <= 0 || op2->val != 0 || rop == op2)
{
printf("Exception (fmpz_poly_evaluate_qadic):\n");
printf("Currently assumes that N > 0 and op2->val == 0, \n");
printf("and does not support aliasing.\n");
abort();
}
if (fmpz_poly_is_zero(op1))
{
qadic_zero(rop);
}
else if (qadic_is_zero(op2))
{
padic_poly_set_fmpz(rop, op1->coeffs + 0, &ctx->pctx);
}
else
{
fmpz_t pN;
fmpz_init(pN);
fmpz_pow_ui(pN, (&ctx->pctx)->p, N);
padic_poly_fit_length(rop, d);
_fmpz_mod_poly_compose_smod(rop->coeffs,
op1->coeffs, op1->length, op2->coeffs, op2->length,
ctx->a, ctx->j, ctx->len, pN);
_padic_poly_set_length(rop, d);
qadic_reduce(rop, ctx);
fmpz_clear(pN);
}
}
void arith_euler_phi(fmpz_t res, const fmpz_t n)
{
fmpz_factor_t factors;
fmpz_t t;
ulong exp;
slong i;
if (fmpz_sgn(n) <= 0)
{
fmpz_zero(res);
return;
}
if (fmpz_abs_fits_ui(n))
{
fmpz_set_ui(res, n_euler_phi(fmpz_get_ui(n)));
return;
}
fmpz_factor_init(factors);
fmpz_factor(factors, n);
fmpz_one(res);
fmpz_init(t);
for (i = 0; i < factors->num; i++)
{
fmpz_sub_ui(t, factors->p + i, UWORD(1));
fmpz_mul(res, res, t);
exp = factors->exp[i];
if (exp != 1)
{
fmpz_pow_ui(t, factors->p + i, exp - UWORD(1));
fmpz_mul(res, res, t);
}
}
fmpz_clear(t);
fmpz_factor_clear(factors);
}
static
void fmpz_poly_mat_canonicalise(fmpz_poly_mat_t A, long *vA, const fmpz_t p)
{
const long w = fmpz_poly_mat_ord_p(A, p);
if (w == LONG_MAX)
{
*vA = 0;
}
else if (w > 0)
{
fmpz_t f;
fmpz_init(f);
fmpz_pow_ui(f, p, w);
fmpz_poly_mat_scalar_divexact_fmpz(A, A, f);
*vA += w;
fmpz_clear(f);
}
}
char * _padic_get_str(char * str, const padic_t op, const padic_ctx_t ctx)
{
const fmpz * u = padic_unit(op);
const long v = padic_val(op);
if (fmpz_is_zero(u))
{
if (!str)
{
str = flint_malloc(2);
}
str[0] = '0';
str[1] = '\0';
return str;
}
if (ctx->mode == PADIC_TERSE)
{
if (v == 0)
{
str = fmpz_get_str(str, 10, u);
}
else if (v > 0)
{
fmpz_t t;
fmpz_init(t);
fmpz_pow_ui(t, ctx->p, v);
fmpz_mul(t, t, u);
str = fmpz_get_str(str, 10, t);
fmpz_clear(t);
}
else /* v < 0 */
{
fmpz_t t;
fmpz_init(t);
fmpz_pow_ui(t, ctx->p, -v);
str = _fmpq_get_str(str, 10, u, t);
fmpz_clear(t);
}
}
else if (ctx->mode == PADIC_SERIES)
{
char *s;
fmpz_t x;
fmpz_t d;
long j, N;
if (fmpz_sgn(u) < 0)
{
printf("ERROR (_padic_get_str). u < 0 in SERIES mode.\n");
abort();
}
N = fmpz_clog(u, ctx->p) + v;
if (!str)
{
long b = (N - v) * (2 * fmpz_sizeinbase(ctx->p, 10)
+ z_sizeinbase(FLINT_MAX(FLINT_ABS(v), FLINT_ABS(N)), 10)
+ 5) + 1;
str = flint_malloc(b);
if (!str)
{
printf("ERROR (_padic_get_str). Memory allocation failed.\n");
abort();
}
}
s = str;
fmpz_init(d);
fmpz_init(x);
fmpz_set(x, u);
/* Unroll first step */
j = 0;
{
fmpz_mod(d, x, ctx->p); /* d = u mod p^{j+1} */
fmpz_sub(x, x, d); /* x = x - d */
fmpz_divexact(x, x, ctx->p); /* x = x / p */
if (!fmpz_is_zero(d))
{
if (j + v != 0)
{
fmpz_get_str(s, 10, d);
while (*++s != '\0') ;
*s++ = '*';
fmpz_get_str(s, 10, ctx->p);
while (*++s != '\0') ;
*s++ = '^';
sprintf(s, "%ld", j + v);
while (*++s != '\0') ;
}
else
{
fmpz_get_str(s, 10, d);
while (*++s != '\0') ;
}
}
j++;
}
for ( ; !fmpz_is_zero(x); j++)
{
fmpz_mod(d, x, ctx->p); /* d = u mod p^{j+1} */
fmpz_sub(x, x, d); /* x = x - d */
fmpz_divexact(x, x, ctx->p); /* x = x / p */
if (!fmpz_is_zero(d))
{
if (j + v != 0)
{
*s++ = ' ';
*s++ = '+';
*s++ = ' ';
fmpz_get_str(s, 10, d);
while (*++s != '\0') ;
*s++ = '*';
fmpz_get_str(s, 10, ctx->p);
while (*++s != '\0') ;
*s++ = '^';
sprintf(s, "%ld", j + v);
while (*++s != '\0') ;
}
else
{
*s++ = ' ';
*s++ = '+';
*s++ = ' ';
fmpz_get_str(s, 10, d);
while (*++s != '\0') ;
}
}
}
fmpz_clear(x);
fmpz_clear(d);
}
else /* ctx->mode == PADIC_VAL_UNIT */
{
if (!str)
{
long b = fmpz_sizeinbase(u, 10) + fmpz_sizeinbase(ctx->p, 10)
+ z_sizeinbase(v, 10) + 4;
str = flint_malloc(b);
if (!str)
{
printf("ERROR (_padic_get_str). Memory allocation failed.\n");
abort();
}
}
if (v == 0)
{
str = fmpz_get_str(str, 10, u);
}
else if (v == 1)
{
char *s = str;
fmpz_get_str(s, 10, u);
while (*++s != '\0') ;
*s++ = '*';
fmpz_get_str(s, 10, ctx->p);
}
else
{
char *s = str;
fmpz_get_str(s, 10, u);
while (*++s != '\0') ;
*s++ = '*';
fmpz_get_str(s, 10, ctx->p);
while (*++s != '\0') ;
*s++ = '^';
sprintf(s, "%ld", v);
}
}
return str;
}
int
main(void)
{
int i, result;
FLINT_TEST_INIT(state);
flint_printf("remove....");
fflush(stdout);
/* Compare with MPIR, random input */
for (i = 0; i < 1000 * flint_test_multiplier(); i++)
{
fmpz_t a, b, c;
mpz_t d, e, f, g;
slong x, y;
fmpz_init(a);
fmpz_init(b);
fmpz_init(c);
mpz_init(d);
mpz_init(e);
mpz_init(f);
mpz_init(g);
fmpz_randtest_not_zero(a, state, 200);
do {
fmpz_randtest_not_zero(b, state, 200);
fmpz_abs(b, b);
} while (fmpz_is_one(b));
fmpz_get_mpz(d, a);
fmpz_get_mpz(e, b);
x = fmpz_remove(c, a, b);
y = mpz_remove(f, d, e);
fmpz_get_mpz(g, c);
result = ((x == y) && (mpz_cmp(f, g) == 0));
if (!result)
{
flint_printf("FAIL:\n");
gmp_printf("d = %Zd, e = %Zd, f = %Zd, g = %Zd\n", d, e, f, g);
abort();
}
fmpz_clear(a);
fmpz_clear(b);
fmpz_clear(c);
mpz_clear(d);
mpz_clear(e);
mpz_clear(f);
mpz_clear(g);
}
/* Compare with MPIR, random input but ensure that factors exist */
for (i = 0; i < 1000 * flint_test_multiplier(); i++)
{
fmpz_t a, b, c, pow;
mpz_t d, e, f, g;
slong x, y;
ulong n;
fmpz_init(a);
fmpz_init(b);
fmpz_init(c);
fmpz_init(pow);
mpz_init(d);
mpz_init(e);
mpz_init(f);
mpz_init(g);
fmpz_randtest_not_zero(a, state, 200);
do {
fmpz_randtest_not_zero(b, state, 200);
fmpz_abs(b, b);
} while (fmpz_is_one(b));
n = n_randint(state, 10);
fmpz_pow_ui(pow, b, n);
fmpz_mul(a, a, pow);
fmpz_get_mpz(d, a);
fmpz_get_mpz(e, b);
x = fmpz_remove(c, a, b);
y = mpz_remove(f, d, e);
fmpz_get_mpz(g, c);
result = ((x == y) && (x >= n) && (mpz_cmp(f, g) == 0));
if (!result)
{
flint_printf("FAIL:\n");
gmp_printf("d = %Zd, e = %Zd, f = %Zd, g = %Zd\n", d, e, f, g);
abort();
}
fmpz_clear(a);
fmpz_clear(b);
fmpz_clear(c);
fmpz_clear(pow);
mpz_clear(d);
mpz_clear(e);
mpz_clear(f);
mpz_clear(g);
}
/* Check aliasing of a and b */
for (i = 0; i < 100 * flint_test_multiplier(); i++)
{
fmpz_t a, c;
slong x;
fmpz_init(a);
fmpz_init(c);
do {
fmpz_randtest_not_zero(a, state, 200);
fmpz_abs(a, a);
} while (fmpz_is_one(a));
x = fmpz_remove(c, a, a);
result = ((x == 1) && (fmpz_cmp_ui(c, 1) == 0));
if (!result)
{
flint_printf("FAIL:\n");
fmpz_print(a), flint_printf("\n");
fmpz_print(c), flint_printf("\n");
abort();
}
fmpz_clear(a);
fmpz_clear(c);
}
/* Check aliasing of a and c */
for (i = 0; i < 100 * flint_test_multiplier(); i++)
{
fmpz_t a, b, c;
slong x, y;
fmpz_init(a);
fmpz_init(b);
fmpz_init(c);
fmpz_randtest_not_zero(a, state, 200);
do {
fmpz_randtest_not_zero(b, state, 200);
fmpz_abs(b, b);
} while (fmpz_is_one(b));
x = fmpz_remove(c, a, b);
y = fmpz_remove(a, a, b);
result = ((x == y) && fmpz_equal(a, c));
if (!result)
{
flint_printf("FAIL:\n");
fmpz_print(a), flint_printf("\n");
fmpz_print(b), flint_printf("\n");
fmpz_print(c), flint_printf("\n");
abort();
}
fmpz_clear(a);
fmpz_clear(b);
fmpz_clear(c);
}
/* Check aliasing of b and c */
for (i = 0; i < 100 * flint_test_multiplier(); i++)
{
fmpz_t a, b, c;
slong x, y;
fmpz_init(a);
fmpz_init(b);
fmpz_init(c);
fmpz_randtest_not_zero(a, state, 200);
do {
fmpz_randtest_not_zero(b, state, 200);
fmpz_abs(b, b);
} while (fmpz_is_one(b));
x = fmpz_remove(c, a, b);
y = fmpz_remove(b, a, b);
result = ((x == y) && fmpz_equal(b, c));
if (!result)
{
flint_printf("FAIL:\n");
fmpz_print(a), flint_printf("\n");
fmpz_print(b), flint_printf("\n");
fmpz_print(c), flint_printf("\n");
abort();
}
fmpz_clear(a);
fmpz_clear(b);
fmpz_clear(c);
}
FLINT_TEST_CLEANUP(state);
flint_printf("PASS\n");
return 0;
}
void frob(const mpoly_t P, const ctx_t ctxFracQt,
const qadic_t t1, const qadic_ctx_t Qq,
prec_t *prec, const prec_t *prec_in,
int verbose)
{
const padic_ctx_struct *Qp = &Qq->pctx;
const fmpz *p = Qp->p;
const long a = qadic_ctx_degree(Qq);
const long n = P->n - 1;
const long d = mpoly_degree(P, -1, ctxFracQt);
const long b = gmc_basis_size(n, d);
long i, j, k;
/* Diagonal fibre */
padic_mat_t F0;
/* Gauss--Manin Connection */
mat_t M;
mon_t *bR, *bC;
fmpz_poly_t r;
/* Local solution */
fmpz_poly_mat_t C, Cinv;
long vC, vCinv;
/* Frobenius */
fmpz_poly_mat_t F;
long vF;
fmpz_poly_mat_t F1;
long vF1;
fmpz_poly_t cp;
clock_t c0, c1;
double c;
if (verbose)
{
printf("Input:\n");
printf(" P = "), mpoly_print(P, ctxFracQt), printf("\n");
printf(" p = "), fmpz_print(p), printf("\n");
printf(" t1 = "), qadic_print_pretty(t1, Qq), printf("\n");
printf("\n");
fflush(stdout);
}
/* Step 1 {M, r} *********************************************************/
c0 = clock();
mat_init(M, b, b, ctxFracQt);
fmpz_poly_init(r);
gmc_compute(M, &bR, &bC, P, ctxFracQt);
{
fmpz_poly_t t;
fmpz_poly_init(t);
fmpz_poly_set_ui(r, 1);
for (i = 0; i < M->m; i++)
for (j = 0; j < M->n; j++)
{
fmpz_poly_lcm(t, r, fmpz_poly_q_denref(
(fmpz_poly_q_struct *) mat_entry(M, i, j, ctxFracQt)));
fmpz_poly_swap(r, t);
}
fmpz_poly_clear(t);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Gauss-Manin connection:\n");
printf(" r(t) = "), fmpz_poly_print_pretty(r, "t"), printf("\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
{
qadic_t t;
qadic_init2(t, 1);
fmpz_poly_evaluate_qadic(t, r, t1, Qq);
if (qadic_is_zero(t))
{
printf("Exception (deformation_frob).\n");
printf("The resultant r evaluates to zero (mod p) at t1.\n");
abort();
}
qadic_clear(t);
}
/* Precisions ************************************************************/
if (prec_in != NULL)
{
*prec = *prec_in;
}
else
{
deformation_precisions(prec, p, a, n, d, fmpz_poly_degree(r));
}
if (verbose)
{
printf("Precisions:\n");
printf(" N0 = %ld\n", prec->N0);
printf(" N1 = %ld\n", prec->N1);
printf(" N2 = %ld\n", prec->N2);
printf(" N3 = %ld\n", prec->N3);
printf(" N3i = %ld\n", prec->N3i);
printf(" N3w = %ld\n", prec->N3w);
printf(" N3iw = %ld\n", prec->N3iw);
printf(" N4 = %ld\n", prec->N4);
printf(" m = %ld\n", prec->m);
printf(" K = %ld\n", prec->K);
printf(" r = %ld\n", prec->r);
printf(" s = %ld\n", prec->s);
printf("\n");
fflush(stdout);
}
/* Initialisation ********************************************************/
padic_mat_init2(F0, b, b, prec->N4);
fmpz_poly_mat_init(C, b, b);
fmpz_poly_mat_init(Cinv, b, b);
fmpz_poly_mat_init(F, b, b);
vF = 0;
fmpz_poly_mat_init(F1, b, b);
vF1 = 0;
fmpz_poly_init(cp);
/* Step 2 {F0} ***********************************************************/
{
padic_ctx_t pctx_F0;
fmpz *t;
padic_ctx_init(pctx_F0, p, FLINT_MIN(prec->N4 - 10, 0), prec->N4, PADIC_VAL_UNIT);
t = _fmpz_vec_init(n + 1);
c0 = clock();
mpoly_diagonal_fibre(t, P, ctxFracQt);
diagfrob(F0, t, n, d, prec->N4, pctx_F0, 0);
padic_mat_transpose(F0, F0);
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Diagonal fibre:\n");
printf(" P(0) = {"), _fmpz_vec_print(t, n + 1), printf("}\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
_fmpz_vec_clear(t, n + 1);
padic_ctx_clear(pctx_F0);
}
/* Step 3 {C, Cinv} ******************************************************/
/*
Compute C as a matrix over Z_p[[t]]. A is the same but as a series
of matrices over Z_p. Mt is the matrix -M^t, and Cinv is C^{-1}^t,
the local solution of the differential equation replacing M by Mt.
*/
c0 = clock();
{
const long K = prec->K;
padic_mat_struct *A;
gmde_solve(&A, K, p, prec->N3, prec->N3w, M, ctxFracQt);
gmde_convert_soln(C, &vC, A, K, p);
for(i = 0; i < K; i++)
padic_mat_clear(A + i);
free(A);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Local solution:\n");
printf(" Time for C = %f\n", c);
fflush(stdout);
}
c0 = clock();
{
const long K = (prec->K + (*p) - 1) / (*p);
mat_t Mt;
padic_mat_struct *Ainv;
mat_init(Mt, b, b, ctxFracQt);
mat_transpose(Mt, M, ctxFracQt);
mat_neg(Mt, Mt, ctxFracQt);
gmde_solve(&Ainv, K, p, prec->N3i, prec->N3iw, Mt, ctxFracQt);
gmde_convert_soln(Cinv, &vCinv, Ainv, K, p);
fmpz_poly_mat_transpose(Cinv, Cinv);
fmpz_poly_mat_compose_pow(Cinv, Cinv, *p);
for(i = 0; i < K; i++)
padic_mat_clear(Ainv + i);
free(Ainv);
mat_clear(Mt, ctxFracQt);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf(" Time for C^{-1} = %f\n", c);
printf("\n");
fflush(stdout);
}
/* Step 4 {F(t) := C(t) F(0) C(t^p)^{-1}} ********************************/
/*
Computes the product C(t) F(0) C(t^p)^{-1} modulo (p^{N_2}, t^K).
This is done by first computing the unit part of the product
exactly over the integers modulo t^K.
*/
c0 = clock();
{
fmpz_t pN;
fmpz_poly_mat_t T;
fmpz_init(pN);
fmpz_poly_mat_init(T, b, b);
for (i = 0; i < b; i++)
{
/* Find the unique k s.t. F0(i,k) is non-zero */
for (k = 0; k < b; k++)
if (!fmpz_is_zero(padic_mat_entry(F0, i, k)))
break;
if (k == b)
{
printf("Exception (frob). F0 is singular.\n\n");
abort();
}
for (j = 0; j < b; j++)
{
fmpz_poly_scalar_mul_fmpz(fmpz_poly_mat_entry(T, i, j),
fmpz_poly_mat_entry(Cinv, k, j),
padic_mat_entry(F0, i, k));
}
}
fmpz_poly_mat_mul(F, C, T);
fmpz_poly_mat_truncate(F, prec->K);
vF = vC + padic_mat_val(F0) + vCinv;
/* Canonicalise (F, vF) */
{
long v = fmpz_poly_mat_ord_p(F, p);
if (v == LONG_MAX)
{
printf("ERROR (deformation_frob). F(t) == 0.\n");
abort();
}
else if (v > 0)
{
fmpz_pow_ui(pN, p, v);
fmpz_poly_mat_scalar_divexact_fmpz(F, F, pN);
vF = vF + v;
}
}
/* Reduce (F, vF) modulo p^{N2} */
fmpz_pow_ui(pN, p, prec->N2 - vF);
fmpz_poly_mat_scalar_mod_fmpz(F, F, pN);
fmpz_clear(pN);
fmpz_poly_mat_clear(T);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Matrix for F(t):\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
/* Step 5 {G = r(t)^m F(t)} **********************************************/
c0 = clock();
{
fmpz_t pN;
fmpz_poly_t t;
fmpz_init(pN);
fmpz_poly_init(t);
fmpz_pow_ui(pN, p, prec->N2 - vF);
/* Compute r(t)^m mod p^{N2-vF} */
if (prec->denR == NULL)
{
fmpz_mod_poly_t _t;
fmpz_mod_poly_init(_t, pN);
fmpz_mod_poly_set_fmpz_poly(_t, r);
fmpz_mod_poly_pow(_t, _t, prec->m);
fmpz_mod_poly_get_fmpz_poly(t, _t);
fmpz_mod_poly_clear(_t);
}
else
{
/* TODO: We don't really need a copy */
fmpz_poly_set(t, prec->denR);
}
fmpz_poly_mat_scalar_mul_fmpz_poly(F, F, t);
fmpz_poly_mat_scalar_mod_fmpz(F, F, pN);
/* TODO: This should not be necessary? */
fmpz_poly_mat_truncate(F, prec->K);
fmpz_clear(pN);
fmpz_poly_clear(t);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Analytic continuation:\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
/* Steps 6 and 7 *********************************************************/
if (a == 1)
{
/* Step 6 {F(1) = r(t_1)^{-m} G(t_1)} ********************************/
c0 = clock();
{
const long N = prec->N2 - vF;
fmpz_t f, g, t, pN;
fmpz_init(f);
fmpz_init(g);
fmpz_init(t);
fmpz_init(pN);
fmpz_pow_ui(pN, p, N);
/* f := \hat{t_1}, g := r(\hat{t_1})^{-m} */
_padic_teichmuller(f, t1->coeffs + 0, p, N);
if (prec->denR == NULL)
{
_fmpz_mod_poly_evaluate_fmpz(g, r->coeffs, r->length, f, pN);
fmpz_powm_ui(t, g, prec->m, pN);
}
else
{
_fmpz_mod_poly_evaluate_fmpz(t, prec->denR->coeffs, prec->denR->length, f, pN);
}
_padic_inv(g, t, p, N);
/* F1 := g G(\hat{t_1}) */
for (i = 0; i < b; i++)
for (j = 0; j < b; j++)
{
const fmpz_poly_struct *poly = fmpz_poly_mat_entry(F, i, j);
const long len = poly->length;
if (len == 0)
{
fmpz_poly_zero(fmpz_poly_mat_entry(F1, i, j));
}
else
{
fmpz_poly_fit_length(fmpz_poly_mat_entry(F1, i, j), 1);
_fmpz_mod_poly_evaluate_fmpz(t, poly->coeffs, len, f, pN);
fmpz_mul(fmpz_poly_mat_entry(F1, i, j)->coeffs + 0, g, t);
fmpz_mod(fmpz_poly_mat_entry(F1, i, j)->coeffs + 0,
fmpz_poly_mat_entry(F1, i, j)->coeffs + 0, pN);
_fmpz_poly_set_length(fmpz_poly_mat_entry(F1, i, j), 1);
_fmpz_poly_normalise(fmpz_poly_mat_entry(F1, i, j));
}
}
vF1 = vF;
fmpz_poly_mat_canonicalise(F1, &vF1, p);
fmpz_clear(f);
fmpz_clear(g);
fmpz_clear(t);
fmpz_clear(pN);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Evaluation:\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
}
else
{
/* Step 6 {F(1) = r(t_1)^{-m} G(t_1)} ********************************/
c0 = clock();
{
const long N = prec->N2 - vF;
fmpz_t pN;
fmpz *f, *g, *t;
fmpz_init(pN);
f = _fmpz_vec_init(a);
g = _fmpz_vec_init(2 * a - 1);
t = _fmpz_vec_init(2 * a - 1);
fmpz_pow_ui(pN, p, N);
/* f := \hat{t_1}, g := r(\hat{t_1})^{-m} */
_qadic_teichmuller(f, t1->coeffs, t1->length, Qq->a, Qq->j, Qq->len, p, N);
if (prec->denR == NULL)
{
fmpz_t e;
fmpz_init_set_ui(e, prec->m);
_fmpz_mod_poly_compose_smod(g, r->coeffs, r->length, f, a,
Qq->a, Qq->j, Qq->len, pN);
_qadic_pow(t, g, a, e, Qq->a, Qq->j, Qq->len, pN);
fmpz_clear(e);
}
else
{
_fmpz_mod_poly_reduce(prec->denR->coeffs, prec->denR->length, Qq->a, Qq->j, Qq->len, pN);
_fmpz_poly_normalise(prec->denR);
_fmpz_mod_poly_compose_smod(t, prec->denR->coeffs, prec->denR->length, f, a,
Qq->a, Qq->j, Qq->len, pN);
}
_qadic_inv(g, t, a, Qq->a, Qq->j, Qq->len, p, N);
/* F1 := g G(\hat{t_1}) */
for (i = 0; i < b; i++)
for (j = 0; j < b; j++)
{
const fmpz_poly_struct *poly = fmpz_poly_mat_entry(F, i, j);
const long len = poly->length;
fmpz_poly_struct *poly2 = fmpz_poly_mat_entry(F1, i, j);
if (len == 0)
{
fmpz_poly_zero(poly2);
}
else
{
_fmpz_mod_poly_compose_smod(t, poly->coeffs, len, f, a,
Qq->a, Qq->j, Qq->len, pN);
fmpz_poly_fit_length(poly2, 2 * a - 1);
_fmpz_poly_mul(poly2->coeffs, g, a, t, a);
_fmpz_mod_poly_reduce(poly2->coeffs, 2 * a - 1, Qq->a, Qq->j, Qq->len, pN);
_fmpz_poly_set_length(poly2, a);
_fmpz_poly_normalise(poly2);
}
}
/* Now the matrix for p^{-1} F_p at t=t_1 is (F1, vF1). */
vF1 = vF;
fmpz_poly_mat_canonicalise(F1, &vF1, p);
fmpz_clear(pN);
_fmpz_vec_clear(f, a);
_fmpz_vec_clear(g, 2 * a - 1);
_fmpz_vec_clear(t, 2 * a - 1);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Evaluation:\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
/* Step 7 {Norm} *****************************************************/
/*
Computes the matrix for $q^{-1} F_q$ at $t = t_1$ as the
product $F \sigma(F) \dotsm \sigma^{a-1}(F)$ up appropriate
transpositions because our convention of columns vs rows is
the opposite of that used by Gerkmann.
Note that, in any case, transpositions do not affect
the characteristic polynomial.
*/
c0 = clock();
{
const long N = prec->N1 - a * vF1;
fmpz_t pN;
fmpz_poly_mat_t T;
fmpz_init(pN);
fmpz_poly_mat_init(T, b, b);
fmpz_pow_ui(pN, p, N);
fmpz_poly_mat_frobenius(T, F1, 1, p, N, Qq);
_qadic_mat_mul(F1, F1, T, pN, Qq);
for (i = 2; i < a; i++)
{
fmpz_poly_mat_frobenius(T, T, 1, p, N, Qq);
_qadic_mat_mul(F1, F1, T, pN, Qq);
}
vF1 = a * vF1;
fmpz_poly_mat_canonicalise(F1, &vF1, p);
fmpz_clear(pN);
fmpz_poly_mat_clear(T);
}
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Norm:\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
}
/* Step 8 {Reverse characteristic polynomial} ****************************/
c0 = clock();
deformation_revcharpoly(cp, F1, vF1, n, d, prec->N0, prec->r, prec->s, Qq);
c1 = clock();
c = (double) (c1 - c0) / CLOCKS_PER_SEC;
if (verbose)
{
printf("Reverse characteristic polynomial:\n");
printf(" p(T) = "), fmpz_poly_print_pretty(cp, "T"), printf("\n");
printf(" Time = %f\n", c);
printf("\n");
fflush(stdout);
}
/* Clean up **************************************************************/
padic_mat_clear(F0);
mat_clear(M, ctxFracQt);
free(bR);
free(bC);
fmpz_poly_clear(r);
fmpz_poly_mat_clear(C);
fmpz_poly_mat_clear(Cinv);
fmpz_poly_mat_clear(F);
fmpz_poly_mat_clear(F1);
fmpz_poly_clear(cp);
}
void eis_series(fmpz_poly_t *eis, ulong k, ulong prec)
{
ulong i, p, ee, p_pow, ind;
fmpz_t last, last_m1, mult, fp, t_coeff, term, term_m1;
long bern_fac[15] = {0, 0, 0, 0, 240, 0, -504, 0, 480, 0, -264, 0, 0, 0, -24};
// Now, we compute the eisenstein series
// First, compute primes by sieving.
// allocate memory for the array.
/*
char *primes;
primes = calloc(prec + 1, sizeof(char));
for(i = 0; i <= prec; i++) {
primes[i] = 1;
}
primes[0] = 0;
primes[1] = 0;
p = 2;
while(p*p <= prec) {
j = p*p;
while(j <= prec) {
primes[j] = 0;
j += p;
}
p += 1;
while(primes[p] != 1)
p += 1;
}
*/
// Now, create the eisenstein series.
// We build up each coefficient using the multiplicative properties of the
// divisor sum function.
fmpz_poly_set_coeff_si(*eis, 0, 1);
for(i = 1; i <= prec; i++)
fmpz_poly_set_coeff_si(*eis, i, bern_fac[k]);
fmpz_init(last);
fmpz_init(last_m1);
fmpz_init(mult);
fmpz_init(fp);
fmpz_init(t_coeff);
fmpz_init(term);
fmpz_init(term_m1);
ee = k - 1;
p = 2;
while(p <= prec) {
p_pow = p;
fmpz_set_ui(fp, p);
fmpz_pow_ui(mult, fp, ee);
fmpz_pow_ui(term, mult, 2);
fmpz_set(last, mult);
while(p_pow <= prec) {
ind = p_pow;
fmpz_sub_ui(term_m1, term, 1);
fmpz_sub_ui(last_m1, last, 1);
while(ind <= prec) {
fmpz_poly_get_coeff_fmpz(t_coeff, *eis, ind);
fmpz_mul(t_coeff, t_coeff, term_m1);
fmpz_divexact(t_coeff, t_coeff, last_m1);
fmpz_poly_set_coeff_fmpz(*eis, ind, t_coeff);
ind += p_pow;
}
p_pow *= p;
fmpz_set(last, term);
fmpz_mul(term, term, mult);
}
p = n_nextprime(p, 1);
}
fmpz_clear(last);
fmpz_clear(last_m1);
fmpz_clear(mult);
fmpz_clear(fp);
fmpz_clear(t_coeff);
fmpz_clear(term);
fmpz_clear(term_m1);
}
int main(int argc, char *argv[])
{
ulong r, s, p, prec, s_prec;
ulong i, m, lambda, char1, char2;
fmpz_poly_t eis, eta, eta_r;
fmpz_t p1, c1, c2, ss1, ss, pp, ppl, pplc;
// input r, s, and the precision desired
if (argc == 4) {
r = atol(argv[1]);
s = atol(argv[2]);
prec = atol(argv[3]);
prec = n_nextprime(prec, 1) - 1;
}
if (argc != 4) {
printf("usage: shimura_coeffs r s n\n");
return EXIT_FAILURE;
}
// Compute the weight of the form f_r_s
lambda = r / 2 + s;
//printf("%d\n", lambda);
// This is the necessary precision of the input
s_prec = (prec + r) * prec * r / 24;
//printf("Necessary precision: %d terms\n", s_prec);
// First compute eta
//printf("Computing eta\n");
fmpz_poly_init(eta);
eta_series(&eta, s_prec);
// Next compute eta^r
//printf("Computing eta^%d\n", r);
fmpz_poly_init(eta_r);
fmpz_poly_pow_trunc(eta_r, eta, r, s_prec);
fmpz_poly_clear(eta);
// Next compute E_s
//printf("Computing E_%d\n", s);
fmpz_poly_init(eis);
if(s != 0) {
eis_series(&eis, s, s_prec);
}
//printf("Computing coefficients\n");
// Instead of computing the product, we will compute each coefficient as
// needed. This is potentially slower, but saves memory.
//
fmpz_init(p1);
fmpz_init(c1);
fmpz_init(c2);
fmpz_init(ss);
fmpz_init(ss1);
// compute alpha(p^2*r)
p = 2;
m = r*p*p;
while(p <= prec) {
fmpz_set_ui(ss1, 0);
if(s != 0) {
for(i = r; i <= m; i += 24) {
if((m - i) % 24 == 0) {
fmpz_poly_get_coeff_fmpz(c1, eta_r, (i - r) / 24);
fmpz_poly_get_coeff_fmpz(c2, eis, (m - i) / 24);
fmpz_addmul(ss1, c1, c2);
}
}
}
else {
if((m - r) % 24 == 0)
fmpz_poly_get_coeff_fmpz(ss1, eta_r, (m - r) / 24);
}
/*
if(p == 199) {
fmpz_print(ss1);
printf("\n");
}
*/
// compute character X12(p)
char1 = n_jacobi(12, p);
// compute character ((-1)^(lambda) * n | p)
if(lambda % 2 == 0) {
char2 = n_jacobi(r, p);
}
else {
char2 = n_jacobi(-r, p);
}
// compute p^(lambda - 1)
fmpz_set_ui(pp, p);
fmpz_pow_ui(ppl, pp, lambda - 1);
fmpz_mul_si(pplc, ppl, char1*char2);
fmpz_add(ss, ss1, pplc);
printf("%d:\t", p);
fmpz_print(ss);
printf("\n");
p = n_nextprime(p, 1);
m = r*p*p;
}
fmpz_clear(p1);
fmpz_clear(c1);
fmpz_clear(c2);
fmpz_clear(ss);
fmpz_clear(ss1);
return EXIT_SUCCESS;
}
void
_fmpz_poly_resultant(fmpz_t res, const fmpz * poly1, long len1,
const fmpz * poly2, long len2)
{
if (len2 == 1)
{
fmpz_pow_ui(res, poly2, len1 - 1);
}
else
{
fmpz_t a, b, g, h, t;
fmpz *A, *B, *W;
const long alloc = len1 + len2;
long sgn = 1;
fmpz_init(a);
fmpz_init(b);
fmpz_init(g);
fmpz_init(h);
fmpz_init(t);
A = W = _fmpz_vec_init(alloc);
B = W + len1;
_fmpz_poly_content(a, poly1, len1);
_fmpz_poly_content(b, poly2, len2);
_fmpz_vec_scalar_divexact_fmpz(A, poly1, len1, a);
_fmpz_vec_scalar_divexact_fmpz(B, poly2, len2, b);
fmpz_set_ui(g, 1);
fmpz_set_ui(h, 1);
fmpz_pow_ui(a, a, len2 - 1);
fmpz_pow_ui(b, b, len1 - 1);
fmpz_mul(t, a, b);
do
{
const long d = len1 - len2;
if (!(len1 & 1L) & !(len2 & 1L))
sgn = -sgn;
_fmpz_poly_pseudo_rem_cohen(A, A, len1, B, len2);
for (len1--; len1 >= 0 && !A[len1]; len1--) ;
len1++;
if (len1 == 0)
{
fmpz_zero(res);
goto cleanup;
}
{
fmpz * T;
long len;
T = A, A = B, B = T;
len = len1, len1 = len2, len2 = len;
}
fmpz_pow_ui(a, h, d);
fmpz_mul(b, g, a);
_fmpz_vec_scalar_divexact_fmpz(B, B, len2, b);
fmpz_pow_ui(g, A + (len1 - 1), d);
fmpz_mul(b, h, g);
fmpz_divexact(h, b, a);
fmpz_set(g, A + (len1 - 1));
} while (len2 > 1);
fmpz_pow_ui(g, h, len1 - 1);
fmpz_pow_ui(b, B + (len2 - 1), len1 - 1);
fmpz_mul(a, h, b);
fmpz_divexact(h, a, g);
fmpz_mul(res, t, h);
if (sgn < 0)
fmpz_neg(res, res);
cleanup:
fmpz_clear(a);
fmpz_clear(b);
fmpz_clear(g);
fmpz_clear(h);
fmpz_clear(t);
_fmpz_vec_clear(W, alloc);
}
}
int main()
{
flint_rand_t state;
flint_printf("digits_round_inplace....");
fflush(stdout);
flint_randinit(state);
{
char s[30];
slong i, j, len, n;
mp_bitcnt_t shift;
fmpz_t inp, out, err, t;
arf_rnd_t rnd;
fmpz_init(inp);
fmpz_init(out);
fmpz_init(err);
fmpz_init(t);
for (i = 0; i < 100000 * arb_test_multiplier(); i++)
{
len = 1 + n_randint(state, 20);
n = 1 + n_randint(state, 20);
s[0] = (n_randint(state, 9) + '1');
for (j = 1; j < len; j++)
s[j] = (n_randint(state, 10) + '0');
s[len] = '\0';
fmpz_set_str(inp, s, 10);
switch (n_randint(state, 3))
{
case 0:
rnd = ARF_RND_DOWN;
break;
case 1:
rnd = ARF_RND_UP;
break;
default:
rnd = ARF_RND_NEAR;
break;
}
_arb_digits_round_inplace(s, &shift, err, n, rnd);
fmpz_set_str(out, s, 10);
fmpz_set_ui(t, 10);
fmpz_pow_ui(t, t, shift);
fmpz_mul(t, t, out);
fmpz_add(t, t, err);
if (!fmpz_equal(t, inp) || (rnd == ARF_RND_UP && fmpz_sgn(err) > 0))
{
flint_printf("FAIL!\n");
flint_printf("inp = "); fmpz_print(inp); flint_printf("\n\n");
flint_printf("shift = %wd\n\n", shift);
flint_printf("err = "); fmpz_print(err); flint_printf("\n\n");
flint_printf("out = "); fmpz_print(out); flint_printf("\n\n");
flint_printf(" t = "); fmpz_print(t); flint_printf("\n\n");
abort();
}
}
fmpz_clear(inp);
fmpz_clear(out);
fmpz_clear(err);
fmpz_clear(t);
}
flint_randclear(state);
flint_cleanup();
flint_printf("PASS\n");
return EXIT_SUCCESS;
}
