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 1841 : vec_isconst(GEN v)
25 : {
26 1841 : long i, l = lg(v);
27 : GEN w;
28 1841 : if (l==1) return 1;
29 1841 : w = gel(v,1);
30 6342 : for(i=2; i<l; i++)
31 5768 : if (!gequal(gel(v,i), w)) return 0;
32 574 : return 1;
33 : }
34 :
35 : int
36 17634 : vecsmall_isconst(GEN v)
37 : {
38 17634 : long i, l = lg(v);
39 : ulong w;
40 17634 : if (l==1) return 1;
41 17634 : w = uel(v,1);
42 30582 : for(i=2; i<l; i++)
43 24564 : if (uel(v,i) != w) return 0;
44 6018 : 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 176195912 : vecsmall_sortspec(GEN v, long n, GEN w)
81 : {
82 176195912 : pari_sp ltop=avma;
83 176195912 : long nx=n>>1, ny=n-nx;
84 : long m, ix, iy;
85 : GEN x, y;
86 176195912 : if (n<=2)
87 : {
88 103944324 : if (n==1)
89 22601347 : w[0]=v[0];
90 81342977 : else if (n==2)
91 : {
92 85230448 : long v0=v[0], v1=v[1];
93 85230448 : if (v0<=v1) { w[0]=v0; w[1]=v1; }
94 3590522 : else { w[0]=v1; w[1]=v0; }
95 : }
96 103944324 : return;
97 : }
98 72251588 : x=new_chunk(nx); y=new_chunk(ny);
99 79954561 : vecsmall_sortspec(v,nx,x);
100 80998437 : vecsmall_sortspec(v+nx,ny,y);
101 369852067 : for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
102 283703221 : if (x[ix]<=y[iy])
103 235765707 : w[m++]=x[ix++];
104 : else
105 47937514 : w[m++]=y[iy++];
106 90203043 : for(;ix<nx;) w[m++]=x[ix++];
107 315268114 : for(;iy<ny;) w[m++]=y[iy++];
108 86148846 : set_avma(ltop);
109 : }
110 :
111 : /*in place sort.*/
112 : void
113 36012473 : vecsmall_sort(GEN V)
114 : {
115 36012473 : long l = lg(V)-1;
116 36012473 : if (l<=1) return;
117 29937957 : vecsmall_sortspec(V+1,l,V+1);
118 : }
119 :
120 : /* cf gen_sortspec */
121 : static GEN
122 18590951 : vecsmall_indexsortspec(GEN v, long n)
123 : {
124 : long nx, ny, m, ix, iy;
125 : GEN x, y, w;
126 18590951 : switch(n)
127 : {
128 19051 : case 1: return mkvecsmall(1);
129 5043469 : case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
130 5189473 : case 3:
131 5189473 : if (v[1] <= v[2]) {
132 4451573 : if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
133 228689 : return (v[1] <= v[3])? mkvecsmall3(1,3,2)
134 673685 : : mkvecsmall3(3,1,2);
135 : } else {
136 737900 : if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
137 318420 : return (v[2] <= v[3])? mkvecsmall3(2,3,1)
138 883492 : : mkvecsmall3(3,2,1);
139 : }
140 : }
141 8338958 : nx = n>>1; ny = n-nx;
142 8338958 : w = cgetg(n+1,t_VECSMALL);
143 8338965 : x = vecsmall_indexsortspec(v,nx);
144 8338965 : y = vecsmall_indexsortspec(v+nx,ny);
145 150555452 : for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
146 142216484 : if (v[x[ix]] <= v[y[iy]+nx])
147 91919391 : w[m++] = x[ix++];
148 : else
149 50297093 : w[m++] = y[iy++]+nx;
150 11292137 : for(;ix<=nx;) w[m++] = x[ix++];
151 56461889 : for(;iy<=ny;) w[m++] = y[iy++]+nx;
152 8338968 : set_avma((pari_sp)w); return w;
153 : }
154 :
155 : /*indirect sort.*/
156 : GEN
157 1913091 : vecsmall_indexsort(GEN V)
158 : {
159 1913091 : long l=lg(V)-1;
160 1913091 : if (l==0) return cgetg(1, t_VECSMALL);
161 1913028 : return vecsmall_indexsortspec(V,l);
162 : }
163 :
164 : /* assume V sorted */
165 : GEN
166 31449 : vecsmall_uniq_sorted(GEN V)
167 : {
168 : GEN W;
169 31449 : long i,j, l = lg(V);
170 31449 : if (l == 1) return vecsmall_copy(V);
171 31395 : W = cgetg(l,t_VECSMALL);
172 31395 : W[1] = V[1];
173 34342 : for(i=j=2; i<l; i++)
174 2947 : if (V[i] != W[j-1]) W[j++] = V[i];
175 31395 : stackdummy((pari_sp)(W + l), (pari_sp)(W + j));
176 31395 : setlg(W, j); return W;
177 : }
178 :
179 : GEN
180 439 : vecsmall_uniq(GEN V)
181 : {
182 439 : pari_sp av = avma;
183 439 : V = zv_copy(V); vecsmall_sort(V);
184 439 : return gerepileuptoleaf(av, vecsmall_uniq_sorted(V));
185 : }
186 :
187 : /* assume x sorted */
188 : long
189 0 : vecsmall_duplicate_sorted(GEN x)
190 : {
191 0 : long i,k,l=lg(x);
192 0 : if (l==1) return 0;
193 0 : for (k=x[1],i=2; i<l; k=x[i++])
194 0 : if (x[i] == k) return i;
195 0 : return 0;
196 : }
197 :
198 : long
199 18315 : vecsmall_duplicate(GEN x)
200 : {
201 18315 : pari_sp av=avma;
202 18315 : GEN p=vecsmall_indexsort(x);
203 18315 : long k,i,r=0,l=lg(x);
204 18315 : if (l==1) return 0;
205 24964 : for (k=x[p[1]],i=2; i<l; k=x[p[i++]])
206 6649 : if (x[p[i]] == k) { r=p[i]; break; }
207 18315 : set_avma(av);
208 18315 : return r;
209 : }
210 :
211 : static int
212 54110 : vecsmall_is1to1spec(GEN v, long n, GEN w)
213 : {
214 54110 : pari_sp ltop=avma;
215 54110 : long nx=n>>1, ny=n-nx;
216 : long m, ix, iy;
217 : GEN x, y;
218 54110 : if (n<=2)
219 : {
220 32564 : if (n==1)
221 11151 : w[0]=v[0];
222 21413 : else if (n==2)
223 : {
224 21413 : long v0=v[0], v1=v[1];
225 21413 : if (v0==v1) return 0;
226 21399 : else if (v0<v1) { w[0]=v0; w[1]=v1; }
227 4688 : else { w[0]=v1; w[1]=v0; }
228 : }
229 32550 : return 1;
230 : }
231 21546 : x = new_chunk(nx);
232 21546 : if (!vecsmall_is1to1spec(v,nx,x)) return 0;
233 21462 : y = new_chunk(ny);
234 21462 : if (!vecsmall_is1to1spec(v+nx,ny,y)) return 0;
235 84096 : for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
236 62718 : if (x[ix]==y[iy]) return 0;
237 62669 : else if (x[ix]<y[iy])
238 37979 : w[m++]=x[ix++];
239 : else
240 24690 : w[m++]=y[iy++];
241 23495 : for(;ix<nx;) w[m++]=x[ix++];
242 52870 : for(;iy<ny;) w[m++]=y[iy++];
243 21378 : set_avma(ltop);
244 21378 : return 1;
245 : }
246 :
247 : int
248 11200 : vecsmall_is1to1(GEN V)
249 : {
250 11200 : pari_sp av = avma;
251 : long l;
252 11200 : GEN W = cgetg_copy(V, &l);
253 11200 : if (l <= 2) return 1;
254 11102 : return gc_bool(av, vecsmall_is1to1spec(V+1,l,W+1));
255 : }
256 :
257 : /*************************************************************************/
258 : /** **/
259 : /** Routines for handling vectors of VECSMALL **/
260 : /** **/
261 : /*************************************************************************/
262 :
263 : GEN
264 7 : vecvecsmall_sort(GEN x)
265 7 : { return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
266 : GEN
267 360255 : vecvecsmall_sort_shallow(GEN x)
268 360255 : { return gen_sort_shallow(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
269 :
270 : void
271 119 : vecvecsmall_sort_inplace(GEN x, GEN *perm)
272 119 : { gen_sort_inplace(x, (void*)&vecsmall_lexcmp, cmp_nodata, perm); }
273 :
274 : GEN
275 462 : vecvecsmall_sort_uniq(GEN x)
276 462 : { return gen_sort_uniq(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
277 :
278 : GEN
279 441 : vecvecsmall_indexsort(GEN x)
280 441 : { return gen_indexsort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
281 :
282 : long
283 22934359 : vecvecsmall_search(GEN x, GEN y)
284 22934359 : { return gen_search(x,y,(void*)vecsmall_prefixcmp, cmp_nodata); }
285 :
286 : /* assume x non empty */
287 : long
288 0 : vecvecsmall_max(GEN x)
289 : {
290 0 : long i, l = lg(x), m = vecsmall_max(gel(x,1));
291 0 : for (i = 2; i < l; i++)
292 : {
293 0 : long t = vecsmall_max(gel(x,i));
294 0 : if (t > m) m = t;
295 : }
296 0 : return m;
297 : }
298 :
299 : /*************************************************************************/
300 : /** **/
301 : /** Routines for handling permutations **/
302 : /** **/
303 : /*************************************************************************/
304 :
305 : /* Permutations may be given by
306 : * perm (VECSMALL): a bijection from 1...n to 1...n i-->perm[i]
307 : * cyc (VEC of VECSMALL): a product of disjoint cycles. */
308 :
309 : /* Multiply (compose) two permutations, putting the result in the second one. */
310 : static void
311 21 : perm_mul_inplace2(GEN s, GEN t)
312 : {
313 21 : long i, l = lg(s);
314 525 : for (i = 1; i < l; i++) t[i] = s[t[i]];
315 21 : }
316 :
317 : GEN
318 0 : vecperm_extendschreier(GEN C, GEN v, long n)
319 : {
320 0 : pari_sp av = avma;
321 0 : long mj, lv = lg(v), m = 1, mtested = 1;
322 0 : GEN bit = const_vecsmall(n, 0);
323 0 : GEN cy = cgetg(n+1, t_VECSMALL);
324 0 : GEN sh = const_vec(n, gen_0);
325 0 : for(mj=1; mj<=n; mj++)
326 : {
327 0 : if (isintzero(gel(C,mj))) continue;
328 0 : gel(sh,mj) = gcopy(gel(C,mj));
329 0 : if (bit[mj]) continue;
330 0 : cy[m++] = mj;
331 0 : bit[mj] = 1;
332 : for(;;)
333 0 : {
334 0 : long o, mold = m;
335 0 : for (o = 1; o < lv; o++)
336 : {
337 0 : GEN vo = gel(v,o);
338 : long p;
339 0 : for (p = mtested; p < mold; p++) /* m increases! */
340 : {
341 0 : long j = vo[ cy[p] ];
342 0 : if (!bit[j])
343 : {
344 0 : gel(sh,j) = perm_mul(vo, gel(sh, cy[p]));
345 0 : cy[m++] = j;
346 : }
347 0 : bit[j] = 1;
348 : }
349 : }
350 0 : mtested = mold;
351 0 : if (m == mold) break;
352 : }
353 : }
354 0 : return gerepileupto(av, sh);
355 : }
356 :
357 : /* Orbits of the subgroup generated by v on {1,..,n} */
358 : static GEN
359 1136173 : vecperm_orbits_i(GEN v, long n)
360 : {
361 1136173 : long mj = 1, lv = lg(v), k, l;
362 1136173 : GEN cycle = cgetg(n+1, t_VEC), bit = const_vecsmall(n, 0);
363 7318055 : for (k = 1, l = 1; k <= n;)
364 : {
365 6181823 : pari_sp ltop = avma;
366 6181823 : long m = 1;
367 6181823 : GEN cy = cgetg(n+1, t_VECSMALL);
368 7500343 : for ( ; bit[mj]; mj++) /*empty*/;
369 6181689 : k++; cy[m++] = mj;
370 6181689 : bit[mj++] = 1;
371 : for(;;)
372 2289851 : {
373 8471540 : long o, mold = m;
374 16957354 : for (o = 1; o < lv; o++)
375 : {
376 8485814 : GEN vo = gel(v,o);
377 : long p;
378 27778675 : for (p = 1; p < m; p++) /* m increases! */
379 : {
380 19292861 : long j = vo[ cy[p] ];
381 19292861 : if (!bit[j]) cy[m++] = j;
382 19292861 : bit[j] = 1;
383 : }
384 : }
385 8471540 : if (m == mold) break;
386 2289851 : k += m - mold;
387 : }
388 6181689 : setlg(cy, m);
389 6181641 : gel(cycle,l++) = gerepileuptoleaf(ltop, cy);
390 : }
391 1136232 : setlg(cycle, l); return cycle;
392 : }
393 : /* memory clean version */
394 : GEN
395 4732 : vecperm_orbits(GEN v, long n)
396 : {
397 4732 : pari_sp av = avma;
398 4732 : return gerepilecopy(av, vecperm_orbits_i(v, n));
399 : }
400 :
401 : static int
402 2667 : isperm(GEN v)
403 : {
404 2667 : pari_sp av = avma;
405 2667 : long i, n = lg(v)-1;
406 : GEN w;
407 2667 : if (typ(v) != t_VECSMALL) return 0;
408 2667 : w = zero_zv(n);
409 26411 : for (i=1; i<=n; i++)
410 : {
411 23779 : long d = v[i];
412 23779 : if (d < 1 || d > n || w[d]) return gc_bool(av,0);
413 23744 : w[d] = 1;
414 : }
415 2632 : return gc_bool(av,1);
416 : }
417 :
418 : /* Compute the cyclic decomposition of a permutation */
419 : GEN
420 13370 : perm_cycles(GEN v)
421 : {
422 13370 : pari_sp av = avma;
423 13370 : return gerepilecopy(av, vecperm_orbits_i(mkvec(v), lg(v)-1));
424 : }
425 :
426 : GEN
427 259 : permcycles(GEN v)
428 : {
429 259 : if (!isperm(v)) pari_err_TYPE("permcycles",v);
430 252 : return perm_cycles(v);
431 : }
432 :
433 : /* Output the order of p */
434 : ulong
435 433190 : perm_orderu(GEN v)
436 : {
437 433190 : pari_sp av = avma;
438 433190 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
439 : long i, d;
440 3087808 : for(i=1, d=1; i<lg(c); i++) d = ulcm(d, lg(gel(c,i))-1);
441 433198 : return gc_ulong(av,d);
442 : }
443 :
444 : static GEN
445 2002 : _domul(void *data, GEN x, GEN y)
446 : {
447 2002 : GEN (*mul)(GEN,GEN)=(GEN (*)(GEN,GEN)) data;
448 2002 : return mul(x,y);
449 : }
450 :
451 : /* Output the order of p */
452 : GEN
453 427 : perm_order(GEN v)
454 : {
455 427 : pari_sp av = avma;
456 427 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
457 427 : long i, l = lg(c);
458 427 : GEN V = cgetg(l, t_VEC);
459 2856 : for (i = 1; i < l; i++)
460 2429 : gel(V,i) = utoi(lg(gel(c,i))-1);
461 427 : return gerepileuptoint(av, gen_product(V, (void *)lcmii, _domul));
462 : }
463 :
464 : GEN
465 434 : permorder(GEN v)
466 : {
467 434 : if (!isperm(v)) pari_err_TYPE("permorder",v);
468 427 : return perm_order(v);
469 : }
470 :
471 : /* sign of a permutation */
472 : long
473 684489 : perm_sign(GEN v)
474 : {
475 684489 : pari_sp av = avma;
476 684489 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
477 684493 : long i, l = lg(c), s = 1;
478 4153529 : for (i = 1; i < l; i++)
479 3469040 : if (odd(lg(gel(c, i)))) s = -s;
480 684489 : return gc_long(av,s);
481 : }
482 :
483 : long
484 273 : permsign(GEN v)
485 : {
486 273 : if (!isperm(v)) pari_err_TYPE("permsign",v);
487 259 : return perm_sign(v);
488 : }
489 :
490 : GEN
491 5915 : Z_to_perm(long n, GEN x)
492 : {
493 : pari_sp av;
494 : ulong i, r;
495 5915 : GEN v = cgetg(n+1, t_VECSMALL);
496 5915 : if (n==0) return v;
497 5908 : uel(v,n) = 1; av = avma;
498 5908 : if (signe(x) <= 0) x = modii(x, mpfact(n));
499 27146 : for (r=n-1; r>=1; r--)
500 : {
501 : ulong a;
502 21238 : x = absdiviu_rem(x, n+1-r, &a);
503 71687 : for (i=r+1; i<=(ulong)n; i++)
504 50449 : if (uel(v,i) > a) uel(v,i)++;
505 21238 : uel(v,r) = a+1;
506 : }
507 5908 : set_avma(av); return v;
508 : }
509 : GEN
510 5915 : numtoperm(long n, GEN x)
511 : {
512 5915 : if (n < 0) pari_err_DOMAIN("numtoperm", "n", "<", gen_0, stoi(n));
513 5915 : if (typ(x) != t_INT) pari_err_TYPE("numtoperm",x);
514 5915 : return Z_to_perm(n, x);
515 : }
516 :
517 : /* destroys v */
518 : static GEN
519 1701 : perm_to_Z_inplace(GEN v)
520 : {
521 1701 : long l = lg(v), i, r;
522 1701 : GEN x = gen_0;
523 1701 : if (!isperm(v)) return NULL;
524 10143 : for (i = 1; i < l; i++)
525 : {
526 8449 : long vi = v[i];
527 8449 : if (vi <= 0) return NULL;
528 8449 : x = i==1 ? utoi(vi-1): addiu(muliu(x,l-i), vi-1);
529 25396 : for (r = i+1; r < l; r++)
530 16947 : if (v[r] > vi) v[r]--;
531 : }
532 1694 : return x;
533 : }
534 : GEN
535 1680 : perm_to_Z(GEN v)
536 : {
537 1680 : pari_sp av = avma;
538 1680 : GEN x = perm_to_Z_inplace(leafcopy(v));
539 1680 : if (!x) pari_err_TYPE("permtonum",v);
540 1680 : return gerepileuptoint(av, x);
541 : }
542 : GEN
543 1708 : permtonum(GEN p)
544 : {
545 1708 : pari_sp av = avma;
546 : GEN v, x;
547 1708 : switch(typ(p))
548 : {
549 1680 : case t_VECSMALL: return perm_to_Z(p);
550 21 : case t_VEC: case t_COL:
551 21 : if (RgV_is_ZV(p)) { v = ZV_to_zv(p); break; }
552 7 : default: pari_err_TYPE("permtonum",p);
553 : return NULL;/*LCOV_EXCL_LINE*/
554 : }
555 21 : x = perm_to_Z_inplace(v);
556 21 : if (!x) pari_err_TYPE("permtonum",p);
557 14 : return gerepileuptoint(av, x);
558 : }
559 :
560 : GEN
561 7336 : cyc_pow(GEN cyc, long exp)
562 : {
563 : long i, j, k, l, r;
564 : GEN c;
565 22239 : for (r = j = 1; j < lg(cyc); j++)
566 : {
567 14903 : long n = lg(gel(cyc,j)) - 1;
568 14903 : r += cgcd(n, exp);
569 : }
570 7336 : c = cgetg(r, t_VEC);
571 22239 : for (r = j = 1; j < lg(cyc); j++)
572 : {
573 14903 : GEN v = gel(cyc,j);
574 14903 : long n = lg(v) - 1, e = umodsu(exp,n), g = (long)ugcd(n, e), m = n / g;
575 31724 : for (i = 0; i < g; i++)
576 : {
577 16821 : GEN p = cgetg(m+1, t_VECSMALL);
578 16821 : gel(c,r++) = p;
579 54824 : for (k = 1, l = i; k <= m; k++)
580 : {
581 38003 : p[k] = v[l+1];
582 38003 : l += e; if (l >= n) l -= n;
583 : }
584 : }
585 : }
586 7336 : return c;
587 : }
588 :
589 : /* Compute the power of a permutation given by product of cycles
590 : * Ouput a perm, not a cyc */
591 : GEN
592 0 : cyc_pow_perm(GEN cyc, long exp)
593 : {
594 : long e, j, k, l, n;
595 : GEN p;
596 0 : for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
597 0 : p = cgetg(n + 1, t_VECSMALL);
598 0 : for (j = 1; j < lg(cyc); j++)
599 : {
600 0 : GEN v = gel(cyc,j);
601 0 : n = lg(v) - 1; e = umodsu(exp, n);
602 0 : for (k = 1, l = e; k <= n; k++)
603 : {
604 0 : p[v[k]] = v[l+1];
605 0 : if (++l == n) l = 0;
606 : }
607 : }
608 0 : return p;
609 : }
610 :
611 : GEN
612 49 : perm_pow(GEN perm, GEN exp)
613 : {
614 49 : long i, r = lg(perm)-1;
615 49 : GEN p = zero_zv(r);
616 49 : pari_sp av = avma;
617 49 : GEN v = cgetg(r+1, t_VECSMALL);
618 168 : for (i=1; i<=r; i++)
619 : {
620 : long e, n, k, l;
621 119 : if (p[i]) continue;
622 49 : v[1] = i;
623 119 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
624 49 : e = umodiu(exp, n);
625 168 : for (k = 1, l = e; k <= n; k++)
626 : {
627 119 : p[v[k]] = v[l+1];
628 119 : if (++l == n) l = 0;
629 : }
630 : }
631 49 : set_avma(av); return p;
632 : }
633 :
634 : GEN
635 18529 : perm_powu(GEN perm, ulong exp)
636 : {
637 18529 : ulong i, r = lg(perm)-1;
638 18529 : GEN p = zero_zv(r);
639 18529 : pari_sp av = avma;
640 18529 : GEN v = cgetg(r+1, t_VECSMALL);
641 245686 : for (i=1; i<=r; i++)
642 : {
643 : ulong e, n, k, l;
644 227157 : if (p[i]) continue;
645 84406 : v[1] = i;
646 227157 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
647 84406 : e = exp % n;
648 311563 : for (k = 1, l = e; k <= n; k++)
649 : {
650 227157 : p[v[k]] = v[l+1];
651 227157 : if (++l == n) l = 0;
652 : }
653 : }
654 18529 : set_avma(av); return p;
655 : }
656 :
657 : GEN
658 21 : perm_to_GAP(GEN p)
659 : {
660 21 : pari_sp ltop=avma;
661 : GEN gap;
662 : GEN x;
663 : long i;
664 21 : long nb, c=0;
665 : char *s;
666 : long sz;
667 21 : long lp=lg(p)-1;
668 21 : if (typ(p) != t_VECSMALL) pari_err_TYPE("perm_to_GAP",p);
669 21 : x = perm_cycles(p);
670 21 : sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
671 : /*Dry run*/
672 133 : for (i = 1, nb = 1; i < lg(x); ++i)
673 : {
674 112 : GEN z = gel(x,i);
675 112 : long lz = lg(z)-1;
676 112 : nb += 1+lz*(sz+2);
677 : }
678 21 : nb++;
679 : /*Real run*/
680 21 : gap = cgetg(nchar2nlong(nb) + 1, t_STR);
681 21 : s = GSTR(gap);
682 133 : for (i = 1; i < lg(x); ++i)
683 : {
684 : long j;
685 112 : GEN z = gel(x,i);
686 112 : if (lg(z) > 2)
687 : {
688 112 : s[c++] = '(';
689 364 : for (j = 1; j < lg(z); ++j)
690 : {
691 252 : if (j > 1)
692 : {
693 140 : s[c++] = ','; s[c++] = ' ';
694 : }
695 252 : sprintf(s+c,"%ld",z[j]);
696 567 : while(s[c++]) /* empty */;
697 252 : c--;
698 : }
699 112 : s[c++] = ')';
700 : }
701 : }
702 21 : if (!c) { s[c++]='('; s[c++]=')'; }
703 21 : s[c] = '\0';
704 21 : return gerepileupto(ltop,gap);
705 : }
706 :
707 : int
708 572495 : perm_commute(GEN s, GEN t)
709 : {
710 572495 : long i, l = lg(t);
711 40373487 : for (i = 1; i < l; i++)
712 39820382 : if (t[ s[i] ] != s[ t[i] ]) return 0;
713 553105 : return 1;
714 : }
715 :
716 : /*************************************************************************/
717 : /** **/
718 : /** Routines for handling groups **/
719 : /** **/
720 : /*************************************************************************/
721 : /* A Group is a t_VEC [gen,orders]
722 : * gen (vecvecsmall): list of generators given by permutations
723 : * orders (vecsmall): relatives orders of generators. */
724 935901 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
725 1584943 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
726 :
727 : /* A Quotient Group is a t_VEC [gen,coset]
728 : * gen (vecvecsmall): coset generators
729 : * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
730 : */
731 140951 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
732 29708 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
733 :
734 : static GEN
735 52346 : trivialsubgroups(void)
736 52346 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
737 :
738 : /* Compute the order of p modulo the group given by a set */
739 : long
740 220115 : perm_relorder(GEN p, GEN set)
741 : {
742 220115 : pari_sp ltop = avma;
743 220115 : long n = 1, q = p[1];
744 653877 : while (!F2v_coeff(set,q)) { q = p[q]; n++; }
745 220115 : return gc_long(ltop,n);
746 : }
747 :
748 : GEN
749 13048 : perm_generate(GEN S, GEN H, long o)
750 : {
751 13048 : long i, n = lg(H)-1;
752 13048 : GEN L = cgetg(n*o + 1, t_VEC);
753 45829 : for(i=1; i<=n; i++) gel(L,i) = vecsmall_copy(gel(H,i));
754 50617 : for( ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
755 13048 : return L;
756 : }
757 :
758 : /*Return the order (cardinality) of a group */
759 : long
760 705340 : group_order(GEN G)
761 : {
762 705340 : return zv_prod(grp_get_ord(G));
763 : }
764 :
765 : /* G being a subgroup of S_n, output n */
766 : long
767 26628 : group_domain(GEN G)
768 : {
769 26628 : GEN gen = grp_get_gen(G);
770 26628 : if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
771 26628 : return lg(gel(gen,1)) - 1;
772 : }
773 :
774 : /*Left coset of g mod G: gG*/
775 : GEN
776 301231 : group_leftcoset(GEN G, GEN g)
777 : {
778 301231 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
779 301231 : GEN res = cgetg(group_order(G)+1, t_VEC);
780 : long i, j, k;
781 301230 : gel(res,1) = vecsmall_copy(g);
782 301233 : k = 1;
783 553857 : for (i = 1; i < lg(gen); i++)
784 : {
785 252628 : long c = k * (ord[i] - 1);
786 694757 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
787 : }
788 301229 : return res;
789 : }
790 : /*Right coset of g mod G: Gg*/
791 : GEN
792 179451 : group_rightcoset(GEN G, GEN g)
793 : {
794 179451 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
795 179451 : GEN res = cgetg(group_order(G)+1, t_VEC);
796 : long i, j, k;
797 179450 : gel(res,1) = vecsmall_copy(g);
798 179450 : k = 1;
799 309965 : for (i = 1; i < lg(gen); i++)
800 : {
801 130515 : long c = k * (ord[i] - 1);
802 410807 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
803 : }
804 179450 : return res;
805 : }
806 : /*Elements of a group from the generators, cf group_leftcoset*/
807 : GEN
808 140713 : group_elts(GEN G, long n)
809 : {
810 140713 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
811 140713 : GEN res = cgetg(group_order(G)+1, t_VEC);
812 : long i, j, k;
813 140713 : gel(res,1) = identity_perm(n);
814 140713 : k = 1;
815 285179 : for (i = 1; i < lg(gen); i++)
816 : {
817 144465 : long c = k * (ord[i] - 1);
818 : /* j = 1, use res[1] = identity */
819 144465 : gel(res,++k) = vecsmall_copy(gel(gen,i));
820 384125 : for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
821 : }
822 140714 : return res;
823 : }
824 :
825 : GEN
826 14448 : groupelts_conj_set(GEN elts, GEN p)
827 : {
828 14448 : long i, j, l = lg(elts), n = lg(p)-1;
829 14448 : GEN res = zero_F2v(n);
830 241465 : for(j = 1; j < n; j++)
831 241465 : if (p[j]==1) break;
832 101136 : for(i = 1; i < l; i++)
833 86688 : F2v_set(res, p[mael(elts,i,j)]);
834 14448 : return res;
835 : }
836 :
837 : GEN
838 28014 : groupelts_set(GEN elts, long n)
839 : {
840 28014 : GEN res = zero_F2v(n);
841 28014 : long i, l = lg(elts);
842 137410 : for(i=1; i<l; i++)
843 109396 : F2v_set(res,mael(elts,i,1));
844 28014 : return res;
845 : }
846 :
847 : /*Elements of a group from the generators, returned as a set (bitmap)*/
848 : GEN
849 90671 : group_set(GEN G, long n)
850 : {
851 90671 : GEN res = zero_F2v(n);
852 90671 : pari_sp av = avma;
853 90671 : GEN elts = group_elts(G, n);
854 90671 : long i, l = lg(elts);
855 284214 : for(i=1; i<l; i++)
856 193543 : F2v_set(res,mael(elts,i,1));
857 90671 : set_avma(av);
858 90671 : return res;
859 : }
860 :
861 : static int
862 17353 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
863 :
864 : GEN
865 497 : subgroups_tableset(GEN S, long n)
866 : {
867 497 : long i, l = lg(S);
868 497 : GEN v = cgetg(l, t_VEC);
869 5411 : for(i=1; i<l; i++)
870 4914 : gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
871 497 : gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
872 497 : return v;
873 : }
874 :
875 : long
876 2002 : tableset_find_index(GEN tbl, GEN set)
877 : {
878 2002 : long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
879 2002 : if (!i) return 0;
880 2002 : return mael3(tbl,i,2,1);
881 : }
882 :
883 : GEN
884 52367 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
885 :
886 : /*Cyclic group generated by g of order s*/
887 : GEN
888 26656 : cyclicgroup(GEN g, long s)
889 26656 : { retmkvec2(mkvec( vecsmall_copy(g) ), mkvecsmall(s)); }
890 :
891 : /*Return the group generated by g1,g2 of relative orders s1,s2*/
892 : GEN
893 1085 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
894 1085 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
895 : mkvecsmall2(s1, s2) ); }
896 :
897 : /* return the quotient map G --> G/H */
898 : /*The ouput is [gen,hash]*/
899 : /* gen (vecvecsmall): coset generators
900 : * coset (vecsmall): vecsmall of coset number) */
901 : GEN
902 11522 : groupelts_quotient(GEN elt, GEN H)
903 : {
904 11522 : pari_sp ltop = avma;
905 : GEN p2, p3;
906 11522 : long i, j, a = 1;
907 11522 : long n = lg(gel(elt,1))-1, o = group_order(H);
908 : GEN el;
909 11522 : long le = lg(elt)-1;
910 11522 : GEN used = zero_F2v(le+1);
911 11522 : long l = le/o;
912 11522 : p2 = cgetg(l+1, t_VEC);
913 11522 : p3 = zero_zv(n);
914 11522 : el = zero_zv(n);
915 148722 : for (i = 1; i<=le; i++)
916 137200 : el[mael(elt,i,1)]=i;
917 68075 : for (i = 1; i <= l; ++i)
918 : {
919 : GEN V;
920 150003 : while(F2v_coeff(used,a)) a++;
921 56560 : V = group_leftcoset(H,gel(elt,a));
922 56560 : gel(p2,i) = gel(V,1);
923 193655 : for(j=1;j<lg(V);j++)
924 : {
925 137102 : long b = el[mael(V,j,1)];
926 137102 : if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
927 137095 : F2v_set(used,b);
928 : }
929 193641 : for (j = 1; j <= o; j++)
930 137088 : p3[mael(V, j, 1)] = i;
931 : }
932 11515 : return gerepilecopy(ltop,mkvec2(p2,p3));
933 : }
934 :
935 : GEN
936 10157 : group_quotient(GEN G, GEN H)
937 : {
938 10157 : return groupelts_quotient(group_elts(G, group_domain(G)), H);
939 : }
940 :
941 : /*Compute the image of a permutation by a quotient map.*/
942 : GEN
943 29708 : quotient_perm(GEN C, GEN p)
944 : {
945 29708 : GEN gen = quo_get_gen(C);
946 29708 : GEN coset = quo_get_coset(C);
947 29708 : long j, l = lg(gen);
948 29708 : GEN p3 = cgetg(l, t_VECSMALL);
949 282163 : for (j = 1; j < l; ++j)
950 : {
951 252455 : p3[j] = coset[p[mael(gen,j,1)]];
952 252455 : if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
953 : }
954 29708 : return p3;
955 : }
956 :
957 : /* H is a subgroup of G, C is the quotient map G --> G/H
958 : *
959 : * Lift a subgroup S of G/H to a subgroup of G containing H */
960 : GEN
961 50547 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
962 : {
963 50547 : GEN genH = grp_get_gen(H);
964 50547 : GEN genS = grp_get_gen(S);
965 50547 : GEN genC = quo_get_gen(C);
966 50547 : long l1 = lg(genH)-1;
967 50547 : long l2 = lg(genS)-1, j;
968 50547 : GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
969 101262 : for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
970 117719 : for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
971 50547 : gel(p1,1) = L;
972 50547 : gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
973 50547 : return p1;
974 : }
975 :
976 : /* Let G a group and C a quotient map G --> G/H
977 : * Assume H is normal, return the group G/H */
978 : GEN
979 10150 : quotient_group(GEN C, GEN G)
980 : {
981 10150 : pari_sp ltop = avma;
982 : GEN Qgen, Qord, Qelt, Qset, Q;
983 10150 : GEN Cgen = quo_get_gen(C);
984 10150 : GEN Ggen = grp_get_gen(G);
985 10150 : long i,j, n = lg(Cgen)-1, l = lg(Ggen);
986 10150 : Qord = cgetg(l, t_VECSMALL);
987 10150 : Qgen = cgetg(l, t_VEC);
988 10150 : Qelt = mkvec(identity_perm(n));
989 10150 : Qset = groupelts_set(Qelt, n);
990 31052 : for (i = 1, j = 1; i < l; ++i)
991 : {
992 20902 : GEN g = quotient_perm(C, gel(Ggen,i));
993 20902 : long o = perm_relorder(g, Qset);
994 20902 : gel(Qgen,j) = g;
995 20902 : Qord[j] = o;
996 20902 : if (o != 1)
997 : {
998 13048 : Qelt = perm_generate(g, Qelt, o);
999 13048 : Qset = groupelts_set(Qelt, n);
1000 13048 : j++;
1001 : }
1002 : }
1003 10150 : setlg(Qgen,j);
1004 10150 : setlg(Qord,j); Q = mkvec2(Qgen, Qord);
1005 10150 : return gerepilecopy(ltop,Q);
1006 : }
1007 :
1008 : GEN
1009 1365 : quotient_groupelts(GEN C)
1010 : {
1011 1365 : GEN G = quo_get_gen(C);
1012 1365 : long i, l = lg(G);
1013 1365 : GEN Q = cgetg(l, t_VEC);
1014 10171 : for (i = 1; i < l; ++i)
1015 8806 : gel(Q,i) = quotient_perm(C, gel(G,i));
1016 1365 : return Q;
1017 : }
1018 :
1019 : /* Return 1 if g normalizes N, 0 otherwise */
1020 : long
1021 179451 : group_perm_normalize(GEN N, GEN g)
1022 : {
1023 179451 : pari_sp ltop = avma;
1024 179451 : long r = gequal(vecvecsmall_sort_shallow(group_leftcoset(N, g)),
1025 : vecvecsmall_sort_shallow(group_rightcoset(N, g)));
1026 179451 : return gc_long(ltop, r);
1027 : }
1028 :
1029 : /* L is a list of subgroups, C is a coset and r a relative order.*/
1030 : static GEN
1031 65219 : liftlistsubgroups(GEN L, GEN C, long r)
1032 : {
1033 65219 : pari_sp ltop = avma;
1034 65219 : long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
1035 : GEN R;
1036 65219 : if (!l) return cgetg(1,t_VEC);
1037 58527 : R = cgetg(l*c+1, t_VEC);
1038 142968 : for (i = 1, k = 1; i <= l; ++i)
1039 : {
1040 84441 : GEN S = gel(L,i), Selt = group_set(S,n);
1041 84441 : GEN gen = grp_get_gen(S);
1042 84441 : GEN ord = grp_get_ord(S);
1043 : long j;
1044 279202 : for (j = 1; j <= c; ++j)
1045 : {
1046 194761 : GEN p = gel(C,j);
1047 194761 : if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
1048 108731 : gel(R,k++) = mkvec2(vec_append(gen, p),
1049 : vecsmall_append(ord, r));
1050 : }
1051 : }
1052 58527 : setlg(R, k);
1053 58527 : return gerepilecopy(ltop, R);
1054 : }
1055 :
1056 : /* H is a normal subgroup, C is the quotient map G -->G/H,
1057 : * S is a subgroup of G/H, and G is embedded in Sym(l)
1058 : * Return all the subgroups K of G such that
1059 : * S= K mod H and K inter H={1} */
1060 : static GEN
1061 49182 : liftsubgroup(GEN C, GEN H, GEN S)
1062 : {
1063 49182 : pari_sp ltop = avma;
1064 49182 : GEN V = trivialsubgroups();
1065 49182 : GEN Sgen = grp_get_gen(S);
1066 49182 : GEN Sord = grp_get_ord(S);
1067 49182 : GEN Cgen = quo_get_gen(C);
1068 49182 : long n = lg(Sgen), i;
1069 114401 : for (i = 1; i < n; ++i)
1070 : { /*loop over generators of S*/
1071 65219 : GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
1072 65219 : V = liftlistsubgroups(V, W, Sord[i]);
1073 : }
1074 49182 : return gerepilecopy(ltop,V);
1075 : }
1076 :
1077 : /* 1:A4, 2:S4, 3:F36, 0: other */
1078 : long
1079 9982 : group_isA4S4(GEN G)
1080 : {
1081 9982 : GEN elt = grp_get_gen(G);
1082 9982 : GEN ord = grp_get_ord(G);
1083 9982 : long n = lg(ord);
1084 9982 : if (n != 4 && n != 5) return 0;
1085 2219 : if (n==4 && ord[1]==3 && ord[2]==3 && ord[3]==4)
1086 : {
1087 : long i;
1088 7 : GEN p = gel(elt,1), q = gel(elt,2), r = gel(elt,3);
1089 259 : for(i=1; i<=36; i++)
1090 252 : if (p[r[i]]!=r[q[i]]) return 0;
1091 7 : return 3;
1092 : }
1093 2212 : if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
1094 42 : if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
1095 42 : if (n==4) return 1;
1096 21 : if (ord[4]!=2) return 0;
1097 21 : if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
1098 21 : return 2;
1099 : }
1100 : /* compute all the subgroups of a group G */
1101 : GEN
1102 13146 : group_subgroups(GEN G)
1103 : {
1104 13146 : pari_sp ltop = avma;
1105 : GEN p1, H, C, Q, M, sg1, sg2, sg3;
1106 13146 : GEN gen = grp_get_gen(G);
1107 13146 : GEN ord = grp_get_ord(G);
1108 13146 : long lM, i, j, n = lg(gen);
1109 : long t;
1110 13146 : if (n == 1) return trivialsubgroups();
1111 9982 : t = group_isA4S4(G);
1112 9982 : if (t == 3)
1113 : {
1114 7 : GEN H = mkvec2(mkvec3(gel(gen,1), gel(gen,2), perm_sqr(gel(gen,3))),
1115 : mkvecsmall3(3, 3, 2));
1116 7 : GEN S = group_subgroups(H);
1117 7 : GEN V = cgetg(11,t_VEC);
1118 7 : gel(V,1) = cyclicgroup(gel(gen,3),4);
1119 63 : for (i=2; i<10; i++)
1120 56 : gel(V,i) = cyclicgroup(perm_mul(gmael3(V,i-1,1,1),gel(gen,i%3==1 ? 2:1)),4);
1121 7 : gel(V,10) = G;
1122 7 : return gerepilecopy(ltop,shallowconcat(S,V));
1123 : }
1124 9975 : else if (t)
1125 : {
1126 42 : GEN s = gel(gen,1); /*s = (1,2)(3,4) */
1127 42 : GEN t = gel(gen,2); /*t = (1,3)(2,4) */
1128 42 : GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
1129 42 : H = dicyclicgroup(s, t, 2, 2);
1130 : /* sg3 is the list of subgroups intersecting only partially with H*/
1131 42 : sg3 = cgetg((n==4)?4: 10, t_VEC);
1132 42 : gel(sg3,1) = cyclicgroup(s, 2);
1133 42 : gel(sg3,2) = cyclicgroup(t, 2);
1134 42 : gel(sg3,3) = cyclicgroup(st, 2);
1135 42 : if (n==5)
1136 : {
1137 21 : GEN u = gel(gen,3);
1138 21 : GEN v = gel(gen,4), w, u2;
1139 21 : if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
1140 21 : u2 = perm_sqr(u);
1141 : else
1142 : {
1143 0 : u2 = u;
1144 0 : u = perm_sqr(u);
1145 : }
1146 21 : if (perm_orderu(v)==2)
1147 : {
1148 21 : if (!perm_commute(s,v)) /*v=(1,2)*/
1149 : {
1150 0 : v = perm_conj(u,v);
1151 0 : if (!perm_commute(s,v)) v = perm_conj(u,v);
1152 : }
1153 21 : w = perm_mul(v,t); /*w=(1,4,2,3)*/
1154 : }
1155 : else
1156 : {
1157 0 : w = v;
1158 0 : if (!zv_equal(perm_sqr(w), s)) /*w=(1,4,2,3)*/
1159 : {
1160 0 : w = perm_conj(u,w);
1161 0 : if (!zv_equal(perm_sqr(w), s)) w = perm_conj(u,w);
1162 : }
1163 0 : v = perm_mul(w,t); /*v=(1,2)*/
1164 : }
1165 21 : gel(sg3,4) = dicyclicgroup(s,v,2,2);
1166 21 : gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
1167 21 : gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
1168 21 : gel(sg3,7) = dicyclicgroup(s,w,2,2);
1169 21 : gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
1170 21 : gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
1171 : }
1172 : }
1173 : else
1174 : {
1175 9933 : ulong osig = mael(factoru(ord[1]), 1, 1);
1176 9933 : GEN sig = perm_powu(gel(gen,1), ord[1]/osig);
1177 9933 : H = cyclicgroup(sig,osig);
1178 9933 : sg3 = NULL;
1179 : }
1180 9975 : C = group_quotient(G,H);
1181 9968 : Q = quotient_group(C,G);
1182 9968 : M = group_subgroups(Q); lM = lg(M);
1183 : /* sg1 is the list of subgroups containing H*/
1184 9961 : sg1 = cgetg(lM, t_VEC);
1185 59143 : for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
1186 : /*sg2 is a list of lists of subgroups not intersecting with H*/
1187 9961 : sg2 = cgetg(lM, t_VEC);
1188 : /* Loop over all subgroups of G/H */
1189 59143 : for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
1190 9961 : p1 = gconcat(sg1, shallowconcat1(sg2));
1191 9961 : if (sg3)
1192 : {
1193 42 : p1 = gconcat(p1, sg3);
1194 42 : if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
1195 84 : for(j = 3; j <= 5; j++)
1196 : {
1197 63 : GEN c = gmael(p1,j,1);
1198 63 : if (!perm_commute(gel(c,1),gel(c,3)))
1199 : {
1200 42 : if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
1201 : else
1202 21 : perm_mul_inplace2(gel(c,2), gel(c,1));
1203 : }
1204 : }
1205 : }
1206 9961 : return gerepileupto(ltop,p1);
1207 : }
1208 :
1209 : /*return 1 if G is abelian, else 0*/
1210 : long
1211 9177 : group_isabelian(GEN G)
1212 : {
1213 9177 : GEN g = grp_get_gen(G);
1214 9177 : long i, j, n = lg(g);
1215 13097 : for(i=2; i<n; i++)
1216 13034 : for(j=1; j<i; j++)
1217 9114 : if (!perm_commute(gel(g,i), gel(g,j))) return 0;
1218 4235 : return 1;
1219 : }
1220 :
1221 : /*If G is abelian, return its HNF matrix*/
1222 : GEN
1223 385 : group_abelianHNF(GEN G, GEN S)
1224 : {
1225 385 : GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
1226 385 : long i, j, k, n = lg(g);
1227 385 : if (!group_isabelian(G)) return NULL;
1228 315 : if (n==1) return cgetg(1,t_MAT);
1229 301 : if (!S) S = group_elts(G, group_domain(G));
1230 301 : M = cgetg(n,t_MAT);
1231 980 : for(i=1; i<n; i++)
1232 : {
1233 679 : GEN P, C = cgetg(n,t_COL);
1234 679 : pari_sp av = avma;
1235 679 : gel(M,i) = C;
1236 679 : P = perm_inv(perm_powu(gel(g,i), o[i]));
1237 959 : for(j=1; j<lg(S); j++)
1238 959 : if (zv_equal(P, gel(S,j))) break;
1239 679 : set_avma(av);
1240 679 : if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
1241 679 : j--;
1242 1218 : for(k=1; k<i; k++)
1243 : {
1244 539 : long q = j / o[k];
1245 539 : gel(C,k) = stoi(j - q*o[k]);
1246 539 : j = q;
1247 : }
1248 679 : gel(C,k) = stoi(o[i]);
1249 1218 : for (k++; k<n; k++) gel(C,k) = gen_0;
1250 : }
1251 301 : return M;
1252 : }
1253 :
1254 : /*If G is abelian, return its abstract SNF matrix*/
1255 : GEN
1256 336 : group_abelianSNF(GEN G, GEN L)
1257 : {
1258 336 : pari_sp ltop = avma;
1259 336 : GEN H = group_abelianHNF(G,L);
1260 336 : if (!H) return NULL;
1261 266 : return gerepileupto(ltop, smithclean( ZM_snf(H) ));
1262 : }
1263 :
1264 : GEN
1265 455 : abelian_group(GEN v)
1266 : {
1267 455 : long card = zv_prod(v), i, d = 1, l = lg(v);
1268 455 : GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
1269 455 : gel(G,1) = gen;
1270 455 : gel(G,2) = vecsmall_copy(v);
1271 959 : for(i=1; i<l; i++)
1272 : {
1273 504 : GEN p = cgetg(card+1, t_VECSMALL);
1274 504 : long o = v[i], u = d*(o-1), j, k, l;
1275 504 : gel(gen, i) = p;
1276 : /* The following loop is over-optimized. Remember that I wrote it for
1277 : * testpermutation. Something has survived... BA */
1278 1148 : for(j=1;j<=card;)
1279 : {
1280 2380 : for(k=1;k<o;k++)
1281 4599 : for(l=1;l<=d; l++,j++) p[j] = j+d;
1282 2107 : for (l=1; l<=d; l++,j++) p[j] = j-u;
1283 : }
1284 504 : d += u;
1285 : }
1286 455 : return G;
1287 : }
1288 :
1289 : static long
1290 13783 : groupelts_subgroup_isnormal(GEN G, GEN H)
1291 : {
1292 13783 : long i, n = lg(G);
1293 61530 : for(i = 1; i < n; i++)
1294 60102 : if (!group_perm_normalize(H, gel(G,i))) return 0;
1295 1428 : return 1;
1296 : }
1297 :
1298 : /*return 1 if H is a normal subgroup of G*/
1299 : long
1300 336 : group_subgroup_isnormal(GEN G, GEN H)
1301 : {
1302 336 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1303 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1304 : strtoGENstr("domain(G)"), H);
1305 336 : return groupelts_subgroup_isnormal(grp_get_gen(G), H);
1306 : }
1307 :
1308 : static GEN
1309 4816 : group_subgroup_kernel_set(GEN G, GEN H)
1310 : {
1311 : pari_sp av;
1312 4816 : GEN g = grp_get_gen(G);
1313 4816 : long i, n = lg(g);
1314 : GEN S, elts;
1315 4816 : long d = group_domain(G);
1316 4816 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1317 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1318 : strtoGENstr("domain(G)"), H);
1319 4816 : elts = group_elts(H,d);
1320 4816 : S = groupelts_set(elts, d);
1321 4816 : av = avma;
1322 19264 : for(i=1; i<n; i++)
1323 : {
1324 14448 : F2v_and_inplace(S, groupelts_conj_set(elts,gel(g,i)));
1325 14448 : set_avma(av);
1326 : }
1327 4816 : return S;
1328 : }
1329 :
1330 : int
1331 4816 : group_subgroup_is_faithful(GEN G, GEN H)
1332 : {
1333 4816 : pari_sp av = avma;
1334 4816 : GEN K = group_subgroup_kernel_set(G,H);
1335 4816 : F2v_clear(K,1);
1336 4816 : return gc_long(av, F2v_equal0(K));
1337 : }
1338 :
1339 : long
1340 0 : groupelts_exponent(GEN elts)
1341 : {
1342 0 : long i, n = lg(elts)-1, expo = 1;
1343 0 : for(i=1; i<=n; i++) expo = ulcm(expo, perm_orderu(gel(elts,i)));
1344 0 : return expo;
1345 : }
1346 :
1347 : GEN
1348 700 : groupelts_center(GEN S)
1349 : {
1350 700 : pari_sp ltop = avma;
1351 700 : long i, j, n = lg(S)-1, l = n;
1352 700 : GEN V, elts = zero_F2v(n+1);
1353 25732 : for(i=1; i<=n; i++)
1354 : {
1355 25032 : if (F2v_coeff(elts,i)) { l--; continue; }
1356 573384 : for(j=1; j<=n; j++)
1357 563192 : if (!perm_commute(gel(S,i),gel(S,j)))
1358 : {
1359 14322 : F2v_set(elts,i);
1360 14322 : F2v_set(elts,j); l--; break;
1361 : }
1362 : }
1363 700 : V = cgetg(l+1,t_VEC);
1364 25732 : for (i=1, j=1; i<=n ;i++)
1365 25032 : if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
1366 700 : return gerepileupto(ltop,V);
1367 : }
1368 :
1369 : GEN
1370 4270 : groupelts_conjclasses(GEN elts, long *pnbcl)
1371 : {
1372 4270 : long i, j, cl = 0, n = lg(elts)-1;
1373 4270 : GEN c = const_vecsmall(n,0);
1374 4270 : pari_sp av = avma;
1375 52850 : for (i=1; i<=n; i++)
1376 : {
1377 48580 : GEN g = gel(elts,i);
1378 48580 : if (c[i]) continue;
1379 34965 : c[i] = ++cl;
1380 486871 : for(j=1; j<=n; j++)
1381 451906 : if (j != i)
1382 : {
1383 416941 : GEN h = perm_conj(gel(elts,j), g);
1384 416941 : long i2 = gen_search(elts,h,(void*)&vecsmall_lexcmp,&cmp_nodata);
1385 416941 : c[i2] = cl; set_avma(av);
1386 : }
1387 : }
1388 4270 : if (pnbcl) *pnbcl = cl;
1389 4270 : return c;
1390 : }
1391 :
1392 : GEN
1393 4270 : conjclasses_repr(GEN conj, long nb)
1394 : {
1395 4270 : long i, l = lg(conj);
1396 4270 : GEN e = const_vecsmall(nb, 0);
1397 52850 : for(i=1; i<l; i++)
1398 : {
1399 48580 : long ci = conj[i];
1400 48580 : if (!e[ci]) e[ci] = i;
1401 : }
1402 4270 : return e;
1403 : }
1404 :
1405 : /* elts of G sorted wrt vecsmall_lexcmp order: g in G is determined by g[1]
1406 : * so sort by increasing g[1] */
1407 : static GEN
1408 3885 : galois_elts_sorted(GEN gal)
1409 : {
1410 : long i, l;
1411 3885 : GEN elts = gal_get_group(gal), v = cgetg_copy(elts, &l);
1412 43141 : for (i = 1; i < l; i++) { GEN g = gel(elts,i); gel(v, g[1]) = g; }
1413 3885 : return v;
1414 : }
1415 : GEN
1416 4291 : group_to_cc(GEN G)
1417 : {
1418 4291 : GEN elts = checkgroupelts(G), z = cgetg(5,t_VEC);
1419 4270 : long n, flag = 1;
1420 4270 : if (typ(gel(G,1)) == t_POL)
1421 3885 : elts = galois_elts_sorted(G); /* galoisinit */
1422 : else
1423 : {
1424 385 : long i, l = lg(elts);
1425 385 : elts = gen_sort_shallow(elts,(void*)vecsmall_lexcmp,cmp_nodata);
1426 5824 : for (i = 1; i < l; i++)
1427 5586 : if (gel(elts,i)[1] != i) { flag = 0; break; }
1428 : }
1429 4270 : gel(z,1) = elts;
1430 4270 : gel(z,2) = groupelts_conjclasses(elts,&n);
1431 4270 : gel(z,3) = conjclasses_repr(gel(z,2),n);
1432 4270 : gel(z,4) = utoi(flag); return z;
1433 : }
1434 :
1435 : /* S a list of generators */
1436 : GEN
1437 0 : groupelts_abelian_group(GEN S)
1438 : {
1439 0 : pari_sp ltop = avma;
1440 : GEN Qgen, Qord, Qelt;
1441 0 : long i, j, n = lg(gel(S,1))-1, l = lg(S);
1442 0 : Qord = cgetg(l, t_VECSMALL);
1443 0 : Qgen = cgetg(l, t_VEC);
1444 0 : Qelt = mkvec(identity_perm(n));
1445 0 : for (i = 1, j = 1; i < l; ++i)
1446 : {
1447 0 : GEN g = gel(S,i);
1448 0 : long o = perm_relorder(g, groupelts_set(Qelt, n));
1449 0 : gel(Qgen,j) = g;
1450 0 : Qord[j] = o;
1451 0 : if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
1452 : }
1453 0 : setlg(Qgen,j);
1454 0 : setlg(Qord,j);
1455 0 : return gerepilecopy(ltop, mkvec2(Qgen, Qord));
1456 : }
1457 :
1458 : GEN
1459 14 : group_export_GAP(GEN G)
1460 : {
1461 14 : pari_sp av = avma;
1462 14 : GEN s, comma, g = grp_get_gen(G);
1463 14 : long i, k, l = lg(g);
1464 14 : if (l == 1) return strtoGENstr("Group(())");
1465 7 : s = cgetg(2*l, t_VEC);
1466 7 : comma = strtoGENstr(", ");
1467 7 : gel(s,1) = strtoGENstr("Group(");
1468 28 : for (i=1, k=2; i < l; ++i)
1469 : {
1470 21 : if (i > 1) gel(s,k++) = comma;
1471 21 : gel(s,k++) = perm_to_GAP(gel(g,i));
1472 : }
1473 7 : gel(s,k++) = strtoGENstr(")");
1474 7 : return gerepilecopy(av, shallowconcat1(s));
1475 : }
1476 :
1477 : GEN
1478 14 : group_export_MAGMA(GEN G)
1479 : {
1480 14 : pari_sp av = avma;
1481 14 : GEN s, comma, g = grp_get_gen(G);
1482 14 : long i, k, l = lg(g);
1483 14 : if (l == 1) return strtoGENstr("PermutationGroup<1|>");
1484 7 : s = cgetg(2*l, t_VEC);
1485 7 : comma = strtoGENstr(", ");
1486 7 : gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
1487 28 : for (i=1, k=2; i < l; ++i)
1488 : {
1489 21 : if (i > 1) gel(s,k++) = comma;
1490 21 : gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
1491 : }
1492 7 : gel(s,k++) = strtoGENstr(">");
1493 7 : return gerepilecopy(av, shallowconcat1(s));
1494 : }
1495 :
1496 : GEN
1497 28 : group_export(GEN G, long format)
1498 : {
1499 28 : switch(format)
1500 : {
1501 14 : case 0: return group_export_GAP(G);
1502 14 : case 1: return group_export_MAGMA(G);
1503 : }
1504 0 : pari_err_FLAG("galoisexport");
1505 0 : return NULL; /*-Wall*/
1506 : }
1507 :
1508 : static GEN
1509 3010 : groupelts_cyclic_subgroups(GEN G)
1510 : {
1511 3010 : pari_sp av = avma;
1512 3010 : long i, j, n = lg(G)-1;
1513 : GEN elts, f, gen, ord;
1514 3010 : if (n==1) return cgetg(1,t_VEC);
1515 3010 : elts = zero_F2v(lg(gel(G,1))-1);
1516 3010 : gen = cgetg(n+1, t_VECSMALL);
1517 3010 : ord = cgetg(n+1, t_VECSMALL);
1518 48958 : for (i=1, j=1; i<=n; i++)
1519 : {
1520 45948 : long k = 1, o, c = 0;
1521 45948 : GEN p = gel(G, i);
1522 45948 : if (F2v_coeff(elts, p[1])) continue;
1523 33439 : o = perm_orderu(p);
1524 33439 : gen[j] = i; ord[j] = o; j++;
1525 : do
1526 : {
1527 90748 : if (cgcd(o, ++c)==1) F2v_set(elts, p[k]);
1528 90748 : k = p[k];
1529 90748 : } while (k!=1);
1530 : }
1531 3010 : setlg(gen, j);
1532 3010 : setlg(ord, j);
1533 3010 : f = vecsmall_indexsort(ord);
1534 3010 : return gerepilecopy(av, mkvec2(vecpermute(gen, f), vecpermute(ord, f)));
1535 : }
1536 :
1537 : GEN
1538 3017 : groupelts_to_group(GEN G)
1539 : {
1540 3017 : pari_sp av = avma;
1541 : GEN L, cyc, ord;
1542 3017 : long i, l, n = lg(G)-1;
1543 3017 : if (n==1) return trivialgroup();
1544 3003 : L = groupelts_cyclic_subgroups(G);
1545 3003 : cyc = gel(L,1); ord = gel(L,2);
1546 3003 : l = lg(cyc);
1547 15085 : for (i = l-1; i >= 2; i--)
1548 : {
1549 14455 : GEN p = gel(G,cyc[i]);
1550 14455 : long o = ord[i];
1551 14455 : GEN H = cyclicgroup(p, o);
1552 14455 : if (o == n) return gerepileupto(av, H);
1553 13447 : if (groupelts_subgroup_isnormal(G, H))
1554 : {
1555 1365 : GEN C = groupelts_quotient(G, H);
1556 1365 : GEN Q = quotient_groupelts(C);
1557 1365 : GEN R = groupelts_to_group(Q);
1558 1365 : if (!R) return gc_NULL(av);
1559 1365 : return gerepilecopy(av, quotient_subgroup_lift(C, H, R));
1560 : }
1561 : }
1562 630 : if (n==12 && l==9 && ord[2]==2 && ord[3]==2 && ord[5]==3)
1563 532 : return gerepilecopy(av,
1564 266 : mkvec2(mkvec3(gel(G,cyc[2]), gel(G,cyc[3]), gel(G,cyc[5])), mkvecsmall3(2,2,3)));
1565 364 : if (n==24 && l==18 && ord[11]==3 && ord[15]==4 && ord[16]==4)
1566 : {
1567 350 : GEN t21 = perm_sqr(gel(G,cyc[15]));
1568 350 : GEN t22 = perm_sqr(gel(G,cyc[16]));
1569 350 : GEN s = perm_mul(t22, gel(G,cyc[15]));
1570 700 : return gerepilecopy(av,
1571 350 : mkvec2(mkvec4(t21,t22, gel(G,cyc[11]), s), mkvecsmall4(2,2,3,2)));
1572 : }
1573 14 : if (n==36 && l==24 && ord[11]==3 && ord[15]==4)
1574 : {
1575 7 : GEN t1 = gel(G,cyc[11]), t3 = gel(G,cyc[15]);
1576 7 : return gerepilecopy(av,
1577 : mkvec2(mkvec3(perm_conj(t3, t1), t1, t3), mkvecsmall3(3,3,4)));
1578 : }
1579 7 : return gc_NULL(av);
1580 : }
1581 :
1582 : static GEN
1583 581 : subg_get_gen(GEN subg) { return gel(subg, 1); }
1584 :
1585 : static GEN
1586 4333 : subg_get_set(GEN subg) { return gel(subg, 2); }
1587 :
1588 : static GEN
1589 399 : groupelt_subg_normalize(GEN elt, GEN subg, GEN cyc)
1590 : {
1591 399 : GEN gen = subg_get_gen(subg), set = subg_get_set(subg);
1592 399 : long i, j, u, n = lg(elt)-1, lgen = lg(gen);
1593 399 : GEN b = F2v_copy(cyc), res = zero_F2v(n);
1594 24339 : for(i = 1; i <= n; i++)
1595 : {
1596 : GEN g;
1597 23940 : if (!F2v_coeff(b, i)) continue;
1598 11186 : g = gel(elt,i);
1599 381731 : for(u=1; u<=n; u++)
1600 381731 : if (g[u]==1) break;
1601 12159 : for(j=1; j<lgen; j++)
1602 : {
1603 11473 : GEN h = gel(elt,gen[j]);
1604 11473 : if (!F2v_coeff(set,g[h[u]])) break;
1605 : }
1606 11186 : if (j < lgen) continue;
1607 686 : F2v_set(res,i);
1608 41846 : for(j=1; j <= n; j++)
1609 41160 : if (F2v_coeff(set, j))
1610 2940 : F2v_clear(b,g[gel(elt,j)[1]]);
1611 : }
1612 399 : return res;
1613 : }
1614 :
1615 : static GEN
1616 7 : triv_subg(GEN elt)
1617 : {
1618 7 : GEN v = cgetg(3, t_VEC);
1619 7 : gel(v,1) = cgetg(1,t_VECSMALL);
1620 7 : gel(v,2) = zero_F2v(lg(elt)-1);
1621 7 : F2v_set(gel(v,2),1);
1622 7 : return v;
1623 : }
1624 :
1625 : static GEN
1626 182 : subg_extend(GEN U, long e, long o, GEN elt)
1627 : {
1628 182 : long i, j, n = lg(elt)-1;
1629 182 : GEN g = gel(elt, e);
1630 182 : GEN gen = vecsmall_append(subg_get_gen(U), e);
1631 182 : GEN set = subg_get_set(U);
1632 182 : GEN Vset = zv_copy(set);
1633 11102 : for(i = 1; i <= n; i++)
1634 10920 : if (F2v_coeff(set, i))
1635 : {
1636 630 : long h = gel(elt, i)[1];
1637 1400 : for(j = 1; j < o; j++)
1638 : {
1639 770 : h = g[h];
1640 770 : F2v_set(Vset, h);
1641 : }
1642 : }
1643 182 : return mkvec2(gen, Vset);
1644 : }
1645 :
1646 : static GEN
1647 217 : cyclic_subg(long e, long o, GEN elt)
1648 : {
1649 217 : long j, n = lg(elt)-1, h = 1;
1650 217 : GEN g = gel(elt, e);
1651 217 : GEN gen = mkvecsmall(e);
1652 217 : GEN set = zero_F2v(n);
1653 217 : F2v_set(set,1);
1654 630 : for(j = 1; j < o; j++)
1655 : {
1656 413 : h = g[h];
1657 413 : F2v_set(set, h);
1658 : }
1659 217 : return mkvec2(gen, set);
1660 : }
1661 :
1662 : static GEN
1663 7 : groupelts_to_regular(GEN elt)
1664 : {
1665 7 : long i, j, n = lg(elt)-1;
1666 7 : GEN V = cgetg(n+1,t_VEC);
1667 427 : for (i=1; i<=n; i++)
1668 : {
1669 420 : pari_sp av = avma;
1670 420 : GEN g = gel(elt, i);
1671 420 : GEN W = cgetg(n+1,t_VEC);
1672 25620 : for(j=1; j<=n; j++)
1673 25200 : gel(W,j) = perm_mul(g, gel(elt,j));
1674 420 : gel(V, i) = gerepileuptoleaf(av,vecvecsmall_indexsort(W));
1675 : }
1676 7 : vecvecsmall_sort_inplace(V, NULL);
1677 7 : return V;
1678 : }
1679 :
1680 : static long
1681 217 : groupelts_pow(GEN elt, long j, long n)
1682 : {
1683 217 : GEN g = gel(elt,j);
1684 217 : long i, h = 1;
1685 847 : for (i=1; i<=n; i++)
1686 630 : h = g[h];
1687 217 : return h;
1688 : }
1689 :
1690 : static GEN
1691 7 : groupelts_cyclic_primepow(GEN elt, GEN *pt_pr, GEN *pt_po)
1692 : {
1693 7 : GEN R = groupelts_cyclic_subgroups(elt);
1694 7 : GEN gen = gel(R,1), ord = gel(R,2);
1695 7 : long i, n = lg(elt)-1, l = lg(gen);
1696 7 : GEN set = zero_F2v(n);
1697 7 : GEN pr = zero_Flv(n);
1698 7 : GEN po = zero_Flv(n);
1699 231 : for (i = 1; i < l; i++)
1700 : {
1701 224 : long h = gen[i];
1702 : ulong p;
1703 224 : if (uisprimepower(ord[i], &p))
1704 : {
1705 217 : F2v_set(set, h);
1706 217 : uel(pr,h) = p;
1707 217 : po[h] = groupelts_pow(elt, h, p);
1708 : }
1709 : }
1710 7 : *pt_pr = pr; *pt_po = po;
1711 7 : return set;
1712 : }
1713 :
1714 : static GEN
1715 7 : all_cyclic_subg(GEN pr, GEN po, GEN elt)
1716 : {
1717 7 : long i, n = lg(pr)-1, m = 0, k = 1;
1718 : GEN W;
1719 427 : for (i=1; i <= n; i++)
1720 420 : m += po[i]==1;
1721 7 : W = cgetg(m+1, t_VEC);
1722 427 : for (i=1; i <= n; i++)
1723 420 : if (po[i]==1)
1724 217 : gel(W, k++) = cyclic_subg(i, pr[i], elt);
1725 7 : return W;
1726 : }
1727 :
1728 : static GEN
1729 7 : groupelts_subgroups_raw(GEN elts)
1730 : {
1731 7 : pari_sp av = avma;
1732 7 : GEN elt = groupelts_to_regular(elts);
1733 7 : GEN pr, po, cyc = groupelts_cyclic_primepow(elt, &pr, &po);
1734 7 : long n = lg(elt)-1;
1735 7 : long i, j, nS = 1;
1736 : GEN S, L;
1737 7 : S = cgetg(1+bigomegau(n)+1, t_VEC);
1738 7 : gel(S, nS++) = mkvec(triv_subg(elt));
1739 7 : gel(S, nS++) = L = all_cyclic_subg(pr, po, elt);
1740 7 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS,lg(L)-1);
1741 28 : while (lg(L) > 1)
1742 : {
1743 21 : pari_sp av2 = avma;
1744 21 : long nW = 1, lL = lg(L);
1745 21 : long ng = n;
1746 21 : GEN W = cgetg(1+ng, t_VEC);
1747 420 : for (i=1; i<lL; i++)
1748 : {
1749 399 : GEN U = gel(L, i), set = subg_get_set(U);
1750 399 : GEN G = groupelt_subg_normalize(elt, U, cyc);
1751 3570 : for (j=1; j<nW; j++)
1752 : {
1753 3171 : GEN Wj = subg_get_set(gel(W, j));
1754 3171 : if (F2v_subset(set, Wj))
1755 364 : F2v_negimply_inplace(G, Wj);
1756 : }
1757 24339 : for (j=1; j<=n; j++)
1758 23940 : if(F2v_coeff(G,j))
1759 : {
1760 378 : long p = pr[j];
1761 378 : if (F2v_coeff(set, j)) continue;
1762 182 : if (F2v_coeff(set, po[j]))
1763 : {
1764 182 : GEN U2 = subg_extend(U, j, p, elt);
1765 182 : F2v_negimply_inplace(G, subg_get_set(U2));
1766 182 : if (nW > ng) { ng<<=1; W = vec_lengthen(W, ng); }
1767 182 : gel(W, nW++) = U2;
1768 : }
1769 : }
1770 : }
1771 21 : setlg(W, nW);
1772 21 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS,nW-1);
1773 21 : L = W;
1774 21 : if (nW > 1) gel(S, nS++) = L = gerepilecopy(av2, W);
1775 : }
1776 7 : setlg(S, nS);
1777 7 : return gerepilecopy(av, shallowconcat1(S));
1778 : }
1779 :
1780 : static GEN
1781 406 : set_groupelts(GEN S, GEN x)
1782 : {
1783 406 : long i, n = F2v_hamming(x), k=1, m = x[1];
1784 406 : GEN v = cgetg(n+1, t_VEC);
1785 24766 : for (i=1; i<=m; i++)
1786 24360 : if (F2v_coeff(x,i))
1787 2037 : gel(v,k++) = gel(S,i);
1788 406 : return v;
1789 : }
1790 :
1791 : static GEN
1792 7 : subg_to_elts(GEN S, GEN x)
1793 413 : { pari_APPLY_type(t_VEC, set_groupelts(S, gmael(x,i,2))); }
1794 :
1795 : GEN
1796 7 : groupelts_solvablesubgroups(GEN G)
1797 : {
1798 7 : pari_sp av = avma;
1799 7 : GEN S = vecvecsmall_sort(checkgroupelts(G));
1800 7 : GEN L = groupelts_subgroups_raw(S);
1801 7 : return gerepilecopy(av, subg_to_elts(S, L));
1802 : }
|
