Code coverage tests

This page documents the degree to which the PARI/GP source code is tested by our public test suite, distributed with the source distribution in directory src/test/. This is measured by the gcov utility; we then process gcov output using the lcov frond-end.

We test a few variants depending on Configure flags on the pari.math.u-bordeaux.fr machine (x86_64 architecture), and agregate them in the final report:

The target is to exceed 90% coverage for all mathematical modules (given that branches depending on DEBUGLEVEL or DEBUGMEM are not covered). This script is run to produce the results below.

LCOV - code coverage report
Current view: top level - basemath - perm.c (source / functions) Hit Total Coverage
Test: PARI/GP v2.12.1 lcov report (development 25819-e703fe1174) Lines: 689 869 79.3 %
Date: 2020-09-18 06:10:04 Functions: 80 94 85.1 %
Legend: Lines: hit not hit

          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. It is distributed in the hope that it will be useful, but WITHOUT
       8             : ANY WARRANTY WHATSOEVER.
       9             : 
      10             : Check the License for details. You should have received a copy of it, along
      11             : with the package; see the file 'COPYING'. If not, write to the Free Software
      12             : Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. */
      13             : 
      14             : #include "pari.h"
      15             : #include "paripriv.h"
      16             : 
      17             : /*************************************************************************/
      18             : /**                                                                     **/
      19             : /**                   Routines for handling VEC/COL                     **/
      20             : /**                                                                     **/
      21             : /*************************************************************************/
      22             : int
      23        1834 : vec_isconst(GEN v)
      24             : {
      25        1834 :   long i, l = lg(v);
      26             :   GEN w;
      27        1834 :   if (l==1) return 1;
      28        1834 :   w = gel(v,1);
      29        6307 :   for(i=2; i<l; i++)
      30        5740 :     if (!gequal(gel(v,i), w)) return 0;
      31         567 :   return 1;
      32             : }
      33             : 
      34             : int
      35        5902 : vecsmall_isconst(GEN v)
      36             : {
      37        5902 :   long i, l = lg(v);
      38             :   ulong w;
      39        5902 :   if (l==1) return 1;
      40        5902 :   w = uel(v,1);
      41        9748 :   for(i=2; i<l; i++)
      42        8137 :     if (uel(v,i) != w) return 0;
      43        1611 :   return 1;
      44             : }
      45             : 
      46             : /* Check if all the elements of v are different.
      47             :  * Use a quadratic algorithm. Could be done in n*log(n) by sorting. */
      48             : int
      49           0 : vec_is1to1(GEN v)
      50             : {
      51           0 :   long i, j, l = lg(v);
      52           0 :   for (i=1; i<l; i++)
      53             :   {
      54           0 :     GEN w = gel(v,i);
      55           0 :     for(j=i+1; j<l; j++)
      56           0 :       if (gequal(gel(v,j), w)) return 0;
      57             :   }
      58           0 :   return 1;
      59             : }
      60             : 
      61             : GEN
      62       97706 : vec_insert(GEN v, long n, GEN x)
      63             : {
      64       97706 :   long i, l=lg(v);
      65       97706 :   GEN V = cgetg(l+1,t_VEC);
      66      703892 :   for(i=1; i<n; i++) gel(V,i) = gel(v,i);
      67       97706 :   gel(V,n) = x;
      68      474194 :   for(i=n+1; i<=l; i++) gel(V,i) = gel(v,i-1);
      69       97706 :   return V;
      70             : }
      71             : /*************************************************************************/
      72             : /**                                                                     **/
      73             : /**                   Routines for handling VECSMALL                    **/
      74             : /**                                                                     **/
      75             : /*************************************************************************/
      76             : /* Sort v[0]...v[n-1] and put result in w[0]...w[n-1].
      77             :  * We accept v==w. w must be allocated. */
      78             : static void
      79   114628739 : vecsmall_sortspec(GEN v, long n, GEN w)
      80             : {
      81   114628739 :   pari_sp ltop=avma;
      82   114628739 :   long nx=n>>1, ny=n-nx;
      83             :   long m, ix, iy;
      84             :   GEN x, y;
      85   114628739 :   if (n<=2)
      86             :   {
      87    64368143 :     if (n==1)
      88    12865436 :       w[0]=v[0];
      89    51502707 :     else if (n==2)
      90             :     {
      91    51502758 :       long v0=v[0], v1=v[1];
      92    51502758 :       if (v0<=v1) { w[0]=v0; w[1]=v1; }
      93     2526933 :       else        { w[0]=v1; w[1]=v0; }
      94             :     }
      95    64368143 :     return;
      96             :   }
      97    50260596 :   x=new_chunk(nx); y=new_chunk(ny);
      98    50260732 :   vecsmall_sortspec(v,nx,x);
      99    50260768 :   vecsmall_sortspec(v+nx,ny,y);
     100   221933858 :   for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
     101   171673030 :     if (x[ix]<=y[iy])
     102   142426879 :       w[m++]=x[ix++];
     103             :     else
     104    29246151 :       w[m++]=y[iy++];
     105    55059708 :   for(;ix<nx;) w[m++]=x[ix++];
     106   184082832 :   for(;iy<ny;) w[m++]=y[iy++];
     107    50260828 :   set_avma(ltop);
     108             : }
     109             : 
     110             : /*in place sort.*/
     111             : void
     112    20434416 : vecsmall_sort(GEN V)
     113             : {
     114    20434416 :   long l = lg(V)-1;
     115    20434416 :   if (l<=1) return;
     116    14107288 :   vecsmall_sortspec(V+1,l,V+1);
     117             : }
     118             : 
     119             : /* cf gen_sortspec */
     120             : static GEN
     121    21321273 : vecsmall_indexsortspec(GEN v, long n)
     122             : {
     123             :   long nx, ny, m, ix, iy;
     124             :   GEN x, y, w;
     125    21321273 :   switch(n)
     126             :   {
     127       52133 :     case 1: return mkvecsmall(1);
     128     5687611 :     case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
     129     6441028 :     case 3:
     130     6441028 :       if (v[1] <= v[2]) {
     131     5523766 :         if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
     132      481127 :         return (v[1] <= v[3])? mkvecsmall3(1,3,2)
     133     1606803 :                              : mkvecsmall3(3,1,2);
     134             :       } else {
     135      917262 :         if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
     136      387819 :         return (v[2] <= v[3])? mkvecsmall3(2,3,1)
     137     1037285 :                              : mkvecsmall3(3,2,1);
     138             :       }
     139             :   }
     140     9140501 :   nx = n>>1; ny = n-nx;
     141     9140501 :   w = cgetg(n+1,t_VECSMALL);
     142     9140502 :   x = vecsmall_indexsortspec(v,nx);
     143     9140503 :   y = vecsmall_indexsortspec(v+nx,ny);
     144   148010066 :   for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
     145   138869563 :     if (v[x[ix]] <= v[y[iy]+nx])
     146    90228831 :       w[m++] = x[ix++];
     147             :     else
     148    48640732 :       w[m++] = y[iy++]+nx;
     149    11770986 :   for(;ix<=nx;) w[m++] = x[ix++];
     150    57342531 :   for(;iy<=ny;) w[m++] = y[iy++]+nx;
     151     9140503 :   set_avma((pari_sp)w); return w;
     152             : }
     153             : 
     154             : /*indirect sort.*/
     155             : GEN
     156     3040333 : vecsmall_indexsort(GEN V)
     157             : {
     158     3040333 :   long l=lg(V)-1;
     159     3040333 :   if (l==0) return cgetg(1, t_VECSMALL);
     160     3040270 :   return vecsmall_indexsortspec(V,l);
     161             : }
     162             : 
     163             : /* assume V sorted */
     164             : GEN
     165         411 : vecsmall_uniq_sorted(GEN V)
     166             : {
     167             :   GEN W;
     168         411 :   long i,j, l = lg(V);
     169         411 :   if (l == 1) return vecsmall_copy(V);
     170         378 :   W = cgetg(l,t_VECSMALL);
     171         378 :   W[1] = V[1];
     172         910 :   for(i=j=2; i<l; i++)
     173         532 :     if (V[i] != W[j-1]) W[j++] = V[i];
     174         378 :   stackdummy((pari_sp)(W + l), (pari_sp)(W + j));
     175         378 :   setlg(W, j); return W;
     176             : }
     177             : 
     178             : GEN
     179         306 : vecsmall_uniq(GEN V)
     180             : {
     181         306 :   pari_sp av = avma;
     182         306 :   V = zv_copy(V); vecsmall_sort(V);
     183         306 :   return gerepileuptoleaf(av, vecsmall_uniq_sorted(V));
     184             : }
     185             : 
     186             : /* assume x sorted */
     187             : long
     188           0 : vecsmall_duplicate_sorted(GEN x)
     189             : {
     190           0 :   long i,k,l=lg(x);
     191           0 :   if (l==1) return 0;
     192           0 :   for (k=x[1],i=2; i<l; k=x[i++])
     193           0 :     if (x[i] == k) return i;
     194           0 :   return 0;
     195             : }
     196             : 
     197             : long
     198       16905 : vecsmall_duplicate(GEN x)
     199             : {
     200       16905 :   pari_sp av=avma;
     201       16905 :   GEN p=vecsmall_indexsort(x);
     202       16905 :   long k,i,r=0,l=lg(x);
     203       16905 :   if (l==1) return 0;
     204       22952 :   for (k=x[p[1]],i=2; i<l; k=x[p[i++]])
     205        6047 :     if (x[p[i]] == k) { r=p[i]; break; }
     206       16905 :   set_avma(av);
     207       16905 :   return r;
     208             : }
     209             : 
     210             : static int
     211       23898 : vecsmall_is1to1spec(GEN v, long n, GEN w)
     212             : {
     213       23898 :   pari_sp ltop=avma;
     214       23898 :   long nx=n>>1, ny=n-nx;
     215             :   long m, ix, iy;
     216             :   GEN x, y;
     217       23898 :   if (n<=2)
     218             :   {
     219       13930 :     if (n==1)
     220        4459 :       w[0]=v[0];
     221        9471 :     else if (n==2)
     222             :     {
     223        9471 :       long v0=v[0], v1=v[1];
     224        9471 :       if (v0==v1) return 0;
     225        9457 :       else if (v0<v1) { w[0]=v0; w[1]=v1; }
     226        2428 :       else            { w[0]=v1; w[1]=v0; }
     227             :     }
     228       13916 :     return 1;
     229             :   }
     230        9968 :   x = new_chunk(nx);
     231        9968 :   if (!vecsmall_is1to1spec(v,nx,x))    return 0;
     232        9884 :   y = new_chunk(ny);
     233        9884 :   if (!vecsmall_is1to1spec(v+nx,ny,y)) return 0;
     234       43443 :   for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
     235       33643 :     if (x[ix]==y[iy]) return 0;
     236       33594 :     else if (x[ix]<y[iy])
     237       19768 :       w[m++]=x[ix++];
     238             :     else
     239       13826 :       w[m++]=y[iy++];
     240       11200 :   for(;ix<nx;) w[m++]=x[ix++];
     241       24422 :   for(;iy<ny;) w[m++]=y[iy++];
     242        9800 :   set_avma(ltop);
     243        9800 :   return 1;
     244             : }
     245             : 
     246             : int
     247        4137 : vecsmall_is1to1(GEN V)
     248             : {
     249        4137 :   pari_sp av = avma;
     250             :   long l;
     251        4137 :   GEN W = cgetg_copy(V, &l);
     252        4137 :   if (l <= 2) return 1;
     253        4046 :   return gc_bool(av, vecsmall_is1to1spec(V+1,l,W+1));
     254             : }
     255             : 
     256             : /*************************************************************************/
     257             : /**                                                                     **/
     258             : /**             Routines for handling vectors of VECSMALL               **/
     259             : /**                                                                     **/
     260             : /*************************************************************************/
     261             : 
     262             : GEN
     263           0 : vecvecsmall_sort(GEN x)
     264           0 : { return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
     265             : GEN
     266      129864 : vecvecsmall_sort_shallow(GEN x)
     267      129864 : { return gen_sort_shallow(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
     268             : 
     269             : void
     270         105 : vecvecsmall_sort_inplace(GEN x, GEN *perm)
     271         105 : { gen_sort_inplace(x, (void*)&vecsmall_lexcmp, cmp_nodata, perm); }
     272             : 
     273             : GEN
     274         434 : vecvecsmall_sort_uniq(GEN x)
     275         434 : { return gen_sort_uniq(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
     276             : 
     277             : GEN
     278          21 : vecvecsmall_indexsort(GEN x)
     279          21 : { return gen_indexsort(x, (void*)&vecsmall_lexcmp, cmp_nodata); }
     280             : 
     281             : long
     282    19741162 : vecvecsmall_search(GEN x, GEN y, long flag)
     283    19741162 : { return gen_search(x,y,flag,(void*)vecsmall_prefixcmp, cmp_nodata); }
     284             : 
     285             : /* assume x non empty */
     286             : long
     287           0 : vecvecsmall_max(GEN x)
     288             : {
     289           0 :   long i, l = lg(x), m = vecsmall_max(gel(x,1));
     290           0 :   for (i = 2; i < l; i++)
     291             :   {
     292           0 :     long t = vecsmall_max(gel(x,i));
     293           0 :     if (t > m) m = t;
     294             :   }
     295           0 :   return m;
     296             : }
     297             : 
     298             : /*************************************************************************/
     299             : /**                                                                     **/
     300             : /**                  Routines for handling permutations                 **/
     301             : /**                                                                     **/
     302             : /*************************************************************************/
     303             : 
     304             : /* Permutations may be given by
     305             :  * perm (VECSMALL): a bijection from 1...n to 1...n i-->perm[i]
     306             :  * cyc (VEC of VECSMALL): a product of disjoint cycles. */
     307             : 
     308             : /* Multiply (compose) two permutations, putting the result in the second one. */
     309             : static void
     310          21 : perm_mul_inplace2(GEN s, GEN t)
     311             : {
     312          21 :   long i, l = lg(s);
     313         525 :   for (i = 1; i < l; i++) t[i] = s[t[i]];
     314          21 : }
     315             : 
     316             : GEN
     317           0 : vecperm_extendschreier(GEN C, GEN v, long n)
     318             : {
     319           0 :   pari_sp av = avma;
     320           0 :   long mj, lv = lg(v), m = 1, mtested = 1;
     321           0 :   GEN bit = const_vecsmall(n, 0);
     322           0 :   GEN cy = cgetg(n+1, t_VECSMALL);
     323           0 :   GEN sh = const_vec(n, gen_0);
     324           0 :   for(mj=1; mj<=n; mj++)
     325             :   {
     326           0 :     if (isintzero(gel(C,mj))) continue;
     327           0 :     gel(sh,mj) = gcopy(gel(C,mj));
     328           0 :     if (bit[mj]) continue;
     329           0 :     cy[m++] = mj;
     330           0 :     bit[mj] = 1;
     331             :     for(;;)
     332           0 :     {
     333           0 :       long o, mold = m;
     334           0 :       for (o = 1; o < lv; o++)
     335             :       {
     336           0 :         GEN vo = gel(v,o);
     337             :         long p;
     338           0 :         for (p = mtested; p < mold; p++) /* m increases! */
     339             :         {
     340           0 :           long j = vo[ cy[p] ];
     341           0 :           if (!bit[j])
     342             :           {
     343           0 :             gel(sh,j) = perm_mul(vo, gel(sh, cy[p]));
     344           0 :             cy[m++] = j;
     345             :           }
     346           0 :           bit[j] = 1;
     347             :         }
     348             :       }
     349           0 :       mtested = mold;
     350           0 :       if (m == mold) break;
     351             :     }
     352             :   }
     353           0 :   return gerepileupto(av, sh);
     354             : }
     355             : 
     356             : /* Orbits of the subgroup generated by v on {1,..,n} */
     357             : static GEN
     358      616357 : vecperm_orbits_i(GEN v, long n)
     359             : {
     360      616357 :   long mj = 1, lv = lg(v), k, l;
     361      616357 :   GEN cycle = cgetg(n+1, t_VEC), bit = const_vecsmall(n, 0);
     362     4872676 :   for (k = 1, l = 1; k <= n;)
     363             :   {
     364     4256274 :     pari_sp ltop = avma;
     365     4256274 :     long m = 1;
     366     4256274 :     GEN cy = cgetg(n+1, t_VECSMALL);
     367     5285096 :     for (  ; bit[mj]; mj++) /*empty*/;
     368     4256228 :     k++; cy[m++] = mj;
     369     4256228 :     bit[mj++] = 1;
     370             :     for(;;)
     371     1684158 :     {
     372     5940386 :       long o, mold = m;
     373    11885471 :       for (o = 1; o < lv; o++)
     374             :       {
     375     5945085 :         GEN vo = gel(v,o);
     376             :         long p;
     377    20852145 :         for (p = 1; p < m; p++) /* m increases! */
     378             :         {
     379    14907060 :           long j = vo[ cy[p] ];
     380    14907060 :           if (!bit[j]) cy[m++] = j;
     381    14907060 :           bit[j] = 1;
     382             :         }
     383             :       }
     384     5940386 :       if (m == mold) break;
     385     1684158 :       k += m - mold;
     386             :     }
     387     4256228 :     setlg(cy, m);
     388     4256197 :     gel(cycle,l++) = gerepileuptoleaf(ltop, cy);
     389             :   }
     390      616402 :   setlg(cycle, l); return cycle;
     391             : }
     392             : /* memory clean version */
     393             : GEN
     394        1463 : vecperm_orbits(GEN v, long n)
     395             : {
     396        1463 :   pari_sp av = avma;
     397        1463 :   return gerepilecopy(av, vecperm_orbits_i(v, n));
     398             : }
     399             : 
     400             : static int
     401        1981 : isperm(GEN v)
     402             : {
     403        1981 :   pari_sp av = avma;
     404        1981 :   long i, n = lg(v)-1;
     405             :   GEN w;
     406        1981 :   if (typ(v) != t_VECSMALL) return 0;
     407        1981 :   w = zero_zv(n);
     408       13517 :   for (i=1; i<=n; i++)
     409             :   {
     410       11571 :     long d = v[i];
     411       11571 :     if (d < 1 || d > n || w[d]) return gc_bool(av,0);
     412       11536 :     w[d] = 1;
     413             :   }
     414        1946 :   return gc_bool(av,1);
     415             : }
     416             : 
     417             : /* Compute the cyclic decomposition of a permutation */
     418             : GEN
     419        6055 : perm_cycles(GEN v)
     420             : {
     421        6055 :   pari_sp av = avma;
     422        6055 :   return gerepilecopy(av, vecperm_orbits_i(mkvec(v), lg(v)-1));
     423             : }
     424             : 
     425             : GEN
     426          91 : permcycles(GEN v)
     427             : {
     428          91 :   if (!isperm(v)) pari_err_TYPE("permcycles",v);
     429          84 :   return perm_cycles(v);
     430             : }
     431             : 
     432             : /* Output the order of p */
     433             : long
     434      397845 : perm_order(GEN v)
     435             : {
     436      397845 :   pari_sp av = avma;
     437      397845 :   GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
     438             :   long i, d;
     439     2601365 :   for(i=1, d=1; i<lg(c); i++) d = ulcm(d, lg(gel(c,i))-1);
     440      397859 :   return gc_long(av,d);
     441             : }
     442             : 
     443             : long
     444          91 : permorder(GEN v)
     445             : {
     446          91 :   if (!isperm(v)) pari_err_TYPE("permorder",v);
     447          84 :   return perm_order(v);
     448             : }
     449             : 
     450             : /* sign of a permutation */
     451             : long
     452      211018 : perm_sign(GEN v)
     453             : {
     454      211018 :   pari_sp av = avma;
     455      211018 :   GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
     456      211009 :   long i, l = lg(c), s = 1;
     457     2235938 :   for (i = 1; i < l; i++)
     458     2024929 :     if (odd(lg(gel(c, i)))) s = -s;
     459      211009 :   return gc_long(av,s);
     460             : }
     461             : 
     462             : long
     463          98 : permsign(GEN v)
     464             : {
     465          98 :   if (!isperm(v)) pari_err_TYPE("permsign",v);
     466          84 :   return perm_sign(v);
     467             : }
     468             : 
     469             : GEN
     470        5915 : Z_to_perm(long n, GEN x)
     471             : {
     472             :   pari_sp av;
     473             :   ulong i, r;
     474        5915 :   GEN v = cgetg(n+1, t_VECSMALL);
     475        5915 :   if (n==0) return v;
     476        5908 :   uel(v,n) = 1; av = avma;
     477        5908 :   if (signe(x) <= 0) x = modii(x, mpfact(n));
     478       27146 :   for (r=n-1; r>=1; r--)
     479             :   {
     480             :     ulong a;
     481       21238 :     x = absdiviu_rem(x, n+1-r, &a);
     482       71687 :     for (i=r+1; i<=(ulong)n; i++)
     483       50449 :       if (uel(v,i) > a) uel(v,i)++;
     484       21238 :     uel(v,r) = a+1;
     485             :   }
     486        5908 :   set_avma(av); return v;
     487             : }
     488             : GEN
     489        5915 : numtoperm(long n, GEN x)
     490             : {
     491        5915 :   if (n < 0) pari_err_DOMAIN("numtoperm", "n", "<", gen_0, stoi(n));
     492        5915 :   if (typ(x) != t_INT) pari_err_TYPE("numtoperm",x);
     493        5915 :   return Z_to_perm(n, x);
     494             : }
     495             : 
     496             : /* destroys v */
     497             : static GEN
     498        1701 : perm_to_Z_inplace(GEN v)
     499             : {
     500        1701 :   long l = lg(v), i, r;
     501        1701 :   GEN x = gen_0;
     502        1701 :   if (!isperm(v)) return NULL;
     503       10143 :   for (i = 1; i < l; i++)
     504             :   {
     505        8449 :     long vi = v[i];
     506        8449 :     if (vi <= 0) return NULL;
     507        8449 :     x = i==1 ? utoi(vi-1): addiu(muliu(x,l-i), vi-1);
     508       25396 :     for (r = i+1; r < l; r++)
     509       16947 :       if (v[r] > vi) v[r]--;
     510             :   }
     511        1694 :   return x;
     512             : }
     513             : GEN
     514        1680 : perm_to_Z(GEN v)
     515             : {
     516        1680 :   pari_sp av = avma;
     517        1680 :   GEN x = perm_to_Z_inplace(leafcopy(v));
     518        1680 :   if (!x) pari_err_TYPE("permtonum",v);
     519        1680 :   return gerepileuptoint(av, x);
     520             : }
     521             : GEN
     522        1708 : permtonum(GEN p)
     523             : {
     524        1708 :   pari_sp av = avma;
     525             :   GEN v, x;
     526        1708 :   switch(typ(p))
     527             :   {
     528        1680 :     case t_VECSMALL: return perm_to_Z(p);
     529          21 :     case t_VEC: case t_COL:
     530          21 :       if (RgV_is_ZV(p)) { v = ZV_to_zv(p); break; }
     531           7 :     default: pari_err_TYPE("permtonum",p);
     532             :       return NULL;/*LCOV_EXCL_LINE*/
     533             :   }
     534          21 :   x = perm_to_Z_inplace(v);
     535          21 :   if (!x) pari_err_TYPE("permtonum",p);
     536          14 :   return gerepileuptoint(av, x);
     537             : }
     538             : 
     539             : GEN
     540        3647 : cyc_pow(GEN cyc, long exp)
     541             : {
     542             :   long i, j, k, l, r;
     543             :   GEN c;
     544       14133 :   for (r = j = 1; j < lg(cyc); j++)
     545             :   {
     546       10486 :     long n = lg(gel(cyc,j)) - 1;
     547       10486 :     r += cgcd(n, exp);
     548             :   }
     549        3647 :   c = cgetg(r, t_VEC);
     550       14133 :   for (r = j = 1; j < lg(cyc); j++)
     551             :   {
     552       10486 :     GEN v = gel(cyc,j);
     553       10486 :     long n = lg(v) - 1, e = umodsu(exp,n), g = (long)ugcd(n, e), m = n / g;
     554       22470 :     for (i = 0; i < g; i++)
     555             :     {
     556       11984 :       GEN p = cgetg(m+1, t_VECSMALL);
     557       11984 :       gel(c,r++) = p;
     558       39424 :       for (k = 1, l = i; k <= m; k++)
     559             :       {
     560       27440 :         p[k] = v[l+1];
     561       27440 :         l += e; if (l >= n) l -= n;
     562             :       }
     563             :     }
     564             :   }
     565        3647 :   return c;
     566             : }
     567             : 
     568             : /* Compute the power of a permutation given by product of cycles
     569             :  * Ouput a perm, not a cyc */
     570             : GEN
     571           0 : cyc_pow_perm(GEN cyc, long exp)
     572             : {
     573             :   long e, j, k, l, n;
     574             :   GEN p;
     575           0 :   for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
     576           0 :   p = cgetg(n + 1, t_VECSMALL);
     577           0 :   for (j = 1; j < lg(cyc); j++)
     578             :   {
     579           0 :     GEN v = gel(cyc,j);
     580           0 :     n = lg(v) - 1; e = umodsu(exp, n);
     581           0 :     for (k = 1, l = e; k <= n; k++)
     582             :     {
     583           0 :       p[v[k]] = v[l+1];
     584           0 :       if (++l == n) l = 0;
     585             :     }
     586             :   }
     587           0 :   return p;
     588             : }
     589             : 
     590             : GEN
     591        9933 : perm_pow(GEN perm, long exp)
     592             : {
     593        9933 :   long i, r = lg(perm)-1;
     594        9933 :   GEN p = zero_zv(r);
     595        9933 :   pari_sp av = avma;
     596        9933 :   GEN v = cgetg(r+1, t_VECSMALL);
     597      159516 :   for (i=1; i<=r; i++)
     598             :   {
     599             :     long e, n, k, l;
     600      149583 :     if (p[i]) continue;
     601       59150 :     v[1] = i;
     602      149583 :     for (n=1, k=perm[i]; k!=i; k=perm[k], n++) v[n+1] = k;
     603       59150 :     e = umodsu(exp, n);
     604      208733 :     for (k = 1, l = e; k <= n; k++)
     605             :     {
     606      149583 :       p[v[k]] = v[l+1];
     607      149583 :       if (++l == n) l = 0;
     608             :     }
     609             :   }
     610        9933 :   set_avma(av); return p;
     611             : }
     612             : 
     613             : GEN
     614          21 : perm_to_GAP(GEN p)
     615             : {
     616          21 :   pari_sp ltop=avma;
     617             :   GEN gap;
     618             :   GEN x;
     619             :   long i;
     620          21 :   long nb, c=0;
     621             :   char *s;
     622             :   long sz;
     623          21 :   long lp=lg(p)-1;
     624          21 :   if (typ(p) != t_VECSMALL)  pari_err_TYPE("perm_to_GAP",p);
     625          21 :   x = perm_cycles(p);
     626          21 :   sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
     627             :   /*Dry run*/
     628         133 :   for (i = 1, nb = 1; i < lg(x); ++i)
     629             :   {
     630         112 :     GEN z = gel(x,i);
     631         112 :     long lz = lg(z)-1;
     632         112 :     nb += 1+lz*(sz+2);
     633             :   }
     634          21 :   nb++;
     635             :   /*Real run*/
     636          21 :   gap = cgetg(nchar2nlong(nb) + 1, t_STR);
     637          21 :   s = GSTR(gap);
     638         133 :   for (i = 1; i < lg(x); ++i)
     639             :   {
     640             :     long j;
     641         112 :     GEN z = gel(x,i);
     642         112 :     if (lg(z) > 2)
     643             :     {
     644         112 :       s[c++] = '(';
     645         364 :       for (j = 1; j < lg(z); ++j)
     646             :       {
     647         252 :         if (j > 1)
     648             :         {
     649         140 :           s[c++] = ','; s[c++] = ' ';
     650             :         }
     651         252 :         sprintf(s+c,"%ld",z[j]);
     652         567 :         while(s[c++]) /* empty */;
     653         252 :         c--;
     654             :       }
     655         112 :       s[c++] = ')';
     656             :     }
     657             :   }
     658          21 :   if (!c) { s[c++]='('; s[c++]=')'; }
     659          21 :   s[c] = '\0';
     660          21 :   return gerepileupto(ltop,gap);
     661             : }
     662             : 
     663             : int
     664      558887 : perm_commute(GEN s, GEN t)
     665             : {
     666      558887 :   long i, l = lg(t);
     667    39730887 :   for (i = 1; i < l; i++)
     668    39185846 :     if (t[ s[i] ] != s[ t[i] ]) return 0;
     669      545041 :   return 1;
     670             : }
     671             : 
     672             : /*************************************************************************/
     673             : /**                                                                     **/
     674             : /**                  Routines for handling groups                       **/
     675             : /**                                                                     **/
     676             : /*************************************************************************/
     677             : /* A Group is a t_VEC [gen,orders]
     678             :  * gen (vecvecsmall): list of generators given by permutations
     679             :  * orders (vecsmall): relatives orders of generators. */
     680      456554 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
     681      778134 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
     682             : 
     683             : /* A Quotient Group is a t_VEC [gen,coset]
     684             :  * gen (vecvecsmall): coset generators
     685             :  * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
     686             :  */
     687       80269 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
     688       13643 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
     689             : 
     690             : static GEN
     691       31990 : trivialsubgroups(void)
     692       31990 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
     693             : 
     694             : /* Compute the order of p modulo the group given by a set */
     695             : long
     696      132510 : perm_relorder(GEN p, GEN set)
     697             : {
     698      132510 :   pari_sp ltop = avma;
     699      132510 :   long n = 1, q = p[1];
     700      368851 :   while (!F2v_coeff(set,q)) { q = p[q]; n++; }
     701      132510 :   return gc_long(ltop,n);
     702             : }
     703             : 
     704             : GEN
     705        8862 : perm_generate(GEN S, GEN H, long o)
     706             : {
     707        8862 :   long i, n = lg(H)-1;
     708        8862 :   GEN L = cgetg(n*o + 1, t_VEC);
     709       33355 :   for(i=1; i<=n;     i++) gel(L,i) = vecsmall_copy(gel(H,i));
     710       34993 :   for(   ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
     711        8862 :   return L;
     712             : }
     713             : 
     714             : /*Return the order (cardinality) of a group */
     715             : long
     716      334712 : group_order(GEN G)
     717             : {
     718      334712 :   return zv_prod(grp_get_ord(G));
     719             : }
     720             : 
     721             : /* G being a subgroup of S_n, output n */
     722             : long
     723        6762 : group_domain(GEN G)
     724             : {
     725        6762 :   GEN gen = grp_get_gen(G);
     726        6762 :   if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
     727        6762 :   return lg(gel(gen,1)) - 1;
     728             : }
     729             : 
     730             : /*Left coset of g mod G: gG*/
     731             : GEN
     732      142590 : group_leftcoset(GEN G, GEN g)
     733             : {
     734      142590 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     735      142590 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     736             :   long i, j, k;
     737      142590 :   gel(res,1) = vecsmall_copy(g);
     738      142590 :   k = 1;
     739      262654 :   for (i = 1; i < lg(gen); i++)
     740             :   {
     741      120064 :     long c = k * (ord[i] - 1);
     742      263459 :     for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
     743             :   }
     744      142590 :   return res;
     745             : }
     746             : /*Right coset of g mod G: Gg*/
     747             : GEN
     748       64876 : group_rightcoset(GEN G, GEN g)
     749             : {
     750       64876 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     751       64876 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     752             :   long i, j, k;
     753       64876 :   gel(res,1) = vecsmall_copy(g);
     754       64876 :   k = 1;
     755      106890 :   for (i = 1; i < lg(gen); i++)
     756             :   {
     757       42014 :     long c = k * (ord[i] - 1);
     758      103754 :     for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
     759             :   }
     760       64876 :   return res;
     761             : }
     762             : /*Elements of a group from the generators, cf group_leftcoset*/
     763             : GEN
     764       75971 : group_elts(GEN G, long n)
     765             : {
     766       75971 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     767       75971 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     768             :   long i, j, k;
     769       75971 :   gel(res,1) = identity_perm(n);
     770       75971 :   k = 1;
     771      155197 :   for (i = 1; i < lg(gen); i++)
     772             :   {
     773       79226 :     long c = k * (ord[i] - 1);
     774             :     /* j = 1, use res[1] = identity */
     775       79226 :     gel(res,++k) = vecsmall_copy(gel(gen,i));
     776      203147 :     for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
     777             :   }
     778       75971 :   return res;
     779             : }
     780             : 
     781             : GEN
     782           0 : groupelts_conj_set(GEN elts, GEN p)
     783             : {
     784           0 :   long i, j, l = lg(elts), n = lg(p)-1;
     785           0 :   GEN res = zero_F2v(n);
     786           0 :   for(j = 1; j < n; j++)
     787           0 :     if (p[j]==1) break;
     788           0 :   for(i = 1; i < l; i++)
     789           0 :     F2v_set(res, p[mael(elts,i,j)]);
     790           0 :   return res;
     791             : }
     792             : 
     793             : GEN
     794       14154 : groupelts_set(GEN elts, long n)
     795             : {
     796       14154 :   GEN res = zero_F2v(n);
     797       14154 :   long i, l = lg(elts);
     798       70070 :   for(i=1; i<l; i++)
     799       55916 :     F2v_set(res,mael(elts,i,1));
     800       14154 :   return res;
     801             : }
     802             : 
     803             : /*Elements of a group from the generators, returned as a set (bitmap)*/
     804             : GEN
     805       62328 : group_set(GEN G, long n)
     806             : {
     807       62328 :   GEN res = zero_F2v(n);
     808       62328 :   pari_sp av = avma;
     809       62328 :   GEN elts = group_elts(G, n);
     810       62328 :   long i, l = lg(elts);
     811      201600 :   for(i=1; i<l; i++)
     812      139272 :     F2v_set(res,mael(elts,i,1));
     813       62328 :   set_avma(av);
     814       62328 :   return res;
     815             : }
     816             : 
     817             : static int
     818       17227 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
     819             : 
     820             : GEN
     821         497 : subgroups_tableset(GEN S, long n)
     822             : {
     823         497 :   long i, l = lg(S);
     824         497 :   GEN  v = cgetg(l, t_VEC);
     825        5411 :   for(i=1; i<l; i++)
     826        4914 :     gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
     827         497 :   gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
     828         497 :   return v;
     829             : }
     830             : 
     831             : long
     832        2002 : tableset_find_index(GEN tbl, GEN set)
     833             : {
     834        2002 :   long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
     835        2002 :   if (!i) return 0;
     836        2002 :   return mael3(tbl,i,2,1);
     837             : }
     838             : 
     839             : GEN
     840       31990 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
     841             : /*Cyclic group generated by g of order s*/
     842             : GEN
     843        7280 : cyclicgroup(GEN g, long s)
     844        7280 : { retmkvec2(mkvec( vecsmall_copy(g) ),
     845             :             mkvecsmall(s)); }
     846             : /*Return the group generated by g1,g2 of relative orders s1,s2*/
     847             : GEN
     848        1085 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
     849        1085 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
     850             :              mkvecsmall2(s1, s2) ); }
     851             : 
     852             : /* return the quotient map G --> G/H */
     853             : /*The ouput is [gen,hash]*/
     854             : /* gen (vecvecsmall): coset generators
     855             :  * coset (vecsmall): vecsmall of coset number) */
     856             : GEN
     857        5299 : groupelts_quotient(GEN elt, GEN H)
     858             : {
     859        5299 :   pari_sp ltop = avma;
     860             :   GEN  p2, p3;
     861        5299 :   long i, j, a = 1;
     862        5299 :   long n = lg(gel(elt,1))-1, o = group_order(H);
     863             :   GEN  el;
     864        5299 :   long le = lg(elt)-1;
     865        5299 :   GEN used = zero_F2v(le+1);
     866        5299 :   long l = le/o;
     867        5299 :   p2 = cgetg(l+1, t_VEC);
     868        5299 :   p3 = zero_zv(n);
     869        5299 :   el = zero_zv(n);
     870       70427 :   for (i = 1; i<=le; i++)
     871       65128 :     el[mael(elt,i,1)]=i;
     872       36750 :   for (i = 1; i <= l; ++i)
     873             :   {
     874             :     GEN V;
     875       83888 :     while(F2v_coeff(used,a)) a++;
     876       31458 :     V = group_leftcoset(H,gel(elt,a));
     877       31458 :     gel(p2,i) = gel(V,1);
     878       96481 :     for(j=1;j<lg(V);j++)
     879             :     {
     880       65030 :       long b = el[mael(V,j,1)];
     881       65030 :       if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
     882       65023 :       F2v_set(used,b);
     883             :     }
     884       96467 :     for (j = 1; j <= o; j++)
     885       65016 :       p3[mael(V, j, 1)] = i;
     886             :   }
     887        5292 :   return gerepilecopy(ltop,mkvec2(p2,p3));
     888             : }
     889             : 
     890             : GEN
     891        5299 : group_quotient(GEN G, GEN H)
     892             : {
     893        5299 :   return groupelts_quotient(group_elts(G, group_domain(G)), H);
     894             : }
     895             : 
     896             : /*Compute the image of a permutation by a quotient map.*/
     897             : GEN
     898       13643 : quotient_perm(GEN C, GEN p)
     899             : {
     900       13643 :   GEN gen = quo_get_gen(C);
     901       13643 :   GEN coset = quo_get_coset(C);
     902       13643 :   long j, l = lg(gen);
     903       13643 :   GEN p3 = cgetg(l, t_VECSMALL);
     904      134883 :   for (j = 1; j < l; ++j)
     905             :   {
     906      121240 :     p3[j] = coset[p[mael(gen,j,1)]];
     907      121240 :     if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
     908             :   }
     909       13643 :   return p3;
     910             : }
     911             : 
     912             : /* H is a subgroup of G, C is the quotient map G --> G/H
     913             :  *
     914             :  * Lift a subgroup S of G/H to a subgroup of G containing H */
     915             : GEN
     916       30667 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
     917             : {
     918       30667 :   GEN genH = grp_get_gen(H);
     919       30667 :   GEN genS = grp_get_gen(S);
     920       30667 :   GEN genC = quo_get_gen(C);
     921       30667 :   long l1 = lg(genH)-1;
     922       30667 :   long l2 = lg(genS)-1, j;
     923       30667 :   GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
     924       61502 :   for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
     925       76923 :   for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
     926       30667 :   gel(p1,1) = L;
     927       30667 :   gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
     928       30667 :   return p1;
     929             : }
     930             : 
     931             : /* Let G a group and C a quotient map G --> G/H
     932             :  * Assume H is normal, return the group G/H */
     933             : GEN
     934        5292 : quotient_group(GEN C, GEN G)
     935             : {
     936        5292 :   pari_sp ltop = avma;
     937             :   GEN Qgen, Qord, Qelt, Qset, Q;
     938        5292 :   GEN Cgen = quo_get_gen(C);
     939        5292 :   GEN Ggen = grp_get_gen(G);
     940        5292 :   long i,j, n = lg(Cgen)-1, l = lg(Ggen);
     941        5292 :   Qord = cgetg(l, t_VECSMALL);
     942        5292 :   Qgen = cgetg(l, t_VEC);
     943        5292 :   Qelt = mkvec(identity_perm(n));
     944        5292 :   Qset = groupelts_set(Qelt, n);
     945       18935 :   for (i = 1, j = 1; i < l; ++i)
     946             :   {
     947       13643 :     GEN  g = quotient_perm(C, gel(Ggen,i));
     948       13643 :     long o = perm_relorder(g, Qset);
     949       13643 :     gel(Qgen,j) = g;
     950       13643 :     Qord[j] = o;
     951       13643 :     if (o != 1)
     952             :     {
     953        8862 :       Qelt = perm_generate(g, Qelt, o);
     954        8862 :       Qset = groupelts_set(Qelt, n);
     955        8862 :       j++;
     956             :     }
     957             :   }
     958        5292 :   setlg(Qgen,j);
     959        5292 :   setlg(Qord,j); Q = mkvec2(Qgen, Qord);
     960        5292 :   return gerepilecopy(ltop,Q);
     961             : }
     962             : 
     963             : GEN
     964           0 : quotient_groupelts(GEN C)
     965             : {
     966           0 :   GEN G = quo_get_gen(C);
     967           0 :   long i, l = lg(G);
     968           0 :   GEN Q = cgetg(l, t_VEC);
     969           0 :   for (i = 1; i < l; ++i)
     970           0 :     gel(Q,i) = quotient_perm(C, gel(G,i));
     971           0 :   return Q;
     972             : }
     973             : 
     974             : /* Return 1 if g normalizes N, 0 otherwise */
     975             : long
     976       64876 : group_perm_normalize(GEN N, GEN g)
     977             : {
     978       64876 :   pari_sp ltop = avma;
     979       64876 :   long r = gequal(vecvecsmall_sort_shallow(group_leftcoset(N, g)),
     980             :                   vecvecsmall_sort_shallow(group_rightcoset(N, g)));
     981       64876 :   return gc_long(ltop, r);
     982             : }
     983             : 
     984             : /* L is a list of subgroups, C is a coset and r a relative order.*/
     985             : static GEN
     986       46256 : liftlistsubgroups(GEN L, GEN C, long r)
     987             : {
     988       46256 :   pari_sp ltop = avma;
     989       46256 :   long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
     990             :   GEN R;
     991       46256 :   if (!l) return cgetg(1,t_VEC);
     992       39592 :   R = cgetg(l*c+1, t_VEC);
     993       95690 :   for (i = 1, k = 1; i <= l; ++i)
     994             :   {
     995       56098 :     GEN S = gel(L,i), Selt = group_set(S,n);
     996       56098 :     GEN gen = grp_get_gen(S);
     997       56098 :     GEN ord = grp_get_ord(S);
     998             :     long j;
     999      170520 :     for (j = 1; j <= c; ++j)
    1000             :     {
    1001      114422 :       GEN p = gel(C,j);
    1002      114422 :       if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
    1003       61803 :         gel(R,k++) = mkvec2(vec_append(gen, p),
    1004             :                             vecsmall_append(ord, r));
    1005             :     }
    1006             :   }
    1007       39592 :   setlg(R, k);
    1008       39592 :   return gerepilecopy(ltop, R);
    1009             : }
    1010             : 
    1011             : /* H is a normal subgroup, C is the quotient map G -->G/H,
    1012             :  * S is a subgroup of G/H, and G is embedded in Sym(l)
    1013             :  * Return all the subgroups K of G such that
    1014             :  * S= K mod H and K inter H={1} */
    1015             : static GEN
    1016       30667 : liftsubgroup(GEN C, GEN H, GEN S)
    1017             : {
    1018       30667 :   pari_sp ltop = avma;
    1019       30667 :   GEN V = trivialsubgroups();
    1020       30667 :   GEN Sgen = grp_get_gen(S);
    1021       30667 :   GEN Sord = grp_get_ord(S);
    1022       30667 :   GEN Cgen = quo_get_gen(C);
    1023       30667 :   long n = lg(Sgen), i;
    1024       76923 :   for (i = 1; i < n; ++i)
    1025             :   { /*loop over generators of S*/
    1026       46256 :     GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
    1027       46256 :     V = liftlistsubgroups(V, W, Sord[i]);
    1028             :   }
    1029       30667 :   return gerepilecopy(ltop,V);
    1030             : }
    1031             : 
    1032             : /* 1:A4, 2:S4, 3:F36, 0: other */
    1033             : long
    1034        5117 : group_isA4S4(GEN G)
    1035             : {
    1036        5117 :   GEN elt = grp_get_gen(G);
    1037        5117 :   GEN ord = grp_get_ord(G);
    1038        5117 :   long n = lg(ord);
    1039        5117 :   if (n != 4 && n != 5) return 0;
    1040        1624 :   if (n==4 && ord[1]==3 && ord[2]==3 && ord[3]==4)
    1041             :   {
    1042             :     long i;
    1043           0 :     GEN p = gel(elt,1), q = gel(elt,2), r = gel(elt,3);
    1044           0 :     for(i=1; i<=36; i++)
    1045           0 :       if (p[r[i]]!=r[q[i]]) return 0;
    1046           0 :     return 3;
    1047             :   }
    1048        1624 :   if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
    1049          42 :   if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
    1050          42 :   if (n==4) return 1;
    1051          21 :   if (ord[4]!=2) return 0;
    1052          21 :   if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
    1053          21 :   return 2;
    1054             : }
    1055             : /* compute all the subgroups of a group G */
    1056             : GEN
    1057        6440 : group_subgroups(GEN G)
    1058             : {
    1059        6440 :   pari_sp ltop = avma;
    1060             :   GEN p1, H, C, Q, M, sg1, sg2, sg3;
    1061        6440 :   GEN gen = grp_get_gen(G);
    1062        6440 :   GEN ord = grp_get_ord(G);
    1063        6440 :   long lM, i, j, n = lg(gen);
    1064             :   long t;
    1065        6440 :   if (n == 1) return trivialsubgroups();
    1066        5117 :   t = group_isA4S4(G);
    1067        5117 :   if (t == 3)
    1068             :   {
    1069           0 :     GEN H = mkvec2(mkvec3(gel(gen,1), gel(gen,2), perm_pow(gel(gen,3),2)),
    1070             :                    mkvecsmall3(3, 3, 2));
    1071           0 :     GEN S = group_subgroups(H);
    1072           0 :     GEN V = cgetg(11,t_VEC);
    1073           0 :     gel(V,1) = cyclicgroup(gel(gen,3),4);
    1074           0 :     for (i=2; i<10; i++)
    1075           0 :       gel(V,i) = cyclicgroup(perm_mul(gmael3(V,i-1,1,1),gel(gen,i%3==1 ? 2:1)),4);
    1076           0 :     gel(V,10) = G;
    1077           0 :     return gerepilecopy(ltop,shallowconcat(S,V));
    1078             :   }
    1079        5117 :   else if (t)
    1080             :   {
    1081          42 :     GEN s = gel(gen,1);       /*s = (1,2)(3,4) */
    1082          42 :     GEN t = gel(gen,2);       /*t = (1,3)(2,4) */
    1083          42 :     GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
    1084          42 :     H = dicyclicgroup(s, t, 2, 2);
    1085             :     /* sg3 is the list of subgroups intersecting only partially with H*/
    1086          42 :     sg3 = cgetg((n==4)?4: 10, t_VEC);
    1087          42 :     gel(sg3,1) = cyclicgroup(s, 2);
    1088          42 :     gel(sg3,2) = cyclicgroup(t, 2);
    1089          42 :     gel(sg3,3) = cyclicgroup(st, 2);
    1090          42 :     if (n==5)
    1091             :     {
    1092          21 :       GEN u = gel(gen,3);
    1093          21 :       GEN v = gel(gen,4), w, u2;
    1094          21 :       if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
    1095          21 :         u2 = perm_mul(u,u);
    1096             :       else
    1097             :       {
    1098           0 :         u2 = u;
    1099           0 :         u = perm_mul(u,u);
    1100             :       }
    1101          21 :       if (perm_order(v)==2)
    1102             :       {
    1103          21 :         if (!perm_commute(s,v)) /*v=(1,2)*/
    1104             :         {
    1105           0 :           v = perm_conj(u,v);
    1106           0 :           if (!perm_commute(s,v)) v = perm_conj(u,v);
    1107             :         }
    1108          21 :         w = perm_mul(v,t); /*w=(1,4,2,3)*/
    1109             :       }
    1110             :       else
    1111             :       {
    1112           0 :         w = v;
    1113           0 :         if (!zv_equal(perm_mul(w,w), s)) /*w=(1,4,2,3)*/
    1114             :         {
    1115           0 :           w = perm_conj(u,w);
    1116           0 :           if (!zv_equal(perm_mul(w,w), s)) w = perm_conj(u,w);
    1117             :         }
    1118           0 :         v = perm_mul(w,t); /*v=(1,2)*/
    1119             :       }
    1120          21 :       gel(sg3,4) = dicyclicgroup(s,v,2,2);
    1121          21 :       gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
    1122          21 :       gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
    1123          21 :       gel(sg3,7) = dicyclicgroup(s,w,2,2);
    1124          21 :       gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
    1125          21 :       gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
    1126             :     }
    1127             :   }
    1128             :   else
    1129             :   {
    1130        5075 :     long osig = mael(factoru(ord[1]), 1, 1);
    1131        5075 :     GEN sig = perm_pow(gel(gen,1), ord[1]/osig);
    1132        5075 :     H = cyclicgroup(sig,osig);
    1133        5075 :     sg3 = NULL;
    1134             :   }
    1135        5117 :   C = group_quotient(G,H);
    1136        5110 :   Q = quotient_group(C,G);
    1137        5110 :   M = group_subgroups(Q); lM = lg(M);
    1138             :   /* sg1 is the list of subgroups containing H*/
    1139        5103 :   sg1 = cgetg(lM, t_VEC);
    1140       35770 :   for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
    1141             :   /*sg2 is a list of lists of subgroups not intersecting with H*/
    1142        5103 :   sg2 = cgetg(lM, t_VEC);
    1143             :   /* Loop over all subgroups of G/H */
    1144       35770 :   for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
    1145        5103 :   p1 = gconcat(sg1, shallowconcat1(sg2));
    1146        5103 :   if (sg3)
    1147             :   {
    1148          42 :     p1 = gconcat(p1, sg3);
    1149          42 :     if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
    1150          84 :       for(j = 3; j <= 5; j++)
    1151             :       {
    1152          63 :         GEN c = gmael(p1,j,1);
    1153          63 :         if (!perm_commute(gel(c,1),gel(c,3)))
    1154             :         {
    1155          42 :           if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
    1156             :           else
    1157          21 :             perm_mul_inplace2(gel(c,2), gel(c,1));
    1158             :         }
    1159             :       }
    1160             :   }
    1161        5103 :   return gerepileupto(ltop,p1);
    1162             : }
    1163             : 
    1164             : /*return 1 if G is abelian, else 0*/
    1165             : long
    1166         938 : group_isabelian(GEN G)
    1167             : {
    1168         938 :   GEN g = grp_get_gen(G);
    1169         938 :   long i, j, n = lg(g);
    1170        1498 :   for(i=2; i<n; i++)
    1171        1498 :     for(j=1; j<i; j++)
    1172         938 :       if (!perm_commute(gel(g,i), gel(g,j))) return 0;
    1173         812 :   return 1;
    1174             : }
    1175             : 
    1176             : /*If G is abelian, return its HNF matrix*/
    1177             : GEN
    1178         329 : group_abelianHNF(GEN G, GEN S)
    1179             : {
    1180         329 :   GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
    1181         329 :   long i, j, k, n = lg(g);
    1182         329 :   if (!group_isabelian(G)) return NULL;
    1183         259 :   if (n==1) return cgetg(1,t_MAT);
    1184         245 :   if (!S) S = group_elts(G, group_domain(G));
    1185         245 :   M = cgetg(n,t_MAT);
    1186         868 :   for(i=1; i<n; i++)
    1187             :   {
    1188         623 :     GEN P, C = cgetg(n,t_COL);
    1189         623 :     pari_sp av = avma;
    1190         623 :     gel(M,i) = C;
    1191         623 :     P = perm_pow(gel(g,i), -o[i]);
    1192         903 :     for(j=1; j<lg(S); j++)
    1193         903 :       if (zv_equal(P, gel(S,j))) break;
    1194         623 :     set_avma(av);
    1195         623 :     if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
    1196         623 :     j--;
    1197        1162 :     for(k=1; k<i; k++)
    1198             :     {
    1199         539 :       long q = j / o[k];
    1200         539 :       gel(C,k) = stoi(j - q*o[k]);
    1201         539 :       j = q;
    1202             :     }
    1203         623 :     gel(C,k) = stoi(o[i]);
    1204        1162 :     for (k++; k<n; k++) gel(C,k) = gen_0;
    1205             :   }
    1206         245 :   return M;
    1207             : }
    1208             : 
    1209             : /*If G is abelian, return its abstract SNF matrix*/
    1210             : GEN
    1211         280 : group_abelianSNF(GEN G, GEN L)
    1212             : {
    1213         280 :   pari_sp ltop = avma;
    1214         280 :   GEN H = group_abelianHNF(G,L);
    1215         280 :   if (!H) return NULL;
    1216         210 :   return gerepileupto(ltop, smithclean( ZM_snf(H) ));
    1217             : }
    1218             : 
    1219             : GEN
    1220         224 : abelian_group(GEN v)
    1221             : {
    1222         224 :   long card = zv_prod(v), i, d = 1, l = lg(v);
    1223         224 :   GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
    1224         224 :   gel(G,1) = gen;
    1225         224 :   gel(G,2) = vecsmall_copy(v);
    1226         490 :   for(i=1; i<l; i++)
    1227             :   {
    1228         266 :     GEN p = cgetg(card+1, t_VECSMALL);
    1229         266 :     long o = v[i], u = d*(o-1), j, k, l;
    1230         266 :     gel(gen, i) = p;
    1231             :     /* The following loop is over-optimized. Remember that I wrote it for
    1232             :      * testpermutation. Something has survived... BA */
    1233         665 :     for(j=1;j<=card;)
    1234             :     {
    1235        1652 :       for(k=1;k<o;k++)
    1236        3626 :         for(l=1;l<=d; l++,j++) p[j] = j+d;
    1237        1610 :       for (l=1; l<=d; l++,j++) p[j] = j-u;
    1238             :     }
    1239         266 :     d += u;
    1240             :   }
    1241         224 :   return G;
    1242             : }
    1243             : 
    1244             : static long
    1245          56 : groupelts_subgroup_isnormal(GEN G, GEN H)
    1246             : {
    1247          56 :   long i, n = lg(G);
    1248         126 :   for(i = 1; i < n; i++)
    1249          91 :     if (!group_perm_normalize(H, gel(G,i))) return 0;
    1250          35 :   return 1;
    1251             : }
    1252             : 
    1253             : /*return 1 if H is a normal subgroup of G*/
    1254             : long
    1255          56 : group_subgroup_isnormal(GEN G, GEN H)
    1256             : {
    1257          56 :   if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
    1258           0 :     pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
    1259             :                     strtoGENstr("domain(G)"), H);
    1260          56 :   return groupelts_subgroup_isnormal(grp_get_gen(G), H);
    1261             : }
    1262             : 
    1263             : static GEN
    1264           0 : group_subgroup_kernel_set(GEN G, GEN H)
    1265             : {
    1266             :   pari_sp av;
    1267           0 :   GEN g = grp_get_gen(G);
    1268           0 :   long i, n = lg(g);
    1269             :   GEN S, elts;
    1270           0 :   long d = group_domain(G);
    1271           0 :   if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
    1272           0 :     pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
    1273             :                     strtoGENstr("domain(G)"), H);
    1274           0 :   elts = group_elts(H,d);
    1275           0 :   S = groupelts_set(elts, d);
    1276           0 :   av = avma;
    1277           0 :   for(i=1; i<n; i++)
    1278             :   {
    1279           0 :     F2v_and_inplace(S, groupelts_conj_set(elts,gel(g,i)));
    1280           0 :     set_avma(av);
    1281             :   }
    1282           0 :   return S;
    1283             : }
    1284             : 
    1285             : int
    1286           0 : group_subgroup_is_faithful(GEN G, GEN H)
    1287             : {
    1288           0 :   pari_sp av = avma;
    1289           0 :   GEN K = group_subgroup_kernel_set(G,H);
    1290           0 :   F2v_clear(K,1);
    1291           0 :   return gc_long(av, F2v_equal0(K));
    1292             : }
    1293             : 
    1294             : long
    1295           0 : groupelts_exponent(GEN elts)
    1296             : {
    1297           0 :   long i, n = lg(elts)-1, expo = 1;
    1298           0 :   for(i=1; i<=n; i++) expo = ulcm(expo, perm_order(gel(elts,i)));
    1299           0 :   return expo;
    1300             : }
    1301             : 
    1302             : GEN
    1303         693 : groupelts_center(GEN S)
    1304             : {
    1305         693 :   pari_sp ltop = avma;
    1306         693 :   long i, j, n = lg(S)-1, l = n;
    1307         693 :   GEN V, elts = zero_F2v(n+1);
    1308       24969 :   for(i=1; i<=n; i++)
    1309             :   {
    1310       24276 :     if (F2v_coeff(elts,i)) { l--;  continue; }
    1311      567931 :     for(j=1; j<=n; j++)
    1312      557760 :       if (!perm_commute(gel(S,i),gel(S,j)))
    1313             :       {
    1314       13594 :         F2v_set(elts,i);
    1315       13594 :         F2v_set(elts,j); l--; break;
    1316             :       }
    1317             :   }
    1318         693 :   V = cgetg(l+1,t_VEC);
    1319       24969 :   for (i=1, j=1; i<=n ;i++)
    1320       24276 :     if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
    1321         693 :   return gerepileupto(ltop,V);
    1322             : }
    1323             : 
    1324             : GEN
    1325        4270 : groupelts_conjclasses(GEN elts, long *pnbcl)
    1326             : {
    1327        4270 :   long i, j, cl = 0, n = lg(elts)-1;
    1328        4270 :   GEN c = const_vecsmall(n,0);
    1329        4270 :   pari_sp av = avma;
    1330       52850 :   for (i=1; i<=n; i++)
    1331             :   {
    1332       48580 :     GEN g = gel(elts,i);
    1333       48580 :     if (c[i]) continue;
    1334       34965 :     c[i] = ++cl;
    1335      486871 :     for(j=1; j<=n; j++)
    1336      451906 :       if (j != i)
    1337             :       {
    1338      416941 :         GEN h = perm_conj(gel(elts,j), g);
    1339      416941 :         long i2 = gen_search(elts,h,0,(void*)&vecsmall_lexcmp,&cmp_nodata);
    1340      416941 :         c[i2] = cl;
    1341      416941 :         set_avma(av);
    1342             :       }
    1343             :   }
    1344        4270 :   if (pnbcl) *pnbcl = cl;
    1345        4270 :   return c;
    1346             : }
    1347             : 
    1348             : GEN
    1349        4270 : conjclasses_repr(GEN conj, long nb)
    1350             : {
    1351        4270 :   long i, l = lg(conj);
    1352        4270 :   GEN e = const_vecsmall(nb, 0);
    1353       52850 :   for(i=1; i<l; i++)
    1354             :   {
    1355       48580 :     long ci = conj[i];
    1356       48580 :     if (!e[ci]) e[ci] = i;
    1357             :   }
    1358        4270 :   return e;
    1359             : }
    1360             : 
    1361             : /* elts of G sorted wrt vecsmall_lexcmp order: g in G is determined by g[1]
    1362             :  * so sort by increasing g[1] */
    1363             : static GEN
    1364        3885 : galois_elts_sorted(GEN gal)
    1365             : {
    1366             :   long i, l;
    1367        3885 :   GEN elts = gal_get_group(gal), v = cgetg_copy(elts, &l);
    1368       43141 :   for (i = 1; i < l; i++) { GEN g = gel(elts,i); gel(v, g[1]) = g; }
    1369        3885 :   return v;
    1370             : }
    1371             : GEN
    1372        4284 : group_to_cc(GEN G)
    1373             : {
    1374        4284 :   GEN elts = checkgroupelts(G), z = cgetg(5,t_VEC);
    1375        4270 :   long n, flag = 1;
    1376        4270 :   if (typ(gel(G,1)) == t_POL)
    1377        3885 :     elts = galois_elts_sorted(G); /* galoisinit */
    1378             :   else
    1379             :   {
    1380         385 :     long i, l = lg(elts);
    1381         385 :     elts = gen_sort_shallow(elts,(void*)vecsmall_lexcmp,cmp_nodata);
    1382        5824 :     for (i = 1; i < l; i++)
    1383        5586 :       if (gel(elts,i)[1] != i) { flag = 0; break; }
    1384             :   }
    1385        4270 :   gel(z,1) = elts;
    1386        4270 :   gel(z,2) = groupelts_conjclasses(elts,&n);
    1387        4270 :   gel(z,3) = conjclasses_repr(gel(z,2),n);
    1388        4270 :   gel(z,4) = utoi(flag); return z;
    1389             : }
    1390             : 
    1391             : /* S a list of generators */
    1392             : GEN
    1393           0 : groupelts_abelian_group(GEN S)
    1394             : {
    1395           0 :   pari_sp ltop = avma;
    1396             :   GEN Qgen, Qord, Qelt;
    1397           0 :   long i, j, n = lg(gel(S,1))-1, l = lg(S);
    1398           0 :   Qord = cgetg(l, t_VECSMALL);
    1399           0 :   Qgen = cgetg(l, t_VEC);
    1400           0 :   Qelt = mkvec(identity_perm(n));
    1401           0 :   for (i = 1, j = 1; i < l; ++i)
    1402             :   {
    1403           0 :     GEN  g = gel(S,i);
    1404           0 :     long o = perm_relorder(g, groupelts_set(Qelt, n));
    1405           0 :     gel(Qgen,j) = g;
    1406           0 :     Qord[j] = o;
    1407           0 :     if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
    1408             :   }
    1409           0 :   setlg(Qgen,j);
    1410           0 :   setlg(Qord,j);
    1411           0 :   return gerepilecopy(ltop, mkvec2(Qgen, Qord));
    1412             : }
    1413             : 
    1414             : GEN
    1415          14 : group_export_GAP(GEN G)
    1416             : {
    1417          14 :   pari_sp av = avma;
    1418          14 :   GEN s, comma, g = grp_get_gen(G);
    1419          14 :   long i, k, l = lg(g);
    1420          14 :   if (l == 1) return strtoGENstr("Group(())");
    1421           7 :   s = cgetg(2*l, t_VEC);
    1422           7 :   comma = strtoGENstr(", ");
    1423           7 :   gel(s,1) = strtoGENstr("Group(");
    1424          28 :   for (i=1, k=2; i < l; ++i)
    1425             :   {
    1426          21 :     if (i > 1) gel(s,k++) = comma;
    1427          21 :     gel(s,k++) = perm_to_GAP(gel(g,i));
    1428             :   }
    1429           7 :   gel(s,k++) = strtoGENstr(")");
    1430           7 :   return gerepilecopy(av, shallowconcat1(s));
    1431             : }
    1432             : 
    1433             : GEN
    1434          14 : group_export_MAGMA(GEN G)
    1435             : {
    1436          14 :   pari_sp av = avma;
    1437          14 :   GEN s, comma, g = grp_get_gen(G);
    1438          14 :   long i, k, l = lg(g);
    1439          14 :   if (l == 1) return strtoGENstr("PermutationGroup<1|>");
    1440           7 :   s = cgetg(2*l, t_VEC);
    1441           7 :   comma = strtoGENstr(", ");
    1442           7 :   gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
    1443          28 :   for (i=1, k=2; i < l; ++i)
    1444             :   {
    1445          21 :     if (i > 1) gel(s,k++) = comma;
    1446          21 :     gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
    1447             :   }
    1448           7 :   gel(s,k++) = strtoGENstr(">");
    1449           7 :   return gerepilecopy(av, shallowconcat1(s));
    1450             : }
    1451             : 
    1452             : GEN
    1453          28 : group_export(GEN G, long format)
    1454             : {
    1455          28 :   switch(format)
    1456             :   {
    1457          14 :   case 0: return group_export_GAP(G);
    1458          14 :   case 1: return group_export_MAGMA(G);
    1459             :   }
    1460           0 :   pari_err_FLAG("galoisexport");
    1461           0 :   return NULL; /*-Wall*/
    1462             : }
    1463             : 
    1464             : static GEN
    1465           0 : groupelts_cyclic_subgroups(GEN G)
    1466             : {
    1467           0 :   pari_sp av = avma;
    1468           0 :   long i, j, n = lg(G)-1;
    1469           0 :   GEN elts = zero_F2v(n+1), f;
    1470           0 :   GEN ord = cgetg(n+1, t_VECSMALL);
    1471           0 :   GEN V = cgetg(n+1, t_VEC);
    1472           0 :   for (i=1, j=1; i<=n; i++)
    1473             :   {
    1474           0 :     long k = 1, o, c = 0;
    1475           0 :     GEN p = gel(G, i);
    1476           0 :     if (F2v_coeff(elts, p[1])) continue;
    1477           0 :     o = perm_order(p);
    1478           0 :     ord[j] = o;
    1479           0 :     gel(V,j++) = p;
    1480             :     do
    1481             :     {
    1482           0 :       if (cgcd(o, ++c)==1) F2v_set(elts, p[k]);
    1483           0 :       k = p[k];
    1484           0 :     } while (k!=1);
    1485             :   }
    1486           0 :   setlg(ord, j);
    1487           0 :   setlg(V, j);
    1488           0 :   f = vecsmall_indexsort(ord);
    1489           0 :   return gerepilecopy(av, mkvec2(vecpermute(V, f), vecpermute(ord, f)));
    1490             : }
    1491             : 
    1492             : GEN
    1493           0 : groupelts_to_group(GEN G)
    1494             : {
    1495           0 :   pari_sp av = avma;
    1496           0 :   GEN L = groupelts_cyclic_subgroups(G);
    1497           0 :   GEN cyc = gel(L,1), ord = gel(L,2);
    1498           0 :   long i, l = lg(cyc), n = lg(G)-1;
    1499           0 :   for (i = l-1; i >= 2; i--)
    1500             :   {
    1501           0 :     GEN p = gel(cyc,i);
    1502           0 :     long o = ord[i];
    1503             :     GEN H;
    1504           0 :     if (o == n) { set_avma(av); return cyclicgroup(p, o); }
    1505           0 :     H = cyclicgroup(p, o);
    1506           0 :     if (groupelts_subgroup_isnormal(G, H))
    1507             :     {
    1508           0 :       GEN C = groupelts_quotient(G, H);
    1509           0 :       GEN Q = quotient_groupelts(C);
    1510           0 :       GEN R = groupelts_to_group(Q);
    1511           0 :       if (!R) return gc_NULL(av);
    1512           0 :       return gerepilecopy(av, quotient_subgroup_lift(C, H, R));
    1513             :     }
    1514             :   }
    1515           0 :   if (n==12 && l==9 && ord[2]==2 && ord[3]==2 && ord[5]==3)
    1516           0 :     return gerepilecopy(av,
    1517           0 :       mkvec2(mkvec3(gel(cyc,2), gel(cyc,3), gel(cyc,5)), mkvecsmall3(2,2,3)));
    1518           0 :   if (n==24 && l==18 && ord[11]==3 && ord[15]==4 && ord[16]==4)
    1519             :   {
    1520           0 :     GEN t21 = perm_pow(gel(cyc,15),2);
    1521           0 :     GEN t22 = perm_pow(gel(cyc,16),2);
    1522           0 :     return gerepilecopy(av,
    1523           0 :       mkvec2(mkvec4(t21,t22, gel(cyc,11), gel(cyc,15)), mkvecsmall4(2,2,3,2)));
    1524             :   }
    1525           0 :   if (n==36 && l==24 && ord[11]==3 && ord[15]==4)
    1526             :   {
    1527           0 :     GEN t1 = gel(cyc,11), t3 = gel(cyc,15);
    1528           0 :     return gerepilecopy(av,
    1529             :       mkvec2(mkvec3(t1, perm_conj(t3, t1), t3), mkvecsmall3(3,3,4)));
    1530             :   }
    1531           0 :   return gc_NULL(av);
    1532             : }

Generated by: LCOV version 1.13