static GEN
F2xqE_chord_update(GEN R, GEN P, GEN Q, GEN a2, GEN T, GEN *pt_R)
{
if (ell_is_inf(R))
{
*pt_R = gcopy(P);
return F2xqE_vert(P, Q, T);
}
else if (ell_is_inf(P))
{
*pt_R = gcopy(R);
return F2xqE_vert(R, Q, T);
}
else if (F2x_equal(gel(P, 1), gel(R, 1)))
{
if (F2x_equal(gel(P, 2), gel(R, 2)))
return F2xqE_tangent_update(R, Q, a2, T, pt_R);
else
{
*pt_R = ellinf();
return F2xqE_vert(R, Q, T);
}
} else {
GEN slope = NULL, tmp1, tmp2;
*pt_R = F2xqE_add_slope(P, R, a2, T, &slope);
tmp1 = F2xq_mul(F2x_add(gel(Q, 1), gel(R, 1)), slope, T);
tmp2 = F2x_add(tmp1, gel(R, 2));
return F2x_add(gel(Q, 2), tmp2);
}
}
/* to INT / FRAC / (POLMOD mod T), not memory clean because T not copied */
static GEN
RgXQ_to_mod(GEN x, GEN T)
{
long d;
switch(typ(x))
{
case t_INT: case t_FRAC:
return gcopy(x);
default:
d = degpol(x);
if (d < 0) return gen_0;
if (d == 0) return gcopy(gel(x,2));
return mkpolmod(gcopy(x), T);
}
}
/* Apply RgXQ_to_mod to all entries. Memory-clean ! */
static GEN
RgXQV_to_mod(GEN V, GEN T)
{
long i, l = lg(V);
GEN z = cgetg(l, t_VEC); T = gcopy(T);
for (i=1;i<l; i++) gel(z,i) = RgXQ_to_mod(gel(V,i), T);
return z;
}
static GEN
row_transposecopy(GEN A, long x0)
{
long i, lB = lg(A);
GEN B = cgetg(lB, t_COL);
for (i=1; i<lB; i++) gel(B, i) = gcopy(gcoeff(A, x0, i));
return B;
}
GEN
F2xqE_neg(GEN P, GEN a, GEN T)
{
GEN LHS;
(void) T;
if (ell_is_inf(P)) return ellinf();
LHS = typ(a)==t_VECSMALL ? gel(P,1): gel(a,1);
return mkvec2(gcopy(gel(P,1)), F2x_add(LHS, gel(P,2)));
}
GEN
gtrans(GEN x)
{
long i, dx, lx;
GEN y;
switch(typ(x))
{
case t_VEC: y = gcopy(x); settyp(y,t_COL); break;
case t_COL: y = gcopy(x); settyp(y,t_VEC); break;
case t_MAT:
lx = lg(x); if (lx==1) return cgetg(1,t_MAT);
dx = lgcols(x); y = cgetg(dx,t_MAT);
for (i = 1; i < dx; i++) gel(y,i) = row_transposecopy(x,i);
break;
default: pari_err_TYPE("gtrans",x); return NULL;
}
return y;
}
static GEN
unifpol0(GEN nf,GEN x,long flag)
{
switch(typ(x))
{
case t_INT: case t_FRAC:
return gcopy(x);
case t_POLMOD:
x = gel(x,2); /* fall through */
if (typ(x) != t_POL) return gcopy(x); /* scalar */
case t_POL:
if (!degpol(x)) return gcopy(constant_term(x));
return (flag == t_COL)? algtobasis(nf, x): gmodulo(x, gel(nf,1));
default: /* t_COL */
return (flag == t_COL)? gcopy(x): basistoalg(nf, x);
}
}
static GEN
_F2xqE_mul(void *E, GEN P, GEN n)
{
pari_sp av = avma;
struct _F2xqE *e=(struct _F2xqE *) E;
long s = signe(n);
if (!s || ell_is_inf(P)) return ellinf();
if (s<0) P = F2xqE_neg(P, e->a2, e->T);
if (is_pm1(n)) return s>0? gcopy(P): P;
return gerepileupto(av, gen_pow(P, n, e, &_F2xqE_dbl, &_F2xqE_add));
}
/* assume A or B is a t_LIST */
static GEN
listconcat(GEN A, GEN B)
{
long i, l1, lx;
GEN L, z, L1, L2;
if (typ(A) != t_LIST) {
if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L2 = list_data(B);
if (!L2) return mklistcopy(A);
lx = lg(L2) + 1;
z = listcreate();
list_data(z) = L = cgetg(lx, t_VEC);
for (i = 2; i < lx; i++) gel(L,i) = gcopy(gel(L2,i-1));
gel(L,1) = gcopy(A); return z;
} else if (typ(B) != t_LIST) {
if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
L1 = list_data(A);
if (!L1) return mklistcopy(B);
lx = lg(L1) + 1;
z = listcreate();
list_data(z) = L = cgetg(lx, t_VEC);
for (i = 1; i < lx-1; i++) gel(L,i) = gcopy(gel(L1,i));
gel(L,i) = gcopy(B); return z;
}
/* A, B both t_LISTs */
if (list_typ(A)!=t_LIST_RAW) pari_err_TYPE("listconcat",A);
if (list_typ(B)!=t_LIST_RAW) pari_err_TYPE("listconcat",B);
L1 = list_data(A); if (!L1) return listcopy(B);
L2 = list_data(B); if (!L2) return listcopy(A);
l1 = lg(L1);
lx = l1-1 + lg(L2);
z = cgetg(3, t_LIST);
z[1] = 0UL;
list_data(z) = L = cgetg(lx, t_VEC);
L2 -= l1-1;
for (i=1; i<l1; i++) gel(L,i) = gclone(gel(L1,i));
for ( ; i<lx; i++) gel(L,i) = gclone(gel(L2,i));
return z;
}
GEN
gpolvar(GEN x)
{
long v;
if (!x) {
GEN h = hash_values(h_polvar);
return vars_to_RgXV(vars_sort_inplace(h));
}
if (typ(x)==t_PADIC) return gcopy( gel(x,2) );
v = gvar(x);
if (v==NO_VARIABLE) return gen_0;
return pol_x(v);
}
GEN
subfields(GEN nf, GEN d0)
{
pari_sp av = avma;
long N, v0, d = itos(d0);
GEN LSB, pol, G;
poldata PD;
primedata S;
blockdata B;
pol = get_nfpol(nf, &nf); /* in order to treat trivial cases */
v0 = varn(pol); N = degpol(pol);
if (d == N) return gerepilecopy(av, _subfield(pol, pol_x[v0]));
if (d == 1) return gerepilecopy(av, _subfield(pol_x[v0], pol));
if (d < 1 || d > N || N % d) return cgetg(1,t_VEC);
/* much easier if nf is Galois (WSS) */
G = galoisconj4(nf? nf: pol, NULL, 1);
if (typ(G) != t_INT)
{ /* Bingo */
GEN L = galoissubgroups(G), F;
long k,i, l = lg(L), o = N/d;
F = cgetg(l, t_VEC);
k = 1;
for (i=1; i<l; i++)
{
GEN H = gel(L,i);
if (group_order(H) == o)
gel(F,k++) = lift_intern(galoisfixedfield(G, gel(H,1), 0, v0));
}
setlg(F, k);
return gerepilecopy(av, F);
}
subfields_poldata(nf? nf: pol, &PD);
B.PD = &PD;
B.S = &S;
B.N = N;
B.d = d;
B.size = N/d;
choose_prime(&S, PD.pol, PD.dis);
LSB = subfields_of_given_degree(&B);
(void)delete_var(); /* from choose_prime */
avma = av;
if (!LSB) return cgetg(1, t_VEC);
G = gcopy(LSB); gunclone(LSB);
return fix_var(G, v0);
}
/* return P(X + c) using destructive Horner, optimize for c = 1,-1 */
GEN
translate_pol(GEN P, GEN c)
{
pari_sp av = avma, lim;
GEN Q, *R;
long i, k, n;
if (!signe(P) || gcmp0(c)) return gcopy(P);
Q = shallowcopy(P);
R = (GEN*)(Q+2); n = degpol(P);
lim = stack_lim(av, 2);
if (gcmp1(c))
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gadd(R[k], R[k+1]);
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL(1), i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
else if (gcmp_1(c))
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gsub(R[k], R[k+1]);
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL(-1), i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
else
{
for (i=1; i<=n; i++)
{
for (k=n-i; k<n; k++) R[k] = gadd(R[k], gmul(c, R[k+1]));
if (low_stack(lim, stack_lim(av,2)))
{
if(DEBUGMEM>1) pari_warn(warnmem,"TR_POL, i = %ld/%ld", i,n);
Q = gerepilecopy(av, Q); R = (GEN*)Q+2;
}
}
}
return gerepilecopy(av, Q);
}
GEN
vecsum(GEN v)
{
pari_sp av = avma;
long i, l;
GEN p;
if (!is_vec_t(typ(v)))
pari_err_TYPE("vecsum", v);
l = lg(v);
if (l == 1) return gen_0;
p = gel(v,1);
if (l == 2) return gcopy(p);
for (i=2; i<l; i++)
{
p = gadd(p, gel(v,i));
if (gc_needed(av, 2))
{
if (DEBUGMEM>1) pari_warn(warnmem,"sum");
p = gerepileupto(av, p);
}
}
return gerepileupto(av, p);
}
GEN
concat(GEN x, GEN y)
{
long tx, lx,ty,ly,i;
GEN z,p1;
if (!y) return concat1(x);
tx = typ(x);
ty = typ(y);
if (tx==t_STR || ty==t_STR)
{
pari_sp av = avma;
return gerepileuptoleaf(av, strconcat(x,y));
}
if (tx==t_LIST || ty==t_LIST) return listconcat(x,y);
lx=lg(x); ly=lg(y);
if (tx==t_MAT && lx==1)
{
if (ty!=t_VEC) return gtomat(y);
if (ly==1) return cgetg(1, t_MAT);
err_cat(x,y);
}
if (ty==t_MAT && ly==1)
{
if (tx!=t_VEC) return gtomat(x);
if (lx==1) return cgetg(1, t_MAT);
err_cat(x,y);
}
if (tx == ty)
{
if (tx == t_MAT && lgcols(x) != lgcols(y)) err_cat(x,y);
if (!is_matvec_t(tx))
{
if (tx != t_VECSMALL) return mkvec2copy(x, y);
z = cgetg(lx+ly-1,t_VECSMALL);
for (i=1; i<lx; i++) z[i] = x[i];
for (i=1; i<ly; i++) z[lx+i-1]= y[i];
return z;
}
z=cgetg(lx+ly-1,tx);
for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
for (i=1; i<ly; i++) gel(z,lx+i-1)= gcopy(gel(y,i));
return z;
}
if (! is_matvec_t(tx))
{
if (! is_matvec_t(ty)) return mkvec2copy(x, y);
z=cgetg(ly+1,ty);
if (ty != t_MAT) p1 = gcopy(x);
else
{
if (lgcols(y)!=2) err_cat(x,y);
p1 = mkcolcopy(x);
}
for (i=2; i<=ly; i++) gel(z,i) = gcopy(gel(y,i-1));
gel(z,1) = p1; return z;
}
if (! is_matvec_t(ty))
{
z=cgetg(lx+1,tx);
if (tx != t_MAT) p1 = gcopy(y);
else
{
if (lgcols(x)!=2) err_cat(x,y);
p1 = mkcolcopy(y);
}
for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
gel(z,lx) = p1; return z;
}
switch(tx)
{
case t_VEC:
switch(ty)
{
case t_COL:
if (lx<=2) return (lx==1)? gcopy(y): concat(gel(x,1),y);
if (ly>=3) break;
return (ly==1)? gcopy(x): concat(x,gel(y,1));
case t_MAT:
z=cgetg(ly,t_MAT); if (lx != ly) break;
for (i=1; i<ly; i++) gel(z,i) = concat(gel(x,i),gel(y,i));
return z;
}
break;
case t_COL:
switch(ty)
{
case t_VEC:
if (lx<=2) return (lx==1)? gcopy(y): concat(gel(x,1),y);
if (ly>=3) break;
return (ly==1)? gcopy(x): concat(x,gel(y,1));
case t_MAT:
if (lx != lgcols(y)) break;
z=cgetg(ly+1,t_MAT); gel(z,1) = gcopy(x);
for (i=2; i<=ly; i++) gel(z,i) = gcopy(gel(y,i-1));
return z;
}
break;
case t_MAT:
switch(ty)
{
case t_VEC:
z=cgetg(lx,t_MAT); if (ly != lx) break;
for (i=1; i<lx; i++) gel(z,i) = concat(gel(x,i),gel(y,i));
return z;
case t_COL:
if (ly != lgcols(x)) break;
z=cgetg(lx+1,t_MAT); gel(z,lx) = gcopy(y);
for (i=1; i<lx; i++) gel(z,i) = gcopy(gel(x,i));
return z;
}
break;
}
err_cat(x,y);
return NULL; /* not reached */
}
/* return the factorization of x in nf */
GEN
nffactor(GEN nf,GEN pol)
{
GEN A,g,y,p1,T, rep = cgetg(3, t_MAT);
long l, j, dA;
pari_sp av = avma;
pari_timer ti;
if (DEBUGLEVEL>2) { TIMERstart(&ti); fprintferr("\nEntering nffactor:\n"); }
nf = checknf(nf); T = gel(nf,1);
if (typ(pol) != t_POL) pari_err(notpoler,"nffactor");
if (varncmp(varn(pol), varn(T)) >= 0)
pari_err(talker,"polynomial variable must have highest priority in nffactor");
A = fix_relative_pol(nf,pol,0);
dA = degpol(A);
if (dA <= 0) {
avma = (pari_sp)(rep + 3);
return dA == 0? trivfact(): zerofact(varn(pol));
}
A = Q_primpart( QXQX_normalize(A, T) );
if (dA == 1) {
GEN c;
A = gerepilecopy(av, A); c = gel(A,2);
if (typ(c) == t_POL && degpol(c) > 0) gel(A,2) = mkpolmod(c, gcopy(T));
gel(rep,1) = mkcol(A);
gel(rep,2) = mkcol(gen_1); return rep;
}
if (degpol(T) == 1)
return gerepileupto(av, factpol(Q_primpart(simplify(pol)), 0));
A = Q_primpart( lift_intern(A) );
g = nfgcd(A, derivpol(A), T, gel(nf,4));
A = QXQX_normalize(A, T);
A = Q_primpart(A);
if (DEBUGLEVEL>2) msgTIMER(&ti, "squarefree test");
if (degpol(g))
{ /* not squarefree */
pari_sp av1;
GEN ex;
g = QXQX_normalize(g, T);
A = RgXQX_div(A,g, T);
y = nfsqff(nf,A,0); av1 = avma;
l = lg(y);
ex=(GEN)gpmalloc(l * sizeof(long));
for (j=l-1; j>=1; j--)
{
GEN fact = lift(gel(y,j)), quo = g, q;
long e = 0;
for(e = 1;; e++)
{
q = RgXQX_divrem(quo,fact,T, ONLY_DIVIDES);
if (!q) break;
quo = q;
}
ex[j] = e;
}
avma = av1; y = gerepileupto(av, RgXQXV_to_mod(y,T));
p1 = cgetg(l, t_COL); for (j=l-1; j>=1; j--) gel(p1,j) = utoipos(ex[j]);
free(ex);
}
else
{
y = gerepileupto(av, RgXQXV_to_mod(nfsqff(nf,A,0), T));
l = lg(y);
p1 = cgetg(l, t_COL); for (j=l-1; j>=1; j--) gel(p1,j) = gen_1;
}
if (DEBUGLEVEL>3)
fprintferr("number of factor(s) found: %ld\n", lg(y)-1);
gel(rep,1) = y;
gel(rep,2) = p1; return sort_factor(rep, cmp_pol);
}
