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 1855 : vec_isconst(GEN v)
25 : {
26 1855 : long i, l = lg(v);
27 : GEN w;
28 1855 : if (l==1) return 1;
29 1855 : w = gel(v,1);
30 6384 : for(i=2; i<l; i++)
31 5796 : if (!gequal(gel(v,i), w)) return 0;
32 588 : return 1;
33 : }
34 :
35 : int
36 17944 : vecsmall_isconst(GEN v)
37 : {
38 17944 : long i, l = lg(v);
39 : ulong w;
40 17944 : if (l==1) return 1;
41 17944 : w = uel(v,1);
42 30812 : for(i=2; i<l; i++)
43 24769 : if (uel(v,i) != w) return 0;
44 6043 : 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 98084 : vec_insert(GEN v, long n, GEN x)
64 : {
65 98084 : long i, l=lg(v);
66 98084 : GEN V = cgetg(l+1,t_VEC);
67 711340 : for(i=1; i<n; i++) gel(V,i) = gel(v,i);
68 98084 : gel(V,n) = x;
69 471646 : for(i=n+1; i<=l; i++) gel(V,i) = gel(v,i-1);
70 98084 : 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 272880716 : vecsmall_sortspec(GEN v, long n, GEN w)
81 : {
82 272880716 : pari_sp ltop=avma;
83 272880716 : long nx=n>>1, ny=n-nx;
84 : long m, ix, iy;
85 : GEN x, y;
86 272880716 : if (n<=2)
87 : {
88 158560903 : if (n==1)
89 33999422 : w[0]=v[0];
90 124561481 : else if (n==2)
91 : {
92 129956594 : long v0=v[0], v1=v[1];
93 129956594 : if (v0<=v1) { w[0]=v0; w[1]=v1; }
94 4164607 : else { w[0]=v1; w[1]=v0; }
95 : }
96 158560903 : return;
97 : }
98 114319813 : x=new_chunk(nx); y=new_chunk(ny);
99 123810538 : vecsmall_sortspec(v,nx,x);
100 124231592 : vecsmall_sortspec(v+nx,ny,y);
101 553905876 : for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
102 427494012 : if (x[ix]<=y[iy])
103 359963867 : w[m++]=x[ix++];
104 : else
105 67530145 : w[m++]=y[iy++];
106 129336109 : for(;ix<nx;) w[m++]=x[ix++];
107 471530818 : for(;iy<ny;) w[m++]=y[iy++];
108 126411864 : set_avma(ltop);
109 : }
110 :
111 : static long
112 48544379 : vecsmall_sort_max(GEN v)
113 : {
114 48544379 : long i, l = lg(v), max = -1;
115 162067985 : for (i = 1; i < l; i++)
116 160391801 : if (v[i] > max) { max = v[i]; if (max >= l) return -1; }
117 21909326 : else if (v[i] < 0) return -1;
118 1713833 : return max;
119 : }
120 : /* assume 0 <= v[i] <= M. In place. */
121 : void
122 1970936 : vecsmall_counting_sort(GEN v, long M)
123 : {
124 : pari_sp av;
125 : long i, j, k, l;
126 : GEN T;
127 1970936 : if (M == 0) return;
128 1970936 : av = avma; T = new_chunk(M + 1); l = lg(v);
129 9565769 : for (i = 0; i <= M; i++) T[i] = 0;
130 7652729 : for (i = 1; i < l; i++) T[v[i]]++; /* T[j] is # keys = j */
131 9565769 : for (j = 0, k = 1; j <= M; j++)
132 13276628 : for (i = 1; i <= T[j]; i++) v[k++] = j;
133 1970938 : set_avma(av);
134 : }
135 : /* not GC-clean, suitable for gc_upto */
136 : GEN
137 16129 : vecsmall_counting_uniq(GEN v, long M)
138 : {
139 16129 : long i, k, l = lg(v);
140 : GEN T, U;
141 16129 : if (l == 1) return cgetg(1, t_VECSMALL);
142 16129 : if (M == 0) return mkvecsmall(0);
143 16129 : if (l == 2) return leafcopy(v);
144 15989 : U = new_chunk(M + 2);
145 15989 : T = U+1; /* allows to rewrite result over T also if T[0] = 1 */
146 124283 : for (i = 0; i <= M; i++) T[i] = 0;
147 201788 : for (i = 1; i < l; i++) T[v[i]] = 1;
148 124283 : for (i = 0, k = 1; i <= M; i++)
149 108294 : if (T[i]) U[k++] = i;
150 15989 : U[0] = evaltyp(t_VECSMALL) | _evallg(k); return U;
151 : }
152 : GEN
153 12923 : vecsmall_counting_indexsort(GEN v, long M)
154 : {
155 : pari_sp av;
156 12923 : long i, l = lg(v);
157 : GEN T, p;
158 12923 : if (M == 0 || l <= 2) return identity_zv(l - 1);
159 12909 : p = cgetg(l, t_VECSMALL); av = avma; T = new_chunk(M + 1);
160 57774 : for (i = 0; i <= M; i++) T[i] = 0;
161 14435521 : for (i = 1; i < l; i++) T[v[i]]++; /* T[j] is # keys = j */
162 44865 : for (i = 1; i <= M; i++) T[i] += T[i-1]; /* T[j] is # keys <= j */
163 14435521 : for (i = l-1; i > 0; i--) { p[T[v[i]]] = i; T[v[i]]--; }
164 12909 : return gc_const(av, p);
165 : }
166 :
167 : /* in place sort */
168 : void
169 53019401 : vecsmall_sort(GEN v)
170 : {
171 53019401 : long n = lg(v) - 1, max;
172 53019401 : if (n <= 1) return;
173 46295838 : if ((max = vecsmall_sort_max(v)) >= 0)
174 1970936 : vecsmall_counting_sort(v, max);
175 : else
176 44201177 : vecsmall_sortspec(v+1, n, v+1);
177 : }
178 :
179 : /* cf gen_sortspec */
180 : static GEN
181 8239185 : vecsmall_indexsortspec(GEN v, long n)
182 : {
183 : long nx, ny, m, ix, iy;
184 : GEN x, y, w;
185 8239185 : switch(n)
186 : {
187 160031 : case 1: return mkvecsmall(1);
188 3721125 : case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
189 1476066 : case 3:
190 1476066 : if (v[1] <= v[2]) {
191 708820 : if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
192 211246 : return (v[1] <= v[3])? mkvecsmall3(1,3,2)
193 633007 : : mkvecsmall3(3,1,2);
194 : } else {
195 767246 : if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
196 287923 : return (v[2] <= v[3])? mkvecsmall3(2,3,1)
197 872952 : : mkvecsmall3(3,2,1);
198 : }
199 : }
200 2881963 : nx = n>>1; ny = n-nx;
201 2881963 : w = cgetg(n+1,t_VECSMALL);
202 2881966 : x = vecsmall_indexsortspec(v,nx);
203 2881967 : y = vecsmall_indexsortspec(v+nx,ny);
204 34334003 : for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
205 31452036 : if (v[x[ix]] <= v[y[iy]+nx])
206 15217892 : w[m++] = x[ix++];
207 : else
208 16234144 : w[m++] = y[iy++]+nx;
209 5486835 : for(;ix<=nx;) w[m++] = x[ix++];
210 5478490 : for(;iy<=ny;) w[m++] = y[iy++]+nx;
211 2881967 : set_avma((pari_sp)w); return w;
212 : }
213 :
214 : /*indirect sort.*/
215 : GEN
216 2488242 : vecsmall_indexsort(GEN v)
217 : {
218 2488242 : long n = lg(v) - 1, max;
219 2488242 : if (n==0) return cgetg(1, t_VECSMALL);
220 2488179 : if ((max = vecsmall_sort_max(v)) >= 0)
221 12923 : return vecsmall_counting_indexsort(v, max);
222 : else
223 2475256 : return vecsmall_indexsortspec(v,n);
224 : }
225 :
226 : /* assume V sorted */
227 : GEN
228 31390 : vecsmall_uniq_sorted(GEN v)
229 : {
230 : long i, j, l;
231 31390 : GEN w = cgetg_copy(v, &l);
232 31390 : if (l == 1) return w;
233 31336 : w[1] = v[1];
234 34309 : for(i = j = 2; i < l; i++)
235 2973 : if (v[i] != w[j-1]) w[j++] = v[i];
236 31336 : stackdummy((pari_sp)(w + l), (pari_sp)(w + j));
237 31336 : setlg(w, j); return w;
238 : }
239 :
240 : GEN
241 16488 : vecsmall_uniq(GEN v)
242 : {
243 16488 : pari_sp av = avma;
244 : long max;
245 16488 : if ((max = vecsmall_sort_max(v)) >= 0)
246 16129 : v = vecsmall_counting_uniq(v, max);
247 : else
248 359 : { v = zv_copy(v); vecsmall_sort(v); v = vecsmall_uniq_sorted(v); }
249 16488 : 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 21157 : vecsmall_duplicate(GEN x)
265 : {
266 21157 : pari_sp av = avma;
267 21157 : GEN p = vecsmall_indexsort(x);
268 21157 : long k, i, r = 0, l = lg(x);
269 21157 : if (l == 1) return gc_long(av, 0);
270 29536 : for (k = x[p[1]], i = 2; i < l; k = x[p[i++]])
271 8379 : if (x[p[i]] == k) { r = p[i]; break; }
272 21157 : return gc_long(av, r);
273 : }
274 :
275 : static int
276 55450 : vecsmall_is1to1spec(GEN v, long n, GEN w)
277 : {
278 55450 : pari_sp av = avma;
279 55450 : long nx = n>>1, ny = n - nx, m, ix, iy;
280 : GEN x, y;
281 55450 : if (n <= 2)
282 : {
283 33378 : if (n == 1) w[0] = v[0];
284 21813 : else if (n==2)
285 : {
286 21813 : long v0 = v[0], v1 = v[1];
287 21813 : if (v0 == v1) return 0;
288 21785 : else if (v0 < v1) { w[0] = v0; w[1] = v1; }
289 4639 : else { w[0] = v1; w[1] = v0; }
290 : }
291 33350 : return 1;
292 : }
293 22072 : x = new_chunk(nx); if (!vecsmall_is1to1spec(v, nx, x)) return 0;
294 21974 : y = new_chunk(ny); if (!vecsmall_is1to1spec(v+nx, ny, y)) return 0;
295 85311 : for (m = ix = iy = 0; ix < nx && iy < ny; )
296 63435 : if (x[ix] == y[iy]) return 0;
297 63386 : else if (x[ix] < y[iy])
298 38694 : w[m++] = x[ix++];
299 : else
300 24692 : w[m++] = y[iy++];
301 24014 : while (ix < nx) w[m++] = x[ix++];
302 54572 : while (iy < ny) w[m++] = y[iy++];
303 21876 : return gc_bool(av, 1);
304 : }
305 :
306 : int
307 11530 : vecsmall_is1to1(GEN V)
308 : {
309 11530 : pari_sp av = avma;
310 : long l;
311 11530 : GEN W = cgetg_copy(V, &l);
312 11530 : 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 21 : vecvecsmall_sort(GEN x)
323 21 : { return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
324 : GEN
325 370881 : vecvecsmall_sort_shallow(GEN x)
326 370881 : { return gen_sort_shallow(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
327 :
328 : void
329 133 : vecvecsmall_sort_inplace(GEN x, GEN *perm)
330 133 : { gen_sort_inplace(x, (void*)&vecsmall_lexcmp, cmp_nodata, perm); }
331 :
332 : GEN
333 462 : vecvecsmall_sort_uniq(GEN x)
334 462 : { return gen_sort_uniq(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
335 :
336 : GEN
337 1281 : vecvecsmall_indexsort(GEN x)
338 1281 : { return gen_indexsort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
339 :
340 : long
341 22934359 : vecvecsmall_search(GEN x, GEN y)
342 22934359 : { 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 21 : perm_mul_inplace2(GEN s, GEN t)
370 : {
371 21 : long i, l = lg(s);
372 525 : for (i = 1; i < l; i++) t[i] = s[t[i]];
373 21 : }
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 461186 : vecperm_orbits_i(GEN v, long n)
418 : {
419 461186 : long mj = 1, lv = lg(v), k, l;
420 461186 : GEN cycle = cgetg(n+1, t_VEC), bit = const_vecsmall(n, 0);
421 3410721 : for (k = 1, l = 1; k <= n;)
422 : {
423 2949488 : pari_sp ltop = avma;
424 2949488 : long m = 1;
425 2949488 : GEN cy = cgetg(n+1, t_VECSMALL);
426 4241663 : for ( ; bit[mj]; mj++) /*empty*/;
427 2949446 : k++; cy[m++] = mj;
428 2949446 : bit[mj++] = 1;
429 : for(;;)
430 2116440 : {
431 5065886 : long o, mold = m;
432 10145840 : for (o = 1; o < lv; o++)
433 : {
434 5079954 : GEN vo = gel(v,o);
435 : long p;
436 20514550 : for (p = 1; p < m; p++) /* m increases! */
437 : {
438 15434596 : long j = vo[ cy[p] ];
439 15434596 : if (!bit[j]) cy[m++] = j;
440 15434596 : bit[j] = 1;
441 : }
442 : }
443 5065886 : if (m == mold) break;
444 2116440 : k += m - mold;
445 : }
446 2949446 : setlg(cy, m);
447 2949490 : gel(cycle,l++) = gc_leaf(ltop, cy);
448 : }
449 461233 : setlg(cycle, l); return cycle;
450 : }
451 : /* memory clean version */
452 : GEN
453 4893 : vecperm_orbits(GEN v, long n)
454 : {
455 4893 : pari_sp av = avma;
456 4893 : return gc_GEN(av, vecperm_orbits_i(v, n));
457 : }
458 :
459 : static int
460 2667 : isperm(GEN v)
461 : {
462 2667 : pari_sp av = avma;
463 2667 : long i, n = lg(v)-1;
464 : GEN w;
465 2667 : if (typ(v) != t_VECSMALL) return 0;
466 2667 : w = zero_zv(n);
467 26411 : for (i=1; i<=n; i++)
468 : {
469 23779 : long d = v[i];
470 23779 : if (d < 1 || d > n || w[d]) return gc_bool(av,0);
471 23744 : w[d] = 1;
472 : }
473 2632 : return gc_bool(av,1);
474 : }
475 :
476 : /* Compute the cyclic decomposition of a permutation */
477 : GEN
478 14121 : perm_cycles(GEN v)
479 : {
480 14121 : pari_sp av = avma;
481 14121 : return gc_GEN(av, vecperm_orbits_i(mkvec(v), lg(v)-1));
482 : }
483 :
484 : GEN
485 259 : permcycles(GEN v)
486 : {
487 259 : if (!isperm(v)) pari_err_TYPE("permcycles",v);
488 252 : return perm_cycles(v);
489 : }
490 :
491 : /* Output the order of p */
492 : ulong
493 441764 : perm_orderu(GEN v)
494 : {
495 441764 : pari_sp av = avma;
496 441764 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
497 : long i, d;
498 3323123 : for(i=1, d=1; i<lg(c); i++) d = ulcm(d, lg(gel(c,i))-1);
499 441794 : return gc_ulong(av,d);
500 : }
501 :
502 : static GEN
503 2002 : _domul(void *data, GEN x, GEN y)
504 : {
505 2002 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
506 2002 : return mul(x,y);
507 : }
508 :
509 : /* Output the order of p */
510 : GEN
511 427 : perm_order(GEN v)
512 : {
513 427 : pari_sp av = avma;
514 427 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
515 427 : long i, l = lg(c);
516 427 : GEN V = cgetg(l, t_VEC);
517 2856 : for (i = 1; i < l; i++)
518 2429 : gel(V,i) = utoi(lg(gel(c,i))-1);
519 427 : return gc_INT(av, gen_product(V, (void *)lcmii, _domul));
520 : }
521 :
522 : GEN
523 434 : permorder(GEN v)
524 : {
525 434 : if (!isperm(v)) pari_err_TYPE("permorder",v);
526 427 : return perm_order(v);
527 : }
528 :
529 : /* sign of a permutation */
530 : long
531 968298 : perm_sign(GEN v)
532 : {
533 968298 : pari_sp av = avma;
534 968298 : long n = lg(v), s = 1;
535 968298 : GEN w = perm_inv(v);
536 968298 : v = vecsmall_copy(v); /* Following lines update v and w in place */
537 5357040 : while (--n > 1)
538 : { /* At this stage, v[1..n] and w[1..n] are inverse of each other.
539 : * Indices > n are implicitly fixed points, not updated */
540 4388740 : long i = v[n];
541 4388740 : if (i != n)
542 : { /* apply transposition tau_{i,n} to v and w; n becomes a fixed point */
543 659899 : long j = w[n];
544 659899 : v[j] = i;
545 659899 : w[i] = j;
546 659899 : s = -s;
547 : }
548 : }
549 968300 : return gc_long(av,s);
550 : }
551 :
552 : long
553 273 : permsign(GEN v)
554 : {
555 273 : if (!isperm(v)) pari_err_TYPE("permsign",v);
556 259 : return perm_sign(v);
557 : }
558 :
559 : GEN
560 5915 : Z_to_perm(long n, GEN x)
561 : {
562 : pari_sp av;
563 : ulong i, r;
564 5915 : GEN v = cgetg(n+1, t_VECSMALL);
565 5915 : if (n==0) return v;
566 5908 : uel(v,n) = 1; av = avma;
567 5908 : if (signe(x) <= 0) x = modii(x, mpfact(n));
568 27146 : for (r=n-1; r>=1; r--)
569 : {
570 : ulong a;
571 21238 : x = absdiviu_rem(x, n+1-r, &a);
572 71687 : for (i=r+1; i<=(ulong)n; i++)
573 50449 : if (uel(v,i) > a) uel(v,i)++;
574 21238 : uel(v,r) = a+1;
575 : }
576 5908 : return gc_const(av, v);
577 : }
578 : GEN
579 5915 : numtoperm(long n, GEN x)
580 : {
581 5915 : if (n < 0) pari_err_DOMAIN("numtoperm", "n", "<", gen_0, stoi(n));
582 5915 : if (typ(x) != t_INT) pari_err_TYPE("numtoperm",x);
583 5915 : return Z_to_perm(n, x);
584 : }
585 :
586 : /* destroys v */
587 : static GEN
588 1701 : perm_to_Z_inplace(GEN v)
589 : {
590 1701 : long l = lg(v), i, r;
591 1701 : GEN x = gen_0;
592 1701 : if (!isperm(v)) return NULL;
593 10143 : for (i = 1; i < l; i++)
594 : {
595 8449 : long vi = v[i];
596 8449 : x = i==1 ? utoi(vi-1): addiu(muliu(x,l-i), vi-1);
597 25396 : for (r = i+1; r < l; r++)
598 16947 : if (v[r] > vi) v[r]--;
599 : }
600 1694 : return x;
601 : }
602 : GEN
603 1680 : perm_to_Z(GEN v)
604 : {
605 1680 : pari_sp av = avma;
606 1680 : GEN x = perm_to_Z_inplace(leafcopy(v));
607 1680 : if (!x) pari_err_TYPE("permtonum",v);
608 1680 : return gc_INT(av, x);
609 : }
610 : GEN
611 1708 : permtonum(GEN p)
612 : {
613 1708 : pari_sp av = avma;
614 : GEN v, x;
615 1708 : switch(typ(p))
616 : {
617 1680 : case t_VECSMALL: return perm_to_Z(p);
618 21 : case t_VEC: case t_COL:
619 21 : if (RgV_is_ZV(p)) { v = ZV_to_zv(p); break; }
620 7 : default: pari_err_TYPE("permtonum",p);
621 : return NULL;/*LCOV_EXCL_LINE*/
622 : }
623 21 : x = perm_to_Z_inplace(v);
624 21 : if (!x) pari_err_TYPE("permtonum",p);
625 14 : return gc_INT(av, x);
626 : }
627 :
628 : GEN
629 7512 : cyc_pow(GEN cyc, long exp)
630 : {
631 : long i, j, k, l, r;
632 : GEN c;
633 22591 : for (r = j = 1; j < lg(cyc); j++)
634 : {
635 15079 : long n = lg(gel(cyc,j)) - 1;
636 15079 : r += cgcd(n, exp);
637 : }
638 7512 : c = cgetg(r, t_VEC);
639 22591 : for (r = j = 1; j < lg(cyc); j++)
640 : {
641 15079 : GEN v = gel(cyc,j);
642 15079 : long n = lg(v) - 1, e = umodsu(exp,n), g = (long)ugcd(n, e), m = n / g;
643 32076 : for (i = 0; i < g; i++)
644 : {
645 16997 : GEN p = cgetg(m+1, t_VECSMALL);
646 16997 : gel(c,r++) = p;
647 55352 : for (k = 1, l = i; k <= m; k++)
648 : {
649 38355 : p[k] = v[l+1];
650 38355 : l += e; if (l >= n) l -= n;
651 : }
652 : }
653 : }
654 7512 : return c;
655 : }
656 :
657 : /* Compute the power of a permutation given by product of cycles
658 : * Ouput a perm, not a cyc */
659 : GEN
660 0 : cyc_pow_perm(GEN cyc, long exp)
661 : {
662 : long e, j, k, l, n;
663 : GEN p;
664 0 : for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
665 0 : p = cgetg(n + 1, t_VECSMALL);
666 0 : for (j = 1; j < lg(cyc); j++)
667 : {
668 0 : GEN v = gel(cyc,j);
669 0 : n = lg(v) - 1; e = umodsu(exp, n);
670 0 : for (k = 1, l = e; k <= n; k++)
671 : {
672 0 : p[v[k]] = v[l+1];
673 0 : if (++l == n) l = 0;
674 : }
675 : }
676 0 : return p;
677 : }
678 :
679 : GEN
680 77 : perm_pow(GEN perm, GEN exp)
681 : {
682 77 : long i, r = lg(perm)-1;
683 77 : GEN p = zero_zv(r);
684 77 : pari_sp av = avma;
685 77 : GEN v = cgetg(r+1, t_VECSMALL);
686 273 : for (i=1; i<=r; i++)
687 : {
688 : long e, n, k, l;
689 196 : if (p[i]) continue;
690 77 : v[1] = i;
691 196 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
692 77 : e = umodiu(exp, n);
693 273 : for (k = 1, l = e; k <= n; k++)
694 : {
695 196 : p[v[k]] = v[l+1];
696 196 : if (++l == n) l = 0;
697 : }
698 : }
699 77 : return gc_const(av, p);
700 : }
701 :
702 : GEN
703 19194 : perm_powu(GEN perm, ulong exp)
704 : {
705 19194 : ulong i, r = lg(perm)-1;
706 19194 : GEN p = zero_zv(r);
707 19194 : pari_sp av = avma;
708 19194 : GEN v = cgetg(r+1, t_VECSMALL);
709 265174 : for (i=1; i<=r; i++)
710 : {
711 : ulong e, n, k, l;
712 245980 : if (p[i]) continue;
713 92190 : v[1] = i;
714 245980 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
715 92190 : e = exp % n;
716 338170 : for (k = 1, l = e; k <= n; k++)
717 : {
718 245980 : p[v[k]] = v[l+1];
719 245980 : if (++l == n) l = 0;
720 : }
721 : }
722 19194 : return gc_const(av, p);
723 : }
724 :
725 : GEN
726 441 : perm_to_GAP(GEN p)
727 : {
728 441 : pari_sp ltop=avma;
729 : GEN gap;
730 : GEN x;
731 : long i;
732 441 : long nb, c=0;
733 : char *s;
734 : long sz;
735 441 : long lp=lg(p)-1;
736 441 : if (typ(p) != t_VECSMALL) pari_err_TYPE("perm_to_GAP",p);
737 441 : x = perm_cycles(p);
738 441 : sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
739 : /*Dry run*/
740 8939 : for (i = 1, nb = 1; i < lg(x); ++i)
741 : {
742 8498 : GEN z = gel(x,i);
743 8498 : long lz = lg(z)-1;
744 8498 : nb += 1+lz*(sz+2);
745 : }
746 441 : nb++;
747 : /*Real run*/
748 441 : gap = cgetg(nchar2nlong(nb) + 1, t_STR);
749 441 : s = GSTR(gap);
750 8939 : for (i = 1; i < lg(x); ++i)
751 : {
752 : long j;
753 8498 : GEN z = gel(x,i);
754 8498 : if (lg(z) > 2)
755 : {
756 8078 : s[c++] = '(';
757 33110 : for (j = 1; j < lg(z); ++j)
758 : {
759 25032 : if (j > 1)
760 : {
761 16954 : s[c++] = ','; s[c++] = ' ';
762 : }
763 25032 : sprintf(s+c,"%ld",z[j]);
764 71190 : while(s[c++]) /* empty */;
765 25032 : c--;
766 : }
767 8078 : s[c++] = ')';
768 : }
769 : }
770 441 : if (!c) { s[c++]='('; s[c++]=')'; }
771 441 : s[c] = '\0';
772 441 : return gc_upto(ltop,gap);
773 : }
774 :
775 : int
776 572901 : perm_commute(GEN s, GEN t)
777 : {
778 572901 : long i, l = lg(t);
779 40382209 : for (i = 1; i < l; i++)
780 39828957 : if (t[ s[i] ] != s[ t[i] ]) return 0;
781 553252 : return 1;
782 : }
783 :
784 : /*************************************************************************/
785 : /** **/
786 : /** Routines for handling groups **/
787 : /** **/
788 : /*************************************************************************/
789 : /* A Group is a t_VEC [gen,orders]
790 : * gen (vecvecsmall): list of generators given by permutations
791 : * orders (vecsmall): relatives orders of generators. */
792 951635 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
793 1612490 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
794 :
795 : /* A Quotient Group is a t_VEC [gen,coset]
796 : * gen (vecvecsmall): coset generators
797 : * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
798 : */
799 142688 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
800 30408 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
801 :
802 : static GEN
803 52570 : trivialsubgroups(void)
804 52570 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
805 :
806 : /* Compute the order of p modulo the group given by a set */
807 : long
808 220332 : perm_relorder(GEN p, GEN set)
809 : {
810 220332 : pari_sp ltop = avma;
811 220332 : long n = 1, q = p[1];
812 654759 : while (!F2v_coeff(set,q)) { q = p[q]; n++; }
813 220332 : return gc_long(ltop,n);
814 : }
815 :
816 : GEN
817 13104 : perm_generate(GEN S, GEN H, long o)
818 : {
819 13104 : long i, n = lg(H)-1;
820 13104 : GEN L = cgetg(n*o + 1, t_VEC);
821 45941 : for(i=1; i<=n; i++) gel(L,i) = vecsmall_copy(gel(H,i));
822 50813 : for( ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
823 13104 : return L;
824 : }
825 :
826 : /*Return the order (cardinality) of a group */
827 : long
828 718570 : group_order(GEN G)
829 : {
830 718570 : return zv_prod(grp_get_ord(G));
831 : }
832 :
833 : /* G being a subgroup of S_n, output n */
834 : long
835 27391 : group_domain(GEN G)
836 : {
837 27391 : GEN gen = grp_get_gen(G);
838 27391 : if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
839 27391 : return lg(gel(gen,1)) - 1;
840 : }
841 :
842 : /*Left coset of g mod G: gG*/
843 : GEN
844 307433 : group_leftcoset(GEN G, GEN g)
845 : {
846 307433 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
847 307433 : GEN res = cgetg(group_order(G)+1, t_VEC);
848 : long i, j, k;
849 307433 : gel(res,1) = vecsmall_copy(g);
850 307433 : k = 1;
851 566237 : for (i = 1; i < lg(gen); i++)
852 : {
853 258804 : long c = k * (ord[i] - 1);
854 713993 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
855 : }
856 307433 : return res;
857 : }
858 : /*Right coset of g mod G: Gg*/
859 : GEN
860 184758 : group_rightcoset(GEN G, GEN g)
861 : {
862 184758 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
863 184758 : GEN res = cgetg(group_order(G)+1, t_VEC);
864 : long i, j, k;
865 184758 : gel(res,1) = vecsmall_copy(g);
866 184758 : k = 1;
867 320551 : for (i = 1; i < lg(gen); i++)
868 : {
869 135793 : long c = k * (ord[i] - 1);
870 427371 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
871 : }
872 184758 : return res;
873 : }
874 : /*Elements of a group from the generators, cf group_leftcoset*/
875 : GEN
876 141813 : group_elts(GEN G, long n)
877 : {
878 141813 : if (lg(G)==3 && typ(gel(G,1))==t_VEC)
879 : {
880 141813 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
881 141812 : GEN res = cgetg(group_order(G)+1, t_VEC);
882 : long i, j, k;
883 141812 : gel(res,1) = identity_perm(n);
884 141813 : k = 1;
885 287826 : for (i = 1; i < lg(gen); i++)
886 : {
887 146013 : long c = k * (ord[i] - 1);
888 : /* j = 1, use res[1] = identity */
889 146013 : gel(res,++k) = vecsmall_copy(gel(gen,i));
890 388738 : for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
891 : }
892 141813 : return res;
893 0 : } else return gcopy(G);
894 : }
895 :
896 : GEN
897 14448 : groupelts_conj_set(GEN elts, GEN p)
898 : {
899 14448 : long i, j, l = lg(elts), n = lg(p)-1;
900 14448 : GEN res = zero_F2v(n);
901 241465 : for(j = 1; j < n; j++)
902 241465 : if (p[j]==1) break;
903 101136 : for(i = 1; i < l; i++)
904 86688 : F2v_set(res, p[mael(elts,i,j)]);
905 14448 : return res;
906 : }
907 :
908 : GEN
909 28182 : groupelts_set(GEN elts, long n)
910 : {
911 28182 : GEN res = zero_F2v(n);
912 28182 : long i, l = lg(elts);
913 137886 : for(i=1; i<l; i++)
914 109704 : F2v_set(res,mael(elts,i,1));
915 28182 : return res;
916 : }
917 :
918 : /*Elements of a group from the generators, returned as a set (bitmap)*/
919 : GEN
920 90727 : group_set(GEN G, long n)
921 : {
922 90727 : GEN res = zero_F2v(n);
923 90727 : pari_sp av = avma;
924 90727 : GEN elts = group_elts(G, n);
925 90727 : long i, l = lg(elts);
926 284326 : for(i=1; i<l; i++)
927 193599 : F2v_set(res,mael(elts,i,1));
928 90727 : return gc_const(av, res);
929 : }
930 :
931 : static int
932 17353 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
933 :
934 : GEN
935 497 : subgroups_tableset(GEN S, long n)
936 : {
937 497 : long i, l = lg(S);
938 497 : GEN v = cgetg(l, t_VEC);
939 5411 : for(i=1; i<l; i++)
940 4914 : gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
941 497 : gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
942 497 : return v;
943 : }
944 :
945 : long
946 2002 : tableset_find_index(GEN tbl, GEN set)
947 : {
948 2002 : long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
949 2002 : if (!i) return 0;
950 2002 : return mael3(tbl,i,2,1);
951 : }
952 :
953 : GEN
954 52612 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
955 :
956 : /*Cyclic group generated by g of order s*/
957 : GEN
958 29162 : cyclicgroup(GEN g, long s)
959 29162 : { retmkvec2(mkvec( vecsmall_copy(g) ), mkvecsmall(s)); }
960 :
961 : /*Return the group generated by g1,g2 of relative orders s1,s2*/
962 : GEN
963 1085 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
964 1085 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
965 : mkvecsmall2(s1, s2) ); }
966 :
967 : /* return the quotient map G --> G/H */
968 : /*The ouput is [gen,hash]*/
969 : /* gen (vecvecsmall): coset generators
970 : * coset (vecsmall): vecsmall of coset number) */
971 : GEN
972 11928 : groupelts_quotient(GEN elt, GEN H)
973 : {
974 11928 : pari_sp ltop = avma;
975 : GEN p2, p3;
976 11928 : long i, j, a = 1;
977 11928 : long n = lg(gel(elt,1))-1, o = group_order(H);
978 : GEN el;
979 11928 : long le = lg(elt)-1;
980 11928 : GEN used = zero_F2v(le+1);
981 11928 : long l = le/o;
982 11928 : p2 = cgetg(l+1, t_VEC);
983 11928 : p3 = zero_zv(n);
984 11928 : el = zero_zv(n);
985 151676 : for (i = 1; i<=le; i++)
986 139748 : el[mael(elt,i,1)]=i;
987 69321 : for (i = 1; i <= l; ++i)
988 : {
989 : GEN V;
990 151445 : while(F2v_coeff(used,a)) a++;
991 57400 : V = group_leftcoset(H,gel(elt,a));
992 57400 : gel(p2,i) = gel(V,1);
993 197043 : for(j=1;j<lg(V);j++)
994 : {
995 139650 : long b = el[mael(V,j,1)];
996 139650 : if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
997 139643 : F2v_set(used,b);
998 : }
999 197029 : for (j = 1; j <= o; j++)
1000 139636 : p3[mael(V, j, 1)] = i;
1001 : }
1002 11921 : return gc_GEN(ltop,mkvec2(p2,p3));
1003 : }
1004 :
1005 : GEN
1006 10269 : group_quotient(GEN G, GEN H)
1007 : {
1008 10269 : return groupelts_quotient(group_elts(G, group_domain(G)), H);
1009 : }
1010 :
1011 : /*Compute the image of a permutation by a quotient map.*/
1012 : GEN
1013 30408 : quotient_perm(GEN C, GEN p)
1014 : {
1015 30408 : GEN gen = quo_get_gen(C);
1016 30408 : GEN coset = quo_get_coset(C);
1017 30408 : long j, l = lg(gen);
1018 30408 : GEN p3 = cgetg(l, t_VECSMALL);
1019 284291 : for (j = 1; j < l; ++j)
1020 : {
1021 253883 : p3[j] = coset[p[mael(gen,j,1)]];
1022 253883 : if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
1023 : }
1024 30408 : return p3;
1025 : }
1026 :
1027 : /* H is a subgroup of G, C is the quotient map G --> G/H
1028 : *
1029 : * Lift a subgroup S of G/H to a subgroup of G containing H */
1030 : GEN
1031 51009 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
1032 : {
1033 51009 : GEN genH = grp_get_gen(H);
1034 51009 : GEN genS = grp_get_gen(S);
1035 51009 : GEN genC = quo_get_gen(C);
1036 51009 : long l1 = lg(genH)-1;
1037 51009 : long l2 = lg(genS)-1, j;
1038 51009 : GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
1039 102186 : for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
1040 118531 : for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
1041 51009 : gel(p1,1) = L;
1042 51009 : gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
1043 51009 : return p1;
1044 : }
1045 :
1046 : /* Let G a group and C a quotient map G --> G/H
1047 : * Assume H is normal, return the group G/H */
1048 : GEN
1049 10262 : quotient_group(GEN C, GEN G)
1050 : {
1051 10262 : pari_sp ltop = avma;
1052 : GEN Qgen, Qord, Qelt, Qset, Q;
1053 10262 : GEN Cgen = quo_get_gen(C);
1054 10262 : GEN Ggen = grp_get_gen(G);
1055 10262 : long i,j, n = lg(Cgen)-1, l = lg(Ggen);
1056 10262 : Qord = cgetg(l, t_VECSMALL);
1057 10262 : Qgen = cgetg(l, t_VEC);
1058 10262 : Qelt = mkvec(identity_perm(n));
1059 10262 : Qset = groupelts_set(Qelt, n);
1060 31276 : for (i = 1, j = 1; i < l; ++i)
1061 : {
1062 21014 : GEN g = quotient_perm(C, gel(Ggen,i));
1063 21014 : long o = perm_relorder(g, Qset);
1064 21014 : gel(Qgen,j) = g;
1065 21014 : Qord[j] = o;
1066 21014 : if (o != 1)
1067 : {
1068 13104 : Qelt = perm_generate(g, Qelt, o);
1069 13104 : Qset = groupelts_set(Qelt, n);
1070 13104 : j++;
1071 : }
1072 : }
1073 10262 : setlg(Qgen,j);
1074 10262 : setlg(Qord,j); Q = mkvec2(Qgen, Qord);
1075 10262 : return gc_GEN(ltop,Q);
1076 : }
1077 :
1078 : GEN
1079 1659 : quotient_groupelts(GEN C)
1080 : {
1081 1659 : GEN G = quo_get_gen(C);
1082 1659 : long i, l = lg(G);
1083 1659 : GEN Q = cgetg(l, t_VEC);
1084 11053 : for (i = 1; i < l; ++i)
1085 9394 : gel(Q,i) = quotient_perm(C, gel(G,i));
1086 1659 : return Q;
1087 : }
1088 :
1089 : /* Return 1 if g normalizes N, 0 otherwise */
1090 : long
1091 184758 : group_perm_normalize(GEN N, GEN g)
1092 : {
1093 184758 : pari_sp ltop = avma;
1094 184758 : long r = gequal(vecvecsmall_sort_shallow(group_leftcoset(N, g)),
1095 : vecvecsmall_sort_shallow(group_rightcoset(N, g)));
1096 184758 : return gc_long(ltop, r);
1097 : }
1098 :
1099 : /* L is a list of subgroups, C is a coset and r a relative order.*/
1100 : static GEN
1101 65275 : liftlistsubgroups(GEN L, GEN C, long r)
1102 : {
1103 65275 : pari_sp ltop = avma;
1104 65275 : long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
1105 : GEN R;
1106 65275 : if (!l) return cgetg(1,t_VEC);
1107 58583 : R = cgetg(l*c+1, t_VEC);
1108 143080 : for (i = 1, k = 1; i <= l; ++i)
1109 : {
1110 84497 : GEN S = gel(L,i), Selt = group_set(S,n);
1111 84497 : GEN gen = grp_get_gen(S);
1112 84497 : GEN ord = grp_get_ord(S);
1113 : long j;
1114 279370 : for (j = 1; j <= c; ++j)
1115 : {
1116 194873 : GEN p = gel(C,j);
1117 194873 : if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
1118 108759 : gel(R,k++) = mkvec2(vec_append(gen, p),
1119 : vecsmall_append(ord, r));
1120 : }
1121 : }
1122 58583 : setlg(R, k);
1123 58583 : return gc_GEN(ltop, R);
1124 : }
1125 :
1126 : /* H is a normal subgroup, C is the quotient map G -->G/H,
1127 : * S is a subgroup of G/H, and G is embedded in Sym(l)
1128 : * Return all the subgroups K of G such that
1129 : * S= K mod H and K inter H={1} */
1130 : static GEN
1131 49350 : liftsubgroup(GEN C, GEN H, GEN S)
1132 : {
1133 49350 : pari_sp ltop = avma;
1134 49350 : GEN V = trivialsubgroups();
1135 49350 : GEN Sgen = grp_get_gen(S);
1136 49350 : GEN Sord = grp_get_ord(S);
1137 49350 : GEN Cgen = quo_get_gen(C);
1138 49350 : long n = lg(Sgen), i;
1139 114625 : for (i = 1; i < n; ++i)
1140 : { /*loop over generators of S*/
1141 65275 : GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
1142 65275 : V = liftlistsubgroups(V, W, Sord[i]);
1143 : }
1144 49350 : return gc_GEN(ltop,V);
1145 : }
1146 :
1147 : /* 1:A4, 2:S4, 3:F36, 0: other */
1148 : long
1149 10094 : group_isA4S4(GEN G)
1150 : {
1151 10094 : GEN elt = grp_get_gen(G);
1152 10094 : GEN ord = grp_get_ord(G);
1153 10094 : long n = lg(ord);
1154 10094 : if (n != 4 && n != 5) return 0;
1155 2219 : if (n==4 && ord[1]==3 && ord[2]==3 && ord[3]==4)
1156 : {
1157 : long i;
1158 7 : GEN p = gel(elt,1), q = gel(elt,2), r = gel(elt,3);
1159 259 : for(i=1; i<=36; i++)
1160 252 : if (p[r[i]]!=r[q[i]]) return 0;
1161 7 : return 3;
1162 : }
1163 2212 : if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
1164 42 : if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
1165 42 : if (n==4) return 1;
1166 21 : if (ord[4]!=2) return 0;
1167 21 : if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
1168 21 : return 2;
1169 : }
1170 : /* compute all the subgroups of a group G */
1171 : GEN
1172 13314 : group_subgroups(GEN G)
1173 : {
1174 13314 : pari_sp ltop = avma;
1175 : GEN p1, H, C, Q, M, sg1, sg2, sg3;
1176 13314 : GEN gen = grp_get_gen(G);
1177 13314 : GEN ord = grp_get_ord(G);
1178 13314 : long lM, i, j, n = lg(gen);
1179 : long t;
1180 13314 : if (n == 1) return trivialsubgroups();
1181 10094 : t = group_isA4S4(G);
1182 10094 : if (t == 3)
1183 : {
1184 7 : GEN H = mkvec2(mkvec3(gel(gen,1), gel(gen,2), perm_sqr(gel(gen,3))),
1185 : mkvecsmall3(3, 3, 2));
1186 7 : GEN S = group_subgroups(H);
1187 7 : GEN V = cgetg(11,t_VEC);
1188 7 : gel(V,1) = cyclicgroup(gel(gen,3),4);
1189 63 : for (i=2; i<10; i++)
1190 56 : gel(V,i) = cyclicgroup(perm_mul(gmael3(V,i-1,1,1),gel(gen,i%3==1 ? 2:1)),4);
1191 7 : gel(V,10) = G;
1192 7 : return gc_GEN(ltop,shallowconcat(S,V));
1193 : }
1194 10087 : else if (t)
1195 : {
1196 42 : GEN s = gel(gen,1); /*s = (1,2)(3,4) */
1197 42 : GEN t = gel(gen,2); /*t = (1,3)(2,4) */
1198 42 : GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
1199 42 : H = dicyclicgroup(s, t, 2, 2);
1200 : /* sg3 is the list of subgroups intersecting only partially with H*/
1201 42 : sg3 = cgetg((n==4)?4: 10, t_VEC);
1202 42 : gel(sg3,1) = cyclicgroup(s, 2);
1203 42 : gel(sg3,2) = cyclicgroup(t, 2);
1204 42 : gel(sg3,3) = cyclicgroup(st, 2);
1205 42 : if (n==5)
1206 : {
1207 21 : GEN u = gel(gen,3);
1208 21 : GEN v = gel(gen,4), w, u2;
1209 21 : if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
1210 21 : u2 = perm_sqr(u);
1211 : else
1212 : {
1213 0 : u2 = u;
1214 0 : u = perm_sqr(u);
1215 : }
1216 21 : if (perm_orderu(v)==2)
1217 : {
1218 21 : if (!perm_commute(s,v)) /*v=(1,2)*/
1219 : {
1220 0 : v = perm_conj(u,v);
1221 0 : if (!perm_commute(s,v)) v = perm_conj(u,v);
1222 : }
1223 21 : w = perm_mul(v,t); /*w=(1,4,2,3)*/
1224 : }
1225 : else
1226 : {
1227 0 : w = v;
1228 0 : if (!zv_equal(perm_sqr(w), s)) /*w=(1,4,2,3)*/
1229 : {
1230 0 : w = perm_conj(u,w);
1231 0 : if (!zv_equal(perm_sqr(w), s)) w = perm_conj(u,w);
1232 : }
1233 0 : v = perm_mul(w,t); /*v=(1,2)*/
1234 : }
1235 21 : gel(sg3,4) = dicyclicgroup(s,v,2,2);
1236 21 : gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
1237 21 : gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
1238 21 : gel(sg3,7) = dicyclicgroup(s,w,2,2);
1239 21 : gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
1240 21 : gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
1241 : }
1242 : }
1243 : else
1244 : {
1245 10045 : ulong osig = mael(factoru(ord[1]), 1, 1);
1246 10045 : GEN sig = perm_powu(gel(gen,1), ord[1]/osig);
1247 10045 : H = cyclicgroup(sig,osig);
1248 10045 : sg3 = NULL;
1249 : }
1250 10087 : C = group_quotient(G,H);
1251 10080 : Q = quotient_group(C,G);
1252 10080 : M = group_subgroups(Q); lM = lg(M);
1253 : /* sg1 is the list of subgroups containing H*/
1254 10073 : sg1 = cgetg(lM, t_VEC);
1255 59423 : for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
1256 : /*sg2 is a list of lists of subgroups not intersecting with H*/
1257 10073 : sg2 = cgetg(lM, t_VEC);
1258 : /* Loop over all subgroups of G/H */
1259 59423 : for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
1260 10073 : p1 = gconcat(sg1, shallowconcat1(sg2));
1261 10073 : if (sg3)
1262 : {
1263 42 : p1 = gconcat(p1, sg3);
1264 42 : if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
1265 84 : for(j = 3; j <= 5; j++)
1266 : {
1267 63 : GEN c = gmael(p1,j,1);
1268 63 : if (!perm_commute(gel(c,1),gel(c,3)))
1269 : {
1270 42 : if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
1271 : else
1272 21 : perm_mul_inplace2(gel(c,2), gel(c,1));
1273 : }
1274 : }
1275 : }
1276 10073 : return gc_upto(ltop,p1);
1277 : }
1278 :
1279 : /*return 1 if G is abelian, else 0*/
1280 : long
1281 9723 : group_isabelian(GEN G)
1282 : {
1283 9723 : GEN g = grp_get_gen(G);
1284 9723 : long i, j, n = lg(g);
1285 13776 : for(i=2; i<n; i++)
1286 13573 : for(j=1; j<i; j++)
1287 9520 : if (!perm_commute(gel(g,i), gel(g,j))) return 0;
1288 4522 : return 1;
1289 : }
1290 :
1291 : /*If G is abelian, return its HNF matrix*/
1292 : GEN
1293 644 : group_abelianHNF(GEN G, GEN S)
1294 : {
1295 644 : GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
1296 644 : long i, j, k, n = lg(g);
1297 644 : if (!group_isabelian(G)) return NULL;
1298 574 : if (n==1) return cgetg(1,t_MAT);
1299 553 : if (!S) S = group_elts(G, group_domain(G));
1300 553 : M = cgetg(n,t_MAT);
1301 1519 : for(i=1; i<n; i++)
1302 : {
1303 966 : GEN P, C = cgetg(n,t_COL);
1304 966 : pari_sp av = avma;
1305 966 : gel(M,i) = C;
1306 966 : P = perm_inv(perm_powu(gel(g,i), o[i]));
1307 1246 : for(j=1; j<lg(S); j++)
1308 1246 : if (zv_equal(P, gel(S,j))) break;
1309 966 : set_avma(av);
1310 966 : if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
1311 966 : j--;
1312 1540 : for(k=1; k<i; k++)
1313 : {
1314 574 : long q = j / o[k];
1315 574 : gel(C,k) = stoi(j - q*o[k]);
1316 574 : j = q;
1317 : }
1318 966 : gel(C,k) = stoi(o[i]);
1319 1540 : for (k++; k<n; k++) gel(C,k) = gen_0;
1320 : }
1321 553 : return M;
1322 : }
1323 :
1324 : /*If G is abelian, return its abstract SNF matrix*/
1325 : GEN
1326 595 : group_abelianSNF(GEN G, GEN L)
1327 : {
1328 595 : pari_sp ltop = avma;
1329 595 : GEN H = group_abelianHNF(G,L);
1330 595 : if (!H) return NULL;
1331 525 : return gc_upto(ltop, smithclean( ZM_snf(H) ));
1332 : }
1333 :
1334 : GEN
1335 462 : abelian_group(GEN v)
1336 : {
1337 462 : long card = zv_prod(v), i, d = 1, l = lg(v);
1338 462 : GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
1339 462 : gel(G,1) = gen;
1340 462 : gel(G,2) = vecsmall_copy(v);
1341 959 : for(i=1; i<l; i++)
1342 : {
1343 497 : GEN p = cgetg(card+1, t_VECSMALL);
1344 497 : long o = v[i], u = d*(o-1), j, k, l;
1345 497 : gel(gen, i) = p;
1346 : /* The following loop is over-optimized. Remember that I wrote it for
1347 : * testpermutation. Something has survived... BA */
1348 1246 : for(j=1;j<=card;)
1349 : {
1350 3122 : for(k=1;k<o;k++)
1351 6615 : for(l=1;l<=d; l++,j++) p[j] = j+d;
1352 2779 : for (l=1; l<=d; l++,j++) p[j] = j-u;
1353 : }
1354 497 : d += u;
1355 : }
1356 462 : return G;
1357 : }
1358 :
1359 : static long
1360 15435 : groupelts_subgroup_isnormal(GEN G, GEN H)
1361 : {
1362 15435 : long i, n = lg(G);
1363 67102 : for(i = 1; i < n; i++)
1364 65380 : if (!group_perm_normalize(H, gel(G,i))) return 0;
1365 1722 : return 1;
1366 : }
1367 :
1368 : /*return 1 if H is a normal subgroup of G*/
1369 : long
1370 336 : group_subgroup_isnormal(GEN G, GEN H)
1371 : {
1372 336 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1373 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1374 : strtoGENstr("domain(G)"), H);
1375 336 : return groupelts_subgroup_isnormal(grp_get_gen(G), H);
1376 : }
1377 :
1378 : static GEN
1379 4816 : group_subgroup_kernel_set(GEN G, GEN H)
1380 : {
1381 : pari_sp av;
1382 4816 : GEN g = grp_get_gen(G);
1383 4816 : long i, n = lg(g);
1384 : GEN S, elts;
1385 4816 : long d = group_domain(G);
1386 4816 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1387 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1388 : strtoGENstr("domain(G)"), H);
1389 4816 : elts = group_elts(H,d);
1390 4816 : S = groupelts_set(elts, d);
1391 4816 : av = avma;
1392 19264 : for(i=1; i<n; i++)
1393 : {
1394 14448 : F2v_and_inplace(S, groupelts_conj_set(elts,gel(g,i)));
1395 14448 : set_avma(av);
1396 : }
1397 4816 : return S;
1398 : }
1399 :
1400 : int
1401 4816 : group_subgroup_is_faithful(GEN G, GEN H)
1402 : {
1403 4816 : pari_sp av = avma;
1404 4816 : GEN K = group_subgroup_kernel_set(G,H);
1405 4816 : F2v_clear(K,1);
1406 4816 : return gc_long(av, F2v_equal0(K));
1407 : }
1408 :
1409 : long
1410 0 : groupelts_exponent(GEN elts)
1411 : {
1412 0 : long i, n = lg(elts)-1, expo = 1;
1413 0 : for(i=1; i<=n; i++) expo = ulcm(expo, perm_orderu(gel(elts,i)));
1414 0 : return expo;
1415 : }
1416 :
1417 : GEN
1418 700 : groupelts_center(GEN S)
1419 : {
1420 700 : pari_sp ltop = avma;
1421 700 : long i, j, n = lg(S)-1, l = n;
1422 700 : GEN V, elts = zero_F2v(n+1);
1423 25732 : for(i=1; i<=n; i++)
1424 : {
1425 25032 : if (F2v_coeff(elts,i)) { l--; continue; }
1426 573384 : for(j=1; j<=n; j++)
1427 563192 : if (!perm_commute(gel(S,i),gel(S,j)))
1428 : {
1429 14322 : F2v_set(elts,i);
1430 14322 : F2v_set(elts,j); l--; break;
1431 : }
1432 : }
1433 700 : V = cgetg(l+1,t_VEC);
1434 25732 : for (i=1, j=1; i<=n ;i++)
1435 25032 : if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
1436 700 : return gc_upto(ltop,V);
1437 : }
1438 :
1439 : GEN
1440 4284 : groupelts_conjclasses(GEN elts, long *pnbcl)
1441 : {
1442 4284 : long i, j, cl = 0, n = lg(elts)-1;
1443 4284 : GEN c = const_vecsmall(n,0);
1444 4284 : pari_sp av = avma;
1445 53704 : for (i=1; i<=n; i++)
1446 : {
1447 49420 : GEN g = gel(elts,i);
1448 49420 : if (c[i]) continue;
1449 35035 : c[i] = ++cl;
1450 491141 : for(j=1; j<=n; j++)
1451 456106 : if (j != i)
1452 : {
1453 421071 : GEN h = perm_conj(gel(elts,j), g);
1454 421071 : long i2 = gen_search(elts,h,(void*)&vecsmall_lexcmp,&cmp_nodata);
1455 421071 : c[i2] = cl; set_avma(av);
1456 : }
1457 : }
1458 4284 : if (pnbcl) *pnbcl = cl;
1459 4284 : return c;
1460 : }
1461 :
1462 : GEN
1463 4284 : conjclasses_repr(GEN conj, long nb)
1464 : {
1465 4284 : long i, l = lg(conj);
1466 4284 : GEN e = const_vecsmall(nb, 0);
1467 53704 : for(i=1; i<l; i++)
1468 : {
1469 49420 : long ci = conj[i];
1470 49420 : if (!e[ci]) e[ci] = i;
1471 : }
1472 4284 : return e;
1473 : }
1474 :
1475 : /* elts of G sorted wrt vecsmall_lexcmp order: g in G is determined by g[1]
1476 : * so sort by increasing g[1] */
1477 : static GEN
1478 3899 : galois_elts_sorted(GEN gal)
1479 : {
1480 : long i, l;
1481 3899 : GEN elts = gal_get_group(gal), v = cgetg_copy(elts, &l);
1482 43995 : for (i = 1; i < l; i++) { GEN g = gel(elts,i); gel(v, g[1]) = g; }
1483 3899 : return v;
1484 : }
1485 : GEN
1486 4305 : group_to_cc(GEN G)
1487 : {
1488 4305 : GEN elts = checkgroupelts(G), z = cgetg(5,t_VEC);
1489 4284 : long n, flag = 1;
1490 4284 : if (typ(gel(G,1)) == t_POL)
1491 3899 : elts = galois_elts_sorted(G); /* galoisinit */
1492 : else
1493 : {
1494 385 : long i, l = lg(elts);
1495 385 : elts = gen_sort_shallow(elts,(void*)vecsmall_lexcmp,cmp_nodata);
1496 5824 : for (i = 1; i < l; i++)
1497 5586 : if (gel(elts,i)[1] != i) { flag = 0; break; }
1498 : }
1499 4284 : gel(z,1) = elts;
1500 4284 : gel(z,2) = groupelts_conjclasses(elts,&n);
1501 4284 : gel(z,3) = conjclasses_repr(gel(z,2),n);
1502 4284 : gel(z,4) = utoi(flag); return z;
1503 : }
1504 :
1505 : /* S a list of generators */
1506 : GEN
1507 0 : groupelts_abelian_group(GEN S)
1508 : {
1509 0 : pari_sp ltop = avma;
1510 : GEN Qgen, Qord, Qelt;
1511 0 : long i, j, n = lg(gel(S,1))-1, l = lg(S);
1512 0 : Qord = cgetg(l, t_VECSMALL);
1513 0 : Qgen = cgetg(l, t_VEC);
1514 0 : Qelt = mkvec(identity_perm(n));
1515 0 : for (i = 1, j = 1; i < l; ++i)
1516 : {
1517 0 : GEN g = gel(S,i);
1518 0 : long o = perm_relorder(g, groupelts_set(Qelt, n));
1519 0 : gel(Qgen,j) = g;
1520 0 : Qord[j] = o;
1521 0 : if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
1522 : }
1523 0 : setlg(Qgen,j);
1524 0 : setlg(Qord,j);
1525 0 : return gc_GEN(ltop, mkvec2(Qgen, Qord));
1526 : }
1527 :
1528 : GEN
1529 21 : group_export_GAP(GEN G)
1530 : {
1531 21 : pari_sp av = avma;
1532 21 : GEN s, comma, g = grp_get_gen(G);
1533 21 : long i, k, l = lg(g);
1534 21 : if (l == 1) return strtoGENstr("Group(())");
1535 14 : s = cgetg(2*l, t_VEC);
1536 14 : comma = strtoGENstr(", ");
1537 14 : gel(s,1) = strtoGENstr("Group(");
1538 455 : for (i=1, k=2; i < l; ++i)
1539 : {
1540 441 : if (i > 1) gel(s,k++) = comma;
1541 441 : gel(s,k++) = perm_to_GAP(gel(g,i));
1542 : }
1543 14 : gel(s,k++) = strtoGENstr(")");
1544 14 : return gc_GEN(av, shallowconcat1(s));
1545 : }
1546 :
1547 : GEN
1548 14 : group_export_MAGMA(GEN G)
1549 : {
1550 14 : pari_sp av = avma;
1551 14 : GEN s, comma, g = grp_get_gen(G);
1552 14 : long i, k, l = lg(g);
1553 14 : if (l == 1) return strtoGENstr("PermutationGroup<1|>");
1554 7 : s = cgetg(2*l, t_VEC);
1555 7 : comma = strtoGENstr(", ");
1556 7 : gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
1557 28 : for (i=1, k=2; i < l; ++i)
1558 : {
1559 21 : if (i > 1) gel(s,k++) = comma;
1560 21 : gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
1561 : }
1562 7 : gel(s,k++) = strtoGENstr(">");
1563 7 : return gc_GEN(av, shallowconcat1(s));
1564 : }
1565 :
1566 : GEN
1567 35 : group_export(GEN G, long format)
1568 : {
1569 35 : switch(format)
1570 : {
1571 21 : case 0: return group_export_GAP(G);
1572 14 : case 1: return group_export_MAGMA(G);
1573 : }
1574 0 : pari_err_FLAG("galoisexport");
1575 0 : return NULL; /*-Wall*/
1576 : }
1577 :
1578 : static GEN
1579 4144 : groupelts_cyclic_subgroups(GEN G)
1580 : {
1581 4144 : pari_sp av = avma;
1582 4144 : long i, j, n = lg(G)-1;
1583 : GEN elts, f, gen, ord;
1584 4144 : if (n==1) return cgetg(1,t_VEC);
1585 4144 : elts = zero_F2v(lg(gel(G,1))-1);
1586 4144 : gen = cgetg(n+1, t_VECSMALL);
1587 4144 : ord = cgetg(n+1, t_VECSMALL);
1588 57260 : for (i=1, j=1; i<=n; i++)
1589 : {
1590 53116 : long k = 1, o, c = 0;
1591 53116 : GEN p = gel(G, i);
1592 53116 : if (F2v_coeff(elts, p[1])) continue;
1593 38367 : o = perm_orderu(p);
1594 38367 : gen[j] = i; ord[j] = o; j++;
1595 : do
1596 : {
1597 101710 : if (cgcd(o, ++c)==1) F2v_set(elts, p[k]);
1598 101710 : k = p[k];
1599 101710 : } while (k!=1);
1600 : }
1601 4144 : setlg(gen, j);
1602 4144 : setlg(ord, j);
1603 4144 : f = vecsmall_indexsort(ord);
1604 4144 : return gc_GEN(av, mkvec2(vecsmallpermute(gen, f),
1605 : vecsmallpermute(ord, f)));
1606 : }
1607 :
1608 : GEN
1609 4151 : groupelts_to_group(GEN G)
1610 : {
1611 4151 : pari_sp av = avma;
1612 : GEN L, cyc, ord;
1613 4151 : long i, l, n = lg(G)-1;
1614 4151 : if (n==1) return trivialgroup();
1615 4123 : L = groupelts_cyclic_subgroups(G);
1616 4123 : cyc = gel(L,1); ord = gel(L,2);
1617 4123 : l = lg(cyc);
1618 17563 : for (i = l-1; i >= 2; i--)
1619 : {
1620 16835 : GEN p = gel(G,cyc[i]);
1621 16835 : long o = ord[i];
1622 16835 : GEN H = cyclicgroup(p, o);
1623 16835 : if (o == n) return gc_upto(av, H);
1624 15099 : if (groupelts_subgroup_isnormal(G, H))
1625 : {
1626 1659 : GEN C = groupelts_quotient(G, H);
1627 1659 : GEN Q = quotient_groupelts(C);
1628 1659 : GEN R = groupelts_to_group(Q);
1629 1659 : if (!R) return gc_NULL(av);
1630 1659 : return gc_GEN(av, quotient_subgroup_lift(C, H, R));
1631 : }
1632 : }
1633 728 : if (n==12 && l==9 && ord[2]==2 && ord[3]==2 && ord[5]==3)
1634 672 : return gc_GEN(av,
1635 336 : mkvec2(mkvec3(gel(G,cyc[2]), gel(G,cyc[3]), gel(G,cyc[5])), mkvecsmall3(2,2,3)));
1636 392 : if (n==24 && l==18 && ord[11]==3 && ord[15]==4 && ord[16]==4)
1637 : {
1638 350 : GEN t21 = perm_sqr(gel(G,cyc[15]));
1639 350 : GEN t22 = perm_sqr(gel(G,cyc[16]));
1640 350 : GEN s = perm_mul(t22, gel(G,cyc[15]));
1641 700 : return gc_GEN(av,
1642 350 : mkvec2(mkvec4(t21,t22, gel(G,cyc[11]), s), mkvecsmall4(2,2,3,2)));
1643 : }
1644 42 : if (n==36 && l==24 && ord[11]==3 && ord[15]==4)
1645 : {
1646 7 : GEN t1 = gel(G,cyc[11]), t3 = gel(G,cyc[15]);
1647 7 : return gc_GEN(av,
1648 : mkvec2(mkvec3(perm_conj(t3, t1), t1, t3), mkvecsmall3(3,3,4)));
1649 : }
1650 35 : return gc_NULL(av);
1651 : }
1652 :
1653 : static GEN
1654 1764 : subg_get_gen(GEN subg) { return gel(subg, 1); }
1655 :
1656 : static GEN
1657 12978 : subg_get_set(GEN subg) { return gel(subg, 2); }
1658 :
1659 : static GEN
1660 1218 : groupelt_subg_normalize(GEN elt, GEN subg, GEN cyc)
1661 : {
1662 1218 : GEN gen = subg_get_gen(subg), set = subg_get_set(subg);
1663 1218 : long i, j, u, n = lg(elt)-1, lgen = lg(gen);
1664 1218 : GEN b = F2v_copy(cyc), res = zero_F2v(n);
1665 74298 : for(i = 1; i <= n; i++)
1666 : {
1667 : GEN g;
1668 73080 : if (!F2v_coeff(b, i)) continue;
1669 33579 : g = gel(elt,i);
1670 1154146 : for(u=1; u<=n; u++)
1671 1154146 : if (g[u]==1) break;
1672 37758 : for(j=1; j<lgen; j++)
1673 : {
1674 35679 : GEN h = gel(elt,gen[j]);
1675 35679 : if (!F2v_coeff(set,g[h[u]])) break;
1676 : }
1677 33579 : if (j < lgen) continue;
1678 2079 : F2v_set(res,i);
1679 126819 : for(j=1; j <= n; j++)
1680 124740 : if (F2v_coeff(set, j))
1681 10080 : F2v_clear(b,g[gel(elt,j)[1]]);
1682 : }
1683 1218 : return res;
1684 : }
1685 :
1686 : static GEN
1687 21 : triv_subg(GEN elt)
1688 : {
1689 21 : GEN v = cgetg(3, t_VEC);
1690 21 : gel(v,1) = cgetg(1,t_VECSMALL);
1691 21 : gel(v,2) = zero_F2v(lg(elt)-1);
1692 21 : F2v_set(gel(v,2),1);
1693 21 : return v;
1694 : }
1695 :
1696 : static GEN
1697 546 : subg_extend(GEN U, long e, long o, GEN elt)
1698 : {
1699 546 : long i, j, n = lg(elt)-1;
1700 546 : GEN g = gel(elt, e);
1701 546 : GEN gen = vecsmall_append(subg_get_gen(U), e);
1702 546 : GEN set = subg_get_set(U);
1703 546 : GEN Vset = zv_copy(set);
1704 33306 : for(i = 1; i <= n; i++)
1705 32760 : if (F2v_coeff(set, i))
1706 : {
1707 1890 : long h = gel(elt, i)[1];
1708 4200 : for(j = 1; j < o; j++)
1709 : {
1710 2310 : h = g[h];
1711 2310 : F2v_set(Vset, h);
1712 : }
1713 : }
1714 546 : return mkvec2(gen, Vset);
1715 : }
1716 :
1717 : static GEN
1718 651 : cyclic_subg(long e, long o, GEN elt)
1719 : {
1720 651 : long j, n = lg(elt)-1, h = 1;
1721 651 : GEN g = gel(elt, e);
1722 651 : GEN gen = mkvecsmall(e);
1723 651 : GEN set = zero_F2v(n);
1724 651 : F2v_set(set,1);
1725 1890 : for(j = 1; j < o; j++)
1726 : {
1727 1239 : h = g[h];
1728 1239 : F2v_set(set, h);
1729 : }
1730 651 : return mkvec2(gen, set);
1731 : }
1732 :
1733 : static GEN
1734 21 : groupelts_to_regular(GEN elt)
1735 : {
1736 21 : long i, j, n = lg(elt)-1;
1737 21 : GEN V = cgetg(n+1,t_VEC);
1738 1281 : for (i=1; i<=n; i++)
1739 : {
1740 1260 : pari_sp av = avma;
1741 1260 : GEN g = gel(elt, i);
1742 1260 : GEN W = cgetg(n+1,t_VEC);
1743 76860 : for(j=1; j<=n; j++)
1744 75600 : gel(W,j) = perm_mul(g, gel(elt,j));
1745 1260 : gel(V, i) = gc_leaf(av,vecvecsmall_indexsort(W));
1746 : }
1747 21 : vecvecsmall_sort_inplace(V, NULL);
1748 21 : return V;
1749 : }
1750 :
1751 : static long
1752 651 : groupelts_pow(GEN elt, long j, long n)
1753 : {
1754 651 : GEN g = gel(elt,j);
1755 651 : long i, h = 1;
1756 2541 : for (i=1; i<=n; i++)
1757 1890 : h = g[h];
1758 651 : return h;
1759 : }
1760 :
1761 : static GEN
1762 21 : groupelts_cyclic_primepow(GEN elt, GEN *pt_pr, GEN *pt_po)
1763 : {
1764 21 : GEN R = groupelts_cyclic_subgroups(elt);
1765 21 : GEN gen = gel(R,1), ord = gel(R,2);
1766 21 : long i, n = lg(elt)-1, l = lg(gen);
1767 21 : GEN set = zero_F2v(n);
1768 21 : GEN pr = zero_Flv(n);
1769 21 : GEN po = zero_Flv(n);
1770 693 : for (i = 1; i < l; i++)
1771 : {
1772 672 : long h = gen[i];
1773 : ulong p;
1774 672 : if (uisprimepower(ord[i], &p))
1775 : {
1776 651 : F2v_set(set, h);
1777 651 : uel(pr,h) = p;
1778 651 : po[h] = groupelts_pow(elt, h, p);
1779 : }
1780 : }
1781 21 : *pt_pr = pr; *pt_po = po;
1782 21 : return set;
1783 : }
1784 :
1785 : static GEN
1786 75600 : perm_bracket(GEN p, GEN q)
1787 : {
1788 75600 : return perm_mul(perm_mul(p,q), perm_inv(perm_mul(q,p)));
1789 : }
1790 :
1791 : static GEN
1792 1239 : set_groupelts(GEN S, GEN x)
1793 : {
1794 1239 : long i, n = F2v_hamming(x), k=1, m = x[1];
1795 1239 : GEN v = cgetg(n+1, t_VEC);
1796 75579 : for (i=1; i<=m; i++)
1797 74340 : if (F2v_coeff(x,i))
1798 7371 : gel(v,k++) = gel(S,i);
1799 1239 : return v;
1800 : }
1801 :
1802 : static GEN
1803 21 : set_idx(GEN x)
1804 : {
1805 21 : long i, n = F2v_hamming(x), k=1, m = x[1];
1806 21 : GEN v = cgetg(n+1, t_VECSMALL);
1807 1281 : for (i=1; i<=m; i++)
1808 1260 : if (F2v_coeff(x,i))
1809 1260 : uel(v,k++) = i;
1810 21 : return v;
1811 : }
1812 :
1813 : static GEN
1814 21 : set_derived(GEN set, GEN elts)
1815 : {
1816 21 : long i, j, l = lg(elts);
1817 21 : GEN V = zero_F2v(l-1);
1818 1281 : for(i = 1; i < l; i++)
1819 1260 : if (F2v_coeff(set, i))
1820 76860 : for(j = 1; j < l; j++)
1821 75600 : if (F2v_coeff(set, j))
1822 75600 : F2v_set(V, perm_bracket(gel(elts,i),gel(elts,j))[1]);
1823 21 : return V;
1824 : }
1825 :
1826 : static GEN
1827 21 : groupelts_residuum(GEN elts)
1828 : {
1829 21 : pari_sp av = avma;
1830 21 : long o = lg(elts)-1, oo;
1831 21 : GEN set = const_F2v(o);
1832 : do
1833 : {
1834 21 : oo = o;
1835 21 : set = set_derived(set, elts);
1836 21 : o = F2v_hamming(set);
1837 21 : } while (o > 1 && o < oo);
1838 21 : if (o==1) return NULL;
1839 21 : return gc_GEN(av,mkvec2(set_idx(set), set));
1840 : }
1841 :
1842 : static GEN
1843 21 : all_cyclic_subg(GEN pr, GEN po, GEN elt)
1844 : {
1845 21 : long i, n = lg(pr)-1, m = 0, k = 1;
1846 : GEN W;
1847 1281 : for (i=1; i <= n; i++)
1848 1260 : m += po[i]==1;
1849 21 : W = cgetg(m+1, t_VEC);
1850 1281 : for (i=1; i <= n; i++)
1851 1260 : if (po[i]==1)
1852 651 : gel(W, k++) = cyclic_subg(i, pr[i], elt);
1853 21 : return W;
1854 : }
1855 :
1856 : static GEN
1857 21 : groupelts_subgroups_raw(GEN elts)
1858 : {
1859 21 : pari_sp av = avma;
1860 21 : GEN elt = groupelts_to_regular(elts);
1861 21 : GEN pr, po, cyc = groupelts_cyclic_primepow(elt, &pr, &po);
1862 21 : long n = lg(elt)-1;
1863 21 : long i, j, nS = 1;
1864 21 : GEN S, L, R = NULL;
1865 21 : S = cgetg(1+bigomegau(n)+1, t_VEC);
1866 21 : gel(S, nS++) = mkvec(triv_subg(elt));
1867 21 : gel(S, nS++) = L = all_cyclic_subg(pr, po, elt);
1868 21 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS-1,lg(L)-1);
1869 105 : while (lg(L) > 1)
1870 : {
1871 84 : pari_sp av2 = avma;
1872 84 : long nW = 1, lL = lg(L);
1873 84 : long ng = n;
1874 84 : GEN W = cgetg(1+ng, t_VEC);
1875 1302 : for (i=1; i<lL; i++)
1876 : {
1877 1218 : GEN U = gel(L, i), set = subg_get_set(U);
1878 1218 : GEN G = groupelt_subg_normalize(elt, U, cyc);
1879 10668 : for (j=1; j<nW; j++)
1880 : {
1881 9450 : GEN Wj = subg_get_set(gel(W, j));
1882 9450 : if (F2v_subset(set, Wj))
1883 1169 : F2v_negimply_inplace(G, Wj);
1884 : }
1885 74298 : for (j=1; j<=n; j++)
1886 73080 : if(F2v_coeff(G,j))
1887 : {
1888 1190 : long p = pr[j];
1889 1190 : if (F2v_coeff(set, j)) continue;
1890 546 : if (F2v_coeff(set, po[j]))
1891 : {
1892 546 : GEN U2 = subg_extend(U, j, p, elt);
1893 546 : F2v_negimply_inplace(G, subg_get_set(U2));
1894 546 : if (nW > ng) { ng<<=1; W = vec_lengthen(W, ng); }
1895 546 : gel(W, nW++) = U2;
1896 : }
1897 : }
1898 : }
1899 84 : setlg(W, nW);
1900 84 : L = W;
1901 84 : if (nW > 1) gel(S, nS++) = L = gc_GEN(av2, W);
1902 84 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS-1,nW-1);
1903 84 : if (lg(L)==1 && !R)
1904 : {
1905 21 : R = groupelts_residuum(elt);
1906 21 : if (!R) break;
1907 21 : gel(S, nS++) = L = mkvec(R);
1908 : }
1909 : }
1910 21 : setlg(S, nS);
1911 21 : return gc_GEN(av, shallowconcat1(S));
1912 : }
1913 :
1914 : static GEN
1915 21 : subg_to_elts(GEN S, GEN x)
1916 1260 : { pari_APPLY_type(t_VEC, set_groupelts(S, gmael(x,i,2))); }
1917 :
1918 : GEN
1919 21 : groupelts_solvablesubgroups(GEN G)
1920 : {
1921 21 : pari_sp av = avma;
1922 21 : GEN S = vecvecsmall_sort(checkgroupelts(G));
1923 21 : GEN L = groupelts_subgroups_raw(S);
1924 21 : return gc_GEN(av, subg_to_elts(S, L));
1925 : }
|
