Line data Source code
1 : /* Copyright (C) 2000-2003 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 :
15 : #include "pari.h"
16 : #include "paripriv.h"
17 :
18 : /*************************************************************************/
19 : /** **/
20 : /** Routines for handling VEC/COL **/
21 : /** **/
22 : /*************************************************************************/
23 : int
24 1584 : vec_isconst(GEN v)
25 : {
26 1584 : long i, l = lg(v);
27 : GEN w;
28 1584 : if (l==1) return 1;
29 1584 : w = gel(v,1);
30 5442 : for(i=2; i<l; i++)
31 4944 : if (!gequal(gel(v,i), w)) return 0;
32 498 : return 1;
33 : }
34 :
35 : int
36 14906 : vecsmall_isconst(GEN v)
37 : {
38 14906 : long i, l = lg(v);
39 : ulong w;
40 14906 : if (l==1) return 1;
41 14906 : w = uel(v,1);
42 25768 : for(i=2; i<l; i++)
43 20673 : if (uel(v,i) != w) return 0;
44 5095 : return 1;
45 : }
46 :
47 : /* Check if all the elements of v are different.
48 : * Use a quadratic algorithm. Could be done in n*log(n) by sorting. */
49 : int
50 0 : vec_is1to1(GEN v)
51 : {
52 0 : long i, j, l = lg(v);
53 0 : for (i=1; i<l; i++)
54 : {
55 0 : GEN w = gel(v,i);
56 0 : for(j=i+1; j<l; j++)
57 0 : if (gequal(gel(v,j), w)) return 0;
58 : }
59 0 : return 1;
60 : }
61 :
62 : GEN
63 70060 : vec_insert(GEN v, long n, GEN x)
64 : {
65 70060 : long i, l=lg(v);
66 70060 : GEN V = cgetg(l+1,t_VEC);
67 508100 : for(i=1; i<n; i++) gel(V,i) = gel(v,i);
68 70060 : gel(V,n) = x;
69 336890 : for(i=n+1; i<=l; i++) gel(V,i) = gel(v,i-1);
70 70060 : return V;
71 : }
72 : /*************************************************************************/
73 : /** **/
74 : /** Routines for handling VECSMALL **/
75 : /** **/
76 : /*************************************************************************/
77 : /* Sort v[0]...v[n-1] and put result in w[0]...w[n-1].
78 : * We accept v==w. w must be allocated. */
79 : static void
80 76470752 : vecsmall_sortspec(GEN v, long n, GEN w)
81 : {
82 76470752 : pari_sp ltop=avma;
83 76470752 : long nx=n>>1, ny=n-nx;
84 : long m, ix, iy;
85 : GEN x, y;
86 76470752 : if (n<=2)
87 : {
88 43032947 : if (n==1)
89 9274468 : w[0]=v[0];
90 33758479 : else if (n==2)
91 : {
92 33758479 : long v0=v[0], v1=v[1];
93 33758479 : if (v0<=v1) { w[0]=v0; w[1]=v1; }
94 2248443 : else { w[0]=v1; w[1]=v0; }
95 : }
96 43032947 : return;
97 : }
98 33437805 : x=new_chunk(nx); y=new_chunk(ny);
99 33437805 : vecsmall_sortspec(v,nx,x);
100 33437805 : vecsmall_sortspec(v+nx,ny,y);
101 147425011 : for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
102 113987206 : if (x[ix]<=y[iy])
103 96166815 : w[m++]=x[ix++];
104 : else
105 17820391 : w[m++]=y[iy++];
106 35060175 : for(;ix<nx;) w[m++]=x[ix++];
107 124842762 : for(;iy<ny;) w[m++]=y[iy++];
108 33437805 : set_avma(ltop);
109 : }
110 :
111 : static long
112 13279109 : vecsmall_sort_max(GEN v)
113 : {
114 13279109 : long i, l = lg(v), max = -1;
115 50321629 : for (i = 1; i < l; i++)
116 48639910 : if (v[i] > max) { max = v[i]; if (max >= l) return -1; }
117 14473451 : else if (v[i] < 0) return -1;
118 1681719 : return max;
119 : }
120 : /* assume 0 <= v[i] <= M. In place. */
121 : void
122 1657736 : vecsmall_counting_sort(GEN v, long M)
123 : {
124 : pari_sp av;
125 : long i, j, k, l;
126 : GEN T;
127 1657736 : if (M == 0) return;
128 1657736 : av = avma; T = new_chunk(M + 1); l = lg(v);
129 8033976 : for (i = 0; i <= M; i++) T[i] = 0;
130 6425867 : for (i = 1; i < l; i++) T[v[i]]++; /* T[j] is # keys = j */
131 8033976 : for (j = 0, k = 1; j <= M; j++)
132 11144371 : for (i = 1; i <= T[j]; i++) v[k++] = j;
133 1657736 : set_avma(av);
134 : }
135 : /* not GC-clean, suitable for gc_upto */
136 : GEN
137 13853 : vecsmall_counting_uniq(GEN v, long M)
138 : {
139 13853 : long i, k, l = lg(v);
140 : GEN T, U;
141 13853 : if (l == 1) return cgetg(1, t_VECSMALL);
142 13853 : if (M == 0) return mkvecsmall(0);
143 13853 : if (l == 2) return leafcopy(v);
144 13740 : U = new_chunk(M + 2);
145 13740 : T = U+1; /* allows to rewrite result over T also if T[0] = 1 */
146 106751 : for (i = 0; i <= M; i++) T[i] = 0;
147 173161 : for (i = 1; i < l; i++) T[v[i]] = 1;
148 106751 : for (i = 0, k = 1; i <= M; i++)
149 93011 : if (T[i]) U[k++] = i;
150 13740 : U[0] = evaltyp(t_VECSMALL) | _evallg(k); return U;
151 : }
152 : GEN
153 10130 : vecsmall_counting_indexsort(GEN v, long M)
154 : {
155 : pari_sp av;
156 10130 : long i, l = lg(v);
157 : GEN T, p;
158 10130 : if (M == 0 || l <= 2) return identity_zv(l - 1);
159 10120 : p = cgetg(l, t_VECSMALL); av = avma; T = new_chunk(M + 1);
160 45735 : for (i = 0; i <= M; i++) T[i] = 0;
161 11279939 : for (i = 1; i < l; i++) T[v[i]]++; /* T[j] is # keys = j */
162 35615 : for (i = 1; i <= M; i++) T[i] += T[i-1]; /* T[j] is # keys <= j */
163 11279939 : for (i = l-1; i > 0; i--) { p[T[v[i]]] = i; T[v[i]]--; }
164 10120 : return gc_const(av, p);
165 : }
166 :
167 : /* in place sort */
168 : void
169 16488107 : vecsmall_sort(GEN v)
170 : {
171 16488107 : long n = lg(v) - 1, max;
172 16488107 : if (n <= 1) return;
173 11252878 : if ((max = vecsmall_sort_max(v)) >= 0)
174 1657736 : vecsmall_counting_sort(v, max);
175 : else
176 9595142 : vecsmall_sortspec(v+1, n, v+1);
177 : }
178 :
179 : /* cf gen_sortspec */
180 : static GEN
181 6628848 : vecsmall_indexsortspec(GEN v, long n)
182 : {
183 : long nx, ny, m, ix, iy;
184 : GEN x, y, w;
185 6628848 : switch(n)
186 : {
187 119927 : case 1: return mkvecsmall(1);
188 3027382 : case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
189 1168095 : case 3:
190 1168095 : if (v[1] <= v[2]) {
191 570873 : if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
192 169620 : return (v[1] <= v[3])? mkvecsmall3(1,3,2)
193 506485 : : mkvecsmall3(3,1,2);
194 : } else {
195 597222 : if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
196 220842 : return (v[2] <= v[3])? mkvecsmall3(2,3,1)
197 672915 : : mkvecsmall3(3,2,1);
198 : }
199 : }
200 2313444 : nx = n>>1; ny = n-nx;
201 2313444 : w = cgetg(n+1,t_VECSMALL);
202 2313444 : x = vecsmall_indexsortspec(v,nx);
203 2313444 : y = vecsmall_indexsortspec(v+nx,ny);
204 28310690 : for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
205 25997246 : if (v[x[ix]] <= v[y[iy]+nx])
206 12626391 : w[m++] = x[ix++];
207 : else
208 13370855 : w[m++] = y[iy++]+nx;
209 4405523 : for(;ix<=nx;) w[m++] = x[ix++];
210 4463615 : for(;iy<=ny;) w[m++] = y[iy++]+nx;
211 2313444 : set_avma((pari_sp)w); return w;
212 : }
213 :
214 : /*indirect sort.*/
215 : GEN
216 2012144 : vecsmall_indexsort(GEN v)
217 : {
218 2012144 : long n = lg(v) - 1, max;
219 2012144 : if (n==0) return cgetg(1, t_VECSMALL);
220 2012090 : if ((max = vecsmall_sort_max(v)) >= 0)
221 10130 : return vecsmall_counting_indexsort(v, max);
222 : else
223 2001960 : return vecsmall_indexsortspec(v,n);
224 : }
225 :
226 : /* assume V sorted */
227 : GEN
228 26883 : vecsmall_uniq_sorted(GEN v)
229 : {
230 : long i, j, l;
231 26883 : GEN w = cgetg_copy(v, &l);
232 26883 : if (l == 1) return w;
233 26847 : w[1] = v[1];
234 29259 : for(i = j = 2; i < l; i++)
235 2412 : if (v[i] != w[j-1]) w[j++] = v[i];
236 26847 : stackdummy((pari_sp)(w + l), (pari_sp)(w + j));
237 26847 : setlg(w, j); return w;
238 : }
239 :
240 : GEN
241 14141 : vecsmall_uniq(GEN v)
242 : {
243 14141 : pari_sp av = avma;
244 : long max;
245 14141 : if ((max = vecsmall_sort_max(v)) >= 0)
246 13853 : v = vecsmall_counting_uniq(v, max);
247 : else
248 288 : { v = zv_copy(v); vecsmall_sort(v); v = vecsmall_uniq_sorted(v); }
249 14141 : return gc_leaf(av, v);
250 : }
251 :
252 : /* assume x sorted */
253 : long
254 0 : vecsmall_duplicate_sorted(GEN x)
255 : {
256 0 : long i, k, l = lg(x);
257 0 : if (l == 1) return 0;
258 0 : for (k = x[1], i = 2; i < l; k = x[i++])
259 0 : if (x[i] == k) return i;
260 0 : return 0;
261 : }
262 :
263 : long
264 16417 : vecsmall_duplicate(GEN x)
265 : {
266 16417 : pari_sp av = avma;
267 16417 : GEN p = vecsmall_indexsort(x);
268 16417 : long k, i, r = 0, l = lg(x);
269 16417 : if (l == 1) return gc_long(av, 0);
270 23075 : for (k = x[p[1]], i = 2; i < l; k = x[p[i++]])
271 6658 : if (x[p[i]] == k) { r = p[i]; break; }
272 16417 : return gc_long(av, r);
273 : }
274 :
275 : static int
276 45254 : vecsmall_is1to1spec(GEN v, long n, GEN w)
277 : {
278 45254 : pari_sp av = avma;
279 45254 : long nx = n>>1, ny = n - nx, m, ix, iy;
280 : GEN x, y;
281 45254 : if (n <= 2)
282 : {
283 27288 : if (n == 1) w[0] = v[0];
284 17845 : else if (n==2)
285 : {
286 17845 : long v0 = v[0], v1 = v[1];
287 17845 : if (v0 == v1) return 0;
288 17821 : else if (v0 < v1) { w[0] = v0; w[1] = v1; }
289 3817 : else { w[0] = v1; w[1] = v0; }
290 : }
291 27264 : return 1;
292 : }
293 17966 : x = new_chunk(nx); if (!vecsmall_is1to1spec(v, nx, x)) return 0;
294 17882 : y = new_chunk(ny); if (!vecsmall_is1to1spec(v+nx, ny, y)) return 0;
295 69476 : for (m = ix = iy = 0; ix < nx && iy < ny; )
296 51678 : if (x[ix] == y[iy]) return 0;
297 51636 : else if (x[ix] < y[iy])
298 31357 : w[m++] = x[ix++];
299 : else
300 20279 : w[m++] = y[iy++];
301 19524 : while (ix < nx) w[m++] = x[ix++];
302 44071 : while (iy < ny) w[m++] = y[iy++];
303 17798 : return gc_bool(av, 1);
304 : }
305 :
306 : int
307 9482 : vecsmall_is1to1(GEN V)
308 : {
309 9482 : pari_sp av = avma;
310 : long l;
311 9482 : GEN W = cgetg_copy(V, &l);
312 9482 : return gc_bool(av, l <= 2? 1: vecsmall_is1to1spec(V+1, l, W+1));
313 : }
314 :
315 : /*************************************************************************/
316 : /** **/
317 : /** Routines for handling vectors of VECSMALL **/
318 : /** **/
319 : /*************************************************************************/
320 :
321 : GEN
322 12 : vecvecsmall_sort(GEN x)
323 12 : { return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
324 : GEN
325 313279 : vecvecsmall_sort_shallow(GEN x)
326 313279 : { return gen_sort_shallow(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
327 :
328 : void
329 108 : vecvecsmall_sort_inplace(GEN x, GEN *perm)
330 108 : { gen_sort_inplace(x, (void*)&vecsmall_lexcmp, cmp_nodata, perm); }
331 :
332 : GEN
333 330 : vecvecsmall_sort_uniq(GEN x)
334 330 : { return gen_sort_uniq(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
335 :
336 : GEN
337 735 : vecvecsmall_indexsort(GEN x)
338 735 : { return gen_indexsort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
339 :
340 : long
341 16383280 : vecvecsmall_search(GEN x, GEN y)
342 16383280 : { return gen_search(x,y,(void*)vecsmall_prefixcmp, cmp_nodata); }
343 :
344 : /* assume x non empty */
345 : long
346 0 : vecvecsmall_max(GEN x)
347 : {
348 0 : long i, l = lg(x), m = vecsmall_max(gel(x,1));
349 0 : for (i = 2; i < l; i++)
350 : {
351 0 : long t = vecsmall_max(gel(x,i));
352 0 : if (t > m) m = t;
353 : }
354 0 : return m;
355 : }
356 :
357 : /*************************************************************************/
358 : /** **/
359 : /** Routines for handling permutations **/
360 : /** **/
361 : /*************************************************************************/
362 :
363 : /* Permutations may be given by
364 : * perm (VECSMALL): a bijection from 1...n to 1...n i-->perm[i]
365 : * cyc (VEC of VECSMALL): a product of disjoint cycles. */
366 :
367 : /* Multiply (compose) two permutations, putting the result in the second one. */
368 : static void
369 15 : perm_mul_inplace2(GEN s, GEN t)
370 : {
371 15 : long i, l = lg(s);
372 375 : for (i = 1; i < l; i++) t[i] = s[t[i]];
373 15 : }
374 :
375 : GEN
376 0 : vecperm_extendschreier(GEN C, GEN v, long n)
377 : {
378 0 : pari_sp av = avma;
379 0 : long mj, lv = lg(v), m = 1, mtested = 1;
380 0 : GEN bit = const_vecsmall(n, 0);
381 0 : GEN cy = cgetg(n+1, t_VECSMALL);
382 0 : GEN sh = const_vec(n, gen_0);
383 0 : for(mj=1; mj<=n; mj++)
384 : {
385 0 : if (isintzero(gel(C,mj))) continue;
386 0 : gel(sh,mj) = gcopy(gel(C,mj));
387 0 : if (bit[mj]) continue;
388 0 : cy[m++] = mj;
389 0 : bit[mj] = 1;
390 : for(;;)
391 0 : {
392 0 : long o, mold = m;
393 0 : for (o = 1; o < lv; o++)
394 : {
395 0 : GEN vo = gel(v,o);
396 : long p;
397 0 : for (p = mtested; p < mold; p++) /* m increases! */
398 : {
399 0 : long j = vo[ cy[p] ];
400 0 : if (!bit[j])
401 : {
402 0 : gel(sh,j) = perm_mul(vo, gel(sh, cy[p]));
403 0 : cy[m++] = j;
404 : }
405 0 : bit[j] = 1;
406 : }
407 : }
408 0 : mtested = mold;
409 0 : if (m == mold) break;
410 : }
411 : }
412 0 : return gc_upto(av, sh);
413 : }
414 :
415 : /* Orbits of the subgroup generated by v on {1,..,n} */
416 : static GEN
417 1186164 : vecperm_orbits_i(GEN v, long n)
418 : {
419 1186164 : long mj = 1, lv = lg(v), k, l;
420 1186164 : GEN cycle = cgetg(n+1, t_VEC), bit = const_vecsmall(n, 0);
421 7376070 : for (k = 1, l = 1; k <= n;)
422 : {
423 6189906 : pari_sp ltop = avma;
424 6189906 : long m = 1;
425 6189906 : GEN cy = cgetg(n+1, t_VECSMALL);
426 7383653 : for ( ; bit[mj]; mj++) /*empty*/;
427 6189906 : k++; cy[m++] = mj;
428 6189906 : bit[mj++] = 1;
429 : for(;;)
430 2049131 : {
431 8239037 : long o, mold = m;
432 16489784 : for (o = 1; o < lv; o++)
433 : {
434 8250747 : GEN vo = gel(v,o);
435 : long p;
436 26150800 : for (p = 1; p < m; p++) /* m increases! */
437 : {
438 17900053 : long j = vo[ cy[p] ];
439 17900053 : if (!bit[j]) cy[m++] = j;
440 17900053 : bit[j] = 1;
441 : }
442 : }
443 8239037 : if (m == mold) break;
444 2049131 : k += m - mold;
445 : }
446 6189906 : setlg(cy, m);
447 6189906 : gel(cycle,l++) = gc_leaf(ltop, cy);
448 : }
449 1186164 : setlg(cycle, l); return cycle;
450 : }
451 : /* memory clean version */
452 : GEN
453 3942 : vecperm_orbits(GEN v, long n)
454 : {
455 3942 : pari_sp av = avma;
456 3942 : return gc_GEN(av, vecperm_orbits_i(v, n));
457 : }
458 :
459 : static int
460 2207 : isperm(GEN v)
461 : {
462 2207 : pari_sp av = avma;
463 2207 : long i, n = lg(v)-1;
464 : GEN w;
465 2207 : if (typ(v) != t_VECSMALL) return 0;
466 2207 : w = zero_zv(n);
467 21377 : for (i=1; i<=n; i++)
468 : {
469 19196 : long d = v[i];
470 19196 : if (d < 1 || d > n || w[d]) return gc_bool(av,0);
471 19170 : w[d] = 1;
472 : }
473 2181 : return gc_bool(av,1);
474 : }
475 :
476 : /* Compute the cyclic decomposition of a permutation */
477 : GEN
478 11426 : perm_cycles(GEN v)
479 : {
480 11426 : pari_sp av = avma;
481 11426 : return gc_GEN(av, vecperm_orbits_i(mkvec(v), lg(v)-1));
482 : }
483 :
484 : GEN
485 197 : permcycles(GEN v)
486 : {
487 197 : if (!isperm(v)) pari_err_TYPE("permcycles",v);
488 192 : return perm_cycles(v);
489 : }
490 :
491 : /* Output the order of p */
492 : ulong
493 374100 : perm_orderu(GEN v)
494 : {
495 374100 : pari_sp av = avma;
496 374100 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
497 : long i, d;
498 2716647 : for(i=1, d=1; i<lg(c); i++) d = ulcm(d, lg(gel(c,i))-1);
499 374100 : return gc_ulong(av,d);
500 : }
501 :
502 : static GEN
503 1674 : _domul(void *data, GEN x, GEN y)
504 : {
505 1674 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
506 1674 : return mul(x,y);
507 : }
508 :
509 : /* Output the order of p */
510 : GEN
511 341 : perm_order(GEN v)
512 : {
513 341 : pari_sp av = avma;
514 341 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
515 341 : long i, l = lg(c);
516 341 : GEN V = cgetg(l, t_VEC);
517 2356 : for (i = 1; i < l; i++)
518 2015 : gel(V,i) = utoi(lg(gel(c,i))-1);
519 341 : return gc_INT(av, gen_product(V, (void *)lcmii, _domul));
520 : }
521 :
522 : GEN
523 346 : permorder(GEN v)
524 : {
525 346 : if (!isperm(v)) pari_err_TYPE("permorder",v);
526 341 : return perm_order(v);
527 : }
528 :
529 : /* sign of a permutation */
530 : long
531 796355 : perm_sign(GEN v)
532 : {
533 796355 : pari_sp av = avma;
534 796355 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
535 796355 : long i, l = lg(c), s = 1;
536 4594428 : for (i = 1; i < l; i++)
537 3798073 : if (odd(lg(gel(c, i)))) s = -s;
538 796355 : return gc_long(av,s);
539 : }
540 :
541 : long
542 207 : permsign(GEN v)
543 : {
544 207 : if (!isperm(v)) pari_err_TYPE("permsign",v);
545 197 : return perm_sign(v);
546 : }
547 :
548 : GEN
549 5069 : Z_to_perm(long n, GEN x)
550 : {
551 : pari_sp av;
552 : ulong i, r;
553 5069 : GEN v = cgetg(n+1, t_VECSMALL);
554 5069 : if (n==0) return v;
555 5063 : uel(v,n) = 1; av = avma;
556 5063 : if (signe(x) <= 0) x = modii(x, mpfact(n));
557 23261 : for (r=n-1; r>=1; r--)
558 : {
559 : ulong a;
560 18198 : x = absdiviu_rem(x, n+1-r, &a);
561 61419 : for (i=r+1; i<=(ulong)n; i++)
562 43221 : if (uel(v,i) > a) uel(v,i)++;
563 18198 : uel(v,r) = a+1;
564 : }
565 5063 : return gc_const(av, v);
566 : }
567 : GEN
568 5069 : numtoperm(long n, GEN x)
569 : {
570 5069 : if (n < 0) pari_err_DOMAIN("numtoperm", "n", "<", gen_0, stoi(n));
571 5069 : if (typ(x) != t_INT) pari_err_TYPE("numtoperm",x);
572 5069 : return Z_to_perm(n, x);
573 : }
574 :
575 : /* destroys v */
576 : static GEN
577 1457 : perm_to_Z_inplace(GEN v)
578 : {
579 1457 : long l = lg(v), i, r;
580 1457 : GEN x = gen_0;
581 1457 : if (!isperm(v)) return NULL;
582 8686 : for (i = 1; i < l; i++)
583 : {
584 7235 : long vi = v[i];
585 7235 : if (vi <= 0) return NULL;
586 7235 : x = i==1 ? utoi(vi-1): addiu(muliu(x,l-i), vi-1);
587 21740 : for (r = i+1; r < l; r++)
588 14505 : if (v[r] > vi) v[r]--;
589 : }
590 1451 : return x;
591 : }
592 : GEN
593 1440 : perm_to_Z(GEN v)
594 : {
595 1440 : pari_sp av = avma;
596 1440 : GEN x = perm_to_Z_inplace(leafcopy(v));
597 1440 : if (!x) pari_err_TYPE("permtonum",v);
598 1440 : return gc_INT(av, x);
599 : }
600 : GEN
601 1463 : permtonum(GEN p)
602 : {
603 1463 : pari_sp av = avma;
604 : GEN v, x;
605 1463 : switch(typ(p))
606 : {
607 1440 : case t_VECSMALL: return perm_to_Z(p);
608 17 : case t_VEC: case t_COL:
609 17 : if (RgV_is_ZV(p)) { v = ZV_to_zv(p); break; }
610 6 : default: pari_err_TYPE("permtonum",p);
611 : return NULL;/*LCOV_EXCL_LINE*/
612 : }
613 17 : x = perm_to_Z_inplace(v);
614 17 : if (!x) pari_err_TYPE("permtonum",p);
615 11 : return gc_INT(av, x);
616 : }
617 :
618 : GEN
619 6288 : cyc_pow(GEN cyc, long exp)
620 : {
621 : long i, j, k, l, r;
622 : GEN c;
623 18907 : for (r = j = 1; j < lg(cyc); j++)
624 : {
625 12619 : long n = lg(gel(cyc,j)) - 1;
626 12619 : r += cgcd(n, exp);
627 : }
628 6288 : c = cgetg(r, t_VEC);
629 18907 : for (r = j = 1; j < lg(cyc); j++)
630 : {
631 12619 : GEN v = gel(cyc,j);
632 12619 : long n = lg(v) - 1, e = umodsu(exp,n), g = (long)ugcd(n, e), m = n / g;
633 26858 : for (i = 0; i < g; i++)
634 : {
635 14239 : GEN p = cgetg(m+1, t_VECSMALL);
636 14239 : gel(c,r++) = p;
637 46399 : for (k = 1, l = i; k <= m; k++)
638 : {
639 32160 : p[k] = v[l+1];
640 32160 : l += e; if (l >= n) l -= n;
641 : }
642 : }
643 : }
644 6288 : return c;
645 : }
646 :
647 : /* Compute the power of a permutation given by product of cycles
648 : * Ouput a perm, not a cyc */
649 : GEN
650 0 : cyc_pow_perm(GEN cyc, long exp)
651 : {
652 : long e, j, k, l, n;
653 : GEN p;
654 0 : for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
655 0 : p = cgetg(n + 1, t_VECSMALL);
656 0 : for (j = 1; j < lg(cyc); j++)
657 : {
658 0 : GEN v = gel(cyc,j);
659 0 : n = lg(v) - 1; e = umodsu(exp, n);
660 0 : for (k = 1, l = e; k <= n; k++)
661 : {
662 0 : p[v[k]] = v[l+1];
663 0 : if (++l == n) l = 0;
664 : }
665 : }
666 0 : return p;
667 : }
668 :
669 : GEN
670 66 : perm_pow(GEN perm, GEN exp)
671 : {
672 66 : long i, r = lg(perm)-1;
673 66 : GEN p = zero_zv(r);
674 66 : pari_sp av = avma;
675 66 : GEN v = cgetg(r+1, t_VECSMALL);
676 234 : for (i=1; i<=r; i++)
677 : {
678 : long e, n, k, l;
679 168 : if (p[i]) continue;
680 66 : v[1] = i;
681 168 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
682 66 : e = umodiu(exp, n);
683 234 : for (k = 1, l = e; k <= n; k++)
684 : {
685 168 : p[v[k]] = v[l+1];
686 168 : if (++l == n) l = 0;
687 : }
688 : }
689 66 : return gc_const(av, p);
690 : }
691 :
692 : GEN
693 15991 : perm_powu(GEN perm, ulong exp)
694 : {
695 15991 : ulong i, r = lg(perm)-1;
696 15991 : GEN p = zero_zv(r);
697 15991 : pari_sp av = avma;
698 15991 : GEN v = cgetg(r+1, t_VECSMALL);
699 209992 : for (i=1; i<=r; i++)
700 : {
701 : ulong e, n, k, l;
702 194001 : if (p[i]) continue;
703 72202 : v[1] = i;
704 194001 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
705 72202 : e = exp % n;
706 266203 : for (k = 1, l = e; k <= n; k++)
707 : {
708 194001 : p[v[k]] = v[l+1];
709 194001 : if (++l == n) l = 0;
710 : }
711 : }
712 15991 : return gc_const(av, p);
713 : }
714 :
715 : GEN
716 18 : perm_to_GAP(GEN p)
717 : {
718 18 : pari_sp ltop=avma;
719 : GEN gap;
720 : GEN x;
721 : long i;
722 18 : long nb, c=0;
723 : char *s;
724 : long sz;
725 18 : long lp=lg(p)-1;
726 18 : if (typ(p) != t_VECSMALL) pari_err_TYPE("perm_to_GAP",p);
727 18 : x = perm_cycles(p);
728 18 : sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
729 : /*Dry run*/
730 114 : for (i = 1, nb = 1; i < lg(x); ++i)
731 : {
732 96 : GEN z = gel(x,i);
733 96 : long lz = lg(z)-1;
734 96 : nb += 1+lz*(sz+2);
735 : }
736 18 : nb++;
737 : /*Real run*/
738 18 : gap = cgetg(nchar2nlong(nb) + 1, t_STR);
739 18 : s = GSTR(gap);
740 114 : for (i = 1; i < lg(x); ++i)
741 : {
742 : long j;
743 96 : GEN z = gel(x,i);
744 96 : if (lg(z) > 2)
745 : {
746 96 : s[c++] = '(';
747 312 : for (j = 1; j < lg(z); ++j)
748 : {
749 216 : if (j > 1)
750 : {
751 120 : s[c++] = ','; s[c++] = ' ';
752 : }
753 216 : sprintf(s+c,"%ld",z[j]);
754 486 : while(s[c++]) /* empty */;
755 216 : c--;
756 : }
757 96 : s[c++] = ')';
758 : }
759 : }
760 18 : if (!c) { s[c++]='('; s[c++]=')'; }
761 18 : s[c] = '\0';
762 18 : return gc_upto(ltop,gap);
763 : }
764 :
765 : int
766 490719 : perm_commute(GEN s, GEN t)
767 : {
768 490719 : long i, l = lg(t);
769 34607367 : for (i = 1; i < l; i++)
770 34133250 : if (t[ s[i] ] != s[ t[i] ]) return 0;
771 474117 : return 1;
772 : }
773 :
774 : /*************************************************************************/
775 : /** **/
776 : /** Routines for handling groups **/
777 : /** **/
778 : /*************************************************************************/
779 : /* A Group is a t_VEC [gen,orders]
780 : * gen (vecvecsmall): list of generators given by permutations
781 : * orders (vecsmall): relatives orders of generators. */
782 807125 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
783 1368020 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
784 :
785 : /* A Quotient Group is a t_VEC [gen,coset]
786 : * gen (vecvecsmall): coset generators
787 : * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
788 : */
789 121310 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
790 25698 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
791 :
792 : static GEN
793 44875 : trivialsubgroups(void)
794 44875 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
795 :
796 : /* Compute the order of p modulo the group given by a set */
797 : long
798 188508 : perm_relorder(GEN p, GEN set)
799 : {
800 188508 : pari_sp ltop = avma;
801 188508 : long n = 1, q = p[1];
802 560128 : while (!F2v_coeff(set,q)) { q = p[q]; n++; }
803 188508 : return gc_long(ltop,n);
804 : }
805 :
806 : GEN
807 11182 : perm_generate(GEN S, GEN H, long o)
808 : {
809 11182 : long i, n = lg(H)-1;
810 11182 : GEN L = cgetg(n*o + 1, t_VEC);
811 39269 : for(i=1; i<=n; i++) gel(L,i) = vecsmall_copy(gel(H,i));
812 43367 : for( ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
813 11182 : return L;
814 : }
815 :
816 : /*Return the order (cardinality) of a group */
817 : long
818 608971 : group_order(GEN G)
819 : {
820 608971 : return zv_prod(grp_get_ord(G));
821 : }
822 :
823 : /* G being a subgroup of S_n, output n */
824 : long
825 22838 : group_domain(GEN G)
826 : {
827 22838 : GEN gen = grp_get_gen(G);
828 22838 : if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
829 22838 : return lg(gel(gen,1)) - 1;
830 : }
831 :
832 : /*Left coset of g mod G: gG*/
833 : GEN
834 260674 : group_leftcoset(GEN G, GEN g)
835 : {
836 260674 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
837 260674 : GEN res = cgetg(group_order(G)+1, t_VEC);
838 : long i, j, k;
839 260674 : gel(res,1) = vecsmall_copy(g);
840 260674 : k = 1;
841 479750 : for (i = 1; i < lg(gen); i++)
842 : {
843 219076 : long c = k * (ord[i] - 1);
844 603503 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
845 : }
846 260674 : return res;
847 : }
848 : /*Right coset of g mod G: Gg*/
849 : GEN
850 156066 : group_rightcoset(GEN G, GEN g)
851 : {
852 156066 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
853 156066 : GEN res = cgetg(group_order(G)+1, t_VEC);
854 : long i, j, k;
855 156066 : gel(res,1) = vecsmall_copy(g);
856 156066 : k = 1;
857 270294 : for (i = 1; i < lg(gen); i++)
858 : {
859 114228 : long c = k * (ord[i] - 1);
860 359490 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
861 : }
862 156066 : return res;
863 : }
864 : /*Elements of a group from the generators, cf group_leftcoset*/
865 : GEN
866 120723 : group_elts(GEN G, long n)
867 : {
868 120723 : if (lg(G)==3 && typ(gel(G,1))==t_VEC)
869 : {
870 120723 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
871 120723 : GEN res = cgetg(group_order(G)+1, t_VEC);
872 : long i, j, k;
873 120723 : gel(res,1) = identity_perm(n);
874 120723 : k = 1;
875 244768 : for (i = 1; i < lg(gen); i++)
876 : {
877 124045 : long c = k * (ord[i] - 1);
878 : /* j = 1, use res[1] = identity */
879 124045 : gel(res,++k) = vecsmall_copy(gel(gen,i));
880 329955 : for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
881 : }
882 120723 : return res;
883 0 : } else return gcopy(G);
884 : }
885 :
886 : GEN
887 12384 : groupelts_conj_set(GEN elts, GEN p)
888 : {
889 12384 : long i, j, l = lg(elts), n = lg(p)-1;
890 12384 : GEN res = zero_F2v(n);
891 206970 : for(j = 1; j < n; j++)
892 206970 : if (p[j]==1) break;
893 86688 : for(i = 1; i < l; i++)
894 74304 : F2v_set(res, p[mael(elts,i,j)]);
895 12384 : return res;
896 : }
897 :
898 : GEN
899 24024 : groupelts_set(GEN elts, long n)
900 : {
901 24024 : GEN res = zero_F2v(n);
902 24024 : long i, l = lg(elts);
903 117778 : for(i=1; i<l; i++)
904 93754 : F2v_set(res,mael(elts,i,1));
905 24024 : return res;
906 : }
907 :
908 : /*Elements of a group from the generators, returned as a set (bitmap)*/
909 : GEN
910 77683 : group_set(GEN G, long n)
911 : {
912 77683 : GEN res = zero_F2v(n);
913 77683 : pari_sp av = avma;
914 77683 : GEN elts = group_elts(G, n);
915 77683 : long i, l = lg(elts);
916 243512 : for(i=1; i<l; i++)
917 165829 : F2v_set(res,mael(elts,i,1));
918 77683 : return gc_const(av, res);
919 : }
920 :
921 : static int
922 14874 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
923 :
924 : GEN
925 426 : subgroups_tableset(GEN S, long n)
926 : {
927 426 : long i, l = lg(S);
928 426 : GEN v = cgetg(l, t_VEC);
929 4638 : for(i=1; i<l; i++)
930 4212 : gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
931 426 : gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
932 426 : return v;
933 : }
934 :
935 : long
936 1716 : tableset_find_index(GEN tbl, GEN set)
937 : {
938 1716 : long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
939 1716 : if (!i) return 0;
940 1716 : return mael3(tbl,i,2,1);
941 : }
942 :
943 : GEN
944 44898 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
945 :
946 : /*Cyclic group generated by g of order s*/
947 : GEN
948 23882 : cyclicgroup(GEN g, long s)
949 23882 : { retmkvec2(mkvec( vecsmall_copy(g) ), mkvecsmall(s)); }
950 :
951 : /*Return the group generated by g1,g2 of relative orders s1,s2*/
952 : GEN
953 906 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
954 906 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
955 : mkvecsmall2(s1, s2) ); }
956 :
957 : /* return the quotient map G --> G/H */
958 : /*The ouput is [gen,hash]*/
959 : /* gen (vecvecsmall): coset generators
960 : * coset (vecsmall): vecsmall of coset number) */
961 : GEN
962 10016 : groupelts_quotient(GEN elt, GEN H)
963 : {
964 10016 : pari_sp ltop = avma;
965 : GEN p2, p3;
966 10016 : long i, j, a = 1;
967 10016 : long n = lg(gel(elt,1))-1, o = group_order(H);
968 : GEN el;
969 10016 : long le = lg(elt)-1;
970 10016 : GEN used = zero_F2v(le+1);
971 10016 : long l = le/o;
972 10016 : p2 = cgetg(l+1, t_VEC);
973 10016 : p3 = zero_zv(n);
974 10016 : el = zero_zv(n);
975 128377 : for (i = 1; i<=le; i++)
976 118361 : el[mael(elt,i,1)]=i;
977 58739 : for (i = 1; i <= l; ++i)
978 : {
979 : GEN V;
980 128895 : while(F2v_coeff(used,a)) a++;
981 48729 : V = group_leftcoset(H,gel(elt,a));
982 48729 : gel(p2,i) = gel(V,1);
983 167000 : for(j=1;j<lg(V);j++)
984 : {
985 118277 : long b = el[mael(V,j,1)];
986 118277 : if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
987 118271 : F2v_set(used,b);
988 : }
989 166988 : for (j = 1; j <= o; j++)
990 118265 : p3[mael(V, j, 1)] = i;
991 : }
992 10010 : return gc_GEN(ltop,mkvec2(p2,p3));
993 : }
994 :
995 : GEN
996 8720 : group_quotient(GEN G, GEN H)
997 : {
998 8720 : return groupelts_quotient(group_elts(G, group_domain(G)), H);
999 : }
1000 :
1001 : /*Compute the image of a permutation by a quotient map.*/
1002 : GEN
1003 25698 : quotient_perm(GEN C, GEN p)
1004 : {
1005 25698 : GEN gen = quo_get_gen(C);
1006 25698 : GEN coset = quo_get_coset(C);
1007 25698 : long j, l = lg(gen);
1008 25698 : GEN p3 = cgetg(l, t_VECSMALL);
1009 242471 : for (j = 1; j < l; ++j)
1010 : {
1011 216773 : p3[j] = coset[p[mael(gen,j,1)]];
1012 216773 : if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
1013 : }
1014 25698 : return p3;
1015 : }
1016 :
1017 : /* H is a subgroup of G, C is the quotient map G --> G/H
1018 : *
1019 : * Lift a subgroup S of G/H to a subgroup of G containing H */
1020 : GEN
1021 43449 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
1022 : {
1023 43449 : GEN genH = grp_get_gen(H);
1024 43449 : GEN genS = grp_get_gen(S);
1025 43449 : GEN genC = quo_get_gen(C);
1026 43449 : long l1 = lg(genH)-1;
1027 43449 : long l2 = lg(genS)-1, j;
1028 43449 : GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
1029 87018 : for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
1030 101128 : for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
1031 43449 : gel(p1,1) = L;
1032 43449 : gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
1033 43449 : return p1;
1034 : }
1035 :
1036 : /* Let G a group and C a quotient map G --> G/H
1037 : * Assume H is normal, return the group G/H */
1038 : GEN
1039 8714 : quotient_group(GEN C, GEN G)
1040 : {
1041 8714 : pari_sp ltop = avma;
1042 : GEN Qgen, Qord, Qelt, Qset, Q;
1043 8714 : GEN Cgen = quo_get_gen(C);
1044 8714 : GEN Ggen = grp_get_gen(G);
1045 8714 : long i,j, n = lg(Cgen)-1, l = lg(Ggen);
1046 8714 : Qord = cgetg(l, t_VECSMALL);
1047 8714 : Qgen = cgetg(l, t_VEC);
1048 8714 : Qelt = mkvec(identity_perm(n));
1049 8714 : Qset = groupelts_set(Qelt, n);
1050 26612 : for (i = 1, j = 1; i < l; ++i)
1051 : {
1052 17898 : GEN g = quotient_perm(C, gel(Ggen,i));
1053 17898 : long o = perm_relorder(g, Qset);
1054 17898 : gel(Qgen,j) = g;
1055 17898 : Qord[j] = o;
1056 17898 : if (o != 1)
1057 : {
1058 11182 : Qelt = perm_generate(g, Qelt, o);
1059 11182 : Qset = groupelts_set(Qelt, n);
1060 11182 : j++;
1061 : }
1062 : }
1063 8714 : setlg(Qgen,j);
1064 8714 : setlg(Qord,j); Q = mkvec2(Qgen, Qord);
1065 8714 : return gc_GEN(ltop,Q);
1066 : }
1067 :
1068 : GEN
1069 1296 : quotient_groupelts(GEN C)
1070 : {
1071 1296 : GEN G = quo_get_gen(C);
1072 1296 : long i, l = lg(G);
1073 1296 : GEN Q = cgetg(l, t_VEC);
1074 9096 : for (i = 1; i < l; ++i)
1075 7800 : gel(Q,i) = quotient_perm(C, gel(G,i));
1076 1296 : return Q;
1077 : }
1078 :
1079 : /* Return 1 if g normalizes N, 0 otherwise */
1080 : long
1081 156066 : group_perm_normalize(GEN N, GEN g)
1082 : {
1083 156066 : pari_sp ltop = avma;
1084 156066 : long r = gequal(vecvecsmall_sort_shallow(group_leftcoset(N, g)),
1085 : vecvecsmall_sort_shallow(group_rightcoset(N, g)));
1086 156066 : return gc_long(ltop, r);
1087 : }
1088 :
1089 : /* L is a list of subgroups, C is a coset and r a relative order.*/
1090 : static GEN
1091 55879 : liftlistsubgroups(GEN L, GEN C, long r)
1092 : {
1093 55879 : pari_sp ltop = avma;
1094 55879 : long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
1095 : GEN R;
1096 55879 : if (!l) return cgetg(1,t_VEC);
1097 50143 : R = cgetg(l*c+1, t_VEC);
1098 122486 : for (i = 1, k = 1; i <= l; ++i)
1099 : {
1100 72343 : GEN S = gel(L,i), Selt = group_set(S,n);
1101 72343 : GEN gen = grp_get_gen(S);
1102 72343 : GEN ord = grp_get_ord(S);
1103 : long j;
1104 239143 : for (j = 1; j <= c; ++j)
1105 : {
1106 166800 : GEN p = gel(C,j);
1107 166800 : if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
1108 93066 : gel(R,k++) = mkvec2(vec_append(gen, p),
1109 : vecsmall_append(ord, r));
1110 : }
1111 : }
1112 50143 : setlg(R, k);
1113 50143 : return gc_GEN(ltop, R);
1114 : }
1115 :
1116 : /* H is a normal subgroup, C is the quotient map G -->G/H,
1117 : * S is a subgroup of G/H, and G is embedded in Sym(l)
1118 : * Return all the subgroups K of G such that
1119 : * S= K mod H and K inter H={1} */
1120 : static GEN
1121 42153 : liftsubgroup(GEN C, GEN H, GEN S)
1122 : {
1123 42153 : pari_sp ltop = avma;
1124 42153 : GEN V = trivialsubgroups();
1125 42153 : GEN Sgen = grp_get_gen(S);
1126 42153 : GEN Sord = grp_get_ord(S);
1127 42153 : GEN Cgen = quo_get_gen(C);
1128 42153 : long n = lg(Sgen), i;
1129 98032 : for (i = 1; i < n; ++i)
1130 : { /*loop over generators of S*/
1131 55879 : GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
1132 55879 : V = liftlistsubgroups(V, W, Sord[i]);
1133 : }
1134 42153 : return gc_GEN(ltop,V);
1135 : }
1136 :
1137 : /* 1:A4, 2:S4, 3:F36, 0: other */
1138 : long
1139 8570 : group_isA4S4(GEN G)
1140 : {
1141 8570 : GEN elt = grp_get_gen(G);
1142 8570 : GEN ord = grp_get_ord(G);
1143 8570 : long n = lg(ord);
1144 8570 : if (n != 4 && n != 5) return 0;
1145 1893 : if (n==4 && ord[1]==3 && ord[2]==3 && ord[3]==4)
1146 : {
1147 : long i;
1148 6 : GEN p = gel(elt,1), q = gel(elt,2), r = gel(elt,3);
1149 222 : for(i=1; i<=36; i++)
1150 216 : if (p[r[i]]!=r[q[i]]) return 0;
1151 6 : return 3;
1152 : }
1153 1887 : if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
1154 30 : if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
1155 30 : if (n==4) return 1;
1156 15 : if (ord[4]!=2) return 0;
1157 15 : if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
1158 15 : return 2;
1159 : }
1160 : /* compute all the subgroups of a group G */
1161 : GEN
1162 11292 : group_subgroups(GEN G)
1163 : {
1164 11292 : pari_sp ltop = avma;
1165 : GEN p1, H, C, Q, M, sg1, sg2, sg3;
1166 11292 : GEN gen = grp_get_gen(G);
1167 11292 : GEN ord = grp_get_ord(G);
1168 11292 : long lM, i, j, n = lg(gen);
1169 : long t;
1170 11292 : if (n == 1) return trivialsubgroups();
1171 8570 : t = group_isA4S4(G);
1172 8570 : if (t == 3)
1173 : {
1174 6 : GEN H = mkvec2(mkvec3(gel(gen,1), gel(gen,2), perm_sqr(gel(gen,3))),
1175 : mkvecsmall3(3, 3, 2));
1176 6 : GEN S = group_subgroups(H);
1177 6 : GEN V = cgetg(11,t_VEC);
1178 6 : gel(V,1) = cyclicgroup(gel(gen,3),4);
1179 54 : for (i=2; i<10; i++)
1180 48 : gel(V,i) = cyclicgroup(perm_mul(gmael3(V,i-1,1,1),gel(gen,i%3==1 ? 2:1)),4);
1181 6 : gel(V,10) = G;
1182 6 : return gc_GEN(ltop,shallowconcat(S,V));
1183 : }
1184 8564 : else if (t)
1185 : {
1186 30 : GEN s = gel(gen,1); /*s = (1,2)(3,4) */
1187 30 : GEN t = gel(gen,2); /*t = (1,3)(2,4) */
1188 30 : GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
1189 30 : H = dicyclicgroup(s, t, 2, 2);
1190 : /* sg3 is the list of subgroups intersecting only partially with H*/
1191 30 : sg3 = cgetg((n==4)?4: 10, t_VEC);
1192 30 : gel(sg3,1) = cyclicgroup(s, 2);
1193 30 : gel(sg3,2) = cyclicgroup(t, 2);
1194 30 : gel(sg3,3) = cyclicgroup(st, 2);
1195 30 : if (n==5)
1196 : {
1197 15 : GEN u = gel(gen,3);
1198 15 : GEN v = gel(gen,4), w, u2;
1199 15 : if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
1200 15 : u2 = perm_sqr(u);
1201 : else
1202 : {
1203 0 : u2 = u;
1204 0 : u = perm_sqr(u);
1205 : }
1206 15 : if (perm_orderu(v)==2)
1207 : {
1208 15 : if (!perm_commute(s,v)) /*v=(1,2)*/
1209 : {
1210 0 : v = perm_conj(u,v);
1211 0 : if (!perm_commute(s,v)) v = perm_conj(u,v);
1212 : }
1213 15 : w = perm_mul(v,t); /*w=(1,4,2,3)*/
1214 : }
1215 : else
1216 : {
1217 0 : w = v;
1218 0 : if (!zv_equal(perm_sqr(w), s)) /*w=(1,4,2,3)*/
1219 : {
1220 0 : w = perm_conj(u,w);
1221 0 : if (!zv_equal(perm_sqr(w), s)) w = perm_conj(u,w);
1222 : }
1223 0 : v = perm_mul(w,t); /*v=(1,2)*/
1224 : }
1225 15 : gel(sg3,4) = dicyclicgroup(s,v,2,2);
1226 15 : gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
1227 15 : gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
1228 15 : gel(sg3,7) = dicyclicgroup(s,w,2,2);
1229 15 : gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
1230 15 : gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
1231 : }
1232 : }
1233 : else
1234 : {
1235 8534 : ulong osig = mael(factoru(ord[1]), 1, 1);
1236 8534 : GEN sig = perm_powu(gel(gen,1), ord[1]/osig);
1237 8534 : H = cyclicgroup(sig,osig);
1238 8534 : sg3 = NULL;
1239 : }
1240 8564 : C = group_quotient(G,H);
1241 8558 : Q = quotient_group(C,G);
1242 8558 : M = group_subgroups(Q); lM = lg(M);
1243 : /* sg1 is the list of subgroups containing H*/
1244 8552 : sg1 = cgetg(lM, t_VEC);
1245 50705 : for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
1246 : /*sg2 is a list of lists of subgroups not intersecting with H*/
1247 8552 : sg2 = cgetg(lM, t_VEC);
1248 : /* Loop over all subgroups of G/H */
1249 50705 : for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
1250 8552 : p1 = gconcat(sg1, shallowconcat1(sg2));
1251 8552 : if (sg3)
1252 : {
1253 30 : p1 = gconcat(p1, sg3);
1254 30 : if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
1255 60 : for(j = 3; j <= 5; j++)
1256 : {
1257 45 : GEN c = gmael(p1,j,1);
1258 45 : if (!perm_commute(gel(c,1),gel(c,3)))
1259 : {
1260 30 : if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
1261 : else
1262 15 : perm_mul_inplace2(gel(c,2), gel(c,1));
1263 : }
1264 : }
1265 : }
1266 8552 : return gc_upto(ltop,p1);
1267 : }
1268 :
1269 : /*return 1 if G is abelian, else 0*/
1270 : long
1271 7668 : group_isabelian(GEN G)
1272 : {
1273 7668 : GEN g = grp_get_gen(G);
1274 7668 : long i, j, n = lg(g);
1275 11052 : for(i=2; i<n; i++)
1276 11232 : for(j=1; j<i; j++)
1277 7848 : if (!perm_commute(gel(g,i), gel(g,j))) return 0;
1278 3432 : return 1;
1279 : }
1280 :
1281 : /*If G is abelian, return its HNF matrix*/
1282 : GEN
1283 330 : group_abelianHNF(GEN G, GEN S)
1284 : {
1285 330 : GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
1286 330 : long i, j, k, n = lg(g);
1287 330 : if (!group_isabelian(G)) return NULL;
1288 270 : if (n==1) return cgetg(1,t_MAT);
1289 258 : if (!S) S = group_elts(G, group_domain(G));
1290 258 : M = cgetg(n,t_MAT);
1291 840 : for(i=1; i<n; i++)
1292 : {
1293 582 : GEN P, C = cgetg(n,t_COL);
1294 582 : pari_sp av = avma;
1295 582 : gel(M,i) = C;
1296 582 : P = perm_inv(perm_powu(gel(g,i), o[i]));
1297 822 : for(j=1; j<lg(S); j++)
1298 822 : if (zv_equal(P, gel(S,j))) break;
1299 582 : set_avma(av);
1300 582 : if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
1301 582 : j--;
1302 1044 : for(k=1; k<i; k++)
1303 : {
1304 462 : long q = j / o[k];
1305 462 : gel(C,k) = stoi(j - q*o[k]);
1306 462 : j = q;
1307 : }
1308 582 : gel(C,k) = stoi(o[i]);
1309 1044 : for (k++; k<n; k++) gel(C,k) = gen_0;
1310 : }
1311 258 : return M;
1312 : }
1313 :
1314 : /*If G is abelian, return its abstract SNF matrix*/
1315 : GEN
1316 288 : group_abelianSNF(GEN G, GEN L)
1317 : {
1318 288 : pari_sp ltop = avma;
1319 288 : GEN H = group_abelianHNF(G,L);
1320 288 : if (!H) return NULL;
1321 228 : return gc_upto(ltop, smithclean( ZM_snf(H) ));
1322 : }
1323 :
1324 : GEN
1325 396 : abelian_group(GEN v)
1326 : {
1327 396 : long card = zv_prod(v), i, d = 1, l = lg(v);
1328 396 : GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
1329 396 : gel(G,1) = gen;
1330 396 : gel(G,2) = vecsmall_copy(v);
1331 822 : for(i=1; i<l; i++)
1332 : {
1333 426 : GEN p = cgetg(card+1, t_VECSMALL);
1334 426 : long o = v[i], u = d*(o-1), j, k, l;
1335 426 : gel(gen, i) = p;
1336 : /* The following loop is over-optimized. Remember that I wrote it for
1337 : * testpermutation. Something has survived... BA */
1338 1068 : for(j=1;j<=card;)
1339 : {
1340 2676 : for(k=1;k<o;k++)
1341 5670 : for(l=1;l<=d; l++,j++) p[j] = j+d;
1342 2382 : for (l=1; l<=d; l++,j++) p[j] = j-u;
1343 : }
1344 426 : d += u;
1345 : }
1346 396 : return G;
1347 : }
1348 :
1349 : static long
1350 12522 : groupelts_subgroup_isnormal(GEN G, GEN H)
1351 : {
1352 12522 : long i, n = lg(G);
1353 55260 : for(i = 1; i < n; i++)
1354 53910 : if (!group_perm_normalize(H, gel(G,i))) return 0;
1355 1350 : return 1;
1356 : }
1357 :
1358 : /*return 1 if H is a normal subgroup of G*/
1359 : long
1360 288 : group_subgroup_isnormal(GEN G, GEN H)
1361 : {
1362 288 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1363 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1364 : strtoGENstr("domain(G)"), H);
1365 288 : return groupelts_subgroup_isnormal(grp_get_gen(G), H);
1366 : }
1367 :
1368 : static GEN
1369 4128 : group_subgroup_kernel_set(GEN G, GEN H)
1370 : {
1371 : pari_sp av;
1372 4128 : GEN g = grp_get_gen(G);
1373 4128 : long i, n = lg(g);
1374 : GEN S, elts;
1375 4128 : long d = group_domain(G);
1376 4128 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1377 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1378 : strtoGENstr("domain(G)"), H);
1379 4128 : elts = group_elts(H,d);
1380 4128 : S = groupelts_set(elts, d);
1381 4128 : av = avma;
1382 16512 : for(i=1; i<n; i++)
1383 : {
1384 12384 : F2v_and_inplace(S, groupelts_conj_set(elts,gel(g,i)));
1385 12384 : set_avma(av);
1386 : }
1387 4128 : return S;
1388 : }
1389 :
1390 : int
1391 4128 : group_subgroup_is_faithful(GEN G, GEN H)
1392 : {
1393 4128 : pari_sp av = avma;
1394 4128 : GEN K = group_subgroup_kernel_set(G,H);
1395 4128 : F2v_clear(K,1);
1396 4128 : return gc_long(av, F2v_equal0(K));
1397 : }
1398 :
1399 : long
1400 0 : groupelts_exponent(GEN elts)
1401 : {
1402 0 : long i, n = lg(elts)-1, expo = 1;
1403 0 : for(i=1; i<=n; i++) expo = ulcm(expo, perm_orderu(gel(elts,i)));
1404 0 : return expo;
1405 : }
1406 :
1407 : GEN
1408 600 : groupelts_center(GEN S)
1409 : {
1410 600 : pari_sp ltop = avma;
1411 600 : long i, j, n = lg(S)-1, l = n;
1412 600 : GEN V, elts = zero_F2v(n+1);
1413 22056 : for(i=1; i<=n; i++)
1414 : {
1415 21456 : if (F2v_coeff(elts,i)) { l--; continue; }
1416 491472 : for(j=1; j<=n; j++)
1417 482736 : if (!perm_commute(gel(S,i),gel(S,j)))
1418 : {
1419 12276 : F2v_set(elts,i);
1420 12276 : F2v_set(elts,j); l--; break;
1421 : }
1422 : }
1423 600 : V = cgetg(l+1,t_VEC);
1424 22056 : for (i=1, j=1; i<=n ;i++)
1425 21456 : if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
1426 600 : return gc_upto(ltop,V);
1427 : }
1428 :
1429 : GEN
1430 3660 : groupelts_conjclasses(GEN elts, long *pnbcl)
1431 : {
1432 3660 : long i, j, cl = 0, n = lg(elts)-1;
1433 3660 : GEN c = const_vecsmall(n,0);
1434 3660 : pari_sp av = avma;
1435 45300 : for (i=1; i<=n; i++)
1436 : {
1437 41640 : GEN g = gel(elts,i);
1438 41640 : if (c[i]) continue;
1439 29970 : c[i] = ++cl;
1440 417318 : for(j=1; j<=n; j++)
1441 387348 : if (j != i)
1442 : {
1443 357378 : GEN h = perm_conj(gel(elts,j), g);
1444 357378 : long i2 = gen_search(elts,h,(void*)&vecsmall_lexcmp,&cmp_nodata);
1445 357378 : c[i2] = cl; set_avma(av);
1446 : }
1447 : }
1448 3660 : if (pnbcl) *pnbcl = cl;
1449 3660 : return c;
1450 : }
1451 :
1452 : GEN
1453 3660 : conjclasses_repr(GEN conj, long nb)
1454 : {
1455 3660 : long i, l = lg(conj);
1456 3660 : GEN e = const_vecsmall(nb, 0);
1457 45300 : for(i=1; i<l; i++)
1458 : {
1459 41640 : long ci = conj[i];
1460 41640 : if (!e[ci]) e[ci] = i;
1461 : }
1462 3660 : return e;
1463 : }
1464 :
1465 : /* elts of G sorted wrt vecsmall_lexcmp order: g in G is determined by g[1]
1466 : * so sort by increasing g[1] */
1467 : static GEN
1468 3330 : galois_elts_sorted(GEN gal)
1469 : {
1470 : long i, l;
1471 3330 : GEN elts = gal_get_group(gal), v = cgetg_copy(elts, &l);
1472 36978 : for (i = 1; i < l; i++) { GEN g = gel(elts,i); gel(v, g[1]) = g; }
1473 3330 : return v;
1474 : }
1475 : GEN
1476 3678 : group_to_cc(GEN G)
1477 : {
1478 3678 : GEN elts = checkgroupelts(G), z = cgetg(5,t_VEC);
1479 3660 : long n, flag = 1;
1480 3660 : if (typ(gel(G,1)) == t_POL)
1481 3330 : elts = galois_elts_sorted(G); /* galoisinit */
1482 : else
1483 : {
1484 330 : long i, l = lg(elts);
1485 330 : elts = gen_sort_shallow(elts,(void*)vecsmall_lexcmp,cmp_nodata);
1486 4992 : for (i = 1; i < l; i++)
1487 4788 : if (gel(elts,i)[1] != i) { flag = 0; break; }
1488 : }
1489 3660 : gel(z,1) = elts;
1490 3660 : gel(z,2) = groupelts_conjclasses(elts,&n);
1491 3660 : gel(z,3) = conjclasses_repr(gel(z,2),n);
1492 3660 : gel(z,4) = utoi(flag); return z;
1493 : }
1494 :
1495 : /* S a list of generators */
1496 : GEN
1497 0 : groupelts_abelian_group(GEN S)
1498 : {
1499 0 : pari_sp ltop = avma;
1500 : GEN Qgen, Qord, Qelt;
1501 0 : long i, j, n = lg(gel(S,1))-1, l = lg(S);
1502 0 : Qord = cgetg(l, t_VECSMALL);
1503 0 : Qgen = cgetg(l, t_VEC);
1504 0 : Qelt = mkvec(identity_perm(n));
1505 0 : for (i = 1, j = 1; i < l; ++i)
1506 : {
1507 0 : GEN g = gel(S,i);
1508 0 : long o = perm_relorder(g, groupelts_set(Qelt, n));
1509 0 : gel(Qgen,j) = g;
1510 0 : Qord[j] = o;
1511 0 : if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
1512 : }
1513 0 : setlg(Qgen,j);
1514 0 : setlg(Qord,j);
1515 0 : return gc_GEN(ltop, mkvec2(Qgen, Qord));
1516 : }
1517 :
1518 : GEN
1519 12 : group_export_GAP(GEN G)
1520 : {
1521 12 : pari_sp av = avma;
1522 12 : GEN s, comma, g = grp_get_gen(G);
1523 12 : long i, k, l = lg(g);
1524 12 : if (l == 1) return strtoGENstr("Group(())");
1525 6 : s = cgetg(2*l, t_VEC);
1526 6 : comma = strtoGENstr(", ");
1527 6 : gel(s,1) = strtoGENstr("Group(");
1528 24 : for (i=1, k=2; i < l; ++i)
1529 : {
1530 18 : if (i > 1) gel(s,k++) = comma;
1531 18 : gel(s,k++) = perm_to_GAP(gel(g,i));
1532 : }
1533 6 : gel(s,k++) = strtoGENstr(")");
1534 6 : return gc_GEN(av, shallowconcat1(s));
1535 : }
1536 :
1537 : GEN
1538 12 : group_export_MAGMA(GEN G)
1539 : {
1540 12 : pari_sp av = avma;
1541 12 : GEN s, comma, g = grp_get_gen(G);
1542 12 : long i, k, l = lg(g);
1543 12 : if (l == 1) return strtoGENstr("PermutationGroup<1|>");
1544 6 : s = cgetg(2*l, t_VEC);
1545 6 : comma = strtoGENstr(", ");
1546 6 : gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
1547 24 : for (i=1, k=2; i < l; ++i)
1548 : {
1549 18 : if (i > 1) gel(s,k++) = comma;
1550 18 : gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
1551 : }
1552 6 : gel(s,k++) = strtoGENstr(">");
1553 6 : return gc_GEN(av, shallowconcat1(s));
1554 : }
1555 :
1556 : GEN
1557 24 : group_export(GEN G, long format)
1558 : {
1559 24 : switch(format)
1560 : {
1561 12 : case 0: return group_export_GAP(G);
1562 12 : case 1: return group_export_MAGMA(G);
1563 : }
1564 0 : pari_err_FLAG("galoisexport");
1565 0 : return NULL; /*-Wall*/
1566 : }
1567 :
1568 : static GEN
1569 3066 : groupelts_cyclic_subgroups(GEN G)
1570 : {
1571 3066 : pari_sp av = avma;
1572 3066 : long i, j, n = lg(G)-1;
1573 : GEN elts, f, gen, ord;
1574 3066 : if (n==1) return cgetg(1,t_VEC);
1575 3066 : elts = zero_F2v(lg(gel(G,1))-1);
1576 3066 : gen = cgetg(n+1, t_VECSMALL);
1577 3066 : ord = cgetg(n+1, t_VECSMALL);
1578 45522 : for (i=1, j=1; i<=n; i++)
1579 : {
1580 42456 : long k = 1, o, c = 0;
1581 42456 : GEN p = gel(G, i);
1582 42456 : if (F2v_coeff(elts, p[1])) continue;
1583 30774 : o = perm_orderu(p);
1584 30774 : gen[j] = i; ord[j] = o; j++;
1585 : do
1586 : {
1587 82482 : if (cgcd(o, ++c)==1) F2v_set(elts, p[k]);
1588 82482 : k = p[k];
1589 82482 : } while (k!=1);
1590 : }
1591 3066 : setlg(gen, j);
1592 3066 : setlg(ord, j);
1593 3066 : f = vecsmall_indexsort(ord);
1594 3066 : return gc_GEN(av, mkvec2(vecsmallpermute(gen, f),
1595 : vecsmallpermute(ord, f)));
1596 : }
1597 :
1598 : GEN
1599 3071 : groupelts_to_group(GEN G)
1600 : {
1601 3071 : pari_sp av = avma;
1602 : GEN L, cyc, ord;
1603 3071 : long i, l, n = lg(G)-1;
1604 3071 : if (n==1) return trivialgroup();
1605 3054 : L = groupelts_cyclic_subgroups(G);
1606 3054 : cyc = gel(L,1); ord = gel(L,2);
1607 3054 : l = lg(cyc);
1608 13992 : for (i = l-1; i >= 2; i--)
1609 : {
1610 13410 : GEN p = gel(G,cyc[i]);
1611 13410 : long o = ord[i];
1612 13410 : GEN H = cyclicgroup(p, o);
1613 13410 : if (o == n) return gc_upto(av, H);
1614 12234 : if (groupelts_subgroup_isnormal(G, H))
1615 : {
1616 1296 : GEN C = groupelts_quotient(G, H);
1617 1296 : GEN Q = quotient_groupelts(C);
1618 1296 : GEN R = groupelts_to_group(Q);
1619 1296 : if (!R) return gc_NULL(av);
1620 1296 : return gc_GEN(av, quotient_subgroup_lift(C, H, R));
1621 : }
1622 : }
1623 582 : if (n==12 && l==9 && ord[2]==2 && ord[3]==2 && ord[5]==3)
1624 516 : return gc_GEN(av,
1625 258 : mkvec2(mkvec3(gel(G,cyc[2]), gel(G,cyc[3]), gel(G,cyc[5])), mkvecsmall3(2,2,3)));
1626 324 : if (n==24 && l==18 && ord[11]==3 && ord[15]==4 && ord[16]==4)
1627 : {
1628 300 : GEN t21 = perm_sqr(gel(G,cyc[15]));
1629 300 : GEN t22 = perm_sqr(gel(G,cyc[16]));
1630 300 : GEN s = perm_mul(t22, gel(G,cyc[15]));
1631 600 : return gc_GEN(av,
1632 300 : mkvec2(mkvec4(t21,t22, gel(G,cyc[11]), s), mkvecsmall4(2,2,3,2)));
1633 : }
1634 24 : if (n==36 && l==24 && ord[11]==3 && ord[15]==4)
1635 : {
1636 6 : GEN t1 = gel(G,cyc[11]), t3 = gel(G,cyc[15]);
1637 6 : return gc_GEN(av,
1638 : mkvec2(mkvec3(perm_conj(t3, t1), t1, t3), mkvecsmall3(3,3,4)));
1639 : }
1640 18 : return gc_NULL(av);
1641 : }
1642 :
1643 : static GEN
1644 1008 : subg_get_gen(GEN subg) { return gel(subg, 1); }
1645 :
1646 : static GEN
1647 7452 : subg_get_set(GEN subg) { return gel(subg, 2); }
1648 :
1649 : static GEN
1650 696 : groupelt_subg_normalize(GEN elt, GEN subg, GEN cyc)
1651 : {
1652 696 : GEN gen = subg_get_gen(subg), set = subg_get_set(subg);
1653 696 : long i, j, u, n = lg(elt)-1, lgen = lg(gen);
1654 696 : GEN b = F2v_copy(cyc), res = zero_F2v(n);
1655 42456 : for(i = 1; i <= n; i++)
1656 : {
1657 : GEN g;
1658 41760 : if (!F2v_coeff(b, i)) continue;
1659 19188 : g = gel(elt,i);
1660 654456 : for(u=1; u<=n; u++)
1661 654456 : if (g[u]==1) break;
1662 21576 : for(j=1; j<lgen; j++)
1663 : {
1664 20388 : GEN h = gel(elt,gen[j]);
1665 20388 : if (!F2v_coeff(set,g[h[u]])) break;
1666 : }
1667 19188 : if (j < lgen) continue;
1668 1188 : F2v_set(res,i);
1669 72468 : for(j=1; j <= n; j++)
1670 71280 : if (F2v_coeff(set, j))
1671 5760 : F2v_clear(b,g[gel(elt,j)[1]]);
1672 : }
1673 696 : return res;
1674 : }
1675 :
1676 : static GEN
1677 12 : triv_subg(GEN elt)
1678 : {
1679 12 : GEN v = cgetg(3, t_VEC);
1680 12 : gel(v,1) = cgetg(1,t_VECSMALL);
1681 12 : gel(v,2) = zero_F2v(lg(elt)-1);
1682 12 : F2v_set(gel(v,2),1);
1683 12 : return v;
1684 : }
1685 :
1686 : static GEN
1687 312 : subg_extend(GEN U, long e, long o, GEN elt)
1688 : {
1689 312 : long i, j, n = lg(elt)-1;
1690 312 : GEN g = gel(elt, e);
1691 312 : GEN gen = vecsmall_append(subg_get_gen(U), e);
1692 312 : GEN set = subg_get_set(U);
1693 312 : GEN Vset = zv_copy(set);
1694 19032 : for(i = 1; i <= n; i++)
1695 18720 : if (F2v_coeff(set, i))
1696 : {
1697 1080 : long h = gel(elt, i)[1];
1698 2400 : for(j = 1; j < o; j++)
1699 : {
1700 1320 : h = g[h];
1701 1320 : F2v_set(Vset, h);
1702 : }
1703 : }
1704 312 : return mkvec2(gen, Vset);
1705 : }
1706 :
1707 : static GEN
1708 372 : cyclic_subg(long e, long o, GEN elt)
1709 : {
1710 372 : long j, n = lg(elt)-1, h = 1;
1711 372 : GEN g = gel(elt, e);
1712 372 : GEN gen = mkvecsmall(e);
1713 372 : GEN set = zero_F2v(n);
1714 372 : F2v_set(set,1);
1715 1080 : for(j = 1; j < o; j++)
1716 : {
1717 708 : h = g[h];
1718 708 : F2v_set(set, h);
1719 : }
1720 372 : return mkvec2(gen, set);
1721 : }
1722 :
1723 : static GEN
1724 12 : groupelts_to_regular(GEN elt)
1725 : {
1726 12 : long i, j, n = lg(elt)-1;
1727 12 : GEN V = cgetg(n+1,t_VEC);
1728 732 : for (i=1; i<=n; i++)
1729 : {
1730 720 : pari_sp av = avma;
1731 720 : GEN g = gel(elt, i);
1732 720 : GEN W = cgetg(n+1,t_VEC);
1733 43920 : for(j=1; j<=n; j++)
1734 43200 : gel(W,j) = perm_mul(g, gel(elt,j));
1735 720 : gel(V, i) = gc_leaf(av,vecvecsmall_indexsort(W));
1736 : }
1737 12 : vecvecsmall_sort_inplace(V, NULL);
1738 12 : return V;
1739 : }
1740 :
1741 : static long
1742 372 : groupelts_pow(GEN elt, long j, long n)
1743 : {
1744 372 : GEN g = gel(elt,j);
1745 372 : long i, h = 1;
1746 1452 : for (i=1; i<=n; i++)
1747 1080 : h = g[h];
1748 372 : return h;
1749 : }
1750 :
1751 : static GEN
1752 12 : groupelts_cyclic_primepow(GEN elt, GEN *pt_pr, GEN *pt_po)
1753 : {
1754 12 : GEN R = groupelts_cyclic_subgroups(elt);
1755 12 : GEN gen = gel(R,1), ord = gel(R,2);
1756 12 : long i, n = lg(elt)-1, l = lg(gen);
1757 12 : GEN set = zero_F2v(n);
1758 12 : GEN pr = zero_Flv(n);
1759 12 : GEN po = zero_Flv(n);
1760 396 : for (i = 1; i < l; i++)
1761 : {
1762 384 : long h = gen[i];
1763 : ulong p;
1764 384 : if (uisprimepower(ord[i], &p))
1765 : {
1766 372 : F2v_set(set, h);
1767 372 : uel(pr,h) = p;
1768 372 : po[h] = groupelts_pow(elt, h, p);
1769 : }
1770 : }
1771 12 : *pt_pr = pr; *pt_po = po;
1772 12 : return set;
1773 : }
1774 :
1775 : static GEN
1776 43200 : perm_bracket(GEN p, GEN q)
1777 : {
1778 43200 : return perm_mul(perm_mul(p,q), perm_inv(perm_mul(q,p)));
1779 : }
1780 :
1781 : static GEN
1782 708 : set_groupelts(GEN S, GEN x)
1783 : {
1784 708 : long i, n = F2v_hamming(x), k=1, m = x[1];
1785 708 : GEN v = cgetg(n+1, t_VEC);
1786 43188 : for (i=1; i<=m; i++)
1787 42480 : if (F2v_coeff(x,i))
1788 4212 : gel(v,k++) = gel(S,i);
1789 708 : return v;
1790 : }
1791 :
1792 : static GEN
1793 12 : set_idx(GEN x)
1794 : {
1795 12 : long i, n = F2v_hamming(x), k=1, m = x[1];
1796 12 : GEN v = cgetg(n+1, t_VECSMALL);
1797 732 : for (i=1; i<=m; i++)
1798 720 : if (F2v_coeff(x,i))
1799 720 : uel(v,k++) = i;
1800 12 : return v;
1801 : }
1802 :
1803 : static GEN
1804 12 : set_derived(GEN set, GEN elts)
1805 : {
1806 12 : long i, j, l = lg(elts);
1807 12 : GEN V = zero_F2v(l-1);
1808 732 : for(i = 1; i < l; i++)
1809 720 : if (F2v_coeff(set, i))
1810 43920 : for(j = 1; j < l; j++)
1811 43200 : if (F2v_coeff(set, j))
1812 43200 : F2v_set(V, perm_bracket(gel(elts,i),gel(elts,j))[1]);
1813 12 : return V;
1814 : }
1815 :
1816 : static GEN
1817 12 : groupelts_residuum(GEN elts)
1818 : {
1819 12 : pari_sp av = avma;
1820 12 : long o = lg(elts)-1, oo;
1821 12 : GEN set = const_F2v(o);
1822 : do
1823 : {
1824 12 : oo = o;
1825 12 : set = set_derived(set, elts);
1826 12 : o = F2v_hamming(set);
1827 12 : } while (o > 1 && o < oo);
1828 12 : if (o==1) return NULL;
1829 12 : return gc_GEN(av,mkvec2(set_idx(set), set));
1830 : }
1831 :
1832 : static GEN
1833 12 : all_cyclic_subg(GEN pr, GEN po, GEN elt)
1834 : {
1835 12 : long i, n = lg(pr)-1, m = 0, k = 1;
1836 : GEN W;
1837 732 : for (i=1; i <= n; i++)
1838 720 : m += po[i]==1;
1839 12 : W = cgetg(m+1, t_VEC);
1840 732 : for (i=1; i <= n; i++)
1841 720 : if (po[i]==1)
1842 372 : gel(W, k++) = cyclic_subg(i, pr[i], elt);
1843 12 : return W;
1844 : }
1845 :
1846 : static GEN
1847 12 : groupelts_subgroups_raw(GEN elts)
1848 : {
1849 12 : pari_sp av = avma;
1850 12 : GEN elt = groupelts_to_regular(elts);
1851 12 : GEN pr, po, cyc = groupelts_cyclic_primepow(elt, &pr, &po);
1852 12 : long n = lg(elt)-1;
1853 12 : long i, j, nS = 1;
1854 12 : GEN S, L, R = NULL;
1855 12 : S = cgetg(1+bigomegau(n)+1, t_VEC);
1856 12 : gel(S, nS++) = mkvec(triv_subg(elt));
1857 12 : gel(S, nS++) = L = all_cyclic_subg(pr, po, elt);
1858 12 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS-1,lg(L)-1);
1859 60 : while (lg(L) > 1)
1860 : {
1861 48 : pari_sp av2 = avma;
1862 48 : long nW = 1, lL = lg(L);
1863 48 : long ng = n;
1864 48 : GEN W = cgetg(1+ng, t_VEC);
1865 744 : for (i=1; i<lL; i++)
1866 : {
1867 696 : GEN U = gel(L, i), set = subg_get_set(U);
1868 696 : GEN G = groupelt_subg_normalize(elt, U, cyc);
1869 6132 : for (j=1; j<nW; j++)
1870 : {
1871 5436 : GEN Wj = subg_get_set(gel(W, j));
1872 5436 : if (F2v_subset(set, Wj))
1873 624 : F2v_negimply_inplace(G, Wj);
1874 : }
1875 42456 : for (j=1; j<=n; j++)
1876 41760 : if(F2v_coeff(G,j))
1877 : {
1878 660 : long p = pr[j];
1879 660 : if (F2v_coeff(set, j)) continue;
1880 312 : if (F2v_coeff(set, po[j]))
1881 : {
1882 312 : GEN U2 = subg_extend(U, j, p, elt);
1883 312 : F2v_negimply_inplace(G, subg_get_set(U2));
1884 312 : if (nW > ng) { ng<<=1; W = vec_lengthen(W, ng); }
1885 312 : gel(W, nW++) = U2;
1886 : }
1887 : }
1888 : }
1889 48 : setlg(W, nW);
1890 48 : L = W;
1891 48 : if (nW > 1) gel(S, nS++) = L = gc_GEN(av2, W);
1892 48 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS-1,nW-1);
1893 48 : if (lg(L)==1 && !R)
1894 : {
1895 12 : R = groupelts_residuum(elt);
1896 12 : if (!R) break;
1897 12 : gel(S, nS++) = L = mkvec(R);
1898 : }
1899 : }
1900 12 : setlg(S, nS);
1901 12 : return gc_GEN(av, shallowconcat1(S));
1902 : }
1903 :
1904 : static GEN
1905 12 : subg_to_elts(GEN S, GEN x)
1906 720 : { pari_APPLY_type(t_VEC, set_groupelts(S, gmael(x,i,2))); }
1907 :
1908 : GEN
1909 12 : groupelts_solvablesubgroups(GEN G)
1910 : {
1911 12 : pari_sp av = avma;
1912 12 : GEN S = vecvecsmall_sort(checkgroupelts(G));
1913 12 : GEN L = groupelts_subgroups_raw(S);
1914 12 : return gc_GEN(av, subg_to_elts(S, L));
1915 : }
|
