Line data Source code
1 : /* Copyright (C) 2000 The PARI group.
2 :
3 : This file is part of the PARI/GP package.
4 :
5 : PARI/GP is free software; you can redistribute it and/or modify it under the
6 : terms of the GNU General Public License as published by the Free Software
7 : Foundation; either version 2 of the License, or (at your option) any later
8 : version. It is distributed in the hope that it will be useful, but WITHOUT
9 : ANY WARRANTY WHATSOEVER.
10 :
11 : Check the License for details. You should have received a copy of it, along
12 : with the package; see the file 'COPYING'. If not, write to the Free Software
13 : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
14 : #include "pari.h"
15 : #include "paripriv.h"
16 :
17 : #define DEBUGLEVEL DEBUGLEVEL_alg
18 :
19 : #define dbg_printf(lvl) if (DEBUGLEVEL >= (lvl) + 3) err_printf
20 :
21 : /********************************************************************/
22 : /** **/
23 : /** ASSOCIATIVE ALGEBRAS, CENTRAL SIMPLE ALGEBRAS **/
24 : /** contributed by Aurel Page (2014) **/
25 : /** **/
26 : /********************************************************************/
27 : static GEN alg_subalg(GEN al, GEN basis);
28 : static GEN alg_maximal_primes(GEN al, GEN P);
29 : static GEN algnatmultable(GEN al, long D);
30 : static GEN _tablemul_ej(GEN mt, GEN x, long j);
31 : static GEN _tablemul_ej_Fp(GEN mt, GEN x, long j, GEN p);
32 : static GEN _tablemul_ej_Fl(GEN mt, GEN x, long j, ulong p);
33 : static ulong algtracei(GEN mt, ulong p, ulong expo, ulong modu);
34 : static GEN alg_pmaximal(GEN al, GEN p);
35 : static GEN alg_maximal(GEN al);
36 : static GEN algtracematrix(GEN al);
37 : static GEN algtableinit_i(GEN mt0, GEN p);
38 : static GEN algbasisrightmultable(GEN al, GEN x);
39 : static GEN algbasismul(GEN al, GEN x, GEN y);
40 : static GEN algbasismultable(GEN al, GEN x);
41 : static GEN algbasismultable_Flm(GEN mt, GEN x, ulong m);
42 : static GEN algeltfromnf_i(GEN al, GEN x);
43 : static void computesplitting(GEN al, long d, long v, long flag);
44 : static GEN alg_change_overorder_shallow(GEN al, GEN ord);
45 :
46 : static GEN H_inv(GEN x);
47 : static GEN H_norm(GEN x, long abs);
48 : static GEN H_trace(GEN x, long abs);
49 :
50 : static int
51 1412171 : checkalg_i(GEN al)
52 : {
53 : GEN mt, rnf;
54 : long t;
55 1412171 : if (typ(al) != t_VEC || lg(al) != 12) return 0;
56 1411842 : mt = alg_get_multable(al);
57 1411842 : if (typ(mt) != t_VEC || lg(mt) == 1 || typ(gel(mt,1)) != t_MAT) return 0;
58 1411821 : rnf = alg_get_splittingfield(al);
59 1411821 : if (isintzero(rnf) || !gequal0(alg_get_char(al)))
60 544611 : return 1;
61 867210 : if (typ(gel(al,2)) != t_VEC || lg(gel(al,2)) == 1) return 0;
62 : /* not checkrnf_i: beware placeholder from alg_csa_table */
63 867203 : t = typ(rnf);
64 867203 : return t==t_COMPLEX || t==t_REAL || (t==t_VEC && lg(rnf)==13);
65 : }
66 : void
67 1539515 : checkalg(GEN al)
68 : {
69 1539515 : if (al && !checkalg_i(al))
70 203 : pari_err_TYPE("checkalg [please apply alginit()]",al);
71 1539312 : }
72 :
73 : static int
74 186858 : checklat_i(GEN al, GEN lat)
75 : {
76 : long N,i,j;
77 : GEN m,t,c;
78 186858 : if (typ(lat)!=t_VEC || lg(lat) != 3) return 0;
79 186858 : t = gel(lat,2);
80 186858 : if (typ(t) != t_INT && typ(t) != t_FRAC) return 0;
81 186858 : if (gsigne(t)<=0) return 0;
82 186858 : m = gel(lat,1);
83 186858 : if (typ(m) != t_MAT) return 0;
84 186858 : N = alg_get_absdim(al);
85 186858 : if (lg(m)-1 != N || lg(gel(m,1))-1 != N) return 0;
86 1686020 : for (i=1; i<=N; i++)
87 14154399 : for (j=1; j<=N; j++) {
88 12655237 : c = gcoeff(m,i,j);
89 12655237 : if (typ(c) != t_INT) return 0;
90 12655237 : if (j<i && signe(gcoeff(m,i,j))) return 0;
91 12655237 : if (i==j && !signe(gcoeff(m,i,j))) return 0;
92 : }
93 186851 : return 1;
94 : }
95 :
96 : void
97 186858 : checklat(GEN al, GEN lat)
98 186858 : { if (!checklat_i(al,lat)) pari_err_TYPE("checklat [please apply alglathnf()]", lat); }
99 :
100 : /** ACCESSORS **/
101 : long
102 10010080 : alg_type(GEN al)
103 : {
104 : long t;
105 10010080 : if (!al) return al_REAL;
106 9879887 : t = typ(alg_get_splittingfield(al));
107 9879887 : if (t==t_REAL || t==t_COMPLEX) return al_REAL;
108 9876366 : if (isintzero(alg_get_splittingfield(al)) || !gequal0(alg_get_char(al))) return al_TABLE;
109 7704334 : switch(typ(gmael(al,2,1))) {
110 1691116 : case t_MAT: return al_CSA;
111 6013183 : case t_INT:
112 : case t_FRAC:
113 : case t_POL:
114 6013183 : case t_POLMOD: return al_CYCLIC;
115 35 : default: return al_NULL;
116 : }
117 : return -1; /*LCOV_EXCL_LINE*/
118 : }
119 : long
120 2254 : algtype(GEN al)
121 2254 : { return checkalg_i(al)? alg_type(al): al_NULL; }
122 :
123 : static long /* is a square special case? */
124 1183 : alg_is_asq(GEN al) { return typ(gmael(al,6,1)) == t_VEC; }
125 :
126 : /* absdim == dim for al_TABLE. */
127 : static long
128 259 : algreal_dim(GEN al)
129 : {
130 259 : switch(lg(alg_get_multable(al))) {
131 161 : case 2: case 3: return 1;
132 91 : case 5: return 4;
133 7 : default: pari_err_TYPE("algreal_dim", al);
134 : }
135 : return -1; /*LCOV_EXCL_LINE*/
136 : }
137 : long
138 410708 : alg_get_dim(GEN al)
139 : {
140 : long d;
141 410708 : if (!al) return 4;
142 410708 : switch(alg_type(al)) {
143 19513 : case al_TABLE: return lg(alg_get_multable(al))-1;
144 391083 : case al_CSA: return lg(alg_get_relmultable(al))-1;
145 77 : case al_CYCLIC: d = alg_get_degree(al); return d*d;
146 28 : case al_REAL: return algreal_dim(al);
147 7 : default: pari_err_TYPE("alg_get_dim", al);
148 : }
149 : return -1; /*LCOV_EXCL_LINE*/
150 : }
151 :
152 : long
153 2563201 : alg_get_absdim(GEN al)
154 : {
155 2563201 : if (!al) return 4;
156 2516483 : switch(alg_type(al)) {
157 925161 : case al_TABLE: case al_REAL: return lg(alg_get_multable(al))-1;
158 198884 : case al_CSA: return alg_get_dim(al)*nf_get_degree(alg_get_center(al));
159 1392431 : case al_CYCLIC:
160 1392431 : return rnf_get_absdegree(alg_get_splittingfield(al))*alg_get_degree(al);
161 7 : default: pari_err_TYPE("alg_get_absdim", al);
162 : }
163 : return -1;/*LCOV_EXCL_LINE*/
164 : }
165 :
166 : long
167 6216 : algdim(GEN al, long abs)
168 : {
169 6216 : checkalg(al);
170 6195 : if (abs) return alg_get_absdim(al);
171 5551 : return alg_get_dim(al);
172 : }
173 :
174 : /* only cyclic */
175 : GEN
176 20937 : alg_get_auts(GEN al)
177 : {
178 20937 : long ta = alg_type(al);
179 20937 : if (ta != al_CYCLIC && ta != al_REAL)
180 0 : pari_err_TYPE("alg_get_auts [noncyclic algebra]", al);
181 20937 : return gel(al,2);
182 : }
183 : GEN
184 1169 : alg_get_aut(GEN al)
185 : {
186 1169 : long ta = alg_type(al);
187 1169 : if (ta != al_CYCLIC && ta != al_REAL)
188 28 : pari_err_TYPE("alg_get_aut [noncyclic algebra]", al);
189 1141 : return gel(alg_get_auts(al),1);
190 : }
191 : GEN
192 63 : algaut(GEN al) { checkalg(al); return alg_get_aut(al); }
193 : GEN
194 19992 : alg_get_b(GEN al)
195 : {
196 19992 : long ta = alg_type(al);
197 19992 : if (ta != al_CYCLIC && ta != al_REAL)
198 28 : pari_err_TYPE("alg_get_b [noncyclic algebra]", al);
199 19964 : return gel(al,3);
200 : }
201 : GEN
202 91 : algb(GEN al) { checkalg(al); return alg_get_b(al); }
203 :
204 : /* only CSA */
205 : GEN
206 394009 : alg_get_relmultable(GEN al)
207 : {
208 394009 : if (alg_type(al) != al_CSA)
209 14 : pari_err_TYPE("alg_get_relmultable [algebra not given via mult. table]", al);
210 393995 : return gel(al,2);
211 : }
212 : GEN
213 70 : algrelmultable(GEN al) { checkalg(al); return alg_get_relmultable(al); }
214 : GEN
215 84 : alg_get_splittingdata(GEN al)
216 : {
217 84 : if (alg_type(al) != al_CSA)
218 14 : pari_err_TYPE("alg_get_splittingdata [algebra not given via mult. table]",al);
219 70 : return gel(al,3);
220 : }
221 : GEN
222 84 : algsplittingdata(GEN al) { checkalg(al); return alg_get_splittingdata(al); }
223 : GEN
224 4347 : alg_get_splittingbasis(GEN al)
225 : {
226 4347 : if (alg_type(al) != al_CSA)
227 0 : pari_err_TYPE("alg_get_splittingbasis [algebra not given via mult. table]",al);
228 4347 : return gmael(al,3,2);
229 : }
230 : GEN
231 4347 : alg_get_splittingbasisinv(GEN al)
232 : {
233 4347 : if (alg_type(al) != al_CSA)
234 0 : pari_err_TYPE("alg_get_splittingbasisinv [algebra not given via mult. table]",al);
235 4347 : return gmael(al,3,3);
236 : }
237 :
238 : /* only cyclic and CSA */
239 : GEN
240 25830485 : alg_get_splittingfield(GEN al) { return gel(al,1); }
241 : GEN
242 161 : algsplittingfield(GEN al)
243 : {
244 : long ta;
245 161 : checkalg(al);
246 161 : ta = alg_type(al);
247 161 : if (ta != al_CYCLIC && ta != al_CSA && ta != al_REAL)
248 7 : pari_err_TYPE("alg_get_splittingfield [use alginit]",al);
249 154 : return alg_get_splittingfield(al);
250 : }
251 : long
252 2495193 : alg_get_degree(GEN al)
253 : {
254 : long ta;
255 2495193 : ta = alg_type(al);
256 2495193 : if (ta == al_REAL) return algreal_dim(al)==1? 1 : 2;
257 2495109 : if (ta != al_CYCLIC && ta != al_CSA)
258 21 : pari_err_TYPE("alg_get_degree [use alginit]",al);
259 2495088 : return rnf_get_degree(alg_get_splittingfield(al));
260 : }
261 : long
262 679 : algdegree(GEN al)
263 : {
264 679 : checkalg(al);
265 672 : return alg_get_degree(al);
266 : }
267 :
268 : GEN
269 542518 : alg_get_center(GEN al)
270 : {
271 : long ta;
272 542518 : ta = alg_type(al);
273 542518 : if (ta == al_REAL)
274 : {
275 28 : if (algreal_dim(al) != 4) return alg_get_splittingfield(al);
276 14 : return stor(1, LOWDEFAULTPREC);
277 : }
278 542490 : if (ta != al_CSA && ta != al_CYCLIC)
279 14 : pari_err_TYPE("alg_get_center [use alginit]",al);
280 542476 : return rnf_get_nf(alg_get_splittingfield(al));
281 : }
282 : GEN
283 315 : alg_get_splitpol(GEN al)
284 : {
285 315 : long ta = alg_type(al);
286 315 : if (ta != al_CYCLIC && ta != al_CSA)
287 0 : pari_err_TYPE("alg_get_splitpol [use alginit]",al);
288 315 : return rnf_get_pol(alg_get_splittingfield(al));
289 : }
290 : GEN
291 102957 : alg_get_abssplitting(GEN al)
292 : {
293 102957 : long ta = alg_type(al), prec;
294 102957 : if (ta != al_CYCLIC && ta != al_CSA)
295 0 : pari_err_TYPE("alg_get_abssplitting [use alginit]",al);
296 102957 : prec = nf_get_prec(alg_get_center(al));
297 102957 : return rnf_build_nfabs(alg_get_splittingfield(al), prec);
298 : }
299 : GEN
300 2212 : alg_get_hasse_i(GEN al)
301 : {
302 2212 : long ta = alg_type(al);
303 2212 : if (ta != al_CYCLIC && ta != al_CSA && ta != al_REAL)
304 7 : pari_err_TYPE("alg_get_hasse_i [use alginit]",al);
305 2205 : if (ta == al_CSA && !alg_is_asq(al))
306 21 : pari_err_IMPL("computation of Hasse invariants over table CSA");
307 2184 : return gel(al,4);
308 : }
309 : GEN
310 266 : alghassei(GEN al) { checkalg(al); return alg_get_hasse_i(al); }
311 : GEN
312 4564 : alg_get_hasse_f(GEN al)
313 : {
314 4564 : long ta = alg_type(al);
315 : GEN hf;
316 4564 : if (ta != al_CYCLIC && ta != al_CSA)
317 7 : pari_err_TYPE("alg_get_hasse_f [use alginit]",al);
318 4557 : if (ta == al_CSA && !alg_is_asq(al))
319 7 : pari_err_IMPL("computation of Hasse invariants over table CSA");
320 4550 : hf = gel(al,5);
321 4550 : if (typ(hf) == t_INT) /* could be computed on the fly */
322 35 : pari_err(e_MISC, "Hasse invariants were not computed for this algebra");
323 4515 : return hf;
324 : }
325 : GEN
326 364 : alghassef(GEN al) { checkalg(al); return alg_get_hasse_f(al); }
327 :
328 : /* all types */
329 : GEN
330 3297 : alg_get_basis(GEN al) { return gel(al,7); }
331 : GEN
332 154 : algbasis(GEN al) { checkalg(al); return alg_get_basis(al); }
333 : GEN
334 86738 : alg_get_invbasis(GEN al) { return gel(al,8); }
335 : GEN
336 84 : alginvbasis(GEN al) { checkalg(al); return alg_get_invbasis(al); }
337 : GEN
338 3759739 : alg_get_multable(GEN al) { return gel(al,9); }
339 : GEN
340 308 : algmultable(GEN al) { checkalg(al); return alg_get_multable(al); }
341 : GEN
342 11653443 : alg_get_char(GEN al) { if (!al) return gen_0; return gel(al,10); }
343 : GEN
344 112 : algchar(GEN al) { checkalg(al); return alg_get_char(al); }
345 : GEN
346 652287 : alg_get_tracebasis(GEN al) { return gel(al,11); }
347 : GEN
348 3774 : alg_get_invol(GEN al) { return gmael(al,6,2); }
349 :
350 : /* lattices */
351 : GEN
352 251188 : alglat_get_primbasis(GEN lat) { return gel(lat,1); }
353 : GEN
354 296779 : alglat_get_scalar(GEN lat) { return gel(lat,2); }
355 :
356 : /* algmodpr */
357 : GEN
358 3948 : algmodpr_get_pr(GEN data) { return gel(data,1); }
359 : long
360 5005 : algmodpr_get_k(GEN data) { return gel(data,2)[1]; } /* target M_k(F_p^m) */
361 : long
362 2219 : algmodpr_get_m(GEN data) { return gel(data,2)[2]; } /* target M_k(F_p^m) */
363 : GEN
364 1715 : algmodpr_get_ff(GEN data) { return gel(data,3); }
365 : GEN
366 1708 : algmodpr_get_proj(GEN data) { return gel(data,4); }
367 : GEN
368 3003 : algmodpr_get_lift(GEN data) { return gel(data,5); }
369 : GEN
370 1729 : algmodpr_get_tau(GEN data) { return gel(data,6); }
371 : GEN
372 3948 : algmodpr_get_p(GEN data) { return pr_get_p(algmodpr_get_pr(data)); }
373 : GEN
374 3801 : algmodpr_get_T(GEN data) { return gel(data,2)[2]==1 ? NULL : gel(data,7); }
375 :
376 : /** ADDITIONAL **/
377 :
378 : /* is N=smooth*prime? */
379 : static int
380 12133 : Z_easyfactor(GEN N, ulong lim)
381 : {
382 : GEN fa;
383 12133 : if (lgefint(N) <= 3) return 1;
384 10325 : fa = absZ_factor_limit(N, lim);
385 10325 : return BPSW_psp(veclast(gel(fa,1)));
386 : }
387 :
388 : /* no garbage collection */
389 : static GEN
390 1827 : backtrackfacto(GEN y0, long n, GEN red, GEN pl, GEN nf, GEN data, int (*test)(GEN,GEN), GEN* fa, GEN N, GEN I)
391 : {
392 : long b, i;
393 1827 : ulong lim = 1UL << 17;
394 1827 : long *v = new_chunk(n+1);
395 1827 : pari_sp av = avma;
396 1827 : for (b = 0;; b += (2*b)/(3*n) + 1)
397 377 : {
398 : GEN ny, y1, y2;
399 2204 : set_avma(av);
400 6472 : for (i = 1; i <= n; i++) v[i] = -b;
401 2204 : v[n]--;
402 : for(;;)
403 : {
404 14883 : i = n;
405 15575 : while (i > 0)
406 15198 : { if (v[i] == b) v[i--] = -b; else { v[i]++; break; } }
407 14883 : if (i==0) break;
408 :
409 14506 : y1 = y0;
410 32271 : for (i = 1; i <= n; i++) y1 = nfadd(nf, y1, ZC_z_mul(gel(red,i), v[i]));
411 14506 : if (!nfchecksigns(nf, y1, pl)) continue;
412 :
413 12133 : ny = absi_shallow(nfnorm(nf, y1));
414 12133 : if (!signe(ny)) continue;
415 12133 : ny = diviiexact(ny, gcdii(ny, N));
416 12133 : if (!Z_easyfactor(ny, lim)) continue;
417 :
418 2323 : y2 = idealdivexact(nf, y1, idealadd(nf,y1,I));
419 2323 : *fa = idealfactor(nf, y2);
420 2323 : if (!data || test(data,*fa)) return y1;
421 : }
422 : }
423 : }
424 :
425 : /* if data == NULL, the test is skipped */
426 : /* in the test, the factorization does not contain the known factors */
427 : static GEN
428 1827 : factoredextchinesetest(GEN nf, GEN x, GEN y, GEN pl, GEN* fa, GEN data, int (*test)(GEN,GEN))
429 : {
430 1827 : pari_sp av = avma;
431 : long n,i;
432 1827 : GEN x1, y0, y1, red, N, I, P = gel(x,1), E = gel(x,2);
433 1827 : n = nf_get_degree(nf);
434 1827 : x = idealchineseinit(nf, mkvec2(x,pl));
435 1827 : x1 = gel(x,1);
436 1827 : red = lg(x1) == 1? matid(n): gmael(x1,1,1);
437 1827 : y0 = idealchinese(nf, x, y);
438 :
439 1827 : E = shallowcopy(E);
440 1827 : if (!gequal0(y0))
441 7811 : for (i=1; i<lg(E); i++)
442 : {
443 5984 : long v = nfval(nf,y0,gel(P,i));
444 5984 : if (cmpsi(v, gel(E,i)) < 0) gel(E,i) = stoi(v);
445 : }
446 : /* N and I : known factors */
447 1827 : I = factorbackprime(nf, P, E);
448 1827 : N = idealnorm(nf,I);
449 :
450 1827 : y1 = backtrackfacto(y0, n, red, pl, nf, data, test, fa, N, I);
451 :
452 : /* restore known factors */
453 7811 : for (i=1; i<lg(E); i++) gel(E,i) = stoi(nfval(nf,y1,gel(P,i)));
454 1827 : *fa = famat_reduce(famat_mul_shallow(*fa, mkmat2(P, E)));
455 1827 : return gc_all(av, 2, &y1, fa);
456 : }
457 :
458 : static GEN
459 1414 : factoredextchinese(GEN nf, GEN x, GEN y, GEN pl, GEN* fa)
460 1414 : { return factoredextchinesetest(nf,x,y,pl,fa,NULL,NULL); }
461 :
462 : /** OPERATIONS ON ASSOCIATIVE ALGEBRAS algebras.c **/
463 :
464 : /*
465 : Convention:
466 : (K/F,sigma,b) = sum_{i=0..n-1} u^i*K
467 : t*u = u*sigma(t)
468 :
469 : Natural basis:
470 : 1<=i<=d*n^2
471 : b_i = u^((i-1)/(dn))*ZKabs.((i-1)%(dn)+1)
472 :
473 : Integral basis:
474 : Basis of some order.
475 :
476 : al structure:
477 : 1- rnf of the cyclic splitting field of degree n over the center nf of degree d
478 : 2- VEC of aut^i 1<=i<=n if n>1, or i=0 if n=1
479 : 3- b in nf
480 : 4- infinite hasse invariants (mod n) : VECSMALL of size r1, values only 0 or n/2 (if integral)
481 : 5- finite hasse invariants (mod n) : VEC[sorted VEC of primes, VECSMALL of hasse inv mod n]
482 : 6- VEC
483 : 6.1- 0, or [a,b,sa] where sa^2=a if al is quaternion algebra (a,b)
484 : 6.2- dn^2*dn^2 matrix of stored involution
485 : 7* dn^2*dn^2 matrix expressing the integral basis in terms of the natural basis
486 : 8* dn^2*dn^2 matrix expressing the natural basis in terms of the integral basis
487 : 9* VEC of dn^2 matrices giving the dn^2*dn^2 left multiplication tables of the integral basis
488 : 10* characteristic of the base field (used only for algebras given by a multiplication table)
489 : 11* trace of basis elements
490 :
491 : If al is given by a multiplication table (al_TABLE), only the * fields are present.
492 : The other ones are filled with gen_0 placeholders.
493 : */
494 :
495 : /* assumes same center and same variable */
496 : /* currently only works for coprime degrees */
497 : GEN
498 84 : algtensor(GEN al1, GEN al2, long flag) {
499 84 : pari_sp av = avma;
500 : long v, k, d1, d2;
501 : GEN nf, P1, P2, aut1, aut2, b1, b2, C, rnf, aut, b, x1, x2, al, rnfpol;
502 :
503 84 : checkalg(al1);
504 70 : checkalg(al2);
505 63 : if (alg_type(al1) != al_CYCLIC || alg_type(al2) != al_CYCLIC)
506 21 : pari_err_IMPL("tensor of noncyclic algebras"); /* TODO: do it. */
507 :
508 42 : nf = alg_get_center(al1);
509 42 : if (!gequal(alg_get_center(al2),nf))
510 7 : pari_err_OP("tensor product [not the same center]", al1, al2);
511 :
512 35 : P1=alg_get_splitpol(al1); aut1=alg_get_aut(al1); b1=alg_get_b(al1);
513 35 : P2=alg_get_splitpol(al2); aut2=alg_get_aut(al2); b2=alg_get_b(al2);
514 35 : v=varn(P1);
515 :
516 35 : d1=alg_get_degree(al1);
517 35 : d2=alg_get_degree(al2);
518 35 : if (ugcd(d1,d2) != 1)
519 7 : pari_err_IMPL("tensor of cyclic algebras of noncoprime degrees"); /* TODO */
520 :
521 28 : if (d1==1) return gcopy(al2);
522 21 : if (d2==1) return gcopy(al1);
523 :
524 14 : C = nfcompositum(nf, P1, P2, 3);
525 14 : rnfpol = gel(C,1);
526 14 : if (!(flag & al_FACTOR)) rnfpol = mkvec2(rnfpol, stoi(1<<20));
527 14 : rnf = rnfinit(nf, rnfpol);
528 : /* TODO use integral basis of P1 and P2 to get that of C */
529 14 : x1 = gel(C,2);
530 14 : x2 = gel(C,3);
531 14 : k = itos(gel(C,4));
532 14 : aut = gadd(gsubst(aut2,v,x2),gmulsg(k,gsubst(aut1,v,x1)));
533 14 : b = nfmul(nf,nfpow_u(nf,b1,d2),nfpow_u(nf,b2,d1));
534 14 : al = alg_cyclic(rnf, aut, b, flag);
535 14 : return gc_GEN(av,al);
536 : }
537 :
538 : /* M an n x d Flm of rank d, n >= d. Initialize Mx = y solver */
539 : static GEN
540 8913 : Flm_invimage_init(GEN M, ulong p)
541 : {
542 8913 : GEN v = Flm_indexrank(M, p), perm = gel(v,1);
543 8913 : GEN MM = rowpermute(M, perm); /* square invertible */
544 8913 : return mkvec2(Flm_inv(MM,p), perm);
545 : }
546 : /* assume Mx = y has a solution, v = Flm_invimage_init(M,p); return x */
547 : static GEN
548 619387 : Flm_invimage_pre(GEN v, GEN y, ulong p)
549 : {
550 619387 : GEN inv = gel(v,1), perm = gel(v,2);
551 619387 : return Flm_Flc_mul(inv, vecsmallpermute(y, perm), p);
552 : }
553 :
554 : GEN
555 14760 : algradical(GEN al)
556 : {
557 14760 : pari_sp av = avma;
558 : GEN I, x, traces, K, MT, P, mt;
559 : long l,i,ni, n;
560 : ulong modu, expo, p;
561 14760 : checkalg(al);
562 14760 : if (alg_type(al) != al_TABLE) return gen_0;
563 14669 : P = alg_get_char(al);
564 14669 : mt = alg_get_multable(al);
565 14669 : n = alg_get_absdim(al);
566 14669 : dbg_printf(1)("algradical: char=%Ps, dim=%d\n", P, n);
567 14669 : traces = algtracematrix(al);
568 14669 : if (!signe(P))
569 : {
570 546 : dbg_printf(2)(" char 0, computing kernel...\n");
571 546 : K = ker(traces);
572 546 : dbg_printf(2)(" ...done.\n");
573 546 : ni = lg(K)-1; if (!ni) return gc_const(av, gen_0);
574 70 : return gc_upto(av, K);
575 : }
576 14123 : dbg_printf(2)(" char>0, computing kernel...\n");
577 14123 : K = FpM_ker(traces, P);
578 14123 : dbg_printf(2)(" ...done.\n");
579 14123 : ni = lg(K)-1; if (!ni) return gc_const(av, gen_0);
580 7815 : if (abscmpiu(P,n)>0) return gc_upto(av, K);
581 :
582 : /* tough case, p <= n. Ronyai's algorithm */
583 4940 : p = P[2]; l = 1;
584 4940 : expo = p; modu = p*p;
585 4940 : dbg_printf(2)(" char>0, hard case.\n");
586 9601 : while (modu<=(ulong)n) { l++; modu *= p; }
587 4940 : MT = ZMV_to_FlmV(mt, modu);
588 4940 : I = ZM_to_Flm(K,p); /* I_0 */
589 13306 : for (i=1; i<=l; i++) {/*compute I_i, expo = p^i, modu = p^(l+1) > n*/
590 : long j, lig,col;
591 8913 : GEN v = cgetg(ni+1, t_VECSMALL);
592 8913 : GEN invI = Flm_invimage_init(I, p);
593 8913 : dbg_printf(2)(" computing I_%d:\n", i);
594 8913 : traces = cgetg(ni+1,t_MAT);
595 60273 : for (j = 1; j <= ni; j++)
596 : {
597 51360 : GEN M = algbasismultable_Flm(MT, gel(I,j), modu);
598 51360 : uel(v,j) = algtracei(M, p,expo,modu);
599 : }
600 60273 : for (col=1; col<=ni; col++)
601 : {
602 51360 : GEN t = cgetg(n+1,t_VECSMALL); gel(traces,col) = t;
603 51360 : x = gel(I, col); /*col-th basis vector of I_{i-1}*/
604 670747 : for (lig=1; lig<=n; lig++)
605 : {
606 619387 : GEN y = _tablemul_ej_Fl(MT,x,lig,p);
607 619387 : GEN z = Flm_invimage_pre(invI, y, p);
608 619387 : uel(t,lig) = Flv_dotproduct(v, z, p);
609 : }
610 : }
611 8913 : dbg_printf(2)(" computing kernel...\n");
612 8913 : K = Flm_ker(traces, p);
613 8913 : dbg_printf(2)(" ...done.\n");
614 8913 : ni = lg(K)-1; if (!ni) return gc_const(av, gen_0);
615 8366 : I = Flm_mul(I,K,p);
616 8366 : expo *= p;
617 : }
618 4393 : return Flm_to_ZM(I);
619 : }
620 :
621 : /* compute the multiplication table of the element x, where mt is a
622 : * multiplication table in an arbitrary ring */
623 : static GEN
624 476 : Rgmultable(GEN mt, GEN x)
625 : {
626 476 : long i, l = lg(x);
627 476 : GEN z = NULL;
628 6188 : for (i = 1; i < l; i++)
629 : {
630 5712 : GEN c = gel(x,i);
631 5712 : if (!gequal0(c))
632 : {
633 714 : GEN M = RgM_Rg_mul(gel(mt,i),c);
634 714 : z = z? RgM_add(z, M): M;
635 : }
636 : }
637 476 : return z;
638 : }
639 :
640 : static GEN
641 56 : change_Rgmultable(GEN mt, GEN P, GEN Pi)
642 : {
643 : GEN mt2;
644 56 : long lmt = lg(mt), i;
645 56 : mt2 = cgetg(lmt,t_VEC);
646 532 : for (i=1;i<lmt;i++) {
647 476 : GEN mti = Rgmultable(mt,gel(P,i));
648 476 : gel(mt2,i) = RgM_mul(Pi, RgM_mul(mti,P));
649 : }
650 56 : return mt2;
651 : }
652 :
653 : /* S: lift (basis of quotient) ; Si: proj */
654 : static GEN
655 38033 : alg_quotient0(GEN al, GEN S, GEN Si, long nq, GEN p, long maps)
656 : {
657 38033 : GEN mt = cgetg(nq+1,t_VEC), P, Pi, d;
658 : long i;
659 38033 : dbg_printf(3)(" alg_quotient0: char=%Ps, dim=%d, dim I=%d\n", p, alg_get_absdim(al), lg(S)-1);
660 173722 : for (i=1; i<=nq; i++) {
661 135689 : GEN mti = algbasismultable(al,gel(S,i));
662 135689 : if (signe(p)) gel(mt,i) = FpM_mul(Si, FpM_mul(mti,S,p), p);
663 6076 : else gel(mt,i) = RgM_mul(Si, RgM_mul(mti,S));
664 : }
665 38033 : if (!signe(p) && !isint1(Q_denom(mt))) {
666 42 : dbg_printf(3)(" bad case: denominator=%Ps\n", Q_denom(mt));
667 42 : P = Q_remove_denom(Si,&d);
668 42 : P = ZM_hnf(P);
669 42 : P = RgM_Rg_div(P,d); /* P: new basis (Z-basis of image of order in al) */
670 42 : Pi = RgM_inv(P);
671 42 : mt = change_Rgmultable(mt,P,Pi);
672 42 : Si = RgM_mul(Pi,Si);
673 42 : S = RgM_mul(S,P);
674 : }
675 38033 : al = algtableinit_i(mt,p);
676 38033 : if (maps) al = mkvec3(al,Si,S); /* algebra, proj, lift */
677 38033 : return al;
678 : }
679 :
680 : /* quotient of an algebra by a nontrivial two-sided ideal */
681 : GEN
682 12235 : alg_quotient(GEN al, GEN I, long maps)
683 : {
684 12235 : pari_sp av = avma;
685 : GEN p, IS, ISi, S, Si;
686 : long n, ni;
687 :
688 12235 : checkalg(al);
689 12235 : if (alg_type(al) != al_TABLE) pari_err_TYPE("alg_quotient [not a table algebra]", al);
690 12228 : p = alg_get_char(al);
691 12228 : n = alg_get_absdim(al);
692 12228 : ni = lg(I)-1;
693 :
694 : /* force first vector of complement to be the identity */
695 12228 : IS = shallowconcat(I, gcoeff(alg_get_multable(al),1,1));
696 12228 : if (signe(p)) {
697 12200 : IS = FpM_suppl(IS,p);
698 12200 : ISi = FpM_inv(IS,p);
699 : }
700 : else {
701 28 : IS = suppl(IS);
702 28 : ISi = RgM_inv(IS);
703 : }
704 12228 : S = vecslice(IS, ni+1, n);
705 12228 : Si = rowslice(ISi, ni+1, n);
706 12228 : return gc_GEN(av, alg_quotient0(al, S, Si, n-ni, p, maps));
707 : }
708 :
709 : static GEN
710 39163 : image_keep_first(GEN m, GEN p) /* assume first column is nonzero or m==0, no GC */
711 : {
712 : GEN ir, icol, irow, M, c, x;
713 : long i;
714 39163 : if (gequal0(gel(m,1))) return zeromat(nbrows(m),0);
715 :
716 39149 : if (signe(p)) ir = FpM_indexrank(m,p);
717 1708 : else ir = indexrank(m);
718 :
719 39149 : icol = gel(ir,2);
720 39149 : if (icol[1]==1) return extract0(m,icol,NULL);
721 :
722 15 : irow = gel(ir,1);
723 15 : M = extract0(m, irow, icol);
724 15 : c = extract0(gel(m,1), irow, NULL);
725 15 : if (signe(p)) x = FpM_FpC_invimage(M,c,p);
726 0 : else x = inverseimage(M,c); /* TODO modulo a small prime */
727 :
728 22 : for (i=1; i<lg(x); i++)
729 : {
730 22 : if (!gequal0(gel(x,i)))
731 : {
732 15 : icol[i] = 1;
733 15 : vecsmall_sort(icol);
734 15 : return extract0(m,icol,NULL);
735 : }
736 : }
737 :
738 : return NULL; /* LCOV_EXCL_LINE */
739 : }
740 :
741 : /* z[1],...z[nz] central elements such that z[1]A + z[2]A + ... + z[nz]A = A
742 : * is a direct sum. idempotents ==> first basis element is identity */
743 : GEN
744 12544 : alg_centralproj(GEN al, GEN z, long maps)
745 : {
746 12544 : pari_sp av = avma;
747 : GEN S, U, Ui, alq, p;
748 12544 : long i, iu, lz = lg(z), ta;
749 :
750 12544 : checkalg(al);
751 12544 : ta = alg_type(al);
752 12544 : if (ta != al_TABLE) pari_err_TYPE("algcentralproj [not a table algebra]", al);
753 12537 : if (typ(z) != t_VEC) pari_err_TYPE("alcentralproj",z);
754 12530 : p = alg_get_char(al);
755 12530 : dbg_printf(3)(" alg_centralproj: char=%Ps, dim=%d, #z=%d\n", p, alg_get_absdim(al), lz-1);
756 12530 : S = cgetg(lz,t_VEC); /* S[i] = Im(z_i) */
757 38349 : for (i=1; i<lz; i++)
758 : {
759 25819 : GEN mti = algbasismultable(al, gel(z,i));
760 25819 : gel(S,i) = image_keep_first(mti,p);
761 : }
762 12530 : U = shallowconcat1(S); /* U = [Im(z_1)|Im(z_2)|...|Im(z_nz)], n x n */
763 12530 : if (lg(U)-1 < alg_get_absdim(al)) pari_err_TYPE("alcentralproj [z[i]'s not surjective]",z);
764 12523 : if (signe(p)) Ui = FpM_inv(U,p);
765 854 : else Ui = RgM_inv(U);
766 : if (!Ui) pari_err_BUG("alcentralproj"); /*LCOV_EXCL_LINE*/
767 :
768 12523 : alq = cgetg(lz,t_VEC);
769 38328 : for (iu=0,i=1; i<lz; i++)
770 : {
771 25805 : long nq = lg(gel(S,i))-1, ju = iu + nq;
772 25805 : GEN Si = rowslice(Ui, iu+1, ju);
773 25805 : gel(alq, i) = alg_quotient0(al,gel(S,i),Si,nq,p,maps);
774 25805 : iu = ju;
775 : }
776 12523 : return gc_GEN(av, alq);
777 : }
778 :
779 : /* al is an al_TABLE */
780 : static GEN
781 33041 : algtablecenter(GEN al)
782 : {
783 33041 : pari_sp av = avma;
784 : long n, i, j, k, ic;
785 : GEN C, cij, mt, p;
786 :
787 33041 : n = alg_get_absdim(al);
788 33041 : mt = alg_get_multable(al);
789 33041 : p = alg_get_char(al);
790 33041 : C = cgetg(n+1,t_MAT);
791 157973 : for (j=1; j<=n; j++)
792 : {
793 124932 : gel(C,j) = cgetg(n*n-n+1,t_COL);
794 124932 : ic = 1;
795 1117394 : for (i=2; i<=n; i++) {
796 992462 : if (signe(p)) cij = FpC_sub(gmael(mt,i,j),gmael(mt,j,i),p);
797 57694 : else cij = RgC_sub(gmael(mt,i,j),gmael(mt,j,i));
798 19693518 : for (k=1; k<=n; k++, ic++) gcoeff(C,ic,j) = gel(cij, k);
799 : }
800 : }
801 33041 : if (signe(p)) return gc_upto(av, FpM_ker(C,p));
802 1785 : else return gc_upto(av, ker(C));
803 : }
804 :
805 : GEN
806 11795 : algcenter(GEN al)
807 : {
808 11795 : checkalg(al);
809 11795 : if (alg_type(al)==al_TABLE) return algtablecenter(al);
810 2821 : return alg_get_center(al);
811 : }
812 :
813 : /* Only in positive characteristic. Assumes that al is semisimple. */
814 : GEN
815 9580 : algprimesubalg(GEN al)
816 : {
817 9580 : pari_sp av = avma;
818 : GEN p, Z, F, K;
819 : long nz, i;
820 9580 : checkalg(al);
821 9580 : p = alg_get_char(al);
822 9580 : if (!signe(p)) pari_err_DOMAIN("algprimesubalg","characteristic","=",gen_0,p);
823 :
824 9566 : Z = algtablecenter(al);
825 9566 : nz = lg(Z)-1;
826 9566 : if (nz==1) return Z;
827 :
828 6723 : F = cgetg(nz+1, t_MAT);
829 28277 : for (i=1; i<=nz; i++) {
830 21554 : GEN zi = gel(Z,i);
831 21554 : gel(F,i) = FpC_sub(algpow(al,zi,p),zi,p);
832 : }
833 6723 : K = FpM_ker(F,p);
834 6723 : return gc_upto(av, FpM_mul(Z,K,p));
835 : }
836 :
837 : static GEN
838 19835 : out_decompose(GEN t, GEN Z, GEN P, GEN p)
839 : {
840 19835 : GEN ali = gel(t,1), projm = gel(t,2), liftm = gel(t,3), pZ;
841 19835 : if (signe(p)) pZ = FpM_image(FpM_mul(projm,Z,p),p);
842 1617 : else pZ = image(RgM_mul(projm,Z));
843 19835 : return mkvec5(ali, projm, liftm, pZ, P);
844 : }
845 : /* fa factorization of charpol(x) */
846 : static GEN
847 9956 : alg_decompose_from_facto(GEN al, GEN x, GEN fa, GEN Z, long mini)
848 : {
849 9956 : long k = lgcols(fa)-1, k2 = mini? 1: k/2;
850 9956 : GEN v1 = rowslice(fa,1,k2);
851 9956 : GEN v2 = rowslice(fa,k2+1,k);
852 9956 : GEN alq, P, Q, p = alg_get_char(al);
853 9956 : dbg_printf(3)(" alg_decompose_from_facto\n");
854 9956 : if (signe(p)) {
855 9130 : P = FpXV_factorback(gel(v1,1), gel(v1,2), p, 0);
856 9130 : Q = FpXV_factorback(gel(v2,1), gel(v2,2), p, 0);
857 9130 : P = FpX_mul(P, FpXQ_inv(P,Q,p), p);
858 : }
859 : else {
860 826 : P = factorback(v1);
861 826 : Q = factorback(v2);
862 826 : P = RgX_mul(P, RgXQ_inv(P,Q));
863 : }
864 9956 : P = algpoleval(al, P, x);
865 9956 : if (signe(p)) Q = FpC_sub(col_ei(lg(P)-1,1), P, p);
866 826 : else Q = gsub(gen_1, P);
867 9956 : if (gequal0(P) || gequal0(Q)) return NULL;
868 9956 : alq = alg_centralproj(al, mkvec2(P,Q), 1);
869 :
870 9956 : P = out_decompose(gel(alq,1), Z, P, p); if (mini) return P;
871 9879 : Q = out_decompose(gel(alq,2), Z, Q, p);
872 9879 : return mkvec2(P,Q);
873 : }
874 :
875 : static GEN
876 15227 : random_pm1(long n)
877 : {
878 15227 : GEN z = cgetg(n+1,t_VECSMALL);
879 : long i;
880 62963 : for (i = 1; i <= n; i++) z[i] = random_bits(5)%3 - 1;
881 15227 : return z;
882 : }
883 :
884 : static GEN alg_decompose(GEN al, GEN Z, long mini, GEN* pt_primelt);
885 : /* Try to split al using x's charpoly. Return gen_0 if simple, NULL if failure.
886 : * And a splitting otherwise
887 : * If pt_primelt!=NULL, compute a primitive element of the center when simple */
888 : static GEN
889 18271 : try_fact(GEN al, GEN x, GEN zx, GEN Z, GEN Zal, long mini, GEN* pt_primelt)
890 : {
891 18271 : GEN z, dec0, dec1, cp = algcharpoly(Zal,zx,0,1), fa, p = alg_get_char(al);
892 : long nfa, e;
893 18271 : dbg_printf(3)(" try_fact: zx=%Ps\n", zx);
894 18271 : if (signe(p)) fa = FpX_factor(cp,p);
895 1519 : else fa = factor(cp);
896 18271 : dbg_printf(3)(" charpoly=%Ps\n", fa);
897 18271 : nfa = nbrows(fa);
898 18271 : if (nfa == 1) {
899 8315 : if (signe(p)) e = gel(fa,2)[1];
900 693 : else e = itos(gcoeff(fa,1,2));
901 8315 : if (e == 1) {
902 4487 : if (pt_primelt != NULL) *pt_primelt = mkvec2(x, cp);
903 4487 : return gen_0;
904 : }
905 3828 : else return NULL;
906 : }
907 9956 : dec0 = alg_decompose_from_facto(al, x, fa, Z, mini);
908 9956 : if (!dec0) return NULL;
909 9956 : if (!mini) return dec0;
910 77 : dec1 = alg_decompose(gel(dec0,1), gel(dec0,4), 1, pt_primelt);
911 77 : z = gel(dec0,5);
912 77 : if (!isintzero(dec1)) {
913 7 : if (signe(p)) z = FpM_FpC_mul(gel(dec0,3),dec1,p);
914 7 : else z = RgM_RgC_mul(gel(dec0,3),dec1);
915 : }
916 77 : return z;
917 : }
918 : static GEN
919 7 : randcol(long n, GEN b)
920 : {
921 7 : GEN N = addiu(shifti(b,1), 1);
922 : long i;
923 7 : GEN res = cgetg(n+1,t_COL);
924 63 : for (i=1; i<=n; i++)
925 : {
926 56 : pari_sp av = avma;
927 56 : gel(res,i) = gc_INT(av, subii(randomi(N),b));
928 : }
929 7 : return res;
930 : }
931 : /* Return gen_0 if already simple. mini: only returns a central idempotent
932 : * corresponding to one simple factor
933 : * if pt_primelt!=NULL, sets it to a primitive element of the center when simple */
934 : static GEN
935 28356 : alg_decompose(GEN al, GEN Z, long mini, GEN* pt_primelt)
936 : {
937 : pari_sp av;
938 : GEN Zal, x, zx, rand, dec0, B, p;
939 28356 : long i, nz = lg(Z)-1;
940 :
941 28356 : if (nz == 1) {
942 13913 : if (pt_primelt != 0) *pt_primelt = mkvec2(zerocol(alg_get_dim(al)), pol_x(0));
943 13913 : return gen_0;
944 : }
945 14443 : p = alg_get_char(al);
946 14443 : dbg_printf(2)(" alg_decompose: char=%Ps, dim=%d, dim Z=%d\n", p, alg_get_absdim(al), nz);
947 14443 : Zal = alg_subalg(al,Z);
948 14443 : Z = gel(Zal,2);
949 14443 : Zal = gel(Zal,1);
950 14443 : av = avma;
951 :
952 14443 : rand = random_pm1(nz);
953 14443 : zx = zc_to_ZC(rand);
954 14443 : if (signe(p)) {
955 13295 : zx = FpC_red(zx,p);
956 13295 : x = ZM_zc_mul(Z,rand);
957 13295 : x = FpC_red(x,p);
958 : }
959 1148 : else x = RgM_zc_mul(Z,rand);
960 14443 : dec0 = try_fact(al,x,zx,Z,Zal,mini,pt_primelt);
961 14443 : if (dec0) return dec0;
962 3758 : set_avma(av);
963 :
964 3828 : for (i=2; i<=nz; i++)
965 : {
966 3821 : dec0 = try_fact(al,gel(Z,i),col_ei(nz,i),Z,Zal,mini,pt_primelt);
967 3821 : if (dec0) return dec0;
968 70 : set_avma(av);
969 : }
970 7 : B = int2n(10);
971 : for (;;)
972 0 : {
973 7 : GEN x = randcol(nz,B), zx = ZM_ZC_mul(Z,x);
974 7 : dec0 = try_fact(al,x,zx,Z,Zal,mini,pt_primelt);
975 7 : if (dec0) return dec0;
976 0 : set_avma(av);
977 : }
978 : }
979 :
980 : static GEN
981 24016 : alg_decompose_total(GEN al, GEN Z, long maps)
982 : {
983 : GEN dec, sc, p;
984 : long i;
985 :
986 24016 : dec = alg_decompose(al, Z, 0, NULL);
987 24016 : if (isintzero(dec))
988 : {
989 14137 : if (maps) {
990 8957 : long n = alg_get_absdim(al);
991 8957 : al = mkvec3(al, matid(n), matid(n));
992 : }
993 14137 : return mkvec(al);
994 : }
995 9879 : p = alg_get_char(al); if (!signe(p)) p = NULL;
996 9879 : sc = cgetg(lg(dec), t_VEC);
997 29637 : for (i=1; i<lg(sc); i++) {
998 19758 : GEN D = gel(dec,i), a = gel(D,1), Za = gel(D,4);
999 19758 : GEN S = alg_decompose_total(a, Za, maps);
1000 19758 : gel(sc,i) = S;
1001 19758 : if (maps)
1002 : {
1003 13150 : GEN projm = gel(D,2), liftm = gel(D,3);
1004 13150 : long j, lS = lg(S);
1005 34776 : for (j=1; j<lS; j++)
1006 : {
1007 21626 : GEN Sj = gel(S,j), p2 = gel(Sj,2), l2 = gel(Sj,3);
1008 21626 : if (p) p2 = FpM_mul(p2, projm, p);
1009 1449 : else p2 = RgM_mul(p2, projm);
1010 21626 : if (p) l2 = FpM_mul(liftm, l2, p);
1011 1449 : else l2 = RgM_mul(liftm, l2);
1012 21626 : gel(Sj,2) = p2;
1013 21626 : gel(Sj,3) = l2;
1014 : }
1015 : }
1016 : }
1017 9879 : return shallowconcat1(sc);
1018 : }
1019 :
1020 : static GEN
1021 14513 : alg_subalg(GEN al, GEN basis)
1022 : {
1023 14513 : GEN invbasis, mt, p = alg_get_char(al);
1024 : long i, j, n;
1025 :
1026 14513 : if (!signe(p)) p = NULL;
1027 14513 : basis = shallowmatconcat(mkvec2(col_ei(alg_get_absdim(al),1), basis));
1028 14513 : if (p)
1029 : {
1030 13344 : basis = image_keep_first(basis,p);
1031 13344 : invbasis = FpM_inv(basis,p);
1032 : }
1033 : else
1034 : { /* FIXME use an integral variant of image_keep_first */
1035 1169 : basis = QM_ImQ_hnf(basis);
1036 1169 : invbasis = RgM_inv(basis);
1037 : }
1038 14513 : n = lg(basis)-1;
1039 14513 : mt = cgetg(n+1,t_VEC);
1040 14513 : gel(mt,1) = matid(n);
1041 45013 : for (i = 2; i <= n; i++)
1042 : {
1043 30500 : GEN mtx = cgetg(n+1,t_MAT), x = gel(basis,i);
1044 30500 : gel(mtx,1) = col_ei(n,i);
1045 182468 : for (j = 2; j <= n; j++)
1046 : {
1047 151968 : GEN xy = algmul(al, x, gel(basis,j));
1048 151968 : if (p) gel(mtx,j) = FpM_FpC_mul(invbasis, xy, p);
1049 36253 : else gel(mtx,j) = RgM_RgC_mul(invbasis, xy);
1050 : }
1051 30500 : gel(mt,i) = mtx;
1052 : }
1053 14513 : return mkvec2(algtableinit_i(mt,p), basis);
1054 : }
1055 :
1056 : GEN
1057 84 : algsubalg(GEN al, GEN basis)
1058 : {
1059 84 : pari_sp av = avma;
1060 : GEN p;
1061 84 : checkalg(al);
1062 84 : if (alg_type(al) == al_REAL) pari_err_TYPE("algsubalg [real algebra]", al);
1063 77 : if (typ(basis) != t_MAT) pari_err_TYPE("algsubalg",basis);
1064 70 : p = alg_get_char(al);
1065 70 : if (signe(p)) basis = RgM_to_FpM(basis,p);
1066 70 : return gc_GEN(av, alg_subalg(al,basis));
1067 : }
1068 :
1069 : static int
1070 14638 : cmp_algebra(GEN x, GEN y)
1071 : {
1072 : long d;
1073 14638 : d = gel(x,1)[1] - gel(y,1)[1]; if (d) return d < 0? -1: 1;
1074 12722 : d = gel(x,1)[2] - gel(y,1)[2]; if (d) return d < 0? -1: 1;
1075 12722 : return cmp_universal(gel(x,2), gel(y,2));
1076 : }
1077 :
1078 : GEN
1079 9685 : algsimpledec_ss(GEN al, long maps)
1080 : {
1081 9685 : pari_sp av = avma;
1082 : GEN Z, p, r, res, perm;
1083 : long i, l, n;
1084 9685 : checkalg(al);
1085 9685 : p = alg_get_char(al);
1086 9685 : dbg_printf(1)("algsimpledec_ss: char=%Ps, dim=%d\n", p, alg_get_absdim(al));
1087 9685 : if (signe(p)) Z = algprimesubalg(al);
1088 273 : else if (alg_type(al)!=al_TABLE) Z = gen_0;
1089 252 : else Z = algtablecenter(al);
1090 :
1091 9685 : if (lg(Z) == 2) {/* dim Z = 1 */
1092 5427 : n = alg_get_absdim(al);
1093 5427 : set_avma(av);
1094 5427 : if (!maps) return mkveccopy(al);
1095 4720 : retmkvec(mkvec3(gcopy(al), matid(n), matid(n)));
1096 : }
1097 4258 : res = alg_decompose_total(al, Z, maps);
1098 4258 : l = lg(res); r = cgetg(l, t_VEC);
1099 18395 : for (i = 1; i < l; i++)
1100 : {
1101 14137 : GEN A = maps? gmael(res,i,1): gel(res,i);
1102 14137 : gel(r,i) = mkvec2(mkvecsmall2(alg_get_dim(A), lg(algtablecenter(A))),
1103 : alg_get_multable(A));
1104 : }
1105 4258 : perm = gen_indexsort(r, (void*)cmp_algebra, &cmp_nodata);
1106 4258 : return gc_GEN(av, vecpermute(res, perm));
1107 : }
1108 :
1109 : GEN
1110 2730 : algsimpledec(GEN al, long maps)
1111 : {
1112 2730 : pari_sp av = avma;
1113 : int ss;
1114 2730 : GEN rad, dec, res, proj=NULL, lift=NULL;
1115 2730 : rad = algradical(al);
1116 2730 : ss = gequal0(rad);
1117 2730 : if (!ss)
1118 : {
1119 1428 : al = alg_quotient(al, rad, maps);
1120 1428 : if (maps) {
1121 14 : proj = gel(al,2);
1122 14 : lift = gel(al,3);
1123 14 : al = gel(al,1);
1124 : }
1125 : }
1126 2730 : dec = algsimpledec_ss(al, maps);
1127 2730 : if (!ss && maps) /* update maps */
1128 : {
1129 14 : GEN p = alg_get_char(al);
1130 : long i;
1131 42 : for (i=1; i<lg(dec); i++)
1132 : {
1133 28 : if (signe(p))
1134 : {
1135 14 : gmael(dec,i,2) = FpM_mul(gmael(dec,i,2), proj, p);
1136 14 : gmael(dec,i,3) = FpM_mul(lift, gmael(dec,i,3), p);
1137 : }
1138 : else
1139 : {
1140 14 : gmael(dec,i,2) = RgM_mul(gmael(dec,i,2), proj);
1141 14 : gmael(dec,i,3) = RgM_mul(lift, gmael(dec,i,3));
1142 : }
1143 : }
1144 : }
1145 2730 : res = mkvec2(rad, dec);
1146 2730 : return gc_GEN(av,res);
1147 : }
1148 :
1149 : static GEN alg_idempotent(GEN al, long n, long d);
1150 : static GEN
1151 12733 : try_split(GEN al, GEN x, long n, long d)
1152 : {
1153 12733 : GEN cp, p = alg_get_char(al), fa, e, pol, exp, P, Q, U, u, mx, mte, ire;
1154 12733 : long nfa, i, smalldim = alg_get_absdim(al)+1, dim, smalli = 0;
1155 12733 : cp = algcharpoly(al,x,0,1);
1156 12733 : fa = FpX_factor(cp,p);
1157 12733 : nfa = nbrows(fa);
1158 12733 : if (nfa == 1) return NULL;
1159 5061 : pol = gel(fa,1);
1160 5061 : exp = gel(fa,2);
1161 :
1162 : /* charpoly is always a d-th power */
1163 15563 : for (i=1; i<lg(exp); i++) {
1164 10509 : if (exp[i]%d) pari_err(e_MISC, "the algebra must be simple (try_split 1)");
1165 10502 : exp[i] /= d;
1166 : }
1167 5054 : cp = FpXV_factorback(gel(fa,1), gel(fa,2), p, 0);
1168 :
1169 : /* find smallest Fp-dimension of a characteristic space */
1170 15556 : for (i=1; i<lg(pol); i++) {
1171 10502 : dim = degree(gel(pol,i))*exp[i];
1172 10502 : if (dim < smalldim) {
1173 5126 : smalldim = dim;
1174 5126 : smalli = i;
1175 : }
1176 : }
1177 5054 : i = smalli;
1178 5054 : if (smalldim != n) return NULL;
1179 : /* We could also compute e*al*e and try again with this smaller algebra */
1180 : /* Fq-rank 1 = Fp-rank n idempotent: success */
1181 :
1182 : /* construct idempotent */
1183 5040 : mx = algbasismultable(al,x);
1184 5040 : P = gel(pol,i);
1185 5040 : P = FpX_powu(P, exp[i], p);
1186 5040 : Q = FpX_div(cp, P, p);
1187 5040 : e = algpoleval(al, Q, mkvec2(x,mx));
1188 5040 : U = FpXQ_inv(Q, P, p);
1189 5040 : u = algpoleval(al, U, mkvec2(x,mx));
1190 5040 : e = algbasismul(al, e, u);
1191 5040 : mte = algbasisrightmultable(al,e);
1192 5040 : ire = FpM_indexrank(mte,p);
1193 5040 : if (lg(gel(ire,1))-1 != smalldim*d) pari_err(e_MISC, "the algebra must be simple (try_split 2)");
1194 :
1195 5033 : return mkvec3(e,mte,ire);
1196 : }
1197 :
1198 : /*
1199 : * Given a simple algebra al of dimension d^2 over its center of degree n,
1200 : * find an idempotent e in al with rank n (which is minimal).
1201 : */
1202 : static GEN
1203 5047 : alg_idempotent(GEN al, long n, long d)
1204 : {
1205 5047 : pari_sp av = avma;
1206 5047 : long i, N = alg_get_absdim(al);
1207 5047 : GEN e, p = alg_get_char(al), x;
1208 12404 : for(i=2; i<=N; i++) {
1209 12061 : x = col_ei(N,i);
1210 12061 : e = try_split(al, x, n, d);
1211 12047 : if (e) return e;
1212 7357 : set_avma(av);
1213 : }
1214 : for(;;) {
1215 672 : x = random_FpC(N,p);
1216 672 : e = try_split(al, x, n, d);
1217 672 : if (e) return e;
1218 329 : set_avma(av);
1219 : }
1220 : }
1221 :
1222 : static GEN
1223 4592 : try_descend(GEN M, GEN B, GEN p, long m, long n, long d)
1224 : {
1225 4592 : GEN B2 = cgetg(m+1,t_MAT), b;
1226 4592 : long i, j, k=0;
1227 13342 : for (i=1; i<=d; i++)
1228 : {
1229 8750 : k++;
1230 8750 : b = gel(B,i);
1231 8750 : gel(B2,k) = b;
1232 20468 : for (j=1; j<n; j++)
1233 : {
1234 11718 : k++;
1235 11718 : b = FpM_FpC_mul(M,b,p);
1236 11718 : gel(B2,k) = b;
1237 : }
1238 : }
1239 4592 : if (!signe(FpM_det(B2,p))) return NULL;
1240 4165 : return FpM_inv(B2,p);
1241 : }
1242 :
1243 : /* Given an m*m matrix M with irreducible charpoly over F of degree n,
1244 : * let K = F(M), which is a field, and write m=d*n.
1245 : * Compute the d-dimensional K-vector space structure on V=F^m induced by M.
1246 : * Return [B,C] where:
1247 : * - B is m*d matrix over F giving a K-basis b_1,...,b_d of V
1248 : * - C is d*m matrix over F[x] expressing the canonical F-basis of V on the b_i
1249 : * Currently F = Fp TODO extend this. */
1250 : static GEN
1251 4165 : descend_i(GEN M, long n, GEN p)
1252 : {
1253 : GEN B, C;
1254 : long m,d,i;
1255 : pari_sp av;
1256 4165 : m = lg(M)-1;
1257 4165 : d = m/n;
1258 4165 : B = cgetg(d+1,t_MAT);
1259 4165 : av = avma;
1260 :
1261 : /* try a subset of the canonical basis */
1262 12061 : for (i=1; i<=d; i++)
1263 7896 : gel(B,i) = col_ei(m,n*(i-1)+1);
1264 4165 : C = try_descend(M,B,p,m,n,d);
1265 4165 : if (C) return mkvec2(B,C);
1266 392 : set_avma(av);
1267 :
1268 : /* try smallish elements */
1269 1176 : for (i=1; i<=d; i++)
1270 784 : gel(B,i) = FpC_red(zc_to_ZC(random_pm1(m)),p);
1271 392 : C = try_descend(M,B,p,m,n,d);
1272 392 : if (C) return mkvec2(B,C);
1273 35 : set_avma(av);
1274 :
1275 : /* try random elements */
1276 : for (;;)
1277 : {
1278 105 : for (i=1; i<=d; i++)
1279 70 : gel(B,i) = random_FpC(m,p);
1280 35 : C = try_descend(M,B,p,m,n,d);
1281 35 : if (C) return mkvec2(B,C);
1282 0 : set_avma(av);
1283 : }
1284 : }
1285 : static GEN
1286 18746 : RgC_contract(GEN C, long n, long v) /* n>1 */
1287 : {
1288 : GEN C2, P;
1289 : long m, d, i, j;
1290 18746 : m = lg(C)-1;
1291 18746 : d = m/n;
1292 18746 : C2 = cgetg(d+1,t_COL);
1293 55034 : for (i=1; i<=d; i++)
1294 : {
1295 36288 : P = pol_xn(n-1,v);
1296 131348 : for (j=1; j<=n; j++)
1297 95060 : gel(P,j+1) = gel(C,n*(i-1)+j);
1298 36288 : P = normalizepol(P);
1299 36288 : gel(C2,i) = P;
1300 : }
1301 18746 : return C2;
1302 : }
1303 : static GEN
1304 4165 : RgM_contract(GEN A, long n, long v) /* n>1 */
1305 : {
1306 4165 : GEN A2 = cgetg(lg(A),t_MAT);
1307 : long i;
1308 22911 : for (i=1; i<lg(A2); i++)
1309 18746 : gel(A2,i) = RgC_contract(gel(A,i),n,v);
1310 4165 : return A2;
1311 : }
1312 : static GEN
1313 4165 : descend(GEN M, long n, GEN p, long v)
1314 : {
1315 4165 : GEN res = descend_i(M,n,p);
1316 4165 : gel(res,2) = RgM_contract(gel(res,2),n,v);
1317 4165 : return res;
1318 : }
1319 :
1320 : /* isomorphism of Fp-vector spaces M_d(F_p^n) -> (F_p)^(d^2*n) */
1321 : static GEN
1322 49343 : RgM_mat2col(GEN M, long d, long n)
1323 : {
1324 49343 : long nd = d*n, N = d*nd, i, j, ni, nj;
1325 49343 : GEN C = cgetg(N+1, t_COL);
1326 168504 : for (i=1, ni = 0; i<=d; i++, ni += nd)
1327 459508 : for (j=1, nj = 0; j<=d; j++, nj += n)
1328 : {
1329 340347 : GEN P = gcoeff(M,i,j);
1330 340347 : long k, e = ni + nj + 1;
1331 340347 : if (typ(P)==t_POL)
1332 : {
1333 339731 : long dP = degpol(P);
1334 708139 : for (k = 0; k <= dP; k++)
1335 368408 : gel(C,e+k) = gel(P,k+2);
1336 : } else
1337 : {
1338 616 : gel(C,e) = P;
1339 616 : k = 1;
1340 : }
1341 552946 : for ( ; k < n; k++)
1342 212599 : gel(C,e+k) = gen_0;
1343 : }
1344 49343 : return C;
1345 : }
1346 : /* inverse isomorphism */
1347 : static GEN
1348 1708 : RgC_col2mat(GEN C, long d, long n, long v)
1349 : {
1350 : long i, j, start;
1351 1708 : GEN M = cgetg(d+1, t_MAT), cM;
1352 5432 : for (j=1; j<=d; j++)
1353 : {
1354 3724 : cM = cgetg(d+1, t_COL);
1355 14420 : for (i=1; i<=d; i++)
1356 : {
1357 10696 : start = n*(d*(i-1)+j-1)+1;
1358 10696 : if (n==1) gel(cM,i) = gel(C, start);
1359 4564 : else gel(cM,i) = RgV_to_RgX(vecslice(C, start, start+n-1), v);
1360 : }
1361 3724 : gel(M,j) = cM;
1362 : }
1363 1708 : return M;
1364 : }
1365 :
1366 : static GEN
1367 6510 : alg_finite_csa_split(GEN al, long v)
1368 : {
1369 : GEN Z, e, mte, ire, primelt, b, T, M, proje, lifte, extre, p, B, C, mt, mx, map, mapi, T2, ro;
1370 6510 : long n, d, N = alg_get_absdim(al), i;
1371 6510 : p = alg_get_char(al);
1372 : /* compute the center */
1373 6510 : Z = algcenter(al);
1374 : /* TODO option to give the center as input instead of computing it */
1375 6510 : n = lg(Z)-1;
1376 :
1377 : /* compute a minimal rank idempotent e */
1378 6510 : if (n==N) {
1379 1456 : d = 1;
1380 1456 : e = col_ei(N,1);
1381 1456 : mte = matid(N);
1382 1456 : ire = mkvec2(identity_perm(n),identity_perm(n));
1383 : }
1384 : else {
1385 5054 : d = usqrt(N/n);
1386 5054 : if (d*d*n != N) pari_err(e_MISC, "the algebra must be simple (alg_finite_csa_split 1)");
1387 5047 : e = alg_idempotent(al,n,d);
1388 5033 : mte = gel(e,2);
1389 5033 : ire = gel(e,3);
1390 5033 : e = gel(e,1);
1391 : }
1392 :
1393 : /* identify the center */
1394 6489 : if (n==1)
1395 : {
1396 2317 : T = pol_x(v);
1397 2317 : primelt = gen_0;
1398 : }
1399 : else
1400 : {
1401 4172 : b = alg_decompose(al, Z, 1, &primelt);
1402 4172 : if (!gequal0(b)) pari_err(e_MISC, "the algebra must be simple (alg_finite_csa_split 2)");
1403 4165 : T = gel(primelt,2);
1404 4165 : primelt = gel(primelt,1);
1405 4165 : setvarn(T,v);
1406 : }
1407 :
1408 : /* use the ffinit polynomial */
1409 6482 : if (n>1)
1410 : {
1411 4165 : T2 = init_Fq(p,n,v);
1412 4165 : setvarn(T,fetch_var_higher());
1413 4165 : ro = FpXQX_roots(T2,T,p);
1414 4165 : ro = gel(ro,1);
1415 4165 : primelt = algpoleval(al,ro,primelt);
1416 4165 : T = T2;
1417 4165 : delete_var();
1418 : }
1419 :
1420 : /* descend al*e to a vector space over the center */
1421 : /* lifte: al*e -> al ; proje: al*e -> al */
1422 6482 : lifte = shallowextract(mte,gel(ire,2));
1423 6482 : extre = shallowmatextract(mte,gel(ire,1),gel(ire,2));
1424 6482 : extre = FpM_inv(extre,p);
1425 6482 : proje = rowpermute(mte,gel(ire,1));
1426 6482 : proje = FpM_mul(extre,proje,p);
1427 6482 : if (n==1)
1428 : {
1429 2317 : B = lifte;
1430 2317 : C = proje;
1431 : }
1432 : else
1433 : {
1434 4165 : M = algbasismultable(al,primelt);
1435 4165 : M = FpM_mul(M,lifte,p);
1436 4165 : M = FpM_mul(proje,M,p);
1437 4165 : B = descend(M,n,p,v);
1438 4165 : C = gel(B,2);
1439 4165 : B = gel(B,1);
1440 4165 : B = FpM_mul(lifte,B,p);
1441 4165 : C = FqM_mul(C,proje,T,p);
1442 : }
1443 :
1444 : /* compute the isomorphism */
1445 6482 : mt = alg_get_multable(al);
1446 6482 : map = cgetg(N+1,t_VEC);
1447 6482 : M = cgetg(N+1,t_MAT);
1448 55321 : for (i=1; i<=N; i++)
1449 : {
1450 48839 : mx = gel(mt,i);
1451 48839 : mx = FpM_mul(mx,B,p);
1452 48839 : mx = FqM_mul(C,mx,T,p);
1453 48839 : gel(map,i) = mx;
1454 48839 : gel(M,i) = RgM_mat2col(mx,d,n);
1455 : }
1456 6482 : mapi = FpM_inv(M,p);
1457 6482 : if (!mapi) pari_err(e_MISC, "the algebra must be simple (alg_finite_csa_split 3)");
1458 6475 : return mkvec4(T,map,mapi,M);
1459 : }
1460 :
1461 : GEN
1462 3766 : algsplit(GEN al, long v)
1463 : {
1464 3766 : pari_sp av = avma;
1465 : GEN res, T, map, mapi, ff, p;
1466 : long i,j,k,li,lj;
1467 3766 : checkalg(al);
1468 3759 : p = alg_get_char(al);
1469 3759 : if (gequal0(p))
1470 7 : pari_err_IMPL("splitting a characteristic 0 algebra over its center");
1471 3752 : res = alg_finite_csa_split(al, v);
1472 3717 : T = gel(res,1);
1473 3717 : map = gel(res,2);
1474 3717 : mapi = gel(res,3);
1475 3717 : ff = Tp_to_FF(T,p);
1476 33593 : for (i=1; i<lg(map); i++)
1477 : {
1478 29876 : li = lg(gel(map,i));
1479 89908 : for (j=1; j<li; j++)
1480 : {
1481 60032 : lj = lg(gmael(map,i,j));
1482 190876 : for (k=1; k<lj; k++)
1483 130844 : gmael3(map,i,j,k) = Fq_to_FF(gmael3(map,i,j,k),ff);
1484 : }
1485 : }
1486 :
1487 3717 : return gc_GEN(av, mkvec2(map,mapi));
1488 : }
1489 :
1490 : /* multiplication table sanity checks */
1491 : static GEN
1492 60463 : check_mt_noid(GEN mt, GEN p)
1493 : {
1494 : long i, l;
1495 60463 : GEN MT = cgetg_copy(mt, &l);
1496 60463 : if (typ(MT) != t_VEC || l == 1) return NULL;
1497 298173 : for (i = 1; i < l; i++)
1498 : {
1499 237759 : GEN M = gel(mt,i);
1500 237759 : if (typ(M) != t_MAT || lg(M) != l || lgcols(M) != l) return NULL;
1501 237731 : if (p) M = RgM_to_FpM(M,p);
1502 237731 : gel(MT,i) = M;
1503 : }
1504 60414 : return MT;
1505 : }
1506 : static GEN
1507 59938 : check_mt(GEN mt, GEN p)
1508 : {
1509 : long i;
1510 : GEN MT;
1511 59938 : MT = check_mt_noid(mt, p);
1512 59938 : if (!MT || !ZM_isidentity(gel(MT,1))) return NULL;
1513 234420 : for (i=2; i<lg(MT); i++)
1514 174510 : if (ZC_is_ei(gmael(MT,i,1)) != i) return NULL;
1515 59910 : return MT;
1516 : }
1517 :
1518 : static GEN
1519 294 : check_relmt(GEN nf, GEN mt)
1520 : {
1521 294 : long i, l = lg(mt), j, k;
1522 294 : GEN MT = gcopy(mt), a, b, d;
1523 294 : if (typ(MT) != t_VEC || l == 1) return NULL;
1524 1225 : for (i = 1; i < l; i++)
1525 : {
1526 952 : GEN M = gel(MT,i);
1527 952 : if (typ(M) != t_MAT || lg(M) != l || lgcols(M) != l) return NULL;
1528 4760 : for (k = 1; k < l; k++)
1529 21525 : for (j = 1; j < l; j++)
1530 : {
1531 17717 : a = gcoeff(M,j,k);
1532 17717 : if (typ(a)==t_INT) continue;
1533 2247 : b = algtobasis(nf,a);
1534 2247 : d = Q_denom(b);
1535 2247 : if (!isint1(d))
1536 14 : pari_err_DOMAIN("alg_csa_table", "denominator(mt)", "!=", gen_1, mt);
1537 2233 : gcoeff(M,j,k) = lift(basistoalg(nf,b));
1538 : }
1539 938 : if (i > 1 && RgC_is_ei(gel(M,1)) != i) return NULL; /* i = 1 checked at end */
1540 931 : gel(MT,i) = M;
1541 : }
1542 273 : if (!RgM_isidentity(gel(MT,1))) return NULL;
1543 273 : return MT;
1544 : }
1545 :
1546 : int
1547 532 : algisassociative(GEN mt0, GEN p)
1548 : {
1549 532 : pari_sp av = avma;
1550 : long i, j, k, n;
1551 : GEN M, mt;
1552 :
1553 532 : if (checkalg_i(mt0)) { p = alg_get_char(mt0); mt0 = alg_get_multable(mt0); }
1554 532 : if (!p) p = gen_0;
1555 532 : if (typ(p) != t_INT) pari_err_TYPE("algisassociative",p);
1556 525 : mt = check_mt_noid(mt0, isintzero(p)? NULL: p);
1557 525 : if (!mt) pari_err_TYPE("algisassociative (mult. table)", mt0);
1558 490 : if (!ZM_isidentity(gel(mt,1))) return gc_bool(av,0);
1559 476 : n = lg(mt)-1;
1560 476 : M = cgetg(n+1,t_MAT);
1561 3731 : for (j=1; j<=n; j++) gel(M,j) = cgetg(n+1,t_COL);
1562 3731 : for (i=1; i<=n; i++)
1563 : {
1564 3255 : GEN mi = gel(mt,i);
1565 36918 : for (j=1; j<=n; j++) gcoeff(M,i,j) = gel(mi,j); /* ei.ej */
1566 : }
1567 3241 : for (i=2; i<=n; i++) {
1568 2772 : GEN mi = gel(mt,i);
1569 30373 : for (j=2; j<=n; j++) {
1570 381451 : for (k=2; k<=n; k++) {
1571 : GEN x, y;
1572 353850 : if (signe(p)) {
1573 242039 : x = _tablemul_ej_Fp(mt,gcoeff(M,i,j),k,p);
1574 242039 : y = FpM_FpC_mul(mi,gcoeff(M,j,k),p);
1575 : }
1576 : else {
1577 111811 : x = _tablemul_ej(mt,gcoeff(M,i,j),k);
1578 111811 : y = RgM_RgC_mul(mi,gcoeff(M,j,k));
1579 : }
1580 : /* not cmp_universal: must not fail on 0 == Mod(0,2) for instance */
1581 353850 : if (!gequal(x,y)) return gc_bool(av,0);
1582 : }
1583 : }
1584 : }
1585 469 : return gc_bool(av,1);
1586 : }
1587 :
1588 : int
1589 392 : algiscommutative(GEN al) /* assumes e_1 = 1 */
1590 : {
1591 : long i,j,k,N,sp;
1592 : GEN mt,a,b,p;
1593 392 : checkalg(al);
1594 392 : if (alg_type(al) != al_TABLE) return alg_get_degree(al)==1;
1595 329 : N = alg_get_absdim(al);
1596 329 : mt = alg_get_multable(al);
1597 329 : p = alg_get_char(al);
1598 329 : sp = signe(p);
1599 1491 : for (i=2; i<=N; i++)
1600 9772 : for (j=2; j<=N; j++)
1601 89047 : for (k=1; k<=N; k++) {
1602 80514 : a = gcoeff(gel(mt,i),k,j);
1603 80514 : b = gcoeff(gel(mt,j),k,i);
1604 80514 : if (sp) {
1605 73423 : if (cmpii(Fp_red(a,p), Fp_red(b,p))) return 0;
1606 : }
1607 7091 : else if (gcmp(a,b)) return 0;
1608 : }
1609 252 : return 1;
1610 : }
1611 :
1612 : int
1613 392 : algissemisimple(GEN al)
1614 : {
1615 392 : pari_sp av = avma;
1616 : GEN rad;
1617 392 : checkalg(al);
1618 392 : if (alg_type(al) != al_TABLE) return 1;
1619 329 : rad = algradical(al);
1620 329 : set_avma(av);
1621 329 : return gequal0(rad);
1622 : }
1623 :
1624 : /* ss : known to be semisimple */
1625 : int
1626 301 : algissimple(GEN al, long ss)
1627 : {
1628 301 : pari_sp av = avma;
1629 : GEN Z, dec, p;
1630 301 : checkalg(al);
1631 301 : if (alg_type(al) != al_TABLE) return 1;
1632 245 : if (!ss && !algissemisimple(al)) return 0;
1633 :
1634 203 : p = alg_get_char(al);
1635 203 : if (signe(p)) Z = algprimesubalg(al);
1636 112 : else Z = algtablecenter(al);
1637 :
1638 203 : if (lg(Z) == 2) {/* dim Z = 1 */
1639 112 : set_avma(av);
1640 112 : return 1;
1641 : }
1642 91 : dec = alg_decompose(al, Z, 1, NULL);
1643 91 : set_avma(av);
1644 91 : return gequal0(dec);
1645 : }
1646 :
1647 : static long
1648 560 : is_place_emb(GEN nf, GEN pl)
1649 : {
1650 : long r, r1, r2;
1651 560 : if (typ(pl) != t_INT) pari_err_TYPE("is_place_emb", pl);
1652 539 : if (signe(pl)<=0) pari_err_DOMAIN("is_place_emb", "pl", "<=", gen_0, pl);
1653 532 : nf_get_sign(nf,&r1,&r2); r = r1+r2;
1654 532 : if (cmpiu(pl,r)>0) pari_err_DOMAIN("is_place_emb", "pl", ">", utoi(r), pl);
1655 511 : return itou(pl);
1656 : }
1657 :
1658 : static long
1659 511 : alghasse_emb(GEN al, long emb)
1660 : {
1661 511 : GEN nf = alg_get_center(al);
1662 511 : long r1 = nf_get_r1(nf);
1663 511 : return (emb <= r1)? alg_get_hasse_i(al)[emb]: 0;
1664 : }
1665 :
1666 : static long
1667 1813 : alghasse_pr(GEN al, GEN pr)
1668 : {
1669 1813 : GEN hf = alg_get_hasse_f(al);
1670 1806 : long i = tablesearch(gel(hf,1), pr, &cmp_prime_ideal);
1671 1806 : return i? gel(hf,2)[i]: 0;
1672 : }
1673 :
1674 : static long
1675 2408 : alghasse_0(GEN al, GEN pl)
1676 : {
1677 : long ta;
1678 : GEN pr, nf;
1679 2408 : ta = alg_type(al);
1680 2408 : if (ta == al_REAL) return algreal_dim(al)!=1;
1681 2387 : if (!pl)
1682 7 : pari_err(e_MISC, "must provide a place pl");
1683 2380 : if (ta == al_CSA && !alg_is_asq(al))
1684 7 : pari_err_IMPL("computation of Hasse invariants over table CSA");
1685 2373 : if ((pr = get_prid(pl))) return alghasse_pr(al, pr);
1686 560 : nf = alg_get_center(al);
1687 560 : return alghasse_emb(al, is_place_emb(nf, pl));
1688 : }
1689 : GEN
1690 343 : alghasse(GEN al, GEN pl)
1691 : {
1692 : long h;
1693 343 : checkalg(al);
1694 343 : if (alg_type(al) == al_TABLE) pari_err_TYPE("alghasse [use alginit]",al);
1695 336 : h = alghasse_0(al,pl);
1696 280 : return sstoQ(h, alg_get_degree(al));
1697 : }
1698 :
1699 : /* h >= 0, d >= 0 */
1700 : static long
1701 2219 : indexfromhasse(long h, long d) { return d/ugcd(h,d); }
1702 :
1703 : long
1704 2191 : algindex(GEN al, GEN pl)
1705 : {
1706 : long d, res, i, l, ta;
1707 : GEN hi, hf;
1708 :
1709 2191 : checkalg(al);
1710 2184 : ta = alg_type(al);
1711 2184 : if (ta == al_TABLE) pari_err_TYPE("algindex [use alginit]",al);
1712 2177 : if (ta == al_REAL) return algreal_dim(al)==1 ? 1 : 2;
1713 2093 : d = alg_get_degree(al);
1714 2093 : if (pl) return indexfromhasse(alghasse_0(al,pl), d);
1715 :
1716 : /* else : global index */
1717 273 : res = 1;
1718 273 : hi = alg_get_hasse_i(al); l = lg(hi);
1719 518 : for (i=1; i<l && res!=d; i++) res = ulcm(res, indexfromhasse(hi[i],d));
1720 273 : hf = gel(alg_get_hasse_f(al), 2); l = lg(hf);
1721 420 : for (i=1; i<l && res!=d; i++) res = ulcm(res, indexfromhasse(hf[i],d));
1722 266 : return res;
1723 : }
1724 :
1725 : int
1726 287 : algisdivision(GEN al, GEN pl)
1727 : {
1728 287 : checkalg(al);
1729 287 : if (alg_type(al) == al_TABLE) {
1730 21 : if (!algissimple(al,0)) return 0;
1731 14 : if (algiscommutative(al)) return 1;
1732 7 : pari_err_IMPL("algisdivision for table algebras");
1733 : }
1734 266 : return algindex(al,pl) == alg_get_degree(al);
1735 : }
1736 :
1737 : int
1738 1652 : algissplit(GEN al, GEN pl)
1739 : {
1740 1652 : checkalg(al);
1741 1652 : if (alg_type(al) == al_TABLE) pari_err_TYPE("algissplit [use alginit]", al);
1742 1638 : return algindex(al,pl) == 1;
1743 : }
1744 :
1745 : int
1746 1386 : algisramified(GEN al, GEN pl) { return !algissplit(al,pl); }
1747 :
1748 : /* sorted; infinite places first */
1749 : GEN
1750 364 : algramifiedplaces(GEN al)
1751 : {
1752 364 : pari_sp av = avma;
1753 : GEN ram, hf, hi, Lpr;
1754 : long r1, count, i, ta;
1755 364 : checkalg(al);
1756 364 : ta = alg_type(al);
1757 364 : if (ta != al_CSA && ta != al_CYCLIC)
1758 14 : pari_err_TYPE("algramifiedplaces [not a central simple algebra"
1759 : " over a number field]", al);
1760 350 : r1 = nf_get_r1(alg_get_center(al));
1761 350 : hi = alg_get_hasse_i(al);
1762 336 : hf = alg_get_hasse_f(al);
1763 322 : Lpr = gel(hf,1);
1764 322 : hf = gel(hf,2);
1765 322 : ram = cgetg(r1+lg(Lpr), t_VEC);
1766 322 : count = 0;
1767 889 : for (i=1; i<=r1; i++)
1768 567 : if (hi[i]) {
1769 224 : count++;
1770 224 : gel(ram,count) = stoi(i);
1771 : }
1772 1059 : for (i=1; i<lg(Lpr); i++)
1773 737 : if (hf[i]) {
1774 322 : count++;
1775 322 : gel(ram,count) = gel(Lpr,i);
1776 : }
1777 322 : setlg(ram, count+1);
1778 322 : return gc_GEN(av, ram);
1779 : }
1780 :
1781 : /* assume same degree and al_CYCLIC or al_CSA */
1782 : static int
1783 168 : algissimilar_i(GEN al, GEN al2, GEN pl)
1784 : {
1785 : GEN ram, ram2;
1786 : long i, h;
1787 168 : if (pl)
1788 : {
1789 84 : h = alghasse_0(al2,pl);
1790 70 : return alghasse_0(al,pl) == h;
1791 : }
1792 84 : ram = algramifiedplaces(al);
1793 63 : ram2 = algramifiedplaces(al2);
1794 63 : if (!gequal(ram, ram2)) return 0;
1795 84 : for (i = 1; i < lg(ram); i++)
1796 : {
1797 49 : h = alghasse_0(al2,gel(ram,i));
1798 49 : if (alghasse_0(al,gel(ram,i)) != h) return 0;
1799 : }
1800 35 : return 1;
1801 : }
1802 :
1803 : int
1804 259 : algisisom(GEN al, GEN al2, GEN pl)
1805 : {
1806 259 : pari_sp av = avma;
1807 : long t, d;
1808 259 : checkalg(al);
1809 252 : checkalg(al2);
1810 245 : t = alg_type(al);
1811 245 : if (t != al_CYCLIC && t != al_CSA)
1812 14 : pari_err_TYPE("algisisom [al: apply alginit()]", al);
1813 231 : t = alg_type(al2);
1814 231 : if (t != al_CYCLIC && t != al_CSA)
1815 14 : pari_err_TYPE("algisisom [al2: apply alginit()]", al2);
1816 217 : if (!gequal(nf_get_pol(alg_get_center(al)), nf_get_pol(alg_get_center(al2))))
1817 7 : pari_err(e_MISC, "base fields must be identical in algisisom");
1818 210 : d = alg_get_degree(al);
1819 210 : if (d != alg_get_degree(al2)) return gc_int(av, 0);
1820 203 : if (d == 1) return gc_int(av, 1);
1821 168 : return gc_int(av, algissimilar_i(al,al2,pl));
1822 : }
1823 :
1824 : GEN
1825 84 : algnewprec_shallow(GEN al, long prec)
1826 : {
1827 : GEN al2;
1828 84 : long t = algtype(al);
1829 84 : if (t != al_CYCLIC && t != al_CSA) return al;
1830 56 : al2 = shallowcopy(al);
1831 56 : gel(al2,1) = rnfnewprec_shallow(gel(al2,1), prec);
1832 56 : return al2;
1833 : };
1834 :
1835 : GEN
1836 84 : algnewprec(GEN al, long prec)
1837 : {
1838 84 : pari_sp av = avma;
1839 84 : GEN al2 = algnewprec_shallow(al, prec);
1840 84 : return gc_GEN(av, al2);
1841 : }
1842 :
1843 : /** OPERATIONS ON ELEMENTS operations.c **/
1844 :
1845 : static long
1846 1897061 : alg_model0(GEN al, GEN x)
1847 : {
1848 1897061 : long t, N = alg_get_absdim(al), lx = lg(x), d, n, D, i;
1849 1897061 : if (typ(x) == t_MAT) return al_MATRIX;
1850 1850938 : if (typ(x) != t_COL) return al_INVALID;
1851 1850861 : if (N == 1) {
1852 7679 : if (lx != 2) return al_INVALID;
1853 7658 : switch(typ(gel(x,1)))
1854 : {
1855 4928 : case t_INT: case t_FRAC: return al_TRIVIAL; /* cannot distinguish basis and alg from size */
1856 2723 : case t_POL: case t_POLMOD: return al_ALGEBRAIC;
1857 7 : default: return al_INVALID;
1858 : }
1859 : }
1860 :
1861 1843182 : switch(alg_type(al)) {
1862 734787 : case al_TABLE:
1863 734787 : if (lx != N+1) return al_INVALID;
1864 734766 : return al_BASIS;
1865 942054 : case al_CYCLIC:
1866 942054 : d = alg_get_degree(al);
1867 942054 : if (lx == N+1) return al_BASIS;
1868 113135 : if (lx == d+1) return al_ALGEBRAIC;
1869 49 : return al_INVALID;
1870 166341 : case al_CSA:
1871 166341 : D = alg_get_dim(al);
1872 166341 : n = nf_get_degree(alg_get_center(al));
1873 166341 : if (n == 1) {
1874 22652 : if (lx != D+1) return al_INVALID;
1875 104433 : for (i=1; i<=D; i++) {
1876 84007 : t = typ(gel(x,i));
1877 84007 : if (t == t_POL || t == t_POLMOD) return al_ALGEBRAIC;
1878 : /* TODO t_COL for coefficients in basis form ? */
1879 : }
1880 20426 : return al_BASIS;
1881 : }
1882 : else {
1883 143689 : if (lx == N+1) return al_BASIS;
1884 25809 : if (lx == D+1) return al_ALGEBRAIC;
1885 7 : return al_INVALID;
1886 : }
1887 : }
1888 : return al_INVALID; /* LCOV_EXCL_LINE */
1889 : }
1890 :
1891 : static void
1892 1896872 : checkalgx(GEN x, long model)
1893 : {
1894 : long t, i;
1895 1896872 : switch(model) {
1896 1701991 : case al_BASIS:
1897 22649465 : for (i=1; i<lg(x); i++) {
1898 20947481 : t = typ(gel(x,i));
1899 20947481 : if (t != t_INT && t != t_FRAC)
1900 7 : pari_err_TYPE("checkalgx", gel(x,i));
1901 : }
1902 1701984 : return;
1903 148758 : case al_TRIVIAL:
1904 : case al_ALGEBRAIC:
1905 503591 : for (i=1; i<lg(x); i++) {
1906 354840 : t = typ(gel(x,i));
1907 354840 : if (t != t_INT && t != t_FRAC && t != t_POL && t != t_POLMOD)
1908 : /* TODO t_COL ? */
1909 7 : pari_err_TYPE("checkalgx", gel(x,i));
1910 : }
1911 148751 : return;
1912 : }
1913 : }
1914 :
1915 : long
1916 1897061 : alg_model(GEN al, GEN x)
1917 : {
1918 1897061 : long res = alg_model0(al, x);
1919 1897061 : if (res == al_INVALID) pari_err_TYPE("alg_model", x);
1920 1896872 : checkalgx(x, res); return res;
1921 : }
1922 :
1923 : static long
1924 462910 : H_model0(GEN x)
1925 : {
1926 : long i;
1927 462910 : switch(typ(x))
1928 : {
1929 15274 : case t_INT:
1930 : case t_FRAC:
1931 : case t_REAL:
1932 : case t_COMPLEX:
1933 15274 : return H_SCALAR;
1934 10157 : case t_MAT:
1935 10157 : return H_MATRIX;
1936 437367 : case t_COL:
1937 437367 : if (lg(x)!=5) return H_INVALID;
1938 2186688 : for (i=1; i<=4; i++) if (!is_real_t(typ(gel(x,i)))) return H_INVALID;
1939 437332 : return H_QUATERNION;
1940 112 : default:
1941 112 : return al_INVALID;
1942 : }
1943 : }
1944 :
1945 : static long
1946 462910 : H_model(GEN x)
1947 : {
1948 462910 : long res = H_model0(x);
1949 462910 : if (res == H_INVALID) pari_err_TYPE("H_model", x);
1950 462763 : return res;
1951 : }
1952 :
1953 : static GEN
1954 756 : alC_add_i(GEN al, GEN x, GEN y, long lx)
1955 : {
1956 756 : GEN A = cgetg(lx, t_COL);
1957 : long i;
1958 2296 : for (i=1; i<lx; i++) gel(A,i) = algadd(al, gel(x,i), gel(y,i));
1959 749 : return A;
1960 : }
1961 : static GEN
1962 406 : alM_add(GEN al, GEN x, GEN y)
1963 : {
1964 406 : long lx = lg(x), l, j;
1965 : GEN z;
1966 406 : if (lg(y) != lx) pari_err_DIM("alM_add (rows)");
1967 392 : if (lx == 1) return cgetg(1, t_MAT);
1968 385 : z = cgetg(lx, t_MAT); l = lgcols(x);
1969 385 : if (lgcols(y) != l) pari_err_DIM("alM_add (columns)");
1970 1127 : for (j = 1; j < lx; j++) gel(z,j) = alC_add_i(al, gel(x,j), gel(y,j), l);
1971 371 : return z;
1972 : }
1973 : static GEN
1974 17745 : H_add(GEN x, GEN y)
1975 : {
1976 17745 : long tx = H_model(x), ty = H_model(y);
1977 17724 : if ((tx==H_MATRIX) ^ (ty==H_MATRIX)) pari_err_TYPE2("H_add", x, y);
1978 17710 : if (tx>ty) { swap(x,y); lswap(tx,ty); }
1979 17710 : switch (tx)
1980 : {
1981 105 : case H_MATRIX: /* both H_MATRIX */ return alM_add(NULL, x, y);
1982 16681 : case H_QUATERNION: /* both H_QUATERNION */ return gadd(x,y);
1983 924 : case H_SCALAR:
1984 924 : if (ty == H_SCALAR) return gadd(x,y);
1985 : else /* ty == H_QUATERNION */
1986 : {
1987 217 : pari_sp av = avma;
1988 217 : GEN res = gcopy(y), im;
1989 217 : gel(res,1) = gadd(gel(res,1), real_i(x));
1990 217 : im = imag_i(x);
1991 217 : if (im != gen_0) gel(res,2) = gadd(gel(res,2), im);
1992 217 : return gc_upto(av, res);
1993 : }
1994 : }
1995 : return NULL; /*LCOV_EXCL_LINE*/
1996 : }
1997 : GEN
1998 54999 : algadd(GEN al, GEN x, GEN y)
1999 : {
2000 54999 : pari_sp av = avma;
2001 : long tx, ty;
2002 : GEN p;
2003 54999 : checkalg(al);
2004 54999 : if (alg_type(al)==al_REAL) return H_add(x,y);
2005 37254 : tx = alg_model(al,x);
2006 37247 : ty = alg_model(al,y);
2007 37247 : p = alg_get_char(al);
2008 37247 : if (signe(p)) return FpC_add(x,y,p);
2009 37114 : if (tx==ty) {
2010 36232 : if (tx!=al_MATRIX) return gadd(x,y);
2011 301 : return gc_GEN(av, alM_add(al,x,y));
2012 : }
2013 882 : if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
2014 882 : if (ty==al_ALGEBRAIC) y = algalgtobasis(al,y);
2015 882 : return gc_upto(av, gadd(x,y));
2016 : }
2017 :
2018 : static GEN
2019 98 : H_neg(GEN x)
2020 : {
2021 98 : (void)H_model(x);
2022 70 : return gneg(x);
2023 : }
2024 :
2025 : GEN
2026 245 : algneg(GEN al, GEN x)
2027 : {
2028 245 : checkalg(al);
2029 245 : if (alg_type(al)==al_REAL) return H_neg(x);
2030 147 : (void)alg_model(al,x);
2031 140 : return gneg(x);
2032 : }
2033 :
2034 : static GEN
2035 210 : alC_sub_i(GEN al, GEN x, GEN y, long lx)
2036 : {
2037 : long i;
2038 210 : GEN A = cgetg(lx, t_COL);
2039 630 : for (i=1; i<lx; i++) gel(A,i) = algsub(al, gel(x,i), gel(y,i));
2040 210 : return A;
2041 : }
2042 : static GEN
2043 126 : alM_sub(GEN al, GEN x, GEN y)
2044 : {
2045 126 : long lx = lg(x), l, j;
2046 : GEN z;
2047 126 : if (lg(y) != lx) pari_err_DIM("alM_sub (rows)");
2048 119 : if (lx == 1) return cgetg(1, t_MAT);
2049 112 : z = cgetg(lx, t_MAT); l = lgcols(x);
2050 112 : if (lgcols(y) != l) pari_err_DIM("alM_sub (columns)");
2051 315 : for (j = 1; j < lx; j++) gel(z,j) = alC_sub_i(al, gel(x,j), gel(y,j), l);
2052 105 : return z;
2053 : }
2054 : GEN
2055 1127 : algsub(GEN al, GEN x, GEN y)
2056 : {
2057 : long tx, ty;
2058 1127 : pari_sp av = avma;
2059 : GEN p;
2060 1127 : checkalg(al);
2061 1127 : if (alg_type(al)==al_REAL) return gc_upto(av, algadd(NULL,x,gneg(y)));
2062 973 : tx = alg_model(al,x);
2063 966 : ty = alg_model(al,y);
2064 966 : p = alg_get_char(al);
2065 966 : if (signe(p)) return FpC_sub(x,y,p);
2066 875 : if (tx==ty) {
2067 553 : if (tx != al_MATRIX) return gsub(x,y);
2068 126 : return gc_GEN(av, alM_sub(al,x,y));
2069 : }
2070 322 : if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
2071 322 : if (ty==al_ALGEBRAIC) y = algalgtobasis(al,y);
2072 322 : return gc_upto(av, gsub(x,y));
2073 : }
2074 :
2075 : static GEN
2076 1659 : algalgmul_cyc(GEN al, GEN x, GEN y)
2077 : {
2078 1659 : pari_sp av = avma;
2079 1659 : long n = alg_get_degree(al), i, k;
2080 : GEN xalg, yalg, res, rnf, auts, sum, b, prod, autx;
2081 1659 : rnf = alg_get_splittingfield(al);
2082 1659 : auts = alg_get_auts(al);
2083 1659 : b = alg_get_b(al);
2084 :
2085 1659 : xalg = cgetg(n+1, t_COL);
2086 4935 : for (i=0; i<n; i++)
2087 3276 : gel(xalg,i+1) = lift_shallow(rnfbasistoalg(rnf,gel(x,i+1)));
2088 :
2089 1659 : yalg = cgetg(n+1, t_COL);
2090 4935 : for (i=0; i<n; i++) gel(yalg,i+1) = rnfbasistoalg(rnf,gel(y,i+1));
2091 :
2092 1659 : res = cgetg(n+1,t_COL);
2093 4935 : for (k=0; k<n; k++) {
2094 3276 : gel(res,k+1) = gmul(gel(xalg,k+1),gel(yalg,1));
2095 5166 : for (i=1; i<=k; i++) {
2096 1890 : autx = poleval(gel(xalg,k-i+1),gel(auts,i));
2097 1890 : prod = gmul(autx,gel(yalg,i+1));
2098 1890 : gel(res,k+1) = gadd(gel(res,k+1), prod);
2099 : }
2100 :
2101 3276 : sum = gen_0;
2102 5166 : for (; i<n; i++) {
2103 1890 : autx = poleval(gel(xalg,k+n-i+1),gel(auts,i));
2104 1890 : prod = gmul(autx,gel(yalg,i+1));
2105 1890 : sum = gadd(sum,prod);
2106 : }
2107 3276 : sum = gmul(b,sum);
2108 :
2109 3276 : gel(res,k+1) = gadd(gel(res,k+1),sum);
2110 : }
2111 :
2112 1659 : return gc_GEN(av, res);
2113 : }
2114 :
2115 : static GEN
2116 521822 : _tablemul(GEN mt, GEN x, GEN y)
2117 : {
2118 521822 : pari_sp av = avma;
2119 521822 : long D = lg(mt)-1, i;
2120 521822 : GEN res = NULL;
2121 8016946 : for (i=1; i<=D; i++) {
2122 7495124 : GEN c = gel(x,i);
2123 7495124 : if (!gequal0(c)) {
2124 1770670 : GEN My = RgM_RgC_mul(gel(mt,i),y);
2125 1770670 : GEN t = RgC_Rg_mul(My,c);
2126 1770670 : res = res? RgC_add(res,t): t;
2127 : }
2128 : }
2129 521822 : if (!res) { set_avma(av); return zerocol(D); }
2130 520912 : return gc_upto(av, res);
2131 : }
2132 :
2133 : static GEN
2134 300275 : _tablemul_Fp(GEN mt, GEN x, GEN y, GEN p)
2135 : {
2136 300275 : pari_sp av = avma;
2137 300275 : long D = lg(mt)-1, i;
2138 300275 : GEN res = NULL;
2139 2869445 : for (i=1; i<=D; i++) {
2140 2569170 : GEN c = gel(x,i);
2141 2569170 : if (signe(c)) {
2142 535114 : GEN My = FpM_FpC_mul(gel(mt,i),y,p);
2143 535114 : GEN t = FpC_Fp_mul(My,c,p);
2144 535114 : res = res? FpC_add(res,t,p): t;
2145 : }
2146 : }
2147 300275 : if (!res) { set_avma(av); return zerocol(D); }
2148 299736 : return gc_upto(av, res);
2149 : }
2150 :
2151 : /* x*ej */
2152 : static GEN
2153 111811 : _tablemul_ej(GEN mt, GEN x, long j)
2154 : {
2155 111811 : pari_sp av = avma;
2156 111811 : long D = lg(mt)-1, i;
2157 111811 : GEN res = NULL;
2158 1707468 : for (i=1; i<=D; i++) {
2159 1595657 : GEN c = gel(x,i);
2160 1595657 : if (!gequal0(c)) {
2161 162302 : GEN My = gel(gel(mt,i),j);
2162 162302 : GEN t = RgC_Rg_mul(My,c);
2163 162302 : res = res? RgC_add(res,t): t;
2164 : }
2165 : }
2166 111811 : if (!res) { set_avma(av); return zerocol(D); }
2167 111629 : return gc_upto(av, res);
2168 : }
2169 : static GEN
2170 242039 : _tablemul_ej_Fp(GEN mt, GEN x, long j, GEN p)
2171 : {
2172 242039 : pari_sp av = avma;
2173 242039 : long D = lg(mt)-1, i;
2174 242039 : GEN res = NULL;
2175 4364787 : for (i=1; i<=D; i++) {
2176 4122748 : GEN c = gel(x,i);
2177 4122748 : if (!gequal0(c)) {
2178 289954 : GEN My = gel(gel(mt,i),j);
2179 289954 : GEN t = FpC_Fp_mul(My,c,p);
2180 289954 : res = res? FpC_add(res,t,p): t;
2181 : }
2182 : }
2183 242039 : if (!res) { set_avma(av); return zerocol(D); }
2184 241927 : return gc_upto(av, res);
2185 : }
2186 :
2187 : static GEN
2188 619387 : _tablemul_ej_Fl(GEN mt, GEN x, long j, ulong p)
2189 : {
2190 619387 : pari_sp av = avma;
2191 619387 : long D = lg(mt)-1, i;
2192 619387 : GEN res = NULL;
2193 13999108 : for (i=1; i<=D; i++) {
2194 13379721 : ulong c = x[i];
2195 13379721 : if (c) {
2196 1286016 : GEN My = gel(gel(mt,i),j);
2197 1286016 : GEN t = Flv_Fl_mul(My,c, p);
2198 1286016 : res = res? Flv_add(res,t, p): t;
2199 : }
2200 : }
2201 619387 : if (!res) { set_avma(av); return zero_Flv(D); }
2202 619387 : return gc_upto(av, res);
2203 : }
2204 :
2205 : static GEN
2206 686 : algalgmul_csa(GEN al, GEN x, GEN y)
2207 : {
2208 686 : GEN z, nf = alg_get_center(al);
2209 : long i;
2210 686 : z = _tablemul(alg_get_relmultable(al), x, y);
2211 2485 : for (i=1; i<lg(z); i++)
2212 1799 : gel(z,i) = basistoalg(nf,gel(z,i));
2213 686 : return z;
2214 : }
2215 :
2216 : /* assumes x and y in algebraic form */
2217 : static GEN
2218 2345 : algalgmul(GEN al, GEN x, GEN y)
2219 : {
2220 2345 : switch(alg_type(al))
2221 : {
2222 1659 : case al_CYCLIC: return algalgmul_cyc(al, x, y);
2223 686 : case al_CSA: return algalgmul_csa(al, x, y);
2224 : }
2225 : return NULL; /*LCOV_EXCL_LINE*/
2226 : }
2227 :
2228 : static GEN
2229 821411 : algbasismul(GEN al, GEN x, GEN y)
2230 : {
2231 821411 : GEN mt = alg_get_multable(al), p = alg_get_char(al);
2232 821411 : if (signe(p)) return _tablemul_Fp(mt, x, y, p);
2233 521136 : return _tablemul(mt, x, y);
2234 : }
2235 :
2236 : /* x[i,]*y. Assume lg(x) > 1 and 0 < i < lgcols(x) */
2237 : static GEN
2238 119651 : alMrow_alC_mul_i(GEN al, GEN x, GEN y, long i, long lx)
2239 : {
2240 119651 : pari_sp av = avma;
2241 119651 : GEN c = algmul(al,gcoeff(x,i,1),gel(y,1)), ZERO;
2242 : long k;
2243 119651 : ZERO = zerocol(alg_get_absdim(al));
2244 273308 : for (k = 2; k < lx; k++)
2245 : {
2246 153657 : GEN t = algmul(al, gcoeff(x,i,k), gel(y,k));
2247 153657 : if (!gequal(t,ZERO)) c = algadd(al, c, t);
2248 : }
2249 119651 : return gc_GEN(av, c);
2250 : }
2251 : /* return x * y, 1 < lx = lg(x), l = lgcols(x) */
2252 : static GEN
2253 54502 : alM_alC_mul_i(GEN al, GEN x, GEN y, long lx, long l)
2254 : {
2255 54502 : GEN z = cgetg(l,t_COL);
2256 : long i;
2257 174153 : for (i=1; i<l; i++) gel(z,i) = alMrow_alC_mul_i(al,x,y,i,lx);
2258 54502 : return z;
2259 : }
2260 : static GEN
2261 25627 : alM_mul(GEN al, GEN x, GEN y)
2262 : {
2263 25627 : long j, l, lx=lg(x), ly=lg(y);
2264 : GEN z;
2265 25627 : if (ly==1) return cgetg(1,t_MAT);
2266 25529 : if (lx != lgcols(y)) pari_err_DIM("alM_mul");
2267 25508 : if (lx==1) return zeromat(0, ly-1);
2268 25501 : l = lgcols(x); z = cgetg(ly,t_MAT);
2269 80003 : for (j=1; j<ly; j++) gel(z,j) = alM_alC_mul_i(al,x,gel(y,j),lx,l);
2270 25501 : return z;
2271 : }
2272 :
2273 : static void
2274 205639 : H_compo(GEN x, GEN* a, GEN* b, GEN* c, GEN* d)
2275 : {
2276 205639 : switch(H_model(x))
2277 : {
2278 5173 : case H_SCALAR:
2279 5173 : *a = real_i(x);
2280 5173 : *b = imag_i(x);
2281 5173 : *c = gen_0;
2282 5173 : *d = gen_0;
2283 5173 : return;
2284 200466 : case H_QUATERNION:
2285 200466 : *a = gel(x,1);
2286 200466 : *b = gel(x,2);
2287 200466 : *c = gel(x,3);
2288 200466 : *d = gel(x,4);
2289 200466 : return;
2290 : default: *a = *b = *c = *d = NULL; return; /*LCOV_EXCL_LINE*/
2291 : }
2292 : }
2293 : static GEN
2294 108129 : H_mul(GEN x, GEN y)
2295 : {
2296 108129 : pari_sp av = avma;
2297 : GEN a,b,c,d,u,v,w,z;
2298 108129 : long tx = H_model(x), ty = H_model(y);
2299 108115 : if ((tx==H_MATRIX) ^ (ty==H_MATRIX)) pari_err_TYPE2("H_mul", x, y);
2300 108108 : if (tx == H_MATRIX) /* both H_MATRIX */ return alM_mul(NULL, x, y);
2301 103817 : if (tx == H_SCALAR && ty == H_SCALAR) return gmul(x,y);
2302 102620 : H_compo(x,&a,&b,&c,&d);
2303 102620 : H_compo(y,&u,&v,&w,&z);
2304 102620 : return gc_GEN(av,mkcol4(
2305 : gsub(gmul(a,u), gadd(gadd(gmul(b,v),gmul(c,w)),gmul(d,z))),
2306 : gsub(gadd(gmul(a,v),gadd(gmul(b,u),gmul(c,z))), gmul(d,w)),
2307 : gsub(gadd(gmul(a,w),gadd(gmul(c,u),gmul(d,v))), gmul(b,z)),
2308 : gsub(gadd(gmul(a,z),gadd(gmul(b,w),gmul(d,u))), gmul(c,v))
2309 : ));
2310 : }
2311 :
2312 : GEN
2313 822105 : algmul(GEN al, GEN x, GEN y)
2314 : {
2315 822105 : pari_sp av = avma;
2316 : long tx, ty;
2317 822105 : checkalg(al);
2318 822105 : if (alg_type(al)==al_REAL) return H_mul(x,y);
2319 714256 : tx = alg_model(al,x);
2320 714242 : ty = alg_model(al,y);
2321 714242 : if (tx==al_MATRIX) {
2322 20832 : if (ty==al_MATRIX) return alM_mul(al,x,y);
2323 7 : pari_err_TYPE("algmul", y);
2324 : }
2325 693410 : if (signe(alg_get_char(al))) return algbasismul(al,x,y);
2326 521150 : if (tx==al_TRIVIAL) retmkcol(gmul(gel(x,1),gel(y,1)));
2327 520450 : if (tx==al_ALGEBRAIC && ty==al_ALGEBRAIC) return algalgmul(al,x,y);
2328 518924 : if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
2329 518924 : if (ty==al_ALGEBRAIC) y = algalgtobasis(al,y);
2330 518924 : return gc_upto(av,algbasismul(al,x,y));
2331 : }
2332 :
2333 : static GEN
2334 329 : H_sqr(GEN x)
2335 : {
2336 329 : pari_sp av = avma;
2337 329 : long tx = H_model(x);
2338 : GEN a,b,c,d;
2339 308 : if (tx == H_SCALAR) return gsqr(x);
2340 224 : if (tx == H_MATRIX) return H_mul(x,x);
2341 119 : H_compo(x,&a,&b,&c,&d);
2342 119 : return gc_GEN(av, mkcol4(
2343 : gsub(gsqr(a), gadd(gsqr(b),gadd(gsqr(c),gsqr(d)))),
2344 : gshift(gmul(a,b),1),
2345 : gshift(gmul(a,c),1),
2346 : gshift(gmul(a,d),1)
2347 : ));
2348 : }
2349 :
2350 : GEN
2351 127301 : algsqr(GEN al, GEN x)
2352 : {
2353 127301 : pari_sp av = avma;
2354 : long tx;
2355 127301 : checkalg(al);
2356 127266 : if (alg_type(al)==al_REAL) return H_sqr(x);
2357 126937 : tx = alg_model(al,x);
2358 126867 : if (tx==al_MATRIX) return gc_GEN(av,alM_mul(al,x,x));
2359 126356 : if (signe(alg_get_char(al))) return algbasismul(al,x,x);
2360 3381 : if (tx==al_TRIVIAL) retmkcol(gsqr(gel(x,1)));
2361 3031 : if (tx==al_ALGEBRAIC) return algalgmul(al,x,x);
2362 2212 : return gc_upto(av,algbasismul(al,x,x));
2363 : }
2364 :
2365 : static GEN
2366 14399 : algmtK2Z_cyc(GEN al, GEN m)
2367 : {
2368 14399 : pari_sp av = avma;
2369 14399 : GEN nf = alg_get_abssplitting(al), res, mt, rnf = alg_get_splittingfield(al), c, dc;
2370 14399 : long n = alg_get_degree(al), N = nf_get_degree(nf), Nn, i, j, i1, j1;
2371 14399 : Nn = N*n;
2372 14399 : res = zeromatcopy(Nn,Nn);
2373 60312 : for (i=0; i<n; i++)
2374 247380 : for (j=0; j<n; j++) {
2375 201467 : c = gcoeff(m,i+1,j+1);
2376 201467 : if (!gequal0(c)) {
2377 45913 : c = rnfeltreltoabs(rnf,c);
2378 45913 : c = algtobasis(nf,c);
2379 45913 : c = Q_remove_denom(c,&dc);
2380 45913 : mt = zk_multable(nf,c);
2381 45913 : if (dc) mt = ZM_Z_div(mt,dc);
2382 384860 : for (i1=1; i1<=N; i1++)
2383 3464636 : for (j1=1; j1<=N; j1++)
2384 3125689 : gcoeff(res,i*N+i1,j*N+j1) = gcoeff(mt,i1,j1);
2385 : }
2386 : }
2387 14399 : return gc_GEN(av,res);
2388 : }
2389 :
2390 : static GEN
2391 1687 : algmtK2Z_csa(GEN al, GEN m)
2392 : {
2393 1687 : pari_sp av = avma;
2394 1687 : GEN nf = alg_get_center(al), res, mt, c, dc;
2395 1687 : long d2 = alg_get_dim(al), n = nf_get_degree(nf), D, i, j, i1, j1;
2396 1687 : D = d2*n;
2397 1687 : res = zeromatcopy(D,D);
2398 9086 : for (i=0; i<d2; i++)
2399 45206 : for (j=0; j<d2; j++) {
2400 37807 : c = gcoeff(m,i+1,j+1);
2401 37807 : if (!gequal0(c)) {
2402 7035 : c = algtobasis(nf,c);
2403 7035 : c = Q_remove_denom(c,&dc);
2404 7035 : mt = zk_multable(nf,c);
2405 7035 : if (dc) mt = ZM_Z_div(mt,dc);
2406 22064 : for (i1=1; i1<=n; i1++)
2407 50414 : for (j1=1; j1<=n; j1++)
2408 35385 : gcoeff(res,i*n+i1,j*n+j1) = gcoeff(mt,i1,j1);
2409 : }
2410 : }
2411 1687 : return gc_GEN(av,res);
2412 : }
2413 :
2414 : /* assumes al is a CSA or CYCLIC */
2415 : static GEN
2416 16086 : algmtK2Z(GEN al, GEN m)
2417 : {
2418 16086 : switch(alg_type(al))
2419 : {
2420 14399 : case al_CYCLIC: return algmtK2Z_cyc(al, m);
2421 1687 : case al_CSA: return algmtK2Z_csa(al, m);
2422 : }
2423 : return NULL; /*LCOV_EXCL_LINE*/
2424 : }
2425 :
2426 : /* left multiplication table, as a vector space of dimension n over the splitting field (by right multiplication) */
2427 : static GEN
2428 17164 : algalgmultable_cyc(GEN al, GEN x)
2429 : {
2430 17164 : pari_sp av = avma;
2431 17164 : long n = alg_get_degree(al), i, j;
2432 : GEN res, rnf, auts, b, pol;
2433 17164 : rnf = alg_get_splittingfield(al);
2434 17164 : auts = alg_get_auts(al);
2435 17164 : b = alg_get_b(al);
2436 17164 : pol = rnf_get_pol(rnf);
2437 :
2438 17164 : res = zeromatcopy(n,n);
2439 68663 : for (i=0; i<n; i++)
2440 51499 : gcoeff(res,i+1,1) = lift_shallow(rnfbasistoalg(rnf,gel(x,i+1)));
2441 :
2442 68663 : for (i=0; i<n; i++) {
2443 132405 : for (j=1; j<=i; j++)
2444 80906 : gcoeff(res,i+1,j+1) = gmodulo(poleval(gcoeff(res,i-j+1,1),gel(auts,j)),pol);
2445 132405 : for (; j<n; j++)
2446 80906 : gcoeff(res,i+1,j+1) = gmodulo(gmul(b,poleval(gcoeff(res,n+i-j+1,1),gel(auts,j))), pol);
2447 : }
2448 :
2449 68663 : for (i=0; i<n; i++)
2450 51499 : gcoeff(res,i+1,1) = gmodulo(gcoeff(res,i+1,1),pol);
2451 :
2452 17164 : return gc_GEN(av, res);
2453 : }
2454 :
2455 : static GEN
2456 2170 : elementmultable(GEN mt, GEN x)
2457 : {
2458 2170 : pari_sp av = avma;
2459 2170 : long D = lg(mt)-1, i;
2460 2170 : GEN z = NULL;
2461 11207 : for (i=1; i<=D; i++)
2462 : {
2463 9037 : GEN c = gel(x,i);
2464 9037 : if (!gequal0(c))
2465 : {
2466 2961 : GEN M = RgM_Rg_mul(gel(mt,i),c);
2467 2961 : z = z? RgM_add(z, M): M;
2468 : }
2469 : }
2470 2170 : if (!z) { set_avma(av); return zeromatcopy(D,D); }
2471 2170 : return gc_upto(av, z);
2472 : }
2473 : /* mt a t_VEC of Flm modulo m */
2474 : static GEN
2475 51360 : algbasismultable_Flm(GEN mt, GEN x, ulong m)
2476 : {
2477 51360 : pari_sp av = avma;
2478 51360 : long D = lg(gel(mt,1))-1, i;
2479 51360 : GEN z = NULL;
2480 670747 : for (i=1; i<=D; i++)
2481 : {
2482 619387 : ulong c = x[i];
2483 619387 : if (c)
2484 : {
2485 80682 : GEN M = Flm_Fl_mul(gel(mt,i),c, m);
2486 80682 : z = z? Flm_add(z, M, m): M;
2487 : }
2488 : }
2489 51360 : if (!z) { set_avma(av); return zero_Flm(D,D); }
2490 51360 : return gc_upto(av, z);
2491 : }
2492 : static GEN
2493 368056 : elementabsmultable_Z(GEN mt, GEN x)
2494 : {
2495 368056 : long i, l = lg(x);
2496 368056 : GEN z = NULL;
2497 4272215 : for (i = 1; i < l; i++)
2498 : {
2499 3904159 : GEN c = gel(x,i);
2500 3904159 : if (signe(c))
2501 : {
2502 1114295 : GEN M = ZM_Z_mul(gel(mt,i),c);
2503 1114295 : z = z? ZM_add(z, M): M;
2504 : }
2505 : }
2506 368056 : return z;
2507 : }
2508 : static GEN
2509 159050 : elementabsmultable(GEN mt, GEN x)
2510 : {
2511 159050 : GEN d, z = elementabsmultable_Z(mt, Q_remove_denom(x,&d));
2512 159050 : return (z && d)? ZM_Z_div(z, d): z;
2513 : }
2514 : static GEN
2515 209006 : elementabsmultable_Fp(GEN mt, GEN x, GEN p)
2516 : {
2517 209006 : GEN z = elementabsmultable_Z(mt, x);
2518 209006 : return z? FpM_red(z, p): z;
2519 : }
2520 : static GEN
2521 368056 : algbasismultable(GEN al, GEN x)
2522 : {
2523 368056 : pari_sp av = avma;
2524 368056 : GEN z, p = alg_get_char(al), mt = alg_get_multable(al);
2525 368056 : z = signe(p)? elementabsmultable_Fp(mt, x, p): elementabsmultable(mt, x);
2526 368056 : if (!z)
2527 : {
2528 4324 : long D = lg(mt)-1;
2529 4324 : set_avma(av); return zeromat(D,D);
2530 : }
2531 363732 : return gc_upto(av, z);
2532 : }
2533 :
2534 : static GEN
2535 2170 : algalgmultable_csa(GEN al, GEN x)
2536 : {
2537 2170 : GEN nf = alg_get_center(al), m;
2538 : long i,j;
2539 2170 : m = elementmultable(alg_get_relmultable(al), x);
2540 11207 : for (i=1; i<lg(m); i++)
2541 53102 : for(j=1; j<lg(m); j++)
2542 44065 : gcoeff(m,i,j) = basistoalg(nf,gcoeff(m,i,j));
2543 2170 : return m;
2544 : }
2545 :
2546 : /* assumes x in algebraic form */
2547 : static GEN
2548 19005 : algalgmultable(GEN al, GEN x)
2549 : {
2550 19005 : switch(alg_type(al))
2551 : {
2552 17164 : case al_CYCLIC: return algalgmultable_cyc(al, x);
2553 1841 : case al_CSA: return algalgmultable_csa(al, x);
2554 : }
2555 : return NULL; /*LCOV_EXCL_LINE*/
2556 : }
2557 :
2558 : /* on the natural basis */
2559 : /* assumes x in algebraic form */
2560 : static GEN
2561 16086 : algZmultable(GEN al, GEN x) {
2562 16086 : pari_sp av = avma;
2563 16086 : return gc_upto(av, algmtK2Z(al,algalgmultable(al,x)));
2564 : }
2565 :
2566 : /* x integral */
2567 : static GEN
2568 41265 : algbasisrightmultable(GEN al, GEN x)
2569 : {
2570 41265 : long N = alg_get_absdim(al), i,j,k;
2571 41265 : GEN res = zeromatcopy(N,N), c, mt = alg_get_multable(al), p = alg_get_char(al);
2572 41265 : if (gequal0(p)) p = NULL;
2573 374591 : for (i=1; i<=N; i++) {
2574 333326 : c = gel(x,i);
2575 333326 : if (!gequal0(c)) {
2576 1320097 : for (j=1; j<=N; j++)
2577 20118318 : for(k=1; k<=N; k++) {
2578 18918764 : if (p) gcoeff(res,k,j) = Fp_add(gcoeff(res,k,j), Fp_mul(c, gcoeff(gel(mt,j),k,i), p), p);
2579 14262724 : else gcoeff(res,k,j) = addii(gcoeff(res,k,j), mulii(c, gcoeff(gel(mt,j),k,i)));
2580 : }
2581 : }
2582 : }
2583 41265 : return res;
2584 : }
2585 :
2586 : /* central simple algebra al from alginit */
2587 : /* right multiplication table on integral basis; no checks no GC */
2588 : static GEN
2589 77 : algrightmultable(GEN al, GEN x)
2590 : {
2591 : GEN d, M;
2592 77 : x = algalgtobasis(al, x);
2593 70 : x = Q_remove_denom(x, &d);
2594 70 : M = algbasisrightmultable(al,x);
2595 70 : return d ? ZM_Z_div(M,d) : M;
2596 : }
2597 :
2598 : /* basis for matrices : 1, E_{i,j} for (i,j)!=(1,1) */
2599 : /* index : ijk = ((i-1)*N+j-1)*n + k */
2600 : /* square matrices only, coefficients in basis form, shallow function */
2601 : static GEN
2602 23961 : algmat2basis(GEN al, GEN M)
2603 : {
2604 23961 : long n = alg_get_absdim(al), N = lg(M)-1, i, j, k, ij, ijk;
2605 : GEN res, x;
2606 23961 : res = zerocol(N*N*n);
2607 75131 : for (i=1; i<=N; i++) {
2608 163310 : for (j=1, ij=(i-1)*N+1; j<=N; j++, ij++) {
2609 112140 : x = gcoeff(M,i,j);
2610 819532 : for (k=1, ijk=(ij-1)*n+1; k<=n; k++, ijk++) {
2611 707392 : gel(res, ijk) = gel(x, k);
2612 707392 : if (i>1 && i==j) gel(res, ijk) = gsub(gel(res,ijk), gel(res,k));
2613 : }
2614 : }
2615 : }
2616 :
2617 23961 : return res;
2618 : }
2619 :
2620 : static GEN
2621 294 : algbasis2mat(GEN al, GEN M, long N)
2622 : {
2623 294 : long n = alg_get_absdim(al), i, j, k, ij, ijk;
2624 : GEN res, x;
2625 294 : res = zeromatcopy(N,N);
2626 882 : for (i=1; i<=N; i++)
2627 1764 : for (j=1; j<=N; j++)
2628 1176 : gcoeff(res,i,j) = zerocol(n);
2629 :
2630 882 : for (i=1; i<=N; i++) {
2631 1764 : for (j=1, ij=(i-1)*N+1; j<=N; j++, ij++) {
2632 1176 : x = gcoeff(res,i,j);
2633 9240 : for (k=1, ijk=(ij-1)*n+1; k<=n; k++, ijk++) {
2634 8064 : gel(x,k) = gel(M,ijk);
2635 8064 : if (i>1 && i==j) gel(x,k) = gadd(gel(x,k), gel(M,k));
2636 : }
2637 : }
2638 : }
2639 :
2640 294 : return res;
2641 : }
2642 :
2643 : static GEN
2644 23884 : algmatbasis_ei(GEN al, long ijk, long N)
2645 : {
2646 23884 : long n = alg_get_absdim(al), i, j, k, ij;
2647 : GEN res;
2648 :
2649 23884 : res = zeromatcopy(N,N);
2650 74900 : for (i=1; i<=N; i++)
2651 162848 : for (j=1; j<=N; j++)
2652 111832 : gcoeff(res,i,j) = zerocol(n);
2653 :
2654 23884 : k = ijk%n;
2655 23884 : if (k==0) k=n;
2656 23884 : ij = (ijk-k)/n+1;
2657 :
2658 23884 : if (ij==1) {
2659 16947 : for (i=1; i<=N; i++)
2660 11410 : gcoeff(res,i,i) = col_ei(n,k);
2661 5537 : return res;
2662 : }
2663 :
2664 18347 : j = ij%N;
2665 18347 : if (j==0) j=N;
2666 18347 : i = (ij-j)/N+1;
2667 :
2668 18347 : gcoeff(res,i,j) = col_ei(n,k);
2669 18347 : return res;
2670 : }
2671 :
2672 : /* FIXME lazy implementation! */
2673 : static GEN
2674 910 : algleftmultable_mat(GEN al, GEN M)
2675 : {
2676 910 : long N = lg(M)-1, n = alg_get_absdim(al), D = N*N*n, j;
2677 : GEN res, x, Mx;
2678 910 : if (N == 0) return cgetg(1, t_MAT);
2679 903 : if (N != nbrows(M)) pari_err_DIM("algleftmultable_mat (nonsquare)");
2680 882 : res = cgetg(D+1, t_MAT);
2681 24766 : for (j=1; j<=D; j++) {
2682 23884 : x = algmatbasis_ei(al, j, N);
2683 23884 : Mx = algmul(al, M, x);
2684 23884 : gel(res, j) = algmat2basis(al, Mx);
2685 : }
2686 882 : return res;
2687 : }
2688 :
2689 : /* left multiplication table on integral basis */
2690 : static GEN
2691 23660 : algleftmultable(GEN al, GEN x)
2692 : {
2693 23660 : pari_sp av = avma;
2694 : long tx;
2695 : GEN res;
2696 :
2697 23660 : checkalg(al);
2698 23660 : tx = alg_model(al,x);
2699 23639 : switch(tx) {
2700 994 : case al_TRIVIAL : res = mkmatcopy(mkcol(gel(x,1))); break;
2701 280 : case al_ALGEBRAIC : x = algalgtobasis(al,x);
2702 22127 : case al_BASIS : res = algbasismultable(al,x); break;
2703 518 : case al_MATRIX : res = algleftmultable_mat(al,x); break;
2704 : default : return NULL; /* LCOV_EXCL_LINE */
2705 : }
2706 23632 : return gc_upto(av,res);
2707 : }
2708 :
2709 : static GEN
2710 4347 : algbasissplittingmatrix_csa(GEN al, GEN x)
2711 : {
2712 4347 : long d = alg_get_degree(al), i, j;
2713 4347 : GEN rnf = alg_get_splittingfield(al), splba = alg_get_splittingbasis(al), splbainv = alg_get_splittingbasisinv(al), M;
2714 4347 : M = algbasismultable(al,x);
2715 4347 : M = RgM_mul(M, splba); /* TODO best order ? big matrix /Q vs small matrix /nf */
2716 4347 : M = RgM_mul(splbainv, M);
2717 12852 : for (i=1; i<=d; i++)
2718 25326 : for (j=1; j<=d; j++)
2719 16821 : gcoeff(M,i,j) = rnfeltabstorel(rnf, gcoeff(M,i,j));
2720 4347 : return M;
2721 : }
2722 :
2723 : static GEN
2724 728 : algmat_tomatrix(GEN al, GEN x) /* abs = 0 */
2725 : {
2726 : GEN res;
2727 : long i,j;
2728 728 : if (lg(x) == 1) return cgetg(1, t_MAT);
2729 700 : res = zeromatcopy(nbrows(x),lg(x)-1);
2730 2212 : for (j=1; j<lg(x); j++)
2731 4879 : for (i=1; i<lgcols(x); i++)
2732 3367 : gcoeff(res,i,j) = algtomatrix(al,gcoeff(x,i,j),0);
2733 700 : return shallowmatconcat(res);
2734 : }
2735 :
2736 : static GEN
2737 42 : R_tomatrix(GEN x)
2738 : {
2739 42 : long t = H_model(x);
2740 42 : if (t == H_QUATERNION) pari_err_TYPE("R_tomatrix", x);
2741 35 : if (t == H_MATRIX) return x;
2742 21 : return mkmat(mkcol(x));
2743 : }
2744 : static GEN
2745 84 : C_tomatrix(GEN z, long abs)
2746 : {
2747 : GEN x,y;
2748 84 : long t = H_model(z), nrows, ncols;
2749 84 : if (t == H_QUATERNION) pari_err_TYPE("C_tomatrix", z);
2750 77 : if (!abs)
2751 : {
2752 14 : if (t == H_MATRIX) return z;
2753 7 : return mkmat(mkcol(z));
2754 : }
2755 63 : if (t == H_MATRIX)
2756 : {
2757 : /* Warning: this is not the same choice of basis as for other algebras */
2758 : GEN res, a, b;
2759 : long i,j;
2760 56 : RgM_dimensions(z,&nrows,&ncols);
2761 56 : res = zeromatcopy(2*nrows,2*ncols);
2762 168 : for (i=1; i<=nrows; i++)
2763 336 : for (j=1; j<=ncols; j++)
2764 : {
2765 224 : a = real_i(gcoeff(z,i,j));
2766 224 : b = imag_i(gcoeff(z,i,j));
2767 224 : gcoeff(res,2*i-1,2*j-1) = a;
2768 224 : gcoeff(res,2*i,2*j) = a;
2769 224 : gcoeff(res,2*i-1,2*j) = gneg(b);
2770 224 : gcoeff(res,2*i,2*j-1) = b;
2771 : }
2772 56 : return res;
2773 : }
2774 7 : x = real_i(z);
2775 7 : y = imag_i(z);
2776 7 : return mkmat22(x,gneg(y),y,x);
2777 : }
2778 : static GEN
2779 2457 : H_tomatrix(GEN x, long abs)
2780 : {
2781 2457 : long tx = H_model(x);
2782 2450 : GEN a = NULL, b =NULL, c = NULL, d = NULL, md = NULL, M = NULL;
2783 2450 : if (abs) {
2784 413 : if (tx == H_MATRIX) return algleftmultable_mat(NULL,x);
2785 280 : switch(tx)
2786 : {
2787 77 : case H_SCALAR:
2788 77 : a = real_i(x);
2789 77 : b = imag_i(x);
2790 77 : c = gen_0;
2791 77 : d = gen_0;
2792 77 : break;
2793 203 : case H_QUATERNION:
2794 203 : a = gel(x,1);
2795 203 : b = gel(x,2);
2796 203 : c = gel(x,3);
2797 203 : d = gel(x,4);
2798 203 : break;
2799 : }
2800 280 : M = scalarmat(a,4);
2801 280 : gcoeff(M,2,1) = gcoeff(M,4,3) = b;
2802 280 : gcoeff(M,1,2) = gcoeff(M,3,4) = gneg(b);
2803 280 : gcoeff(M,3,1) = gcoeff(M,2,4) = c;
2804 280 : gcoeff(M,4,2) = gcoeff(M,1,3) = gneg(c);
2805 280 : gcoeff(M,4,1) = gcoeff(M,3,2) = d;
2806 280 : gcoeff(M,2,3) = gcoeff(M,1,4) = gneg(d);
2807 : }
2808 : else /* abs == 0 */
2809 : {
2810 2037 : if (tx == H_MATRIX) return algmat_tomatrix(NULL,x);
2811 1778 : switch(tx)
2812 : {
2813 273 : case H_SCALAR:
2814 273 : M = mkmat22(
2815 : x, gen_0,
2816 : gen_0, conj_i(x)
2817 : );
2818 273 : break;
2819 1505 : case H_QUATERNION:
2820 1505 : a = gel(x,1);
2821 1505 : b = gel(x,2);
2822 1505 : c = gel(x,3);
2823 1505 : md = gneg(gel(x,4));
2824 1505 : M = mkmat22(
2825 : mkcomplex(a,b), mkcomplex(gneg(c),md),
2826 : mkcomplex(c,md), mkcomplex(a,gneg(b))
2827 : );
2828 : }
2829 : }
2830 2058 : return M;
2831 : }
2832 :
2833 : GEN
2834 25109 : algtomatrix(GEN al, GEN x, long abs)
2835 : {
2836 25109 : pari_sp av = avma;
2837 25109 : GEN res = NULL;
2838 : long ta, tx;
2839 25109 : checkalg(al);
2840 25109 : ta = alg_type(al);
2841 25109 : if (ta==al_REAL)
2842 : {
2843 2268 : switch(alg_get_absdim(al)) {
2844 42 : case 1: res = R_tomatrix(x); break;
2845 84 : case 2: res = C_tomatrix(x,abs); break;
2846 2135 : case 4: res = H_tomatrix(x,abs); break;
2847 7 : default: pari_err_TYPE("algtomatrix [apply alginit]", al);
2848 : }
2849 2240 : return gc_GEN(av, res);
2850 : }
2851 22841 : if (abs || ta==al_TABLE) return algleftmultable(al,x);
2852 7014 : tx = alg_model(al,x);
2853 7014 : if (tx == al_MATRIX) res = algmat_tomatrix(al,x);
2854 6545 : else switch (alg_type(al))
2855 : {
2856 2198 : case al_CYCLIC:
2857 2198 : if (tx==al_BASIS) x = algbasistoalg(al,x);
2858 2198 : res = algalgmultable(al,x);
2859 2198 : break;
2860 4347 : case al_CSA:
2861 4347 : if (tx==al_ALGEBRAIC) x = algalgtobasis(al,x);
2862 4347 : res = algbasissplittingmatrix_csa(al,x);
2863 4347 : break;
2864 : default: return NULL; /*LCOV_EXCL_LINE*/
2865 : }
2866 7014 : return gc_GEN(av,res);
2867 : }
2868 :
2869 : /* x^(-1)*y, NULL if no solution */
2870 : static GEN
2871 112 : C_divl_i(GEN x, GEN y)
2872 : {
2873 112 : long tx = H_model(x), ty = H_model(y);
2874 112 : if (tx != ty) pari_err_TYPE2("C_divl", x, y);
2875 105 : switch (tx) {
2876 42 : case H_SCALAR:
2877 42 : if (gequal0(x)) return gequal0(y) ? gen_0 : NULL;
2878 14 : else return gdiv(y,x);
2879 56 : case H_MATRIX:
2880 56 : if ((lg(x)>1 && lg(x) != lgcols(x)) || (lg(y)>1 && lg(y) != lgcols(y)))
2881 7 : pari_err_DIM("C_divl (nonsquare)");
2882 49 : if (lg(x) != lg(y)) pari_err_DIM("C_divl");
2883 42 : if (lg(y) == 1) return cgetg(1, t_MAT);
2884 42 : return RgM_invimage(x, y);
2885 7 : default: pari_err_TYPE("C_divl", x); return NULL;
2886 : }
2887 : }
2888 : /* H^k -> C^2k */
2889 : static GEN
2890 140 : HC_to_CC(GEN v)
2891 : {
2892 140 : long l = lg(v), i;
2893 140 : GEN w = cgetg(2*l-1, t_COL), a, b, c, d;
2894 420 : for (i=1; i<l; i++)
2895 : {
2896 280 : H_compo(gel(v,i),&a,&b,&c,&d);
2897 280 : gel(w,2*i-1) = mkcomplex(a,b);
2898 280 : gel(w,2*i) = mkcomplex(c,gneg(d));
2899 : }
2900 140 : return w;
2901 : }
2902 : /* C^2k -> H^k */
2903 : static GEN
2904 98 : CC_to_HC(GEN w)
2905 : {
2906 98 : long l = lg(w), i, lv = (l+1)/2;
2907 98 : GEN v = cgetg(lv, t_COL), ab, cd;
2908 294 : for (i=1; i<lv; i++)
2909 : {
2910 196 : ab = gel(w,2*i-1);
2911 196 : cd = gel(w,2*i);
2912 196 : gel(v,i) = mkcol4(real_i(ab),imag_i(ab),real_i(cd),gneg(imag_i(cd)));
2913 : }
2914 98 : return v;
2915 : }
2916 : /* M_{k,n}(H) -> M_{2k,n}(C) */
2917 : static GEN
2918 210 : HM_to_CM(GEN x) pari_APPLY_same(HC_to_CC(gel(x,i)));
2919 : /* M_{2k,n}(C) -> M_{k,n}(H) */
2920 : static GEN
2921 147 : CM_to_HM(GEN x) pari_APPLY_same(CC_to_HC(gel(x,i)));
2922 : /* x^(-1)*y, NULL if no solution */
2923 : static GEN
2924 203 : H_divl_i(GEN x, GEN y)
2925 : {
2926 203 : pari_sp av = avma;
2927 203 : long tx = H_model(x), ty = H_model(y);
2928 189 : if ((tx==H_MATRIX) ^ (ty==H_MATRIX)) pari_err_TYPE2("H_divl", x, y);
2929 168 : if (tx==H_MATRIX)
2930 : {
2931 : GEN mx, my, mxdivy;
2932 98 : if ((lg(x)>1 && lg(x) != lgcols(x)) || (lg(y)>1 && lg(y) != lgcols(y)))
2933 14 : pari_err_DIM("H_divl (nonsquare)");
2934 84 : if (lg(x) != lg(y)) pari_err_DIM("H_divl");
2935 77 : if (lg(y) == 1) return cgetg(1, t_MAT);
2936 70 : mx = H_tomatrix(x,0);
2937 70 : my = HM_to_CM(y);
2938 70 : mxdivy = RgM_invimage(mx, my);
2939 70 : if (!mxdivy) return gc_NULL(av);
2940 49 : return gc_GEN(av,CM_to_HM(mxdivy));
2941 : }
2942 70 : if (gequal0(y)) return gen_0;
2943 56 : if (gequal0(x)) return NULL;
2944 42 : return gc_GEN(av,H_mul(H_inv(x),y));
2945 : }
2946 : /* x^(-1)*y, NULL if no solution */
2947 : static GEN
2948 3199 : algdivl_i(GEN al, GEN x, GEN y, long tx, long ty) {
2949 3199 : pari_sp av = avma;
2950 3199 : GEN res, p = alg_get_char(al), mtx;
2951 3199 : if (tx != ty) {
2952 343 : if (tx==al_ALGEBRAIC) { x = algalgtobasis(al,x); tx=al_BASIS; }
2953 343 : if (ty==al_ALGEBRAIC) { y = algalgtobasis(al,y); ty=al_BASIS; }
2954 : }
2955 3199 : if (ty == al_MATRIX)
2956 : {
2957 77 : if (alg_type(al) != al_TABLE) y = algalgtobasis(al,y);
2958 77 : y = algmat2basis(al,y);
2959 : }
2960 3199 : if (signe(p)) res = FpM_FpC_invimage(algbasismultable(al,x),y,p);
2961 : else
2962 : {
2963 3010 : if (ty==al_ALGEBRAIC) mtx = algalgmultable(al,x);
2964 2303 : else mtx = algleftmultable(al,x);
2965 3010 : res = inverseimage(mtx,y);
2966 : }
2967 3199 : if (!res || lg(res)==1) return gc_NULL(av);
2968 1764 : if (tx == al_MATRIX) {
2969 294 : res = algbasis2mat(al, res, lg(x)-1);
2970 294 : return gc_GEN(av,res);
2971 : }
2972 1470 : return gc_upto(av,res);
2973 : }
2974 : static GEN
2975 1015 : algdivl_i2(GEN al, GEN x, GEN y)
2976 : {
2977 : long tx, ty;
2978 1015 : checkalg(al);
2979 1015 : if (alg_type(al)==al_REAL) switch(alg_get_absdim(al)) {
2980 112 : case 1: case 2: return C_divl_i(x,y);
2981 147 : case 4: return H_divl_i(x,y);
2982 : }
2983 756 : tx = alg_model(al,x);
2984 749 : ty = alg_model(al,y);
2985 749 : if (tx == al_MATRIX) {
2986 140 : if (ty != al_MATRIX) pari_err_TYPE2("\\", x, y);
2987 133 : if ((lg(x)>1 && lg(x) != lgcols(x)) || (lg(y)>1 && lg(y) != lgcols(y)))
2988 28 : pari_err_DIM("algdivl (nonsquare)");
2989 105 : if (lg(x) != lg(y)) pari_err_DIM("algdivl");
2990 84 : if (lg(y) == 1) return cgetg(1, t_MAT);
2991 : }
2992 686 : return algdivl_i(al,x,y,tx,ty);
2993 : }
2994 :
2995 : GEN
2996 889 : algdivl(GEN al, GEN x, GEN y)
2997 : {
2998 : GEN z;
2999 889 : z = algdivl_i2(al,x,y);
3000 742 : if (!z) pari_err_INV("algdivl", x);
3001 728 : return z;
3002 : }
3003 :
3004 : int
3005 126 : algisdivl(GEN al, GEN x, GEN y, GEN* ptz)
3006 : {
3007 126 : pari_sp av = avma;
3008 126 : GEN z = algdivl_i2(al,x,y);
3009 126 : if (!z) return gc_bool(av,0);
3010 84 : if (ptz != NULL) *ptz = z;
3011 84 : return 1;
3012 : }
3013 :
3014 : static GEN
3015 140 : C_inv(GEN x)
3016 : {
3017 140 : switch (H_model(x))
3018 : {
3019 63 : case H_SCALAR: return gequal0(x) ? NULL : ginv(x);
3020 70 : case H_MATRIX: return RgM_inv(x);
3021 7 : default: pari_err_TYPE("alginv_i", x);
3022 : }
3023 : return NULL; /*LCOV_EXCL_LINE*/
3024 : }
3025 : static GEN
3026 259 : H_inv(GEN x)
3027 : {
3028 259 : pari_sp av = avma;
3029 : GEN nm, xi;
3030 : long i;
3031 259 : switch (H_model(x))
3032 : {
3033 28 : case H_SCALAR:
3034 28 : if (gequal0(x)) return NULL;
3035 14 : return ginv(x);
3036 161 : case H_QUATERNION:
3037 161 : if (gequal0(x)) return NULL;
3038 154 : nm = H_norm(x, 0);
3039 154 : xi = gdiv(x,nm);
3040 616 : for(i=2; i<=4; i++) gel(xi,i) = gneg(gel(xi,i));
3041 154 : return gc_GEN(av,xi);
3042 63 : case H_MATRIX:
3043 63 : if (lg(x)==1) return cgetg(1,t_MAT);
3044 56 : return H_divl_i(x, matid(lg(x)-1));
3045 : }
3046 : return NULL; /*LCOV_EXCL_LINE*/
3047 : }
3048 : static GEN
3049 2989 : alginv_i(GEN al, GEN x)
3050 : {
3051 2989 : pari_sp av = avma;
3052 2989 : GEN res = NULL, p = alg_get_char(al);
3053 : long tx, n, ta;
3054 2989 : ta = alg_type(al);
3055 2989 : if (ta==al_REAL) switch(alg_get_absdim(al)) {
3056 140 : case 1: case 2: return C_inv(x);
3057 217 : case 4: return H_inv(x);
3058 7 : default: pari_err_TYPE("alginv_i [apply alginit]", al);
3059 : }
3060 2625 : tx = alg_model(al,x);
3061 2604 : switch(tx) {
3062 70 : case al_TRIVIAL :
3063 70 : if (signe(p)) { res = mkcol(Fp_inv(gel(x,1),p)); break; }
3064 56 : else { res = mkcol(ginv(gel(x,1))); break; }
3065 455 : case al_ALGEBRAIC :
3066 455 : switch(ta) {
3067 350 : case al_CYCLIC: n = alg_get_degree(al); break;
3068 105 : case al_CSA: n = alg_get_dim(al); break;
3069 : default: return NULL; /* LCOV_EXCL_LINE */
3070 : }
3071 455 : res = algdivl_i(al, x, col_ei(n,1), tx, al_ALGEBRAIC); break;
3072 1841 : case al_BASIS : res = algdivl_i(al, x, col_ei(alg_get_absdim(al),1), tx,
3073 1841 : al_BASIS); break;
3074 238 : case al_MATRIX :
3075 238 : n = lg(x)-1;
3076 238 : if (n==0) return cgetg(1, t_MAT);
3077 224 : if (n != nbrows(x)) pari_err_DIM("alginv_i (nonsquare)");
3078 217 : res = algdivl_i(al, x, col_ei(n*n*alg_get_absdim(al),1), tx, al_BASIS);
3079 : /* cheat on type because wrong dimension */
3080 : }
3081 2583 : if (!res) return gc_NULL(av);
3082 1162 : return gc_GEN(av,res);
3083 : }
3084 : GEN
3085 1330 : alginv(GEN al, GEN x)
3086 : {
3087 : GEN z;
3088 1330 : checkalg(al);
3089 1330 : z = alginv_i(al,x);
3090 1281 : if (!z) pari_err_INV("alginv", x);
3091 1246 : return z;
3092 : }
3093 :
3094 : int
3095 1659 : algisinv(GEN al, GEN x, GEN* ptix)
3096 : {
3097 1659 : pari_sp av = avma;
3098 : GEN ix;
3099 1659 : if (al) checkalg(al);
3100 1659 : ix = alginv_i(al,x);
3101 1659 : if (!ix) return gc_bool(av,0);
3102 196 : if (ptix != NULL) *ptix = ix;
3103 196 : return 1;
3104 : }
3105 :
3106 : /* x*y^(-1) */
3107 : GEN
3108 469 : algdivr(GEN al, GEN x, GEN y) { return algmul(al, x, alginv(al, y)); }
3109 :
3110 : static GEN
3111 52317 : _mul(void* data, GEN x, GEN y) { return algmul((GEN)data,x,y); }
3112 : static GEN
3113 124907 : _sqr(void* data, GEN x) { return algsqr((GEN)data,x); }
3114 :
3115 : static GEN
3116 21 : algmatid(GEN al, long N)
3117 : {
3118 21 : long n = alg_get_absdim(al), i, j;
3119 : GEN res, one, zero;
3120 :
3121 21 : res = zeromatcopy(N,N);
3122 21 : one = col_ei(n,1);
3123 21 : zero = zerocol(n);
3124 49 : for (i=1; i<=N; i++)
3125 84 : for (j=1; j<=N; j++)
3126 56 : gcoeff(res,i,j) = i==j ? one : zero;
3127 21 : return res;
3128 : }
3129 :
3130 : GEN
3131 22555 : algpow(GEN al, GEN x, GEN n)
3132 : {
3133 22555 : pari_sp av = avma;
3134 : GEN res;
3135 22555 : long s = signe(n);
3136 22555 : checkalg(al);
3137 22555 : if (!s && alg_type(al)==al_REAL)
3138 : {
3139 63 : if (H_model(x) == H_MATRIX) return matid(lg(x)-1);
3140 35 : else return gen_1;
3141 : }
3142 22492 : switch (s) {
3143 28 : case 0:
3144 28 : if (alg_model(al,x) == al_MATRIX)
3145 21 : res = algmatid(al,lg(x)-1);
3146 : else
3147 7 : res = col_ei(alg_get_absdim(al),1);
3148 28 : return res;
3149 22317 : case 1:
3150 22317 : res = gen_pow_i(x, n, (void*)al, _sqr, _mul); break;
3151 147 : default: /* -1 */
3152 147 : res = gen_pow_i(alginv(al,x), gneg(n), (void*)al, _sqr, _mul);
3153 : }
3154 22450 : return gc_GEN(av,res);
3155 : }
3156 :
3157 : static GEN
3158 546 : algredcharpoly_i(GEN al, GEN x, long v)
3159 : {
3160 546 : GEN rnf = alg_get_splittingfield(al);
3161 546 : GEN cp = charpoly(algtomatrix(al,x,0),v);
3162 539 : long i, m = lg(cp);
3163 2184 : for (i=2; i<m; i++) gel(cp,i) = rnfeltdown(rnf, gel(cp,i));
3164 539 : return cp;
3165 : }
3166 :
3167 : /* assumes al is CSA or CYCLIC */
3168 : static GEN
3169 553 : algredcharpoly(GEN al, GEN x, long v)
3170 : {
3171 553 : pari_sp av = avma;
3172 553 : long w = gvar(rnf_get_pol(alg_get_center(al)));
3173 553 : if (varncmp(v,w)>=0) pari_err_PRIORITY("algredcharpoly",pol_x(v),">=",w);
3174 546 : switch(alg_type(al))
3175 : {
3176 546 : case al_CYCLIC:
3177 : case al_CSA:
3178 546 : return gc_upto(av, algredcharpoly_i(al, x, v));
3179 : }
3180 : return NULL; /*LCOV_EXCL_LINE*/
3181 : }
3182 :
3183 : static GEN
3184 31963 : algbasischarpoly(GEN al, GEN x, long v)
3185 : {
3186 31963 : pari_sp av = avma;
3187 31963 : GEN p = alg_get_char(al), mx;
3188 31963 : if (alg_model(al,x) == al_MATRIX) mx = algleftmultable_mat(al,x);
3189 31872 : else mx = algbasismultable(al,x);
3190 31956 : if (signe(p)) {
3191 29604 : GEN res = FpM_charpoly(mx,p);
3192 29604 : setvarn(res,v);
3193 29604 : return gc_upto(av, res);
3194 : }
3195 2352 : return gc_upto(av, charpoly(mx,v));
3196 : }
3197 :
3198 : static GEN
3199 35 : R_charpoly(GEN x, long v, long abs)
3200 : {
3201 35 : pari_sp av = avma;
3202 35 : GEN res = NULL;
3203 35 : switch (H_model(x))
3204 : {
3205 14 : case H_SCALAR: res = mkpoln(2, gen_1, gneg(x)); break;
3206 14 : case H_MATRIX:
3207 14 : res = charpoly(x,v);
3208 14 : if (abs) res = gpowgs(res,nbrows(x));
3209 14 : break;
3210 7 : default: pari_err_TYPE("R_charpoly", x);
3211 : }
3212 28 : if (v) setvarn(res, v);
3213 28 : return gc_GEN(av, res);
3214 : }
3215 : static GEN
3216 35 : C_charpoly(GEN x, long v, long abs)
3217 : {
3218 35 : pari_sp av = avma;
3219 35 : GEN res = NULL;
3220 35 : switch (H_model(x))
3221 : {
3222 14 : case H_SCALAR:
3223 14 : if (abs) res = mkpoln(3, gen_1, gneg(gshift(real_i(x),1)), cxnorm(x));
3224 7 : else res = mkpoln(2, gen_1, gneg(x));
3225 14 : break;
3226 14 : case H_MATRIX:
3227 14 : res = charpoly(x,v);
3228 14 : if (abs) res = gpowgs(real_i(gmul(res,gconj(res))),nbrows(x));
3229 14 : break;
3230 7 : default: pari_err_TYPE("C_charpoly", x);
3231 : }
3232 28 : if (v) setvarn(res, v);
3233 28 : return gc_GEN(av, res);
3234 : }
3235 : static GEN
3236 98 : H_charpoly(GEN x, long v, long abs)
3237 : {
3238 98 : pari_sp av = avma;
3239 : GEN res;
3240 98 : if (H_model(x) == H_MATRIX) return greal(charpoly(H_tomatrix(x,abs),v));
3241 70 : res = mkpoln(3, gen_1, gneg(H_trace(x,0)), H_norm(x,0));
3242 70 : if (v) setvarn(res, v);
3243 70 : if (abs) res = gsqr(res);
3244 70 : return gc_GEN(av, res);
3245 : }
3246 :
3247 : GEN
3248 32152 : algcharpoly(GEN al, GEN x, long v, long abs)
3249 : {
3250 : long ta;
3251 32152 : if (v<0) v=0;
3252 32152 : checkalg(al);
3253 32152 : ta = alg_type(al);
3254 32152 : if (ta == al_REAL) switch (alg_get_absdim(al)) {
3255 35 : case 1: return R_charpoly(x, v, abs);
3256 35 : case 2: return C_charpoly(x, v, abs);
3257 98 : case 4: return H_charpoly(x, v, abs);
3258 7 : default: pari_err_TYPE("algcharpoly [apply alginit]", al);
3259 : }
3260 :
3261 : /* gneg(x[1]) left on stack */
3262 31977 : if (alg_model(al,x) == al_TRIVIAL) {
3263 84 : GEN p = alg_get_char(al);
3264 84 : if (signe(p)) return deg1pol(gen_1,Fp_neg(gel(x,1),p),v);
3265 70 : return deg1pol(gen_1,gneg(gel(x,1)),v);
3266 : }
3267 :
3268 31886 : switch(ta) {
3269 665 : case al_CYCLIC: case al_CSA:
3270 665 : if (abs)
3271 : {
3272 112 : if (alg_model(al,x)==al_ALGEBRAIC) x = algalgtobasis(al,x);
3273 : }
3274 553 : else return algredcharpoly(al,x,v);
3275 31333 : case al_TABLE: return algbasischarpoly(al,x,v);
3276 : default : return NULL; /* LCOV_EXCL_LINE */
3277 : }
3278 : }
3279 :
3280 : /* assumes x in basis form */
3281 : static GEN
3282 652441 : algabstrace(GEN al, GEN x)
3283 : {
3284 652441 : pari_sp av = avma;
3285 652441 : GEN res = NULL, p = alg_get_char(al);
3286 652441 : if (signe(p)) return FpV_dotproduct(x, alg_get_tracebasis(al), p);
3287 49462 : switch(alg_model(al,x)) {
3288 154 : case al_TRIVIAL: return gcopy(gel(x,1)); break;
3289 49308 : case al_BASIS: res = RgV_dotproduct(x, alg_get_tracebasis(al)); break;
3290 : }
3291 49308 : return gc_upto(av,res);
3292 : }
3293 :
3294 : static GEN
3295 1512 : algredtrace(GEN al, GEN x)
3296 : {
3297 1512 : pari_sp av = avma;
3298 1512 : GEN res = NULL;
3299 1512 : switch(alg_model(al,x)) {
3300 35 : case al_TRIVIAL: return gcopy(gel(x,1)); break;
3301 560 : case al_BASIS: return algredtrace(al, algbasistoalg(al,x));
3302 : /* TODO precompute too? */
3303 917 : case al_ALGEBRAIC:
3304 917 : switch(alg_type(al))
3305 : {
3306 588 : case al_CYCLIC:
3307 588 : res = rnfelttrace(alg_get_splittingfield(al),gel(x,1));
3308 588 : break;
3309 329 : case al_CSA:
3310 329 : res = gtrace(algalgmultable_csa(al,x));
3311 329 : res = gdiv(res, stoi(alg_get_degree(al)));
3312 329 : break;
3313 : default: return NULL; /* LCOV_EXCL_LINE */
3314 : }
3315 : }
3316 917 : return gc_upto(av,res);
3317 : }
3318 :
3319 : static GEN
3320 469 : algtrace_mat(GEN al, GEN M, long abs) {
3321 469 : pari_sp av = avma;
3322 469 : long N = lg(M)-1, i;
3323 469 : GEN res, p = alg_get_char(al);
3324 469 : if (N == 0) return gen_0;
3325 448 : if (N != nbrows(M)) pari_err_DIM("algtrace_mat (nonsquare)");
3326 :
3327 434 : if (!signe(p)) p = NULL;
3328 434 : if (alg_type(al) == al_TABLE) abs = 1;
3329 434 : res = algtrace(al, gcoeff(M,1,1), abs);
3330 896 : for (i=2; i<=N; i++) {
3331 462 : if (p) res = Fp_add(res, algtrace(al,gcoeff(M,i,i),abs), p);
3332 455 : else res = gadd(res, algtrace(al,gcoeff(M,i,i),abs));
3333 : }
3334 434 : if (abs) res = gmulgu(res, N); /* absolute trace */
3335 434 : return gc_upto(av, res);
3336 : }
3337 :
3338 : static GEN
3339 35 : R_trace(GEN x, long abs)
3340 : {
3341 35 : pari_sp av = avma;
3342 35 : GEN res = NULL;
3343 35 : switch (H_model(x))
3344 : {
3345 14 : case H_SCALAR: res = gcopy(x); break;
3346 14 : case H_MATRIX: res = abs? mulrs(gtrace(x),nbrows(x)) : gtrace(x); break;
3347 7 : default: pari_err_TYPE("R_trace", x);
3348 : }
3349 28 : return gc_GEN(av, res);
3350 : }
3351 : static GEN
3352 35 : C_trace(GEN x, long abs)
3353 : {
3354 35 : pari_sp av = avma;
3355 35 : GEN res = NULL;
3356 35 : switch (H_model(x))
3357 : {
3358 14 : case H_SCALAR: res = abs ? gshift(real_i(x),1) : x; break;
3359 14 : case H_MATRIX:
3360 14 : res = abs ? mulrs(real_i(gtrace(x)),2*nbrows(x)) : gtrace(x); break;
3361 7 : default: pari_err_TYPE("C_trace", x);
3362 : }
3363 28 : return gc_GEN(av, res);
3364 : }
3365 : static GEN
3366 567 : H_trace(GEN x, long abs)
3367 : {
3368 567 : long s = abs? 2 : 1;
3369 567 : switch (H_model(x))
3370 : {
3371 154 : case H_SCALAR: return gshift(real_i(x),s);
3372 329 : case H_QUATERNION: return gshift(gel(x,1),s);
3373 77 : case H_MATRIX:
3374 77 : return algtrace_mat(NULL, x, abs);
3375 : }
3376 : return NULL; /*LCOV_EXCL_LINE*/
3377 : }
3378 :
3379 : GEN
3380 2702 : algtrace(GEN al, GEN x, long abs)
3381 : {
3382 : long ta;
3383 2702 : checkalg(al);
3384 2702 : ta = alg_type(al);
3385 2702 : if (ta==al_REAL) switch (alg_get_absdim(al)) {
3386 35 : case 1: return R_trace(x,abs);
3387 35 : case 2: return C_trace(x,abs);
3388 497 : case 4: return H_trace(x,abs);
3389 7 : default: pari_err_TYPE("algtrace [apply alginit]", al);
3390 : }
3391 2128 : if (alg_model(al,x) == al_MATRIX) return algtrace_mat(al,x,abs);
3392 1736 : switch(ta) {
3393 1596 : case al_CYCLIC: case al_CSA:
3394 1596 : if (!abs) return algredtrace(al,x);
3395 644 : if (alg_model(al,x)==al_ALGEBRAIC) x = algalgtobasis(al,x);
3396 784 : case al_TABLE: return algabstrace(al,x);
3397 : default : return NULL; /* LCOV_EXCL_LINE */
3398 : }
3399 : }
3400 :
3401 : static GEN
3402 65063 : algtracebasis(GEN al)
3403 : {
3404 65063 : pari_sp av = avma;
3405 65063 : GEN mt = alg_get_multable(al), p = alg_get_char(al);
3406 65063 : long i, l = lg(mt);
3407 65063 : GEN v = cgetg(l, t_VEC);
3408 284951 : if (signe(p)) for (i=1; i < l; i++) gel(v,i) = FpM_trace(gel(mt,i), p);
3409 78261 : else for (i=1; i < l; i++) gel(v,i) = ZM_trace(gel(mt,i));
3410 65063 : return gc_upto(av,v);
3411 : }
3412 :
3413 : /* Assume: i > 0, expo := p^i <= absdim, x contained in I_{i-1} given by mult
3414 : * table modulo modu=p^(i+1). Return Tr(x^(p^i)) mod modu */
3415 : static ulong
3416 51360 : algtracei(GEN mt, ulong p, ulong expo, ulong modu)
3417 : {
3418 51360 : pari_sp av = avma;
3419 51360 : long j, l = lg(mt);
3420 51360 : ulong tr = 0;
3421 51360 : mt = Flm_powu(mt,expo,modu);
3422 670747 : for (j=1; j<l; j++) tr += ucoeff(mt,j,j);
3423 51360 : return gc_ulong(av, (tr/expo) % p);
3424 : }
3425 :
3426 : static GEN
3427 42 : R_norm(GEN x, long abs)
3428 : {
3429 42 : pari_sp av = avma;
3430 42 : GEN res = NULL;
3431 42 : switch (H_model(x))
3432 : {
3433 14 : case H_SCALAR: res = gcopy(x); break;
3434 21 : case H_MATRIX: res = abs ? powrs(det(x),nbrows(x)) : det(x); break;
3435 7 : default: pari_err_TYPE("R_norm", x);
3436 : }
3437 35 : return gc_GEN(av,res);
3438 : }
3439 : static GEN
3440 42 : C_norm(GEN x, long abs)
3441 : {
3442 42 : pari_sp av = avma;
3443 42 : GEN res = NULL;
3444 42 : switch (H_model(x))
3445 : {
3446 14 : case H_SCALAR: res = abs ? cxnorm(x) : x; break;
3447 21 : case H_MATRIX: res = abs ? powrs(cxnorm(det(x)),nbrows(x)) : det(x); break;
3448 7 : default: pari_err_TYPE("C_norm", x);
3449 : }
3450 35 : return gc_GEN(av,res);
3451 : }
3452 : static GEN
3453 434 : H_norm(GEN x, long abs)
3454 : {
3455 434 : pari_sp av = avma;
3456 434 : switch (H_model(x))
3457 : {
3458 42 : case H_SCALAR:
3459 42 : if (abs) return gc_GEN(av,gsqr(gnorm(x)));
3460 35 : else return gnorm(x);
3461 322 : case H_QUATERNION:
3462 322 : if (abs) return gc_GEN(av,gsqr(gnorml2(x)));
3463 294 : else return gnorml2(x);
3464 63 : case H_MATRIX:
3465 63 : return gc_GEN(av,real_i(det(H_tomatrix(x,abs))));
3466 : }
3467 : return NULL; /*LCOV_EXCL_LINE*/
3468 : }
3469 :
3470 : GEN
3471 1309 : algnorm(GEN al, GEN x, long abs)
3472 : {
3473 1309 : pari_sp av = avma;
3474 : long tx, ta;
3475 : GEN p, rnf, res, mx;
3476 1309 : checkalg(al);
3477 1309 : ta = alg_type(al);
3478 1309 : if (ta==al_REAL) switch (alg_get_absdim(al)) {
3479 42 : case 1: return R_norm(x,abs);
3480 42 : case 2: return C_norm(x,abs);
3481 210 : case 4: return H_norm(x,abs);
3482 7 : default: pari_err_TYPE("algnorm [apply alginit]", al);
3483 : }
3484 1008 : p = alg_get_char(al);
3485 1008 : tx = alg_model(al,x);
3486 1008 : if (signe(p)) {
3487 21 : if (tx == al_MATRIX) mx = algleftmultable_mat(al,x);
3488 14 : else mx = algbasismultable(al,x);
3489 21 : return gc_upto(av, FpM_det(mx,p));
3490 : }
3491 987 : if (tx == al_TRIVIAL) return gcopy(gel(x,1));
3492 :
3493 945 : switch(ta) {
3494 875 : case al_CYCLIC: case al_CSA:
3495 875 : if (abs)
3496 : {
3497 196 : if (alg_model(al,x)==al_ALGEBRAIC) x = algalgtobasis(al,x);
3498 : }
3499 : else
3500 : {
3501 679 : rnf = alg_get_splittingfield(al);
3502 679 : res = rnfeltdown(rnf, det(algtomatrix(al,x,0)));
3503 672 : break;
3504 : }
3505 : case al_TABLE:
3506 266 : if (tx == al_MATRIX) mx = algleftmultable_mat(al,x);
3507 105 : else mx = algbasismultable(al,x);
3508 259 : res = det(mx);
3509 259 : break;
3510 : default: return NULL; /* LCOV_EXCL_LINE */
3511 : }
3512 931 : return gc_upto(av, res);
3513 : }
3514 :
3515 : static GEN
3516 70491 : algalgtonat_cyc(GEN al, GEN x)
3517 : {
3518 70491 : pari_sp av = avma;
3519 70491 : GEN nf = alg_get_abssplitting(al), rnf = alg_get_splittingfield(al), res, c;
3520 70491 : long n = alg_get_degree(al), N = nf_get_degree(nf), i, i1;
3521 70491 : res = zerocol(N*n);
3522 219132 : for (i=0; i<n; i++) {
3523 148641 : c = gel(x,i+1);
3524 148641 : c = rnfeltreltoabs(rnf,c);
3525 148641 : if (!gequal0(c)) {
3526 96622 : c = algtobasis(nf,c);
3527 502115 : for (i1=1; i1<=N; i1++) gel(res,i*N+i1) = gel(c,i1);
3528 : }
3529 : }
3530 70491 : return gc_GEN(av, res);
3531 : }
3532 :
3533 : static GEN
3534 16163 : algalgtonat_csa(GEN al, GEN x)
3535 : {
3536 16163 : pari_sp av = avma;
3537 16163 : GEN nf = alg_get_center(al), res, c;
3538 16163 : long d2 = alg_get_dim(al), n = nf_get_degree(nf), i, i1;
3539 16163 : res = zerocol(d2*n);
3540 80129 : for (i=0; i<d2; i++) {
3541 63966 : c = gel(x,i+1);
3542 63966 : if (!gequal0(c)) {
3543 35980 : c = algtobasis(nf,c);
3544 107415 : for (i1=1; i1<=n; i1++) gel(res,i*n+i1) = gel(c,i1);
3545 : }
3546 : }
3547 16163 : return gc_GEN(av, res);
3548 : }
3549 :
3550 : /* assumes al CSA or CYCLIC */
3551 : static GEN
3552 86654 : algalgtonat(GEN al, GEN x)
3553 : {
3554 86654 : switch(alg_type(al))
3555 : {
3556 70491 : case al_CYCLIC: return algalgtonat_cyc(al, x);
3557 16163 : case al_CSA: return algalgtonat_csa(al, x);
3558 : }
3559 : return NULL; /*LCOV_EXCL_LINE*/
3560 : }
3561 :
3562 : static GEN
3563 17094 : algnattoalg_cyc(GEN al, GEN x)
3564 : {
3565 17094 : pari_sp av = avma;
3566 17094 : GEN nf = alg_get_abssplitting(al), rnf = alg_get_splittingfield(al), res, c;
3567 17094 : long n = alg_get_degree(al), N = nf_get_degree(nf), i, i1;
3568 17094 : res = zerocol(n);
3569 17094 : c = zerocol(N);
3570 68390 : for (i=0; i<n; i++) {
3571 411523 : for (i1=1; i1<=N; i1++) gel(c,i1) = gel(x,i*N+i1);
3572 51296 : gel(res,i+1) = rnfeltabstorel(rnf,basistoalg(nf,c));
3573 : }
3574 17094 : return gc_GEN(av, res);
3575 : }
3576 :
3577 : static GEN
3578 2135 : algnattoalg_csa(GEN al, GEN x)
3579 : {
3580 2135 : pari_sp av = avma;
3581 2135 : GEN nf = alg_get_center(al), res, c;
3582 2135 : long d2 = alg_get_dim(al), n = nf_get_degree(nf), i, i1;
3583 2135 : res = zerocol(d2);
3584 2135 : c = zerocol(n);
3585 11032 : for (i=0; i<d2; i++) {
3586 28728 : for (i1=1; i1<=n; i1++) gel(c,i1) = gel(x,i*n+i1);
3587 8897 : gel(res,i+1) = basistoalg(nf,c);
3588 : }
3589 2135 : return gc_GEN(av, res);
3590 : }
3591 :
3592 : /* assumes al CSA or CYCLIC */
3593 : static GEN
3594 19229 : algnattoalg(GEN al, GEN x)
3595 : {
3596 19229 : switch(alg_type(al))
3597 : {
3598 17094 : case al_CYCLIC: return algnattoalg_cyc(al, x);
3599 2135 : case al_CSA: return algnattoalg_csa(al, x);
3600 : }
3601 : return NULL; /*LCOV_EXCL_LINE*/
3602 : }
3603 :
3604 : static GEN
3605 182 : algalgtobasis_mat(GEN al, GEN x) /* componentwise */
3606 : {
3607 182 : pari_sp av = avma;
3608 : long lx, lxj, i, j;
3609 : GEN res;
3610 182 : lx = lg(x);
3611 182 : res = cgetg(lx, t_MAT);
3612 546 : for (j=1; j<lx; j++) {
3613 364 : lxj = lg(gel(x,j));
3614 364 : gel(res,j) = cgetg(lxj, t_COL);
3615 1092 : for (i=1; i<lxj; i++)
3616 728 : gcoeff(res,i,j) = algalgtobasis(al,gcoeff(x,i,j));
3617 : }
3618 182 : return gc_GEN(av,res);
3619 : }
3620 : GEN
3621 88656 : algalgtobasis(GEN al, GEN x)
3622 : {
3623 : pari_sp av;
3624 : long tx, ta;
3625 88656 : checkalg(al);
3626 88649 : ta = alg_type(al);
3627 88649 : if (ta != al_CYCLIC && ta != al_CSA) pari_err_TYPE("algalgtobasis [use alginit]", al);
3628 88614 : tx = alg_model(al,x);
3629 88593 : if (tx==al_BASIS) return gcopy(x);
3630 86752 : if (tx==al_MATRIX) return algalgtobasis_mat(al,x);
3631 86570 : av = avma;
3632 86570 : x = algalgtonat(al,x);
3633 86570 : x = RgM_RgC_mul(alg_get_invbasis(al),x);
3634 86570 : return gc_upto(av, x);
3635 : }
3636 :
3637 : /*
3638 : Quaternion algebras special case:
3639 : al = (L/F, sigma, b) with L quadratic
3640 : > v^2-a: i = v
3641 : > v^2+A*v+B: i = 2*v+A: i^2 = a = A^2-4*B
3642 : al ~ (a,b)_F
3643 : */
3644 : /* We could improve efficiency, but these functions are just for convenience. */
3645 : GEN
3646 280 : algquattobasis(GEN al, GEN x)
3647 : {
3648 280 : pari_sp av = avma;
3649 : GEN L1, L2, pol, A, x2, nf;
3650 : long v, i, ta;
3651 280 : checkalg(al);
3652 273 : if (alg_is_asq(al))
3653 : {
3654 84 : x = algalgtonat(al,x);
3655 84 : x = RgM_RgC_mul(alg_get_invbasis(al),x);
3656 84 : return gc_upto(av,x);
3657 : }
3658 189 : ta = alg_type(al);
3659 189 : if (ta != al_CYCLIC || alg_get_degree(al)!=2)
3660 28 : pari_err_TYPE("algquattobasis [not a quaternion algebra]", al);
3661 161 : if (typ(x)!=t_COL && typ(x)!=t_VEC) pari_err_TYPE("algquattobasis", x);
3662 154 : if (lg(x)!=5) pari_err_DIM("algquattobasis [quaternions have 4 components]");
3663 147 : nf = alg_get_center(al);
3664 147 : x2 = cgetg(5, t_COL);
3665 707 : for (i=1; i<=4; i++) gel(x2,i) = basistoalg(nf, gel(x,i));
3666 140 : gel(x2,4) = gneg(gel(x2,4));
3667 140 : pol = alg_get_splitpol(al);
3668 140 : v = varn(pol);
3669 140 : A = gel(pol,3); /* coeff of v^1 */
3670 140 : if (gequal0(A))
3671 : {
3672 : /* i = v */
3673 91 : L1 = deg1pol_shallow(gel(x2,2), gel(x2,1), v);
3674 91 : L2 = deg1pol_shallow(gel(x2,4), gel(x2,3), v);
3675 : }
3676 : else
3677 : {
3678 : /* i = 2*v+A */
3679 49 : L1 = deg1pol_shallow(gshift(gel(x2,2),1),
3680 49 : gadd(gel(x2,1),gmul(A,gel(x2,2))), v);
3681 49 : L2 = deg1pol_shallow(gshift(gel(x2,4),1),
3682 49 : gadd(gel(x2,3),gmul(A,gel(x2,4))), v);
3683 : }
3684 140 : return gc_upto(av, algalgtobasis(al,mkcol2(L1,L2)));
3685 : }
3686 : GEN
3687 126 : algbasistoquat(GEN al, GEN x)
3688 : {
3689 126 : pari_sp av = avma;
3690 : GEN pol, A, x2, q;
3691 : long v, ta;
3692 126 : checkalg(al);
3693 119 : if (alg_is_asq(al))
3694 : {
3695 21 : x = RgM_RgC_mul(alg_get_basis(al),x);
3696 21 : x = algnattoalg(al,x);
3697 21 : return gc_upto(av, x);
3698 : }
3699 98 : ta = alg_type(al);
3700 98 : if (ta != al_CYCLIC || alg_get_degree(al)!=2)
3701 28 : pari_err_TYPE("algbasistoquat [not a quaternion algebra]", al);
3702 70 : pol = alg_get_splitpol(al);
3703 70 : v = varn(pol);
3704 70 : A = gel(pol,3); /* coeff of v^1 */
3705 70 : x2 = algbasistoalg(al, x);
3706 56 : x2 = lift0(x2, v);
3707 56 : q = cgetg(5, t_COL);
3708 56 : if (gequal0(A))
3709 : {
3710 : /* v = i */
3711 42 : gel(q,1) = polcoef_i(gel(x2,1),0,v);
3712 42 : gel(q,2) = polcoef_i(gel(x2,1),1,v);
3713 42 : gel(q,3) = polcoef_i(gel(x2,2),0,v);
3714 42 : gel(q,4) = polcoef_i(gel(x2,2),1,v);
3715 42 : gel(q,4) = gneg(gel(q,4));
3716 : }
3717 : else
3718 : {
3719 : /* v = (i-A)/2 */
3720 14 : gel(q,2) = gshift(polcoef_i(gel(x2,1),1,v),-1);
3721 14 : gel(q,1) = gsub(polcoef_i(gel(x2,1),0,v), gmul(A,gel(q,2)));
3722 14 : gel(q,4) = gneg(gshift(polcoef_i(gel(x2,2),1,v),-1));
3723 14 : gel(q,3) = gadd(polcoef_i(gel(x2,2),0,v),gmul(A,gel(q,4)));
3724 : }
3725 56 : return gc_GEN(av, q);
3726 : }
3727 : GEN
3728 98 : algisquatalg(GEN al)
3729 : {
3730 98 : pari_sp av = avma;
3731 : GEN pol, a;
3732 : long ta;
3733 98 : checkalg(al);
3734 91 : ta = alg_type(al);
3735 91 : if (ta == al_REAL && algreal_dim(al)==4)
3736 7 : return gc_GEN(av, mkvec2(gen_m1,gen_m1));
3737 84 : if (alg_is_asq(al))
3738 21 : return gc_GEN(av, mkvec2(gmael3(al,6,1,1),gmael3(al,6,1,2)));
3739 63 : if (ta != al_CYCLIC || alg_get_degree(al)!=2) return gc_const(av, gen_0);
3740 35 : pol = alg_get_splitpol(al);
3741 35 : if (gequal0(gel(pol,3))) a = gneg(gel(pol,2)); /* coeffs of v^1 and v^0 */
3742 7 : else a = RgX_disc(pol);
3743 35 : return gc_GEN(av, mkvec2(a,lift_shallow(alg_get_b(al))));
3744 : }
3745 :
3746 : static GEN
3747 119 : algbasistoalg_mat(GEN al, GEN x) /* componentwise */
3748 : {
3749 119 : long j, lx = lg(x);
3750 119 : GEN res = cgetg(lx, t_MAT);
3751 357 : for (j=1; j<lx; j++) {
3752 238 : long i, lxj = lg(gel(x,j));
3753 238 : gel(res,j) = cgetg(lxj, t_COL);
3754 714 : for (i=1; i<lxj; i++) gcoeff(res,i,j) = algbasistoalg(al,gcoeff(x,i,j));
3755 : }
3756 119 : return res;
3757 : }
3758 : GEN
3759 3409 : algbasistoalg(GEN al, GEN x)
3760 : {
3761 : pari_sp av;
3762 : long tx, ta;
3763 3409 : checkalg(al);
3764 3409 : ta = alg_type(al);
3765 3409 : if (ta != al_CYCLIC && ta != al_CSA) pari_err_TYPE("algbasistoalg [use alginit]", al);
3766 3388 : tx = alg_model(al,x);
3767 3374 : if (tx==al_ALGEBRAIC) return gcopy(x);
3768 3241 : if (tx==al_MATRIX) return algbasistoalg_mat(al,x);
3769 3122 : av = avma;
3770 3122 : x = RgM_RgC_mul(alg_get_basis(al),x);
3771 3122 : x = algnattoalg(al,x);
3772 3122 : return gc_upto(av, x);
3773 : }
3774 :
3775 : static GEN
3776 4466 : R_random(GEN b)
3777 : {
3778 4466 : pari_sp av = avma;
3779 4466 : long prec = realprec(b);
3780 4466 : GEN z = randomr(prec); shiftr_inplace(z, 1);
3781 4466 : return gc_leaf(av, mulrr(b,addsr(-1, z)));
3782 : }
3783 : static GEN
3784 182 : C_random(GEN b)
3785 : {
3786 182 : retmkcomplex(R_random(b), R_random(b));
3787 : }
3788 : static GEN
3789 980 : H_random(GEN b)
3790 : {
3791 980 : GEN res = cgetg(5, t_COL);
3792 : long i;
3793 4900 : for (i=1; i<=4; i++) gel(res,i) = R_random(b);
3794 980 : return res;
3795 : }
3796 : GEN
3797 20104 : algrandom(GEN al, GEN b)
3798 : {
3799 20104 : GEN res = NULL, p, N;
3800 : long i, n;
3801 20104 : checkalg(al);
3802 20090 : if (alg_type(al)==al_REAL)
3803 : {
3804 1365 : if (typ(b) != t_REAL) pari_err_TYPE("algrandom",b);
3805 1358 : if (signe(b) < 0) pari_err_DOMAIN("algrandom", "b", "<", gen_0, b);
3806 1351 : switch(alg_get_absdim(al))
3807 : {
3808 182 : case 1: res = R_random(b); break;
3809 182 : case 2: res = C_random(b); break;
3810 980 : case 4: res = H_random(b); break;
3811 7 : default: pari_err_TYPE("algrandom [apply alginit]", al);
3812 : }
3813 1344 : return res;
3814 : }
3815 18725 : if (typ(b) != t_INT) pari_err_TYPE("algrandom",b);
3816 18718 : if (signe(b) < 0) pari_err_DOMAIN("algrandom", "b", "<", gen_0, b);
3817 18711 : n = alg_get_absdim(al);
3818 18711 : N = addiu(shifti(b,1), 1); /* left on stack */
3819 18711 : p = alg_get_char(al); if (!signe(p)) p = NULL;
3820 18711 : res = cgetg(n+1,t_COL);
3821 168385 : for (i = 1; i <= n; i++)
3822 : {
3823 149674 : pari_sp av = avma;
3824 149674 : GEN t = subii(randomi(N),b);
3825 149674 : if (p) t = modii(t, p);
3826 149674 : gel(res,i) = gc_INT(av, t);
3827 : }
3828 18711 : return res;
3829 : }
3830 :
3831 : static GEN
3832 84 : H_poleval(GEN pol, GEN x)
3833 : {
3834 84 : pari_sp av = avma;
3835 : GEN res;
3836 : long i;
3837 84 : switch (H_model(x))
3838 : {
3839 21 : case H_SCALAR: return RgX_cxeval(pol, x, NULL);
3840 49 : case H_QUATERNION: break;
3841 7 : default: pari_err_TYPE("H_poleval", x);
3842 : }
3843 :
3844 49 : res = zerocol(4);
3845 231 : for (i=lg(pol)-1; i>1; i--)
3846 : {
3847 182 : gel(res,1) = gadd(gel(res,1), gel(pol,i));
3848 182 : if (i>2) res = H_mul(x, res);
3849 : }
3850 :
3851 49 : return gc_GEN(av,res);
3852 : }
3853 :
3854 : /* Assumes pol has coefficients in the same ring as the COL x; x either
3855 : * in basis or algebraic form or [x,mx] where mx is the mult. table of x.
3856 : TODO more general version: pol with coeffs in center and x in basis form */
3857 : GEN
3858 29423 : algpoleval(GEN al, GEN pol, GEN x)
3859 : {
3860 29423 : pari_sp av = avma;
3861 29423 : GEN p, mx = NULL, res, c;
3862 29423 : long i, xalg = 0;
3863 29423 : if (typ(pol) != t_POL) pari_err_TYPE("algpoleval", pol);
3864 29409 : checkalg(al);
3865 29409 : if (alg_type(al)==al_REAL) return H_poleval(pol,x);
3866 29325 : p = alg_get_char(al);
3867 29325 : if (typ(x) == t_VEC)
3868 : {
3869 10122 : if (lg(x) != 3) pari_err_TYPE("algpoleval [vector must be of length 2]", x);
3870 10115 : mx = gel(x,2);
3871 10115 : x = gel(x,1);
3872 10115 : if (typ(mx)!=t_MAT || !gequal(x,gel(mx,1)))
3873 21 : pari_err_TYPE("algpoleval [mx must be the multiplication table of x]", mx);
3874 : }
3875 : else
3876 : {
3877 19203 : switch(alg_model(al,x))
3878 : {
3879 14 : case al_ALGEBRAIC: mx = algalgmultable(al,x); xalg=1; break;
3880 19175 : case al_BASIS:
3881 19175 : case al_TRIVIAL: mx = algbasismultable(al,x); break;
3882 7 : default: pari_err_TYPE("algpoleval", x);
3883 : }
3884 : }
3885 29283 : res = zerocol(lg(mx)-1);
3886 29283 : if (signe(p)) {
3887 86399 : for (i=lg(pol)-1; i>1; i--)
3888 : {
3889 62891 : gel(res,1) = Fp_add(gel(res,1), gel(pol,i), p);
3890 62891 : if (i>2) res = FpM_FpC_mul(mx, res, p);
3891 : }
3892 : }
3893 : else {
3894 29338 : for (i=lg(pol)-1; i>1; i--)
3895 : {
3896 23563 : c = gel(pol,i);
3897 23563 : if (xalg || is_rational_t(typ(c))) gel(res,1) = gadd(gel(res,1), c);
3898 434 : else res = RgC_add(res, algeltfromnf_i(al,c));
3899 23563 : if (i>2) res = RgM_RgC_mul(mx, res);
3900 : }
3901 : }
3902 29283 : return gc_upto(av, res);
3903 : }
3904 :
3905 : static GEN
3906 98 : H_invol(GEN x)
3907 : {
3908 98 : pari_sp av = avma;
3909 : long tx;
3910 : GEN cx;
3911 98 : if (!x) return gc_upto(av,diagonal(mkvec4(gen_1,gen_m1,gen_m1,gen_m1)));
3912 35 : tx = H_model(x);
3913 28 : if (tx == H_SCALAR) return gconj(x);
3914 14 : cx = gneg(x);
3915 14 : gel(cx,1) = gcopy(gel(x,1));
3916 14 : return gc_upto(av, cx);
3917 : }
3918 :
3919 : GEN
3920 308 : alginvol(GEN al, GEN x)
3921 : {
3922 308 : pari_sp av = avma;
3923 : GEN invol;
3924 308 : checkalg(al);
3925 294 : if (!x && al) return gc_upto(av, alg_get_invol(al));
3926 175 : if (alg_type(al)==al_REAL) return H_invol(x);
3927 133 : x = algalgtobasis(al, x);
3928 126 : invol = alg_get_invol(al);
3929 126 : if (typ(invol)!=t_MAT)
3930 7 : pari_err_DOMAIN("alginvol [al does not contain an involution]", "invol", "=", gen_0, invol);
3931 119 : return gc_upto(av, RgM_RgC_mul(invol,x));
3932 : }
3933 :
3934 : GEN
3935 112 : algskolemnoether(GEN al, GEN a, GEN fa)
3936 : {
3937 112 : pari_sp av = avma;
3938 112 : long c = 0, i, ta;
3939 : GEN M, K, b;
3940 112 : checkalg(al);
3941 105 : ta = alg_type(al);
3942 105 : if (ta!=al_CYCLIC && ta!=al_CSA) pari_err_TYPE("algskolemnoether"
3943 : " [al: apply alginit()]", al);
3944 91 : if (typ(a) != t_VEC) a = mkvec(a);
3945 91 : if (typ(fa) != t_VEC) fa = mkvec(fa);
3946 91 : if (lg(a) != lg(fa)) pari_err_DIM("algskolemnoether [lg(a) != lg(fa)]");
3947 84 : if (lg(a) == 1) return gc_upto(av, col_ei(alg_get_absdim(al),1));
3948 :
3949 : /* compute space K of b s.t. b*a_i == fa_i*b for all i */
3950 77 : M = cgetg(lg(a),t_COL);
3951 154 : for (i=1; i<lg(a); i++) gel(M,i) = RgM_sub(algrightmultable(al,gel(a,i)),
3952 91 : algleftmultable(al,gel(fa,i)));
3953 56 : M = shallowmatconcat(M);
3954 56 : K = QM_ker(M);
3955 :
3956 : /* find invertible element in K */
3957 56 : if (lg(K)==1) pari_err(e_MISC, "no solution in algskolemnoether"
3958 : " [check simplicity and homomorphism assumptions]");
3959 49 : b = gel(K,1);
3960 1449 : while (!algisinv(al, b, NULL))
3961 : {
3962 1407 : b = gadd(b, gel(K,1+random_Fl(lg(K)-1)));
3963 1407 : c++;
3964 1407 : if (c > 200) pari_err(e_MISC, "probable infinite loop in algskolemnoether"
3965 : " (the subalgebra is probably not simple)");
3966 : }
3967 42 : return gc_upto(av, b);
3968 : }
3969 :
3970 : /** GRUNWALD-WANG **/
3971 : /*
3972 : Song Wang's PhD thesis (pdf pages)
3973 : p.25 definition of chi_b. K^Ker(chi_b) = K(b^(1/m))
3974 : p.26 bound on the conductor (also Cohen adv. GTM 193 p.166)
3975 : p.21 & p.34 description special case, also on wikipedia:
3976 : http://en.wikipedia.org/wiki/Grunwald%E2%80%93Wang_theorem#Special_fields
3977 : p.77 Kummer case
3978 : */
3979 :
3980 : /* n > 0. Is n = 2^k ? */
3981 : static int
3982 385 : uispow2(ulong n) { return !(n &(n-1)); }
3983 :
3984 : static GEN
3985 441 : get_phi0(GEN bnr, GEN Lpr, GEN Ld, GEN pl, long *pr, long *pn)
3986 : {
3987 441 : const long NTRY = 10; /* FIXME: magic constant */
3988 441 : const long n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
3989 441 : GEN S = bnr_get_cyc(bnr);
3990 : GEN Sst, G, globGmod, loc, X, Rglob, Rloc, H, U, Lconj;
3991 : long i, j, r, nbfrob, nbloc, nz, t;
3992 :
3993 441 : *pn = n;
3994 441 : *pr = r = lg(S)-1;
3995 441 : if (!r) return NULL;
3996 392 : Sst = cgetg(r+1, t_VECSMALL); /* Z/n-dual */
3997 1715 : for (i=1; i<=r; i++) Sst[i] = ugcdiu(gel(S,i), n);
3998 392 : if (Sst[1] != n) return NULL;
3999 385 : Lconj = NULL;
4000 385 : nbloc = nbfrob = lg(Lpr)-1;
4001 385 : if (uispow2(n))
4002 : {
4003 266 : long l = lg(pl), k = 0;
4004 266 : GEN real = cgetg(l, t_VECSMALL);
4005 994 : for (i = 1; i < l; i++)
4006 728 : if (pl[i] == -1) real[++k] = i;
4007 266 : if (k)
4008 : {
4009 266 : GEN nf = bnr_get_nf(bnr), I = bid_get_fact(bnr_get_bid(bnr));
4010 266 : GEN v, y, C = idealchineseinit(bnr, I);
4011 266 : long r1 = nf_get_r1(nf), n = nbrows(I);
4012 266 : nbloc += k;
4013 266 : Lconj = cgetg(k+1, t_VEC);
4014 266 : v = const_vecsmall(r1, 1);
4015 266 : y = const_vec(n, gen_1);
4016 728 : for (i = 1; i <= k; i++)
4017 : {
4018 462 : v[real[i]] = -1; gel(Lconj,i) = idealchinese(nf, mkvec2(C,v), y);
4019 462 : v[real[i]] = 1;
4020 : }
4021 : }
4022 : }
4023 385 : globGmod = cgetg(r+1,t_MAT);
4024 385 : G = cgetg(r+1,t_VECSMALL);
4025 1701 : for (i = 1; i <= r; i++)
4026 : {
4027 1316 : G[i] = n / Sst[i]; /* pairing between S and Sst */
4028 1316 : gel(globGmod,i) = cgetg(nbloc+1,t_VECSMALL);
4029 : }
4030 :
4031 : /* compute images of Frobenius elements (and complex conjugation) */
4032 385 : loc = cgetg(nbloc+1,t_VECSMALL);
4033 868 : for (i = 1; i <= nbloc; i++)
4034 : {
4035 : long L;
4036 651 : if (i <= nbfrob)
4037 : {
4038 322 : X = gel(Lpr, i);
4039 322 : L = Ld[i];
4040 : }
4041 : else
4042 : { /* X = 1 (mod f), sigma_i(x) < 0, positive at all other real places */
4043 329 : X = gel(Lconj, i-nbfrob);
4044 329 : L = 2;
4045 : }
4046 651 : X = ZV_to_Flv(isprincipalray(bnr,X), n);
4047 2499 : for (nz=0,j=1; j<=r; j++)
4048 : {
4049 1848 : ulong c = (X[j] * G[j]) % L;
4050 1848 : ucoeff(globGmod,i,j) = c;
4051 1848 : if (c) nz = 1;
4052 : }
4053 651 : if (!nz) return NULL;
4054 483 : loc[i] = L;
4055 : }
4056 :
4057 : /* try some random elements in the dual */
4058 217 : Rglob = cgetg(r+1,t_VECSMALL);
4059 506 : for (t=0; t<NTRY; t++) {
4060 1775 : for (j = 1; j <= r; j++) Rglob[j] = random_Fl(Sst[j]);
4061 499 : Rloc = zm_zc_mul(globGmod,Rglob);
4062 1164 : for (i = 1; i <= nbloc; i++)
4063 954 : if (Rloc[i] % loc[i] == 0) break;
4064 499 : if (i > nbloc) return zv_to_ZV(Rglob);
4065 : }
4066 :
4067 : /* try to realize some random elements of the product of the local duals */
4068 7 : H = ZM_hnfall_i(shallowconcat(zm_to_ZM(globGmod),
4069 : diagonal_shallow(zv_to_ZV(loc))), &U, 2);
4070 : /* H,U nbloc x nbloc */
4071 7 : Rloc = cgetg(nbloc+1,t_COL);
4072 77 : for (t = 0; t < NTRY; t++)
4073 : { /* nonzero random coordinate */ /* TODO add special case ? */
4074 560 : for (i = 1; i <= nbloc; i++) gel(Rloc,i) = stoi(1 + random_Fl(loc[i]-1));
4075 70 : Rglob = hnf_invimage(H, Rloc);
4076 70 : if (Rglob)
4077 : {
4078 0 : Rglob = ZM_ZC_mul(U,Rglob);
4079 0 : return vecslice(Rglob,1,r);
4080 : }
4081 : }
4082 7 : return NULL;
4083 : }
4084 :
4085 : static GEN
4086 441 : bnrgwsearch(GEN bnr, GEN Lpr, GEN Ld, GEN pl)
4087 : {
4088 441 : pari_sp av = avma;
4089 : long n, r;
4090 441 : GEN phi0 = get_phi0(bnr,Lpr,Ld,pl, &r,&n), gn, v, H,U;
4091 441 : if (!phi0) return gc_const(av, gen_0);
4092 210 : gn = stoi(n);
4093 : /* compute kernel of phi0 */
4094 210 : v = ZV_extgcd(vec_append(phi0, gn));
4095 210 : U = vecslice(gel(v,2), 1,r);
4096 210 : H = ZM_hnfmodid(rowslice(U, 1,r), gn);
4097 210 : return gc_upto(av, H);
4098 : }
4099 :
4100 : GEN
4101 210 : bnfgwgeneric(GEN bnf, GEN Lpr, GEN Ld, GEN pl, long var)
4102 : {
4103 210 : pari_sp av = avma;
4104 210 : const long n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
4105 : forprime_t S;
4106 210 : GEN bnr = NULL, ideal = gen_1, nf, dec, H = gen_0, finf, pol;
4107 : ulong ell, p;
4108 : long deg, i, degell;
4109 210 : (void)uisprimepower(n, &ell);
4110 210 : nf = bnf_get_nf(bnf);
4111 210 : deg = nf_get_degree(nf);
4112 210 : degell = ugcd(deg,ell-1);
4113 210 : finf = cgetg(lg(pl),t_VEC);
4114 546 : for (i=1; i<lg(pl); i++) gel(finf,i) = pl[i]==-1 ? gen_1 : gen_0;
4115 :
4116 210 : u_forprime_init(&S, 2, ULONG_MAX);
4117 903 : while ((p = u_forprime_next(&S))) {
4118 903 : if (Fl_powu(p % ell, degell, ell) != 1) continue; /* ell | p^deg-1 ? */
4119 434 : dec = idealprimedec(nf, utoipos(p));
4120 784 : for (i=1; i<lg(dec); i++) {
4121 560 : GEN pp = gel(dec,i);
4122 560 : if (RgV_isin(Lpr,pp)) continue;
4123 : /* TODO also accept the prime ideals at which there is a condition
4124 : * (use local Artin)? */
4125 497 : if (smodis(idealnorm(nf,pp),ell) != 1) continue; /* ell | N(pp)-1 ? */
4126 441 : ideal = idealmul(bnf,ideal,pp);
4127 : /* TODO: give factorization ? */
4128 441 : bnr = Buchray(bnf, mkvec2(ideal,finf), nf_INIT);
4129 441 : H = bnrgwsearch(bnr,Lpr,Ld,pl);
4130 441 : if (H != gen_0)
4131 : {
4132 210 : pol = rnfkummer(bnr,H,nf_get_prec(nf));
4133 210 : setvarn(pol, var);
4134 210 : return gc_upto(av,pol);
4135 : }
4136 : }
4137 : }
4138 : pari_err_BUG("bnfgwgeneric (no suitable p)"); /*LCOV_EXCL_LINE*/
4139 : return NULL;/*LCOV_EXCL_LINE*/
4140 : }
4141 :
4142 : /* pr.p != ell */
4143 : static GEN
4144 1624 : localextdeg(GEN nf, GEN pr, long d, ulong ell, long n)
4145 : {
4146 : GEN modpr, T, p, gen, k;
4147 1624 : if (d == 1) return gen_1;
4148 1610 : k = powuu(ell, Z_lval(subiu(pr_norm(pr),1), ell));
4149 1610 : k = divis(k, n / d);
4150 1610 : modpr = nf_to_Fq_init(nf, &pr, &T, &p);
4151 1610 : (void)Fq_sqrtn(gen_1, k, T, p, &gen);
4152 1610 : return Fq_to_nf(gen, modpr);
4153 : }
4154 : /* pr.p = ell */
4155 : static GEN
4156 175 : localextdegell(GEN nf, GEN pr, GEN E, long d, long n)
4157 : {
4158 : GEN x;
4159 175 : if (d == 1) return gen_1;
4160 168 : x = nfadd(nf, gen_1, pr_get_gen(pr));
4161 168 : return nfpowmodideal(nf, x, stoi(n / d), idealpow(nf, pr, E));
4162 : }
4163 :
4164 : /* Ld[i] must be nontrivial powers of the same prime ell */
4165 : /* pl : -1 at real places at which the extension must ramify, 0 elsewhere */
4166 : GEN
4167 294 : nfgwkummer(GEN nf, GEN Lpr, GEN Ld, GEN pl, long var)
4168 : {
4169 294 : const long n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
4170 : ulong ell;
4171 294 : long i, l = lg(Lpr), v = uisprimepower(n, &ell);
4172 294 : GEN E = cgetg(l, t_COL), y = cgetg(l, t_VEC), fa;
4173 :
4174 2093 : for (i = 1; i < l; i++)
4175 : {
4176 1799 : GEN pr = gel(Lpr,i), p = pr_get_p(pr);
4177 1799 : if (!absequalui(ell, p))
4178 : {
4179 1624 : gel(E, i) = gen_1;
4180 1624 : gel(y, i) = localextdeg(nf, pr, Ld[i], ell, n);
4181 : }
4182 : else
4183 : {
4184 175 : long e = pr_get_e(pr);
4185 175 : gel(E, i) = addui(1 + v*e, divsi(e, subiu(p,1)));
4186 175 : gel(y, i) = localextdegell(nf, pr, gel(E,i), Ld[i], n);
4187 : }
4188 : }
4189 294 : y = factoredextchinese(nf, mkmat2(shallowtrans(Lpr),E), y, pl, &fa);
4190 294 : return gsub(gpowgs(pol_x(var),n), basistoalg(nf, y));
4191 : }
4192 :
4193 : static GEN
4194 1113 : get_vecsmall(GEN v)
4195 : {
4196 1113 : switch(typ(v))
4197 : {
4198 987 : case t_VECSMALL: return v;
4199 119 : case t_VEC: if (RgV_is_ZV(v)) return ZV_to_zv(v);
4200 : }
4201 7 : pari_err_TYPE("nfgrunwaldwang",v);
4202 : return NULL;/*LCOV_EXCL_LINE*/
4203 : }
4204 : GEN
4205 602 : nfgrunwaldwang(GEN nf0, GEN Lpr, GEN Ld, GEN pl, long var)
4206 : {
4207 : ulong n, ell, ell2;
4208 602 : pari_sp av = avma;
4209 : GEN nf, bnf;
4210 : long t, w, i, vnf;
4211 :
4212 602 : if (var < 0) var = 0;
4213 602 : nf = get_nf(nf0,&t);
4214 602 : if (!nf) pari_err_TYPE("nfgrunwaldwang",nf0);
4215 602 : vnf = nf_get_varn(nf);
4216 602 : if (varncmp(var, vnf) >= 0)
4217 7 : pari_err_PRIORITY("nfgrunwaldwang", pol_x(var), ">=", vnf);
4218 595 : if (typ(Lpr) != t_VEC) pari_err_TYPE("nfgrunwaldwang",Lpr);
4219 581 : if (lg(Lpr) != lg(Ld)) pari_err_DIM("nfgrunwaldwang [#Lpr != #Ld]");
4220 574 : if (nf_get_degree(nf)==1) Lpr = shallowcopy(Lpr);
4221 2709 : for (i=1; i<lg(Lpr); i++) {
4222 2142 : GEN pr = gel(Lpr,i);
4223 2142 : if (nf_get_degree(nf)==1 && typ(pr)==t_INT)
4224 77 : gel(Lpr,i) = gel(idealprimedec(nf,pr), 1);
4225 2065 : else checkprid(pr);
4226 : }
4227 567 : if (lg(pl)-1 != nf_get_r1(nf))
4228 7 : pari_err_DOMAIN("nfgrunwaldwang [pl should have r1 components]", "#pl",
4229 7 : "!=", stoi(nf_get_r1(nf)), stoi(lg(pl)-1));
4230 :
4231 560 : Ld = get_vecsmall(Ld);
4232 553 : pl = get_vecsmall(pl);
4233 553 : bnf = get_bnf(nf0,&t);
4234 553 : n = (lg(Ld)==1)? 2: vecsmall_max(Ld);
4235 :
4236 553 : if (!uisprimepower(n, &ell))
4237 7 : pari_err_IMPL("nfgrunwaldwang for non prime-power local degrees (a)");
4238 2646 : for (i=1; i<lg(Ld); i++)
4239 2107 : if (Ld[i]!=1 && (!uisprimepower(Ld[i],&ell2) || ell2!=ell))
4240 7 : pari_err_IMPL("nfgrunwaldwang for non prime-power local degrees (b)");
4241 1393 : for (i=1; i<lg(pl); i++)
4242 861 : if (pl[i]==-1 && ell%2)
4243 7 : pari_err_IMPL("nfgrunwaldwang for non prime-power local degrees (c)");
4244 :
4245 532 : w = bnf? bnf_get_tuN(bnf): itos(gel(nfrootsof1(nf),1));
4246 :
4247 : /* TODO choice between kummer and generic ? Let user choose between speed
4248 : * and size */
4249 532 : if (w%n==0 && lg(Ld)>1)
4250 294 : return gc_upto(av, nfgwkummer(nf,Lpr,Ld,pl,var));
4251 238 : if (ell==n)
4252 : {
4253 210 : if (!bnf) bnf = Buchall(nf, nf_FORCE, 0);
4254 210 : return gc_upto(av, bnfgwgeneric(bnf,Lpr,Ld,pl,var));
4255 : }
4256 28 : pari_err_IMPL("nfgrunwaldwang for nonprime degree");
4257 : return NULL; /*LCOV_EXCL_LINE*/
4258 : }
4259 :
4260 : /** HASSE INVARIANTS **/
4261 :
4262 : /* TODO long -> ulong + uel */
4263 : static GEN
4264 1484 : hasseconvert(GEN H, long n)
4265 : {
4266 : GEN h, c;
4267 : long i, l;
4268 1484 : switch(typ(H)) {
4269 1323 : case t_VEC:
4270 1323 : l = lg(H); h = cgetg(l,t_VECSMALL);
4271 1323 : if (l == 1) return h;
4272 1197 : c = gel(H,1);
4273 1197 : if (typ(c) == t_VEC && l == 3)
4274 476 : return mkvec2(gel(H,1),hasseconvert(gel(H,2),n));
4275 3374 : for (i=1; i<l; i++)
4276 : {
4277 2681 : c = gel(H,i);
4278 2681 : switch(typ(c)) {
4279 910 : case t_INT: break;
4280 7 : case t_INTMOD:
4281 7 : c = gel(c,2); break;
4282 1743 : case t_FRAC :
4283 1743 : c = gmulgs(c,n);
4284 1743 : if (typ(c) == t_INT) break;
4285 7 : pari_err_DOMAIN("hasseconvert [degree should be a denominator of the invariant]", "denom(h)", "ndiv", stoi(n), Q_denom(gel(H,i)));
4286 21 : default : pari_err_TYPE("Hasse invariant", c);
4287 : }
4288 2653 : h[i] = smodis(c,n);
4289 : }
4290 693 : return h;
4291 154 : case t_VECSMALL: return H;
4292 : }
4293 7 : pari_err_TYPE("Hasse invariant", H);
4294 : return NULL;/*LCOV_EXCL_LINE*/
4295 : }
4296 :
4297 : /* assume f >= 2 */
4298 : static long
4299 546 : cyclicrelfrob0(GEN nf, GEN aut, GEN pr, GEN q, long f, long g)
4300 : {
4301 546 : GEN T, p, a, b, modpr = nf_to_Fq_init(nf,&pr,&T,&p);
4302 : long s;
4303 :
4304 546 : a = pol_x(nf_get_varn(nf));
4305 546 : b = galoisapply(nf, aut, modpr_genFq(modpr));
4306 546 : b = nf_to_Fq(nf, b, modpr);
4307 1582 : for (s = 0; !ZX_equal(a, b); s++) a = Fq_pow(a, q, T, p);
4308 546 : return g * Fl_inv(s, f); /* < n */
4309 : }
4310 :
4311 : static long
4312 3310 : cyclicrelfrob(GEN rnf, GEN auts, GEN pr)
4313 : {
4314 3310 : pari_sp av = avma;
4315 3310 : long f,g,frob, n = rnf_get_degree(rnf);
4316 3310 : GEN P = rnfidealprimedec(rnf, pr);
4317 :
4318 3310 : if (pr_get_e(gel(P,1)) > pr_get_e(pr))
4319 0 : pari_err_DOMAIN("cyclicrelfrob","e(PR/pr)",">",gen_1,pr);
4320 3310 : g = lg(P) - 1;
4321 3310 : f = n / g;
4322 :
4323 3310 : if (f <= 2) frob = g % n;
4324 : else {
4325 546 : GEN nf2, PR = gel(P,1);
4326 546 : GEN autabs = rnfeltreltoabs(rnf,gel(auts,g));
4327 546 : nf2 = obj_check(rnf,rnf_NFABS);
4328 546 : autabs = nfadd(nf2, autabs, gmul(rnf_get_k(rnf), rnf_get_alpha(rnf)));
4329 546 : frob = cyclicrelfrob0(nf2, autabs, PR, pr_norm(pr), f, g);
4330 : }
4331 3310 : return gc_long(av, frob);
4332 : }
4333 :
4334 : static long
4335 1120 : localhasse(GEN rnf, GEN cnd, GEN pl, GEN auts, GEN b, long k)
4336 : {
4337 1120 : pari_sp av = avma;
4338 : long v, m, h, lfa, frob, n, i;
4339 : GEN previous, y, pr, nf, q, fa;
4340 1120 : nf = rnf_get_nf(rnf);
4341 1120 : n = rnf_get_degree(rnf);
4342 1120 : pr = gcoeff(cnd,k,1);
4343 1120 : v = nfval(nf, b, pr);
4344 1120 : m = lg(cnd)>1 ? nbrows(cnd) : 0;
4345 :
4346 : /* add the valuation of b to the conductor... */
4347 1120 : previous = gcoeff(cnd,k,2);
4348 1120 : gcoeff(cnd,k,2) = addis(previous, v);
4349 :
4350 1120 : y = const_vec(m, gen_1);
4351 1120 : gel(y,k) = b;
4352 : /* find a factored element y congruent to b mod pr^(vpr(b)+vpr(cnd)) and to 1 mod the conductor. */
4353 1120 : y = factoredextchinese(nf, cnd, y, pl, &fa);
4354 1120 : h = 0;
4355 1120 : lfa = nbrows(fa);
4356 : /* sum of all Hasse invariants of (rnf/nf,aut,y) is 0, Hasse invariants at q!=pr are easy, Hasse invariant at pr is the same as for al=(rnf/nf,aut,b). */
4357 2169 : for (i=1; i<=lfa; i++) {
4358 1049 : q = gcoeff(fa,i,1);
4359 1049 : if (cmp_prime_ideal(pr,q)) {
4360 972 : frob = cyclicrelfrob(rnf, auts, q);
4361 972 : frob = Fl_mul(frob,umodiu(gcoeff(fa,i,2),n),n);
4362 972 : h = Fl_add(h,frob,n);
4363 : }
4364 : }
4365 : /* ...then restore it. */
4366 1120 : gcoeff(cnd,k,2) = previous;
4367 1120 : return gc_long(av, Fl_neg(h,n));
4368 : }
4369 :
4370 : static GEN
4371 1386 : allauts(GEN rnf, GEN aut)
4372 : {
4373 1386 : long n = rnf_get_degree(rnf), i;
4374 1386 : GEN pol = rnf_get_pol(rnf), vaut;
4375 1386 : if (n==1) n=2;
4376 1386 : vaut = cgetg(n,t_VEC);
4377 1386 : aut = lift_shallow(rnfbasistoalg(rnf,aut));
4378 1386 : if (typ(aut) != t_POL || varn(pol) != varn(aut))
4379 0 : pari_err_TYPE("alg_cyclic", aut);
4380 1386 : gel(vaut,1) = aut;
4381 1841 : for (i=1; i<n-1; i++)
4382 455 : gel(vaut,i+1) = RgX_rem(poleval(gel(vaut,i), aut), pol);
4383 1386 : return vaut;
4384 : }
4385 :
4386 : static GEN
4387 413 : clean_factor(GEN fa)
4388 : {
4389 413 : GEN P2,E2, P = gel(fa,1), E = gel(fa,2);
4390 413 : long l = lg(P), i, j = 1;
4391 413 : P2 = cgetg(l, t_COL);
4392 413 : E2 = cgetg(l, t_COL);
4393 2842 : for (i = 1;i < l; i++)
4394 2429 : if (signe(gel(E,i))) {
4395 721 : gel(P2,j) = gel(P,i);
4396 721 : gel(E2,j) = gel(E,i); j++;
4397 : }
4398 413 : setlg(P2,j);
4399 413 : setlg(E2,j); return mkmat2(P2,E2);
4400 : }
4401 :
4402 : /* shallow concat x[1],...x[nx],y[1], ... y[ny], returning a t_COL. To be
4403 : * used when we do not know whether x,y are t_VEC or t_COL */
4404 : static GEN
4405 826 : colconcat(GEN x, GEN y)
4406 : {
4407 826 : long i, lx = lg(x), ly = lg(y);
4408 826 : GEN z=cgetg(lx+ly-1, t_COL);
4409 4396 : for (i=1; i<lx; i++) z[i] = x[i];
4410 2114 : for (i=1; i<ly; i++) z[lx+i-1]= y[i];
4411 826 : return z;
4412 : }
4413 :
4414 : /* return v(x) at all primes in listpr, replace x by cofactor */
4415 : static GEN
4416 1799 : nfmakecoprime(GEN nf, GEN *px, GEN listpr)
4417 : {
4418 1799 : long j, l = lg(listpr);
4419 1799 : GEN x1, x = *px, L = cgetg(l, t_COL);
4420 :
4421 1799 : if (typ(x) != t_MAT)
4422 : { /* scalar, divide at the end (fast valuation) */
4423 1554 : x1 = NULL;
4424 6307 : for (j=1; j<l; j++)
4425 : {
4426 4753 : GEN pr = gel(listpr,j), e;
4427 4753 : long v = nfval(nf, x, pr);
4428 4753 : e = stoi(v); gel(L,j) = e;
4429 6552 : if (v) x1 = x1? idealmulpowprime(nf, x1, pr, e)
4430 1799 : : idealpow(nf, pr, e);
4431 : }
4432 1554 : if (x1) x = idealdivexact(nf, idealhnf(nf,x), x1);
4433 : }
4434 : else
4435 : { /* HNF, divide as we proceed (reduce size) */
4436 497 : for (j=1; j<l; j++)
4437 : {
4438 252 : GEN pr = gel(listpr,j);
4439 252 : long v = idealval(nf, x, pr);
4440 252 : gel(L,j) = stoi(v);
4441 252 : if (v) x = idealmulpowprime(nf, x, pr, stoi(-v));
4442 : }
4443 : }
4444 1799 : *px = x; return L;
4445 : }
4446 :
4447 : /* Caveat: factorizations are not sorted wrt cmp_prime_ideal: Lpr comes first */
4448 : static GEN
4449 413 : computecnd(GEN rnf, GEN Lpr)
4450 : {
4451 : GEN id, nf, fa, Le, P,E;
4452 413 : long n = rnf_get_degree(rnf);
4453 :
4454 413 : nf = rnf_get_nf(rnf);
4455 413 : id = rnf_get_idealdisc(rnf);
4456 413 : Le = nfmakecoprime(nf, &id, Lpr);
4457 413 : fa = idealfactor(nf, id); /* part of D_{L/K} coprime with Lpr */
4458 413 : P = colconcat(Lpr,gel(fa,1));
4459 413 : E = colconcat(Le, gel(fa,2));
4460 413 : fa = mkmat2(P, gdiventgs(E, eulerphiu(n)));
4461 413 : return mkvec2(fa, clean_factor(fa));
4462 : }
4463 :
4464 : /* h >= 0 */
4465 : static void
4466 77 : nextgen(GEN gene, long h, GEN* gens, GEN* hgens, long* ngens, long* curgcd) {
4467 77 : long nextgcd = ugcd(h,*curgcd);
4468 77 : if (nextgcd == *curgcd) return;
4469 77 : (*ngens)++;
4470 77 : gel(*gens,*ngens) = gene;
4471 77 : gel(*hgens,*ngens) = utoi(h);
4472 77 : *curgcd = nextgcd;
4473 77 : return;
4474 : }
4475 :
4476 : static int
4477 140 : dividesmod(long d, long h, long n) { return !(h%cgcd(d,n)); }
4478 :
4479 : /* ramified prime with nontrivial Hasse invariant */
4480 : static GEN
4481 77 : localcomplete(GEN rnf, GEN pl, GEN cnd, GEN auts, long j, long n, long h, long* v)
4482 : {
4483 : GEN nf, gens, hgens, pr, modpr, T, p, sol, U, b, gene, randg, pu;
4484 : long ngens, i, d, np, d1, d2, hg, dnf, vcnd, curgcd;
4485 77 : nf = rnf_get_nf(rnf);
4486 77 : pr = gcoeff(cnd,j,1);
4487 77 : np = umodiu(pr_norm(pr), n);
4488 77 : dnf = nf_get_degree(nf);
4489 77 : vcnd = itos(gcoeff(cnd,j,2));
4490 77 : ngens = 13+dnf;
4491 77 : gens = zerovec(ngens);
4492 77 : hgens = zerovec(ngens);
4493 77 : *v = 0;
4494 77 : curgcd = 0;
4495 77 : ngens = 0;
4496 :
4497 77 : if (!uisprime(n)) {
4498 0 : gene = pr_get_gen(pr);
4499 0 : hg = localhasse(rnf, cnd, pl, auts, gene, j);
4500 0 : nextgen(gene, hg, &gens, &hgens, &ngens, &curgcd);
4501 : }
4502 :
4503 77 : if (ugcd(np,n) != 1) { /* GCD(Np,n) != 1 */
4504 77 : pu = idealprincipalunits(nf,pr,vcnd);
4505 77 : pu = abgrp_get_gen(pu);
4506 154 : for (i=1; i<lg(pu) && !dividesmod(curgcd,h,n); i++) {
4507 77 : gene = gel(pu,i);
4508 77 : hg = localhasse(rnf, cnd, pl, auts, gene, j);
4509 77 : nextgen(gene, hg, &gens, &hgens, &ngens, &curgcd);
4510 : }
4511 : }
4512 :
4513 77 : d = ugcd(np-1,n);
4514 77 : if (d != 1) { /* GCD(Np-1,n) != 1 */
4515 14 : modpr = nf_to_Fq_init(nf, &pr, &T, &p);
4516 14 : while (!dividesmod(curgcd,h,n)) { /* TODO gener_FpXQ_local */
4517 0 : if (T==NULL) randg = randomi(p);
4518 0 : else randg = random_FpX(degpol(T), varn(T),p);
4519 :
4520 0 : if (!gequal0(randg) && !gequal1(randg)) {
4521 0 : gene = Fq_to_nf(randg, modpr);
4522 0 : hg = localhasse(rnf, cnd, pl, auts, gene, j);
4523 0 : nextgen(gene, hg, &gens, &hgens, &ngens, &curgcd);
4524 : }
4525 : }
4526 : }
4527 :
4528 77 : setlg(gens,ngens+1);
4529 77 : setlg(hgens,ngens+1);
4530 :
4531 77 : sol = ZV_extgcd(hgens);
4532 77 : U = ZV_to_Flv(gmael(sol,2,ngens), n);
4533 77 : d = itou(gel(sol,1));
4534 77 : d1 = ugcd(d, n);
4535 77 : d2 = d / d1;
4536 77 : d = Fl_mul(h / d1, Fl_inv(d2,n), n);
4537 77 : if (d != 1) U = Flv_Fl_mul(U, d, n);
4538 154 : for (i = 1, b = gen_1; i <= ngens; i++)
4539 77 : if (U[i]) b = nfmul(nf, b, nfpow_u(nf, gel(gens,i), U[i]));
4540 77 : *v = U[1]; return b;
4541 : }
4542 :
4543 : static int
4544 909 : testsplits(GEN data, GEN fa)
4545 : {
4546 909 : GEN rnf = gel(data,1), forbid = gel(data,2), P = gel(fa,1), E = gel(fa,2);
4547 909 : long i, n, l = lg(P);
4548 :
4549 1318 : for (i = 1; i < l; i++)
4550 : {
4551 822 : GEN pr = gel(P,i);
4552 822 : if (tablesearch(forbid, pr, &cmp_prime_ideal)) return 0;
4553 : }
4554 496 : n = rnf_get_degree(rnf);
4555 704 : for (i = 1; i < l; i++)
4556 : {
4557 291 : long e = itos(gel(E,i)) % n;
4558 291 : if (e)
4559 : {
4560 276 : GEN L = rnfidealprimedec(rnf, gel(P,i));
4561 276 : long g = lg(L) - 1;
4562 276 : if ((e * g) % n) return 0;
4563 : }
4564 : }
4565 413 : return 1;
4566 : }
4567 :
4568 : /* remove entries with Hasse invariant 0 */
4569 : static GEN
4570 854 : hassereduce(GEN hf)
4571 : {
4572 854 : GEN pr,h, PR = gel(hf,1), H = gel(hf,2);
4573 854 : long i, j, l = lg(PR);
4574 :
4575 854 : pr= cgetg(l, t_VEC);
4576 854 : h = cgetg(l, t_VECSMALL);
4577 4788 : for (i = j = 1; i < l; i++)
4578 3934 : if (H[i]) {
4579 3598 : gel(pr,j) = gel(PR,i);
4580 3598 : h[j] = H[i]; j++;
4581 : }
4582 854 : setlg(pr,j);
4583 854 : setlg(h,j); return mkvec2(pr,h);
4584 : }
4585 :
4586 : static void
4587 1036 : alg_insert_quatconj(GEN al)
4588 : {
4589 : GEN aut, nf, rnf, nfabs, gene, absaut;
4590 : long d;
4591 1036 : aut = alg_get_aut(al);
4592 1036 : d = alg_get_absdim(al) / 4;
4593 1036 : nf = alg_get_center(al);
4594 1036 : rnf = alg_get_splittingfield(al);
4595 1036 : nfabs = rnf_build_nfabs(rnf, nf_get_prec(nf));
4596 1036 : gene = lift_shallow(rnfeltabstorel(rnf,pol_x(nf_get_varn(nfabs))));
4597 1036 : absaut = rnfeltreltoabs(rnf,poleval(gene,aut));
4598 1036 : gmael(al,6,2) = shallowmatconcat(mkmat22(
4599 : nfgaloismatrix(nfabs,absaut),
4600 : gen_0,
4601 : gen_0,
4602 : gneg(matid(2*d))
4603 : ));
4604 1036 : }
4605 :
4606 : /* rnf complete */
4607 : static GEN
4608 413 : alg_complete0(GEN rnf, GEN aut, GEN hf, GEN hi, long flag)
4609 : {
4610 413 : pari_sp av = avma;
4611 : GEN nf, pl, pl2, cnd, prcnd, cnds, y, Lpr, auts, b, fa, data, hfe;
4612 : GEN forbid, al, ind, perm;
4613 : long D, n, d, i, j, l;
4614 413 : nf = rnf_get_nf(rnf);
4615 413 : n = rnf_get_degree(rnf);
4616 413 : d = nf_get_degree(nf);
4617 413 : D = d*n*n;
4618 413 : checkhasse(nf,hf,hi,n);
4619 413 : hf = hassereduce(hf);
4620 413 : Lpr = gel(hf,1);
4621 413 : hfe = gel(hf,2);
4622 :
4623 413 : auts = allauts(rnf,aut);
4624 :
4625 413 : pl = leafcopy(hi); /* conditions on the final b */
4626 413 : pl2 = leafcopy(hi); /* conditions for computing local Hasse invariants */
4627 413 : l = lg(pl); ind = cgetg(l, t_VECSMALL);
4628 1036 : for (i = j = 1; i < l; i++)
4629 623 : if (hi[i]) { pl[i] = -1; pl2[i] = 1; } else ind[j++] = i;
4630 413 : setlg(ind, j);
4631 413 : y = nfpolsturm(nf, rnf_get_pol(rnf), ind);
4632 777 : for (i = 1; i < j; i++)
4633 364 : if (!signe(gel(y,i))) { pl[ind[i]] = 1; pl2[ind[i]] = 1; }
4634 :
4635 413 : cnds = computecnd(rnf,Lpr);
4636 413 : prcnd = gel(cnds,1);
4637 413 : cnd = gel(cnds,2);
4638 413 : y = cgetg(lgcols(prcnd),t_VEC);
4639 413 : forbid = vectrunc_init(lg(Lpr));
4640 2198 : for (i=j=1; i<lg(Lpr); i++)
4641 : {
4642 1785 : GEN pr = gcoeff(prcnd,i,1), yi;
4643 1785 : long v, e = itou( gcoeff(prcnd,i,2) );
4644 1785 : if (!e) {
4645 1708 : long frob = cyclicrelfrob(rnf,auts,pr), f1 = ugcd(frob,n);
4646 1708 : vectrunc_append(forbid, pr);
4647 1708 : yi = gen_0;
4648 1708 : v = ((hfe[i]/f1) * Fl_inv(frob/f1,n)) % n;
4649 : }
4650 : else
4651 77 : yi = localcomplete(rnf, pl2, cnd, auts, j++, n, hfe[i], &v);
4652 1785 : gel(y,i) = yi;
4653 1785 : gcoeff(prcnd,i,2) = stoi(e + v);
4654 : }
4655 1057 : for (; i<lgcols(prcnd); i++) gel(y,i) = gen_1;
4656 413 : gen_sort_inplace(forbid, (void*)&cmp_prime_ideal, &cmp_nodata, NULL);
4657 413 : data = mkvec2(rnf,forbid);
4658 413 : b = factoredextchinesetest(nf,prcnd,y,pl,&fa,data,testsplits);
4659 :
4660 413 : al = cgetg(12, t_VEC);
4661 413 : gel(al,10)= gen_0; /* must be set first */
4662 413 : gel(al,1) = rnf;
4663 413 : gel(al,2) = auts;
4664 413 : gel(al,3) = basistoalg(nf,b);
4665 413 : gel(al,4) = hi;
4666 : /* add primes | disc or b with trivial Hasse invariant to hf */
4667 413 : Lpr = gel(prcnd,1); y = b;
4668 413 : (void)nfmakecoprime(nf, &y, Lpr);
4669 413 : Lpr = shallowconcat(Lpr, gel(idealfactor(nf,y), 1));
4670 413 : settyp(Lpr,t_VEC);
4671 413 : hf = shallowconcat(hfe, const_vecsmall(lg(Lpr)-lg(hfe), 0));
4672 413 : perm = gen_indexsort(Lpr, (void*)&cmp_prime_ideal, &cmp_nodata);
4673 413 : gel(al,5) = mkvec2(vecpermute(Lpr,perm), vecsmallpermute(hf,perm));
4674 413 : gel(al,6) = mkvec2(gen_0,gen_0);
4675 413 : gel(al,7) = matid(D);
4676 413 : gel(al,8) = matid(D); /* TODO modify 7, 8 et 9 once LLL added */
4677 413 : gel(al,9) = algnatmultable(al,D);
4678 413 : gel(al,11)= algtracebasis(al);
4679 :
4680 413 : if (n==2) alg_insert_quatconj(al);
4681 413 : if (flag & al_MAXORD) al = alg_maximal_primes(al, prV_primes(Lpr));
4682 413 : return gc_GEN(av, al);
4683 : }
4684 :
4685 : GEN
4686 0 : alg_complete(GEN rnf, GEN aut, GEN hf, GEN hi, long flag)
4687 : {
4688 0 : long n = rnf_get_degree(rnf);
4689 0 : rnfcomplete(rnf);
4690 0 : return alg_complete0(rnf, aut, hasseconvert(hf,n), hasseconvert(hi,n), flag);
4691 : }
4692 :
4693 : void
4694 2254 : checkhasse(GEN nf, GEN hf, GEN hi, long n)
4695 : {
4696 : GEN Lpr, Lh;
4697 : long i, sum;
4698 2254 : if (typ(hf) != t_VEC || lg(hf) != 3) pari_err_TYPE("checkhasse [hf]", hf);
4699 2247 : Lpr = gel(hf,1);
4700 2247 : Lh = gel(hf,2);
4701 2247 : if (typ(Lpr) != t_VEC) pari_err_TYPE("checkhasse [Lpr]", Lpr);
4702 2247 : if (typ(Lh) != t_VECSMALL) pari_err_TYPE("checkhasse [Lh]", Lh);
4703 2247 : if (typ(hi) != t_VECSMALL) pari_err_TYPE("checkhasse [hi]", hi);
4704 2247 : if ((nf && lg(hi) != nf_get_r1(nf)+1))
4705 7 : pari_err_DOMAIN("checkhasse [hi should have r1 components]","#hi","!=",stoi(nf_get_r1(nf)),stoi(lg(hi)-1));
4706 2240 : if (lg(Lpr) != lg(Lh))
4707 7 : pari_err_DIM("checkhasse [Lpr and Lh should have same length]");
4708 9646 : for (i=1; i<lg(Lpr); i++) checkprid(gel(Lpr,i));
4709 2233 : if (lg(gen_sort_uniq(Lpr, (void*)cmp_prime_ideal, cmp_nodata)) < lg(Lpr))
4710 7 : pari_err(e_MISC, "error in checkhasse [duplicate prime ideal]");
4711 2226 : sum = 0;
4712 9625 : for (i=1; i<lg(Lh); i++) sum = (sum+Lh[i])%n;
4713 5278 : for (i=1; i<lg(hi); i++) {
4714 3066 : if (hi[i] && 2*hi[i] != n) pari_err_DOMAIN("checkhasse", "Hasse invariant at real place [must be 0 or 1/2]", "!=", n%2? gen_0 : stoi(n/2), stoi(hi[i]));
4715 3052 : sum = (sum+hi[i])%n;
4716 : }
4717 2212 : if (sum<0) sum = n+sum;
4718 2212 : if (sum != 0)
4719 7 : pari_err_DOMAIN("checkhasse","sum(Hasse invariants)","!=",gen_0,Lh);
4720 2205 : }
4721 :
4722 : static GEN
4723 511 : hassecoprime(GEN hf, GEN hi, long n)
4724 : {
4725 511 : pari_sp av = avma;
4726 : long l, i, j, lk, inv;
4727 : GEN fa, P,E, res, hil, hfl;
4728 511 : hi = hasseconvert(hi, n);
4729 497 : hf = hasseconvert(hf, n);
4730 476 : checkhasse(NULL,hf,hi,n);
4731 434 : fa = factoru(n);
4732 434 : P = gel(fa,1); l = lg(P);
4733 434 : E = gel(fa,2);
4734 434 : res = cgetg(l,t_VEC);
4735 875 : for (i=1; i<l; i++) {
4736 441 : lk = upowuu(P[i],E[i]);
4737 441 : inv = Fl_invsafe((n/lk)%lk, lk);
4738 441 : hil = gcopy(hi);
4739 441 : hfl = gcopy(hf);
4740 :
4741 441 : if (P[i] == 2)
4742 896 : for (j=1; j<lg(hil); j++) hil[j] = hi[j]==0 ? 0 : lk/2;
4743 : else
4744 203 : for (j=1; j<lg(hil); j++) hil[j] = 0;
4745 2590 : for (j=1; j<lgcols(hfl); j++) gel(hfl,2)[j] = (gel(hf,2)[j]*inv)%lk;
4746 441 : hfl = hassereduce(hfl);
4747 441 : gel(res,i) = mkvec3(hfl,hil,utoi(lk));
4748 : }
4749 :
4750 434 : return gc_GEN(av, res);
4751 : }
4752 :
4753 : /* no garbage collection */
4754 : static GEN
4755 140 : genefrob(GEN nf, GEN gal, GEN r)
4756 : {
4757 : long i;
4758 140 : GEN g = identity_perm(nf_get_degree(nf)), fa = Z_factor(r), p, pr, frob;
4759 217 : for (i=1; i<lgcols(fa); i++) {
4760 77 : p = gcoeff(fa,i,1);
4761 77 : pr = idealprimedec(nf, p);
4762 77 : pr = gel(pr,1);
4763 77 : frob = idealfrobenius(nf, gal, pr);
4764 77 : g = perm_mul(g, perm_pow(frob, gcoeff(fa,i,2)));
4765 : }
4766 140 : return g;
4767 : }
4768 :
4769 : static GEN
4770 413 : rnfcycaut(GEN rnf)
4771 : {
4772 413 : GEN nf2 = obj_check(rnf, rnf_NFABS);
4773 : GEN L, alpha, pol, salpha, s, sj, polabs, k, X, pol0, nf;
4774 : long i, d, j;
4775 413 : d = rnf_get_degree(rnf);
4776 413 : L = galoisconj(nf2,NULL);
4777 413 : alpha = lift_shallow(rnf_get_alpha(rnf));
4778 413 : pol = rnf_get_pol(rnf);
4779 413 : k = rnf_get_k(rnf);
4780 413 : polabs = rnf_get_polabs(rnf);
4781 413 : nf = rnf_get_nf(rnf);
4782 413 : pol0 = nf_get_pol(nf);
4783 413 : X = RgX_rem(pol_x(varn(pol0)), pol0);
4784 :
4785 : /* TODO check mod prime of degree 1 */
4786 630 : for (i=1; i<lg(L); i++) {
4787 630 : s = gel(L,i);
4788 630 : salpha = RgX_RgXQ_eval(alpha,s,polabs);
4789 630 : if (!gequal(alpha,salpha)) continue;
4790 :
4791 553 : s = lift_shallow(rnfeltabstorel(rnf,s));
4792 553 : sj = s = gsub(s, gmul(k,X));
4793 1092 : for (j=1; !gequal0(gsub(sj,pol_x(varn(s)))); j++)
4794 539 : sj = RgX_RgXQ_eval(sj,s,pol);
4795 553 : if (j<d) continue;
4796 413 : return s;
4797 : }
4798 : return NULL; /*LCOV_EXCL_LINE*/
4799 : }
4800 :
4801 : /* returns the smallest prime not in P */
4802 : static GEN
4803 84 : extraprime(GEN P)
4804 : {
4805 : forprime_t T;
4806 : GEN p;
4807 84 : forprime_init(&T, gen_2, NULL);
4808 98 : while ((p = forprime_next(&T))) if (!ZV_search(P, p)) break;
4809 84 : return p;
4810 : }
4811 :
4812 : /* true nf */
4813 : GEN
4814 525 : alg_hasse(GEN nf, long n, GEN hf, GEN hi, long var, long flag)
4815 : {
4816 525 : pari_sp av = avma;
4817 525 : GEN primary, al = gen_0, al2, rnf, hil, hfl, Ld, pl, pol, Lpr, aut, Lpr2, Ld2;
4818 : long i, lk, j, maxdeg;
4819 525 : dbg_printf(1)("alg_hasse\n");
4820 525 : if (n<=1) pari_err_DOMAIN("alg_hasse", "degree", "<=", gen_1, stoi(n));
4821 511 : primary = hassecoprime(hf, hi, n);
4822 854 : for (i=1; i<lg(primary); i++) {
4823 441 : lk = itos(gmael(primary,i,3));
4824 441 : hfl = gmael(primary,i,1);
4825 441 : hil = gmael(primary,i,2);
4826 441 : checkhasse(nf, hfl, hil, lk);
4827 434 : dbg_printf(1)("alg_hasse: i=%d hf=%Ps hi=%Ps lk=%d\n", i, hfl, hil, lk);
4828 :
4829 434 : if (lg(gel(hfl,1))>1 || lk%2==0) {
4830 427 : maxdeg = 1;
4831 427 : Lpr = gel(hfl,1);
4832 427 : Ld = gcopy(gel(hfl,2));
4833 2226 : for (j=1; j<lg(Ld); j++)
4834 : {
4835 1799 : Ld[j] = lk/ugcd(lk,Ld[j]);
4836 1799 : maxdeg = maxss(Ld[j],maxdeg);
4837 : }
4838 427 : pl = leafcopy(hil);
4839 1064 : for (j=1; j<lg(pl); j++) if(pl[j])
4840 : {
4841 259 : pl[j] = -1;
4842 259 : maxdeg = maxss(maxdeg,2);
4843 : }
4844 :
4845 427 : Lpr2 = Lpr;
4846 427 : Ld2 = Ld;
4847 427 : if (maxdeg<lk)
4848 : {
4849 154 : if (maxdeg==1 && lk==2 && lg(pl)>1) pl[1] = -1;
4850 : else
4851 : {
4852 84 : GEN p = extraprime(prV_primes(Lpr));
4853 84 : Lpr2 = vec_append(Lpr2, idealprimedec_galois(nf, p));
4854 84 : Ld2 = vecsmall_append(Ld2, lk);
4855 : }
4856 : }
4857 :
4858 427 : dbg_printf(2)("alg_hasse: calling nfgrunwaldwang Lpr=%Ps Pd=%Ps pl=%Ps\n",
4859 : Lpr, Ld, pl);
4860 427 : pol = nfgrunwaldwang(nf, Lpr2, Ld2, pl, var);
4861 413 : dbg_printf(2)("alg_hasse: calling rnfinit(%Ps)\n", pol);
4862 413 : rnf = rnfinit0(nf,pol,1);
4863 413 : dbg_printf(2)("alg_hasse: computing automorphism\n");
4864 413 : aut = rnfcycaut(rnf);
4865 413 : dbg_printf(2)("alg_hasse: calling alg_complete\n");
4866 413 : al2 = alg_complete0(rnf, aut, hfl, hil, flag);
4867 : }
4868 7 : else al2 = alg_matrix(nf, lk, var, flag);
4869 :
4870 420 : if (i==1) al = al2;
4871 7 : else al = algtensor(al,al2,flag);
4872 : }
4873 413 : return gc_GEN(av,al);
4874 : }
4875 :
4876 : /** CYCLIC ALGEBRA WITH GIVEN HASSE INVARIANTS **/
4877 :
4878 : /* no garbage collection */
4879 : static GEN
4880 140 : subcycloindep(GEN nf, long n, long v, GEN *pr)
4881 : {
4882 : pari_sp av;
4883 : forprime_t S;
4884 : ulong p;
4885 140 : u_forprime_arith_init(&S, 1, ULONG_MAX, 1, n);
4886 140 : av = avma;
4887 147 : while ((p = u_forprime_next(&S)))
4888 : {
4889 147 : ulong r = pgener_Fl(p);
4890 147 : GEN pol = galoissubcyclo(utoipos(p), utoipos(Fl_powu(r,n,p)), 0, v);
4891 147 : GEN fa = nffactor(nf, pol);
4892 147 : if (lgcols(fa) == 2) { *pr = utoipos(r); return pol; }
4893 7 : set_avma(av);
4894 : }
4895 : pari_err_BUG("subcycloindep (no suitable prime = 1(mod n))"); /*LCOV_EXCL_LINE*/
4896 : *pr = NULL; return NULL; /*LCOV_EXCL_LINE*/
4897 : }
4898 :
4899 : GEN
4900 147 : alg_matrix(GEN nf, long n, long v, long flag)
4901 : {
4902 147 : pari_sp av = avma;
4903 : GEN pol, gal, rnf, cyclo, g, r, aut;
4904 147 : dbg_printf(1)("alg_matrix\n");
4905 147 : if (n<=0) pari_err_DOMAIN("alg_matrix", "n", "<=", gen_0, stoi(n));
4906 140 : pol = subcycloindep(nf, n, v, &r);
4907 140 : rnf = rnfinit(nf, pol);
4908 140 : cyclo = nfinit(pol, nf_get_prec(nf));
4909 140 : gal = galoisinit(cyclo, NULL);
4910 140 : g = genefrob(cyclo,gal,r);
4911 140 : aut = galoispermtopol(gal,g);
4912 140 : return gc_upto(av, alg_cyclic(rnf, aut, gen_1, flag));
4913 : }
4914 :
4915 : static GEN
4916 28 : alg_hilbert_asquare(GEN nf, GEN a, GEN sa, GEN b, long v, long flag)
4917 : {
4918 : GEN mt, al, ord, z1, z2, den, invol;
4919 28 : long d = nf_get_degree(nf), i;
4920 28 : mt = mkvec4(
4921 : matid(4),
4922 : mkmat4(
4923 : mkcol4(gen_0,gen_1,gen_0,gen_0),
4924 : mkcol4(a,gen_0,gen_0,gen_0),
4925 : mkcol4(gen_0,gen_0,gen_0,gen_1),
4926 : mkcol4(gen_0,gen_0,a,gen_0)
4927 : ),
4928 : mkmat4(
4929 : mkcol4(gen_0,gen_0,gen_1,gen_0),
4930 : mkcol4(gen_0,gen_0,gen_0,gen_m1),
4931 : mkcol4(b,gen_0,gen_0,gen_0),
4932 : mkcol4(gen_0,gneg(b),gen_0,gen_0)
4933 : ),
4934 : mkmat4(
4935 : mkcol4(gen_0,gen_0,gen_0,gen_1),
4936 : mkcol4(gen_0,gen_0,gneg(a),gen_0),
4937 : mkcol4(gen_0,b,gen_0,gen_0),
4938 : mkcol4(gneg(gmul(a,b)),gen_0,gen_0,gen_0)
4939 : )
4940 : );
4941 28 : al = alg_csa_table(nf, mt, v, al_NOSPLITTING);
4942 :
4943 : /* set trivial Hasse invariants */
4944 28 : gel(al,4) = zero_zv(nf_get_r1(nf));
4945 28 : gel(al,5) = mkvec2(cgetg(1,t_VEC),cgetg(1,t_VECSMALL));
4946 :
4947 : /* remember special case */
4948 28 : sa = basistoalg(nf,sa);
4949 28 : gmael(al,6,1) = mkvec3(a,b,sa);
4950 28 : invol = matid(4*d);
4951 196 : for (i=d+1; i<lg(invol); i++) gcoeff(invol,i,i) = gen_m1;
4952 28 : gmael(al,6,2) = invol;
4953 :
4954 28 : if (flag & al_MAXORD)
4955 : {
4956 28 : ord = cgetg(4,t_VEC);
4957 :
4958 28 : z1 = mkfracss(1,2); /* 1/2 */
4959 28 : z2 = gmul2n(ginv(sa),-1); /* 1/(2*sa) */
4960 : /* (1+i/sa)/2 */
4961 28 : gel(ord,1) = algleftmultable(al,mkcol4(z1,z2,gen_0,gen_0));
4962 : /* (j-ij/sa)/2 */
4963 28 : gel(ord,2) = algleftmultable(al,mkcol4(gen_0,gen_0,z1,gneg(z2)));
4964 28 : z1 = basistoalg(nf,nfdiv(nf,z1,b));
4965 28 : z2 = basistoalg(nf,nfdiv(nf,z2,b));
4966 : /* (j/b + ij/(b*sa))/2 */
4967 28 : gel(ord,3) = algleftmultable(al,mkcol4(gen_0,gen_0,z1,z2));
4968 :
4969 : /* multiply by nf.zk == d first vectors of natural basis */
4970 112 : for (i=1; i<=3; i++) gel(ord,i) = vecslice(gel(ord,i),1,d);
4971 :
4972 28 : ord = shallowmatconcat(ord);
4973 28 : ord = Q_remove_denom(ord, &den);
4974 28 : ord = hnfmodid(ord, den);
4975 28 : ord = ZM_Z_div(ord, den);
4976 28 : al = alg_change_overorder_shallow(al, ord);
4977 : }
4978 : /* could take splitting field == nf */
4979 28 : computesplitting(al, 2, v, flag);
4980 28 : return al;
4981 : }
4982 :
4983 : GEN
4984 658 : alg_hilbert(GEN nf, GEN a, GEN b, long v, long flag)
4985 : {
4986 658 : pari_sp av = avma;
4987 : GEN rnf, aut, rnfpol, sa;
4988 658 : dbg_printf(1)("alg_hilbert\n");
4989 658 : if (gequal0(a)) pari_err_DOMAIN("alg_hilbert", "a", "=", gen_0, a);
4990 651 : if (gequal0(b)) pari_err_DOMAIN("alg_hilbert", "b", "=", gen_0, b);
4991 644 : if (!isint1(Q_denom(algtobasis(nf,a))))
4992 7 : pari_err_DOMAIN("alg_hilbert", "denominator(a)", "!=", gen_1,a);
4993 637 : if (!isint1(Q_denom(algtobasis(nf,b))))
4994 7 : pari_err_DOMAIN("alg_hilbert", "denominator(b)", "!=", gen_1,b);
4995 630 : if (nfissquare(nf,a,&sa))
4996 28 : return gc_GEN(av, alg_hilbert_asquare(nf,a,sa,b,v,flag));
4997 :
4998 602 : if (v < 0) v = 0;
4999 602 : rnfpol = deg2pol_shallow(gen_1, gen_0, gneg(basistoalg(nf,a)), v);
5000 602 : if (!(flag & al_FACTOR)) rnfpol = mkvec2(rnfpol, stoi(1<<20));
5001 602 : rnf = rnfinit(nf, rnfpol);
5002 602 : aut = gneg(pol_x(v));
5003 602 : return gc_upto(av, alg_cyclic(rnf, aut, b, flag));
5004 : }
5005 :
5006 : /* shortcut for alg_hasse in quaternion case */
5007 : static GEN
5008 77 : alg_quatramif(GEN nf, GEN Lpr, GEN hi, long var, long flag)
5009 : {
5010 77 : pari_sp av = avma;
5011 77 : GEN hf = mkvec2(Lpr, const_vecsmall(lg(Lpr)-1,1));
5012 77 : return gc_upto(av, alg_hasse(nf, 2, hf, hi, var, flag));
5013 : }
5014 :
5015 : /* return a structure representing the algebra of real numbers */
5016 : static GEN
5017 28 : mk_R()
5018 : {
5019 28 : pari_sp av = avma;
5020 : GEN al;
5021 28 : al = zerovec(11);
5022 28 : gel(al,1) = stor(1, LOWDEFAULTPREC);
5023 28 : gel(al,2) = mkvec(gel(al,1));
5024 28 : gel(al,3) = gen_1;
5025 28 : gel(al,4) = mkvecsmall(0);
5026 28 : gel(al,6) = mkvec2(gen_0,matid(1));
5027 28 : gel(al,8) = gel(al,7) = matid(1);
5028 28 : gel(al,9) = mkvec(matid(1));
5029 28 : return gc_GEN(av,al);
5030 : }
5031 : /* return a structure representing the algebra of complex numbers */
5032 : static GEN
5033 21 : mk_C()
5034 : {
5035 21 : pari_sp av = avma;
5036 : GEN al, I;
5037 21 : al = zerovec(11);
5038 21 : I = gen_I();
5039 21 : gel(al,1) = I;
5040 21 : gel(al,2) = mkvec(I);
5041 21 : gel(al,3) = gen_1;
5042 21 : gel(al,4) = cgetg(1,t_VECSMALL);
5043 21 : gel(al,6) = mkvec2(gen_0,mkmat22(gen_1,gen_0,gen_0,gen_m1));
5044 21 : gel(al,8) = gel(al,7) = matid(2);
5045 21 : gel(al,9) = mkvec2(
5046 : matid(2),
5047 : mkmat22(gen_0,gen_m1,gen_1,gen_0)
5048 : );
5049 21 : return gc_GEN(av,al);
5050 : }
5051 : /* return a structure representing the Hamilton quaternion algebra */
5052 : static GEN
5053 56 : mk_H()
5054 : {
5055 56 : pari_sp av = avma;
5056 : GEN al, I;
5057 56 : al = zerovec(11);
5058 56 : I = gen_I();
5059 56 : gel(al,1) = I;
5060 56 : gel(al,2) = mkvec(gconj(I));
5061 56 : gel(al,3) = gen_m1;
5062 56 : gel(al,4) = mkvecsmall(1);
5063 56 : gel(al,6) = mkvec2(gen_0, H_invol(NULL));
5064 56 : gel(al,8) = gel(al,7) = matid(4);
5065 56 : gel(al,9) = mkvec4(
5066 : matid(4),
5067 : H_tomatrix(I,1),
5068 : H_tomatrix(mkcol4(gen_0,gen_0,gen_1,gen_0),1),
5069 : H_tomatrix(mkcol4(gen_0,gen_0,gen_0,gen_1),1)
5070 : );
5071 56 : return gc_GEN(av,al);
5072 : }
5073 :
5074 : GEN
5075 1995 : alginit(GEN A, GEN B, long v, long flag)
5076 : {
5077 : long w;
5078 1995 : if (typ(A) == t_COMPLEX) return mk_C();
5079 1974 : if (typ(A) == t_REAL)
5080 : {
5081 91 : if (is_scalar_t(typ(B)) && gequal0(B)) return mk_R();
5082 63 : if (typ(B) == t_FRAC && gequal(B, mkfrac(gen_1,gen_2))) return mk_H();
5083 7 : pari_err_DOMAIN("alginit", "real Hasse invariant [must be 0 or 1/2]", "", NULL, B);
5084 : }
5085 1883 : switch(nftyp(A))
5086 : {
5087 1624 : case typ_NF:
5088 1624 : if (v<0) v=0;
5089 1624 : w = gvar(nf_get_pol(A));
5090 1624 : if (varncmp(v,w)>=0) pari_err_PRIORITY("alginit", pol_x(v), ">=", w);
5091 1610 : switch(typ(B))
5092 : {
5093 : long nB;
5094 140 : case t_INT: return alg_matrix(A, itos(B), v, flag);
5095 1463 : case t_VEC:
5096 1463 : nB = lg(B)-1;
5097 1463 : if (nB && typ(gel(B,1)) == t_MAT) return alg_csa_table(A,B,v,flag);
5098 1197 : switch(nB)
5099 : {
5100 735 : case 2:
5101 735 : if (typ(gel(B,1)) == t_VEC)
5102 77 : return alg_quatramif(A, gel(B,1), gel(B,2), v, flag);
5103 658 : return alg_hilbert(A, gel(B,1), gel(B,2), v, flag);
5104 455 : case 3:
5105 455 : if (typ(gel(B,1))!=t_INT)
5106 7 : pari_err_TYPE("alginit [degree should be an integer]", gel(B,1));
5107 448 : return alg_hasse(A, itos(gel(B,1)), gel(B,2), gel(B,3), v,
5108 : flag);
5109 : }
5110 : }
5111 14 : pari_err_TYPE("alginit", B); break;
5112 :
5113 245 : case typ_RNF:
5114 245 : if (typ(B) != t_VEC || lg(B) != 3) pari_err_TYPE("alginit", B);
5115 231 : return alg_cyclic(A, gel(B,1), gel(B,2), flag);
5116 : }
5117 14 : pari_err_TYPE("alginit", A);
5118 : return NULL;/*LCOV_EXCL_LINE*/
5119 : }
5120 :
5121 : /* assumes al CSA or CYCLIC */
5122 : static GEN
5123 1652 : algnatmultable(GEN al, long D)
5124 : {
5125 : GEN res, x;
5126 : long i;
5127 1652 : res = cgetg(D+1,t_VEC);
5128 17738 : for (i=1; i<=D; i++) {
5129 16086 : x = algnattoalg(al,col_ei(D,i));
5130 16086 : gel(res,i) = algZmultable(al,x);
5131 : }
5132 1652 : return res;
5133 : }
5134 :
5135 : static int
5136 168 : normfact_is_partial(GEN nf, GEN x, GEN fax)
5137 : {
5138 : long i;
5139 : GEN nfx;
5140 168 : nfx = RgM_shallowcopy(fax);
5141 434 : for (i=1; i<lg(gel(nfx,1)); i++)
5142 266 : gcoeff(nfx,i,1) = idealnorm(nf, gcoeff(nfx,i,1));
5143 168 : nfx = factorback(nfx);
5144 168 : return !gequal(idealnorm(nf, x), nfx);
5145 : }
5146 : /* no garbage collection */
5147 : static void
5148 973 : algcomputehasse(GEN al, long flag)
5149 : {
5150 : int partialfact;
5151 : long r1, k, n, m, m1, m2, m3, i, m23, m123;
5152 : GEN rnf, nf, b, fab, disc2, cnd, fad, auts, pr, pl, perm, y, hi, PH, H, L;
5153 :
5154 973 : rnf = alg_get_splittingfield(al);
5155 973 : n = rnf_get_degree(rnf);
5156 973 : nf = rnf_get_nf(rnf);
5157 973 : b = alg_get_b(al);
5158 973 : r1 = nf_get_r1(nf);
5159 973 : auts = alg_get_auts(al);
5160 973 : (void)alg_get_abssplitting(al);
5161 :
5162 973 : y = nfpolsturm(nf, rnf_get_pol(rnf), NULL);
5163 973 : pl = cgetg(r1+1, t_VECSMALL);
5164 : /* real places where rnf/nf ramifies */
5165 2170 : for (k = 1; k <= r1; k++) pl[k] = !signe(gel(y,k));
5166 :
5167 : /* infinite Hasse invariants */
5168 973 : if (odd(n)) hi = const_vecsmall(r1, 0);
5169 : else
5170 : {
5171 805 : GEN s = nfsign(nf, b);
5172 805 : hi = cgetg(r1+1, t_VECSMALL);
5173 1834 : for (k = 1; k<=r1; k++) hi[k] = (s[k] && pl[k]) ? (n/2) : 0;
5174 : }
5175 973 : gel(al,4) = hi;
5176 :
5177 973 : partialfact = 0;
5178 973 : if (flag & al_FACTOR)
5179 868 : fab = idealfactor(nf, b);
5180 : else {
5181 105 : fab = idealfactor_limit(nf, b, 1<<20);
5182 : /* does not report whether factorisation was partial; check it */
5183 105 : partialfact = normfact_is_partial(nf, b, fab);
5184 : }
5185 :
5186 973 : disc2 = rnf_get_idealdisc(rnf);
5187 973 : L = nfmakecoprime(nf, &disc2, gel(fab,1));
5188 973 : m = lg(L)-1;
5189 : /* m1 = #{pr|b: pr \nmid disc}, m3 = #{pr|b: pr | disc} */
5190 973 : perm = cgetg(m+1, t_VECSMALL);
5191 1764 : for (i=1, m1=m, k=1; k<=m; k++)
5192 791 : if (signe(gel(L,k))) perm[m1--] = k; else perm[i++] = k;
5193 973 : m3 = m - m1;
5194 :
5195 : /* disc2 : factor of disc coprime to b */
5196 973 : if (flag & al_FACTOR)
5197 868 : fad = idealfactor(nf, disc2);
5198 : else {
5199 105 : fad = idealfactor_limit(nf, disc2, 1<<20);
5200 105 : partialfact = partialfact || normfact_is_partial(nf, disc2, fad);
5201 : }
5202 :
5203 : /* if factorisation is partial, do not compute Hasse invariants */
5204 : /* we could compute their sum at composite factors */
5205 973 : if (partialfact)
5206 : {
5207 49 : if (!(flag & al_MAXORD))
5208 : {
5209 42 : gel(al,5) = gen_0;
5210 49 : return;
5211 : }
5212 : /* but transmit list of factors found for computation of maximal order */
5213 7 : PH = prV_primes(shallowconcat(gel(fab,1), gel(fad,1)));
5214 7 : gel(al,5) = mkvec2(PH, gen_0);;
5215 7 : return;
5216 : }
5217 :
5218 : /* m2 : number of prime factors of disc not dividing b */
5219 924 : m2 = nbrows(fad);
5220 924 : m23 = m2+m3;
5221 924 : m123 = m1+m2+m3;
5222 :
5223 : /* initialize the possibly ramified primes (hasse) and the factored conductor of rnf/nf (cnd) */
5224 924 : cnd = zeromatcopy(m23,2);
5225 924 : PH = cgetg(m123+1, t_VEC); /* ramified primes */
5226 924 : H = cgetg(m123+1, t_VECSMALL); /* Hasse invariant */
5227 : /* compute Hasse invariant at primes that are unramified in rnf/nf */
5228 1554 : for (k=1; k<=m1; k++) {/* pr | b, pr \nmid disc */
5229 630 : long frob, e, j = perm[k];
5230 630 : pr = gcoeff(fab,j,1);
5231 630 : e = itos(gcoeff(fab,j,2));
5232 630 : frob = cyclicrelfrob(rnf, auts, pr);
5233 630 : gel(PH,k) = pr;
5234 630 : H[k] = Fl_mul(frob, e, n);
5235 : }
5236 : /* compute Hasse invariant at primes that are ramified in rnf/nf */
5237 1890 : for (k=1; k<=m2; k++) {/* pr \nmid b, pr | disc */
5238 966 : pr = gcoeff(fad,k,1);
5239 966 : gel(PH,k+m1) = pr;
5240 966 : gcoeff(cnd,k,1) = pr;
5241 966 : gcoeff(cnd,k,2) = gcoeff(fad,k,2);
5242 : }
5243 1001 : for (k=1; k<=m3; k++) { /* pr | (b, disc) */
5244 77 : long j = perm[k+m1];
5245 77 : pr = gcoeff(fab,j,1);
5246 77 : gel(PH,k+m1+m2) = pr;
5247 77 : gcoeff(cnd,k+m2,1) = pr;
5248 77 : gcoeff(cnd,k+m2,2) = gel(L,j);
5249 : }
5250 924 : gel(cnd,2) = gdiventgs(gel(cnd,2), eulerphiu(n));
5251 1967 : for (k=1; k<=m23; k++) H[k+m1] = localhasse(rnf, cnd, pl, auts, b, k);
5252 924 : perm = gen_indexsort(PH, (void*)&cmp_prime_ideal, &cmp_nodata);
5253 924 : gel(al,5) = mkvec2(vecpermute(PH,perm),vecsmallpermute(H,perm));
5254 924 : checkhasse(nf, alg_get_hasse_f(al), alg_get_hasse_i(al), n);
5255 : }
5256 :
5257 : static GEN
5258 1442 : alg_maximal_primes(GEN al, GEN P)
5259 : {
5260 1442 : pari_sp av = avma;
5261 1442 : long l = lg(P), i;
5262 4713 : for (i=1; i<l; i++)
5263 : {
5264 3271 : if (i != 1) al = gc_GEN(av, al);
5265 3271 : al = alg_pmaximal(al,gel(P,i));
5266 : }
5267 1442 : return al;
5268 : }
5269 :
5270 : GEN
5271 987 : alg_cyclic(GEN rnf, GEN aut, GEN b, long flag)
5272 : {
5273 987 : pari_sp av = avma;
5274 : GEN al, nf;
5275 : long D, n, d;
5276 987 : dbg_printf(1)("alg_cyclic\n");
5277 987 : checkrnf(rnf); nf = rnf_get_nf(rnf);
5278 987 : b = nf_to_scalar_or_basis(nf, b);
5279 980 : if (typ(b) == t_FRAC || (typ(b) == t_COL && !RgV_is_ZV(b)))
5280 7 : pari_err_DOMAIN("alg_cyclic", "denominator(b)", "!=", gen_1,b);
5281 :
5282 973 : n = rnf_get_degree(rnf);
5283 973 : d = nf_get_degree(nf);
5284 973 : D = d*n*n;
5285 :
5286 973 : al = cgetg(12,t_VEC);
5287 973 : gel(al,10)= gen_0; /* must be set first */
5288 973 : gel(al,1) = rnf;
5289 973 : gel(al,2) = allauts(rnf, aut);
5290 973 : gel(al,3) = basistoalg(nf,b);
5291 973 : rnf_build_nfabs(rnf, nf_get_prec(nf));
5292 973 : gel(al,6) = mkvec2(gen_0,gen_0);
5293 973 : gel(al,7) = matid(D);
5294 973 : gel(al,8) = matid(D); /* TODO modify 7, 8 et 9 once LLL added */
5295 973 : gel(al,9) = algnatmultable(al,D);
5296 973 : gel(al,11)= algtracebasis(al);
5297 :
5298 973 : if (n==2) alg_insert_quatconj(al);
5299 :
5300 973 : algcomputehasse(al, flag);
5301 :
5302 973 : if (flag & al_MAXORD) {
5303 854 : GEN hf = alg_get_hasse_f(al), pr = gel(hf,1);
5304 854 : if (typ(gel(hf,2)) == t_INT) /* factorisation was partial */
5305 7 : gel(al,5) = gen_0;
5306 847 : else pr = prV_primes(pr);
5307 854 : al = alg_maximal_primes(al, pr);
5308 : }
5309 973 : return gc_GEN(av, al);
5310 : }
5311 :
5312 : static int
5313 630 : ismaximalsubfield(GEN al, GEN x, GEN d, long v, GEN *pt_minpol)
5314 : {
5315 630 : GEN cp = algbasischarpoly(al, x, v), lead;
5316 630 : if (!ispower(cp, d, pt_minpol)) return 0;
5317 630 : lead = leading_coeff(*pt_minpol);
5318 630 : if (isintm1(lead)) *pt_minpol = gneg(*pt_minpol);
5319 630 : return ZX_is_irred(*pt_minpol);
5320 : }
5321 :
5322 : static GEN
5323 266 : findmaximalsubfield(GEN al, GEN d, long v)
5324 : {
5325 266 : long count, nb=2, i, N = alg_get_absdim(al), n = nf_get_degree(alg_get_center(al));
5326 266 : GEN x, minpol, maxc = gen_1;
5327 :
5328 385 : for (i=n+1; i<=N; i+=n) {
5329 595 : for (count=0; count<2 && i+count<=N; count++) {
5330 476 : x = col_ei(N,i+count);
5331 476 : if (ismaximalsubfield(al, x, d, v, &minpol)) return mkvec2(x,minpol);
5332 : }
5333 : }
5334 :
5335 : while(1) {
5336 154 : x = zerocol(N);
5337 609 : for (count=0; count<nb; count++)
5338 : {
5339 455 : i = random_Fl(N)+1;
5340 455 : gel(x,i) = addiu(randomi(maxc),1);
5341 455 : if (random_bits(1)) gel(x,i) = negi(gel(x,i));
5342 : }
5343 154 : if (ismaximalsubfield(al, x, d, v, &minpol)) return mkvec2(x,minpol);
5344 70 : if (!random_bits(3)) maxc = addiu(maxc,1);
5345 70 : if (nb<N) nb++;
5346 : }
5347 :
5348 : return NULL; /* LCOV_EXCL_LINE */
5349 : }
5350 :
5351 : static GEN
5352 266 : frobeniusform(GEN al, GEN x)
5353 : {
5354 : GEN M, FP, P, Pi;
5355 :
5356 : /* /!\ has to be the *right* multiplication table */
5357 266 : M = algbasisrightmultable(al, x);
5358 :
5359 266 : FP = matfrobenius(M,2,0); /* M = P^(-1)*F*P */
5360 266 : P = gel(FP,2);
5361 266 : Pi = RgM_inv(P);
5362 266 : return mkvec2(P, Pi);
5363 : }
5364 :
5365 : static void
5366 266 : computesplitting(GEN al, long d, long v, long flag)
5367 : {
5368 266 : GEN subf, x, pol, polabs, basis, P, Pi, nf = alg_get_center(al), rnf, Lbasis, Lbasisinv, Q, pows;
5369 266 : long i, n = nf_get_degree(nf), nd = n*d, N = alg_get_absdim(al), j, j2;
5370 :
5371 266 : subf = findmaximalsubfield(al, utoipos(d), v);
5372 266 : x = gel(subf, 1);
5373 266 : polabs = gel(subf, 2);
5374 :
5375 : /* Frobenius form to obtain L-vector space structure */
5376 266 : basis = frobeniusform(al, x);
5377 266 : P = gel(basis, 1);
5378 266 : Pi = gel(basis, 2);
5379 :
5380 : /* construct rnf of splitting field */
5381 266 : pol = gel(nffactor(nf,polabs),1);
5382 308 : for (i=1; i<lg(pol); i++)
5383 : /* select relative factor that vanishes on x */
5384 308 : if (gequal0(algpoleval(al, gel(pol,i), x)))
5385 : {
5386 266 : pol = gel(pol,i);
5387 266 : break;
5388 : }
5389 266 : if (typ(pol) != t_POL) pari_err_BUG("computesplitting (no valid factor)");
5390 266 : if (!(flag & al_FACTOR)) pol = mkvec2(pol, stoi(1<<20));
5391 266 : gel(al,1) = rnf = rnfinit(nf, pol);
5392 : /* since pol is irreducible over Q, we have k=0 in rnf. */
5393 266 : if (!gequal0(rnf_get_k(rnf)))
5394 : pari_err_BUG("computesplitting (k!=0)"); /*LCOV_EXCL_LINE*/
5395 266 : rnf_build_nfabs(rnf, nf_get_prec(nf));
5396 :
5397 : /* construct splitting data */
5398 266 : Lbasis = cgetg(d+1, t_MAT);
5399 735 : for (j=j2=1; j<=d; j++, j2+=nd)
5400 469 : gel(Lbasis,j) = gel(Pi,j2);
5401 :
5402 266 : Q = zeromatcopy(d,N);
5403 266 : pows = pol_x_powers(nd,v);
5404 735 : for (i=j=1; j<=N; j+=nd, i++)
5405 2156 : for (j2=0; j2<nd; j2++)
5406 1687 : gcoeff(Q,i,j+j2) = mkpolmod(gel(pows,j2+1),polabs);
5407 266 : Lbasisinv = RgM_mul(Q,P);
5408 :
5409 266 : gel(al,3) = mkvec3(x,Lbasis,Lbasisinv);
5410 266 : }
5411 :
5412 : /* assumes that mt defines a central simple algebra over nf */
5413 : GEN
5414 294 : alg_csa_table(GEN nf, GEN mt0, long v, long flag)
5415 : {
5416 294 : pari_sp av = avma;
5417 : GEN al, mt;
5418 294 : long n, D, d2 = lg(mt0)-1, d = usqrt(d2);
5419 294 : dbg_printf(1)("alg_csa_table\n");
5420 :
5421 294 : mt = check_relmt(nf,mt0);
5422 280 : if (!mt) pari_err_TYPE("alg_csa_table", mt0);
5423 273 : n = nf_get_degree(nf);
5424 273 : D = n*d2;
5425 273 : if (d*d != d2)
5426 7 : pari_err_DOMAIN("alg_csa_table","(nonsquare) dimension","!=",stoi(d*d),mt);
5427 :
5428 266 : al = cgetg(12, t_VEC);
5429 266 : gel(al,10) = gen_0; /* must be set first */
5430 266 : gel(al,1) = zerovec(12); gmael(al,1,10) = nf;
5431 266 : gmael(al,1,1) = gpowgs(pol_x(0), d); /* placeholder before splitting field */
5432 266 : gel(al,2) = mt;
5433 266 : gel(al,3) = gen_0; /* placeholder */
5434 266 : gel(al,4) = gel(al,5) = gen_0; /* TODO Hasse invariants if flag&al_FACTOR */
5435 266 : gel(al,6) = mkvec2(gen_0,gen_0);
5436 266 : gel(al,7) = matid(D);
5437 266 : gel(al,8) = matid(D);
5438 266 : gel(al,9) = algnatmultable(al,D);
5439 266 : gel(al,11)= algtracebasis(al);
5440 266 : if (flag & al_MAXORD) al = alg_maximal(al);
5441 266 : if (!(flag & al_NOSPLITTING)) computesplitting(al, d, v, flag);
5442 266 : return gc_GEN(av, al);
5443 : }
5444 :
5445 : static GEN
5446 59896 : algtableinit_i(GEN mt0, GEN p)
5447 : {
5448 : GEN al, mt;
5449 : long i, n;
5450 :
5451 59896 : if (p && !signe(p)) p = NULL;
5452 59896 : mt = check_mt(mt0,p);
5453 59896 : if (!mt) pari_err_TYPE("algtableinit", mt0);
5454 59889 : if (!p && !isint1(Q_denom(mt0)))
5455 7 : pari_err_DOMAIN("algtableinit", "denominator(mt)", "!=", gen_1, mt0);
5456 59882 : n = lg(mt)-1;
5457 59882 : al = cgetg(12, t_VEC);
5458 359292 : for (i=1; i<=5; i++) gel(al,i) = gen_0;
5459 59882 : gel(al,6) = mkvec2(gen_0, gen_0);
5460 59882 : gel(al,7) = matid(n);
5461 59882 : gel(al,8) = matid(n);
5462 59882 : gel(al,9) = mt;
5463 59882 : gel(al,10) = p? p: gen_0;
5464 59882 : gel(al,11) = algtracebasis(al);
5465 59882 : return al;
5466 : }
5467 : GEN
5468 6223 : algtableinit(GEN mt0, GEN p)
5469 : {
5470 6223 : pari_sp av = avma;
5471 6223 : if (p)
5472 : {
5473 6041 : if (typ(p) != t_INT) pari_err_TYPE("algtableinit",p);
5474 6034 : if (signe(p) && !BPSW_psp(p)) pari_err_PRIME("algtableinit",p);
5475 : }
5476 6202 : return gc_GEN(av, algtableinit_i(mt0, p));
5477 : }
5478 :
5479 : /** REPRESENTATIONS OF GROUPS **/
5480 :
5481 : static GEN
5482 294 : list_to_regular_rep(GEN elts, long n)
5483 : {
5484 : GEN reg, elts2, g;
5485 : long i,j;
5486 294 : elts = shallowcopy(elts);
5487 294 : gen_sort_inplace(elts, (void*)&vecsmall_lexcmp, &cmp_nodata, NULL);
5488 294 : reg = cgetg(n+1, t_VEC);
5489 294 : gel(reg,1) = identity_perm(n);
5490 3857 : for (i=2; i<=n; i++) {
5491 3563 : g = perm_inv(gel(elts,i));
5492 3563 : elts2 = cgetg(n+1, t_VEC);
5493 74543 : for (j=1; j<=n; j++) gel(elts2,j) = perm_mul(g,gel(elts,j));
5494 3563 : gen_sort_inplace(elts2, (void*)&vecsmall_lexcmp, &cmp_nodata, &gel(reg,i));
5495 : }
5496 294 : return reg;
5497 : }
5498 :
5499 : static GEN
5500 3857 : matrix_perm(GEN perm, long n)
5501 : {
5502 : GEN m;
5503 : long j;
5504 3857 : m = cgetg(n+1, t_MAT);
5505 78694 : for (j=1; j<=n; j++) {
5506 74837 : gel(m,j) = col_ei(n,perm[j]);
5507 : }
5508 3857 : return m;
5509 : }
5510 :
5511 : GEN
5512 854 : conjclasses_algcenter(GEN cc, GEN p)
5513 : {
5514 854 : GEN mt, elts = gel(cc,1), conjclass = gel(cc,2), rep = gel(cc,3), card;
5515 854 : long i, nbcl = lg(rep)-1, n = lg(elts)-1;
5516 : pari_sp av;
5517 :
5518 854 : card = zero_Flv(nbcl);
5519 15246 : for (i=1; i<=n; i++) card[conjclass[i]]++;
5520 :
5521 : /* multiplication table of the center of Z[G] (class functions) */
5522 854 : mt = cgetg(nbcl+1,t_VEC);
5523 7259 : for (i=1;i<=nbcl;i++) gel(mt,i) = zero_Flm_copy(nbcl,nbcl);
5524 854 : av = avma;
5525 7259 : for (i=1;i<=nbcl;i++)
5526 : {
5527 6405 : GEN xi = gel(elts,rep[i]), mi = gel(mt,i);
5528 : long j,k;
5529 134379 : for (j=1;j<=n;j++)
5530 : {
5531 127974 : GEN xj = gel(elts,j);
5532 127974 : k = vecsearch(elts, perm_mul(xi,xj), NULL);
5533 127974 : ucoeff(mi, conjclass[k], conjclass[j])++;
5534 : }
5535 70448 : for (k=1; k<=nbcl; k++)
5536 853412 : for (j=1; j<=nbcl; j++)
5537 : {
5538 789369 : ucoeff(mi,k,j) *= card[i];
5539 789369 : ucoeff(mi,k,j) /= card[k];
5540 : }
5541 6405 : set_avma(av);
5542 : }
5543 7259 : for (i=1;i<=nbcl;i++) gel(mt,i) = Flm_to_ZM(gel(mt,i));
5544 854 : return algtableinit_i(mt,p);
5545 : }
5546 :
5547 : GEN
5548 329 : alggroupcenter(GEN G, GEN p, GEN *pcc)
5549 : {
5550 329 : pari_sp av = avma;
5551 329 : GEN cc = group_to_cc(G), al = conjclasses_algcenter(cc, p);
5552 315 : if (!pcc) return gc_GEN(av,al);
5553 7 : *pcc = cc; return gc_all(av, 2, &al, pcc);
5554 : }
5555 :
5556 : static GEN
5557 294 : groupelts_algebra(GEN elts, GEN p)
5558 : {
5559 294 : pari_sp av = avma;
5560 : GEN mt;
5561 294 : long i, n = lg(elts)-1;
5562 294 : elts = list_to_regular_rep(elts,n);
5563 294 : mt = cgetg(n+1, t_VEC);
5564 4151 : for (i=1; i<=n; i++) gel(mt,i) = matrix_perm(gel(elts,i),n);
5565 294 : return gc_GEN(av, algtableinit_i(mt,p));
5566 : }
5567 :
5568 : GEN
5569 329 : alggroup(GEN gal, GEN p)
5570 : {
5571 329 : GEN elts = checkgroupelts(gal);
5572 294 : return groupelts_algebra(elts, p);
5573 : }
5574 :
5575 : /** MAXIMAL ORDER **/
5576 :
5577 : static GEN
5578 93201 : mattocol(GEN M, long n)
5579 : {
5580 93201 : GEN C = cgetg(n*n+1, t_COL);
5581 : long i,j,ic;
5582 93201 : ic = 1;
5583 1650060 : for (i=1; i<=n; i++)
5584 40690752 : for (j=1; j<=n; j++, ic++)
5585 39133893 : gel(C,ic) = gcoeff(M,i,j);
5586 93201 : return C;
5587 : }
5588 :
5589 : /* Ip is a lift of a left O/pO-ideal where O is the integral basis of al */
5590 : static GEN
5591 8604 : algleftordermodp(GEN al, GEN Ip, GEN p)
5592 : {
5593 8604 : pari_sp av = avma;
5594 : GEN I, Ii, M, mt, K, imi, p2;
5595 : long n, i;
5596 8604 : n = alg_get_absdim(al);
5597 8604 : mt = alg_get_multable(al);
5598 8604 : p2 = sqri(p);
5599 :
5600 8604 : I = ZM_hnfmodid(Ip, p);
5601 8604 : Ii = ZM_inv(I,NULL);
5602 :
5603 8604 : M = cgetg(n+1, t_MAT);
5604 101805 : for (i=1; i<=n; i++) {
5605 93201 : imi = FpM_mul(Ii, FpM_mul(gel(mt,i), I, p2), p2);
5606 93201 : imi = ZM_Z_divexact(imi, p);
5607 93201 : gel(M,i) = mattocol(imi, n);
5608 : }
5609 8604 : K = FpM_ker(M, p);
5610 8604 : if (lg(K)==1) { set_avma(av); return matid(n); }
5611 3501 : K = ZM_hnfmodid(K,p);
5612 :
5613 3501 : return gc_upto(av, ZM_Z_div(K,p));
5614 : }
5615 :
5616 : static GEN
5617 14406 : alg_ordermodp(GEN al, GEN p)
5618 : {
5619 : GEN alp;
5620 14406 : long i, N = alg_get_absdim(al);
5621 14406 : alp = cgetg(12, t_VEC);
5622 129654 : for (i=1; i<=8; i++) gel(alp,i) = gen_0;
5623 14406 : gel(alp,9) = cgetg(N+1, t_VEC);
5624 151931 : for (i=1; i<=N; i++) gmael(alp,9,i) = FpM_red(gmael(al,9,i), p);
5625 14406 : gel(alp,10) = p;
5626 14406 : gel(alp,11) = cgetg(N+1, t_VEC);
5627 151931 : for (i=1; i<=N; i++) gmael(alp,11,i) = Fp_red(gmael(al,11,i), p);
5628 :
5629 14406 : return alp;
5630 : }
5631 :
5632 : static GEN
5633 6772 : algpradical_i(GEN al, GEN p, GEN zprad, GEN projs)
5634 : {
5635 6772 : pari_sp av = avma;
5636 6772 : GEN alp = alg_ordermodp(al, p), liftrad, projrad, alq, alrad, res, Lalp, radq;
5637 : long i;
5638 6772 : if (lg(zprad)==1) {
5639 4704 : liftrad = NULL;
5640 4704 : projrad = NULL;
5641 : }
5642 : else {
5643 2068 : alq = alg_quotient(alp, zprad, 1);
5644 2068 : alp = gel(alq,1);
5645 2068 : projrad = gel(alq,2);
5646 2068 : liftrad = gel(alq,3);
5647 : }
5648 :
5649 6772 : if (projs) {
5650 1333 : if (projrad) {
5651 28 : projs = gcopy(projs);
5652 84 : for (i=1; i<lg(projs); i++)
5653 56 : gel(projs,i) = FpM_FpC_mul(projrad, gel(projs,i), p);
5654 : }
5655 1333 : Lalp = alg_centralproj(alp, projs, 1);
5656 :
5657 1333 : alrad = cgetg(lg(Lalp),t_VEC);
5658 4389 : for (i=1; i<lg(Lalp); i++) {
5659 3056 : alq = gel(Lalp,i);
5660 3056 : radq = algradical(gel(alq,1));
5661 3056 : if (gequal0(radq))
5662 1744 : gel(alrad,i) = cgetg(1,t_MAT);
5663 : else {
5664 1312 : radq = FpM_mul(gel(alq,3),radq,p);
5665 1312 : gel(alrad,i) = radq;
5666 : }
5667 : }
5668 1333 : alrad = shallowmatconcat(alrad);
5669 1333 : alrad = FpM_image(alrad,p);
5670 : }
5671 5439 : else alrad = algradical(alp);
5672 :
5673 6772 : if (!gequal0(alrad)) {
5674 5377 : if (liftrad) alrad = FpM_mul(liftrad, alrad, p);
5675 5377 : res = shallowmatconcat(mkvec2(alrad, zprad));
5676 5377 : res = FpM_image(res,p);
5677 : }
5678 1395 : else res = lg(zprad)==1 ? gen_0 : zprad;
5679 6772 : return gc_GEN(av, res);
5680 : }
5681 :
5682 : static GEN
5683 4876 : algpdecompose0(GEN al, GEN prad, GEN p, GEN projs)
5684 : {
5685 4876 : pari_sp av = avma;
5686 4876 : GEN alp, quo, ss, liftm = NULL, projm = NULL, dec, res, I, Lss, deci;
5687 : long i, j;
5688 :
5689 4876 : alp = alg_ordermodp(al, p);
5690 4876 : if (!gequal0(prad)) {
5691 3951 : quo = alg_quotient(alp, prad, 1);
5692 3951 : ss = gel(quo,1);
5693 3951 : projm = gel(quo,2);
5694 3951 : liftm = gel(quo,3);
5695 : }
5696 925 : else ss = alp;
5697 :
5698 4876 : if (projs) {
5699 1171 : if (projm) {
5700 2676 : for (i=1; i<lg(projs); i++)
5701 1856 : gel(projs,i) = FpM_FpC_mul(projm, gel(projs,i), p);
5702 : }
5703 1171 : Lss = alg_centralproj(ss, projs, 1);
5704 :
5705 1171 : dec = cgetg(lg(Lss),t_VEC);
5706 3882 : for (i=1; i<lg(Lss); i++) {
5707 2711 : gel(dec,i) = algsimpledec_ss(gmael(Lss,i,1), 1);
5708 2711 : deci = gel(dec,i);
5709 6144 : for (j=1; j<lg(deci); j++)
5710 3433 : gmael(deci,j,3) = FpM_mul(gmael(Lss,i,3), gmael(deci,j,3), p);
5711 : }
5712 1171 : dec = shallowconcat1(dec);
5713 : }
5714 3705 : else dec = algsimpledec_ss(ss,1);
5715 :
5716 4876 : res = cgetg(lg(dec),t_VEC);
5717 13373 : for (i=1; i<lg(dec); i++) {
5718 8497 : I = gmael(dec,i,3);
5719 8497 : if (liftm) I = FpM_mul(liftm,I,p);
5720 8497 : I = shallowmatconcat(mkvec2(I,prad));
5721 8497 : gel(res,i) = I;
5722 : }
5723 :
5724 4876 : return gc_GEN(av, res);
5725 : }
5726 :
5727 : /* finds a nontrivial ideal of O/prad or gen_0 if there is none. */
5728 : static GEN
5729 1605 : algpdecompose_i(GEN al, GEN p, GEN zprad, GEN projs)
5730 : {
5731 1605 : pari_sp av = avma;
5732 1605 : GEN prad = algpradical_i(al,p,zprad,projs);
5733 1605 : return gc_upto(av, algpdecompose0(al, prad, p, projs));
5734 : }
5735 :
5736 : /* ord is assumed to be in hnf wrt the integral basis of al. */
5737 : /* assumes that alg_get_invbasis(al) is integral. */
5738 : static GEN
5739 3529 : alg_change_overorder_shallow(GEN al, GEN ord)
5740 : {
5741 : GEN al2, mt, iord, mtx, den, den2, div, invol;
5742 : long i, n;
5743 3529 : n = alg_get_absdim(al);
5744 :
5745 3529 : iord = QM_inv(ord);
5746 3529 : al2 = shallowcopy(al);
5747 :
5748 3529 : invol = alg_get_invol(al);
5749 3529 : if (typ(invol) == t_MAT) gmael(al2,6,2) = QM_mul(iord, QM_mul(invol,ord));
5750 :
5751 3529 : ord = Q_remove_denom(ord,&den);
5752 :
5753 3529 : gel(al2,7) = Q_remove_denom(gel(al,7), &den2);
5754 3529 : if (den2) div = mulii(den,den2);
5755 1253 : else div = den;
5756 3529 : gel(al2,7) = ZM_Z_div(ZM_mul(gel(al2,7), ord), div);
5757 :
5758 3529 : gel(al2,8) = ZM_mul(iord, gel(al,8));
5759 :
5760 3529 : mt = cgetg(n+1,t_VEC);
5761 3529 : gel(mt,1) = matid(n);
5762 3529 : div = sqri(den);
5763 39207 : for (i=2; i<=n; i++) {
5764 35678 : mtx = algbasismultable(al,gel(ord,i));
5765 35678 : gel(mt,i) = ZM_mul(iord, ZM_mul(mtx, ord));
5766 35678 : gel(mt,i) = ZM_Z_divexact(gel(mt,i), div);
5767 : }
5768 3529 : gel(al2,9) = mt;
5769 :
5770 3529 : gel(al2,11) = algtracebasis(al2);
5771 :
5772 3529 : return al2;
5773 : }
5774 :
5775 : static GEN
5776 36345 : algeltfromnf_i(GEN al, GEN x)
5777 : {
5778 36345 : GEN nf = alg_get_center(al);
5779 : long n;
5780 36345 : switch(alg_type(al)) {
5781 30647 : case al_CYCLIC:
5782 30647 : n = alg_get_degree(al);
5783 30647 : break;
5784 5698 : case al_CSA:
5785 5698 : n = alg_get_dim(al);
5786 5698 : break;
5787 : default: return NULL; /*LCOV_EXCL_LINE*/
5788 : }
5789 36345 : return algalgtobasis(al, scalarcol(basistoalg(nf, x), n));
5790 : }
5791 :
5792 : GEN
5793 5138 : algeltfromnf(GEN al, GEN x)
5794 : {
5795 5138 : pari_sp av = avma;
5796 5138 : checkalg(al);
5797 5131 : return gc_upto(av, algeltfromnf_i(al,x));
5798 : }
5799 :
5800 : /* x is an ideal of the center in hnf form */
5801 : static GEN
5802 6772 : algeltfromnf_hnf(GEN al, GEN x)
5803 : {
5804 : GEN res;
5805 : long i;
5806 6772 : res = cgetg(lg(x), t_MAT);
5807 19327 : for (i=1; i<lg(x); i++) gel(res,i) = algeltfromnf_i(al, gel(x,i));
5808 6772 : return res;
5809 : }
5810 :
5811 : /* assumes al is CSA or CYCLIC */
5812 : static GEN
5813 3271 : algcenter_precompute(GEN al, GEN p)
5814 : {
5815 3271 : GEN fa, pdec, nfprad, projs, nf = alg_get_center(al);
5816 : long i, np;
5817 :
5818 3271 : pdec = idealprimedec(nf, p);
5819 3271 : settyp(pdec, t_COL);
5820 3271 : np = lg(pdec)-1;
5821 3271 : fa = mkmat2(pdec, const_col(np, gen_1));
5822 3271 : if (dvdii(nf_get_disc(nf), p))
5823 666 : nfprad = idealprodprime(nf, pdec);
5824 : else
5825 2605 : nfprad = scalarmat_shallow(p, nf_get_degree(nf));
5826 3271 : fa = idealchineseinit(nf, fa);
5827 3271 : projs = cgetg(np+1, t_VEC);
5828 7375 : for (i=1; i<=np; i++) gel(projs, i) = idealchinese(nf, fa, vec_ei(np,i));
5829 3271 : return mkvec2(nfprad, projs);
5830 : }
5831 :
5832 : static GEN
5833 6772 : algcenter_prad(GEN al, GEN p, GEN pre)
5834 : {
5835 : GEN nfprad, zprad, mtprad;
5836 : long i;
5837 6772 : nfprad = gel(pre,1);
5838 6772 : zprad = algeltfromnf_hnf(al, nfprad);
5839 6772 : zprad = FpM_image(zprad, p);
5840 6772 : mtprad = cgetg(lg(zprad), t_VEC);
5841 9177 : for (i=1; i<lg(zprad); i++) gel(mtprad, i) = algbasismultable(al, gel(zprad,i));
5842 6772 : mtprad = shallowmatconcat(mtprad);
5843 6772 : zprad = FpM_image(mtprad, p);
5844 6772 : return zprad;
5845 : }
5846 :
5847 : static GEN
5848 6772 : algcenter_p_projs(GEN al, GEN p, GEN pre)
5849 : {
5850 : GEN projs, zprojs;
5851 : long i;
5852 6772 : projs = gel(pre,2);
5853 6772 : zprojs = cgetg(lg(projs), t_VEC);
5854 15267 : for (i=1; i<lg(projs); i++) gel(zprojs,i) = FpC_red(algeltfromnf_i(al, gel(projs,i)),p);
5855 6772 : return zprojs;
5856 : }
5857 :
5858 : /* al is assumed to be simple */
5859 : static GEN
5860 3271 : alg_pmaximal(GEN al, GEN p)
5861 : {
5862 : pari_sp av;
5863 3271 : long n = alg_get_absdim(al);
5864 3271 : GEN id = matid(n), al2 = al, prad, lord = gen_0, dec, zprad, projs, pre;
5865 :
5866 3271 : dbg_printf(0)("Round 2 (noncommutative) at p=%Ps, dim=%d\n", p, n);
5867 3271 : pre = algcenter_precompute(al,p); av = avma;
5868 : while (1) {
5869 5167 : zprad = algcenter_prad(al2, p, pre);
5870 5167 : projs = algcenter_p_projs(al2, p, pre);
5871 5167 : if (lg(projs) == 2) projs = NULL;
5872 5167 : prad = algpradical_i(al2,p,zprad,projs);
5873 5167 : if (typ(prad) == t_INT) break;
5874 5125 : lord = algleftordermodp(al2,prad,p);
5875 5125 : if (!cmp_universal(lord,id)) break;
5876 1896 : al2 = gc_GEN(av, alg_change_overorder_shallow(al2,lord));
5877 : }
5878 :
5879 3271 : dec = algpdecompose0(al2,prad,p,projs); av = avma;
5880 4876 : while (lg(dec) > 2) {
5881 : long i;
5882 4145 : for (i = 1; i < lg(dec); i++) {
5883 3479 : GEN I = gel(dec,i);
5884 3479 : lord = algleftordermodp(al2,I,p);
5885 3479 : if (cmp_universal(lord,id)) break;
5886 : }
5887 2271 : if (i==lg(dec)) break;
5888 1605 : al2 = gc_GEN(av, alg_change_overorder_shallow(al2,lord));
5889 1605 : zprad = algcenter_prad(al2, p, pre);
5890 1605 : projs = algcenter_p_projs(al2, p, pre);
5891 1605 : if (lg(projs) == 2) projs = NULL;
5892 1605 : dec = algpdecompose_i(al2,p,zprad,projs);
5893 : }
5894 3271 : return al2;
5895 : }
5896 :
5897 : static GEN
5898 15236 : algtracematrix(GEN al)
5899 : {
5900 : GEN M, mt;
5901 : long n, i, j;
5902 15236 : n = alg_get_absdim(al);
5903 15236 : mt = alg_get_multable(al);
5904 15236 : M = cgetg(n+1, t_MAT);
5905 114068 : for (i=1; i<=n; i++)
5906 : {
5907 98832 : gel(M,i) = cgetg(n+1,t_MAT);
5908 750489 : for (j=1; j<=i; j++)
5909 651657 : gcoeff(M,j,i) = gcoeff(M,i,j) = algabstrace(al,gmael(mt,i,j));
5910 : }
5911 15236 : return M;
5912 : }
5913 : static GEN
5914 567 : algdisc_i(GEN al) { return ZM_det(algtracematrix(al)); }
5915 : GEN
5916 364 : algdisc(GEN al)
5917 : {
5918 364 : pari_sp av = avma;
5919 364 : checkalg(al);
5920 364 : if (alg_type(al) == al_REAL) pari_err_TYPE("algdisc [real algebra]", al);
5921 343 : return gc_INT(av, algdisc_i(al));
5922 : }
5923 : static GEN
5924 224 : alg_maximal(GEN al)
5925 : {
5926 224 : GEN fa = absZ_factor(algdisc_i(al));
5927 224 : return alg_maximal_primes(al, gel(fa,1));
5928 : }
5929 :
5930 : /** LATTICES **/
5931 :
5932 : /*
5933 : Convention: lattice = [I,t] representing t*I, where
5934 : - I integral nonsingular upper-triangular matrix representing a lattice over
5935 : the integral basis of the algebra, and
5936 : - t>0 either an integer or a rational number.
5937 :
5938 : Recommended and returned by the functions below:
5939 : - I HNF and primitive
5940 : */
5941 :
5942 : /* TODO use hnfmodid whenever possible using a*O <= I <= O
5943 : * for instance a = ZM_det_triangular(I) */
5944 :
5945 : static GEN
5946 64351 : primlat(GEN lat)
5947 : {
5948 : GEN m, t, c;
5949 64351 : m = alglat_get_primbasis(lat);
5950 64351 : t = alglat_get_scalar(lat);
5951 64351 : m = Q_primitive_part(m,&c);
5952 64351 : if (c) return mkvec2(m,gmul(t,c));
5953 54817 : return lat;
5954 : }
5955 :
5956 : /* assumes the lattice contains d * integral basis, d=0 allowed */
5957 : GEN
5958 53487 : alglathnf(GEN al, GEN m, GEN d)
5959 : {
5960 53487 : pari_sp av = avma;
5961 : long N,i,j;
5962 : GEN m2, c;
5963 53487 : if (!d) d = gen_0;
5964 53487 : checkalg(al);
5965 53487 : if (alg_type(al) == al_REAL) pari_err_TYPE("alglathnf [real algebra]", al);
5966 53480 : N = alg_get_absdim(al);
5967 53480 : if (!d) d = gen_0;
5968 53480 : if (typ(m) == t_VEC) m = matconcat(m);
5969 53480 : if (typ(m) == t_COL) m = algleftmultable(al,m);
5970 53480 : if (typ(m) != t_MAT) pari_err_TYPE("alglathnf",m);
5971 53473 : if (typ(d) != t_FRAC && typ(d) != t_INT) pari_err_TYPE("alglathnf",d);
5972 53473 : if (lg(m)-1 < N || lg(gel(m,1))-1 != N) pari_err_DIM("alglathnf");
5973 480935 : for (i=1; i<=N; i++)
5974 7185192 : for (j=1; j<lg(m); j++)
5975 6757702 : if (typ(gcoeff(m,i,j)) != t_FRAC && typ(gcoeff(m,i,j)) != t_INT)
5976 7 : pari_err_TYPE("alglathnf", gcoeff(m,i,j));
5977 53438 : m2 = Q_primitive_part(m,&c);
5978 53438 : if (!c) c = gen_1;
5979 53438 : if (!signe(d)) d = detint(m2);
5980 45593 : else d = gdiv(d,c); /* should be an integer */
5981 53438 : if (!signe(d)) pari_err_INV("alglathnf [m does not have full rank]", m2);
5982 53424 : m2 = ZM_hnfmodid(m2,d);
5983 53424 : return gc_GEN(av, mkvec2(m2,c));
5984 : }
5985 :
5986 : static GEN
5987 11683 : prepare_multipliers(GEN *a, GEN *b)
5988 : {
5989 : GEN na, nb, da, db, d;
5990 11683 : na = numer_i(*a); da = denom_i(*a);
5991 11683 : nb = numer_i(*b); db = denom_i(*b);
5992 11683 : na = mulii(na,db);
5993 11683 : nb = mulii(nb,da);
5994 11683 : d = gcdii(na,nb);
5995 11683 : *a = diviiexact(na,d);
5996 11683 : *b = diviiexact(nb,d);
5997 11683 : return gdiv(d, mulii(da,db));
5998 : }
5999 :
6000 : static GEN
6001 11683 : prepare_lat(GEN m1, GEN t1, GEN m2, GEN t2)
6002 : {
6003 11683 : GEN d = prepare_multipliers(&t1, &t2);
6004 11683 : m1 = ZM_Z_mul(m1,t1);
6005 11683 : m2 = ZM_Z_mul(m2,t2);
6006 11683 : return mkvec3(m1,m2,d);
6007 : }
6008 :
6009 : static GEN
6010 11697 : alglataddinter(GEN al, GEN lat1, GEN lat2, GEN *sum, GEN *inter)
6011 : {
6012 : GEN d, m1, m2, t1, t2, M, prep, d1, d2, ds, di, K;
6013 11697 : checkalg(al);
6014 11697 : if (alg_type(al) == al_REAL)
6015 14 : pari_err_TYPE("alglataddinter [real algebra]", al);
6016 11683 : checklat(al,lat1);
6017 11683 : checklat(al,lat2);
6018 :
6019 11683 : m1 = alglat_get_primbasis(lat1);
6020 11683 : t1 = alglat_get_scalar(lat1);
6021 11683 : m2 = alglat_get_primbasis(lat2);
6022 11683 : t2 = alglat_get_scalar(lat2);
6023 11683 : prep = prepare_lat(m1, t1, m2, t2);
6024 11683 : m1 = gel(prep,1);
6025 11683 : m2 = gel(prep,2);
6026 11683 : d = gel(prep,3);
6027 11683 : M = matconcat(mkvec2(m1,m2));
6028 11683 : d1 = ZM_det_triangular(m1);
6029 11683 : d2 = ZM_det_triangular(m2);
6030 11683 : ds = gcdii(d1,d2);
6031 11683 : if (inter)
6032 : {
6033 7616 : di = diviiexact(mulii(d1,d2),ds);
6034 7616 : if (equali1(di))
6035 : {
6036 140 : *inter = matid(lg(m1)-1);
6037 140 : if (sum) *sum = matid(lg(m1)-1);
6038 : }
6039 : else
6040 : {
6041 7476 : K = matkermod(M,di,sum);
6042 7476 : K = rowslice(K,1,lg(m1));
6043 7476 : *inter = hnfmodid(FpM_mul(m1,K,di),di);
6044 7476 : if (sum) *sum = hnfmodid(*sum,ds);
6045 : }
6046 : }
6047 4067 : else *sum = hnfmodid(M,ds);
6048 11683 : return d;
6049 : }
6050 :
6051 : GEN
6052 4109 : alglatinter(GEN al, GEN lat1, GEN lat2, GEN* psum)
6053 : {
6054 4109 : pari_sp av = avma;
6055 : GEN inter, d;
6056 4109 : d = alglataddinter(al, lat1, lat2, psum, &inter);
6057 4102 : inter = primlat(mkvec2(inter, d));
6058 4102 : if (!psum) return gc_GEN(av, inter);
6059 28 : *psum = primlat(mkvec2(*psum,d));
6060 28 : return gc_all(av, 2, &inter, psum);
6061 : }
6062 :
6063 : GEN
6064 7588 : alglatadd(GEN al, GEN lat1, GEN lat2, GEN* pinter)
6065 : {
6066 7588 : pari_sp av = avma;
6067 : GEN sum, d;
6068 7588 : d = alglataddinter(al, lat1, lat2, &sum, pinter);
6069 7581 : sum = primlat(mkvec2(sum, d));
6070 7581 : if (!pinter) return gc_GEN(av, sum);
6071 3514 : *pinter = primlat(mkvec2(*pinter,d));
6072 3514 : return gc_all(av, 2, &sum, pinter);
6073 : }
6074 :
6075 : /* TODO version that returns the quotient as abelian group? */
6076 : /* return matrices to convert coordinates from one to other? */
6077 : int
6078 33495 : alglatsubset(GEN al, GEN lat1, GEN lat2, GEN* pindex)
6079 : {
6080 33495 : pari_sp av = avma;
6081 : int res;
6082 : GEN m1, m2, m2i, m, t;
6083 33495 : checkalg(al);
6084 33495 : if (alg_type(al) == al_REAL) pari_err_TYPE("alglatsubset [real algebra]", al);
6085 33488 : checklat(al,lat1);
6086 33488 : checklat(al,lat2);
6087 33488 : m1 = alglat_get_primbasis(lat1);
6088 33488 : m2 = alglat_get_primbasis(lat2);
6089 33488 : m2i = RgM_inv_upper(m2);
6090 33488 : t = gdiv(alglat_get_scalar(lat1), alglat_get_scalar(lat2));
6091 33488 : m = RgM_Rg_mul(RgM_mul(m2i,m1), t);
6092 33488 : res = RgM_is_ZM(m);
6093 33488 : if (!res || !pindex) return gc_int(av, res);
6094 1757 : *pindex = gc_INT(av, mpabs(ZM_det_triangular(m)));
6095 1757 : return 1;
6096 : }
6097 :
6098 : GEN
6099 5271 : alglatindex(GEN al, GEN lat1, GEN lat2)
6100 : {
6101 5271 : pari_sp av = avma;
6102 : long N;
6103 : GEN res;
6104 5271 : checkalg(al);
6105 5271 : if (alg_type(al) == al_REAL) pari_err_TYPE("alglatindex [real algebra]", al);
6106 5264 : checklat(al,lat1);
6107 5264 : checklat(al,lat2);
6108 5264 : N = alg_get_absdim(al);
6109 5264 : res = alglat_get_scalar(lat1);
6110 5264 : res = gdiv(res, alglat_get_scalar(lat2));
6111 5264 : res = gpowgs(res, N);
6112 5264 : res = gmul(res,RgM_det_triangular(alglat_get_primbasis(lat1)));
6113 5264 : res = gdiv(res, RgM_det_triangular(alglat_get_primbasis(lat2)));
6114 5264 : res = gabs(res,0);
6115 5264 : return gc_GEN(av, res);
6116 : }
6117 :
6118 : GEN
6119 45612 : alglatmul(GEN al, GEN lat1, GEN lat2)
6120 : {
6121 45612 : pari_sp av = avma;
6122 : long N,i;
6123 : GEN m1, m2, m, V, lat, t, d, dp;
6124 45612 : checkalg(al);
6125 45612 : if (alg_type(al) == al_REAL) pari_err_TYPE("alglatmul [real algebra]", al);
6126 45605 : if (typ(lat1)==t_COL)
6127 : {
6128 19292 : if (typ(lat2)==t_COL)
6129 7 : pari_err_TYPE("alglatmul [one of lat1, lat2 has to be a lattice]", lat2);
6130 19285 : checklat(al,lat2);
6131 19285 : lat1 = Q_remove_denom(lat1,&d);
6132 19285 : m = algbasismultable(al,lat1);
6133 19285 : m2 = alglat_get_primbasis(lat2);
6134 19285 : dp = mulii(detint(m),ZM_det_triangular(m2));
6135 19285 : m = ZM_mul(m,m2);
6136 19285 : t = alglat_get_scalar(lat2);
6137 19285 : if (d) t = gdiv(t,d);
6138 : }
6139 : else /* typ(lat1)!=t_COL */
6140 : {
6141 26313 : checklat(al,lat1);
6142 26313 : if (typ(lat2)==t_COL)
6143 : {
6144 19285 : lat2 = Q_remove_denom(lat2,&d);
6145 19285 : m = algbasisrightmultable(al,lat2);
6146 19285 : m1 = alglat_get_primbasis(lat1);
6147 19285 : dp = mulii(detint(m),ZM_det_triangular(m1));
6148 19285 : m = ZM_mul(m,m1);
6149 19285 : t = alglat_get_scalar(lat1);
6150 19285 : if (d) t = gdiv(t,d);
6151 : }
6152 : else /* typ(lat2)!=t_COL */
6153 : {
6154 7028 : checklat(al,lat2);
6155 7021 : N = alg_get_absdim(al);
6156 7021 : m1 = alglat_get_primbasis(lat1);
6157 7021 : m2 = alglat_get_primbasis(lat2);
6158 7021 : dp = mulii(ZM_det_triangular(m1), ZM_det_triangular(m2));
6159 7021 : V = cgetg(N+1,t_VEC);
6160 63189 : for (i=1; i<=N; i++) {
6161 56168 : gel(V,i) = algbasismultable(al,gel(m1,i));
6162 56168 : gel(V,i) = ZM_mul(gel(V,i),m2);
6163 : }
6164 7021 : m = matconcat(V);
6165 7021 : t = gmul(alglat_get_scalar(lat1), alglat_get_scalar(lat2));
6166 : }
6167 : }
6168 :
6169 45591 : lat = alglathnf(al,m,dp);
6170 45591 : gel(lat,2) = gmul(alglat_get_scalar(lat), t);
6171 45591 : lat = primlat(lat);
6172 45591 : return gc_GEN(av, lat);
6173 : }
6174 :
6175 : int
6176 17528 : alglatcontains(GEN al, GEN lat, GEN x, GEN *ptc)
6177 : {
6178 17528 : pari_sp av = avma;
6179 : GEN m, t, sol;
6180 17528 : checkalg(al);
6181 17528 : if (alg_type(al) == al_REAL)
6182 7 : pari_err_TYPE("alglatcontains [real algebra]", al);
6183 17521 : checklat(al,lat);
6184 17521 : m = alglat_get_primbasis(lat);
6185 17521 : t = alglat_get_scalar(lat);
6186 17521 : x = RgC_Rg_div(x,t);
6187 17521 : if (!RgV_is_ZV(x)) return gc_bool(av,0);
6188 17521 : sol = hnf_solve(m,x);
6189 17521 : if (!sol) return gc_bool(av,0);
6190 8771 : if (!ptc) return gc_bool(av,1);
6191 8764 : *ptc = gc_GEN(av, sol); return 1;
6192 : }
6193 :
6194 : GEN
6195 8778 : alglatelement(GEN al, GEN lat, GEN c)
6196 : {
6197 8778 : pari_sp av = avma;
6198 : GEN res;
6199 8778 : checkalg(al);
6200 8778 : if (alg_type(al) == al_REAL)
6201 7 : pari_err_TYPE("alglatelement [real algebra]", al);
6202 8771 : checklat(al,lat);
6203 8771 : if (typ(c)!=t_COL) pari_err_TYPE("alglatelement", c);
6204 8764 : res = ZM_ZC_mul(alglat_get_primbasis(lat),c);
6205 8764 : res = RgC_Rg_mul(res, alglat_get_scalar(lat));
6206 8764 : return gc_GEN(av,res);
6207 : }
6208 :
6209 : /* idem QM_invimZ, knowing result is contained in 1/c*Z^n */
6210 : static GEN
6211 3535 : QM_invimZ_mod(GEN m, GEN c)
6212 : {
6213 : GEN d, m0, K;
6214 3535 : m0 = Q_remove_denom(m, &d);
6215 3535 : if (d) d = mulii(d,c);
6216 35 : else d = c;
6217 3535 : K = matkermod(m0, d, NULL);
6218 3535 : if (lg(K)==1) K = scalarmat(d, lg(m)-1);
6219 3493 : else K = hnfmodid(K, d);
6220 3535 : return RgM_Rg_div(K,c);
6221 : }
6222 :
6223 : /* If m is injective, computes a Z-basis of the submodule of elements whose
6224 : * image under m is integral */
6225 : static GEN
6226 14 : QM_invimZ(GEN m)
6227 : {
6228 14 : return RgM_invimage(m, QM_ImQ_hnf(m));
6229 : }
6230 :
6231 : /* An isomorphism of R-modules M_{m,n}(R) -> R^{m*n} */
6232 : static GEN
6233 28322 : mat2col(GEN M, long m, long n)
6234 : {
6235 : long i,j,k,p;
6236 : GEN C;
6237 28322 : p = m*n;
6238 28322 : C = cgetg(p+1,t_COL);
6239 254702 : for (i=1,k=1;i<=m;i++)
6240 2036804 : for (j=1;j<=n;j++,k++)
6241 1810424 : gel(C,k) = gcoeff(M,i,j);
6242 28322 : return C;
6243 : }
6244 :
6245 : static GEN
6246 3535 : alglattransporter_i(GEN al, GEN lat1, GEN lat2, long right)
6247 : {
6248 : GEN m1, m2, m2i, M, MT, mt, t1, t2, T, c;
6249 : long N, i;
6250 3535 : N = alg_get_absdim(al);
6251 3535 : m1 = alglat_get_primbasis(lat1);
6252 3535 : m2 = alglat_get_primbasis(lat2);
6253 3535 : m2i = RgM_inv_upper(m2);
6254 3535 : c = detint(m1);
6255 3535 : t1 = alglat_get_scalar(lat1);
6256 3535 : m1 = RgM_Rg_mul(m1,t1);
6257 3535 : t2 = alglat_get_scalar(lat2);
6258 3535 : m2i = RgM_Rg_div(m2i,t2);
6259 :
6260 3535 : MT = right? NULL: alg_get_multable(al);
6261 3535 : M = cgetg(N+1, t_MAT);
6262 31815 : for (i=1; i<=N; i++) {
6263 28280 : if (right) mt = algbasisrightmultable(al, vec_ei(N,i));
6264 14168 : else mt = gel(MT,i);
6265 28280 : mt = RgM_mul(m2i,mt);
6266 28280 : mt = RgM_mul(mt,m1);
6267 28280 : gel(M,i) = mat2col(mt, N, N);
6268 : }
6269 :
6270 3535 : c = gdiv(t2,gmul(c,t1));
6271 3535 : c = denom_i(c);
6272 3535 : T = QM_invimZ_mod(M,c);
6273 3535 : return primlat(mkvec2(T,gen_1));
6274 : }
6275 :
6276 : /*
6277 : { x in al | x*lat1 subset lat2}
6278 : */
6279 : GEN
6280 1778 : alglatlefttransporter(GEN al, GEN lat1, GEN lat2)
6281 : {
6282 1778 : pari_sp av = avma;
6283 1778 : checkalg(al);
6284 1778 : if (alg_type(al) == al_REAL)
6285 7 : pari_err_TYPE("alglatlefttransporter [real algebra]", al);
6286 1771 : checklat(al,lat1);
6287 1771 : checklat(al,lat2);
6288 1771 : return gc_GEN(av, alglattransporter_i(al,lat1,lat2,0));
6289 : }
6290 :
6291 : /*
6292 : { x in al | lat1*x subset lat2}
6293 : */
6294 : GEN
6295 1771 : alglatrighttransporter(GEN al, GEN lat1, GEN lat2)
6296 : {
6297 1771 : pari_sp av = avma;
6298 1771 : checkalg(al);
6299 1771 : if (alg_type(al) == al_REAL)
6300 7 : pari_err_TYPE("alglatrighttransporter [real algebra]", al);
6301 1764 : checklat(al,lat1);
6302 1764 : checklat(al,lat2);
6303 1764 : return gc_GEN(av, alglattransporter_i(al,lat1,lat2,1));
6304 : }
6305 :
6306 : GEN
6307 42 : algmakeintegral(GEN mt0, long maps)
6308 : {
6309 42 : pari_sp av = avma;
6310 : long n,i;
6311 : GEN m,P,Pi,mt2,mt;
6312 42 : n = lg(mt0)-1;
6313 42 : mt = check_mt(mt0,NULL);
6314 42 : if (!mt) pari_err_TYPE("algmakeintegral", mt0);
6315 21 : if (isint1(Q_denom(mt0))) {
6316 7 : if (maps) mt = mkvec3(mt,matid(n),matid(n));
6317 7 : return gc_GEN(av,mt);
6318 : }
6319 14 : dbg_printf(2)(" algmakeintegral: dim=%d, denom=%Ps\n", n, Q_denom(mt0));
6320 14 : m = cgetg(n+1,t_MAT);
6321 56 : for (i=1;i<=n;i++)
6322 42 : gel(m,i) = mat2col(gel(mt,i),n,n);
6323 14 : dbg_printf(2)(" computing order, dims m = %d x %d...\n", nbrows(m), lg(m)-1);
6324 14 : P = QM_invimZ(m);
6325 14 : dbg_printf(2)(" ...done.\n");
6326 14 : P = shallowmatconcat(mkvec2(col_ei(n,1),P));
6327 14 : P = hnf(P);
6328 14 : Pi = RgM_inv(P);
6329 14 : mt2 = change_Rgmultable(mt,P,Pi);
6330 14 : if (maps) mt2 = mkvec3(mt2,Pi,P); /* mt2, mt->mt2, mt2->mt */
6331 14 : return gc_GEN(av,mt2);
6332 : }
6333 :
6334 : /** ORDERS **/
6335 :
6336 : /*
6337 : * algmodpr data:
6338 : * 1. pr
6339 : * 2. Vecsmall([k,m]) s.t. target is M_k(F_p^m). /!\ m can differ from pr.f
6340 : * 3. t_FFELT 1 representing the finite field F_q
6341 : * 4. proj: O -> M_k(F_q)
6342 : * 5. lift: M_k(F_q) -> O
6343 : * 6. tau: anti uniformizer (left multiplication matrix)
6344 : * 7. T s.t. F_q = F_p[x]/T
6345 : */
6346 : GEN
6347 2793 : algmodprinit(GEN al, GEN pr, long v)
6348 : {
6349 2793 : pari_sp av = avma;
6350 : GEN p, alp, g, Q, pro, lif, map, mapi, alpr, spl, data, nf, T, J, tau;
6351 : long tal, k, m;
6352 2793 : checkalg(al); checkprid(pr);
6353 2779 : tal = alg_type(al);
6354 2779 : if (tal!=al_CYCLIC && tal!=al_CSA)
6355 21 : pari_err_TYPE("algmodprinit [use alginit]", al);
6356 2758 : nf = alg_get_center(al);
6357 2758 : p = pr_get_p(pr);
6358 2758 : alp = alg_ordermodp(al, p);
6359 2758 : g = algeltfromnf_i(al, pr_get_gen(pr));
6360 2758 : g = algbasismultable(alp, g);
6361 2758 : g = FpM_image(g, p);
6362 2758 : alpr = alg_quotient(alp, g, 1);
6363 2758 : Q = gel(alpr, 1);
6364 2758 : pro = gel(alpr, 2);
6365 2758 : lif = gel(alpr, 3);
6366 2758 : J = algradical(Q); /* could skip if we knew the order is maximal at unramified pr */
6367 2758 : if (!gequal0(J))
6368 : {
6369 21 : Q = alg_quotient(Q, J, 1);
6370 21 : pro = ZM_mul(gel(Q,2), pro);
6371 21 : lif = ZM_mul(lif, gel(Q,3));
6372 21 : Q = gel(Q,1);
6373 : }
6374 2758 : spl = alg_finite_csa_split(Q, v);
6375 2758 : T = gel(spl, 1); /* t_POL, possibly of degree 1 */
6376 2758 : mapi = gel(spl, 3);
6377 2758 : map = gel(spl, 4);
6378 2758 : tau = pr_anti_uniformizer(nf, pr);
6379 2758 : m = degpol(T);
6380 2758 : k = lg(gmael(spl,2,1)) - 1;
6381 2758 : if (typ(tau) != t_INT) tau = algbasismultable(al,algeltfromnf_i(al,tau));
6382 2758 : data = mkvecn(7,
6383 : pr,
6384 : mkvecsmall2(k, m),
6385 : Tp_to_FF(T,p),
6386 : FpM_mul(map, pro, p),
6387 : FpM_mul(lif, mapi, p),
6388 : tau,
6389 : T
6390 : );
6391 2758 : return gc_GEN(av, data);
6392 : }
6393 :
6394 : static int
6395 2135 : checkalgmodpr_i(GEN data)
6396 : {
6397 : GEN compo;
6398 2135 : if (typ(data)!=t_VEC || lg(data)!=8) return 0;
6399 2121 : checkprid(gel(data,1));
6400 2114 : compo = gel(data,2);
6401 2114 : if (typ(compo)!=t_VECSMALL || lg(compo)!=3) return 0;
6402 2107 : if (typ(gel(data,3))!=t_FFELT) return 0;
6403 2100 : if (typ(gel(data,4))!=t_MAT) return 0;
6404 2093 : if (typ(gel(data,5))!=t_MAT) return 0;
6405 2086 : compo = gel(data,6);
6406 2086 : if (typ(compo)!=t_MAT && (typ(compo)!=t_INT || !equali1(compo))) return 0;
6407 2079 : if (typ(gel(data,7))!=t_POL) return 0;
6408 2072 : return 1;
6409 : }
6410 : static void
6411 2135 : checkalgmodpr(GEN data)
6412 : {
6413 2135 : if(!checkalgmodpr_i(data))
6414 56 : pari_err_TYPE("checkalgmodpr [use algmodprinit()]", data);
6415 2072 : }
6416 :
6417 : /* x belongs to the stored order of al, no GC */
6418 : static GEN
6419 1708 : algmodpr_integral(GEN x, GEN data, long reduce)
6420 : {
6421 : GEN res, T, p;
6422 1708 : long k, m, v = -1;
6423 1708 : T = algmodpr_get_T(data);
6424 1708 : if (T) v = varn(T);
6425 1708 : p = algmodpr_get_p(data);
6426 1708 : k = algmodpr_get_k(data);
6427 1708 : m = algmodpr_get_m(data);
6428 1708 : res = ZM_ZC_mul(algmodpr_get_proj(data), x);
6429 1708 : res = RgC_col2mat(res, k, m, v);
6430 1708 : return reduce? FqM_red(res, T, p) : res;
6431 : }
6432 :
6433 : /* x in basis form */
6434 : static GEN
6435 1729 : algmodpr_i(GEN x, GEN data)
6436 : {
6437 : GEN T, p, res, den, tau;
6438 : long v, i, j;
6439 1729 : x = Q_remove_denom(x, &den);
6440 1729 : T = algmodpr_get_T(data);
6441 1729 : p = algmodpr_get_p(data);
6442 1729 : tau = algmodpr_get_tau(data);
6443 1729 : if (den)
6444 : {
6445 35 : v = Z_pvalrem(den, p, &den);
6446 35 : if (v && typ(tau)!=t_INT)
6447 : {
6448 : /* TODO not always better to exponentiate the matrix */
6449 21 : x = ZM_ZC_mul(ZM_powu(tau, v), x);
6450 21 : v -= ZV_pvalrem(x, p, &x);
6451 : }
6452 35 : if (v>0) pari_err_INV("algmodpr", mkintmod(gen_0,p));
6453 21 : if (v<0)
6454 : {
6455 7 : long k = algmodpr_get_k(data);
6456 7 : return zeromatcopy(k,k);
6457 : }
6458 14 : if (equali1(den)) den = NULL;
6459 : }
6460 1708 : res = algmodpr_integral(x, data, 0);
6461 1708 : if (den)
6462 : {
6463 7 : GEN d = Fp_inv(den, p);
6464 21 : for (j=1; j<lg(res); j++)
6465 42 : for (i=1; i<lg(res); i++)
6466 28 : gcoeff(res,i,j) = Fq_Fp_mul(gcoeff(res,i,j), d, T, p);
6467 : }
6468 1701 : else res = FqM_red(res, T, p);
6469 1708 : return res;
6470 : }
6471 :
6472 : static GEN
6473 28 : algmodpr_mat(GEN al, GEN x, GEN data)
6474 : {
6475 : GEN res, cx, c;
6476 : long i, j;
6477 28 : res = cgetg(lg(x),t_MAT);
6478 133 : for (j=1; j<lg(x); j++)
6479 : {
6480 105 : cx = gel(x,j);
6481 105 : c = cgetg(lg(cx), t_COL);
6482 525 : for (i=1; i<lg(cx); i++) gel(c,i) = algmodpr(al, gel(cx,i), data);
6483 105 : gel(res, j) = c;
6484 : }
6485 28 : return shallowmatconcat(res);
6486 : }
6487 :
6488 : GEN
6489 1841 : algmodpr(GEN al, GEN x, GEN data)
6490 : {
6491 1841 : pari_sp av = avma;
6492 : GEN res, ff;
6493 1841 : checkalgmodpr(data);
6494 1785 : if (typ(x) == t_MAT) return gc_GEN(av, algmodpr_mat(al,x,data));
6495 1757 : x = algalgtobasis(al, x);
6496 1729 : res = algmodpr_i(x, data);
6497 1715 : ff = algmodpr_get_ff(data);
6498 1715 : return gc_GEN(av, FqM_to_FFM(res,ff));
6499 : }
6500 :
6501 : static GEN
6502 511 : algmodprlift_i(GEN x, GEN data)
6503 : {
6504 511 : GEN lift, C, p, c, T = NULL;
6505 : long i, j, k, m;
6506 511 : lift = algmodpr_get_lift(data);
6507 511 : p = algmodpr_get_p(data);
6508 511 : k = algmodpr_get_k(data);
6509 511 : m = algmodpr_get_m(data); /* M_k(F_p^m) */
6510 511 : if (m > 1) T = algmodpr_get_T(data);
6511 511 : x = gcopy(x);
6512 1561 : for (i=1; i<=k; i++)
6513 3689 : for (j=1; j<=k; j++)
6514 : {
6515 2639 : c = gcoeff(x,i,j);
6516 2639 : if (typ(c) == t_FFELT) gcoeff(x,i,j) = FF_to_FpXQ(c);
6517 119 : else if (m == 1) gcoeff(x,i,j) = scalarpol(Rg_to_Fp(c,p), -1);
6518 91 : else gcoeff(x,i,j) = Rg_to_FpXQ(c, T, p);
6519 : }
6520 504 : C = RgM_mat2col(x, k, m);
6521 504 : return FpM_FpC_mul(lift, C, p);
6522 : }
6523 :
6524 : GEN
6525 301 : algmodprlift(GEN al, GEN x, GEN data)
6526 : {
6527 301 : pari_sp av = avma;
6528 : GEN res, blk;
6529 : long k, nc, nr, i, j;
6530 301 : checkalg(al);
6531 294 : checkalgmodpr(data);
6532 287 : k = algmodpr_get_k(data); /* M_k(F_p^m) */
6533 287 : if (typ(x) != t_MAT) pari_err_TYPE("algmodprlift [matrix x]",x);
6534 280 : if ((lg(x)-1)%k) pari_err_DIM("algmodprlift [matrix x, nb cols]");
6535 273 : nc = (lg(x)-1)/k;
6536 273 : if (!nc) return gc_upto(av, zeromat(0,0));
6537 266 : if ((lgcols(x)-1)%k) pari_err_DIM("algmodprlift [matrix x, nb rows]");
6538 259 : nr = nbrows(x)/k;
6539 259 : if (nr==1 && nc==1) res = algmodprlift_i(x, data);
6540 : else
6541 : {
6542 28 : res = zeromatcopy(nr, nc);
6543 119 : for (i=1; i<=nr; i++)
6544 371 : for(j=1; j<=nc; j++)
6545 : {
6546 280 : blk = matslice(x, (i-1)*k+1, i*k, (j-1)*k+1, j*k);
6547 280 : gcoeff(res,i,j) = algmodprlift_i(blk, data);
6548 : }
6549 : }
6550 252 : return gc_GEN(av, res);
6551 : }
6552 :
6553 : /* e in al such that e mod pr is a non-invertible idempotent of maximal rank */
6554 : static GEN
6555 2499 : eichleridempotent(GEN al, GEN pr)
6556 : {
6557 : long i, k, n, nk, j;
6558 : GEN data, mapi, e;
6559 2499 : data = algmodprinit(al, pr, -1);
6560 2492 : mapi = algmodpr_get_lift(data);
6561 2492 : k = algmodpr_get_k(data);
6562 2492 : n = pr_get_f(pr);
6563 2492 : nk = n*(k+1);
6564 2492 : if (k==1) return zerocol(alg_get_absdim(al));
6565 1820 : e = gel(mapi,1+nk);
6566 2681 : for (i = 2, j = 1+2*nk; i < k; i++, j += nk) e = ZC_add(e,gel(mapi,j));
6567 1820 : return e;
6568 : }
6569 :
6570 : static GEN
6571 2492 : mat_algeltfromnf(GEN al, GEN x)
6572 : {
6573 6244 : pari_APPLY_type(t_MAT, algeltfromnf_i(al, gel(x,i)));
6574 : }
6575 : static GEN
6576 2499 : eichlerprimepower_i(GEN al, GEN pr, long m, GEN prm)
6577 : {
6578 : GEN p, e, polidem, Me, Mzk, nf, Mprm;
6579 : long ep, i;
6580 : ulong mask;
6581 2499 : polidem = mkpoln(4, gen_m2, utoi(3), gen_0, gen_0);
6582 2499 : p = pr_get_p(pr); ep = pr_get_e(pr);
6583 2499 : e = eichleridempotent(al, pr); /* ZC */
6584 2492 : mask = quadratic_prec_mask(m);
6585 2492 : i = 1;
6586 6769 : while (mask > 1)
6587 : {
6588 4277 : i *=2;
6589 4277 : if (mask & 1UL) i--;
6590 4277 : mask >>= 1;
6591 4277 : e = algpoleval(al, polidem, e);
6592 4277 : e = FpC_red(e, powiu(p,(i+ep-1)/ep));
6593 : }
6594 2492 : Me = algbasisrightmultable(al, e);
6595 2492 : nf = algcenter(al);
6596 2492 : Mzk = mat_algeltfromnf(al, nf_get_zk(nf));
6597 2492 : prm = idealtwoelt(nf, prm);
6598 2492 : Mprm = algbasismultable(al, algeltfromnf_i(al,gel(prm,2)));
6599 2492 : return hnfmodid(shallowmatconcat(mkvec3(Me,Mzk,Mprm)), gel(prm,1));
6600 : }
6601 : static GEN
6602 546 : eichlerprimepower(GEN al, GEN pr, long m, GEN prm)
6603 : {
6604 546 : pari_sp av = avma;
6605 546 : return gc_upto(av, eichlerprimepower_i(al, pr, m, prm));
6606 : }
6607 :
6608 : GEN
6609 2100 : algeichlerbasis(GEN al, GEN N)
6610 : {
6611 2100 : pari_sp av = avma;
6612 2100 : GEN nf, faN, LH = NULL, Cpr = NULL, Cm = NULL, Lpp, M, H, pp, LH2;
6613 : long k, n, ih, lh, np;
6614 :
6615 2100 : checkalg(al);
6616 2093 : nf = alg_get_center(al);
6617 2086 : if (checkprid_i(N)) return eichlerprimepower(al,N,1,N);
6618 2065 : if (is_nf_factor(N))
6619 : {
6620 2037 : faN = sort_factor(shallowcopy(N), (void*)&cmp_prime_ideal, &cmp_nodata);
6621 2037 : N = factorbackprime(nf, gel(faN,1), gel(faN,2));
6622 : }
6623 28 : else faN = idealfactor(nf, N);
6624 2051 : n = nbrows(faN);
6625 2051 : if (!n) { set_avma(av); return matid(alg_get_absdim(al)); }
6626 2044 : if (n==1)
6627 : {
6628 1953 : GEN pr = gcoeff(faN,1,1), mZ = gcoeff(faN,1,2);
6629 1953 : long m = itos(mZ);
6630 1953 : return gc_upto(av, eichlerprimepower_i(al, pr, m, N));
6631 : }
6632 :
6633 : /* collect prime power Eichler orders */
6634 91 : Lpp = cgetg(n+1,t_VEC);
6635 91 : LH2 = cgetg(n+1, t_VEC);
6636 91 : np = 0;
6637 91 : ih = 1;
6638 91 : lh = 1;
6639 616 : for (k = 1; k <= n; k++)
6640 : {
6641 525 : GEN pr = gcoeff(faN,k,1), mZ = gcoeff(faN,k,2), prm;
6642 525 : long m = itos(mZ);
6643 :
6644 525 : if (ih == lh) /* done with previous p, prepare next */
6645 : {
6646 462 : GEN p = pr_get_p(pr);
6647 462 : long k2 = k + 1;
6648 462 : np++;
6649 462 : gel(Lpp,np) = gen_0;
6650 462 : lh = 2;
6651 : /* count the pr|p in faN */
6652 525 : while (k2<=n && equalii(p,pr_get_p(gcoeff(faN,k2,1)))) { lh++; k2++; }
6653 462 : LH = cgetg(lh, t_VEC);
6654 462 : Cpr = cgetg(lh, t_COL);
6655 462 : Cm = cgetg(lh, t_COL);
6656 462 : ih = 1;
6657 : }
6658 525 : prm = idealpow(nf, pr, mZ);
6659 525 : H = eichlerprimepower(al, pr, m, prm);
6660 525 : pp = gcoeff(prm,1,1);
6661 525 : if (cmpii(pp,gel(Lpp,np)) > 0) gel(Lpp,np) = pp;
6662 525 : gel(LH,ih) = H;
6663 525 : gel(Cpr,ih) = pr;
6664 525 : gel(Cm,ih) = mZ;
6665 525 : ih++;
6666 :
6667 525 : if (ih == lh) /* done with this p */
6668 : {
6669 462 : if (lh == 2) gel(LH2,np) = gel(LH,1);
6670 : else
6671 : { /* put together the pr|p */
6672 63 : GEN U = gmael(idealchineseinit(nf, mkmat2(Cpr,Cm)),1,2);
6673 : long i;
6674 189 : for (i = 1; i < lh; i++)
6675 : {
6676 126 : GEN e = algeltfromnf_i(al, gel(U,i));
6677 126 : e = algbasismultable(al, e);
6678 126 : gel(LH,i) = ZM_mul(e, gel(LH,i));
6679 : }
6680 63 : gel(LH2,np) = hnfmodid(shallowmatconcat(LH), gel(Lpp,np));
6681 : }
6682 : }
6683 : }
6684 91 : if (np == 1) return gc_GEN(av, gel(LH2,1));
6685 : /* put together all p */
6686 84 : setlg(Lpp,np+1);
6687 84 : setlg(LH2,np+1);
6688 84 : H = nmV_chinese_center(LH2, Lpp, &M);
6689 84 : return gc_upto(av, hnfmodid(H, M));
6690 : }
6691 :
6692 : /** IDEALS **/
|
