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.0 lcov report (development 23011-59c7027a2) Lines: 652 699 93.3 %
Date: 2018-09-22 05:37:52 Functions: 75 79 94.9 %
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        5784 : vec_isconst(GEN v)
      24             : {
      25        5784 :   long i, l = lg(v);
      26             :   GEN w;
      27        5784 :   if (l==1) return 1;
      28        5784 :   w = gel(v,1);
      29       13030 :   for(i=2;i<l;i++)
      30       11083 :     if (!gequal(gel(v,i), w)) return 0;
      31        1947 :   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        2731 : vec_is1to1(GEN v)
      38             : {
      39        2731 :   long i, j, l = lg(v);
      40       16922 :   for (i=1; i<l; i++)
      41             :   {
      42       14331 :     GEN w = gel(v,i);
      43       91801 :     for(j=i+1; j<l; j++)
      44       77610 :       if (gequal(gel(v,j), w)) return 0;
      45             :   }
      46        2591 :   return 1;
      47             : }
      48             : 
      49             : GEN
      50       97538 : vec_insert(GEN v, long n, GEN x)
      51             : {
      52       97538 :   long i, l=lg(v);
      53       97538 :   GEN V = cgetg(l+1,t_VEC);
      54       97538 :   for(i=1; i<n; i++) gel(V,i) = gel(v,i);
      55       97538 :   gel(V,n) = x;
      56       97538 :   for(i=n+1; i<=l; i++) gel(V,i) = gel(v,i-1);
      57       97538 :   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    97267337 : vecsmall_sortspec(GEN v, long n, GEN w)
      68             : {
      69    97267337 :   pari_sp ltop=avma;
      70    97267337 :   long nx=n>>1, ny=n-nx;
      71             :   long m, ix, iy;
      72             :   GEN x, y;
      73    97267337 :   if (n<=2)
      74             :   {
      75    54737701 :     if (n==1)
      76    10694341 :       w[0]=v[0];
      77    44043360 :     else if (n==2)
      78             :     {
      79    44043364 :       long v0=v[0], v1=v[1];
      80    44043364 :       if (v0<=v1) { w[0]=v0; w[1]=v1; }
      81     1871934 :       else        { w[0]=v1; w[1]=v0; }
      82             :     }
      83    54737701 :     return;
      84             :   }
      85    42529636 :   x=new_chunk(nx); y=new_chunk(ny);
      86    42529638 :   vecsmall_sortspec(v,nx,x);
      87    42529638 :   vecsmall_sortspec(v+nx,ny,y);
      88   228794087 :   for (m=0, ix=0, iy=0; ix<nx && iy<ny; )
      89   143734809 :     if (x[ix]<=y[iy])
      90   120545947 :       w[m++]=x[ix++];
      91             :     else
      92    23188862 :       w[m++]=y[iy++];
      93    42529639 :   for(;ix<nx;) w[m++]=x[ix++];
      94    42529639 :   for(;iy<ny;) w[m++]=y[iy++];
      95    42529639 :   set_avma(ltop);
      96             : }
      97             : 
      98             : /*in place sort.*/
      99             : void
     100    18153456 : vecsmall_sort(GEN V)
     101             : {
     102    18153456 :   long l = lg(V)-1;
     103    18153456 :   if (l<=1) return;
     104    12208064 :   vecsmall_sortspec(V+1,l,V+1);
     105             : }
     106             : 
     107             : /* cf gen_sortspec */
     108             : static GEN
     109    21085570 : vecsmall_indexsortspec(GEN v, long n)
     110             : {
     111             :   long nx, ny, m, ix, iy;
     112             :   GEN x, y, w;
     113    21085570 :   switch(n)
     114             :   {
     115       50099 :     case 1: return mkvecsmall(1);
     116     5574782 :     case 2: return (v[1] <= v[2])? mkvecsmall2(1,2): mkvecsmall2(2,1);
     117             :     case 3:
     118     6368893 :       if (v[1] <= v[2]) {
     119     5458476 :         if (v[2] <= v[3]) return mkvecsmall3(1,2,3);
     120     1116461 :         return (v[1] <= v[3])? mkvecsmall3(1,3,2)
     121     1116461 :                              : mkvecsmall3(3,1,2);
     122             :       } else {
     123      910417 :         if (v[1] <= v[3]) return mkvecsmall3(2,1,3);
     124      643857 :         return (v[2] <= v[3])? mkvecsmall3(2,3,1)
     125      643857 :                              : mkvecsmall3(3,2,1);
     126             :       }
     127             :   }
     128     9091796 :   nx = n>>1; ny = n-nx;
     129     9091796 :   w = cgetg(n+1,t_VECSMALL);
     130     9091796 :   x = vecsmall_indexsortspec(v,nx);
     131     9091796 :   y = vecsmall_indexsortspec(v+nx,ny);
     132   156637466 :   for (m=1, ix=1, iy=1; ix<=nx && iy<=ny; )
     133   138453874 :     if (v[x[ix]] <= v[y[iy]+nx])
     134    89916416 :       w[m++] = x[ix++];
     135             :     else
     136    48537458 :       w[m++] = y[iy++]+nx;
     137     9091796 :   for(;ix<=nx;) w[m++] = x[ix++];
     138     9091796 :   for(;iy<=ny;) w[m++] = y[iy++]+nx;
     139     9091796 :   avma = (pari_sp)w; return w;
     140             : }
     141             : 
     142             : /*indirect sort.*/
     143             : GEN
     144     2902041 : vecsmall_indexsort(GEN V)
     145             : {
     146     2902041 :   long l=lg(V)-1;
     147     2902041 :   if (l==0) return cgetg(1, t_VECSMALL);
     148     2901978 :   return vecsmall_indexsortspec(V,l);
     149             : }
     150             : 
     151             : /* assume V sorted */
     152             : GEN
     153        1449 : vecsmall_uniq_sorted(GEN V)
     154             : {
     155             :   GEN W;
     156        1449 :   long i,j, l = lg(V);
     157        1449 :   if (l == 1) return vecsmall_copy(V);
     158        1428 :   W = cgetg(l,t_VECSMALL);
     159        1428 :   W[1] = V[1];
     160        2737 :   for(i=j=2; i<l; i++)
     161        1309 :     if (V[i] != W[j-1]) W[j++] = V[i];
     162        1428 :   stackdummy((pari_sp)(W + l), (pari_sp)(W + j));
     163        1428 :   setlg(W, j); return W;
     164             : }
     165             : 
     166             : GEN
     167        1372 : vecsmall_uniq(GEN V)
     168             : {
     169        1372 :   pari_sp av = avma;
     170        1372 :   V = zv_copy(V); vecsmall_sort(V);
     171        1372 :   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       14432 : vecsmall_duplicate(GEN x)
     187             : {
     188       14432 :   pari_sp av=avma;
     189       14432 :   GEN p=vecsmall_indexsort(x);
     190       14432 :   long k,i,r=0,l=lg(x);
     191       14432 :   if (l==1) return 0;
     192       19631 :   for (k=x[p[1]],i=2; i<l; k=x[p[i++]])
     193        5199 :     if (x[p[i]] == k) { r=p[i]; break; }
     194       14432 :   set_avma(av);
     195       14432 :   return r;
     196             : }
     197             : 
     198             : /*************************************************************************/
     199             : /**                                                                     **/
     200             : /**             Routines for handling vectors of VECSMALL               **/
     201             : /**                                                                     **/
     202             : /*************************************************************************/
     203             : 
     204             : GEN
     205      121072 : vecvecsmall_sort(GEN x)
     206             : {
     207      121072 :   return gen_sort(x, (void*)&vecsmall_lexcmp, cmp_nodata);
     208             : }
     209             : 
     210             : GEN
     211         392 : vecvecsmall_sort_uniq(GEN x)
     212             : {
     213         392 :   return gen_sort_uniq(x, (void*)&vecsmall_lexcmp, cmp_nodata);
     214             : }
     215             : 
     216             : GEN
     217          21 : vecvecsmall_indexsort(GEN x)
     218             : {
     219          21 :   return gen_indexsort(x, (void*)&vecsmall_lexcmp, cmp_nodata);
     220             : }
     221             : 
     222             : long
     223    19730179 : vecvecsmall_search(GEN x, GEN y, long flag)
     224             : {
     225    19730179 :   return gen_search(x,y,flag,(void*)vecsmall_prefixcmp, cmp_nodata);
     226             : }
     227             : 
     228             : /* assume x non empty */
     229             : long
     230         133 : vecvecsmall_max(GEN x)
     231             : {
     232         133 :   long i, l = lg(x), m = vecsmall_max(gel(x,1));
     233        1099 :   for (i = 2; i < l; i++)
     234             :   {
     235         966 :     long t = vecsmall_max(gel(x,i));
     236         966 :     if (t > m) m = t;
     237             :   }
     238         133 :   return m;
     239             : }
     240             : 
     241             : /*************************************************************************/
     242             : /**                                                                     **/
     243             : /**                  Routines for handling permutations                 **/
     244             : /**                                                                     **/
     245             : /*************************************************************************/
     246             : 
     247             : /* Permutations may be given by
     248             :  * perm (VECSMALL): a bijection from 1...n to 1...n i-->perm[i]
     249             :  * cyc (VEC of VECSMALL): a product of disjoint cycles. */
     250             : 
     251             : /* Multiply (compose) two permutations, putting the result in the second one. */
     252             : static void
     253           7 : perm_mul_inplace2(GEN s, GEN t)
     254             : {
     255           7 :   long i, l = lg(s);
     256           7 :   for (i = 1; i < l; i++) t[i] = s[t[i]];
     257           7 : }
     258             : 
     259             : /* Orbits of the subgroup generated by v on {1,..,n} */
     260             : static GEN
     261      573107 : vecperm_orbits_i(GEN v, long n)
     262             : {
     263      573107 :   long mj = 1, lv = lg(v), k, l;
     264      573107 :   GEN cycle = cgetg(n+1, t_VEC), bit = const_vecsmall(n, 0);
     265     4677353 :   for (k = 1, l = 1; k <= n;)
     266             :   {
     267     3531120 :     long m = 1;
     268     3531120 :     GEN cy = cgetg(n+1, t_VECSMALL);
     269     3531119 :     for (  ; bit[mj]; mj++) /*empty*/;
     270     3531119 :     k++; cy[m++] = mj;
     271     3531119 :     bit[mj++] = 1;
     272             :     for(;;)
     273     1627181 :     {
     274     5158300 :       long o, mold = m;
     275    10319605 :       for (o = 1; o < lv; o++)
     276             :       {
     277     5161305 :         GEN vo = gel(v,o);
     278             :         long p;
     279    19069985 :         for (p = 1; p < m; p++) /* m increases! */
     280             :         {
     281    13908680 :           long j = vo[ cy[p] ];
     282    13908680 :           if (!bit[j]) cy[m++] = j;
     283    13908680 :           bit[j] = 1;
     284             :         }
     285             :       }
     286     5158300 :       if (m == mold) break;
     287     1627181 :       k += m - mold;
     288             :     }
     289     3531119 :     setlg(cy, m); gel(cycle,l++) = cy;
     290             :   }
     291      573114 :   setlg(cycle, l); return cycle;
     292             : }
     293             : /* memory clean version */
     294             : GEN
     295         826 : vecperm_orbits(GEN v, long n)
     296             : {
     297         826 :   pari_sp av = avma;
     298         826 :   return gerepilecopy(av, vecperm_orbits_i(v, n));
     299             : }
     300             : 
     301             : /* Compute the cyclic decomposition of a permutation */
     302             : GEN
     303        4055 : perm_cycles(GEN v)
     304             : {
     305        4055 :   pari_sp av = avma;
     306        4055 :   return gerepilecopy(av, vecperm_orbits_i(mkvec(v), lg(v)-1));
     307             : }
     308             : 
     309             : static int
     310        1890 : isperm(GEN v)
     311             : {
     312        1890 :   pari_sp av = avma;
     313        1890 :   long i, n = lg(v)-1;
     314             :   GEN w;
     315        1890 :   if (typ(v) != t_VECSMALL) return 0;
     316        1890 :   w = zero_zv(n);
     317       12404 :   for (i=1; i<=n; i++)
     318             :   {
     319       10542 :     long d = v[i];
     320       10542 :     if (d < 1 || d > n || w[d]) return gc_bool(av,0);
     321       10514 :     w[d] = 1;
     322             :   }
     323        1862 :   return gc_bool(av,1);
     324             : }
     325             : 
     326             : /* Output the order of p */
     327             : long
     328      388920 : perm_order(GEN v)
     329             : {
     330      388920 :   pari_sp av = avma;
     331      388920 :   GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
     332             :   long i, d;
     333      388920 :   for(i=1, d=1; i<lg(c); i++) d = ulcm(d, lg(gel(c,i))-1);
     334      388920 :   return gc_long(av,d);
     335             : }
     336             : 
     337             : long
     338          91 : permorder(GEN v)
     339             : {
     340          91 :   if (!isperm(v)) pari_err_TYPE("permorder",v);
     341          84 :   return perm_order(v);
     342             : }
     343             : 
     344             : /* sign of a permutation */
     345             : long
     346      179308 : perm_sign(GEN v)
     347             : {
     348      179308 :   pari_sp av = avma;
     349      179308 :   GEN c = vecperm_orbits_i(mkvec(v), lg(v)-1);
     350      179317 :   long i, l = lg(c), s = 1;
     351     1535190 :   for (i = 1; i < l; i++)
     352     1355878 :     if (odd(lg(gel(c, i)))) s = -s;
     353      179312 :   return gc_long(av,s);
     354             : }
     355             : 
     356             : long
     357          98 : permsign(GEN v)
     358             : {
     359          98 :   if (!isperm(v)) pari_err_TYPE("permsign",v);
     360          84 :   return perm_sign(v);
     361             : }
     362             : 
     363             : GEN
     364        5915 : Z_to_perm(long n, GEN x)
     365             : {
     366             :   pari_sp av;
     367             :   ulong i, r;
     368        5915 :   GEN v = cgetg(n+1, t_VECSMALL);
     369        5915 :   if (n==0) return v;
     370        5908 :   uel(v,n) = 1; av = avma;
     371        5908 :   if (signe(x) <= 0) x = modii(x, mpfact(n));
     372       27146 :   for (r=n-1; r>=1; r--)
     373             :   {
     374             :     ulong a;
     375       21238 :     x = absdiviu_rem(x, n+1-r, &a);
     376       71687 :     for (i=r+1; i<=(ulong)n; i++)
     377       50449 :       if (uel(v,i) > a) uel(v,i)++;
     378       21238 :     uel(v,r) = a+1;
     379             :   }
     380        5908 :   set_avma(av); return v;
     381             : }
     382             : GEN
     383        5915 : numtoperm(long n, GEN x)
     384             : {
     385        5915 :   if (n < 0) pari_err_DOMAIN("numtoperm", "n", "<", gen_0, stoi(n));
     386        5915 :   if (typ(x) != t_INT) pari_err_TYPE("numtoperm",x);
     387        5915 :   return Z_to_perm(n, x);
     388             : }
     389             : 
     390             : /* destroys v */
     391             : static GEN
     392        1701 : perm_to_Z_inplace(GEN v)
     393             : {
     394        1701 :   long l = lg(v), i, r;
     395        1701 :   GEN x = gen_0;
     396        1701 :   if (!isperm(v)) pari_err_TYPE("permsign",v);
     397       10143 :   for (i = 1; i < l; i++)
     398             :   {
     399        8449 :     long vi = v[i];
     400        8449 :     if (vi <= 0) return NULL;
     401        8449 :     x = i==1 ? utoi(vi-1): addiu(muliu(x,l-i), vi-1);
     402       25396 :     for (r = i+1; r < l; r++)
     403       16947 :       if (v[r] > vi) v[r]--;
     404             :   }
     405        1694 :   return x;
     406             : }
     407             : GEN
     408        1680 : perm_to_Z(GEN v)
     409             : {
     410        1680 :   pari_sp av = avma;
     411        1680 :   GEN x = perm_to_Z_inplace(leafcopy(v));
     412        1680 :   if (!x) pari_err_TYPE("permtonum",v);
     413        1680 :   return gerepileuptoint(av, x);
     414             : }
     415             : GEN
     416        1708 : permtonum(GEN p)
     417             : {
     418        1708 :   pari_sp av = avma;
     419             :   GEN v, x;
     420        1708 :   switch(typ(p))
     421             :   {
     422        1680 :     case t_VECSMALL: return perm_to_Z(p);
     423             :     case t_VEC: case t_COL:
     424          21 :       if (RgV_is_ZV(p)) { v = ZV_to_zv(p); break; }
     425           7 :     default: pari_err_TYPE("permtonum",p); return NULL;
     426             :   }
     427          21 :   x = perm_to_Z_inplace(v);
     428          14 :   if (!x) pari_err_TYPE("permtonum",p);
     429          14 :   return gerepileuptoint(av, x);
     430             : }
     431             : 
     432             : 
     433             : GEN
     434        1891 : cyc_pow(GEN cyc, long exp)
     435             : {
     436             :   long i, j, k, l, r;
     437             :   GEN c;
     438        6344 :   for (r = j = 1; j < lg(cyc); j++)
     439             :   {
     440        4453 :     long n = lg(gel(cyc,j)) - 1;
     441        4453 :     r += cgcd(n, exp);
     442             :   }
     443        1891 :   c = cgetg(r, t_VEC);
     444        6344 :   for (r = j = 1; j < lg(cyc); j++)
     445             :   {
     446        4453 :     GEN v = gel(cyc,j);
     447        4453 :     long n = lg(v) - 1, e = smodss(exp,n), g = (long)ugcd(n, e), m = n / g;
     448        9725 :     for (i = 0; i < g; i++)
     449             :     {
     450        5272 :       GEN p = cgetg(m+1, t_VECSMALL);
     451        5272 :       gel(c,r++) = p;
     452       17790 :       for (k = 1, l = i; k <= m; k++)
     453             :       {
     454       12518 :         p[k] = v[l+1];
     455       12518 :         l += e; if (l >= n) l -= n;
     456             :       }
     457             :     }
     458             :   }
     459        1891 :   return c;
     460             : }
     461             : 
     462             : /* Compute the power of a permutation given by product of cycles
     463             :  * Ouput a perm, not a cyc */
     464             : GEN
     465           0 : cyc_pow_perm(GEN cyc, long exp)
     466             : {
     467             :   long e, j, k, l, n;
     468             :   GEN p;
     469           0 :   for (n = 0, j = 1; j < lg(cyc); j++) n += lg(gel(cyc,j))-1;
     470           0 :   p = cgetg(n + 1, t_VECSMALL);
     471           0 :   for (j = 1; j < lg(cyc); j++)
     472             :   {
     473           0 :     GEN v = gel(cyc,j);
     474           0 :     n = lg(v) - 1; e = smodss(exp, n);
     475           0 :     for (k = 1, l = e; k <= n; k++)
     476             :     {
     477           0 :       p[v[k]] = v[l+1];
     478           0 :       if (++l == n) l = 0;
     479             :     }
     480             :   }
     481           0 :   return p;
     482             : }
     483             : 
     484             : GEN
     485        8359 : perm_pow(GEN perm, long exp)
     486             : {
     487        8359 :   long i, r = lg(perm)-1;
     488        8359 :   GEN p = zero_zv(r);
     489        8359 :   pari_sp av = avma;
     490        8359 :   GEN v = cgetg(r+1, t_VECSMALL);
     491      142018 :   for (i=1; i<=r; i++)
     492             :   {
     493             :     long e, n, k, l;
     494      133659 :     if (p[i]) continue;
     495       50894 :     v[1] = i;
     496      133659 :     for (n=1, k=perm[i]; k!=i; k=perm[k], n++)
     497       82765 :       v[n+1] = k;
     498       50894 :     e = smodss(exp, n);
     499      184553 :     for (k = 1, l = e; k <= n; k++)
     500             :     {
     501      133659 :       p[v[k]] = v[l+1];
     502      133659 :       if (++l == n) l = 0;
     503             :     }
     504             :   }
     505        8359 :   set_avma(av); return p;
     506             : }
     507             : 
     508             : static GEN
     509          21 : perm_to_GAP(GEN p)
     510             : {
     511          21 :   pari_sp ltop=avma;
     512             :   GEN gap;
     513             :   GEN x;
     514             :   long i;
     515          21 :   long nb, c=0;
     516             :   char *s;
     517             :   long sz;
     518          21 :   long lp=lg(p)-1;
     519          21 :   if (typ(p) != t_VECSMALL)  pari_err_TYPE("perm_to_GAP",p);
     520          21 :   x = perm_cycles(p);
     521          21 :   sz = (long) ((bfffo(lp)+1) * LOG10_2 + 1);
     522             :   /*Dry run*/
     523         133 :   for (i = 1, nb = 1; i < lg(x); ++i)
     524             :   {
     525         112 :     GEN z = gel(x,i);
     526         112 :     long lz = lg(z)-1;
     527         112 :     nb += 1+lz*(sz+2);
     528             :   }
     529          21 :   nb++;
     530             :   /*Real run*/
     531          21 :   gap = cgetg(nchar2nlong(nb) + 1, t_STR);
     532          21 :   s = GSTR(gap);
     533         133 :   for (i = 1; i < lg(x); ++i)
     534             :   {
     535             :     long j;
     536         112 :     GEN z = gel(x,i);
     537         112 :     if (lg(z) > 2)
     538             :     {
     539         112 :       s[c++] = '(';
     540         364 :       for (j = 1; j < lg(z); ++j)
     541             :       {
     542         252 :         if (j > 1)
     543             :         {
     544         140 :           s[c++] = ','; s[c++] = ' ';
     545             :         }
     546         252 :         sprintf(s+c,"%ld",z[j]);
     547         252 :         while(s[c++]) /* empty */;
     548         252 :         c--;
     549             :       }
     550         112 :       s[c++] = ')';
     551             :     }
     552             :   }
     553          21 :   if (!c) { s[c++]='('; s[c++]=')'; }
     554          21 :   s[c] = '\0';
     555          21 :   return gerepileupto(ltop,gap);
     556             : }
     557             : 
     558             : int
     559      536711 : perm_commute(GEN s, GEN t)
     560             : {
     561      536711 :   long i, l = lg(t);
     562    38374455 :   for (i = 1; i < l; i++)
     563    37851499 :     if (t[ s[i] ] != s[ t[i] ]) return 0;
     564      522956 :   return 1;
     565             : }
     566             : 
     567             : /*************************************************************************/
     568             : /**                                                                     **/
     569             : /**                  Routines for handling groups                       **/
     570             : /**                                                                     **/
     571             : /*************************************************************************/
     572             : /* A Group is a t_VEC [gen,orders]
     573             :  * gen (vecvecsmall): list of generators given by permutations
     574             :  * orders (vecsmall): relatives orders of generators. */
     575      432699 : INLINE GEN grp_get_gen(GEN G) { return gel(G,1); }
     576      738551 : INLINE GEN grp_get_ord(GEN G) { return gel(G,2); }
     577             : 
     578             : /* A Quotient Group is a t_VEC [gen,coset]
     579             :  * gen (vecvecsmall): coset generators
     580             :  * coset (vecsmall): gen[coset[p[1]]] generate the p-coset.
     581             :  */
     582       76328 : INLINE GEN quo_get_gen(GEN C) { return gel(C,1); }
     583       12215 : INLINE GEN quo_get_coset(GEN C) { return gel(C,2); }
     584             : 
     585             : static GEN
     586       30744 : trivialsubgroups(void)
     587       30744 : { GEN L = cgetg(2, t_VEC); gel(L,1) = trivialgroup(); return L; }
     588             : 
     589             : /* Compute the order of p modulo the group given by a set */
     590             : long
     591      122906 : perm_relorder(GEN p, GEN set)
     592             : {
     593      122906 :   pari_sp ltop = avma;
     594      122906 :   long n = 1, q = p[1];
     595      122906 :   while (!F2v_coeff(set,q)) { q = p[q]; n++; }
     596      122906 :   return gc_long(ltop,n);
     597             : }
     598             : 
     599             : GEN
     600        8071 : perm_generate(GEN S, GEN H, long o)
     601             : {
     602        8071 :   long i, n = lg(H)-1;
     603        8071 :   GEN L = cgetg(n*o + 1, t_VEC);
     604        8071 :   for(i=1; i<=n;     i++) gel(L,i) = vecsmall_copy(gel(H,i));
     605        8071 :   for(   ; i <= n*o; i++) gel(L,i) = perm_mul(gel(L,i-n), S);
     606        8071 :   return L;
     607             : }
     608             : 
     609             : /*Return the order (cardinality) of a group */
     610             : long
     611      318550 : group_order(GEN G)
     612             : {
     613      318550 :   return zv_prod(grp_get_ord(G));
     614             : }
     615             : 
     616             : /* G being a subgroup of S_n, output n */
     617             : long
     618        6587 : group_domain(GEN G)
     619             : {
     620        6587 :   GEN gen = grp_get_gen(G);
     621        6587 :   if (lg(gen) < 2) pari_err_DOMAIN("group_domain", "#G", "=", gen_1,G);
     622        6587 :   return lg(gel(gen,1)) - 1;
     623             : }
     624             : 
     625             : /*Left coset of g mod G: gG*/
     626             : GEN
     627      136451 : group_leftcoset(GEN G, GEN g)
     628             : {
     629      136451 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     630      136451 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     631             :   long i, j, k;
     632      136451 :   gel(res,1) = vecsmall_copy(g);
     633      136451 :   k = 1;
     634      253652 :   for (i = 1; i < lg(gen); i++)
     635             :   {
     636      117201 :     long c = k * (ord[i] - 1);
     637      117201 :     for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
     638             :   }
     639      136451 :   return res;
     640             : }
     641             : /*Right coset of g mod G: Gg*/
     642             : GEN
     643       60480 : group_rightcoset(GEN G, GEN g)
     644             : {
     645       60480 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     646       60480 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     647             :   long i, j, k;
     648       60480 :   gel(res,1) = vecsmall_copy(g);
     649       60480 :   k = 1;
     650      101598 :   for (i = 1; i < lg(gen); i++)
     651             :   {
     652       41118 :     long c = k * (ord[i] - 1);
     653       41118 :     for (j = 1; j <= c; j++) gel(res,++k) = perm_mul(gel(gen,i), gel(res,j));
     654             :   }
     655       60480 :   return res;
     656             : }
     657             : /*Elements of a group from the generators, cf group_leftcoset*/
     658             : GEN
     659       70995 : group_elts(GEN G, long n)
     660             : {
     661       70995 :   GEN gen = grp_get_gen(G), ord = grp_get_ord(G);
     662       70995 :   GEN res = cgetg(group_order(G)+1, t_VEC);
     663             :   long i, j, k;
     664       70995 :   gel(res,1) = identity_perm(n);
     665       70995 :   k = 1;
     666      142992 :   for (i = 1; i < lg(gen); i++)
     667             :   {
     668       71997 :     long c = k * (ord[i] - 1);
     669             :     /* j = 1, use res[1] = identity */
     670       71997 :     gel(res,++k) = vecsmall_copy(gel(gen,i));
     671       71997 :     for (j = 2; j <= c; j++) gel(res,++k) = perm_mul(gel(res,j), gel(gen,i));
     672             :   }
     673       70995 :   return res;
     674             : }
     675             : 
     676             : GEN
     677       13188 : groupelts_set(GEN elts, long n)
     678             : {
     679       13188 :   GEN res = zero_F2v(n);
     680       13188 :   long i, l = lg(elts);
     681       65625 :   for(i=1; i<l; i++)
     682       52437 :     F2v_set(res,mael(elts,i,1));
     683       13188 :   return res;
     684             : }
     685             : 
     686             : /*Elements of a group from the generators, returned as a set (bitmap)*/
     687             : GEN
     688       58338 : group_set(GEN G, long n)
     689             : {
     690       58338 :   GEN res = zero_F2v(n);
     691       58338 :   pari_sp av = avma;
     692       58338 :   GEN elts = group_elts(G, n);
     693       58338 :   long i, l = lg(elts);
     694      189203 :   for(i=1; i<l; i++)
     695      130865 :     F2v_set(res,mael(elts,i,1));
     696       58338 :   set_avma(av);
     697       58338 :   return res;
     698             : }
     699             : 
     700             : static int
     701       17206 : sgcmp(GEN a, GEN b) { return vecsmall_lexcmp(gel(a,1),gel(b,1)); }
     702             : 
     703             : GEN
     704         490 : subgroups_tableset(GEN S, long n)
     705             : {
     706         490 :   long i, l = lg(S);
     707         490 :   GEN  v = cgetg(l, t_VEC);
     708        5390 :   for(i=1; i<l; i++)
     709        4900 :     gel(v,i) = mkvec2(group_set(gel(S,i), n), mkvecsmall(i));
     710         490 :   gen_sort_inplace(v,(void*)sgcmp,cmp_nodata, NULL);
     711         490 :   return v;
     712             : }
     713             : 
     714             : long
     715        1981 : tableset_find_index(GEN tbl, GEN set)
     716             : {
     717        1981 :   long i = tablesearch(tbl,mkvec2(set,mkvecsmall(0)),sgcmp);
     718        1981 :   if (!i) return 0;
     719        1981 :   return mael3(tbl,i,2,1);
     720             : }
     721             : 
     722             : GEN
     723       30744 : trivialgroup(void) { retmkvec2(cgetg(1,t_VEC), cgetg(1,t_VECSMALL)); }
     724             : /*Cyclic group generated by g of order s*/
     725             : GEN
     726        7049 : cyclicgroup(GEN g, long s)
     727        7049 : { retmkvec2(mkvec( vecsmall_copy(g) ),
     728             :             mkvecsmall(s)); }
     729             : /*Return the group generated by g1,g2 of relative orders s1,s2*/
     730             : GEN
     731         973 : dicyclicgroup(GEN g1, GEN g2, long s1, long s2)
     732         973 : { retmkvec2( mkvec2(vecsmall_copy(g1), vecsmall_copy(g2)),
     733             :              mkvecsmall2(s1, s2) ); }
     734             : 
     735             : /* return the quotient map G --> G/H */
     736             : /*The ouput is [gen,hash]*/
     737             : /* gen (vecvecsmall): coset generators
     738             :  * coset (vecsmall): vecsmall of coset number) */
     739             : GEN
     740        5124 : group_quotient(GEN G, GEN H)
     741             : {
     742        5124 :   pari_sp ltop = avma;
     743             :   GEN  p2, p3;
     744        5124 :   long i, j, a = 1;
     745        5124 :   long n = group_domain(G), o = group_order(H);
     746        5124 :   GEN  elt = group_elts(G,n), el;
     747        5124 :   long le = lg(elt)-1;
     748        5124 :   GEN used = zero_F2v(le+1);
     749        5124 :   long l = le/o;
     750        5124 :   p2 = cgetg(l+1, t_VEC);
     751        5124 :   p3 = zero_zv(n);
     752        5124 :   el = zero_zv(n);
     753       69160 :   for (i = 1; i<=le; i++)
     754       64036 :     el[mael(elt,i,1)]=i;
     755       36204 :   for (i = 1; i <= l; ++i)
     756             :   {
     757             :     GEN V;
     758       31087 :     while(F2v_coeff(used,a)) a++;
     759       31087 :     V = group_leftcoset(H,gel(elt,a));
     760       31087 :     gel(p2,i) = gel(V,1);
     761       95018 :     for(j=1;j<lg(V);j++)
     762             :     {
     763       63938 :       long b = el[mael(V,j,1)];
     764       63938 :       if (b==0) pari_err_IMPL("group_quotient for a non-WSS group");
     765       63931 :       F2v_set(used,b);
     766             :     }
     767       95004 :     for (j = 1; j <= o; j++)
     768       63924 :       p3[mael(V, j, 1)] = i;
     769             :   }
     770        5117 :   return gerepilecopy(ltop,mkvec2(p2,p3));
     771             : }
     772             : 
     773             : /*Compute the image of a permutation by a quotient map.*/
     774             : GEN
     775       12215 : quotient_perm(GEN C, GEN p)
     776             : {
     777       12215 :   GEN gen = quo_get_gen(C);
     778       12215 :   GEN coset = quo_get_coset(C);
     779       12215 :   long j, l = lg(gen);
     780       12215 :   GEN p3 = cgetg(l, t_VECSMALL);
     781      115850 :   for (j = 1; j < l; ++j)
     782             :   {
     783      103635 :     p3[j] = coset[p[mael(gen,j,1)]];
     784      103635 :     if (p3[j]==0) pari_err_IMPL("quotient_perm for a non-WSS group");
     785             :   }
     786       12215 :   return p3;
     787             : }
     788             : 
     789             : /* H is a subgroup of G, C is the quotient map G --> G/H
     790             :  *
     791             :  * Lift a subgroup S of G/H to a subgroup of G containing H */
     792             : GEN
     793       29498 : quotient_subgroup_lift(GEN C, GEN H, GEN S)
     794             : {
     795       29498 :   GEN genH = grp_get_gen(H);
     796       29498 :   GEN genS = grp_get_gen(S);
     797       29498 :   GEN genC = quo_get_gen(C);
     798       29498 :   long l1 = lg(genH)-1;
     799       29498 :   long l2 = lg(genS)-1, j;
     800       29498 :   GEN p1 = cgetg(3, t_VEC), L = cgetg(l1+l2+1, t_VEC);
     801       29498 :   for (j = 1; j <= l1; ++j) gel(L,j) = gel(genH,j);
     802       29498 :   for (j = 1; j <= l2; ++j) gel(L,l1+j) = gel(genC, mael(genS,j,1));
     803       29498 :   gel(p1,1) = L;
     804       29498 :   gel(p1,2) = vecsmall_concat(grp_get_ord(H), grp_get_ord(S));
     805       29498 :   return p1;
     806             : }
     807             : 
     808             : /* Let G a group and C a quotient map G --> G/H
     809             :  * Assume H is normal, return the group G/H */
     810             : GEN
     811        5117 : quotient_group(GEN C, GEN G)
     812             : {
     813        5117 :   pari_sp ltop = avma;
     814             :   GEN Qgen, Qord, Qelt, Qset, Q;
     815        5117 :   GEN Cgen = quo_get_gen(C);
     816        5117 :   GEN Ggen = grp_get_gen(G);
     817        5117 :   long i,j, n = lg(Cgen)-1, l = lg(Ggen);
     818        5117 :   Qord = cgetg(l, t_VECSMALL);
     819        5117 :   Qgen = cgetg(l, t_VEC);
     820        5117 :   Qelt = mkvec(identity_perm(n));
     821        5117 :   Qset = groupelts_set(Qelt, n);
     822       17332 :   for (i = 1, j = 1; i < l; ++i)
     823             :   {
     824       12215 :     GEN  g = quotient_perm(C, gel(Ggen,i));
     825       12215 :     long o = perm_relorder(g, Qset);
     826       12215 :     gel(Qgen,j) = g;
     827       12215 :     Qord[j] = o;
     828       12215 :     if (o != 1)
     829             :     {
     830        8071 :       Qelt = perm_generate(g, Qelt, o);
     831        8071 :       Qset = groupelts_set(Qelt, n);
     832        8071 :       j++;
     833             :     }
     834             :   }
     835        5117 :   setlg(Qgen,j);
     836        5117 :   setlg(Qord,j); Q = mkvec2(Qgen, Qord);
     837        5117 :   return gerepilecopy(ltop,Q);
     838             : }
     839             : 
     840             : /* Return 1 if g normalizes N, 0 otherwise */
     841             : long
     842       60480 : group_perm_normalize(GEN N, GEN g)
     843             : {
     844       60480 :   pari_sp ltop = avma;
     845       60480 :   long r = gequal(vecvecsmall_sort(group_leftcoset(N, g)),
     846             :                   vecvecsmall_sort(group_rightcoset(N, g)));
     847       60480 :   return gc_long(ltop, r);
     848             : }
     849             : 
     850             : /* L is a list of subgroups, C is a coset and r a relative order.*/
     851             : static GEN
     852       44884 : liftlistsubgroups(GEN L, GEN C, long r)
     853             : {
     854       44884 :   pari_sp ltop = avma;
     855       44884 :   long c = lg(C)-1, l = lg(L)-1, n = lg(gel(C,1))-1, i, k;
     856             :   GEN R;
     857       44884 :   if (!l) return cgetg(1,t_VEC);
     858       37443 :   R = cgetg(l*c+1, t_VEC);
     859       89565 :   for (i = 1, k = 1; i <= l; ++i)
     860             :   {
     861       52122 :     GEN S = gel(L,i), Selt = group_set(S,n);
     862       52122 :     GEN gen = grp_get_gen(S);
     863       52122 :     GEN ord = grp_get_ord(S);
     864             :     long j;
     865      158270 :     for (j = 1; j <= c; ++j)
     866             :     {
     867      106148 :       GEN p = gel(C,j);
     868      106148 :       if (perm_relorder(p, Selt) == r && group_perm_normalize(S, p))
     869       58275 :         gel(R,k++) = mkvec2(vec_append(gen, p),
     870             :                             vecsmall_append(ord, r));
     871             :     }
     872             :   }
     873       37443 :   setlg(R, k);
     874       37443 :   return gerepilecopy(ltop, R);
     875             : }
     876             : 
     877             : /* H is a normal subgroup, C is the quotient map G -->G/H,
     878             :  * S is a subgroup of G/H, and G is embedded in Sym(l)
     879             :  * Return all the subgroups K of G such that
     880             :  * S= K mod H and K inter H={1} */
     881             : static GEN
     882       29498 : liftsubgroup(GEN C, GEN H, GEN S)
     883             : {
     884       29498 :   pari_sp ltop = avma;
     885       29498 :   GEN V = trivialsubgroups();
     886       29498 :   GEN Sgen = grp_get_gen(S);
     887       29498 :   GEN Sord = grp_get_ord(S);
     888       29498 :   GEN Cgen = quo_get_gen(C);
     889       29498 :   long n = lg(Sgen), i;
     890       74382 :   for (i = 1; i < n; ++i)
     891             :   { /*loop over generators of S*/
     892       44884 :     GEN W = group_leftcoset(H, gel(Cgen, mael(Sgen, i, 1)));
     893       44884 :     V = liftlistsubgroups(V, W, Sord[i]);
     894             :   }
     895       29498 :   return gerepilecopy(ltop,V);
     896             : }
     897             : 
     898             : /* 1:A4 2:S4 0: other */
     899             : long
     900        4942 : group_isA4S4(GEN G)
     901             : {
     902        4942 :   GEN elt = grp_get_gen(G);
     903        4942 :   GEN ord = grp_get_ord(G);
     904        4942 :   long n = lg(ord);
     905        4942 :   if (n != 4 && n != 5) return 0;
     906        1330 :   if (ord[1]!=2 || ord[2]!=2 || ord[3]!=3) return 0;
     907          14 :   if (perm_commute(gel(elt,1),gel(elt,3))) return 0;
     908          14 :   if (n==4) return 1;
     909           7 :   if (ord[4]!=2) return 0;
     910           7 :   if (perm_commute(gel(elt,3),gel(elt,4))) return 0;
     911           7 :   return 2;
     912             : }
     913             : /* compute all the subgroups of a group G */
     914             : GEN
     915        6188 : group_subgroups(GEN G)
     916             : {
     917        6188 :   pari_sp ltop = avma;
     918             :   GEN p1, H, C, Q, M, sg1, sg2, sg3;
     919        6188 :   GEN gen = grp_get_gen(G);
     920        6188 :   GEN ord = grp_get_ord(G);
     921        6188 :   long lM, i, j, n = lg(gen);
     922        6188 :   if (n == 1) return trivialsubgroups();
     923        4942 :   if (group_isA4S4(G))
     924             :   {
     925          14 :     GEN s = gel(gen,1);       /*s = (1,2)(3,4) */
     926          14 :     GEN t = gel(gen,2);       /*t = (1,3)(2,4) */
     927          14 :     GEN st = perm_mul(s, t); /*st = (1,4)(2,3) */
     928          14 :     H = dicyclicgroup(s, t, 2, 2);
     929             :     /* sg3 is the list of subgroups intersecting only partially with H*/
     930          14 :     sg3 = cgetg((n==4)?4: 10, t_VEC);
     931          14 :     gel(sg3,1) = cyclicgroup(s, 2);
     932          14 :     gel(sg3,2) = cyclicgroup(t, 2);
     933          14 :     gel(sg3,3) = cyclicgroup(st, 2);
     934          14 :     if (n==5)
     935             :     {
     936           7 :       GEN u = gel(gen,3);
     937           7 :       GEN v = gel(gen,4), w, u2;
     938           7 :       if (zv_equal(perm_conj(u,s), t)) /*u=(2,3,4)*/
     939           7 :         u2 = perm_mul(u,u);
     940             :       else
     941             :       {
     942           0 :         u2 = u;
     943           0 :         u = perm_mul(u,u);
     944             :       }
     945           7 :       if (perm_order(v)==2)
     946             :       {
     947           7 :         if (!perm_commute(s,v)) /*v=(1,2)*/
     948             :         {
     949           0 :           v = perm_conj(u,v);
     950           0 :           if (!perm_commute(s,v)) v = perm_conj(u,v);
     951             :         }
     952           7 :         w = perm_mul(v,t); /*w=(1,4,2,3)*/
     953             :       }
     954             :       else
     955             :       {
     956           0 :         w = v;
     957           0 :         if (!zv_equal(perm_mul(w,w), s)) /*w=(1,4,2,3)*/
     958             :         {
     959           0 :           w = perm_conj(u,w);
     960           0 :           if (!zv_equal(perm_mul(w,w), s)) w = perm_conj(u,w);
     961             :         }
     962           0 :         v = perm_mul(w,t); /*v=(1,2)*/
     963             :       }
     964           7 :       gel(sg3,4) = dicyclicgroup(s,v,2,2);
     965           7 :       gel(sg3,5) = dicyclicgroup(t,perm_conj(u,v),2,2);
     966           7 :       gel(sg3,6) = dicyclicgroup(st,perm_conj(u2,v),2,2);
     967           7 :       gel(sg3,7) = dicyclicgroup(s,w,2,2);
     968           7 :       gel(sg3,8) = dicyclicgroup(t,perm_conj(u,w),2,2);
     969           7 :       gel(sg3,9) = dicyclicgroup(st,perm_conj(u2,w),2,2);
     970             :     }
     971             :   }
     972             :   else
     973             :   {
     974        4928 :     long osig = mael(factoru(ord[1]), 1, 1);
     975        4928 :     GEN sig = perm_pow(gel(gen,1), ord[1]/osig);
     976        4928 :     H = cyclicgroup(sig,osig);
     977        4928 :     sg3 = NULL;
     978             :   }
     979        4942 :   C = group_quotient(G,H);
     980        4935 :   Q = quotient_group(C,G);
     981        4935 :   M = group_subgroups(Q); lM = lg(M);
     982             :   /* sg1 is the list of subgroups containing H*/
     983        4928 :   sg1 = cgetg(lM, t_VEC);
     984        4928 :   for (i = 1; i < lM; ++i) gel(sg1,i) = quotient_subgroup_lift(C,H,gel(M,i));
     985             :   /*sg2 is a list of lists of subgroups not intersecting with H*/
     986        4928 :   sg2 = cgetg(lM, t_VEC);
     987             :   /* Loop over all subgroups of G/H */
     988        4928 :   for (j = 1; j < lM; ++j) gel(sg2,j) = liftsubgroup(C, H, gel(M,j));
     989        4928 :   p1 = gconcat(sg1, shallowconcat1(sg2));
     990        4928 :   if (sg3)
     991             :   {
     992          14 :     p1 = gconcat(p1, sg3);
     993          14 :     if (n==5) /*ensure that the D4 subgroups of S4 are in supersolvable format*/
     994          28 :       for(j = 3; j <= 5; j++)
     995             :       {
     996          21 :         GEN c = gmael(p1,j,1);
     997          21 :         if (!perm_commute(gel(c,1),gel(c,3)))
     998             :         {
     999          14 :           if (perm_commute(gel(c,2),gel(c,3))) { swap(gel(c,1), gel(c,2)); }
    1000             :           else
    1001           7 :             perm_mul_inplace2(gel(c,2), gel(c,1));
    1002             :         }
    1003             :       }
    1004             :   }
    1005        4928 :   return gerepileupto(ltop,p1);
    1006             : }
    1007             : 
    1008             : /*return 1 if G is abelian, else 0*/
    1009             : long
    1010         854 : group_isabelian(GEN G)
    1011             : {
    1012         854 :   GEN g = grp_get_gen(G);
    1013         854 :   long i, j, n = lg(g);
    1014        1407 :   for(i=2; i<n; i++)
    1015        1477 :     for(j=1; j<i; j++)
    1016         924 :       if (!perm_commute(gel(g,i), gel(g,j))) return 0;
    1017         728 :   return 1;
    1018             : }
    1019             : 
    1020             : /*If G is abelian, return its HNF matrix*/
    1021             : GEN
    1022         329 : group_abelianHNF(GEN G, GEN S)
    1023             : {
    1024         329 :   GEN M, g = grp_get_gen(G), o = grp_get_ord(G);
    1025         329 :   long i, j, k, n = lg(g);
    1026         329 :   if (!group_isabelian(G)) return NULL;
    1027         259 :   if (n==1) return cgetg(1,t_MAT);
    1028         245 :   if (!S) S = group_elts(G, group_domain(G));
    1029         245 :   M = cgetg(n,t_MAT);
    1030         868 :   for(i=1; i<n; i++)
    1031             :   {
    1032         623 :     GEN P, C = cgetg(n,t_COL);
    1033         623 :     pari_sp av = avma;
    1034         623 :     gel(M,i) = C;
    1035         623 :     P = perm_pow(gel(g,i), o[i]);
    1036         903 :     for(j=1; j<lg(S); j++)
    1037         903 :       if (zv_equal(P, gel(S,j))) break;
    1038         623 :     set_avma(av);
    1039         623 :     if (j==lg(S)) pari_err_BUG("galoisisabelian [inconsistent group]");
    1040         623 :     j--;
    1041        1162 :     for(k=1; k<i; k++)
    1042             :     {
    1043         539 :       long q = j / o[k];
    1044         539 :       gel(C,k) = stoi(j - q*o[k]);
    1045         539 :       j = q;
    1046             :     }
    1047         623 :     gel(C,k) = stoi(o[i]);
    1048         623 :     for (k++; k<n; k++) gel(C,k) = gen_0;
    1049             :   }
    1050         245 :   return M;
    1051             : }
    1052             : 
    1053             : /*If G is abelian, return its abstract SNF matrix*/
    1054             : GEN
    1055         280 : group_abelianSNF(GEN G, GEN L)
    1056             : {
    1057         280 :   pari_sp ltop = avma;
    1058         280 :   GEN H = group_abelianHNF(G,L);
    1059         280 :   if (!H) return NULL;
    1060         210 :   return gerepileupto(ltop, smithclean( ZM_snf(H) ));
    1061             : }
    1062             : 
    1063             : GEN
    1064         189 : abelian_group(GEN v)
    1065             : {
    1066         189 :   long card = zv_prod(v), i, d = 1, l = lg(v);
    1067         189 :   GEN G = cgetg(3,t_VEC), gen = cgetg(l,t_VEC);
    1068         189 :   gel(G,1) = gen;
    1069         189 :   gel(G,2) = vecsmall_copy(v);
    1070         420 :   for(i=1; i<l; i++)
    1071             :   {
    1072         231 :     GEN p = cgetg(card+1, t_VECSMALL);
    1073         231 :     long o = v[i], u = d*(o-1), j, k, l;
    1074         231 :     gel(gen, i) = p;
    1075             :     /* The following loop is over-optimized. Remember that I wrote it for
    1076             :      * testpermutation. Something has survived... BA */
    1077         826 :     for(j=1;j<=card;)
    1078             :     {
    1079        1582 :       for(k=1;k<o;k++)
    1080        1218 :         for(l=1;l<=d; l++,j++) p[j] = j+d;
    1081         364 :       for (l=1; l<=d; l++,j++) p[j] = j-u;
    1082             :     }
    1083         231 :     d += u;
    1084             :   }
    1085         189 :   return G;
    1086             : }
    1087             : 
    1088             : /*return 1 if H is a normal subgroup of G*/
    1089             : long
    1090          56 : group_subgroup_isnormal(GEN G, GEN H)
    1091             : {
    1092          56 :   GEN g = grp_get_gen(G);
    1093          56 :   long i, n = lg(g);
    1094          56 :   if (lg(grp_get_gen(H)) > 1 && group_domain(G) != group_domain(H))
    1095           0 :     pari_err_DOMAIN("group_subgroup_isnormal","domain(H)","!=",
    1096             :                     strtoGENstr("domain(G)"), H);
    1097         126 :   for(i=1; i<n; i++)
    1098          91 :     if (!group_perm_normalize(H, gel(g,i))) return 0;
    1099          35 :   return 1;
    1100             : }
    1101             : 
    1102             : long
    1103           0 : groupelts_exponent(GEN elts)
    1104             : {
    1105           0 :   long i, n = lg(elts)-1, expo = 1;
    1106           0 :   for(i=1; i<=n; i++) expo = ulcm(expo, perm_order(gel(elts,i)));
    1107           0 :   return expo;
    1108             : }
    1109             : 
    1110             : GEN
    1111         693 : groupelts_center(GEN S)
    1112             : {
    1113         693 :   pari_sp ltop = avma;
    1114         693 :   long i, j, n = lg(S)-1, l = n;
    1115         693 :   GEN V, elts = zero_F2v(n+1);
    1116       24969 :   for(i=1; i<=n; i++)
    1117             :   {
    1118       24276 :     if (F2v_coeff(elts,i)) { l--;  continue; }
    1119      545895 :     for(j=1; j<=n; j++)
    1120      535724 :       if (!perm_commute(gel(S,i),gel(S,j)))
    1121             :       {
    1122       13587 :         F2v_set(elts,i);
    1123       13587 :         F2v_set(elts,j); l--; break;
    1124             :       }
    1125             :   }
    1126         693 :   V = cgetg(l+1,t_VEC);
    1127       24969 :   for (i=1, j=1; i<=n ;i++)
    1128       24276 :     if (!F2v_coeff(elts,i)) gel(V,j++) = vecsmall_copy(gel(S,i));
    1129         693 :   return gerepileupto(ltop,V);
    1130             : }
    1131             : 
    1132             : GEN
    1133        4249 : groupelts_conjclasses(GEN elts, long *pnbcl)
    1134             : {
    1135        4249 :   long i, j, cl = 0, n = lg(elts)-1;
    1136        4249 :   GEN c = const_vecsmall(n,0);
    1137        4249 :   pari_sp av = avma;
    1138       52787 :   for (i=1; i<=n; i++)
    1139             :   {
    1140       48538 :     GEN g = gel(elts,i);
    1141       48538 :     if (c[i]) continue;
    1142       34923 :     c[i] = ++cl;
    1143      486745 :     for(j=1; j<=n; j++)
    1144      451822 :       if (j != i)
    1145             :       {
    1146      416899 :         GEN h = perm_conj(gel(elts,j), g);
    1147      416899 :         long i2 = gen_search(elts,h,0,(void*)&vecsmall_lexcmp,&cmp_nodata);
    1148      416899 :         c[i2] = cl;
    1149      416899 :         set_avma(av);
    1150             :       }
    1151             :   }
    1152        4249 :   if (pnbcl) *pnbcl = cl;
    1153        4249 :   return c;
    1154             : }
    1155             : 
    1156             : GEN
    1157        4249 : conjclasses_repr(GEN conj, long nb)
    1158             : {
    1159        4249 :   long i, l = lg(conj);
    1160        4249 :   GEN e = const_vecsmall(nb, 0);
    1161       52787 :   for(i=1; i<l; i++)
    1162             :   {
    1163       48538 :     long ci = conj[i];
    1164       48538 :     if (!e[ci]) e[ci] = i;
    1165             :   }
    1166        4249 :   return e;
    1167             : }
    1168             : 
    1169             : /* elts of G sorted wrt vecsmall_lexcmp order: g in G is determined by g[1]
    1170             :  * so sort by increasing g[1] */
    1171             : static GEN
    1172        3864 : galois_elts_sorted(GEN gal)
    1173             : {
    1174             :   long i, l;
    1175        3864 :   GEN elts = gal_get_group(gal), v = cgetg_copy(elts, &l);
    1176        3864 :   for (i = 1; i < l; i++) { GEN g = gel(elts,i); gel(v, g[1]) = g; }
    1177        3864 :   return v;
    1178             : }
    1179             : GEN
    1180        4263 : group_to_cc(GEN G)
    1181             : {
    1182        4263 :   GEN elts = checkgroupelts(G), z = cgetg(5,t_VEC);
    1183        4249 :   long n, flag = 1;
    1184        4249 :   if (typ(gel(G,1)) == t_POL)
    1185        3864 :     elts = galois_elts_sorted(G); /* galoisinit */
    1186             :   else
    1187             :   {
    1188         385 :     long i, l = lg(elts);
    1189         385 :     elts = gen_sort(elts,(void*)vecsmall_lexcmp,cmp_nodata); /* general case */
    1190        5824 :     for (i = 1; i < l; i++)
    1191        5586 :       if (gel(elts,i)[1] != i) { flag = 0; break; }
    1192             :   }
    1193        4249 :   gel(z,1) = elts;
    1194        4249 :   gel(z,2) = groupelts_conjclasses(elts,&n);
    1195        4249 :   gel(z,3) = conjclasses_repr(gel(z,2),n);
    1196        4249 :   gel(z,4) = utoi(flag); return z;
    1197             : }
    1198             : 
    1199             : /* S a list of generators */
    1200             : GEN
    1201           0 : groupelts_abelian_group(GEN S)
    1202             : {
    1203           0 :   pari_sp ltop = avma;
    1204             :   GEN Qgen, Qord, Qelt;
    1205           0 :   long i, j, n = lg(gel(S,1))-1, l = lg(S);
    1206           0 :   Qord = cgetg(l, t_VECSMALL);
    1207           0 :   Qgen = cgetg(l, t_VEC);
    1208           0 :   Qelt = mkvec(identity_perm(n));
    1209           0 :   for (i = 1, j = 1; i < l; ++i)
    1210             :   {
    1211           0 :     GEN  g = gel(S,i);
    1212           0 :     long o = perm_relorder(g, groupelts_set(Qelt, n));
    1213           0 :     gel(Qgen,j) = g;
    1214           0 :     Qord[j] = o;
    1215           0 :     if (o != 1) { Qelt = perm_generate(g, Qelt, o); j++; }
    1216             :   }
    1217           0 :   setlg(Qgen,j);
    1218           0 :   setlg(Qord,j);
    1219           0 :   return gerepilecopy(ltop, mkvec2(Qgen, Qord));
    1220             : }
    1221             : 
    1222             : GEN
    1223          14 : group_export_GAP(GEN G)
    1224             : {
    1225          14 :   pari_sp av = avma;
    1226          14 :   GEN s, comma, g = grp_get_gen(G);
    1227          14 :   long i, k, l = lg(g);
    1228          14 :   if (l == 1) return strtoGENstr("Group(())");
    1229           7 :   s = cgetg(2*l, t_VEC);
    1230           7 :   comma = strtoGENstr(", ");
    1231           7 :   gel(s,1) = strtoGENstr("Group(");
    1232          28 :   for (i=1, k=2; i < l; ++i)
    1233             :   {
    1234          21 :     if (i > 1) gel(s,k++) = comma;
    1235          21 :     gel(s,k++) = perm_to_GAP(gel(g,i));
    1236             :   }
    1237           7 :   gel(s,k++) = strtoGENstr(")");
    1238           7 :   return gerepilecopy(av, shallowconcat1(s));
    1239             : }
    1240             : 
    1241             : GEN
    1242          14 : group_export_MAGMA(GEN G)
    1243             : {
    1244          14 :   pari_sp av = avma;
    1245          14 :   GEN s, comma, g = grp_get_gen(G);
    1246          14 :   long i, k, l = lg(g);
    1247          14 :   if (l == 1) return strtoGENstr("PermutationGroup<1|>");
    1248           7 :   s = cgetg(2*l, t_VEC);
    1249           7 :   comma = strtoGENstr(", ");
    1250           7 :   gel(s,1) = gsprintf("PermutationGroup<%ld|",group_domain(G));
    1251          28 :   for (i=1, k=2; i < l; ++i)
    1252             :   {
    1253          21 :     if (i > 1) gel(s,k++) = comma;
    1254          21 :     gel(s,k++) = GENtoGENstr( vecsmall_to_vec(gel(g,i)) );
    1255             :   }
    1256           7 :   gel(s,k++) = strtoGENstr(">");
    1257           7 :   return gerepilecopy(av, shallowconcat1(s));
    1258             : }
    1259             : 
    1260             : GEN
    1261          28 : group_export(GEN G, long format)
    1262             : {
    1263          28 :   switch(format)
    1264             :   {
    1265          14 :   case 0: return group_export_GAP(G);
    1266          14 :   case 1: return group_export_MAGMA(G);
    1267             :   }
    1268           0 :   pari_err_FLAG("galoisexport");
    1269           0 :   return NULL; /*-Wall*/
    1270             : }

Generated by: LCOV version 1.13