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 1848 : vec_isconst(GEN v)
25 : {
26 1848 : long i, l = lg(v);
27 : GEN w;
28 1848 : if (l==1) return 1;
29 1848 : w = gel(v,1);
30 6349 : for(i=2; i<l; i++)
31 5768 : if (!gequal(gel(v,i), w)) return 0;
32 581 : return 1;
33 : }
34 :
35 : int
36 17893 : vecsmall_isconst(GEN v)
37 : {
38 17893 : long i, l = lg(v);
39 : ulong w;
40 17893 : if (l==1) return 1;
41 17893 : w = uel(v,1);
42 30735 : for(i=2; i<l; i++)
43 24721 : if (uel(v,i) != w) return 0;
44 6014 : 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 279797544 : vecsmall_sortspec(GEN v, long n, GEN w)
81 : {
82 279797544 : pari_sp ltop=avma;
83 279797544 : long nx=n>>1, ny=n-nx;
84 : long m, ix, iy;
85 : GEN x, y;
86 279797544 : if (n<=2)
87 : {
88 163193220 : if (n==1)
89 34792610 : w[0]=v[0];
90 128400610 : else if (n==2)
91 : {
92 133355696 : long v0=v[0], v1=v[1];
93 133355696 : if (v0<=v1) { w[0]=v0; w[1]=v1; }
94 4213780 : else { w[0]=v1; w[1]=v0; }
95 : }
96 163193220 : return;
97 : }
98 116604324 : x=new_chunk(nx); y=new_chunk(ny);
99 126034573 : vecsmall_sortspec(v,nx,x);
100 127616186 : vecsmall_sortspec(v+nx,ny,y);
101 570703974 : for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
102 440142406 : if (x[ix]<=y[iy])
103 371628125 : w[m++]=x[ix++];
104 : else
105 68514281 : w[m++]=y[iy++];
106 133478950 : for(;ix<nx;) w[m++]=x[ix++];
107 487194953 : for(;iy<ny;) w[m++]=y[iy++];
108 130561568 : set_avma(ltop);
109 : }
110 :
111 : static long
112 47629987 : vecsmall_sort_max(GEN v)
113 : {
114 47629987 : long i, l = lg(v), max = -1;
115 159754173 : for (i = 1; i < l; i++)
116 158220143 : if (v[i] > max) { max = v[i]; if (max >= l) return -1; }
117 21871192 : else if (v[i] < 0) return -1;
118 1711991 : return max;
119 : }
120 : /* assume 0 <= v[i] <= M. In place. */
121 : void
122 1969219 : vecsmall_counting_sort(GEN v, long M)
123 : {
124 : pari_sp av;
125 : long i, j, k, l;
126 : GEN T;
127 1969219 : if (M == 0) return;
128 1969219 : av = avma; T = new_chunk(M + 1); l = lg(v);
129 9558260 : for (i = 0; i <= M; i++) T[i] = 0;
130 7646940 : for (i = 1; i < l; i++) T[v[i]]++; /* T[j] is # keys = j */
131 9558260 : for (j = 0, k = 1; j <= M; j++)
132 13266768 : for (i = 1; i <= T[j]; i++) v[k++] = j;
133 1969218 : 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 12459 : vecsmall_counting_indexsort(GEN v, long M)
154 : {
155 : pari_sp av;
156 12459 : long i, l = lg(v);
157 : GEN T, p;
158 12459 : if (M == 0 || l <= 2) return identity_zv(l - 1);
159 12445 : p = cgetg(l, t_VECSMALL); av = avma; T = new_chunk(M + 1);
160 55604 : for (i = 0; i <= M; i++) T[i] = 0;
161 14431482 : for (i = 1; i < l; i++) T[v[i]]++; /* T[j] is # keys = j */
162 43159 : for (i = 1; i <= M; i++) T[i] += T[i-1]; /* T[j] is # keys <= j */
163 14431482 : for (i = l-1; i > 0; i--) { p[T[v[i]]] = i; T[v[i]]--; }
164 12445 : return gc_const(av, p);
165 : }
166 :
167 : /* in place sort */
168 : void
169 52019451 : vecsmall_sort(GEN v)
170 : {
171 52019451 : long n = lg(v) - 1, max;
172 52019451 : if (n <= 1) return;
173 45300167 : if ((max = vecsmall_sort_max(v)) >= 0)
174 1969219 : vecsmall_counting_sort(v, max);
175 : else
176 43441862 : vecsmall_sortspec(v+1, n, v+1);
177 : }
178 :
179 : /* cf gen_sortspec */
180 : static GEN
181 8125500 : vecsmall_indexsortspec(GEN v, long n)
182 : {
183 : long nx, ny, m, ix, iy;
184 : GEN x, y, w;
185 8125500 : switch(n)
186 : {
187 158712 : case 1: return mkvecsmall(1);
188 3680306 : case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
189 1454192 : case 3:
190 1454192 : if (v[1] <= v[2]) {
191 699129 : if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
192 208619 : return (v[1] <= v[3])? mkvecsmall3(1,3,2)
193 624769 : : mkvecsmall3(3,1,2);
194 : } else {
195 755063 : if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
196 283327 : return (v[2] <= v[3])? mkvecsmall3(2,3,1)
197 859122 : : mkvecsmall3(3,2,1);
198 : }
199 : }
200 2832290 : nx = n>>1; ny = n-nx;
201 2832290 : w = cgetg(n+1,t_VECSMALL);
202 2832296 : x = vecsmall_indexsortspec(v,nx);
203 2832294 : y = vecsmall_indexsortspec(v+nx,ny);
204 33958840 : for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
205 31126545 : if (v[x[ix]] <= v[y[iy]+nx])
206 15066489 : w[m++] = x[ix++];
207 : else
208 16060056 : w[m++] = y[iy++]+nx;
209 5398643 : for(;ix<=nx;) w[m++] = x[ix++];
210 5394037 : for(;iy<=ny;) w[m++] = y[iy++]+nx;
211 2832295 : set_avma((pari_sp)w); return w;
212 : }
213 :
214 : /*indirect sort.*/
215 : GEN
216 2473436 : vecsmall_indexsort(GEN v)
217 : {
218 2473436 : long n = lg(v) - 1, max;
219 2473436 : if (n==0) return cgetg(1, t_VECSMALL);
220 2473373 : if ((max = vecsmall_sort_max(v)) >= 0)
221 12459 : return vecsmall_counting_indexsort(v, max);
222 : else
223 2460915 : 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 20682 : vecsmall_duplicate(GEN x)
265 : {
266 20682 : pari_sp av = avma;
267 20682 : GEN p = vecsmall_indexsort(x);
268 20682 : long k, i, r = 0, l = lg(x);
269 20682 : if (l == 1) return gc_long(av, 0);
270 28840 : for (k = x[p[1]], i = 2; i < l; k = x[p[i++]])
271 8158 : if (x[p[i]] == k) { r = p[i]; break; }
272 20682 : return gc_long(av, r);
273 : }
274 :
275 : static int
276 55369 : vecsmall_is1to1spec(GEN v, long n, GEN w)
277 : {
278 55369 : pari_sp av = avma;
279 55369 : long nx = n>>1, ny = n - nx, m, ix, iy;
280 : GEN x, y;
281 55369 : if (n <= 2)
282 : {
283 33324 : if (n == 1) w[0] = v[0];
284 21786 : else if (n==2)
285 : {
286 21786 : long v0 = v[0], v1 = v[1];
287 21786 : if (v0 == v1) return 0;
288 21758 : else if (v0 < v1) { w[0] = v0; w[1] = v1; }
289 4635 : else { w[0] = v1; w[1] = v0; }
290 : }
291 33296 : return 1;
292 : }
293 22045 : x = new_chunk(nx); if (!vecsmall_is1to1spec(v, nx, x)) return 0;
294 21947 : y = new_chunk(ny); if (!vecsmall_is1to1spec(v+nx, ny, y)) return 0;
295 85333 : for (m = ix = iy = 0; ix < nx && iy < ny; )
296 63484 : if (x[ix] == y[iy]) return 0;
297 63435 : else if (x[ix] < y[iy])
298 38683 : w[m++] = x[ix++];
299 : else
300 24752 : w[m++] = y[iy++];
301 23971 : while (ix < nx) w[m++] = x[ix++];
302 54431 : while (iy < ny) w[m++] = y[iy++];
303 21849 : return gc_bool(av, 1);
304 : }
305 :
306 : int
307 11503 : vecsmall_is1to1(GEN V)
308 : {
309 11503 : pari_sp av = avma;
310 : long l;
311 11503 : GEN W = cgetg_copy(V, &l);
312 11503 : 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 14 : vecvecsmall_sort(GEN x)
323 14 : { return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
324 : GEN
325 365904 : vecvecsmall_sort_shallow(GEN x)
326 365904 : { return gen_sort_shallow(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
327 :
328 : void
329 126 : vecvecsmall_sort_inplace(GEN x, GEN *perm)
330 126 : { 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 861 : vecvecsmall_indexsort(GEN x)
338 861 : { 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 455372 : vecperm_orbits_i(GEN v, long n)
418 : {
419 455372 : long mj = 1, lv = lg(v), k, l;
420 455372 : GEN cycle = cgetg(n+1, t_VEC), bit = const_vecsmall(n, 0);
421 3248149 : for (k = 1, l = 1; k <= n;)
422 : {
423 2792751 : pari_sp ltop = avma;
424 2792751 : long m = 1;
425 2792751 : GEN cy = cgetg(n+1, t_VECSMALL);
426 3995203 : for ( ; bit[mj]; mj++) /*empty*/;
427 2792711 : k++; cy[m++] = mj;
428 2792711 : bit[mj++] = 1;
429 : for(;;)
430 2010753 : {
431 4803464 : long o, mold = m;
432 9620986 : for (o = 1; o < lv; o++)
433 : {
434 4817522 : GEN vo = gel(v,o);
435 : long p;
436 19642861 : for (p = 1; p < m; p++) /* m increases! */
437 : {
438 14825339 : long j = vo[ cy[p] ];
439 14825339 : if (!bit[j]) cy[m++] = j;
440 14825339 : bit[j] = 1;
441 : }
442 : }
443 4803464 : if (m == mold) break;
444 2010753 : k += m - mold;
445 : }
446 2792711 : setlg(cy, m);
447 2792742 : gel(cycle,l++) = gc_leaf(ltop, cy);
448 : }
449 455398 : 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 13647 : perm_cycles(GEN v)
479 : {
480 13647 : pari_sp av = avma;
481 13647 : 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 436404 : perm_orderu(GEN v)
494 : {
495 436404 : pari_sp av = avma;
496 436404 : GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
497 : long i, d;
498 3169418 : for(i=1, d=1; i<lg(c); i++) d = ulcm(d, lg(gel(c,i))-1);
499 436436 : 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 964948 : perm_sign(GEN v)
532 : {
533 964948 : pari_sp av = avma;
534 964948 : long n = lg(v), s = 1;
535 964948 : GEN w = perm_inv(v);
536 964964 : v = vecsmall_copy(v); /* Following lines update v and w in place */
537 5299316 : 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 4334351 : long i = v[n];
541 4334351 : if (i != n)
542 : { /* apply transposition tau_{i,n} to v and w; n becomes a fixed point */
543 651648 : long j = w[n];
544 651648 : v[j] = i;
545 651648 : w[i] = j;
546 651648 : s = -s;
547 : }
548 : }
549 964965 : 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 : if (vi <= 0) return NULL;
597 8449 : x = i==1 ? utoi(vi-1): addiu(muliu(x,l-i), vi-1);
598 25396 : for (r = i+1; r < l; r++)
599 16947 : if (v[r] > vi) v[r]--;
600 : }
601 1694 : return x;
602 : }
603 : GEN
604 1680 : perm_to_Z(GEN v)
605 : {
606 1680 : pari_sp av = avma;
607 1680 : GEN x = perm_to_Z_inplace(leafcopy(v));
608 1680 : if (!x) pari_err_TYPE("permtonum",v);
609 1680 : return gc_INT(av, x);
610 : }
611 : GEN
612 1708 : permtonum(GEN p)
613 : {
614 1708 : pari_sp av = avma;
615 : GEN v, x;
616 1708 : switch(typ(p))
617 : {
618 1680 : case t_VECSMALL: return perm_to_Z(p);
619 21 : case t_VEC: case t_COL:
620 21 : if (RgV_is_ZV(p)) { v = ZV_to_zv(p); break; }
621 7 : default: pari_err_TYPE("permtonum",p);
622 : return NULL;/*LCOV_EXCL_LINE*/
623 : }
624 21 : x = perm_to_Z_inplace(v);
625 21 : if (!x) pari_err_TYPE("permtonum",p);
626 14 : return gc_INT(av, x);
627 : }
628 :
629 : GEN
630 7485 : cyc_pow(GEN cyc, long exp)
631 : {
632 : long i, j, k, l, r;
633 : GEN c;
634 22537 : for (r = j = 1; j < lg(cyc); j++)
635 : {
636 15052 : long n = lg(gel(cyc,j)) - 1;
637 15052 : r += cgcd(n, exp);
638 : }
639 7485 : c = cgetg(r, t_VEC);
640 22537 : for (r = j = 1; j < lg(cyc); j++)
641 : {
642 15052 : GEN v = gel(cyc,j);
643 15052 : long n = lg(v) - 1, e = umodsu(exp,n), g = (long)ugcd(n, e), m = n / g;
644 32022 : for (i = 0; i < g; i++)
645 : {
646 16970 : GEN p = cgetg(m+1, t_VECSMALL);
647 16970 : gel(c,r++) = p;
648 55271 : for (k = 1, l = i; k <= m; k++)
649 : {
650 38301 : p[k] = v[l+1];
651 38301 : l += e; if (l >= n) l -= n;
652 : }
653 : }
654 : }
655 7485 : return c;
656 : }
657 :
658 : /* Compute the power of a permutation given by product of cycles
659 : * Ouput a perm, not a cyc */
660 : GEN
661 0 : cyc_pow_perm(GEN cyc, long exp)
662 : {
663 : long e, j, k, l, n;
664 : GEN p;
665 0 : for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
666 0 : p = cgetg(n + 1, t_VECSMALL);
667 0 : for (j = 1; j < lg(cyc); j++)
668 : {
669 0 : GEN v = gel(cyc,j);
670 0 : n = lg(v) - 1; e = umodsu(exp, n);
671 0 : for (k = 1, l = e; k <= n; k++)
672 : {
673 0 : p[v[k]] = v[l+1];
674 0 : if (++l == n) l = 0;
675 : }
676 : }
677 0 : return p;
678 : }
679 :
680 : GEN
681 77 : perm_pow(GEN perm, GEN exp)
682 : {
683 77 : long i, r = lg(perm)-1;
684 77 : GEN p = zero_zv(r);
685 77 : pari_sp av = avma;
686 77 : GEN v = cgetg(r+1, t_VECSMALL);
687 273 : for (i=1; i<=r; i++)
688 : {
689 : long e, n, k, l;
690 196 : if (p[i]) continue;
691 77 : v[1] = i;
692 196 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
693 77 : e = umodiu(exp, n);
694 273 : for (k = 1, l = e; k <= n; k++)
695 : {
696 196 : p[v[k]] = v[l+1];
697 196 : if (++l == n) l = 0;
698 : }
699 : }
700 77 : return gc_const(av, p);
701 : }
702 :
703 : GEN
704 18907 : perm_powu(GEN perm, ulong exp)
705 : {
706 18907 : ulong i, r = lg(perm)-1;
707 18907 : GEN p = zero_zv(r);
708 18907 : pari_sp av = avma;
709 18907 : GEN v = cgetg(r+1, t_VECSMALL);
710 247667 : for (i=1; i<=r; i++)
711 : {
712 : ulong e, n, k, l;
713 228760 : if (p[i]) continue;
714 85036 : v[1] = i;
715 228760 : for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
716 85036 : e = exp % n;
717 313796 : for (k = 1, l = e; k <= n; k++)
718 : {
719 228760 : p[v[k]] = v[l+1];
720 228760 : if (++l == n) l = 0;
721 : }
722 : }
723 18907 : return gc_const(av, p);
724 : }
725 :
726 : GEN
727 21 : perm_to_GAP(GEN p)
728 : {
729 21 : pari_sp ltop=avma;
730 : GEN gap;
731 : GEN x;
732 : long i;
733 21 : long nb, c=0;
734 : char *s;
735 : long sz;
736 21 : long lp=lg(p)-1;
737 21 : if (typ(p) != t_VECSMALL) pari_err_TYPE("perm_to_GAP",p);
738 21 : x = perm_cycles(p);
739 21 : sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
740 : /*Dry run*/
741 133 : for (i = 1, nb = 1; i < lg(x); ++i)
742 : {
743 112 : GEN z = gel(x,i);
744 112 : long lz = lg(z)-1;
745 112 : nb += 1+lz*(sz+2);
746 : }
747 21 : nb++;
748 : /*Real run*/
749 21 : gap = cgetg(nchar2nlong(nb) + 1, t_STR);
750 21 : s = GSTR(gap);
751 133 : for (i = 1; i < lg(x); ++i)
752 : {
753 : long j;
754 112 : GEN z = gel(x,i);
755 112 : if (lg(z) > 2)
756 : {
757 112 : s[c++] = '(';
758 364 : for (j = 1; j < lg(z); ++j)
759 : {
760 252 : if (j > 1)
761 : {
762 140 : s[c++] = ','; s[c++] = ' ';
763 : }
764 252 : sprintf(s+c,"%ld",z[j]);
765 567 : while(s[c++]) /* empty */;
766 252 : c--;
767 : }
768 112 : s[c++] = ')';
769 : }
770 : }
771 21 : if (!c) { s[c++]='('; s[c++]=')'; }
772 21 : s[c] = '\0';
773 21 : return gc_upto(ltop,gap);
774 : }
775 :
776 : int
777 572537 : perm_commute(GEN s, GEN t)
778 : {
779 572537 : long i, l = lg(t);
780 40375545 : for (i = 1; i < l; i++)
781 39822398 : if (t[ s[i] ] != s[ t[i] ]) return 0;
782 553147 : return 1;
783 : }
784 :
785 : /*************************************************************************/
786 : /** **/
787 : /** Routines for handling groups **/
788 : /** **/
789 : /*************************************************************************/
790 : /* A Group is a t_VEC [gen,orders]
791 : * gen (vecvecsmall): list of generators given by permutations
792 : * orders (vecsmall): relatives orders of generators. */
793 943733 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
794 1599150 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
795 :
796 : /* A Quotient Group is a t_VEC [gen,coset]
797 : * gen (vecvecsmall): coset generators
798 : * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
799 : */
800 142100 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
801 30114 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
802 :
803 : static GEN
804 52570 : trivialsubgroups(void)
805 52570 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
806 :
807 : /* Compute the order of p modulo the group given by a set */
808 : long
809 220332 : perm_relorder(GEN p, GEN set)
810 : {
811 220332 : pari_sp ltop = avma;
812 220332 : long n = 1, q = p[1];
813 654759 : while (!F2v_coeff(set,q)) { q = p[q]; n++; }
814 220332 : return gc_long(ltop,n);
815 : }
816 :
817 : GEN
818 13104 : perm_generate(GEN S, GEN H, long o)
819 : {
820 13104 : long i, n = lg(H)-1;
821 13104 : GEN L = cgetg(n*o + 1, t_VEC);
822 45941 : for(i=1; i<=n; i++) gel(L,i) = vecsmall_copy(gel(H,i));
823 50813 : for( ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
824 13104 : return L;
825 : }
826 :
827 : /*Return the order (cardinality) of a group */
828 : long
829 711697 : group_order(GEN G)
830 : {
831 711697 : return zv_prod(grp_get_ord(G));
832 : }
833 :
834 : /* G being a subgroup of S_n, output n */
835 : long
836 26740 : group_domain(GEN G)
837 : {
838 26740 : GEN gen = grp_get_gen(G);
839 26740 : if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
840 26740 : return lg(gel(gen,1)) - 1;
841 : }
842 :
843 : /*Left coset of g mod G: gG*/
844 : GEN
845 304654 : group_leftcoset(GEN G, GEN g)
846 : {
847 304654 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
848 304654 : GEN res = cgetg(group_order(G)+1, t_VEC);
849 : long i, j, k;
850 304654 : gel(res,1) = vecsmall_copy(g);
851 304654 : k = 1;
852 560679 : for (i = 1; i < lg(gen); i++)
853 : {
854 256025 : long c = k * (ord[i] - 1);
855 705159 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
856 : }
857 304654 : return res;
858 : }
859 : /*Right coset of g mod G: Gg*/
860 : GEN
861 182273 : group_rightcoset(GEN G, GEN g)
862 : {
863 182273 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
864 182273 : GEN res = cgetg(group_order(G)+1, t_VEC);
865 : long i, j, k;
866 182273 : gel(res,1) = vecsmall_copy(g);
867 182273 : k = 1;
868 315581 : for (i = 1; i < lg(gen); i++)
869 : {
870 133308 : long c = k * (ord[i] - 1);
871 419517 : for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
872 : }
873 182273 : return res;
874 : }
875 : /*Elements of a group from the generators, cf group_leftcoset*/
876 : GEN
877 141162 : group_elts(GEN G, long n)
878 : {
879 141162 : if (lg(G)==3 && typ(gel(G,1))==t_VEC)
880 : {
881 141162 : GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
882 141162 : GEN res = cgetg(group_order(G)+1, t_VEC);
883 : long i, j, k;
884 141162 : gel(res,1) = identity_perm(n);
885 141162 : k = 1;
886 286272 : for (i = 1; i < lg(gen); i++)
887 : {
888 145110 : long c = k * (ord[i] - 1);
889 : /* j = 1, use res[1] = identity */
890 145110 : gel(res,++k) = vecsmall_copy(gel(gen,i));
891 386589 : for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
892 : }
893 141162 : return res;
894 0 : } else return gcopy(G);
895 : }
896 :
897 : GEN
898 14448 : groupelts_conj_set(GEN elts, GEN p)
899 : {
900 14448 : long i, j, l = lg(elts), n = lg(p)-1;
901 14448 : GEN res = zero_F2v(n);
902 241465 : for(j = 1; j < n; j++)
903 241465 : if (p[j]==1) break;
904 101136 : for(i = 1; i < l; i++)
905 86688 : F2v_set(res, p[mael(elts,i,j)]);
906 14448 : return res;
907 : }
908 :
909 : GEN
910 28182 : groupelts_set(GEN elts, long n)
911 : {
912 28182 : GEN res = zero_F2v(n);
913 28182 : long i, l = lg(elts);
914 137886 : for(i=1; i<l; i++)
915 109704 : F2v_set(res,mael(elts,i,1));
916 28182 : return res;
917 : }
918 :
919 : /*Elements of a group from the generators, returned as a set (bitmap)*/
920 : GEN
921 90727 : group_set(GEN G, long n)
922 : {
923 90727 : GEN res = zero_F2v(n);
924 90727 : pari_sp av = avma;
925 90727 : GEN elts = group_elts(G, n);
926 90727 : long i, l = lg(elts);
927 284326 : for(i=1; i<l; i++)
928 193599 : F2v_set(res,mael(elts,i,1));
929 90727 : return gc_const(av, res);
930 : }
931 :
932 : static int
933 17353 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
934 :
935 : GEN
936 497 : subgroups_tableset(GEN S, long n)
937 : {
938 497 : long i, l = lg(S);
939 497 : GEN v = cgetg(l, t_VEC);
940 5411 : for(i=1; i<l; i++)
941 4914 : gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
942 497 : gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
943 497 : return v;
944 : }
945 :
946 : long
947 2002 : tableset_find_index(GEN tbl, GEN set)
948 : {
949 2002 : long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
950 2002 : if (!i) return 0;
951 2002 : return mael3(tbl,i,2,1);
952 : }
953 :
954 : GEN
955 52598 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
956 :
957 : /*Cyclic group generated by g of order s*/
958 : GEN
959 27972 : cyclicgroup(GEN g, long s)
960 27972 : { retmkvec2(mkvec( vecsmall_copy(g) ), mkvecsmall(s)); }
961 :
962 : /*Return the group generated by g1,g2 of relative orders s1,s2*/
963 : GEN
964 1085 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
965 1085 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
966 : mkvecsmall2(s1, s2) ); }
967 :
968 : /* return the quotient map G --> G/H */
969 : /*The ouput is [gen,hash]*/
970 : /* gen (vecvecsmall): coset generators
971 : * coset (vecsmall): vecsmall of coset number) */
972 : GEN
973 11781 : groupelts_quotient(GEN elt, GEN H)
974 : {
975 11781 : pari_sp ltop = avma;
976 : GEN p2, p3;
977 11781 : long i, j, a = 1;
978 11781 : long n = lg(gel(elt,1))-1, o = group_order(H);
979 : GEN el;
980 11781 : long le = lg(elt)-1;
981 11781 : GEN used = zero_F2v(le+1);
982 11781 : long l = le/o;
983 11781 : p2 = cgetg(l+1, t_VEC);
984 11781 : p3 = zero_zv(n);
985 11781 : el = zero_zv(n);
986 150549 : for (i = 1; i<=le; i++)
987 138768 : el[mael(elt,i,1)]=i;
988 68880 : for (i = 1; i <= l; ++i)
989 : {
990 : GEN V;
991 150899 : while(F2v_coeff(used,a)) a++;
992 57106 : V = group_leftcoset(H,gel(elt,a));
993 57106 : gel(p2,i) = gel(V,1);
994 195769 : for(j=1;j<lg(V);j++)
995 : {
996 138670 : long b = el[mael(V,j,1)];
997 138670 : if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
998 138663 : F2v_set(used,b);
999 : }
1000 195755 : for (j = 1; j <= o; j++)
1001 138656 : p3[mael(V, j, 1)] = i;
1002 : }
1003 11774 : return gc_GEN(ltop,mkvec2(p2,p3));
1004 : }
1005 :
1006 : GEN
1007 10269 : group_quotient(GEN G, GEN H)
1008 : {
1009 10269 : return groupelts_quotient(group_elts(G, group_domain(G)), H);
1010 : }
1011 :
1012 : /*Compute the image of a permutation by a quotient map.*/
1013 : GEN
1014 30114 : quotient_perm(GEN C, GEN p)
1015 : {
1016 30114 : GEN gen = quo_get_gen(C);
1017 30114 : GEN coset = quo_get_coset(C);
1018 30114 : long j, l = lg(gen);
1019 30114 : GEN p3 = cgetg(l, t_VECSMALL);
1020 283409 : for (j = 1; j < l; ++j)
1021 : {
1022 253295 : p3[j] = coset[p[mael(gen,j,1)]];
1023 253295 : if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
1024 : }
1025 30114 : return p3;
1026 : }
1027 :
1028 : /* H is a subgroup of G, C is the quotient map G --> G/H
1029 : *
1030 : * Lift a subgroup S of G/H to a subgroup of G containing H */
1031 : GEN
1032 50862 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
1033 : {
1034 50862 : GEN genH = grp_get_gen(H);
1035 50862 : GEN genS = grp_get_gen(S);
1036 50862 : GEN genC = quo_get_gen(C);
1037 50862 : long l1 = lg(genH)-1;
1038 50862 : long l2 = lg(genS)-1, j;
1039 50862 : GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
1040 101892 : for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
1041 118237 : for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
1042 50862 : gel(p1,1) = L;
1043 50862 : gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
1044 50862 : return p1;
1045 : }
1046 :
1047 : /* Let G a group and C a quotient map G --> G/H
1048 : * Assume H is normal, return the group G/H */
1049 : GEN
1050 10262 : quotient_group(GEN C, GEN G)
1051 : {
1052 10262 : pari_sp ltop = avma;
1053 : GEN Qgen, Qord, Qelt, Qset, Q;
1054 10262 : GEN Cgen = quo_get_gen(C);
1055 10262 : GEN Ggen = grp_get_gen(G);
1056 10262 : long i,j, n = lg(Cgen)-1, l = lg(Ggen);
1057 10262 : Qord = cgetg(l, t_VECSMALL);
1058 10262 : Qgen = cgetg(l, t_VEC);
1059 10262 : Qelt = mkvec(identity_perm(n));
1060 10262 : Qset = groupelts_set(Qelt, n);
1061 31276 : for (i = 1, j = 1; i < l; ++i)
1062 : {
1063 21014 : GEN g = quotient_perm(C, gel(Ggen,i));
1064 21014 : long o = perm_relorder(g, Qset);
1065 21014 : gel(Qgen,j) = g;
1066 21014 : Qord[j] = o;
1067 21014 : if (o != 1)
1068 : {
1069 13104 : Qelt = perm_generate(g, Qelt, o);
1070 13104 : Qset = groupelts_set(Qelt, n);
1071 13104 : j++;
1072 : }
1073 : }
1074 10262 : setlg(Qgen,j);
1075 10262 : setlg(Qord,j); Q = mkvec2(Qgen, Qord);
1076 10262 : return gc_GEN(ltop,Q);
1077 : }
1078 :
1079 : GEN
1080 1512 : quotient_groupelts(GEN C)
1081 : {
1082 1512 : GEN G = quo_get_gen(C);
1083 1512 : long i, l = lg(G);
1084 1512 : GEN Q = cgetg(l, t_VEC);
1085 10612 : for (i = 1; i < l; ++i)
1086 9100 : gel(Q,i) = quotient_perm(C, gel(G,i));
1087 1512 : return Q;
1088 : }
1089 :
1090 : /* Return 1 if g normalizes N, 0 otherwise */
1091 : long
1092 182273 : group_perm_normalize(GEN N, GEN g)
1093 : {
1094 182273 : pari_sp ltop = avma;
1095 182273 : long r = gequal(vecvecsmall_sort_shallow(group_leftcoset(N, g)),
1096 : vecvecsmall_sort_shallow(group_rightcoset(N, g)));
1097 182273 : return gc_long(ltop, r);
1098 : }
1099 :
1100 : /* L is a list of subgroups, C is a coset and r a relative order.*/
1101 : static GEN
1102 65275 : liftlistsubgroups(GEN L, GEN C, long r)
1103 : {
1104 65275 : pari_sp ltop = avma;
1105 65275 : long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
1106 : GEN R;
1107 65275 : if (!l) return cgetg(1,t_VEC);
1108 58583 : R = cgetg(l*c+1, t_VEC);
1109 143080 : for (i = 1, k = 1; i <= l; ++i)
1110 : {
1111 84497 : GEN S = gel(L,i), Selt = group_set(S,n);
1112 84497 : GEN gen = grp_get_gen(S);
1113 84497 : GEN ord = grp_get_ord(S);
1114 : long j;
1115 279370 : for (j = 1; j <= c; ++j)
1116 : {
1117 194873 : GEN p = gel(C,j);
1118 194873 : if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
1119 108759 : gel(R,k++) = mkvec2(vec_append(gen, p),
1120 : vecsmall_append(ord, r));
1121 : }
1122 : }
1123 58583 : setlg(R, k);
1124 58583 : return gc_GEN(ltop, R);
1125 : }
1126 :
1127 : /* H is a normal subgroup, C is the quotient map G -->G/H,
1128 : * S is a subgroup of G/H, and G is embedded in Sym(l)
1129 : * Return all the subgroups K of G such that
1130 : * S= K mod H and K inter H={1} */
1131 : static GEN
1132 49350 : liftsubgroup(GEN C, GEN H, GEN S)
1133 : {
1134 49350 : pari_sp ltop = avma;
1135 49350 : GEN V = trivialsubgroups();
1136 49350 : GEN Sgen = grp_get_gen(S);
1137 49350 : GEN Sord = grp_get_ord(S);
1138 49350 : GEN Cgen = quo_get_gen(C);
1139 49350 : long n = lg(Sgen), i;
1140 114625 : for (i = 1; i < n; ++i)
1141 : { /*loop over generators of S*/
1142 65275 : GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
1143 65275 : V = liftlistsubgroups(V, W, Sord[i]);
1144 : }
1145 49350 : return gc_GEN(ltop,V);
1146 : }
1147 :
1148 : /* 1:A4, 2:S4, 3:F36, 0: other */
1149 : long
1150 10094 : group_isA4S4(GEN G)
1151 : {
1152 10094 : GEN elt = grp_get_gen(G);
1153 10094 : GEN ord = grp_get_ord(G);
1154 10094 : long n = lg(ord);
1155 10094 : if (n != 4 && n != 5) return 0;
1156 2219 : if (n==4 && ord[1]==3 && ord[2]==3 && ord[3]==4)
1157 : {
1158 : long i;
1159 7 : GEN p = gel(elt,1), q = gel(elt,2), r = gel(elt,3);
1160 259 : for(i=1; i<=36; i++)
1161 252 : if (p[r[i]]!=r[q[i]]) return 0;
1162 7 : return 3;
1163 : }
1164 2212 : if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
1165 42 : if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
1166 42 : if (n==4) return 1;
1167 21 : if (ord[4]!=2) return 0;
1168 21 : if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
1169 21 : return 2;
1170 : }
1171 : /* compute all the subgroups of a group G */
1172 : GEN
1173 13314 : group_subgroups(GEN G)
1174 : {
1175 13314 : pari_sp ltop = avma;
1176 : GEN p1, H, C, Q, M, sg1, sg2, sg3;
1177 13314 : GEN gen = grp_get_gen(G);
1178 13314 : GEN ord = grp_get_ord(G);
1179 13314 : long lM, i, j, n = lg(gen);
1180 : long t;
1181 13314 : if (n == 1) return trivialsubgroups();
1182 10094 : t = group_isA4S4(G);
1183 10094 : if (t == 3)
1184 : {
1185 7 : GEN H = mkvec2(mkvec3(gel(gen,1), gel(gen,2), perm_sqr(gel(gen,3))),
1186 : mkvecsmall3(3, 3, 2));
1187 7 : GEN S = group_subgroups(H);
1188 7 : GEN V = cgetg(11,t_VEC);
1189 7 : gel(V,1) = cyclicgroup(gel(gen,3),4);
1190 63 : for (i=2; i<10; i++)
1191 56 : gel(V,i) = cyclicgroup(perm_mul(gmael3(V,i-1,1,1),gel(gen,i%3==1 ? 2:1)),4);
1192 7 : gel(V,10) = G;
1193 7 : return gc_GEN(ltop,shallowconcat(S,V));
1194 : }
1195 10087 : else if (t)
1196 : {
1197 42 : GEN s = gel(gen,1); /*s = (1,2)(3,4) */
1198 42 : GEN t = gel(gen,2); /*t = (1,3)(2,4) */
1199 42 : GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
1200 42 : H = dicyclicgroup(s, t, 2, 2);
1201 : /* sg3 is the list of subgroups intersecting only partially with H*/
1202 42 : sg3 = cgetg((n==4)?4: 10, t_VEC);
1203 42 : gel(sg3,1) = cyclicgroup(s, 2);
1204 42 : gel(sg3,2) = cyclicgroup(t, 2);
1205 42 : gel(sg3,3) = cyclicgroup(st, 2);
1206 42 : if (n==5)
1207 : {
1208 21 : GEN u = gel(gen,3);
1209 21 : GEN v = gel(gen,4), w, u2;
1210 21 : if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
1211 21 : u2 = perm_sqr(u);
1212 : else
1213 : {
1214 0 : u2 = u;
1215 0 : u = perm_sqr(u);
1216 : }
1217 21 : if (perm_orderu(v)==2)
1218 : {
1219 21 : if (!perm_commute(s,v)) /*v=(1,2)*/
1220 : {
1221 0 : v = perm_conj(u,v);
1222 0 : if (!perm_commute(s,v)) v = perm_conj(u,v);
1223 : }
1224 21 : w = perm_mul(v,t); /*w=(1,4,2,3)*/
1225 : }
1226 : else
1227 : {
1228 0 : w = v;
1229 0 : if (!zv_equal(perm_sqr(w), s)) /*w=(1,4,2,3)*/
1230 : {
1231 0 : w = perm_conj(u,w);
1232 0 : if (!zv_equal(perm_sqr(w), s)) w = perm_conj(u,w);
1233 : }
1234 0 : v = perm_mul(w,t); /*v=(1,2)*/
1235 : }
1236 21 : gel(sg3,4) = dicyclicgroup(s,v,2,2);
1237 21 : gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
1238 21 : gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
1239 21 : gel(sg3,7) = dicyclicgroup(s,w,2,2);
1240 21 : gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
1241 21 : gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
1242 : }
1243 : }
1244 : else
1245 : {
1246 10045 : ulong osig = mael(factoru(ord[1]), 1, 1);
1247 10045 : GEN sig = perm_powu(gel(gen,1), ord[1]/osig);
1248 10045 : H = cyclicgroup(sig,osig);
1249 10045 : sg3 = NULL;
1250 : }
1251 10087 : C = group_quotient(G,H);
1252 10080 : Q = quotient_group(C,G);
1253 10080 : M = group_subgroups(Q); lM = lg(M);
1254 : /* sg1 is the list of subgroups containing H*/
1255 10073 : sg1 = cgetg(lM, t_VEC);
1256 59423 : for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
1257 : /*sg2 is a list of lists of subgroups not intersecting with H*/
1258 10073 : sg2 = cgetg(lM, t_VEC);
1259 : /* Loop over all subgroups of G/H */
1260 59423 : for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
1261 10073 : p1 = gconcat(sg1, shallowconcat1(sg2));
1262 10073 : if (sg3)
1263 : {
1264 42 : p1 = gconcat(p1, sg3);
1265 42 : if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
1266 84 : for(j = 3; j <= 5; j++)
1267 : {
1268 63 : GEN c = gmael(p1,j,1);
1269 63 : if (!perm_commute(gel(c,1),gel(c,3)))
1270 : {
1271 42 : if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
1272 : else
1273 21 : perm_mul_inplace2(gel(c,2), gel(c,1));
1274 : }
1275 : }
1276 : }
1277 10073 : return gc_upto(ltop,p1);
1278 : }
1279 :
1280 : /*return 1 if G is abelian, else 0*/
1281 : long
1282 8946 : group_isabelian(GEN G)
1283 : {
1284 8946 : GEN g = grp_get_gen(G);
1285 8946 : long i, j, n = lg(g);
1286 12894 : for(i=2; i<n; i++)
1287 13104 : for(j=1; j<i; j++)
1288 9156 : if (!perm_commute(gel(g,i), gel(g,j))) return 0;
1289 4004 : return 1;
1290 : }
1291 :
1292 : /*If G is abelian, return its HNF matrix*/
1293 : GEN
1294 385 : group_abelianHNF(GEN G, GEN S)
1295 : {
1296 385 : GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
1297 385 : long i, j, k, n = lg(g);
1298 385 : if (!group_isabelian(G)) return NULL;
1299 315 : if (n==1) return cgetg(1,t_MAT);
1300 301 : if (!S) S = group_elts(G, group_domain(G));
1301 301 : M = cgetg(n,t_MAT);
1302 980 : for(i=1; i<n; i++)
1303 : {
1304 679 : GEN P, C = cgetg(n,t_COL);
1305 679 : pari_sp av = avma;
1306 679 : gel(M,i) = C;
1307 679 : P = perm_inv(perm_powu(gel(g,i), o[i]));
1308 959 : for(j=1; j<lg(S); j++)
1309 959 : if (zv_equal(P, gel(S,j))) break;
1310 679 : set_avma(av);
1311 679 : if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
1312 679 : j--;
1313 1218 : for(k=1; k<i; k++)
1314 : {
1315 539 : long q = j / o[k];
1316 539 : gel(C,k) = stoi(j - q*o[k]);
1317 539 : j = q;
1318 : }
1319 679 : gel(C,k) = stoi(o[i]);
1320 1218 : for (k++; k<n; k++) gel(C,k) = gen_0;
1321 : }
1322 301 : return M;
1323 : }
1324 :
1325 : /*If G is abelian, return its abstract SNF matrix*/
1326 : GEN
1327 336 : group_abelianSNF(GEN G, GEN L)
1328 : {
1329 336 : pari_sp ltop = avma;
1330 336 : GEN H = group_abelianHNF(G,L);
1331 336 : if (!H) return NULL;
1332 266 : return gc_upto(ltop, smithclean( ZM_snf(H) ));
1333 : }
1334 :
1335 : GEN
1336 462 : abelian_group(GEN v)
1337 : {
1338 462 : long card = zv_prod(v), i, d = 1, l = lg(v);
1339 462 : GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
1340 462 : gel(G,1) = gen;
1341 462 : gel(G,2) = vecsmall_copy(v);
1342 959 : for(i=1; i<l; i++)
1343 : {
1344 497 : GEN p = cgetg(card+1, t_VECSMALL);
1345 497 : long o = v[i], u = d*(o-1), j, k, l;
1346 497 : gel(gen, i) = p;
1347 : /* The following loop is over-optimized. Remember that I wrote it for
1348 : * testpermutation. Something has survived... BA */
1349 1246 : for(j=1;j<=card;)
1350 : {
1351 3122 : for(k=1;k<o;k++)
1352 6615 : for(l=1;l<=d; l++,j++) p[j] = j+d;
1353 2779 : for (l=1; l<=d; l++,j++) p[j] = j-u;
1354 : }
1355 497 : d += u;
1356 : }
1357 462 : return G;
1358 : }
1359 :
1360 : static long
1361 14609 : groupelts_subgroup_isnormal(GEN G, GEN H)
1362 : {
1363 14609 : long i, n = lg(G);
1364 64470 : for(i = 1; i < n; i++)
1365 62895 : if (!group_perm_normalize(H, gel(G,i))) return 0;
1366 1575 : return 1;
1367 : }
1368 :
1369 : /*return 1 if H is a normal subgroup of G*/
1370 : long
1371 336 : group_subgroup_isnormal(GEN G, GEN H)
1372 : {
1373 336 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1374 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1375 : strtoGENstr("domain(G)"), H);
1376 336 : return groupelts_subgroup_isnormal(grp_get_gen(G), H);
1377 : }
1378 :
1379 : static GEN
1380 4816 : group_subgroup_kernel_set(GEN G, GEN H)
1381 : {
1382 : pari_sp av;
1383 4816 : GEN g = grp_get_gen(G);
1384 4816 : long i, n = lg(g);
1385 : GEN S, elts;
1386 4816 : long d = group_domain(G);
1387 4816 : if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
1388 0 : pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
1389 : strtoGENstr("domain(G)"), H);
1390 4816 : elts = group_elts(H,d);
1391 4816 : S = groupelts_set(elts, d);
1392 4816 : av = avma;
1393 19264 : for(i=1; i<n; i++)
1394 : {
1395 14448 : F2v_and_inplace(S, groupelts_conj_set(elts,gel(g,i)));
1396 14448 : set_avma(av);
1397 : }
1398 4816 : return S;
1399 : }
1400 :
1401 : int
1402 4816 : group_subgroup_is_faithful(GEN G, GEN H)
1403 : {
1404 4816 : pari_sp av = avma;
1405 4816 : GEN K = group_subgroup_kernel_set(G,H);
1406 4816 : F2v_clear(K,1);
1407 4816 : return gc_long(av, F2v_equal0(K));
1408 : }
1409 :
1410 : long
1411 0 : groupelts_exponent(GEN elts)
1412 : {
1413 0 : long i, n = lg(elts)-1, expo = 1;
1414 0 : for(i=1; i<=n; i++) expo = ulcm(expo, perm_orderu(gel(elts,i)));
1415 0 : return expo;
1416 : }
1417 :
1418 : GEN
1419 700 : groupelts_center(GEN S)
1420 : {
1421 700 : pari_sp ltop = avma;
1422 700 : long i, j, n = lg(S)-1, l = n;
1423 700 : GEN V, elts = zero_F2v(n+1);
1424 25732 : for(i=1; i<=n; i++)
1425 : {
1426 25032 : if (F2v_coeff(elts,i)) { l--; continue; }
1427 573384 : for(j=1; j<=n; j++)
1428 563192 : if (!perm_commute(gel(S,i),gel(S,j)))
1429 : {
1430 14322 : F2v_set(elts,i);
1431 14322 : F2v_set(elts,j); l--; break;
1432 : }
1433 : }
1434 700 : V = cgetg(l+1,t_VEC);
1435 25732 : for (i=1, j=1; i<=n ;i++)
1436 25032 : if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
1437 700 : return gc_upto(ltop,V);
1438 : }
1439 :
1440 : GEN
1441 4270 : groupelts_conjclasses(GEN elts, long *pnbcl)
1442 : {
1443 4270 : long i, j, cl = 0, n = lg(elts)-1;
1444 4270 : GEN c = const_vecsmall(n,0);
1445 4270 : pari_sp av = avma;
1446 52850 : for (i=1; i<=n; i++)
1447 : {
1448 48580 : GEN g = gel(elts,i);
1449 48580 : if (c[i]) continue;
1450 34965 : c[i] = ++cl;
1451 486871 : for(j=1; j<=n; j++)
1452 451906 : if (j != i)
1453 : {
1454 416941 : GEN h = perm_conj(gel(elts,j), g);
1455 416941 : long i2 = gen_search(elts,h,(void*)&vecsmall_lexcmp,&cmp_nodata);
1456 416941 : c[i2] = cl; set_avma(av);
1457 : }
1458 : }
1459 4270 : if (pnbcl) *pnbcl = cl;
1460 4270 : return c;
1461 : }
1462 :
1463 : GEN
1464 4270 : conjclasses_repr(GEN conj, long nb)
1465 : {
1466 4270 : long i, l = lg(conj);
1467 4270 : GEN e = const_vecsmall(nb, 0);
1468 52850 : for(i=1; i<l; i++)
1469 : {
1470 48580 : long ci = conj[i];
1471 48580 : if (!e[ci]) e[ci] = i;
1472 : }
1473 4270 : return e;
1474 : }
1475 :
1476 : /* elts of G sorted wrt vecsmall_lexcmp order: g in G is determined by g[1]
1477 : * so sort by increasing g[1] */
1478 : static GEN
1479 3885 : galois_elts_sorted(GEN gal)
1480 : {
1481 : long i, l;
1482 3885 : GEN elts = gal_get_group(gal), v = cgetg_copy(elts, &l);
1483 43141 : for (i = 1; i < l; i++) { GEN g = gel(elts,i); gel(v, g[1]) = g; }
1484 3885 : return v;
1485 : }
1486 : GEN
1487 4291 : group_to_cc(GEN G)
1488 : {
1489 4291 : GEN elts = checkgroupelts(G), z = cgetg(5,t_VEC);
1490 4270 : long n, flag = 1;
1491 4270 : if (typ(gel(G,1)) == t_POL)
1492 3885 : elts = galois_elts_sorted(G); /* galoisinit */
1493 : else
1494 : {
1495 385 : long i, l = lg(elts);
1496 385 : elts = gen_sort_shallow(elts,(void*)vecsmall_lexcmp,cmp_nodata);
1497 5824 : for (i = 1; i < l; i++)
1498 5586 : if (gel(elts,i)[1] != i) { flag = 0; break; }
1499 : }
1500 4270 : gel(z,1) = elts;
1501 4270 : gel(z,2) = groupelts_conjclasses(elts,&n);
1502 4270 : gel(z,3) = conjclasses_repr(gel(z,2),n);
1503 4270 : gel(z,4) = utoi(flag); return z;
1504 : }
1505 :
1506 : /* S a list of generators */
1507 : GEN
1508 0 : groupelts_abelian_group(GEN S)
1509 : {
1510 0 : pari_sp ltop = avma;
1511 : GEN Qgen, Qord, Qelt;
1512 0 : long i, j, n = lg(gel(S,1))-1, l = lg(S);
1513 0 : Qord = cgetg(l, t_VECSMALL);
1514 0 : Qgen = cgetg(l, t_VEC);
1515 0 : Qelt = mkvec(identity_perm(n));
1516 0 : for (i = 1, j = 1; i < l; ++i)
1517 : {
1518 0 : GEN g = gel(S,i);
1519 0 : long o = perm_relorder(g, groupelts_set(Qelt, n));
1520 0 : gel(Qgen,j) = g;
1521 0 : Qord[j] = o;
1522 0 : if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
1523 : }
1524 0 : setlg(Qgen,j);
1525 0 : setlg(Qord,j);
1526 0 : return gc_GEN(ltop, mkvec2(Qgen, Qord));
1527 : }
1528 :
1529 : GEN
1530 14 : group_export_GAP(GEN G)
1531 : {
1532 14 : pari_sp av = avma;
1533 14 : GEN s, comma, g = grp_get_gen(G);
1534 14 : long i, k, l = lg(g);
1535 14 : if (l == 1) return strtoGENstr("Group(())");
1536 7 : s = cgetg(2*l, t_VEC);
1537 7 : comma = strtoGENstr(", ");
1538 7 : gel(s,1) = strtoGENstr("Group(");
1539 28 : for (i=1, k=2; i < l; ++i)
1540 : {
1541 21 : if (i > 1) gel(s,k++) = comma;
1542 21 : gel(s,k++) = perm_to_GAP(gel(g,i));
1543 : }
1544 7 : gel(s,k++) = strtoGENstr(")");
1545 7 : return gc_GEN(av, shallowconcat1(s));
1546 : }
1547 :
1548 : GEN
1549 14 : group_export_MAGMA(GEN G)
1550 : {
1551 14 : pari_sp av = avma;
1552 14 : GEN s, comma, g = grp_get_gen(G);
1553 14 : long i, k, l = lg(g);
1554 14 : if (l == 1) return strtoGENstr("PermutationGroup<1|>");
1555 7 : s = cgetg(2*l, t_VEC);
1556 7 : comma = strtoGENstr(", ");
1557 7 : gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
1558 28 : for (i=1, k=2; i < l; ++i)
1559 : {
1560 21 : if (i > 1) gel(s,k++) = comma;
1561 21 : gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
1562 : }
1563 7 : gel(s,k++) = strtoGENstr(">");
1564 7 : return gc_GEN(av, shallowconcat1(s));
1565 : }
1566 :
1567 : GEN
1568 28 : group_export(GEN G, long format)
1569 : {
1570 28 : switch(format)
1571 : {
1572 14 : case 0: return group_export_GAP(G);
1573 14 : case 1: return group_export_MAGMA(G);
1574 : }
1575 0 : pari_err_FLAG("galoisexport");
1576 0 : return NULL; /*-Wall*/
1577 : }
1578 :
1579 : static GEN
1580 3577 : groupelts_cyclic_subgroups(GEN G)
1581 : {
1582 3577 : pari_sp av = avma;
1583 3577 : long i, j, n = lg(G)-1;
1584 : GEN elts, f, gen, ord;
1585 3577 : if (n==1) return cgetg(1,t_VEC);
1586 3577 : elts = zero_F2v(lg(gel(G,1))-1);
1587 3577 : gen = cgetg(n+1, t_VECSMALL);
1588 3577 : ord = cgetg(n+1, t_VECSMALL);
1589 53109 : for (i=1, j=1; i<=n; i++)
1590 : {
1591 49532 : long k = 1, o, c = 0;
1592 49532 : GEN p = gel(G, i);
1593 49532 : if (F2v_coeff(elts, p[1])) continue;
1594 35903 : o = perm_orderu(p);
1595 35903 : gen[j] = i; ord[j] = o; j++;
1596 : do
1597 : {
1598 96229 : if (cgcd(o, ++c)==1) F2v_set(elts, p[k]);
1599 96229 : k = p[k];
1600 96229 : } while (k!=1);
1601 : }
1602 3577 : setlg(gen, j);
1603 3577 : setlg(ord, j);
1604 3577 : f = vecsmall_indexsort(ord);
1605 3577 : return gc_GEN(av, mkvec2(vecsmallpermute(gen, f),
1606 : vecsmallpermute(ord, f)));
1607 : }
1608 :
1609 : GEN
1610 3584 : groupelts_to_group(GEN G)
1611 : {
1612 3584 : pari_sp av = avma;
1613 : GEN L, cyc, ord;
1614 3584 : long i, l, n = lg(G)-1;
1615 3584 : if (n==1) return trivialgroup();
1616 3563 : L = groupelts_cyclic_subgroups(G);
1617 3563 : cyc = gel(L,1); ord = gel(L,2);
1618 3563 : l = lg(cyc);
1619 16324 : for (i = l-1; i >= 2; i--)
1620 : {
1621 15645 : GEN p = gel(G,cyc[i]);
1622 15645 : long o = ord[i];
1623 15645 : GEN H = cyclicgroup(p, o);
1624 15645 : if (o == n) return gc_upto(av, H);
1625 14273 : if (groupelts_subgroup_isnormal(G, H))
1626 : {
1627 1512 : GEN C = groupelts_quotient(G, H);
1628 1512 : GEN Q = quotient_groupelts(C);
1629 1512 : GEN R = groupelts_to_group(Q);
1630 1512 : if (!R) return gc_NULL(av);
1631 1512 : return gc_GEN(av, quotient_subgroup_lift(C, H, R));
1632 : }
1633 : }
1634 679 : if (n==12 && l==9 && ord[2]==2 && ord[3]==2 && ord[5]==3)
1635 602 : return gc_GEN(av,
1636 301 : mkvec2(mkvec3(gel(G,cyc[2]), gel(G,cyc[3]), gel(G,cyc[5])), mkvecsmall3(2,2,3)));
1637 378 : if (n==24 && l==18 && ord[11]==3 && ord[15]==4 && ord[16]==4)
1638 : {
1639 350 : GEN t21 = perm_sqr(gel(G,cyc[15]));
1640 350 : GEN t22 = perm_sqr(gel(G,cyc[16]));
1641 350 : GEN s = perm_mul(t22, gel(G,cyc[15]));
1642 700 : return gc_GEN(av,
1643 350 : mkvec2(mkvec4(t21,t22, gel(G,cyc[11]), s), mkvecsmall4(2,2,3,2)));
1644 : }
1645 28 : if (n==36 && l==24 && ord[11]==3 && ord[15]==4)
1646 : {
1647 7 : GEN t1 = gel(G,cyc[11]), t3 = gel(G,cyc[15]);
1648 7 : return gc_GEN(av,
1649 : mkvec2(mkvec3(perm_conj(t3, t1), t1, t3), mkvecsmall3(3,3,4)));
1650 : }
1651 21 : return gc_NULL(av);
1652 : }
1653 :
1654 : static GEN
1655 1176 : subg_get_gen(GEN subg) { return gel(subg, 1); }
1656 :
1657 : static GEN
1658 8694 : subg_get_set(GEN subg) { return gel(subg, 2); }
1659 :
1660 : static GEN
1661 812 : groupelt_subg_normalize(GEN elt, GEN subg, GEN cyc)
1662 : {
1663 812 : GEN gen = subg_get_gen(subg), set = subg_get_set(subg);
1664 812 : long i, j, u, n = lg(elt)-1, lgen = lg(gen);
1665 812 : GEN b = F2v_copy(cyc), res = zero_F2v(n);
1666 49532 : for(i = 1; i <= n; i++)
1667 : {
1668 : GEN g;
1669 48720 : if (!F2v_coeff(b, i)) continue;
1670 22386 : g = gel(elt,i);
1671 763532 : for(u=1; u<=n; u++)
1672 763532 : if (g[u]==1) break;
1673 25172 : for(j=1; j<lgen; j++)
1674 : {
1675 23786 : GEN h = gel(elt,gen[j]);
1676 23786 : if (!F2v_coeff(set,g[h[u]])) break;
1677 : }
1678 22386 : if (j < lgen) continue;
1679 1386 : F2v_set(res,i);
1680 84546 : for(j=1; j <= n; j++)
1681 83160 : if (F2v_coeff(set, j))
1682 6720 : F2v_clear(b,g[gel(elt,j)[1]]);
1683 : }
1684 812 : return res;
1685 : }
1686 :
1687 : static GEN
1688 14 : triv_subg(GEN elt)
1689 : {
1690 14 : GEN v = cgetg(3, t_VEC);
1691 14 : gel(v,1) = cgetg(1,t_VECSMALL);
1692 14 : gel(v,2) = zero_F2v(lg(elt)-1);
1693 14 : F2v_set(gel(v,2),1);
1694 14 : return v;
1695 : }
1696 :
1697 : static GEN
1698 364 : subg_extend(GEN U, long e, long o, GEN elt)
1699 : {
1700 364 : long i, j, n = lg(elt)-1;
1701 364 : GEN g = gel(elt, e);
1702 364 : GEN gen = vecsmall_append(subg_get_gen(U), e);
1703 364 : GEN set = subg_get_set(U);
1704 364 : GEN Vset = zv_copy(set);
1705 22204 : for(i = 1; i <= n; i++)
1706 21840 : if (F2v_coeff(set, i))
1707 : {
1708 1260 : long h = gel(elt, i)[1];
1709 2800 : for(j = 1; j < o; j++)
1710 : {
1711 1540 : h = g[h];
1712 1540 : F2v_set(Vset, h);
1713 : }
1714 : }
1715 364 : return mkvec2(gen, Vset);
1716 : }
1717 :
1718 : static GEN
1719 434 : cyclic_subg(long e, long o, GEN elt)
1720 : {
1721 434 : long j, n = lg(elt)-1, h = 1;
1722 434 : GEN g = gel(elt, e);
1723 434 : GEN gen = mkvecsmall(e);
1724 434 : GEN set = zero_F2v(n);
1725 434 : F2v_set(set,1);
1726 1260 : for(j = 1; j < o; j++)
1727 : {
1728 826 : h = g[h];
1729 826 : F2v_set(set, h);
1730 : }
1731 434 : return mkvec2(gen, set);
1732 : }
1733 :
1734 : static GEN
1735 14 : groupelts_to_regular(GEN elt)
1736 : {
1737 14 : long i, j, n = lg(elt)-1;
1738 14 : GEN V = cgetg(n+1,t_VEC);
1739 854 : for (i=1; i<=n; i++)
1740 : {
1741 840 : pari_sp av = avma;
1742 840 : GEN g = gel(elt, i);
1743 840 : GEN W = cgetg(n+1,t_VEC);
1744 51240 : for(j=1; j<=n; j++)
1745 50400 : gel(W,j) = perm_mul(g, gel(elt,j));
1746 840 : gel(V, i) = gc_leaf(av,vecvecsmall_indexsort(W));
1747 : }
1748 14 : vecvecsmall_sort_inplace(V, NULL);
1749 14 : return V;
1750 : }
1751 :
1752 : static long
1753 434 : groupelts_pow(GEN elt, long j, long n)
1754 : {
1755 434 : GEN g = gel(elt,j);
1756 434 : long i, h = 1;
1757 1694 : for (i=1; i<=n; i++)
1758 1260 : h = g[h];
1759 434 : return h;
1760 : }
1761 :
1762 : static GEN
1763 14 : groupelts_cyclic_primepow(GEN elt, GEN *pt_pr, GEN *pt_po)
1764 : {
1765 14 : GEN R = groupelts_cyclic_subgroups(elt);
1766 14 : GEN gen = gel(R,1), ord = gel(R,2);
1767 14 : long i, n = lg(elt)-1, l = lg(gen);
1768 14 : GEN set = zero_F2v(n);
1769 14 : GEN pr = zero_Flv(n);
1770 14 : GEN po = zero_Flv(n);
1771 462 : for (i = 1; i < l; i++)
1772 : {
1773 448 : long h = gen[i];
1774 : ulong p;
1775 448 : if (uisprimepower(ord[i], &p))
1776 : {
1777 434 : F2v_set(set, h);
1778 434 : uel(pr,h) = p;
1779 434 : po[h] = groupelts_pow(elt, h, p);
1780 : }
1781 : }
1782 14 : *pt_pr = pr; *pt_po = po;
1783 14 : return set;
1784 : }
1785 :
1786 : static GEN
1787 50400 : perm_bracket(GEN p, GEN q)
1788 : {
1789 50400 : return perm_mul(perm_mul(p,q), perm_inv(perm_mul(q,p)));
1790 : }
1791 :
1792 : static GEN
1793 826 : set_groupelts(GEN S, GEN x)
1794 : {
1795 826 : long i, n = F2v_hamming(x), k=1, m = x[1];
1796 826 : GEN v = cgetg(n+1, t_VEC);
1797 50386 : for (i=1; i<=m; i++)
1798 49560 : if (F2v_coeff(x,i))
1799 4914 : gel(v,k++) = gel(S,i);
1800 826 : return v;
1801 : }
1802 :
1803 : static GEN
1804 14 : set_idx(GEN x)
1805 : {
1806 14 : long i, n = F2v_hamming(x), k=1, m = x[1];
1807 14 : GEN v = cgetg(n+1, t_VECSMALL);
1808 854 : for (i=1; i<=m; i++)
1809 840 : if (F2v_coeff(x,i))
1810 840 : uel(v,k++) = i;
1811 14 : return v;
1812 : }
1813 :
1814 : static GEN
1815 14 : set_derived(GEN set, GEN elts)
1816 : {
1817 14 : long i, j, l = lg(elts);
1818 14 : GEN V = zero_F2v(l-1);
1819 854 : for(i = 1; i < l; i++)
1820 840 : if (F2v_coeff(set, i))
1821 51240 : for(j = 1; j < l; j++)
1822 50400 : if (F2v_coeff(set, j))
1823 50400 : F2v_set(V, perm_bracket(gel(elts,i),gel(elts,j))[1]);
1824 14 : return V;
1825 : }
1826 :
1827 : static GEN
1828 14 : groupelts_residuum(GEN elts)
1829 : {
1830 14 : pari_sp av = avma;
1831 14 : long o = lg(elts)-1, oo;
1832 14 : GEN set = const_F2v(o);
1833 : do
1834 : {
1835 14 : oo = o;
1836 14 : set = set_derived(set, elts);
1837 14 : o = F2v_hamming(set);
1838 14 : } while (o > 1 && o < oo);
1839 14 : if (o==1) return NULL;
1840 14 : return gc_GEN(av,mkvec2(set_idx(set), set));
1841 : }
1842 :
1843 : static GEN
1844 14 : all_cyclic_subg(GEN pr, GEN po, GEN elt)
1845 : {
1846 14 : long i, n = lg(pr)-1, m = 0, k = 1;
1847 : GEN W;
1848 854 : for (i=1; i <= n; i++)
1849 840 : m += po[i]==1;
1850 14 : W = cgetg(m+1, t_VEC);
1851 854 : for (i=1; i <= n; i++)
1852 840 : if (po[i]==1)
1853 434 : gel(W, k++) = cyclic_subg(i, pr[i], elt);
1854 14 : return W;
1855 : }
1856 :
1857 : static GEN
1858 14 : groupelts_subgroups_raw(GEN elts)
1859 : {
1860 14 : pari_sp av = avma;
1861 14 : GEN elt = groupelts_to_regular(elts);
1862 14 : GEN pr, po, cyc = groupelts_cyclic_primepow(elt, &pr, &po);
1863 14 : long n = lg(elt)-1;
1864 14 : long i, j, nS = 1;
1865 14 : GEN S, L, R = NULL;
1866 14 : S = cgetg(1+bigomegau(n)+1, t_VEC);
1867 14 : gel(S, nS++) = mkvec(triv_subg(elt));
1868 14 : gel(S, nS++) = L = all_cyclic_subg(pr, po, elt);
1869 14 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS-1,lg(L)-1);
1870 70 : while (lg(L) > 1)
1871 : {
1872 56 : pari_sp av2 = avma;
1873 56 : long nW = 1, lL = lg(L);
1874 56 : long ng = n;
1875 56 : GEN W = cgetg(1+ng, t_VEC);
1876 868 : for (i=1; i<lL; i++)
1877 : {
1878 812 : GEN U = gel(L, i), set = subg_get_set(U);
1879 812 : GEN G = groupelt_subg_normalize(elt, U, cyc);
1880 7154 : for (j=1; j<nW; j++)
1881 : {
1882 6342 : GEN Wj = subg_get_set(gel(W, j));
1883 6342 : if (F2v_subset(set, Wj))
1884 728 : F2v_negimply_inplace(G, Wj);
1885 : }
1886 49532 : for (j=1; j<=n; j++)
1887 48720 : if(F2v_coeff(G,j))
1888 : {
1889 770 : long p = pr[j];
1890 770 : if (F2v_coeff(set, j)) continue;
1891 364 : if (F2v_coeff(set, po[j]))
1892 : {
1893 364 : GEN U2 = subg_extend(U, j, p, elt);
1894 364 : F2v_negimply_inplace(G, subg_get_set(U2));
1895 364 : if (nW > ng) { ng<<=1; W = vec_lengthen(W, ng); }
1896 364 : gel(W, nW++) = U2;
1897 : }
1898 : }
1899 : }
1900 56 : setlg(W, nW);
1901 56 : L = W;
1902 56 : if (nW > 1) gel(S, nS++) = L = gc_GEN(av2, W);
1903 56 : if (DEBUGLEVEL) err_printf("subgroups: level %ld: %ld\n",nS-1,nW-1);
1904 56 : if (lg(L)==1 && !R)
1905 : {
1906 14 : R = groupelts_residuum(elt);
1907 14 : if (!R) break;
1908 14 : gel(S, nS++) = L = mkvec(R);
1909 : }
1910 : }
1911 14 : setlg(S, nS);
1912 14 : return gc_GEN(av, shallowconcat1(S));
1913 : }
1914 :
1915 : static GEN
1916 14 : subg_to_elts(GEN S, GEN x)
1917 840 : { pari_APPLY_type(t_VEC, set_groupelts(S, gmael(x,i,2))); }
1918 :
1919 : GEN
1920 14 : groupelts_solvablesubgroups(GEN G)
1921 : {
1922 14 : pari_sp av = avma;
1923 14 : GEN S = vecvecsmall_sort(checkgroupelts(G));
1924 14 : GEN L = groupelts_subgroups_raw(S);
1925 14 : return gc_GEN(av, subg_to_elts(S, L));
1926 : }
|
