Testing latest pari + WASM + node.js... and it works?! Wow.
License: GPL3
ubuntu2004
/* Copyright (C) 2000 The PARI group.12This file is part of the PARI/GP package.34PARI/GP is free software; you can redistribute it and/or modify it under the5terms of the GNU General Public License as published by the Free Software6Foundation; either version 2 of the License, or (at your option) any later7version. It is distributed in the hope that it will be useful, but WITHOUT8ANY WARRANTY WHATSOEVER.910Check the License for details. You should have received a copy of it, along11with the package; see the file 'COPYING'. If not, write to the Free Software12Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */1314#include "pari.h"15#include "paripriv.h"1617#define DEBUGLEVEL DEBUGLEVEL_pol1819/*******************************************************************/20/* */21/* GENERIC */22/* */23/*******************************************************************/2425/* Return optimal parameter l for the evaluation of n/m polynomials of degree d26Fractional values can be used if the evaluations are done with different27accuracies, and thus have different weights.28*/29long30brent_kung_optpow(long d, long n, long m)31{32long p, r;33long pold=1, rold=n*(d-1);34for(p=2; p<=d; p++)35{36r = m*(p-1) + n*((d-1)/p);37if (r<rold) { pold=p; rold=r; }38}39return pold;40}4142static GEN43gen_RgXQ_eval_powers(GEN P, GEN V, long a, long n, void *E, const struct bb_algebra *ff,44GEN cmul(void *E, GEN P, long a, GEN x))45{46pari_sp av = avma;47long i;48GEN z = cmul(E,P,a,ff->one(E));49if (!z) z = gen_0;50for (i=1; i<=n; i++)51{52GEN t = cmul(E,P,a+i,gel(V,i+1));53if (t) {54z = ff->add(E, z, t);55if (gc_needed(av,2)) z = gerepileupto(av, z);56}57}58return ff->red(E,z);59}6061/* Brent & Kung62* (Fast algorithms for manipulating formal power series, JACM 25:581-595, 1978)63*64* V as output by FpXQ_powers(x,l,T,p). For optimal performance, l is as given65* by brent_kung_optpow */66GEN67gen_bkeval_powers(GEN P, long d, GEN V, void *E, const struct bb_algebra *ff,68GEN cmul(void *E, GEN P, long a, GEN x))69{70pari_sp av = avma;71long l = lg(V)-1;72GEN z, u;7374if (d < 0) return ff->zero(E);75if (d < l) return gerepileupto(av, gen_RgXQ_eval_powers(P,V,0,d,E,ff,cmul));76if (l<2) pari_err_DOMAIN("gen_RgX_bkeval_powers", "#powers", "<",gen_2,V);77if (DEBUGLEVEL>=8)78{79long cnt = 1 + (d - l) / (l-1);80err_printf("RgX_RgXQV_eval(%ld/%ld): %ld RgXQ_mul\n", d, l-1, cnt);81}82d -= l;83z = gen_RgXQ_eval_powers(P,V,d+1,l-1,E,ff,cmul);84while (d >= l-1)85{86d -= l-1;87u = gen_RgXQ_eval_powers(P,V,d+1,l-2,E,ff,cmul);88z = ff->add(E,u, ff->mul(E,z,gel(V,l)));89if (gc_needed(av,2))90z = gerepileupto(av, z);91}92u = gen_RgXQ_eval_powers(P,V,0,d,E,ff,cmul);93z = ff->add(E,u, ff->mul(E,z,gel(V,d+2)));94return gerepileupto(av, ff->red(E,z));95}9697GEN98gen_bkeval(GEN Q, long d, GEN x, int use_sqr, void *E, const struct bb_algebra *ff,99GEN cmul(void *E, GEN P, long a, GEN x))100{101pari_sp av = avma;102GEN z, V;103long rtd;104if (d < 0) return ff->zero(E);105rtd = (long) sqrt((double)d);106V = gen_powers(x,rtd,use_sqr,E,ff->sqr,ff->mul,ff->one);107z = gen_bkeval_powers(Q, d, V, E, ff, cmul);108return gerepileupto(av, z);109}110111static GEN112_gen_nored(void *E, GEN x) { (void)E; return x; }113static GEN114_gen_add(void *E, GEN x, GEN y) { (void)E; return gadd(x, y); }115static GEN116_gen_sub(void *E, GEN x, GEN y) { (void)E; return gsub(x, y); }117static GEN118_gen_mul(void *E, GEN x, GEN y) { (void)E; return gmul(x, y); }119static GEN120_gen_sqr(void *E, GEN x) { (void)E; return gsqr(x); }121static GEN122_gen_one(void *E) { (void)E; return gen_1; }123static GEN124_gen_zero(void *E) { (void)E; return gen_0; }125126static struct bb_algebra Rg_algebra = { _gen_nored, _gen_add, _gen_sub,127_gen_mul, _gen_sqr,_gen_one,_gen_zero };128129static GEN130_gen_cmul(void *E, GEN P, long a, GEN x)131{(void)E; return gmul(gel(P,a+2), x);}132133GEN134RgX_RgV_eval(GEN Q, GEN x)135{136return gen_bkeval_powers(Q, degpol(Q), x, NULL, &Rg_algebra, _gen_cmul);137}138139GEN140RgX_Rg_eval_bk(GEN Q, GEN x)141{142return gen_bkeval(Q, degpol(Q), x, 1, NULL, &Rg_algebra, _gen_cmul);143}144145GEN146RgXV_RgV_eval(GEN Q, GEN x)147{148long i, l = lg(Q), vQ = gvar(Q);149GEN v = cgetg(l, t_VEC);150for (i = 1; i < l; i++)151{152GEN Qi = gel(Q, i);153gel(v, i) = typ(Qi)==t_POL && varn(Qi)==vQ? RgX_RgV_eval(Qi, x): gcopy(Qi);154}155return v;156}157158GEN159RgX_homogenous_evalpow(GEN P, GEN A, GEN B)160{161pari_sp av = avma;162long d, i;163GEN s;164if (typ(P)!=t_POL)165return mkvec2(P, gen_1);166d = degpol(P);167s = gel(P, d+2);168for (i = d-1; i >= 0; i--)169{170s = gadd(gmul(s, A), gmul(gel(B,d+1-i), gel(P,i+2)));171if (gc_needed(av,1))172{173if(DEBUGMEM>1) pari_warn(warnmem,"RgX_homogenous_eval(%ld)",i);174s = gerepileupto(av, s);175}176}177s = gerepileupto(av, s);178return mkvec2(s, gel(B,d+1));179}180181GEN182QXQX_homogenous_evalpow(GEN P, GEN A, GEN B, GEN T)183{184pari_sp av = avma;185long i, d = degpol(P), v = varn(A);186GEN s;187if (signe(P)==0) return mkvec2(pol_0(v), pol_1(v));188s = scalarpol_shallow(gel(P, d+2), v);189for (i = d-1; i >= 0; i--)190{191GEN c = gel(P,i+2), b = gel(B,d+1-i);192s = RgX_add(QXQX_mul(s, A, T), typ(c)==t_POL ? QXQX_QXQ_mul(b, c, T): gmul(b, c));193if (gc_needed(av,1))194{195if(DEBUGMEM>1) pari_warn(warnmem,"QXQX_homogenous_eval(%ld)",i);196s = gerepileupto(av, s);197}198}199s = gerepileupto(av, s);200return mkvec2(s, gel(B,d+1));201}202203const struct bb_algebra *204get_Rg_algebra(void)205{206return &Rg_algebra;207}208209static struct bb_ring Rg_ring = { _gen_add, _gen_mul, _gen_sqr };210211static GEN212_RgX_divrem(void *E, GEN x, GEN y, GEN *r)213{214(void) E;215return RgX_divrem(x, y, r);216}217218GEN219RgX_digits(GEN x, GEN T)220{221pari_sp av = avma;222long d = degpol(T), n = (lgpol(x)+d-1)/d;223GEN z = gen_digits(x,T,n,NULL, &Rg_ring, _RgX_divrem);224return gerepileupto(av, z);225}226227/*******************************************************************/228/* */229/* RgX */230/* */231/*******************************************************************/232233long234RgX_equal(GEN x, GEN y)235{236long i = lg(x);237238if (i != lg(y)) return 0;239for (i--; i > 1; i--)240if (!gequal(gel(x,i),gel(y,i))) return 0;241return 1;242}243244/* Returns 1 in the base ring over which x is defined */245/* HACK: this also works for t_SER */246GEN247Rg_get_1(GEN x)248{249GEN p, T;250long i, lx, tx = Rg_type(x, &p, &T, &lx);251if (RgX_type_is_composite(tx))252RgX_type_decode(tx, &i /*junk*/, &tx);253switch(tx)254{255case t_INTMOD: retmkintmod(is_pm1(p)? gen_0: gen_1, icopy(p));256case t_PADIC: return cvtop(gen_1, p, lx);257case t_FFELT: return FF_1(T);258default: return gen_1;259}260}261/* Returns 0 in the base ring over which x is defined */262/* HACK: this also works for t_SER */263GEN264Rg_get_0(GEN x)265{266GEN p, T;267long i, lx, tx = Rg_type(x, &p, &T, &lx);268if (RgX_type_is_composite(tx))269RgX_type_decode(tx, &i /*junk*/, &tx);270switch(tx)271{272case t_INTMOD: retmkintmod(gen_0, icopy(p));273case t_PADIC: return zeropadic(p, lx);274case t_FFELT: return FF_zero(T);275default: return gen_0;276}277}278279GEN280QX_ZXQV_eval(GEN P, GEN V, GEN dV)281{282long i, n = degpol(P);283GEN z, dz, dP;284if (n < 0) return gen_0;285P = Q_remove_denom(P, &dP);286z = gel(P,2); if (n == 0) return icopy(z);287if (dV) z = mulii(dV, z); /* V[1] = dV */288z = ZX_Z_add_shallow(ZX_Z_mul(gel(V,2),gel(P,3)), z);289for (i=2; i<=n; i++) z = ZX_add(ZX_Z_mul(gel(V,i+1),gel(P,2+i)), z);290dz = mul_denom(dP, dV);291return dz? RgX_Rg_div(z, dz): z;292}293294/* Return P(h * x), not memory clean */295GEN296RgX_unscale(GEN P, GEN h)297{298long i, l = lg(P);299GEN hi = gen_1, Q = cgetg(l, t_POL);300Q[1] = P[1];301if (l == 2) return Q;302gel(Q,2) = gcopy(gel(P,2));303for (i=3; i<l; i++)304{305hi = gmul(hi,h);306gel(Q,i) = gmul(gel(P,i), hi);307}308return Q;309}310/* P a ZX, Return P(h * x), not memory clean; optimize for h = -1 */311GEN312ZX_z_unscale(GEN P, long h)313{314long i, l = lg(P);315GEN Q = cgetg(l, t_POL);316Q[1] = P[1];317if (l == 2) return Q;318gel(Q,2) = gel(P,2);319if (l == 3) return Q;320if (h == -1)321for (i = 3; i < l; i++)322{323gel(Q,i) = negi(gel(P,i));324if (++i == l) break;325gel(Q,i) = gel(P,i);326}327else328{329GEN hi;330gel(Q,3) = mulis(gel(P,3), h);331hi = sqrs(h);332for (i = 4; i < l; i++)333{334gel(Q,i) = mulii(gel(P,i), hi);335if (i != l-1) hi = mulis(hi,h);336}337}338return Q;339}340/* P a ZX, h a t_INT. Return P(h * x), not memory clean; optimize for h = -1 */341GEN342ZX_unscale(GEN P, GEN h)343{344long i, l;345GEN Q, hi;346i = itos_or_0(h); if (i) return ZX_z_unscale(P, i);347l = lg(P); Q = cgetg(l, t_POL);348Q[1] = P[1];349if (l == 2) return Q;350gel(Q,2) = gel(P,2);351if (l == 3) return Q;352hi = h;353gel(Q,3) = mulii(gel(P,3), hi);354for (i = 4; i < l; i++)355{356hi = mulii(hi,h);357gel(Q,i) = mulii(gel(P,i), hi);358}359return Q;360}361/* P a ZX. Return P(x << n), not memory clean */362GEN363ZX_unscale2n(GEN P, long n)364{365long i, ni = n, l = lg(P);366GEN Q = cgetg(l, t_POL);367Q[1] = P[1];368if (l == 2) return Q;369gel(Q,2) = gel(P,2);370if (l == 3) return Q;371gel(Q,3) = shifti(gel(P,3), ni);372for (i=4; i<l; i++)373{374ni += n;375gel(Q,i) = shifti(gel(P,i), ni);376}377return Q;378}379/* P(h*X) / h, assuming h | P(0), i.e. the result is a ZX */380GEN381ZX_unscale_div(GEN P, GEN h)382{383long i, l = lg(P);384GEN hi, Q = cgetg(l, t_POL);385Q[1] = P[1];386if (l == 2) return Q;387gel(Q,2) = diviiexact(gel(P,2), h);388if (l == 3) return Q;389gel(Q,3) = gel(P,3);390if (l == 4) return Q;391hi = h;392gel(Q,4) = mulii(gel(P,4), hi);393for (i=5; i<l; i++)394{395hi = mulii(hi,h);396gel(Q,i) = mulii(gel(P,i), hi);397}398return Q;399}400401GEN402RgXV_unscale(GEN v, GEN h)403{404long i, l;405GEN w;406if (!h || isint1(h)) return v;407w = cgetg_copy(v, &l);408for (i=1; i<l; i++) gel(w,i) = RgX_unscale(gel(v,i), h);409return w;410}411412/* Return h^degpol(P) P(x / h), not memory clean */413GEN414RgX_rescale(GEN P, GEN h)415{416long i, l = lg(P);417GEN Q = cgetg(l,t_POL), hi = h;418gel(Q,l-1) = gel(P,l-1);419for (i=l-2; i>=2; i--)420{421gel(Q,i) = gmul(gel(P,i), hi);422if (i == 2) break;423hi = gmul(hi,h);424}425Q[1] = P[1]; return Q;426}427428/* A(X^d) --> A(X) */429GEN430RgX_deflate(GEN x0, long d)431{432GEN z, y, x;433long i,id, dy, dx = degpol(x0);434if (d == 1 || dx <= 0) return leafcopy(x0);435dy = dx/d;436y = cgetg(dy+3, t_POL); y[1] = x0[1];437z = y + 2;438x = x0+ 2;439for (i=id=0; i<=dy; i++,id+=d) gel(z,i) = gel(x,id);440return y;441}442443/* F a t_RFRAC */444long445rfrac_deflate_order(GEN F)446{447GEN N = gel(F,1), D = gel(F,2);448long m = (degpol(D) <= 0)? 0: RgX_deflate_order(D);449if (m == 1) return 1;450if (typ(N) == t_POL && varn(N) == varn(D))451m = cgcd(m, RgX_deflate_order(N));452return m;453}454/* F a t_RFRAC */455GEN456rfrac_deflate_max(GEN F, long *m)457{458*m = rfrac_deflate_order(F);459return rfrac_deflate(F, *m);460}461/* F a t_RFRAC */462GEN463rfrac_deflate(GEN F, long m)464{465GEN N = gel(F,1), D = gel(F,2);466if (m == 1) return F;467if (typ(N) == t_POL && varn(N) == varn(D)) N = RgX_deflate(N, m);468D = RgX_deflate(D, m); return mkrfrac(N, D);469}470471/* return x0(X^d) */472GEN473RgX_inflate(GEN x0, long d)474{475long i, id, dy, dx = degpol(x0);476GEN x = x0 + 2, z, y;477if (dx <= 0) return leafcopy(x0);478dy = dx*d;479y = cgetg(dy+3, t_POL); y[1] = x0[1];480z = y + 2;481for (i=0; i<=dy; i++) gel(z,i) = gen_0;482for (i=id=0; i<=dx; i++,id+=d) gel(z,id) = gel(x,i);483return y;484}485486/* return P(X + c) using destructive Horner, optimize for c = 1,-1 */487static GEN488RgX_translate_basecase(GEN P, GEN c)489{490pari_sp av = avma;491GEN Q, R;492long i, k, n;493494if (!signe(P) || gequal0(c)) return RgX_copy(P);495Q = leafcopy(P);496R = Q+2; n = degpol(P);497if (isint1(c))498{499for (i=1; i<=n; i++)500{501for (k=n-i; k<n; k++) gel(R,k) = gadd(gel(R,k), gel(R,k+1));502if (gc_needed(av,2))503{504if(DEBUGMEM>1) pari_warn(warnmem,"RgX_translate(1), i = %ld/%ld", i,n);505Q = gerepilecopy(av, Q); R = Q+2;506}507}508}509else if (isintm1(c))510{511for (i=1; i<=n; i++)512{513for (k=n-i; k<n; k++) gel(R,k) = gsub(gel(R,k), gel(R,k+1));514if (gc_needed(av,2))515{516if(DEBUGMEM>1) pari_warn(warnmem,"RgX_translate(-1), i = %ld/%ld", i,n);517Q = gerepilecopy(av, Q); R = Q+2;518}519}520}521else522{523for (i=1; i<=n; i++)524{525for (k=n-i; k<n; k++) gel(R,k) = gadd(gel(R,k), gmul(c, gel(R,k+1)));526if (gc_needed(av,2))527{528if(DEBUGMEM>1) pari_warn(warnmem,"RgX_translate, i = %ld/%ld", i,n);529Q = gerepilecopy(av, Q); R = Q+2;530}531}532}533return gerepilecopy(av, Q);534}535GEN536RgX_translate(GEN P, GEN c)537{538pari_sp av = avma;539long n = degpol(P);540if (n < 40)541return RgX_translate_basecase(P, c);542else543{544long d = n >> 1;545GEN Q = RgX_translate(RgX_shift_shallow(P, -d), c);546GEN R = RgX_translate(RgXn_red_shallow(P, d), c);547GEN S = gpowgs(deg1pol_shallow(gen_1, c, varn(P)), d);548return gerepileupto(av, RgX_add(RgX_mul(Q, S), R));549}550}551552/* return lift( P(X + c) ) using Horner, c in R[y]/(T) */553GEN554RgXQX_translate(GEN P, GEN c, GEN T)555{556pari_sp av = avma;557GEN Q, R;558long i, k, n;559560if (!signe(P) || gequal0(c)) return RgX_copy(P);561Q = leafcopy(P);562R = Q+2; n = degpol(P);563for (i=1; i<=n; i++)564{565for (k=n-i; k<n; k++)566{567pari_sp av2 = avma;568gel(R,k) = gerepileupto(av2,569RgX_rem(gadd(gel(R,k), gmul(c, gel(R,k+1))), T));570}571if (gc_needed(av,2))572{573if(DEBUGMEM>1) pari_warn(warnmem,"RgXQX_translate, i = %ld/%ld", i,n);574Q = gerepilecopy(av, Q); R = Q+2;575}576}577return gerepilecopy(av, Q);578}579580/********************************************************************/581/** **/582/** CONVERSIONS **/583/** (not memory clean) **/584/** **/585/********************************************************************/586/* to INT / FRAC / (POLMOD mod T), not memory clean because T not copied,587* but everything else is */588static GEN589QXQ_to_mod(GEN x, GEN T)590{591long d;592switch(typ(x))593{594case t_INT: return icopy(x);595case t_FRAC: return gcopy(x);596case t_POL:597d = degpol(x);598if (d < 0) return gen_0;599if (d == 0) return gcopy(gel(x,2));600return mkpolmod(RgX_copy(x), T);601default: pari_err_TYPE("QXQ_to_mod",x);602return NULL;/* LCOV_EXCL_LINE */603}604}605/* pure shallow version */606GEN607QXQ_to_mod_shallow(GEN x, GEN T)608{609long d;610switch(typ(x))611{612case t_INT:613case t_FRAC: return x;614case t_POL:615d = degpol(x);616if (d < 0) return gen_0;617if (d == 0) return gel(x,2);618return mkpolmod(x, T);619default: pari_err_TYPE("QXQ_to_mod",x);620return NULL;/* LCOV_EXCL_LINE */621}622}623/* T a ZX, z lifted from (Q[Y]/(T(Y)))[X], apply QXQ_to_mod to all coeffs.624* Not memory clean because T not copied, but everything else is */625static GEN626QXQX_to_mod(GEN z, GEN T)627{628long i,l = lg(z);629GEN x = cgetg(l,t_POL);630for (i=2; i<l; i++) gel(x,i) = QXQ_to_mod(gel(z,i), T);631x[1] = z[1]; return normalizepol_lg(x,l);632}633/* pure shallow version */634GEN635QXQX_to_mod_shallow(GEN z, GEN T)636{637long i,l = lg(z);638GEN x = cgetg(l,t_POL);639for (i=2; i<l; i++) gel(x,i) = QXQ_to_mod_shallow(gel(z,i), T);640x[1] = z[1]; return normalizepol_lg(x,l);641}642/* Apply QXQX_to_mod to all entries. Memory-clean ! */643GEN644QXQXV_to_mod(GEN V, GEN T)645{646long i, l = lg(V);647GEN z = cgetg(l, t_VEC); T = ZX_copy(T);648for (i=1;i<l; i++) gel(z,i) = QXQX_to_mod(gel(V,i), T);649return z;650}651/* Apply QXQ_to_mod to all entries. Memory-clean ! */652GEN653QXQV_to_mod(GEN V, GEN T)654{655long i, l = lg(V);656GEN z = cgetg(l, t_VEC); T = ZX_copy(T);657for (i=1;i<l; i++) gel(z,i) = QXQ_to_mod(gel(V,i), T);658return z;659}660661/* Apply QXQ_to_mod to all entries. Memory-clean ! */662GEN663QXQC_to_mod_shallow(GEN V, GEN T)664{665long i, l = lg(V);666GEN z = cgetg(l, t_COL);667for (i=1;i<l; i++) gel(z,i) = QXQ_to_mod_shallow(gel(V,i), T);668return z;669}670671GEN672QXQM_to_mod_shallow(GEN V, GEN T)673{674long i, l = lg(V);675GEN z = cgetg(l, t_MAT);676for (i=1; i<l; i++) gel(z,i) = QXQC_to_mod_shallow(gel(V,i), T);677return z;678}679680GEN681RgX_renormalize_lg(GEN x, long lx)682{683long i;684for (i = lx-1; i>1; i--)685if (! gequal0(gel(x,i))) break; /* _not_ isexactzero */686stackdummy((pari_sp)(x + lg(x)), (pari_sp)(x + i+1));687setlg(x, i+1); setsigne(x, i != 1); return x;688}689690GEN691RgV_to_RgX(GEN x, long v)692{693long i, k = lg(x);694GEN p;695696while (--k && gequal0(gel(x,k)));697if (!k) return pol_0(v);698i = k+2; p = cgetg(i,t_POL);699p[1] = evalsigne(1) | evalvarn(v);700x--; for (k=2; k<i; k++) gel(p,k) = gel(x,k);701return p;702}703GEN704RgV_to_RgX_reverse(GEN x, long v)705{706long j, k, l = lg(x);707GEN p;708709for (k = 1; k < l; k++)710if (!gequal0(gel(x,k))) break;711if (k == l) return pol_0(v);712k -= 1;713l -= k;714x += k;715p = cgetg(l+1,t_POL);716p[1] = evalsigne(1) | evalvarn(v);717for (j=2, k=l; j<=l; j++) gel(p,j) = gel(x,--k);718return p;719}720721/* return the (N-dimensional) vector of coeffs of p */722GEN723RgX_to_RgC(GEN x, long N)724{725long i, l;726GEN z;727l = lg(x)-1; x++;728if (l > N+1) l = N+1; /* truncate higher degree terms */729z = cgetg(N+1,t_COL);730for (i=1; i<l ; i++) gel(z,i) = gel(x,i);731for ( ; i<=N; i++) gel(z,i) = gen_0;732return z;733}734GEN735Rg_to_RgC(GEN x, long N)736{737return (typ(x) == t_POL)? RgX_to_RgC(x,N): scalarcol_shallow(x, N);738}739740/* vector of polynomials (in v) whose coefs are given by the columns of x */741GEN742RgM_to_RgXV(GEN x, long v)743{ pari_APPLY_type(t_VEC, RgV_to_RgX(gel(x,i), v)) }744GEN745RgM_to_RgXV_reverse(GEN x, long v)746{ pari_APPLY_type(t_VEC, RgV_to_RgX_reverse(gel(x,i), v)) }747748/* matrix whose entries are given by the coeffs of the polynomials in749* vector v (considered as degree n-1 polynomials) */750GEN751RgV_to_RgM(GEN x, long n)752{ pari_APPLY_type(t_MAT, Rg_to_RgC(gel(x,i), n)) }753754GEN755RgXV_to_RgM(GEN x, long n)756{ pari_APPLY_type(t_MAT, RgX_to_RgC(gel(x,i), n)) }757758/* polynomial (in v) of polynomials (in w) whose coeffs are given by the columns of x */759GEN760RgM_to_RgXX(GEN x, long v,long w)761{762long j, lx = lg(x);763GEN y = cgetg(lx+1, t_POL);764y[1] = evalsigne(1) | evalvarn(v);765y++;766for (j=1; j<lx; j++) gel(y,j) = RgV_to_RgX(gel(x,j), w);767return normalizepol_lg(--y, lx+1);768}769770/* matrix whose entries are given by the coeffs of the polynomial v in771* two variables (considered as degree n-1 polynomials) */772GEN773RgXX_to_RgM(GEN v, long n)774{775long j, N = lg(v)-1;776GEN y = cgetg(N, t_MAT);777for (j=1; j<N; j++) gel(y,j) = Rg_to_RgC(gel(v,j+1), n);778return y;779}780781/* P(X,Y) --> P(Y,X), n is an upper bound for deg_Y(P) */782GEN783RgXY_swapspec(GEN x, long n, long w, long nx)784{785long j, ly = n+3;786GEN y = cgetg(ly, t_POL);787y[1] = evalsigne(1);788for (j=2; j<ly; j++)789{790long k;791GEN a = cgetg(nx+2,t_POL);792a[1] = evalsigne(1) | evalvarn(w);793for (k=0; k<nx; k++)794{795GEN xk = gel(x,k);796if (typ(xk)==t_POL)797gel(a,k+2) = j<lg(xk)? gel(xk,j): gen_0;798else799gel(a,k+2) = j==2 ? xk: gen_0;800}801gel(y,j) = normalizepol_lg(a, nx+2);802}803return normalizepol_lg(y,ly);804}805806/* P(X,Y) --> P(Y,X), n is an upper bound for deg_Y(P) */807GEN808RgXY_swap(GEN x, long n, long w)809{810GEN z = RgXY_swapspec(x+2, n, w, lgpol(x));811setvarn(z, varn(x)); return z;812}813814long815RgXY_degreex(GEN b)816{817long deg = 0, i;818if (!signe(b)) return -1;819for (i = 2; i < lg(b); ++i)820{821GEN bi = gel(b, i);822if (typ(bi) == t_POL)823deg = maxss(deg, degpol(bi));824}825return deg;826}827828GEN829RgXY_derivx(GEN x)830{831long i,lx;832GEN y = cgetg_copy(x,&lx);833for (i=2; i<lx ; i++)834gel(y,i) = RgX_deriv(gel(x,i));835y[1] = x[1]; return normalizepol_lg(y,i);836}837838/* return (x % X^n). Shallow */839GEN840RgXn_red_shallow(GEN a, long n)841{842long i, L = n+2, l = lg(a);843GEN b;844if (L >= l) return a; /* deg(x) < n */845b = cgetg(L, t_POL); b[1] = a[1];846for (i=2; i<L; i++) gel(b,i) = gel(a,i);847return normalizepol_lg(b,L);848}849850GEN851RgXnV_red_shallow(GEN x, long n)852{ pari_APPLY_type(t_VEC, RgXn_red_shallow(gel(x,i), n)) }853854/* return (x * X^n). Shallow */855GEN856RgX_shift_shallow(GEN a, long n)857{858long i, l = lg(a);859GEN b;860if (l == 2 || !n) return a;861l += n;862if (n < 0)863{864if (l <= 2) return pol_0(varn(a));865b = cgetg(l, t_POL); b[1] = a[1];866a -= n;867for (i=2; i<l; i++) gel(b,i) = gel(a,i);868} else {869b = cgetg(l, t_POL); b[1] = a[1];870a -= n; n += 2;871for (i=2; i<n; i++) gel(b,i) = gen_0;872for ( ; i<l; i++) gel(b,i) = gel(a,i);873}874return b;875}876/* return (x * X^n). */877GEN878RgX_shift(GEN a, long n)879{880long i, l = lg(a);881GEN b;882if (l == 2 || !n) return RgX_copy(a);883l += n;884if (n < 0)885{886if (l <= 2) return pol_0(varn(a));887b = cgetg(l, t_POL); b[1] = a[1];888a -= n;889for (i=2; i<l; i++) gel(b,i) = gcopy(gel(a,i));890} else {891b = cgetg(l, t_POL); b[1] = a[1];892a -= n; n += 2;893for (i=2; i<n; i++) gel(b,i) = gen_0;894for ( ; i<l; i++) gel(b,i) = gcopy(gel(a,i));895}896return b;897}898899GEN900RgX_rotate_shallow(GEN P, long k, long p)901{902long i, l = lgpol(P);903GEN r;904if (signe(P)==0)905return pol_0(varn(P));906r = cgetg(p+2,t_POL); r[1] = P[1];907for(i=0; i<p; i++)908{909long s = 2+(i+k)%p;910gel(r,s) = i<l? gel(P,2+i): gen_0;911}912return RgX_renormalize(r);913}914915GEN916RgX_mulXn(GEN x, long d)917{918pari_sp av;919GEN z;920long v;921if (d >= 0) return RgX_shift(x, d);922d = -d;923v = RgX_val(x);924if (v >= d) return RgX_shift(x, -d);925av = avma;926z = gred_rfrac_simple(RgX_shift_shallow(x, -v), pol_xn(d - v, varn(x)));927return gerepileupto(av, z);928}929930long931RgXV_maxdegree(GEN x)932{933long d = -1, i, l = lg(x);934for (i = 1; i < l; i++)935d = maxss(d, degpol(gel(x,i)));936return d;937}938939long940RgX_val(GEN x)941{942long i, lx = lg(x);943if (lx == 2) return LONG_MAX;944for (i = 2; i < lx; i++)945if (!isexactzero(gel(x,i))) break;946if (i == lx) return LONG_MAX;/* possible with nonrational zeros */947return i - 2;948}949long950RgX_valrem(GEN x, GEN *Z)951{952long v, i, lx = lg(x);953if (lx == 2) { *Z = pol_0(varn(x)); return LONG_MAX; }954for (i = 2; i < lx; i++)955if (!isexactzero(gel(x,i))) break;956/* possible with nonrational zeros */957if (i == lx) { *Z = pol_0(varn(x)); return LONG_MAX; }958v = i - 2;959*Z = RgX_shift_shallow(x, -v);960return v;961}962long963RgX_valrem_inexact(GEN x, GEN *Z)964{965long v;966if (!signe(x)) { if (Z) *Z = pol_0(varn(x)); return LONG_MAX; }967for (v = 0;; v++)968if (!gequal0(gel(x,2+v))) break;969if (Z) *Z = RgX_shift_shallow(x, -v);970return v;971}972973GEN974RgXQC_red(GEN x, GEN T)975{ pari_APPLY_type(t_COL, grem(gel(x,i), T)) }976977GEN978RgXQV_red(GEN x, GEN T)979{ pari_APPLY_type(t_VEC, grem(gel(x,i), T)) }980981GEN982RgXQM_red(GEN x, GEN T)983{ pari_APPLY_same(RgXQC_red(gel(x,i), T)) }984985GEN986RgXQM_mul(GEN P, GEN Q, GEN T)987{988return RgXQM_red(RgM_mul(P, Q), T);989}990991GEN992RgXQX_red(GEN P, GEN T)993{994long i, l = lg(P);995GEN Q = cgetg(l, t_POL);996Q[1] = P[1];997for (i=2; i<l; i++) gel(Q,i) = grem(gel(P,i), T);998return normalizepol_lg(Q, l);999}10001001GEN1002RgX_deriv(GEN x)1003{1004long i,lx = lg(x)-1;1005GEN y;10061007if (lx<3) return pol_0(varn(x));1008y = cgetg(lx,t_POL); gel(y,2) = gcopy(gel(x,3));1009for (i=3; i<lx ; i++) gel(y,i) = gmulsg(i-1,gel(x,i+1));1010y[1] = x[1]; return normalizepol_lg(y,i);1011}10121013GEN1014RgX_recipspec_shallow(GEN x, long l, long n)1015{1016long i;1017GEN z = cgetg(n+2,t_POL);1018z[1] = 0; z += 2;1019for(i=0; i<l; i++) gel(z,n-i-1) = gel(x,i);1020for( ; i<n; i++) gel(z, n-i-1) = gen_0;1021return normalizepol_lg(z-2,n+2);1022}10231024GEN1025RgXn_recip_shallow(GEN P, long n)1026{1027GEN Q = RgX_recipspec_shallow(P+2, lgpol(P), n);1028setvarn(Q, varn(P));1029return Q;1030}10311032/* return coefficients s.t x = x_0 X^n + ... + x_n */1033GEN1034RgX_recip(GEN x)1035{1036long lx, i, j;1037GEN y = cgetg_copy(x, &lx);1038y[1] = x[1]; for (i=2,j=lx-1; i<lx; i++,j--) gel(y,i) = gcopy(gel(x,j));1039return normalizepol_lg(y,lx);1040}1041/* shallow version */1042GEN1043RgX_recip_shallow(GEN x)1044{1045long lx, i, j;1046GEN y = cgetg_copy(x, &lx);1047y[1] = x[1]; for (i=2,j=lx-1; i<lx; i++,j--) gel(y,i) = gel(x,j);1048return normalizepol_lg(y,lx);1049}10501051GEN1052RgX_recip_i(GEN x)1053{1054long lx, i, j;1055GEN y = cgetg_copy(x, &lx);1056y[1] = x[1]; for (i=2,j=lx-1; i<lx; i++,j--) gel(y,i) = gel(x,j);1057return y;1058}1059/*******************************************************************/1060/* */1061/* ADDITION / SUBTRACTION */1062/* */1063/*******************************************************************/1064/* same variable */1065GEN1066RgX_add(GEN x, GEN y)1067{1068long i, lx = lg(x), ly = lg(y);1069GEN z;1070if (ly <= lx) {1071z = cgetg(lx,t_POL); z[1] = x[1];1072for (i=2; i < ly; i++) gel(z,i) = gadd(gel(x,i),gel(y,i));1073for ( ; i < lx; i++) gel(z,i) = gcopy(gel(x,i));1074z = normalizepol_lg(z, lx);1075} else {1076z = cgetg(ly,t_POL); z[1] = y[1];1077for (i=2; i < lx; i++) gel(z,i) = gadd(gel(x,i),gel(y,i));1078for ( ; i < ly; i++) gel(z,i) = gcopy(gel(y,i));1079z = normalizepol_lg(z, ly);1080}1081return z;1082}1083GEN1084RgX_sub(GEN x, GEN y)1085{1086long i, lx = lg(x), ly = lg(y);1087GEN z;1088if (ly <= lx) {1089z = cgetg(lx,t_POL); z[1] = x[1];1090for (i=2; i < ly; i++) gel(z,i) = gsub(gel(x,i),gel(y,i));1091for ( ; i < lx; i++) gel(z,i) = gcopy(gel(x,i));1092z = normalizepol_lg(z, lx);1093} else {1094z = cgetg(ly,t_POL); z[1] = y[1];1095for (i=2; i < lx; i++) gel(z,i) = gsub(gel(x,i),gel(y,i));1096for ( ; i < ly; i++) gel(z,i) = gneg(gel(y,i));1097z = normalizepol_lg(z, ly);1098}1099return z;1100}1101GEN1102RgX_neg(GEN x)1103{1104long i, lx = lg(x);1105GEN y = cgetg(lx, t_POL); y[1] = x[1];1106for (i=2; i<lx; i++) gel(y,i) = gneg(gel(x,i));1107return y;1108}11091110GEN1111RgX_Rg_add(GEN y, GEN x)1112{1113GEN z;1114long lz = lg(y), i;1115if (lz == 2) return scalarpol(x,varn(y));1116z = cgetg(lz,t_POL); z[1] = y[1];1117gel(z,2) = gadd(gel(y,2),x);1118for(i=3; i<lz; i++) gel(z,i) = gcopy(gel(y,i));1119/* probably useless unless lz = 3, but cannot be skipped if y is1120* an inexact 0 */1121return normalizepol_lg(z,lz);1122}1123GEN1124RgX_Rg_add_shallow(GEN y, GEN x)1125{1126GEN z;1127long lz = lg(y), i;1128if (lz == 2) return scalarpol(x,varn(y));1129z = cgetg(lz,t_POL); z[1] = y[1];1130gel(z,2) = gadd(gel(y,2),x);1131for(i=3; i<lz; i++) gel(z,i) = gel(y,i);1132return z = normalizepol_lg(z,lz);1133}1134GEN1135RgX_Rg_sub(GEN y, GEN x)1136{1137GEN z;1138long lz = lg(y), i;1139if (lz == 2)1140{ /* scalarpol(gneg(x),varn(y)) optimized */1141long v = varn(y);1142if (isrationalzero(x)) return pol_0(v);1143z = cgetg(3,t_POL);1144z[1] = gequal0(x)? evalvarn(v)1145: evalvarn(v) | evalsigne(1);1146gel(z,2) = gneg(x); return z;1147}1148z = cgetg(lz,t_POL); z[1] = y[1];1149gel(z,2) = gsub(gel(y,2),x);1150for(i=3; i<lz; i++) gel(z,i) = gcopy(gel(y,i));1151return z = normalizepol_lg(z,lz);1152}1153GEN1154Rg_RgX_sub(GEN x, GEN y)1155{1156GEN z;1157long lz = lg(y), i;1158if (lz == 2) return scalarpol(x,varn(y));1159z = cgetg(lz,t_POL); z[1] = y[1];1160gel(z,2) = gsub(x, gel(y,2));1161for(i=3; i<lz; i++) gel(z,i) = gneg(gel(y,i));1162return z = normalizepol_lg(z,lz);1163}1164/*******************************************************************/1165/* */1166/* KARATSUBA MULTIPLICATION */1167/* */1168/*******************************************************************/1169#if 01170/* to debug Karatsuba-like routines */1171GEN1172zx_debug_spec(GEN x, long nx)1173{1174GEN z = cgetg(nx+2,t_POL);1175long i;1176for (i=0; i<nx; i++) gel(z,i+2) = stoi(x[i]);1177z[1] = evalsigne(1); return z;1178}11791180GEN1181RgX_debug_spec(GEN x, long nx)1182{1183GEN z = cgetg(nx+2,t_POL);1184long i;1185for (i=0; i<nx; i++) z[i+2] = x[i];1186z[1] = evalsigne(1); return z;1187}1188#endif11891190/* generic multiplication */1191GEN1192RgX_addspec_shallow(GEN x, GEN y, long nx, long ny)1193{1194GEN z, t;1195long i;1196if (nx == ny) {1197z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;1198for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));1199return normalizepol_lg(z, nx+2);1200}1201if (ny < nx) {1202z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;1203for (i=0; i < ny; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));1204for ( ; i < nx; i++) gel(t,i) = gel(x,i);1205return normalizepol_lg(z, nx+2);1206} else {1207z = cgetg(ny+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;1208for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));1209for ( ; i < ny; i++) gel(t,i) = gel(y,i);1210return normalizepol_lg(z, ny+2);1211}1212}1213GEN1214RgX_addspec(GEN x, GEN y, long nx, long ny)1215{1216GEN z, t;1217long i;1218if (nx == ny) {1219z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;1220for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));1221return normalizepol_lg(z, nx+2);1222}1223if (ny < nx) {1224z = cgetg(nx+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;1225for (i=0; i < ny; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));1226for ( ; i < nx; i++) gel(t,i) = gcopy(gel(x,i));1227return normalizepol_lg(z, nx+2);1228} else {1229z = cgetg(ny+2,t_POL); z[1] = evalsigne(1)|evalvarn(0); t = z+2;1230for (i=0; i < nx; i++) gel(t,i) = gadd(gel(x,i),gel(y,i));1231for ( ; i < ny; i++) gel(t,i) = gcopy(gel(y,i));1232return normalizepol_lg(z, ny+2);1233}1234}12351236/* Return the vector of coefficients of x, where we replace rational 0s by NULL1237* [ to speed up basic operation s += x[i]*y[j] ]. We create a proper1238* t_VECSMALL, to hold this, which can be left on stack: gerepile1239* will not crash on it. The returned vector itself is not a proper GEN,1240* we access the coefficients as x[i], i = 0..deg(x) */1241static GEN1242RgXspec_kill0(GEN x, long lx)1243{1244GEN z = cgetg(lx+1, t_VECSMALL) + 1; /* inhibit gerepile-wise */1245long i;1246for (i=0; i <lx; i++)1247{1248GEN c = gel(x,i);1249z[i] = (long)(isrationalzero(c)? NULL: c);1250}1251return z;1252}12531254INLINE GEN1255RgX_mulspec_basecase_limb(GEN x, GEN y, long a, long b)1256{1257pari_sp av = avma;1258GEN s = NULL;1259long i;12601261for (i=a; i<b; i++)1262if (gel(y,i) && gel(x,-i))1263{1264GEN t = gmul(gel(y,i), gel(x,-i));1265s = s? gadd(s, t): t;1266}1267return s? gerepileupto(av, s): gen_0;1268}12691270/* assume nx >= ny > 0, return x * y * t^v */1271static GEN1272RgX_mulspec_basecase(GEN x, GEN y, long nx, long ny, long v)1273{1274long i, lz, nz;1275GEN z;12761277x = RgXspec_kill0(x,nx);1278y = RgXspec_kill0(y,ny);1279lz = nx + ny + 1; nz = lz-2;1280lz += v;1281z = cgetg(lz, t_POL) + 2; /* x:y:z [i] = term of degree i */1282for (i=0; i<v; i++) gel(z++, 0) = gen_0;1283for (i=0; i<ny; i++)gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0, i+1);1284for ( ; i<nx; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0,ny);1285for ( ; i<nz; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, i-nx+1,ny);1286z -= v+2; z[1] = 0; return normalizepol_lg(z, lz);1287}12881289/* return (x * X^d) + y. Assume d > 0 */1290GEN1291RgX_addmulXn_shallow(GEN x0, GEN y0, long d)1292{1293GEN x, y, xd, yd, zd;1294long a, lz, nx, ny;12951296if (!signe(x0)) return y0;1297ny = lgpol(y0);1298nx = lgpol(x0);1299zd = (GEN)avma;1300x = x0 + 2; y = y0 + 2; a = ny-d;1301if (a <= 0)1302{1303lz = nx+d+2;1304(void)new_chunk(lz); xd = x+nx; yd = y+ny;1305while (xd > x) gel(--zd,0) = gel(--xd,0);1306x = zd + a;1307while (zd > x) gel(--zd,0) = gen_0;1308}1309else1310{1311xd = new_chunk(d); yd = y+d;1312x = RgX_addspec_shallow(x,yd, nx,a);1313lz = (a>nx)? ny+2: lg(x)+d;1314x += 2; while (xd > x) *--zd = *--xd;1315}1316while (yd > y) *--zd = *--yd;1317*--zd = x0[1];1318*--zd = evaltyp(t_POL) | evallg(lz); return zd;1319}1320GEN1321RgX_addmulXn(GEN x0, GEN y0, long d)1322{1323GEN x, y, xd, yd, zd;1324long a, lz, nx, ny;13251326if (!signe(x0)) return RgX_copy(y0);1327nx = lgpol(x0);1328ny = lgpol(y0);1329zd = (GEN)avma;1330x = x0 + 2; y = y0 + 2; a = ny-d;1331if (a <= 0)1332{1333lz = nx+d+2;1334(void)new_chunk(lz); xd = x+nx; yd = y+ny;1335while (xd > x) gel(--zd,0) = gcopy(gel(--xd,0));1336x = zd + a;1337while (zd > x) gel(--zd,0) = gen_0;1338}1339else1340{1341xd = new_chunk(d); yd = y+d;1342x = RgX_addspec(x,yd, nx,a);1343lz = (a>nx)? ny+2: lg(x)+d;1344x += 2; while (xd > x) *--zd = *--xd;1345}1346while (yd > y) gel(--zd,0) = gcopy(gel(--yd,0));1347*--zd = x0[1];1348*--zd = evaltyp(t_POL) | evallg(lz); return zd;1349}13501351/* return x * y mod t^n */1352static GEN1353RgXn_mul_basecase(GEN x, GEN y, long n)1354{1355long i, lz = n+2, lx = lgpol(x), ly = lgpol(y);1356GEN z;1357if (lx < 0) return pol_0(varn(x));1358if (ly < 0) return pol_0(varn(x));1359z = cgetg(lz, t_POL) + 2;1360x+=2; if (lx > n) lx = n;1361y+=2; if (ly > n) ly = n;1362z[-1] = x[-1];1363if (ly > lx) { swap(x,y); lswap(lx,ly); }1364x = RgXspec_kill0(x, lx);1365y = RgXspec_kill0(y, ly);1366/* x:y:z [i] = term of degree i */1367for (i=0;i<ly; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0,i+1);1368for ( ; i<lx; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, 0,ly);1369for ( ; i<n; i++) gel(z,i) = RgX_mulspec_basecase_limb(x+i,y, i-lx+1,ly);1370return normalizepol_lg(z - 2, lz);1371}1372/* Mulders / Karatsuba product f*g mod t^n (Hanrot-Zimmermann variant) */1373static GEN1374RgXn_mul2(GEN f, GEN g, long n)1375{1376pari_sp av = avma;1377GEN fe,fo, ge,go, l,h,m;1378long n0, n1;1379if (degpol(f) + degpol(g) < n) return RgX_mul(f,g);1380if (n < 80) return RgXn_mul_basecase(f,g,n);1381n0 = n>>1; n1 = n-n0;1382RgX_even_odd(f, &fe, &fo);1383RgX_even_odd(g, &ge, &go);1384l = RgXn_mul2(fe,ge,n1);1385h = RgXn_mul2(fo,go,n0);1386m = RgX_sub(RgXn_mul2(RgX_add(fe,fo),RgX_add(ge,go),n0), RgX_add(l,h));1387/* n1-1 <= n0 <= n1, deg l,m <= n1-1, deg h <= n0-11388* result is t^2 h(t^2) + t m(t^2) + l(t^2) */1389l = RgX_inflate(l,2); /* deg l <= 2n1 - 2 <= n-1 */1390/* deg(t m(t^2)) <= 2n1 - 1 <= n, truncate to < n */1391if (2*degpol(m)+1 == n) m = normalizepol_lg(m, lg(m)-1);1392m = RgX_inflate(m,2);1393/* deg(t^2 h(t^2)) <= 2n0 <= n, truncate to < n */1394if (2*degpol(h)+2 == n) h = normalizepol_lg(h, lg(h)-1);1395h = RgX_inflate(h,2);1396h = RgX_addmulXn(RgX_addmulXn_shallow(h,m,1), l,1);1397return gerepileupto(av, h);1398}1399/* (f*g) \/ x^n */1400static GEN1401RgX_mulhigh_i2(GEN f, GEN g, long n)1402{1403long d = degpol(f)+degpol(g) + 1 - n;1404GEN h;1405if (d <= 2) return RgX_shift_shallow(RgX_mul(f,g), -n);1406h = RgX_recip_i(RgXn_mul2(RgX_recip_i(f),1407RgX_recip_i(g), d));1408return RgX_shift_shallow(h, d-1-degpol(h)); /* possibly (fg)(0) = 0 */1409}14101411/* (f*g) \/ x^n */1412static GEN1413RgX_sqrhigh_i2(GEN f, long n)1414{1415long d = 2*degpol(f)+ 1 - n;1416GEN h;1417if (d <= 2) return RgX_shift_shallow(RgX_sqr(f), -n);1418h = RgX_recip_i(RgXn_sqr(RgX_recip_i(f), d));1419return RgX_shift_shallow(h, d-1-degpol(h)); /* possibly (fg)(0) = 0 */1420}14211422/* fast product (Karatsuba) of polynomials a,b. These are not real GENs, a+2,1423* b+2 were sent instead. na, nb = number of terms of a, b.1424* Only c, c0, c1, c2 are genuine GEN.1425*/1426GEN1427RgX_mulspec(GEN a, GEN b, long na, long nb)1428{1429GEN a0, c, c0;1430long n0, n0a, i, v = 0;1431pari_sp av;14321433while (na && isrationalzero(gel(a,0))) { a++; na--; v++; }1434while (nb && isrationalzero(gel(b,0))) { b++; nb--; v++; }1435if (na < nb) swapspec(a,b, na,nb);1436if (!nb) return pol_0(0);14371438if (nb < RgX_MUL_LIMIT) return RgX_mulspec_basecase(a,b,na,nb, v);1439RgX_shift_inplace_init(v);1440i = (na>>1); n0 = na-i; na = i;1441av = avma; a0 = a+n0; n0a = n0;1442while (n0a && isrationalzero(gel(a,n0a-1))) n0a--;14431444if (nb > n0)1445{1446GEN b0,c1,c2;1447long n0b;14481449nb -= n0; b0 = b+n0; n0b = n0;1450while (n0b && isrationalzero(gel(b,n0b-1))) n0b--;1451c = RgX_mulspec(a,b,n0a,n0b);1452c0 = RgX_mulspec(a0,b0, na,nb);14531454c2 = RgX_addspec_shallow(a0,a, na,n0a);1455c1 = RgX_addspec_shallow(b0,b, nb,n0b);14561457c1 = RgX_mulspec(c1+2,c2+2, lgpol(c1),lgpol(c2));1458c2 = RgX_sub(c1, RgX_add(c0,c));1459c0 = RgX_addmulXn_shallow(c0, c2, n0);1460}1461else1462{1463c = RgX_mulspec(a,b,n0a,nb);1464c0 = RgX_mulspec(a0,b,na,nb);1465}1466c0 = RgX_addmulXn(c0,c,n0);1467return RgX_shift_inplace(gerepileupto(av,c0), v);1468}14691470INLINE GEN1471RgX_sqrspec_basecase_limb(GEN x, long a, long i)1472{1473pari_sp av = avma;1474GEN s = NULL;1475long j, l = (i+1)>>1;1476for (j=a; j<l; j++)1477{1478GEN xj = gel(x,j), xx = gel(x,i-j);1479if (xj && xx)1480{1481GEN t = gmul(xj, xx);1482s = s? gadd(s, t): t;1483}1484}1485if (s) s = gshift(s,1);1486if ((i&1) == 0)1487{1488GEN t = gel(x, i>>1);1489if (t) {1490t = gsqr(t);1491s = s? gadd(s, t): t;1492}1493}1494return s? gerepileupto(av,s): gen_0;1495}1496static GEN1497RgX_sqrspec_basecase(GEN x, long nx, long v)1498{1499long i, lz, nz;1500GEN z;15011502if (!nx) return pol_0(0);1503x = RgXspec_kill0(x,nx);1504lz = (nx << 1) + 1, nz = lz-2;1505lz += v;1506z = cgetg(lz,t_POL) + 2;1507for (i=0; i<v; i++) gel(z++, 0) = gen_0;1508for (i=0; i<nx; i++)gel(z,i) = RgX_sqrspec_basecase_limb(x, 0, i);1509for ( ; i<nz; i++) gel(z,i) = RgX_sqrspec_basecase_limb(x, i-nx+1, i);1510z -= v+2; z[1] = 0; return normalizepol_lg(z, lz);1511}1512/* return x^2 mod t^n */1513static GEN1514RgXn_sqr_basecase(GEN x, long n)1515{1516long i, lz = n+2, lx = lgpol(x);1517GEN z;1518if (lx < 0) return pol_0(varn(x));1519z = cgetg(lz, t_POL);1520z[1] = x[1];1521x+=2; if (lx > n) lx = n;1522x = RgXspec_kill0(x,lx);1523z+=2;/* x:z [i] = term of degree i */1524for (i=0;i<lx; i++) gel(z,i) = RgX_sqrspec_basecase_limb(x, 0, i);1525for ( ; i<n; i++) gel(z,i) = RgX_sqrspec_basecase_limb(x, i-lx+1, i);1526z -= 2; return normalizepol_lg(z, lz);1527}1528/* Mulders / Karatsuba product f^2 mod t^n (Hanrot-Zimmermann variant) */1529static GEN1530RgXn_sqr2(GEN f, long n)1531{1532pari_sp av = avma;1533GEN fe,fo, l,h,m;1534long n0, n1;1535if (2*degpol(f) < n) return RgX_sqr_i(f);1536if (n < 80) return RgXn_sqr_basecase(f,n);1537n0 = n>>1; n1 = n-n0;1538RgX_even_odd(f, &fe, &fo);1539l = RgXn_sqr(fe,n1);1540h = RgXn_sqr(fo,n0);1541m = RgX_sub(RgXn_sqr(RgX_add(fe,fo),n0), RgX_add(l,h));1542/* n1-1 <= n0 <= n1, deg l,m <= n1-1, deg h <= n0-11543* result is t^2 h(t^2) + t m(t^2) + l(t^2) */1544l = RgX_inflate(l,2); /* deg l <= 2n1 - 2 <= n-1 */1545/* deg(t m(t^2)) <= 2n1 - 1 <= n, truncate to < n */1546if (2*degpol(m)+1 == n) m = normalizepol_lg(m, lg(m)-1);1547m = RgX_inflate(m,2);1548/* deg(t^2 h(t^2)) <= 2n0 <= n, truncate to < n */1549if (2*degpol(h)+2 == n) h = normalizepol_lg(h, lg(h)-1);1550h = RgX_inflate(h,2);1551h = RgX_addmulXn(RgX_addmulXn_shallow(h,m,1), l,1);1552return gerepileupto(av, h);1553}1554GEN1555RgX_sqrspec(GEN a, long na)1556{1557GEN a0, c, c0, c1;1558long n0, n0a, i, v = 0;1559pari_sp av;15601561while (na && isrationalzero(gel(a,0))) { a++; na--; v += 2; }1562if (na<RgX_SQR_LIMIT) return RgX_sqrspec_basecase(a, na, v);1563RgX_shift_inplace_init(v);1564i = (na>>1); n0 = na-i; na = i;1565av = avma; a0 = a+n0; n0a = n0;1566while (n0a && isrationalzero(gel(a,n0a-1))) n0a--;15671568c = RgX_sqrspec(a,n0a);1569c0 = RgX_sqrspec(a0,na);1570c1 = gmul2n(RgX_mulspec(a0,a, na,n0a), 1);1571c0 = RgX_addmulXn_shallow(c0,c1, n0);1572c0 = RgX_addmulXn(c0,c,n0);1573return RgX_shift_inplace(gerepileupto(av,c0), v);1574}15751576/* (X^a + A)(X^b + B) - X^(a+b), where deg A < a, deg B < b */1577GEN1578RgX_mul_normalized(GEN A, long a, GEN B, long b)1579{1580GEN z = RgX_mul(A, B);1581if (a < b)1582z = RgX_addmulXn_shallow(RgX_addmulXn_shallow(A, B, b-a), z, a);1583else if (a > b)1584z = RgX_addmulXn_shallow(RgX_addmulXn_shallow(B, A, a-b), z, b);1585else1586z = RgX_addmulXn_shallow(RgX_add(A, B), z, a);1587return z;1588}15891590GEN1591RgX_mul_i(GEN x, GEN y)1592{1593GEN z = RgX_mulspec(x+2, y+2, lgpol(x), lgpol(y));1594setvarn(z, varn(x)); return z;1595}15961597GEN1598RgX_sqr_i(GEN x)1599{1600GEN z = RgX_sqrspec(x+2, lgpol(x));1601setvarn(z,varn(x)); return z;1602}16031604/*******************************************************************/1605/* */1606/* DIVISION */1607/* */1608/*******************************************************************/1609GEN1610RgX_Rg_divexact(GEN x, GEN y) {1611long i, lx = lg(x);1612GEN z;1613if (lx == 2) return gcopy(x);1614switch(typ(y))1615{1616case t_INT:1617if (is_pm1(y)) return signe(y) < 0 ? RgX_neg(x): RgX_copy(x);1618break;1619case t_INTMOD: case t_POLMOD: return RgX_Rg_mul(x, ginv(y));1620}1621z = cgetg(lx, t_POL); z[1] = x[1];1622for (i=2; i<lx; i++) gel(z,i) = gdivexact(gel(x,i),y);1623return z;1624}1625GEN1626RgX_Rg_div(GEN x, GEN y) {1627long i, lx = lg(x);1628GEN z;1629if (lx == 2) return gcopy(x);1630switch(typ(y))1631{1632case t_INT:1633if (is_pm1(y)) return signe(y) < 0 ? RgX_neg(x): RgX_copy(x);1634break;1635case t_INTMOD: case t_POLMOD: return RgX_Rg_mul(x, ginv(y));1636}1637z = cgetg(lx, t_POL); z[1] = x[1];1638for (i=2; i<lx; i++) gel(z,i) = gdiv(gel(x,i),y);1639return normalizepol_lg(z, lx);1640}1641GEN1642RgX_normalize(GEN x)1643{1644GEN z, d = NULL;1645long i, n = lg(x)-1;1646for (i = n; i > 1; i--) { d = gel(x,i); if (!gequal0(d)) break; }1647if (i == 1) return pol_0(varn(x));1648if (i == n && isint1(d)) return x;1649n = i; z = cgetg(n+1, t_POL); z[1] = x[1];1650for (i=2; i<n; i++) gel(z,i) = gdiv(gel(x,i),d);1651gel(z,n) = Rg_get_1(d); return z;1652}1653GEN1654RgX_divs(GEN x, long y) {1655long i, lx;1656GEN z = cgetg_copy(x, &lx); z[1] = x[1];1657for (i=2; i<lx; i++) gel(z,i) = gdivgs(gel(x,i),y);1658return normalizepol_lg(z, lx);1659}1660GEN1661RgX_div_by_X_x(GEN a, GEN x, GEN *r)1662{1663long l = lg(a), i;1664GEN a0, z0, z;16651666if (l <= 3)1667{1668if (r) *r = l == 2? gen_0: gcopy(gel(a,2));1669return pol_0(0);1670}1671z = cgetg(l-1, t_POL);1672z[1] = a[1];1673a0 = a + l-1;1674z0 = z + l-2; *z0 = *a0--;1675for (i=l-3; i>1; i--) /* z[i] = a[i+1] + x*z[i+1] */1676{1677GEN t = gadd(gel(a0--,0), gmul(x, gel(z0--,0)));1678gel(z0,0) = t;1679}1680if (r) *r = gadd(gel(a0,0), gmul(x, gel(z0,0)));1681return z;1682}1683/* Polynomial division x / y:1684* if pr = ONLY_REM return remainder, otherwise return quotient1685* if pr = ONLY_DIVIDES return quotient if division is exact, else NULL1686* if pr != NULL set *pr to remainder, as the last object on stack */1687/* assume, typ(x) = typ(y) = t_POL, same variable */1688static GEN1689RgX_divrem_i(GEN x, GEN y, GEN *pr)1690{1691pari_sp avy, av, av1;1692long dx,dy,dz,i,j,sx,lr;1693GEN z,p1,p2,rem,y_lead,mod,p;1694GEN (*f)(GEN,GEN);16951696if (!signe(y)) pari_err_INV("RgX_divrem",y);16971698dy = degpol(y);1699y_lead = gel(y,dy+2);1700if (gequal0(y_lead)) /* normalize denominator if leading term is 0 */1701{1702pari_warn(warner,"normalizing a polynomial with 0 leading term");1703for (dy--; dy>=0; dy--)1704{1705y_lead = gel(y,dy+2);1706if (!gequal0(y_lead)) break;1707}1708}1709if (!dy) /* y is constant */1710{1711if (pr == ONLY_REM) return pol_0(varn(x));1712z = RgX_Rg_div(x, y_lead);1713if (pr == ONLY_DIVIDES) return z;1714if (pr) *pr = pol_0(varn(x));1715return z;1716}1717dx = degpol(x);1718if (dx < dy)1719{1720if (pr == ONLY_REM) return RgX_copy(x);1721if (pr == ONLY_DIVIDES) return signe(x)? NULL: pol_0(varn(x));1722z = pol_0(varn(x));1723if (pr) *pr = RgX_copy(x);1724return z;1725}17261727/* x,y in R[X], y non constant */1728av = avma;1729p = NULL;1730if (RgX_is_FpX(x, &p) && RgX_is_FpX(y, &p) && p)1731{1732z = FpX_divrem(RgX_to_FpX(x, p), RgX_to_FpX(y, p), p, pr);1733if (!z) return gc_NULL(av);1734z = FpX_to_mod(z, p);1735if (!pr || pr == ONLY_REM || pr == ONLY_DIVIDES)1736return gerepileupto(av, z);1737*pr = FpX_to_mod(*pr, p);1738gerepileall(av, 2, pr, &z);1739return z;1740}1741switch(typ(y_lead))1742{1743case t_REAL:1744y_lead = ginv(y_lead);1745f = gmul; mod = NULL;1746break;1747case t_INTMOD:1748case t_POLMOD: y_lead = ginv(y_lead);1749f = gmul; mod = gmodulo(gen_1, gel(y_lead,1));1750break;1751default: if (gequal1(y_lead)) y_lead = NULL;1752f = gdiv; mod = NULL;1753}17541755if (y_lead == NULL)1756p2 = gel(x,dx+2);1757else {1758for(;;) {1759p2 = f(gel(x,dx+2),y_lead);1760p2 = simplify_shallow(p2);1761if (!isexactzero(p2) || (--dx < 0)) break;1762}1763if (dx < dy) /* leading coeff of x was in fact zero */1764{1765if (pr == ONLY_DIVIDES) {1766set_avma(av);1767return (dx < 0)? pol_0(varn(x)) : NULL;1768}1769if (pr == ONLY_REM)1770{1771if (dx < 0)1772return gerepilecopy(av, scalarpol(p2, varn(x)));1773else1774{1775GEN t;1776set_avma(av);1777t = cgetg(dx + 3, t_POL); t[1] = x[1];1778for (i = 2; i < dx + 3; i++) gel(t,i) = gcopy(gel(x,i));1779return t;1780}1781}1782if (pr) /* cf ONLY_REM above */1783{1784if (dx < 0)1785{1786p2 = gclone(p2);1787set_avma(av);1788z = pol_0(varn(x));1789x = scalarpol(p2, varn(x));1790gunclone(p2);1791}1792else1793{1794GEN t;1795set_avma(av);1796z = pol_0(varn(x));1797t = cgetg(dx + 3, t_POL); t[1] = x[1];1798for (i = 2; i < dx + 3; i++) gel(t,i) = gcopy(gel(x,i));1799x = t;1800}1801*pr = x;1802}1803else1804{1805set_avma(av);1806z = pol_0(varn(x));1807}1808return z;1809}1810}1811/* dx >= dy */1812avy = avma;1813dz = dx-dy;1814z = cgetg(dz+3,t_POL); z[1] = x[1];1815x += 2;1816z += 2;1817y += 2;1818gel(z,dz) = gcopy(p2);18191820for (i=dx-1; i>=dy; i--)1821{1822av1=avma; p1=gel(x,i);1823for (j=i-dy+1; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));1824if (y_lead) p1 = simplify(f(p1,y_lead));18251826if (isrationalzero(p1)) { set_avma(av1); p1 = gen_0; }1827else1828p1 = avma==av1? gcopy(p1): gerepileupto(av1,p1);1829gel(z,i-dy) = p1;1830}1831if (!pr) return gerepileupto(av,z-2);18321833rem = (GEN)avma; av1 = (pari_sp)new_chunk(dx+3);1834for (sx=0; ; i--)1835{1836p1 = gel(x,i);1837/* we always enter this loop at least once */1838for (j=0; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));1839if (mod && avma==av1) p1 = gmul(p1,mod);1840if (!gequal0(p1)) { sx = 1; break; } /* remainder is nonzero */1841if (!isexactzero(p1)) break;1842if (!i) break;1843set_avma(av1);1844}1845if (pr == ONLY_DIVIDES)1846{1847if (sx) return gc_NULL(av);1848set_avma((pari_sp)rem); return gerepileupto(av,z-2);1849}1850lr=i+3; rem -= lr;1851if (avma==av1) { set_avma((pari_sp)rem); p1 = gcopy(p1); }1852else p1 = gerepileupto((pari_sp)rem,p1);1853rem[0] = evaltyp(t_POL) | evallg(lr);1854rem[1] = z[-1];1855rem += 2;1856gel(rem,i) = p1;1857for (i--; i>=0; i--)1858{1859av1=avma; p1 = gel(x,i);1860for (j=0; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));1861if (mod && avma==av1) p1 = gmul(p1,mod);1862gel(rem,i) = avma==av1? gcopy(p1):gerepileupto(av1,p1);1863}1864rem -= 2;1865if (!sx) (void)normalizepol_lg(rem, lr);1866if (pr == ONLY_REM) return gerepileupto(av,rem);1867z -= 2;1868{1869GEN *gptr[2]; gptr[0]=&z; gptr[1]=&rem;1870gerepilemanysp(av,avy,gptr,2); *pr = rem; return z;1871}1872}18731874GEN1875RgX_divrem(GEN x, GEN y, GEN *pr)1876{1877if (pr == ONLY_REM) return RgX_rem(x, y);1878return RgX_divrem_i(x, y, pr);1879}18801881/* x and y in (R[Y]/T)[X] (lifted), T in R[Y]. y preferably monic */1882GEN1883RgXQX_divrem(GEN x, GEN y, GEN T, GEN *pr)1884{1885long vx, dx, dy, dz, i, j, sx, lr;1886pari_sp av0, av, tetpil;1887GEN z,p1,rem,lead;18881889if (!signe(y)) pari_err_INV("RgXQX_divrem",y);1890vx = varn(x);1891dx = degpol(x);1892dy = degpol(y);1893if (dx < dy)1894{1895if (pr)1896{1897av0 = avma; x = RgXQX_red(x, T);1898if (pr == ONLY_DIVIDES) { set_avma(av0); return signe(x)? NULL: gen_0; }1899if (pr == ONLY_REM) return x;1900*pr = x;1901}1902return pol_0(vx);1903}1904lead = leading_coeff(y);1905if (!dy) /* y is constant */1906{1907if (pr && pr != ONLY_DIVIDES)1908{1909if (pr == ONLY_REM) return pol_0(vx);1910*pr = pol_0(vx);1911}1912if (gequal1(lead)) return RgX_copy(x);1913av0 = avma; x = gmul(x, ginvmod(lead,T)); tetpil = avma;1914return gerepile(av0,tetpil,RgXQX_red(x,T));1915}1916av0 = avma; dz = dx-dy;1917lead = gequal1(lead)? NULL: gclone(ginvmod(lead,T));1918set_avma(av0);1919z = cgetg(dz+3,t_POL); z[1] = x[1];1920x += 2; y += 2; z += 2;19211922p1 = gel(x,dx); av = avma;1923gel(z,dz) = lead? gerepileupto(av, grem(gmul(p1,lead), T)): gcopy(p1);1924for (i=dx-1; i>=dy; i--)1925{1926av=avma; p1=gel(x,i);1927for (j=i-dy+1; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));1928if (lead) p1 = gmul(grem(p1, T), lead);1929tetpil=avma; gel(z,i-dy) = gerepile(av,tetpil, grem(p1, T));1930}1931if (!pr) { guncloneNULL(lead); return z-2; }19321933rem = (GEN)avma; av = (pari_sp)new_chunk(dx+3);1934for (sx=0; ; i--)1935{1936p1 = gel(x,i);1937for (j=0; j<=i && j<=dz; j++) p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));1938tetpil=avma; p1 = grem(p1, T); if (!gequal0(p1)) { sx = 1; break; }1939if (!i) break;1940set_avma(av);1941}1942if (pr == ONLY_DIVIDES)1943{1944guncloneNULL(lead);1945if (sx) return gc_NULL(av0);1946return gc_const((pari_sp)rem, z-2);1947}1948lr=i+3; rem -= lr;1949rem[0] = evaltyp(t_POL) | evallg(lr);1950rem[1] = z[-1];1951p1 = gerepile((pari_sp)rem,tetpil,p1);1952rem += 2; gel(rem,i) = p1;1953for (i--; i>=0; i--)1954{1955av=avma; p1 = gel(x,i);1956for (j=0; j<=i && j<=dz; j++)1957p1 = gsub(p1, gmul(gel(z,j),gel(y,i-j)));1958tetpil=avma; gel(rem,i) = gerepile(av,tetpil, grem(p1, T));1959}1960rem -= 2;1961guncloneNULL(lead);1962if (!sx) (void)normalizepol_lg(rem, lr);1963if (pr == ONLY_REM) return gerepileupto(av0,rem);1964*pr = rem; return z-2;1965}19661967/*******************************************************************/1968/* */1969/* PSEUDO-DIVISION */1970/* */1971/*******************************************************************/1972INLINE GEN1973rem(GEN c, GEN T)1974{1975if (T && typ(c) == t_POL && varn(c) == varn(T)) c = RgX_rem(c, T);1976return c;1977}19781979/* x, y, are ZYX, lc(y) is an integer, T is a ZY */1980int1981ZXQX_dvd(GEN x, GEN y, GEN T)1982{1983long dx, dy, dz, i, p, T_ismonic;1984pari_sp av = avma, av2;1985GEN y_lead;19861987if (!signe(y)) pari_err_INV("ZXQX_dvd",y);1988dy = degpol(y); y_lead = gel(y,dy+2);1989if (typ(y_lead) == t_POL) y_lead = gel(y_lead, 2); /* t_INT */1990/* if monic, no point in using pseudo-division */1991if (gequal1(y_lead)) return signe(RgXQX_rem(x, y, T)) == 0;1992T_ismonic = gequal1(leading_coeff(T));1993dx = degpol(x);1994if (dx < dy) return !signe(x);1995(void)new_chunk(2);1996x = RgX_recip_i(x)+2;1997y = RgX_recip_i(y)+2;1998/* pay attention to sparse divisors */1999for (i = 1; i <= dy; i++)2000if (!signe(gel(y,i))) gel(y,i) = NULL;2001dz = dx-dy; p = dz+1;2002av2 = avma;2003for (;;)2004{2005GEN m, x0 = gel(x,0), y0 = y_lead, cx = content(x0);2006x0 = gneg(x0); p--;2007m = gcdii(cx, y0);2008if (!equali1(m))2009{2010x0 = gdiv(x0, m);2011y0 = diviiexact(y0, m);2012if (equali1(y0)) y0 = NULL;2013}2014for (i=1; i<=dy; i++)2015{2016GEN c = gel(x,i); if (y0) c = gmul(y0, c);2017if (gel(y,i)) c = gadd(c, gmul(x0,gel(y,i)));2018if (typ(c) == t_POL) c = T_ismonic ? ZX_rem(c, T): RgX_rem(c, T);2019gel(x,i) = c;2020}2021for ( ; i<=dx; i++)2022{2023GEN c = gel(x,i); if (y0) c = gmul(y0, c);2024if (typ(c) == t_POL) c = T_ismonic ? ZX_rem(c, T): RgX_rem(c, T);2025gel(x,i) = c;2026}2027do { x++; dx--; } while (dx >= 0 && !signe(gel(x,0)));2028if (dx < dy) break;2029if (gc_needed(av2,1))2030{2031if(DEBUGMEM>1) pari_warn(warnmem,"ZXQX_dvd dx = %ld >= %ld",dx,dy);2032gerepilecoeffs(av2,x,dx+1);2033}2034}2035return gc_bool(av, dx < 0);2036}20372038/* T either NULL or a t_POL. */2039GEN2040RgXQX_pseudorem(GEN x, GEN y, GEN T)2041{2042long vx = varn(x), dx, dy, dz, i, lx, p;2043pari_sp av = avma, av2;2044GEN y_lead;20452046if (!signe(y)) pari_err_INV("RgXQX_pseudorem",y);2047dy = degpol(y); y_lead = gel(y,dy+2);2048/* if monic, no point in using pseudo-division */2049if (gequal1(y_lead)) return T? RgXQX_rem(x, y, T): RgX_rem(x, y);2050dx = degpol(x);2051if (dx < dy) return RgX_copy(x);2052(void)new_chunk(2);2053x = RgX_recip_i(x)+2;2054y = RgX_recip_i(y)+2;2055/* pay attention to sparse divisors */2056for (i = 1; i <= dy; i++)2057if (isexactzero(gel(y,i))) gel(y,i) = NULL;2058dz = dx-dy; p = dz+1;2059av2 = avma;2060for (;;)2061{2062gel(x,0) = gneg(gel(x,0)); p--;2063for (i=1; i<=dy; i++)2064{2065GEN c = gmul(y_lead, gel(x,i));2066if (gel(y,i)) c = gadd(c, gmul(gel(x,0),gel(y,i)));2067gel(x,i) = rem(c, T);2068}2069for ( ; i<=dx; i++)2070{2071GEN c = gmul(y_lead, gel(x,i));2072gel(x,i) = rem(c, T);2073}2074do { x++; dx--; } while (dx >= 0 && gequal0(gel(x,0)));2075if (dx < dy) break;2076if (gc_needed(av2,1))2077{2078if(DEBUGMEM>1) pari_warn(warnmem,"RgX_pseudorem dx = %ld >= %ld",dx,dy);2079gerepilecoeffs(av2,x,dx+1);2080}2081}2082if (dx < 0) return pol_0(vx);2083lx = dx+3; x -= 2;2084x[0] = evaltyp(t_POL) | evallg(lx);2085x[1] = evalsigne(1) | evalvarn(vx);2086x = RgX_recip_i(x);2087if (p)2088{ /* multiply by y[0]^p [beware dummy vars from FpX_FpXY_resultant] */2089GEN t = y_lead;2090if (T && typ(t) == t_POL && varn(t) == varn(T))2091t = RgXQ_powu(t, p, T);2092else2093t = gpowgs(t, p);2094for (i=2; i<lx; i++)2095{2096GEN c = gmul(gel(x,i), t);2097gel(x,i) = rem(c,T);2098}2099if (!T) return gerepileupto(av, x);2100}2101return gerepilecopy(av, x);2102}21032104GEN2105RgX_pseudorem(GEN x, GEN y) { return RgXQX_pseudorem(x,y, NULL); }21062107/* Compute z,r s.t lc(y)^(dx-dy+1) x = z y + r */2108GEN2109RgXQX_pseudodivrem(GEN x, GEN y, GEN T, GEN *ptr)2110{2111long vx = varn(x), dx, dy, dz, i, iz, lx, lz, p;2112pari_sp av = avma, av2;2113GEN z, r, ypow, y_lead;21142115if (!signe(y)) pari_err_INV("RgXQX_pseudodivrem",y);2116dy = degpol(y); y_lead = gel(y,dy+2);2117if (gequal1(y_lead)) return T? RgXQX_divrem(x,y, T, ptr): RgX_divrem(x,y, ptr);2118dx = degpol(x);2119if (dx < dy) { *ptr = RgX_copy(x); return pol_0(vx); }2120if (dx == dy)2121{2122GEN x_lead = gel(x,lg(x)-1);2123x = RgX_renormalize_lg(leafcopy(x), lg(x)-1);2124y = RgX_renormalize_lg(leafcopy(y), lg(y)-1);2125r = RgX_sub(RgX_Rg_mul(x, y_lead), RgX_Rg_mul(y, x_lead));2126*ptr = gerepileupto(av, r); return scalarpol(x_lead, vx);2127}2128(void)new_chunk(2);2129x = RgX_recip_i(x)+2;2130y = RgX_recip_i(y)+2;2131/* pay attention to sparse divisors */2132for (i = 1; i <= dy; i++)2133if (isexactzero(gel(y,i))) gel(y,i) = NULL;2134dz = dx-dy; p = dz+1;2135lz = dz+3;2136z = cgetg(lz, t_POL);2137z[1] = evalsigne(1) | evalvarn(vx);2138for (i = 2; i < lz; i++) gel(z,i) = gen_0;2139ypow = new_chunk(dz+1);2140gel(ypow,0) = gen_1;2141gel(ypow,1) = y_lead;2142for (i=2; i<=dz; i++)2143{2144GEN c = gmul(gel(ypow,i-1), y_lead);2145gel(ypow,i) = rem(c,T);2146}2147av2 = avma;2148for (iz=2;;)2149{2150p--;2151gel(z,iz++) = rem(gmul(gel(x,0), gel(ypow,p)), T);2152for (i=1; i<=dy; i++)2153{2154GEN c = gmul(y_lead, gel(x,i));2155if (gel(y,i)) c = gsub(c, gmul(gel(x,0),gel(y,i)));2156gel(x,i) = rem(c, T);2157}2158for ( ; i<=dx; i++)2159{2160GEN c = gmul(y_lead, gel(x,i));2161gel(x,i) = rem(c,T);2162}2163x++; dx--;2164while (dx >= dy && gequal0(gel(x,0))) { x++; dx--; iz++; }2165if (dx < dy) break;2166if (gc_needed(av2,1))2167{2168GEN X = x-2;2169if(DEBUGMEM>1) pari_warn(warnmem,"RgX_pseudodivrem dx=%ld >= %ld",dx,dy);2170X[0] = evaltyp(t_POL)|evallg(dx+3); X[1] = z[1]; /* hack */2171gerepileall(av2,2, &X, &z); x = X+2;2172}2173}2174while (dx >= 0 && gequal0(gel(x,0))) { x++; dx--; }2175if (dx < 0)2176x = pol_0(vx);2177else2178{2179lx = dx+3; x -= 2;2180x[0] = evaltyp(t_POL) | evallg(lx);2181x[1] = evalsigne(1) | evalvarn(vx);2182x = RgX_recip_i(x);2183}2184z = RgX_recip_i(z);2185r = x;2186if (p)2187{2188GEN c = gel(ypow,p); r = RgX_Rg_mul(r, c);2189if (T && typ(c) == t_POL && varn(c) == varn(T)) r = RgXQX_red(r, T);2190}2191gerepileall(av, 2, &z, &r);2192*ptr = r; return z;2193}2194GEN2195RgX_pseudodivrem(GEN x, GEN y, GEN *ptr)2196{ return RgXQX_pseudodivrem(x,y,NULL,ptr); }21972198GEN2199RgXQX_mul(GEN x, GEN y, GEN T)2200{2201return RgXQX_red(RgX_mul(x,y), T);2202}2203GEN2204RgX_Rg_mul(GEN y, GEN x) {2205long i, ly;2206GEN z = cgetg_copy(y, &ly); z[1] = y[1];2207if (ly == 2) return z;2208for (i = 2; i < ly; i++) gel(z,i) = gmul(x,gel(y,i));2209return normalizepol_lg(z,ly);2210}2211GEN2212RgX_muls(GEN y, long x) {2213long i, ly;2214GEN z = cgetg_copy(y, &ly); z[1] = y[1];2215if (ly == 2) return z;2216for (i = 2; i < ly; i++) gel(z,i) = gmulsg(x,gel(y,i));2217return normalizepol_lg(z,ly);2218}2219GEN2220RgXQX_RgXQ_mul(GEN x, GEN y, GEN T)2221{2222return RgXQX_red(RgX_Rg_mul(x,y), T);2223}2224GEN2225RgXQV_RgXQ_mul(GEN v, GEN x, GEN T)2226{2227return RgXQV_red(RgV_Rg_mul(v,x), T);2228}22292230GEN2231RgXQX_sqr(GEN x, GEN T)2232{2233return RgXQX_red(RgX_sqr(x), T);2234}22352236GEN2237RgXQX_powers(GEN P, long n, GEN T)2238{2239GEN v = cgetg(n+2, t_VEC);2240long i;2241gel(v, 1) = pol_1(varn(T));2242if (n==0) return v;2243gel(v, 2) = gcopy(P);2244for (i = 2; i <= n; i++) gel(v,i+1) = RgXQX_mul(P, gel(v,i), T);2245return v;2246}22472248static GEN2249_add(void *data, GEN x, GEN y) { (void)data; return RgX_add(x, y); }2250static GEN2251_sub(void *data, GEN x, GEN y) { (void)data; return RgX_sub(x, y); }2252static GEN2253_sqr(void *data, GEN x) { return RgXQ_sqr(x, (GEN)data); }2254static GEN2255_pow(void *data, GEN x, GEN n) { return RgXQ_pow(x, n, (GEN)data); }2256static GEN2257_mul(void *data, GEN x, GEN y) { return RgXQ_mul(x,y, (GEN)data); }2258static GEN2259_cmul(void *data, GEN P, long a, GEN x) { (void)data; return RgX_Rg_mul(x,gel(P,a+2)); }2260static GEN2261_one(void *data) { return pol_1(varn((GEN)data)); }2262static GEN2263_zero(void *data) { return pol_0(varn((GEN)data)); }2264static GEN2265_red(void *data, GEN x) { (void)data; return gcopy(x); }22662267static struct bb_algebra RgXQ_algebra = { _red, _add, _sub,2268_mul, _sqr, _one, _zero };22692270GEN2271RgX_RgXQV_eval(GEN Q, GEN x, GEN T)2272{2273return gen_bkeval_powers(Q,degpol(Q),x,(void*)T,&RgXQ_algebra,_cmul);2274}22752276GEN2277RgX_RgXQ_eval(GEN Q, GEN x, GEN T)2278{2279int use_sqr = 2*degpol(x) >= degpol(T);2280return gen_bkeval(Q,degpol(Q),x,use_sqr,(void*)T,&RgXQ_algebra,_cmul);2281}22822283/* mod X^n */2284struct modXn {2285long v; /* varn(X) */2286long n;2287} ;2288static GEN2289_sqrXn(void *data, GEN x) {2290struct modXn *S = (struct modXn*)data;2291return RgXn_sqr(x, S->n);2292}2293static GEN2294_mulXn(void *data, GEN x, GEN y) {2295struct modXn *S = (struct modXn*)data;2296return RgXn_mul(x,y, S->n);2297}2298static GEN2299_oneXn(void *data) {2300struct modXn *S = (struct modXn*)data;2301return pol_1(S->v);2302}2303static GEN2304_zeroXn(void *data) {2305struct modXn *S = (struct modXn*)data;2306return pol_0(S->v);2307}2308static struct bb_algebra RgXn_algebra = { _red, _add, _sub, _mulXn, _sqrXn,2309_oneXn, _zeroXn };23102311GEN2312RgXn_powers(GEN x, long m, long n)2313{2314long d = degpol(x);2315int use_sqr = (d<<1) >= n;2316struct modXn S;2317S.v = varn(x); S.n = n;2318return gen_powers(x,m,use_sqr,(void*)&S,_sqrXn,_mulXn,_oneXn);2319}23202321GEN2322RgXn_powu_i(GEN x, ulong m, long n)2323{2324struct modXn S;2325long v;2326if (n == 1) return x;2327v = RgX_valrem(x, &x);2328if (v) n -= m * v;2329S.v = varn(x); S.n = n;2330x = gen_powu_i(x, m, (void*)&S,_sqrXn,_mulXn);2331if (v) x = RgX_shift_shallow(x, m * v);2332return x;2333}2334GEN2335RgXn_powu(GEN x, ulong m, long n)2336{2337pari_sp av;2338if (n == 1) return gcopy(x);2339av = avma; return gerepilecopy(av, RgXn_powu_i(x, m, n));2340}23412342GEN2343RgX_RgXnV_eval(GEN Q, GEN x, long n)2344{2345struct modXn S;2346S.v = varn(gel(x,2)); S.n = n;2347return gen_bkeval_powers(Q,degpol(Q),x,(void*)&S,&RgXn_algebra,_cmul);2348}23492350GEN2351RgX_RgXn_eval(GEN Q, GEN x, long n)2352{2353int use_sqr = 2*degpol(x) >= n;2354struct modXn S;2355S.v = varn(x); S.n = n;2356return gen_bkeval(Q,degpol(Q),x,use_sqr,(void*)&S,&RgXn_algebra,_cmul);2357}23582359/* Q(x) mod t^n, x in R[t], n >= 1 */2360GEN2361RgXn_eval(GEN Q, GEN x, long n)2362{2363long d = degpol(x);2364int use_sqr;2365struct modXn S;2366if (d == 1 && isrationalzero(gel(x,2)))2367{2368GEN y = RgX_unscale(Q, gel(x,3));2369setvarn(y, varn(x)); return y;2370}2371S.v = varn(x);2372S.n = n;2373use_sqr = (d<<1) >= n;2374return gen_bkeval(Q,degpol(Q),x,use_sqr,(void*)&S,&RgXn_algebra,_cmul);2375}23762377/* (f*g mod t^n) \ t^n2, assuming 2*n2 >= n */2378static GEN2379RgXn_mulhigh(GEN f, GEN g, long n2, long n)2380{2381GEN F = RgX_blocks(f, n2, 2), fl = gel(F,1), fh = gel(F,2);2382return RgX_add(RgX_mulhigh_i(fl, g, n2), RgXn_mul(fh, g, n - n2));2383}23842385/* (f^2 mod t^n) \ t^n2, assuming 2*n2 >= n */2386static GEN2387RgXn_sqrhigh(GEN f, long n2, long n)2388{2389GEN F = RgX_blocks(f, n2, 2), fl = gel(F,1), fh = gel(F,2);2390return RgX_add(RgX_mulhigh_i(fl, f, n2), RgXn_mul(fh, f, n - n2));2391}23922393GEN2394RgXn_inv_i(GEN f, long e)2395{2396pari_sp av;2397ulong mask;2398GEN W, a;2399long v = varn(f), n = 1;24002401if (!signe(f)) pari_err_INV("RgXn_inv",f);2402a = ginv(gel(f,2));2403if (e == 1) return scalarpol(a, v);2404else if (e == 2)2405{2406GEN b;2407if (degpol(f) <= 0 || gequal0(b = gel(f,3))) return scalarpol(a, v);2408b = gneg(b);2409if (!gequal1(a)) b = gmul(b, gsqr(a));2410return deg1pol(b, a, v);2411}2412av = avma;2413W = scalarpol_shallow(a,v);2414mask = quadratic_prec_mask(e);2415while (mask > 1)2416{2417GEN u, fr;2418long n2 = n;2419n<<=1; if (mask & 1) n--;2420mask >>= 1;2421fr = RgXn_red_shallow(f, n);2422u = RgXn_mul(W, RgXn_mulhigh(fr, W, n2, n), n-n2);2423W = RgX_sub(W, RgX_shift_shallow(u, n2));2424if (gc_needed(av,2))2425{2426if(DEBUGMEM>1) pari_warn(warnmem,"RgXn_inv, e = %ld", n);2427W = gerepileupto(av, W);2428}2429}2430return W;2431}24322433static GEN2434RgXn_inv_FpX(GEN x, long e, GEN p)2435{2436pari_sp av = avma;2437GEN r;2438if (lgefint(p) == 3)2439{2440ulong pp = uel(p, 2);2441if (pp == 2)2442r = F2x_to_ZX(F2xn_inv(RgX_to_F2x(x), e));2443else2444r = Flx_to_ZX_inplace(Flxn_inv(RgX_to_Flx(x, pp), e, pp));2445}2446else2447r = FpXn_inv(RgX_to_FpX(x, p), e, p);2448return gerepileupto(av, FpX_to_mod(r, p));2449}24502451static GEN2452RgXn_inv_FpXQX(GEN x, long n, GEN pol, GEN p)2453{2454pari_sp av = avma;2455GEN r, T = RgX_to_FpX(pol, p);2456if (signe(T) == 0) pari_err_OP("/", gen_1, x);2457r = FpXQXn_inv(RgX_to_FpXQX(x, T, p), n, T, p);2458return gerepileupto(av, FpXQX_to_mod(r, T, p));2459}24602461#define code(t1,t2) ((t1 << 6) | t2)24622463static GEN2464RgXn_inv_fast(GEN x, long e)2465{2466GEN p, pol;2467long pa;2468long t = RgX_type(x,&p,&pol,&pa);2469switch(t)2470{2471case t_INTMOD: return RgXn_inv_FpX(x, e, p);2472case code(t_POLMOD, t_INTMOD):2473return RgXn_inv_FpXQX(x, e, pol, p);2474default: return NULL;2475}2476}2477#undef code24782479GEN2480RgXn_inv(GEN f, long e)2481{2482pari_sp av = avma;2483GEN h = RgXn_inv_fast(f, e);2484if (h) return h;2485return gerepileupto(av, RgXn_inv_i(f, e));2486}24872488/* Compute intformal(x^n*S)/x^(n+1) */2489static GEN2490RgX_integXn(GEN x, long n)2491{2492long i, lx = lg(x);2493GEN y;2494if (lx == 2) return RgX_copy(x);2495y = cgetg(lx, t_POL); y[1] = x[1];2496for (i=2; i<lx; i++)2497gel(y,i) = gdivgs(gel(x,i), n+i-1);2498return RgX_renormalize_lg(y, lx);;2499}25002501GEN2502RgXn_expint(GEN h, long e)2503{2504pari_sp av = avma, av2;2505long v = varn(h), n;2506GEN f = pol_1(v), g;2507ulong mask;25082509if (!signe(h)) return f;2510g = pol_1(v);2511n = 1; mask = quadratic_prec_mask(e);2512av2 = avma;2513for (;mask>1;)2514{2515GEN u, w;2516long n2 = n;2517n<<=1; if (mask & 1) n--;2518mask >>= 1;2519u = RgXn_mul(g, RgX_mulhigh_i(f, RgXn_red_shallow(h, n2-1), n2-1), n-n2);2520u = RgX_add(u, RgX_shift_shallow(RgXn_red_shallow(h, n-1), 1-n2));2521w = RgXn_mul(f, RgX_integXn(u, n2-1), n-n2);2522f = RgX_add(f, RgX_shift_shallow(w, n2));2523if (mask<=1) break;2524u = RgXn_mul(g, RgXn_mulhigh(f, g, n2, n), n-n2);2525g = RgX_sub(g, RgX_shift_shallow(u, n2));2526if (gc_needed(av2,2))2527{2528if (DEBUGMEM>1) pari_warn(warnmem,"RgXn_expint, e = %ld", n);2529gerepileall(av2, 2, &f, &g);2530}2531}2532return gerepileupto(av, f);2533}25342535GEN2536RgXn_exp(GEN h, long e)2537{2538long d = degpol(h);2539if (d < 0) return pol_1(varn(h));2540if (!d || !gequal0(gel(h,2)))2541pari_err_DOMAIN("RgXn_exp","valuation", "<", gen_1, h);2542return RgXn_expint(RgX_deriv(h), e);2543}25442545GEN2546RgXn_reverse(GEN f, long e)2547{2548pari_sp av = avma, av2;2549ulong mask;2550GEN fi, a, df, W, an;2551long v = varn(f), n=1;2552if (degpol(f)<1 || !gequal0(gel(f,2)))2553pari_err_INV("serreverse",f);2554fi = ginv(gel(f,3));2555a = deg1pol_shallow(fi,gen_0,v);2556if (e <= 2) return gerepilecopy(av, a);2557W = scalarpol(fi,v);2558df = RgX_deriv(f);2559mask = quadratic_prec_mask(e);2560av2 = avma;2561for (;mask>1;)2562{2563GEN u, fa, fr;2564long n2 = n, rt;2565n<<=1; if (mask & 1) n--;2566mask >>= 1;2567fr = RgXn_red_shallow(f, n);2568rt = brent_kung_optpow(degpol(fr), 4, 3);2569an = RgXn_powers(a, rt, n);2570if (n>1)2571{2572long n4 = (n2+1)>>1;2573GEN dfr = RgXn_red_shallow(df, n2);2574dfr = RgX_RgXnV_eval(dfr, RgXnV_red_shallow(an, n2), n2);2575u = RgX_shift(RgX_Rg_sub(RgXn_mul(W, dfr, n2), gen_1), -n4);2576W = RgX_sub(W, RgX_shift(RgXn_mul(u, W, n2-n4), n4));2577}2578fa = RgX_sub(RgX_RgXnV_eval(fr, an, n), pol_x(v));2579fa = RgX_shift(fa, -n2);2580a = RgX_sub(a, RgX_shift(RgXn_mul(W, fa, n-n2), n2));2581if (gc_needed(av2,2))2582{2583if(DEBUGMEM>1) pari_warn(warnmem,"RgXn_reverse, e = %ld", n);2584gerepileall(av2, 2, &a, &W);2585}2586}2587return gerepileupto(av, a);2588}25892590GEN2591RgXn_sqrt(GEN h, long e)2592{2593pari_sp av = avma, av2;2594long v = varn(h), n = 1;2595GEN f = scalarpol(gen_1, v), df = f;2596ulong mask = quadratic_prec_mask(e);2597if (degpol(h)<0 || !gequal1(gel(h,2)))2598pari_err_SQRTN("RgXn_sqrt",h);2599av2 = avma;2600while(1)2601{2602long n2 = n, m;2603GEN g;2604n<<=1; if (mask & 1) n--;2605mask >>= 1;2606m = n-n2;2607g = RgX_sub(RgXn_sqrhigh(f, n2, n), RgX_shift_shallow(RgXn_red_shallow(h, n),-n2));2608f = RgX_sub(f, RgX_shift_shallow(RgXn_mul(gmul2n(df, -1), g, m), n2));2609if (mask==1) return gerepileupto(av, f);2610g = RgXn_mul(df, RgXn_mulhigh(df, f, n2, n), m);2611df = RgX_sub(df, RgX_shift_shallow(g, n2));2612if (gc_needed(av2,2))2613{2614if(DEBUGMEM>1) pari_warn(warnmem,"RgXn_sqrt, e = %ld", n);2615gerepileall(av2, 2, &f, &df);2616}2617}2618}26192620/* x,T in Rg[X], n in N, compute lift(x^n mod T)) */2621GEN2622RgXQ_powu(GEN x, ulong n, GEN T)2623{2624pari_sp av = avma;26252626if (!n) return pol_1(varn(x));2627if (n == 1) return RgX_copy(x);2628x = gen_powu_i(x, n, (void*)T, &_sqr, &_mul);2629return gerepilecopy(av, x);2630}2631/* x,T in Rg[X], n in N, compute lift(x^n mod T)) */2632GEN2633RgXQ_pow(GEN x, GEN n, GEN T)2634{2635pari_sp av;2636long s = signe(n);26372638if (!s) return pol_1(varn(x));2639if (is_pm1(n) == 1)2640return (s < 0)? RgXQ_inv(x, T): RgX_copy(x);2641av = avma;2642if (s < 0) x = RgXQ_inv(x, T);2643x = gen_pow_i(x, n, (void*)T, &_sqr, &_mul);2644return gerepilecopy(av, x);2645}2646static GEN2647_ZXQsqr(void *data, GEN x) { return ZXQ_sqr(x, (GEN)data); }2648static GEN2649_ZXQmul(void *data, GEN x, GEN y) { return ZXQ_mul(x,y, (GEN)data); }26502651/* generates the list of powers of x of degree 0,1,2,...,l*/2652GEN2653ZXQ_powers(GEN x, long l, GEN T)2654{2655int use_sqr = 2*degpol(x) >= degpol(T);2656return gen_powers(x, l, use_sqr, (void *)T,_ZXQsqr,_ZXQmul,_one);2657}26582659/* x,T in Z[X], n in N, compute lift(x^n mod T)) */2660GEN2661ZXQ_powu(GEN x, ulong n, GEN T)2662{2663pari_sp av = avma;26642665if (!n) return pol_1(varn(x));2666if (n == 1) return ZX_copy(x);2667x = gen_powu_i(x, n, (void*)T, &_ZXQsqr, &_ZXQmul);2668return gerepilecopy(av, x);2669}26702671/* generates the list of powers of x of degree 0,1,2,...,l*/2672GEN2673RgXQ_powers(GEN x, long l, GEN T)2674{2675int use_sqr = 2*degpol(x) >= degpol(T);2676return gen_powers(x, l, use_sqr, (void *)T,_sqr,_mul,_one);2677}26782679GEN2680RgXQV_factorback(GEN L, GEN e, GEN T)2681{2682return gen_factorback(L, e, (void*)T, &_mul, &_pow, &_one);2683}26842685/* a in K = Q[X]/(T), returns [a^0, ..., a^n] */2686GEN2687QXQ_powers(GEN a, long n, GEN T)2688{2689GEN den, v = ZXQ_powers(Q_remove_denom(a, &den), n, T);2690/* den*a integral; v[i+1] = (den*a)^i in K */2691if (den)2692{ /* restore denominators */2693GEN d = den;2694long i;2695gel(v,2) = a;2696for (i=3; i<=n+1; i++) {2697d = mulii(d,den);2698gel(v,i) = RgX_Rg_div(gel(v,i), d);2699}2700}2701return v;2702}27032704static GEN2705do_QXQ_eval(GEN v, long imin, GEN a, GEN T)2706{2707long l, i, m = 0;2708GEN dz, z;2709GEN V = cgetg_copy(v, &l);2710for (i = imin; i < l; i++)2711{2712GEN c = gel(v, i);2713if (typ(c) == t_POL) m = maxss(m, degpol(c));2714}2715z = Q_remove_denom(QXQ_powers(a, m, T), &dz);2716for (i = 1; i < imin; i++) V[i] = v[i];2717for (i = imin; i < l; i++)2718{2719GEN c = gel(v,i);2720if (typ(c) == t_POL) c = QX_ZXQV_eval(c, z, dz);2721gel(V,i) = c;2722}2723return V;2724}2725/* [ s(a mod T) | s <- lift(v) ], a,T are QX, v a QXV */2726GEN2727QXV_QXQ_eval(GEN v, GEN a, GEN T)2728{ return do_QXQ_eval(v, 1, a, T); }27292730GEN2731QXY_QXQ_evalx(GEN v, GEN a, GEN T)2732{ return normalizepol(do_QXQ_eval(v, 2, a, T)); }27332734GEN2735RgXQ_matrix_pow(GEN y, long n, long m, GEN P)2736{2737return RgXV_to_RgM(RgXQ_powers(y,m-1,P),n);2738}27392740GEN2741RgXQ_norm(GEN x, GEN T)2742{2743pari_sp av;2744long dx = degpol(x);2745GEN L, y;27462747av = avma; y = resultant(T, x);2748L = leading_coeff(T);2749if (gequal1(L) || !signe(x)) return y;2750return gerepileupto(av, gdiv(y, gpowgs(L, dx)));2751}27522753GEN2754RgXQ_trace(GEN x, GEN T)2755{2756pari_sp av = avma;2757GEN dT = RgX_deriv(T);2758long n = degpol(dT);2759GEN z = RgXQ_mul(x, dT, T);2760if (degpol(z)<n) return gc_const(av, gen_0);2761return gerepileupto(av, gdiv(gel(z,2+n), gel(T,3+n)));2762}27632764GEN2765RgX_blocks(GEN P, long n, long m)2766{2767GEN z = cgetg(m+1,t_VEC);2768long i,j, k=2, l = lg(P);2769for(i=1; i<=m; i++)2770{2771GEN zi = cgetg(n+2,t_POL);2772zi[1] = P[1];2773gel(z,i) = zi;2774for(j=2; j<n+2; j++)2775gel(zi, j) = k==l ? gen_0 : gel(P,k++);2776zi = RgX_renormalize_lg(zi, n+2);2777}2778return z;2779}27802781/* write p(X) = e(X^2) + Xo(X^2), shallow function */2782void2783RgX_even_odd(GEN p, GEN *pe, GEN *po)2784{2785long n = degpol(p), v = varn(p), n0, n1, i;2786GEN p0, p1;27872788if (n <= 0) { *pe = RgX_copy(p); *po = zeropol(v); return; }27892790n0 = (n>>1)+1; n1 = n+1 - n0; /* n1 <= n0 <= n1+1 */2791p0 = cgetg(n0+2, t_POL); p0[1] = evalvarn(v)|evalsigne(1);2792p1 = cgetg(n1+2, t_POL); p1[1] = evalvarn(v)|evalsigne(1);2793for (i=0; i<n1; i++)2794{2795p0[2+i] = p[2+(i<<1)];2796p1[2+i] = p[3+(i<<1)];2797}2798if (n1 != n0)2799p0[2+i] = p[2+(i<<1)];2800*pe = normalizepol(p0);2801*po = normalizepol(p1);2802}28032804/* write p(X) = a_0(X^k) + Xa_1(X^k) + ... + X^(k-1)a_{k-1}(X^k), shallow function */2805GEN2806RgX_splitting(GEN p, long k)2807{2808long n = degpol(p), v = varn(p), m, i, j, l;2809GEN r;28102811m = n/k;2812r = cgetg(k+1,t_VEC);2813for(i=1; i<=k; i++)2814{2815gel(r,i) = cgetg(m+3, t_POL);2816mael(r,i,1) = evalvarn(v)|evalsigne(1);2817}2818for (j=1, i=0, l=2; i<=n; i++)2819{2820gmael(r,j,l) = gel(p,2+i);2821if (j==k) { j=1; l++; } else j++;2822}2823for(i=1; i<=k; i++)2824gel(r,i) = normalizepol_lg(gel(r,i),i<j?l+1:l);2825return r;2826}28272828/*******************************************************************/2829/* */2830/* Kronecker form */2831/* */2832/*******************************************************************/28332834/* z in R[Y] representing an elt in R[X,Y] mod T(Y) in Kronecker form,2835* i.e subst(lift(z), x, y^(2deg(z)-1)). Recover the "real" z, with2836* normalized coefficients */2837GEN2838Kronecker_to_mod(GEN z, GEN T)2839{2840long i,j,lx,l = lg(z), N = (degpol(T)<<1) + 1;2841GEN x, t = cgetg(N,t_POL);2842t[1] = T[1];2843lx = (l-2) / (N-2); x = cgetg(lx+3,t_POL);2844x[1] = z[1];2845T = RgX_copy(T);2846for (i=2; i<lx+2; i++, z+= N-2)2847{2848for (j=2; j<N; j++) gel(t,j) = gel(z,j);2849gel(x,i) = mkpolmod(RgX_rem(normalizepol_lg(t,N), T), T);2850}2851N = (l-2) % (N-2) + 2;2852for (j=2; j<N; j++) t[j] = z[j];2853gel(x,i) = mkpolmod(RgX_rem(normalizepol_lg(t,N), T), T);2854return normalizepol_lg(x, i+1);2855}28562857/*******************************************************************/2858/* */2859/* Domain detection */2860/* */2861/*******************************************************************/28622863static GEN2864zero_FpX_mod(GEN p, long v)2865{2866GEN r = cgetg(3,t_POL);2867r[1] = evalvarn(v);2868gel(r,2) = mkintmod(gen_0, icopy(p));2869return r;2870}28712872static GEN2873RgX_mul_FpX(GEN x, GEN y, GEN p)2874{2875pari_sp av = avma;2876GEN r;2877if (lgefint(p) == 3)2878{2879ulong pp = uel(p, 2);2880r = Flx_to_ZX_inplace(Flx_mul(RgX_to_Flx(x, pp),2881RgX_to_Flx(y, pp), pp));2882}2883else2884r = FpX_mul(RgX_to_FpX(x, p), RgX_to_FpX(y, p), p);2885if (signe(r)==0) { set_avma(av); return zero_FpX_mod(p, varn(x)); }2886return gerepileupto(av, FpX_to_mod(r, p));2887}28882889static GEN2890zero_FpXQX_mod(GEN pol, GEN p, long v)2891{2892GEN r = cgetg(3,t_POL);2893r[1] = evalvarn(v);2894gel(r,2) = mkpolmod(mkintmod(gen_0, icopy(p)), gcopy(pol));2895return r;2896}28972898static GEN2899RgX_mul_FpXQX(GEN x, GEN y, GEN pol, GEN p)2900{2901pari_sp av = avma;2902long dT;2903GEN kx, ky, r;2904GEN T = RgX_to_FpX(pol, p);2905if (signe(T)==0) pari_err_OP("*", x, y);2906dT = degpol(T);2907kx = RgXX_to_Kronecker(RgX_to_FpXQX(x, T, p), dT);2908ky = RgXX_to_Kronecker(RgX_to_FpXQX(y, T, p), dT);2909r = FpX_mul(kx, ky, p);2910if (signe(r)==0) { set_avma(av); return zero_FpXQX_mod(pol, p, varn(x)); }2911return gerepileupto(av, Kronecker_to_mod(FpX_to_mod(r, p), pol));2912}29132914static GEN2915RgX_liftred(GEN x, GEN T)2916{ return RgXQX_red(liftpol_shallow(x), T); }29172918static GEN2919RgX_mul_QXQX(GEN x, GEN y, GEN T)2920{2921pari_sp av = avma;2922long dT = degpol(T);2923GEN r = QX_mul(RgXX_to_Kronecker(RgX_liftred(x, T), dT),2924RgXX_to_Kronecker(RgX_liftred(y, T), dT));2925return gerepileupto(av, Kronecker_to_mod(r, T));2926}29272928static GEN2929RgX_sqr_FpX(GEN x, GEN p)2930{2931pari_sp av = avma;2932GEN r;2933if (lgefint(p) == 3)2934{2935ulong pp = uel(p, 2);2936r = Flx_to_ZX_inplace(Flx_sqr(RgX_to_Flx(x, pp), pp));2937}2938else2939r = FpX_sqr(RgX_to_FpX(x, p), p);2940if (signe(r)==0) { set_avma(av); return zero_FpX_mod(p, varn(x)); }2941return gerepileupto(av, FpX_to_mod(r, p));2942}29432944static GEN2945RgX_sqr_FpXQX(GEN x, GEN pol, GEN p)2946{2947pari_sp av = avma;2948long dT;2949GEN kx, r, T = RgX_to_FpX(pol, p);2950if (signe(T)==0) pari_err_OP("*",x,x);2951dT = degpol(T);2952kx = RgXX_to_Kronecker(RgX_to_FpXQX(x, T, p), dT);2953r = FpX_sqr(kx, p);2954if (signe(r)==0) { set_avma(av); return zero_FpXQX_mod(pol, p, varn(x)); }2955return gerepileupto(av, Kronecker_to_mod(FpX_to_mod(r, p), pol));2956}29572958static GEN2959RgX_sqr_QXQX(GEN x, GEN T)2960{2961pari_sp av = avma;2962long dT = degpol(T);2963GEN r = QX_sqr(RgXX_to_Kronecker(RgX_liftred(x, T), dT));2964return gerepileupto(av, Kronecker_to_mod(r, T));2965}29662967static GEN2968RgX_rem_FpX(GEN x, GEN y, GEN p)2969{2970pari_sp av = avma;2971GEN r;2972if (lgefint(p) == 3)2973{2974ulong pp = uel(p, 2);2975r = Flx_to_ZX_inplace(Flx_rem(RgX_to_Flx(x, pp),2976RgX_to_Flx(y, pp), pp));2977}2978else2979r = FpX_rem(RgX_to_FpX(x, p), RgX_to_FpX(y, p), p);2980if (signe(r)==0) { set_avma(av); return zero_FpX_mod(p, varn(x)); }2981return gerepileupto(av, FpX_to_mod(r, p));2982}29832984static GEN2985RgX_rem_QXQX(GEN x, GEN y, GEN T)2986{2987pari_sp av = avma;2988GEN r;2989r = RgXQX_rem(RgX_liftred(x, T), RgX_liftred(y, T), T);2990return gerepilecopy(av, QXQX_to_mod_shallow(r, T));2991}2992static GEN2993RgX_rem_FpXQX(GEN x, GEN y, GEN pol, GEN p)2994{2995pari_sp av = avma;2996GEN r;2997GEN T = RgX_to_FpX(pol, p);2998if (signe(T) == 0) pari_err_OP("%", x, y);2999if (lgefint(p) == 3)3000{3001ulong pp = uel(p, 2);3002GEN Tp = ZX_to_Flx(T, pp);3003r = FlxX_to_ZXX(FlxqX_rem(RgX_to_FlxqX(x, Tp, pp),3004RgX_to_FlxqX(y, Tp, pp), Tp, pp));3005}3006else3007r = FpXQX_rem(RgX_to_FpXQX(x, T, p), RgX_to_FpXQX(y, T, p), T, p);3008if (signe(r)==0) { set_avma(av); return zero_FpXQX_mod(pol, p, varn(x)); }3009return gerepileupto(av, FpXQX_to_mod(r, T, p));3010}30113012#define code(t1,t2) ((t1 << 6) | t2)3013static GEN3014RgX_mul_fast(GEN x, GEN y)3015{3016GEN p, pol;3017long pa;3018long t = RgX_type2(x,y, &p,&pol,&pa);3019switch(t)3020{3021case t_INT: return ZX_mul(x,y);3022case t_FRAC: return QX_mul(x,y);3023case t_FFELT: return FFX_mul(x, y, pol);3024case t_INTMOD: return RgX_mul_FpX(x, y, p);3025case code(t_POLMOD, t_INT):3026case code(t_POLMOD, t_FRAC):3027return RgX_mul_QXQX(x, y, pol);3028case code(t_POLMOD, t_INTMOD):3029return RgX_mul_FpXQX(x, y, pol, p);3030default: return NULL;3031}3032}3033static GEN3034RgX_sqr_fast(GEN x)3035{3036GEN p, pol;3037long pa;3038long t = RgX_type(x,&p,&pol,&pa);3039switch(t)3040{3041case t_INT: return ZX_sqr(x);3042case t_FRAC: return QX_sqr(x);3043case t_FFELT: return FFX_sqr(x, pol);3044case t_INTMOD: return RgX_sqr_FpX(x, p);3045case code(t_POLMOD, t_INT):3046case code(t_POLMOD, t_FRAC):3047return RgX_sqr_QXQX(x, pol);3048case code(t_POLMOD, t_INTMOD):3049return RgX_sqr_FpXQX(x, pol, p);3050default: return NULL;3051}3052}30533054static GEN3055RgX_rem_fast(GEN x, GEN y)3056{3057GEN p, pol;3058long pa;3059long t = RgX_type2(x,y, &p,&pol,&pa);3060switch(t)3061{3062case t_INT: return ZX_is_monic(y) ? ZX_rem(x,y): NULL;3063case t_FRAC: return RgX_is_ZX(y) && ZX_is_monic(y) ? QX_ZX_rem(x,y): NULL;3064case t_FFELT: return FFX_rem(x, y, pol);3065case t_INTMOD: return RgX_rem_FpX(x, y, p);3066case code(t_POLMOD, t_INT):3067case code(t_POLMOD, t_FRAC):3068return RgX_rem_QXQX(x, y, pol);3069case code(t_POLMOD, t_INTMOD):3070return RgX_rem_FpXQX(x, y, pol, p);3071default: return NULL;3072}3073}30743075#undef code30763077GEN3078RgX_mul(GEN x, GEN y)3079{3080GEN z = RgX_mul_fast(x,y);3081if (!z) z = RgX_mul_i(x,y);3082return z;3083}30843085GEN3086RgX_sqr(GEN x)3087{3088GEN z = RgX_sqr_fast(x);3089if (!z) z = RgX_sqr_i(x);3090return z;3091}30923093GEN3094RgX_rem(GEN x, GEN y)3095{3096GEN z = RgX_rem_fast(x, y);3097if (!z) z = RgX_divrem_i(x, y, ONLY_REM);3098return z;3099}31003101GEN3102RgXn_mul(GEN f, GEN g, long n)3103{3104pari_sp av = avma;3105GEN h = RgX_mul_fast(f,g);3106if (!h) return RgXn_mul2(f,g,n);3107if (degpol(h) < n) return h;3108return gerepilecopy(av, RgXn_red_shallow(h, n));3109}31103111GEN3112RgXn_sqr(GEN f, long n)3113{3114pari_sp av = avma;3115GEN g = RgX_sqr_fast(f);3116if (!g) return RgXn_sqr2(f,n);3117if (degpol(g) < n) return g;3118return gerepilecopy(av, RgXn_red_shallow(g, n));3119}31203121/* (f*g) \/ x^n */3122GEN3123RgX_mulhigh_i(GEN f, GEN g, long n)3124{3125GEN h = RgX_mul_fast(f,g);3126return h? RgX_shift_shallow(h, -n): RgX_mulhigh_i2(f,g,n);3127}31283129/* (f*g) \/ x^n */3130GEN3131RgX_sqrhigh_i(GEN f, long n)3132{3133GEN h = RgX_sqr_fast(f);3134return h? RgX_shift_shallow(h, -n): RgX_sqrhigh_i2(f,n);3135}313631373138