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-bordeaux1.fr machine (x86_64 architecture), and agregate them in the final report:

The target is 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.8.0 lcov report (development 17110-9967e23) Lines: 539 573 94.1 %
Date: 2014-11-26 Functions: 61 64 95.3 %
Legend: Lines: hit not hit | Branches: + taken - not taken # not executed Branches: 296 337 87.8 %

           Branch data     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                 :       1785 : vec_isconst(GEN v)
      24                 :            : {
      25                 :       1785 :   long i, l = lg(v);
      26                 :            :   GEN w;
      27         [ -  + ]:       1785 :   if (l==1) return 1;
      28                 :       1785 :   w = gel(v,1);
      29         [ +  + ]:       2970 :   for(i=2;i<l;i++)
      30         [ +  + ]:       2410 :     if (!gequal(gel(v,i), w)) return 0;
      31                 :       1785 :   return 1;
      32                 :            : }
      33                 :            : 
      34                 :            : /* Check if all the elements of v are different.
      35                 :            :  * Use a quadratic algorithm. Could be done in n*log(n) by sorting. */
      36                 :            : int
      37                 :       1500 : vec_is1to1(GEN v)
      38                 :            : {
      39                 :       1500 :   long i, j, l = lg(v);
      40         [ +  + ]:       9720 :   for (i=1; i<l; i++)
      41                 :            :   {
      42                 :       8515 :     GEN w = gel(v,i);
      43         [ +  + ]:      68265 :     for(j=i+1; j<l; j++)
      44         [ +  + ]:      60045 :       if (gequal(gel(v,j), w)) return 0;
      45                 :            :   }
      46                 :       1500 :   return 1;
      47                 :            : }
      48                 :            : 
      49                 :            : GEN
      50                 :      38360 : vec_insert(GEN v, long n, GEN x)
      51                 :            : {
      52                 :      38360 :   long i, l=lg(v);
      53                 :      38360 :   GEN V = cgetg(l+1,t_VEC);
      54         [ +  + ]:     270520 :   for(i=1; i<n; i++) gel(V,i) = gel(v,i);
      55                 :      38360 :   gel(V,n) = x;
      56         [ +  + ]:     180580 :   for(i=n+1; i<=l; i++) gel(V,i) = gel(v,i-1);
      57                 :      38360 :   return V;
      58                 :            : }
      59                 :            : /*************************************************************************/
      60                 :            : /**                                                                     **/
      61                 :            : /**                   Routines for handling VECSMALL                    **/
      62                 :            : /**                                                                     **/
      63                 :            : /*************************************************************************/
      64                 :            : /* Sort v[0]...v[n-1] and put result in w[0]...w[n-1].
      65                 :            :  * We accept v==w. w must be allocated. */
      66                 :            : static void
      67                 :     483110 : vecsmall_sortspec(GEN v, long n, GEN w)
      68                 :            : {
      69                 :     483110 :   pari_sp ltop=avma;
      70                 :     483110 :   long nx=n>>1, ny=n-nx;
      71                 :            :   long m, ix, iy;
      72                 :            :   GEN x, y;
      73         [ +  + ]:     483110 :   if (n<=2)
      74                 :            :   {
      75         [ +  + ]:     273703 :     if (n==1)
      76                 :      73331 :       w[0]=v[0];
      77         [ +  - ]:     200372 :     else if (n==2)
      78                 :            :     {
      79                 :     200372 :       long v0=v[0], v1=v[1];
      80         [ +  + ]:     200372 :       if (v0<=v1) { w[0]=v0; w[1]=v1; }
      81                 :      88588 :       else        { w[0]=v1; w[1]=v0; }
      82                 :            :     }
      83                 :     483110 :     return;
      84                 :            :   }
      85                 :     209407 :   x=new_chunk(nx); y=new_chunk(ny);
      86                 :     209407 :   vecsmall_sortspec(v,nx,x);
      87                 :     209407 :   vecsmall_sortspec(v+nx,ny,y);
      88 [ +  + ][ +  + ]:    1510515 :   for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
      89         [ +  + ]:    1301108 :     if (x[ix]<=y[iy])
      90                 :     527742 :       w[m++]=x[ix++];
      91                 :            :     else
      92                 :     773366 :       w[m++]=y[iy++];
      93         [ +  + ]:     534986 :   for(;ix<nx;) w[m++]=x[ix++];
      94         [ +  + ]:     408311 :   for(;iy<ny;) w[m++]=y[iy++];
      95                 :     209407 :   avma=ltop;
      96                 :            : }
      97                 :            : 
      98                 :            : /*in place sort.*/
      99                 :            : void
     100                 :     101969 : vecsmall_sort(GEN V)
     101                 :            : {
     102                 :     101969 :   long l = lg(V)-1;
     103         [ +  + ]:     166265 :   if (l<=1) return;
     104                 :      64296 :   vecsmall_sortspec(V+1,l,V+1);
     105                 :            : }
     106                 :            : 
     107                 :            : /* cf gen_sortspec */
     108                 :            : static GEN
     109                 :    6127946 : vecsmall_indexsortspec(GEN v, long n)
     110                 :            : {
     111                 :            :   long nx, ny, m, ix, iy;
     112                 :            :   GEN x, y, w;
     113   [ +  +  +  + ]:    6127946 :   switch(n)
     114                 :            :   {
     115                 :       4607 :     case 1: return mkvecsmall(1);
     116         [ +  + ]:    1195870 :     case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
     117                 :            :     case 3:
     118         [ +  + ]:    1886117 :       if (v[1] <= v[2]) {
     119         [ +  + ]:    1804468 :         if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
     120                 :      68823 :         return (v[1] <= v[3])? mkvecsmall3(1,3,2)
     121         [ +  + ]:      68823 :                              : mkvecsmall3(3,1,2);
     122                 :            :       } else {
     123         [ +  + ]:      81649 :         if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
     124                 :      63186 :         return (v[2] <= v[3])? mkvecsmall3(2,3,1)
     125         [ +  + ]:      63186 :                              : mkvecsmall3(3,2,1);
     126                 :            :       }
     127                 :            :   }
     128                 :    3041352 :   nx = n>>1; ny = n-nx;
     129                 :    3041352 :   w = cgetg(n+1,t_VECSMALL);
     130                 :    3041352 :   x = vecsmall_indexsortspec(v,nx);
     131                 :    3041352 :   y = vecsmall_indexsortspec(v+nx,ny);
     132 [ +  + ][ +  + ]:   64243445 :   for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
     133         [ +  + ]:   61202093 :     if (v[x[ix]] <= v[y[iy]+nx])
     134                 :   40711343 :       w[m++] = x[ix++];
     135                 :            :     else
     136                 :   20490750 :       w[m++] = y[iy++]+nx;
     137         [ +  + ]:    3456064 :   for(;ix<=nx;) w[m++] = x[ix++];
     138         [ +  + ]:   25417344 :   for(;iy<=ny;) w[m++] = y[iy++]+nx;
     139                 :    6127946 :   avma = (pari_sp)w; return w;
     140                 :            : }
     141                 :            : 
     142                 :            : /*indirect sort.*/
     143                 :            : GEN
     144                 :      45242 : vecsmall_indexsort(GEN V)
     145                 :            : {
     146                 :      45242 :   long l=lg(V)-1;
     147         [ -  + ]:      45242 :   if (l==0) return cgetg(1, t_VECSMALL);
     148                 :      45242 :   return vecsmall_indexsortspec(V,l);
     149                 :            : }
     150                 :            : 
     151                 :            : /* assume V sorted */
     152                 :            : GEN
     153                 :        748 : vecsmall_uniq_sorted(GEN V)
     154                 :            : {
     155                 :            :   GEN W;
     156                 :        748 :   long i,j, l = lg(V);
     157         [ +  + ]:        748 :   if (l == 1) return vecsmall_copy(V);
     158                 :        744 :   W = cgetg(l,t_VECSMALL);
     159                 :        744 :   W[1] = V[1];
     160         [ +  + ]:       1527 :   for(i=j=2; i<l; i++)
     161         [ +  + ]:        783 :     if (V[i] != W[j-1]) W[j++] = V[i];
     162                 :        744 :   stackdummy((pari_sp)(W + l), (pari_sp)(W + j));
     163                 :        748 :   setlg(W, j); return W;
     164                 :            : }
     165                 :            : 
     166                 :            : GEN
     167                 :        748 : vecsmall_uniq(GEN V)
     168                 :            : {
     169                 :        748 :   pari_sp av = avma;
     170                 :        748 :   V = zv_copy(V); vecsmall_sort(V);
     171                 :        748 :   return gerepileuptoleaf(av, vecsmall_uniq_sorted(V));
     172                 :            : }
     173                 :            : 
     174                 :            : /* assume x sorted */
     175                 :            : long
     176                 :          0 : vecsmall_duplicate_sorted(GEN x)
     177                 :            : {
     178                 :          0 :   long i,k,l=lg(x);
     179         [ #  # ]:          0 :   if (l==1) return 0;
     180         [ #  # ]:          0 :   for (k=x[1],i=2; i<l; k=x[i++])
     181         [ #  # ]:          0 :     if (x[i] == k) return i;
     182                 :          0 :   return 0;
     183                 :            : }
     184                 :            : 
     185                 :            : long
     186                 :       5392 : vecsmall_duplicate(GEN x)
     187                 :            : {
     188                 :       5392 :   pari_sp av=avma;
     189                 :       5392 :   GEN p=vecsmall_indexsort(x);
     190                 :       5392 :   long k,i,r=0,l=lg(x);
     191         [ -  + ]:       5392 :   if (l==1) return 0;
     192         [ +  + ]:       6787 :   for (k=x[p[1]],i=2; i<l; k=x[p[i++]])
     193         [ -  + ]:       1395 :     if (x[p[i]] == k) { r=p[i]; break; }
     194                 :       5392 :   avma=av;
     195                 :       5392 :   return r;
     196                 :            : }
     197                 :            : 
     198                 :            : /*************************************************************************/
     199                 :            : /**                                                                     **/
     200                 :            : /**             Routines for handling vectors of VECSMALL               **/
     201                 :            : /**                                                                     **/
     202                 :            : /*************************************************************************/
     203                 :            : 
     204                 :            : GEN
     205                 :      82000 : vecvecsmall_sort(GEN x)
     206                 :            : {
     207                 :      82000 :   return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata);
     208                 :            : }
     209                 :            : 
     210                 :            : GEN
     211                 :        150 : vecvecsmall_sort_uniq(GEN x)
     212                 :            : {
     213                 :        150 :   return gen_sort_uniq(x, (void*)&vecsmall_lexcmp, cmp_nodata);
     214                 :            : }
     215                 :            : 
     216                 :            : GEN
     217                 :          0 : vecvecsmall_indexsort(GEN x)
     218                 :            : {
     219                 :          0 :   return gen_indexsort(x, (void*)&vecsmall_lexcmp, cmp_nodata);
     220                 :            : }
     221                 :            : 
     222                 :            : long
     223                 :    7704280 : vecvecsmall_search(GEN x, GEN y, long flag)
     224                 :            : {
     225                 :    7704280 :   return gen_search(x,y,flag,(void*)vecsmall_prefixcmp, cmp_nodata);
     226                 :            : }
     227                 :            : 
     228                 :            : /*************************************************************************/
     229                 :            : /**                                                                     **/
     230                 :            : /**                  Routines for handling permutations                 **/
     231                 :            : /**                                                                     **/
     232                 :            : /*************************************************************************/
     233                 :            : 
     234                 :            : /* Permutations may be given by
     235                 :            :  * perm (VECSMALL): a bijection from 1...n to 1...n i-->perm[i]
     236                 :            :  * cyc (VEC of VECSMALL): a product of disjoint cycles. */
     237                 :            : 
     238                 :            : /* Multiply (compose) two permutations, putting the result in the second one. */
     239                 :            : static void
     240                 :          5 : perm_mul_inplace2(GEN s, GEN t)
     241                 :            : {
     242                 :          5 :   long i, l = lg(s);
     243         [ +  + ]:        125 :   for (i = 1; i < l; i++) t[i] = s[t[i]];
     244                 :          5 : }
     245                 :            : 
     246                 :            : /* Orbits of the subgroup generated by v on {1,..,n} */
     247                 :            : static GEN
     248                 :      35620 : vecperm_orbits_i(GEN v, long n)
     249                 :            : {
     250                 :      35620 :   long mj = 1, k, l, m;
     251                 :      35620 :   GEN cy, cycle = cgetg(n+1, t_VEC), bit = zero_F2v(n);
     252         [ +  + ]:     552980 :   for (k = 1, l = 1; k <= n;)
     253                 :            :   {
     254         [ +  + ]:     942325 :     for (  ; F2v_coeff(bit,mj); mj++) /*empty*/;
     255                 :     517360 :     cy = cgetg(n+1, t_VECSMALL);
     256                 :     517360 :     m = 1; k++; cy[m++] = mj;
     257                 :     517360 :     F2v_set(bit, mj++);
     258                 :            :     for(;;)
     259                 :            :     {
     260                 :     964270 :       long o, mold = m;
     261         [ +  + ]:    1929460 :       for (o = 1; o < lg(v); o++)
     262                 :            :       {
     263                 :     965190 :         GEN vo = gel(v,o);
     264                 :            :         long p;
     265         [ +  + ]:    4500785 :         for (p = 1; p < m; p++) /* m increases! */
     266                 :            :         {
     267                 :    3535595 :           long j = vo[ cy[p] ];
     268         [ +  + ]:    3535595 :           if (!F2v_coeff(bit,j)) cy[m++] = j;
     269                 :    3535595 :           F2v_set(bit,j);
     270                 :            :         }
     271                 :            :       }
     272         [ +  + ]:     964270 :       if (m == mold) break;
     273                 :     446910 :       k += m - mold;
     274                 :     446910 :     }
     275                 :     517360 :     setlg(cy, m); gel(cycle,l++) = cy;
     276                 :            :   }
     277                 :      35620 :   setlg(cycle, l); return cycle;
     278                 :            : }
     279                 :            : /* memory clean version */
     280                 :            : GEN
     281                 :        390 : vecperm_orbits(GEN v, long n)
     282                 :            : {
     283                 :        390 :   pari_sp av = avma;
     284                 :        390 :   return gerepilecopy(av, vecperm_orbits_i(v, n));
     285                 :            : }
     286                 :            : 
     287                 :            : /* Compute the cyclic decomposition of a permutation */
     288                 :            : GEN
     289                 :       6030 : perm_cycles(GEN v)
     290                 :            : {
     291                 :       6030 :   pari_sp av = avma;
     292                 :       6030 :   return gerepilecopy(av, vecperm_orbits_i(mkvec(v), lg(v)-1));
     293                 :            : }
     294                 :            : 
     295                 :            : /* Output the order of p */
     296                 :            : long
     297                 :      29200 : perm_order(GEN v)
     298                 :            : {
     299                 :      29200 :   pari_sp ltop = avma;
     300                 :      29200 :   GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
     301                 :            :   long i, d;
     302         [ +  + ]:     507005 :   for(i=1, d=1; i<lg(c); i++) d = clcm(d, lg(gel(c,i))-1);
     303                 :      29200 :   avma = ltop; return d;
     304                 :            : }
     305                 :            : 
     306                 :            : GEN
     307                 :        860 : cyc_pow(GEN cyc, long exp)
     308                 :            : {
     309                 :            :   long i, j, k, l, r;
     310                 :            :   GEN c;
     311         [ +  + ]:       3385 :   for (r = j = 1; j < lg(cyc); j++)
     312                 :            :   {
     313                 :       2525 :     long n = lg(gel(cyc,j)) - 1;
     314                 :       2525 :     r += cgcd(n, exp);
     315                 :            :   }
     316                 :        860 :   c = cgetg(r, t_VEC);
     317         [ +  + ]:       3385 :   for (r = j = 1; j < lg(cyc); j++)
     318                 :            :   {
     319                 :       2525 :     GEN v = gel(cyc,j);
     320                 :       2525 :     long n = lg(v) - 1, e = smodss(exp,n), g = (long)ugcd(n, e), m = n / g;
     321         [ +  + ]:       5570 :     for (i = 0; i < g; i++)
     322                 :            :     {
     323                 :       3045 :       GEN p = cgetg(m+1, t_VECSMALL);
     324                 :       3045 :       gel(c,r++) = p;
     325         [ +  + ]:      10400 :       for (k = 1, l = i; k <= m; k++)
     326                 :            :       {
     327                 :       7355 :         p[k] = v[l+1];
     328         [ +  + ]:       7355 :         l += e; if (l >= n) l -= n;
     329                 :            :       }
     330                 :            :     }
     331                 :            :   }
     332                 :        860 :   return c;
     333                 :            : }
     334                 :            : 
     335                 :            : /* Compute the power of a permutation given by product of cycles
     336                 :            :  * Ouput a perm, not a cyc */
     337                 :            : GEN
     338                 :       4020 : cyc_pow_perm(GEN cyc, long exp)
     339                 :            : {
     340                 :            :   long e, j, k, l, n;
     341                 :            :   GEN p;
     342         [ +  + ]:      35365 :   for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
     343                 :       4020 :   p = cgetg(n + 1, t_VECSMALL);
     344         [ +  + ]:      35365 :   for (j = 1; j < lg(cyc); j++)
     345                 :            :   {
     346                 :      31345 :     GEN v = gel(cyc,j);
     347                 :      31345 :     n = lg(v) - 1; e = smodss(exp, n);
     348         [ +  + ]:     111795 :     for (k = 1, l = e; k <= n; k++)
     349                 :            :     {
     350                 :      80450 :       p[v[k]] = v[l+1];
     351         [ +  + ]:      80450 :       if (++l == n) l = 0;
     352                 :            :     }
     353                 :            :   }
     354                 :       4020 :   return p;
     355                 :            : }
     356                 :            : 
     357                 :            : /* Compute the power of a permutation.
     358                 :            :  * TODO: make it more clever for small exp */
     359                 :            : GEN
     360                 :       4020 : perm_pow(GEN perm, long exp)
     361                 :            : {
     362                 :       4020 :   return cyc_pow_perm(perm_cycles(perm), exp);
     363                 :            : }
     364                 :            : 
     365                 :            : GEN
     366                 :         15 : perm_to_GAP(GEN p)
     367                 :            : {
     368                 :         15 :   pari_sp ltop=avma;
     369                 :            :   GEN gap;
     370                 :            :   GEN x;
     371                 :            :   long i;
     372                 :         15 :   long nb, c=0;
     373                 :            :   char *s;
     374                 :            :   long sz;
     375                 :         15 :   long lp=lg(p)-1;
     376         [ -  + ]:         15 :   if (typ(p) != t_VECSMALL)  pari_err_TYPE("perm_to_GAP",p);
     377                 :         15 :   x = perm_cycles(p);
     378 [ -  + ][ -  + ]:         15 :   sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
         [ -  + ][ -  + ]
     379                 :            :   /*Dry run*/
     380 [ +  + ][ +  + ]:         95 :   for (i = 1, nb = 1; i < lg(x); ++i)
     381                 :            :   {
     382                 :         80 :     GEN z = gel(x,i);
     383                 :         80 :     long lz = lg(z)-1;
     384                 :         80 :     nb += 1+lz*(sz+2);
     385                 :            :   }
     386                 :         15 :   nb++;
     387                 :            :   /*Real run*/
     388                 :         15 :   gap = cgetg(nchar2nlong(nb) + 1, t_STR);
     389                 :         15 :   s = GSTR(gap);
     390         [ +  + ]:         95 :   for (i = 1; i < lg(x); ++i)
     391                 :            :   {
     392                 :            :     long j;
     393                 :         80 :     GEN z = gel(x,i);
     394         [ +  - ]:         80 :     if (lg(z) > 2)
     395                 :            :     {
     396                 :         80 :       s[c++] = '(';
     397         [ +  + ]:        260 :       for (j = 1; j < lg(z); ++j)
     398                 :            :       {
     399         [ +  + ]:        180 :         if (j > 1)
     400                 :            :         {
     401                 :        100 :           s[c++] = ','; s[c++] = ' ';
     402                 :            :         }
     403                 :        180 :         sprintf(s+c,"%ld",z[j]);
     404         [ +  + ]:        405 :         while(s[c++]) /* empty */;
     405                 :        180 :         c--;
     406                 :            :       }
     407                 :         80 :       s[c++] = ')';
     408                 :            :     }
     409                 :            :   }
     410         [ -  + ]:         15 :   if (!c) { s[c++]='('; s[c++]=')'; }
     411                 :         15 :   s[c] = '\0';
     412                 :         15 :   return gerepileupto(ltop,gap);
     413                 :            : }
     414                 :            : 
     415                 :            : int
     416                 :     383345 : perm_commute(GEN s, GEN t)
     417                 :            : {
     418                 :     383345 :   long i, l = lg(t);
     419         [ +  + ]:   27410285 :   for (i = 1; i < l; i++)
     420         [ +  + ]:   27036750 :     if (t[ s[i] ] != s[ t[i] ]) return 0;
     421                 :     383345 :   return 1;
     422                 :            : }
     423                 :            : 
     424                 :            : /*************************************************************************/
     425                 :            : /**                                                                     **/
     426                 :            : /**                  Routines for handling groups                       **/
     427                 :            : /**                                                                     **/
     428                 :            : /*************************************************************************/
     429                 :            : /* A Group is a t_VEC [gen,orders]
     430                 :            :  * gen (vecvecsmall): list of generators given by permutations
     431                 :            :  * orders (vecsmall): relatives orders of generators. */
     432                 :     276385 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
     433                 :     474865 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
     434                 :            : 
     435                 :            : /* A Quotient Group is a t_VEC [gen,coset]
     436                 :            :  * gen (vecvecsmall): coset generators
     437                 :            :  * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
     438                 :            :  */
     439                 :      47205 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
     440                 :       7130 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
     441                 :            : 
     442                 :            : static GEN
     443                 :      19230 : trivialsubgroups(void)
     444                 :      19230 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
     445                 :            : 
     446                 :            : /* Compute the order of p modulo the group given by a set */
     447                 :            : long
     448                 :      79405 : perm_relorder(GEN p, GEN set)
     449                 :            : {
     450                 :      79405 :   pari_sp ltop = avma;
     451                 :      79405 :   long n = 1;
     452                 :      79405 :   long q = p[1];
     453         [ +  + ]:     225350 :   while (!F2v_coeff(set,q)) { q = p[q]; n++; }
     454                 :      79405 :   avma = ltop; return n;
     455                 :            : }
     456                 :            : 
     457                 :            : GEN
     458                 :       4895 : perm_generate(GEN S, GEN H, long o)
     459                 :            : {
     460                 :       4895 :   long i, n = lg(H)-1;
     461                 :       4895 :   GEN L = cgetg(n*o + 1, t_VEC);
     462         [ +  + ]:      18850 :   for(i=1; i<=n;     i++) gel(L,i) = vecsmall_copy(gel(H,i));
     463         [ +  + ]:      21900 :   for(   ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
     464                 :       4895 :   return L;
     465                 :            : }
     466                 :            : 
     467                 :            : /*Return the order (cardinal) of a group */
     468                 :            : long
     469                 :     205120 : group_order(GEN G)
     470                 :            : {
     471                 :     205120 :   return zv_prod(grp_get_ord(G));
     472                 :            : }
     473                 :            : 
     474                 :            : /* G being a subgroup of S_n, output n */
     475                 :            : long
     476                 :       3480 : group_domain(GEN G)
     477                 :            : {
     478                 :       3480 :   GEN gen = grp_get_gen(G);
     479         [ -  + ]:       3480 :   if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
     480                 :       3480 :   return lg(gel(gen,1)) - 1;
     481                 :            : }
     482                 :            : 
     483                 :            : /*Left coset of g mod G: gG*/
     484                 :            : GEN
     485                 :      91055 : group_leftcoset(GEN G, GEN g)
     486                 :            : {
     487                 :      91055 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     488                 :      91055 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     489                 :            :   long i, j, k;
     490                 :      91055 :   gel(res,1) = vecsmall_copy(g);
     491                 :      91055 :   k = 1;
     492         [ +  + ]:     170405 :   for (i = 1; i < lg(gen); i++)
     493                 :            :   {
     494                 :      79350 :     long c = k * (ord[i] - 1);
     495         [ +  + ]:     174455 :     for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
     496                 :            :   }
     497                 :      91055 :   return res;
     498                 :            : }
     499                 :            : /*Right coset of g mod G: Gg*/
     500                 :            : GEN
     501                 :      40975 : group_rightcoset(GEN G, GEN g)
     502                 :            : {
     503                 :      40975 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     504                 :      40975 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     505                 :            :   long i, j, k;
     506                 :      40975 :   gel(res,1) = vecsmall_copy(g);
     507                 :      40975 :   k = 1;
     508         [ +  + ]:      70165 :   for (i = 1; i < lg(gen); i++)
     509                 :            :   {
     510                 :      29190 :     long c = k * (ord[i] - 1);
     511         [ +  + ]:      72670 :     for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
     512                 :            :   }
     513                 :      40975 :   return res;
     514                 :            : }
     515                 :            : /*Elements of a group from the generators, cf group_leftcoset*/
     516                 :            : GEN
     517                 :      40175 : group_elts(GEN G, long n)
     518                 :            : {
     519                 :      40175 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     520                 :      40175 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     521                 :            :   long i, j, k;
     522                 :      40175 :   gel(res,1) = identity_perm(n);
     523                 :      40175 :   k = 1;
     524         [ +  + ]:      79000 :   for (i = 1; i < lg(gen); i++)
     525                 :            :   {
     526                 :      38825 :     long c = k * (ord[i] - 1);
     527                 :            :     /* j = 1, use res[1] = identity */
     528                 :      38825 :     gel(res,++k) = vecsmall_copy(gel(gen,i));
     529         [ +  + ]:     101285 :     for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
     530                 :            :   }
     531                 :      40175 :   return res;
     532                 :            : }
     533                 :            : 
     534                 :            : GEN
     535                 :       7590 : groupelts_set(GEN elts, long n)
     536                 :            : {
     537                 :       7590 :   GEN res = zero_F2v(n);
     538                 :       7590 :   long i, l = lg(elts);
     539         [ +  + ]:      41245 :   for(i=1; i<l; i++)
     540                 :      33655 :     F2v_set(res,mael(elts,i,1));
     541                 :       7590 :   return res;
     542                 :            : }
     543                 :            : 
     544                 :            : /*Elements of a group from the generators, returned as a set (bitmap)*/
     545                 :            : GEN
     546                 :      35785 : group_set(GEN G, long n)
     547                 :            : {
     548                 :      35785 :   GEN res = zero_F2v(n);
     549                 :      35785 :   pari_sp av = avma;
     550                 :      35785 :   GEN elts = group_elts(G, n);
     551                 :      35785 :   long i, l = lg(elts);
     552         [ +  + ]:     112220 :   for(i=1; i<l; i++)
     553                 :      76435 :     F2v_set(res,mael(elts,i,1));
     554                 :      35785 :   avma = av;
     555                 :      35785 :   return res;
     556                 :            : }
     557                 :            : 
     558                 :            : static int
     559                 :        895 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
     560                 :            : 
     561                 :            : GEN
     562                 :         10 : subgroups_tableset(GEN S, long n)
     563                 :            : {
     564                 :         10 :   long i, l = lg(S);
     565                 :         10 :   GEN  v = cgetg(l, t_VEC);
     566         [ +  + ]:        230 :   for(i=1; i<l; i++)
     567                 :        220 :     gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
     568                 :         10 :   gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
     569                 :         10 :   return v;
     570                 :            : }
     571                 :            : 
     572                 :            : long
     573                 :         45 : tableset_find_index(GEN tbl, GEN set)
     574                 :            : {
     575                 :         45 :   long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
     576         [ -  + ]:         45 :   if (!i) return 0;
     577                 :         45 :   return mael3(tbl,i,2,1);
     578                 :            : }
     579                 :            : 
     580                 :            : GEN
     581                 :      19230 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
     582                 :            : /*Cyclic group generated by g of order s*/
     583                 :            : GEN
     584                 :       2780 : cyclicgroup(GEN g, long s)
     585                 :       2780 : { retmkvec2(mkvec( vecsmall_copy(g) ),
     586                 :            :             mkvecsmall(s)); }
     587                 :            : /*Return the group generated by g1,g2 of relative orders s1,s2*/
     588                 :            : GEN
     589                 :         50 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
     590                 :         50 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
     591                 :            :              mkvecsmall2(s1, s2) ); }
     592                 :            : 
     593                 :            : /* return the quotient map G --> G/H */
     594                 :            : /*The ouput is [gen,hash]*/
     595                 :            : /* gen (vecvecsmall): coset generators
     596                 :            :  * coset (vecsmall): vecsmall of coset number) */
     597                 :            : GEN
     598                 :       2700 : group_quotient(GEN G, GEN H)
     599                 :            : {
     600                 :       2700 :   pari_sp ltop = avma;
     601                 :            :   GEN  p2, p3;
     602                 :       2700 :   long i, j, a = 1;
     603                 :       2700 :   long n = group_domain(G), o = group_order(H);
     604                 :       2700 :   GEN  elt = group_elts(G,n), el;
     605                 :       2700 :   long le = lg(elt)-1;
     606                 :       2700 :   GEN used = zero_F2v(le+1);
     607                 :       2700 :   long l = le/o;
     608                 :       2700 :   p2 = cgetg(l+1, t_VEC);
     609                 :       2700 :   p3 = zero_zv(n);
     610                 :       2700 :   el = zero_zv(n);
     611         [ +  + ]:      42920 :   for (i = 1; i<=le; i++)
     612                 :      40220 :     el[mael(elt,i,1)]=i;
     613         [ +  + ]:      22420 :   for (i = 1; i <= l; ++i)
     614                 :            :   {
     615                 :            :     GEN V;
     616         [ +  + ]:      52850 :     while(F2v_coeff(used,a)) a++;
     617                 :      19725 :     V = group_leftcoset(H,gel(elt,a));
     618                 :      19725 :     gel(p2,i) = gel(V,1);
     619         [ +  + ]:      59870 :     for(j=1;j<lg(V);j++)
     620                 :            :     {
     621                 :      40150 :       long b = el[mael(V,j,1)];
     622         [ +  + ]:      40150 :       if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
     623                 :      40145 :       F2v_set(used,b);
     624                 :            :     }
     625         [ +  + ]:      59860 :     for (j = 1; j <= o; j++)
     626                 :      40140 :       p3[mael(V, j, 1)] = i;
     627                 :            :   }
     628                 :       2695 :   return gerepilecopy(ltop,mkvec2(p2,p3));
     629                 :            : }
     630                 :            : 
     631                 :            : /*Compute the image of a permutation by a quotient map.*/
     632                 :            : GEN
     633                 :       7130 : quotient_perm(GEN C, GEN p)
     634                 :            : {
     635                 :       7130 :   GEN gen = quo_get_gen(C);
     636                 :       7130 :   GEN coset = quo_get_coset(C);
     637                 :       7130 :   long j, l = lg(gen);
     638                 :       7130 :   GEN p3 = cgetg(l, t_VECSMALL);
     639         [ +  + ]:      76325 :   for (j = 1; j < l; ++j)
     640                 :            :   {
     641                 :      69195 :     p3[j] = coset[p[mael(gen,j,1)]];
     642         [ -  + ]:      69195 :     if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
     643                 :            :   }
     644                 :       7130 :   return p3;
     645                 :            : }
     646                 :            : 
     647                 :            : /* H is a subgroup of G, C is the quotient map G --> G/H
     648                 :            :  *
     649                 :            :  * Lift a subgroup S of G/H to a subgroup of G containing H */
     650                 :            : GEN
     651                 :      18690 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
     652                 :            : {
     653                 :      18690 :   GEN genH = grp_get_gen(H);
     654                 :      18690 :   GEN genS = grp_get_gen(S);
     655                 :      18690 :   GEN genC = quo_get_gen(C);
     656                 :      18690 :   long l1 = lg(genH)-1;
     657                 :      18690 :   long l2 = lg(genS)-1, j;
     658                 :      18690 :   GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
     659         [ +  + ]:      37420 :   for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
     660         [ +  + ]:      49045 :   for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
     661                 :      18690 :   gel(p1,1) = L;
     662                 :      18690 :   gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
     663                 :      18690 :   return p1;
     664                 :            : }
     665                 :            : 
     666                 :            : /* Let G a group and C a quotient map G --> G/H
     667                 :            :  * Assume H is normal, return the group G/H */
     668                 :            : GEN
     669                 :       2695 : quotient_group(GEN C, GEN G)
     670                 :            : {
     671                 :       2695 :   pari_sp ltop = avma;
     672                 :            :   GEN Qgen, Qord, Qelt, Qset, Q;
     673                 :       2695 :   GEN Cgen = quo_get_gen(C);
     674                 :       2695 :   GEN Ggen = grp_get_gen(G);
     675                 :       2695 :   long i,j, n = lg(Cgen)-1, l = lg(Ggen);
     676                 :       2695 :   Qord = cgetg(l, t_VECSMALL);
     677                 :       2695 :   Qgen = cgetg(l, t_VEC);
     678                 :       2695 :   Qelt = mkvec(identity_perm(n));
     679                 :       2695 :   Qset = groupelts_set(Qelt, n);
     680         [ +  + ]:       9825 :   for (i = 1, j = 1; i < l; ++i)
     681                 :            :   {
     682                 :       7130 :     GEN  g = quotient_perm(C, gel(Ggen,i));
     683                 :       7130 :     long o = perm_relorder(g, Qset);
     684                 :       7130 :     gel(Qgen,j) = g;
     685                 :       7130 :     Qord[j] = o;
     686         [ +  + ]:       7130 :     if (o != 1)
     687                 :            :     {
     688                 :       4895 :       Qelt = perm_generate(g, Qelt, o);
     689                 :       4895 :       Qset = groupelts_set(Qelt, n);
     690                 :       4895 :       j++;
     691                 :            :     }
     692                 :            :   }
     693                 :       2695 :   setlg(Qgen,j);
     694                 :       2695 :   setlg(Qord,j); Q = mkvec2(Qgen, Qord);
     695                 :       2695 :   return gerepilecopy(ltop,Q);
     696                 :            : }
     697                 :            : 
     698                 :            : /* Return 1 if g normalizes N, 0 otherwise */
     699                 :            : long
     700                 :      40975 : group_perm_normalize(GEN N, GEN g)
     701                 :            : {
     702                 :      40975 :   pari_sp ltop = avma;
     703                 :      40975 :   long r = gequal(vecvecsmall_sort(group_leftcoset(N, g)),
     704                 :            :                   vecvecsmall_sort(group_rightcoset(N, g)));
     705                 :      40975 :   avma = ltop; return r;
     706                 :            : }
     707                 :            : 
     708                 :            : /* L is a list of subgroups, C is a coset and r a relative order.*/
     709                 :            : static GEN
     710                 :      30355 : liftlistsubgroups(GEN L, GEN C, long r)
     711                 :            : {
     712                 :      30355 :   pari_sp ltop = avma;
     713                 :      30355 :   long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
     714                 :            :   GEN R;
     715         [ +  + ]:      30355 :   if (!l) return cgetg(1,t_VEC);
     716                 :      25115 :   R = cgetg(l*c+1, t_VEC);
     717         [ +  + ]:      60670 :   for (i = 1, k = 1; i <= l; ++i)
     718                 :            :   {
     719                 :      35555 :     GEN S = gel(L,i), Selt = group_set(S,n);
     720                 :      35555 :     GEN gen = grp_get_gen(S);
     721                 :      35555 :     GEN ord = grp_get_ord(S);
     722                 :            :     long j;
     723         [ +  + ]:     107735 :     for (j = 1; j <= c; ++j)
     724                 :            :     {
     725                 :      72180 :       GEN p = gel(C,j);
     726 [ +  + ][ +  + ]:      72180 :       if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
     727                 :      39210 :         gel(R,k++) = mkvec2(vec_append(gen, p),
     728                 :            :                             vecsmall_append(ord, r));
     729                 :            :     }
     730                 :            :   }
     731                 :      25115 :   setlg(R, k);
     732                 :      30355 :   return gerepilecopy(ltop, R);
     733                 :            : }
     734                 :            : 
     735                 :            : /* H is a normal subgroup, C is the quotient map G -->G/H,
     736                 :            :  * S is a subgroup of G/H, and G is embedded in Sym(l)
     737                 :            :  * Return all the subgroups K of G such that
     738                 :            :  * S= K mod H and K inter H={1} */
     739                 :            : static GEN
     740                 :      18690 : liftsubgroup(GEN C, GEN H, GEN S)
     741                 :            : {
     742                 :      18690 :   pari_sp ltop = avma;
     743                 :      18690 :   GEN V = trivialsubgroups();
     744                 :      18690 :   GEN Sgen = grp_get_gen(S);
     745                 :      18690 :   GEN Sord = grp_get_ord(S);
     746                 :      18690 :   GEN Cgen = quo_get_gen(C);
     747                 :      18690 :   long n = lg(Sgen), i;
     748         [ +  + ]:      49045 :   for (i = 1; i < n; ++i)
     749                 :            :   { /*loop over generators of S*/
     750                 :      30355 :     GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
     751                 :      30355 :     V = liftlistsubgroups(V, W, Sord[i]);
     752                 :            :   }
     753                 :      18690 :   return gerepilecopy(ltop,V);
     754                 :            : }
     755                 :            : 
     756                 :            : /* 1:A4 2:S4 0: other */
     757                 :            : long
     758                 :       2570 : group_isA4S4(GEN G)
     759                 :            : {
     760                 :       2570 :   GEN elt = grp_get_gen(G);
     761                 :       2570 :   GEN ord = grp_get_ord(G);
     762                 :       2570 :   long n = lg(ord);
     763 [ +  + ][ +  + ]:       2570 :   if (n != 4 && n != 5) return 0;
     764 [ +  + ][ +  + ]:        905 :   if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
                 [ +  + ]
     765         [ -  + ]:         10 :   if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
     766         [ +  + ]:         10 :   if (n==4) return 1;
     767         [ -  + ]:          5 :   if (ord[4]!=2) return 0;
     768         [ -  + ]:          5 :   if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
     769                 :       2570 :   return 2;
     770                 :            : }
     771                 :            : /* compute all the subgroups of a group G */
     772                 :            : GEN
     773                 :       3110 : group_subgroups(GEN G)
     774                 :            : {
     775                 :       3110 :   pari_sp ltop = avma;
     776                 :            :   GEN p1, H, C, Q, M, sg1, sg2, sg3;
     777                 :       3110 :   GEN gen = grp_get_gen(G);
     778                 :       3110 :   GEN ord = grp_get_ord(G);
     779                 :       3110 :   long lM, i, j, n = lg(gen);
     780         [ +  + ]:       3110 :   if (n == 1) return trivialsubgroups();
     781         [ +  + ]:       2570 :   if (group_isA4S4(G))
     782                 :            :   {
     783                 :         10 :     GEN s = gel(gen,1);       /*s = (1,2)(3,4) */
     784                 :         10 :     GEN t = gel(gen,2);       /*t = (1,3)(2,4) */
     785                 :         10 :     GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
     786                 :         10 :     H = dicyclicgroup(s, t, 2, 2);
     787                 :            :     /* sg3 is the list of subgroups intersecting only partially with H*/
     788         [ +  + ]:         10 :     sg3 = cgetg((n==4)?4: 10, t_VEC);
     789                 :         10 :     gel(sg3,1) = cyclicgroup(s, 2);
     790                 :         10 :     gel(sg3,2) = cyclicgroup(t, 2);
     791                 :         10 :     gel(sg3,3) = cyclicgroup(st, 2);
     792         [ +  + ]:         10 :     if (n==5)
     793                 :            :     {
     794                 :          5 :       GEN u = gel(gen,3);
     795                 :          5 :       GEN v = gel(gen,4), w, u2;
     796         [ +  - ]:          5 :       if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
     797                 :          5 :         u2 = perm_mul(u,u);
     798                 :            :       else
     799                 :            :       {
     800                 :          0 :         u2 = u;
     801                 :          0 :         u = perm_mul(u,u);
     802                 :            :       }
     803         [ +  - ]:          5 :       if (perm_order(v)==2)
     804                 :            :       {
     805         [ -  + ]:          5 :         if (!perm_commute(s,v)) /*v=(1,2)*/
     806                 :            :         {
     807                 :          0 :           v = perm_conj(u,v);
     808         [ #  # ]:          0 :           if (!perm_commute(s,v)) v = perm_conj(u,v);
     809                 :            :         }
     810                 :          5 :         w = perm_mul(v,t); /*w=(1,4,2,3)*/
     811                 :            :       }
     812                 :            :       else
     813                 :            :       {
     814                 :          0 :         w = v;
     815         [ #  # ]:          0 :         if (!zv_equal(perm_mul(w,w), s)) /*w=(1,4,2,3)*/
     816                 :            :         {
     817                 :          0 :           w = perm_conj(u,w);
     818         [ #  # ]:          0 :           if (!zv_equal(perm_mul(w,w), s)) w = perm_conj(u,w);
     819                 :            :         }
     820                 :          0 :         v = perm_mul(w,t); /*v=(1,2)*/
     821                 :            :       }
     822                 :          5 :       gel(sg3,4) = dicyclicgroup(s,v,2,2);
     823                 :          5 :       gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
     824                 :          5 :       gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
     825                 :          5 :       gel(sg3,7) = dicyclicgroup(s,w,2,2);
     826                 :          5 :       gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
     827                 :          5 :       gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
     828                 :            :     }
     829                 :            :   }
     830                 :            :   else
     831                 :            :   {
     832                 :       2560 :     long osig = mael(factoru(ord[1]), 1, 1);
     833                 :       2560 :     GEN sig = perm_pow(gel(gen,1), ord[1]/osig);
     834                 :       2560 :     H = cyclicgroup(sig,osig);
     835                 :       2560 :     sg3 = NULL;
     836                 :            :   }
     837                 :       2570 :   C = group_quotient(G,H);
     838                 :       2565 :   Q = quotient_group(C,G);
     839                 :       2565 :   M = group_subgroups(Q); lM = lg(M);
     840                 :            :   /* sg1 is the list of subgroups containing H*/
     841                 :       2560 :   sg1 = cgetg(lM, t_VEC);
     842         [ +  + ]:      21250 :   for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
     843                 :            :   /*sg2 is a list of lists of subgroups not intersecting with H*/
     844                 :       2560 :   sg2 = cgetg(lM, t_VEC);
     845                 :            :   /* Loop over all subgroups of G/H */
     846         [ +  + ]:      21250 :   for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
     847                 :       2560 :   p1 = concat(sg1, shallowconcat1(sg2));
     848         [ +  + ]:       2560 :   if (sg3)
     849                 :            :   {
     850                 :         10 :     p1 = concat(p1, sg3);
     851         [ +  + ]:         10 :     if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
     852         [ +  + ]:         20 :       for(j = 3; j <= 5; j++)
     853                 :            :       {
     854                 :         15 :         GEN c = gmael(p1,j,1);
     855         [ +  + ]:         15 :         if (!perm_commute(gel(c,1),gel(c,3)))
     856                 :            :         {
     857         [ +  + ]:         10 :           if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
     858                 :            :           else
     859                 :          5 :             perm_mul_inplace2(gel(c,2), gel(c,1));
     860                 :            :         }
     861                 :            :       }
     862                 :            :   }
     863                 :       3100 :   return gerepileupto(ltop,p1);
     864                 :            : }
     865                 :            : 
     866                 :            : /*return 1 if G is abelian, else 0*/
     867                 :            : long
     868                 :        365 : group_isabelian(GEN G)
     869                 :            : {
     870                 :        365 :   GEN g = grp_get_gen(G);
     871                 :        365 :   long i, j, n = lg(g);
     872         [ +  + ]:        755 :   for(i=2; i<n; i++)
     873         [ +  + ]:       1030 :     for(j=1; j<i; j++)
     874         [ +  + ]:        640 :       if (!perm_commute(gel(g,i), gel(g,j))) return 0;
     875                 :        365 :   return 1;
     876                 :            : }
     877                 :            : 
     878                 :            : /*If G is abelian, return its HNF matrix*/
     879                 :            : GEN
     880                 :        235 : group_abelianHNF(GEN G, GEN S)
     881                 :            : {
     882                 :        235 :   GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
     883                 :        235 :   long i, j, k, n = lg(g);
     884         [ +  + ]:        235 :   if (!group_isabelian(G)) return NULL;
     885         [ +  + ]:        185 :   if (n==1) return cgetg(1,t_MAT);
     886         [ +  + ]:        175 :   if (!S) S = group_elts(G, group_domain(G));
     887                 :        175 :   M = cgetg(n,t_MAT);
     888         [ +  + ]:        620 :   for(i=1; i<n; i++)
     889                 :            :   {
     890                 :        445 :     GEN P, C = cgetg(n,t_COL);
     891                 :        445 :     pari_sp av = avma;
     892                 :        445 :     gel(M,i) = C;
     893                 :        445 :     P = perm_pow(gel(g,i), o[i]);
     894         [ +  - ]:        645 :     for(j=1; j<lg(S); j++)
     895         [ +  + ]:        645 :       if (zv_equal(P, gel(S,j))) break;
     896                 :        445 :     avma = av;
     897         [ -  + ]:        445 :     if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
     898                 :        445 :     j--;
     899         [ +  + ]:        830 :     for(k=1; k<i; k++)
     900                 :            :     {
     901                 :        385 :       long q = j / o[k];
     902                 :        385 :       gel(C,k) = stoi(j - q*o[k]);
     903                 :        385 :       j = q;
     904                 :            :     }
     905                 :        445 :     gel(C,k) = stoi(o[i]);
     906         [ +  + ]:        830 :     for (k++; k<n; k++) gel(C,k) = gen_0;
     907                 :            :   }
     908                 :        235 :   return M;
     909                 :            : }
     910                 :            : 
     911                 :            : /*If G is abelian, return its abstract SNF matrix*/
     912                 :            : GEN
     913                 :        200 : group_abelianSNF(GEN G, GEN L)
     914                 :            : {
     915                 :        200 :   pari_sp ltop = avma;
     916                 :        200 :   GEN H = group_abelianHNF(G,L);
     917         [ +  + ]:        200 :   if (!H) return NULL;
     918                 :        200 :   return gerepileupto(ltop, smithclean( ZM_snf(H) ));
     919                 :            : }
     920                 :            : 
     921                 :            : GEN
     922                 :         30 : abelian_group(GEN v)
     923                 :            : {
     924                 :         30 :   long card = zv_prod(v), i, d = 1, l = lg(v);
     925                 :         30 :   GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
     926                 :         30 :   gel(G,1) = gen;
     927                 :         30 :   gel(G,2) = vecsmall_copy(v);
     928         [ +  + ]:         90 :   for(i=1; i<l; i++)
     929                 :            :   {
     930                 :         60 :     GEN p = cgetg(card+1, t_VECSMALL);
     931                 :         60 :     long o = v[i], u = d*(o-1), j, k, l;
     932                 :         60 :     gel(gen, i) = p;
     933                 :            :     /* The following loop is over-optimized. Remember that I wrote it for
     934                 :            :      * testpermutation. Something has survived... BA */
     935         [ +  + ]:        190 :     for(j=1;j<=card;)
     936                 :            :     {
     937         [ +  + ]:        700 :       for(k=1;k<o;k++)
     938         [ +  + ]:       1750 :         for(l=1;l<=d; l++,j++) p[j] = j+d;
     939         [ +  + ]:        650 :       for (l=1; l<=d; l++,j++) p[j] = j-u;
     940                 :            :     }
     941                 :         60 :     d += u;
     942                 :            :   }
     943                 :         30 :   return G;
     944                 :            : }
     945                 :            : 
     946                 :            : /*return 1 if H is a normal subgroup of G*/
     947                 :            : long
     948                 :         40 : group_subgroup_isnormal(GEN G, GEN H)
     949                 :            : {
     950                 :         40 :   GEN g = grp_get_gen(G);
     951                 :         40 :   long i, n = lg(g);
     952 [ +  + ][ -  + ]:         40 :   if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
     953                 :          0 :     pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
     954                 :            :                     strtoGENstr("domain(G)"), H);
     955         [ +  + ]:         90 :   for(i=1; i<n; i++)
     956         [ +  + ]:         65 :     if (!group_perm_normalize(H, gel(g,i))) return 0;
     957                 :         40 :   return 1;
     958                 :            : }
     959                 :            : 
     960                 :            : GEN
     961                 :        495 : groupelts_center(GEN S)
     962                 :            : {
     963                 :        495 :   pari_sp ltop = avma;
     964                 :        495 :   long i, j, n = lg(S)-1, l = n;
     965                 :        495 :   GEN V, elts = zero_F2v(n+1);
     966         [ +  + ]:      17835 :   for(i=1; i<=n; i++)
     967                 :            :   {
     968         [ +  + ]:      17340 :     if (F2v_coeff(elts,i)) { l--;  continue; }
     969         [ +  + ]:     389925 :     for(j=1; j<=n; j++)
     970         [ +  + ]:     382660 :       if (!perm_commute(gel(S,i),gel(S,j)))
     971                 :            :       {
     972                 :       9705 :         F2v_set(elts,i);
     973                 :       9705 :         F2v_set(elts,j); l--; break;
     974                 :            :       }
     975                 :            :   }
     976                 :        495 :   V = cgetg(l+1,t_VEC);
     977         [ +  + ]:      17835 :   for (i=1, j=1; i<=n ;i++)
     978         [ +  + ]:      17340 :     if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
     979                 :        495 :   return gerepileupto(ltop,V);
     980                 :            : }
     981                 :            : 
     982                 :            : /* S a list of generators */
     983                 :            : GEN
     984                 :          0 : groupelts_abelian_group(GEN S)
     985                 :            : {
     986                 :          0 :   pari_sp ltop = avma;
     987                 :            :   GEN Qgen, Qord, Qelt;
     988                 :          0 :   long i, j, n = lg(gel(S,1))-1, l = lg(S);
     989                 :          0 :   Qord = cgetg(l, t_VECSMALL);
     990                 :          0 :   Qgen = cgetg(l, t_VEC);
     991                 :          0 :   Qelt = mkvec(identity_perm(n));
     992         [ #  # ]:          0 :   for (i = 1, j = 1; i < l; ++i)
     993                 :            :   {
     994                 :          0 :     GEN  g = gel(S,i);
     995                 :          0 :     long o = perm_relorder(g, groupelts_set(Qelt, n));
     996                 :          0 :     gel(Qgen,j) = g;
     997                 :          0 :     Qord[j] = o;
     998         [ #  # ]:          0 :     if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
     999                 :            :   }
    1000                 :          0 :   setlg(Qgen,j);
    1001                 :          0 :   setlg(Qord,j);
    1002                 :          0 :   return gerepilecopy(ltop, mkvec2(Qgen, Qord));
    1003                 :            : }
    1004                 :            : 
    1005                 :            : GEN
    1006                 :         10 : group_export_GAP(GEN G)
    1007                 :            : {
    1008                 :         10 :   pari_sp av = avma;
    1009                 :         10 :   GEN s, comma, g = grp_get_gen(G);
    1010                 :         10 :   long i, k, l = lg(g);
    1011         [ +  + ]:         10 :   if (l == 1) return strtoGENstr("Group(())");
    1012                 :          5 :   s = cgetg(2*l, t_VEC);
    1013                 :          5 :   comma = strtoGENstr(", ");
    1014                 :          5 :   gel(s,1) = strtoGENstr("Group(");
    1015         [ +  + ]:         20 :   for (i=1, k=2; i < l; ++i)
    1016                 :            :   {
    1017         [ +  + ]:         15 :     if (i > 1) gel(s,k++) = comma;
    1018                 :         15 :     gel(s,k++) = perm_to_GAP(gel(g,i));
    1019                 :            :   }
    1020                 :          5 :   gel(s,k++) = strtoGENstr(")");
    1021                 :         10 :   return gerepilecopy(av, shallowconcat1(s));
    1022                 :            : }
    1023                 :            : 
    1024                 :            : GEN
    1025                 :         10 : group_export_MAGMA(GEN G)
    1026                 :            : {
    1027                 :         10 :   pari_sp av = avma;
    1028                 :         10 :   GEN s, comma, g = grp_get_gen(G);
    1029                 :         10 :   long i, k, l = lg(g);
    1030         [ +  + ]:         10 :   if (l == 1) return strtoGENstr("PermutationGroup<1|>");
    1031                 :          5 :   s = cgetg(2*l, t_VEC);
    1032                 :          5 :   comma = strtoGENstr(", ");
    1033                 :          5 :   gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
    1034         [ +  + ]:         20 :   for (i=1, k=2; i < l; ++i)
    1035                 :            :   {
    1036         [ +  + ]:         15 :     if (i > 1) gel(s,k++) = comma;
    1037                 :         15 :     gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
    1038                 :            :   }
    1039                 :          5 :   gel(s,k++) = strtoGENstr(">");
    1040                 :         10 :   return gerepilecopy(av, shallowconcat1(s));
    1041                 :            : }
    1042                 :            : 
    1043                 :            : GEN
    1044                 :         20 : group_export(GEN G, long format)
    1045                 :            : {
    1046      [ +  +  - ]:         20 :   switch(format)
    1047                 :            :   {
    1048                 :         10 :   case 0: return group_export_GAP(G);
    1049                 :         10 :   case 1: return group_export_MAGMA(G);
    1050                 :            :   }
    1051                 :          0 :   pari_err_FLAG("galoisexport");
    1052                 :         20 :   return NULL; /*-Wall*/
    1053                 :            : }

Generated by: LCOV version 1.9